From 0c93aa38b3f5333d7b026e6cc1e0c9d313a4da71 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Nov 2012 18:13:19 -0800 Subject: Minor cleanup for times as lists of four integers. * doc/lispref/os.texi (Time Parsing): Time values can now be four integers. * lisp/files.el (dir-locals-directory-cache): * lisp/ps-bdf.el (bdf-file-mod-time, bdf-read-font-info): Doc fixes. * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls): * lisp/ps-bdf.el (bdf-file-newer-than-time): Process four-integers time stamps, not two. Doc fixes. --- doc/lispref/ChangeLog | 5 +++++ doc/lispref/os.texi | 4 ++-- lisp/ChangeLog | 10 ++++++++++ lisp/files.el | 2 +- lisp/net/tramp-sh.el | 7 +++---- lisp/ps-bdf.el | 19 +++++++------------ 6 files changed, 28 insertions(+), 19 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 43ca9ac4aa5..389d94bf8c5 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2012-11-18 Paul Eggert + + Minor cleanup for times as lists of four integers. + * os.texi (Time Parsing): Time values can now be four integers. + 2012-11-18 Glenn Morris * loading.texi (How Programs Do Loading): Add eager macro expansion. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 6c5f6e85683..002632c3479 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1373,8 +1373,8 @@ on others, years as early as 1901 do work. @node Time Parsing @section Parsing and Formatting Times - These functions convert time values (lists of two or three integers) -to text in a string, and vice versa. + These functions convert time values to text in a string, and vice versa. +Time values are lists of two to four integers (@pxref{Time of Day}). @defun date-to-time string This function parses the time-string @var{string} and returns the diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 00cf0c1afb6..920f893bb7d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2012-11-18 Paul Eggert + + Minor cleanup for times as lists of four integers. + * files.el (dir-locals-directory-cache): + * ps-bdf.el (bdf-file-mod-time, bdf-read-font-info): + Doc fixes. + * net/tramp-sh.el (tramp-do-file-attributes-with-ls): + * ps-bdf.el (bdf-file-newer-than-time): + Process four-integers time stamps, not two. Doc fixes. + 2012-11-18 Glenn Morris * image.el (insert-image, insert-sliced-image): Doc fix. diff --git a/lisp/files.el b/lisp/files.el index 26c5c683b3d..51f8256f71a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3424,7 +3424,7 @@ DIR is the name of the directory. CLASS is the name of a variable class (a symbol). MTIME is the recorded modification time of the directory-local variables file associated with this entry. This time is a list -of two integers (the same format as `file-attributes'), and is +of integers (the same format as `file-attributes'), and is used to test whether the cache entry is still valid. Alternatively, MTIME can be nil, which means the entry is always considered valid.") diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ec321d00506..5b090047f8d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1270,12 +1270,11 @@ target of the symlink differ." res-uid ;; 3. File gid. res-gid - ;; 4. Last access time, as a list of two integers. First - ;; integer has high-order 16 bits of time, second has low 16 - ;; bits. + ;; 4. Last access time, as a list of integers in the same format + ;; as `current-time'. ;; 5. Last modification time, likewise. ;; 6. Last status change time, likewise. - '(0 0) '(0 0) '(0 0) ;CCC how to find out? + '(0 0 0 0) '(0 0 0 0) '(0 0 0 0) ;CCC how to find out? ;; 7. Size in bytes (-1, if number is out of range). res-size ;; 8. File modes, as a string of ten letters or dashes as in ls -l. diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index a82e03ceda7..477aee1b2da 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -70,20 +70,15 @@ for BDFNAME." (defsubst bdf-file-mod-time (filename) "Return modification time of FILENAME. -The value is a list of two integers, the first integer has high-order -16 bits, the second has low 16 bits." +The value is a list of integers in the same format as `current-time'." (nth 5 (file-attributes filename))) (defun bdf-file-newer-than-time (filename mod-time) "Return non-nil if and only if FILENAME is newer than MOD-TIME. -MOD-TIME is a modification time as a list of two integers, the first -integer has high-order 16 bits, the second has low 16 bits." - (let* ((new-mod-time (bdf-file-mod-time filename)) - (new-time (car new-mod-time)) - (time (car mod-time))) - (or (> new-time time) - (and (= new-time time) - (> (nth 1 new-mod-time) (nth 1 mod-time)))))) +MOD-TIME is a modification time as a list of integers in the same +format as `current-time'." + (let ((new-mod-time (bdf-file-mod-time filename))) + (time-less-p mod-time new-mod-time))) (defun bdf-find-file (bdfname) "Return a buffer visiting a bdf file BDFNAME. @@ -178,8 +173,8 @@ FONT-INFO is a list of the following format: (BDFFILE MOD-TIME FONT-BOUNDING-BOX RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) -MOD-TIME is last modification time as a list of two integers, the -first integer has high-order 16 bits, the second has low 16 bits. +MOD-TIME is last modification time as a list of integers in the +same format as `current-time'. SIZE is a size of the font on 72 dpi device. This value is got from SIZE record of the font. -- cgit v1.3 From d1a355a1bfb2ff5914e42267c2d0c9e414f08b68 Mon Sep 17 00:00:00 2001 From: Dani Moncayo Date: Sun, 18 Nov 2012 14:27:43 +0800 Subject: Emacs manual fixes regarding automatic scrolling. * display.texi (Auto Scrolling): Fix some inaccuracies, plus clarifications. (Horizontal Scrolling): Clarifications. Fixes: debbugs:12865 --- doc/emacs/ChangeLog | 6 +++ doc/emacs/display.texi | 99 ++++++++++++++++++++++++++------------------------ 2 files changed, 57 insertions(+), 48 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 5f8a252b5d6..56001d6e29e 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,9 @@ +2012-11-18 Dani Moncayo + + * display.texi (Auto Scrolling): Fix some inaccuracies, plus + clarifications (Bug#12865). + (Horizontal Scrolling): Clarifications. + 2012-11-17 Dani Moncayo * mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746). diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index b6ab4913f9c..876c46bdf1a 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -213,59 +213,62 @@ entire current defun onto the screen if possible. @node Auto Scrolling @section Automatic Scrolling +@cindex automatic scrolling Emacs performs @dfn{automatic scrolling} when point moves out of the -visible portion of the text. +visible portion of the text. Normally, automatic scrolling centers +point vertically in the window, but there are several ways to alter +this behavior. @vindex scroll-conservatively - Normally, this centers point vertically within the window. However, -if you set @code{scroll-conservatively} to a small number @var{n}, -then if you move point just a little off the screen (less than @var{n} -lines), Emacs scrolls the text just far enough to bring point back on -screen. If doing so fails to make point visible, Emacs centers point -in the window. By default, @code{scroll-conservatively} is@tie{}0. -If you set @code{scroll-conservatively} to a large number (larger than -100), Emacs will never center point as result of scrolling, even if -point moves far away from the text previously displayed in the window. -With such a large value, Emacs will always scroll text just enough for -bringing point into view, so point will end up at the top or bottom of -the window, depending on the scroll direction. + If you set @code{scroll-conservatively} to a small number @var{n}, +then moving point just a little off the screen (no more than @var{n} +lines) causes Emacs to scroll just enough to bring point back on +screen; if doing so fails to make point visible, Emacs scrolls just +far enough to center point in the window. If you set +@code{scroll-conservatively} to a large number (larger than 100), +automatic scrolling never centers point, no matter how far point +moves; Emacs always scrolls text just enough to bring point into view, +either at the top or bottom of the window depending on the scroll +direction. By default, @code{scroll-conservatively} is@tie{}0, which +means to always center point in the window. @vindex scroll-step - An alternative way of controlling how Emacs scrolls text is by -customizing the variable @code{scroll-step}. Its value determines how -many lines to scroll the window when point moves off the screen. If -moving by that number of lines fails to bring point back into view, -point is centered instead. The default value is zero, which causes -point to always be centered after scrolling. - - Since both @code{scroll-conservatively} and @code{scroll-step} -control automatic scrolling in contradicting ways, you should set only -one of them. If you customize both, the value of -@code{scroll-conservatively} takes precedence. + Another way to control automatic scrolling is to customize the +variable @code{scroll-step}. Its value determines the number of lines +by which to automatically scroll, when point moves off the screen. If +scrolling by that number of lines fails to bring point back into view, +point is centered instead. The default value is zero, which (by +default) causes point to always be centered after scrolling. @cindex aggressive scrolling @vindex scroll-up-aggressively @vindex scroll-down-aggressively - When the window does scroll by a distance longer than -@code{scroll-step}, you can control how aggressively it scrolls by -setting the variables @code{scroll-up-aggressively} and -@code{scroll-down-aggressively}. The value of -@code{scroll-up-aggressively} should be either @code{nil}, or a -fraction @var{f} between 0 and 1. A fraction specifies where on the -screen to put point when scrolling upward, i.e.@: forward. When point -goes off the window end, the new start position is chosen to put point -@var{f} parts of the window height from the bottom margin. Thus, -larger @var{f} means more aggressive scrolling: more new text is -brought into view. The default value, @code{nil}, is equivalent to -0.5. - - Likewise, @code{scroll-down-aggressively} is used for scrolling -down, i.e.@: backward. The value specifies how far point should be -placed from the top margin of the window; thus, as with -@code{scroll-up-aggressively}, a larger value is more aggressive. - - These two variables are ignored if either @code{scroll-step} or -@code{scroll-conservatively} are set to a non-zero value. + A third way to control automatic scrolling is to customize the +variables @code{scroll-up-aggressively} and +@code{scroll-down-aggressively}, which directly specify the vertical +position of point after scrolling. The value of +@code{scroll-up-aggressively} should be either @code{nil} (the +default), or a floating point number @var{f} between 0 and 1. The +latter means that when point goes below the bottom window edge (i.e.@: +scrolling forward), Emacs scrolls the window so that point is @var{f} +parts of the window height from the bottom window edge. Thus, larger +@var{f} means more aggressive scrolling: more new text is brought into +view. The default value, @code{nil}, is equivalent to 0.5. + + Likewise, @code{scroll-down-aggressively} is used when point goes +above the bottom window edge (i.e.@: scrolling backward). The value +specifies how far point should be from the top margin of the window +after scrolling. Thus, as with @code{scroll-up-aggressively}, a +larger value is more aggressive. + + Note that the variables @code{scroll-conservatively}, +@code{scroll-step}, and @code{scroll-up-aggressively} / +@code{scroll-down-aggressively} control automatic scrolling in +contradictory ways. Therefore, you should pick no more than one of +these methods to customize automatic scrolling. In case you customize +multiple variables, the order of priority is: +@code{scroll-conservatively}, then @code{scroll-step}, and finally +@code{scroll-up-aggressively} / @code{scroll-down-aggressively}. @vindex scroll-margin The variable @code{scroll-margin} restricts how close point can come @@ -295,10 +298,10 @@ the cursor is left at the edge instead.) @vindex hscroll-margin The variable @code{hscroll-margin} controls how close point can get -to the window's edges before automatic scrolling occurs. It is -measured in columns. For example, if the value is 5, then moving -point within 5 columns of an edge causes horizontal scrolling away -from that edge. +to the window's left and right edges before automatic scrolling +occurs. It is measured in columns. For example, if the value is 5, +then moving point within 5 columns of an edge causes horizontal +scrolling away from that edge. @vindex hscroll-step The variable @code{hscroll-step} determines how many columns to -- cgit v1.3 From 66c466d4fdb7f874f19191ca06fad92f9c2393cd Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sun, 18 Nov 2012 12:34:36 +0100 Subject: Fix example for Display Action Functions. * windows.texi (Display Action Functions): Fix recently added example. Suggested by Michael Heerdegen. --- doc/lispref/ChangeLog | 5 +++++ doc/lispref/windows.texi | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 389d94bf8c5..bdf4ef13488 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2012-11-18 Martin Rudalics + + * windows.texi (Display Action Functions): Fix recently added + example. Suggested by Michael Heerdegen. + 2012-11-18 Paul Eggert Minor cleanup for times as lists of four integers. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 439e807260f..46b31ef0d9f 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2038,7 +2038,8 @@ Evaluating the form above will cause @code{display-buffer} to proceed as follows: If `*foo*' already appears on a visible or iconified frame, it will reuse its window. Otherwise, it will try to pop up a new window or, if that is impossible, a new frame. If all these steps fail, it -will try to use some existing window. +will proceed using whatever @code{display-buffer-base-action} and +@code{display-buffer-fallback-action} prescribe. Furthermore, @code{display-buffer} will try to adjust a reused window (provided `*foo*' was put by @code{display-buffer} there before) or a -- cgit v1.3 From 273ac8d1ef96529d010975b59caa99489cbc51b4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Nov 2012 18:43:36 +0200 Subject: Prevent crashes on MS-Windows when w32-downcase-file-names is non-nil. src/fileio.c (Fsubstitute_in_file_name, Ffile_name_directory) (Fexpand_file_name) [DOS_NT]: Pass encoded file name to dostounix_filename. Prevents crashes down the road, because dostounix_filename assumes it gets a unibyte string. Reported by Michel de Ruiter , see http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00017.html --- src/ChangeLog | 9 +++++++++ src/fileio.c | 46 +++++++++++++++++++++++++++++++++++++--------- 2 files changed, 46 insertions(+), 9 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index c12eff19ddd..c4f1ee60d84 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2012-11-18 Eli Zaretskii + + * fileio.c (Fsubstitute_in_file_name, Ffile_name_directory) + (Fexpand_file_name) [DOS_NT]: Pass encoded file name to + dostounix_filename. Prevents crashes down the road, because + dostounix_filename assumes it gets a unibyte string. Reported by + Michel de Ruiter , see + http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00017.html + 2012-11-17 Eli Zaretskii * w32select.c: Include w32common.h before w32term.h, so that diff --git a/src/fileio.c b/src/fileio.c index d47d7dd9e0b..a04eb8ecea1 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -315,6 +315,7 @@ Given a Unix syntax file name, returns a string ending in slash. */) register const char *beg; #else register char *beg; + Lisp_Object tem_fn; #endif register const char *p; Lisp_Object handler; @@ -374,10 +375,13 @@ Given a Unix syntax file name, returns a string ending in slash. */) p = beg + strlen (beg); } } - dostounix_filename (beg); -#endif /* DOS_NT */ - + tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg, + STRING_MULTIBYTE (filename))); + dostounix_filename (SSDATA (tem_fn)); + return DECODE_FILE (tem_fn); +#else /* DOS_NT */ return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); +#endif /* DOS_NT */ } DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, @@ -951,7 +955,18 @@ filesystem tree, not (expand-file-name ".." dirname). */) #ifdef DOS_NT /* Make sure directories are all separated with /, but avoid allocation of a new string when not required. */ - dostounix_filename (nm); + if (multibyte) + { + Lisp_Object tem_name = make_specified_string (nm, -1, strlen (nm), + multibyte); + + tem_name = ENCODE_FILE (tem_name); + dostounix_filename (SSDATA (tem_name)); + tem_name = DECODE_FILE (tem_name); + memcpy (nm, SSDATA (tem_name), SBYTES (tem_name) + 1); + } + else + dostounix_filename (nm); #ifdef WINDOWSNT if (IS_DIRECTORY_SEP (nm[1])) { @@ -1305,10 +1320,13 @@ filesystem tree, not (expand-file-name ".." dirname). */) target[0] = '/'; target[1] = ':'; } - dostounix_filename (target); -#endif /* DOS_NT */ - result = make_specified_string (target, -1, o - target, multibyte); + result = ENCODE_FILE (result); + dostounix_filename (SSDATA (result)); + result = DECODE_FILE (result); +#else /* !DOS_NT */ + result = make_specified_string (target, -1, o - target, multibyte); +#endif /* !DOS_NT */ } /* Again look to see if the file name has special constructs in it @@ -1587,8 +1605,18 @@ those `/' is discarded. */) memcpy (nm, SDATA (filename), SBYTES (filename) + 1); #ifdef DOS_NT - dostounix_filename (nm); - substituted = (strcmp (nm, SDATA (filename)) != 0); + { + Lisp_Object encoded_filename = ENCODE_FILE (filename); + Lisp_Object tem_fn; + + dostounix_filename (SDATA (encoded_filename)); + tem_fn = DECODE_FILE (encoded_filename); + nm = alloca (SBYTES (tem_fn) + 1); + memcpy (nm, SDATA (tem_fn), SBYTES (tem_fn) + 1); + substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0); + if (substituted) + filename = tem_fn; + } #endif endp = nm + SBYTES (filename); -- cgit v1.3 From 031b541f1943a49ee06944cc5957dab3f7baedf9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Nov 2012 18:54:31 +0200 Subject: Fix latest changes in nt/inc/unistd.h. nt/inc/unistd.h: Don't include fcntl.h and don't define O_RDWR. Fixes: debbugs:12881 --- nt/ChangeLog | 4 ++++ nt/inc/unistd.h | 11 ----------- 2 files changed, 4 insertions(+), 11 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index 95203b9d2fa..4f9e8a2663c 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2012-11-18 Eli Zaretskii + + * inc/unistd.h: Don't include fcntl.h and don't define O_RDWR. + 2012-11-17 Juanma Barranquero * config.nt: Sync with autogen/config.in. diff --git a/nt/inc/unistd.h b/nt/inc/unistd.h index 0173fdbb943..e751ed124d3 100644 --- a/nt/inc/unistd.h +++ b/nt/inc/unistd.h @@ -26,17 +26,6 @@ extern int faccessat (int, char const *, int, int); #define AT_EACCESS 4 #define AT_SYMLINK_NOFOLLOW 4096 -/* Here are some more fcntl.h macros that default to gnulib-compatible - values. Include first, to make sure we don't override - its values if any. FIXME: If we know does not define - O_NOCTTY and O_RDWR, this can be replaced with a simple "#define - O_NOCTTY 0" and "#define O_RDWR 2". */ -#include -#ifndef O_NOCTTY #define O_NOCTTY 0 -#endif -#ifndef O_RDWR -#define O_RDWR 2 -#endif #endif /* _UNISTD_H */ -- cgit v1.3 From 535efd4a430b6595a30efaa2919e565ad21209b9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 18 Nov 2012 09:10:35 -0800 Subject: More minor time fixes. * calendar/time-date.el: Commentary fix. * net/tramp-sh.el (tramp-do-file-attributes-with-ls): Undo last change; too much other code depends on (0 0) time stamps. * net/tramp.el (tramp-time-less-p, tramp-time-subtract): Add a couple of FIXME comments. --- lisp/ChangeLog | 7 +++++++ lisp/calendar/time-date.el | 9 ++++----- lisp/net/tramp-sh.el | 7 ++++--- lisp/net/tramp.el | 2 ++ 4 files changed, 17 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 920f893bb7d..a6fdf7ebc4b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2012-11-18 Paul Eggert + More minor time fixes. + * calendar/time-date.el: Commentary fix. + * net/tramp-sh.el (tramp-do-file-attributes-with-ls): Undo last change; + too much other code depends on (0 0) time stamps. + * net/tramp.el (tramp-time-less-p, tramp-time-subtract): + Add a couple of FIXME comments. + Minor cleanup for times as lists of four integers. * files.el (dir-locals-directory-cache): * ps-bdf.el (bdf-file-mod-time, bdf-read-font-info): diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 38b766084c9..6e967bd8c79 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -30,11 +30,10 @@ ;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 ;; seconds, where missing components are treated as zero. HIGH can be ;; negative, either because the value is a time difference, or because -;; the machine supports negative time stamps that fall before the -;; epoch. The macro `with-decoded-time-value' and the -;; function `encode-time-value' make it easier to deal with these -;; three formats. See `time-subtract' for an example of how to use -;; them. +;; the machine supports negative time stamps that fall before the epoch. +;; The macro `with-decoded-time-value' and the function +;; `encode-time-value' make it easier to deal with these formats. +;; See `time-subtract' for an example of how to use them. ;;; Code: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 5b090047f8d..059e1e63c77 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1270,11 +1270,12 @@ target of the symlink differ." res-uid ;; 3. File gid. res-gid - ;; 4. Last access time, as a list of integers in the same format - ;; as `current-time'. + ;; 4. Last access time, as a list of integers. Normally this would be + ;; in the same format as `current-time', but the subseconds part is not + ;; currently implemented, and (0 0) denotes an unknown time. ;; 5. Last modification time, likewise. ;; 6. Last status change time, likewise. - '(0 0 0 0) '(0 0 0 0) '(0 0 0 0) ;CCC how to find out? + '(0 0) '(0 0) '(0 0) ;CCC how to find out? ;; 7. Size in bytes (-1, if number is out of range). res-size ;; 8. File modes, as a string of ten letters or dashes as in ls -l. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 874c0aa7fef..6157da20db7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3761,6 +3761,7 @@ Invokes `password-read' if available, `read-passwd' else." ("oct" . 10) ("nov" . 11) ("dec" . 12)) "Alist mapping month names to integers.") +;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? ;;;###tramp-autoload (defun tramp-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." @@ -3770,6 +3771,7 @@ Invokes `password-read' if available, `read-passwd' else." (and (= (car t1) (car t2)) (< (nth 1 t1) (nth 1 t2))))) +;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? (defun tramp-time-subtract (t1 t2) "Subtract two time values. Return the difference in the format of a time value." -- cgit v1.3 From 6e9f7997b36d21004794fa2b8a550729cbabd81a Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Sun, 18 Nov 2012 17:39:37 -0800 Subject: Rename cygwin_convert_path* to cygwin_convert_file_name* --- etc/NEWS | 7 ++++--- lisp/ChangeLog | 5 +++++ lisp/term/w32-win.el | 4 ++-- src/ChangeLog | 9 +++++++++ src/cygw32.c | 20 +++++++++++--------- src/w32fns.c | 6 +++--- 6 files changed, 34 insertions(+), 17 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 57e40982af6..c906640d80e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1034,9 +1034,10 @@ takes precedence over most other maps for a short while (normally one key). Pass --with-w32 to configure. The default remains the X11 interface. ** Two new functions are available in Cygwin builds: -`cygwin-convert-path-from-windows' and `cygwin-convert-path-to-windows'. -These functions allow Lisp code to access the Cygwin file-name mapping -machinery to convert between Cygwin and Windows-native file names. +`cygwin-convert-file-name-from-windows' and +`cygwin-convert-file-name-to-windows'. These functions allow Lisp +code to access the Cygwin file-name mapping machinery to convert +between Cygwin and Windows-native file and directory names. ** When invoked with the -nw switch to run on the Windows text-mode terminal, Emacs now supports mouse highlight, help-echo (in the echo area), and diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ca65e431964..26b4e6bb8c7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Daniel Colascione + + * term/w32-win.el (cygwin-convert-path-from-windows): Accomodate + rename of cygwin_convert_path* to cygwin_convert_file_name*. + 2012-11-18 Chong Yidong * filecache.el (file-cache--read-list): New function. diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 42e09b65750..95dab10101b 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -91,7 +91,7 @@ (declare-function w32-send-sys-command "w32fns.c") (declare-function set-message-beep "w32fns.c") -(declare-function cygwin-convert-path-from-windows "cygw32.c" +(declare-function cygwin-convert-file-name-from-windows "cygw32.c" (path &optional absolute_p)) ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles @@ -108,7 +108,7 @@ (defun w32-handle-dropped-file (window file-name) (let ((f (if (eq system-type 'cygwin) - (cygwin-convert-path-from-windows file-name t) + (cygwin-convert-file-name-from-windows file-name t) (subst-char-in-string ?\\ ?/ file-name))) (coding (or file-name-coding-system default-file-name-coding-system))) diff --git a/src/ChangeLog b/src/ChangeLog index 2a0c0e6822d..89c4e273715 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2012-11-19 Daniel Colascione + + * w32fns.c (Fx_file_dialog): + (Fx_file_dialog): Accomodate rename of cygwin_convert_path* to + cygwin_convert_file_name*. + + * cygw32.c (Fcygwin_convert_path_to_windows, syms_of_cygw32): + Rename cygwin_convert_path* to cygwin_convert_file_name*. + 2012-11-18 Paul Eggert * nsterm.m (ns_select): Send SIGIO only to self, not to process group. diff --git a/src/cygw32.c b/src/cygw32.c index 54f2076a891..d9777d5e22e 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -106,22 +106,24 @@ conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p) return unbind_to (count, DECODE_FILE (converted)); } -DEFUN ("cygwin-convert-path-to-windows", - Fcygwin_convert_path_to_windows, Scygwin_convert_path_to_windows, +DEFUN ("cygwin-convert-file-name-to-windows", + Fcygwin_convert_file_name_to_windows, + Scygwin_convert_file_name_to_windows, 1, 2, 0, - doc: /* Convert PATH to a Windows path. If ABSOLUTE-P if - non-nil, return an absolute path.*/) + doc: /* Convert PATH to a Windows path. If ABSOLUTE-P is +non-nil, return an absolute path.*/) (Lisp_Object path, Lisp_Object absolute_p) { return from_unicode ( conv_filename_to_w32_unicode (path, EQ (absolute_p, Qnil) ? 0 : 1)); } -DEFUN ("cygwin-convert-path-from-windows", - Fcygwin_convert_path_from_windows, Scygwin_convert_path_from_windows, +DEFUN ("cygwin-convert-file-name-from-windows", + Fcygwin_convert_file_name_from_windows, + Scygwin_convert_file_name_from_windows, 1, 2, 0, doc: /* Convert a Windows path to a Cygwin path. If ABSOLUTE-P - if non-nil, return an absolute path.*/) +is non-nil, return an absolute path.*/) (Lisp_Object path, Lisp_Object absolute_p) { return conv_filename_from_w32_unicode (to_unicode (path, &path), @@ -131,6 +133,6 @@ DEFUN ("cygwin-convert-path-from-windows", void syms_of_cygw32 (void) { - defsubr (&Scygwin_convert_path_from_windows); - defsubr (&Scygwin_convert_path_to_windows); + defsubr (&Scygwin_convert_file_name_from_windows); + defsubr (&Scygwin_convert_file_name_to_windows); } diff --git a/src/w32fns.c b/src/w32fns.c index ed5625e802c..90f5b1695ea 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6167,9 +6167,9 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) filename = empty_unibyte_string; #ifdef CYGWIN - dir = Fcygwin_convert_path_to_windows (dir, Qt); + dir = Fcygwin_convert_file_name_to_windows (dir, Qt); if (SCHARS (filename) > 0) - filename = Fcygwin_convert_path_to_windows (filename, Qnil); + filename = Fcygwin_convert_file_name_to_windows (filename, Qnil); #endif CHECK_STRING (dir); @@ -6270,7 +6270,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) #endif /* NTGUI_UNICODE */ #ifdef CYGWIN - filename = Fcygwin_convert_path_from_windows (filename, Qt); + filename = Fcygwin_convert_file_name_from_windows (filename, Qt); #endif /* CYGWIN */ /* Strip the dummy filename off the end of the string if we -- cgit v1.3 From d1c0cddf73e3edf4b1a7bbaa9e24caa817bd10e1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 18 Nov 2012 22:16:03 -0500 Subject: * lisp/window.el (switch-to-buffer): Re-add the warning that was lost in the code rewrite. --- lisp/ChangeLog | 5 +++++ lisp/window.el | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a6fdf7ebc4b..85e762497e4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Stefan Monnier + + * window.el (switch-to-buffer): Re-add the warning that was lost in the + code rewrite. + 2012-11-18 Paul Eggert More minor time fixes. diff --git a/lisp/window.el b/lisp/window.el index d378ea5ff14..52909fa9e5f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5870,7 +5870,12 @@ the selected window or never appeared in it before, or if :version "24.3") (defun switch-to-buffer (buffer-or-name &optional norecord force-same-window) - "Switch to buffer BUFFER-OR-NAME in the selected window. + "Display buffer BUFFER-OR-NAME in the selected window. + +WARNING: This is NOT the way to work on another buffer temporarily +within a Lisp program! Use `set-buffer' instead. That avoids +messing with the window-buffer correspondences. + If the selected window cannot display the specified buffer (e.g. if it is a minibuffer window or strongly dedicated to another buffer), call `pop-to-buffer' to select the buffer in -- cgit v1.3 From e8909bdc32f996219fe6875c837c65f891efd726 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Sun, 18 Nov 2012 23:03:08 -0600 Subject: * calc/calc-forms.el (math-leap-year-p): Fix formula for negative year numbers. (math-date-to-julian-dt): Adjust the initial approximation for the year to deal with the new definition of the DATE. --- lisp/ChangeLog | 7 +++++++ lisp/calc/calc-forms.el | 13 ++++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 26b4e6bb8c7..ab060de5782 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-19 Jay Belanger + + * calc/calc-forms.el (math-leap-year-p): Fix formula for negative + year numbers. + (math-date-to-julian-dt): Adjust the initial approximation for the + year to deal with the new definition of the DATE. + 2012-11-19 Daniel Colascione * term/w32-win.el (cygwin-convert-path-from-windows): Accomodate diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 709250f9ba9..98b22550f75 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -371,9 +371,10 @@ ;;; These versions are rewritten to use arbitrary-size integers. ;;; A numerical date is the number of days since midnight on -;;; the morning of December 31, 1 B.C. Emacs's calendar refers to such -;;; a date as an absolute date, some function names also use that -;;; terminology. If the date is a non-integer, it represents a specific date and time. +;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian). +;;; Emacs's calendar refers to such a date as an absolute date, some Calc function +;;; names also use that terminology. If the date is a non-integer, it represents +;;; a specific date and time. ;;; A "dt" is a list of the form, (year month day), corresponding to ;;; an integer code, or (year month day hour minute second), corresponding ;;; to a non-integer code. @@ -408,8 +409,8 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar." (let* ((month 1) day (year (math-quotient (math-add date (if (Math-lessp date 711859) - 365 ; for speed, we take - -108)) ; >1950 as a special case + 367 ; for speed, we take + -106)) ; >1950 as a special case (if (math-negp date) 366 365))) ; this result may be an overestimate temp) @@ -494,6 +495,8 @@ Gregorian calendar." (if (math-negp year) (= (math-imod (math-neg year) 4) 1) (= (math-imod year 4) 0)) + (if (math-negp year) + (setq year (math-sub -1 year))) (setq year (math-imod year 400)) (or (and (= (% year 4) 0) (/= (% year 100) 0)) (= year 0)))) -- cgit v1.3 From 70678cd508e66742681c9479aa6a9d4c77010783 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Mon, 19 Nov 2012 06:24:14 +0000 Subject: message.el (message-get-reply-headers): Make sure the reply goes to the author if it is a wide reply --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/message.el | 13 +++++++++---- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dd493d383a3..d0dfd100f44 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Katsumi Yamaoka + + * message.el (message-get-reply-headers): + Make sure the reply goes to the author if it is a wide reply. + 2012-11-16 Jan Tatarik * gnus-score.el (gnus-score-body): diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8905acb9d1f..a44f08bcd32 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6730,11 +6730,16 @@ The function is called with one parameter, a cons cell ..." ", ")) mct (message-fetch-field "mail-copies-to") author (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to") - (message-fetch-field "from") - "") + (message-fetch-field "reply-to")) mft (and message-use-mail-followup-to - (message-fetch-field "mail-followup-to")))) + (message-fetch-field "mail-followup-to"))) + ;; Make sure this message goes to the author if this is a wide + ;; reply, sine Reply-To address may be a list address a mailing + ;; list server added. + (when (and wide author) + (setq cc (concat author ", " cc))) + (when (or wide (not author)) + (setq author (or (message-fetch-field "from") "")))) ;; Handle special values of Mail-Copies-To. (when mct -- cgit v1.3 From 3394be35d90acdae2607339f712bd3f37cb38e4d Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Mon, 19 Nov 2012 11:36:02 +0000 Subject: message.el (message-get-reply-headers): Fix typo in comment --- lisp/gnus/message.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a44f08bcd32..5a2b4334582 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6734,7 +6734,7 @@ The function is called with one parameter, a cons cell ..." mft (and message-use-mail-followup-to (message-fetch-field "mail-followup-to"))) ;; Make sure this message goes to the author if this is a wide - ;; reply, sine Reply-To address may be a list address a mailing + ;; reply, since Reply-To address may be a list address a mailing ;; list server added. (when (and wide author) (setq cc (concat author ", " cc))) -- cgit v1.3 From d7f2a65cc22f1383b7d9a0e78e7bb90c19f56a39 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 19 Nov 2012 16:25:10 +0100 Subject: * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files are remote, check out-of-band property for both. --- lisp/ChangeLog | 5 +++++ lisp/net/tramp-sh.el | 16 +++++++++------- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 85e762497e4..8447be48e14 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Michael Albinus + + * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files + are remote, check out-of-band property for both. + 2012-11-19 Stefan Monnier * window.el (switch-to-buffer): Re-add the warning that was lost in the diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 059e1e63c77..07da0b3dc16 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1270,9 +1270,10 @@ target of the symlink differ." res-uid ;; 3. File gid. res-gid - ;; 4. Last access time, as a list of integers. Normally this would be - ;; in the same format as `current-time', but the subseconds part is not - ;; currently implemented, and (0 0) denotes an unknown time. + ;; 4. Last access time, as a list of integers. Normally this + ;; would be in the same format as `current-time', but the + ;; subseconds part is not currently implemented, and (0 0) + ;; denotes an unknown time. ;; 5. Last modification time, likewise. ;; 6. Last status change time, likewise. '(0 0) '(0 0) '(0 0) ;CCC how to find out? @@ -1980,6 +1981,7 @@ file names." (error "Unknown operation `%s', must be `copy' or `rename'" op)) (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) + (length (nth 7 (file-attributes (file-truename filename)))) (context (and preserve-selinux-context (apply 'file-selinux-context (list filename)))) pr tm) @@ -2009,8 +2011,9 @@ file names." ok-if-already-exists keep-date preserve-uid-gid)) ;; Try out-of-band operation. - ((tramp-method-out-of-band-p - v1 (nth 7 (file-attributes (file-truename filename)))) + ((and + (tramp-method-out-of-band-p v1 length) + (tramp-method-out-of-band-p v2 length)) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) @@ -2038,8 +2041,7 @@ file names." ;; If the Tramp file has an out-of-band method, the ;; corresponding copy-program can be invoked. - ((tramp-method-out-of-band-p - v (nth 7 (file-attributes (file-truename filename)))) + ((tramp-method-out-of-band-p v length) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date)) -- cgit v1.3 From 020423c2c37f80e6746bce87f431a51c66082a50 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 11:16:07 -0500 Subject: * lisp/cedet/semantic/fw.el (semantic-make-local-hook) (semantic-mode-line-update): Simplify via CSE. --- lisp/cedet/ChangeLog | 13 +++++++++---- lisp/cedet/semantic/fw.el | 14 ++++++-------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index a01ce4c30a3..cdfb357b646 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,12 +1,17 @@ +2012-11-19 Stefan Monnier + + * semantic/fw.el (semantic-make-local-hook, semantic-mode-line-update): + Simplify via CSE. + 2012-11-16 David Engster - * semantic/symref/list.el (semantic-symref-symbol): Use - `semantic-complete-read-tag-project' instead of + * semantic/symref/list.el (semantic-symref-symbol): + Use `semantic-complete-read-tag-project' instead of `semantic-complete-read-tag-buffer-deep', since the latter is not working correctly. - * semantic/symref.el (semantic-symref-result-get-tags): Use - `find-buffer-visiting' to follow symbolic links. + * semantic/symref.el (semantic-symref-result-get-tags): + Use `find-buffer-visiting' to follow symbolic links. * semantic/fw.el (semantic-find-file-noselect): Always set `enable-local-variables' to `:safe' when loading files. diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 14ffc808c44..6dd85309967 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -122,15 +122,13 @@ ) - (if (and (not (featurep 'xemacs)) - (>= emacs-major-version 21)) - (defalias 'semantic-make-local-hook 'identity) - (defalias 'semantic-make-local-hook 'make-local-hook) - ) + (defalias 'semantic-make-local-hook + (if (and (not (featurep 'xemacs)) + (>= emacs-major-version 21)) + #'identity #'make-local-hook)) - (if (featurep 'xemacs) - (defalias 'semantic-mode-line-update 'redraw-modeline) - (defalias 'semantic-mode-line-update 'force-mode-line-update)) + (defalias 'semantic-mode-line-update + (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update)) ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. -- cgit v1.3 From 855b17af8fd8a96e1ca66a652b88f34479df12d7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 11:17:49 -0500 Subject: * lisp/calendar/time-date.el (time-to-seconds): De-obsolete. --- etc/NEWS | 1 + lisp/ChangeLog | 8 ++++++-- lisp/calendar/time-date.el | 4 +--- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c906640d80e..b63d3f8d538 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -52,6 +52,7 @@ spurious warnings about an unused var. * Lisp changes in Emacs 24.4 +** time-to-seconds is not obsolete any more. ** New function special-form-p. ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' text-property on the first char. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ab060de5782..abaa53f5e4c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-19 Stefan Monnier + + * calendar/time-date.el (time-to-seconds): De-obsolete. + 2012-11-19 Jay Belanger * calc/calc-forms.el (math-leap-year-p): Fix formula for negative @@ -7,8 +11,8 @@ 2012-11-19 Daniel Colascione - * term/w32-win.el (cygwin-convert-path-from-windows): Accomodate - rename of cygwin_convert_path* to cygwin_convert_file_name*. + * term/w32-win.el (cygwin-convert-path-from-windows): + Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*. 2012-11-18 Chong Yidong diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 38b766084c9..b953a6fb2b0 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -134,9 +134,7 @@ If DATE lacks timezone information, GMT is assumed." ;;;###autoload(if (or (featurep 'emacs) ;;;###autoload (and (fboundp 'float-time) ;;;###autoload (subrp (symbol-function 'float-time)))) -;;;###autoload (progn -;;;###autoload (defalias 'time-to-seconds 'float-time) -;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) +;;;###autoload (defalias 'time-to-seconds 'float-time) ;;;###autoload (autoload 'time-to-seconds "time-date")) (eval-when-compile -- cgit v1.3 From bc715d67b3997988e2a48286410d45404e49342c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 12:02:20 -0500 Subject: * lisp/emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/ert.el | 15 +++++---------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8447be48e14..d88aac7bc61 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-19 Stefan Monnier + + * emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib. + 2012-11-19 Michael Albinus * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ff00be7a237..9cbf417d876 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -388,16 +388,11 @@ DATA is displayed to the user and should state the reason of the failure." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - ;; If `cl-macroexpand' isn't bound, the code that we're - ;; compiling doesn't depend on cl and thus doesn't need an - ;; environment arg for `macroexpand'. - (if (fboundp 'cl-macroexpand) - ;; Suppress warning about run-time call to cl function: we - ;; only call it if it's fboundp. - (with-no-warnings - (cl-macroexpand form (and (boundp 'cl-macro-environment) - cl-macro-environment))) - (macroexpand form)))) + (macroexpand form (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (ert--gensym "value-"))) -- cgit v1.3 From 19dc72069c79865d5464737b4ce10ed25a3be49b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 12:24:12 -0500 Subject: Use cl-lib instead of cl, and interactive-p => called-interactively-p. * lisp/erc/erc-track.el, lisp/erc/erc-networks.el, lisp/erc/erc-netsplit.el: * lisp/erc/erc-dcc.el, lisp/erc/erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p instead of cl. * lisp/erc/erc-speedbar.el, lisp/erc/erc-services.el: * lisp/erc/erc-pcomplete.el, lisp/erc/erc-notify.el, lisp/erc/erc-match.el: * lisp/erc/erc-log.el, lisp/erc/erc-join.el, lisp/erc/erc-ezbounce.el: * lisp/erc/erc-capab.el: Don't require cl since we don't use it. * lisp/erc/erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. (erc-lurker-ignore-chars, erc-common-server-suffixes): Move before first use. * lisp/json.el: Don't require cl since we don't use it. * lisp/color.el: Don't require cl. (color-complement): `caddr' -> `nth 2'. * test/automated/ert-x-tests.el: Use cl-lib. * test/automated/ert-tests.el: Use lexical-binding and cl-lib. --- lisp/ChangeLog | 4 ++ lisp/color.el | 9 +-- lisp/erc/ChangeLog | 13 ++++ lisp/erc/erc-backend.el | 156 +++++++++++++++++++++--------------------- lisp/erc/erc-capab.el | 1 - lisp/erc/erc-dcc.el | 68 +++++++++--------- lisp/erc/erc-ezbounce.el | 1 - lisp/erc/erc-join.el | 1 - lisp/erc/erc-log.el | 7 +- lisp/erc/erc-match.el | 1 - lisp/erc/erc-netsplit.el | 7 +- lisp/erc/erc-networks.el | 14 ++-- lisp/erc/erc-notify.el | 4 +- lisp/erc/erc-pcomplete.el | 1 - lisp/erc/erc-services.el | 2 +- lisp/erc/erc-speedbar.el | 1 - lisp/erc/erc-track.el | 26 +++---- lisp/erc/erc.el | 99 ++++++++++++++------------- lisp/json.el | 1 - test/ChangeLog | 9 ++- test/automated/ert-tests.el | 132 +++++++++++++++++------------------ test/automated/ert-x-tests.el | 50 +++++++------- 22 files changed, 308 insertions(+), 299 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index abaa53f5e4c..cd81564d032 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2012-11-19 Stefan Monnier + * json.el: Don't require cl since we don't use it. + * color.el: Don't require cl. + (color-complement): `caddr' -> `nth 2'. + * calendar/time-date.el (time-to-seconds): De-obsolete. 2012-11-19 Jay Belanger diff --git a/lisp/color.el b/lisp/color.el index b915beacb0a..e1563ea474c 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -33,9 +33,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - ;; Emacs < 23.3 (eval-and-compile (unless (boundp 'float-pi) @@ -69,9 +66,9 @@ RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive." COLOR-NAME should be a string naming a color (e.g. \"white\"), or a string specifying a color's RGB components (e.g. \"#ff12ec\")." (let ((color (color-name-to-rgb color-name))) - (list (- 1.0 (car color)) - (- 1.0 (cadr color)) - (- 1.0 (caddr color))))) + (list (- 1.0 (nth 0 color)) + (- 1.0 (nth 1 color)) + (- 1.0 (nth 2 color))))) (defun color-gradient (start stop step-number) "Return a list with STEP-NUMBER colors from START to STOP. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index e0a88461dc9..ca7edd1aa88 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,16 @@ +2012-11-19 Stefan Monnier + + Use cl-lib instead of cl, and interactive-p => called-interactively-p. + * erc-track.el, erc-networks.el, erc-netsplit.el, erc-dcc.el: + * erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p + instead of cl. + * erc-speedbar.el, erc-services.el, erc-pcomplete.el, erc-notify.el: + * erc-match.el, erc-log.el, erc-join.el, erc-ezbounce.el: + * erc-capab.el: Don't require cl since we don't use it. + * erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. + (erc-lurker-ignore-chars, erc-common-server-suffixes): + Move before first use. + 2012-11-16 Glenn Morris * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 90b96d7c763..a3d0ebe121f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -98,7 +98,7 @@ ;;; Code: (require 'erc-compat) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the ;; reverse is true: @@ -109,7 +109,7 @@ (defvar erc-server-responses (make-hash-table :test #'equal) "Hashtable mapping server responses to their handler hooks.") -(defstruct (erc-response (:conc-name erc-response.)) +(cl-defstruct (erc-response (:conc-name erc-response.)) (unparsed "" :type string) (sender "" :type string) (command "" :type string) @@ -950,7 +950,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (push str (erc-response.command-args msg)))) (setf (erc-response.contents msg) - (first (erc-response.command-args msg))) + (car (erc-response.command-args msg))) (setf (erc-response.command-args msg) (nreverse (erc-response.command-args msg))) @@ -1045,7 +1045,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable." (name &rest name) &optional sexp sexp def-body)) -(defmacro* define-erc-response-handler ((name &rest aliases) +(cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc &rest fn-body) "Define an ERC handler hook/function pair. @@ -1154,11 +1154,11 @@ add things to `%s' instead." "") name hook-name)) (fn-alternates - (loop for alias in aliases - collect (intern (format "erc-server-%s" alias)))) + (cl-loop for alias in aliases + collect (intern (format "erc-server-%s" alias)))) (var-alternates - (loop for alias in aliases - collect (intern (format "erc-server-%s-functions" alias))))) + (cl-loop for alias in aliases + collect (intern (format "erc-server-%s-functions" alias))))) `(prog2 ;; Normal hook variable. (defvar ,hook-name ',fn-name ,(format hook-doc name)) @@ -1172,19 +1172,19 @@ add things to `%s' instead." (put ',hook-name 'definition-name ',name) ;; Hashtable map of responses to hook variables - ,@(loop for response in (cons name aliases) - for var in (cons hook-name var-alternates) - collect `(puthash ,(format "%s" response) ',var - erc-server-responses)) + ,@(cl-loop for response in (cons name aliases) + for var in (cons hook-name var-alternates) + collect `(puthash ,(format "%s" response) ',var + erc-server-responses)) ;; Alternates. ;; Functions are defaliased, hook variables are defvared so we ;; can add hooks to one alias, but not another. - ,@(loop for fn in fn-alternates - for var in var-alternates - for a in aliases - nconc (list `(defalias ',fn ',fn-name) - `(defvar ,var ',fn-name ,(format hook-doc a)) - `(put ',var 'definition-name ',hook-name)))))) + ,@(cl-loop for fn in fn-alternates + for var in var-alternates + for a in aliases + nconc (list `(defalias ',fn ',fn-name) + `(defvar ,var ',fn-name ,(format hook-doc a)) + `(put ',var 'definition-name ',hook-name)))))) (define-erc-response-handler (ERROR) "Handle an ERROR command from the server." nil @@ -1196,10 +1196,10 @@ add things to `%s' instead." (define-erc-response-handler (INVITE) "Handle invitation messages." nil - (let ((target (first (erc-response.command-args parsed))) + (let ((target (car (erc-response.command-args parsed))) (chnl (erc-response.contents parsed))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq erc-invitation chnl) (when (string= target (erc-current-nick)) (erc-display-message @@ -1212,8 +1212,8 @@ add things to `%s' instead." nil (let ((chnl (erc-response.contents parsed)) (buffer nil)) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) ;; strip the stupid combined JOIN facility (IRC 2.9) (if (string-match "^\\(.*\\)?\^g.*$" chnl) (setq chnl (match-string 1 chnl))) @@ -1249,12 +1249,12 @@ add things to `%s' instead." (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil - (let* ((ch (first (erc-response.command-args parsed))) - (tgt (second (erc-response.command-args parsed))) + (let* ((ch (nth 0 (erc-response.command-args parsed))) + (tgt (nth 1 (erc-response.command-args parsed))) (reason (erc-trim-string (erc-response.contents parsed))) (buffer (erc-get-buffer ch proc))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-remove-channel-member buffer tgt) (cond ((string= tgt (erc-current-nick)) @@ -1277,11 +1277,11 @@ add things to `%s' instead." (define-erc-response-handler (MODE) "Handle server mode changes." nil - (let ((tgt (first (erc-response.command-args parsed))) + (let ((tgt (car (erc-response.command-args parsed))) (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) " "))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) ;; dirty hack (let ((buf (cond ((erc-channel-p tgt) @@ -1305,8 +1305,8 @@ add things to `%s' instead." "Handle nick change messages." nil (let ((nn (erc-response.contents parsed)) bufs) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq bufs (erc-buffer-list-with-nick nick proc)) (erc-log (format "NICK: %s -> %s" nick nn)) ;; if we had a query with this user, make sure future messages will be @@ -1340,11 +1340,11 @@ add things to `%s' instead." (define-erc-response-handler (PART) "Handle part messages." nil - (let* ((chnl (first (erc-response.command-args parsed))) + (let* ((chnl (car (erc-response.command-args parsed))) (reason (erc-trim-string (erc-response.contents parsed))) (buffer (erc-get-buffer chnl proc))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-remove-channel-member buffer nick) (erc-display-message parsed 'notice buffer 'PART ?n nick ?u login @@ -1361,7 +1361,7 @@ add things to `%s' instead." (define-erc-response-handler (PING) "Handle ping messages." nil - (let ((pinger (first (erc-response.command-args parsed)))) + (let ((pinger (car (erc-response.command-args parsed)))) (erc-log (format "PING: %s" pinger)) ;; ping response to the server MUST be forced, or you can lose big (erc-server-send (format "PONG :%s" pinger) t) @@ -1379,7 +1379,7 @@ add things to `%s' instead." (when erc-verbose-server-ping (erc-display-message parsed 'notice proc 'PONG - ?h (first (erc-response.command-args parsed)) ?i erc-server-lag + ?h (car (erc-response.command-args parsed)) ?i erc-server-lag ?s (if (/= erc-server-lag 1) "s" ""))) (erc-update-mode-line)))) @@ -1451,8 +1451,8 @@ add things to `%s' instead." "Another user has quit IRC." nil (let ((reason (erc-response.contents parsed)) bufs) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq bufs (erc-buffer-list-with-nick nick proc)) (erc-remove-user nick) (setq reason (erc-wash-quit-reason reason nick login host)) @@ -1462,12 +1462,12 @@ add things to `%s' instead." (define-erc-response-handler (TOPIC) "The channel topic has changed." nil - (let* ((ch (first (erc-response.command-args parsed))) + (let* ((ch (car (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) (time (format-time-string erc-server-timestamp-format (current-time)))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-update-channel-member ch nick nick nil nil nil host login) (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) @@ -1477,8 +1477,8 @@ add things to `%s' instead." (define-erc-response-handler (WALLOPS) "Display a WALLOPS message." nil (let ((message (erc-response.contents parsed))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-display-message parsed 'notice nil 'WALLOPS ?n nick ?m message)))) @@ -1486,7 +1486,7 @@ add things to `%s' instead." (define-erc-response-handler (001) "Set `erc-server-current-nick' to reflect server settings and display the welcome message." nil - (erc-set-current-nick (first (erc-response.command-args parsed))) + (erc-set-current-nick (car (erc-response.command-args parsed))) (erc-update-mode-line) ; needed here? (setq erc-nick-change-attempt-count 0) (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) @@ -1507,16 +1507,16 @@ add things to `%s' instead." (define-erc-response-handler (004) "Display the server's identification." nil - (multiple-value-bind (server-name server-version) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,server-name ,server-version) + (cdr (erc-response.command-args parsed)))) (setq erc-server-version server-version) (setq erc-server-announced-name server-name) (erc-update-mode-line-buffer (process-buffer proc)) (erc-display-message parsed 'notice proc 's004 ?s server-name ?v server-version - ?U (fourth (erc-response.command-args parsed)) - ?C (fifth (erc-response.command-args parsed))))) + ?U (nth 3 (erc-response.command-args parsed)) + ?C (nth 4 (erc-response.command-args parsed))))) (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. @@ -1547,7 +1547,7 @@ A server may send more than one 005 message." (define-erc-response-handler (221) "Display the current user modes." nil - (let* ((nick (first (erc-response.command-args parsed))) + (let* ((nick (car (erc-response.command-args parsed))) (modes (mapconcat 'identity (cdr (erc-response.command-args parsed)) " "))) (erc-set-modes nick modes) @@ -1576,8 +1576,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (275) "Display secure connection message." nil - (multiple-value-bind (nick user message) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,message) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's275 ?n nick @@ -1612,8 +1612,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (307) "Display nick-identified message." nil - (multiple-value-bind (nick user message) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,message) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's307 ?n nick @@ -1624,8 +1624,8 @@ See `erc-display-server-message'." nil "WHOIS/WHOWAS notices." nil (let ((fname (erc-response.contents parsed)) (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) - (multiple-value-bind (nick user host) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,host) + (cdr (erc-response.command-args parsed)))) (erc-update-user-nick nick nick host nil fname user) (erc-display-message parsed 'notice 'active catalog-entry @@ -1633,8 +1633,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (312) "Server name response in WHOIS." nil - (multiple-value-bind (nick server-host) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,server-host)) + (cdr (erc-response.command-args parsed))) (erc-display-message parsed 'notice 'active 's312 ?n nick ?s server-host ?c (erc-response.contents parsed)))) @@ -1655,8 +1655,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (317) "IDLE notice." nil - (multiple-value-bind (nick seconds-idle on-since time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,seconds-idle ,on-since ,time) + (cdr (erc-response.command-args parsed)))) (setq time (when on-since (format-time-string erc-server-timestamp-format (erc-string-to-emacs-time on-since)))) @@ -1696,16 +1696,16 @@ See `erc-display-server-message'." nil (define-erc-response-handler (322) "LIST notice." nil (let ((topic (erc-response.contents parsed))) - (multiple-value-bind (channel num-users) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,num-users) + (cdr (erc-response.command-args parsed)))) (add-to-list 'erc-channel-list (list channel)) (erc-update-channel-topic channel topic)))) (defun erc-server-322-message (proc parsed) "Display a message for the 322 event." (let ((topic (erc-response.contents parsed))) - (multiple-value-bind (channel num-users) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,num-users) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice proc 's322 ?c channel ?u num-users ?t (or topic ""))))) @@ -1732,7 +1732,7 @@ See `erc-display-server-message'." nil "Channel creation date." nil (let ((channel (second (erc-response.command-args parsed))) (time (erc-string-to-emacs-time - (third (erc-response.command-args parsed))))) + (nth 2 (erc-response.command-args parsed))))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's329 ?c channel ?t (format-time-string erc-server-timestamp-format @@ -1749,7 +1749,7 @@ See `erc-display-server-message'." nil ;; authmsg == (aref parsed 5) ;; The guesses below are, well, just that. -- Lawrence 2004/05/10 (let ((nick (second (erc-response.command-args parsed))) - (authaccount (third (erc-response.command-args parsed))) + (authaccount (nth 2 (erc-response.command-args parsed))) (authmsg (erc-response.contents parsed))) (erc-display-message parsed 'notice 'active 's330 ?n nick ?a authmsg ?i authaccount))) @@ -1771,8 +1771,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (333) "Who set the topic, and when." nil - (multiple-value-bind (channel nick time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,nick ,time) + (cdr (erc-response.command-args parsed)))) (setq time (format-time-string erc-server-timestamp-format (erc-string-to-emacs-time time))) (erc-update-channel-topic channel @@ -1784,15 +1784,15 @@ See `erc-display-server-message'." nil (define-erc-response-handler (341) "Let user know when an INVITE attempt has been sent successfully." nil - (multiple-value-bind (nick channel) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,channel) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's341 ?n nick ?c channel))) (define-erc-response-handler (352) "WHO notice." nil - (multiple-value-bind (channel user host server nick away-flag) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag) + (cdr (erc-response.command-args parsed)))) (let ((full-name (erc-response.contents parsed)) hopcount) (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) @@ -1806,7 +1806,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (353) "NAMES notice." nil - (let ((channel (third (erc-response.command-args parsed))) + (let ((channel (nth 2 (erc-response.command-args parsed))) (users (erc-response.contents parsed))) (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) 'active) @@ -1821,8 +1821,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (367) "Channel ban list entries." nil - (multiple-value-bind (channel banmask setter time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,banmask ,setter ,time) + (cdr (erc-response.command-args parsed)))) ;; setter and time are not standard (if setter (erc-display-message parsed 'notice 'active 's367-set-by @@ -1845,8 +1845,8 @@ See `erc-display-server-message'." nil ;; FIXME: Yet more magic numbers in original code, I'm guessing this ;; command takes two arguments, and doesn't have any "contents". -- ;; Lawrence 2004/05/10 - (multiple-value-bind (from to) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,from ,to) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's379 ?c from ?f to))) @@ -1855,7 +1855,7 @@ See `erc-display-server-message'." nil (erc-display-message parsed 'notice 'active 's391 ?s (second (erc-response.command-args parsed)) - ?t (third (erc-response.command-args parsed)))) + ?t (nth 2 (erc-response.command-args parsed)))) (define-erc-response-handler (401) "No such nick/channel." nil diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 08b9c67f6c0..e8201f2ea43 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -68,7 +68,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) ;;; Customization: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index ed8440315eb..e31416f0e1a 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -54,9 +54,7 @@ ;;; Code: (require 'erc) -(eval-when-compile - (require 'cl) - (require 'pcomplete)) +(eval-when-compile (require 'pcomplete)) ;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") (define-erc-module dcc nil @@ -277,7 +275,7 @@ Argument IP is the address as a string. The result is also a string." (* (nth 1 ips) 65536.0) (* (nth 2 ips) 256.0) (nth 3 ips)))) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %.0f" ip res) (format "%.0f" res))))) @@ -380,8 +378,8 @@ created subprocess, or nil." (with-no-warnings ; obsolete since 23.1 (set-process-filter-multibyte process nil))))) (file-error - (unless (and (string= "Cannot bind server socket" (cadr err)) - (string= "address already in use" (caddr err))) + (unless (and (string= "Cannot bind server socket" (nth 1 err)) + (string= "address already in use" (nth 2 err))) (signal (car err) (cdr err))) (setq port (1+ port)) (unless (< port upper) @@ -434,38 +432,38 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (append '("chat" "close" "get" "list") (when (fboundp 'make-network-process) '("send")))) (pcomplete-here - (case (intern (downcase (pcomplete-arg 1))) - (chat (mapcar (lambda (elt) (plist-get elt :nick)) + (pcase (intern (downcase (pcomplete-arg 1))) + (`chat (mapcar (lambda (elt) (plist-get elt :nick)) + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) 'CHAT)) + erc-dcc-list))) + (`close (erc-delete-dups + (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) + erc-dcc-list))) + (`get (mapcar #'erc-dcc-nick (erc-remove-if-not #'(lambda (elt) - (eq (plist-get elt :type) 'CHAT)) + (eq (plist-get elt :type) 'GET)) erc-dcc-list))) - (close (erc-delete-dups - (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) - erc-dcc-list))) - (get (mapcar #'erc-dcc-nick - (erc-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'GET)) - erc-dcc-list))) - (send (pcomplete-erc-all-nicks)))) + (`send (pcomplete-erc-all-nicks)))) (pcomplete-here - (case (intern (downcase (pcomplete-arg 2))) - (get (mapcar (lambda (elt) (plist-get elt :file)) - (erc-remove-if-not - #'(lambda (elt) - (and (eq (plist-get elt :type) 'GET) - (erc-nick-equal-p (erc-extract-nick - (plist-get elt :nick)) - (pcomplete-arg 1)))) - erc-dcc-list))) - (close (mapcar #'erc-dcc-nick - (erc-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) - (intern (upcase (pcomplete-arg 1))))) - erc-dcc-list))) - (send (pcomplete-entries))))) + (pcase (intern (downcase (pcomplete-arg 2))) + (`get (mapcar (lambda (elt) (plist-get elt :file)) + (erc-remove-if-not + #'(lambda (elt) + (and (eq (plist-get elt :type) 'GET) + (erc-nick-equal-p (erc-extract-nick + (plist-get elt :nick)) + (pcomplete-arg 1)))) + erc-dcc-list))) + (`close (mapcar #'erc-dcc-nick + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) + (intern (upcase (pcomplete-arg 1))))) + erc-dcc-list))) + (`send (pcomplete-entries))))) (defun erc-dcc-do-CHAT-command (proc &optional nick) (when nick @@ -1248,7 +1246,7 @@ other client." (defun erc-dcc-no-such-nick (proc parsed) "Detect and handle no-such-nick replies from the IRC server." - (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed)) + (let* ((elt (erc-dcc-member :nick (nth 1 (erc-response.command-args parsed)) :parent proc)) (peer (plist-get elt :peer))) (when (or (and (processp peer) (not (eq (process-status peer) 'open))) diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 5e5d6c2c188..6bcc17e4bc0 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -26,7 +26,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) (defgroup erc-ezbounce nil "Interface to the EZBounce IRC bouncer (a virtual IRC server)" diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index ac6b311a0c4..e285cfb4ec5 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -34,7 +34,6 @@ (require 'erc) (require 'auth-source) -(eval-when-compile (require 'cl)) (defgroup erc-autojoin nil "Enable autojoining." diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index b3f3f5865a1..1ff2951e09e 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -93,9 +93,7 @@ ;;; Code: (require 'erc) -(eval-when-compile - (require 'erc-networks) - (require 'cl)) +(eval-when-compile (require 'erc-networks)) (defgroup erc-log nil "Logging facilities for ERC." @@ -429,7 +427,8 @@ You can save every individual message by putting this function on file t 'nomessage)))) (let ((coding-system-for-write coding-system)) (write-region start end file t 'nomessage)))) - (if (and erc-truncate-buffer-on-save (interactive-p)) + (if (and erc-truncate-buffer-on-save + (called-interactively-p 'interactive)) (progn (let ((inhibit-read-only t)) (erase-buffer)) (move-marker erc-last-saved-position (point-max)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 8dcdcb9e2e6..f1219427360 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -35,7 +35,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) ;; Customization: diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index fc4aeb10c84..cbaf62b1a61 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -31,7 +31,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) (defgroup erc-netsplit nil "Netsplit detection tries to automatically figure when a @@ -107,7 +106,7 @@ join from that split has been detected or not.") (dolist (elt erc-netsplit-list) (if (member nick (nthcdr 3 elt)) (progn - (if (not (caddr elt)) + (if (not (nth 2 elt)) (progn (erc-display-message parsed 'notice (process-buffer proc) @@ -149,7 +148,7 @@ join from that split has been detected or not.") ;; element for this netsplit exists already (progn (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) - (when (caddr ass) + (when (nth 2 ass) ;; There was already a netjoin for this netsplit, it ;; seems like the old one didn't get finished... (erc-display-message @@ -194,7 +193,7 @@ join from that split has been detected or not.") nil 'notice 'active 'netsplit-wholeft ?s (car elt) ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") - ?t (if (caddr elt) + ?t (if (nth 2 elt) "(joining)" ""))))) t) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 89372555ccc..5089ff6b4ba 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -40,7 +40,7 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Variables @@ -729,10 +729,10 @@ search for a match in `erc-networks-alist'." (or ;; Loop through `erc-networks-alist' looking for a match. (let ((server (or erc-server-announced-name erc-session-server))) - (loop for (name matcher) in erc-networks-alist - when (and matcher - (string-match (concat matcher "\\'") server)) - do (return name))) + (cl-loop for (name matcher) in erc-networks-alist + when (and matcher + (string-match (concat matcher "\\'") server)) + do (cl-return name))) 'Unknown))) (defun erc-network () @@ -789,8 +789,8 @@ As an example: (cond ((numberp p) (push p result)) ((listp p) - (setq result (nconc (loop for i from (cadr p) downto (car p) - collect i) + (setq result (nconc (cl-loop for i from (cadr p) downto (car p) + collect i) result))))) (nreverse result))) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 0b5e99180d6..b9d7ff78cd8 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -30,9 +30,7 @@ (require 'erc) (require 'erc-networks) -(eval-when-compile - (require 'cl) - (require 'pcomplete)) +(eval-when-compile (require 'pcomplete)) ;;;; Customizable variables diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index bb30fd90066..d6bb8019b15 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -43,7 +43,6 @@ (require 'erc) (require 'erc-compat) (require 'time-date) -(eval-when-compile (require 'cl)) (defgroup erc-pcomplete nil "Programmable completion for ERC" diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index b3b80a5f851..b75ad8e9517 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -62,7 +62,7 @@ (require 'erc) (require 'erc-networks) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Customization: diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 4b98cf173be..22053945159 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -38,7 +38,6 @@ (require 'erc) (require 'speedbar) (condition-case nil (require 'dframe) (error nil)) -(eval-when-compile (require 'cl)) ;;; Customization: diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index a204584b400..976d2a21030 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -34,7 +34,7 @@ ;; * Add extensibility so that custom functions can track ;; custom modification types. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'erc) (require 'erc-compat) (require 'erc-match) @@ -484,7 +484,7 @@ START is the minimum length of the name used." ;;; Test: -(assert +(cl-assert (and ;; verify examples from the doc strings (equal (let ((erc-track-shorten-aggressively nil)) @@ -869,7 +869,7 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (setq erc-modified-channels-alist (delete (assq buffer erc-modified-channels-alist) erc-modified-channels-alist)) - (when (interactive-p) + (when (called-interactively-p 'interactive) (erc-modified-channels-display))) (defun erc-track-find-face (faces) @@ -980,7 +980,7 @@ is in `erc-mode'." (add-to-list 'faces cur))) faces)) -(assert +(cl-assert (let ((str "is bold")) (put-text-property 3 (length str) 'face '(bold erc-current-nick-face) @@ -1030,17 +1030,17 @@ relative to `erc-track-switch-direction'" (let ((dir erc-track-switch-direction) offset) (when (< arg 0) - (setq dir (case dir - (oldest 'newest) - (newest 'oldest) - (mostactive 'leastactive) - (leastactive 'mostactive) - (importance 'oldest))) + (setq dir (pcase dir + (`oldest 'newest) + (`newest 'oldest) + (`mostactive 'leastactive) + (`leastactive 'mostactive) + (`importance 'oldest))) (setq arg (- arg))) - (setq offset (case dir - ((oldest leastactive) + (setq offset (pcase dir + ((or `oldest `leastactive) (- (length erc-modified-channels-alist) arg)) - (t (1- arg)))) + (_ (1- arg)))) ;; normalize out of range user input (cond ((>= offset (length erc-modified-channels-alist)) (setq offset (1- (length erc-modified-channels-alist)))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7cb6fbb595b..cec9718e751 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,7 @@ (defconst erc-version-string "Version 5.3" "ERC version. This is used by function `erc-version'.") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'font-lock) (require 'pp) (require 'thingatpt) @@ -369,7 +369,7 @@ If no server buffer exists, return nil." (with-current-buffer ,buffer ,@body))))) -(defstruct (erc-server-user (:type vector) :named) +(cl-defstruct (erc-server-user (:type vector) :named) ;; User data nickname host login full-name info ;; Buffers @@ -379,7 +379,7 @@ If no server buffer exists, return nil." (buffers nil) ) -(defstruct (erc-channel-user (:type vector) :named) +(cl-defstruct (erc-channel-user (:type vector) :named) op voice ;; Last message time (in the form of the return value of ;; (current-time) @@ -1386,7 +1386,7 @@ If BUFFER is nil, the current buffer is used." t)) (erc-server-send (format "ISON %s" nick)) (while (eq erc-online-p 'unknown) (accept-process-output)) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %sonline" (or erc-online-p nick) (if erc-online-p "" "not ")) @@ -2157,11 +2157,11 @@ functions in here get called with the parameters SERVER and NICK." (list :server server :port port :nick nick :password passwd))) ;;;###autoload -(defun* erc (&key (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - password - (full-name (erc-compute-full-name))) +(cl-defun erc (&key (server (erc-compute-server)) + (port (erc-compute-port)) + (nick (erc-compute-nick)) + password + (full-name (erc-compute-full-name))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC. @@ -2383,24 +2383,24 @@ If STRING is nil, the function does nothing." (while list (setq elt (car list)) (cond ((integerp elt) ; POSITION - (incf (car list) shift)) + (cl-incf (car list) shift)) ((or (atom elt) ; nil, EXTENT ;; (eq t (car elt)) ; (t . TIME) (markerp (car elt))) ; (MARKER . DISTANCE) nil) ((integerp (car elt)) ; (BEGIN . END) - (incf (car elt) shift) - (incf (cdr elt) shift)) + (cl-incf (car elt) shift) + (cl-incf (cdr elt) shift)) ((stringp (car elt)) ; (TEXT . POSITION) - (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) + (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) (let ((cons (nthcdr 3 elt))) - (incf (car cons) shift) - (incf (cdr cons) shift))) + (cl-incf (car cons) shift) + (cl-incf (cdr cons) shift))) ((and (featurep 'xemacs) (extentp (car elt))) ; (EXTENT START END) - (incf (nth 1 elt) shift) - (incf (nth 2 elt) shift))) + (cl-incf (nth 1 elt) shift) + (cl-incf (nth 2 elt) shift))) (setq list (cdr list)))))) (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" @@ -2477,6 +2477,13 @@ purposes." :group 'erc-lurker :type 'boolean) +(defcustom erc-lurker-ignore-chars "`_" + "Characters at the end of a nick to strip for activity tracking purposes. + +See also `erc-lurker-trim-nicks'." + :group 'erc-lurker + :type 'string) + (defun erc-lurker-maybe-trim (nick) "Maybe trim trailing `erc-lurker-ignore-chars' from NICK. @@ -2491,13 +2498,6 @@ non-nil." "" nick) nick)) -(defcustom erc-lurker-ignore-chars "`_" - "Characters at the end of a nick to strip for activity tracking purposes. - -See also `erc-lurker-trim-nicks'." - :group 'erc-lurker - :type 'string) - (defcustom erc-lurker-hide-list nil "List of IRC type messages to hide when sent by lurkers. @@ -2580,7 +2580,8 @@ updates of `erc-lurker-state'." (server (erc-canonicalize-server-name erc-server-announced-name))) (when (equal command "PRIVMSG") - (when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval) + (when (>= (cl-incf erc-lurker-cleanup-count) + erc-lurker-cleanup-interval) (setq erc-lurker-cleanup-count 0) (erc-lurker-cleanup)) (unless (gethash server erc-lurker-state) @@ -2605,6 +2606,17 @@ server within `erc-lurker-threshold-time'. See also (time-subtract (current-time) last-PRIVMSG-time)) erc-lurker-threshold-time)))) +(defcustom erc-common-server-suffixes + '(("openprojects.net$" . "OPN") + ("freenode.net$" . "freenode") + ("oftc.net$" . "OFTC")) + "Alist of common server name suffixes. +This variable is used in mode-line display to save screen +real estate. Set it to nil if you want to avoid changing +displayed hostnames." + :group 'erc-mode-line-and-header + :type 'alist) + (defun erc-canonicalize-server-name (server) "Returns the canonical network name for SERVER if any, otherwise `erc-server-announced-name'. SERVER is matched against @@ -3115,37 +3127,37 @@ If SERVER is non-nil, use that, rather than the current server." (add-to-list 'symlist (cons (erc-once-with-server-event 311 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-311-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 312 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-312-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 318 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-318-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 319 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-319-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 320 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-320-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 330 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-330-functions)) (add-to-list 'symlist @@ -4328,8 +4340,8 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-store (proc parsed) "Record ban entries for a channel." - (multiple-value-bind (channel mask whoset) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,mask ,whoset) + (cdr (erc-response.command-args parsed)))) ;; Determine to which buffer the message corresponds (let ((buffer (erc-get-buffer channel proc))) (with-current-buffer buffer @@ -4340,7 +4352,7 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." - (let* ((channel (second (erc-response.command-args parsed))) + (let* ((channel (nth 1 (erc-response.command-args parsed))) (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) @@ -4349,7 +4361,7 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 - (let* ((tgt (first (erc-response.command-args parsed))) + (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) (buffer (erc-get-buffer tgt proc))) @@ -6000,7 +6012,7 @@ entry of `channel-members'." (if cuser (setq op (erc-channel-user-op cuser) voice (erc-channel-user-voice cuser))) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %s@%s%s%s" nick login host (if full-name (format " (%s)" full-name) "") @@ -6088,17 +6100,6 @@ Otherwise, use the `erc-header-line' face." :group 'erc-paranoia :type 'boolean) -(defcustom erc-common-server-suffixes - '(("openprojects.net$" . "OPN") - ("freenode.net$" . "freenode") - ("oftc.net$" . "OFTC")) - "Alist of common server name suffixes. -This variable is used in mode-line display to save screen -real estate. Set it to nil if you want to avoid changing -displayed hostnames." - :group 'erc-mode-line-and-header - :type 'alist) - (defcustom erc-mode-line-away-status-format "(AWAY since %a %b %d %H:%M) " "When you're away on a server, this is shown in the mode line. @@ -6302,7 +6303,7 @@ If optional argument HERE is non-nil, insert version number at point." (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) (if here (insert version-string) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s" version-string) version-string)))) @@ -6322,7 +6323,7 @@ If optional argument HERE is non-nil, insert version number at point." ", "))) (if here (insert string) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s" string) string)))) diff --git a/lisp/json.el b/lisp/json.el index 8167bfe93f2..b1ea03120dc 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -51,7 +51,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;; Compatibility code diff --git a/test/ChangeLog b/test/ChangeLog index f11325d0318..75903ae3ef4 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Stefan Monnier + + * automated/ert-x-tests.el: Use cl-lib. + * automated/ert-tests.el: Use lexical-binding and cl-lib. + 2012-11-14 Dmitry Gutov * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. @@ -5,8 +10,8 @@ (ruby-indent-inside-heredoc-after-space): New tests. Change direct font-lock face references to var references. (ruby-interpolation-suppresses-syntax-inside): New test. - (ruby-interpolation-inside-percent-literal-with-paren): New - failing test. + (ruby-interpolation-inside-percent-literal-with-paren): + New failing test. 2012-11-13 Dmitry Gutov diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index 1778afea802..1aef1921871 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@ -1,4 +1,4 @@ -;;; ert-tests.el --- ERT's self-tests +;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. @@ -27,7 +27,7 @@ ;;; Code: (eval-when-compile - (require 'cl)) + (require 'cl-lib)) (require 'ert) @@ -45,7 +45,7 @@ ;; The buffer name chosen here should not compete with the default ;; results buffer name for completion in `switch-to-buffer'. (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) - (assert ert--test-body-was-run) + (cl-assert ert--test-body-was-run) (if (zerop (ert-stats-completed-unexpected stats)) ;; Hide results window only when everything went well. (set-window-configuration window-configuration) @@ -71,26 +71,26 @@ failed or if there was a problem." (ert-deftest ert-test-nested-test-body-runs () "Test that nested test bodies run." - (lexical-let ((was-run nil)) + (let ((was-run nil)) (let ((test (make-ert-test :body (lambda () (setq was-run t))))) - (assert (not was-run)) + (cl-assert (not was-run)) (ert-run-test test) - (assert was-run)))) + (cl-assert was-run)))) ;;; Test that pass/fail works. (ert-deftest ert-test-pass () (let ((test (make-ert-test :body (lambda ())))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result))))) + (cl-assert (ert-test-passed-p result))))) (ert-deftest ert-test-fail () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed "failure message")) t)))) @@ -100,50 +100,50 @@ failed or if there was a problem." (progn (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil)) + (cl-assert nil)) ((error) - (assert (equal condition '(ert-test-failed "failure message")) t))))) + (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) (ert-deftest ert-test-fail-debug-with-debugger-1 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((debugger (lambda (&rest debugger-args) - (assert nil)))) + (let ((debugger (lambda (&rest _args) + (cl-assert nil)))) (let ((ert-debug-on-error nil)) (ert-run-test test))))) (ert-deftest ert-test-fail-debug-with-debugger-2 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (block nil - (let ((debugger (lambda (&rest debugger-args) - (return-from nil nil)))) + (cl-block nil + (let ((debugger (lambda (&rest _args) + (cl-return-from nil nil)))) (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil))))) + (cl-assert nil))))) (ert-deftest ert-test-fail-debug-nested-with-debugger () (let ((test (make-ert-test :body (lambda () (let ((ert-debug-on-error t)) (ert-fail "failure message")))))) - (let ((debugger (lambda (&rest debugger-args) - (assert nil nil "Assertion a")))) + (let ((debugger (lambda (&rest _args) + (cl-assert nil nil "Assertion a")))) (let ((ert-debug-on-error nil)) (ert-run-test test)))) (let ((test (make-ert-test :body (lambda () (let ((ert-debug-on-error nil)) (ert-fail "failure message")))))) - (block nil - (let ((debugger (lambda (&rest debugger-args) - (return-from nil nil)))) + (cl-block nil + (let ((debugger (lambda (&rest _args) + (cl-return-from nil nil)))) (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil nil "Assertion b"))))) + (cl-assert nil nil "Assertion b"))))) (ert-deftest ert-test-error () (let ((test (make-ert-test :body (lambda () (error "Error message"))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(error "Error message")) t)))) @@ -153,9 +153,9 @@ failed or if there was a problem." (progn (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil)) + (cl-assert nil)) ((error) - (assert (equal condition '(error "Error message")) t))))) + (cl-assert (equal condition '(error "Error message")) t))))) ;;; Test that `should' works. @@ -163,13 +163,13 @@ failed or if there was a problem." (let ((test (make-ert-test :body (lambda () (should nil))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed ((should nil) :form nil :value nil))) t))) (let ((test (make-ert-test :body (lambda () (should t))))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result) t)))) + (cl-assert (ert-test-passed-p result) t)))) (ert-deftest ert-test-should-value () (should (eql (should 'foo) 'foo)) @@ -179,17 +179,18 @@ failed or if there was a problem." (let ((test (make-ert-test :body (lambda () (should-not t))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed ((should-not t) :form t :value t))) t))) (let ((test (make-ert-test :body (lambda () (should-not nil))))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result))))) + (cl-assert (ert-test-passed-p result))))) + (ert-deftest ert-test-should-with-macrolet () (let ((test (make-ert-test :body (lambda () - (macrolet ((foo () `(progn t nil))) + (cl-macrolet ((foo () `(progn t nil))) (should (foo))))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) @@ -303,32 +304,33 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-should-failure-debugging () "Test that `should' errors contain the information we expect them to." - (loop for (body expected-condition) in - `((,(lambda () (let ((x nil)) (should x))) - (ert-test-failed ((should x) :form x :value nil))) - (,(lambda () (let ((x t)) (should-not x))) - (ert-test-failed ((should-not x) :form x :value t))) - (,(lambda () (let ((x t)) (should (not x)))) - (ert-test-failed ((should (not x)) :form (not t) :value nil))) - (,(lambda () (let ((x nil)) (should-not (not x)))) - (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) - (,(lambda () (let ((x t) (y nil)) (should-not - (ert--test-my-list x y)))) - (ert-test-failed - ((should-not (ert--test-my-list x y)) - :form (list t nil) - :value (t nil)))) - (,(lambda () (let ((x t)) (should (error "Foo")))) - (error "Foo"))) - do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (cl-loop + for (body expected-condition) in + `((,(lambda () (let ((x nil)) (should x))) + (ert-test-failed ((should x) :form x :value nil))) + (,(lambda () (let ((x t)) (should-not x))) + (ert-test-failed ((should-not x) :form x :value t))) + (,(lambda () (let ((x t)) (should (not x)))) + (ert-test-failed ((should (not x)) :form (not t) :value nil))) + (,(lambda () (let ((x nil)) (should-not (not x)))) + (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) + (,(lambda () (let ((x t) (y nil)) (should-not + (ert--test-my-list x y)))) + (ert-test-failed + ((should-not (ert--test-my-list x y)) + :form (list t nil) + :value (t nil)))) + (,(lambda () (let ((_x t)) (should (error "Foo")))) + (error "Foo"))) + do + (let ((test (make-ert-test :body body))) + (condition-case actual-condition + (progn + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (cl-assert nil)) + ((error) + (should (equal actual-condition expected-condition))))))) (ert-deftest ert-test-deftest () (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) @@ -520,7 +522,7 @@ This macro is used to test if macroexpansion in `should' works." (setf (cdr (last a)) (cddr a)) (should (not (ert--proper-list-p a)))) (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cdddr a)) + (setf (cdr (last a)) (cl-cdddr a)) (should (not (ert--proper-list-p a))))) (ert-deftest ert-test-parse-keys-and-body () @@ -657,14 +659,14 @@ This macro is used to test if macroexpansion in `should' works." (i 0)) (let ((result (ert--remove-if-not (lambda (x) (should (eql x (nth i list))) - (incf i) + (cl-incf i) (member i '(2 3))) list))) (should (equal i 4)) (should (equal result '(b c))) (should (equal list '(a b c d))))) (should (equal '() - (ert--remove-if-not (lambda (x) (should nil)) '())))) + (ert--remove-if-not (lambda (_x) (should nil)) '())))) (ert-deftest ert-test-remove* () (let ((list (list 'a 'b 'c 'd)) @@ -676,13 +678,13 @@ This macro is used to test if macroexpansion in `should' works." (should (eql x (nth key-index list))) (prog1 (list key-index x) - (incf key-index))) + (cl-incf key-index))) :test (lambda (a b) (should (eql a 'foo)) (should (equal b (list test-index (nth test-index list)))) - (incf test-index) + (cl-incf test-index) (member test-index '(2 3)))))) (should (equal key-index 4)) (should (equal test-index 4)) diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el index 520502bb307..e03c8475442 100644 --- a/test/automated/ert-x-tests.el +++ b/test/automated/ert-x-tests.el @@ -28,7 +28,7 @@ ;;; Code: (eval-when-compile - (require 'cl)) + (require 'cl-lib)) (require 'ert) (require 'ert-x) @@ -233,8 +233,8 @@ desired effect." (should (equal (buffer-string) "")) (let ((message-log-max 2)) (let ((message-log-max t)) - (loop for i below 4 do - (message "%s" i)) + (cl-loop for i below 4 do + (message "%s" i)) (should (equal (buffer-string) "0\n1\n2\n3\n"))) (should (equal (buffer-string) "0\n1\n2\n3\n")) (message "") @@ -244,28 +244,28 @@ desired effect." (ert-deftest ert-test-force-message-log-buffer-truncation () :tags '(:causes-redisplay) - (labels ((body () - (loop for i below 3 do - (message "%s" i))) - ;; Uses the implicit messages buffer truncation implemented - ;; in Emacs' C core. - (c (x) - (ert-with-buffer-renamed ("*Messages*") - (let ((message-log-max x)) - (body)) - (with-current-buffer "*Messages*" - (buffer-string)))) - ;; Uses our lisp reimplementation. - (lisp (x) - (ert-with-buffer-renamed ("*Messages*") - (let ((message-log-max t)) - (body)) - (let ((message-log-max x)) - (ert--force-message-log-buffer-truncation)) - (with-current-buffer "*Messages*" - (buffer-string))))) - (loop for x in '(0 1 2 3 4 t) do - (should (equal (c x) (lisp x)))))) + (cl-labels ((body () + (cl-loop for i below 3 do + (message "%s" i))) + ;; Uses the implicit messages buffer truncation implemented + ;; in Emacs' C core. + (c (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max x)) + (body)) + (with-current-buffer "*Messages*" + (buffer-string)))) + ;; Uses our lisp reimplementation. + (lisp (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max t)) + (body)) + (let ((message-log-max x)) + (ert--force-message-log-buffer-truncation)) + (with-current-buffer "*Messages*" + (buffer-string))))) + (cl-loop for x in '(0 1 2 3 4 t) do + (should (equal (c x) (lisp x)))))) (provide 'ert-x-tests) -- cgit v1.3 From 88c4a13c3b573e0fa844c88ab89765ef308c267e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Nov 2012 19:34:21 +0200 Subject: More fixes for bug #12878 with MS-Windows MSVC build. src/xdisp.c (start_hourglass) [HAVE_NTGUI]: Don't mix declaration of w32_note_current_window with code. (Backport from trunk.) src/w32.c (FILE_DEVICE_FILE_SYSTEM, METHOD_BUFFERED) (FILE_ANY_ACCESS, CTL_CODE, FSCTL_GET_REPARSE_POINT) [_MSC_VER]: Define for the MSVC compiler. src/w32term.h (EnumSystemLocalesW) [_MSC_VER]: Add a missing semi-colon. nt/inc/stdint.h (PTRDIFF_MIN) [!__GNUC__]: Define for MSVC. --- nt/ChangeLog | 4 ++++ nt/inc/stdint.h | 1 + src/ChangeLog | 12 ++++++++++++ src/w32.c | 13 ++++++++++--- src/w32term.h | 2 +- src/xdisp.c | 6 ++++-- 6 files changed, 32 insertions(+), 6 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index d34d23df4d5..cb63a90bb41 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2012-11-19 Eli Zaretskii + + * inc/stdint.h (PTRDIFF_MIN) [!__GNUC__]: Define for MSVC. + 2012-11-01 Eli Zaretskii * inc/unistd.h (setpgid, getpgrp): Provide prototypes. (Bug#12776) diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h index 5c53fa18b55..edb0469eb87 100644 --- a/nt/inc/stdint.h +++ b/nt/inc/stdint.h @@ -60,6 +60,7 @@ typedef unsigned int uint32_t; #endif #define PTRDIFF_MAX INTPTR_MAX +#define PTRDIFF_MIN INTPTR_MIN #endif /* !__GNUC__ */ diff --git a/src/ChangeLog b/src/ChangeLog index c4f1ee60d84..da5a9607903 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,15 @@ +2012-11-19 Eli Zaretskii + + * xdisp.c (start_hourglass) [HAVE_NTGUI]: Don't mix declaration of + w32_note_current_window with code. (Backport from trunk.) + + * w32.c (FILE_DEVICE_FILE_SYSTEM, METHOD_BUFFERED) + (FILE_ANY_ACCESS, CTL_CODE, FSCTL_GET_REPARSE_POINT) [_MSC_VER]: + Define for the MSVC compiler. + + * w32term.h (EnumSystemLocalesW) [_MSC_VER]: Add a missing + semi-colon. + 2012-11-18 Eli Zaretskii * fileio.c (Fsubstitute_in_file_name, Ffile_name_directory) diff --git a/src/w32.c b/src/w32.c index 5ac1bc3eb7c..1c3331516d4 100644 --- a/src/w32.c +++ b/src/w32.c @@ -119,9 +119,10 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX { #include #ifdef _MSC_VER -/* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER, except - on ntifs.h, which cannot be included because it triggers conflicts - with other Windows API headers. So we define it here by hand. */ +/* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER and the + associated macros, except on ntifs.h, which cannot be included + because it triggers conflicts with other Windows API headers. So + we define it here by hand. */ typedef struct _REPARSE_DATA_BUFFER { ULONG ReparseTag; @@ -149,6 +150,12 @@ typedef struct _REPARSE_DATA_BUFFER { } DUMMYUNIONNAME; } REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER; +#define FILE_DEVICE_FILE_SYSTEM 9 +#define METHOD_BUFFERED 0 +#define FILE_ANY_ACCESS 0x00000000 +#define CTL_CODE(t,f,m,a) (((t)<<16)|((a)<<14)|((f)<<2)|(m)) +#define FSCTL_GET_REPARSE_POINT \ + CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) #endif /* TCP connection support. */ diff --git a/src/w32term.h b/src/w32term.h index 6e30d374c82..9b5a4a0189a 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -758,7 +758,7 @@ extern int w32_system_caret_y; typedef BOOL (CALLBACK *LOCALE_ENUMPROCA)(LPSTR); typedef BOOL (CALLBACK *LOCALE_ENUMPROCW)(LPWSTR); BOOL WINAPI EnumSystemLocalesA(LOCALE_ENUMPROCA,DWORD); -BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD) +BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD); #ifdef UNICODE #define EnumSystemLocales EnumSystemLocalesW #else diff --git a/src/xdisp.c b/src/xdisp.c index 290c3a07fe9..85fe9a00f60 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29433,8 +29433,10 @@ start_hourglass (void) delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0); #ifdef HAVE_NTGUI - extern void w32_note_current_window (void); - w32_note_current_window (); + { + extern void w32_note_current_window (void); + w32_note_current_window (); + } #endif /* HAVE_NTGUI */ hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, -- cgit v1.3 From ac5392dcfda42b26767ae966a8b290142c00bff7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 13:27:25 -0500 Subject: * lisp/files.el (load-file): Require match in minibuffer selection, as was the case in Emacs-20 before we changed the spec to allow .elc files. Fixes: debbugs:12935 --- lisp/ChangeLog | 4 ++++ lisp/files.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cd81564d032..50effda7a48 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2012-11-19 Stefan Monnier + * files.el (load-file): Require match in minibuffer selection, as was + the case in Emacs-20 before we changed the spec to allow .elc files + (bug#12935). + * json.el: Don't require cl since we don't use it. * color.el: Don't require cl. (color-complement): `caddr' -> `nth 2'. diff --git a/lisp/files.el b/lisp/files.el index 8e8a178caab..40eddec469b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -730,7 +730,7 @@ The path separator is colon in GNU and GNU-like systems." ;; This is a case where .elc makes a lot of sense. (interactive (list (let ((completion-ignored-extensions (remove ".elc" completion-ignored-extensions))) - (read-file-name "Load file: ")))) + (read-file-name "Load file: " nil nil 'lambda)))) (load (expand-file-name file) nil nil t)) (defun locate-file (filename path &optional suffixes predicate) -- cgit v1.3 From 1000d89524f28cc33341ae00c60ecc6994503f23 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 13:40:18 -0500 Subject: * lisp/vc/diff-mode.el (diff-hunk): Don't make useless timers. --- lisp/ChangeLog | 2 ++ lisp/vc/diff-mode.el | 28 +++++++++++++++------------- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 50effda7a48..df0b8bd422f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2012-11-19 Stefan Monnier + * vc/diff-mode.el (diff-hunk): Don't make useless timers. + * files.el (load-file): Require match in minibuffer selection, as was the case in Emacs-20 before we changed the spec to allow .elc files (bug#12935). diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 26c64ce2ad3..0c023b0f7f4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -575,19 +575,21 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." (easy-mmode-define-navigation diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view (when diff-auto-refine-mode - (setq diff--auto-refine-data (cons (current-buffer) (point-marker))) - (run-at-time 0.0 nil - (lambda () - (when diff--auto-refine-data - (let ((buffer (car diff--auto-refine-data)) - (point (cdr diff--auto-refine-data))) - (setq diff--auto-refine-data nil) - (with-local-quit - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (goto-char point) - (diff-refine-hunk))))))))))) + (unless (prog1 diff--auto-refine-data + (setq diff--auto-refine-data + (cons (current-buffer) (point-marker)))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (goto-char point) + (diff-refine-hunk)))))))))))) (easy-mmode-define-navigation diff-file diff-file-header-re "file" diff-end-of-file) -- cgit v1.3 From 93b050412adab7512b7ebc77077fdbbe72730114 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 14:22:07 -0500 Subject: * lisp/eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838: Fallback on completion-at-point rather than pcomplete-expand-and-complete, and only if pcomplete actually failed. (eshell-cmpl-initialize): Setup completion-at-point. * lisp/pcomplete.el (pcomplete--entries): Obey pcomplete-ignore-case. --- lisp/ChangeLog | 7 +++++++ lisp/eshell/em-cmpl.el | 8 +++++--- lisp/pcomplete.el | 3 ++- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d88aac7bc61..e2299df822f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2012-11-19 Stefan Monnier + * eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838: + Fallback on completion-at-point rather than + pcomplete-expand-and-complete, and only if pcomplete actually failed. + (eshell-cmpl-initialize): Setup completion-at-point. + + * pcomplete.el (pcomplete--entries): Obey pcomplete-ignore-case. + * emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib. 2012-11-19 Michael Albinus diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index aa8aae2d245..b4c86e39e86 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -297,6 +297,8 @@ to writing a completion function." (define-key eshell-command-map [? ] 'pcomplete-expand) (define-key eshell-mode-map [tab] 'eshell-pcomplete) (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete) + (add-hook 'completion-at-point-functions + #'pcomplete-completions-at-point nil t) ;; jww (1999-10-19): Will this work on anything but X? (if (featurep 'xemacs) (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) @@ -452,9 +454,9 @@ to writing a completion function." (defun eshell-pcomplete () "Eshell wrapper for `pcomplete'." (interactive) - (if eshell-cmpl-ignore-case - (pcomplete-expand-and-complete) ; hack workaround for bug#12838 - (pcomplete))) + (condition-case nil + (pcomplete) + (text-read-only (completion-at-point)))) ; Workaround for bug#12838. (provide 'em-cmpl) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 9e55976a8bd..13cf7356e7f 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -833,7 +833,8 @@ this is `comint-dynamic-complete-functions'." . ,(lambda (comps) (sort comps pcomplete-compare-entry-function))) ,@(cdr (completion-file-name-table s p a))) - (let ((completion-ignored-extensions nil)) + (let ((completion-ignored-extensions nil) + (completion-ignore-case pcomplete-ignore-case)) (completion-table-with-predicate #'comint-completion-file-name-table pred 'strict s p a)))))) -- cgit v1.3 From 63f251724c324fc04d987877d06ca62ac1735b0a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 15:57:36 -0500 Subject: * lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Don't accept non-symbols for compiler macros (yet). --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/byte-run.el | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e2299df822f..7e9ed2502a7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-11-19 Stefan Monnier + * emacs-lisp/byte-run.el (defun-declarations-alist): Don't accept + non-symbols for compiler macros (yet). + * eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838: Fallback on completion-at-point rather than pcomplete-expand-and-complete, and only if pcomplete actually failed. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 462b4a25154..544b64bc3a6 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -82,7 +82,9 @@ The return value of this function is not used." `(make-obsolete ',f ',new-name ,when))) (list 'compiler-macro #'(lambda (f _args compiler-function) - `(put ',f 'compiler-macro #',compiler-function))) + (if (not (symbolp compiler-function)) + (error "Only symbols are supported in `compiler-macro'") + `(put ',f 'compiler-macro #',compiler-function)))) (list 'doc-string #'(lambda (f _args pos) (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) -- cgit v1.3 From 141462223d6f8063bf01692c2f41ecc58baea506 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 16:30:55 -0500 Subject: * lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Allow compiler-macros to be lambda expressions. * lisp/progmodes/python.el: Use cl-lib. Move var declarations outside of eval-when-compile. (python-syntax-context): Add compiler-macro. (python-font-lock-keywords): Simplify with De Morgan. --- lisp/ChangeLog | 8 +++++ lisp/emacs-lisp/byte-run.el | 10 ++++-- lisp/progmodes/python.el | 77 ++++++++++++++++++++++++++------------------- 3 files changed, 60 insertions(+), 35 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index df0b8bd422f..ca585e0669f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,13 @@ 2012-11-19 Stefan Monnier + * emacs-lisp/byte-run.el (defun-declarations-alist): + Allow a compiler-macro to be a lambda expression. + + * progmodes/python.el: Use cl-lib. Move var declarations outside of + eval-when-compile. + (python-syntax-context): Add compiler-macro. + (python-font-lock-keywords): Simplify with De Morgan. + * vc/diff-mode.el (diff-hunk): Don't make useless timers. * files.el (load-file): Require match in minibuffer selection, as was diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 462b4a25154..06f404d615c 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -81,8 +81,14 @@ The return value of this function is not used." #'(lambda (f _args new-name when) `(make-obsolete ',f ',new-name ,when))) (list 'compiler-macro - #'(lambda (f _args compiler-function) - `(put ',f 'compiler-macro #',compiler-function))) + #'(lambda (f args compiler-function) + ;; FIXME: Make it possible to just reuse `args'. + `(eval-and-compile + (put ',f 'compiler-macro + ,(if (eq (car-safe compiler-function) 'lambda) + `(lambda ,(append (cadr compiler-function) args) + ,@(cddr compiler-function)) + #',compiler-function))))) (list 'doc-string #'(lambda (f _args pos) (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 949b0252bf1..550c5f5a129 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -202,13 +202,12 @@ (require 'ansi-color) (require 'comint) +(eval-when-compile (require 'cl-lib)) -(eval-when-compile - (require 'cl) - ;; Avoid compiler warnings - (defvar view-return-to-alist) - (defvar compilation-error-regexp-alist) - (defvar outline-heading-end-regexp)) +;; Avoid compiler warnings +(defvar view-return-to-alist) +(defvar compilation-error-regexp-alist) +(defvar outline-heading-end-regexp) (autoload 'comint-mode "comint") @@ -364,12 +363,24 @@ This variant of `rx' supports common python named REGEXPS." "Return non-nil if point is on TYPE using SYNTAX-PPSS. TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." + (declare (compiler-macro + (lambda (form) + (pcase type + (`'comment + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 4 ppss) (nth 8 ppss)))) + (`'string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 3 ppss) (nth 8 ppss)))) + (`'paren + `(nth 1 (or ,syntax-ppss (syntax-ppss)))) + (_ form))))) (let ((ppss (or syntax-ppss (syntax-ppss)))) - (case type - (comment (and (nth 4 ppss) (nth 8 ppss))) - (string (and (not (nth 4 ppss)) (nth 8 ppss))) - (paren (nth 1 ppss)) - (t nil)))) + (pcase type + (`comment (and (nth 4 ppss) (nth 8 ppss))) + (`string (and (nth 3 ppss) (nth 8 ppss))) + (`paren (nth 1 ppss)) + (_ nil)))) (defun python-syntax-context-type (&optional syntax-ppss) "Return the context type using SYNTAX-PPSS. @@ -481,8 +492,8 @@ The type returned can be `comment', `string' or `paren'." (when (re-search-forward re limit t) (while (and (python-syntax-context 'paren) (re-search-forward re limit t))) - (if (and (not (python-syntax-context 'paren)) - (not (equal (char-after (point-marker)) ?=))) + (if (not (or (python-syntax-context 'paren) + (equal (char-after (point-marker)) ?=))) t (set-match-data nil))))) (1 font-lock-variable-name-face nil nil)) @@ -516,7 +527,7 @@ is used to limit the scan." (while (and (< i 3) (or (not limit) (< (+ point i) limit)) (eq (char-after (+ point i)) quote-char)) - (incf i)) + (cl-incf i)) i)) (defun python-syntax-stringify () @@ -723,17 +734,17 @@ START is the buffer position where the sexp starts." (save-restriction (widen) (save-excursion - (case context-status - ('no-indent 0) + (pcase context-status + (`no-indent 0) ;; When point is after beginning of block just add one level ;; of indentation relative to the context-start - ('after-beginning-of-block + (`after-beginning-of-block (goto-char context-start) (+ (current-indentation) python-indent-offset)) ;; When after a simple line just use previous line ;; indentation, in the case current line starts with a ;; `python-indent-dedenters' de-indent one level. - ('after-line + (`after-line (- (save-excursion (goto-char context-start) @@ -746,11 +757,11 @@ START is the buffer position where the sexp starts." ;; When inside of a string, do nothing. just use the current ;; indentation. XXX: perhaps it would be a good idea to ;; invoke standard text indentation here - ('inside-string + (`inside-string (goto-char context-start) (current-indentation)) ;; After backslash we have several possibilities. - ('after-backslash + (`after-backslash (cond ;; Check if current line is a dot continuation. For this ;; the current line must start with a dot and previous @@ -816,7 +827,7 @@ START is the buffer position where the sexp starts." (+ (current-indentation) python-indent-offset))))) ;; When inside a paren there's a need to handle nesting ;; correctly - ('inside-paren + (`inside-paren (cond ;; If current line closes the outermost open paren use the ;; current indentation of the context-start line. @@ -2164,11 +2175,11 @@ INPUT." 'default) (t nil))) (completion-code - (case completion-context - (pdb python-shell-completion-pdb-string-code) - (import python-shell-completion-module-string-code) - (default python-shell-completion-string-code) - (t nil))) + (pcase completion-context + (`pdb python-shell-completion-pdb-string-code) + (`import python-shell-completion-module-string-code) + (`default python-shell-completion-string-code) + (_ nil))) (input (if (eq completion-context 'import) (replace-regexp-in-string "^[ \t]+" "" line) @@ -2492,17 +2503,17 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;; Docstring styles may vary for oneliners and multi-liners. (> (count-matches "\n" str-start-pos str-end-pos) 0)) (delimiters-style - (case python-fill-docstring-style + (pcase python-fill-docstring-style ;; delimiters-style is a cons cell with the form ;; (START-NEWLINES . END-NEWLINES). When any of the sexps ;; is NIL means to not add any newlines for start or end ;; of docstring. See `python-fill-docstring-style' for a ;; graphic idea of each style. - (django (cons 1 1)) - (onetwo (and multi-line-p (cons 1 2))) - (pep-257 (and multi-line-p (cons nil 2))) - (pep-257-nn (and multi-line-p (cons nil 1))) - (symmetric (and multi-line-p (cons 1 1))))) + (`django (cons 1 1)) + (`onetwo (and multi-line-p (cons 1 2))) + (`pep-257 (and multi-line-p (cons nil 2))) + (`pep-257-nn (and multi-line-p (cons nil 1))) + (`symmetric (and multi-line-p (cons 1 1))))) (docstring-p (save-excursion ;; Consider docstrings those strings which ;; start on a line by themselves. @@ -2703,7 +2714,7 @@ The skeleton will be bound to python-skeleton-NAME." (easy-menu-add-item nil '("Python" "Skeletons") `[,(format - "Insert %s" (caddr (split-string (symbol-name skeleton) "-"))) + "Insert %s" (nth 2 (split-string (symbol-name skeleton) "-"))) ,skeleton t])))) ;;; FFAP -- cgit v1.3 From 8ea5c4de2a2a9d71b3877974c92def925fb26f5d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 19 Nov 2012 15:39:28 -0800 Subject: Improve static checking of integer overflow and stack smashing. * configure.ac (WARN_CFLAGS): Add -Wstack-protector and -Wstrict-overflow if using GCC 4.7.2 or later on a platform with at least 64-bit long int. This improves static checking on these platforms, when configured with --enable-gcc-warnings. --- ChangeLog | 8 ++++++++ configure.ac | 19 ++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 05e1a14d55d..6852069087a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-11-19 Paul Eggert + + Improve static checking of integer overflow and stack smashing. + * configure.ac (WARN_CFLAGS): Add -Wstack-protector and + -Wstrict-overflow if using GCC 4.7.2 or later on a platform with + at least 64-bit long int. This improves static checking on these + platforms, when configured with --enable-gcc-warnings. + 2012-11-17 Paul Eggert Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). diff --git a/configure.ac b/configure.ac index 1884cc7ccf7..2a079cad264 100644 --- a/configure.ac +++ b/configure.ac @@ -717,11 +717,24 @@ else # . nw="$nw -Wshadow" - # The following lines should be removable at some point. - nw="$nw -Wstack-protector" - nw="$nw -Wstrict-overflow" + # The following line should be removable at some point. nw="$nw -Wsuggest-attribute=pure" + AC_MSG_CHECKING([whether to use -Wstack-protector -Wstrict-overflow]) + AC_PREPROC_IFELSE( + [AC_LANG_PROGRAM( + [[#if (1 <= __LONG_MAX__ >> 31 >> 31 \ + && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__))) + /* OK */ + #else + #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits." + #endif + ]])], + [AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no) + nw="$nw -Wstack-protector" + nw="$nw -Wstrict-overflow"]) + gl_MANYWARN_ALL_GCC([ws]) gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw]) for w in $ws; do -- cgit v1.3 From b0636be7f9526041aeaa9f4fb6d3636426eec899 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 19 Nov 2012 19:57:23 -0500 Subject: Add a menu for profiler report mode * lisp/profiler.el (profiler-report-mode-map): Add a menu. No need to bind `q' because we derive from special-mode. (profiler-report-find-entry): Handle calls from the menu-bar. --- lisp/ChangeLog | 6 ++++++ lisp/profiler.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 52 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ca585e0669f..8fc9bd409a3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Glenn Morris + + * profiler.el (profiler-report-mode-map): Add a menu. + No need to bind `q' because we derive from special-mode. + (profiler-report-find-entry): Handle calls from the menu-bar. + 2012-11-19 Stefan Monnier * emacs-lisp/byte-run.el (defun-declarations-alist): diff --git a/lisp/profiler.el b/lisp/profiler.el index 38c0c0b83a7..00b51ffe099 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -404,7 +404,6 @@ RET: expand or collapse")) (defvar profiler-report-mode-map (let ((map (make-sparse-keymap))) - ;; FIXME: Add menu. (define-key map "n" 'profiler-report-next-entry) (define-key map "p" 'profiler-report-previous-entry) ;; I find it annoying more than helpful to not be able to navigate @@ -424,8 +423,43 @@ RET: expand or collapse")) (define-key map "D" 'profiler-report-descending-sort) (define-key map "=" 'profiler-report-compare-profile) (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) - (define-key map "q" 'quit-window) - map)) + (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode." + '("Profiler" + ["Next Entry" profiler-report-next-entry :active t + :help "Move to next entry"] + ["Previous Entry" profiler-report-previous-entry :active t + :help "Move to previous entry"] + "--" + ["Toggle Entry" profiler-report-toggle-entry + :active (profiler-report-calltree-at-point) + :help "Expand or collapse the current entry"] + ["Find Entry" profiler-report-find-entry + ;; FIXME should deactivate if not on a known function. + :active (profiler-report-calltree-at-point) + :help "Find the definition of the current entry"] + ["Describe Entry" profiler-report-describe-entry + :active (profiler-report-calltree-at-point) + :help "Show the documentation of the current entry"] + "--" + ["Show Calltree" profiler-report-render-calltree + :active profiler-report-reversed + :help "Show calltree view"] + ["Show Reversed Calltree" profiler-report-render-reversed-calltree + :active (not profiler-report-reversed) + :help "Show reversed calltree view"] + ["Sort Ascending" profiler-report-ascending-sort + :active (not (eq profiler-report-order 'ascending)) + :help "Sort calltree view in ascending order"] + ["Sort Descending" profiler-report-descending-sort + :active (not (eq profiler-report-order 'descending)) + :help "Sort calltree view in descending order"] + "--" + ["Compare Profile..." profiler-report-compare-profile :active t + :help "Compare current profile with another"] + ["Write Profile..." profiler-report-write-profile :active t + :help "Write current profile to a file"])) + map) + "Keymap for `profiler-report-mode'.") (defun profiler-report-make-buffer-name (profile) (format "*%s-Profiler-Report %s*" @@ -529,11 +563,15 @@ otherwise collapse." (defun profiler-report-find-entry (&optional event) "Find entry at point." (interactive (list last-nonmenu-event)) - (if event (posn-set-point (event-end event))) - (let ((tree (profiler-report-calltree-at-point))) - (when tree - (let ((entry (profiler-calltree-entry tree))) - (find-function entry))))) + (with-current-buffer + (if event (window-buffer (posn-window (event-start event))) + (current-buffer)) + (and event (setq event (event-end event)) + (posn-set-point event)) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (find-function entry)))))) (defun profiler-report-describe-entry () "Describe entry at point." -- cgit v1.3 From 23ba2705e22b89154ef7cbb0595419732080b94c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 23:24:09 -0500 Subject: Make called-interactively-p work for edebug or advised code. * lisp/subr.el (called-interactively-p-functions): New var. (internal--called-interactively-p--get-frame): New macro. (called-interactively-p, interactive-p): Rewrite in Lisp. * lisp/emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/allout.el (allout-called-interactively-p): Don't assume called-interactively-p is a subr. * src/eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. (syms_of_eval): Remove corresponding defsubr. * src/bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function. * test/automated/advice-tests.el (advice-tests--data): Remove. (advice-tests): Move the tests directly here instead. Add called-interactively-p tests. --- lisp/ChangeLog | 12 ++++ lisp/allout.el | 7 +- lisp/emacs-lisp/edebug.el | 15 +++++ lisp/emacs-lisp/nadvice.el | 50 ++++++++++++++ lisp/subr.el | 148 ++++++++++++++++++++++++++++++++++++++++- src/ChangeLog | 18 +++-- src/bytecode.c | 4 +- src/eval.c | 107 ++--------------------------- test/ChangeLog | 6 ++ test/automated/advice-tests.el | 129 +++++++++++++++++++---------------- 10 files changed, 323 insertions(+), 173 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8fc9bd409a3..4be61545f7f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2012-11-20 Stefan Monnier + + * subr.el (called-interactively-p-functions): New var. + (internal--called-interactively-p--get-frame): New macro. + (called-interactively-p, interactive-p): Rewrite in Lisp. + * emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. + (called-interactively-p-functions): Use it. + * emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. + (called-interactively-p-functions): Use it. + * allout.el (allout-called-interactively-p): Don't assume + called-interactively-p is a subr. + 2012-11-20 Glenn Morris * profiler.el (profiler-report-mode-map): Add a menu. diff --git a/lisp/allout.el b/lisp/allout.el index 04de853ebe0..e93aefd12cc 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1657,10 +1657,9 @@ and the place for the cursor after the decryption is done." (defmacro allout-called-interactively-p () "A version of `called-interactively-p' independent of Emacs version." ;; ... to ease maintenance of allout without betraying deprecation. - (if (equal (subr-arity (symbol-function 'called-interactively-p)) - '(0 . 0)) - '(called-interactively-p) - '(called-interactively-p 'interactive))) + (if (ignore-errors (called-interactively-p 'interactive) t) + '(called-interactively-p 'interactive) + '(called-interactively-p))) ;;;_ = allout-inhibit-aberrance-doublecheck nil ;; In some exceptional moments, disparate topic depths need to be allowed ;; momentarily, eg when one topic is being yanked into another and they're diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 483ed64de20..12311711fe0 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4268,6 +4268,21 @@ With prefix argument, make it a temporary breakpoint." ;;; Finalize Loading +;; When edebugging a function, some of the sub-expressions are +;; wrapped in (edebug-enter (lambda () ..)), so we need to teach +;; called-interactively-p that calls within the inner lambda should refer to +;; the outside function. +(add-hook 'called-interactively-p-functions + #'edebug--called-interactively-skip) +(defun edebug--called-interactively-skip (i frame1 frame2) + (when (and (eq (car-safe (nth 1 frame1)) 'lambda) + (eq (nth 1 (nth 1 frame1)) '()) + (eq (nth 1 frame2) 'edebug-enter)) + ;; `edebug-enter' calls itself on its first invocation. + (if (eq (nth 1 (internal--called-interactively-p--get-frame i)) + 'edebug-enter) + 2 1))) + ;; Finally, hook edebug into the rest of Emacs. ;; There are probably some other things that could go here. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 540e0166ec2..d9c5316b1b8 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -402,6 +402,56 @@ of the piece of advice." (if (fboundp function-name) (symbol-function function-name)))))) +;; When code is advised, called-interactively-p needs to be taught to skip +;; the advising frames. +;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p +;; done from the advised function if the deepest advice is an around advice! +;; In other cases (calls from an advice or calls from the advised function when +;; the deepest advice is not an around advice), it should hopefully get +;; it right. +(add-hook 'called-interactively-p-functions + #'advice--called-interactively-skip) +(defun advice--called-interactively-skip (origi frame1 frame2) + (let* ((i origi) + (get-next-frame + (lambda () + (setq frame1 frame2) + (setq frame2 (internal--called-interactively-p--get-frame i)) + ;; (message "Advice Frame %d = %S" i frame2) + (setq i (1+ i))))) + (when (and (eq (nth 1 frame2) 'apply) + (progn + (funcall get-next-frame) + (advice--p (indirect-function (nth 1 frame2))))) + (funcall get-next-frame) + ;; If we now have the symbol, this was the head advice and + ;; we're done. + (while (advice--p (nth 1 frame1)) + ;; This was an inner advice called from some earlier advice. + ;; The stack frames look different depending on the particular + ;; kind of the earlier advice. + (let ((inneradvice (nth 1 frame1))) + (if (and (eq (nth 1 frame2) 'apply) + (progn + (funcall get-next-frame) + (advice--p (indirect-function + (nth 1 frame2))))) + ;; The earlier advice was something like a before/after + ;; advice where the "next" code is called directly by the + ;; advice--p object. + (funcall get-next-frame) + ;; It's apparently an around advice, where the "next" is + ;; called by the body of the advice in any way it sees fit, + ;; so we need to skip the frames of that body. + (while + (progn + (funcall get-next-frame) + (not (and (eq (nth 1 frame2) 'apply) + (eq (nth 3 frame2) inneradvice))))) + (funcall get-next-frame) + (funcall get-next-frame)))) + (- i origi 1)))) + (provide 'nadvice) ;;; nadvice.el ends here diff --git a/lisp/subr.el b/lisp/subr.el index 8410897fd6f..c0479d35987 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1191,8 +1191,6 @@ is converted into a string by expressing it in decimal." (make-obsolete 'unfocus-frame "it does nothing." "22.1") (make-obsolete 'make-variable-frame-local "explicitly check for a frame-parameter instead." "22.2") -(make-obsolete 'interactive-p 'called-interactively-p "23.2") -(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1") (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") @@ -3963,6 +3961,152 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) +(defvar called-interactively-p-functions nil + "Special hook called to skip special frames in `called-interactively-p'. +The functions are called with 3 arguments: (I FRAME1 FRAME2), +where FRAME1 is a \"current frame\", FRAME2 is the next frame, +I is the index of the frame after FRAME2. It should return nil +if those frames don't seem special and otherwise, it should return +the number of frames to skip (minus 1).") + +(defmacro internal--called-interactively-p--get-frame (n) + ;; `sym' will hold a global variable, which will be used kind of like C's + ;; "static" variables. + (let ((sym (make-symbol "base-index"))) + `(progn + (defvar ,sym + (let ((i 1)) + (while (not (eq (nth 1 (backtrace-frame i)) + 'called-interactively-p)) + (setq i (1+ i))) + i)) + ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) + ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) + (backtrace-frame (+ ,sym ,n))))) + +(defun called-interactively-p (&optional kind) + "Return t if the containing function was called by `call-interactively'. +If KIND is `interactive', then only return t if the call was made +interactively by the user, i.e. not in `noninteractive' mode nor +when `executing-kbd-macro'. +If KIND is `any', on the other hand, it will return t for any kind of +interactive call, including being called as the binding of a key or +from a keyboard macro, even in `noninteractive' mode. + +This function is very brittle, it may fail to return the intended result when +the code is debugged, advised, or instrumented in some form. Some macros and +special forms (such as `condition-case') may also sometimes wrap their bodies +in a `lambda', so any call to `called-interactively-p' from those bodies will +indicate whether that lambda (rather than the surrounding function) was called +interactively. + +Instead of using this function, it is cleaner and more reliable to give your +function an extra optional argument whose `interactive' spec specifies +non-nil unconditionally (\"p\" is a good way to do this), or via +\(not (or executing-kbd-macro noninteractive)). + +The only known proper use of `interactive' for KIND is in deciding +whether to display a helpful message, or how to display it. If you're +thinking of using it for any other purpose, it is quite likely that +you're making a mistake. Think: what do you want to do when the +command is called from a keyboard macro?" + (declare (advertised-calling-convention (kind) "23.1")) + (when (not (and (eq kind 'interactive) + (or executing-kbd-macro noninteractive))) + (let* ((i 1) ;; 0 is the called-interactively-p frame. + frame nextframe + (get-next-frame + (lambda () + (setq frame nextframe) + (setq nextframe (internal--called-interactively-p--get-frame i)) + ;; (message "Frame %d = %S" i nextframe) + (setq i (1+ i))))) + (funcall get-next-frame) ;; Get the first frame. + (while + ;; FIXME: The edebug and advice handling should be made modular and + ;; provided directly by edebug.el and nadvice.el. + (progn + ;; frame =(backtrace-frame i-2) + ;; nextframe=(backtrace-frame i-1) + (funcall get-next-frame) + ;; `pcase' would be a fairly good fit here, but it sometimes moves + ;; branches within local functions, which then messes up the + ;; `backtrace-frame' data we get, + (or + ;; Skip special forms (from non-compiled code). + (and frame (null (car frame))) + ;; Skip also `interactive-p' (because we don't want to know if + ;; interactive-p was called interactively but if it's caller was) + ;; and `byte-code' (idem; this appears in subexpressions of things + ;; like condition-case, which are wrapped in a separate bytecode + ;; chunk). + ;; FIXME: For lexical-binding code, this is much worse, + ;; because the frames look like "byte-code -> funcall -> #[...]", + ;; which is not a reliable signature. + (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; Skip package-specific stack-frames. + (let ((skip (run-hook-with-args-until-success + 'called-interactively-p-functions + i frame nextframe))) + (pcase skip + (`nil nil) + (`0 t) + (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) + ;; Now `frame' should be "the function from which we were called". + (pcase (cons frame nextframe) + ;; No subr calls `interactive-p', so we can rule that out. + (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) + ;; Somehow, I sometimes got `command-execute' rather than + ;; `call-interactively' on my stacktrace !? + ;;(`(,_ . (t command-execute . ,_)) t) + (`(,_ . (t call-interactively . ,_)) t))))) + +(defun interactive-p () + "Return t if the containing function was run directly by user input. +This means that the function was called with `call-interactively' +\(which includes being called as the binding of a key) +and input is currently coming from the keyboard (not a keyboard macro), +and Emacs is not running in batch mode (`noninteractive' is nil). + +The only known proper use of `interactive-p' is in deciding whether to +display a helpful message, or how to display it. If you're thinking +of using it for any other purpose, it is quite likely that you're +making a mistake. Think: what do you want to do when the command is +called from a keyboard macro or in batch mode? + +To test whether your function was called with `call-interactively', +either (i) add an extra optional argument and give it an `interactive' +spec that specifies non-nil unconditionally (such as \"p\"); or (ii) +use `called-interactively-p'." + (declare (obsolete called-interactively-p "23.2")) + (called-interactively-p 'interactive)) + +(defun function-arity (f &optional num) + "Return the (MIN . MAX) arity of F. +If the maximum arity is infinite, MAX is `many'. +F can be a function or a macro. +If NUM is non-nil, return non-nil iff F can be called with NUM args." + (if (symbolp f) (setq f (indirect-function f))) + (if (eq (car-safe f) 'macro) (setq f (cdr f))) + (let ((res + (if (subrp f) + (let ((x (subr-arity f))) + (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) + (let* ((args (if (consp f) (cadr f) (aref f 0))) + (max (length args)) + (opt (memq '&optional args)) + (rest (memq '&rest args)) + (min (- max (length opt)))) + (if opt + (cons min (if rest 'many (1- max))) + (if rest + (cons (- max (length rest)) 'many) + (cons min max))))))) + (if (not num) + res + (and (>= num (car res)) + (or (eq 'many (cdr res)) (<= num (cdr res))))))) + (defun set-temporary-overlay-map (map &optional keep-pred) "Set MAP as a temporary keymap taking precedence over most other keymaps. Note that this does NOT take precedence over the \"overriding\" maps diff --git a/src/ChangeLog b/src/ChangeLog index 89c4e273715..9e83129e585 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Stefan Monnier + + * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. + (syms_of_eval): Remove corresponding defsubr. + * bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function. + 2012-11-19 Daniel Colascione * w32fns.c (Fx_file_dialog): @@ -17,10 +23,10 @@ windows.h gets included before w32term.h uses some of its features, see below. - * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: New - typedefs. - (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: New - prototypes. + * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: + New typedefs. + (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: + New prototypes. (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878) 2012-11-18 Jan Djärv @@ -312,8 +318,8 @@ * xdisp.c (try_scrolling): Fix correction of aggressive-scroll amount when the scroll margins are too large. When scrolling backwards in the buffer, give up if cannot reach point or the - scroll margin within a reasonable number of screen lines. Fixes - point position in window under scroll-up/down-aggressively when + scroll margin within a reasonable number of screen lines. + Fixes point position in window under scroll-up/down-aggressively when point is positioned many lines beyond the window top/bottom. (Bug#12811) diff --git a/src/bytecode.c b/src/bytecode.c index 648813aed86..3267c7c8c76 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1579,7 +1579,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Binteractive_p): /* Obsolete since 24.1. */ - PUSH (Finteractive_p ()); + BEFORE_POTENTIAL_GC (); + PUSH (call0 (intern ("interactive-p"))); + AFTER_POTENTIAL_GC (); NEXT; CASE (Bforward_char): diff --git a/src/eval.c b/src/eval.c index f8a76646352..459fb762c6e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -489,102 +489,6 @@ usage: (function ARG) */) } -DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, - doc: /* Return t if the containing function was run directly by user input. -This means that the function was called with `call-interactively' -\(which includes being called as the binding of a key) -and input is currently coming from the keyboard (not a keyboard macro), -and Emacs is not running in batch mode (`noninteractive' is nil). - -The only known proper use of `interactive-p' is in deciding whether to -display a helpful message, or how to display it. If you're thinking -of using it for any other purpose, it is quite likely that you're -making a mistake. Think: what do you want to do when the command is -called from a keyboard macro? - -To test whether your function was called with `call-interactively', -either (i) add an extra optional argument and give it an `interactive' -spec that specifies non-nil unconditionally (such as \"p\"); or (ii) -use `called-interactively-p'. */) - (void) -{ - return (INTERACTIVE && interactive_p ()) ? Qt : Qnil; -} - - -DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0, - doc: /* Return t if the containing function was called by `call-interactively'. -If KIND is `interactive', then only return t if the call was made -interactively by the user, i.e. not in `noninteractive' mode nor -when `executing-kbd-macro'. -If KIND is `any', on the other hand, it will return t for any kind of -interactive call, including being called as the binding of a key, or -from a keyboard macro, or in `noninteractive' mode. - -The only known proper use of `interactive' for KIND is in deciding -whether to display a helpful message, or how to display it. If you're -thinking of using it for any other purpose, it is quite likely that -you're making a mistake. Think: what do you want to do when the -command is called from a keyboard macro? - -Instead of using this function, it is sometimes cleaner to give your -function an extra optional argument whose `interactive' spec specifies -non-nil unconditionally (\"p\" is a good way to do this), or via -\(not (or executing-kbd-macro noninteractive)). */) - (Lisp_Object kind) -{ - return (((INTERACTIVE || !EQ (kind, intern ("interactive"))) - && interactive_p ()) - ? Qt : Qnil); -} - - -/* Return true if function in which this appears was called using - call-interactively and is not a built-in. */ - -static bool -interactive_p (void) -{ - struct backtrace *btp; - Lisp_Object fun; - - btp = backtrace_list; - - /* If this isn't a byte-compiled function, there may be a frame at - the top for Finteractive_p. If so, skip it. */ - fun = Findirect_function (btp->function, Qnil); - if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p - || XSUBR (fun) == &Scalled_interactively_p)) - btp = btp->next; - - /* If we're running an Emacs 18-style byte-compiled function, there - may be a frame for Fbytecode at the top level. In any version of - Emacs there can be Fbytecode frames for subexpressions evaluated - inside catch and condition-case. Skip past them. - - If this isn't a byte-compiled function, then we may now be - looking at several frames for special forms. Skip past them. */ - while (btp - && (EQ (btp->function, Qbytecode) - || btp->nargs == UNEVALLED)) - btp = btp->next; - - /* `btp' now points at the frame of the innermost function that isn't - a special form, ignoring frames for Finteractive_p and/or - Fbytecode at the top. If this frame is for a built-in function - (such as load or eval-region) return false. */ - fun = Findirect_function (btp->function, Qnil); - if (SUBRP (fun)) - return 0; - - /* `btp' points to the frame of a Lisp function that called interactive-p. - Return t if that function was called interactively. */ - if (btp && btp->next && EQ (btp->next->function, Qcall_interactively)) - return 1; - return 0; -} - - DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. Aliased variables always have the same value; setting one sets the other. @@ -696,8 +600,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) if (EQ ((--pdl)->symbol, sym) && !pdl->func && EQ (pdl->old_value, Qunbound)) { - message_with_string ("Warning: defvar ignored because %s is let-bound", - SYMBOL_NAME (sym), 1); + message_with_string + ("Warning: defvar ignored because %s is let-bound", + SYMBOL_NAME (sym), 1); break; } } @@ -717,8 +622,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ - Vinternal_interpreter_environment = - Fcons (sym, Vinternal_interpreter_environment); + Vinternal_interpreter_environment + = Fcons (sym, Vinternal_interpreter_environment); else { /* Simple (defvar ) should not count as a definition at all. @@ -3551,8 +3456,6 @@ alist of active lexical bindings. */); defsubr (&Sunwind_protect); defsubr (&Scondition_case); defsubr (&Ssignal); - defsubr (&Sinteractive_p); - defsubr (&Scalled_interactively_p); defsubr (&Scommandp); defsubr (&Sautoload); defsubr (&Sautoload_do_load); diff --git a/test/ChangeLog b/test/ChangeLog index 75903ae3ef4..b66c2925287 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Stefan Monnier + + * automated/advice-tests.el (advice-tests--data): Remove. + (advice-tests): Move the tests directly here instead. + Add called-interactively-p tests. + 2012-11-19 Stefan Monnier * automated/ert-x-tests.el: Use cl-lib. diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 80321f8f3f9..94f69e77e43 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -21,81 +21,94 @@ ;;; Code: -(defvar advice-tests--data - '(((defun sm-test1 (x) (+ x 4)) - (sm-test1 6) 10) - ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) - (sm-test1 6) 50) - ((defun sm-test1 (x) (+ x 14)) - (sm-test1 6) 100) - ((null (get 'sm-test1 'defalias-fset-function)) nil) - ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) - (sm-test1 6) 20) - ((null (get 'sm-test1 'defalias-fset-function)) t) - - ((defun sm-test2 (x) (+ x 4)) - (sm-test2 6) 10) - ((defadvice sm-test2 (around sm-test activate) +(ert-deftest advice-tests () + "Test advice code." + (with-temp-buffer + (defun sm-test1 (x) (+ x 4)) + (should (equal (sm-test1 6) 10)) + (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 50)) + (defun sm-test1 (x) (+ x 14)) + (should (equal (sm-test1 6) 100)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) + (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 20)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) + + (defun sm-test2 (x) (+ x 4)) + (should (equal (sm-test2 6) 10)) + (defadvice sm-test2 (around sm-test activate) ad-do-it (setq ad-return-value (* ad-return-value 5))) - (sm-test2 6) 50) - ((ad-deactivate 'sm-test2) - (sm-test2 6) 10) - ((ad-activate 'sm-test2) - (sm-test2 6) 50) - ((defun sm-test2 (x) (+ x 14)) - (sm-test2 6) 100) - ((null (get 'sm-test2 'defalias-fset-function)) nil) - ((ad-remove-advice 'sm-test2 'around 'sm-test) - (sm-test2 6) 100) - ((ad-activate 'sm-test2) - (sm-test2 6) 20) - ((null (get 'sm-test2 'defalias-fset-function)) t) - - ((advice-add 'sm-test3 :around + (should (equal (sm-test2 6) 50)) + (ad-deactivate 'sm-test2) + (should (equal (sm-test2 6) 10)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 50)) + (defun sm-test2 (x) (+ x 14)) + (should (equal (sm-test2 6) 100)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) + (ad-remove-advice 'sm-test2 'around 'sm-test) + (should (equal (sm-test2 6) 100)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 20)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) + + (advice-add 'sm-test3 :around (lambda (f &rest args) `(toto ,(apply f args))) '((name . wrap-with-toto))) (defmacro sm-test3 (x) `(call-test3 ,x)) - (macroexpand '(sm-test3 56)) (toto (call-test3 56))) + (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) - ((defadvice sm-test4 (around wrap-with-toto activate) + (defadvice sm-test4 (around wrap-with-toto activate) ad-do-it (setq ad-return-value `(toto ,ad-return-value))) (defmacro sm-test4 (x) `(call-test4 ,x)) - (macroexpand '(sm-test4 56)) (toto (call-test4 56))) - ((defmacro sm-test4 (x) `(call-testq ,x)) - (macroexpand '(sm-test4 56)) (toto (call-testq 56))) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) + (defmacro sm-test4 (x) `(call-testq ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) ;; Combining old style and new style advices. - ((defun sm-test5 (x) (+ x 4)) - (sm-test5 6) 10) - ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) - (sm-test5 6) 50) - ((defadvice sm-test5 (around test activate) + (defun sm-test5 (x) (+ x 4)) + (should (equal (sm-test5 6) 10)) + (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 50)) + (defadvice sm-test5 (around test activate) ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) - (sm-test5 5) 45.1) - ((ad-deactivate 'sm-test5) - (sm-test5 6) 50) - ((ad-activate 'sm-test5) - (sm-test5 6) 50.1) - ((defun sm-test5 (x) (+ x 14)) - (sm-test5 6) 100.1) - ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) - (sm-test5 6) 20.1) + (should (equal (sm-test5 5) 45.1)) + (ad-deactivate 'sm-test5) + (should (equal (sm-test5 6) 50)) + (ad-activate 'sm-test5) + (should (equal (sm-test5 6) 50.1)) + (defun sm-test5 (x) (+ x 14)) + (should (equal (sm-test5 6) 100.1)) + (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 20.1)) ;; This used to signal an error (bug#12858). - ((autoload 'sm-test6 "foo") + (autoload 'sm-test6 "foo") (defadvice sm-test6 (around test activate) ad-do-it) - t t) + ;; Check interaction between advice and called-interactively-p. + (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (list (cons 1 (called-interactively-p)) (apply f args)))) + (should (equal (sm-test7) '((1 . nil) 11))) + (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) + (let ((smi 7)) + (advice-add 'sm-test7 :before + (lambda (&rest args) + (setq smi (called-interactively-p)))) + (should (equal (list (sm-test7) smi) + '(((1 . nil) 11) nil))) + (should (equal (list (call-interactively 'sm-test7) smi) + '(((1 . t) 11) t)))) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (cons (cons 2 (called-interactively-p)) (apply f args)))) + (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) )) -(ert-deftest advice-tests () - "Test advice code." - (with-temp-buffer - (dolist (test advice-tests--data) - (let ((res (eval `(progn ,@(butlast test))))) - (should (equal (car (last test)) res)))))) - ;; Local Variables: ;; no-byte-compile: t ;; End: -- cgit v1.3 From 952580c5fd273ff9d8f095ab8edb6b116d07eb56 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Tue, 20 Nov 2012 11:53:04 +0400 Subject: * xdisp.c (buffer_shared): Adjust comment. (buffer_shared_and_changed): New function. (prepare_menu_bars, redisplay_internal): Use it to decide whether all windows or frames should be updated. --- src/ChangeLog | 7 +++++++ src/xdisp.c | 23 +++++++++++++++-------- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9e83129e585..c749b12cae8 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2012-11-20 Dmitry Antipov + + * xdisp.c (buffer_shared): Adjust comment. + (buffer_shared_and_changed): New function. + (prepare_menu_bars, redisplay_internal): Use it to + decide whether all windows or frames should be updated. + 2012-11-20 Stefan Monnier * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. diff --git a/src/xdisp.c b/src/xdisp.c index 27d9fff0b7d..618f4dfc585 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -515,9 +515,8 @@ Lisp_Object Qmenu_bar_update_hook; static int overlay_arrow_seen; -/* Number of windows showing the buffer of the selected window (or - another buffer with the same base buffer). keyboard.c refers to - this. */ +/* Number of windows showing the buffer of the selected + window (or another buffer with the same base buffer). */ int buffer_shared; @@ -10889,8 +10888,15 @@ echo_area_display (int update_frame_p) return window_height_changed_p; } +/* True if the current buffer is shown in more than + one window and was modified since last display. */ + +static int +buffer_shared_and_changed (void) +{ + return (buffer_shared > 1 && UNCHANGED_MODIFIED < MODIFF); +} - /*********************************************************************** Mode Lines and Frame Titles ***********************************************************************/ @@ -11196,7 +11202,7 @@ prepare_menu_bars (void) /* Update the menu bar item lists, if appropriate. This has to be done before any actual redisplay or generation of display lines. */ all_windows = (update_mode_lines - || buffer_shared > 1 + || buffer_shared_and_changed () || windows_or_buffers_changed); if (all_windows) { @@ -13116,7 +13122,7 @@ redisplay_internal (void) if ((SAVE_MODIFF < MODIFF) != w->last_had_star) { w->update_mode_line = 1; - if (buffer_shared > 1) + if (buffer_shared_and_changed ()) update_mode_lines++; } @@ -13141,7 +13147,8 @@ redisplay_internal (void) /* The variable buffer_shared is set in redisplay_window and indicates that we redisplay a buffer in different windows. See there. */ - consider_all_windows_p = (update_mode_lines || buffer_shared > 1 + consider_all_windows_p = (update_mode_lines + || buffer_shared_and_changed () || cursor_type_changed); /* If specs for an arrow have changed, do thorough redisplay @@ -13433,7 +13440,7 @@ redisplay_internal (void) } CHARPOS (this_line_start_pos) = 0; - consider_all_windows_p |= buffer_shared > 1; + consider_all_windows_p |= buffer_shared_and_changed (); ++clear_face_cache_count; #ifdef HAVE_WINDOW_SYSTEM ++clear_image_cache_count; -- cgit v1.3 From 5b776637e1facf949c9bc0db665db879c580e2f6 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 00:02:54 -0800 Subject: Make a start on a Profiling section in the lispref * doc/lispref/debugging.texi (Profiling): New section, in progress. * doc/lispref/tips.texi (Compilation Tips): Move profiling to separate section. * doc/lispref/elisp.texi: Add Profiling to detailed menu. --- doc/lispref/ChangeLog | 6 ++++++ doc/lispref/debugging.texi | 40 ++++++++++++++++++++++++++++++++++++++++ doc/lispref/elisp.texi | 1 + doc/lispref/tips.texi | 14 ++------------ 4 files changed, 49 insertions(+), 12 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index bdf4ef13488..9d71d4b4420 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Glenn Morris + + * debugging.texi (Profiling): New section, in progress. + * tips.texi (Compilation Tips): Move profiling to separate section. + * elisp.texi: Add Profiling to detailed menu. + 2012-11-18 Martin Rudalics * windows.texi (Display Action Functions): Fix recently added diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 11532b19781..53d739f2295 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -43,6 +43,7 @@ function (@pxref{Terminal Output}). * Edebug:: A source-level Emacs Lisp debugger. * Syntax Errors:: How to find syntax errors. * Test Coverage:: Ensuring you have tested all branches in your code. +* Profiling:: Measuring the resources that your code uses. @end menu @node Debugger @@ -809,3 +810,42 @@ never return. If it ever does return, you get a run-time error. Edebug also has a coverage testing feature (@pxref{Coverage Testing}). These features partly duplicate each other, and it would be cleaner to combine them. + + +@node Profiling +@section Profiling +@cindex profiling +@cindex measuring resource usage +@cindex memory usage + +If your program is working correctly, but you want to make it run more +quickly or efficiently, the first thing to do is @dfn{profile} your +code that you know how it is using resources. If you find that one +particular function is responsible for a significant portion of the +runtime, you can start by looking for ways to optimize that piece. + +Emacs has built-in support for this. To begin profiling, type +@kbd{M-x profiler-start}. You can choose to profile by processor +usage, memory usage, or both. After doing some work, type +@kbd{M-x profiler-report} to display a summary buffer for each +resource that you chose to profile. The names of the report buffers +include the times at which the reports were generated, so you can +generate another report later on without erasing previous results. +When you have finished profiling, type @kbd{M-x profiler-stop} (there +is a small overhead associated with profiling). + +@c FIXME +@c Basic apperance of the report buffer: + +@c The following commands are available in the report buffer: + +@cindex @file{elp.el} +@cindex timing programs +The @file{elp} library offers an alternative approach. See the file +@file{elp.el} for instructions. + +@cindex @file{benchmark.el} +@cindex benchmarking +You can check the speed of individual Emacs Lisp forms using the +@file{benchmark} library. See the functions @code{benchmark-run} and +@code{benchmark-run-compiled} in @file{benchmark.el}. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a70558bf09f..cb00b5e9889 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -617,6 +617,7 @@ Debugging Lisp Programs * Edebug:: A source-level Emacs Lisp debugger. * Syntax Errors:: How to find syntax errors. * Test Coverage:: Ensuring you have tested all branches in your code. +* Profiling:: Measuring the resources that your code uses. The Lisp Debugger diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 4336baa128f..bba416d5614 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -460,18 +460,8 @@ Lisp programs. @itemize @bullet @item -@cindex profiling -@cindex timing programs -@cindex @file{elp.el} -Profile your program with the @file{elp} library. See the file -@file{elp.el} for instructions. - -@item -@cindex @file{benchmark.el} -@cindex benchmarking -Check the speed of individual Emacs Lisp forms using the -@file{benchmark} library. See the functions @code{benchmark-run} and -@code{benchmark-run-compiled} in @file{benchmark.el}. +Profile your program, to find out where the time is being spent. +@xref{Profiling}. @item Use iteration rather than recursion whenever possible. -- cgit v1.3 From d7fcbbfe4a6f310814b45ee1a0aa7ccb458f0eb1 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 20 Nov 2012 00:29:04 -0800 Subject: Omit -Wstrict-overflow as it does not play well with --enable-checking. --- ChangeLog | 6 +++--- configure.ac | 7 ++++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6852069087a..cd31e954721 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,8 @@ -2012-11-19 Paul Eggert +2012-11-20 Paul Eggert Improve static checking of integer overflow and stack smashing. - * configure.ac (WARN_CFLAGS): Add -Wstack-protector and - -Wstrict-overflow if using GCC 4.7.2 or later on a platform with + * configure.ac (WARN_CFLAGS): Add -Wstack-protector + if using GCC 4.7.2 or later on a platform with at least 64-bit long int. This improves static checking on these platforms, when configured with --enable-gcc-warnings. diff --git a/configure.ac b/configure.ac index 2a079cad264..01fe72d1ee6 100644 --- a/configure.ac +++ b/configure.ac @@ -710,6 +710,8 @@ else nw="$nw -Wfloat-equal" # warns about high-quality code nw="$nw -Winline" # OK to ignore 'inline' nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. + nw="$nw -Wstrict-overflow" # OK to optimize assuming that + # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations @@ -720,7 +722,7 @@ else # The following line should be removable at some point. nw="$nw -Wsuggest-attribute=pure" - AC_MSG_CHECKING([whether to use -Wstack-protector -Wstrict-overflow]) + AC_MSG_CHECKING([whether to use -Wstack-protector]) AC_PREPROC_IFELSE( [AC_LANG_PROGRAM( [[#if (1 <= __LONG_MAX__ >> 31 >> 31 \ @@ -732,8 +734,7 @@ else ]])], [AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no) - nw="$nw -Wstack-protector" - nw="$nw -Wstrict-overflow"]) + nw="$nw -Wstack-protector"]) gl_MANYWARN_ALL_GCC([ws]) gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw]) -- cgit v1.3 From a7db35b378d960071823a319bb781dc96b8eed7c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 20 Nov 2012 00:31:19 -0800 Subject: * emacsclient.c (handle_sigcont, handle_sigtstp): Use raise (sig) rather than kill (getpid (), sig), as it's simpler and safer. --- lib-src/ChangeLog | 5 +++++ lib-src/emacsclient.c | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 926297b6dd3..67035773977 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,8 @@ +2012-11-20 Paul Eggert + + * emacsclient.c (handle_sigcont, handle_sigtstp): Use raise (sig) + rather than kill (getpid (), sig), as it's simpler and safer. + 2012-11-17 Juanma Barranquero * makefile.w32-in (SYSWAIT_H): New macro. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 8d60d7961da..78079b5cf69 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1138,7 +1138,7 @@ handle_sigcont (int signalnum) else { /* We are in the background; cancel the continue. */ - kill (getpid (), SIGSTOP); + raise (SIGSTOP); } signal (signalnum, handle_sigcont); @@ -1165,7 +1165,7 @@ handle_sigtstp (int signalnum) sigprocmask (SIG_BLOCK, NULL, &set); sigdelset (&set, signalnum); signal (signalnum, SIG_DFL); - kill (getpid (), signalnum); + raise (signalnum); sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */ signal (signalnum, handle_sigtstp); -- cgit v1.3 From b83fdfa997d54f8b41f23de23103ceda36eca02c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 20 Nov 2012 00:32:19 -0800 Subject: * eval.c (interactive_p): Remove no-longer-used decl. --- src/ChangeLog | 4 ++++ src/eval.c | 1 - 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index c749b12cae8..c69452a1f1b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2012-11-20 Paul Eggert + + * eval.c (interactive_p): Remove no-longer-used decl. + 2012-11-20 Dmitry Antipov * xdisp.c (buffer_shared): Adjust comment. diff --git a/src/eval.c b/src/eval.c index 459fb762c6e..053b1a7f097 100644 --- a/src/eval.c +++ b/src/eval.c @@ -114,7 +114,6 @@ Lisp_Object Vsignaling_function; Lisp_Object inhibit_lisp_code; static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); -static bool interactive_p (void); static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); /* Functions to set Lisp_Object slots of struct specbinding. */ -- cgit v1.3 From ccba372d5140646db3ea8ce3d928797611a8d89a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 00:39:41 -0800 Subject: NEWS fix Ref: http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00377.html --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index c82dde7a01a..43e760ba330 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -787,7 +787,7 @@ are deprecated and will be removed eventually. ** New sampling-based Elisp profiler. Try M-x profiler-start, do some work, and then call M-x profiler-report. When finished, use M-x profiler-stop. The sampling rate can be based on -CPU time (only supported on some systems) or memory allocations. +CPU time or memory allocations. +++ ** CL-style generalized variables are now in core Elisp. -- cgit v1.3 From 1faaca8ac8e43c1f9fc2ae80771308b2eb20228f Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 00:47:57 -0800 Subject: Fix typos in previous --- doc/lispref/debugging.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 53d739f2295..4450d177896 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -820,9 +820,9 @@ be cleaner to combine them. If your program is working correctly, but you want to make it run more quickly or efficiently, the first thing to do is @dfn{profile} your -code that you know how it is using resources. If you find that one +code so that you know how it is using resources. If you find that one particular function is responsible for a significant portion of the -runtime, you can start by looking for ways to optimize that piece. +runtime, you can start looking for ways to optimize that piece. Emacs has built-in support for this. To begin profiling, type @kbd{M-x profiler-start}. You can choose to profile by processor -- cgit v1.3 From 555ccdc2150fa00050ac04d55be15f768f90136c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Nov 2012 10:29:47 +0100 Subject: * trampver.el: * trampver.texi: Downgrade version to 2.2.6-24.3, in order to distinguish from trunk. Don't merge with trunk, please. --- doc/misc/ChangeLog | 5 +++++ doc/misc/trampver.texi | 2 +- lisp/ChangeLog | 5 +++++ lisp/net/trampver.el | 4 ++-- 4 files changed, 13 insertions(+), 3 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 4a3c8778e88..d82d9699829 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2012-11-20 Michael Albinus + + * trampver.texi: Downgrade version to 2.2.6-24.3, in order to + distinguish from trunk. + 2012-11-16 Glenn Morris * cl.texi (Function Bindings): Clarify that cl-flet is lexical. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 96043a07300..b44f1df2a1e 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.2.7-pre +@set trampver 2.2.6-24.3 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7e9ed2502a7..247222bde21 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-20 Michael Albinus + + * net/trampver.el (tramp-version): Downgrade to 2.2.6-24.3, in + order to distinguish from trunk. + 2012-11-19 Stefan Monnier * emacs-lisp/byte-run.el (defun-declarations-alist): Don't accept diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 331884691f4..2147f109de9 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.7-pre" +(defconst tramp-version "2.2.6-24.3" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.7-pre is not fit for %s" + (format "Tramp 2.2.6-24.3 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) -- cgit v1.3 From da8ed5ba5fe78842d24a566fde07fcc2dee4bb73 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 06:17:33 -0500 Subject: Auto-commit of generated files. --- autogen/configure | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/autogen/configure b/autogen/configure index afcf9a73fa6..22cdb7334b8 100755 --- a/autogen/configure +++ b/autogen/configure @@ -7257,6 +7257,8 @@ fi nw="$nw -Wfloat-equal" # warns about high-quality code nw="$nw -Winline" # OK to ignore 'inline' nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. + nw="$nw -Wstrict-overflow" # OK to optimize assuming that + # signed overflow has undefined behavior nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations @@ -7264,11 +7266,38 @@ fi # . nw="$nw -Wshadow" - # The following lines should be removable at some point. - nw="$nw -Wstack-protector" - nw="$nw -Wstrict-overflow" + # The following line should be removable at some point. nw="$nw -Wsuggest-attribute=pure" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -Wstack-protector" >&5 +$as_echo_n "checking whether to use -Wstack-protector... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#if (1 <= __LONG_MAX__ >> 31 >> 31 \ + && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__))) + /* OK */ + #else + #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits." + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + nw="$nw -Wstack-protector" +fi +rm -f conftest.err conftest.$ac_ext + if test -n "$GCC"; then -- cgit v1.3 From ea6de9b1f867a49a1ad062ca54e461cd3b1e003f Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Tue, 20 Nov 2012 15:41:57 +0400 Subject: Tiny adjustment around the previous redisplay change. * xdisp.c (window_outdated): New function. (text_outside_line_unchanged_p, redisplay_window): Use it. (redisplay_internal): Likewise. Fix indentation. --- src/ChangeLog | 3 +++ src/xdisp.c | 49 ++++++++++++++++++++++++------------------------- 2 files changed, 27 insertions(+), 25 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index c69452a1f1b..9a2cec8a7fc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -8,6 +8,9 @@ (buffer_shared_and_changed): New function. (prepare_menu_bars, redisplay_internal): Use it to decide whether all windows or frames should be updated. + (window_outdated): New function. + (text_outside_line_unchanged_p, redisplay_window): Use it. + (redisplay_internal): Likewise. Fix indentation. 2012-11-20 Stefan Monnier diff --git a/src/xdisp.c b/src/xdisp.c index 618f4dfc585..4d359593c75 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10888,7 +10888,7 @@ echo_area_display (int update_frame_p) return window_height_changed_p; } -/* True if the current buffer is shown in more than +/* Nonzero if the current buffer is shown in more than one window and was modified since last display. */ static int @@ -10897,6 +10897,17 @@ buffer_shared_and_changed (void) return (buffer_shared > 1 && UNCHANGED_MODIFIED < MODIFF); } +/* Nonzero if W doesn't reflect the actual state of + current buffer due to its text or overlays change. */ + +static int +window_outdated (struct window *w) +{ + eassert (XBUFFER (w->buffer) == current_buffer); + return (w->last_modified < MODIFF + || w->last_overlay_modified < OVERLAY_MODIFF); +} + /*********************************************************************** Mode Lines and Frame Titles ***********************************************************************/ @@ -12622,8 +12633,7 @@ text_outside_line_unchanged_p (struct window *w, int unchanged_p = 1; /* If text or overlays have changed, see where. */ - if (w->last_modified < MODIFF - || w->last_overlay_modified < OVERLAY_MODIFF) + if (window_outdated (w)) { /* Gap in the line? */ if (GPT < start || Z - GPT < end) @@ -13134,9 +13144,7 @@ redisplay_internal (void) if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ - && !(PT == w->last_point - && w->last_modified >= MODIFF - && w->last_overlay_modified >= OVERLAY_MODIFF) + && !(PT == w->last_point && !window_outdated (w)) && (XFASTINT (w->column_number_displayed) != current_column ())) w->update_mode_line = 1; @@ -13198,18 +13206,16 @@ redisplay_internal (void) } } else if (EQ (selected_window, minibuf_window) - && (current_buffer->clip_changed - || w->last_modified < MODIFF - || w->last_overlay_modified < OVERLAY_MODIFF) + && (current_buffer->clip_changed || window_outdated (w)) && resize_mini_window (w, 0)) { /* Resized active mini-window to fit the size of what it is showing if its contents might have changed. */ must_finish = 1; -/* FIXME: this causes all frames to be updated, which seems unnecessary - since only the current frame needs to be considered. This function needs - to be rewritten with two variables, consider_all_windows and - consider_all_frames. */ + /* FIXME: this causes all frames to be updated, which seems unnecessary + since only the current frame needs to be considered. This function + needs to be rewritten with two variables, consider_all_windows and + consider_all_frames. */ consider_all_windows_p = 1; ++windows_or_buffers_changed; ++update_mode_lines; @@ -13264,9 +13270,7 @@ redisplay_internal (void) || FETCH_BYTE (BYTEPOS (tlbufpos)) == '\n')) /* Former continuation line has disappeared by becoming empty. */ goto cancel; - else if (w->last_modified < MODIFF - || w->last_overlay_modified < OVERLAY_MODIFF - || MINI_WINDOW_P (w)) + else if (window_outdated (w) || MINI_WINDOW_P (w)) { /* We have to handle the case of continuation around a wide-column character (see the comment in indent.c around @@ -15517,8 +15521,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) = (!NILP (w->window_end_valid) && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p - && w->last_modified >= MODIFF - && w->last_overlay_modified >= OVERLAY_MODIFF); + && !window_outdated (w)); /* Run the window-bottom-change-functions if it is possible that the text on the screen has changed @@ -15540,8 +15543,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) buffer_unchanged_p = (!NILP (w->window_end_valid) && !current_buffer->clip_changed - && w->last_modified >= MODIFF - && w->last_overlay_modified >= OVERLAY_MODIFF); + && !window_outdated (w)); /* When windows_or_buffers_changed is non-zero, we can't rely on the window end being valid, so set it to nil there. */ @@ -15566,9 +15568,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ - && !(PT == w->last_point - && w->last_modified >= MODIFF - && w->last_overlay_modified >= OVERLAY_MODIFF) + && !(PT == w->last_point && !window_outdated (w)) && (XFASTINT (w->column_number_displayed) != current_column ())) update_mode_line = 1; @@ -15810,8 +15810,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) && (CHARPOS (startp) < ZV /* Avoid starting at end of buffer. */ || CHARPOS (startp) == BEGV - || (w->last_modified >= MODIFF - && w->last_overlay_modified >= OVERLAY_MODIFF))) + || !window_outdated (w))) { int d1, d2, d3, d4, d5, d6; -- cgit v1.3 From 4ffea4478002db1df699a563477ec06000628e77 Mon Sep 17 00:00:00 2001 From: Ken Brown Date: Tue, 20 Nov 2012 08:26:40 -0500 Subject: Fix non-GTK builds on Cygwin * src/emacs.c (main): Set the G_SLICE environment variable for all Cygwin builds, not just GTK builds. See https://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00368.html. --- src/ChangeLog | 6 ++++++ src/emacs.c | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index da5a9607903..3836e32fdbc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Ken Brown + + * emacs.c (main): Set the G_SLICE environment variable for all + Cygwin builds, not just GTK builds. See + https://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00368.html. + 2012-11-19 Eli Zaretskii * xdisp.c (start_hourglass) [HAVE_NTGUI]: Don't mix declaration of diff --git a/src/emacs.c b/src/emacs.c index 98e3f11f0cb..f533c3ae983 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -702,7 +702,7 @@ main (int argc, char **argv) stack_base = &dummy; #endif -#if defined (USE_GTK) && defined (G_SLICE_ALWAYS_MALLOC) +#ifdef G_SLICE_ALWAYS_MALLOC /* This is used by the Cygwin build. */ setenv ("G_SLICE", "always-malloc", 1); #endif -- cgit v1.3 From 3b0108c5ba5d2bae34877a7cf499a84f814c22ee Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Nov 2012 19:07:55 +0200 Subject: Yet more fixes for bug #12878 with MSVC build. nt/inc/stdint.h (INTPTR_MIN): Define for MSVC. --- nt/ChangeLog | 4 ++++ nt/inc/stdint.h | 2 ++ 2 files changed, 6 insertions(+) diff --git a/nt/ChangeLog b/nt/ChangeLog index cb63a90bb41..42b04fd5d03 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,7 @@ +2012-11-20 Eli Zaretskii + + * inc/stdint.h (INTPTR_MIN): Define for MSVC. + 2012-11-19 Eli Zaretskii * inc/stdint.h (PTRDIFF_MIN) [!__GNUC__]: Define for MSVC. diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h index edb0469eb87..97c9bbdaee9 100644 --- a/nt/inc/stdint.h +++ b/nt/inc/stdint.h @@ -37,6 +37,7 @@ typedef unsigned __int64 uint64_t; #define INT64_MAX 9223372036854775807i64 #define INT64_MIN (~INT64_MAX) #define INTPTR_MAX INT64_MAX +#define INTPTR_MIN INT64_MIN #define UINTMAX_MAX UINT64_MAX #define UINTMAX_MIN UINT64_MIN #define INTMAX_MAX INT64_MAX @@ -51,6 +52,7 @@ typedef unsigned int uint32_t; #define INT32_MAX 2147483647 #define INT32_MIN (~INT32_MAX) #define INTPTR_MAX INT32_MAX +#define INTPTR_MIN INT32_MIN #define UINTMAX_MAX UINT32_MAX #define UINTMAX_MIN UINT32_MIN #define INTMAX_MAX INT32_MAX -- cgit v1.3 From 9aef4c1281d3adc1a348d802dc3a7d192006ae33 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Nov 2012 19:13:10 +0200 Subject: Fix !ifdef in nmake.defs. nt/nmake.defs: Use !if, not !ifdef. See http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00027.html for the details. --- nt/ChangeLog | 4 ++++ nt/nmake.defs | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index 42b04fd5d03..f11f1fc5fc5 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,5 +1,9 @@ 2012-11-20 Eli Zaretskii + * nmake.defs: Use !if, not !ifdef. See + http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00027.html + for the details. + * inc/stdint.h (INTPTR_MIN): Define for MSVC. 2012-11-19 Eli Zaretskii diff --git a/nt/nmake.defs b/nt/nmake.defs index 48809afc771..16a787ea30a 100644 --- a/nt/nmake.defs +++ b/nt/nmake.defs @@ -116,7 +116,7 @@ RC_INCLUDE = -i USE_CRT_DLL = 1 -!ifdef USE_CRT_DLL +!if USE_CRT_DLL libc = msvcrt$(D).lib EMACS_EXTRA_C_FLAGS= -D_DLL -D_MT -DUSE_CRT_DLL=1 !else -- cgit v1.3 From 7cf95797aff43cb59fec03905a8937d41e68ada1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 20 Nov 2012 19:44:04 +0200 Subject: Fix bug #12927 with scrolling under hl-line-mode and scroll-conservatively. lisp/simple.el (line-move): Don't call line-move-partial if scroll-conservatively is in effect. --- lisp/ChangeLog | 5 +++++ lisp/simple.el | 3 +++ 2 files changed, 8 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 247222bde21..225f296e135 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-20 Eli Zaretskii + + * simple.el (line-move): Don't call line-move-partial if + scroll-conservatively is in effect. (Bug#12927) + 2012-11-20 Michael Albinus * net/trampver.el (tramp-version): Downgrade to 2.2.6-24.3, in diff --git a/lisp/simple.el b/lisp/simple.el index aed945d6e13..5867561da26 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4583,6 +4583,9 @@ lines." (unless (and auto-window-vscroll try-vscroll ;; Only vscroll for single line moves (= (abs arg) 1) + ;; Under scroll-conservatively, the display engine + ;; does this better. + (zerop scroll-conservatively) ;; But don't vscroll in a keyboard macro. (not defining-kbd-macro) (not executing-kbd-macro) -- cgit v1.3 From 3837d988dd8892064c86ee483c6f09b2bacd7604 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 20 Nov 2012 12:54:00 -0500 Subject: * lisp/emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. --- lisp/ChangeLog | 2 ++ lisp/emacs-lisp/byte-run.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4be61545f7f..edb1a65266e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2012-11-20 Stefan Monnier + * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. + * subr.el (called-interactively-p-functions): New var. (internal--called-interactively-p--get-frame): New macro. (called-interactively-p, interactive-p): Rewrite in Lisp. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 06f404d615c..b4582a41d6c 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -88,7 +88,7 @@ The return value of this function is not used." ,(if (eq (car-safe compiler-function) 'lambda) `(lambda ,(append (cadr compiler-function) args) ,@(cddr compiler-function)) - #',compiler-function))))) + `#',compiler-function))))) (list 'doc-string #'(lambda (f _args pos) (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) -- cgit v1.3 From 5d0ccd9509a21ef18e60004a4d46e60a916e4a36 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 20 Nov 2012 14:05:20 -0500 Subject: * lisp/emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures. --- lisp/ChangeLog | 2 ++ lisp/emacs-lisp/bytecomp.el | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index edb1a65266e..910cc3522bd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2012-11-20 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures. + * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. * subr.el (called-interactively-p-functions): New var. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a325e0f3e44..60036c86dc0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2509,8 +2509,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (symbolp form) (unless (memq (car-safe fun) '(closure lambda)) (error "Don't know how to compile %S" fun)) - (setq fun (byte-compile--reify-function fun)) - (setq lexical-binding (eq (car fun) 'closure))) + (setq lexical-binding (eq (car fun) 'closure)) + (setq fun (byte-compile--reify-function fun))) (unless (eq (car-safe fun) 'lambda) (error "Don't know how to compile %S" fun)) ;; Expand macros. -- cgit v1.3 From a16ac13f6299d2610284a6b3fb4231c3279d2e9c Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Tue, 20 Nov 2012 11:28:53 -0800 Subject: Backport: Rename cygwin_convert_path* to cygwin_convert_file_name* --- etc/NEWS | 7 ++++--- lisp/ChangeLog | 6 ++++++ lisp/term/w32-win.el | 5 ++++- src/ChangeLog | 9 +++++++++ src/cygw32.c | 20 +++++++++++--------- src/w32fns.c | 6 +++--- 6 files changed, 37 insertions(+), 16 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 43e760ba330..d9efc57b907 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -988,9 +988,10 @@ takes precedence over most other maps for a short while (normally one key). Pass --with-w32 to configure. The default remains the X11 interface. ** Two new functions are available in Cygwin builds: -`cygwin-convert-path-from-windows' and `cygwin-convert-path-to-windows'. -These functions allow Lisp code to access the Cygwin file-name mapping -machinery to convert between Cygwin and Windows-native file names. +`cygwin-convert-file-name-from-windows' and +`cygwin-convert-file-name-to-windows'. These functions allow Lisp +code to access the Cygwin file-name mapping machinery to convert +between Cygwin and Windows-native file and directory names. ** When invoked with the -nw switch to run on the Windows text-mode terminal, Emacs now supports mouse highlight, help-echo (in the echo area), and diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 225f296e135..8502cd477e9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Daniel Colascione + + * term/w32-win.el (cygwin-convert-path-from-windows): Accomodate + rename of cygwin_convert_path* to cygwin_convert_file_name*. + This change is a backport from trunk. + 2012-11-20 Eli Zaretskii * simple.el (line-move): Don't call line-move-partial if diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index ad6e1125027..3f8a66843e4 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -91,6 +91,9 @@ (declare-function w32-send-sys-command "w32fns.c") (declare-function set-message-beep "w32fns.c") +(declare-function cygwin-convert-file-name-from-windows "cygw32.c" + (path &optional absolute_p)) + ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles (if (fboundp 'new-fontset) (require 'fontset)) @@ -105,7 +108,7 @@ (defun w32-handle-dropped-file (window file-name) (let ((f (if (eq system-type 'cygwin) - (cygwin-convert-path-from-windows file-name t) + (cygwin-convert-file-name-from-windows file-name t) (subst-char-in-string ?\\ ?/ file-name))) (coding (or file-name-coding-system default-file-name-coding-system))) diff --git a/src/ChangeLog b/src/ChangeLog index 3836e32fdbc..f7cb0fe850f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2012-11-20 Daniel Colascione + + * w32fns.c (Fx_file_dialog): + (Fx_file_dialog): Accomodate rename of cygwin_convert_path* to + cygwin_convert_file_name*. + + * cygw32.c (Fcygwin_convert_path_to_windows, syms_of_cygw32): + Rename cygwin_convert_path* to cygwin_convert_file_name*. + 2012-11-20 Ken Brown * emacs.c (main): Set the G_SLICE environment variable for all diff --git a/src/cygw32.c b/src/cygw32.c index 54f2076a891..d9777d5e22e 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -106,22 +106,24 @@ conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p) return unbind_to (count, DECODE_FILE (converted)); } -DEFUN ("cygwin-convert-path-to-windows", - Fcygwin_convert_path_to_windows, Scygwin_convert_path_to_windows, +DEFUN ("cygwin-convert-file-name-to-windows", + Fcygwin_convert_file_name_to_windows, + Scygwin_convert_file_name_to_windows, 1, 2, 0, - doc: /* Convert PATH to a Windows path. If ABSOLUTE-P if - non-nil, return an absolute path.*/) + doc: /* Convert PATH to a Windows path. If ABSOLUTE-P is +non-nil, return an absolute path.*/) (Lisp_Object path, Lisp_Object absolute_p) { return from_unicode ( conv_filename_to_w32_unicode (path, EQ (absolute_p, Qnil) ? 0 : 1)); } -DEFUN ("cygwin-convert-path-from-windows", - Fcygwin_convert_path_from_windows, Scygwin_convert_path_from_windows, +DEFUN ("cygwin-convert-file-name-from-windows", + Fcygwin_convert_file_name_from_windows, + Scygwin_convert_file_name_from_windows, 1, 2, 0, doc: /* Convert a Windows path to a Cygwin path. If ABSOLUTE-P - if non-nil, return an absolute path.*/) +is non-nil, return an absolute path.*/) (Lisp_Object path, Lisp_Object absolute_p) { return conv_filename_from_w32_unicode (to_unicode (path, &path), @@ -131,6 +133,6 @@ DEFUN ("cygwin-convert-path-from-windows", void syms_of_cygw32 (void) { - defsubr (&Scygwin_convert_path_from_windows); - defsubr (&Scygwin_convert_path_to_windows); + defsubr (&Scygwin_convert_file_name_from_windows); + defsubr (&Scygwin_convert_file_name_to_windows); } diff --git a/src/w32fns.c b/src/w32fns.c index aa120d59ce5..d598d66b3a5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6151,9 +6151,9 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) filename = empty_unibyte_string; #ifdef CYGWIN - dir = Fcygwin_convert_path_to_windows (dir, Qt); + dir = Fcygwin_convert_file_name_to_windows (dir, Qt); if (SCHARS (filename) > 0) - filename = Fcygwin_convert_path_to_windows (filename, Qnil); + filename = Fcygwin_convert_file_name_to_windows (filename, Qnil); #endif CHECK_STRING (dir); @@ -6254,7 +6254,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) #endif /* NTGUI_UNICODE */ #ifdef CYGWIN - filename = Fcygwin_convert_path_from_windows (filename, Qt); + filename = Fcygwin_convert_file_name_from_windows (filename, Qt); #endif /* CYGWIN */ /* Strip the dummy filename off the end of the string if we -- cgit v1.3 From 8b62d7427e12bbf07ab3454cc061a6b43ded56dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 20 Nov 2012 14:30:37 -0500 Subject: * lisp/emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding. (trace-buffer): Don't purecopy. (trace-entry-message, trace-exit-message): Add `context' arg. (trace--timer): New var. (trace-make-advice): Adjust for use in nadvice. Add `context' argument. Delay `display-buffer' via a timer. (trace-function-internal): Use advice-add. (trace--read-args): New function. (trace-function-foreground, trace-function-background): Use it. (trace-function): Rename to trace-function-foreground and redefine as an alias to that new name. (untrace-function, untrace-all): Adjust to the use of nadvice. --- etc/NEWS | 9 +++ lisp/ChangeLog | 13 +++ lisp/emacs-lisp/trace.el | 206 ++++++++++++++++++++++++++--------------------- 3 files changed, 136 insertions(+), 92 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b63d3f8d538..6ef093991ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -32,6 +32,15 @@ so we will look at it and add it to the manual. +++ ** New function `ses-rename-cell' to give SES cells arbitrary names. +** trace-function was largely rewritten. +New features include: +- no prompting for the destination buffer, unless a prefix-arg was used. +- additionally to prompting for a destination buffer, when a prefix-arg is + used, the user can enter a "context", i.e. Lisp expression whose value at the + time the function is entered/exited will be printed along with the function + name and arguments. Useful to trace the value of (current-buffer) or + (point) when the function is invoked. + * New Modes and Packages in Emacs 24.4 ** New nadvice.el package offering lighter-weight advice facilities. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 910cc3522bd..c2d1b58b6ec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,18 @@ 2012-11-20 Stefan Monnier + * emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding. + (trace-buffer): Don't purecopy. + (trace-entry-message, trace-exit-message): Add `context' arg. + (trace--timer): New var. + (trace-make-advice): Adjust for use in nadvice. + Add `context' argument. Delay `display-buffer' via a timer. + (trace-function-internal): Use advice-add. + (trace--read-args): New function. + (trace-function-foreground, trace-function-background): Use it. + (trace-function): Rename to trace-function-foreground and redefine as + an alias to that new name. + (untrace-function, untrace-all): Adjust to the use of nadvice. + * emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures. * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index c6fff7aa443..722e6270e95 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -1,4 +1,4 @@ -;;; trace.el --- tracing facility for Emacs Lisp functions +;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*- ;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc. @@ -151,18 +151,15 @@ ;;; Code: -(require 'advice) - (defgroup trace nil "Tracing facility for Emacs Lisp functions." :prefix "trace-" :group 'lisp) ;;;###autoload -(defcustom trace-buffer (purecopy "*trace-output*") +(defcustom trace-buffer "*trace-output*" "Trace output will by default go to that buffer." - :type 'string - :group 'trace) + :type 'string) ;; Current level of traced function invocation: (defvar trace-level 0) @@ -176,78 +173,109 @@ (defvar inhibit-trace nil "If non-nil, all tracing is temporarily inhibited.") -(defun trace-entry-message (function level argument-bindings) - ;; Generates a string that describes that FUNCTION has been entered at - ;; trace LEVEL with ARGUMENT-BINDINGS. - (format "%s%s%d -> %s: %s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - (let ((print-circle t)) - (mapconcat (lambda (binding) - (concat - (symbol-name (ad-arg-binding-field binding 'name)) - "=" - ;; do this so we'll see strings: - (prin1-to-string - (ad-arg-binding-field binding 'value)))) - argument-bindings - " ")))) - -(defun trace-exit-message (function level value) - ;; Generates a string that describes that FUNCTION has been exited at - ;; trace LEVEL and that it returned VALUE. - (format "%s%s%d <- %s: %s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - ;; do this so we'll see strings: - (let ((print-circle t)) (prin1-to-string value)))) - -(defun trace-make-advice (function buffer background) - ;; Builds the piece of advice to be added to FUNCTION's advice info - ;; so that it will generate the proper trace output in BUFFER - ;; (quietly if BACKGROUND is t). - (ad-make-advice - trace-advice-name nil t - `(advice - lambda () - (let ((trace-level (1+ trace-level)) - (trace-buffer (get-buffer-create ,buffer))) - (unless inhibit-trace - (with-current-buffer trace-buffer - (set (make-local-variable 'window-point-insertion-type) t) - ,(unless background '(display-buffer trace-buffer)) - (goto-char (point-max)) - ;; Insert a separator from previous trace output: - (if (= trace-level 1) (insert trace-separator)) - (insert - (trace-entry-message - ',function trace-level ad-arg-bindings)))) - ad-do-it - (unless inhibit-trace - (with-current-buffer trace-buffer - ,(unless background '(display-buffer trace-buffer)) - (goto-char (point-max)) - (insert - (trace-exit-message - ',function trace-level ad-return-value)))))))) - -(defun trace-function-internal (function buffer background) - ;; Adds trace advice for FUNCTION and activates it. - (ad-add-advice - function - (trace-make-advice function (or buffer trace-buffer) background) - 'around 'last) - (ad-activate function nil)) +(defun trace-entry-message (function level args context) + "Generate a string that describes that FUNCTION has been entered. +LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, +and CONTEXT is a string describing the dynamic context (e.g. values of +some global variables)." + (let ((print-circle t)) + (format "%s%s%d -> %S%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + (cons function args) + context))) + +(defun trace-exit-message (function level value context) + "Generate a string that describes that FUNCTION has exited. +LEVEL is the trace level, VALUE value returned by FUNCTION, +and CONTEXT is a string describing the dynamic context (e.g. values of +some global variables)." + (let ((print-circle t)) + (format "%s%s%d <- %s: %S%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + function + ;; Do this so we'll see strings: + value + context))) + +(defvar trace--timer nil) + +(defun trace-make-advice (function buffer background context) + "Build the piece of advice to be added to trace FUNCTION. +FUNCTION is the name of the traced function. +BUFFER is the buffer where the trace should be printed. +BACKGROUND if nil means to display BUFFER. +CONTEXT if non-nil should be a function that returns extra info that should +be printed along with the arguments in the trace." + (lambda (body &rest args) + (let ((trace-level (1+ trace-level)) + (trace-buffer (get-buffer-create buffer)) + (ctx (funcall context))) + (unless inhibit-trace + (with-current-buffer trace-buffer + (set (make-local-variable 'window-point-insertion-type) t) + (unless (or background trace--timer + (get-buffer-window trace-buffer 'visible)) + (setq trace--timer + ;; Postpone the display to some later time, in case we + ;; can't actually do it now. + (run-with-timer 0 nil + (lambda () + (setq trace--timer nil) + (display-buffer trace-buffer))))) + (goto-char (point-max)) + ;; Insert a separator from previous trace output: + (if (= trace-level 1) (insert trace-separator)) + (insert + (trace-entry-message + function trace-level args ctx)))) + (let ((result)) + (unwind-protect + (setq result (list (apply body args))) + (unless inhibit-trace + (let ((ctx (funcall context))) + (with-current-buffer trace-buffer + (unless background (display-buffer trace-buffer)) + (goto-char (point-max)) + (insert + (trace-exit-message + function + trace-level + (if result (car result) '\!non-local\ exit\!) + ctx)))))) + (car result))))) + +(defun trace-function-internal (function buffer background context) + "Add trace advice for FUNCTION." + (advice-add + function :around + (trace-make-advice function (or buffer trace-buffer) background + (or context (lambda () ""))) + `((name . ,trace-advice-name)))) (defun trace-is-traced (function) - (ad-find-advice function 'around trace-advice-name)) + (advice-member-p trace-advice-name function)) + +(defun trace--read-args (prompt) + (cons + (intern (completing-read prompt obarray 'fboundp t)) + (when current-prefix-arg + (list + (read-buffer "Output to buffer: " trace-buffer) + (let ((exp + (let ((minibuffer-completing-symbol t)) + (read-from-minibuffer "Context expression: " + nil read-expression-map t + 'read-expression-history)))) + `(lambda () + (let ((print-circle t)) + (concat " [" (prin1-to-string ,exp) "]")))))))) ;;;###autoload -(defun trace-function (function &optional buffer) +(defun trace-function-foreground (function &optional buffer context) "Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the @@ -255,14 +283,11 @@ trace advice for FUNCTION and activates it together with any other advice there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead." - (interactive - (list - (intern (completing-read "Trace function: " obarray 'fboundp t)) - (read-buffer "Output to buffer: " trace-buffer))) - (trace-function-internal function buffer nil)) + (interactive (trace--read-args "Trace function: ")) + (trace-function-internal function buffer nil context)) ;;;###autoload -(defun trace-function-background (function &optional buffer) +(defun trace-function-background (function &optional buffer context) "Traces FUNCTION with trace output going quietly to BUFFER. When this tracing is enabled, every call to FUNCTION writes a Lisp-style trace message (showing the arguments and return value) @@ -272,12 +297,11 @@ The trace output goes to BUFFER quietly, without changing the window or buffer configuration. BUFFER defaults to `trace-buffer'." - (interactive - (list - (intern - (completing-read "Trace function in background: " obarray 'fboundp t)) - (read-buffer "Output to buffer: " trace-buffer))) - (trace-function-internal function buffer t)) + (interactive (trace--read-args "Trace function in background: ")) + (trace-function-internal function buffer t context)) + +;;;###autoload +(defalias 'trace-function 'trace-function-foreground) (defun untrace-function (function) "Untraces FUNCTION and possibly activates all remaining advice. @@ -285,16 +309,14 @@ Activation is performed with `ad-update', hence remaining advice will get activated only if the advice of FUNCTION is currently active. If FUNCTION was not traced this is a noop." (interactive - (list (ad-read-advised-function "Untrace function" 'trace-is-traced))) - (when (trace-is-traced function) - (ad-remove-advice function 'around trace-advice-name) - (ad-update function))) + (list (intern (completing-read "Untrace function: " + obarray #'trace-is-traced t)))) + (advice-remove function trace-advice-name)) (defun untrace-all () "Untraces all currently traced functions." (interactive) - (ad-do-advised-functions (function) - (untrace-function function))) + (mapatoms #'untrace-function)) (provide 'trace) -- cgit v1.3 From 2e31777bd1354d22319cf6de4085ccc362cff42c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 20 Nov 2012 14:32:20 -0500 Subject: * lisp/uniquify.el (uniquify-managed): Use defvar-local. (rename-buffer, create-file-buffer): Advise with advice-add. (uniquify-unload-function): Unadvise accordingly. --- lisp/ChangeLog | 4 ++++ lisp/uniquify.el | 29 +++++++++++++++++------------ 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c2d1b58b6ec..3e35c8a9fcb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2012-11-20 Stefan Monnier + * uniquify.el (uniquify-managed): Use defvar-local. + (rename-buffer, create-file-buffer): Advise with advice-add. + (uniquify-unload-function): Unadvise accordingly. + * emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding. (trace-buffer): Don't purecopy. (trace-entry-message, trace-exit-message): Add `context' arg. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 3619d499419..2b4794c9cc2 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -183,10 +183,9 @@ contains the name of the directory which the buffer is visiting.") ;; Internal variables used free (defvar uniquify-possibly-resolvable nil) -(defvar uniquify-managed nil +(defvar-local uniquify-managed nil "Non-nil if the name of this buffer is managed by uniquify. It actually holds the list of `uniquify-item's corresponding to the conflict.") -(make-variable-buffer-local 'uniquify-managed) (put 'uniquify-managed 'permanent-local t) ;; Used in desktop.el to save the non-uniquified buffer name @@ -464,27 +463,34 @@ For use on `kill-buffer-hook'." ;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't ;; sufficient.) -(defadvice rename-buffer (after rename-buffer-uniquify activate) +(advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice) +(defun uniquify--rename-buffer-advice (rb-fun newname &optional unique &rest args) "Uniquify buffer names with parts of directory name." + (let ((retval (apply rb-fun newname unique args))) (uniquify-maybe-rerationalize-w/o-cb) - (if (null (ad-get-arg 1)) ; no UNIQUE argument. + (if (null unique) ;; Mark this buffer so it won't be renamed by uniquify. (setq uniquify-managed nil) (when uniquify-buffer-name-style ;; Rerationalize w.r.t the new name. (uniquify-rationalize-file-buffer-names - (ad-get-arg 0) + newname (uniquify-buffer-file-name (current-buffer)) (current-buffer)) - (setq ad-return-value (buffer-name (current-buffer)))))) + (setq retval (buffer-name (current-buffer))))) + retval)) -(defadvice create-file-buffer (after create-file-buffer-uniquify activate) + +(advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice) +(defun uniquify--create-file-buffer-advice (cfb-fun filename &rest args) "Uniquify buffer names with parts of directory name." + (let ((retval (apply cfb-fun filename args))) (if uniquify-buffer-name-style - (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0))))) + (let ((filename (expand-file-name (directory-file-name filename)))) (uniquify-rationalize-file-buffer-names (file-name-nondirectory filename) - (file-name-directory filename) ad-return-value)))) + (file-name-directory filename) retval))) + retval)) ;;; The End @@ -496,9 +502,8 @@ For use on `kill-buffer-hook'." (set-buffer buf) (when uniquify-managed (push (cons buf (uniquify-item-base (car uniquify-managed))) buffers))) - (dolist (fun '(rename-buffer create-file-buffer)) - (ad-remove-advice fun 'after (intern (concat (symbol-name fun) "-uniquify"))) - (ad-update fun)) + (advice-remove 'rename-buffer #'uniquify--rename-buffer-advice) + (advice-remove 'create-file-buffer #'uniquify--create-file-buffer-advice) (dolist (buf buffers) (set-buffer (car buf)) (rename-buffer (cdr buf) t)))) -- cgit v1.3 From eadf1faa3cb5eea8c25a5166a9a97ebd63525c56 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 20 Nov 2012 15:06:17 -0500 Subject: Conflate Qnil and Qunbound for `symbol-function'. * src/alloc.c (Fmake_symbol): Initialize `function' to Qnil. * src/lread.c (init_obarray): Set `function' fields to Qnil. * src/eval.c (Fcommandp): Ignore Qunbound. (Fautoload, eval_sub, Fapply, Ffuncall, Fmacroexpand): * src/data.c (Ffset, Ffboundp, indirect_function, Findirect_function): Test NILP rather than Qunbound. (Ffmakunbound): Set to Qnil. (Fsymbol_function): Never signal an error. (Finteractive_form): Ignore Qunbound. --- etc/NEWS | 4 ++++ src/ChangeLog | 13 +++++++++++++ src/alloc.c | 4 ++-- src/data.c | 21 ++++++++++----------- src/eval.c | 24 ++++++++++++------------ src/lisp.h | 2 +- src/lread.c | 3 ++- 7 files changed, 44 insertions(+), 27 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6ef093991ae..a66a3858e0e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -52,6 +52,10 @@ It is layered as: * Incompatible Lisp Changes in Emacs 24.4 +** nil and "unbound" are indistinguishable in symbol-function. +`symbol-function' never signals `void-function' any more. +`fboundp' returns non-nil if the symbol was `fset' to nil. + ** `defadvice' does not honor the `freeze' flag and cannot advise special-forms any more. diff --git a/src/ChangeLog b/src/ChangeLog index 9a2cec8a7fc..332656fcf00 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2012-11-20 Stefan Monnier + + Conflate Qnil and Qunbound for `symbol-function'. + * alloc.c (Fmake_symbol): Initialize `function' to Qnil. + * lread.c (init_obarray): Set `function' fields to Qnil. + * eval.c (Fcommandp): Ignore Qunbound. + (Fautoload, eval_sub, Fapply, Ffuncall, Fmacroexpand): + * data.c (Ffset, Ffboundp, indirect_function, Findirect_function): + Test NILP rather than Qunbound. + (Ffmakunbound): Set to Qnil. + (Fsymbol_function): Never signal an error. + (Finteractive_form): Ignore Qunbound. + 2012-11-20 Paul Eggert * eval.c (interactive_p): Remove no-longer-used decl. diff --git a/src/alloc.c b/src/alloc.c index a66a752f5dc..22e3db3cc77 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3212,7 +3212,7 @@ static struct Lisp_Symbol *symbol_free_list; DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, doc: /* Return a newly allocated uninterned symbol whose name is NAME. -Its value and function definition are void, and its property list is nil. */) +Its value is void, and its function definition and property list are nil. */) (Lisp_Object name) { register Lisp_Object val; @@ -3249,7 +3249,7 @@ Its value and function definition are void, and its property list is nil. */) set_symbol_plist (val, Qnil); p->redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (p, Qunbound); - set_symbol_function (val, Qunbound); + set_symbol_function (val, Qnil); set_symbol_next (val, NULL); p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; diff --git a/src/data.c b/src/data.c index 09899400b68..5fc6afaaa03 100644 --- a/src/data.c +++ b/src/data.c @@ -543,12 +543,13 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, return (EQ (valcontents, Qunbound) ? Qnil : Qt); } +/* FIXME: Make it an alias for function-symbol! */ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, doc: /* Return t if SYMBOL's function definition is not void. */) (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt; + return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; } DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, @@ -564,14 +565,14 @@ Return SYMBOL. */) } DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, - doc: /* Make SYMBOL's function definition be void. + doc: /* Make SYMBOL's function definition be nil. Return SYMBOL. */) (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) xsignal1 (Qsetting_constant, symbol); - set_symbol_function (symbol, Qunbound); + set_symbol_function (symbol, Qnil); return symbol; } @@ -580,9 +581,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - if (!EQ (XSYMBOL (symbol)->function, Qunbound)) return XSYMBOL (symbol)->function; - xsignal1 (Qvoid_function, symbol); } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, @@ -613,7 +612,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, function = XSYMBOL (symbol)->function; - if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) + if (!NILP (Vautoload_queue) && !NILP (function)) Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); if (AUTOLOADP (function)) @@ -714,7 +713,7 @@ Value, if non-nil, is a list \(interactive SPEC). */) { Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ - if (NILP (fun) || EQ (fun, Qunbound)) + if (NILP (fun)) return Qnil; /* Use an `interactive-form' property if present, analogous to the @@ -2008,10 +2007,10 @@ indirect_function (register Lisp_Object object) for (;;) { - if (!SYMBOLP (hare) || EQ (hare, Qunbound)) + if (!SYMBOLP (hare) || NILP (hare)) break; hare = XSYMBOL (hare)->function; - if (!SYMBOLP (hare) || EQ (hare, Qunbound)) + if (!SYMBOLP (hare) || NILP (hare)) break; hare = XSYMBOL (hare)->function; @@ -2038,10 +2037,10 @@ function chain of symbols. */) /* Optimize for no indirection. */ result = object; - if (SYMBOLP (result) && !EQ (result, Qunbound) + if (SYMBOLP (result) && !NILP (result) && (result = XSYMBOL (result)->function, SYMBOLP (result))) result = indirect_function (result); - if (!EQ (result, Qunbound)) + if (!NILP (result)) return result; if (NILP (noerror)) diff --git a/src/eval.c b/src/eval.c index 053b1a7f097..34b20f6fc8e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -875,7 +875,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) if (NILP (tem)) { def = XSYMBOL (sym)->function; - if (!EQ (def, Qunbound)) + if (!NILP (def)) continue; } break; @@ -890,7 +890,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) GCPRO1 (form); def = Fautoload_do_load (def, sym, Qmacro); UNGCPRO; - if (EQ (def, Qunbound) || !CONSP (def)) + if (!CONSP (def)) /* Not defined or definition not suitable. */ break; if (!EQ (XCAR (def), Qmacro)) @@ -1715,12 +1715,12 @@ then strings and vectors are not accepted. */) fun = function; - fun = indirect_function (fun); /* Check cycles. */ - if (NILP (fun) || EQ (fun, Qunbound)) + fun = indirect_function (fun); /* Check cycles. */ + if (NILP (fun)) return Qnil; /* Check an `interactive-form' property if present, analogous to the - function-documentation property. */ + function-documentation property. */ fun = function; while (SYMBOLP (fun)) { @@ -1780,7 +1780,7 @@ this does nothing and returns nil. */) CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if (!EQ (XSYMBOL (function)->function, Qunbound) + if (!NILP (XSYMBOL (function)->function) && !AUTOLOADP (XSYMBOL (function)->function)) return Qnil; @@ -1959,7 +1959,7 @@ eval_sub (Lisp_Object form) /* Optimize for no indirection. */ fun = original_fun; - if (SYMBOLP (fun) && !EQ (fun, Qunbound) + if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); @@ -2081,7 +2081,7 @@ eval_sub (Lisp_Object form) val = apply_lambda (fun, original_args); else { - if (EQ (fun, Qunbound)) + if (NILP (fun)) xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) xsignal1 (Qinvalid_function, original_fun); @@ -2155,10 +2155,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) numargs += nargs - 2; /* Optimize for no indirection. */ - if (SYMBOLP (fun) && !EQ (fun, Qunbound) + if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); - if (EQ (fun, Qunbound)) + if (NILP (fun)) { /* Let funcall get the error. */ fun = args[0]; @@ -2632,7 +2632,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ fun = original_fun; - if (SYMBOLP (fun) && !EQ (fun, Qunbound) + if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); @@ -2720,7 +2720,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) val = funcall_lambda (fun, numargs, args + 1); else { - if (EQ (fun, Qunbound)) + if (NILP (fun)) xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) xsignal1 (Qinvalid_function, original_fun); diff --git a/src/lisp.h b/src/lisp.h index 67ae28a488f..4817c6eb990 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1104,7 +1104,7 @@ struct Lisp_Symbol union Lisp_Fwd *fwd; } val; - /* Function value of the symbol or Qunbound if not fboundp. */ + /* Function value of the symbol or Qnil if not fboundp. */ Lisp_Object function; /* The symbol's property list. */ diff --git a/src/lread.c b/src/lread.c index 5859a2f85a9..6d0ff9f780e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3957,12 +3957,13 @@ init_obarray (void) /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, so those two need to be fixed manually. */ SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); - set_symbol_function (Qunbound, Qunbound); + set_symbol_function (Qunbound, Qnil); set_symbol_plist (Qunbound, Qnil); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); XSYMBOL (Qnil)->constant = 1; XSYMBOL (Qnil)->declared_special = 1; set_symbol_plist (Qnil, Qnil); + set_symbol_function (Qnil, Qnil); Qt = intern_c_string ("t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); -- cgit v1.3 From 1b3b7caa0c1fd99dada144640d7fdaad2b06081b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 20:22:09 -0500 Subject: * configure.ac (--enable-profiling): Doc fix. --- ChangeLog | 4 ++++ configure.ac | 9 +++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index a139c0dfb6d..39f9b31bf5b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-11-21 Glenn Morris + + * configure.ac (--enable-profiling): Doc fix. + 2012-11-03 Eli Zaretskii * config.bat: Copy lib/execinfo.in.h to lib/execinfo.in-h if needed. diff --git a/configure.ac b/configure.ac index 4564bc3085e..3246372ca48 100644 --- a/configure.ac +++ b/configure.ac @@ -329,10 +329,15 @@ if test "${enableval}" != "no"; then fi) +dnl The name of this option is unfortunate. It predates, and has no +dnl relation to, the "sampling-based elisp profiler" added in 24.3. +dnl Actually, it stops it working. +dnl http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00393.html AC_ARG_ENABLE(profiling, [AS_HELP_STRING([--enable-profiling], - [build emacs with profiling support. - This might not work on all platforms])], + [build emacs with low-level, gprof profiling support. + Mainly useful for debugging Emacs itself. May not work on + all platforms. Stops profiler.el working.])], [ac_enable_profiling="${enableval}"],[]) if test x$ac_enable_profiling != x ; then PROFILING_CFLAGS="-DPROFILING=1 -pg" -- cgit v1.3 From 38a2f91778682f903416137d36bab29251dd1db2 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 20:32:09 -0500 Subject: * doc/lispref/debugging.texi (Profiling) [!tex]: Mention --enable-profiling. --- doc/lispref/ChangeLog | 4 ++++ doc/lispref/debugging.texi | 11 +++++++++++ 2 files changed, 15 insertions(+) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 9d71d4b4420..cda6ed27837 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2012-11-21 Glenn Morris + + * debugging.texi (Profiling) [!tex]: Mention --enable-profiling. + 2012-11-20 Glenn Morris * debugging.texi (Profiling): New section, in progress. diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 4450d177896..ef1342ea289 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -849,3 +849,14 @@ The @file{elp} library offers an alternative approach. See the file You can check the speed of individual Emacs Lisp forms using the @file{benchmark} library. See the functions @code{benchmark-run} and @code{benchmark-run-compiled} in @file{benchmark.el}. + +@c Not worth putting in the printed manual. +@ifnottex +@cindex --enable-profiling option of configure +For low-level profiling of Emacs itself, you can build it using the +@option{--enable-profiling} option of @command{configure}. When Emacs +exits, it generates a file @file{gmon.out} that you can examine using +the @command{gprof} utility. This feature is mainly useful for +debugging Emacs. It actually stops the Lisp-level @kbd{M-x +profiler-@dots{}} commands described above from working. +@end ifnottex -- cgit v1.3 From b6729a180f4b81ac26bd7b61f5330643b2d5e994 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 20 Nov 2012 20:52:03 -0500 Subject: Add a bit more about profiling to the lispref * doc/lispref/debugging.texi (Profiling): Add some basic information about the profile report buffer. (Debugging): Mention profiling in the introduction. --- doc/lispref/ChangeLog | 4 +++- doc/lispref/debugging.texi | 19 ++++++++++++++++--- 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index cda6ed27837..b5bbd8ef93f 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,6 +1,8 @@ 2012-11-21 Glenn Morris - * debugging.texi (Profiling) [!tex]: Mention --enable-profiling. + * debugging.texi (Profiling): Mention --enable-profiling (if !tex). + Add some basic information about the profile report buffer. + (Debugging): Mention profiling in the introduction. 2012-11-20 Glenn Morris diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index ef1342ea289..3439a8ae152 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -32,6 +32,9 @@ program. @item You can use the ERT package to write regression tests for the program. @xref{Top,the ERT manual,, ERT, ERT: Emacs Lisp Regression Testing}. + +@item +You can profile the program to get hints about how to make it more efficient. @end itemize Other useful tools for debugging input and output problems are the @@ -834,10 +837,20 @@ generate another report later on without erasing previous results. When you have finished profiling, type @kbd{M-x profiler-stop} (there is a small overhead associated with profiling). -@c FIXME -@c Basic apperance of the report buffer: +The profiler report buffer shows, on each line, a function that was +called, followed by how much resource (processor or memory) it used in +absolute and percentage times since profiling started. If a given +line has a @samp{+} symbol at the left-hand side, you can expand that +line by typing @key{RET}, in order to see the function(s) called by +the higher-level function. Pressing @key{RET} again will collapse +back to the original state. + +Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function. +Press @kbd{d} to view a function's documentation. +You can save a profile to a file using @kbd{C-x C-w}. +You can compare two profiles using @kbd{=}. -@c The following commands are available in the report buffer: +@c FIXME reversed calltree? @cindex @file{elp.el} @cindex timing programs -- cgit v1.3 From 3ca2f1bf25b46877497c34c70b36dd511678e29b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 21 Nov 2012 00:27:13 -0800 Subject: Remove -p suffix from set-face-* functions * lisp/faces.el (set-face-inverse-video, set-face-bold, set-face-italic): Remove -p suffix from names, for consistency with other set-face-*. (set-face-inverse-video): Fix interactive spec. * lisp/play/gamegrid.el (gamegrid-make-mono-tty-face): * lisp/textmodes/table.el (table--update-cell-face): Use set-face-inverse-video rather than now obsolete alias. * doc/lispref/display.texi (Attribute Functions): Update for set-face-* name changes. --- doc/lispref/ChangeLog | 3 +++ doc/lispref/display.texi | 6 +++--- lisp/ChangeLog | 9 +++++++++ lisp/faces.el | 17 ++++++++++------- lisp/play/gamegrid.el | 2 +- lisp/textmodes/table.el | 2 +- 6 files changed, 27 insertions(+), 12 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index db896984c86..9dee3797bdd 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,5 +1,8 @@ 2012-11-21 Glenn Morris + * display.texi (Attribute Functions): + Update for set-face-* name changes. + * debugging.texi (Profiling): New section. (Debugging): Mention profiling in the introduction. * tips.texi (Compilation Tips): Move profiling to separate section. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 475a9550f99..0932e8ceac2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2425,12 +2425,12 @@ This sets the @code{:stipple} attribute of @var{face} to This sets the @code{:font} attribute of @var{face} to @var{font}. @end deffn -@defun set-face-bold-p face bold-p &optional frame +@defun set-face-bold face bold-p &optional frame This sets the @code{:weight} attribute of @var{face} to @var{normal} if @var{bold-p} is @code{nil}, and to @var{bold} otherwise. @end defun -@defun set-face-italic-p face italic-p &optional frame +@defun set-face-italic face italic-p &optional frame This sets the @code{:slant} attribute of @var{face} to @var{normal} if @var{italic-p} is @code{nil}, and to @var{italic} otherwise. @end defun @@ -2440,7 +2440,7 @@ This sets the @code{:underline} attribute of @var{face} to @var{underline}. @end defun -@defun set-face-inverse-video-p face inverse-video-p &optional frame +@defun set-face-inverse-video face inverse-video-p &optional frame This sets the @code{:inverse-video} attribute of @var{face} to @var{inverse-video-p}. @end defun diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 05f86ca22c0..19268a4f860 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-11-21 Glenn Morris + + * faces.el (set-face-inverse-video, set-face-bold, set-face-italic): + Remove -p suffix from names, for consistency with other set-face-*. + (set-face-inverse-video): Fix interactive spec. + * play/gamegrid.el (gamegrid-make-mono-tty-face): + * textmodes/table.el (table--update-cell-face): + Use set-face-inverse-video rather than now obsolete alias. + 2012-11-21 Eli Zaretskii * simple.el (line-move): Don't call line-move-partial if diff --git a/lisp/faces.el b/lisp/faces.el index 9e0ca962499..cb3470c167d 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -862,7 +862,7 @@ Use `set-face-attribute' to ``unspecify'' underlining." 'set-face-underline "24.3") -(defun set-face-inverse-video-p (face inverse-video-p &optional frame) +(defun set-face-inverse-video (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video. INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video. @@ -870,14 +870,13 @@ FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' the inverse video attribute." (interactive (let ((list (read-face-and-attribute :inverse-video))) - (list (car list) (eq (car (cdr list)) t)))) + (list (car list) (if (cadr list) t)))) (set-face-attribute face frame :inverse-video inverse-video-p)) +(define-obsolete-function-alias 'set-face-inverse-video-p + 'set-face-inverse-video "24.4") -;; The -p suffix is a hostage to fortune. What if we want to extend -;; this to allow more than boolean options? Exactly this happened -;; to set-face-underline-p. -(defun set-face-bold-p (face bold-p &optional frame) +(defun set-face-bold (face bold-p &optional frame) "Specify whether face FACE is bold. BOLD-P non-nil means FACE should explicitly display bold. BOLD-P nil means FACE should explicitly display non-bold. @@ -887,8 +886,10 @@ Use `set-face-attribute' or `modify-face' for finer control." (make-face-unbold face frame) (make-face-bold face frame))) +(define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4") -(defun set-face-italic-p (face italic-p &optional frame) + +(defun set-face-italic (face italic-p &optional frame) "Specify whether face FACE is italic. ITALIC-P non-nil means FACE should explicitly display italic. ITALIC-P nil means FACE should explicitly display non-italic. @@ -898,6 +899,8 @@ Use `set-face-attribute' or `modify-face' for finer control." (make-face-unitalic face frame) (make-face-italic face frame))) +(define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4") + (defalias 'set-face-background-pixmap 'set-face-stipple) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index a3ea4af4651..8af877c7843 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -175,7 +175,7 @@ static unsigned char gamegrid_bits[] = { (defun gamegrid-make-mono-tty-face () (let ((face (make-face 'gamegrid-mono-tty-face))) - (set-face-inverse-video-p face t) + (set-face-inverse-video face t) face)) (defun gamegrid-make-color-tty-face (color) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 3d9f88a43c9..6db15b7ec2a 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -5210,7 +5210,7 @@ instead of the current buffer and returns the OBJECT." "Update cell face according to the current mode." (if (featurep 'xemacs) (set-face-property 'table-cell 'underline table-fixed-width-mode) - (set-face-inverse-video-p 'table-cell table-fixed-width-mode))) + (set-face-inverse-video 'table-cell table-fixed-width-mode))) (table--update-cell-face) -- cgit v1.3 From 1bf335cf4327486931b6d4fe42fe1bd3c14406cf Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 21 Nov 2012 00:39:08 -0800 Subject: Add optional "inherit" argument for face-bold-p and related functions * lisp/faces.el (face-underline-p, face-inverse-video-p, face-bold-p) (face-italic-p): Add optional argument "inherit". * doc/lispref/display.texi (Attribute Functions): Add new "inherit" argument for face-bold-p etc. Move description of this argument to a common section, like "frame". --- doc/lispref/ChangeLog | 2 ++ doc/lispref/display.texi | 41 +++++++++++++++-------------------------- lisp/ChangeLog | 3 +++ lisp/faces.el | 30 +++++++++++++++--------------- 4 files changed, 35 insertions(+), 41 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 9dee3797bdd..99e21bac469 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -2,6 +2,8 @@ * display.texi (Attribute Functions): Update for set-face-* name changes. + Add new "inherit" argument for face-bold-p etc. + Move description of this argument to a common section, like "frame". * debugging.texi (Profiling): New section. (Debugging): Mention profiling in the introduction. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 0932e8ceac2..5148c6ec22e 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2453,59 +2453,48 @@ This swaps the foreground and background colors of face @var{face}. don't specify @var{frame}, they refer to the selected frame; @code{t} refers to the default data for new frames. They return the symbol @code{unspecified} if the face doesn't define any value for that -attribute. +attribute. If @var{inherit} is @code{nil}, only an attribute directly +defined by the face is returned. If @var{inherit} is non-@code{nil}, +any faces specified by its @code{:inherit} attribute are considered as +well, and if @var{inherit} is a face or a list of faces, then they are +also considered, until a specified attribute is found. To ensure that +the return value is always specified, use a value of @code{default} for +@var{inherit}. + +@defun face-font face &optional frame +This function returns the name of the font of face @var{face}. +@end defun @defun face-foreground face &optional frame inherit @defunx face-background face &optional frame inherit These functions return the foreground color (or background color, respectively) of face @var{face}, as a string. - -If @var{inherit} is @code{nil}, only a color directly defined by the face is -returned. If @var{inherit} is non-@code{nil}, any faces specified by its -@code{:inherit} attribute are considered as well, and if @var{inherit} -is a face or a list of faces, then they are also considered, until a -specified color is found. To ensure that the return value is always -specified, use a value of @code{default} for @var{inherit}. @end defun @defun face-stipple face &optional frame inherit This function returns the name of the background stipple pattern of face @var{face}, or @code{nil} if it doesn't have one. - -If @var{inherit} is @code{nil}, only a stipple directly defined by the -face is returned. If @var{inherit} is non-@code{nil}, any faces -specified by its @code{:inherit} attribute are considered as well, and -if @var{inherit} is a face or a list of faces, then they are also -considered, until a specified stipple is found. To ensure that the -return value is always specified, use a value of @code{default} for -@var{inherit}. -@end defun - -@defun face-font face &optional frame -This function returns the name of the font of face @var{face}. @end defun -@defun face-bold-p face &optional frame +@defun face-bold-p face &optional frame inherit This function returns a non-@code{nil} value if the @code{:weight} attribute of @var{face} is bolder than normal (i.e., one of @code{semi-bold}, @code{bold}, @code{extra-bold}, or @code{ultra-bold}). Otherwise, it returns @code{nil}. @end defun -@defun face-italic-p face &optional frame +@defun face-italic-p face &optional frame inherit This function returns a non-@code{nil} value if the @code{:slant} attribute of @var{face} is @code{italic} or @code{oblique}, and @code{nil} otherwise. @end defun -@c Note the weasel words. A face that inherits from an underlined -@c face but does not specify :underline will return nil. -@defun face-underline-p face &optional frame +@defun face-underline-p face &optional frame inherit This function returns non-@code{nil} if face @var{face} specifies a non-@code{nil} @code{:underline} attribute. @end defun -@defun face-inverse-video-p face &optional frame +@defun face-inverse-video-p face &optional frame inherit This function returns non-@code{nil} if face @var{face} specifies a non-@code{nil} @code{:inverse-video} attribute. @end defun diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 19268a4f860..192de015ea6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-11-21 Glenn Morris + * faces.el (face-underline-p, face-inverse-video-p, face-bold-p) + (face-italic-p): Add optional argument "inherit". + * faces.el (set-face-inverse-video, set-face-bold, set-face-italic): Remove -p suffix from names, for consistency with other set-face-*. (set-face-inverse-video): Fix interactive spec. diff --git a/lisp/faces.el b/lisp/faces.el index cb3470c167d..f8dc4783cbb 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -487,44 +487,44 @@ with the `default' face (which is always completely specified)." (defalias 'face-background-pixmap 'face-stipple) -;; FIXME all of these -p functions ignore inheritance (cf face-stipple). -;; Ie, a face that inherits from an underlined face but does not -;; specify :underline will return nil. -;; So these functions don't actually tell you anything about how the -;; face will _appear_. So not very useful IMO. -(defun face-underline-p (face &optional frame) +(defun face-underline-p (face &optional frame inherit) "Return non-nil if FACE specifies a non-nil underlining. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). -If FRAME is omitted or nil, use the selected frame." - (face-attribute-specified-or (face-attribute face :underline frame) nil)) +If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'." + (face-attribute-specified-or + (face-attribute face :underline frame inherit) nil)) -(defun face-inverse-video-p (face &optional frame) +(defun face-inverse-video-p (face &optional frame inherit) "Return non-nil if FACE specifies a non-nil inverse-video. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). -If FRAME is omitted or nil, use the selected frame." - (eq (face-attribute face :inverse-video frame) t)) +If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'." + (eq (face-attribute face :inverse-video frame inherit) t)) -(defun face-bold-p (face &optional frame) +(defun face-bold-p (face &optional frame inherit) "Return non-nil if the font of FACE is bold on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'. Use `face-attribute' for finer control." - (let ((bold (face-attribute face :weight frame))) + (let ((bold (face-attribute face :weight frame inherit))) (memq bold '(semi-bold bold extra-bold ultra-bold)))) -(defun face-italic-p (face &optional frame) +(defun face-italic-p (face &optional frame inherit) "Return non-nil if the font of FACE is italic on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'. Use `face-attribute' for finer control." - (let ((italic (face-attribute face :slant frame))) + (let ((italic (face-attribute face :slant frame inherit))) (memq italic '(italic oblique)))) -- cgit v1.3 From 3dc00ee808ba8e8eea214d541025c2dc27e74831 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 21 Nov 2012 06:17:40 -0500 Subject: Auto-commit of generated files. --- autogen/configure | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/autogen/configure b/autogen/configure index 22cdb7334b8..79a7c8ba066 100755 --- a/autogen/configure +++ b/autogen/configure @@ -2058,8 +2058,9 @@ Optional Features: enable compile time checks for the Lisp_Object data type. This is useful for development for catching certain types of bugs. - --enable-profiling build emacs with profiling support. This might not - work on all platforms + --enable-profiling build emacs with low-level, gprof profiling support. + Mainly useful for debugging Emacs itself. May not + work on all platforms. Stops profiler.el working. --enable-autodepend automatically generate dependencies to .h-files. Requires GNU Make and Gcc. Enabled if GNU Make and Gcc is found -- cgit v1.3 From 954bba56c62e4e0637a933cf21626a55b873e144 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 21 Nov 2012 11:34:35 -0500 Subject: * src/xdisp.c (fast_set_selected_frame): Rename from update_tool_bar_unwind. Make it set selected_window as well. (update_tool_bar): Use it. --- src/ChangeLog | 6 ++++++ src/xdisp.c | 21 ++++++++++++++++----- 2 files changed, 22 insertions(+), 5 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index c16a4dc87ce..b1a76bfdae0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-21 Stefan Monnier + + * xdisp.c (fast_set_selected_frame): Rename from update_tool_bar_unwind. + Make it set selected_window as well. + (update_tool_bar): Use it. + 2012-11-21 Ken Brown * emacs.c (main): Set the G_SLICE environment variable for all diff --git a/src/xdisp.c b/src/xdisp.c index 4d359593c75..f0da28fcedd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -11484,11 +11484,18 @@ FRAME_PTR last_mouse_frame; int last_tool_bar_item; - +/* Select `frame' temporarily without running all the code in + do_switch_frame. + FIXME: Maybe do_switch_frame should be trimmed down similarly + when `norecord' is set. */ static Lisp_Object -update_tool_bar_unwind (Lisp_Object frame) +fast_set_selected_frame (Lisp_Object frame) { - selected_frame = frame; + if (!EQ (selected_frame, frame)) + { + selected_frame = frame; + selected_window = XFRAME (frame)->selected_window; + } return Qnil; } @@ -11560,9 +11567,13 @@ update_tool_bar (struct frame *f, int save_match_data) before calling tool_bar_items, because the calculation of the tool-bar keymap uses the selected frame (see `tool-bar-make-keymap' in tool-bar.el). */ - record_unwind_protect (update_tool_bar_unwind, selected_frame); + eassert (EQ (selected_window, + /* Since we only explicitly preserve selected_frame, + check that selected_window would be redundant. */ + XFRAME (selected_frame)->selected_window)); + record_unwind_protect (fast_set_selected_frame, selected_frame); XSETFRAME (frame, f); - selected_frame = frame; + fast_set_selected_frame (frame); /* Build desired tool-bar items from keymaps. */ new_tool_bar -- cgit v1.3 From 9239d970523919dfcf7437f728f4976b3a9467f3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 21 Nov 2012 13:06:52 -0800 Subject: Assume POSIX 1003.1-1988 or later for unistd.h. * admin/CPP-DEFINES (BROKEN_GETWD, HAVE_GETCWD, HAVE_GETWD, HAVE_SIZE_T) (HAVE_UNISTD_H): Remove. * configure.ac: Do not check for getcwd or getwd. * lib-src/emacsclient.c (getcwd): Remove decl. (get_current_dir_name): Assume getcwd exists. * lib-src/etags.c (HAVE_GETCWD): Remove. (getcwd): Remove decl. (NO_LONG_OPTIONS): Remove this. All uses removed. Emacs always has GNU getopt. (etags_getcwd): Assume getcwd exists. * lib-src/movemail.c (F_OK, X_OK, W_OK, R_OK): Remove. * nt/config.nt (HAVE_GETCWD): Remove. * src/alloc.c: Assume unistd.h exists. * src/fileio.c (Fexpand_file_name) [DOS_NT]: Use getcwd, not getwd. * src/sysdep.c (get_current_dir_name): Assume getcwd exists. (getwd) [USG]: Remove; no longer needed. (sys_subshell) [DOS_NT]: Use getcwd, not getwd. * src/w32.c (getcwd): Rename from getwd, and switch to getcwd's API. * src/w32.h (getcwd): Remove decl. Fixes: debbugs:12945 --- ChangeLog | 5 ++++ admin/CPP-DEFINES | 5 ---- admin/ChangeLog | 6 ++++ configure.ac | 10 +------ lib-src/ChangeLog | 12 ++++++++ lib-src/emacsclient.c | 23 ++------------- lib-src/etags.c | 68 ++++++------------------------------------- lib-src/movemail.c | 7 ----- nt/ChangeLog | 5 ++++ nt/config.nt | 6 ---- src/ChangeLog | 11 +++++++ src/alloc.c | 4 --- src/fileio.c | 2 +- src/sysdep.c | 80 +++------------------------------------------------ src/w32.c | 14 +++++++-- src/w32.h | 2 -- 16 files changed, 67 insertions(+), 193 deletions(-) diff --git a/ChangeLog b/ChangeLog index 33dafaaea4c..4dad9a171dc 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-11-21 Paul Eggert + + Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). + * configure.ac: Do not check for getcwd or getwd. + 2012-11-21 Glenn Morris * configure.ac (--enable-profiling): Doc fix. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index ae8673452a3..5c291944766 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -86,7 +86,6 @@ anymore, so they can be removed. AMPERSAND_FULL_NAME BROKEN_DATAGRAM_SOCKETS BROKEN_FIONREAD -BROKEN_GETWD BROKEN_GET_CURRENT_DIR_NAME BROKEN_NON_BLOCKING_CONNECT BROKEN_PTY_READ_AFTER_EAGAIN @@ -161,7 +160,6 @@ HAVE_FUTIMESAT HAVE_GAI_STRERROR HAVE_GCONF HAVE_GETADDRINFO -HAVE_GETCWD HAVE_GETDELIM HAVE_GETGRENT HAVE_GETHOSTNAME @@ -178,7 +176,6 @@ HAVE_GETRLIMIT HAVE_GETRUSAGE HAVE_GETSOCKNAME HAVE_GETTIMEOFDAY -HAVE_GETWD HAVE_GET_CURRENT_DIR_NAME HAVE_GHOSTSCRIPT HAVE_GIF @@ -304,7 +301,6 @@ HAVE_SIGNED_SIG_ATOMIC_T HAVE_SIGNED_WCHAR_T HAVE_SIGNED_WINT_T HAVE_SIGSET_T -HAVE_SIZE_T HAVE_SNPRINTF HAVE_SOCKETS HAVE_SOUND @@ -369,7 +365,6 @@ HAVE_TM_ZONE HAVE_TOUCHLOCK HAVE_TZNAME HAVE_TZSET -HAVE_UNISTD_H HAVE_UNSIGNED_LONG_LONG_INT HAVE_UTIL_H HAVE_UTIMENSAT diff --git a/admin/ChangeLog b/admin/ChangeLog index 3d76f9dd2ba..b256a0f5dc4 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,9 @@ +2012-11-21 Paul Eggert + + Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). + * CPP-DEFINES (BROKEN_GETWD, HAVE_GETCWD, HAVE_GETWD, HAVE_SIZE_T) + (HAVE_UNISTD_H): Remove. + 2012-11-17 Paul Eggert Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). diff --git a/configure.ac b/configure.ac index 343a9e7cfb5..25bf2b47cc9 100644 --- a/configure.ac +++ b/configure.ac @@ -2894,7 +2894,7 @@ AC_CHECK_FUNCS(gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ -utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ +utimes getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ gai_strerror mkstemp getline getdelim fsync sync \ @@ -2903,14 +2903,6 @@ getpwent endpwent getgrent endgrent \ touchlock \ cfmakeraw cfsetspeed copysign __executable_start) -dnl getwd appears to be buggy on SVR4.2, so we don't use it. -if test $opsys = unixware; then - dnl In case some other test ends up checking for getwd. - AC_DEFINE(BROKEN_GETWD, 1, [Define if getwd should not be used.]) -else - AC_CHECK_FUNCS(getwd) -fi - ## Eric Backus says, HP-UX 9.x on HP 700 machines ## has a broken `rint' in some library versions including math library ## version number A.09.05. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 67035773977..8e835795e6a 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,15 @@ +2012-11-21 Paul Eggert + + Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). + * emacsclient.c (getcwd): Remove decl. + (get_current_dir_name): Assume getcwd exists. + * etags.c (HAVE_GETCWD): Remove. + (getcwd): Remove decl. + (NO_LONG_OPTIONS): Remove this. All uses removed. + Emacs always has GNU getopt. + (etags_getcwd): Assume getcwd exists. + * movemail.c (F_OK, X_OK, W_OK, R_OK): Remove. + 2012-11-20 Paul Eggert * emacsclient.c (handle_sigcont, handle_sigtstp): Use raise (sig) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 78079b5cf69..021ac6eb247 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -88,10 +88,7 @@ char *w32_getenv (char *); -char *getenv (const char *), *getwd (char *); -#ifdef HAVE_GETCWD -char *(getcwd) (char *, size_t); -#endif +char *getenv (const char *); #ifndef VERSION #define VERSION "unspecified" @@ -223,7 +220,7 @@ get_current_dir_name (void) char *buf; const char *pwd; struct stat dotstat, pwdstat; - /* If PWD is accurate, use it instead of calling getwd. PWD is + /* If PWD is accurate, use it instead of calling getcwd. PWD is sometimes a nicer name, and using it may avoid a fatal error if a parent directory is searchable but not readable. */ if ((pwd = egetenv ("PWD")) != 0 @@ -240,7 +237,6 @@ get_current_dir_name (void) buf = (char *) xmalloc (strlen (pwd) + 1); strcpy (buf, pwd); } -#ifdef HAVE_GETCWD else { size_t buf_size = 1024; @@ -267,20 +263,6 @@ get_current_dir_name (void) } } } -#else - else - { - /* We need MAXPATHLEN here. */ - buf = (char *) xmalloc (MAXPATHLEN + 1); - if (getwd (buf) == NULL) - { - int tmp_errno = errno; - free (buf); - errno = tmp_errno; - return NULL; - } - } -#endif return buf; } #endif @@ -1592,7 +1574,6 @@ main (int argc, char **argv) cwd = get_current_dir_name (); if (cwd == 0) { - /* getwd puts message in STRING if it fails. */ message (TRUE, "%s: %s\n", progname, "Cannot get current working directory"); fail (); diff --git a/lib-src/etags.c b/lib-src/etags.c index ec415e9905f..b6af17b8edf 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -123,19 +123,9 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # undef HAVE_NTGUI # undef DOS_NT # define DOS_NT -# ifndef HAVE_GETCWD -# define HAVE_GETCWD -# endif /* undef HAVE_GETCWD */ -#else /* not WINDOWSNT */ -#endif /* !WINDOWSNT */ +#endif /* WINDOWSNT */ #include -#ifndef HAVE_UNISTD_H -# if defined (HAVE_GETCWD) && !defined (WINDOWSNT) - extern char *getcwd (char *buf, size_t size); -# endif -#endif /* HAVE_UNISTD_H */ - #include #include #include @@ -152,16 +142,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # define assert(x) ((void) 0) #endif -#ifdef NO_LONG_OPTIONS /* define this if you don't have GNU getopt */ -# define NO_LONG_OPTIONS TRUE -# define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr) - extern char *optarg; - extern int optind, opterr; -#else -# define NO_LONG_OPTIONS FALSE -# include -#endif /* NO_LONG_OPTIONS */ - +#include #include /* Define CTAGS to make the program "ctags" compatible with the usual one. @@ -869,11 +850,7 @@ print_help (argument *argbuffer) printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ \n\ These are the options accepted by %s.\n", progname, progname); - if (NO_LONG_OPTIONS) - puts ("WARNING: long option names do not work with this executable,\n\ -as it is not linked with GNU getopt."); - else - puts ("You may use unambiguous abbreviations for the long option names."); + puts ("You may use unambiguous abbreviations for the long option names."); puts (" A - as file name means read names from stdin (one per line).\n\ Absolute names are stored in the output file as they are.\n\ Relative ones are stored relative to the output file's directory.\n"); @@ -1065,9 +1042,9 @@ main (int argc, char **argv) /* When the optstring begins with a '-' getopt_long does not rearrange the non-options arguments to be at the end, but leaves them alone. */ - optstring = concat (NO_LONG_OPTIONS ? "" : "-", - "ac:Cf:Il:o:r:RSVhH", - (CTAGS) ? "BxdtTuvw" : "Di:"); + optstring = concat ("-ac:Cf:Il:o:r:RSVhH", + (CTAGS) ? "BxdtTuvw" : "Di:", + ""); while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF) switch (opt) @@ -6333,8 +6310,8 @@ pfatal (const char *s1) static void suggest_asking_for_help (void) { - fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n", - progname, NO_LONG_OPTIONS ? "-h" : "--help"); + fprintf (stderr, "\tTry `%s --help' for a complete list of options.\n", + progname); exit (EXIT_FAILURE); } @@ -6372,7 +6349,6 @@ concat (const char *s1, const char *s2, const char *s3) static char * etags_getcwd (void) { -#ifdef HAVE_GETCWD int bufsize = 200; char *path = xnew (bufsize, char); @@ -6387,34 +6363,6 @@ etags_getcwd (void) canonicalize_filename (path); return path; - -#else /* not HAVE_GETCWD */ -#if MSDOS - - char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ - - getwd (path); - - for (p = path; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; - else - *p = lowcase (*p); - - return strdup (path); -#else /* not MSDOS */ - linebuffer path; - FILE *pipe; - - linebuffer_init (&path); - pipe = (FILE *) popen ("pwd 2>/dev/null", "r"); - if (pipe == NULL || readline_internal (&path, pipe) == 0) - pfatal ("pwd"); - pclose (pipe); - - return path.buffer; -#endif /* not MSDOS */ -#endif /* not HAVE_GETCWD */ } /* Return a newly allocated string containing the file name of FILE diff --git a/lib-src/movemail.c b/lib-src/movemail.c index cd329a110a8..adc5dd96409 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -96,13 +96,6 @@ along with GNU Emacs. If not, see . */ #include #endif /* WINDOWSNT */ -#ifndef F_OK -#define F_OK 0 -#define X_OK 1 -#define W_OK 2 -#define R_OK 4 -#endif - #ifdef WINDOWSNT #include #endif diff --git a/nt/ChangeLog b/nt/ChangeLog index 0eda3a699d6..4fa3d04513c 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,8 @@ +2012-11-21 Paul Eggert + + Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). + * config.nt (HAVE_GETCWD): Remove. + 2012-11-21 Eli Zaretskii * nmake.defs: Use !if, not !ifdef. For the details, see diff --git a/nt/config.nt b/nt/config.nt index 57c18ad2789..1adcbca89be 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -411,12 +411,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `getaddrinfo' function. */ #undef HAVE_GETADDRINFO -/* Define to 1 if you have the `getcwd' function. - If you think about defining HAVE_GETCWD, don't: the alternative - getwd is redefined on w32.c, and does not really return the current - directory, to get the desired results elsewhere in Emacs. */ -#undef HAVE_GETCWD - /* Define to 1 if you have the `getdelim' function. */ #undef HAVE_GETDELIM diff --git a/src/ChangeLog b/src/ChangeLog index b1a76bfdae0..9e9ae468044 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2012-11-21 Paul Eggert + + Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). + * alloc.c: Assume unistd.h exists. + * fileio.c (Fexpand_file_name) [DOS_NT]: Use getcwd, not getwd. + * sysdep.c (get_current_dir_name): Assume getcwd exists. + (getwd) [USG]: Remove; no longer needed. + (sys_subshell) [DOS_NT]: Use getcwd, not getwd. + * w32.c (getcwd): Rename from getwd, and switch to getcwd's API. + * w32.h (getcwd): Remove decl. + 2012-11-21 Stefan Monnier * xdisp.c (fast_set_selected_frame): Rename from update_tool_bar_unwind. diff --git a/src/alloc.c b/src/alloc.c index 22e3db3cc77..46b2dde93a3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -63,10 +63,6 @@ along with GNU Emacs. If not, see . */ #endif #include -#ifndef HAVE_UNISTD_H -extern void *sbrk (); -#endif - #include #ifdef USE_GTK diff --git a/src/fileio.c b/src/fileio.c index e1a7cf55e28..442c66550d3 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1148,7 +1148,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) newdir = "/"; } else - getwd (adir); + getcwd (adir, MAXPATHLEN + 1); newdir = adir; } diff --git a/src/sysdep.c b/src/sysdep.c index 7c5c144fa8c..3dd19685540 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -101,7 +101,6 @@ along with GNU Emacs. If not, see . */ #define _P_WAIT 0 int _cdecl _spawnlp (int, const char *, const char *, ...); int _cdecl _getpid (void); -extern char *getwd (char *); #endif #include "syssignal.h" @@ -134,12 +133,12 @@ char* get_current_dir_name (void) { char *buf; - char *pwd; + char *pwd = getenv ("PWD"); struct stat dotstat, pwdstat; - /* If PWD is accurate, use it instead of calling getwd. PWD is + /* If PWD is accurate, use it instead of calling getcwd. PWD is sometimes a nicer name, and using it may avoid a fatal error if a parent directory is searchable but not readable. */ - if ((pwd = getenv ("PWD")) != 0 + if (pwd && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1]))) && stat (pwd, &pwdstat) == 0 && stat (".", &dotstat) == 0 @@ -155,7 +154,6 @@ get_current_dir_name (void) return NULL; strcpy (buf, pwd); } -#ifdef HAVE_GETCWD else { size_t buf_size = 1024; @@ -179,22 +177,6 @@ get_current_dir_name (void) return NULL; } } -#else - else - { - /* We need MAXPATHLEN here. */ - buf = malloc (MAXPATHLEN + 1); - if (!buf) - return NULL; - if (getwd (buf) == NULL) - { - int tmp_errno = errno; - free (buf); - errno = tmp_errno; - return NULL; - } - } -#endif return buf; } #endif @@ -521,7 +503,7 @@ sys_subshell (void) const char *sh = 0; #ifdef DOS_NT /* MW, Aug 1993 */ - getwd (oldwd); + getcwd (oldwd, sizeof oldwd); if (sh == 0) sh = (char *) egetenv ("SUSPEND"); /* KFS, 1994-12-14 */ #endif @@ -2238,60 +2220,6 @@ emacs_readlink (char const *filename, char initial_buf[READLINK_BUFSIZE]) &emacs_norealloc_allocator, careadlinkatcwd); } -#ifdef USG -/* - * All of the following are for USG. - * - * On USG systems the system calls are INTERRUPTIBLE by signals - * that the user program has elected to catch. Thus the system call - * must be retried in these cases. To handle this without massive - * changes in the source code, we remap the standard system call names - * to names for our own functions in sysdep.c that do the system call - * with retries. Actually, for portability reasons, it is good - * programming practice, as this example shows, to limit all actual - * system calls to a single occurrence in the source. Sure, this - * adds an extra level of function call overhead but it is almost - * always negligible. Fred Fish, Unisoft Systems Inc. - */ - -/* - * Warning, this function may not duplicate 4.2 action properly - * under error conditions. - */ - -#if !defined (HAVE_GETWD) || defined (BROKEN_GETWD) - -#ifndef MAXPATHLEN -/* In 4.1, param.h fails to define this. */ -#define MAXPATHLEN 1024 -#endif - -char * -getwd (char *pathname) -{ - char *npath, *spath; - extern char *getcwd (char *, size_t); - - block_input (); /* getcwd uses malloc */ - spath = npath = getcwd ((char *) 0, MAXPATHLEN); - if (spath == 0) - { - unblock_input (); - return spath; - } - /* On Altos 3068, getcwd can return @hostname/dir, so discard - up to first slash. Should be harmless on other systems. */ - while (*npath && *npath != '/') - npath++; - strcpy (pathname, npath); - free (spath); /* getcwd uses malloc */ - unblock_input (); - return pathname; -} - -#endif /* !defined (HAVE_GETWD) || defined (BROKEN_GETWD) */ -#endif /* USG */ - /* Directory routines for systems that don't have them. */ #ifdef HAVE_DIRENT_H diff --git a/src/w32.c b/src/w32.c index b51022c6001..da778eb8541 100644 --- a/src/w32.c +++ b/src/w32.c @@ -908,8 +908,18 @@ static char startup_dir[MAXPATHLEN]; /* Get the current working directory. */ char * -getwd (char *dir) +getcwd (char *dir, size_t dirsize) { + if (!dirsize) + { + errno = EINVAL; + return NULL; + } + if (dirsize <= strlen (startup_dir)) + { + errno = ERANGE; + return NULL; + } #if 0 if (GetCurrentDirectory (MAXPATHLEN, dir) > 0) return dir; @@ -1825,7 +1835,7 @@ init_environment (char ** argv) memcpy (*envp, "COMSPEC=", 8); } - /* Remember the initial working directory for getwd. */ + /* Remember the initial working directory for getcwd. */ /* FIXME: Do we need to resolve possible symlinks in startup_dir? Does it matter anywhere in Emacs? */ if (!GetCurrentDirectory (MAXPATHLEN, startup_dir)) diff --git a/src/w32.h b/src/w32.h index 8309a3cc23d..23eda830268 100644 --- a/src/w32.h +++ b/src/w32.h @@ -163,7 +163,6 @@ extern int sys_spawnve (int, char *, char **, char **); extern void register_child (int, int); extern void sys_sleep (int); -extern char *getwd (char *); extern int sys_link (const char *, const char *); @@ -181,4 +180,3 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, #endif /* HAVE_GNUTLS */ #endif /* EMACS_W32_H */ - -- cgit v1.3 From 723da6aa83d8308623ed56aff31a4171fae029ee Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Wed, 21 Nov 2012 19:47:04 -0600 Subject: * doc/misc/calc.texi (Date Forms): Mention the customizable Gregorian-Julian switch. (Customizing Calc): Mention the variable `calc-gregorian-switch'. * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer after the variable is changed. --- doc/misc/ChangeLog | 6 ++++ doc/misc/calc.texi | 91 +++++++++++++++++++++++++++++++++++------------------- lisp/ChangeLog | 5 +++ lisp/calc/README | 13 ++++++-- lisp/calc/calc.el | 3 +- 5 files changed, 82 insertions(+), 36 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 39931f3a779..67cbd40a0a3 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,9 @@ +2012-11-22 Jay Belanger + + * doc/misc/calc.texi (Date Forms): Mention the customizable + Gregorian-Julian switch. + (Customizing Calc): Mention the variable `calc-gregorian-switch'. + 2012-11-17 Paul Eggert Calc now uses the Gregorian calendar for all dates, diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 6daceb4d41a..761d4deefe4 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10987,10 +10987,10 @@ Input is flexible; date forms can be entered in any of the usual notations for dates and times. @xref{Date Formats}. Date forms are stored internally as numbers, specifically the number -of days since midnight on the morning of January 1 of the year 1 AD. +of days since midnight on the morning of December 31 of the year 1 BC. If the internal number is an integer, the form represents a date only; if the internal number is a fraction or float, the form represents -a date and time. For example, @samp{<6:00am Wed Jan 9, 1991>} +a date and time. For example, @samp{<6:00am Thu Jan 10, 1991>} is represented by the number 726842.25. The standard precision of 12 decimal digits is enough to ensure that a (reasonable) date and time can be stored without roundoff error. @@ -11014,42 +11014,55 @@ year numbers represent years BC. There is no ``year 0''; the day before @samp{} is @samp{}. These are days 1 and 0 respectively in Calc's internal numbering scheme. The Gregorian calendar is used for all dates, including dates before the -Gregorian calendar was invented. Thus Calc's use of the day number -@mathit{-10000} to represent August 15, 28 BC should be taken with a -grain of salt. +Gregorian calendar was invented (although that can be configured; see +below). Thus Calc's use of the day number @mathit{-10000} to +represent August 15, 28 BC should be taken with a grain of salt. @cindex Julian calendar @cindex Gregorian calendar Some historical background: The Julian calendar was created by Julius Caesar in the year 46 BC as an attempt to fix the confusion caused by the irregular Roman calendar that was used before that time. -The Julian calendar introduced an extra day in -all years divisible by four. After some initial confusion, the -calendar was adopted around the year we call 8 AD, although the years were -numbered differently and did not necessarily begin on January 1. Some centuries -later it became apparent that the Julian year of 365.25 days was -itself not quite right. In 1582 Pope Gregory XIII introduced the -Gregorian calendar, which added the new rule that years divisible -by 100, but not by 400, were not to be considered leap years -despite being divisible by four. Many countries delayed adoption -of the Gregorian calendar because of religious differences, and -used differing year numbers and start-of-year for other reasons; -for example, in early 1752 England changed the start of its year from -March 25 to January 1, and in September it switched to the Gregorian -calendar: in England, the day after December 31, 1750 was January 1, -1750 and the day after March 24, 1750 was March 25, 1751, but the day -after December 31, 1751 was January 1, 1752 and the day after -September 2, 1752 was September 14, 1752. To take another example, -Russia switched both year numbering and start-of-year in 1700, but did -not adopt the Gregorian calendar until 1918. Calc's reckoning -therefore matches English practice starting in 1752 and Russian -practice starting in 1918, but disagrees with earlier dates in both -countries. - -Today's timekeepers introduce an occasional ``leap second'' as -well, but Calc does not take these minor effects into account. -(If it did, it would have to report a non-integer number of days -between, say, @samp{<12:00am Mon Jan 1, 1900>} and +The Julian calendar introduced an extra day in all years divisible by +four. After some initial confusion, the calendar was adopted around +the year we call 8 AD. Some centuries later it became +apparent that the Julian year of 365.25 days was itself not quite +right. In 1582 Pope Gregory XIII introduced the Gregorian calendar, +which added the new rule that years divisible by 100, but not by 400, +were not to be considered leap years despite being divisible by four. +Many countries delayed adoption of the Gregorian calendar +because of religious differences. For example, Great Britain and the +British colonies switched to the Gregorian calendar in September +1752, when the Julian calendar was eleven days behind the +Gregorian calendar. That year in Britain, the day after September 2 +was September 14. To take another example, Russia did not adopt the +Gregorian calendar until 1918, and that year in Russia the day after +January 31 was February 14. Calc's reckoning therefore matches English +practice starting in 1752 and Russian practice starting in 1918, but +disagrees with earlier dates in both countries. + +When the Julian calendar was introduced, it had January 1 as the first +day of the year. By the Middle Ages, many European countries +had changed the beginning of a new year to a different date, often to +a religious festival. Almost all countries reverted to using January 1 +as the beginning of the year by the time they adopted the Gregorian +calendar. + +Some calendars attempt to mimic the historical situation by using the +Gregorian calendar for recent dates and the Julian calendar for older +dates. The @code{cal} program in most Unix implementations does this, +for example. While January 1 wasn't always the beginning of a calendar +year, these hybrid calendars still use January 1 as the beginning of +the year even for older dates. The customizable variable +@code{calc-gregorian-switch} (@pxref{Customizing Calc}) can be set to +have Calc's date forms switch from the Julian to Gregorian calendar at +any specified date. + +Today's timekeepers introduce an occasional ``leap second''. +These do not occur regularly and Calc does not take these minor +effects into account. (If it did, it would have to report a +non-integer number of days between, say, +@samp{<12:00am Mon Jan 1, 1900>} and @samp{<12:00am Sat Jan 1, 2000>}.) @cindex Julian day counting @@ -35590,6 +35603,20 @@ number of undo steps that will be preserved; if be preserved. The default value of @code{calc-undo-length} is @expr{100}. @end defvar +@defvar calc-gregorian-switch +See @ref{Date Forms}.@* +The variable @code{calc-gregorian-switch} is either a list of integers +@code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}. +If it is @code{nil}, then Calc's date forms always represent Gregorian dates. +Otherwise, @code{calc-gregorian-switch} represents the date that the +calendar switches from Julian dates to Gregorian dates; +@code{(@var{YEAR} @var{MONTH} @var{DAY})} will be the first Gregorian +date. The customization buffer will offer several standard dates to +choose from, or the user can enter their own date. + +The default value of @code{calc-gregorian-switch} is @code{nil}. +@end defvar + @node Reporting Bugs, Summary, Customizing Calc, Top @appendix Reporting Bugs diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6b6a64b9899..253392fe5b8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-22 Jay Belanger + + * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer + after the variable is changed. + 2012-11-21 Daniel Colascione * progmodes/sql.el (sql-mode-font-lock-object-name): Support IF NOT EXISTS diff --git a/lisp/calc/README b/lisp/calc/README index 25d1a5e9b58..638b482a60a 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -70,11 +70,18 @@ opinions. Summary of changes to "Calc" ------- -- ------- -- ---- +Emacs 24.4 + +* The date forms use the Gregorian calendar for all dates. + (Previously they were a combination of Julian and Gregorian + dates.) This can be configured with the customizable variable + `calc-gregorian-switch'. + Emacs 24.3 -Algebraic simplification mode is now the default. -To restrict to the limited simplifications given by the former -default simplification mode, use `m I'. +* Algebraic simplification mode is now the default. + To restrict to the limited simplifications given by the former + default simplification mode, use `m I'. Emacs 24.1 diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index aeca45ebf26..99e40768467 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -508,7 +508,8 @@ the United States." (integer :tag "Day"))) :set (lambda (symbol value) (set-default symbol value) - (setq math-format-date-cache nil))) + (setq math-format-date-cache nil) + (calc-refresh))) (defface calc-nonselected-face '((t :inherit shadow -- cgit v1.3 From ec84768f9754d5943610cbbd048dc4d4a46d847f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 22 Nov 2012 05:56:38 +0200 Subject: Fix MS-Windows build following 2012-11-21T21:06:52Z!eggert@cs.ucla.edu. src/w32.c (getcwd): Fix the 2nd argument type, to prevent conflicts with Windows system header. Fixes: debbugs:12945 --- src/ChangeLog | 5 +++++ src/w32.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9e9ae468044..3587a9e295b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-11-22 Eli Zaretskii + + * w32.c (getcwd): Fix the 2nd argument type, to prevent conflicts + with Windows system header. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). diff --git a/src/w32.c b/src/w32.c index da778eb8541..038a442f529 100644 --- a/src/w32.c +++ b/src/w32.c @@ -908,7 +908,7 @@ static char startup_dir[MAXPATHLEN]; /* Get the current working directory. */ char * -getcwd (char *dir, size_t dirsize) +getcwd (char *dir, int dirsize) { if (!dirsize) { -- cgit v1.3 From 6ceeb5f14411ed388979d0bb944c06e36756f9af Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Thu, 22 Nov 2012 10:52:30 +0400 Subject: * xdisp.c (window_buffer_changed): New function. (update_menu_bar, update_tool_bar): Use it to simplify large 'if' statements. (redisplay_internal): Generalize commonly used 'tail' and 'frame' local variables. --- src/ChangeLog | 8 +++++++ src/xdisp.c | 74 ++++++++++++++++++++++++++--------------------------------- 2 files changed, 40 insertions(+), 42 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3587a9e295b..4a4572bdd63 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2012-11-22 Dmitry Antipov + + * xdisp.c (window_buffer_changed): New function. + (update_menu_bar, update_tool_bar): Use it to + simplify large 'if' statements. + (redisplay_internal): Generalize commonly used + 'tail' and 'frame' local variables. + 2012-11-22 Eli Zaretskii * w32.c (getcwd): Fix the 2nd argument type, to prevent conflicts diff --git a/src/xdisp.c b/src/xdisp.c index f0da28fcedd..e9b20d148c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10908,6 +10908,21 @@ window_outdated (struct window *w) || w->last_overlay_modified < OVERLAY_MODIFF); } +/* Nonzero if W's buffer was changed but not saved or Transient Mark mode + is enabled and mark of W's buffer was changed since last W's update. */ + +static int +window_buffer_changed (struct window *w) +{ + struct buffer *b = XBUFFER (w->buffer); + + eassert (BUFFER_LIVE_P (b)); + + return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star) + || ((!NILP (Vtransient_mark_mode) && !NILP (BVAR (b, mark_active))) + != !NILP (w->region_showing))); +} + /*********************************************************************** Mode Lines and Frame Titles ***********************************************************************/ @@ -11327,12 +11342,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) /* This used to test w->update_mode_line, but we believe there is no need to recompute the menu in that case. */ || update_mode_lines - || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) - < BUF_MODIFF (XBUFFER (w->buffer))) - != w->last_had_star) - || ((!NILP (Vtransient_mark_mode) - && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) - != !NILP (w->region_showing))) + || window_buffer_changed (w)) { struct buffer *prev = current_buffer; ptrdiff_t count = SPECPDL_INDEX (); @@ -11532,12 +11542,7 @@ update_tool_bar (struct frame *f, int save_match_data) if (windows_or_buffers_changed || w->update_mode_line || update_mode_lines - || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) - < BUF_MODIFF (XBUFFER (w->buffer))) - != w->last_had_star) - || ((!NILP (Vtransient_mark_mode) - && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) - != !NILP (w->region_showing))) + || window_buffer_changed (w)) { struct buffer *prev = current_buffer; ptrdiff_t count = SPECPDL_INDEX (); @@ -12988,7 +12993,7 @@ redisplay_internal (void) ptrdiff_t count, count1; struct frame *sf; int polling_stopped_here = 0; - Lisp_Object old_frame = selected_frame; + Lisp_Object tail, frame, old_frame = selected_frame; struct backtrace backtrace; /* Non-zero means redisplay has to consider all windows on all @@ -13040,15 +13045,8 @@ redisplay_internal (void) backtrace.debug_on_exit = 0; backtrace_list = &backtrace; - { - Lisp_Object tail, frame; - - FOR_EACH_FRAME (tail, frame) - { - struct frame *f = XFRAME (frame); - f->already_hscrolled_p = 0; - } - } + FOR_EACH_FRAME (tail, frame) + XFRAME (frame)->already_hscrolled_p = 0; retry: /* Remember the currently selected window. */ @@ -13098,25 +13096,20 @@ redisplay_internal (void) FRAME_TTY (sf)->previous_frame = sf; } - /* Set the visible flags for all frames. Do this before checking - for resized or garbaged frames; they want to know if their frames - are visible. See the comment in frame.h for - FRAME_SAMPLE_VISIBILITY. */ - { - Lisp_Object tail, frame; - - number_of_visible_frames = 0; + /* Set the visible flags for all frames. Do this before checking for + resized or garbaged frames; they want to know if their frames are + visible. See the comment in frame.h for FRAME_SAMPLE_VISIBILITY. */ + number_of_visible_frames = 0; - FOR_EACH_FRAME (tail, frame) - { - struct frame *f = XFRAME (frame); + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); - FRAME_SAMPLE_VISIBILITY (f); - if (FRAME_VISIBLE_P (f)) - ++number_of_visible_frames; - clear_desired_matrices (f); - } - } + FRAME_SAMPLE_VISIBILITY (f); + if (FRAME_VISIBLE_P (f)) + ++number_of_visible_frames; + clear_desired_matrices (f); + } /* Notice any pending interrupt request to change frame size. */ do_pending_window_change (1); @@ -13467,8 +13460,6 @@ redisplay_internal (void) if (consider_all_windows_p) { - Lisp_Object tail, frame; - FOR_EACH_FRAME (tail, frame) XFRAME (frame)->updated_p = 0; @@ -13678,7 +13669,6 @@ redisplay_internal (void) frames here explicitly. */ if (!pending) { - Lisp_Object tail, frame; int new_count = 0; FOR_EACH_FRAME (tail, frame) -- cgit v1.3 From 2ecb2679ad2f052343479bdaf8b96fa016c1f4cf Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 21 Nov 2012 23:31:45 -0800 Subject: * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh definition. This fixes a bootstrap failure. --- lisp/ChangeLog | 5 ++++ lisp/calc/calc.el | 90 +++++++++++++++++++++++++++---------------------------- 2 files changed, 50 insertions(+), 45 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 253392fe5b8..cbf80456b0e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-22 Paul Eggert + + * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh + definition. This fixes a bootstrap failure. + 2012-11-22 Jay Belanger * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 99e40768467..ff4e5d71dce 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -466,51 +466,6 @@ to be identified as that note." (defvar math-format-date-cache) ; calc-forms.el -;; Dates that are built-in options for `calc-gregorian-switch' should be -;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. -(defcustom calc-gregorian-switch nil - "The first day the Gregorian calendar is used by Calc's date forms. -This is `nil' (the default) if the Gregorian calendar is the only one used. -Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use -the Gregorian calendar; Calc will use the Julian calendar for earlier dates. -The dates in which different regions of the world began to use the -Gregorian calendar vary quite a bit, even within a single country. -If you want Calc's date forms to switch between the Julian and -Gregorian calendar, you can specify the date or choose from several -common choices. Some of these choices should be taken with a grain -of salt; for example different parts of France changed calendars at -different times, and Sweden's change to the Gregorian calendar was -complicated. Also, the boundaries of the countries were different at -the times of the calendar changes than they are now. -The Vatican decided that the Gregorian calendar should take effect -on 15 October 1582 (Gregorian), and many Catholic countries made -the change then. Great Britian and its colonies had the Gregorian -calendar take effect on 14 September 1752 (Gregorian); this includes -the United States." - :group 'calc - :version "24.4" - :type '(choice (const :tag "Always use the Gregorian calendar" nil) - (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) - (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) - (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) - (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) - (const :tag "France (1582 12 20)" (1582 12 20 577802)) - (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) - (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) - (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) - (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) - (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) - (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) - (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) - (list :tag "(YEAR MONTH DAY)" - (integer :tag "Year") - (integer :tag "Month (integer)") - (integer :tag "Day"))) - :set (lambda (symbol value) - (set-default symbol value) - (setq math-format-date-cache nil) - (calc-refresh))) - (defface calc-nonselected-face '((t :inherit shadow :slant italic)) @@ -2067,6 +2022,51 @@ See calc-keypad for details." (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) +;; Dates that are built-in options for `calc-gregorian-switch' should be +;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. +(defcustom calc-gregorian-switch nil + "The first day the Gregorian calendar is used by Calc's date forms. +This is `nil' (the default) if the Gregorian calendar is the only one used. +Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use +the Gregorian calendar; Calc will use the Julian calendar for earlier dates. +The dates in which different regions of the world began to use the +Gregorian calendar vary quite a bit, even within a single country. +If you want Calc's date forms to switch between the Julian and +Gregorian calendar, you can specify the date or choose from several +common choices. Some of these choices should be taken with a grain +of salt; for example different parts of France changed calendars at +different times, and Sweden's change to the Gregorian calendar was +complicated. Also, the boundaries of the countries were different at +the times of the calendar changes than they are now. +The Vatican decided that the Gregorian calendar should take effect +on 15 October 1582 (Gregorian), and many Catholic countries made +the change then. Great Britian and its colonies had the Gregorian +calendar take effect on 14 September 1752 (Gregorian); this includes +the United States." + :group 'calc + :version "24.4" + :type '(choice (const :tag "Always use the Gregorian calendar" nil) + (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) + (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) + (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) + (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) + (const :tag "France (1582 12 20)" (1582 12 20 577802)) + (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) + (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) + (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) + (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) + (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) + (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) + (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) + (list :tag "(YEAR MONTH DAY)" + (integer :tag "Year") + (integer :tag "Month (integer)") + (integer :tag "Day"))) + :set (lambda (symbol value) + (set-default symbol value) + (setq math-format-date-cache nil) + (calc-refresh))) + ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned () -- cgit v1.3 From a14a5a40990df7637e6852d328cb16dc5c35ede0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 22 Nov 2012 00:09:03 -0800 Subject: * calc/calc.el (calc-gregorian-switch): In menu, put dates before regions. This is easier to follow, lines up better in the menu, and lets us coalesce regions that switch at the same time. Give country names, not "Vatican", as that's better for non-expert users. Use names that are stable between the date of switch and now, e.g., Bohemia and Moravia (which existed then and now) and not Czechoslovakia (which didn't exist then and doesn't exist now). What is now the U.S. mostly did not switch at the same time as Britain, so omit the U.S. Correct spelling of "Britain". Catholic Switzerland was too much of a mess, so omit it. --- lisp/ChangeLog | 10 ++++++++++ lisp/calc/calc.el | 25 ++++++++++++------------- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cbf80456b0e..01d6ce0d865 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -2,6 +2,16 @@ * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh definition. This fixes a bootstrap failure. + (calc-gregorian-switch): In menu, put dates before regions. + This is easier to follow, lines up better in the menu, and lets us + coalesce regions that switch at the same time. Give country + names, not "Vatican", as that's better for non-expert users. Use + names that are stable between the date of switch and now, e.g., + Bohemia and Moravia (which existed then and now) and not + Czechoslovakia (which didn't exist then and doesn't exist now). + What is now the U.S. mostly did not switch at the same time as + Britain, so omit the U.S. Correct spelling of "Britain". + Catholic Switzerland was too much of a mess, so omit it. 2012-11-22 Jay Belanger diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index ff4e5d71dce..58eabf9bcec 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2040,24 +2040,23 @@ complicated. Also, the boundaries of the countries were different at the times of the calendar changes than they are now. The Vatican decided that the Gregorian calendar should take effect on 15 October 1582 (Gregorian), and many Catholic countries made -the change then. Great Britian and its colonies had the Gregorian +the change then. Great Britain and its colonies had the Gregorian calendar take effect on 14 September 1752 (Gregorian); this includes the United States." :group 'calc :version "24.4" :type '(choice (const :tag "Always use the Gregorian calendar" nil) - (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) - (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) - (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) - (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) - (const :tag "France (1582 12 20)" (1582 12 20 577802)) - (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) - (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) - (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) - (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) - (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) - (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) - (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) + (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) + (const :tag "1582-12-20 - France" (1582 12 20 577802)) + (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807)) + (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195)) + (const :tag "1587-11-01 - Hungary" (1587 11 1 579579)) + (const :tag "1700-03-01 - Denmark" (1700 3 1 620607)) + (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924)) + (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797)) + (const :tag "1753-03-01 - Sweden" (1753 3 1 639965)) + (const :tag "1918-02-14 - Russia" (1918 2 14 700214)) + (const :tag "1919-04-14 - Romania" (1919 4 14 700638)) (list :tag "(YEAR MONTH DAY)" (integer :tag "Year") (integer :tag "Month (integer)") -- cgit v1.3 From 0e70ce9335996bd21c6b7f4ae0bf6b2924b89d4f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 22 Nov 2012 00:39:27 -0800 Subject: Document Calc Gregorian in NEWS; fix manual a bit. --- doc/misc/ChangeLog | 6 ++++ doc/misc/calc.texi | 102 +++++++++++++++++++++++++++-------------------------- etc/ChangeLog | 4 +++ etc/NEWS | 14 ++++++++ 4 files changed, 76 insertions(+), 50 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 67cbd40a0a3..7c56d56fd73 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,9 @@ +2012-11-22 Paul Eggert + + * calc.texi: Fix TeX issues with capitals followed by ".", "?", "!". + (Date Forms): Correct off-by-one error in explanation of + Julian day numbers. Give Gregorian equivalent of its origin. + 2012-11-22 Jay Belanger * doc/misc/calc.texi (Date Forms): Mention the customizable diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 761d4deefe4..0ce1efbff58 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -1186,7 +1186,7 @@ since the large integer arithmetic was there anyway it seemed only fair to give the user direct access to it, which in turn made it practical to support fractions as well as floats. All these features inspired me to look around for other data types that might be worth -having. +having. Around this time, my friend Rick Koshi showed me his nifty new HP-28 calculator. It allowed the user to manipulate formulas as well as @@ -4461,7 +4461,7 @@ date by one or several months. @xref{Date Arithmetic}, for more. Friday the 13th? @xref{Types Answer 5, 5}. (@bullet{}) (@bullet{}) @strong{Exercise 6.} How many leap years will there be -between now and the year 10001 A.D.? @xref{Types Answer 6, 6}. (@bullet{}) +between now and the year 10001 AD@? @xref{Types Answer 6, 6}. (@bullet{}) @cindex Slope and angle of a line @cindex Angle and slope of a line @@ -5693,7 +5693,7 @@ on the stack, we want to be able to type @kbd{*} and get the result rearranged. (This one is rather tricky; the solution at the end of this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)} condition tests whether @samp{x} is a number.) @xref{Rewrites Answer -6, 6}. (@bullet{}) +6, 6}. (@bullet{}) Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}. What happens? (Be sure to remove this rule afterward, or you might get @@ -8697,7 +8697,7 @@ Multiplying by the conjugate helps because @expr{(a+b) (a-b) = a^2 - b^2}. @smallexample @group ___ -1: V 2 +1: V 2 . a r a*(b+c) := a*b + a*c @@ -8897,7 +8897,7 @@ Note that this rule does not mention @samp{O} at all, so it will apply to any product-of-sum it encounters---this rule may surprise you if you put it into @code{EvalRules}! -In the second rule, the sum of two O's is changed to the smaller O. +In the second rule, the sum of two O's is changed to the smaller O@. The optional constant coefficients are there mostly so that @samp{O(x^2) - O(x^3)} and @samp{O(x^3) - O(x^2)} are handled as well as @samp{O(x^2) + O(x^3)}. @@ -10987,7 +10987,7 @@ Input is flexible; date forms can be entered in any of the usual notations for dates and times. @xref{Date Formats}. Date forms are stored internally as numbers, specifically the number -of days since midnight on the morning of December 31 of the year 1 BC. +of days since midnight on the morning of December 31 of the year 1 BC@. If the internal number is an integer, the form represents a date only; if the internal number is a fraction or float, the form represents a date and time. For example, @samp{<6:00am Thu Jan 10, 1991>} @@ -11010,13 +11010,13 @@ You can use the @kbd{v p} (@code{calc-pack}) and @kbd{v u} of a date form. @xref{Packing and Unpacking}. Date forms can go arbitrarily far into the future or past. Negative -year numbers represent years BC. There is no ``year 0''; the day +year numbers represent years BC@. There is no ``year 0''; the day before @samp{} is @samp{}. These are days 1 and 0 respectively in Calc's internal numbering scheme. The Gregorian calendar is used for all dates, including dates before the Gregorian calendar was invented (although that can be configured; see below). Thus Calc's use of the day number @mathit{-10000} to -represent August 15, 28 BC should be taken with a grain of salt. +represent August 15, 28 BC should be taken with a grain of salt. @cindex Julian calendar @cindex Gregorian calendar @@ -11025,7 +11025,7 @@ Julius Caesar in the year 46 BC as an attempt to fix the confusion caused by the irregular Roman calendar that was used before that time. The Julian calendar introduced an extra day in all years divisible by four. After some initial confusion, the calendar was adopted around -the year we call 8 AD. Some centuries later it became +the year we call 8 AD@. Some centuries later it became apparent that the Julian year of 365.25 days was itself not quite right. In 1582 Pope Gregory XIII introduced the Gregorian calendar, which added the new rule that years divisible by 100, but not by 400, @@ -11039,39 +11039,41 @@ was September 14. To take another example, Russia did not adopt the Gregorian calendar until 1918, and that year in Russia the day after January 31 was February 14. Calc's reckoning therefore matches English practice starting in 1752 and Russian practice starting in 1918, but -disagrees with earlier dates in both countries. +disagrees with earlier dates in both countries. When the Julian calendar was introduced, it had January 1 as the first day of the year. By the Middle Ages, many European countries had changed the beginning of a new year to a different date, often to a religious festival. Almost all countries reverted to using January 1 as the beginning of the year by the time they adopted the Gregorian -calendar. +calendar. Some calendars attempt to mimic the historical situation by using the Gregorian calendar for recent dates and the Julian calendar for older dates. The @code{cal} program in most Unix implementations does this, for example. While January 1 wasn't always the beginning of a calendar year, these hybrid calendars still use January 1 as the beginning of -the year even for older dates. The customizable variable +the year even for older dates. The customizable variable @code{calc-gregorian-switch} (@pxref{Customizing Calc}) can be set to have Calc's date forms switch from the Julian to Gregorian calendar at -any specified date. +any specified date. Today's timekeepers introduce an occasional ``leap second''. These do not occur regularly and Calc does not take these minor effects into account. (If it did, it would have to report a -non-integer number of days between, say, -@samp{<12:00am Mon Jan 1, 1900>} and +non-integer number of days between, say, +@samp{<12:00am Mon Jan 1, 1900>} and @samp{<12:00am Sat Jan 1, 2000>}.) @cindex Julian day counting Another day counting system in common use is, confusingly, also called -``Julian.'' The Julian day number is the numbers of days since -12:00 noon (GMT) on Jan 1, 4713 BC, which in Calc's scheme (in GMT) -is @mathit{-1721423.5} (recall that Calc starts at midnight instead -of noon). Thus to convert a Calc date code obtained by unpacking a -date form into a Julian day number, simply add 1721423.5 after +``Julian.'' Julian days go from noon to noon. The Julian day number +is the numbers of days since 12:00 noon (GMT) on November 24, 4714 BC +in the Gregorian calendar (i.e., January 1, 4713 BC in the Julian +calendar). In Calc's scheme (in GMT) the Julian day origin is +@mathit{-1721422.5}, because Calc starts at midnight instead of noon. +Thus to convert a Calc date code obtained by unpacking a +date form into a Julian day number, simply add 1721422.5 after compensating for the time zone difference. The built-in @kbd{t J} command performs this conversion for you. @@ -11103,7 +11105,7 @@ the Julian cycle as an astronomical dating system; this idea was taken up by other astronomers. (At the time, noon was the start of the astronomical day. Herschel originally suggested counting the days since Jan 1, 4713 BC at noon Alexandria time; this was later amended to -noon GMT.) Julian day numbering is largely used in astronomy. +noon GMT@.) Julian day numbering is largely used in astronomy. @cindex Unix time format The Unix operating system measures time as an integer number of @@ -12651,7 +12653,7 @@ are simplified with their unit definitions in mind. A common technique is to set the simplification mode down to the lowest amount of simplification you will allow to be applied automatically, then use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to -perform higher types of simplifications on demand. +perform higher types of simplifications on demand. @node Declarations, Display Modes, Simplification Modes, Mode Settings @section Declarations @@ -13002,7 +13004,7 @@ The @code{dneg} function checks for negative reals. The @code{dnonneg} function checks for nonnegative reals, i.e., reals greater than or equal to zero. Note that Calc's algebraic simplifications, which are effectively applied to all conditions in rewrite rules, can simplify -an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. +an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} are rarely necessary. @@ -13437,7 +13439,7 @@ the time part. The punctuation characters (including spaces) must match exactly; letter fields must correspond to suitable text in the input. If this doesn't work, Calc checks if the input is a simple number; if so, the number is interpreted as a number of days -since Jan 1, 1 AD. Otherwise, Calc tries a much more relaxed and +since Jan 1, 1 AD@. Otherwise, Calc tries a much more relaxed and flexible algorithm which is described in the next section. Weekday names are ignored during reading. @@ -14666,7 +14668,7 @@ Subscripts use double square brackets: @samp{a[[i]]}. The @kbd{d W} (@code{calc-maple-language}) command selects the conventions of Maple. -Maple's language is much like C. Underscores are allowed in symbol +Maple's language is much like C@. Underscores are allowed in symbol names; square brackets are used for subscripts; explicit @samp{*}s for multiplications are required. Use either @samp{^} or @samp{**} to denote powers. @@ -16727,7 +16729,7 @@ number (i.e., pervasively). If the simplification mode is set below basic simplification, it is raised for the purposes of this command. Thus, @kbd{c c} applies the basic simplifications even if their automatic application is disabled. -@xref{Simplification Modes}. +@xref{Simplification Modes}. @cindex Roundoff errors, correcting A numeric prefix argument to @kbd{c c} sets the floating-point precision @@ -16804,7 +16806,7 @@ additional argument from the top of the stack. @pindex calc-date @tindex date The @kbd{t D} (@code{calc-date}) [@code{date}] command converts a -date form into a number, measured in days since Jan 1, 1 AD. The +date form into a number, measured in days since Jan 1, 1 AD@. The result will be an integer if @var{date} is a pure date form, or a fraction or float if @var{date} is a date/time form. Or, if its argument is a number, it converts this number into a date form. @@ -16842,7 +16844,7 @@ The last two arguments default to zero if omitted. @cindex Julian day counts, conversions The @kbd{t J} (@code{calc-julian}) [@code{julian}] command converts a date form into a Julian day count, which is the number of days -since noon (GMT) on Jan 1, 4713 BC. A pure date is converted to an +since noon (GMT) on Jan 1, 4713 BC@. A pure date is converted to an integer Julian count representing noon of that day. A date/time form is converted to an exact floating-point Julian count, adjusted to interpret the date form in the current time zone but the Julian @@ -18988,7 +18990,7 @@ modulo operation as numbers 39 and below.) If @var{m} is a power of ten, however, the numbers should be completely unbiased. The Gaussian random numbers generated by @samp{random(0.0)} use the -``polar'' method described in Knuth section 3.4.1C. This method +``polar'' method described in Knuth section 3.4.1C@. This method generates a pair of Gaussian random numbers at a time, so only every other call to @samp{random(0.0)} will require significant calculations. @@ -22188,7 +22190,7 @@ Use @kbd{a v} if you want the variables to ignore their stored values. If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies using Calc's algebraic simplifications; @pxref{Simplifying Formulas}. If you give a numeric prefix of 3 or more, it uses Extended -Simplification mode (@kbd{a e}). +Simplification mode (@kbd{a e}). If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3}, it simplifies in the corresponding mode but only works on the top-level @@ -22261,7 +22263,7 @@ If inequalities with opposite direction (e.g., @samp{<} and @samp{>}) are mapped, the direction of the second inequality is reversed to match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2} reverses the latter to get @samp{2 < a}, which then allows the -combination @samp{a + 2 < b + a}, which the algebraic simplifications +combination @samp{a + 2 < b + a}, which the algebraic simplifications can reduce to @samp{2 < b}. Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate @@ -22408,7 +22410,7 @@ common special case of regular arithmetic commands like @kbd{+} and @kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack and collected into a suitable function call, which is then simplified (the arguments being simplified first as part of the process, as -described above). +described above). Even the basic set of simplifications are too numerous to describe completely here, but this section will describe the ones that apply to the @@ -22714,7 +22716,7 @@ the algebraic simplification mode, which is the default simplification mode. If you have switched to a different simplification mode, you can switch back with the @kbd{m A} command. Even in other simplification modes, the @kbd{a s} command will use these algebraic simplifications to -simplify the formula. +simplify the formula. There is a variable, @code{AlgSimpRules}, in which you can put rewrites to be applied. Its use is analogous to @code{EvalRules}, @@ -22751,7 +22753,7 @@ This allows easier comparison of products; for example, the basic simplifications will not change @expr{x y + y x} to @expr{2 x y}, but the algebraic simplifications; it first rewrites the sum to @expr{x y + x y} which can then be recognized as a sum of identical -terms. +terms. The canonical ordering used to sort terms of products has the property that real-valued numbers, interval forms and infinities @@ -22794,10 +22796,10 @@ factor in the numerator and denominator, it is canceled out; for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}. Non-constant common factors are not found even by algebraic -simplifications. To cancel the factor @expr{a} in +simplifications. To cancel the factor @expr{a} in @expr{(a x + a) / a^2} you could first use @kbd{j M} on the product @expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be -simplified successfully. +simplified successfully. @tex \bigskip @@ -22950,7 +22952,7 @@ as is @expr{x^2 >= 0} if @expr{x} is known to be real. @tindex esimplify Calc is capable of performing some simplifications which may sometimes be desired but which are not ``safe'' in all cases. The @kbd{a e} -(@code{calc-simplify-extended}) [@code{esimplify}] command +(@code{calc-simplify-extended}) [@code{esimplify}] command applies the algebraic simplifications as well as these extended, or ``unsafe'', simplifications. Use this only if you know the values in your formula lie in the restricted ranges for which these @@ -23594,10 +23596,10 @@ forever!) @vindex IntegSimpRules Another set of rules, stored in @code{IntegSimpRules}, are applied every time the integrator uses algebraic simplifications to simplify an -intermediate result. For example, putting the rule +intermediate result. For example, putting the rule @samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to convert the @code{twice} function into a form it knows whenever -integration is attempted. +integration is attempted. One more way to influence the integrator is to define a function with the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's @@ -26762,7 +26764,7 @@ meta-variable @expr{v}. As usual, if this meta-variable has already been matched to something else the two values must be equal; if the meta-variable is new then it is bound to the result of the expression. This variable can then appear in later conditions, and on the righthand -side of the rule. +side of the rule. In fact, @expr{v} may be any pattern in which case the result of evaluating @expr{x} is matched to that pattern, binding any meta-variables that appear in that pattern. Note that @code{let} @@ -27516,7 +27518,7 @@ but only when algebraic simplifications are used to simplify the formula. The variable @code{AlgSimpRules} holds rules for this purpose. The @kbd{a s} command will apply @code{EvalRules} and @code{AlgSimpRules} to the formula, as well as all of its built-in -simplifications. +simplifications. Most of the special limitations for @code{EvalRules} don't apply to @code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules} @@ -27524,7 +27526,7 @@ command with an infinite repeat count as the first step of algebraic simplifications. It then applies its own built-in simplifications throughout the formula, and then repeats these two steps (along with applying the default simplifications) until no further changes are -possible. +possible. @cindex @code{ExtSimpRules} variable @cindex @code{UnitSimpRules} variable @@ -28959,9 +28961,9 @@ to select the lefthand side, execute your commands, then type All current modes apply when an @samp{=>} operator is computed, including the current simplification mode. Recall that the formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic -simplifications, but Calc's unsafe simplifications will reduce it to +simplifications, but Calc's unsafe simplifications will reduce it to @samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result -will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to +will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to Extended Simplification mode, the result will be @samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e} once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))}, @@ -29579,7 +29581,7 @@ plot on any text-only printer. @kindex g O @pindex calc-graph-output The @kbd{g O} (@code{calc-graph-output}) command sets the name of the -output file used by GNUPLOT. For some devices, notably @code{x11} and +output file used by GNUPLOT@. For some devices, notably @code{x11} and @code{windows}, there is no output file and this information is not used. Many other ``devices'' are really file formats like @code{postscript}; in these cases the output in the desired format @@ -29651,7 +29653,7 @@ window in the upper-left corner of the screen. This command has no effect if the current device is @code{windows}. The buffer called @samp{*Gnuplot Trail*} holds a transcript of the -session with GNUPLOT. This shows the commands Calc has ``typed'' to +session with GNUPLOT@. This shows the commands Calc has ``typed'' to GNUPLOT and the responses it has received. Calc tries to notice when an error message has appeared here and display the buffer for you when this happens. You can check this buffer yourself if you suspect @@ -33262,7 +33264,7 @@ in the range @samp{[0 ..@: 60)}. Date forms are stored as @samp{(date @var{n})}, where @var{n} is a real number that counts days since midnight on the morning of -January 1, 1 AD. If @var{n} is an integer, this is a pure date +January 1, 1 AD@. If @var{n} is an integer, this is a pure date form. If @var{n} is a fraction or float, this is a date/time form. Modulo forms are stored as @samp{(mod @var{n} @var{m})}, where @var{m} is a @@ -33770,7 +33772,7 @@ objects into a definite, consistent order. The @code{beforep} function is used by the @kbd{V S} vector-sorting command, and also by Calc's algebraic simplifications to put the terms of a product into canonical order: This allows @samp{x y + y x} to be simplified easily to -@samp{2 x y}. +@samp{2 x y}. @end defun @defun equal x y @@ -35605,11 +35607,11 @@ be preserved. The default value of @code{calc-undo-length} is @expr{100}. @defvar calc-gregorian-switch See @ref{Date Forms}.@* -The variable @code{calc-gregorian-switch} is either a list of integers +The variable @code{calc-gregorian-switch} is either a list of integers @code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}. If it is @code{nil}, then Calc's date forms always represent Gregorian dates. Otherwise, @code{calc-gregorian-switch} represents the date that the -calendar switches from Julian dates to Gregorian dates; +calendar switches from Julian dates to Gregorian dates; @code{(@var{YEAR} @var{MONTH} @var{DAY})} will be the first Gregorian date. The customization buffer will offer several standard dates to choose from, or the user can enter their own date. diff --git a/etc/ChangeLog b/etc/ChangeLog index 60d4a7aa271..6056336dff6 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2012-11-22 Paul Eggert + + * NEWS: Document Calc changes for Gregorian calendar. + 2012-10-26 Nicolas Goaziou * refcards/orgcard.tex: Fix keybindings about diff --git a/etc/NEWS b/etc/NEWS index 090715587d3..d1665fb3b70 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -29,6 +29,20 @@ so we will look at it and add it to the manual. * Changes in Specialized Modes and Packages in Emacs 24.4 +** Calc + +*** Calc by default now uses the Gregorian calendar for all dates, and +uses January 1, 1 AD as its day number 1. Previously Calc used the +Julian calendar for dates before September 14, 1752, and it used +December 31, 1 BC as its day number 1; the new scheme is more +consistent with Calendar's calendrical system and day numbering. + +*** The new variable `calc-gregorian-switch' lets you configure the +date when Calc switches from the Julian to the Gregorian calendar. +Nil, the default value, means to always use the Gregorian calendar. +The value (YEAR MONTH DAY) means to start using the Gregorian calendar +on the given date. + +++ ** New function `ses-rename-cell' to give SES cells arbitrary names. -- cgit v1.3 From 5c74767510841c8afc35f66f5cb068fe99f29615 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Thu, 22 Nov 2012 13:32:32 +0400 Subject: * alloc.c (Fgarbage_collect): Unblock input after clearing gc_in_progress to avoid note_mouse_highlight glitch with GC. * frame.h (FRAME_MOUSE_UPDATE): New macro. * msdos.c (IT_frame_up_to_date): Use it here... * w32term.c (w32_frame_up_to_date): ...here... * xterm.c (XTframe_up_to_date): ...and here... * nsterm.m (ns_frame_up_to_date): ...but not here. * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member. Adjust users. * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight): Do not check whether GC is in progress. --- src/ChangeLog | 14 ++++++++++++++ src/alloc.c | 4 ++-- src/frame.h | 15 +++++++++++++++ src/lisp.h | 4 ---- src/msdos.c | 15 +-------------- src/nsterm.m | 25 ++++++++++--------------- src/w32term.c | 17 +---------------- src/xdisp.c | 10 ++-------- src/xterm.c | 18 +----------------- 9 files changed, 46 insertions(+), 76 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 4a4572bdd63..2e485f1b87b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,17 @@ +2012-11-22 Dmitry Antipov + + * alloc.c (Fgarbage_collect): Unblock input after clearing + gc_in_progress to avoid note_mouse_highlight glitch with GC. + * frame.h (FRAME_MOUSE_UPDATE): New macro. + * msdos.c (IT_frame_up_to_date): Use it here... + * w32term.c (w32_frame_up_to_date): ...here... + * xterm.c (XTframe_up_to_date): ...and here... + * nsterm.m (ns_frame_up_to_date): ...but not here. + * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member. + Adjust users. + * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight): + Do not check whether GC is in progress. + 2012-11-22 Dmitry Antipov * xdisp.c (window_buffer_changed): New function. diff --git a/src/alloc.c b/src/alloc.c index 46b2dde93a3..28c9b51dab4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5331,12 +5331,12 @@ See Info node `(elisp)Garbage Collection'. */) dump_zombies (); #endif - unblock_input (); - check_cons_list (); gc_in_progress = 0; + unblock_input (); + consing_since_gc = 0; if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; diff --git a/src/frame.h b/src/frame.h index 35cbc44becc..87c4fcb0555 100644 --- a/src/frame.h +++ b/src/frame.h @@ -933,6 +933,21 @@ typedef struct frame *FRAME_PTR; && (frame_var = XCAR (list_var), 1)); \ list_var = XCDR (list_var)) +/* Reflect mouse movement when a complete frame update is performed. */ + +#define FRAME_MOUSE_UPDATE(frame) \ + do { \ + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); \ + if (frame == hlinfo->mouse_face_mouse_frame) \ + { \ + block_input (); \ + if (hlinfo->mouse_face_mouse_frame) \ + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \ + hlinfo->mouse_face_mouse_x, \ + hlinfo->mouse_face_mouse_y); \ + unblock_input (); \ + } \ + } while (0) extern Lisp_Object Qframep, Qframe_live_p; extern Lisp_Object Qtty, Qtty_type; diff --git a/src/lisp.h b/src/lisp.h index 4817c6eb990..419176d06c8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1649,10 +1649,6 @@ typedef struct { int mouse_face_face_id; Lisp_Object mouse_face_overlay; - /* 1 if a mouse motion event came and we didn't handle it right away because - gc was in progress. */ - int mouse_face_deferred_gc; - /* FRAME and X, Y position of mouse when last checked for highlighting. X and Y can be negative or out of range for the frame. */ struct frame *mouse_face_mouse_frame; diff --git a/src/msdos.c b/src/msdos.c index dd05a8b2c5d..433bf1074d8 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1275,7 +1275,6 @@ IT_update_begin (struct frame *f) hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = NULL; } @@ -1295,21 +1294,10 @@ IT_update_end (struct frame *f) static void IT_frame_up_to_date (struct frame *f) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); Lisp_Object new_cursor, frame_desired_cursor; struct window *sw; - if (hlinfo->mouse_face_deferred_gc - || (f && f == hlinfo->mouse_face_mouse_frame)) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } + FRAME_MOUSE_UPDATE (f); /* Set the cursor type to whatever they wanted. In a minibuffer window, we want the cursor to appear only if we are reading input @@ -1849,7 +1837,6 @@ internal_terminal_init (void) FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1]; } the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL; - the_only_display_info.mouse_highlight.mouse_face_deferred_gc = 0; the_only_display_info.mouse_highlight.mouse_face_beg_row = the_only_display_info.mouse_highlight.mouse_face_beg_col = -1; the_only_display_info.mouse_highlight.mouse_face_end_row = diff --git a/src/nsterm.m b/src/nsterm.m index 57d32ee0528..25eb7ebc495 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1186,7 +1186,6 @@ x_free_frame_resources (struct frame *f) hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } @@ -1887,8 +1886,7 @@ static void ns_frame_up_to_date (struct frame *f) /* -------------------------------------------------------------------------- External (hook): Fix up mouse highlighting right after a full update. - Some highlighting was deferred if GC was happening during - note_mouse_highlight (), while other highlighting was deferred for update. + Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls. -------------------------------------------------------------------------- */ { NSTRACE (ns_frame_up_to_date); @@ -1896,19 +1894,17 @@ ns_frame_up_to_date (struct frame *f) if (FRAME_NS_P (f)) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame) - /*&& hlinfo->mouse_face_mouse_frame*/) - { - block_input (); + if (f == hlinfo->mouse_face_mouse_frame) + { + block_input (); ns_update_begin(f); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); ns_update_end(f); - unblock_input (); - } + unblock_input (); + } } } @@ -3869,7 +3865,6 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo) dpyinfo->root_window = 42; /* a placeholder.. */ hlinfo->mouse_face_mouse_frame = NULL; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; diff --git a/src/w32term.c b/src/w32term.c index 032912c27f4..ab6afd32c75 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -723,21 +723,7 @@ static void w32_frame_up_to_date (struct frame *f) { if (FRAME_W32_P (f)) - { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - - if (hlinfo->mouse_face_deferred_gc - || f == hlinfo->mouse_face_mouse_frame) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } - } + FRAME_MOUSE_UPDATE (f); } @@ -5979,7 +5965,6 @@ x_free_frame_resources (struct frame *f) hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } diff --git a/src/xdisp.c b/src/xdisp.c index e9b20d148c7..5d260d851ef 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9642,7 +9642,7 @@ message2_nolog (const char *m, ptrdiff_t nbytes, int multibyte) do_pending_window_change (0); echo_area_display (1); do_pending_window_change (0); - if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) + if (FRAME_TERMINAL (f)->frame_up_to_date_hook) (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); } } @@ -9739,7 +9739,7 @@ message3_nolog (Lisp_Object m, ptrdiff_t nbytes, int multibyte) do_pending_window_change (0); echo_area_display (1); do_pending_window_change (0); - if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) + if (FRAME_TERMINAL (f)->frame_up_to_date_hook) (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); } } @@ -27685,12 +27685,6 @@ note_mouse_highlight (struct frame *f, int x, int y) if (hlinfo->mouse_face_defer) return; - if (gc_in_progress) - { - hlinfo->mouse_face_deferred_gc = 1; - return; - } - /* Which window is that in? */ window = window_from_coordinates (f, x, y, &part, 1); diff --git a/src/xterm.c b/src/xterm.c index 463d82b4ee2..61e942e10d2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -669,21 +669,7 @@ static void XTframe_up_to_date (struct frame *f) { if (FRAME_X_P (f)) - { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - - if (hlinfo->mouse_face_deferred_gc - || f == hlinfo->mouse_face_mouse_frame) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } - } + FRAME_MOUSE_UPDATE (f); } @@ -9502,7 +9488,6 @@ x_free_frame_resources (struct frame *f) hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } @@ -10153,7 +10138,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->bitmaps_last = 0; dpyinfo->scratch_cursor_gc = 0; hlinfo->mouse_face_mouse_frame = 0; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; -- cgit v1.3 From aa8715fbdb6c619666f7213a9ec8615b31b01517 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 22 Nov 2012 06:17:34 -0500 Subject: Auto-commit of generated files. --- autogen/config.in | 9 --------- autogen/configure | 20 +------------------- 2 files changed, 1 insertion(+), 28 deletions(-) diff --git a/autogen/config.in b/autogen/config.in index 9f664063761..9f530cc57d3 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -50,9 +50,6 @@ along with GNU Emacs. If not, see . */ /* Define to the number of bits in type 'wint_t'. */ #undef BITSIZEOF_WINT_T -/* Define if getwd should not be used. */ -#undef BROKEN_GETWD - /* Define if get_current_dir_name should not be used. */ #undef BROKEN_GET_CURRENT_DIR_NAME @@ -402,9 +399,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `getaddrinfo' function. */ #undef HAVE_GETADDRINFO -/* Define to 1 if you have the `getcwd' function. */ -#undef HAVE_GETCWD - /* Define to 1 if you have the `getdelim' function. */ #undef HAVE_GETDELIM @@ -453,9 +447,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `gettimeofday' function. */ #undef HAVE_GETTIMEOFDAY -/* Define to 1 if you have the `getwd' function. */ -#undef HAVE_GETWD - /* Define to 1 if you have the `get_current_dir_name' function. */ #undef HAVE_GET_CURRENT_DIR_NAME diff --git a/autogen/configure b/autogen/configure index 79a7c8ba066..0558955911f 100755 --- a/autogen/configure +++ b/autogen/configure @@ -13477,7 +13477,7 @@ for ac_func in gethostname \ closedir getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ -utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ +utimes getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ gai_strerror mkstemp getline getdelim fsync sync \ @@ -13498,24 +13498,6 @@ fi done -if test $opsys = unixware; then - -$as_echo "#define BROKEN_GETWD 1" >>confdefs.h - -else - for ac_func in getwd -do : - ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" -if test "x$ac_cv_func_getwd" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETWD 1 -_ACEOF - -fi -done - -fi - ## Eric Backus says, HP-UX 9.x on HP 700 machines ## has a broken `rint' in some library versions including math library ## version number A.09.05. -- cgit v1.3 From 15c9d04ea4b75254aef346161998e08509736fc0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 22 Nov 2012 22:26:09 -0500 Subject: * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. --- lisp/ChangeLog | 8 +- lisp/emacs-lisp/ert-x.el | 47 ++- lisp/emacs-lisp/ert.el | 789 ++++++++++++++++++++++++----------------------- 3 files changed, 429 insertions(+), 415 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01d6ce0d865..1fb8ca6d67e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-11-23 Stefan Monnier + + * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. + 2012-11-22 Paul Eggert * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh @@ -5,8 +9,8 @@ (calc-gregorian-switch): In menu, put dates before regions. This is easier to follow, lines up better in the menu, and lets us coalesce regions that switch at the same time. Give country - names, not "Vatican", as that's better for non-expert users. Use - names that are stable between the date of switch and now, e.g., + names, not "Vatican", as that's better for non-expert users. + Use names that are stable between the date of switch and now, e.g., Bohemia and Moravia (which existed then and now) and not Czechoslovakia (which didn't exist then and doesn't exist now). What is now the U.S. mostly did not switch at the same time as diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index c3b8e5e10d4..60d74774e87 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -1,4 +1,4 @@ -;;; ert-x.el --- Staging area for experimental extensions to ERT +;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*- ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. @@ -28,8 +28,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'ert) @@ -90,8 +89,8 @@ ERT--THUNK with that buffer as current." (kill-buffer ert--buffer) (remhash ert--buffer ert--test-buffers)))) -(defmacro* ert-with-test-buffer ((&key ((:name name-form))) - &body body) +(cl-defmacro ert-with-test-buffer ((&key ((:name name-form))) + &body body) "Create a test buffer and run BODY in that buffer. To be used in ERT tests. If BODY finishes successfully, the test @@ -116,10 +115,10 @@ the name of the test and the result of NAME-FORM." "Kill all test buffers that are still live." (interactive) (let ((count 0)) - (maphash (lambda (buffer dummy) + (maphash (lambda (buffer _dummy) (when (or (not (buffer-live-p buffer)) (kill-buffer buffer)) - (incf count))) + (cl-incf count))) ert--test-buffers) (message "%s out of %s test buffers killed" count (hash-table-count ert--test-buffers))) @@ -149,9 +148,9 @@ the rest are arguments to the command. NOTE: Since the command is not called by `call-interactively' test for `called-interactively' in the command will fail." - (assert (listp command) t) - (assert (commandp (car command)) t) - (assert (not unread-command-events) t) + (cl-assert (listp command) t) + (cl-assert (commandp (car command)) t) + (cl-assert (not unread-command-events) t) (let (return-value) ;; For the order of things here see command_loop_1 in keyboard.c. ;; @@ -175,7 +174,7 @@ test for `called-interactively' in the command will fail." (when (boundp 'last-repeatable-command) (setq last-repeatable-command real-last-command)) (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) - (assert (not unread-command-events) t) + (cl-assert (not unread-command-events) t) return-value)) (defun ert-run-idle-timers () @@ -198,7 +197,7 @@ rather than the entire match." (with-temp-buffer (insert s) (dolist (x regexps) - (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) + (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (replace-match "" t t nil subexp)))) @@ -224,15 +223,15 @@ would return the string \"foo bar baz quux\" where the substring None of the ARGS are modified, but the return value may share structure with the plists in ARGS." (with-temp-buffer - (loop with current-plist = nil - for x in args do - (etypecase x - (string (let ((begin (point))) - (insert x) - (set-text-properties begin (point) current-plist))) - (list (unless (zerop (mod (length x) 2)) - (error "Odd number of args in plist: %S" x)) - (setq current-plist x)))) + (cl-loop with current-plist = nil + for x in args do + (cl-etypecase x + (string (let ((begin (point))) + (insert x) + (set-text-properties begin (point) current-plist))) + (list (unless (zerop (mod (length x) 2)) + (error "Odd number of args in plist: %S" x)) + (setq current-plist x)))) (buffer-string))) @@ -245,8 +244,8 @@ buffer, and renames the original buffer back to BUFFER-NAME. This is useful if THUNK has undesirable side-effects on an Emacs buffer with a fixed name such as *Messages*." - (lexical-let ((new-buffer-name (generate-new-buffer-name - (format "%s orig buffer" buffer-name)))) + (let ((new-buffer-name (generate-new-buffer-name + (format "%s orig buffer" buffer-name)))) (with-current-buffer (get-buffer-create buffer-name) (rename-buffer new-buffer-name)) (unwind-protect @@ -258,7 +257,7 @@ buffer with a fixed name such as *Messages*." (with-current-buffer new-buffer-name (rename-buffer buffer-name))))) -(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body) +(cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body) "Protect the buffer named BUFFER-NAME from side-effects and run BODY. See `ert-call-with-buffer-renamed' for details." diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 9cbf417d876..ab6dcb58143 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1,4 +1,4 @@ -;;; ert.el --- Emacs Lisp Regression Testing +;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. @@ -54,8 +54,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'button) (require 'debug) (require 'easymenu) @@ -105,33 +104,33 @@ "A reimplementation of `remove-if-not'. ERT-PRED is a predicate, ERT-LIST is the input list." - (loop for ert-x in ert-list - if (funcall ert-pred ert-x) - collect ert-x)) + (cl-loop for ert-x in ert-list + if (funcall ert-pred ert-x) + collect ert-x)) (defun ert--intersection (a b) "A reimplementation of `intersection'. Intersect the sets A and B. Elements are compared using `eql'." - (loop for x in a - if (memql x b) - collect x)) + (cl-loop for x in a + if (memql x b) + collect x)) (defun ert--set-difference (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eql'." - (loop for x in a - unless (memql x b) - collect x)) + (cl-loop for x in a + unless (memql x b) + collect x)) (defun ert--set-difference-eq (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eq'." - (loop for x in a - unless (memq x b) - collect x)) + (cl-loop for x in a + unless (memq x b) + collect x)) (defun ert--union (a b) "A reimplementation of `union'. Compute the union of the sets A and B. @@ -149,7 +148,7 @@ Elements are compared using `eql'." (make-symbol (format "%s%s" prefix (prog1 ert--gensym-counter - (incf ert--gensym-counter)))))) + (cl-incf ert--gensym-counter)))))) (defun ert--coerce-to-vector (x) "Coerce X to a vector." @@ -158,19 +157,19 @@ Elements are compared using `eql'." x (vconcat x))) -(defun* ert--remove* (x list &key key test) +(cl-defun ert--remove* (x list &key key test) "Does not support all the keywords of remove*." (unless key (setq key #'identity)) (unless test (setq test #'eql)) - (loop for y in list - unless (funcall test x (funcall key y)) - collect y)) + (cl-loop for y in list + unless (funcall test x (funcall key y)) + collect y)) (defun ert--string-position (c s) "Return the position of the first occurrence of C in S, or nil if none." - (loop for i from 0 - for x across s - when (eql x c) return i)) + (cl-loop for i from 0 + for x across s + when (eql x c) return i)) (defun ert--mismatch (a b) "Return index of first element that differs between A and B. @@ -184,29 +183,30 @@ Like `mismatch'. Uses `equal' for comparison." (t (let ((la (length a)) (lb (length b))) - (assert (arrayp a) t) - (assert (arrayp b) t) - (assert (<= la lb) t) - (loop for i below la - when (not (equal (aref a i) (aref b i))) return i - finally (return (if (/= la lb) - la - (assert (equal a b) t) - nil))))))) + (cl-assert (arrayp a) t) + (cl-assert (arrayp b) t) + (cl-assert (<= la lb) t) + (cl-loop for i below la + when (not (equal (aref a i) (aref b i))) return i + finally (cl-return (if (/= la lb) + la + (cl-assert (equal a b) t) + nil))))))) (defun ert--subseq (seq start &optional end) "Return a subsequence of SEQ from START to END." (when (char-table-p seq) (error "Not supported")) (let ((vector (substring (ert--coerce-to-vector seq) start end))) - (etypecase seq + (cl-etypecase seq (vector vector) (string (concat vector)) (list (append vector nil)) - (bool-vector (loop with result = (make-bool-vector (length vector) nil) - for i below (length vector) do - (setf (aref result i) (aref vector i)) - finally (return result))) - (char-table (assert nil))))) + (bool-vector (cl-loop with result + = (make-bool-vector (length vector) nil) + for i below (length vector) do + (setf (aref result i) (aref vector i)) + finally (cl-return result))) + (char-table (cl-assert nil))))) (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. @@ -225,10 +225,10 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;;; Defining and locating tests. ;; The data structure that represents a test case. -(defstruct ert-test +(cl-defstruct ert-test (name nil) (documentation nil) - (body (assert nil)) + (body (cl-assert nil)) (most-recent-result nil) (expected-result-type ':passed) (tags '())) @@ -273,7 +273,7 @@ Returns a two-element list containing the keys-and-values plist and the body." (let ((extracted-key-accu '()) (remaining keys-and-body)) - (while (and (consp remaining) (keywordp (first remaining))) + (while (keywordp (car-safe remaining)) (let ((keyword (pop remaining))) (unless (consp remaining) (error "Value expected after keyword %S in %S" @@ -283,13 +283,13 @@ and the body." keys-and-body)) (push (cons keyword (pop remaining)) extracted-key-accu))) (setq extracted-key-accu (nreverse extracted-key-accu)) - (list (loop for (key . value) in extracted-key-accu - collect key - collect value) + (list (cl-loop for (key . value) in extracted-key-accu + collect key + collect value) remaining))) ;;;###autoload -(defmacro* ert-deftest (name () &body docstring-keys-and-body) +(cl-defmacro ert-deftest (name () &body docstring-keys-and-body) "Define NAME (a symbol) as a test. BODY is evaluated as a `progn' when the test is run. It should @@ -313,12 +313,13 @@ description of valid values for RESULT-TYPE. (indent 2)) (let ((documentation nil) (documentation-supplied-p nil)) - (when (stringp (first docstring-keys-and-body)) + (when (stringp (car docstring-keys-and-body)) (setq documentation (pop docstring-keys-and-body) documentation-supplied-p t)) - (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) - (tags nil tags-supplied-p)) - body) + (cl-destructuring-bind + ((&key (expected-result nil expected-result-supplied-p) + (tags nil tags-supplied-p)) + body) (ert--parse-keys-and-body docstring-keys-and-body) `(progn (ert-set-test ',name @@ -405,10 +406,10 @@ DATA is displayed to the user and should state the reason of the failure." (t (let ((fn-name (car form)) (arg-forms (cdr form))) - (assert (or (symbolp fn-name) - (and (consp fn-name) - (eql (car fn-name) 'lambda) - (listp (cdr fn-name))))) + (cl-assert (or (symbolp fn-name) + (and (consp fn-name) + (eql (car fn-name) 'lambda) + (listp (cdr fn-name))))) (let ((fn (ert--gensym "fn-")) (args (ert--gensym "args-")) (value (ert--gensym "value-")) @@ -446,35 +447,34 @@ should return code that calls INNER-FORM and performs the checks and error signaling specific to the particular variant of `should'. The code that INNER-EXPANDER returns must not call FORM-DESCRIPTION-FORM before it has called INNER-FORM." - (lexical-let ((inner-expander inner-expander)) - (ert--expand-should-1 - whole form - (lambda (inner-form form-description-form value-var) - (let ((form-description (ert--gensym "form-description-"))) - `(let (,form-description) - ,(funcall inner-expander - `(unwind-protect - ,inner-form - (setq ,form-description ,form-description-form) - (ert--signal-should-execution ,form-description)) - `,form-description - value-var))))))) - -(defmacro* should (form) + (ert--expand-should-1 + whole form + (lambda (inner-form form-description-form value-var) + (let ((form-description (ert--gensym "form-description-"))) + `(let (,form-description) + ,(funcall inner-expander + `(unwind-protect + ,inner-form + (setq ,form-description ,form-description-form) + (ert--signal-should-execution ,form-description)) + `,form-description + value-var)))))) + +(cl-defmacro should (form) "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." (ert--expand-should `(should ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless ,inner-form (ert-fail ,form-description-form))))) -(defmacro* should-not (form) +(cl-defmacro should-not (form) "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." (ert--expand-should `(should-not ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless (not ,inner-form) (ert-fail ,form-description-form))))) @@ -485,10 +485,10 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (etypecase type + (handled-conditions (cl-etypecase type (list type) (symbol (list type))))) - (assert signaled-conditions) + (cl-assert signaled-conditions) (unless (ert--intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) @@ -507,7 +507,7 @@ and aborts the current test as failed if it doesn't." ;; FIXME: The expansion will evaluate the keyword args (if any) in ;; nonstandard order. -(defmacro* should-error (form &rest keys &key type exclude-subtypes) +(cl-defmacro should-error (form &rest keys &key type exclude-subtypes) "Evaluate FORM and check that it signals an error. The error signaled needs to match TYPE. TYPE should be a list @@ -555,19 +555,19 @@ failed." (defun ert--proper-list-p (x) "Return non-nil if X is a proper list, nil otherwise." - (loop + (cl-loop for firstp = t then nil for fast = x then (cddr fast) for slow = x then (cdr slow) do - (when (null fast) (return t)) - (when (not (consp fast)) (return nil)) - (when (null (cdr fast)) (return t)) - (when (not (consp (cdr fast))) (return nil)) - (when (and (not firstp) (eq fast slow)) (return nil)))) + (when (null fast) (cl-return t)) + (when (not (consp fast)) (cl-return nil)) + (when (null (cdr fast)) (cl-return t)) + (when (not (consp (cdr fast))) (cl-return nil)) + (when (and (not firstp) (eq fast slow)) (cl-return nil)))) (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." - (typecase x + (cl-typecase x (fixnum (list x (format "#x%x" x) (format "?%c" x))) (t x))) @@ -576,7 +576,7 @@ failed." Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) - (etypecase a + (cl-etypecase a (cons (let ((a-proper-p (ert--proper-list-p a)) (b-proper-p (ert--proper-list-p b))) @@ -588,19 +588,19 @@ Returns nil if they are." ,a ,b first-mismatch-at ,(ert--mismatch a b)) - (loop for i from 0 - for ai in a - for bi in b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(list-elt ,i ,xi))) - finally (assert (equal a b) t))) + (cl-loop for i from 0 + for ai in a + for bi in b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(list-elt ,i ,xi))) + finally (cl-assert (equal a b) t))) (let ((car-x (ert--explain-equal-rec (car a) (car b)))) (if car-x `(car ,car-x) (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) (if cdr-x `(cdr ,cdr-x) - (assert (equal a b) t) + (cl-assert (equal a b) t) nil)))))))) (array (if (not (equal (length a) (length b))) `(arrays-of-different-length ,(length a) ,(length b) @@ -608,12 +608,12 @@ Returns nil if they are." ,@(unless (char-table-p a) `(first-mismatch-at ,(ert--mismatch a b)))) - (loop for i from 0 - for ai across a - for bi across b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(array-elt ,i ,xi))) - finally (assert (equal a b) t)))) + (cl-loop for i from 0 + for ai across a + for bi across b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(array-elt ,i ,xi))) + finally (cl-assert (equal a b) t)))) (atom (if (not (equal a b)) (if (and (symbolp a) (symbolp b) (string= a b)) `(different-symbols-with-the-same-name ,a ,b) @@ -632,10 +632,10 @@ Returns nil if they are." (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." - (assert (zerop (mod (length plist) 2)) t) - (loop for (key value . rest) on plist by #'cddr - unless (or (null value) (memq key accu)) collect key into accu - finally (return accu))) + (cl-assert (zerop (mod (length plist) 2)) t) + (cl-loop for (key value . rest) on plist by #'cddr + unless (or (null value) (memq key accu)) collect key into accu + finally (cl-return accu))) (defun ert--plist-difference-explanation (a b) "Return a programmer-readable explanation of why A and B are different plists. @@ -643,8 +643,8 @@ Returns nil if they are." Returns nil if they are equivalent, i.e., have the same value for each key, where absent values are treated as nil. The order of key/value pairs in each list does not matter." - (assert (zerop (mod (length a) 2)) t) - (assert (zerop (mod (length b) 2)) t) + (cl-assert (zerop (mod (length a) 2)) t) + (cl-assert (zerop (mod (length b) 2)) t) ;; Normalizing the plists would be another way to do this but it ;; requires a total ordering on all lisp objects (since any object ;; is valid as a text property key). Perhaps defining such an @@ -654,21 +654,21 @@ key/value pairs in each list does not matter." (keys-b (ert--significant-plist-keys b)) (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) - (flet ((explain-with-key (key) - (let ((value-a (plist-get a key)) - (value-b (plist-get b key))) - (assert (not (equal value-a value-b)) t) - `(different-properties-for-key - ,key ,(ert--explain-equal-including-properties value-a - value-b))))) + (cl-flet ((explain-with-key (key) + (let ((value-a (plist-get a key)) + (value-b (plist-get b key))) + (cl-assert (not (equal value-a value-b)) t) + `(different-properties-for-key + ,key ,(ert--explain-equal-including-properties value-a + value-b))))) (cond (keys-in-a-not-in-b - (explain-with-key (first keys-in-a-not-in-b))) + (explain-with-key (car keys-in-a-not-in-b))) (keys-in-b-not-in-a - (explain-with-key (first keys-in-b-not-in-a))) + (explain-with-key (car keys-in-b-not-in-a))) (t - (loop for key in keys-a - when (not (equal (plist-get a key) (plist-get b key))) - return (explain-with-key key))))))) + (cl-loop for key in keys-a + when (not (equal (plist-get a key) (plist-get b key))) + return (explain-with-key key))))))) (defun ert--abbreviate-string (s len suffixp) "Shorten string S to at most LEN chars. @@ -692,29 +692,30 @@ Returns a programmer-readable explanation of why A and B are not `ert-equal-including-properties', or nil if they are." (if (not (equal a b)) (ert--explain-equal a b) - (assert (stringp a) t) - (assert (stringp b) t) - (assert (eql (length a) (length b)) t) - (loop for i from 0 to (length a) - for props-a = (text-properties-at i a) - for props-b = (text-properties-at i b) - for difference = (ert--plist-difference-explanation props-a props-b) - do (when difference - (return `(char ,i ,(substring-no-properties a i (1+ i)) - ,difference - context-before - ,(ert--abbreviate-string - (substring-no-properties a 0 i) - 10 t) - context-after - ,(ert--abbreviate-string - (substring-no-properties a (1+ i)) - 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (assert (equal-including-properties a b) t) - ))) + (cl-assert (stringp a) t) + (cl-assert (stringp b) t) + (cl-assert (eql (length a) (length b)) t) + (cl-loop for i from 0 to (length a) + for props-a = (text-properties-at i a) + for props-b = (text-properties-at i b) + for difference = (ert--plist-difference-explanation + props-a props-b) + do (when difference + (cl-return `(char ,i ,(substring-no-properties a i (1+ i)) + ,difference + context-before + ,(ert--abbreviate-string + (substring-no-properties a 0 i) + 10 t) + context-after + ,(ert--abbreviate-string + (substring-no-properties a (1+ i)) + 10 nil)))) + ;; TODO(ohler): Get `equal-including-properties' fixed in + ;; Emacs, delete `ert-equal-including-properties', and + ;; re-enable this assertion. + ;;finally (cl-assert (equal-including-properties a b) t) + ))) (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) @@ -729,8 +730,8 @@ Returns a programmer-readable explanation of why A and B are not Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") -(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) - &body body) +(cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) + &body body) "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. To be used within ERT tests. MESSAGE-FORM should evaluate to a @@ -750,18 +751,19 @@ and is displayed in front of the value of MESSAGE-FORM." "Non-nil means enter debugger when a test fails or terminates with an error.") ;; The data structures that represent the result of running a test. -(defstruct ert-test-result +(cl-defstruct ert-test-result (messages nil) (should-forms nil) ) -(defstruct (ert-test-passed (:include ert-test-result))) -(defstruct (ert-test-result-with-condition (:include ert-test-result)) - (condition (assert nil)) - (backtrace (assert nil)) - (infos (assert nil))) -(defstruct (ert-test-quit (:include ert-test-result-with-condition))) -(defstruct (ert-test-failed (:include ert-test-result-with-condition))) -(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) +(cl-defstruct (ert-test-passed (:include ert-test-result))) +(cl-defstruct (ert-test-result-with-condition (:include ert-test-result)) + (condition (cl-assert nil)) + (backtrace (cl-assert nil)) + (infos (cl-assert nil))) +(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-aborted-with-non-local-exit + (:include ert-test-result))) (defun ert--record-backtrace () @@ -774,7 +776,7 @@ and is displayed in front of the value of MESSAGE-FORM." ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we ;; already have `ert-results-rerun-test-debugging-errors-at-point'. ;; For batch use, however, printing the backtrace may be useful. - (loop + (cl-loop ;; 6 is the number of frames our own debugger adds (when ;; compiled; more when interpreted). FIXME: Need to describe a ;; procedure for determining this constant. @@ -791,33 +793,33 @@ and is displayed in front of the value of MESSAGE-FORM." (print-level 8) (print-length 50)) (dolist (frame backtrace) - (ecase (first frame) + (cl-ecase (car frame) ((nil) ;; Special operator. - (destructuring-bind (special-operator &rest arg-forms) + (cl-destructuring-bind (special-operator &rest arg-forms) (cdr frame) (insert - (format " %S\n" (list* special-operator arg-forms))))) + (format " %S\n" (cons special-operator arg-forms))))) ((t) ;; Function call. - (destructuring-bind (fn &rest args) (cdr frame) + (cl-destructuring-bind (fn &rest args) (cdr frame) (insert (format " %S(" fn)) - (loop for firstp = t then nil - for arg in args do - (unless firstp - (insert " ")) - (insert (format "%S" arg))) + (cl-loop for firstp = t then nil + for arg in args do + (unless firstp + (insert " ")) + (insert (format "%S" arg))) (insert ")\n"))))))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. -(defstruct ert--test-execution-info - (test (assert nil)) - (result (assert nil)) +(cl-defstruct ert--test-execution-info + (test (cl-assert nil)) + (result (cl-assert nil)) ;; A thunk that may be called when RESULT has been set to its final ;; value and test execution should be terminated. Should not ;; return. - (exit-continuation (assert nil)) + (exit-continuation (cl-assert nil)) ;; The binding of `debugger' outside of the execution of the test. next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the @@ -826,7 +828,7 @@ and is displayed in front of the value of MESSAGE-FORM." ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info debugger-args) +(defun ert--run-test-debugger (info args) "During a test run, `debugger' is bound to a closure that calls this function. This function records failures and errors and either terminates @@ -834,21 +836,21 @@ the test silently or calls the interactive debugger, as appropriate. INFO is the ert--test-execution-info corresponding to this test -run. DEBUGGER-ARGS are the arguments to `debugger'." - (destructuring-bind (first-debugger-arg &rest more-debugger-args) - debugger-args - (ecase first-debugger-arg +run. ARGS are the arguments to `debugger'." + (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) + args + (cl-ecase first-debugger-arg ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (error - (let* ((condition (first more-debugger-args)) - (type (case (car condition) + (let* ((condition (car more-debugger-args)) + (type (cl-case (car condition) ((quit) 'quit) (otherwise 'failed))) (backtrace (ert--record-backtrace)) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) - (ecase type + (cl-ecase type (quit (make-ert-test-quit :condition condition :backtrace backtrace @@ -859,39 +861,42 @@ run. DEBUGGER-ARGS are the arguments to `debugger'." :infos infos)))) ;; Work around Emacs's heuristic (in eval.c) for detecting ;; errors in the debugger. - (incf num-nonmacro-input-events) + (cl-incf num-nonmacro-input-events) ;; FIXME: We should probably implement more fine-grained ;; control a la non-t `debug-on-error' here. (cond ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (t)) (funcall (ert--test-execution-info-exit-continuation info))))))) -(defun ert--run-test-internal (ert-test-execution-info) - "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. +(defun ert--run-test-internal (test-execution-info) + "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (lexical-let ((info ert-test-execution-info)) - (setf (ert--test-execution-info-next-debugger info) debugger - (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) - (catch 'ert--pass - ;; For now, each test gets its own temp buffer and its own - ;; window excursion, just to be safe. If this turns out to be - ;; too expensive, we can remove it. - (with-temp-buffer - (save-window-excursion - (let ((debugger (lambda (&rest debugger-args) - (ert--run-test-debugger info debugger-args))) - (debug-on-error t) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) - (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test info)))))) - (ert-pass)) - (setf (ert--test-execution-info-result info) (make-ert-test-passed))) + (setf (ert--test-execution-info-next-debugger test-execution-info) debugger + (ert--test-execution-info-ert-debug-on-error test-execution-info) + ert-debug-on-error) + (catch 'ert--pass + ;; For now, each test gets its own temp buffer and its own + ;; window excursion, just to be safe. If this turns out to be + ;; too expensive, we can remove it. + (with-temp-buffer + (save-window-excursion + (let ((debugger (lambda (&rest args) + (ert--run-test-debugger test-execution-info + args))) + (debug-on-error t) + (debug-on-quit t) + ;; FIXME: Do we need to store the old binding of this + ;; and consider it in `ert--run-test-debugger'? + (debug-ignored-errors nil) + (ert--infos '())) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))) + (ert-pass)) + (setf (ert--test-execution-info-result test-execution-info) + (make-ert-test-passed)) nil) (defun ert--force-message-log-buffer-truncation () @@ -929,18 +934,18 @@ The elements are of type `ert-test'.") Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) - (block error - (lexical-let ((begin-marker - (with-current-buffer (get-buffer-create "*Messages*") - (set-marker (make-marker) (point-max))))) + (cl-block error + (let ((begin-marker + (with-current-buffer (get-buffer-create "*Messages*") + (set-marker (make-marker) (point-max))))) (unwind-protect - (lexical-let ((info (make-ert--test-execution-info - :test ert-test - :result - (make-ert-test-aborted-with-non-local-exit) - :exit-continuation (lambda () - (return-from error nil)))) - (should-form-accu (list))) + (let ((info (make-ert--test-execution-info + :test ert-test + :result + (make-ert-test-aborted-with-non-local-exit) + :exit-continuation (lambda () + (cl-return-from error nil)))) + (should-form-accu (list))) (unwind-protect (let ((ert--should-execution-observer (lambda (form-description) @@ -982,32 +987,32 @@ t -- Always matches. RESULT." ;; It would be easy to add `member' and `eql' types etc., but I ;; haven't bothered yet. - (etypecase result-type + (cl-etypecase result-type ((member nil) nil) ((member t) t) ((member :failed) (ert-test-failed-p result)) ((member :passed) (ert-test-passed-p result)) (cons - (destructuring-bind (operator &rest operands) result-type - (ecase operator + (cl-destructuring-bind (operator &rest operands) result-type + (cl-ecase operator (and - (case (length operands) + (cl-case (length operands) (0 t) (t - (and (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(and ,@(rest operands))))))) + (and (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(and ,@(cdr operands))))))) (or - (case (length operands) + (cl-case (length operands) (0 nil) (t - (or (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(or ,@(rest operands))))))) + (or (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(or ,@(cdr operands))))))) (not - (assert (eql (length operands) 1)) - (not (ert-test-result-type-p result (first operands)))) + (cl-assert (eql (length operands) 1)) + (not (ert-test-result-type-p result (car operands)))) (satisfies - (assert (eql (length operands) 1)) - (funcall (first operands) result))))))) + (cl-assert (eql (length operands) 1)) + (funcall (car operands) result))))))) (defun ert-test-result-expected-p (test result) "Return non-nil if TEST's expected result type matches RESULT." @@ -1048,9 +1053,9 @@ set implied by them without checking whether it is really contained in UNIVERSE." ;; This code needs to match the etypecase in ;; `ert-insert-human-readable-selector'. - (etypecase selector + (cl-etypecase selector ((member nil) nil) - ((member t) (etypecase universe + ((member t) (cl-etypecase universe (list universe) ((member t) (ert-select-tests "" universe)))) ((member :new) (ert-select-tests @@ -1078,7 +1083,7 @@ contained in UNIVERSE." universe)) ((member :unexpected) (ert-select-tests `(not :expected) universe)) (string - (etypecase universe + (cl-etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) (list (ert--remove-if-not (lambda (test) @@ -1088,51 +1093,51 @@ contained in UNIVERSE." universe)))) (ert-test (list selector)) (symbol - (assert (ert-test-boundp selector)) + (cl-assert (ert-test-boundp selector)) (list (ert-get-test selector))) (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator (member (mapcar (lambda (purported-test) - (etypecase purported-test - (symbol (assert (ert-test-boundp purported-test)) + (cl-etypecase purported-test + (symbol (cl-assert (ert-test-boundp purported-test)) (ert-get-test purported-test)) (ert-test purported-test))) operands)) (eql - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (ert-select-tests `(member ,@operands) universe)) (and ;; Do these definitions of AND, NOT and OR satisfy de ;; Morgan's laws? Should they? - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 't universe)) - (t (ert-select-tests `(and ,@(rest operands)) - (ert-select-tests (first operands) + (t (ert-select-tests `(and ,@(cdr operands)) + (ert-select-tests (car operands) universe))))) (not - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) (ert--set-difference all-tests - (ert-select-tests (first operands) + (ert-select-tests (car operands) all-tests)))) (or - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 'nil universe)) - (t (ert--union (ert-select-tests (first operands) universe) - (ert-select-tests `(or ,@(rest operands)) + (t (ert--union (ert-select-tests (car operands) universe) + (ert-select-tests `(or ,@(cdr operands)) universe))))) (tag - (assert (eql (length operands) 1)) - (let ((tag (first operands))) + (cl-assert (eql (length operands) 1)) + (let ((tag (car operands))) (ert-select-tests `(satisfies ,(lambda (test) (member tag (ert-test-tags test)))) universe))) (satisfies - (assert (eql (length operands) 1)) - (ert--remove-if-not (first operands) + (cl-assert (eql (length operands) 1)) + (ert--remove-if-not (car operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) @@ -1141,26 +1146,27 @@ contained in UNIVERSE." ;; `backtrace' slot of the result objects in the ;; `most-recent-result' slots of test case objects in (eql ...) or ;; (member ...) selectors. - (labels ((rec (selector) - ;; This code needs to match the etypecase in `ert-select-tests'. - (etypecase selector - ((or (member nil t - :new :failed :passed - :expected :unexpected) - string - symbol) - selector) - (ert-test - (if (ert-test-name selector) - (make-symbol (format "<%S>" (ert-test-name selector))) - (make-symbol ""))) - (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator - ((member eql and not or) - `(,operator ,@(mapcar #'rec operands))) - ((member tag satisfies) - selector))))))) + (cl-labels ((rec (selector) + ;; This code needs to match the etypecase in + ;; `ert-select-tests'. + (cl-etypecase selector + ((or (member nil t + :new :failed :passed + :expected :unexpected) + string + symbol) + selector) + (ert-test + (if (ert-test-name selector) + (make-symbol (format "<%S>" (ert-test-name selector))) + (make-symbol ""))) + (cons + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator + ((member eql and not or) + `(,operator ,@(mapcar #'rec operands))) + ((member tag satisfies) + selector))))))) (insert (format "%S" (rec selector))))) @@ -1177,21 +1183,21 @@ contained in UNIVERSE." ;; that corresponds to this run in order to be able to update the ;; statistics correctly when a test is re-run interactively and has a ;; different result than before. -(defstruct ert--stats - (selector (assert nil)) +(cl-defstruct ert--stats + (selector (cl-assert nil)) ;; The tests, in order. - (tests (assert nil) :type vector) + (tests (cl-assert nil) :type vector) ;; A map of test names (or the test objects themselves for unnamed ;; tests) to indices into the `tests' vector. - (test-map (assert nil) :type hash-table) + (test-map (cl-assert nil) :type hash-table) ;; The results of the tests during this run, in order. - (test-results (assert nil) :type vector) + (test-results (cl-assert nil) :type vector) ;; The start times of the tests, in order, as reported by ;; `current-time'. - (test-start-times (assert nil) :type vector) + (test-start-times (cl-assert nil) :type vector) ;; The end times of the tests, in order, as reported by ;; `current-time'. - (test-end-times (assert nil) :type vector) + (test-end-times (cl-assert nil) :type vector) (passed-expected 0) (passed-unexpected 0) (failed-expected 0) @@ -1241,21 +1247,25 @@ Also changes the counters in STATS to match." (results (ert--stats-test-results stats)) (old-test (aref tests pos)) (map (ert--stats-test-map stats))) - (flet ((update (d) - (if (ert-test-result-expected-p (aref tests pos) - (aref results pos)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-expected stats) d)) - (ert-test-failed (incf (ert--stats-failed-expected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) - (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit))))) + (cl-flet ((update (d) + (if (ert-test-result-expected-p (aref tests pos) + (aref results pos)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-expected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-expected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-unexpected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-unexpected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit))))) ;; Adjust counters to remove the result that is currently in stats. (update -1) ;; Put new test and result into stats. @@ -1273,11 +1283,11 @@ Also changes the counters in STATS to match." SELECTOR is the selector that was used to select TESTS." (setq tests (ert--coerce-to-vector tests)) (let ((map (make-hash-table :size (length tests)))) - (loop for i from 0 - for test across tests - for key = (ert--stats-test-key test) do - (assert (not (gethash key map))) - (setf (gethash key map) i)) + (cl-loop for i from 0 + for test across tests + for key = (ert--stats-test-key test) do + (cl-assert (not (gethash key map))) + (setf (gethash key map) i)) (make-ert--stats :selector selector :tests tests :test-map map @@ -1319,8 +1329,8 @@ SELECTOR is the selector that was used to select TESTS." (force-mode-line-update) (unwind-protect (progn - (loop for test in tests do - (ert-run-or-rerun-test stats test listener)) + (cl-loop for test in tests do + (ert-run-or-rerun-test stats test listener)) (setq abortedp nil)) (setf (ert--stats-aborted-p stats) abortedp) (setf (ert--stats-end-time stats) (current-time)) @@ -1344,7 +1354,7 @@ SELECTOR is the selector that was used to select TESTS." "Return a character that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed ".P") (ert-test-failed "fF") (null "--") @@ -1356,7 +1366,7 @@ EXPECTEDP specifies whether the result was expected." "Return a string that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed '("passed" "PASSED")) (ert-test-failed '("failed" "FAILED")) (null '("unknown" "UNKNOWN")) @@ -1378,9 +1388,9 @@ Ensures a final newline is inserted." "Insert `ert-info' infos from RESULT into current buffer. RESULT must be an `ert-test-result-with-condition'." - (check-type result ert-test-result-with-condition) + (cl-check-type result ert-test-result-with-condition) (dolist (info (ert-test-result-with-condition-infos result)) - (destructuring-bind (prefix . message) info + (cl-destructuring-bind (prefix . message) info (let ((begin (point)) (indentation (make-string (+ (length prefix) 4) ?\s)) (end nil)) @@ -1416,14 +1426,14 @@ Returns the stats object." (ert-run-tests selector (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (message "Running %s tests (%s)" (length (ert--stats-tests stats)) (ert--format-time-iso8601 (ert--stats-start-time stats))))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (let ((unexpected (ert-stats-completed-unexpected stats)) (expected-failures (ert--stats-failed-expected stats))) (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" @@ -1441,19 +1451,19 @@ Returns the stats object." (format "\n%s expected failures" expected-failures))) (unless (zerop unexpected) (message "%s unexpected results:" unexpected) - (loop for test across (ert--stats-tests stats) - for result = (ert-test-most-recent-result test) do - (when (not (ert-test-result-expected-p test result)) - (message "%9s %S" - (ert-string-for-test-result result nil) - (ert-test-name test)))) + (cl-loop for test across (ert--stats-tests stats) + for result = (ert-test-most-recent-result test) do + (when (not (ert-test-result-expected-p test result)) + (message "%9s %S" + (ert-string-for-test-result result nil) + (ert-test-name test)))) (message "%s" ""))))) (test-started ) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) - (etypecase result + (cl-etypecase result (ert-test-passed (message "Test %S passed unexpectedly" (ert-test-name test))) (ert-test-result-with-condition @@ -1479,7 +1489,7 @@ Returns the stats object." (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result))) (goto-char (1- (point-max))) - (assert (looking-at "\n")) + (cl-assert (looking-at "\n")) (delete-char 1) (message "Test %S condition:" (ert-test-name test)) (message "%s" (buffer-string)))) @@ -1527,7 +1537,7 @@ the tests)." (1 font-lock-keyword-face nil t) (2 font-lock-function-name-face nil t))))) -(defun* ert--remove-from-list (list-var element &key key test) +(cl-defun ert--remove-from-list (list-var element &key key test) "Remove ELEMENT from the value of LIST-VAR if present. This can be used as an inverse of `add-to-list'." @@ -1552,7 +1562,7 @@ If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to include the default, if any. Signals an error if no test name was read." - (etypecase default + (cl-etypecase default (string (let ((symbol (intern-soft default))) (unless (and symbol (ert-test-boundp symbol)) (setq default nil)))) @@ -1609,11 +1619,11 @@ Nothing more than an interactive interface to `ert-make-test-unbound'." ;;; Display of test progress and results. ;; An entry in the results buffer ewoc. There is one entry per test. -(defstruct ert--ewoc-entry - (test (assert nil)) +(cl-defstruct ert--ewoc-entry + (test (cl-assert nil)) ;; If the result of this test was expected, its ewoc entry is hidden ;; initially. - (hidden-p (assert nil)) + (hidden-p (cl-assert nil)) ;; An ewoc entry may be collapsed to hide details such as the error ;; condition. ;; @@ -1689,7 +1699,7 @@ Also sets `ert--results-progress-bar-button-begin'." ((ert--stats-current-test stats) 'running) ((ert--stats-end-time stats) 'finished) (t 'preparing)))) - (ecase state + (cl-ecase state (preparing (insert "")) (aborted @@ -1700,12 +1710,12 @@ Also sets `ert--results-progress-bar-button-begin'." (t (insert "Aborted.")))) (running - (assert (ert--stats-current-test stats)) + (cl-assert (ert--stats-current-test stats)) (insert "Running test: ") (ert-insert-test-name-button (ert-test-name (ert--stats-current-test stats)))) (finished - (assert (not (ert--stats-current-test stats))) + (cl-assert (not (ert--stats-current-test stats))) (insert "Finished."))) (insert "\n") (if (ert--stats-end-time stats) @@ -1808,7 +1818,7 @@ non-nil, returns the face for expected results.." (defun ert-face-for-stats (stats) "Return a face that represents STATS." (cond ((ert--stats-aborted-p stats) 'nil) - ((plusp (ert-stats-completed-unexpected stats)) + ((cl-plusp (ert-stats-completed-unexpected stats)) (ert-face-for-test-result nil)) ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) (ert-face-for-test-result t)) @@ -1819,7 +1829,7 @@ non-nil, returns the face for expected results.." (let* ((test (ert--ewoc-entry-test entry)) (stats ert--results-stats) (result (let ((pos (ert--stats-test-pos stats test))) - (assert pos) + (cl-assert pos) (aref (ert--stats-test-results stats) pos))) (hiddenp (ert--ewoc-entry-hidden-p entry)) (expandedp (ert--ewoc-entry-expanded-p entry)) @@ -1845,7 +1855,7 @@ non-nil, returns the face for expected results.." (ert--string-first-line (ert-test-documentation test)) 'font-lock-face 'font-lock-doc-face) "\n")) - (etypecase result + (cl-etypecase result (ert-test-passed (if (ert-test-result-expected-p test result) (insert " passed\n") @@ -1903,9 +1913,10 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (make-string (ert-stats-total stats) (ert-char-for-test-result nil t))) (set (make-local-variable 'ert--results-listener) listener) - (loop for test across (ert--stats-tests stats) do - (ewoc-enter-last ewoc - (make-ert--ewoc-entry :test test :hidden-p t))) + (cl-loop for test across (ert--stats-tests stats) do + (ewoc-enter-last ewoc + (make-ert--ewoc-entry :test test + :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (goto-char (1- (point-max))) buffer))))) @@ -1940,21 +1951,21 @@ and how to display message." default nil)) nil)) (unless message-fn (setq message-fn 'message)) - (lexical-let ((output-buffer-name output-buffer-name) - buffer - listener - (message-fn message-fn)) + (let ((output-buffer-name output-buffer-name) + buffer + listener + (message-fn message-fn)) (setq listener (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (setq buffer (ert--setup-results-buffer stats listener output-buffer-name)) (pop-to-buffer buffer))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (funcall message-fn "%sRan %s tests, %s results were as expected%s" (if (not abortedp) @@ -1971,19 +1982,19 @@ and how to display message." ert--results-ewoc) stats))) (test-started - (destructuring-bind (stats test) event-args + (cl-destructuring-bind (stats test) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) (node (ewoc-nth ewoc pos))) - (assert node) + (cl-assert node) (setf (ert--ewoc-entry-test (ewoc-data node)) test) (aset ert--results-progress-bar-string pos (ert-char-for-test-result nil t)) (ert--results-update-stats-display-maybe ewoc stats) (ewoc-invalidate ewoc node))))) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) @@ -2015,28 +2026,28 @@ and how to display message." (define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") -(loop for (key binding) in - '(;; Stuff that's not in the menu. - ("\t" forward-button) - ([backtab] backward-button) - ("j" ert-results-jump-between-summary-and-result) - ("L" ert-results-toggle-printer-limits-for-test-at-point) - ("n" ert-results-next-test) - ("p" ert-results-previous-test) - ;; Stuff that is in the menu. - ("R" ert-results-rerun-all-tests) - ("r" ert-results-rerun-test-at-point) - ("d" ert-results-rerun-test-at-point-debugging-errors) - ("." ert-results-find-test-at-point-other-window) - ("b" ert-results-pop-to-backtrace-for-test-at-point) - ("m" ert-results-pop-to-messages-for-test-at-point) - ("l" ert-results-pop-to-should-forms-for-test-at-point) - ("h" ert-results-describe-test-at-point) - ("D" ert-delete-test) - ("T" ert-results-pop-to-timings) - ) - do - (define-key ert-results-mode-map key binding)) +(cl-loop for (key binding) in + '( ;; Stuff that's not in the menu. + ("\t" forward-button) + ([backtab] backward-button) + ("j" ert-results-jump-between-summary-and-result) + ("L" ert-results-toggle-printer-limits-for-test-at-point) + ("n" ert-results-next-test) + ("p" ert-results-previous-test) + ;; Stuff that is in the menu. + ("R" ert-results-rerun-all-tests) + ("r" ert-results-rerun-test-at-point) + ("d" ert-results-rerun-test-at-point-debugging-errors) + ("." ert-results-find-test-at-point-other-window) + ("b" ert-results-pop-to-backtrace-for-test-at-point) + ("m" ert-results-pop-to-messages-for-test-at-point) + ("l" ert-results-pop-to-should-forms-for-test-at-point) + ("h" ert-results-describe-test-at-point) + ("D" ert-delete-test) + ("T" ert-results-pop-to-timings) + ) + do + (define-key ert-results-mode-map key binding)) (easy-menu-define ert-results-mode-menu ert-results-mode-map "Menu for `ert-results-mode'." @@ -2116,15 +2127,15 @@ To be used in the ERT results buffer." EWOC-FN specifies the direction and should be either `ewoc-prev' or `ewoc-next'. If there are no more nodes in that direction, an error is signaled with the message ERROR-MESSAGE." - (loop + (cl-loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) (error "%s" error-message)) (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) (goto-char (ewoc-location node)) - (return)))) + (cl-return)))) -(defun ert--results-expand-collapse-button-action (button) +(defun ert--results-expand-collapse-button-action (_button) "Expand or collapse the test node BUTTON belongs to." (let* ((ewoc ert--results-ewoc) (node (save-excursion @@ -2153,11 +2164,11 @@ To be used in the ERT results buffer." (defun ert--ewoc-position (ewoc node) ;; checkdoc-order: nil "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." - (loop for i from 0 - for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) - do (when (eql node node-here) - (return i)) - finally (return nil))) + (cl-loop for i from 0 + for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) + do (when (eql node node-here) + (cl-return i)) + finally (cl-return nil))) (defun ert-results-jump-between-summary-and-result () "Jump back and forth between the test run summary and individual test results. @@ -2205,7 +2216,7 @@ To be used in the ERT results buffer." "Return the test at point, or nil. To be used in the ERT results buffer." - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (if (ert--results-test-node-or-null-at-point) (let* ((node (ert--results-test-node-at-point)) (test (ert--ewoc-entry-test (ewoc-data node)))) @@ -2277,9 +2288,9 @@ definition." (point)) ((eventp last-command-event) (posn-point (event-start last-command-event))) - (t (assert nil)))) + (t (cl-assert nil)))) -(defun ert--results-progress-bar-button-action (button) +(defun ert--results-progress-bar-button-action (_button) "Jump to details for the test represented by the character clicked in BUTTON." (goto-char (ert--button-action-position)) (ert-results-jump-between-summary-and-result)) @@ -2289,7 +2300,7 @@ definition." To be used in the ERT results buffer." (interactive) - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) (ert-run-tests-interactively selector (buffer-name)))) @@ -2298,13 +2309,13 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (destructuring-bind (test redefinition-state) + (cl-destructuring-bind (test redefinition-state) (ert--results-test-at-point-allow-redefinition) (when (null test) (error "No test at point")) (let* ((stats ert--results-stats) (progress-message (format "Running %stest %S" - (ecase redefinition-state + (cl-ecase redefinition-state ((nil) "") (redefined "new definition of ") (deleted "deleted ")) @@ -2345,7 +2356,7 @@ To be used in the ERT results buffer." (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) - (etypecase result + (cl-etypecase result (ert-test-passed (error "Test passed, no backtrace available")) (ert-test-result-with-condition (let ((backtrace (ert-test-result-with-condition-backtrace result)) @@ -2403,13 +2414,14 @@ To be used in the ERT results buffer." (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") - (loop for form-description in (ert-test-result-should-forms result) - for i from 1 do - (insert "\n") - (insert (format "%s: " i)) - (let ((begin (point))) - (ert--pp-with-indentation-and-newline form-description) - (ert--make-xrefs-region begin (point))))) + (cl-loop for form-description + in (ert-test-result-should-forms result) + for i from 1 do + (insert "\n") + (insert (format "%s: " i)) + (let ((begin (point))) + (ert--pp-with-indentation-and-newline form-description) + (ert--make-xrefs-region begin (point))))) (goto-char (point-min)) (insert "`should' forms executed during test `") (ert-insert-test-name-button (ert-test-name test)) @@ -2438,17 +2450,16 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) (let* ((stats ert--results-stats) - (start-times (ert--stats-test-start-times stats)) - (end-times (ert--stats-test-end-times stats)) (buffer (get-buffer-create "*ERT timings*")) - (data (loop for test across (ert--stats-tests stats) - for start-time across (ert--stats-test-start-times stats) - for end-time across (ert--stats-test-end-times stats) - collect (list test - (float-time (subtract-time end-time - start-time)))))) + (data (cl-loop for test across (ert--stats-tests stats) + for start-time across (ert--stats-test-start-times + stats) + for end-time across (ert--stats-test-end-times stats) + collect (list test + (float-time (subtract-time + end-time start-time)))))) (setq data (sort data (lambda (a b) - (> (second a) (second b))))) + (> (cl-second a) (cl-second b))))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) @@ -2457,13 +2468,13 @@ To be used in the ERT results buffer." (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) - (loop for (test time) in data - for cumul-time = time then (+ cumul-time time) - for i from 1 do - (let ((begin (point))) - (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) - (ert-insert-test-name-button (ert-test-name test)) - (insert "\n")))) + (cl-loop for (test time) in data + for cumul-time = time then (+ cumul-time time) + for i from 1 do + (progn + (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) + (ert-insert-test-name-button (ert-test-name test)) + (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") (forward-line 1)))) @@ -2476,7 +2487,7 @@ To be used in the ERT results buffer." (error "Requires Emacs 24")) (let (test-name test-definition) - (etypecase test-or-test-name + (cl-etypecase test-or-test-name (symbol (setq test-name test-or-test-name test-definition (ert-get-test test-or-test-name))) (ert-test (setq test-name (ert-test-name test-or-test-name) -- cgit v1.3 From 12645ae6912e7627d71ebbc7c37d9335cd0a429e Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Fri, 23 Nov 2012 14:23:28 +0800 Subject: * xftfont.c (xftfont_open): Remove duplicate assignment. --- src/ChangeLog | 4 ++++ src/xftfont.c | 4 +--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 2e485f1b87b..d0f4ad6869d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2012-11-23 Chong Yidong + + * xftfont.c (xftfont_open): Remove duplicate assignment. + 2012-11-22 Dmitry Antipov * alloc.c (Fgarbage_collect): Unblock input after clearing diff --git a/src/xftfont.c b/src/xftfont.c index 372ed87705f..181a1da9b38 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -369,7 +369,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) ASET (font_object, FONT_FORMAT_INDEX, ftfont_font_format (xftfont->pattern, filename)); font = XFONT_OBJECT (font_object); - font->pixel_size = pixel_size; + font->pixel_size = size; font->driver = &xftfont_driver; font->encoding_charset = font->repertory_charset = -1; @@ -387,8 +387,6 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) xftfont_info->matrix.xy = 0x10000L * matrix->xy; xftfont_info->matrix.yx = 0x10000L * matrix->yx; } - font->pixel_size = size; - font->driver = &xftfont_driver; if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); else -- cgit v1.3 From 6f6b82d66f73e65545865b72f109dbf695934aea Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 22 Nov 2012 23:31:58 -0800 Subject: Add Bug# to Nov 17 ChangeLog entries. --- doc/misc/ChangeLog | 4 ++-- etc/ChangeLog | 2 +- lisp/ChangeLog | 4 +++- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 7c56d56fd73..6be52213a4a 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -12,8 +12,8 @@ 2012-11-17 Paul Eggert - Calc now uses the Gregorian calendar for all dates, - and uses January 1, 1 AD as its day number 1. + Calc now uses the Gregorian calendar for all dates (Bug#12633). + It also uses January 1, 1 AD as its day number 1. * calc.texi (Date Forms): Document this. 2012-11-16 Glenn Morris diff --git a/etc/ChangeLog b/etc/ChangeLog index 6056336dff6..11dc42b7f45 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,6 +1,6 @@ 2012-11-22 Paul Eggert - * NEWS: Document Calc changes for Gregorian calendar. + * NEWS: Document Calc changes for Gregorian calendar (Bug#12633). 2012-10-26 Nicolas Goaziou diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1fb8ca6d67e..5ace77ed0d3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -205,8 +205,10 @@ 2012-11-17 Paul Eggert + Calc by default uses the Gregorian calendar for all dates (Bug#12633). + It also uses January 1, 1 AD as its day number 1. * calc/calc-forms.el (math-julian-date-beginning) - (math-julian-date-beginning-int): Implement [new date numbering]. + (math-julian-date-beginning-int): Implement this. 2012-11-17 Juanma Barranquero -- cgit v1.3 From 95ef7787fb0a5786a2e4f150649aadfa687a15f2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 22 Nov 2012 23:48:43 -0800 Subject: Assume POSIX 1003.1-1988 or later for dirent.h. * admin/CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove. * admin/notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming. * configure.ac: Do not check for dirent.h or closdir. * nt/inc/dirent.h: Rename from ../src/ndir.h, with these changes: (struct dirent): Rename from struct direct. All uses changed. * nt/inc/sys/dir.h: Remove. * src/dired.c: Assume HAVE_DIRENT_H. (NAMLEN): Remove, replacing with ... (dirent_namelen): New function. All uses changed. Use the GNU macro _D_EXACT_NAMELEN if available, as it's faster than strlen. (DIRENTRY): Remove, replacing all uses with 'struct dirent'. (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero. * src/makefile.w32-in (DIR_H): Remove. All uses replaced with $(NT_INC)/dirent.h. ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h. * src/ndir.h: Rename to ../nt/inc/dirent.h. * src/sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove. Do not include ; no longer needed. * src/w32.c: Include rather than "ndir.h". Fixes: debbugs:12958 --- ChangeLog | 5 ++ admin/CPP-DEFINES | 2 - admin/ChangeLog | 6 ++ admin/notes/copyright | 4 +- configure.ac | 4 +- nt/ChangeLog | 7 ++ nt/inc/dirent.h | 38 ++++++++++ nt/inc/sys/dir.h | 6 -- src/ChangeLog | 17 +++++ src/dired.c | 205 ++++++++++++++++++++++---------------------------- src/makefile.w32-in | 6 +- src/ndir.h | 41 ---------- src/sysdep.c | 22 ------ src/w32.c | 8 +- 14 files changed, 173 insertions(+), 198 deletions(-) create mode 100644 nt/inc/dirent.h delete mode 100644 nt/inc/sys/dir.h delete mode 100644 src/ndir.h diff --git a/ChangeLog b/ChangeLog index 4dad9a171dc..03815e86ff8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * configure.ac: Do not check for dirent.h or closdir. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 5c291944766..f4105f00c47 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -118,7 +118,6 @@ HAVE_CFMAKERAW HAVE_CFSETSPEED HAVE_CLOCK_GETTIME HAVE_CLOCK_SETTIME -HAVE_CLOSEDIR HAVE_COFF_H HAVE_COM_ERR_H HAVE_COPYSIGN @@ -143,7 +142,6 @@ HAVE_DES_H HAVE_DEV_PTMX HAVE_DIALOGS HAVE_DIFFTIME -HAVE_DIRENT_H HAVE_DUP2 HAVE_ENDGRENT HAVE_ENDPWENT diff --git a/admin/ChangeLog b/admin/ChangeLog index b256a0f5dc4..fe75ae57a6d 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,9 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove. + * notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). diff --git a/admin/notes/copyright b/admin/notes/copyright index 72b7d7e2d23..173ff83343a 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright @@ -380,7 +380,7 @@ Makefile.in does now. src/gmalloc.c - contains numerous copyrights from the GNU C library. Leave them alone. -src/ndir.h +nt/inc/dirent.h - see comments below. This file is OK to be released with Emacs 22, but we may want to revisit it afterwards. @@ -429,7 +429,7 @@ admin/check-doc-strings File says it's in the public domain, but that might not make it so. etc/e/eterm-color.ti -src/ndir.h +nt/inc/dirent.h On legal advice from Matt Norwood, the following comment was added to these files in Feb/Mar 2007: diff --git a/configure.ac b/configure.ac index 25bf2b47cc9..7dda0010f28 100644 --- a/configure.ac +++ b/configure.ac @@ -1289,7 +1289,7 @@ AC_CHECK_HEADERS_ONCE( linux/version.h sys/systeminfo.h coff.h pty.h sys/vlimit.h sys/resource.h - sys/utsname.h pwd.h utmp.h dirent.h util.h) + sys/utsname.h pwd.h utmp.h util.h) AC_MSG_CHECKING(if personality LINUX32 can be set) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[personality (PER_LINUX32)]])], @@ -2891,7 +2891,7 @@ AC_SUBST(BLESSMAIL_TARGET) AC_CHECK_FUNCS(gethostname \ -closedir getrusage get_current_dir_name \ +getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ utimes getrlimit setrlimit shutdown getaddrinfo \ diff --git a/nt/ChangeLog b/nt/ChangeLog index 4fa3d04513c..6737f952a43 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,10 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * inc/dirent.h: Rename from ../src/ndir.h, with these changes: + (struct dirent): Rename from struct direct. All uses changed. + * inc/sys/dir.h: Remove. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). diff --git a/nt/inc/dirent.h b/nt/inc/dirent.h new file mode 100644 index 00000000000..618f3beddf0 --- /dev/null +++ b/nt/inc/dirent.h @@ -0,0 +1,38 @@ +/* + -- definitions for POSIX-compatible directory access + + * The code here is forced by the interface, and is not subject to + * copyright, constituting the only possible expression of the + * algorithm in this format. + */ + +#define DIRBLKSIZ 512 /* size of directory block */ +#ifdef WINDOWSNT +#define MAXNAMLEN 255 +#else /* not WINDOWSNT */ +#define MAXNAMLEN 15 /* maximum filename length */ +#endif /* not WINDOWSNT */ + /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ + +struct dirent /* data from readdir() */ + { + long d_ino; /* inode number of entry */ + unsigned short d_reclen; /* length of this record */ + unsigned short d_namlen; /* length of string in d_name */ + char d_name[MAXNAMLEN+1]; /* name of file */ + }; + +typedef struct + { + int dd_fd; /* file descriptor */ + int dd_loc; /* offset in block */ + int dd_size; /* amount of valid data */ + char dd_buf[DIRBLKSIZ]; /* directory block */ + } DIR; /* stream data from opendir() */ + +extern DIR *opendir (char *); +extern struct dirent *readdir (DIR *); +extern void seekdir (DIR *, long); +extern void closedir (DIR *); + +#define rewinddir( dirp ) seekdir( dirp, 0L ) diff --git a/nt/inc/sys/dir.h b/nt/inc/sys/dir.h deleted file mode 100644 index dc075cd7587..00000000000 --- a/nt/inc/sys/dir.h +++ /dev/null @@ -1,6 +0,0 @@ -/* - * map sys\dir.h to ..\..\..\src\ndir.h - */ - -#include "..\..\..\src\ndir.h" - diff --git a/src/ChangeLog b/src/ChangeLog index d0f4ad6869d..5566b623cec 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,20 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * dired.c: Assume HAVE_DIRENT_H. + (NAMLEN): Remove, replacing with ... + (dirent_namelen): New function. All uses changed. Use the GNU macro + _D_EXACT_NAMELEN if available, as it's faster than strlen. + (DIRENTRY): Remove, replacing all uses with 'struct dirent'. + (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero. + * makefile.w32-in (DIR_H): Remove. All uses replaced with + $(NT_INC)/dirent.h. + ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h. + * ndir.h: Rename to ../nt/inc/dirent.h. + * sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove. + Do not include ; no longer needed. + * w32.c: Include rather than "ndir.h". + 2012-11-23 Chong Yidong * xftfont.c (xftfont_open): Remove duplicate assignment. diff --git a/src/dired.c b/src/dired.c index 4986f845101..3530b74ecb4 100644 --- a/src/dired.c +++ b/src/dired.c @@ -31,44 +31,10 @@ along with GNU Emacs. If not, see . */ #include #include -/* The d_nameln member of a struct dirent includes the '\0' character - on some systems, but not on others. What's worse, you can't tell - at compile-time which one it will be, since it really depends on - the sort of system providing the filesystem you're reading from, - not the system you are running on. Paul Eggert - says this occurs when Emacs is running on a - SunOS 4.1.2 host, reading a directory that is remote-mounted from a - Solaris 2.1 host and is in a native Solaris 2.1 filesystem. - - Since applying strlen to the name always works, we'll just do that. */ -#define NAMLEN(p) strlen (p->d_name) - -#ifdef HAVE_DIRENT_H - #include -#define DIRENTRY struct dirent - -#else /* not HAVE_DIRENT_H */ - -#include -#include - -#define DIRENTRY struct direct - -extern DIR *opendir (char *); -extern struct direct *readdir (DIR *); - -#endif /* HAVE_DIRENT_H */ - #include #include -#ifdef MSDOS -#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) -#else -#define DIRENTRY_NONEMPTY(p) ((p)->d_ino) -#endif - #include "lisp.h" #include "systime.h" #include "character.h" @@ -88,6 +54,17 @@ static Lisp_Object Qfile_attributes_lessp; static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); +/* Return the number of bytes in DP's name. */ +static ptrdiff_t +dirent_namelen (struct dirent *dp) +{ +#ifdef _D_EXACT_NAMLEN + return _D_EXACT_NAMLEN (dp); +#else + return strlen (dp->d_name); +#endif +} + #ifdef WINDOWSNT Lisp_Object directory_files_internal_w32_unwind (Lisp_Object arg) @@ -124,7 +101,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - DIRENTRY *dp; + struct dirent *dp; #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif @@ -209,6 +186,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Loop reading blocks until EOF or error. */ for (;;) { + ptrdiff_t len; + bool wanted = 0; + Lisp_Object name, finalname; + struct gcpro gcpro1, gcpro2; + errno = 0; dp = readdir (d); @@ -225,89 +207,81 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, if (dp == NULL) break; - if (DIRENTRY_NONEMPTY (dp)) + len = dirent_namelen (dp); + name = finalname = make_unibyte_string (dp->d_name, len); + GCPRO2 (finalname, name); + + /* Note: DECODE_FILE can GC; it should protect its argument, + though. */ + name = DECODE_FILE (name); + len = SBYTES (name); + + /* Now that we have unwind_protect in place, we might as well + allow matching to be interrupted. */ + immediate_quit = 1; + QUIT; + + if (NILP (match) + || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) + wanted = 1; + + immediate_quit = 0; + + if (wanted) { - ptrdiff_t len; - bool wanted = 0; - Lisp_Object name, finalname; - struct gcpro gcpro1, gcpro2; + if (!NILP (full)) + { + Lisp_Object fullname; + ptrdiff_t nbytes = len + directory_nbytes + needsep; + ptrdiff_t nchars; - len = NAMLEN (dp); - name = finalname = make_unibyte_string (dp->d_name, len); - GCPRO2 (finalname, name); + fullname = make_uninit_multibyte_string (nbytes, nbytes); + memcpy (SDATA (fullname), SDATA (directory), + directory_nbytes); - /* Note: DECODE_FILE can GC; it should protect its argument, - though. */ - name = DECODE_FILE (name); - len = SBYTES (name); + if (needsep) + SSET (fullname, directory_nbytes, DIRECTORY_SEP); - /* Now that we have unwind_protect in place, we might as well - allow matching to be interrupted. */ - immediate_quit = 1; - QUIT; + memcpy (SDATA (fullname) + directory_nbytes + needsep, + SDATA (name), len); - if (NILP (match) - || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) - wanted = 1; + nchars = chars_in_text (SDATA (fullname), nbytes); - immediate_quit = 0; + /* Some bug somewhere. */ + if (nchars > nbytes) + emacs_abort (); - if (wanted) - { - if (!NILP (full)) - { - Lisp_Object fullname; - ptrdiff_t nbytes = len + directory_nbytes + needsep; - ptrdiff_t nchars; - - fullname = make_uninit_multibyte_string (nbytes, nbytes); - memcpy (SDATA (fullname), SDATA (directory), - directory_nbytes); - - if (needsep) - SSET (fullname, directory_nbytes, DIRECTORY_SEP); - - memcpy (SDATA (fullname) + directory_nbytes + needsep, - SDATA (name), len); - - nchars = chars_in_text (SDATA (fullname), nbytes); - - /* Some bug somewhere. */ - if (nchars > nbytes) - emacs_abort (); - - STRING_SET_CHARS (fullname, nchars); - if (nchars == nbytes) - STRING_SET_UNIBYTE (fullname); - - finalname = fullname; - } - else - finalname = name; - - if (attrs) - { - /* Construct an expanded filename for the directory entry. - Use the decoded names for input to Ffile_attributes. */ - Lisp_Object decoded_fullname, fileattrs; - struct gcpro gcpro1, gcpro2; - - decoded_fullname = fileattrs = Qnil; - GCPRO2 (decoded_fullname, fileattrs); - - /* Both Fexpand_file_name and Ffile_attributes can GC. */ - decoded_fullname = Fexpand_file_name (name, directory); - fileattrs = Ffile_attributes (decoded_fullname, id_format); - - list = Fcons (Fcons (finalname, fileattrs), list); - UNGCPRO; - } - else - list = Fcons (finalname, list); + STRING_SET_CHARS (fullname, nchars); + if (nchars == nbytes) + STRING_SET_UNIBYTE (fullname); + + finalname = fullname; } + else + finalname = name; - UNGCPRO; + if (attrs) + { + /* Construct an expanded filename for the directory entry. + Use the decoded names for input to Ffile_attributes. */ + Lisp_Object decoded_fullname, fileattrs; + struct gcpro gcpro1, gcpro2; + + decoded_fullname = fileattrs = Qnil; + GCPRO2 (decoded_fullname, fileattrs); + + /* Both Fexpand_file_name and Ffile_attributes can GC. */ + decoded_fullname = Fexpand_file_name (name, directory); + fileattrs = Ffile_attributes (decoded_fullname, id_format); + + list = Fcons (Fcons (finalname, fileattrs), list); + UNGCPRO; + } + else + list = Fcons (finalname, list); } + + UNGCPRO; } block_input (); @@ -442,7 +416,8 @@ These are all file names in directory DIRECTORY which begin with FILE. */) return file_name_completion (file, directory, 1, Qnil); } -static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr); +static int file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, + struct stat *st_addr); static Lisp_Object Qdefault_directory; static Lisp_Object @@ -499,7 +474,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, /* (att3b compiler bug requires do a null comparison this way) */ while (1) { - DIRENTRY *dp; + struct dirent *dp; ptrdiff_t len; bool canexclude = 0; @@ -517,11 +492,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, if (!dp) break; - len = NAMLEN (dp); + len = dirent_namelen (dp); QUIT; - if (! DIRENTRY_NONEMPTY (dp) - || len < SCHARS (encoded_file) + if (len < SCHARS (encoded_file) || 0 <= scmp (dp->d_name, SSDATA (encoded_file), SCHARS (encoded_file))) continue; @@ -806,9 +780,10 @@ scmp (const char *s1, const char *s2, ptrdiff_t len) } static int -file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr) +file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, + struct stat *st_addr) { - ptrdiff_t len = NAMLEN (dp); + ptrdiff_t len = dirent_namelen (dp); ptrdiff_t pos = SCHARS (dirname); int value; USE_SAFE_ALLOCA; diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 9778e955677..5d0c6e72146 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -413,8 +413,6 @@ CONF_POST_H = $(SRC)/conf_post.h \ $(MS_W32_H) CONFIG_H = $(SRC)/config.h \ $(CONF_POST_H) -DIR_H = $(NT_INC)/sys/dir.h \ - $(SRC)/ndir.h W32GUI_H = $(SRC)/w32gui.h \ $(SYSTIME_H) DISPEXTERN_H = $(SRC)/dispextern.h \ @@ -714,6 +712,7 @@ $(BLD)/dired.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/regex.h \ + $(NT_INC)/dirent.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ @@ -722,7 +721,6 @@ $(BLD)/dired.$(O) : \ $(CHARSET_H) \ $(CODING_H) \ $(CONFIG_H) \ - $(DIR_H) \ $(FILEMODE_H) \ $(GRP_H) \ $(LISP_H) \ @@ -1175,11 +1173,11 @@ $(BLD)/minibuf.$(O) : \ $(BLD)/w32.$(O) : \ $(SRC)/w32.c \ - $(SRC)/ndir.h \ $(SRC)/w32.h \ $(SRC)/w32common.h \ $(SRC)/w32heap.h \ $(SRC)/w32select.h \ + $(NT_INC)/dirent.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/sys/time.h \ diff --git a/src/ndir.h b/src/ndir.h deleted file mode 100644 index cd7cdbe55f5..00000000000 --- a/src/ndir.h +++ /dev/null @@ -1,41 +0,0 @@ -/* - -- definitions for 4.2BSD-compatible directory access - - last edit: 09-Jul-1983 D A Gwyn - - * The code here is forced by the interface, and is not subject to - * copyright, constituting the only possible expression of the - * algorithm in this format. - */ - -#define DIRBLKSIZ 512 /* size of directory block */ -#ifdef WINDOWSNT -#define MAXNAMLEN 255 -#else /* not WINDOWSNT */ -#define MAXNAMLEN 15 /* maximum filename length */ -#endif /* not WINDOWSNT */ - /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ - -struct direct /* data from readdir() */ - { - long d_ino; /* inode number of entry */ - unsigned short d_reclen; /* length of this record */ - unsigned short d_namlen; /* length of string in d_name */ - char d_name[MAXNAMLEN+1]; /* name of file */ - }; - -typedef struct - { - int dd_fd; /* file descriptor */ - int dd_loc; /* offset in block */ - int dd_size; /* amount of valid data */ - char dd_buf[DIRBLKSIZ]; /* directory block */ - } DIR; /* stream data from opendir() */ - -extern DIR *opendir (char *); -extern struct direct *readdir (DIR *); -extern void seekdir (DIR *, long); -extern void closedir (DIR *); - -#define rewinddir( dirp ) seekdir( dirp, 0L ) - diff --git a/src/sysdep.c b/src/sysdep.c index 3dd19685540..bc4dc91509f 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2219,28 +2219,6 @@ emacs_readlink (char const *filename, char initial_buf[READLINK_BUFSIZE]) return careadlinkat (AT_FDCWD, filename, initial_buf, READLINK_BUFSIZE, &emacs_norealloc_allocator, careadlinkatcwd); } - -/* Directory routines for systems that don't have them. */ - -#ifdef HAVE_DIRENT_H - -#include - -#if !defined (HAVE_CLOSEDIR) - -int -closedir (DIR *dirp /* stream from opendir */) -{ - int rtnval; - - rtnval = emacs_close (dirp->dd_fd); - xfree (dirp); - - return rtnval; -} -#endif /* not HAVE_CLOSEDIR */ -#endif /* HAVE_DIRENT_H */ - /* Return a struct timeval that is roughly equivalent to T. Use the least timeval not less than T. diff --git a/src/w32.c b/src/w32.c index 038a442f529..c8e16dfaa94 100644 --- a/src/w32.c +++ b/src/w32.c @@ -179,7 +179,7 @@ typedef struct _REPARSE_DATA_BUFFER { #undef sendto #include "w32.h" -#include "ndir.h" +#include #include "w32common.h" #include "w32heap.h" #include "w32select.h" @@ -2448,7 +2448,7 @@ is_exec (const char * name) and readdir. We can't use the procedures supplied in sysdep.c, so we provide them here. */ -struct direct dir_static; /* simulated directory contents */ +struct dirent dir_static; /* simulated directory contents */ static HANDLE dir_find_handle = INVALID_HANDLE_VALUE; static int dir_is_fat; static char dir_pathname[MAXPATHLEN+1]; @@ -2518,7 +2518,7 @@ closedir (DIR *dirp) xfree ((char *) dirp); } -struct direct * +struct dirent * readdir (DIR *dirp) { int downcase = !NILP (Vw32_downcase_file_names); @@ -2572,7 +2572,7 @@ readdir (DIR *dirp) downcase = 1; /* 8+3 aliases are returned in all caps */ } dir_static.d_namlen = strlen (dir_static.d_name); - dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + + dir_static.d_reclen = sizeof (struct dirent) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; /* If the file name in cFileName[] includes `?' characters, it means -- cgit v1.3 From e6bac8768bfff6756ccf9b595e403821ff539036 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 23 Nov 2012 00:28:06 -0800 Subject: movemail: treat EACCES etc. failures as permanent * movemail.c (main): Treat any link failure other than EEXIST as a permanent failure, not just EPERM. EACCES, for example. --- lib-src/ChangeLog | 6 ++++++ lib-src/movemail.c | 7 ++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 8e835795e6a..b85ba12a5b2 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-23 Paul Eggert + + movemail: treat EACCES etc. failures as permanent + * movemail.c (main): Treat any link failure other than EEXIST as a + permanent failure, not just EPERM. EACCES, for example. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). diff --git a/lib-src/movemail.c b/lib-src/movemail.c index adc5dd96409..264b3d292c6 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -328,11 +328,8 @@ main (int argc, char **argv) tem = link (tempname, lockname); -#ifdef EPERM - if (tem < 0 && errno == EPERM) - fatal ("Unable to create hard link between %s and %s", - tempname, lockname); -#endif + if (tem < 0 && errno != EEXIST) + pfatal_with_name (lockname); unlink (tempname); if (tem >= 0) -- cgit v1.3 From 930a6273b85ca1bd9a1406f50f52845637fc10ea Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Fri, 23 Nov 2012 16:33:20 +0800 Subject: Add some missing find options to find-cmd.el. * find-cmd.el (find-constituents): Add executable, ipath, readable, samefile, writable, daystart, regextype. Fixes: debbugs:12856 --- lisp/ChangeLog | 5 +++++ lisp/find-cmd.el | 15 +++++++++++---- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5ace77ed0d3..09f42233f96 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-11-23 Chong Yidong + + * find-cmd.el (find-constituents): Add executable, ipath, + readable, samefile, writable, daystart, regextype (Bug#12856). + 2012-11-23 Stefan Monnier * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el index 6589bac0c6a..4cf5b85c81a 100644 --- a/lisp/find-cmd.el +++ b/lisp/find-cmd.el @@ -63,6 +63,7 @@ (cnewer . (1)) (ctime . (1)) (empty . (0)) + (executable . (0)) (false . (0)) (fstype . (1)) (gid . (1)) @@ -70,37 +71,43 @@ (ilname . (1)) (iname . (1)) (inum . (1)) - (iwholename . (1)) + (ipath . (1)) (iregex . (1)) + (iwholename . (1)) (links . (1)) (lname . (1)) (mmin . (1)) (mtime . (1)) (name . (1)) (newer . (1)) - (nouser . (0)) (nogroup . (0)) + (nouser . (0)) (path . (1)) (perm . (0)) + (readable . (0)) (regex . (1)) - (wholename . (1)) + (samefile . (1)) (size . (1)) (true . (0)) (type . (1)) (uid . (1)) (used . (1)) (user . (1)) + (wholename . (1)) + (writable . (0)) (xtype . (nil)) ;; normal options (always true) + (daystart . (0)) (depth . (0)) (maxdepth . (1)) (mindepth . (1)) (mount . (0)) (noleaf . (0)) - (xdev . (0)) (ignore_readdir_race . (0)) (noignore_readdir_race . (0)) + (regextype . (1)) + (xdev . (0)) ;; actions (delete . (0)) -- cgit v1.3 From a879f0eaae49460a29c840e3e35acdb84aa9aa7e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 23 Nov 2012 10:47:34 +0200 Subject: Fix bug #12955 with building under MSYS Bash. src/makefile.w32-in (globals.h, gl-stamp): Use $(SWITCHCHAR) instead of a literal "/". (gl-stamp): Invoke fc.exe directly, not through cmd. --- nt/ChangeLog | 7 +++++++ nt/gmake.defs | 8 ++++++++ nt/nmake.defs | 1 + src/ChangeLog | 6 ++++++ src/makefile.w32-in | 4 ++-- 5 files changed, 24 insertions(+), 2 deletions(-) diff --git a/nt/ChangeLog b/nt/ChangeLog index 6737f952a43..ae6cb231614 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,10 @@ +2012-11-23 Eli Zaretskii + + * gmake.defs (SWITCHCHAR): Define to // under MSYS, / otherwise. + (Bug#12955) + + * nmake.defs (SWITCHCHAR): Define to /. + 2012-11-23 Paul Eggert Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). diff --git a/nt/gmake.defs b/nt/gmake.defs index 358c262db28..3d545fab975 100644 --- a/nt/gmake.defs +++ b/nt/gmake.defs @@ -69,10 +69,18 @@ sh_output := $(shell echo) ifeq "$(findstring ECHO, $(sh_output))" "ECHO" THE_SHELL = $(COMSPEC)$(ComSpec) SHELLTYPE=CMD +SWITCHCHAR=/ else USING_SH = 1 THE_SHELL = $(SHELL) SHELLTYPE=SH +# MSYS needs to double the slash in cmd-style switches to avoid +# interpreting /x as a Posix style file name reference +ifneq ($(MSYSTEM),) +SWITCHCHAR=// +else +SWITCHCHAR=/ +endif endif MAKETYPE=gmake diff --git a/nt/nmake.defs b/nt/nmake.defs index 16a787ea30a..2c6bc66b673 100644 --- a/nt/nmake.defs +++ b/nt/nmake.defs @@ -22,6 +22,7 @@ all: THE_SHELL = $(COMSPEC) SHELLTYPE=CMD +SWITCHCHAR=/ MAKETYPE=nmake diff --git a/src/ChangeLog b/src/ChangeLog index 5566b623cec..45df517eff5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-11-23 Eli Zaretskii + + * makefile.w32-in (globals.h, gl-stamp): Use $(SWITCHCHAR) instead + of a literal "/". (Bug#12955) + (gl-stamp): Invoke fc.exe directly, not through cmd. + 2012-11-23 Paul Eggert Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 5d0c6e72146..a296f6eb393 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -229,12 +229,12 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ obj = $(GLOBAL_SOURCES:.c=.o) globals.h: gl-stamp - @cmd /c rem true + @cmd $(SWITCHCHAR)c rem true gl-stamp: ../lib-src/$(BLD)/make-docfile.exe $(GLOBAL_SOURCES) - $(DEL) gl-tmp "$(THISDIR)/../lib-src/$(BLD)/make-docfile" -d . -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp - cmd /c "fc /b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h" + fc.exe $(SWITCHCHAR)b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h - $(DEL) gl-tmp echo timestamp > $@ -- cgit v1.3 From e7d0e5ee247a155a268ffbf80bedbe25e15b5032 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 23 Nov 2012 06:17:42 -0500 Subject: Auto-commit of generated files. --- autogen/config.in | 6 ------ autogen/configure | 5 +---- 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/autogen/config.in b/autogen/config.in index 9f530cc57d3..c0fb1f34bf4 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -253,9 +253,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `clock_settime' function. */ #undef HAVE_CLOCK_SETTIME -/* Define to 1 if you have the `closedir' function. */ -#undef HAVE_CLOSEDIR - /* Define to 1 if you have the header file. */ #undef HAVE_COFF_H @@ -339,9 +336,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `difftime' function. */ #undef HAVE_DIFFTIME -/* Define to 1 if you have the header file. */ -#undef HAVE_DIRENT_H - /* Define to 1 if you have the 'dup2' function. */ #undef HAVE_DUP2 diff --git a/autogen/configure b/autogen/configure index 0558955911f..fbb2efbc860 100755 --- a/autogen/configure +++ b/autogen/configure @@ -3214,7 +3214,6 @@ as_fn_append ac_header_list " sys/resource.h" as_fn_append ac_header_list " sys/utsname.h" as_fn_append ac_header_list " pwd.h" as_fn_append ac_header_list " utmp.h" -as_fn_append ac_header_list " dirent.h" as_fn_append ac_header_list " util.h" as_fn_append ac_header_list " sys/socket.h" as_fn_append ac_header_list " stdlib.h" @@ -8806,8 +8805,6 @@ done - - @@ -13474,7 +13471,7 @@ esac for ac_func in gethostname \ -closedir getrusage get_current_dir_name \ +getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ utimes getrlimit setrlimit shutdown getaddrinfo \ -- cgit v1.3