From 71d73c9c284c7a617f488c00c1fe0a923d553ebd Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 9 Apr 2011 15:57:47 -0400 Subject: [PATCH 01/77] Image mode doc fixes (Bug#8098). * lisp/image-mode.el (image-type, image-mode-map, image-minor-mode-map) (image-toggle-display): Doc fixes. --- lisp/ChangeLog | 5 +++++ lisp/image-mode.el | 14 +++++++------- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8f24803e3e9..f85300264ff 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-09 Chong Yidong + + * image-mode.el (image-type, image-mode-map, image-minor-mode-map) + (image-toggle-display): + 2011-04-06 Juanma Barranquero Backport revno:103823 and revno:103824 from trunk. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 191e347330d..9ef43442980 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -304,8 +304,7 @@ This function assumes the current frame has only one window." ;;; Image Mode setup (defvar image-type nil - "Current image type. -This variable is used to display the current image type in the mode line.") + "The image type for the current Image mode buffer.") (make-variable-buffer-local 'image-type) (defvar image-mode-previous-major-mode nil @@ -329,13 +328,13 @@ This variable is used to display the current image type in the mode line.") (define-key map [remap beginning-of-buffer] 'image-bob) (define-key map [remap end-of-buffer] 'image-eob) map) - "Major mode keymap for viewing images in Image mode.") + "Mode keymap for `image-mode'.") (defvar image-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'image-toggle-display) map) - "Minor mode keymap for viewing images as text in Image mode.") + "Mode keymap for `image-minor-mode'.") (defvar bookmark-make-record-function) @@ -521,9 +520,10 @@ was inserted." (message "Repeat this command to go back to displaying the file as text")))) (defun image-toggle-display () - "Start or stop displaying an image file as the actual image. -This command toggles between `image-mode-as-text' showing the text of -the image file and `image-mode' showing the image as an image." + "Toggle between image and text display. +If the current buffer is displaying an image file as an image, +call `image-mode-as-text' to switch to text. Otherwise, display +the image by calling `image-mode'." (interactive) (if (image-get-display-property) (image-mode-as-text) From 6395aab9034182b316869c56ee82241adb7a76eb Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 9 Apr 2011 16:29:22 -0400 Subject: [PATCH 02/77] Fix last change. --- lisp/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f85300264ff..9f7577fa829 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,7 @@ 2011-04-09 Chong Yidong * image-mode.el (image-type, image-mode-map, image-minor-mode-map) - (image-toggle-display): + (image-toggle-display): Doc fix. 2011-04-06 Juanma Barranquero From 3ad8bad03884c5e3a1609083973997abe1feeb8c Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 9 Apr 2011 22:10:52 -0400 Subject: [PATCH 03/77] Handle deferred `event-kind' property when using unread-command-events. * src/mouse.el (mouse-drag-mode-line-1): Make sure that if we push mouse-2 into unread-command-events, it is interpreted correctly. --- lisp/ChangeLog | 5 +++++ lisp/mouse.el | 3 +++ 2 files changed, 8 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9f7577fa829..a2ed50e4b6f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-10 Chong Yidong + + * mouse.el (mouse-drag-mode-line-1): Make sure that if we push + mouse-2 into unread-command-events, it is interpreted correctly. + 2011-04-09 Chong Yidong * image-mode.el (image-type, image-mode-map, image-minor-mode-map) diff --git a/lisp/mouse.el b/lisp/mouse.el index bed4776c135..628f900e886 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -538,6 +538,9 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ;; a `drag-mouse-1'. In any case `on-link' would have been nulled ;; above if there had been any significant mouse movement. (when (and on-link (eq 'mouse-1 (car-safe event))) + ;; If mouse-2 has never been done by the user, it doesn't + ;; have the necessary property to be interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click) (push (cons 'mouse-2 (cdr event)) unread-command-events)))))) (defun mouse-drag-mode-line (start-event) From 4095436808b499ffb813daac6f7cea828318faa5 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 10 Apr 2011 16:43:35 -0400 Subject: [PATCH 04/77] Doc fix for left-fringe and right-fringe parameters (Bug#6930) * doc/lispref/frames.texi (Layout Parameters): Note the difference between querying and setting parameters for left-fringe and right-fringe. --- doc/lispref/ChangeLog | 6 ++++++ doc/lispref/frames.texi | 21 ++++++++++++--------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 440159a9a58..035fee67f8d 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,9 @@ +2011-04-10 Chong Yidong + + * frames.texi (Layout Parameters): Note the difference between + querying and setting parameters for left-fringe and right-fringe + (Bug#6930). + 2011-03-21 Stefan Monnier * minibuf.texi (Basic Completion): Be a bit more precise about the diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a99782b95e1..0c81718750a 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -654,17 +654,20 @@ use the default width. @itemx right-fringe The default width of the left and right fringes of windows in this frame (@pxref{Fringes}). If either of these is zero, that effectively -removes the corresponding fringe. A value of @code{nil} stands for -the standard fringe width, which is the width needed to display the -fringe bitmaps. +removes the corresponding fringe. + +When you use @code{frame-parameter} to query the value of either of +these two frame parameters, the return value is always an integer. +When using @code{set-frame-parameter}, passing a @code{nil} value +imposes an actual default value of 8 pixels. The combined fringe widths must add up to an integral number of -columns, so the actual default fringe widths for the frame may be -larger than the specified values. The extra width needed to reach an -acceptable total is distributed evenly between the left and right -fringe. However, you can force one fringe or the other to a precise -width by specifying that width as a negative integer. If both widths are -negative, only the left fringe gets the specified width. +columns, so the actual default fringe widths for the frame, as +reported by @code{frame-parameter}, may be larger than what you +specify. Any extra width is distributed evenly between the left and +right fringe. However, you can force one fringe or the other to a +precise width by specifying that width as a negative integer. If both +widths are negative, only the left fringe gets the specified width. @item menu-bar-lines The number of lines to allocate at the top of the frame for a menu From 7e735aaf4d422be1c3bdf6a72e0ce6043a3e2cdf Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 10 Apr 2011 16:52:31 -0400 Subject: [PATCH 05/77] Fix for what-page (Bug#6825). * textmodes/page.el (what-page): Use line-number-at-pos to calculate line number. --- lisp/ChangeLog | 5 +++++ lisp/textmodes/page.el | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a2ed50e4b6f..c89bb3f281a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-10 Stephen Berman + + * textmodes/page.el (what-page): Use line-number-at-pos to + calculate line number (Bug#6825). + 2011-04-10 Chong Yidong * mouse.el (mouse-drag-mode-line-1): Make sure that if we push diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index d71e20030ff..a758a9ba998 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -156,9 +156,9 @@ thus showing a page other than the one point was originally in." (if (= (match-beginning 0) (match-end 0)) (forward-char 1)) (setq count (1+ count))) - (message "Page %d, line %d" - count - (1+ (count-lines (point) opoint))))))) + (message "Page %d, line %d" count (line-number-at-pos opoint)))))) + + ;;; Place `provide' at end of file. (provide 'page) From fde4eb868f9ec91cb3a281f798da2c0ebdadd5a3 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 10 Apr 2011 16:55:52 -0400 Subject: [PATCH 06/77] * src/buffer.c (syms_of_buffer): Doc fix (Bug#6902). --- src/ChangeLog | 4 ++++ src/buffer.c | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 570a55ec2a2..3c6d4fc8841 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2011-04-10 Chong Yidong + + * buffer.c (syms_of_buffer): Doc fix (Bug#6902). + 2011-04-08 Chong Yidong * ftfont.c (get_adstyle_property, ftfont_pattern_entity): Use diff --git a/src/buffer.c b/src/buffer.c index e7759cb5255..076495cfc64 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5746,7 +5746,8 @@ Linefeed indents to this column in Fundamental mode. */); DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer->tab_width, make_number (LISP_INT_TAG), - doc: /* *Distance between tab stops (for display of tab characters), in columns. */); + doc: /* *Distance between tab stops (for display of tab characters), in columns. +This should be an integer greater than zero. */); DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer->ctl_arrow, Qnil, doc: /* *Non-nil means display control chars with uparrow. From 6f21a3198d25844445ab58a5f08d968197e5ea4e Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 10 Apr 2011 17:07:40 -0400 Subject: [PATCH 07/77] Fix completion-auto-help/icomplete-mode bad interaction (Bug#5849). * minibuffer.el (completion--do-completion): Avoid the "Next char not unique" prompt if icomplete-mode is enabled. --- lisp/ChangeLog | 5 +++++ lisp/minibuffer.el | 7 ++++--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c89bb3f281a..cbfbd2b71f1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-10 Chong Yidong + + * minibuffer.el (completion--do-completion): Avoid the "Next char + not unique" prompt if icomplete-mode is enabled (Bug#5849). + 2011-04-10 Stephen Berman * textmodes/page.el (what-page): Use line-number-at-pos to diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 338ab4e281e..adbb9a6c539 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -574,9 +574,10 @@ E = after completion we now have an Exact match. ;; Show the completion table, if requested. (cond ((not exact) - (if (case completion-auto-help - (lazy (eq this-command last-command)) - (t completion-auto-help)) + (if (cond (icomplete-mode t) + ((eq completion-auto-help 'lazy) + (eq this-command last-command)) + (t completion-auto-help)) (minibuffer-completion-help) (minibuffer-message "Next char not unique"))) ;; If the last exact completion and this one were the same, it From 300f9fca551d3aa024ff24b85e6ab7f0ae49ae03 Mon Sep 17 00:00:00 2001 From: Samuel Thibault Date: Sun, 10 Apr 2011 18:05:04 -0400 Subject: [PATCH 08/77] Fix wait_for_termination on GNU Hurd (Bug#8467) * sysdep.c (wait_for_termination): On GNU Hurd, kill returns -1 on zombies. --- src/ChangeLog | 5 +++++ src/sysdep.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3c6d4fc8841..f82494f8a04 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-10 Samuel Thibault (tiny change) + + * sysdep.c (wait_for_termination): On GNU Hurd, kill returns -1 on + zombies (Bug#8467). + 2011-04-10 Chong Yidong * buffer.c (syms_of_buffer): Doc fix (Bug#6902). diff --git a/src/sysdep.c b/src/sysdep.c index 1fbc0617904..3abb43f14d2 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -411,7 +411,7 @@ wait_for_termination (pid) while (1) { #ifdef subprocesses -#if defined (BSD_SYSTEM) || defined (HPUX) +#if (defined (BSD_SYSTEM) || defined (HPUX)) && !defined(__GNU__) /* Note that kill returns -1 even if the process is just a zombie now. But inevitably a SIGCHLD interrupt should be generated and child_sig will do wait3 and make the process go away. */ From 7ee6a1d37268f1f4b7047fc6ccad271d2ee5fd31 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 13 Apr 2011 13:50:12 +0200 Subject: [PATCH 09/77] Fix typos. --- doc/emacs/ChangeLog | 5 +++++ doc/emacs/mini.texi | 2 +- doc/emacs/screen.texi | 2 +- doc/lispref/ChangeLog | 4 ++++ doc/lispref/windows.texi | 2 +- lisp/ChangeLog.14 | 2 +- lisp/cedet/ChangeLog | 8 ++++++++ lisp/cedet/ede/pconf.el | 4 ++-- lisp/cedet/ede/proj-comp.el | 4 ++-- lisp/cedet/ede/proj-elisp.el | 8 ++++---- lisp/cedet/ede/proj-scheme.el | 2 +- src/dispextern.h | 4 ++-- src/msdos.c | 2 +- 13 files changed, 33 insertions(+), 16 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index edd66bddfdf..4923316c4db 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2011-04-13 Juanma Barranquero + + * mini.texi (Minibuffer Edit): + * screen.texi (Mode Line): Fix typo. + 2011-03-26 Chong Yidong * display.texi (Auto Scrolling): Fix scroll-up/scroll-down confusion. diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index bf7e4469dd9..b7bda61e238 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -165,7 +165,7 @@ however: for instance, you cannot split it. @xref{Windows}. @vindex resize-mini-windows Normally, the minibuffer window occupies a single screen line. However, if you add two or more lines' worth of text into the -minibuffer, it expands automatically to accomodate the text. The +minibuffer, it expands automatically to accommodate the text. The variable @code{resize-mini-windows} controls the resizing of the minibuffer. The default value is @code{grow-only}, which means the behavior we have just described. If the value is @code{t}, the diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi index c3b2e178278..f12c03e1abf 100644 --- a/doc/emacs/screen.texi +++ b/doc/emacs/screen.texi @@ -260,7 +260,7 @@ the buffer. Minor modes are optional editing modes that provide additional features on top of the major mode. @xref{Minor Modes}. Some features are listed together with the minor modes whenever they -are turned on, even through they are not really minor modes. +are turned on, even though they are not really minor modes. @samp{Narrow} means that the buffer being displayed has editing restricted to only a portion of its text (@pxref{Narrowing}). @samp{Def} means that a keyboard macro is currently being defined diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 035fee67f8d..fc57e20e612 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2011-04-13 Juanma Barranquero + + * windows.texi (Choosing Window): Fix typo. + 2011-04-10 Chong Yidong * frames.texi (Layout Parameters): Note the difference between diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 77fd44fb162..f17fc3c718b 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1015,7 +1015,7 @@ a window only if the space taken up by that window can accommodate two windows one above the other that are both at least @code{window-min-height} lines tall. Moreover, if the window that shall be split has a mode line, @code{split-window-sensibly} does not split -the window unless the new window can accomodate a mode line too. +the window unless the new window can accommodate a mode line too. @end defopt @defopt split-width-threshold diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index cf08fd0ae44..54d41f4d0ed 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -4283,7 +4283,7 @@ (proced-descend): New variable. (proced-sort): New arg descend. (proced-sort-interactive): Repeated calls toggle sort order. - (proced-format): Accomodate changes of proced-format-alist. + (proced-format): Accommodate changes of proced-format-alist. Undefined attributes are displayed as "?". (proced-process-attributes): New optional arg pid-list. Ignore processes with empty attribute list. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 2d0cbb8159b..d8a4209cc98 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,11 @@ +2011-04-13 Juanma Barranquero + + * ede/pconf.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-comp.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-elisp.el (ede-proj-tweak-autoconf, ede-proj-flush-autoconf) + (ede-proj-tweak-autoconf, ede-proj-flush-autoconf): + * ede/proj-scheme.el (ede-proj-tweak-autoconf): Fix typos in docstrings. + 2011-03-07 Chong Yidong * Version 23.3 released. diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index a2258c1d16f..77299c7eb39 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -160,7 +160,7 @@ don't do it. A value of nil means to just do it.") (ede-proj-configure-synchronize this)) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." ;; Check the compilers belonging to THIS, and call the autoconf ;; setup for those compilers. (mapc 'ede-proj-tweak-autoconf (ede-proj-compilers this)) @@ -168,7 +168,7 @@ don't do it. A value of nil means to just do it.") ) (defmethod ede-proj-flush-autoconf ((this ede-proj-target)) - "Flush the configure file (current buffer) to accomodate THIS. + "Flush the configure file (current buffer) to accommodate THIS. By flushing, remove any cruft that may be in the file. Subsequent calls to `ede-proj-tweak-autoconf' can restore items removed by flush." nil) diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 9ec5cc64306..8757a6a1403 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -236,7 +236,7 @@ This will prevent rules from creating duplicate variables or rules." ;;; Methods: (defmethod ede-proj-tweak-autoconf ((this ede-compilation-program)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (mapcar (lambda (obj) (cond ((stringp obj) @@ -248,7 +248,7 @@ This will prevent rules from creating duplicate variables or rules." (oref this autoconf))) (defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." nil) (defmacro proj-comp-insert-variable-once (varname &rest body) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index cff68debef0..1182c41128c 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -214,7 +214,7 @@ is found, such as a `-version' variable, or the standard header." (error "Don't know how to update load path")))) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (call-next-method) ;; Ok, now we have to tweak the autoconf provided `elisp-comp' program. (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))) @@ -238,7 +238,7 @@ is found, such as a `-version' variable, or the standard header." (save-buffer)) ))) (defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." ;; Remove crufty old paths from elisp-compile (let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) ) @@ -381,11 +381,11 @@ Argument THIS is the target which needs to insert an info file." ) (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (error "Autoloads not supported in autoconf yet")) (defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads)) - "Flush the configure file (current buffer) to accomodate THIS." + "Flush the configure file (current buffer) to accommodate THIS." nil) (provide 'ede/proj-elisp) diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el index 64a17503684..e3d99129d31 100644 --- a/lisp/cedet/ede/proj-scheme.el +++ b/lisp/cedet/ede/proj-scheme.el @@ -41,7 +41,7 @@ "This target consists of scheme files.") (defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) - "Tweak the configure file (current buffer) to accomodate THIS." + "Tweak the configure file (current buffer) to accommodate THIS." (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) (provide 'ede/proj-scheme) diff --git a/src/dispextern.h b/src/dispextern.h index 8e19bdae197..8ae5e23fa97 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -63,7 +63,7 @@ typedef HDC XImagePtr_or_DC; #ifdef HAVE_NS #include "nsgui.h" -/* following typedef needed to accomodate the MSDOS port, believe it or not */ +/* Following typedef needed to accommodate the MSDOS port, believe it or not. */ typedef struct ns_display_info Display_Info; typedef Pixmap XImagePtr; typedef XImagePtr XImagePtr_or_DC; @@ -368,7 +368,7 @@ struct glyph doesn't have a glyph in a font. */ unsigned glyph_not_available_p : 1; - + /* Non-zero means don't display cursor here. */ unsigned avoid_cursor_p : 1; diff --git a/src/msdos.c b/src/msdos.c index 87b857bbb9d..c176680bf9d 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -960,7 +960,7 @@ IT_set_face (int face) /* According to RBIL (INTERRUP.A, V-1000), 160 is the maximum possible width of a DOS display in any known text mode. We multiply by 2 to - accomodate the screen attribute byte. */ + accommodate the screen attribute byte. */ #define MAX_SCREEN_BUF 160*2 Lisp_Object Vdos_unsupported_char_glyph; From c17819f4cd58df1a0a17593152e32fee70cc90f7 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Wed, 13 Apr 2011 14:19:23 -0400 Subject: [PATCH 10/77] * xdisp.c (init_xdisp): Initialize echo_area_window (Bug#6451). --- src/ChangeLog | 4 ++++ src/xdisp.c | 1 + 2 files changed, 5 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index f82494f8a04..cfa9426c882 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2011-04-13 Chong Yidong + + * xdisp.c (init_xdisp): Initialize echo_area_window (Bug#6451). + 2011-04-10 Samuel Thibault (tiny change) * sysdep.c (wait_for_termination): On GNU Hurd, kill returns -1 on diff --git a/src/xdisp.c b/src/xdisp.c index ade95cf3d62..c42410b9f9f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25139,6 +25139,7 @@ init_xdisp () mini_w = XWINDOW (minibuf_window); root_window = FRAME_ROOT_WINDOW (XFRAME (WINDOW_FRAME (mini_w))); + echo_area_window = minibuf_window; if (!noninteractive) { From 6470c3c6a99ed0d1eae68bbbe1d0a3f6ca8b4983 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Fri, 15 Apr 2011 04:56:50 +0200 Subject: [PATCH 11/77] lisp/mouse-drag.el (mouse-drag-throw): Fix typo in docstring. --- lisp/ChangeLog | 4 ++++ lisp/mouse-drag.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cbfbd2b71f1..13561921b1f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-04-15 Juanma Barranquero + + * mouse-drag.el (mouse-drag-throw): Fix typo in docstring. + 2011-04-10 Chong Yidong * minibuffer.el (completion--do-completion): Avoid the "Next char diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index c892501fe53..84a680bfcde 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -195,7 +195,7 @@ from the original mouse click to the current mouse location. Try it; you'll like it. It's easier to observe than to explain. If the mouse is clicked and released in the same place of time we -assume that the user didn't want to scdebugroll but wanted to whatever +assume that the user didn't want to scroll but wanted to whatever mouse-2 used to do, so we pass it through. Throw scrolling was inspired (but is not identical to) the \"hand\" From 97a9309556465557781fb95b2bc5a44f7b4520b9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 18 Apr 2011 11:33:58 +0300 Subject: [PATCH 12/77] Fix a bug in time functions when timezone is changed on Windows. src/s/ms-w32.h (localtime): Redirect to sys_localtime. src/w32.c: Include . (sys_localtime): New function. --- src/ChangeLog | 7 +++++++ src/s/ms-w32.h | 1 + src/w32.c | 22 ++++++++++++++++++++++ 3 files changed, 30 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index cfa9426c882..faf9564a835 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-04-18 Eli Zaretskii + + * s/ms-w32.h (localtime): Redirect to sys_localtime. + + * w32.c: Include . + (sys_localtime): New function. + 2011-04-13 Chong Yidong * xdisp.c (init_xdisp): Initialize echo_area_window (Bug#6451). diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index 2b0a60cfab9..b9e57687a09 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -236,6 +236,7 @@ along with GNU Emacs. If not, see . */ #define dup2 sys_dup2 #define fopen sys_fopen #define link sys_link +#define localtime sys_localtime #define mkdir sys_mkdir #undef mktemp #define mktemp sys_mktemp diff --git a/src/w32.c b/src/w32.c index 8dbf0cf8f19..804d6d0c4bc 100644 --- a/src/w32.c +++ b/src/w32.c @@ -35,6 +35,7 @@ along with GNU Emacs. If not, see . */ #include /* for _mbspbrk */ #include #include +#include /* must include CRT headers *before* config.h */ @@ -65,6 +66,8 @@ along with GNU Emacs. If not, see . */ #undef strerror +#undef localtime + #include "lisp.h" #include @@ -1961,6 +1964,12 @@ gettimeofday (struct timeval *tv, struct timezone *tz) tv->tv_sec = tb.time; tv->tv_usec = tb.millitm * 1000L; + /* Implementation note: _ftime sometimes doesn't update the dstflag + according to the new timezone when the system timezone is + changed. We could fix that by using GetSystemTime and + GetTimeZoneInformation, but that doesn't seem necessary, since + Emacs always calls gettimeofday with the 2nd argument NULL (see + EMACS_GET_TIME). */ if (tz) { tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ @@ -5676,6 +5685,19 @@ sys_write (int fd, const void * buffer, unsigned int count) return nchars; } +/* The Windows CRT functions are "optimized for speed", so they don't + check for timezone and DST changes if they were last called less + than 1 minute ago (see http://support.microsoft.com/kb/821231). So + all Emacs features that repeatedly call time functions (e.g., + display-time) are in real danger of missing timezone and DST + changes. Calling tzset before each localtime call fixes that. */ +struct tm * +sys_localtime (const time_t *t) +{ + tzset (); + return localtime (t); +} + static void check_windows_init_file () { From 40c9205d587f0b0ae88c683cd523b125eeb2c39e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 19 Apr 2011 19:11:41 -0700 Subject: [PATCH 13/77] ChangeLog whitespace fix (no need to merge to trunk). --- ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index b45615d4317..e305cb7faa1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,6 @@ 2011-03-13 Glenn Morris - * configure.in (FREETYPE_LIBS): Actually set it to something. + * configure.in (FREETYPE_LIBS): Actually set it to something. 2011-03-13 Miles Bader From e7dcef2a6667aca45504dd205435692513494407 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 20 Apr 2011 06:18:10 -0400 Subject: [PATCH 14/77] Auto-commit of generated files. --- autogen/configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/autogen/configure b/autogen/configure index 0dacc86a99d..f433171636b 100755 --- a/autogen/configure +++ b/autogen/configure @@ -9323,7 +9323,7 @@ fi use_mmap_for_buffers=no case "$opsys" in - freebsd|irix6-5) use_mmap_for_buffers=yes ;; + cygwin|freebsd|irix6-5) use_mmap_for_buffers=yes ;; esac From b2e59ad27f0e26709d0e89c13d4b58d9b5033851 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 20 Apr 2011 06:23:12 -0400 Subject: [PATCH 15/77] Auto-commit of loaddefs files. --- lisp/dired.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index 73a716d0bff..c581597494c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3629,7 +3629,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "0488aa71a7abdb8dcc9ce90201114ebc") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "e34e1bbdb701078d52466c319d8e0cda") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4089,7 +4089,7 @@ true then the type of the file linked to by FILE is printed instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "87fd4ae2fdade7e0f11c4a0b1cfdeda2") +;;;;;; "dired-x" "dired-x.el" "94bd5ca0bd260e43402e3cd9f114970c") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ From bed7f14004246c8ade77a48f79f0cc48f2ca74f7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 14:18:34 -0300 Subject: [PATCH 16/77] * lisp/obsolete/erc-hecomplete.el: Make obsolete. * obsolete/: Standardize obsolescence info in the header. --- lisp/ChangeLog | 5 +++++ lisp/obsolete/awk-mode.el | 3 +-- lisp/{erc => obsolete}/erc-hecomplete.el | 17 ++++++++--------- lisp/obsolete/fast-lock.el | 3 +-- lisp/obsolete/iso-acc.el | 3 +-- lisp/obsolete/iso-insert.el | 3 +-- lisp/obsolete/iso-swed.el | 3 +-- lisp/obsolete/keyswap.el | 3 +-- lisp/obsolete/lazy-lock.el | 3 +-- lisp/obsolete/old-whitespace.el | 3 +-- lisp/obsolete/options.el | 3 +-- lisp/obsolete/resume.el | 3 +-- lisp/obsolete/scribe.el | 3 +-- lisp/obsolete/swedish.el | 3 +-- lisp/obsolete/vc-mcvs.el | 4 +--- 15 files changed, 26 insertions(+), 36 deletions(-) rename lisp/{erc => obsolete}/erc-hecomplete.el (95%) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 867d7f9aa23..a7aedca6944 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-20 Stefan Monnier + + * obsolete/erc-hecomplete.el: Make obsolete. + * obsolete/: Standardize obsolescence info in the header. + 2011-04-20 Glenn Morris * calendar/solar.el (solar-horizontal-coordinates): diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el index d09ff1dd892..1a6d08c08ef 100644 --- a/lisp/obsolete/awk-mode.el +++ b/lisp/obsolete/awk-mode.el @@ -4,6 +4,7 @@ ;; Maintainer: FSF ;; Keywords: unix, languages +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Sets up C-mode with support for awk-style #-comments and a lightly ;; hacked syntax table. diff --git a/lisp/erc/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el similarity index 95% rename from lisp/erc/erc-hecomplete.el rename to lisp/obsolete/erc-hecomplete.el index 530c586d24f..67f51d690b2 100644 --- a/lisp/erc/erc-hecomplete.el +++ b/lisp/obsolete/erc-hecomplete.el @@ -4,6 +4,7 @@ ;; Author: Alex Schroeder ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion +;; Obsolete-since: 24.1 ;; This file is part of GNU Emacs. @@ -108,16 +109,14 @@ add this string when a unique expansion was found." This is a function to put on `hippie-expand-try-functions-list'. Then use \\[hippie-expand] to expand nicks. The type of completion depends on `erc-nick-completion'." - (cond ((eq erc-nick-completion 'pals) - (try-complete-erc-nick old erc-pals)) - ((eq erc-nick-completion 'all) - (try-complete-erc-nick old (append + (try-complete-erc-nick old (cond ((eq erc-nick-completion 'pals) erc-pals) + ((eq erc-nick-completion 'all) + (append (erc-get-channel-nickname-list) - (erc-command-list)))) - ((functionp erc-nick-completion) - (try-complete-erc-nick old (funcall erc-nick-completion))) - (t - (try-complete-erc-nick old erc-nick-completion)))) + (erc-command-list))) + ((functionp erc-nick-completion) + (funcall erc-nick-completion)) + (t erc-nick-completion)))) (defvar try-complete-erc-nick-window-configuration nil "The window configuration for `try-complete-erc-nick'. diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index a59e7871458..9c750ca5e89 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: faces files ;; Version: 3.14 +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Fast Lock mode is a Font Lock support mode. ;; It makes visiting a file in Font Lock mode faster by restoring its face text ;; properties from automatically saved associated Font Lock cache files. diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el index 14b6a202012..cb06091dfcf 100644 --- a/lisp/obsolete/iso-acc.el +++ b/lisp/obsolete/iso-acc.el @@ -5,6 +5,7 @@ ;; Author: Johan Vromans ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Function `iso-accents-mode' activates a minor mode in which ;; typewriter "dead keys" are emulated. The purpose of this emulation ;; is to provide a simple means for inserting accented characters diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el index 3f3b6d4abb3..c223d096730 100644 --- a/lisp/obsolete/iso-insert.el +++ b/lisp/obsolete/iso-insert.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Provides keys for inserting ISO Latin-1 characters. They use the ;; prefix key C-x 8. Type C-x 8 C-h for a list. diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el index d197f0d5b67..43686283e89 100644 --- a/lisp/obsolete/iso-swed.el +++ b/lisp/obsolete/iso-swed.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Written by Howard Gayle. See case-table.el for details. ;;; Code: diff --git a/lisp/obsolete/keyswap.el b/lisp/obsolete/keyswap.el index f95b8f5bdb5..ec1263e5189 100644 --- a/lisp/obsolete/keyswap.el +++ b/lisp/obsolete/keyswap.el @@ -4,6 +4,7 @@ ;; Author: Eric S. Raymond ;; Keywords: terminals +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; This package is meant to be called by other terminal packages. ;;; Code: diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el index f922a5c30b6..a04db4a0c72 100644 --- a/lisp/obsolete/lazy-lock.el +++ b/lisp/obsolete/lazy-lock.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: faces files ;; Version: 2.11 +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Purpose: ;; ;; Lazy Lock mode is a Font Lock support mode. diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index be967938bc9..c33794f668d 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -4,6 +4,7 @@ ;; Author: Rajesh Vaidheeswarran ;; Keywords: convenience +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -22,8 +23,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 23.1. - ;; URL: http://www.dsmit.com/lisp/ ;; ;; The whitespace library is intended to find and help fix five different types diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index 1b475e9e98b..7c1c3552e2d 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -21,8 +22,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; This code provides functions to list and edit the values of all global ;; option variables known to loaded Emacs Lisp code. There are two entry ;; points, `list-options' and `edit' options'. The latter enters a major diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el index 6b52ef28784..c9df1184d90 100644 --- a/lisp/obsolete/resume.el +++ b/lisp/obsolete/resume.el @@ -5,6 +5,7 @@ ;; Author: Joe Wells ;; Adapted-By: ESR ;; Keywords: processes +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 23.1. - ;; The purpose of this library is to handle command line arguments ;; when you resume an existing Emacs job. diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el index 3f543b38e44..1fbc9bc4158 100644 --- a/lisp/obsolete/scribe.el +++ b/lisp/obsolete/scribe.el @@ -6,6 +6,7 @@ ;; (according to ack.texi) ;; Maintainer: FSF ;; Keywords: wp +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -24,8 +25,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; A major mode for editing source in written for the Scribe text formatter. ;; Knows about Scribe syntax and standard layout rules. The command to ;; run Scribe on a buffer is bogus; someone interested should fix it. diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el index 4b82a74bce7..c31af8697ef 100644 --- a/lisp/obsolete/swedish.el +++ b/lisp/obsolete/swedish.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Obsolete-since: 22.1 ;; This file is part of GNU Emacs. @@ -23,8 +24,6 @@ ;;; Commentary: -;; This file has been obsolete since Emacs 22.1. - ;; Fixme: Is this actually used? if so, it should be in language, ;; possibly as a feature property of Swedish, probably defining a ;; `swascii' coding system. diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el index 06ce7f41c65..980cdbfd71b 100644 --- a/lisp/obsolete/vc-mcvs.el +++ b/lisp/obsolete/vc-mcvs.el @@ -4,6 +4,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: None +;; Obsolete-since: 23.1 ;; This file is part of GNU Emacs. @@ -30,9 +31,6 @@ ;; ;; ********** READ THIS! ********** -;; This file has been obsolete and unsupported since Emacs 23.1. - - ;; The home page of the Meta-CVS version control system is at ;; ;; http://users.footprints.net/~kaz/mcvs.html From bfab7d852d64bcfe68073e03e787eb2200391d9d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 14:23:30 -0300 Subject: [PATCH 17/77] * Makefile.in (config.status): Don't erase in case of error. In case it disappeared, rebuild it with `configure'. --- ChangeLog | 5 +++++ Makefile.in | 9 ++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 6a3b1701726..7fcdef4272b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2011-04-20 Stefan Monnier + + * Makefile.in (config.status): Don't erase in case of error. + In case it disappeared, rebuild it with `configure'. + 2011-04-20 Ken Brown * configure.in (use_mmap_for_buffers): Set to yes on Cygwin. diff --git a/Makefile.in b/Makefile.in index 1ac77ed66ac..d828649e7aa 100644 --- a/Makefile.in +++ b/Makefile.in @@ -402,8 +402,15 @@ Makefile: config.status $(srcdir)/src/config.in \ $(srcdir)/test/automated/Makefile.in ./config.status +# Don't erase config.status if make is interrupted while refreshing it. +.PRECIOUS: config.status + config.status: ${srcdir}/configure ${srcdir}/lisp/version.el - ./config.status --recheck + if [ -x ./config.status ]; then \ + ./config.status --recheck; \ + else \ + ./configure; \ + fi AUTOCONF_INPUTS = @MAINT@ $(srcdir)/configure.in $(srcdir)/aclocal.m4 From 332e62ab1f5d90d22951b67c430cbd4da9c10dbe Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 14:28:07 -0300 Subject: [PATCH 18/77] * lisp/emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Remove dead code, add sanity check. --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/byte-opt.el | 9 ++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a7aedca6944..d019eca95c9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2011-04-20 Stefan Monnier + * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Remove dead code, + add sanity check. + * obsolete/erc-hecomplete.el: Make obsolete. * obsolete/: Standardize obsolescence info in the header. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 548fcd133df..7b98ade2422 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1364,8 +1364,7 @@ (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) (let ((length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset - lap tmp - endtag) + lap tmp) (while (not (= bytedecomp-ptr length)) (or make-spliceable (push bytedecomp-ptr lap)) @@ -1373,7 +1372,9 @@ optr bytedecomp-ptr ;; This uses dynamic-scope magic. offset (disassemble-offset bytes)) - (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) + (let ((opcode (aref byte-code-vector bytedecomp-op))) + (assert opcode) + (setq bytedecomp-op opcode)) (cond ((memq bytedecomp-op byte-goto-ops) ;; It's a pc. (setq offset @@ -1417,8 +1418,6 @@ (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) - (if endtag - (setq lap (cons (cons nil endtag) lap))) ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) (mapcar (function (lambda (elt) (if (numberp elt) From 1c6c854ec7faf9184115245c7e300df89f1795bc Mon Sep 17 00:00:00 2001 From: Christoph Scholtes Date: Wed, 20 Apr 2011 14:33:09 -0300 Subject: [PATCH 19/77] * lisp/vc/vc.el (vc-diff-build-argument-list-internal) (vc-version-ediff, vc-ediff): New functions. (vc-version-diff): Use vc-diff-build-argument-list-internal. * doc/emacs/maintaining.texi (Old Revisions): Add paragraph on new function vc-ediff. * etc/NEWS: Document new function `vc-ediff'. --- doc/emacs/ChangeLog | 191 +++++++++++++++++++------------------ doc/emacs/maintaining.texi | 7 ++ etc/ChangeLog | 4 + etc/NEWS | 3 + lisp/ChangeLog | 6 ++ lisp/vc/vc.el | 118 ++++++++++++++++------- 6 files changed, 200 insertions(+), 129 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 47aa395c730..d20c529f043 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2011-04-20 Christoph Scholtes + + * maintaining.texi (Old Revisions): Add paragraph on new function + vc-ediff. + 2011-03-26 Chong Yidong * display.texi (Auto Scrolling): Fix scroll-up/scroll-down confusion. @@ -22,8 +27,8 @@ 2011-03-09 Eli Zaretskii - * ack.texi (Acknowledgments): Convert to ISO-8859-1 encoding. Use - Texinfo @-commands for non Latin-1 characters. + * ack.texi (Acknowledgments): Convert to ISO-8859-1 encoding. + Use Texinfo @-commands for non Latin-1 characters. * makefile.w32-in (MAKEINFO_OPTS): Add --enable-encoding. @@ -231,8 +236,8 @@ (Old Revisions): Document revert-buffer for vc-diff. (Log Buffer): Promote to a subsection. Document header lines. - * macos.texi (Mac / GNUstep Basics): Document - ns-right-alternate-modifier. + * macos.texi (Mac / GNUstep Basics): + Document ns-right-alternate-modifier. * emacs.texi (Top): Update node listing. @@ -553,8 +558,8 @@ mail-self-blind, mail-default-reply-to, and mail-archive-file-name in favor of mail-default-headers. Ad index entries for user-full-name and user-mail-address. - (Citing Mail): Update changes in Message mode behavior. Document - mail-yank-prefix. + (Citing Mail): Update changes in Message mode behavior. + Document mail-yank-prefix. (Mail Signature): New node, moved from Mail Misc. (Mail Aliases): Mail abbrevs are the default with Message mode. (Mail Methods): Note that Message mode is now the default. @@ -724,8 +729,8 @@ * files.texi (Visiting): * buffers.texi (Buffers): Max buffer size is now 512 MB. - * frames.texi (Cut/Paste Other App): Document - save-interprogram-paste-before-kill. + * frames.texi (Cut/Paste Other App): + Document save-interprogram-paste-before-kill. * killing.texi (Kill Options): New node. @@ -813,8 +818,8 @@ * entering.texi (Exiting): C-z is now bound to suspend-frame. * custom.texi (Init Examples): Replace Rumseld with Cheny (Bug#3519). - (Key Bindings): Reference Init Rebinding in introductory text. Shift - some of the introduction to Keymaps node. + (Key Bindings): Reference Init Rebinding in introductory text. + Shift some of the introduction to Keymaps node. (Keymaps): Simplify. (Local Keymaps): Simplify. Move binding example to Init Rebinding. (Minibuffer Maps): Remove mention of Mocklisp. @@ -1080,8 +1085,8 @@ * misc.texi (Interactive Shell, Saving Emacs Sessions) (Shell History Copying, Terminal emulator): Copyedits. - * xresources.texi (Resources): Simplify descriptions. Shorten - description of editres, which is not very useful these days. + * xresources.texi (Resources): Simplify descriptions. + Shorten description of editres, which is not very useful these days. (Table of Resources): Document fontBackend resource. * trouble.texi (Quitting): Add other undo bindings to table. @@ -1102,8 +1107,8 @@ (Enabling Multibyte): Remove obsolete discussion. Copyedits. (Language Environments): Add language environments new to Emacs 23. (Multibyte Conversion): Node deleted. - (Coding Systems): Remove obsolete unify-8859-on-decoding-mode. Don't - mention obsolete emacs-mule coding system. + (Coding Systems): Remove obsolete unify-8859-on-decoding-mode. + Don't mention obsolete emacs-mule coding system. (Output Coding): Copyedits. * emacs.texi (Top): Update node listing. @@ -1159,8 +1164,8 @@ * mini.texi (Completion Commands): Describe Emacs 23 completion rules. (Completion Options): Document read-file-name-completion-ignore-case, - read-buffer-completion-ignore-case, and completion-styles. Remove - description of partial-completion-mode. + read-buffer-completion-ignore-case, and completion-styles. + Remove description of partial-completion-mode. 2009-03-14 Glenn Morris @@ -1582,8 +1587,8 @@ * files.texi (Visiting): Document new behavior of confirm-nonexistent-file-or-buffer. - * buffers.texi (Select Buffer): Document - confirm-nonexistent-file-or-buffer. + * buffers.texi (Select Buffer): + Document confirm-nonexistent-file-or-buffer. * picture-xtra.texi (Picture Mode): Use picture-mode instead of edit-picture. @@ -1708,8 +1713,8 @@ * dired.texi (Dired): Mention C-x C-d too. (Dired Enter): Document M-n in the Dired minibuffer. - (Dired Navigation): Explain dired-goto-file more clearly. Document - dired-isearch-filenames. + (Dired Navigation): Explain dired-goto-file more clearly. + Document dired-isearch-filenames. (Dired Deletion): Remove unnecessary "expunged" terminology. (Flagging Many Files): & is now rebound to `% &'. (Shell Commands in Dired): Document dired-do-async-shell-command. @@ -1731,8 +1736,8 @@ open-paren-in-column-0-is-defun-start more concisely. (Which Function, Program Indent, Info Lookup): Minor edits. (Basic Indent): If region is active, TAB indents the region. - (Multi-line Indent): If region is active, TAB indents the region. Note - that indent-region is useful when Transient Mark mode is off. + (Multi-line Indent): If region is active, TAB indents the region. + Note that indent-region is useful when Transient Mark mode is off. (Matching): The delimiter at the cursor is highlighted---the character changes color. (Symbol Completion): Link to Completion node. @@ -1761,12 +1766,12 @@ 2008-10-31 Chong Yidong - * misc.texi (Document View): Renamed from Document Files, moved here + * misc.texi (Document View): Rename from Document Files, moved here from files.texi. - * files.texi (Version Control): Moved to maintaining.texi. Subnodes - moved as well. - (Document Files): Moved to misc.texi. + * files.texi (Version Control): Move to maintaining.texi. + Subnodes moved as well. + (Document Files): Move to misc.texi. * maintaining.texi (Change Log): Document log-edit-insert-changelog and vc-update-change-log. @@ -1782,8 +1787,8 @@ 2008-10-31 Chong Yidong - * building.texi (Compilation Mode): Document - compilation-auto-jump-to-first-error. + * building.texi (Compilation Mode): + Document compilation-auto-jump-to-first-error. (Debuggers): Lower GUD subsections to subsubsections. (Starting GUD): Add cindex. (Lisp Interaction): Note that scratch is no longer the initial buffer. @@ -1801,8 +1806,8 @@ * emacs.texi (Top): Update node listings. - * misc.texi (Emacs Server): Rewrite. Document daemon-mode. Don't - mention obsolete emacs.bash script. + * misc.texi (Emacs Server): Rewrite. Document daemon-mode. + Don't mention obsolete emacs.bash script. (Invoking emacsclient): Rewrite, moving optional arguments to emacsclient Options. (emacsclient Options): New node. Document server-use-tcp and @@ -1842,7 +1847,7 @@ 2008-10-22 Tassilo Horn - * emacs.texi (Acknowledgments): Added myself to Acknowledgments + * emacs.texi (Acknowledgments): Add myself to Acknowledgments section. 2008-10-21 Chong Yidong @@ -1877,15 +1882,15 @@ crucial to using distributed version control systems. (Comparing Files): Note that diff uses the minibuffer, and that the output is shown using Diff mode. - (Diff Mode): Explain what "patch" and "hunk" mean. Document - diff-update-on-the-fly, diff-refine-hunk, and + (Diff Mode): Explain what "patch" and "hunk" mean. + Document diff-update-on-the-fly, diff-refine-hunk, and diff-show-trailing-whitespaces. (File Archives): Add rar support. * major.texi (Choosing Modes): Make mode selection sequence more obvious by describing the steps in order of priority. Note that - magic-mode-alist is nil by default. Document - magic-fallback-mode-alist. + magic-mode-alist is nil by default. + Document magic-fallback-mode-alist. 2008-10-20 Chong Yidong @@ -1944,8 +1949,8 @@ 2008-10-12 Chong Yidong * mini.texi (Minibuffer File): Add xref to File Names. - (Minibuffer File): Add discussion of `~' in file names. Add - insert-default-directory index reference. + (Minibuffer File): Add discussion of `~' in file names. + Add insert-default-directory index reference. * files.texi (File Names): Reorganize description. (Visiting): Add xref to Mode Line. Copyedits. @@ -1990,8 +1995,8 @@ * msdog-xtra.texi (MS-DOS Printing, MS-DOS and MULE): No need to create cpNNN coding systems anymore. (MS-DOS and MULE): Don't mention code-pages.el. Don't mention support - for unibyte mode. Don't mention line-drawing characters. Don't - mention dos-unsupported-char-glyph. + for unibyte mode. Don't mention line-drawing characters. + Don't mention dos-unsupported-char-glyph. 2008-09-25 Chong Yidong @@ -2022,12 +2027,12 @@ * kmacro.texi (Basic Keyboard Macro): Make F3 and F4 the preferred interface for defining macros. Simplify examples. Note that C-g quits macro definitions. - (Keyboard Macro Counter): Document using F3 to insert counter. Give - usage example. + (Keyboard Macro Counter): Document using F3 to insert counter. + Give usage example. (Keyboard Macro Query): Organize query responses in a table. - * fixit.texi (Fixit): Favor C-/ keybinding for undo throughout. Link - to Erasing node. + * fixit.texi (Fixit): Favor C-/ keybinding for undo throughout. + Link to Erasing node. (Undo): Reorganize paragraphs for logical flow. Move keybinding rationale to a footnote. (Kill Errors): Remove node, due to redundancy with Erasing. @@ -2229,8 +2234,8 @@ * display.texi (Visual Line Mode): New node. * basic.texi (Inserting Text): Move DEL to deletion node. - (Moving Point): Add additional alternative key bindings. Describe - line-move-visual. + (Moving Point): Add additional alternative key bindings. + Describe line-move-visual. (Erasing): Describe DEL. (Basic Undo, Blank Lines, Arguments): Copyedit. (Continuation Lines): Mention Visual Line mode. @@ -2349,8 +2354,8 @@ 2008-06-04 Miles Bader - * display.texi (Temporary Face Changes): Add - `adjust-buffer-face-height'. Rewrite description of + * display.texi (Temporary Face Changes): + Add `adjust-buffer-face-height'. Rewrite description of `increase-buffer-face-height' and `decrease-default-face-height' now that they aren't bound by default. @@ -2514,8 +2519,8 @@ (Replace, Unconditional Replace, Other Repeating Search): Describe Transient Mark mode as the default. - * text.texi (Words, Pages, Fill Commands, HTML Mode): Describe - Transient Mark mode as the default. + * text.texi (Words, Pages, Fill Commands, HTML Mode): + Describe Transient Mark mode as the default. (Paragraphs): Describe how M-h behaves when region is active. * trouble.texi (Quitting): Clarify effects of C-g. @@ -2661,8 +2666,8 @@ 2007-11-10 Paul Pogonyshev - * search.texi (Query Replace): Mention - `query-replace-show-replacement'. + * search.texi (Query Replace): + Mention `query-replace-show-replacement'. 2007-11-09 Nick Roberts @@ -3015,8 +3020,8 @@ 2007-04-20 David Koppelman - * display.texi (Highlight Interactively): Document - hi-lock-file-patterns-policy. + * display.texi (Highlight Interactively): + Document hi-lock-file-patterns-policy. 2007-04-20 Martin Rudalics @@ -3574,8 +3579,8 @@ 2006-08-10 Richard Stallman * text.texi (Format Faces): Substantial rewrites to deal - with face merging. Empty regions don't count. Clarify - face property inheritance. + with face merging. Empty regions don't count. + Clarify face property inheritance. 2006-08-08 Romain Francoise @@ -4034,7 +4039,7 @@ of emacs-xtra.texi. Convert each @chapter into @section, @section into @subsection, etc. - * emacs-xtra.texi (MS-DOS): Renamed from "MS-DOG". All references + * emacs-xtra.texi (MS-DOS): Rename from "MS-DOG". All references updated. * msdog.texi (Microsoft Windows): Rename from "Emacs and Microsoft @@ -4071,7 +4076,7 @@ (Comparing Files): Delete what duplicates new node. (Files): Put Diff Mode in menu. - * misc.texi (Diff Mode): Moved to files.texi. + * misc.texi (Diff Mode): Move to files.texi. * emacs.texi (Top): Update menu for Diff Mode. @@ -4997,8 +5002,8 @@ 2005-11-01 Nick Roberts - * building.texi (Other GDB User Interface Buffers): Describe - the command gdb-use-inferior-io-buffer. + * building.texi (Other GDB User Interface Buffers): + Describe the command gdb-use-inferior-io-buffer. 2005-10-31 Romain Francoise @@ -5036,8 +5041,8 @@ 2005-10-25 Nick Roberts - * building.texi (GDB Graphical Interface): Describe - gdb-mouse-until. + * building.texi (GDB Graphical Interface): + Describe gdb-mouse-until. 2005-10-23 Richard M. Stallman @@ -5104,7 +5109,7 @@ 2005-10-09 Jan Djärv - * cmdargs.texi (Icons X): Removed options -i, -itype, --icon-type, + * cmdargs.texi (Icons X): Remove options -i, -itype, --icon-type, added -nb, --no-bitmap-icon. 2005-10-07 Nick Roberts @@ -5141,16 +5146,16 @@ emulation and related variables. (Mac International): Mention Central European and Cyrillic support. Now `keyboard-coding-system' is dynamically changed. - Add description about coding system for selection. Add - description about language environment. - (Mac Environment Variables): Mention - `~/.MacOSX/environment.plist'. Give example of command line + Add description about coding system for selection. + Add description about language environment. + (Mac Environment Variables): + Mention `~/.MacOSX/environment.plist'. Give example of command line arguments. Add Preferences support. (Mac Directories): Explicitly state that this node is for Mac OS Classic only. - (Mac Font Specs): Mention specification for scalable fonts. List - supported charsets. Add preferred way of creating fontsets. Add - description about `mac-allow-anti-aliasing'. + (Mac Font Specs): Mention specification for scalable fonts. + List supported charsets. Add preferred way of creating fontsets. + Add description about `mac-allow-anti-aliasing'. (Mac Functions): Add descriptions about `mac-set-file-creator', `mac-get-file-creator', `mac-set-file-type', `mac-get-file-type', and `mac-get-preference'. @@ -5312,8 +5317,8 @@ 2005-07-16 Eli Zaretskii * display.texi (Standard Faces): Explain that customization of - `menu' face has no effect on w32 and with GTK. Add - cross-references. + `menu' face has no effect on w32 and with GTK. + Add cross-references. * cmdargs.texi (General Variables): Clarify the default location of $HOME on w32 systems. @@ -5325,8 +5330,8 @@ 2005-07-08 Kenichi Handa - * mule.texi (Recognize Coding): Recommend - revert-buffer-with-coding-system instead of revert-buffer. + * mule.texi (Recognize Coding): + Recommend revert-buffer-with-coding-system instead of revert-buffer. 2005-07-07 Richard M. Stallman @@ -5374,12 +5379,12 @@ 2005-06-23 Richard M. Stallman - * anti.texi (Antinews): Renamed show-nonbreak-escape to + * anti.texi (Antinews): Rename show-nonbreak-escape to nobreak-char-display. * emacs.texi (Top): Update detailed node listing. - * display.texi (Text Display): Renamed show-nonbreak-escape + * display.texi (Text Display): Rename show-nonbreak-escape to nobreak-char-display and no-break-space to nobreak-space. (Standard Faces): Split up the list of standard faces and put it in a separate node. Add nobreak-space and @@ -5391,8 +5396,8 @@ 2005-06-23 Kenichi Handa - * mule.texi (International): List all supported scripts. Adjust - text for that leim is now included in the normal Emacs + * mule.texi (International): List all supported scripts. + Adjust text for that leim is now included in the normal Emacs distribution. (Language Environments): List all language environments. Intlfonts contains fonts for most supported scripts, not all.. @@ -5634,8 +5639,8 @@ * ack.texi (Acknowledgments): Delete info about iso-acc.el. - * dired.texi (Misc Dired Features): Document - dired-compare-directories. + * dired.texi (Misc Dired Features): + Document dired-compare-directories. * files.texi (Filesets): New node. (File Conveniences): Document Image mode. @@ -6023,8 +6028,8 @@ 2005-03-19 Eli Zaretskii - * anti.texi (Antinews): Refer to Emacs 21.4, not 21.3. Update - copyright years. + * anti.texi (Antinews): Refer to Emacs 21.4, not 21.3. + Update copyright years. 2005-03-14 Nick Roberts @@ -6231,7 +6236,7 @@ (Scrolling): For C-l, don't presume text terminal. (Horizontal Scrolling): Simplify intro. (Follow Mode): Clarify. - (Cursor Display): Moved before Display Custom. + (Cursor Display): Move before Display Custom. (Display Custom): Explain no-redraw-on-reenter is for text terminals. Doc default-tab-width. Doc line truncation more thoroughly. @@ -6401,8 +6406,8 @@ cross-references to mailutils documentation. Describe various methods of specifying mailbox names, user names and user passwords for rmail. - (Remote Mailboxes): New section. Describe - how movemail handles remote mailboxes. Describe configuration + (Remote Mailboxes): New section. + Describe how movemail handles remote mailboxes. Describe configuration options used to control its behavior. (Other Mailbox Formats): Explain handling of various mailbox formats. @@ -6576,8 +6581,8 @@ 2004-11-10 Andre Spiegel * files.texi (Version Control): Rewrite the introduction about - version systems, mentioning the new ones that we support. Thanks - to Alex Ott, Karl Fogel, Stefan Monnier, and David Kastrup for + version systems, mentioning the new ones that we support. + Thanks to Alex Ott, Karl Fogel, Stefan Monnier, and David Kastrup for suggestions. 2004-11-03 Jan Djärv @@ -7072,8 +7077,8 @@ 2004-02-21 Juri Linkov - * cmdargs.texi (Action Arguments): Add alias --find-file. Add - --directory, --help, --version. Move text about command-line-args + * cmdargs.texi (Action Arguments): Add alias --find-file. + Add --directory, --help, --version. Move text about command-line-args to Command Arguments. (Initial Options): Add @cindex for --script. Fix @cindex for -q. Add --no-desktop. Add alias --no-multibyte, --no-unibyte. @@ -7093,7 +7098,7 @@ 2004-01-24 Richard M. Stallman - * emacs.texi (Acknowledgments): Renamed from Acknowledgements. + * emacs.texi (Acknowledgments): Rename from Acknowledgements. Include it only @ifnotinfo. Patch the preceding and following node headers to point to each other. @@ -7176,8 +7181,8 @@ 2003-09-24 Luc Teirlinck - * cmdargs.texi (Font X): Mention new default font. More - fully describe long font names, wildcard patterns and the + * cmdargs.texi (Font X): Mention new default font. + More fully describe long font names, wildcard patterns and the problems involved. (Result of discussion on emacs-devel.) 2003-09-22 Luc Teirlinck @@ -7199,8 +7204,8 @@ * screen.texi (Mode Line): Say that POS comes before LINE. Mention `size-indication-mode'. - * display.texi (Optional Mode Line): Document - `size-indication-mode'. + * display.texi (Optional Mode Line): + Document `size-indication-mode'. * basic.texi (Position Info): Mention `size-indication-mode'. 2003-09-07 Luc Teirlinck diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index d311104ddd7..bc7484b0557 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -744,6 +744,13 @@ is neither visiting a version-controlled file nor a VC directory buffer, these commands generate a diff of all registered files in the current directory and its subdirectories. +@findex vc-ediff +The function @code{vc-ediff} works like @code{vc-diff} and provides a way to +visually compare two revisions of a file an Ediff session, @pxref{Top, Ediff, +ediff, The Ediff Manual}. It compares the file associated with the current +buffer with the last repository revision. To compare two arbitrary revisions +of the current file, call @code{vc-ediff} with a prefix argument. + @vindex vc-diff-switches @vindex vc-rcs-diff-switches @kbd{C-x v =} works by running a variant of the @code{diff} utility diff --git a/etc/ChangeLog b/etc/ChangeLog index b9e409e8783..002dfaf7fd5 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2011-04-08 Christoph Scholtes + + * NEWS: Document new function `vc-ediff'. + 2011-04-06 Juanma Barranquero * NEWS: New variable `revert-buffer-in-progress-p'. diff --git a/etc/NEWS b/etc/NEWS index 69540fa1f54..bc85b3223ed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -672,6 +672,9 @@ use this to display the full log entry for the revision at point. **** Packages using Log View mode can enable this functionality by binding `log-view-expanded-log-entry-function' to a suitable function. +*** New command `vc-ediff' allows visual comparison of two revisions +of a file similar to `vc-diff', but using ediff backend. + ** Miscellaneous --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d019eca95c9..0f6608d2fc1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2011-04-20 Christoph Scholtes + + * vc/vc.el (vc-diff-build-argument-list-internal) + (vc-version-ediff, vc-ediff): New functions. + (vc-version-diff): Use vc-diff-build-argument-list-internal. + 2011-04-20 Stefan Monnier * emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Remove dead code, diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7f55ffdbdad..06abde21d4f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -653,6 +653,7 @@ (require 'vc-hooks) (require 'vc-dispatcher) +(require 'ediff) (eval-when-compile (require 'cl) @@ -1617,45 +1618,48 @@ returns t if the buffer had changes, nil otherwise." nil nil initial-input nil default) (read-string prompt initial-input nil default)))) +(defun vc-diff-build-argument-list-internal () + "Build argument list for calling internal diff functions." + (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef + (files (cadr vc-fileset)) + (backend (car vc-fileset)) + (first (car files)) + (rev1-default nil) + (rev2-default nil)) + (cond + ;; someday we may be able to do revision completion on non-singleton + ;; filesets, but not yet. + ((/= (length files) 1) + nil) + ;; if it's a directory, don't supply any revision default + ((file-directory-p first) + nil) + ;; if the file is not up-to-date, use working revision as older revision + ((not (vc-up-to-date-p first)) + (setq rev1-default (vc-working-revision first))) + ;; if the file is not locked, use last and previous revisions as defaults + (t + (setq rev1-default (vc-call-backend backend 'previous-revision first + (vc-working-revision first))) + (when (string= rev1-default "") (setq rev1-default nil)) + (setq rev2-default (vc-working-revision first)))) + ;; construct argument list + (let* ((rev1-prompt (if rev1-default + (concat "Older revision (default " + rev1-default "): ") + "Older revision: ")) + (rev2-prompt (concat "Newer revision (default " + (or rev2-default "current source") "): ")) + (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) + (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) + (when (string= rev1 "") (setq rev1 nil)) + (when (string= rev2 "") (setq rev2 nil)) + (list files rev1 rev2)))) + ;;;###autoload (defun vc-version-diff (files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." - (interactive - (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef - (files (cadr vc-fileset)) - (backend (car vc-fileset)) - (first (car files)) - (rev1-default nil) - (rev2-default nil)) - (cond - ;; someday we may be able to do revision completion on non-singleton - ;; filesets, but not yet. - ((/= (length files) 1) - nil) - ;; if it's a directory, don't supply any revision default - ((file-directory-p first) - nil) - ;; if the file is not up-to-date, use working revision as older revision - ((not (vc-up-to-date-p first)) - (setq rev1-default (vc-working-revision first))) - ;; if the file is not locked, use last and previous revisions as defaults - (t - (setq rev1-default (vc-call-backend backend 'previous-revision first - (vc-working-revision first))) - (when (string= rev1-default "") (setq rev1-default nil)) - (setq rev2-default (vc-working-revision first)))) - ;; construct argument list - (let* ((rev1-prompt (if rev1-default - (concat "Older revision (default " - rev1-default "): ") - "Older revision: ")) - (rev2-prompt (concat "Newer revision (default " - (or rev2-default "current source") "): ")) - (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) - (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) - (when (string= rev1 "") (setq rev1 nil)) - (when (string= rev2 "") (setq rev2 nil)) - (list files rev1 rev2)))) + (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) (error "Not a valid revision range")) @@ -1680,6 +1684,48 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset t) nil nil (called-interactively-p 'interactive)))) +;;;###autoload +(defun vc-version-ediff (files rev1 rev2) + "Show differences between revisions of the fileset in the +repository history using ediff." + (interactive (vc-diff-build-argument-list-internal)) + ;; All that was just so we could do argument completion! + (when (and (not rev1) rev2) + (error "Not a valid revision range")) + + (message "%s" (format "Finding changes in %s..." (vc-delistify files))) + + ;; Functions ediff-(vc|rcs)-internal use "" instead of nil. + (when (null rev1) (setq rev1 "")) + (when (null rev2) (setq rev2 "")) + + (cond + ;; FIXME We only support running ediff on one file for now. + ;; We could spin off an ediff session per file in the file set. + ((= (length files) 1) + (ediff-load-version-control) + (find-file (car files)) + (funcall + (intern (format "ediff-%S-internal" ediff-version-control-package)) + rev1 rev2 nil)) + (t + (error "More than one file is not supported")))) + +;;;###autoload +(defun vc-ediff (historic &optional not-urgent) + "Display diffs between file revisions using ediff. +Normally this compares the currently selected fileset with their +working revisions. With a prefix argument HISTORIC, it reads two revision +designators specifying which revisions to compare. + +The optional argument NOT-URGENT non-nil means it is ok to say no to +saving the buffer." + (interactive (list current-prefix-arg t)) + (if historic + (call-interactively 'vc-version-ediff) + (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil))) + ;;;###autoload (defun vc-root-diff (historic &optional not-urgent) "Display diffs between VC-controlled whole tree revisions. From 024ff1707e4a301b21b9de14ab64a406b92dd19f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 14:39:39 -0300 Subject: [PATCH 20/77] * lisp/vc/vc.el (vc-version-ediff): Call ediff-vc-internal directly, since we're in VC after all. --- doc/emacs/ChangeLog | 3 +-- doc/emacs/maintaining.texi | 8 ++++---- lisp/ChangeLog | 7 ++++++- lisp/vc/vc.el | 6 ++---- 4 files changed, 13 insertions(+), 11 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index d20c529f043..c6405019ddb 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,7 +1,6 @@ 2011-04-20 Christoph Scholtes - * maintaining.texi (Old Revisions): Add paragraph on new function - vc-ediff. + * maintaining.texi (Old Revisions): Mention new function vc-ediff. 2011-03-26 Chong Yidong diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index bc7484b0557..8f395ba9563 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -746,10 +746,10 @@ current directory and its subdirectories. @findex vc-ediff The function @code{vc-ediff} works like @code{vc-diff} and provides a way to -visually compare two revisions of a file an Ediff session, @pxref{Top, Ediff, -ediff, The Ediff Manual}. It compares the file associated with the current -buffer with the last repository revision. To compare two arbitrary revisions -of the current file, call @code{vc-ediff} with a prefix argument. +visually compare two revisions of a file in an Ediff session, @pxref{Top, +Ediff, ediff, The Ediff Manual}. It compares the file associated with the +current buffer with the last repository revision. To compare two arbitrary +revisions of the current file, call @code{vc-ediff} with a prefix argument. @vindex vc-diff-switches @vindex vc-rcs-diff-switches diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0f6608d2fc1..6e98a03dd24 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,12 @@ +2011-04-20 Stefan Monnier + + * vc/vc.el (vc-version-ediff): Call ediff-vc-internal directly, since + we're in VC after all. + 2011-04-20 Christoph Scholtes * vc/vc.el (vc-diff-build-argument-list-internal) - (vc-version-ediff, vc-ediff): New functions. + (vc-version-ediff, vc-ediff): New commands. (vc-version-diff): Use vc-diff-build-argument-list-internal. 2011-04-20 Stefan Monnier diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 06abde21d4f..1639cd7b1b1 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1704,10 +1704,8 @@ repository history using ediff." ;; We could spin off an ediff session per file in the file set. ((= (length files) 1) (ediff-load-version-control) - (find-file (car files)) - (funcall - (intern (format "ediff-%S-internal" ediff-version-control-package)) - rev1 rev2 nil)) + (find-file (car files)) ;FIXME: find-file from Elisp is bad. + (ediff-vc-internal rev1 rev2 nil)) (t (error "More than one file is not supported")))) From c79a6f38ab49050faa0d33e57d0c606bd9ea0e1a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 15:08:21 -0300 Subject: [PATCH 21/77] * lisp/progmodes/flymake.el (flymake-start-syntax-check-process): Obey `dir'. --- lisp/ChangeLog | 3 +++ lisp/progmodes/flymake.el | 53 +++++++++++++++++++-------------------- 2 files changed, 29 insertions(+), 27 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6e98a03dd24..64ca1027ca4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2011-04-20 Stefan Monnier + * progmodes/flymake.el (flymake-start-syntax-check-process): + Obey `dir'. Simplify. + * vc/vc.el (vc-version-ediff): Call ediff-vc-internal directly, since we're in VC after all. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 4461ec27456..16c099d0127 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1152,35 +1152,34 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-start-syntax-check-process (cmd args dir) "Start syntax check process." - (let* ((process nil)) - (condition-case err - (progn - (when dir - (let ((default-directory dir)) - (flymake-log 3 "starting process on dir %s" default-directory))) - (setq process (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (push process flymake-processes) + (condition-case err + (let* ((process + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (apply 'start-file-process + "flymake-proc" (current-buffer) cmd args)))) + (set-process-sentinel process 'flymake-process-sentinel) + (set-process-filter process 'flymake-process-filter) + (push process flymake-processes) - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (flymake-float-time)) + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (flymake-float-time)) - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str)))))) + (flymake-report-status nil "*") + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id process) (process-command process) + default-directory) + process) + (error + (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" + cmd args (error-message-string err))) + (source-file-name buffer-file-name) + (cleanup-f (flymake-get-cleanup-function source-file-name))) + (flymake-log 0 err-str) + (funcall cleanup-f) + (flymake-report-fatal-status "PROCERR" err-str))))) (defun flymake-kill-process (proc) "Kill process PROC." From 2dbaa0806bb585dec7d678bc2bdf842847514097 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 16:05:50 -0300 Subject: [PATCH 22/77] * lisp/comint.el: Use lexical-binding. Use std completion UI. Require CL. (comint-dynamic-complete-functions): Use comint-filename-completion. (comint-completion-addsuffix): Tweak custom type. (comint-filename-completion, comint--common-suffix) (comint--common-quoted-suffix, comint--table-subvert) (comint--complete-file-name-data): New functions. (comint-dynamic-complete-as-filename, comint-dynamic-complete-filename) (comint-dynamic-list-filename-completions): Use them. (comint-dynamic-simple-complete): Make obsolete. * lisp/minibuffer.el (completion-in-region-mode): Keep completion-in-region-mode--predicate global. (completion-in-region--postch): Assume completion-in-region-mode--predicate is not null. --- lisp/ChangeLog | 14 +++ lisp/comint.el | 234 +++++++++++++++++++++++++++------------------ lisp/minibuffer.el | 13 +-- 3 files changed, 160 insertions(+), 101 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 64ca1027ca4..214376b817c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,19 @@ 2011-04-20 Stefan Monnier + * comint.el: Use lexical-binding. Require CL. + (comint-dynamic-complete-functions): Use comint-filename-completion. + (comint-completion-addsuffix): Tweak custom type. + (comint-filename-completion, comint--common-suffix) + (comint--common-quoted-suffix, comint--table-subvert) + (comint--complete-file-name-data): New functions. + (comint-dynamic-complete-as-filename, comint-dynamic-complete-filename) + (comint-dynamic-list-filename-completions): Use them. + (comint-dynamic-simple-complete): Make obsolete. + * minibuffer.el (completion-in-region-mode): + Keep completion-in-region-mode--predicate global. + (completion-in-region--postch): + Assume completion-in-region-mode--predicate is not null. + * progmodes/flymake.el (flymake-start-syntax-check-process): Obey `dir'. Simplify. diff --git a/lisp/comint.el b/lisp/comint.el index 64ed32dd2b3..735770a8908 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1,4 +1,4 @@ -;;; comint.el --- general command interpreter in a window stuff +;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc. @@ -101,6 +101,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'ring) ;; Buffer Local Variables: @@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of `comint-use-prompt-regexp'.") (defvar comint-dynamic-complete-functions - '(comint-replace-by-expanded-history comint-dynamic-complete-filename) + '(comint-replace-by-expanded-history comint-filename-completion) "List of functions called to perform completion. Works like `completion-at-point-functions'. See also `comint-dynamic-complete'. @@ -2831,10 +2832,9 @@ its response can be seen." ;; comint-dynamic-list-filename-completions List completions in help buffer. ;; comint-replace-by-expanded-filename Expand and complete filename at point; ;; replace with expanded/completed name. -;; comint-dynamic-simple-complete Complete stub given candidates. -;; These are not installed in the comint-mode keymap. But they are -;; available for people who want them. Shell-mode installs them: +;; These are not installed in the comint-mode keymap. But they are +;; available for people who want them. Shell-mode installs them: ;; (define-key shell-mode-map "\t" 'comint-dynamic-complete) ;; (define-key shell-mode-map "\M-?" ;; 'comint-dynamic-list-filename-completions))) @@ -2849,14 +2849,16 @@ This mirrors the optional behavior of tcsh." :group 'comint-completion) (defcustom comint-completion-addsuffix t - "If non-nil, add a `/' to completed directories, ` ' to file names. -If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where -DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. + "If non-nil, add ` ' to file names. +It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX) +where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous +or exact completion. This mirrors the optional behavior of tcsh." :type '(choice (const :tag "None" nil) - (const :tag "Add /" t) - (cons :tag "Suffix pair" - (string :tag "Directory suffix") + (const :tag "Add SPC" t) + (string :tag "File suffix") + (cons :tag "Obsolete suffix pair" + (string :tag "Ignored") (string :tag "File suffix"))) :group 'comint-completion) @@ -3016,73 +3018,125 @@ Returns t if successful." (when (comint--match-partial-filename) (unless (window-minibuffer-p (selected-window)) (message "Completing file name...")) - (comint-dynamic-complete-as-filename))) + (apply #'completion-in-region (comint--complete-file-name-data)))) + +(defun comint-filename-completion () + "Return completion data for filename at point, if any." + (when (comint--match-partial-filename) + (comint--complete-file-name-data))) + +;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and +;; comint--table-subvert copied from pcomplete. And they don't fully solve +;; the problem, since selecting a file from *Completions* won't quote it. + +(defun comint--common-suffix (s1 s2) + (assert (not (or (string-match "\n" s1) (string-match "\n" s2)))) + ;; Since S2 is expected to be the "unquoted/expanded" version of S1, + ;; there shouldn't be any case difference, even if the completion is + ;; case-insensitive. + (let ((case-fold-search nil)) + (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2)) + (- (match-end 1) (match-beginning 1)))) + +(defun comint--common-quoted-suffix (s1 s2) + "Find the common suffix between S1 and S2 where S1 is the expanded S2. +S1 is expected to be the unquoted and expanded version of S1. +Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that +S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and +SS1 = (unquote SS2)." + (let* ((cs (comint--common-suffix s1 s2)) + (ss1 (substring s1 (- (length s1) cs))) + (qss1 (comint-quote-filename ss1)) + qc) + (if (and (not (equal ss1 qss1)) + (setq qc (comint-quote-filename (substring ss1 0 1))) + (eq t (compare-strings s2 (- (length s2) cs (length qc) -1) + (- (length s2) cs -1) + qc nil nil))) + ;; The difference found is just that one char is quoted in S2 + ;; but not in S1, keep looking before this difference. + (comint--common-quoted-suffix + (substring s1 0 (- (length s1) cs)) + (substring s2 0 (- (length s2) cs (length qc) -1))) + (cons (substring s1 0 (- (length s1) cs)) + (substring s2 0 (- (length s2) cs)))))) + +(defun comint--table-subvert (table s1 s2 string pred action) + "Completion table that replaces the prefix S1 with S2 in STRING. +When TABLE, S1 and S2 are provided by `apply-partially', the result +is a completion table which completes strings of the form (concat S1 S) +in the same way as TABLE completes strings of the form (concat S2 S)." + (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil + completion-ignore-case)) + (concat s2 (comint-unquote-filename + (substring string (length s1)))))) + (res (if str (complete-with-action action table str pred)))) + (when res + (cond + ((and (eq (car-safe action) 'boundaries)) + (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) + (list* 'boundaries + (max (length s1) + ;; FIXME: Adjust because of quoting/unquoting. + (+ beg (- (length s1) (length s2)))) + (and (eq (car-safe res) 'boundaries) (cddr res))))) + ((stringp res) + (if (eq t (compare-strings res 0 (length s2) s2 nil nil + completion-ignore-case)) + (concat s1 (comint-quote-filename + (substring res (length s2)))))) + ((eq action t) + (let ((bounds (completion-boundaries str table pred ""))) + (if (>= (car bounds) (length s2)) + res + (let ((re (concat "\\`" + (regexp-quote (substring s2 (car bounds)))))) + (delq nil + (mapcar (lambda (c) + (if (string-match re c) + (substring c (match-end 0)))) + res)))))) + ;; E.g. action=nil and it's the only completion. + (res))))) + +(defun comint--complete-file-name-data () + "Return the completion data for file name at point." + (let* ((filesuffix (cond ((not comint-completion-addsuffix) "") + ((stringp comint-completion-addsuffix) + comint-completion-addsuffix) + ((not (consp comint-completion-addsuffix)) " ") + (t (cdr comint-completion-addsuffix)))) + (filename (comint--match-partial-filename)) + (filename-beg (if filename (match-beginning 0) (point))) + (filename-end (if filename (match-end 0) (point))) + (unquoted (if filename (comint--unquote&expand-filename filename) "")) + (table + (let ((prefixes (comint--common-quoted-suffix + unquoted filename))) + (apply-partially + #'comint--table-subvert + #'completion-file-name-table + (cdr prefixes) (car prefixes))))) + (list + filename-beg filename-end + (lambda (string pred action) + (let ((completion-ignore-case read-file-name-completion-ignore-case) + (completion-ignored-extensions comint-completion-fignore)) + (if (zerop (length filesuffix)) + (complete-with-action action table string pred) + ;; Add a space at the end of completion. Use a terminator-regexp + ;; that never matches since the terminator cannot appear + ;; within the completion field anyway. + (completion-table-with-terminator + (cons filesuffix "\\`a\\`") + table string pred action))))))) (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." - (let* ((completion-ignore-case read-file-name-completion-ignore-case) - (completion-ignored-extensions comint-completion-fignore) - ;; If we bind this, it breaks remote directory tracking in rlogin.el. - ;; I think it was originally bound to solve file completion problems, - ;; but subsequent changes may have made this unnecessary. sm. - ;;(file-name-handler-alist nil) - (minibuffer-p (window-minibuffer-p (selected-window))) - (success t) - (dirsuffix (cond ((not comint-completion-addsuffix) "") - ((not (consp comint-completion-addsuffix)) "/") - (t (car comint-completion-addsuffix)))) - (filesuffix (cond ((not comint-completion-addsuffix) "") - ((not (consp comint-completion-addsuffix)) " ") - (t (cdr comint-completion-addsuffix)))) - (filename (comint-match-partial-filename)) - (filename-beg (if filename (match-beginning 0) (point))) - (filename-end (if filename (match-end 0) (point))) - (filename (or filename "")) - (filedir (file-name-directory filename)) - (filenondir (file-name-nondirectory filename)) - (directory (if filedir (comint-directory filedir) default-directory)) - (completion (file-name-completion filenondir directory))) - (cond ((null completion) - (if minibuffer-p - (minibuffer-message "No completions of %s" filename) - (message "No completions of %s" filename)) - (setq success nil)) - ((eq completion t) ; Means already completed "file". - (insert filesuffix) - (unless minibuffer-p - (message "Sole completion"))) - ((string-equal completion "") ; Means completion on "directory/". - (comint-dynamic-list-filename-completions)) - (t ; Completion string returned. - (let ((file (concat (file-name-as-directory directory) completion))) - ;; Insert completion. Note that the completion string - ;; may have a different case than what's in the prompt, - ;; if read-file-name-completion-ignore-case is non-nil, - (delete-region filename-beg filename-end) - (if filedir (insert (comint-quote-filename filedir))) - (insert (comint-quote-filename (directory-file-name completion))) - (cond ((symbolp (file-name-completion completion directory)) - ;; We inserted a unique completion. - (insert (if (file-directory-p file) dirsuffix filesuffix)) - (unless minibuffer-p - (message "Completed"))) - ((and comint-completion-recexact comint-completion-addsuffix - (string-equal filenondir completion) - (file-exists-p file)) - ;; It's not unique, but user wants shortest match. - (insert (if (file-directory-p file) dirsuffix filesuffix)) - (unless minibuffer-p - (message "Completed shortest"))) - ((or comint-completion-autolist - (string-equal filenondir completion)) - ;; It's not unique, list possible completions. - (comint-dynamic-list-filename-completions)) - (t - (unless minibuffer-p - (message "Partially completed"))))))) - success)) - + (apply #'completion-in-region (comint--complete-file-name-data))) +(make-obsolete 'comint-dynamic-complete-as-filename + 'comint-filename-completion "24.1") (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. @@ -3155,28 +3209,20 @@ See also `comint-dynamic-complete-filename'." (unless minibuffer-p (message "Partially completed")) 'partial))))))) +(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1") (defun comint-dynamic-list-filename-completions () "Display a list of possible completions for the filename at point." (interactive) - (let* ((completion-ignore-case read-file-name-completion-ignore-case) - ;; If we bind this, it breaks remote directory tracking in rlogin.el. - ;; I think it was originally bound to solve file completion problems, - ;; but subsequent changes may have made this unnecessary. sm. - ;;(file-name-handler-alist nil) - (filename (or (comint-match-partial-filename) "")) - (filedir (file-name-directory filename)) - (filenondir (file-name-nondirectory filename)) - (directory (if filedir (comint-directory filedir) default-directory)) - (completions (file-name-all-completions filenondir directory))) - (if (not completions) - (if (window-minibuffer-p (selected-window)) - (minibuffer-message "No completions of %s" filename) - (message "No completions of %s" filename)) - (comint-dynamic-list-completions - (mapcar 'comint-quote-filename completions) - (comint-quote-filename filenondir))))) + (let* ((data (comint--complete-file-name-data)) + (minibuffer-completion-table (nth 2 data)) + (minibuffer-completion-predicate nil) + (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t))) + (overlay-put ol 'field 'completion) + (unwind-protect + (call-interactively 'minibuffer-completion-help) + (delete-overlay ol)))) ;; This is bound locally in a *Completions* buffer to the list of @@ -3244,7 +3290,6 @@ Typing SPC flushes the completions buffer." (if (eq first ?\s) (set-window-configuration comint-dynamic-list-completions-config) (setq unread-command-events (listify-key-sequence key))))))) - (defun comint-get-next-from-history () "After fetching a line from input history, this fetches the following line. @@ -3742,9 +3787,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; ;; For modes that use comint-mode, comint-dynamic-complete-functions is the ;; hook to add completion functions to. Functions on this list should return -;; non-nil if completion occurs (i.e., further completion should not occur). -;; You could use comint-dynamic-simple-complete to do the bulk of the -;; completion job. +;; the completion data according to the documentation of +;; `completion-at-point-functions' (provide 'comint) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0d26d6bdcf6..0adf2a1d8b8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -58,6 +58,8 @@ ;;; Todo: +;; - Make things like icomplete-mode or lightning-completion work with +;; completion-in-region-mode. ;; - completion-insert-complete-hook (called after inserting a complete ;; completion), typically used for "complete-abbrev" where it would expand ;; the abbrev. Tho we'd probably want to provide it from the @@ -1314,8 +1316,7 @@ Point needs to be somewhere between START and END." (save-excursion (goto-char (nth 2 completion-in-region--data)) (line-end-position))) - (when completion-in-region-mode--predicate - (funcall completion-in-region-mode--predicate)))) + (funcall completion-in-region-mode--predicate))) (completion-in-region-mode -1))) ;; (defalias 'completion-in-region--prech 'completion-in-region--postch) @@ -1330,12 +1331,12 @@ Point needs to be somewhere between START and END." (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist) minor-mode-overriding-map-alist)) (if (null completion-in-region-mode) - (unless (or (equal "*Completions*" (buffer-name (window-buffer))) - (null completion-in-region-mode--predicate)) + (unless (equal "*Completions*" (buffer-name (window-buffer))) (minibuffer-hide-completions)) ;; (add-hook 'pre-command-hook #'completion-in-region--prech) - (set (make-local-variable 'completion-in-region-mode--predicate) - completion-in-region-mode-predicate) + (assert completion-in-region-mode-predicate) + (setq completion-in-region-mode--predicate + completion-in-region-mode-predicate) (add-hook 'post-command-hook #'completion-in-region--postch) (push `(completion-in-region-mode . ,completion-in-region-mode-map) minor-mode-overriding-map-alist))) From 201133802956936332f1c4ce04eac42dfd1cf1c6 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Wed, 20 Apr 2011 22:12:08 +0000 Subject: [PATCH 23/77] gnus-registry.el (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs. (gnus-registry-ignored-groups): New variable. (gnus-registry-ignore-group-p): Use it. (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and set the destination group to nil (same as delete) if it's ignored. --- lisp/gnus/ChangeLog | 9 +++++++++ lisp/gnus/gnus-registry.el | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 35531df0ad2..73e7345e07d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,12 @@ +2011-04-20 Teodor Zlatanov + + * gnus-registry.el + (gnus-registry--split-fancy-with-parent-internal): Fix loop bugs. + (gnus-registry-ignored-groups): New variable. + (gnus-registry-ignore-group-p): Use it. + (gnus-registry-handle-action): Use `gnus-registry-ignore-group-p' and + set the destination group to nil (same as delete) if it's ignored. + 2011-04-20 Katsumi Yamaoka * gnus-registry.el (gnus-registry-action) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 009786dec80..21cec5f2b42 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -133,6 +133,16 @@ qualified. This parameter tells the Gnus registry 'never split a message into a group that matches one of these, regardless of references.' +nnmairix groups are specifically excluded because they are ephemeral." + :group 'gnus-registry + :type '(repeat regexp)) + +(defcustom gnus-registry-ignored-groups + '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive") + "List of groups that the Gnus Registry will ignore. +The group names are matched, they don't have to be fully +qualified. + nnmairix groups are specifically excluded because they are ephemeral." :group 'gnus-registry :type '(repeat regexp)) @@ -341,6 +351,8 @@ This is not required after changing `gnus-registry-cache-file'." 10 "gnus-registry-handle-action %S" (list id from to subject sender recipients)) (let ((db gnus-registry-db) + ;; if the group is ignored, set the destination to nil (same as delete) + (to (if (gnus-registry-ignore-group-p to) nil to)) ;; safe if not found (entry (gnus-registry-get-or-make-entry id)) (subject (gnus-string-remove-all-properties @@ -442,8 +454,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (gnus-message 9 "%s is looking up %s" log-agent reference) (loop for group in (gnus-registry-get-id-key reference 'group) when (gnus-registry-follow-group-p group) - do (gnus-message 7 "%s traced %s to %s" log-agent reference group) - do (push group found))) + do + (progn + (gnus-message 7 "%s traced %s to %s" log-agent reference group) + (push group found)))) ;; filter the found groups and return them ;; the found groups are the full groups (setq found (gnus-registry-post-process-groups @@ -468,7 +482,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced subject '%s' to %s" log-agent subject group) - collect group)) + and collect group)) ;; filter the found groups and return them ;; the found groups are NOT the full groups (setq found (gnus-registry-post-process-groups @@ -495,7 +509,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced sender '%s' to %s" log-agent sender group) - collect group))) + and collect group))) ;; filter the found groups and return them ;; the found groups are NOT the full groups @@ -525,7 +539,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if gnus-registry-track-extra 7 9) "%s (extra tracking) traced recipient '%s' to %s" log-agent recp group) - collect group))))) + and collect group))))) ;; filter the found groups and return them ;; the found groups are NOT the full groups @@ -641,6 +655,18 @@ Consults `gnus-registry-unfollowed-groups' and group nnmail-split-fancy-with-parent-ignore-groups))))) +(defun gnus-registry-ignore-group-p (group) + "Determines if a group name should be ignored. +Consults `gnus-registry-ignored-groups' and +`nnmail-split-fancy-with-parent-ignore-groups'." + (and group + (not (or (gnus-grep-in-list + group + gnus-registry-ignored-groups) + (gnus-grep-in-list + group + nnmail-split-fancy-with-parent-ignore-groups))))) + (defun gnus-registry-wash-for-keywords (&optional force) "Get the keywords of the current article. Overrides existing keywords with FORCE set non-nil." From c0a193ea2017fbaa6fb3e64a07125878656da156 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 20 Apr 2011 19:31:06 -0300 Subject: [PATCH 24/77] * lisp/shell.el: Use lexical-binding and std completion UI. (shell-filter-ctrl-a-ctrl-b): Work as a preoutput filter. (shell-mode): Put shell-filter-ctrl-a-ctrl-b on comint-preoutput-filter-functions rather than on comint-output-filter-functions. (shell-command-completion, shell--command-completion-data) (shell-filename-completion, shell-environment-variable-completion) (shell-c-a-p-replace-by-expanded-directory): New functions. (shell-dynamic-complete-functions, shell-dynamic-complete-command) (shell-dynamic-complete-filename, shell-replace-by-expanded-directory) (shell-dynamic-complete-environment-variable): Use them. (shell-dynamic-complete-as-environment-variable) (shell-dynamic-complete-as-command): Remove. (shell-match-partial-variable): Match past point. * lisp/comint.el: Clean up use of completion-at-point-functions. (comint-completion-at-point): New function. (comint-mode): Use it completion-at-point-functions. (comint-dynamic-complete): Make it obsolete. (comint-replace-by-expanded-history-before-point): Add dry-run arg. (comint-c-a-p-replace-by-expanded-history): New function. (comint-dynamic-complete-functions) (comint-replace-by-expanded-history): Use it. * lisp/minibuffer.el (completion-table-with-terminator): Allow dynamic termination strings. Try harder to avoid second try-completion. (completion-in-region-mode-map): Disable bindings that don't work yet. --- etc/NEWS | 2 + lisp/ChangeLog | 27 ++++++ lisp/comint.el | 59 ++++++++----- lisp/minibuffer.el | 24 ++++-- lisp/shell.el | 211 +++++++++++++++++++++++++-------------------- 5 files changed, 203 insertions(+), 120 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index bc85b3223ed..aed90764fa1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -370,6 +370,8 @@ $ESHELL nor variable `explicit-shell-file-name' is set. * Changes in Specialized Modes and Packages in Emacs 24.1 +** comint and modes derived from it use the generic completion code. + ** The compile.el mode can be used without font-lock-mode. `compilation-parse-errors-function' is now obsolete. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 214376b817c..70bb631df9e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,31 @@ 2011-04-20 Stefan Monnier + * shell.el: Use lexical-binding and std completion UI. + (shell-filter-ctrl-a-ctrl-b): Work as a preoutput filter. + (shell-mode): Put shell-filter-ctrl-a-ctrl-b on + comint-preoutput-filter-functions rather than on + comint-output-filter-functions. + (shell-command-completion, shell--command-completion-data) + (shell-filename-completion, shell-environment-variable-completion) + (shell-c-a-p-replace-by-expanded-directory): New functions. + (shell-dynamic-complete-functions, shell-dynamic-complete-command) + (shell-dynamic-complete-filename, shell-replace-by-expanded-directory) + (shell-dynamic-complete-environment-variable): Use them. + (shell-dynamic-complete-as-environment-variable) + (shell-dynamic-complete-as-command): Remove. + (shell-match-partial-variable): Match past point. + * comint.el: Clean up use of completion-at-point-functions. + (comint-completion-at-point): New function. + (comint-mode): Use it completion-at-point-functions. + (comint-dynamic-complete): Make it obsolete. + (comint-replace-by-expanded-history-before-point): Add dry-run arg. + (comint-c-a-p-replace-by-expanded-history): New function. + (comint-dynamic-complete-functions) + (comint-replace-by-expanded-history): Use it. + * minibuffer.el (completion-table-with-terminator): Allow dynamic + termination strings. Try harder to avoid second try-completion. + (completion-in-region-mode-map): Disable bindings that don't work yet. + * comint.el: Use lexical-binding. Require CL. (comint-dynamic-complete-functions): Use comint-filename-completion. (comint-completion-addsuffix): Tweak custom type. @@ -9,6 +35,7 @@ (comint-dynamic-complete-as-filename, comint-dynamic-complete-filename) (comint-dynamic-list-filename-completions): Use them. (comint-dynamic-simple-complete): Make obsolete. + * minibuffer.el (completion-in-region-mode): Keep completion-in-region-mode--predicate global. (completion-in-region--postch): diff --git a/lisp/comint.el b/lisp/comint.el index 735770a8908..8608c0d31e9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -367,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of `comint-use-prompt-regexp'.") (defvar comint-dynamic-complete-functions - '(comint-replace-by-expanded-history comint-filename-completion) + '(comint-c-a-p-replace-by-expanded-history comint-filename-completion) "List of functions called to perform completion. Works like `completion-at-point-functions'. See also `comint-dynamic-complete'. @@ -493,7 +493,7 @@ executed once when the buffer is created." (define-key map [menu-bar completion complete-file] '("Complete File Name" . comint-dynamic-complete-filename)) (define-key map [menu-bar completion complete] - '("Complete Before Point" . comint-dynamic-complete)) + '("Complete at Point" . completion-at-point)) ;; Input history: (define-key map [menu-bar inout] (cons "In/Out" (make-sparse-keymap "In/Out"))) @@ -683,6 +683,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (setq font-lock-defaults '(nil t)) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'comint-history-isearch-setup nil t) + (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) ;; This behavior is not useful in comint buffers, and is annoying (set (make-local-variable 'next-line-add-newlines) nil)) @@ -1231,6 +1232,12 @@ See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'. Returns t if successful." (interactive) + (let ((f (comint-c-a-p-replace-by-expanded-history silent start))) + (if f (funcall f)))) + +(defun comint-c-a-p-replace-by-expanded-history (&optional silent start) + "Expand input command history at point. +For use on `completion-at-point-functions'." (if (and comint-input-autoexpand (if comint-use-prompt-regexp ;; Use comint-prompt-regexp @@ -1240,20 +1247,28 @@ Returns t if successful." ;; Use input fields. User input that hasn't been entered ;; yet, at the end of the buffer, has a nil `field' property. (and (null (get-char-property (point) 'field)) - (string-match "!\\|^\\^" (field-string))))) - ;; Looks like there might be history references in the command. - (let ((previous-modified-tick (buffer-modified-tick))) - (comint-replace-by-expanded-history-before-point silent start) - (/= previous-modified-tick (buffer-modified-tick))))) + (string-match "!\\|^\\^" (field-string)))) + (catch 'dry-run + (comint-replace-by-expanded-history-before-point + silent start 'dry-run))) + (lambda () + ;; Looks like there might be history references in the command. + (let ((previous-modified-tick (buffer-modified-tick))) + (comint-replace-by-expanded-history-before-point silent start) + (/= previous-modified-tick (buffer-modified-tick)))))) -(defun comint-replace-by-expanded-history-before-point (silent &optional start) +(defun comint-replace-by-expanded-history-before-point + (silent &optional start dry-run) "Expand directory stack reference before point. See `comint-replace-by-expanded-history'. Returns t if successful. If the optional argument START is non-nil, that specifies the start of the text to scan for history references, rather -than the logical beginning of line." +than the logical beginning of line. + +If DRY-RUN is non-nil, throw to DRY-RUN before performing any +actual side-effect." (save-excursion (let ((toend (- (line-end-position) (point))) (start (or start (comint-line-beginning-position)))) @@ -1274,10 +1289,12 @@ than the logical beginning of line." (goto-char (1+ (point)))) ((looking-at "![0-9]+\\($\\|[^-]\\)") ;; We cannot know the interpreter's idea of input line numbers. + (if dry-run (throw dry-run 'message)) (goto-char (match-end 0)) (message "Absolute reference cannot be expanded")) ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?") ;; Just a number of args from `number' lines backward. + (if dry-run (throw dry-run 'history)) (let ((number (1- (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))) @@ -1293,6 +1310,7 @@ than the logical beginning of line." (message "Relative reference exceeds input history size")))) ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!")) ;; Just a number of args from the previous input line. + (if dry-run (throw dry-run 'expand)) (replace-match (comint-args (comint-previous-input-string 0) (match-beginning 1) (match-end 1)) t t) @@ -1301,6 +1319,7 @@ than the logical beginning of line." "!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?") ;; Most recent input starting with or containing (possibly ;; protected) string, maybe just a number of args. Phew. + (if dry-run (throw dry-run 'expand)) (let* ((mb1 (match-beginning 1)) (me1 (match-end 1)) (mb2 (match-beginning 2)) (me2 (match-end 2)) (exp (buffer-substring (or mb2 mb1) (or me2 me1))) @@ -1322,6 +1341,7 @@ than the logical beginning of line." (message "History item: %d" (1+ pos))))) ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?") ;; Quick substitution on the previous input line. + (if dry-run (throw dry-run 'expand)) (let ((old (buffer-substring (match-beginning 1) (match-end 1))) (new (buffer-substring (match-beginning 2) (match-end 2))) (pos nil)) @@ -1334,7 +1354,8 @@ than the logical beginning of line." (replace-match new t t) (message "History item: substituted")))) (t - (forward-char 1))))))) + (forward-char 1))))) + nil)) (defun comint-magic-space (arg) @@ -1740,9 +1761,9 @@ Similarly for Soar, Scheme, etc." (insert copy) copy))) (input (if (not (eq comint-input-autoexpand 'input)) - ;; Just whatever's already there + ;; Just whatever's already there. intxt - ;; Expand and leave it visible in buffer + ;; Expand and leave it visible in buffer. (comint-replace-by-expanded-history t pmark) (buffer-substring pmark (point)))) (history (if (not (eq comint-input-autoexpand 'history)) @@ -2990,16 +3011,12 @@ Magic characters are those in `comint-file-name-quote-list'." (setq i (+ 1 (match-beginning 0))))) filename))) +(defun comint-completion-at-point () + (run-hook-with-args-until-success 'comint-dynamic-complete-functions)) -(defun comint-dynamic-complete () - "Dynamically perform completion at point. -Calls the functions in `comint-dynamic-complete-functions' to perform -completion until a function returns non-nil, at which point completion is -assumed to have occurred." - (interactive) - (let ((completion-at-point-functions comint-dynamic-complete-functions)) - (completion-at-point))) - +(define-obsolete-function-alias + 'comint-dynamic-complete + 'completion-at-point "24.1") (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0adf2a1d8b8..e012c324012 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -247,7 +247,9 @@ TERMINATOR can also be a cons cell (TERMINATOR . TERMINATOR-REGEXP) in which case TERMINATOR-REGEXP is a regular expression whose submatch number 1 should match TERMINATOR. This is used when there is a need to distinguish occurrences of the TERMINATOR strings which are really terminators -from others (e.g. escaped)." +from others (e.g. escaped). In this form, the car of TERMINATOR can also be, +instead of a string, a function that takes the completion and returns the +\"terminated\" string." ;; FIXME: This implementation is not right since it only adds the terminator ;; in try-completion, so any completion-style that builds the completion via ;; all-completions won't get the terminator, and selecting an entry in @@ -258,22 +260,28 @@ from others (e.g. escaped)." (bounds (completion-boundaries string table pred suffix)) (terminator-regexp (if (consp terminator) (cdr terminator) (regexp-quote terminator))) - (max (string-match terminator-regexp suffix))) + (max (and terminator-regexp + (string-match terminator-regexp suffix)))) (list* 'boundaries (car bounds) (min (cdr bounds) (or max (length suffix)))))) ((eq action nil) (let ((comp (try-completion string table pred))) (if (consp terminator) (setq terminator (car terminator))) (if (eq comp t) - (concat string terminator) - (if (and (stringp comp) - ;; FIXME: Try to avoid this second call, especially since + (if (functionp terminator) + (funcall terminator string) + (concat string terminator)) + (if (and (stringp comp) (not (zerop (length comp))) + ;; Try to avoid the second call to try-completion, since ;; it may be very inefficient (because `comp' made us ;; jump to a new boundary, so we complete in that ;; boundary with an empty start string). - ;; completion-boundaries might help. + (let ((newbounds (completion-boundaries comp table pred ""))) + (< (car newbounds) (length comp))) (eq (try-completion comp table pred) t)) - (concat comp terminator) + (if (functionp terminator) + (funcall terminator comp) + (concat comp terminator)) comp)))) ((eq action t) ;; FIXME: We generally want the `try' and `all' behaviors to be @@ -1294,6 +1302,8 @@ Point needs to be somewhere between START and END." (defvar completion-in-region-mode-map (let ((map (make-sparse-keymap))) + ;; FIXME: Only works if completion-in-region-mode was activated via + ;; completion-at-point called directly. (define-key map "?" 'completion-help-at-point) (define-key map "\t" 'completion-at-point) map) diff --git a/lisp/shell.el b/lisp/shell.el index 57187b6d7f9..d6bc685618c 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,4 +1,4 @@ -;;; shell.el --- specialized comint.el for running the shell +;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1993-1997, 2000-2011 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ ;; Shell Mode Commands: ;; shell Fires up the shell process -;; tab comint-dynamic-complete Complete filename/command/history +;; tab completion-at-point Complete filename/command/history ;; m-? comint-dynamic-list-filename-completions ;; List completions in help buffer ;; m-c-f shell-forward-command Forward a shell command @@ -96,6 +96,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'comint) ;;; Customization and Buffer Variables @@ -181,12 +182,12 @@ shell buffer. The value may depend on the operating system or shell. This is a fine thing to set in your `.emacs' file.") (defvar shell-dynamic-complete-functions - '(comint-replace-by-expanded-history - shell-dynamic-complete-environment-variable - shell-dynamic-complete-command - shell-replace-by-expanded-directory - shell-dynamic-complete-filename - comint-dynamic-complete-filename) + '(comint-c-a-p-replace-by-expanded-history + shell-environment-variable-completion + shell-command-completion + shell-c-a-p-replace-by-expanded-directory + shell-filename-completion + comint-filename-completion) "List of functions called to perform completion. This variable is used to initialize `comint-dynamic-complete-functions' in the shell buffer. @@ -312,7 +313,7 @@ This mirrors the optional behavior of tcsh (its autoexpand and histlit). If the value is `input', then the expansion is seen on input. If the value is `history', then the expansion is only when inserting into the buffer's input ring. See also `comint-magic-space' and -`comint-dynamic-complete'. +`comint-dynamic-complete-functions'. This variable supplies a default for `comint-input-autoexpand', for Shell mode only." @@ -339,7 +340,7 @@ Thus, this does not include the shell's current directory.") (let ((map (nconc (make-sparse-keymap) comint-mode-map))) (define-key map "\C-c\C-f" 'shell-forward-command) (define-key map "\C-c\C-b" 'shell-backward-command) - (define-key map "\t" 'comint-dynamic-complete) + (define-key map "\t" 'completion-at-point) (define-key map (kbd "M-RET") 'shell-resync-dirs) (define-key map "\M-?" 'comint-dynamic-list-filename-completions) (define-key map [menu-bar completion] @@ -486,7 +487,7 @@ buffer." (t "dirs"))) ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") - (add-hook 'comint-output-filter-functions + (add-hook 'comint-preoutput-filter-functions 'shell-filter-ctrl-a-ctrl-b nil t))) (when shell-dir-cookie-re ;; Watch for magic cookies in the output to track the current dir. @@ -494,7 +495,7 @@ buffer." 'shell-dir-cookie-watcher nil t)) (comint-read-input-ring t))) -(defun shell-filter-ctrl-a-ctrl-b (_string) +(defun shell-filter-ctrl-a-ctrl-b (string) "Remove `^A' and `^B' characters from comint output. Bash uses these characters as internal quoting characters in its @@ -504,15 +505,10 @@ started with the `--noediting' option and Select Graphic Rendition (SGR) control sequences (formerly known as ANSI escape sequences) are used to color the prompt. -This function can be put on `comint-output-filter-functions'. -The argument STRING is ignored." - (let ((pmark (process-mark (get-buffer-process (current-buffer))))) - (save-excursion - (goto-char (or (and (markerp comint-last-output-start) - (marker-position comint-last-output-start)) - (point-min))) - (while (re-search-forward "[\C-a\C-b]" pmark t) - (replace-match ""))))) +This function can be put on `comint-preoutput-filter-functions'." + (if (string-match "[\C-a\C-b]" string) + (replace-regexp-in-string "[\C-a\C-b]" "" string t t) + string)) (defun shell-write-history-on-exit (process event) "Called when the shell process is stopped. @@ -1011,30 +1007,36 @@ candidates. Note that this may not be the same as the shell's idea of the path. Completion is dependent on the value of `shell-completion-execonly', plus -those that effect file completion. See `shell-dynamic-complete-as-command'. +those that effect file completion. Returns t if successful." (interactive) + (let ((data (shell-command-completion))) + (if data + (prog2 (unless (window-minibuffer-p (selected-window)) + (message "Completing command name...")) + (apply #'completion-in-region data))))) + +(defun shell-command-completion () + "Return the completion data for the command at point, if any." (let ((filename (comint-match-partial-filename))) (if (and filename (save-match-data (not (string-match "[~/]" filename))) (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point)))) - (prog2 (unless (window-minibuffer-p (selected-window)) - (message "Completing command name...")) - (shell-dynamic-complete-as-command))))) + (shell--command-completion-data)))) - -(defun shell-dynamic-complete-as-command () - "Dynamically complete at point as a command. -See `shell-dynamic-complete-filename'. Returns t if successful." +(defun shell--command-completion-data () + "Return the completion data for the command at point." (let* ((filename (or (comint-match-partial-filename) "")) + (start (if (zerop (length filename)) (point) (match-beginning 0))) + (end (if (zerop (length filename)) (point) (match-end 0))) (filenondir (file-name-nondirectory filename)) - (path-dirs (cdr (reverse exec-path))) + (path-dirs (cdr (reverse exec-path))) ;FIXME: Why `cdr'? (cwd (file-name-as-directory (expand-file-name default-directory))) (ignored-extensions (and comint-completion-fignore - (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) + (mapconcat (function (lambda (x) (concat (regexp-quote x) "\\'"))) comint-completion-fignore "\\|"))) (dir "") (comps-in-dir ()) (file "") (abs-file-name "") (completions ())) @@ -1058,18 +1060,31 @@ See `shell-dynamic-complete-filename'. Returns t if successful." (setq comps-in-dir (cdr comps-in-dir))) (setq path-dirs (cdr path-dirs))) ;; OK, we've got a list of completions. - (let ((success (let ((comint-completion-addsuffix nil)) - (comint-dynamic-simple-complete filenondir completions)))) - (if (and (memq success '(sole shortest)) comint-completion-addsuffix - (not (file-directory-p (comint-match-partial-filename)))) - (insert " ")) - success))) + (list + start end + (lambda (string pred action) + (completion-table-with-terminator + " " (lambda (string pred action) + (if (string-match "/" string) + (completion-file-name-table string pred action) + (complete-with-action action completions string pred))) + string pred action))))) + +;; (defun shell-dynamic-complete-as-command () +;; "Dynamically complete at point as a command. +;; See `shell-dynamic-complete-filename'. Returns t if successful." +;; (apply #'completion-in-region shell--command-completion-data)) (defun shell-dynamic-complete-filename () "Dynamically complete the filename at point. This completes only if point is at a suitable position for a filename argument." (interactive) + (let ((data (shell-filename-completion))) + (if data (apply #'completion-in-region data)))) + +(defun shell-filename-completion () + "Return the completion data for file name at point, if any." (let ((opoint (point)) (beg (comint-line-beginning-position))) (when (save-excursion @@ -1077,24 +1092,21 @@ filename argument." (match-end 0) beg)) (re-search-forward "[^ \t][ \t]" opoint t)) - (comint-dynamic-complete-as-filename)))) + (comint-filename-completion)))) (defun shell-match-partial-variable () "Return the shell variable at point, or nil if none is found." (save-excursion - (let ((limit (point))) - (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move) - (or (looking-at "\\$") (forward-char 1))) - ;; Anchor the search forwards. - (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]")) - nil - (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit) - (buffer-substring (match-beginning 0) (match-end 0)))))) + (if (re-search-backward "[^A-Za-z0-9_{(]" nil 'move) + (or (looking-at "\\$") (forward-char 1))) + (if (or (eolp) (looking-at "[^A-Za-z0-9_{($]")) + nil + (looking-at "\\$?[{(]?[A-Za-z0-9_]*[})]?") + (buffer-substring (match-beginning 0) (match-end 0))))) (defun shell-dynamic-complete-environment-variable () "Dynamically complete the environment variable at point. Completes if after a variable, i.e., if it starts with a \"$\". -See `shell-dynamic-complete-as-environment-variable'. This function is similar to `comint-dynamic-complete-filename', except that it searches `process-environment' for completion candidates. Note that this may @@ -1106,39 +1118,70 @@ called `shell-dynamic-complete-process-environment-variable'. Returns non-nil if successful." (interactive) - (let ((variable (shell-match-partial-variable))) - (if (and variable (string-match "^\\$" variable)) + (let ((data (shell-environment-variable-completion))) + (if data (prog2 (unless (window-minibuffer-p (selected-window)) (message "Completing variable name...")) - (shell-dynamic-complete-as-environment-variable))))) + (apply #'completion-in-region data))))) -(defun shell-dynamic-complete-as-environment-variable () - "Dynamically complete at point as an environment variable. -Used by `shell-dynamic-complete-environment-variable'. -Uses `comint-dynamic-simple-complete'." - (let* ((var (or (shell-match-partial-variable) "")) - (variable (substring var (or (string-match "[^$({]\\|$" var) 0))) - (variables (mapcar (function (lambda (x) - (substring x 0 (string-match "=" x)))) - process-environment)) - (addsuffix comint-completion-addsuffix) - (comint-completion-addsuffix nil) - (success (comint-dynamic-simple-complete variable variables))) - (if (memq success '(sole shortest)) - (let* ((var (shell-match-partial-variable)) - (variable (substring var (string-match "[^$({]" var))) - (protection (cond ((string-match "{" var) "}") - ((string-match "(" var) ")") - (t ""))) - (suffix (cond ((null addsuffix) "") - ((file-directory-p - (comint-directory (getenv variable))) "/") - (t " ")))) - (insert protection suffix))) - success)) +(defun shell-environment-variable-completion () + "Completion data for an environment variable at point, if any." + (let* ((var (shell-match-partial-variable)) + (end (match-end 0))) + (when (and (not (zerop (length var))) (eq (aref var 0) ?$)) + (let* ((start + (save-excursion + (goto-char (match-beginning 0)) + (looking-at "\\$?[({]*") + (match-end 0))) + (variables (mapcar (lambda (x) + (substring x 0 (string-match "=" x))) + process-environment)) + (suffix (case (char-before start) (?\{ "}") (?\( ")") (t "")))) + (list + start end + (apply-partially + #'completion-table-with-terminator + (cons (lambda (comp) + (concat comp + suffix + (if (file-directory-p + (comint-directory (getenv comp))) + "/"))) + "\\`a\\`") + variables)))))) +(defun shell-c-a-p-replace-by-expanded-directory () + "Expand directory stack reference before point. +For use on `completion-at-point-functions'." + (when (comint-match-partial-filename) + (save-excursion + (goto-char (match-beginning 0)) + (let ((stack (cons default-directory shell-dirstack)) + (index (cond ((looking-at "=-/?") + (length shell-dirstack)) + ((looking-at "=\\([0-9]+\\)/?") + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1))))))) + (when index + (let ((start (match-beginning 0)) + (end (match-end 0)) + (replacement (file-name-as-directory (nth index stack)))) + (lambda () + (cond + ((>= index (length stack)) + (error "Directory stack not that deep")) + (t + (save-excursion + (goto-char start) + (insert replacement) + (delete-char (- end start))) + (message "Directory item: %d" index) + t))))))))) + (defun shell-replace-by-expanded-directory () "Expand directory stack reference before point. Directory stack references are of the form \"=digit\" or \"=-\". @@ -1146,24 +1189,8 @@ See `default-directory' and `shell-dirstack'. Returns t if successful." (interactive) - (if (comint-match-partial-filename) - (save-excursion - (goto-char (match-beginning 0)) - (let ((stack (cons default-directory shell-dirstack)) - (index (cond ((looking-at "=-/?") - (length shell-dirstack)) - ((looking-at "=\\([0-9]+\\)/?") - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1))))))) - (cond ((null index) - nil) - ((>= index (length stack)) - (error "Directory stack not that deep")) - (t - (replace-match (file-name-as-directory (nth index stack)) t t) - (message "Directory item: %d" index) - t)))))) + (let ((f (shell-c-a-p-replace-by-expanded-directory))) + (if f (funcall f)))) (provide 'shell) From 80f499c7c1cae0e008400b2a2fe443a1a7621ce5 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 21 Apr 2011 01:34:00 +0200 Subject: [PATCH 25/77] lisp/vc/vc.el (ediff-vc-internal): Declare function. --- lisp/ChangeLog | 4 ++++ lisp/vc/vc.el | 2 ++ 2 files changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 70bb631df9e..ea762d06982 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-04-20 Juanma Barranquero + + * vc/vc.el (ediff-vc-internal): Declare function. + 2011-04-20 Stefan Monnier * shell.el: Use lexical-binding and std completion UI. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 1639cd7b1b1..3809b5b4293 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1684,6 +1684,8 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset t) nil nil (called-interactively-p 'interactive)))) +(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks)) + ;;;###autoload (defun vc-version-ediff (files rev1 rev2) "Show differences between revisions of the fileset in the From dbd5ffad4d537506245e92d56c7b833ad5af821b Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Thu, 21 Apr 2011 00:24:27 +0000 Subject: [PATCH 26/77] shr.el (shr-base): New binding. (shr-tag-base): Keep track of . (shr-expand-url): New function used throughout. --- lisp/gnus/ChangeLog | 6 ++++++ lisp/gnus/shr.el | 25 +++++++++++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 73e7345e07d..9c37b9bf576 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2011-04-20 Lars Magne Ingebrigtsen + + * shr.el (shr-base): New binding. + (shr-tag-base): Keep track of . + (shr-expand-url): New function used throughout. + 2011-04-20 Teodor Zlatanov * gnus-registry.el diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 113137a0046..f27705e0bf5 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -99,6 +99,7 @@ cid: URL as the argument.") (defvar shr-kinsoku-shorten nil) (defvar shr-table-depth 0) (defvar shr-stylesheet nil) +(defvar shr-base nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -127,6 +128,7 @@ cid: URL as the argument.") (setq shr-content-cache nil) (let ((shr-state nil) (shr-start nil) + (shr-base nil) (shr-width (or shr-width (window-width)))) (shr-descend (shr-transform-dom dom)))) @@ -392,6 +394,18 @@ redirects somewhere else." (forward-char 1)))) (not failed))) +(defun shr-expand-url (url) + (cond + ;; Absolute URL. + ((or (string-match "\\`[a-z]*:" url) + (not shr-base)) + url) + ((and (not (string-match "/\\'" shr-base)) + (not (string-match "\\`" url))) + (concat shr-base "/" url)) + (t + (concat shr-base url)))) + (defun shr-ensure-newline () (unless (zerop (current-column)) (insert "\n"))) @@ -773,13 +787,16 @@ ones, in case fg and bg are nil." plist))))) plist))) +(defun shr-tag-base (cont) + (setq shr-base (cdr (assq :href cont)))) + (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) (title (cdr (assq :title cont))) (start (point)) shr-start) (shr-generic cont) - (shr-urlify (or shr-start start) url title))) + (shr-urlify (or shr-start start) (shr-expand-url url) title))) (defun shr-tag-object (cont) (let ((start (point)) @@ -792,7 +809,7 @@ ones, in case fg and bg are nil." (setq url (or url (cdr (assq :value (cdr elem))))))) (when url (shr-insert " [multimedia] ") - (shr-urlify start url)) + (shr-urlify start (shr-expand-url url))) (shr-generic cont))) (defun shr-tag-video (cont) @@ -800,7 +817,7 @@ ones, in case fg and bg are nil." (url (cdr (assq :src cont))) (start (point))) (shr-tag-img nil image) - (shr-urlify start url))) + (shr-urlify start (shr-expand-url url)))) (defun shr-tag-img (cont &optional url) (when (or url @@ -810,7 +827,7 @@ ones, in case fg and bg are nil." (not (eq shr-state 'image))) (insert "\n")) (let ((alt (cdr (assq :alt cont))) - (url (or url (cdr (assq :src cont))))) + (url (shr-expand-url (or url (cdr (assq :src cont)))))) (let ((start (point-marker))) (when (zerop (length alt)) (setq alt "*")) From 2b45516032f09132ef5a6da32c4482bbe689815f Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Thu, 21 Apr 2011 02:22:56 +0000 Subject: [PATCH 27/77] shr.el (shr-expand-url): Protect against null urls. --- lisp/gnus/ChangeLog | 4 ++++ lisp/gnus/shr.el | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 9c37b9bf576..5803fe7d0fd 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,7 @@ +2011-04-21 Lars Magne Ingebrigtsen + + * shr.el (shr-expand-url): Protect against null urls. + 2011-04-20 Lars Magne Ingebrigtsen * shr.el (shr-base): New binding. diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index f27705e0bf5..ee231e6a82f 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -397,7 +397,8 @@ redirects somewhere else." (defun shr-expand-url (url) (cond ;; Absolute URL. - ((or (string-match "\\`[a-z]*:" url) + ((or (not url) + (string-match "\\`[a-z]*:" url) (not shr-base)) url) ((and (not (string-match "/\\'" shr-base)) From 58d468b44d8e8b639e8dd13f9895516d30bcbba5 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 21 Apr 2011 04:45:31 +0200 Subject: [PATCH 28/77] lisp/play/doctor.el: Fix typos in docstrings. --- lisp/ChangeLog | 5 +++++ lisp/play/doctor.el | 16 ++++++++-------- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 13561921b1f..77c586c47fb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-21 Juanma Barranquero + + * play/doctor.el (doc$, doctor-$, doctor-read-print, doctor-read-token) + (doctor-nounp, doctor-pronounp): Fix typos in docstrings. + 2011-04-15 Juanma Barranquero * mouse-drag.el (mouse-drag-throw): Fix typo in docstring. diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 6a21f035cd2..fd69497dc42 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -61,11 +61,11 @@ (defun doc// (x) x) (defmacro doc$ (what) - "quoted arg form of doctor-$" + "Quoted arg form of doctor-$." (list 'doctor-$ (list 'quote what))) (defun doctor-$ (what) - "Return the car of a list, rotating the list each time" + "Return the car of a list, rotating the list each time." (let* ((vv (symbol-value what)) (first (car vv)) (ww (append (cdr vv) (list first)))) @@ -562,8 +562,8 @@ reads the sentence before point, and prints the Doctor's answer." (defun doctor-meaning (x) (get x 'doctor-meaning)) (defmacro doctor-put-meaning (symb val) - "Store the base meaning of a word on the property list." - (list 'put (list 'quote symb) ''doctor-meaning val)) + "Store the base meaning of a word on the property list." + (list 'put (list 'quote symb) ''doctor-meaning val)) (doctor-put-meaning howdy 'howdy) (doctor-put-meaning hi 'howdy) @@ -851,7 +851,7 @@ Otherwise call the Doctor to parse preceding sentence." (newline arg))) (defun doctor-read-print nil - "top level loop" + "Top level loop." (interactive) (let ((sent (doctor-readin))) (insert "\n") @@ -869,7 +869,7 @@ Otherwise call the Doctor to parse preceding sentence." sentence)) (defun doctor-read-token () - "read one word from buffer" + "Read one word from buffer." (prog1 (intern (downcase (buffer-substring (point) (progn (forward-word 1) @@ -1039,7 +1039,7 @@ the subject noun, and return the portion of the sentence following it." nil)))) (defun doctor-nounp (x) - "Returns t if the symbol argument is a noun." + "Return t if the symbol argument is a noun." (or (doctor-pronounp x) (not (or (doctor-verbp x) (equal x 'not) @@ -1047,7 +1047,7 @@ the subject noun, and return the portion of the sentence following it." (doctor-modifierp x) )) )) (defun doctor-pronounp (x) - "Returns t if the symbol argument is a pronoun." + "Return t if the symbol argument is a pronoun." (memq x '( i me mine myself we us ours ourselves ourself From 891e751b65caba415af328856e27345382f4416d Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Thu, 21 Apr 2011 02:48:04 +0000 Subject: [PATCH 29/77] shr.el (shr-expand-url): Fix typo. --- lisp/gnus/shr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index ee231e6a82f..401ac1a08c6 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -402,7 +402,7 @@ redirects somewhere else." (not shr-base)) url) ((and (not (string-match "/\\'" shr-base)) - (not (string-match "\\`" url))) + (not (string-match "\\`/" url))) (concat shr-base "/" url)) (t (concat shr-base url)))) From c6c3212525649764708af281de3deb2d96225686 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 21 Apr 2011 14:06:01 +0200 Subject: [PATCH 30/77] lisp/play/mpuz.el: Small fixes. * play/mpuz (mpuz-silent): Doc fix. (mpuz-mode-map): Move initialization into declaration. (mpuz-put-number-on-board): Rename parameter L to COLUMNS. (mpuz-letter-to-digit, mpuz-check-all-solved, mpuz-create-buffer): Fix typos in docstrings. --- lisp/ChangeLog | 6 ++++++ lisp/play/mpuz.el | 51 +++++++++++++++-------------------------------- 2 files changed, 22 insertions(+), 35 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 77c586c47fb..7cfe6d842d9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2011-04-21 Juanma Barranquero + * play/mpuz.el (mpuz-silent): Doc fix. + (mpuz-mode-map): Move initialization into declaration. + (mpuz-put-number-on-board): Rename parameter L to COLUMNS. + (mpuz-letter-to-digit, mpuz-check-all-solved, mpuz-create-buffer): + Fix typos in docstrings. + * play/doctor.el (doc$, doctor-$, doctor-read-print, doctor-read-token) (doctor-nounp, doctor-pronounp): Fix typos in docstrings. diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 32678650ab3..4c6d66b27ae 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -40,7 +40,7 @@ (defcustom mpuz-silent 'error "Set this to nil if you want dings on inputs. -t means never ding, and `error' means only ding on wrong input." +The value t means never ding, and `error' means only ding on wrong input." :type '(choice (const :tag "No" nil) (const :tag "Yes" t) (const :tag "If correct" error)) @@ -87,34 +87,16 @@ t means never ding, and `error' means only ding on wrong input." :type 'hook :group 'mpuz) -(defvar mpuz-mode-map nil +(defvar mpuz-mode-map + (let ((map (make-sparse-keymap))) + (mapc (lambda (ch) + (define-key map (char-to-string ch) 'mpuz-try-letter)) + "abcdefghijABCDEFGHIJ") + (define-key map "\C-g" 'mpuz-offer-abort) + (define-key map "?" 'describe-mode) + map) "Local keymap to use in Mult Puzzle.") -(if mpuz-mode-map nil - (setq mpuz-mode-map (make-sparse-keymap)) - (define-key mpuz-mode-map "a" 'mpuz-try-letter) - (define-key mpuz-mode-map "b" 'mpuz-try-letter) - (define-key mpuz-mode-map "c" 'mpuz-try-letter) - (define-key mpuz-mode-map "d" 'mpuz-try-letter) - (define-key mpuz-mode-map "e" 'mpuz-try-letter) - (define-key mpuz-mode-map "f" 'mpuz-try-letter) - (define-key mpuz-mode-map "g" 'mpuz-try-letter) - (define-key mpuz-mode-map "h" 'mpuz-try-letter) - (define-key mpuz-mode-map "i" 'mpuz-try-letter) - (define-key mpuz-mode-map "j" 'mpuz-try-letter) - (define-key mpuz-mode-map "A" 'mpuz-try-letter) - (define-key mpuz-mode-map "B" 'mpuz-try-letter) - (define-key mpuz-mode-map "C" 'mpuz-try-letter) - (define-key mpuz-mode-map "D" 'mpuz-try-letter) - (define-key mpuz-mode-map "E" 'mpuz-try-letter) - (define-key mpuz-mode-map "F" 'mpuz-try-letter) - (define-key mpuz-mode-map "G" 'mpuz-try-letter) - (define-key mpuz-mode-map "H" 'mpuz-try-letter) - (define-key mpuz-mode-map "I" 'mpuz-try-letter) - (define-key mpuz-mode-map "J" 'mpuz-try-letter) - (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort) - (define-key mpuz-mode-map "?" 'describe-mode)) - (defun mpuz-mode () "Multiplication puzzle mode. @@ -171,7 +153,7 @@ You may abort a game by typing \\\\[mpuz-offer-abort]." "A permutation from [0..9] to [0..9].") (defvar mpuz-letter-to-digit (make-vector 10 0) - "The inverse of mpuz-digit-to-letter.") + "The inverse of `mpuz-digit-to-letter'.") (defmacro mpuz-to-digit (letter) (list 'aref 'mpuz-letter-to-digit letter)) @@ -198,17 +180,16 @@ You may abort a game by typing \\\\[mpuz-offer-abort]." (defvar mpuz-board (make-vector 10 nil) "The board associates to any digit the list of squares where it appears.") -(defun mpuz-put-number-on-board (number row &rest l) +(defun mpuz-put-number-on-board (number row &rest columns) "Put (last digit of) NUMBER on ROW and COLUMNS of the puzzle board." (let (digit) - (while l + (dolist (column columns) (setq digit (% number 10) - number (/ number 10)) - (aset mpuz-board digit `((,row . ,(car l)) ,@(aref mpuz-board digit))) - (setq l (cdr l))))) + number (/ number 10)) + (aset mpuz-board digit `((,row . ,column) ,@(aref mpuz-board digit)))))) (defun mpuz-check-all-solved (&optional row col) - "Check whether all digits have been solved. Return t if yes." + "Check whether all digits have been solved. Return t if yes." (catch 'solved (let (A B1 B2 C D E squares) (and mpuz-solve-when-trivial @@ -294,7 +275,7 @@ You may abort a game by typing \\\\[mpuz-offer-abort]." "The general picture of the puzzle screen, as a string.") (defun mpuz-create-buffer () - "Create (or recreate) the puzzle buffer. Return it." + "Create (or recreate) the puzzle buffer. Return it." (let ((buf (get-buffer-create "*Mult Puzzle*")) (face '(face mpuz-text)) buffer-read-only) From 121656e9e3bd049f75d979360295a60944ff19d6 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Thu, 21 Apr 2011 14:24:46 +0200 Subject: [PATCH 31/77] lisp/play/*.el: Lexical-binding cleanup. --- lisp/ChangeLog | 48 +++++++++++++++++ lisp/play/5x5.el | 6 +-- lisp/play/bubbles.el | 16 +++--- lisp/play/decipher.el | 53 ++++++++++--------- lisp/play/doctor.el | 114 ++++++++++++++++++++--------------------- lisp/play/fortune.el | 2 +- lisp/play/gamegrid.el | 11 ++-- lisp/play/gametree.el | 41 ++++++--------- lisp/play/gomoku.el | 4 +- lisp/play/handwrite.el | 5 +- lisp/play/hanoi.el | 1 - lisp/play/landmark.el | 18 +++---- lisp/play/mpuz.el | 5 +- lisp/play/solitaire.el | 4 +- lisp/play/tetris.el | 62 +++++++++++----------- lisp/play/zone.el | 2 + 16 files changed, 215 insertions(+), 177 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ea762d06982..e359a0f7cc5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,51 @@ +2011-04-21 Juanma Barranquero + + Lexical-binding cleanup. + + * play/5x5.el (5x5-make-random-solution, 5x5-make-mutate-current) + (5x5-make-mutate-best): + * play/fortune.el (fortune-in-buffer): + * play/gomoku.el (gomoku-init-display): + * play/solitaire.el (solitaire, solitaire-do-check): + * play/tetris.el (tetris-default-update-speed-function): + Mark unused parameters. + + * play/bubbles.el (bubbles-mode): Set `show-trailing-whitespace'. + (bubbles--shift): Remove unused variable `char-org'. + (bubbles--set-faces): Remove unused variable `fg-col'. Simplify. + (bubbles--show-images): Remove unused variable `char'. + + * play/decipher.el (decipher-keypress, decipher-alphabet-keypress) + (decipher-get-undo, decipher-set-map, decipher-complete-alphabet) + (decipher-resync, decipher-loop-with-breaks, decipher--analyze) + (decipher-analyze-buffer): Use ?\s. + (decipher-make-checkpoint): Remove unused variable `mapping'. + + * play/doctor.el (doctor-doc): Rename parameter DOCTOR-SENT to SENT. + + * play/gamegrid.el (gamegrid-add-score-with-update-game-score): + Remove unused variable `result'; use `let'. + + * play/gametree.el (gametree-current-layout, gametree-apply-layout): + Rename parameter TOP-LEVEL to FROM-TOP-LEVEL; use `ignore-errors'. + (gametree-children-shown-p, gametree-compute-reduced-score): + Use `ignore-errors'. + + * play/handwrite.el (ps-lpr-switches): Declare. + (handwrite): Remove unused variables `pmin' and `lastp'. + + * play/hanoi.el (hanoi-move-ring): Remove unused variable `total-steps'. + + * play/landmark.el (landmark-init-display) + (landmark-update-naught-weights): Mark unused parameters. + (landmark-y): Remove unused variable `noise'. Simplify. + (landmark-human-plays): Remove unused variable `score'. + + * play/mpuz.el (mpuz-try-letter): Remove unused variable `message'. + (mpuz-try-proposal): Remove unused variable `game'. + + * play/zone.el (life-patterns): Declare. + 2011-04-20 Juanma Barranquero * vc/vc.el (ediff-vc-internal): Declare function. diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 364ea35af3c..46c3c867304 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -368,15 +368,15 @@ should return a grid vector array that is the new solution." (5x5-copy-grid best-solution))))) (setq 5x5-cracking nil)) -(defun 5x5-make-random-solution (&rest ignore) +(defun 5x5-make-random-solution (&rest _ignore) "Make a random solution." (5x5-make-random-grid)) -(defun 5x5-make-mutate-current (current best) +(defun 5x5-make-mutate-current (current _best) "Mutate the current solution." (5x5-mutate-solution current)) -(defun 5x5-make-mutate-best (current best) +(defun 5x5-make-mutate-best (_current best) "Mutate the best solution." (5x5-mutate-solution best)) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 0dc556007ba..f2b7294e2d0 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1,4 +1,4 @@ -;;; bubbles.el --- Puzzle game for Emacs. +;;; bubbles.el --- Puzzle game for Emacs ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. @@ -921,7 +921,8 @@ static char * dot3d_xpm[] = { (define-derived-mode bubbles-mode nil "Bubbles" "Major mode for playing bubbles. \\{bubbles-mode-map}" - (setq buffer-read-only t) + (setq buffer-read-only t + show-trailing-whitespace nil) (buffer-disable-undo) (force-mode-line-update) (redisplay) @@ -1317,8 +1318,7 @@ Use optional parameter POS instead of point if given." Return t if new char is non-empty." (save-excursion (when (bubbles--goto row col) - (let ((char-org (char-after (point))) - (char-new (bubbles--empty-char)) + (let ((char-new (bubbles--empty-char)) (removed nil) (trow row) (tcol col) @@ -1416,9 +1416,8 @@ Return t if new char is non-empty." (dotimes (i (bubbles--grid-height)) (dotimes (j (bubbles--grid-width)) (bubbles--goto i j) - (let* ((index (get-text-property (point) 'index)) - (face (nth index bubbles--faces)) - (fg-col (face-foreground face))) + (let ((face (nth (get-text-property (point) 'index) + bubbles--faces))) (when (get-text-property (point) 'active) (set-face-foreground 'bubbles--highlight-face "#ff0000") (setq face 'bubbles--highlight-face)) @@ -1434,8 +1433,7 @@ Return t if new char is non-empty." (save-excursion (goto-char (point-min)) (forward-line 1) - (let ((inhibit-read-only t) - char) + (let ((inhibit-read-only t)) (dotimes (i (bubbles--grid-height)) (dotimes (j (bubbles--grid-width)) (forward-char 1) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 3de8ca3d4fd..b9ce669533a 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -353,7 +353,7 @@ The most useful commands are: (let ((char-a (following-char)) (char-b (decipher-last-command-char))) (or (and (not (= ?w (char-syntax char-a))) - (= char-b ?\ )) ;Spacebar just advances on non-letters + (= char-b ?\s)) ;Spacebar just advances on non-letters (funcall decipher-function char-a char-b))))) (forward-char)) @@ -366,10 +366,10 @@ The most useful commands are: (decipher-set-map a b)) ((and (>= a ?a) (<= a ?z)) ;; If A is lowercase, then it is in the plaintext alphabet: - (if (= b ?\ ) + (if (= b ?\s) ;; We are clearing the association (if any): - (if (/= ?\ (setq b (cdr (assoc a decipher-alphabet)))) - (decipher-set-map b ?\ )) + (if (/= ?\s (setq b (cdr (assoc a decipher-alphabet)))) + (decipher-set-map b ?\s)) ;; Associate the plaintext char with the char pressed: (decipher-set-map b a))) (t @@ -432,12 +432,12 @@ The most useful commands are: ;; modified using setcdr. (let ((cipher-map (decipher-copy-cons (rassoc cipher-char decipher-alphabet))) (plain-map (decipher-copy-cons (assoc plain-char decipher-alphabet)))) - (cond ((equal ?\ plain-char) + (cond ((equal ?\s plain-char) cipher-map) ((equal cipher-char (cdr plain-map)) nil) ;We aren't changing anything - ((equal ?\ (cdr plain-map)) - (or cipher-map (cons ?\ cipher-char))) + ((equal ?\s (cdr plain-map)) + (or cipher-map (cons ?\s cipher-char))) (cipher-map (list plain-map cipher-map)) (t @@ -466,15 +466,15 @@ The most useful commands are: (goto-char (point-min)) (if (setq mapping (rassoc cipher-char decipher-alphabet)) (progn - (setcdr mapping ?\ ) + (setcdr mapping ?\s) (search-forward-regexp (concat "^([a-z]*" (char-to-string (car mapping)))) - (decipher-insert ?\ ) + (decipher-insert ?\s) (beginning-of-line))) (if (setq mapping (assoc plain-char decipher-alphabet)) (progn - (if (/= ?\ (cdr mapping)) - (decipher-set-map (cdr mapping) ?\ t)) + (if (/= ?\s (cdr mapping)) + (decipher-set-map (cdr mapping) ?\s t)) (setcdr mapping cipher-char) (search-forward-regexp (concat "^([a-z]*" plain-string)) (decipher-insert cipher-char) @@ -527,8 +527,7 @@ Type `\\[decipher-restore-checkpoint]' to restore a checkpoint." (or (stringp desc) (setq desc "")) (let (alphabet - buffer-read-only ;Make buffer writable - mapping) + buffer-read-only) ;Make buffer writable (goto-char (point-min)) (re-search-forward "^)") (move-to-column 27 t) @@ -585,12 +584,12 @@ you have determined the keyword." buffer-read-only ;Make buffer writable plain-map undo-rec) (while (setq plain-map (pop ptr)) - (if (equal ?\ (cdr plain-map)) + (if (equal ?\s (cdr plain-map)) (progn (while (rassoc cipher-char decipher-alphabet) ;; Find the next unused letter (incf cipher-char)) - (push (cons ?\ cipher-char) undo-rec) + (push (cons ?\s cipher-char) undo-rec) (decipher-set-map cipher-char (car plain-map) t)))) (decipher-add-undo undo-rec))) @@ -624,7 +623,7 @@ You should use this if you edit the ciphertext." (replace-match ">" nil nil)) (decipher-read-alphabet) (while (setq mapping (pop alphabet)) - (or (equal ?\ (cdr mapping)) + (or (equal ?\s (cdr mapping)) (decipher-set-map (cdr mapping) (car mapping)))))) (setq decipher-undo-list nil decipher-undo-list-size 0) @@ -751,8 +750,8 @@ FUNC is called exactly once between words, with `decipher-char' set to a space. See `decipher-loop-no-breaks' if you do not care about word divisions." - (let ((decipher-char ?\ ) - (decipher--loop-prev-char ?\ )) + (let ((decipher-char ?\s) + (decipher--loop-prev-char ?\s)) (save-excursion (goto-char (point-min)) (funcall func) ;Space marks beginning of first word @@ -760,16 +759,16 @@ See `decipher-loop-no-breaks' if you do not care about word divisions." (while (not (eolp)) (setq decipher-char (upcase (following-char))) (or (and (>= decipher-char ?A) (<= decipher-char ?Z)) - (setq decipher-char ?\ )) - (or (and (equal decipher-char ?\ ) - (equal decipher--loop-prev-char ?\ )) + (setq decipher-char ?\s)) + (or (and (equal decipher-char ?\s) + (equal decipher--loop-prev-char ?\s)) (funcall func)) (setq decipher--loop-prev-char decipher-char) (forward-char)) - (or (equal decipher-char ?\ ) + (or (equal decipher-char ?\s) (progn (setq decipher-char ?\s - decipher--loop-prev-char ?\ ) + decipher--loop-prev-char ?\s) (funcall func))))))) (defun decipher-loop-no-breaks (func) @@ -844,13 +843,13 @@ TOTAL is the total number of letters in the ciphertext." decipher--digram-list))))) (and (>= decipher--prev-char ?A) (incf (aref (aref decipher--before (- decipher--prev-char ?A)) - (if (equal decipher-char ?\ ) + (if (equal decipher-char ?\s) 26 (- decipher-char ?A))))) (and (>= decipher-char ?A) (incf (aref decipher--freqs (- decipher-char ?A))) (incf (aref (aref decipher--after (- decipher-char ?A)) - (if (equal decipher--prev-char ?\ ) + (if (equal decipher--prev-char ?\s) 26 (- decipher--prev-char ?A))))) (setq decipher--prev-char decipher-char)) @@ -883,7 +882,7 @@ TOTAL is the total number of letters in the ciphertext." (defun decipher-analyze-buffer () "Perform frequency analysis and store results in statistics buffer. Creates the statistics buffer if it doesn't exist." - (let ((decipher--prev-char (if decipher-ignore-spaces ?\ ?\*)) + (let ((decipher--prev-char (if decipher-ignore-spaces ?\s ?\*)) (decipher--before (make-vector 26 nil)) (decipher--after (make-vector 26 nil)) (decipher--freqs (make-vector 26 0)) @@ -1057,7 +1056,7 @@ if it can't, it signals an error." ;; (setq undo-rec (list undo-rec))) ;; (insert ?\() ;; (while (setq undo-map (pop undo-rec)) -;; (insert (cdr undo-map) (car undo-map) ?\ )) +;; (insert (cdr undo-map) (car undo-map) ?\s)) ;; (delete-char -1) ;; (insert ")\n")))))) diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index c60472e9386..02d24afb278 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -268,7 +268,7 @@ reads the sentence before point, and prints the Doctor's answer." (you seem to dwell on (doc// doctor-owner) family \.) ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?))) (set (make-local-variable 'doctor--huhlst) - '(((doc$ doctor--whysay)(doc// doctor-sent) \?) + '(((doc$ doctor--whysay) (doc// doctor-sent) \?) (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?))) (set (make-local-variable 'doctor--longhuhlst) '(((doc$ doctor--whysay) that \?) @@ -371,8 +371,8 @@ reads the sentence before point, and prints the Doctor's answer." (did you watch a lot of crime and violence on television as a child \?))) (set (make-local-variable 'doctor--sexlst) '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?) - ((doc$ doctor--describe)(doc$ doctor--something) about your sexual history \.) - ((doc$ doctor--please)(doc$ doctor--describe) your sex life \.\.\.) + ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.) + ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.) ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.) ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.) ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?))) @@ -384,11 +384,11 @@ reads the sentence before point, and prints the Doctor's answer." ((doc$ doctor--bother) i ask that \?))) (set (make-local-variable 'doctor--beclst) '((is it because (doc// doctor-sent) that you came to me \?) - ((doc$ doctor--bother)(doc// doctor-sent) \?) + ((doc$ doctor--bother) (doc// doctor-sent) \?) (when did you first know that (doc// doctor-sent) \?) (is the fact that (doc// doctor-sent) the real reason \?) (does the fact that (doc// doctor-sent) explain anything else \?) - ((doc$ doctor--areyou)(doc$ doctor--sure)(doc// doctor-sent) \? ))) + ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? ))) (set (make-local-variable 'doctor--shortbeclst) '(((doc$ doctor--bother) i ask you that \?) (that\'s not much of an answer!) @@ -398,15 +398,15 @@ reads the sentence before point, and prints the Doctor's answer." (don\'t be (doc$ doctor--afraidof) elaborating \.) ((doc$ doctor--please) go into more detail \.))) (set (make-local-variable 'doctor--thlst) - '(((doc$ doctor--maybe)(doc$ doctor--thing)(doc$ doctor--isrelated) this \.) - ((doc$ doctor--maybe)(doc$ doctor--things)(doc$ doctor--arerelated) this \.) + '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.) + ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.) (is it because of (doc$ doctor--things) that you are going through all this \?) (how do you reconcile (doc$ doctor--things) \? ) - ((doc$ doctor--maybe) this (doc$ doctor--isrelated)(doc$ doctor--things) \?))) + ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?))) (set (make-local-variable 'doctor--remlst) '((earlier you said (doc$ doctor--history) \?) (you mentioned that (doc$ doctor--history) \?) - ((doc$ doctor--whysay)(doc$ doctor--history) \? ))) + ((doc$ doctor--whysay) (doc$ doctor--history) \? ))) (set (make-local-variable 'doctor--toklst) '((is this how you relax \?) (how long have you been smoking grass \?) @@ -415,7 +415,7 @@ reads the sentence before point, and prints the Doctor's answer." '((do you get (doc// doctor-found) often \?) (do you enjoy being (doc// doctor-found) \?) (what makes you (doc// doctor-found) \?) - (how often (doc$ doctor--areyou)(doc// doctor-found) \?) + (how often (doc$ doctor--areyou) (doc// doctor-found) \?) (when were you last (doc// doctor-found) \?))) (set (make-local-variable 'doctor--replist) '((i . (you)) (my . (your)) @@ -859,25 +859,25 @@ Otherwise call the Doctor to parse preceding sentence." ;; Main processing function for sentences that have been read. -(defun doctor-doc (doctor-sent) +(defun doctor-doc (sent) (cond - ((equal doctor-sent '(foo)) - (doctor-type '(bar! (doc$ doctor--please)(doc$ doctor--continue) \.))) - ((member doctor-sent doctor--howareyoulst) + ((equal sent '(foo)) + (doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.))) + ((member sent doctor--howareyoulst) (doctor-type '(i\'m ok \. (doc$ doctor--describe) yourself \.))) - ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long) + ((or (member sent '((good bye) (see you later) (i quit) (so long) (go away) (get lost))) - (memq (car doctor-sent) + (memq (car sent) '(bye halt break quit done exit goodbye bye\, stop pause goodbye\, stop pause))) (doctor-type (doc$ doctor--bye))) - ((and (eq (car doctor-sent) 'you) - (memq (cadr doctor-sent) doctor--abusewords)) - (setq doctor-found (cadr doctor-sent)) + ((and (eq (car sent) 'you) + (memq (cadr sent) doctor--abusewords)) + (setq doctor-found (cadr sent)) (doctor-type (doc$ doctor--abuselst))) - ((eq (car doctor-sent) 'whatmeans) - (doctor-def (cadr doctor-sent))) - ((equal doctor-sent '(parse)) + ((eq (car sent) 'whatmeans) + (doctor-def (cadr sent))) + ((equal sent '(parse)) (doctor-type (list 'subj '= doctor-subj ", " 'verb '= doctor-verb "\n" 'object 'phrase '= doctor-obj "," @@ -889,29 +889,29 @@ Otherwise call the Doctor to parse preceding sentence." 'sentence 'used 'was "..." '(doc// doctor--bak)))) - ((memq (car doctor-sent) '(are is do has have how when where who why)) + ((memq (car sent) '(are is do has have how when where who why)) (doctor-type (doc$ doctor--qlist))) - ;; ((eq (car doctor-sent) 'forget) - ;; (set (cadr doctor-sent) nil) - ;; (doctor-type '((doc$ doctor--isee)(doc$ doctor--please) + ;; ((eq (car sent) 'forget) + ;; (set (cadr sent) nil) + ;; (doctor-type '((doc$ doctor--isee) (doc$ doctor--please) ;; (doc$ doctor--continue)\.))) (t - (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found)) - (if (> (length doctor-sent) 12)(setq doctor-sent (doctor-shorten doctor-sent))) - (setq doctor-sent (doctor-correct-spelling (doctor-replace doctor-sent doctor--replist))) - (cond ((and (not (memq 'me doctor-sent))(not (memq 'i doctor-sent)) - (memq 'am doctor-sent)) - (setq doctor-sent (doctor-replace doctor-sent '((am . (are))))))) - (cond ((equal (car doctor-sent) 'yow) (doctor-zippy)) - ((< (length doctor-sent) 2) - (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy) + (if (doctor-defq sent) (doctor-define sent doctor-found)) + (if (> (length sent) 12) (setq sent (doctor-shorten sent))) + (setq sent (doctor-correct-spelling (doctor-replace sent doctor--replist))) + (cond ((and (not (memq 'me sent)) (not (memq 'i sent)) + (memq 'am sent)) + (setq sent (doctor-replace sent '((am . (are))))))) + (cond ((equal (car sent) 'yow) (doctor-zippy)) + ((< (length sent) 2) + (cond ((eq (doctor-meaning (car sent)) 'howdy) (doctor-howdy)) (t (doctor-short)))) (t - (if (memq 'am doctor-sent) - (setq doctor-sent (doctor-replace doctor-sent '((me . (i)))))) - (setq doctor-sent (doctor-fixup doctor-sent)) - (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not)) + (if (memq 'am sent) + (setq sent (doctor-replace sent '((me . (i)))))) + (setq sent (doctor-fixup sent)) + (if (and (eq (car sent) 'do) (eq (cadr sent) 'not)) (cond ((zerop (random 3)) (doctor-type '(are you (doc$ doctor--afraidof) that \?))) ((zerop (random 2)) @@ -920,9 +920,9 @@ Otherwise call the Doctor to parse preceding sentence." (doctor-rthing)) (t (doctor-type '((doc$ doctor--whysay) that i shouldn\'t - (cddr doctor-sent) + (cddr sent) \?)))) - (doctor-go (doctor-wherego doctor-sent)))))))) + (doctor-go (doctor-wherego sent)))))))) ;; Things done to process sentences once read. @@ -1130,8 +1130,8 @@ the subject noun, and return the portion of the sentence following it." (t 'something)))) (defun doctor-getnoun (x) - (cond ((null x)(setq doctor-object 'something)) - ((atom x)(setq doctor-object x)) + (cond ((null x) (setq doctor-object 'something)) + ((atom x) (setq doctor-object x)) ((eq (length x) 1) (setq doctor-object (cond ((doctor-nounp (setq doctor-object (car x))) doctor-object) @@ -1304,7 +1304,7 @@ element pair in RLIST." sent))) (defun doctor-wherego (sent) - (cond ((null sent)(doc$ doctor--whereoutp)) + (cond ((null sent) (doc$ doctor--whereoutp)) ((null (doctor-meaning (car sent))) (doctor-wherego (cond ((zerop (random 2)) (reverse (cdr sent))) @@ -1327,8 +1327,8 @@ and DOCTOR-OBJ." (setq foo (cdr foo))) (setq doctor-verb (car foo)) (setq doctor-obj (doctor-getnoun (cdr foo))) - (cond ((eq doctor-object 'i)(setq doctor-object 'me)) - ((eq doctor-subj 'me)(setq doctor-subj 'i))) + (cond ((eq doctor-object 'i) (setq doctor-object 'me)) + ((eq doctor-subj 'me) (setq doctor-subj 'i))) (cond (mem (doctor-remember (list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-possess (sent key) @@ -1414,7 +1414,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (defun doctor-rthing () (doctor-type (doc$ doctor--thlst))) -(defun doctor-remem () (cond ((null doctor--history)(doctor-huh)) +(defun doctor-remem () (cond ((null doctor--history) (doctor-huh)) ((doctor-type (doc$ doctor--remlst))))) (defun doctor-howdy () @@ -1426,14 +1426,14 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-type '((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--things) \.))))) (defun doctor-when () - (cond ((< (length (memq doctor-found doctor-sent)) 3)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 3) (doctor-short)) (t (setq doctor-sent (cdr (memq doctor-found doctor-sent))) (setq doctor-sent (doctor-fixup doctor-sent)) - (doctor-type '((doc$ doctor--whatwhen)(doc// doctor-sent) \?))))) + (doctor-type '((doc$ doctor--whatwhen) (doc// doctor-sent) \?))))) (defun doctor-conj () - (cond ((< (length (memq doctor-found doctor-sent)) 4)(doctor-short)) + (cond ((< (length (memq doctor-found doctor-sent)) 4) (doctor-short)) (t (setq doctor-sent (cdr (memq doctor-found doctor-sent))) (setq doctor-sent (doctor-fixup doctor-sent)) @@ -1497,10 +1497,10 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-type (doc$ doctor--toklst))) (defun doctor-state () - (doctor-type (doc$ doctor--states))(doctor-remember (list 'you 'were doctor-found))) + (doctor-type (doc$ doctor--states)) (doctor-remember (list 'you 'were doctor-found))) (defun doctor-mood () - (doctor-type (doc$ doctor--moods))(doctor-remember (list 'you 'felt doctor-found))) + (doctor-type (doc$ doctor--moods)) (doctor-remember (list 'you 'felt doctor-found))) (defun doctor-fear () (setq doctor--feared (doctor-setprep doctor-sent doctor-found)) @@ -1511,8 +1511,8 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-svo doctor-sent doctor-found 1 t) (cond ((memq 'not doctor-sent) (doctor-forget) (doctor-huh)) ((equal doctor-subj 'you) - (doctor-type '(why do you (doc// doctor-verb)(doc// doctor-obj) \?))) - (t (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj)))))) + (doctor-type '(why do you (doc// doctor-verb) (doc// doctor-obj) \?))) + (t (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj)))))) (defun doctor-symptoms () (doctor-type '((doc$ doctor--maybe) you should consult a medical doctor\; @@ -1523,14 +1523,14 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (doctor-hates1)) (defun doctor-hates1 () - (doctor-type '((doc$ doctor--whysay)(list doctor-subj doctor-verb doctor-obj) \?))) + (doctor-type '((doc$ doctor--whysay) (list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-loves () (doctor-svo doctor-sent doctor-found 1 t) (doctor-qloves)) (defun doctor-qloves () - (doctor-type '((doc$ doctor--bother)(list doctor-subj doctor-verb doctor-obj) \?))) + (doctor-type '((doc$ doctor--bother) (list doctor-subj doctor-verb doctor-obj) \?))) (defun doctor-love () (doctor-svo doctor-sent doctor-found 1 t) @@ -1564,7 +1564,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result." (defun doctor-sexnoun () (doctor-sexverb)) (defun doctor-sexverb () - (if (or (memq 'me doctor-sent)(memq 'myself doctor-sent)(memq 'i doctor-sent)) + (if (or (memq 'me doctor-sent) (memq 'myself doctor-sent) (memq 'i doctor-sent)) (doctor-foul) (doctor-type (doc$ doctor--sexlst)))) diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 05775c8a85e..a61b52f4ad1 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -282,7 +282,7 @@ and choose the directory as the fortune-file." ;;; ************** ;;; Display fortune -(defun fortune-in-buffer (interactive &optional file) +(defun fortune-in-buffer (_interactive &optional file) "Put a fortune cookie in the *fortune* buffer. INTERACTIVE is ignored. Optional argument FILE, when supplied, specifies the file to choose the fortune from." diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 99e3b487437..e245e70a55c 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -485,12 +485,11 @@ FILE is created there." (defvar gamegrid-shared-game-dir) (defun gamegrid-add-score-with-update-game-score (file score) - (let* ((result nil) ;; What is this good for? -- os - (gamegrid-shared-game-dir - (not (zerop (logand (file-modes - (expand-file-name "update-game-score" - exec-directory)) - #o4000))))) + (let ((gamegrid-shared-game-dir + (not (zerop (logand (file-modes + (expand-file-name "update-game-score" + exec-directory)) + #o4000))))) (cond ((file-name-absolute-p file) (gamegrid-add-score-insecure file score)) ((and gamegrid-shared-game-dir diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index cd353d27f07..4d514d2d0aa 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -258,23 +258,20 @@ This value is simply the outline heading level of the current line." (defun gametree-children-shown-p () (save-excursion - (condition-case nil + (ignore-errors (let ((depth (gametree-current-branch-depth))) (outline-next-visible-heading 1) - (< depth (gametree-current-branch-depth))) - (error nil)))) + (< depth (gametree-current-branch-depth)))))) -(defun gametree-current-layout (depth &optional top-level) +(defun gametree-current-layout (depth &optional from-top-level) (let ((layout nil) (first-time t)) (while (save-excursion - (condition-case nil - (progn - (or (and first-time top-level - (bolp) (looking-at outline-regexp)) - (setq first-time nil) - (outline-next-visible-heading 1)) - (< depth (gametree-current-branch-depth))) - (error nil))) + (ignore-errors + (or (and first-time from-top-level + (bolp) (looking-at outline-regexp)) + (setq first-time nil) + (outline-next-visible-heading 1)) + (< depth (gametree-current-branch-depth)))) (if (not first-time) (outline-next-visible-heading 1)) (setq first-time nil) @@ -297,18 +294,16 @@ This value is simply the outline heading level of the current line." (goto-char (point-min)) (setq gametree-local-layout (gametree-current-layout 0 t)))) -(defun gametree-apply-layout (layout depth &optional top-level) +(defun gametree-apply-layout (layout depth &optional from-top-level) (let ((first-time t)) (while (and layout (save-excursion - (condition-case nil - (progn - (or (and first-time top-level - (bolp) (looking-at outline-regexp)) - (setq first-time nil) - (outline-next-visible-heading 1)) - (< depth (gametree-current-branch-depth))) - (error nil)))) + (ignore-errors + (or (and first-time from-top-level + (bolp) (looking-at outline-regexp)) + (setq first-time nil) + (outline-next-visible-heading 1)) + (< depth (gametree-current-branch-depth))))) (if (not first-time) (outline-next-visible-heading 1)) (setq first-time nil) @@ -375,9 +370,7 @@ Subnodes which have been manually scored are honored." (while (not done) ;handle subheadings (setq running (funcall minmax running (gametree-compute-reduced-score))) - (setq done (condition-case nil - (outline-forward-same-level 1) - (error nil))))) + (setq done (ignore-errors (outline-forward-same-level 1))))) running))))) ;;;; Commands diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index f9d5594cd0b..33fcf451ebb 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -1043,11 +1043,11 @@ If the game is finished, this command requests for another game." (insert-char ?\n gomoku-square-height)) (or (eq (char-after 1) ?.) (put-text-property 1 2 'point-entered - (lambda (x y) (if (bobp) (forward-char))))) + (lambda (_x _y) (if (bobp) (forward-char))))) (or intangible (put-text-property point (point) 'intangible 2)) (put-text-property point (point) 'point-entered - (lambda (x y) (if (eobp) (backward-char)))) + (lambda (_x _y) (if (eobp) (backward-char)))) (put-text-property (point-min) (point) 'category 'gomoku-mode)) (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 601232e4321..70c10da5405 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -67,8 +67,10 @@ ;;; Code: +;; From ps-print.el (defvar ps-printer-name) (defvar ps-lpr-command) +(defvar ps-lpr-switches) ;; Variables @@ -157,8 +159,7 @@ Variables: `handwrite-linespace' (default 12) `handwrite-pagenumbering' (default nil)" (interactive) (let - ((pmin) ; thanks, Havard - (lastp) + (;(pmin) ; thanks, Havard (cur-buf (current-buffer)) (tpoint (point)) (ps-ypos 63) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 767792babb3..ac78a86757c 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -355,7 +355,6 @@ BITS must be of length nrings. Start at START-TIME." (fly-steps (abs (/ (- (cdr to) (cdr from)) fly-step))) (directed-fly-step (/ (- (cdr to) (cdr from)) fly-steps)) (baseward-steps (/ (- (car to) (cdr to)) baseward-step)) - (total-steps (+ flyward-steps fly-steps baseward-steps)) ;; A step is a character cell. A tick is a time-unit. To ;; make horizontal and vertical motion appear roughly the ;; same speed, we allow one tick per horizontal step and two diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index dd32fd790d3..f0e6670fe58 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -943,11 +943,11 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (insert-char ?\n landmark-square-height)) (or (eq (char-after 1) ?.) (put-text-property 1 2 'point-entered - (lambda (x y) (if (bobp) (forward-char))))) + (lambda (_x _y) (if (bobp) (forward-char))))) (or intangible (put-text-property point (point) 'intangible 2)) (put-text-property point (point) 'point-entered - (lambda (x y) (if (eobp) (backward-char)))) + (lambda (_x _y) (if (eobp) (backward-char)))) (put-text-property (point-min) (point) 'category 'landmark-mode)) (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW @@ -1377,11 +1377,11 @@ After this limit is reached, landmark-random-move is called to push him out of i (t x))) (defun landmark-y (direction) - (let ((noise (put direction 'noise (landmark-noise)))) - (put direction 'y_t - (if (> (get direction 's) 0.0) - 1.0 - 0.0)))) + (put direction 'noise (landmark-noise)) + (put direction 'y_t + (if (> (get direction 's) 0.0) + 1.0 + 0.0))) (defun landmark-update-normal-weights (direction) (mapc (lambda (target-direction) @@ -1395,7 +1395,7 @@ After this limit is reached, landmark-random-move is called to push him out of i landmark-directions)) (defun landmark-update-naught-weights (direction) - (mapc (lambda (target-direction) + (mapc (lambda (_target-direction) (put direction 'w0 (landmark-f (+ @@ -1513,7 +1513,7 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square score) + (let (square) (setq square (landmark-point-square)) (cond ((null square) (error "Your point is not on a square. Retry!")) diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 269da0a061c..5f4ecce31ca 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -425,7 +425,7 @@ You may abort a game by typing \\\\[mpuz-offer-abort]." "Propose a digit for a letter in puzzle." (interactive) (if mpuz-in-progress - (let (letter-char digit digit-char message) + (let (letter-char digit digit-char) (setq letter-char (upcase last-command-event) digit (mpuz-to-digit (- letter-char ?A))) (cond ((mpuz-digit-solved-p digit) @@ -454,8 +454,7 @@ You may abort a game by typing \\\\[mpuz-offer-abort]." "Propose LETTER-CHAR as code for DIGIT-CHAR." (let* ((letter (- letter-char ?A)) (digit (- digit-char ?0)) - (correct-digit (mpuz-to-digit letter)) - (game mpuz-nb-completed-games)) + (correct-digit (mpuz-to-digit letter))) (cond ((mpuz-digit-solved-p correct-digit) (message "%c has already been found." (+ correct-digit ?0))) ((mpuz-digit-solved-p digit) diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 2fe62ed0e60..722c3b43033 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -126,7 +126,7 @@ the game is over, or off, if you are working on a slow machine." '(solitaire-left solitaire-right solitaire-up solitaire-down)) ;;;###autoload -(defun solitaire (arg) +(defun solitaire (_arg) "Play Solitaire. To play Solitaire, type \\[solitaire]. @@ -393,7 +393,7 @@ which a stone will be taken away) and target." solitaire-valid-directions))) count)))) -(defun solitaire-do-check (&optional arg) +(defun solitaire-do-check (&optional _arg) "Check for any possible moves in Solitaire." (interactive "P") (let ((moves (solitaire-check))) diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 2935ff04c96..053b07adfc7 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -193,32 +193,32 @@ If the return value is a number, it is used as the timer period." ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst tetris-shapes - [[[[0 0] [1 0] [0 1] [1 1]]] - - [[[0 0] [1 0] [2 0] [2 1]] - [[1 -1] [1 0] [1 1] [0 1]] - [[0 -1] [0 0] [1 0] [2 0]] - [[1 -1] [2 -1] [1 0] [1 1]]] - - [[[0 0] [1 0] [2 0] [0 1]] - [[0 -1] [1 -1] [1 0] [1 1]] - [[2 -1] [0 0] [1 0] [2 0]] - [[1 -1] [1 0] [1 1] [2 1]]] - - [[[0 0] [1 0] [1 1] [2 1]] + [[[[0 0] [1 0] [0 1] [1 1]]] + + [[[0 0] [1 0] [2 0] [2 1]] + [[1 -1] [1 0] [1 1] [0 1]] + [[0 -1] [0 0] [1 0] [2 0]] + [[1 -1] [2 -1] [1 0] [1 1]]] + + [[[0 0] [1 0] [2 0] [0 1]] + [[0 -1] [1 -1] [1 0] [1 1]] + [[2 -1] [0 0] [1 0] [2 0]] + [[1 -1] [1 0] [1 1] [2 1]]] + + [[[0 0] [1 0] [1 1] [2 1]] [[1 0] [0 1] [1 1] [0 2]]] - - [[[1 0] [2 0] [0 1] [1 1]] - [[0 0] [0 1] [1 1] [1 2]]] - - [[[1 0] [0 1] [1 1] [2 1]] - [[1 0] [1 1] [2 1] [1 2]] - [[0 1] [1 1] [2 1] [1 2]] + + [[[1 0] [2 0] [0 1] [1 1]] + [[0 0] [0 1] [1 1] [1 2]]] + + [[[1 0] [0 1] [1 1] [2 1]] + [[1 0] [1 1] [2 1] [1 2]] + [[0 1] [1 1] [2 1] [1 2]] [[1 0] [0 1] [1 1] [1 2]]] - + [[[0 0] [1 0] [2 0] [3 0]] [[1 -1] [1 0] [1 1] [1 2]]]] - "Each shape is described by a vector that contains the coordinates of + "Each shape is described by a vector that contains the coordinates of each one of its four blocks.") ;;the scoring rules were taken from "xtetris". Blocks score differently @@ -236,7 +236,7 @@ each one of its four blocks.") (defconst tetris-space 9) -(defun tetris-default-update-speed-function (shapes rows) +(defun tetris-default-update-speed-function (_shapes rows) (/ 20.0 (+ 50.0 rows))) ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -380,10 +380,10 @@ each one of its four blocks.") (loop for i from 0 to 3 do (let ((c (tetris-get-shape-cell i))) (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x + tetris-pos-x (aref c 0)) (+ tetris-top-left-y - tetris-pos-y + tetris-pos-y (aref c 1)) tetris-blank)))) @@ -393,14 +393,14 @@ each one of its four blocks.") (unless hit (setq hit (let* ((c (tetris-get-shape-cell i)) - (xx (+ tetris-pos-x + (xx (+ tetris-pos-x (aref c 0))) - (yy (+ tetris-pos-y + (yy (+ tetris-pos-y (aref c 1)))) (or (>= xx tetris-width) (>= yy tetris-height) - (/= (gamegrid-get-cell - (+ xx tetris-top-left-x) + (/= (gamegrid-get-cell + (+ xx tetris-top-left-x) (+ yy tetris-top-left-y)) tetris-blank)))))) hit)) @@ -537,10 +537,10 @@ Drops the shape one square, testing for collision." (interactive) (unless tetris-paused (tetris-erase-shape) - (setq tetris-rot (% (+ 1 tetris-rot) + (setq tetris-rot (% (+ 1 tetris-rot) (tetris-shape-rotations))) (if (tetris-test-shape) - (setq tetris-rot (% (+ 3 tetris-rot) + (setq tetris-rot (% (+ 3 tetris-rot) (tetris-shape-rotations)))) (tetris-draw-shape))) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 75c3b6fbc7d..d194a8af919 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -626,6 +626,8 @@ If the element is a function or a list of a function and a number, "*Seconds to wait between successive `life' generations. If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).") +(defvar life-patterns) ; from life.el + (defun zone-pgm-random-life () (require 'life) (zone-fill-out-screen (1- (window-width)) (1- (window-height))) From c024b0212914973d24d6b6d579c5b1024861db57 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Thu, 21 Apr 2011 22:06:12 +0000 Subject: [PATCH 32/77] gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el, not gnus-registry.el. gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom. Explain why in comments. (gnus-registry-action): Fix data-header reference to use the extra headers. Explain in package commentary how to add To and Cc headers to the gnus-extra-headers. (gnus-registry-ignored-groups): Adjust defaults to match the parameter. (gnus-registry-ignore-group-p): Adjust to take either a group/topic parameter list or a string list in `gnus-registry-ignored-groups'. Fix logic error. --- lisp/gnus/ChangeLog | 15 +++++++++ lisp/gnus/gnus-registry.el | 65 ++++++++++++++++++++++---------------- lisp/gnus/gnus.el | 5 ++- 3 files changed, 57 insertions(+), 28 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 5803fe7d0fd..601f1823d96 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,18 @@ +2011-04-21 Teodor Zlatanov + + * gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el, + not gnus-registry.el. + + * gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom. + Explain why in comments. + (gnus-registry-action): Fix data-header reference to use the extra + headers. Explain in package commentary how to add To and Cc headers to + the gnus-extra-headers. + (gnus-registry-ignored-groups): Adjust defaults to match the parameter. + (gnus-registry-ignore-group-p): Adjust to take either a group/topic + parameter list or a string list in `gnus-registry-ignored-groups'. Fix + logic error. + 2011-04-21 Lars Magne Ingebrigtsen * shr.el (shr-expand-url): Protect against null urls. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 21cec5f2b42..68c6e0a2678 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -31,7 +31,16 @@ ;; gnus-registry.el intercepts article respooling, moving, deleting, ;; and copying for all backends. If it doesn't work correctly for ;; you, submit a bug report and I'll be glad to fix it. It needs -;; documentation in the manual (also on my to-do list). +;; better documentation in the manual (also on my to-do list). + +;; If you want to track recipients (and you should to make the +;; gnus-registry splitting work better), you need the To and Cc +;; headers collected by Gnus: + +;; ;;; you may also want Gcc Newsgroups Keywords X-Face +;; (add-to-list 'gnus-extra-headers 'To) +;; (add-to-list 'gnus-extra-headers 'Cc) +;; (setq nnmail-extra-headers gnus-extra-headers) ;; Put this in your startup file (~/.gnus.el for instance) or use Customize: @@ -133,16 +142,6 @@ qualified. This parameter tells the Gnus registry 'never split a message into a group that matches one of these, regardless of references.' -nnmairix groups are specifically excluded because they are ephemeral." - :group 'gnus-registry - :type '(repeat regexp)) - -(defcustom gnus-registry-ignored-groups - '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive") - "List of groups that the Gnus Registry will ignore. -The group names are matched, they don't have to be fully -qualified. - nnmairix groups are specifically excluded because they are ephemeral." :group 'gnus-registry :type '(repeat regexp)) @@ -313,9 +312,10 @@ This is not required after changing `gnus-registry-cache-file'." (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (mail-header-subject data-header)) + (extra (mail-header-extra data-header)) (recipients (gnus-registry-sort-addresses - (or (cdr (assq "Cc" data-header)) "") - (or (cdr (assq "To" data-header)) ""))) + (or (cdr-safe (assq 'Cc extra)) "") + (or (cdr-safe (assq 'To extra)) ""))) (sender (nth 0 (gnus-registry-extract-addresses (mail-header-from data-header)))) (from (gnus-group-guess-full-name-from-command-method from)) @@ -333,9 +333,9 @@ This is not required after changing `gnus-registry-cache-file'." (defun gnus-registry-spool-action (id group &optional subject sender recipients) (let ((to (gnus-group-guess-full-name-from-command-method group)) (recipients (or recipients - (gnus-registry-sort-addresses - (or (message-fetch-field "cc") "") - (or (message-fetch-field "to") "")))) + (gnus-registry-sort-addresses + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") "")))) (subject (or subject (message-fetch-field "subject"))) (sender (or sender (message-fetch-field "from")))) (when (and (stringp id) (string-match "\r$" id)) @@ -414,8 +414,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (sender (gnus-string-remove-all-properties (message-fetch-field "from"))) (recipients (gnus-registry-sort-addresses - (or (message-fetch-field "cc") "") - (or (message-fetch-field "to") ""))) + (or (message-fetch-field "cc") "") + (or (message-fetch-field "to") ""))) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject (message-fetch-field "subject")))) @@ -655,17 +655,28 @@ Consults `gnus-registry-unfollowed-groups' and group nnmail-split-fancy-with-parent-ignore-groups))))) +;; note that gnus-registry-ignored-groups is defined in gnus.el as a +;; group/topic parameter and an associated variable! + +;; we do special logic for ignoring to accept regular expressions and +;; nnmail-split-fancy-with-parent-ignore-groups as well (defun gnus-registry-ignore-group-p (group) "Determines if a group name should be ignored. Consults `gnus-registry-ignored-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." (and group - (not (or (gnus-grep-in-list - group - gnus-registry-ignored-groups) - (gnus-grep-in-list - group - nnmail-split-fancy-with-parent-ignore-groups))))) + (or (gnus-parameter-registry-ignore group) + (gnus-grep-in-list + group + (delq nil (mapcar (lambda (g) + (cond + ((stringp g) g) + ((and (listp g) (nth 1 g)) + (nth 0 g)) + (t nil))) gnus-registry-ignored-groups))) + (gnus-grep-in-list + group + nnmail-split-fancy-with-parent-ignore-groups)))) (defun gnus-registry-wash-for-keywords (&optional force) "Get the keywords of the current article. @@ -738,7 +749,7 @@ Addresses without a name will say \"noname\"." (defun gnus-registry-sort-addresses (&rest addresses) "Return a normalized and sorted list of ADDRESSES." (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses)) - 'string-lessp)) + 'string-lessp)) (defun gnus-registry-simplify-subject (subject) (if (stringp subject) @@ -769,7 +780,7 @@ Addresses without a name will say \"noname\"." (assoc article (gnus-data-list nil))) (gnus-string-remove-all-properties (cdr (assq header (gnus-data-header - (assoc article (gnus-data-list nil)))))) + (assoc article (gnus-data-list nil)))))) nil)) ;; registry marks glue @@ -998,7 +1009,7 @@ only the last one's marks are returned." extra-cell key val) ;; remove all the strings from the entry (dolist (elem rest) - (if (stringp elem) (setq rest (delq elem rest)))) + (if (stringp elem) (setq rest (delq elem rest)))) (gnus-registry-set-id-key id 'group groups) ;; just use the first extra element (setq rest (car-safe rest)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index f68ea41e6bd..5ff03572832 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1875,7 +1875,10 @@ total number of articles in the group.") :function-document "Whether this group should be ignored by the registry." :variable gnus-registry-ignored-groups - :variable-default nil + :variable-default (mapcar + (lambda (g) (list g t)) + '("delayed$" "drafts$" "queue$" "INBOX$" + "^nnmairix:" "archive")) :variable-document "*Groups in which the registry should be turned off." :variable-group gnus-registry From a6e77075d4056ce25269fe2797bf10de8e2af4a8 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Fri, 22 Apr 2011 00:37:01 +0000 Subject: [PATCH 33/77] gnus-sum.el (gnus-extra-headers): Add Keywords, Cc, and Gcc to default. gnus-registry.el: Mention in comments how to modify `gnus-extra-headers' for proper recipient tracking and that it may already have To and Cc recently, which it does as of this commit. --- lisp/gnus/ChangeLog | 8 +++++++- lisp/gnus/gnus-registry.el | 3 ++- lisp/gnus/gnus-sum.el | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 601f1823d96..57182504331 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,9 +1,15 @@ 2011-04-21 Teodor Zlatanov + * gnus-sum.el (gnus-extra-headers): Add Keywords, Cc, and Gcc to + default. + * gnus.el (gnus-registry-ignored-groups): Provide default in gnus.el, not gnus-registry.el. - * gnus-registry.el (gnus-registry-ignored-groups): Remove defcustom. + * gnus-registry.el: Mention in comments how to modify + `gnus-extra-headers' for proper recipient tracking and that it may + already have To and Cc recently, which it does as of this commit. + (gnus-registry-ignored-groups): Remove defcustom. Explain why in comments. (gnus-registry-action): Fix data-header reference to use the extra headers. Explain in package commentary how to add To and Cc headers to diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 68c6e0a2678..f0b1f186541 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -35,7 +35,8 @@ ;; If you want to track recipients (and you should to make the ;; gnus-registry splitting work better), you need the To and Cc -;; headers collected by Gnus: +;; headers collected by Gnus. Note that in more recent Gnus versions +;; this is already the case: look at `gnus-extra-headers' to be sure. ;; ;;; you may also want Gcc Newsgroups Keywords X-Face ;; (add-to-list 'gnus-extra-headers 'To) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d023bc5bb63..b6a3860a81f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1128,7 +1128,7 @@ which it may alter in any way." 'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") -(defcustom gnus-extra-headers '(To Newsgroups) +(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) "*Extra headers to parse." :version "21.1" :group 'gnus-summary From 5e68f8614fa019ae831a6d48de01322202880274 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Fri, 22 Apr 2011 01:01:32 +0000 Subject: [PATCH 34/77] nnimap.el (nnimap-user): New backend variable. (nnimap-open-connection-1): Use it. (nnimap-credentials): Accept user parameter so it's explicit what user name is desired. --- lisp/gnus/ChangeLog | 7 ++++++- lisp/gnus/nnimap.el | 9 +++++++-- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 57182504331..4a8311f6e0a 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,4 +1,9 @@ -2011-04-21 Teodor Zlatanov +2011-04-22 Teodor Zlatanov + + * nnimap.el (nnimap-user): New backend variable. + (nnimap-open-connection-1): Use it. + (nnimap-credentials): Accept user parameter so it's explicit what user + name is desired. * gnus-sum.el (gnus-extra-headers): Add Keywords, Cc, and Gcc to default. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index afdea185dd3..f819c17afe8 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -58,6 +58,9 @@ (defvoo nnimap-address nil "The address of the IMAP server.") +(defvoo nnimap-user nil + "Username to use for authentication to the IMAP server.") + (defvoo nnimap-server-port nil "The IMAP port used. If nnimap-stream is `ssl', this will default to `imaps'. If not, @@ -283,13 +286,14 @@ textual parts.") (push (current-buffer) nnimap-process-buffers) (current-buffer))) -(defun nnimap-credentials (address ports) +(defun nnimap-credentials (address ports user) (let* ((auth-source-creation-prompts '((user . "IMAP user at %h: ") (secret . "IMAP password for %u@%h: "))) (found (nth 0 (auth-source-search :max 1 :host address :port ports + :user user :require '(:user :secret) :create t)))) (if found @@ -408,7 +412,8 @@ textual parts.") (list nnimap-address (nnoo-current-server 'nnimap))) - ports)))) + ports + nnimap-user)))) (setq nnimap-object nil) (let ((nnimap-inhibit-logging t)) (setq login-result From 7ede3b6577ae99a3e7ac45baa7cace439bf5070c Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Thu, 21 Apr 2011 22:35:48 -0400 Subject: [PATCH 35/77] Doc fixes for package.el. * emacs-lisp/package.el (package--builtins, package-alist) (package-load-descriptor, package-built-in-p, package-activate) (define-package, package-installed-p) (package-compute-transaction, package-buffer-info) (package--push): Doc fix. Distinguish more clearly between version strings and version lists. --- lisp/ChangeLog | 9 ++++++ lisp/emacs-lisp/package.el | 60 +++++++++++++++++++++----------------- 2 files changed, 43 insertions(+), 26 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e359a0f7cc5..118e34b96d3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-04-22 Chong Yidong + + * emacs-lisp/package.el (package--builtins, package-alist) + (package-load-descriptor, package-built-in-p, package-activate) + (define-package, package-installed-p) + (package-compute-transaction, package-buffer-info) + (package--push): Doc fix. Distinguish more clearly between + version strings and version lists. + 2011-04-21 Juanma Barranquero Lexical-binding cleanup. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4ce71b29d70..bdb40dd9dff 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -290,9 +290,11 @@ function `package-built-in-p'. Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION REQS DOCSTRING]. - VERSION is a version list. - REQS is a list of packages (symbols) required by the package. +The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. + VERSION-LIST is a version list. + REQS is a list of packages required by the package, each + requirement having the form (NAME VL), where NAME is a string + and VL is a version list. DOCSTRING is a brief description of the package.") (put 'package--builtins 'risky-local-variable t) @@ -301,9 +303,11 @@ The vector DESC has the form [VERSION REQS DOCSTRING]. Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION REQS DOCSTRING]. - VERSION is a version list. - REQS is a list of packages (symbols) required by the package. +The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. + VERSION-LIST is a version list. + REQS is a list of packages required by the package, each + requirement having the form (NAME VL) where NAME is a string + and VL is a version list. DOCSTRING is a brief description of the package. This variable is set automatically by `package-load-descriptor', @@ -358,8 +362,8 @@ E.g., if given \"quux-23.0\", will return \"quux\"" (defun package-load-descriptor (dir package) "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VER, where NAME is the -package name and VER is its version." +Here, PACKAGE is a string of the form NAME-VERSION, where NAME is +the package name and VERSION is its version." (let* ((pkg-dir (expand-file-name package dir)) (pkg-file (expand-file-name (concat (package-strip-version package) "-pkg") @@ -452,18 +456,21 @@ NAME and VERSION are both strings." ;; Don't return nil. t)) -(defun package-built-in-p (package &optional version) - "Return true if PACKAGE, of VERSION or newer, is built-in to Emacs." +(defun package-built-in-p (package &optional min-version) + "Return true if PACKAGE is built-in to Emacs. +Optional arg MIN-VERSION, if non-nil, should be a version list +specifying the minimum acceptable version." (require 'finder-inf nil t) ; For `package--builtins'. (let ((elt (assq package package--builtins))) - (and elt (version-list-<= version (package-desc-vers (cdr elt)))))) + (and elt (min-version-<= min-version (package-desc-vers (cdr elt)))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package version) - "Activate package PACKAGE, of version VERSION or newer. +(defun package-activate (package min-version) + "Activate package PACKAGE, of version MIN-VERSION or newer. +MIN-VERSION should be a version list. If PACKAGE has any dependencies, recursively activate them. Return nil if the package could not be activated." (let ((pkg-vec (cdr (assq package package-alist))) @@ -471,11 +478,11 @@ Return nil if the package could not be activated." ;; Check if PACKAGE is available in `package-alist'. (when pkg-vec (setq available-version (package-desc-vers pkg-vec) - found (version-list-<= version available-version))) + found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. ((null found) - (package-built-in-p package version)) + (package-built-in-p package min-version)) ;; If the package is already activated, just return t. ((memq package package-activated-list) t) @@ -512,11 +519,11 @@ Required package `%s-%s' is unavailable" &rest extra-properties) "Define a new package. NAME-STRING is the name of the package, as a string. -VERSION-STRING is the version of the package, as a list of -integers of the form produced by `version-to-list'. +VERSION-STRING is the version of the package, as a string. DOCSTRING is a short description of the package, a string. REQUIREMENTS is a list of dependencies on other packages. -Each requirement is of the form (OTHER-PACKAGE \"VERSION\"). + Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION), + where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-string)) @@ -703,8 +710,8 @@ It will move point to somewhere in the headers." (package-unpack name version)))) (defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of VERSION or newer, is installed. -Built-in packages also qualify." + "Return true if PACKAGE, of MIN-VERSION or newer, is installed. +MIN-VERSION should be a version list." (let ((pkg-desc (assq package package-alist))) (if pkg-desc (version-list-<= min-version @@ -717,9 +724,9 @@ Built-in packages also qualify." PACKAGE-LIST should be a list of package names (symbols). REQUIREMENTS should be a list of additional requirements; each -element in this list should have the form (PACKAGE VERSION), -where PACKAGE is a package name and VERSION is the required -version of that package (as a list). +element in this list should have the form (PACKAGE VERSION-LIST), +where PACKAGE is a package name and VERSION-LIST is the required +version of that package. This function recursively computes the requirements of the packages in REQUIREMENTS, and returns a list of all the packages @@ -890,7 +897,8 @@ The vector has the form [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a requires list, or nil. +REQUIRES is a list of requirements, each requirement having the + form (NAME VER); NAME is a string and VER is a version list. DESCRIPTION is the package description, a string. VERSION is the version, a string. COMMENTARY is the commentary section, a string, or nil if none. @@ -1329,8 +1337,8 @@ Letters do not insert themselves; instead, they are commands. "Convenience macro for `package-menu--generate'. If the alist stored in the symbol LISTNAME lacks an entry for a package PACKAGE with descriptor DESC, add one. The alist is -keyed with cons cells (PACKAGE . VERSION), where PACKAGE is a -symbol and VERSION is a version list." +keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is +a symbol and VERSION-LIST is a version list." `(let* ((version (package-desc-vers ,desc)) (key (cons ,package version))) (unless (assoc key ,listname) From e02f48d76bfd57f014ffbe3ba56b62f2d5ccc794 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Fri, 22 Apr 2011 20:44:26 +0200 Subject: [PATCH 36/77] lisp/progmodes/*.el: Lexical-binding cleanup. --- lisp/ChangeLog | 158 ++++++++++++++++++++++++++++++++ lisp/progmodes/ada-mode.el | 12 +-- lisp/progmodes/ada-prj.el | 24 ++--- lisp/progmodes/ada-xref.el | 4 +- lisp/progmodes/antlr-mode.el | 18 ++-- lisp/progmodes/asm-mode.el | 2 +- lisp/progmodes/bug-reference.el | 2 +- lisp/progmodes/compile.el | 26 +++--- lisp/progmodes/cpp.el | 5 +- lisp/progmodes/dcl-mode.el | 24 ++--- lisp/progmodes/delphi.el | 27 +++--- lisp/progmodes/ebrowse.el | 143 ++++++++++++++--------------- lisp/progmodes/etags.el | 9 +- lisp/progmodes/executable.el | 4 +- lisp/progmodes/flymake.el | 10 +- lisp/progmodes/fortran.el | 2 +- lisp/progmodes/gdb-mi.el | 91 +++++++++--------- lisp/progmodes/glasses.el | 2 +- lisp/progmodes/gud.el | 60 ++++++------ lisp/progmodes/hideif.el | 15 +-- lisp/progmodes/hideshow.el | 7 +- lisp/progmodes/icon.el | 11 +-- lisp/progmodes/js.el | 19 ++-- lisp/progmodes/make-mode.el | 11 +-- lisp/progmodes/octave-inf.el | 5 +- lisp/progmodes/octave-mod.el | 2 +- lisp/progmodes/perl-mode.el | 2 +- lisp/progmodes/prolog.el | 7 +- lisp/progmodes/ps-mode.el | 4 + lisp/progmodes/python.el | 10 +- lisp/progmodes/sh-script.el | 9 +- lisp/progmodes/simula.el | 17 ++-- lisp/progmodes/sql.el | 2 +- lisp/progmodes/tcl.el | 4 +- lisp/progmodes/vera-mode.el | 10 +- lisp/progmodes/xscheme.el | 5 +- 36 files changed, 456 insertions(+), 307 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 118e34b96d3..ed06af250f6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,161 @@ +2011-04-22 Juanma Barranquero + + Lexical-binding cleanup. + + * progmodes/ada-mode.el (ada-after-change-function, ada-loose-case-word) + (ada-no-auto-case, ada-capitalize-word, ada-untab, ada-narrow-to-defun): + * progmodes/ada-prj.el (ada-prj-initialize-values) + (ada-prj-display-page, ada-prj-field-modified, ada-prj-display-help) + (ada-prj-show-value): + * progmodes/ada-xref.el (ada-find-any-references, ada-gdb-application): + * progmodes/antlr-mode.el (antlr-with-displaying-help-buffer) + (antlr-invalidate-context-cache, antlr-options-menu-filter) + (antlr-language-option-extra, antlr-c++-mode-extra, antlr-run-tool): + * progmodes/bug-reference.el (bug-reference-push-button): + * progmodes/fortran.el (fortran-line-length): + * progmodes/glasses.el (glasses-change): + * progmodes/octave-mod.el (octave-fill-paragraph): + * progmodes/python.el (python-mode, python-pdbtrack-track-stack-file) + (python-pdbtrack-grub-for-buffer, python-sentinel): + * progmodes/sql.el (sql-save-connection): + * progmodes/tcl.el (tcl-indent-command, tcl-popup-menu): + * progmodes/xscheme.el (xscheme-enter-debugger-mode): + Mark unused parameters. + + * progmodes/compile.el (compilation--flush-directory-cache) + (compilation--flush-parse, compile-internal): Mark unused parameters. + (compilation-buffer-name): Rename parameter MODE-NAME to NAME-OF-MODE. + (compilation-next-error-function): Remove unused variable `timestamp'. + + * progmodes/cpp.el (cpp-parse-close): Remove unused variable `begin'. + (cpp-signal-read-only, cpp-grow-overlay): Mark unused parameters. + + * progmodes/dcl-mode.el (dcl-end-of-command): + Remove unused variable `start'. + (dcl-calc-command-indent-multiple, dcl-calc-cont-indent-relative) + (dcl-option-value-basic, dcl-option-value-offset) + (dcl-option-value-margin-offset, dcl-option-value-comment-line): + Mark unused parameters. + (dcl-save-local-variable): Remove unused variable `val'. + (mode): Declare. + + * progmodes/delphi.el (delphi-save-state, delphi-after-change): + Mark unused parameters. + (delphi-ignore-changes): Move before first use. + (delphi-charset-token-at): Remove unused variable `start'. + (delphi-else-start): Remove unused variable `if-count'. + (delphi-comment-block-start, delphi-comment-block-end): + Remove unused variable `kind'. + (delphi-indent-line): Remove unused variable `new-point'. + + * progmodes/ebrowse.el (ebrowse-files-list) + (ebrowse-list-of-matching-members, ebrowse-tags-list-members-in-file): + Mark unused parameters. Don't quote `lambda'. + (ebrowse-sort-tree-list, ebrowse-same-tree-member-buffer-list): + Don't quote `lambda'. + (ebrowse-revert-tree-buffer-from-file, ebrowse-tags-choose-class) + (ebrowse-goto-visible-member/all-member-lists): Mark unused parameters. + (ebrowse-create-tree-buffer): Rename parameter OBARRAY to CLASSES. + (ebrowse-toggle-mark-at-point): Remove unused variable `pnt'. + Use `ignore-errors'. + (ebrowse-frozen-tree-buffer-name, ebrowse-find-source-file) + (ebrowse-view/find-file-and-search-pattern) + (ebrowse-view/find-member-declaration/definition): + Rename parameter TAGS-FILE-NAME to TAGS-FILE. + (ebrowse-find-class-declaration, ebrowse-view-class-declaration): + Rename parameter PREFIX-ARG to PREFIX. + (ebrowse-tags-read-name): Remove unused variables `start' and + `member-info'. + (ebrowse-display-member-buffer): Rename variable `tags-file-name' + to `tags-file'. + + * progmodes/etags.el (local-find-tag-hook): Declare. + (tag-partial-file-name-match-p, tag-any-match-p, list-tags): + Mark unused parameters. + + * progmodes/executable.el (compilation-error-regexp-alist): Declare. + (executable-interpret): Mark unused parameter. + + * progmodes/flymake.el (flymake-process-sentinel) + (flymake-after-change-function) + (flymake-create-temp-with-folder-structure) + (flymake-get-include-dirs-dot): Mark unused parameters. + (flymake-safe-delete-directory): Remove unused variable `err'. + + * progmodes/gdb-mi.el (speedbar-change-initial-expansion-list) + (speedbar-timer-fn, speedbar-line-text) + (speedbar-change-expand-button-char, speedbar-delete-subblock) + (speedbar-center-buffer-smartly): Declare functions. + (gdb-find-watch-expression): Remove unused variable `array'. + (gdb-edit-value, gdb-gdb, gdb-ignored-notification, gdb-thread-created) + (gdb-starting): Mark unused parameters. + (gud-gdbmi-marker-filter): Remove unused variable `output-record'. + (gdb-table-string): Remove unused variable `res'. + (gdb-place-breakpoints): Remove unused variables `flag' and `bptno'. + (gdb-disassembly-handler-custom): Remove unused variable `pos'. + (gdb-display-buffer): Remove unused variable `cur-size'. + + * progmodes/gud.el (gud-def): Use `defalias' instead of `defun' to + allow lexical-binding compilation. + (gud-expansion-speedbar-buttons, gud-gdb-goto-stackframe) + (gud-dbx-massage-args, gud-xdb-massage-args, gud-perldb-massage-args) + (gud-jdb-massage-args, gud-jdb-find-source, gud-find-class): + Mark unused parameters. + (gud-gdb-marker-filter): Remove unused variable `match'. + (gud-find-class): Bind `syntax-symbol' and `syntax-point' to suitable + lambda expressions and funcall them, instead of using `fset'. + + * progmodes/hideif.el (hif-parse-if-exp): Rename parameter + HIF-TOKEN-LIST to TOKEN-LIST and let-bind `hif-token-list'. + + * progmodes/hideshow.el (hs-hide-block-at-point): Remove unused + variable `header-beg'; use `let'. + + * progmodes/icon.el (indent-icon-exp): Remove unused variables + `restart', `last-sexp' and `at-do'. + + * progmodes/js.el (js--debug): Mark unused parameter. + (js--parse-state-at-point): Remove unused variable `bound'; use `let'. + (js--splice-into-items): Remove unused variable `item'. + (js--read-symbol, js--read-tab): Pass 1/-1 to `ido-mode', not t/nil. + + * progmodes/make-mode.el (makefile-make-font-lock-keywords): + Rename parameter FONT-LOCK-KEYWORDS to FL-KEYWORDS. + (makefile-complete): Remove unused variable `try'. + (makefile-fill-paragraph, makefile-match-function-end): + Mark unused parameters. + + * progmodes/octave-inf.el (inferior-octave-complete): + Remove unused variable `proc'. + (inferior-octave-output-digest): Mark unused parameter. + + * progmodes/perl-mode.el (perl-calculate-indent): + Remove unused variable `err'. + + * progmodes/prolog.el (prolog-mode-keybindings-inferior) + (prolog-indent-line): Mark unused parameters. + (prolog-indent-line): Remove unused variable `beg'. + + * progmodes/ps-mode.el (reporter-prompt-for-summary-p) + (reporter-dont-compact-list): Declare. + + * progmodes/sh-script.el (sh-font-lock-quoted-subshell): + Remove unused variable `char'. + (sh-debug): Mark unused parameter. + (sh-get-indent-info): Remove unused variable `start'. + (sh-calculate-indent): Remove unused variable `var'. + + * progmodes/simula.el (simula-popup-menu): Mark unused parameter. + (simula-electric-keyword): Remove unused variable `null'. + (simula-search-backward, simula-search-forward): Remove unused + variables `begin' and `end'. + + * progmodes/vera-mode.el (vera-guess-basic-syntax): + Remove unused variable `pos'. + (vera-electric-tab, vera-comment-uncomment-region): + Mark unused parameters. + (vera-electric-tab): Rename parameter PREFIX-ARG to PREFIX. + 2011-04-22 Chong Yidong * emacs-lisp/package.el (package--builtins, package-alist) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index beb737ba613..89a37307506 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -966,7 +966,7 @@ are treated as numbers instead of gnatprep comments." (unless modified (restore-buffer-modified-p nil)))) -(defun ada-after-change-function (beg end old-len) +(defun ada-after-change-function (beg end _old-len) "Called when the region between BEG and END was changed in the buffer. OLD-LEN indicates what the length of the replaced text was." (save-excursion @@ -1675,7 +1675,7 @@ ARG is the prefix the user entered with \\[universal-argument]." '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) -(defun ada-loose-case-word (&optional arg) +(defun ada-loose-case-word (&optional _arg) "Upcase first letter and letters following `_' in the following word. No other letter is modified. ARG is ignored, and is there for compatibility with `capitalize-word' only." @@ -1691,7 +1691,7 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only." (insert-char (upcase (following-char)) 1) (delete-char 1))))) -(defun ada-no-auto-case (&optional arg) +(defun ada-no-auto-case (&optional _arg) "Do nothing. ARG is ignored. This function can be used for the auto-casing variables in Ada mode, to adapt to unusal auto-casing schemes. Since it does nothing, you can for @@ -1700,7 +1700,7 @@ auto-casing for identifiers, whereas keywords have to be lower-cased. See also `ada-auto-case' to disable auto casing altogether." nil) -(defun ada-capitalize-word (&optional arg) +(defun ada-capitalize-word (&optional _arg) "Upcase first letter and letters following '_', lower case other letters. ARG is ignored, and is there for compatibility with `capitalize-word' only." (interactive) @@ -4219,7 +4219,7 @@ of the region. Otherwise, operate only on the current line." ((eq ada-tab-policy 'always-tab) (error "Not implemented")) )) -(defun ada-untab (arg) +(defun ada-untab (_arg) "Delete leading indenting according to `ada-tab-policy'." ;; FIXME: ARG is ignored (interactive "P") @@ -5250,7 +5250,7 @@ Return nil if no body was found." ;; Support for narrow-to-region ;; --------------------------------------------------------- -(defun ada-narrow-to-defun (&optional arg) +(defun ada-narrow-to-defun (&optional _arg) "Make text outside current subprogram invisible. The subprogram visible is the one that contains or follow point. Optional ARG is ignored. diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index dd05ab8f310..a32e22828fc 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -92,7 +92,7 @@ If there is none, opens a new project file." (ada-customize) (ada-prj-new))) -(defun ada-prj-initialize-values (symbol ada-buffer filename) +(defun ada-prj-initialize-values (symbol _ada-buffer filename) "Set SYMBOL to the property list of the project file FILENAME. If FILENAME is null, read the file associated with ADA-BUFFER. If no project file is found, return the default values." @@ -257,19 +257,19 @@ The current buffer must be the project editing buffer." (widget-insert "\n Project configuration.\n ___________ ____________ ____________ ____________ ____________\n / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 1)) "General") + (lambda (&rest _dummy) (ada-prj-display-page 1)) "General") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 2)) "Paths") + (lambda (&rest _dummy) (ada-prj-display-page 2)) "Paths") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 3)) "Switches") + (lambda (&rest _dummy) (ada-prj-display-page 3)) "Switches") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 4)) "Ada Menu") + (lambda (&rest _dummy) (ada-prj-display-page 4)) "Ada Menu") (widget-insert " \\ / ") (widget-create 'push-button :notify - (lambda (&rest dummy) (ada-prj-display-page 5)) "Debugger") + (lambda (&rest _dummy) (ada-prj-display-page 5)) "Debugger") (widget-insert " \\\n") ;; Display the currently selected page @@ -458,15 +458,15 @@ connect to the target when working with cross-environments" t) (widget-insert "______________________________________________________________________\n\n ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (setq ada-prj-current-values (ada-default-prj-properties)) (ada-prj-display-page 1)) "Reset to Default Values") (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest ignore) (kill-buffer nil)) + (widget-create 'push-button :notify (lambda (&rest _ignore) (kill-buffer nil)) "Cancel") (widget-insert " ") - (widget-create 'push-button :notify (lambda (&rest ignore) (ada-prj-save)) + (widget-create 'push-button :notify (lambda (&rest _ignore) (ada-prj-save)) "Save") (widget-insert "\n\n") @@ -546,7 +546,7 @@ converted to a directory name." ada-list "\n")) -(defun ada-prj-field-modified (widget &rest dummy) +(defun ada-prj-field-modified (widget &rest _dummy) "Callback for modification of WIDGET. Remaining args DUMMY are ignored. Save the change in `ada-prj-current-values' so that selecting @@ -556,7 +556,7 @@ another page and coming back keeps the new value." (widget-get widget ':prj-field) (widget-value widget)))) -(defun ada-prj-display-help (widget widget-modified event) +(defun ada-prj-display-help (widget _widget-modified event) "Callback for help button in WIDGET. Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let ((text (widget-get widget 'prj-help))) @@ -572,7 +572,7 @@ Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (concat "*****Help*****\n" text "\n**************\n") (point-at-bol 2))))) -(defun ada-prj-show-value (widget widget-modified event) +(defun ada-prj-show-value (widget _widget-modified event) "Show the current field value in WIDGET. Parameters WIDGET-MODIFIED, EVENT match :notify for the widget." (let* ((field (widget-get widget ':prj-field)) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 85659cafd95..7751f3e98fc 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1043,7 +1043,7 @@ existing buffer `*gnatfind*', if there is one." (setq old-contents (buffer-string)))) (let ((compilation-error "reference")) - (compilation-start command 'compilation-mode (lambda (mode) ada-gnatfind-buffer-name))) + (compilation-start command 'compilation-mode (lambda (_mode) ada-gnatfind-buffer-name))) ;; Hide the "Compilation" menu (with-current-buffer ada-gnatfind-buffer-name @@ -1384,7 +1384,7 @@ project file." ;; Do not add -fullname, since we can have a 'rsh' command in front. ;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef - (fset 'gud-gdb-massage-args (lambda (file args) args)) + (fset 'gud-gdb-massage-args (lambda (_file args) args)) (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator)) (if (not (equal pre-cmd "")) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index c5207139014..d1ff1aead10 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -82,7 +82,7 @@ ;;; Code: -(eval-when-compile +(eval-when-compile (require 'cl)) (require 'easymenu) @@ -93,7 +93,7 @@ (declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg)) ;; General Emacs/XEmacs-compatibility compile-time macros -(eval-when-compile +(eval-when-compile (defmacro cond-emacs-xemacs (&rest args) (cond-emacs-xemacs-macfn args "`cond-emacs-xemacs' must return exactly one element")) @@ -1073,7 +1073,7 @@ Used for `antlr-slow-syntactic-context'.") (read-from-minibuffer prompt initial-input nil nil (or history 'shell-command-history))) -(defunx antlr-with-displaying-help-buffer (thunk &optional name) +(defunx antlr-with-displaying-help-buffer (thunk &optional _name) :xemacs-and-try with-displaying-help-buffer "Make a help buffer and call `thunk' there." (with-output-to-temp-buffer "*Help*" @@ -1092,7 +1092,7 @@ Used for `antlr-slow-syntactic-context'.") ;;;(defvar antlr-statistics-cache 0) ;;;(defvar antlr-statistics-inval 0) -(defunx antlr-invalidate-context-cache (&rest dummies) +(defunx antlr-invalidate-context-cache (&rest _dummies) ;; checkdoc-params: (dummies) "Invalidate context cache for syntactical context information." :XEMACS ; XEmacs bug workaround @@ -1670,7 +1670,7 @@ Return \(LEVEL OPTION LOCATION)." table))) (list level input (cdr kind)))))) -(defun antlr-options-menu-filter (level menu-items) +(defun antlr-options-menu-filter (level _menu-items) "Return items for options submenu of level LEVEL." ;; checkdoc-params: (menu-items) (let ((active (if buffer-read-only @@ -2072,7 +2072,7 @@ Used inside `antlr-options-alists'." nil table '(("false") ("true")))) -(defun antlr-language-option-extra (phase &rest dummies) +(defun antlr-language-option-extra (phase &rest _dummies) ;; checkdoc-params: (dummies) "Change language according to the new value of the \"language\" option. Call `antlr-mode' if the new language would be different from the value @@ -2088,7 +2088,7 @@ Called in PHASE `after-insertion', see `antlr-options-alists'." (antlr-mode) (and font-lock (null font-lock-mode) (font-lock-mode 1))))))) -(defun antlr-c++-mode-extra (phase option &rest dummies) +(defun antlr-c++-mode-extra (phase option &rest _dummies) ;; checkdoc-params: (option dummies) "Warn if C++ option is used with the wrong language. Ask user \(\"y or n\"), if a C++ only option is going to be inserted but @@ -2260,7 +2260,7 @@ called interactively, the buffers are always saved, see also variable (or saved (save-some-buffers (not antlr-ask-about-save))) (let ((default-directory (file-name-directory file))) (compilation-start (concat command " " (file-name-nondirectory file)) - nil #'(lambda (mode-name) "*Antlr-Run*")))) + nil (lambda (_mode-name) "*Antlr-Run*")))) (defun antlr-run-tool-interactive () ;; code in `interactive' is not compiled @@ -2592,7 +2592,7 @@ the default language." ;; FIXME: Since it uses cc-mode, it bumps into c-update-modeline's ;; limitation to mode-name being a string. ;; '("Antlr." (:eval (cadr (assq antlr-language antlr-language-alist)))) - "Antlr" + "Antlr" "Major mode for editing ANTLR grammar files." :abbrev-table antlr-mode-abbrev-table (c-initialize-cc-mode) ; cc-mode is required diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 9d79d22d42e..3ac8b119fe1 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -90,7 +90,7 @@ "Keymap for Asm mode.") (defconst asm-font-lock-keywords - (append + (append '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\(\\.\\sw+\\)*\\)?" (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t)) ;; label started from ".". diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 4d78047268f..8ec379afab2 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -109,7 +109,7 @@ so that it is considered safe, see `enable-local-variables'.") (funcall bug-reference-url-format)))))))))) ;; Taken from button.el. -(defun bug-reference-push-button (&optional pos use-mouse-action) +(defun bug-reference-push-button (&optional pos _use-mouse-action) "Open URL corresponding to the bug reference at POS." (interactive (list (if (integerp last-command-event) (point) last-command-event))) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 40383c6bc31..ec0830b3b1b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -833,7 +833,7 @@ returned RES, i.e. there is no change of `compilation-directory' between POS and RES.") (make-variable-buffer-local 'compilation--previous-directory-cache) -(defun compilation--flush-directory-cache (start end) +(defun compilation--flush-directory-cache (start _end) (cond ((or (not compilation--previous-directory-cache) (<= (car compilation--previous-directory-cache) start))) @@ -1307,7 +1307,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (compilation--parse-region (point) compilation--parsed))))) nil) -(defun compilation--flush-parse (start end) +(defun compilation--flush-parse (start _end) "Mark the region between START and END for re-parsing." (if (markerp compilation--parsed) (move-marker compilation--parsed (min start compilation--parsed)))) @@ -1399,31 +1399,31 @@ point on its location in the *compilation* buffer." :group 'compilation) -(defun compilation-buffer-name (mode-name mode-command name-function) +(defun compilation-buffer-name (name-of-mode mode-command name-function) "Return the name of a compilation buffer to use. -If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME +If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE to determine the buffer name. Likewise if `compilation-buffer-name-function' is non-nil. If current buffer has the major mode MODE-COMMAND, return the name of the current buffer, so that it gets reused. -Otherwise, construct a buffer name from MODE-NAME." +Otherwise, construct a buffer name from NAME-OF-MODE." (cond (name-function - (funcall name-function mode-name)) + (funcall name-function name-of-mode)) (compilation-buffer-name-function - (funcall compilation-buffer-name-function mode-name)) + (funcall compilation-buffer-name-function name-of-mode)) ((eq mode-command major-mode) (buffer-name)) (t - (concat "*" (downcase mode-name) "*")))) + (concat "*" (downcase name-of-mode) "*")))) ;; This is a rough emulation of the old hack, until the transition to new ;; compile is complete. (defun compile-internal (command error-message - &optional name-of-mode parser + &optional _name-of-mode parser error-regexp-alist name-function - enter-regexp-alist leave-regexp-alist - file-regexp-alist nomessage-regexp-alist - no-async highlight-regexp local-map) + _enter-regexp-alist _leave-regexp-alist + file-regexp-alist _nomessage-regexp-alist + _no-async highlight-regexp _local-map) (if parser (error "Compile now works very differently, see `compilation-error-regexp-alist'")) (let ((compilation-error-regexp-alist @@ -2229,7 +2229,7 @@ This is the value of `next-error-function' in Compilation buffers." (when reset (setq compilation-current-error nil)) (let* ((columns compilation-error-screen-columns) ; buffer's local value - (last 1) timestamp + (last 1) (msg (compilation-next-error (or n 1) nil (or compilation-current-error compilation-messages-start diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index d7b8b0e8748..a8f01705e2d 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -308,7 +308,6 @@ A prefix arg suppresses display of that buffer." ;; Pop top of cpp-state-stack and create overlay. (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list)) (branch (nth 0 (car cpp-state-stack))) - (begin (nth 2 (car cpp-state-stack))) (end (nth 3 (car cpp-state-stack)))) (setq cpp-state-stack (cdr cpp-state-stack)) (if entry @@ -398,7 +397,7 @@ A prefix arg suppresses display of that buffer." (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay)) (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay))) -(defun cpp-signal-read-only (overlay after start end &optional len) +(defun cpp-signal-read-only (overlay after start end &optional _len) ;; Only allow deleting the whole overlay. ;; Trying to change a read-only overlay. (if (and (not after) @@ -406,7 +405,7 @@ A prefix arg suppresses display of that buffer." (> (overlay-end overlay) end))) (error "This text is read only"))) -(defun cpp-grow-overlay (overlay after start end &optional len) +(defun cpp-grow-overlay (overlay after start end &optional _len) ;; Make OVERLAY grow to contain range START to END. (if after (move-overlay overlay diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 902848ef007..b4094914d61 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -662,8 +662,7 @@ There is some minimal font-lock support (see vars (defun dcl-end-of-command () "Move point to end of current command or next command if not on a command." (interactive) - (let ((type (dcl-get-line-type)) - (start (point))) + (let ((type (dcl-get-line-type))) (if (or (eq type '$) (eq type '-)) (progn @@ -941,7 +940,7 @@ Returns one of the following symbols: ;;;--------------------------------------------------------------------------- (defun dcl-calc-command-indent-multiple - (indent-type cur-indent extra-indent last-point this-point) + (indent-type cur-indent extra-indent _last-point _this-point) "Indent lines to a multiple of dcl-basic-offset. Set dcl-calc-command-indent-function to this function to customize @@ -1185,7 +1184,7 @@ The indent-type classification could probably be expanded upon. ;;;--------------------------------------------------------------------------- -(defun dcl-calc-cont-indent-relative (cur-indent extra-indent) +(defun dcl-calc-cont-indent-relative (_cur-indent _extra-indent) "Indent continuation lines to align with words on previous line. Indent continuation lines to a position relative to preceding @@ -1540,7 +1539,7 @@ Also remove the continuation mark if easily detected." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-basic (option-assoc) +(defun dcl-option-value-basic (_option-assoc) "Guess a value for basic-offset." (save-excursion (dcl-beginning-of-command) @@ -1575,7 +1574,7 @@ Also remove the continuation mark if easily detected." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-offset (option-assoc) +(defun dcl-option-value-offset (_option-assoc) "Guess a value for an offset. Find the column of the first non-blank character on the line. Returns the column offset." @@ -1586,7 +1585,7 @@ Returns the column offset." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-margin-offset (option-assoc) +(defun dcl-option-value-margin-offset (_option-assoc) "Guess a value for margin offset. Find the column of the first non-blank character on the line, not counting labels. @@ -1598,7 +1597,7 @@ Returns a number as a string." ;;;------------------------------------------------------------------------- -(defun dcl-option-value-comment-line (option-assoc) +(defun dcl-option-value-comment-line (_option-assoc) "Guess a value for `dcl-comment-line-regexp'. Must return a string." ;; Should we set comment-start and comment-start-skip as well? @@ -1789,8 +1788,7 @@ Set or update the value of VAR in the current buffers (if (eolp) (error "Missing colon in local variables entry")) (skip-chars-backward " \t") (let* ((str (buffer-substring beg (point))) - (found-var (read str)) - val) + (found-var (read str))) ;; Setting variable named "end" means end of list. (if (string-equal (downcase str) "end") (progn @@ -1895,6 +1893,10 @@ section at the end of the current buffer." ;;;------------------------------------------------------------------------- +(with-no-warnings + ;; Dynamically bound in `dcl-save-mode'. + (defvar mode)) + (defun dcl-save-mode () "Save the current mode for this buffer. Save the current mode in a `Local Variables:' @@ -1902,7 +1904,7 @@ section at the end of the current buffer." (interactive) (let ((mode (prin1-to-string major-mode))) (if (string-match "-mode$" mode) - (let ((mode (intern (substring mode 0 (match-beginning 0))))) + (let ((mode (intern (substring mode 0 (match-beginning 0))))) (dcl-save-option 'mode)) (message "Strange mode: %s" mode)))) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index 0f823c806e0..c809079381f 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -328,7 +328,7 @@ routine.") (after-change-functions nil) (modified (buffer-modified-p))) ;; Disable any queries about editing obsolete files. - (fset 'ask-user-about-supersession-threat (lambda (fn))) + (fset 'ask-user-about-supersession-threat (lambda (_fn))) (unwind-protect (progn ,@forms) (set-buffer-modified-p modified) @@ -444,6 +444,12 @@ routine.") (goto-char curr-point) next)) +(defvar delphi-ignore-changes t + "Internal flag to control if the Delphi mode responds to buffer changes. +Defaults to t in case the `delphi-after-change' function is called on a +non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: + (let ((delphi-ignore-changes t)) ...)") + (defun delphi-set-text-properties (from to properties) ;; Like `set-text-properties', except we do not consider this to be a buffer ;; modification. @@ -590,7 +596,6 @@ routine.") ;; character set. (let ((currp (point)) (end nil) - (start nil) (token nil)) (goto-char p) (when (> (skip-chars-forward charset) 0) @@ -720,13 +725,7 @@ routine.") (delphi-step-progress p "Fontifying" delphi-fontifying-progress-step)) (delphi-progress-done))))) -(defvar delphi-ignore-changes t - "Internal flag to control if the Delphi mode responds to buffer changes. -Defaults to t in case the `delphi-after-change' function is called on a -non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: - (let ((delphi-ignore-changes t)) ...)") - -(defun delphi-after-change (change-start change-end old-length) +(defun delphi-after-change (change-start change-end _old-length) ;; Called when the buffer has changed. Reparses the changed region. (unless delphi-ignore-changes (let ((delphi-ignore-changes t)) ; Prevent recursive calls. @@ -922,8 +921,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: ;; Returns the token of the if or case statement. (let ((token (delphi-previous-token from-else)) (token-kind nil) - (semicolon-count 0) - (if-count 0)) + (semicolon-count 0)) (catch 'done (while token (setq token-kind (delphi-token-kind token)) @@ -971,8 +969,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: comment ;; Scan until we run out of // comments. (let ((prev-comment comment) - (start-comment comment) - (kind nil)) + (start-comment comment)) (while (let ((kind (delphi-token-kind prev-comment))) (cond ((eq kind 'space)) ((eq kind 'comment-single-line) @@ -989,8 +986,7 @@ non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: comment ;; Scan until we run out of // comments. (let ((next-comment comment) - (end-comment comment) - (kind nil)) + (end-comment comment)) (while (let ((kind (delphi-token-kind next-comment))) (cond ((eq kind 'space)) ((eq kind 'comment-single-line) @@ -1527,7 +1523,6 @@ If before the indent, the point is moved to the indent." (interactive) (delphi-save-match-data (let ((marked-point (point-marker)) ; Maintain our position reliably. - (new-point nil) (line-start nil) (old-indent 0) (new-indent 0)) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 87e5875c943..d31a46cc308 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -736,7 +736,7 @@ MARKED-ONLY non-nil means include marked classes only." "Return a list containing all files mentioned in a tree. MARKED-ONLY non-nil means include marked classes only." (let (list) - (maphash #'(lambda (file dummy) (setq list (cons file list))) + (maphash (lambda (file _dummy) (setq list (cons file list))) (ebrowse-files-table marked-only)) list)) @@ -784,9 +784,9 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." (defun ebrowse-sort-tree-list (list) "Sort a LIST of `ebrowse-ts' structures by qualified class names." (sort list - #'(lambda (a b) - (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) - (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) + (lambda (a b) + (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) + (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) (defun ebrowse-class-in-tree (class tree) @@ -923,7 +923,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree." (list header tree))) -(defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm) +(defun ebrowse-revert-tree-buffer-from-file (_ignore-auto-save noconfirm) "Function installed as `revert-buffer-function' in tree buffers. See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and NOCONFIRM." @@ -937,11 +937,11 @@ NOCONFIRM." (current-buffer))) -(defun ebrowse-create-tree-buffer (tree tags-file header obarray pop) +(defun ebrowse-create-tree-buffer (tree tags-file header classes pop) "Create a new tree buffer for tree TREE. The tree was loaded from file TAGS-FILE. HEADER is the header structure of the file. -OBARRAY is an obarray with a symbol for each class in the tree. +CLASSES is an obarray with a symbol for each class in the tree. POP non-nil means popup the buffer up at the end. Return the buffer created." (let ((name ebrowse-tree-buffer-name)) @@ -949,7 +949,7 @@ Return the buffer created." (ebrowse-tree-mode) (setq ebrowse--tree tree ebrowse--tags-file-name tags-file - ebrowse--tree-obarray obarray + ebrowse--tree-obarray classes ebrowse--header header ebrowse--frozen-flag nil) (ebrowse-redraw-tree) @@ -1215,17 +1215,16 @@ Do not ask for confirmation if FORCED is non-nil." "Toggle mark for class cursor is on. If given a numeric N-TIMES argument, mark that many classes." (interactive "p") - (let (to-change pnt) + (let (to-change) ;; Get the classes whose mark must be toggled. Note that ;; ebrowse-tree-at-point might issue an error. - (condition-case error - (loop repeat (or n-times 1) - as tree = (ebrowse-tree-at-point) - do (progn - (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) - (forward-line 1) - (push tree to-change))) - (error nil)) + (ignore-errors + (loop repeat (or n-times 1) + as tree = (ebrowse-tree-at-point) + do (progn + (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) + (forward-line 1) + (push tree to-change)))) (save-excursion ;; For all these classes, reverse the mark char in the display ;; by a regexp replace over the whole buffer. The reason for this @@ -1376,9 +1375,9 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." (ebrowse-delete-if-not - #'(lambda (buffer) - (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) - ebrowse--tree)) + (lambda (buffer) + (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) + ebrowse--tree)) (ebrowse-member-buffer-list))) @@ -1417,9 +1416,9 @@ If no member buffer exists, make one." when (eq class tree) do (kill-buffer buffer))) -(defun ebrowse-frozen-tree-buffer-name (tags-file-name) - "Return the buffer name of a tree which is associated TAGS-FILE-NAME." - (concat ebrowse-tree-buffer-name " (" tags-file-name ")")) +(defun ebrowse-frozen-tree-buffer-name (tags-file) + "Return the buffer name of a tree which is associated TAGS-FILE." + (concat ebrowse-tree-buffer-name " (" tags-file ")")) (defun ebrowse-pop-to-browser-buffer (arg) @@ -1545,41 +1544,41 @@ VIEW non-nil means view it. WHERE is additional position info." where))) -(defun ebrowse-find-class-declaration (prefix-arg) +(defun ebrowse-find-class-declaration (prefix) "Find a class declaration and position cursor on it. -PREFIX-ARG 4 means find it in another window. -PREFIX-ARG 5 means find it in another frame." +PREFIX 4 means find it in another window. +PREFIX 5 means find it in another frame." (interactive "p") (ebrowse-view/find-class-declaration :view nil - :where (cond ((= prefix-arg 4) 'other-window) - ((= prefix-arg 5) 'other-frame) - (t 'this-window)))) + :where (cond ((= prefix 4) 'other-window) + ((= prefix 5) 'other-frame) + (t 'this-window)))) -(defun ebrowse-view-class-declaration (prefix-arg) +(defun ebrowse-view-class-declaration (prefix) "View class declaration and position cursor on it. -PREFIX-ARG 4 means view it in another window. -PREFIX-ARG 5 means view it in another frame." +PREFIX 4 means view it in another window. +PREFIX 5 means view it in another frame." (interactive "p") (ebrowse-view/find-class-declaration :view 'view - :where (cond ((= prefix-arg 4) 'other-window) - ((= prefix-arg 5) 'other-frame) - (t 'this-window)))) + :where (cond ((= prefix 4) 'other-window) + ((= prefix 5) 'other-frame) + (t 'this-window)))) ;;; The FIND engine -(defun ebrowse-find-source-file (file tags-file-name) +(defun ebrowse-find-source-file (file tags-file) "Find source file FILE. -Source files are searched for (a) relative to TAGS-FILE-NAME +Source files are searched for (a) relative to TAGS-FILE which is the path of the BROWSE file from which the class tree was loaded, and (b) in the directories named in `ebrowse-search-path'." (let (file-name (try-file (expand-file-name file - (file-name-directory tags-file-name)))) + (file-name-directory tags-file)))) (if (file-readable-p try-file) (setq file-name try-file) (let ((search-in ebrowse-search-path)) @@ -1629,7 +1628,7 @@ The new frame is deleted when you quit viewing the file in that frame." 'ebrowse-view-exit-fn))) (defun ebrowse-view/find-file-and-search-pattern - (struc info file tags-file-name &optional view where) + (struc info file tags-file &optional view where) "Find or view a member or class. STRUC is an `ebrowse-bs' structure (or a structure including that) describing what to search. @@ -1641,7 +1640,7 @@ if MEMBER-OR-CLASS is an `ebrowse-ms'. FILE is the file to search the member in. FILE is not taken out of STRUC here because the filename in STRUC may be nil in which case the filename of the class description is used. -TAGS-FILE-NAME is the name of the BROWSE file from which the +TAGS-FILE is the name of the BROWSE file from which the tree was loaded. If VIEW is non-nil, view file else find the file. WHERE is either `other-window', `other-frame' or `this-window' and @@ -1650,7 +1649,7 @@ specifies where to find/view the result." (error "Sorry, no file information available for %s" (ebrowse-bs-name struc))) ;; Get the source file to view or find. - (setf file (ebrowse-find-source-file file tags-file-name)) + (setf file (ebrowse-find-source-file file tags-file)) ;; If current window is dedicated, use another frame. (when (window-dedicated-p (selected-window)) (setf where 'other-window)) @@ -2538,7 +2537,7 @@ find file in another frame." (defun* ebrowse-view/find-member-declaration/definition - (prefix view &optional definition info header tags-file-name) + (prefix view &optional definition info header tags-file) "Find or view a member declaration or definition. With PREFIX 4. find file in another window, with prefix 5 find file in another frame. @@ -2546,11 +2545,11 @@ DEFINITION non-nil means find the definition, otherwise find the declaration. INFO is a list (TREE ACCESSOR MEMBER) describing the member to search. -TAGS-FILE-NAME is the file name of the BROWSE file." +TAGS-FILE is the file name of the BROWSE file." (unless header (setq header ebrowse--header)) - (unless tags-file-name - (setq tags-file-name ebrowse--tags-file-name)) + (unless tags-file + (setq tags-file ebrowse--tags-file-name)) (let (tree member accessor file on-class (where (if (= prefix 4) 'other-window (if (= prefix 5) 'other-frame 'this-window)))) @@ -2570,7 +2569,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." (ebrowse-ts-class tree) (list ebrowse--header (ebrowse-ts-class tree) nil) (ebrowse-cs-file (ebrowse-ts-class tree)) - tags-file-name view where))) + tags-file view where))) ;; For some member lists, it doesn't make sense to search for ;; a definition. If this is requested, silently search for the ;; declaration. @@ -2607,7 +2606,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." (message nil) ;; Recurse with new info. (ebrowse-view/find-member-declaration/definition - prefix view (not definition) info header tags-file-name)) + prefix view (not definition) info header tags-file)) (error "Search canceled")) ;; Find that thing. (ebrowse-view/find-file-and-search-pattern @@ -2618,7 +2617,7 @@ TAGS-FILE-NAME is the file name of the BROWSE file." :point (ebrowse-ms-point member)) (list header member accessor) file - tags-file-name + tags-file view where)))) @@ -2677,7 +2676,7 @@ LIST is the member list to display. STAND-ALONE non-nil means the member buffer is standalone. CLASS is its class." (let* ((classes ebrowse--tree-obarray) (tree ebrowse--tree) - (tags-file-name ebrowse--tags-file-name) + (tags-file ebrowse--tags-file-name) (header ebrowse--header) temp-buffer-setup-hook (temp-buffer (get-buffer ebrowse-member-buffer-name))) @@ -2697,7 +2696,7 @@ means the member buffer is standalone. CLASS is its class." ebrowse--accessor list ebrowse--tree-obarray classes ebrowse--frozen-flag stand-alone - ebrowse--tags-file-name tags-file-name + ebrowse--tags-file-name tags-file ebrowse--header header ebrowse--tree tree buffer-read-only t) @@ -2849,7 +2848,7 @@ is nil." ;;; Switching member buffer to display a selected member -(defun ebrowse-goto-visible-member/all-member-lists (prefix) +(defun ebrowse-goto-visible-member/all-member-lists (_prefix) "Position cursor on a member read from the minibuffer. With PREFIX, search all members in the tree. Otherwise consider only members visible in the buffer." @@ -3279,7 +3278,7 @@ HEADER is the `ebrowse-hs' structure of the class tree. Prompt with PROMPT. Insert into the minibuffer a C++ identifier read from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (save-excursion - (let* (start member-info (members (ebrowse-member-table header))) + (let ((members (ebrowse-member-table header))) (multiple-value-bind (class-name member-name) (values-list (ebrowse-tags-read-member+class-name)) (unless member-name @@ -3290,7 +3289,7 @@ from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (completion-result (try-completion name members))) ;; Cannot rely on `try-completion' returning t for exact ;; matches! It returns the name as a string. - (unless (setq member-info (gethash name members)) + (unless (gethash name members) (if (y-or-n-p "No exact match found. Try substrings? ") (setq name (or (first (ebrowse-list-of-matching-members @@ -3316,7 +3315,7 @@ MEMBER-NAME is the name of the member found." (list class name)))) -(defun ebrowse-tags-choose-class (tree header name initial-class-name) +(defun ebrowse-tags-choose-class (_tree header name initial-class-name) "Read a class name for a member from the minibuffer. TREE is the class tree we operate on. HEADER is its header structure. @@ -3354,7 +3353,7 @@ definition." info) (unless name (multiple-value-setq (class-name name) - (values-list + (values-list (ebrowse-tags-read-name header (concat (if view "View" "Find") " member " @@ -3481,7 +3480,7 @@ Otherwise read a member name from point." (let* ((marker (point-marker)) class-name (name fix-name) info) (unless name (multiple-value-setq (class-name name) - (values-list + (values-list (ebrowse-tags-read-name header (concat "Find member list of: "))))) (setq info (ebrowse-tags-choose-class tree header name class-name)) @@ -3495,10 +3494,10 @@ Both NAME and REGEXP may be nil in which case exact or regexp matches are not performed." (let (list) (when (or name regexp) - (maphash #'(lambda (member-name info) - (when (or (and name (string= name member-name)) - (and regexp (string-match regexp member-name))) - (setq list (cons member-name list)))) + (maphash (lambda (member-name _info) + (when (or (and name (string= name member-name)) + (and regexp (string-match regexp member-name))) + (setq list (cons member-name list)))) members)) list)) @@ -3535,18 +3534,18 @@ The file name is read from the minibuffer." (with-output-to-temp-buffer (concat "*Members in file " file "*") (set-buffer standard-output) (maphash - #'(lambda (member-name list) - (loop for info in list - as member = (third info) - as class = (ebrowse-ts-class (first info)) - when (or (and (null (ebrowse-ms-file member)) - (string= (ebrowse-cs-file class) file)) - (string= file (ebrowse-ms-file member))) - do (ebrowse-draw-file-member-info info "decl.") - when (or (and (null (ebrowse-ms-definition-file member)) - (string= (ebrowse-cs-source-file class) file)) - (string= file (ebrowse-ms-definition-file member))) - do (ebrowse-draw-file-member-info info "defn."))) + (lambda (_member-name list) + (loop for info in list + as member = (third info) + as class = (ebrowse-ts-class (first info)) + when (or (and (null (ebrowse-ms-file member)) + (string= (ebrowse-cs-file class) file)) + (string= file (ebrowse-ms-file member))) + do (ebrowse-draw-file-member-info info "decl.") + when (or (and (null (ebrowse-ms-definition-file member)) + (string= (ebrowse-cs-source-file class) file)) + (string= file (ebrowse-ms-definition-file member))) + do (ebrowse-draw-file-member-info info "defn."))) members)))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index d22d03fbe96..49a2971a92a 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -263,7 +263,7 @@ One argument, the tag info returned by `snarf-tag-function'.") (defun initialize-new-tags-table () "Initialize the tags table in the current buffer. Return non-nil if it is a valid tags table, and -in that case, also make the tags table state variables +in that case, also make the tags table state variables buffer-local and set them to nil." (set (make-local-variable 'tags-table-files) nil) (set (make-local-variable 'tags-completion-table) nil) @@ -853,6 +853,7 @@ The functions using this are `find-tag-noselect', ;; Dynamic bondage: (defvar etags-case-fold-search) (defvar etags-syntax-table) +(defvar local-find-tag-hook) ;;;###autoload (defun find-tag-noselect (tagname &optional next-p regexp-p) @@ -1656,7 +1657,7 @@ Point should be just after a string that matches TAG." ;; partial file name match, i.e. searched tag must match a substring ;; of the file name (potentially including a directory separator). -(defun tag-partial-file-name-match-p (tag) +(defun tag-partial-file-name-match-p (_tag) "Return non-nil if current tag matches file name. This is a substring match, and it can include directory separators. Point should be just after a string that matches TAG." @@ -1666,7 +1667,7 @@ Point should be just after a string that matches TAG." (looking-at "\f\n")))) ;; t if point is in a tag line with a tag containing TAG as a substring. -(defun tag-any-match-p (tag) +(defun tag-any-match-p (_tag) "Return non-nil if current tag line contains TAG as a substring." (looking-at ".*\177")) @@ -1906,7 +1907,7 @@ See also the documentation of the variable `tags-file-name'." (try-completion string (tags-table-files) predicate)))) ;;;###autoload -(defun list-tags (file &optional next-match) +(defun list-tags (file &optional _next-match) "Display list of tags in file FILE. This searches only the first table in the list, and no included tables. FILE should be as it appeared in the `etags' command, usually without a diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index 9313df9f587..d8133cb6b90 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -173,6 +173,8 @@ non-executable files." (file-modes buffer-file-name))))))) +(defvar compilation-error-regexp-alist) ; from compile.el + ;;;###autoload (defun executable-interpret (command) "Run script with user-specified args, and collect output in a buffer. @@ -186,7 +188,7 @@ command to find the next error. The buffer is also in `comint-mode' and (save-some-buffers (not compilation-ask-about-save)) (set (make-local-variable 'executable-command) command) (let ((compilation-error-regexp-alist executable-error-regexp-alist)) - (compilation-start command t (lambda (x) "*interpretation*")))) + (compilation-start command t (lambda (_x) "*interpretation*")))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 16c099d0127..6200591fbbb 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -596,7 +596,7 @@ It's flymake process filter." (with-current-buffer source-buffer (flymake-parse-output-and-residual output))))) -(defun flymake-process-sentinel (process event) +(defun flymake-process-sentinel (process _event) "Sentinel for syntax check buffers." (when (memq (process-status process) '(signal exit)) (let* ((exit-status (process-exit-status process)) @@ -1110,7 +1110,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-log 1 "deleted file %s" file-name))) (defun flymake-safe-delete-directory (dir-name) - (condition-case err + (condition-case nil (progn (delete-directory dir-name) (flymake-log 1 "deleted dir %s" dir-name)) @@ -1386,7 +1386,7 @@ With arg, turn Flymake mode on if and only if arg is positive." :group 'flymake :type 'boolean) -(defun flymake-after-change-function (start stop len) +(defun flymake-after-change-function (start stop _len) "Start syntax check for current buffer if it isn't already running." ;;+(flymake-log 0 "setting change time to %s" (flymake-float-time)) (let((new-text (buffer-substring start stop))) @@ -1496,7 +1496,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) temp-name)) -(defun flymake-create-temp-with-folder-structure (file-name prefix) +(defun flymake-create-temp-with-folder-structure (file-name _prefix) (unless (stringp file-name) (error "Invalid file-name")) @@ -1763,7 +1763,7 @@ Use CREATE-TEMP-F for creating temp copy." (when temp-master-file-name (flymake-get-tex-args temp-master-file-name)))) -(defun flymake-get-include-dirs-dot (base-dir) +(defun flymake-get-include-dirs-dot (_base-dir) '(".")) ;;;; xml-specific init-cleanup routines diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 67a214977b1..7c305ec3f6e 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -291,7 +291,7 @@ buffer). This corresponds to the g77 compiler option :type 'integer :safe 'integerp :initialize 'custom-initialize-default - :set (lambda (symbol value) + :set (lambda (_symbol value) ;; Do all fortran buffers, and the default. (fortran-line-length value t)) :version "23.1" diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 6aece579d5d..c2ee1a93389 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -104,6 +104,13 @@ (require 'bindat) (eval-when-compile (require 'cl)) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) +(declare-function speedbar-timer-fn "speedbar" ()) +(declare-function speedbar-line-text "speedbar" (&optional p)) +(declare-function speedbar-change-expand-button-char "speedbar" (char)) +(declare-function speedbar-delete-subblock "speedbar" (indent)) +(declare-function speedbar-center-buffer-smartly "speedbar" ()) + (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) (defvar speedbar-frame) @@ -544,7 +551,7 @@ the list) is deleted every time a new one is added (at the front)." (defun gdb-find-watch-expression () (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) - (varnum (car var)) expr array) + (varnum (car var)) expr) (string-match "\\(var[0-9]+\\)\\.\\(.*\\)" varnum) (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet (component-list (split-string (match-string 2 varnum) "\\." t))) @@ -1151,7 +1158,7 @@ With arg, enter name of variable to be watched in the minibuffer." (gdb-input (list (concat "-var-delete -c " varnum) 'ignore))) -(defun gdb-edit-value (text token indent) +(defun gdb-edit-value (_text _token _indent) "Assign a value to a variable displayed in the speedbar." (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) (varnum (car var)) (value)) @@ -1820,7 +1827,7 @@ is running." ;; Start accumulating output for the GUD buffer (setq gdb-filter-output "") - (let ((output-record) (output-record-list)) + (let (output-record-list) ;; Process all the complete markers in this chunk. (dolist (gdbmi-record gdbmi-record-list) @@ -1860,17 +1867,17 @@ is running." gdb-filter-output)) -(defun gdb-gdb (output-field)) +(defun gdb-gdb (_output-field)) (defun gdb-shell (output-field) (let ((gdb-output-sink gdb-output-sink)) (setq gdb-filter-output (concat output-field gdb-filter-output)))) -(defun gdb-ignored-notification (output-field)) +(defun gdb-ignored-notification (_output-field)) ;; gdb-invalidate-threads is defined to accept 'update-threads signal -(defun gdb-thread-created (output-field)) +(defun gdb-thread-created (_output-field)) (defun gdb-thread-exited (output-field) "Handle =thread-exited async record: unset `gdb-thread-number' if current thread exited and update threads list." @@ -1918,7 +1925,7 @@ Sets `gdb-thread-number' to new id." (setq gdb-active-process t) (gdb-emit-signal gdb-buf-publisher 'update-threads)) -(defun gdb-starting (output-field) +(defun gdb-starting (_output-field) ;; CLI commands don't emit ^running at the moment so use gdb-running too. (setq gdb-inferior-status "running") (gdb-force-mode-line-update @@ -2219,8 +2226,7 @@ calling `gdb-table-string'." (defun gdb-table-string (table &optional sep) "Return TABLE as a string with columns separated with SEP." - (let ((column-sizes (gdb-table-column-sizes table)) - (res "")) + (let ((column-sizes (gdb-table-column-sizes table))) (mapconcat 'identity (gdb-mapcar* @@ -2375,38 +2381,37 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). (defun gdb-place-breakpoints () - (let ((flag) (bptno)) - ;; Remove all breakpoint-icons in source buffers but not assembler buffer. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (if (and (eq gud-minor-mode 'gdbmi) - (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) - (gdb-remove-breakpoint-icons (point-min) (point-max))))) - (dolist (breakpoint gdb-breakpoints-list) - (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is - ; an associative list - (line (bindat-get-field breakpoint 'line))) - (when line - (let ((file (bindat-get-field breakpoint 'fullname)) - (flag (bindat-get-field breakpoint 'enabled)) - (bptno (bindat-get-field breakpoint 'number))) - (unless (file-exists-p file) - (setq file (cdr (assoc bptno gdb-location-alist)))) - (if (and file - (not (string-equal file "File not found"))) - (with-current-buffer - (find-file-noselect file 'nowarn) - (gdb-init-buffer) - ;; Only want one breakpoint icon at each location. - (gdb-put-breakpoint-icon (string-equal flag "y") bptno - (string-to-number line))) - (gdb-input - (list (concat "list " file ":1") - 'ignore)) - (gdb-input - (list "-file-list-exec-source-file" - `(lambda () (gdb-get-location - ,bptno ,line ,flag))))))))))) + ;; Remove all breakpoint-icons in source buffers but not assembler buffer. + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (if (and (eq gud-minor-mode 'gdbmi) + (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name)))) + (gdb-remove-breakpoint-icons (point-min) (point-max))))) + (dolist (breakpoint gdb-breakpoints-list) + (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is + ; an associative list + (line (bindat-get-field breakpoint 'line))) + (when line + (let ((file (bindat-get-field breakpoint 'fullname)) + (flag (bindat-get-field breakpoint 'enabled)) + (bptno (bindat-get-field breakpoint 'number))) + (unless (file-exists-p file) + (setq file (cdr (assoc bptno gdb-location-alist)))) + (if (and file + (not (string-equal file "File not found"))) + (with-current-buffer + (find-file-noselect file 'nowarn) + (gdb-init-buffer) + ;; Only want one breakpoint icon at each location. + (gdb-put-breakpoint-icon (string-equal flag "y") bptno + (string-to-number line))) + (gdb-input + (list (concat "list " file ":1") + 'ignore)) + (gdb-input + (list "-file-list-exec-source-file" + `(lambda () (gdb-get-location + ,bptno ,line ,flag)))))))))) (defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") @@ -3276,7 +3281,6 @@ DOC is an optional documentation string." (defun gdb-disassembly-handler-custom () (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns)) (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) - (pos 1) (table (make-gdb-table)) (marked-line nil)) (dolist (instr instructions) @@ -3806,8 +3810,7 @@ already, in which case that window is splitted first." (let ((window (get-lru-window))) (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window)) 'gdbmi) - (let* ((largest (get-largest-window)) - (cur-size (window-height largest))) + (let ((largest (get-largest-window))) (setq answer (split-window largest)) (set-window-buffer answer buf) (set-window-dedicated-p answer dedicated) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index a1dc19da1ed..0d9359caa77 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -290,7 +290,7 @@ recognized according to the current value of the variable `glasses-separator'." nil) -(defun glasses-change (beg end &optional old-len) +(defun glasses-change (beg end &optional _old-len) "After-change function updating glass overlays." (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position))) (end-line (save-excursion (goto-char end) (line-end-position)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e81f4ca949b..74bdc980e8b 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -379,13 +379,13 @@ step (if we're in the GUD buffer). source file) or the source line number at the last break or step (if we're in the GUD buffer)." `(progn - (defun ,func (arg) + (defalias ',func (lambda (arg) ,@(if doc (list doc)) (interactive "p") (if (not gud-running) ,(if (stringp cmd) `(gud-call ,cmd arg) - cmd))) + cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) ',func)) ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func)))) @@ -491,7 +491,7 @@ The value t means that there is no stack, and we are in display-file mode.") (gud-install-speedbar-variables) (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) -(defun gud-expansion-speedbar-buttons (directory zero) +(defun gud-expansion-speedbar-buttons (_directory _zero) "Wrapper for call to `speedbar-add-expansion-list'. DIRECTORY and ZERO are not used, but are required by the caller." (gud-speedbar-buttons gud-comint-buffer)) @@ -657,17 +657,15 @@ The option \"--fullname\" must be included in this value." gud-marker-acc (substring gud-marker-acc (match-end 0)))) (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) - (let ((match (match-string 1 gud-marker-acc))) + (setq + ;; Append any text before the marker to the output we're going + ;; to return - we don't include the marker in this text. + output (concat output + (substring gud-marker-acc 0 (match-beginning 0))) - (setq - ;; Append any text before the marker to the output we're going - ;; to return - we don't include the marker in this text. - output (concat output - (substring gud-marker-acc 0 (match-beginning 0))) + ;; Set the accumulator to the remaining text. - ;; Set the accumulator to the remaining text. - - gud-marker-acc (substring gud-marker-acc (match-end 0))))) + gud-marker-acc (substring gud-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in @@ -884,7 +882,7 @@ It is passed through FILTER before we look at it." ;; gdb speedbar functions -(defun gud-gdb-goto-stackframe (text token indent) +(defun gud-gdb-goto-stackframe (_text token _indent) "Goto the stackframe described by TEXT, TOKEN, and INDENT." (speedbar-with-attached-buffer (gud-basic-call (concat "server frame " (nth 1 token))) @@ -1074,7 +1072,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-dbx-massage-args (file args) +(defun gud-dbx-massage-args (_file args) (nconc (let ((directories gud-dbx-directories) (result nil)) (while directories @@ -1386,7 +1384,7 @@ containing the executable being debugged." directory)) :group 'gud) -(defun gud-xdb-massage-args (file args) +(defun gud-xdb-massage-args (_file args) (nconc (let ((directories gud-xdb-directories) (result nil)) (while directories @@ -1450,7 +1448,7 @@ directories if your program contains sources from more than one directory." ;; History of argument lists passed to perldb. (defvar gud-perldb-history nil) -(defun gud-perldb-massage-args (file args) +(defun gud-perldb-massage-args (_file args) "Convert a command line as would be typed normally to run perldb into one that invokes an Emacs-enabled debugging session. \"-emacs\" is inserted where it will be $ARGV[0] (see perl5db.pl)." @@ -2072,7 +2070,7 @@ extension EXTN. Normally EXTN is given as the regular expression ;; Change what was given in the minibuffer to something that can be used to ;; invoke the debugger. -(defun gud-jdb-massage-args (file args) +(defun gud-jdb-massage-args (_file args) ;; The jdb executable must have whitespace between "-classpath" and ;; its value while gud-common-init expects all switch values to ;; follow the switch keyword without intervening whitespace. We @@ -2151,7 +2149,7 @@ relative to a classpath directory." (setq cplist (cdr cplist))) (if found-file (concat (car cplist) "/" filename))))) -(defun gud-jdb-find-source (string) +(defun gud-jdb-find-source (_string) "Alias for function used to locate source files. Set to `gud-jdb-find-source-using-classpath' or `gud-jdb-find-source-file' during jdb initialization depending on the value of @@ -3047,7 +3045,7 @@ Link exprs of the form: (declare-function syntax-symbol "gud" (x)) (declare-function syntax-point "gud" (x)) -(defun gud-find-class (f line) +(defun gud-find-class (f _line) "Find fully qualified class in file F at line LINE. This function uses the `gud-jdb-classpath' (and optional `gud-jdb-sourcepath') list(s) to derive a file @@ -3063,13 +3061,13 @@ class of the file (using s to separate nested class ids)." (save-match-data (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath)) (fbuffer (get-file-buffer f)) - syntax-symbol syntax-point class-found) + class-found + ;; Syntax-symbol returns the symbol of the *first* element + ;; in the syntactical analysis result list, syntax-point + ;; returns the buffer position of same + (syntax-symbol (lambda (x) (c-langelem-sym (car x)))) + (syntax-point (lambda (x) (c-langelem-pos (car x))))) (setq f (file-name-sans-extension (file-truename f))) - ;; Syntax-symbol returns the symbol of the *first* element - ;; in the syntactical analysis result list, syntax-point - ;; returns the buffer position of same - (fset 'syntax-symbol (lambda (x) (c-langelem-sym (car x)))) - (fset 'syntax-point (lambda (x) (c-langelem-pos (car x)))) ;; Search through classpath list for an entry that is ;; contained in f (while (and cplist (not class-found)) @@ -3092,17 +3090,17 @@ class of the file (using s to separate nested class ids)." ;; with the 'topmost-intro symbol, there may be ;; nested classes... (while (not (eq 'topmost-intro - (syntax-symbol (c-guess-basic-syntax)))) + (funcall syntax-symbol (c-guess-basic-syntax)))) ;; Check if the current position c-syntactic ;; analysis has 'inclass (setq syntax (c-guess-basic-syntax)) (while - (and (not (eq 'inclass (syntax-symbol syntax))) + (and (not (eq 'inclass (funcall syntax-symbol syntax))) (cdr syntax)) (setq syntax (cdr syntax))) - (if (eq 'inclass (syntax-symbol syntax)) + (if (eq 'inclass (funcall syntax-symbol syntax)) (progn - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) ;; Now we're at the beginning of a class ;; definition. Find class name (looking-at @@ -3111,9 +3109,9 @@ class of the file (using s to separate nested class ids)." (append (list (match-string-no-properties 1)) nclass))) (setq syntax (c-guess-basic-syntax)) - (while (and (not (syntax-point syntax)) (cdr syntax)) + (while (and (not (funcall syntax-point syntax)) (cdr syntax)) (setq syntax (cdr syntax))) - (goto-char (syntax-point syntax)) + (goto-char (funcall syntax-point syntax)) )) (string-match (concat (car nclass) "$") class-found) (setq class-found diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 76a91c4b000..48d1ac4b85e 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -412,13 +412,14 @@ that form should be displayed.") "Pop the next token from token-list into the let variable \"hif-token\"." (setq hif-token (pop hif-token-list))) -(defun hif-parse-if-exp (hif-token-list) +(defun hif-parse-if-exp (token-list) "Parse the TOKEN-LIST. Return translated list in prefix form." - (hif-nexttoken) - (prog1 - (hif-expr) - (if hif-token ; is there still a token? - (error "Error: unexpected token: %s" hif-token)))) + (let ((hif-token-list token-list)) + (hif-nexttoken) + (prog1 + (hif-expr) + (if hif-token ; is there still a token? + (error "Error: unexpected token: %s" hif-token))))) (defun hif-expr () "Parse an expression as found in #if. @@ -507,7 +508,7 @@ that form should be displayed.") ;; Unary plus/minus. ((memq hif-token '(hif-minus hif-plus)) (list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor))) - + (t ; identifier (let ((ident hif-token)) (if (memq ident '(or and)) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 9468d7b463e..d07edd5de2f 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -565,10 +565,9 @@ and then further adjusted to be at the end of the line." (if comment-reg (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) (when (looking-at hs-block-start-regexp) - (let* ((mdata (match-data t)) - (header-beg (match-beginning 0)) - (header-end (match-end 0)) - p q ov) + (let ((mdata (match-data t)) + (header-end (match-end 0)) + p q ov) ;; `p' is the point at the end of the block beginning, which ;; may need to be adjusted (save-excursion diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 9a8b8064be7..5382ce1386d 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -484,9 +484,9 @@ Returns nil if line starts inside a string, t if in a comment." (let ((indent-stack (list nil)) (contain-stack (list (point))) (case-fold-search nil) - restart outer-loop-done inner-loop-done state ostate - this-indent last-sexp last-depth - at-else at-brace at-do + outer-loop-done inner-loop-done state ostate + this-indent last-depth + at-else at-brace (opoint (point)) (next-depth 0)) (save-excursion @@ -506,9 +506,6 @@ Returns nil if line starts inside a string, t if in a comment." (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) nil nil state)) (setq next-depth (car state)) - (if (and (car (cdr (cdr state))) - (>= (car (cdr (cdr state))) 0)) - (setq last-sexp (car (cdr (cdr state))))) (if (or (nth 4 ostate)) (icon-indent-line)) (if (or (nth 3 state)) @@ -518,8 +515,6 @@ Returns nil if line starts inside a string, t if in a comment." (setq outer-loop-done t)) (if outer-loop-done nil - (if (/= last-depth next-depth) - (setq last-sexp nil)) (while (> last-depth next-depth) (setq indent-stack (cdr indent-stack) contain-stack (cdr contain-stack) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f495e35dc89..cd382d4e78d 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -934,7 +934,7 @@ BEG defaults to `point-min', meaning to flush the entire cache." (setq beg (or beg (save-restriction (widen) (point-min)))) (setq js--cache-end (min js--cache-end beg))) -(defmacro js--debug (&rest arguments) +(defmacro js--debug (&rest _arguments) ;; `(message ,@arguments) ) @@ -1591,10 +1591,9 @@ will be returned." (save-restriction (widen) (js--ensure-cache) - (let* ((bound (if (eobp) (point) (1+ (point)))) - (pstate (or (save-excursion - (js--backward-pstate)) - (list js--initial-pitem)))) + (let ((pstate (or (save-excursion + (js--backward-pstate)) + (list js--initial-pitem)))) ;; Loop until we either hit a pitem at BOB or pitem ends after ;; point (or at point if we're at eob) @@ -1921,7 +1920,7 @@ the broken-down class name of the item to insert." (let ((top-name (car name-parts)) (item-ptr items) - new-items last-new-item new-cons item) + new-items last-new-item new-cons) (js--debug "js--splice-into-items: name-parts: %S items:%S" name-parts @@ -2147,8 +2146,8 @@ initial input INITIAL-INPUT. Return a cons of (SYMBOL-NAME . LOCATION), where SYMBOL-NAME is a string and LOCATION is a marker." (unless ido-mode - (ido-mode t) - (ido-mode nil)) + (ido-mode 1) + (ido-mode -1)) (let ((choice (ido-completing-read prompt @@ -2955,8 +2954,8 @@ browser, respectively." ;; Prime IDO (unless ido-mode - (ido-mode t) - (ido-mode nil)) + (ido-mode 1) + (ido-mode -1)) (with-js (lexical-let ((tabs (js--get-tabs)) selected-tab-cname diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index fd9a576002a..22e5d2f7c5c 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -343,7 +343,7 @@ not be enclosed in { } or ( )." (defun makefile-make-font-lock-keywords (var keywords space &optional negation - &rest font-lock-keywords) + &rest fl-keywords) `(;; Do macro assignments. These get the "variable-name" face. (,makefile-macroassign-regex (1 font-lock-variable-name-face) @@ -393,7 +393,7 @@ not be enclosed in { } or ( )." ;; They can make a tab fail to be effective. ("^\\( +\\)\t" 1 makefile-space))) - ,@font-lock-keywords + ,@fl-keywords ;; Do dependencies. (makefile-match-dependency @@ -491,7 +491,7 @@ not be enclosed in { } or ( )." '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))) (defconst makefile-imake-font-lock-keywords - (append + (append (makefile-make-font-lock-keywords makefile-var-use-regex makefile-statements @@ -1155,7 +1155,6 @@ The context determines which are considered." (let* ((beg (save-excursion (skip-chars-backward "^$(){}:#= \t\n") (point))) - (try (buffer-substring beg (point))) (paren nil) (do-macros (save-excursion @@ -1262,7 +1261,7 @@ definition and conveniently use this command." ;; Filling -(defun makefile-fill-paragraph (arg) +(defun makefile-fill-paragraph (_arg) ;; Fill comments, backslashed lines, and variable definitions ;; specially. (save-excursion @@ -1680,7 +1679,7 @@ Then prompts for all required parameters." ;;; Utility functions ;;; ------------------------------------------------------------ -(defun makefile-match-function-end (end) +(defun makefile-match-function-end (_end) "To be called as an anchored matcher by font-lock. The anchor must have matched the opening parens in the first group." (let ((s (match-string-no-properties 1))) diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index e1d41c2ebd6..239da3d8cd6 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -268,8 +268,7 @@ is NOT available with versions of Octave prior to 2.0." (command (save-excursion (skip-syntax-backward "w_" (comint-line-beginning-position)) - (buffer-substring-no-properties (point) end))) - (proc (get-buffer-process inferior-octave-buffer))) + (buffer-substring-no-properties (point) end)))) (cond (inferior-octave-complete-impossible (error (concat "Your Octave does not have `completion_matches'. " @@ -336,7 +335,7 @@ Ring Emacs bell if process output starts with an ASCII bell, and pass the rest to `comint-output-filter'." (comint-output-filter proc (inferior-octave-strip-ctrl-g string))) -(defun inferior-octave-output-digest (proc string) +(defun inferior-octave-output-digest (_proc string) "Special output filter for the inferior Octave process. Save all output between newlines into `inferior-octave-output-list', and the rest to `inferior-octave-output-string'." diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 8bf9ff299d0..241928c8a1c 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -893,7 +893,7 @@ otherwise." (setq give-up t)))) (not give-up)))) -(defun octave-fill-paragraph (&optional arg) +(defun octave-fill-paragraph (&optional _arg) "Fill paragraph of Octave code, handling Octave comments." ;; FIXME: difference with generic fill-paragraph: ;; - code lines are only split, never joined. diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 9b446e49b5c..ed628730fc1 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -862,7 +862,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." ;; ); (progn (skip-syntax-backward "(") - (condition-case err + (condition-case nil (while (save-excursion (skip-syntax-backward " ") (not (bolp))) (forward-sexp -1)) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 62472edfbe4..283919c131e 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1010,7 +1010,7 @@ VERSION is of the format (Major . Minor)" (define-key map "\C-c\C-l" 'prolog-consult-file) (define-key map "\C-c\C-z" 'switch-to-prolog)) -(defun prolog-mode-keybindings-inferior (map) +(defun prolog-mode-keybindings-inferior (_map) "Define keybindings for inferior Prolog mode in MAP." ;; No inferior mode specific keybindings now. ) @@ -2012,15 +2012,14 @@ Argument BOUND is a buffer position limiting searching." ;; NB: This function *MUST* have this optional argument since XEmacs ;; assumes it. This does not mean we have to use it... -(defun prolog-indent-line (&optional whole-exp) +(defun prolog-indent-line (&optional _whole-exp) "Indent current line as Prolog code. With argument, indent any additional lines of the same clause rigidly along with this one (not yet)." (interactive "p") (let ((indent (prolog-indent-level)) - (pos (- (point-max) (point))) beg) + (pos (- (point-max) (point)))) (beginning-of-line) - (setq beg (point)) (skip-chars-forward " \t") (indent-line-to indent) (if (> (- (point-max) pos) (point)) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index f3418a60729..cade56a194c 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -541,6 +541,10 @@ Typing \\\\[ps-run-goto-error] when the cursor is at the number (interactive) (message " *** PostScript Mode (ps-mode) Version %s *** " ps-mode-version)) +;; From reporter.el +(defvar reporter-prompt-for-summary-p) +(defvar reporter-dont-compact-list) + (defun ps-mode-submit-bug-report () "Submit via mail a bug report on PostScript mode." (interactive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0cbb8c186cc..a7851c54356 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2495,7 +2495,7 @@ with skeleton expansions for compound statement templates. ;; doesn't seem to work properly. (add-to-list 'hs-special-modes-alist `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#" - ,(lambda (arg) + ,(lambda (_arg) (python-end-of-defun) (skip-chars-backward " \t\n")) nil)) @@ -2554,7 +2554,7 @@ Runs `jython-mode-hook' after `python-mode-hook'." (setq overlay-arrow-position nil python-pdbtrack-is-tracking-p nil))) -(defun python-pdbtrack-track-stack-file (text) +(defun python-pdbtrack-track-stack-file (_text) "Show the file indicated by the pdb stack entry line, in a separate window. Activity is disabled if the buffer-local variable @@ -2666,8 +2666,8 @@ problem." ) ) -(defun python-pdbtrack-grub-for-buffer (funcname lineno) - "Find recent python-mode buffer named, or having function named funcname." +(defun python-pdbtrack-grub-for-buffer (funcname _lineno) + "Find recent Python mode buffer named, or having function named FUNCNAME." (let ((buffers (buffer-list)) buf got) @@ -2725,7 +2725,7 @@ comint believe the user typed this string so that (interactive) (python-pdbtrack-toggle-stack-tracking 0)) -(defun python-sentinel (proc msg) +(defun python-sentinel (_proc _msg) (setq overlay-arrow-position nil)) (provide 'python) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 7b84cc89d08..258f9be9237 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -987,8 +987,7 @@ subshells can nest." ;; rather flakey. (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" - (let ((char (char-after (point))) - ;; `state' can be: double-quote, backquote, code. + (let (;; `state' can be: double-quote, backquote, code. (state (if (eq (char-before) ?`) 'backquote 'code)) ;; Stacked states in the context. (states '(double-quote))) @@ -1212,7 +1211,7 @@ a number means align to that column, e.g. 0 means first column." ;; "For debugging: display message ARGS if variable SH-DEBUG is non-nil." ;; (if sh-debug ;; (apply 'message args))) -(defmacro sh-debug (&rest args)) +(defmacro sh-debug (&rest _args)) (defconst sh-symbol-list '((const :tag "+ " :value + @@ -2138,7 +2137,6 @@ STRING This is ignored for the purposes of calculating (save-excursion (let ((have-result nil) this-kw - start val (result nil) (align-point nil) @@ -2209,7 +2207,6 @@ STRING This is ignored for the purposes of calculating ;; We start off at beginning of this line. ;; Scan previous statements while this is <= ;; start of previous line. - (setq start (point)) ;; for debug only (goto-char prev-line-end) (setq x t) (while (and x (setq x (sh-prev-thing))) @@ -2614,7 +2611,7 @@ can be represented by a symbol then do so." If INFO is supplied it is used, else it is calculated from current line." (let ((ofs 0) (base-value 0) - elt a b var val) + elt a b val) (or info (setq info (sh-get-indent-info))) (when info diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 976ec202483..dc2773a9efe 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -324,7 +324,7 @@ for SIMULA mode to function correctly." "Keymap used in `simula-mode'.") ;; menus for Lucid -(defun simula-popup-menu (e) +(defun simula-popup-menu (_e) "Pops up the SIMULA menu." (interactive "@e") (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))) @@ -1202,9 +1202,8 @@ If COUNT is negative, move backward instead." ((eq simula-abbrev-keyword 'downcase) (downcase-word -1)) ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))) (let ((pos (- (point-max) (point))) - (case-fold-search t) - null) - (condition-case null + (case-fold-search t)) + (condition-case nil (progn ;; check if the expanded word is on the beginning of the line. (if (and (eq (char-syntax (preceding-char)) ?w) @@ -1244,8 +1243,9 @@ An optional second argument BOUND bounds the search, it is a buffer position. The match found must not extend after that position. Optional third argument NOERROR, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil." - (let (begin end context (comb-regexp (concat regexp "\\|\\")) - match (start-point (point))) + (let ((comb-regexp (concat regexp "\\|\\")) + (start-point (point)) + context match) (catch 'simula-backward (while (re-search-backward comb-regexp bound 1) ;; We have a match, check SIMULA context at match-beginning @@ -1306,8 +1306,9 @@ An optional second argument BOUND bounds the search, it is a buffer position. The match found must not extend after that position. Optional third argument NOERROR, if t, means if fail just return nil (no error). If not nil and not t, move to limit of search and return nil." - (let (begin end context (comb-regexp (concat regexp "\\|\\")) - match (start-point (point))) + (let ((comb-regexp (concat regexp "\\|\\")) + (start-point (point)) + context match) (catch 'simula-forward (while (re-search-forward comb-regexp bound 1) ;; We have a match, check SIMULA context at match-beginning diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 1c1ffc41624..facbba60057 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3540,7 +3540,7 @@ optionally is saved to the user's init file." (append (list name) (sql-for-each-login `(product ,@login) - (lambda (token plist) + (lambda (token _plist) (cond ((eq token 'product) `(sql-product ',sql-product)) ((eq token 'user) `(sql-user ,sql-user)) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index eb254676469..f18ec5abe81 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -660,7 +660,7 @@ already exist." -(defun tcl-indent-command (&optional arg) +(defun tcl-indent-command (&optional _arg) "Indent current line as Tcl code, or in some cases insert a tab character. If `tcl-tab-always-indent' is t (the default), always indent current line. If `tcl-tab-always-indent' is nil and point is not in the indentation @@ -1506,7 +1506,7 @@ The first line is assumed to look like \"#!.../program ...\"." ;; loading the XEmacs menu emulation code. ;; -(defun tcl-popup-menu (e) +(defun tcl-popup-menu (_e) (interactive "@e") (popup-menu tcl-mode-menu)) diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index f2842721f21..1f33f5f3aaf 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -1,4 +1,4 @@ -;;; vera-mode.el --- major mode for editing Vera files. +;;; vera-mode.el --- major mode for editing Vera files ;; Copyright (C) 1997-2011 Free Software Foundation, Inc. @@ -1077,7 +1077,7 @@ try to increase performance by using this macro." (save-excursion (beginning-of-line) (let ((indent-point (point)) - syntax state placeholder pos) + syntax state placeholder) ;; determine syntax state (setq state (parse-partial-sexp (point-min) (point))) (cond @@ -1240,7 +1240,7 @@ Calls `indent-region' for whole buffer." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; electrifications -(defun vera-electric-tab (&optional prefix-arg) +(defun vera-electric-tab (&optional prefix) "Do what I mean (indent, expand, tab, change indent, etc..). If preceding character is part of a word or a paren then `hippie-expand', else if right of non whitespace on line then `tab-to-tab-stop', @@ -1260,7 +1260,7 @@ If `vera-intelligent-tab' is nil, always indent line." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vera-mode)))) - (vera-expand-abbrev prefix-arg))) + (vera-expand-abbrev prefix))) ((> (current-column) (current-indentation)) (tab-to-tab-stop)) ((and (or (eq last-command 'vera-electric-tab) @@ -1402,7 +1402,7 @@ If `vera-intelligent-tab' is nil, always indent line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Comments -(defun vera-comment-uncomment-region (beg end &optional arg) +(defun vera-comment-uncomment-region (beg end &optional _arg) "Comment region if not commented, uncomment region if already commented." (interactive "r\nP") (goto-char beg) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index cd50174f8cd..dfa91b3fe30 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -511,7 +511,7 @@ Commands: (interactive) (xscheme-send-char last-command-event)) -(defun xscheme-enter-debugger-mode (prompt-string) +(defun xscheme-enter-debugger-mode (_prompt-string) (with-current-buffer (xscheme-process-buffer) (if (not (derived-mode-p 'scheme-debugger-mode)) (progn @@ -1024,8 +1024,7 @@ the remaining input.") (xscheme-goto-output-point) (let ((old-point (point))) (while (string-match "\\(\007\\|\f\\)" string) - (let ((start (match-beginning 0)) - (end (match-end 0))) + (let ((start (match-beginning 0))) (insert-before-markers (substring string 0 start)) (if (= ?\f (aref string start)) (progn From be71f8100a71a5b896ef05c32f51a09a3d9e3993 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Fri, 22 Apr 2011 20:49:58 +0200 Subject: [PATCH 37/77] lisp/buff-menu.el (Buffer-menu--buffers): Fix typo in docstring. Fixes: debbugs:8535 --- lisp/ChangeLog | 4 ++++ lisp/buff-menu.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7cfe6d842d9..8ff0625068d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-04-22 Juanma Barranquero + + * buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535). + 2011-04-21 Juanma Barranquero * play/mpuz.el (mpuz-silent): Doc fix. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 19cc01c5144..3454f416314 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -116,7 +116,7 @@ Auto Revert Mode.") (defvar Buffer-menu--buffers nil "If non-nil, list of buffers shown in the current buffer-menu. This variable determines whether reverting the buffer lists only -this buffers. It affects both manual reverting and reverting by +these buffers. It affects both manual reverting and reverting by Auto Revert Mode.") (make-variable-buffer-local 'Buffer-menu--buffers) From c2fb1b6051a9acd880d99954504dd94259628f19 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Fri, 22 Apr 2011 22:15:21 +0200 Subject: [PATCH 38/77] lisp/eshell/esh-mode.el (find-tag-interactive): Small cleanup. * eshell/esh-mode.el (find-tag-interactive): Declare function. (eshell-find-tag): Remove `with-no-warnings', unneeded now. Pass argument NO-DEFAULT to `find-tag-interactive'. --- lisp/ChangeLog | 6 ++++++ lisp/eshell/esh-mode.el | 5 +++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ed06af250f6..f422a977ebe 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2011-04-22 Juanma Barranquero + + * eshell/esh-mode.el (find-tag-interactive): Declare function. + (eshell-find-tag): Remove `with-no-warnings', unneeded now. + Pass argument NO-DEFAULT to `find-tag-interactive'. + 2011-04-22 Juanma Barranquero Lexical-binding cleanup. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 10623dba8e3..9abb0c8ecc0 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -497,6 +497,8 @@ and the hook `eshell-exit-hook'." (if intercept (setq this-command 'eshell-self-insert-command))))) +(declare-function find-tag-interactive "etags" (prompt &optional no-default)) + (defun eshell-find-tag (&optional tagname next-p regexp-p) "A special version of `find-tag' that ignores read-onlyness." (interactive) @@ -504,8 +506,7 @@ and the hook `eshell-exit-hook'." (let ((inhibit-read-only t) (no-default (eobp)) (find-tag-default-function 'ignore)) - (with-no-warnings - (setq tagname (car (find-tag-interactive "Find tag: ")))) + (setq tagname (car (find-tag-interactive "Find tag: " no-default))) (find-tag tagname next-p regexp-p))) (defun eshell-move-argument (limit func property arg) From c243bc792c65a94733ecdbfa2aa7f5a38a76885e Mon Sep 17 00:00:00 2001 From: Noah Friedman Date: Fri, 22 Apr 2011 16:29:02 -0700 Subject: [PATCH 39/77] Add trailing underscores to appropriate member names, per change 2011-02-14T15:39:19Z!tromey@redhat.com of src/lisp.h. --- etc/ChangeLog | 6 ++++++ etc/emacs-buffer.gdb | 23 +++++++++++------------ 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/etc/ChangeLog b/etc/ChangeLog index 002dfaf7fd5..24f44b9d0e8 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,9 @@ +2011-04-22 Noah Friedman + + * emacs-buffer.gdb: Add trailing underscores to appropriate member + names, per change tromey@redhat.com-20110214153919-bxkckrdmmg4qhyyj + of src/lisp.h. + 2011-04-08 Christoph Scholtes * NEWS: Document new function `vc-ediff'. diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb index 14a7615801c..1378e5b81fc 100644 --- a/etc/emacs-buffer.gdb +++ b/etc/emacs-buffer.gdb @@ -1,12 +1,8 @@ # emacs-buffer.gdb --- gdb macros for recovering buffers from emacs coredumps -# Copyright (C) 2005-2011 Free Software Foundation, Inc. +# Copyright (C) 2005, 06, 2011 Free Software Foundation, Inc. # Maintainer: Noah Friedman -# Status: Works with Emacs 22.0.51.1 (prerelease) as of 2006-01-12. -# Older cvs snapshots, and released versions, will not work due to -# changes in lisp data structures. But there are older versions of -# this gdb script which work with those versions. # Created: 2005-04-28 # This file is part of GNU Emacs. @@ -37,6 +33,10 @@ # `ysave-buffer', and `ybuffer-contents'. The `y' prefix avoids any # namespace collisions with emacs/src/.gdbinit. +# Since the internal data structures in Emacs occasionally from time to +# time, you should use the version of this file that came with your +# particular Emacs version; older versions might not work anymore. + # Example usage: # # $ gdb /export/src/emacs/2005-05-02--03-17/src/emacs core.emacs.6.9845 @@ -107,16 +107,16 @@ define ybuffer-list ygetptr $buf set $buf = (struct buffer *) $ptr - if ! ($files_only && $buf->filename == Qnil) - ygetptr $buf->name + if ! ($files_only && $buf->filename_ == Qnil) + ygetptr $buf->name_ set $name = ((struct Lisp_String *) $ptr)->data set $modp = ($buf->text->modiff > $buf->text->save_modiff) ? '*' : ' ' - ygetptr $buf->mode_name + ygetptr $buf->mode_name_ set $mode = ((struct Lisp_String *) $ptr)->data - if $buf->filename != Qnil - ygetptr $buf->filename + if $buf->filename_ != Qnil + ygetptr $buf->filename_ printf "%2d %c %9d %-20s %-10s %s\n", \ $i, $modp, ($buf->text->z_byte - 1), $name, $mode, \ ((struct Lisp_String *) $ptr)->data @@ -193,7 +193,7 @@ document yget-buffer-pointers end define yget-current-buffer-name - set $this = $ycurrent_buffer->name + set $this = $ycurrent_buffer->name_ ygetptr $this set $ycurrent_buffer_name = ((struct Lisp_String *) $ptr)->data end @@ -267,4 +267,3 @@ end # local variables: # mode: gdb-script # end: - From 74db886b06e4577e5f69859c5ad590c86bc1d964 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Sat, 23 Apr 2011 00:08:28 +0000 Subject: [PATCH 40/77] gnus-registry.el (gnus-registry-ignore-group-p): Test specifically for the case where `gnus-registry-ignored-groups' is a list of lists, and don't call `gnus-parameter-registry-ignore' otherwise. --- lisp/gnus/ChangeLog | 6 ++++++ lisp/gnus/gnus-registry.el | 8 ++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 4a8311f6e0a..013f5392e02 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,11 @@ 2011-04-22 Teodor Zlatanov + * gnus-registry.el (gnus-registry-ignore-group-p): Test specifically + for the case where `gnus-registry-ignored-groups' is a list of lists, + and don't call `gnus-parameter-registry-ignore' otherwise. + +2011-04-21 Teodor Zlatanov + * nnimap.el (nnimap-user): New backend variable. (nnimap-open-connection-1): Use it. (nnimap-credentials): Accept user parameter so it's explicit what user diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index f0b1f186541..3597cbc1584 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -666,8 +666,7 @@ Consults `gnus-registry-unfollowed-groups' and Consults `gnus-registry-ignored-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." (and group - (or (gnus-parameter-registry-ignore group) - (gnus-grep-in-list + (or (gnus-grep-in-list group (delq nil (mapcar (lambda (g) (cond @@ -675,6 +674,11 @@ Consults `gnus-registry-ignored-groups' and ((and (listp g) (nth 1 g)) (nth 0 g)) (t nil))) gnus-registry-ignored-groups))) + ;; only use `gnus-parameter-registry-ignore' if + ;; `gnus-registry-ignored-groups' is a list of lists + ;; (it can be a list of regexes) + (and (listp (nth 0 gnus-registry-ignored-groups)) + (gnus-parameter-registry-ignore group)) (gnus-grep-in-list group nnmail-split-fancy-with-parent-ignore-groups)))) From 3553ba549bdfa630819044e8f2d544f371bd1d9e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 22 Apr 2011 19:15:03 -0700 Subject: [PATCH 41/77] Revert incorrect change to copyright years. --- etc/emacs-buffer.gdb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb index 1378e5b81fc..d4eecc9f8ef 100644 --- a/etc/emacs-buffer.gdb +++ b/etc/emacs-buffer.gdb @@ -1,6 +1,6 @@ # emacs-buffer.gdb --- gdb macros for recovering buffers from emacs coredumps -# Copyright (C) 2005, 06, 2011 Free Software Foundation, Inc. +# Copyright (C) 2005-2011 Free Software Foundation, Inc. # Maintainer: Noah Friedman # Created: 2005-04-28 From 81de9236e1daa1fe7dfd0ef9aaaf1e13b6aa74e4 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 22 Apr 2011 19:18:10 -0700 Subject: [PATCH 42/77] * lisp/gnus/gnus-sum.el (gnus-extra-headers): Bump :version. --- lisp/gnus/ChangeLog | 4 ++++ lisp/gnus/gnus-sum.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 013f5392e02..b683a1563b6 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,7 @@ +2011-04-23 Glenn Morris + + * gnus-sum.el (gnus-extra-headers): Bump :version. + 2011-04-22 Teodor Zlatanov * gnus-registry.el (gnus-registry-ignore-group-p): Test specifically diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b6a3860a81f..807f133e481 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1130,7 +1130,7 @@ which it may alter in any way." (defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups) "*Extra headers to parse." - :version "21.1" + :version "24.1" ; added Cc Keywords Gcc :group 'gnus-summary :type '(repeat symbol)) From e6c3da2065ac72cc4e1a2bef22d367cd75401892 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Apr 2011 13:33:28 +0300 Subject: [PATCH 43/77] Fix doprnt so it could be used safely in `verror'. (Bug#8435) src/doprnt.c: Include limits.h. (SIZE_MAX): New macro. (doprnt): Return a size_t value. 2nd arg is now size_t. Many local variables are now size_t instead of int or unsigned. Improve overflow protection. Support `l' modifier for integer conversions. Support %l conversion. Don't assume an EMACS_INT argument for integer conversions and for %c. src/lisp.h (doprnt): Restore prototype. src/makefile.w32-in ($(BLD)/callint.$(O)): Depend on $(SRC)/character.h. src/Makefile.in (base_obj): Add back doprnt.o. src/deps.mk (doprnt.o): Add back prerequisites. (callint.o): Depend on character.h. src/eval.c (internal_lisp_condition_case): Include the handler representation in the error message. (verror): Call doprnt instead of vsnprintf. Fix an off-by-one bug when breaking from the loop. src/xdisp.c (vmessage): Call doprnt instead of vsnprintf. src/callint.c (Fcall_interactively): When displaying error message about invalid control letter, pass the character's codepoint, not a pointer to its multibyte form. Improve display of the character in octal and display also its hex code. src/character.c (char_string): Use %x to display the (unsigned) codepoint of an invalid character, to avoid displaying a bogus negative value. src/font.c (check_otf_features): Pass SDATA of SYMBOL_NAME to `error', not SYMBOL_NAME itself. src/coding.c (Fencode_sjis_char, Fencode_big5_char): Use %c for character arguments to `error'. src/charset.c (check_iso_charset_parameter): Fix incorrect argument to `error' in error message about FINAL_CHAR argument. Make sure FINAL_CHAR is a character, and use %c when it is passed as argument to `error'. --- src/ChangeLog | 48 ++++++++++++++++++++ src/Makefile.in | 2 +- src/callint.c | 7 ++- src/character.c | 2 +- src/charset.c | 10 ++--- src/coding.c | 4 +- src/deps.mk | 4 +- src/doprnt.c | 106 ++++++++++++++++++++++++++++++-------------- src/eval.c | 37 ++++++++-------- src/font.c | 6 ++- src/lisp.h | 3 ++ src/makefile.w32-in | 1 + src/xdisp.c | 18 ++------ 13 files changed, 165 insertions(+), 83 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 0067163edbf..831fb6afcd0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,51 @@ +2011-04-23 Eli Zaretskii + + Fix doprnt so it could be used again safely in `verror'. (Bug#8435) + * doprnt.c: Include limits.h. + (SIZE_MAX): New macro. + (doprnt): Return a size_t value. 2nd arg is now size_t. Many + local variables are now size_t instead of int or unsigned. + Improve overflow protection. Support `l' modifier for integer + conversions. Support %l conversion. Don't assume an EMACS_INT + argument for integer conversions and for %c. + + * lisp.h (doprnt): Restore prototype. + + * makefile.w32-in ($(BLD)/callint.$(O)): Depend on + $(SRC)/character.h. + + * Makefile.in (base_obj): Add back doprnt.o. + + * deps.mk (doprnt.o): Add back prerequisites. + (callint.o): Depend on character.h. + + * eval.c (internal_lisp_condition_case): Include the handler + representation in the error message. + (verror): Call doprnt instead of vsnprintf. Fix an off-by-one bug + when breaking from the loop. + + * xdisp.c (vmessage): Call doprnt instead of vsnprintf. + + * callint.c (Fcall_interactively): When displaying error message + about invalid control letter, pass the character's codepoint, not + a pointer to its multibyte form. Improve display of the character + in octal and display also its hex code. + + * character.c (char_string): Use %x to display the (unsigned) + codepoint of an invalid character, to avoid displaying a bogus + negative value. + + * font.c (check_otf_features): Pass SDATA of SYMBOL_NAME to + `error', not SYMBOL_NAME itself. + + * coding.c (Fencode_sjis_char, Fencode_big5_char): Use %c for + character arguments to `error'. + + * charset.c (check_iso_charset_parameter): Fix incorrect argument + to `error' in error message about FINAL_CHAR argument. Make sure + FINAL_CHAR is a character, and use %c when it is passed as + argument to `error'. + 2011-04-23 Eli Zaretskii * s/ms-w32.h (localtime): Redirect to sys_localtime. diff --git a/src/Makefile.in b/src/Makefile.in index 154d6abba4e..e1195968f7f 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -354,7 +354,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ - intervals.o textprop.o composite.o xml.o \ + doprnt.o intervals.o textprop.o composite.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) diff --git a/src/callint.c b/src/callint.c index e5ec3d7d931..cddd92c8a94 100644 --- a/src/callint.c +++ b/src/callint.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "window.h" #include "keymap.h" +#include "character.h" Lisp_Object Qminus, Qplus; Lisp_Object Qcall_interactively; @@ -786,8 +787,10 @@ invoke it. If KEYS is omitted or nil, the return value of if anyone tries to define one here. */ case '+': default: - error ("Invalid control letter `%c' (%03o) in interactive calling string", - *tem, (unsigned char) *tem); + error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string", + STRING_CHAR ((unsigned char *) tem), + (unsigned) STRING_CHAR ((unsigned char *) tem), + (unsigned) STRING_CHAR ((unsigned char *) tem)); } if (varies[i] == 0) diff --git a/src/character.c b/src/character.c index 84eddeb2fc2..4087e8984d0 100644 --- a/src/character.c +++ b/src/character.c @@ -156,7 +156,7 @@ char_string (unsigned int c, unsigned char *p) bytes = BYTE8_STRING (c, p); } else - error ("Invalid character: %d", c); + error ("Invalid character: %x", c); return bytes; } diff --git a/src/charset.c b/src/charset.c index c4699dcb0a7..e7435c292e2 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1436,7 +1436,7 @@ check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars, Lisp_Obje { CHECK_NATNUM (dimension); CHECK_NATNUM (chars); - CHECK_NATNUM (final_char); + CHECK_CHARACTER (final_char); if (XINT (dimension) > 3) error ("Invalid DIMENSION %"pEd", it should be 1, 2, or 3", @@ -1444,12 +1444,8 @@ check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars, Lisp_Obje if (XINT (chars) != 94 && XINT (chars) != 96) error ("Invalid CHARS %"pEd", it should be 94 or 96", XINT (chars)); if (XINT (final_char) < '0' || XINT (final_char) > '~') - { - unsigned char str[MAX_MULTIBYTE_LENGTH + 1]; - int len = CHAR_STRING (XINT (chars), str); - str[len] = '\0'; - error ("Invalid FINAL-CHAR %s, it should be `0'..`~'", str); - } + error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", + (int)XINT (final_char)); } diff --git a/src/coding.c b/src/coding.c index b49070e5e16..221ada51158 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9071,7 +9071,7 @@ Return the corresponding code in SJIS. */) charset_list = CODING_ATTR_CHARSET_LIST (attrs); charset = char_charset (c, charset_list, &code); if (code == CHARSET_INVALID_CODE (charset)) - error ("Can't encode by shift_jis encoding: %d", c); + error ("Can't encode by shift_jis encoding: %c", c); JIS_TO_SJIS (code); return make_number (code); @@ -9142,7 +9142,7 @@ Return the corresponding character code in Big5. */) charset_list = CODING_ATTR_CHARSET_LIST (attrs); charset = char_charset (c, charset_list, &code); if (code == CHARSET_INVALID_CODE (charset)) - error ("Can't encode by Big5 encoding: %d", c); + error ("Can't encode by Big5 encoding: %c", c); return make_number (code); } diff --git a/src/deps.mk b/src/deps.mk index 2df1577ef78..8d0e0e69589 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -44,7 +44,8 @@ buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ $(INTERVALS_H) blockinput.h atimer.h systime.h character.h ../lib/unistd.h \ indent.h keyboard.h coding.h keymap.h frame.h lisp.h globals.h $(config_h) callint.o: callint.c window.h commands.h buffer.h keymap.h globals.h msdos.h \ - keyboard.h dispextern.h systime.h coding.h composite.h lisp.h $(config_h) + keyboard.h dispextern.h systime.h coding.h composite.h lisp.h \ + character.h $(config_h) callproc.o: callproc.c epaths.h buffer.h commands.h lisp.h $(config_h) \ process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \ composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h \ @@ -82,6 +83,7 @@ dispnew.o: dispnew.c systime.h commands.h process.h frame.h coding.h \ # doc.o's dependency on buildobj.h is in src/Makefile.in. doc.o: doc.c lisp.h $(config_h) buffer.h keyboard.h keymap.h \ character.h systime.h coding.h composite.h ../lib/unistd.h globals.h +doprnt.o: doprnt.c character.h lisp.h globals.h ../lib/unistd.h $(config_h) dosfns.o: buffer.h termchar.h termhooks.h frame.h blockinput.h window.h \ msdos.h dosfns.h dispextern.h charset.h coding.h atimer.h systime.h \ lisp.h $(config_h) diff --git a/src/doprnt.c b/src/doprnt.c index 36eb272caae..f182529b801 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -30,6 +30,11 @@ along with GNU Emacs. If not, see . */ #include +#include +#ifndef SIZE_MAX +# define SIZE_MAX ((size_t) -1) +#endif + #include "lisp.h" /* Since we use the macro CHAR_HEAD_P, we have to include this, but @@ -51,8 +56,8 @@ along with GNU Emacs. If not, see . */ String arguments are passed as C strings. Integers are passed as C integers. */ -EMACS_INT -doprnt (char *buffer, register int bufsize, const char *format, +size_t +doprnt (char *buffer, register size_t bufsize, const char *format, const char *format_end, va_list ap) { const char *fmt = format; /* Pointer into format string */ @@ -62,15 +67,15 @@ doprnt (char *buffer, register int bufsize, const char *format, char tembuf[DBL_MAX_10_EXP + 100]; /* Size of sprintf_buffer. */ - unsigned size_allocated = sizeof (tembuf); + size_t size_allocated = sizeof (tembuf); /* Buffer to use for sprintf. Either tembuf or same as BIG_BUFFER. */ char *sprintf_buffer = tembuf; /* Buffer we have got with malloc. */ - char *big_buffer = 0; + char *big_buffer = NULL; - register int tem; + register size_t tem; char *string; char fixed_buffer[20]; /* Default buffer for small formatting. */ char *fmtcpy; @@ -92,8 +97,9 @@ doprnt (char *buffer, register int bufsize, const char *format, { if (*fmt == '%') /* Check for a '%' character */ { - unsigned size_bound = 0; - EMACS_INT width; /* Columns occupied by STRING. */ + size_t size_bound = 0; + EMACS_INT width; /* Columns occupied by STRING on display. */ + int long_flag = 0; fmt++; /* Copy this one %-spec into fmtcpy. */ @@ -108,10 +114,11 @@ doprnt (char *buffer, register int bufsize, const char *format, This might be a field width or a precision; e.g. %1.1000f and %1000.1f both might need 1000+ bytes. Parse the width or precision, checking for overflow. */ - unsigned n = *fmt - '0'; + size_t n = *fmt - '0'; while ('0' <= fmt[1] && fmt[1] <= '9') { - if (n * 10 + fmt[1] - '0' < n) + if (n >= SIZE_MAX / 10 + || n * 10 > SIZE_MAX - (fmt[1] - '0')) error ("Format width or precision too large"); n = n * 10 + fmt[1] - '0'; *string++ = *++fmt; @@ -122,6 +129,13 @@ doprnt (char *buffer, register int bufsize, const char *format, } else if (*fmt == '-' || *fmt == ' ' || *fmt == '.' || *fmt == '+') ; + else if (*fmt == 'l') + { + long_flag = 1; + if (!strchr ("dox", fmt[1])) + /* %l as conversion specifier, not as modifier. */ + break; + } else break; fmt++; @@ -130,7 +144,7 @@ doprnt (char *buffer, register int bufsize, const char *format, /* Make the size bound large enough to handle floating point formats with large numbers. */ - if (size_bound + DBL_MAX_10_EXP + 50 < size_bound) + if (size_bound > SIZE_MAX - DBL_MAX_10_EXP - 50) error ("Format width or precision too large"); size_bound += DBL_MAX_10_EXP + 50; @@ -151,23 +165,47 @@ doprnt (char *buffer, register int bufsize, const char *format, error ("Invalid format operation %%%c", fmt[-1]); /* case 'b': */ + case 'l': case 'd': + { + int i; + long l; + + if (long_flag) + { + l = va_arg(ap, long); + sprintf (sprintf_buffer, fmtcpy, l); + } + else + { + i = va_arg(ap, int); + sprintf (sprintf_buffer, fmtcpy, i); + } + /* Now copy into final output, truncating as necessary. */ + string = sprintf_buffer; + goto doit; + } + case 'o': case 'x': - if (sizeof (int) == sizeof (EMACS_INT)) - ; - else if (sizeof (long) == sizeof (EMACS_INT)) - /* Insert an `l' the right place. */ - string[1] = string[0], - string[0] = string[-1], - string[-1] = 'l', - string++; - else - abort (); - sprintf (sprintf_buffer, fmtcpy, va_arg(ap, char *)); - /* Now copy into final output, truncating as nec. */ - string = sprintf_buffer; - goto doit; + { + unsigned u; + unsigned long ul; + + if (long_flag) + { + ul = va_arg(ap, unsigned long); + sprintf (sprintf_buffer, fmtcpy, ul); + } + else + { + u = va_arg(ap, unsigned); + sprintf (sprintf_buffer, fmtcpy, u); + } + /* Now copy into final output, truncating as necessary. */ + string = sprintf_buffer; + goto doit; + } case 'f': case 'e': @@ -175,7 +213,7 @@ doprnt (char *buffer, register int bufsize, const char *format, { double d = va_arg(ap, double); sprintf (sprintf_buffer, fmtcpy, d); - /* Now copy into final output, truncating as nec. */ + /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; goto doit; } @@ -187,13 +225,18 @@ doprnt (char *buffer, register int bufsize, const char *format, minlen = atoi (&fmtcpy[1]); string = va_arg (ap, char *); tem = strlen (string); + if (tem > MOST_POSITIVE_FIXNUM) + error ("String for %%s or %%S format is too long"); width = strwidth (string, tem); goto doit1; /* Copy string into final output, truncating if no room. */ doit: /* Coming here means STRING contains ASCII only. */ - width = tem = strlen (string); + tem = strlen (string); + if (tem > MOST_POSITIVE_FIXNUM) + error ("Format width or precision too large"); + width = tem; doit1: /* We have already calculated: TEM -- length of STRING, @@ -236,13 +279,8 @@ doprnt (char *buffer, register int bufsize, const char *format, case 'c': { - /* Sometimes for %c we pass a char, which would widen - to int. Sometimes we pass XFASTINT() or XINT() - values, which would be EMACS_INT. Let's hope that - both are passed the same way, otherwise we'll need - to rewrite callers. */ - EMACS_INT chr = va_arg(ap, EMACS_INT); - tem = CHAR_STRING ((int) chr, (unsigned char *) charbuf); + int chr = va_arg(ap, int); + tem = CHAR_STRING (chr, (unsigned char *) charbuf); string = charbuf; string[tem] = 0; width = strwidth (string, tem); @@ -274,6 +312,6 @@ doprnt (char *buffer, register int bufsize, const char *format, /* If we had to malloc something, free it. */ xfree (big_buffer); - *bufptr = 0; /* Make sure our string end with a '\0' */ + *bufptr = 0; /* Make sure our string ends with a '\0' */ return bufptr - buffer; } diff --git a/src/eval.c b/src/eval.c index b843ca5b2ec..c3676720940 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1416,7 +1416,8 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, || (CONSP (tem) && (SYMBOLP (XCAR (tem)) || CONSP (XCAR (tem)))))) - error ("Invalid condition handler"); + error ("Invalid condition handler: %s", + SDATA (Fprin1_to_string (tem, Qt))); } c.tag = Qnil; @@ -1995,31 +1996,31 @@ verror (const char *m, va_list ap) size_t size = sizeof buf; size_t size_max = min (MOST_POSITIVE_FIXNUM, min (INT_MAX, SIZE_MAX - 1)) + 1; + size_t mlen = strlen (m); char *buffer = buf; - int used; + size_t used; Lisp_Object string; while (1) { - used = vsnprintf (buffer, size, m, ap); + used = doprnt (buffer, size, m, m + mlen, ap); - if (used < 0) - { - /* Non-C99 vsnprintf, such as w32, returns -1 when SIZE is too small. - Guess a larger USED to work around the incompatibility. */ - used = (size <= size_max / 2 ? 2 * size - : size < size_max ? size_max - 1 - : size_max); - } - else if (used < size) + /* Note: the -1 below is because `doprnt' returns the number of bytes + excluding the terminating null byte, and it always terminates with a + null byte, even when producing a truncated message. */ + if (used < size - 1) break; - if (size_max <= used) - memory_full (); - size = used + 1; + if (size <= size_max / 2) + size *= 2; + else if (size < size_max - 1) + size = size_max - 1; + else + break; /* and leave the message truncated */ - if (buffer != buf) - xfree (buffer); - buffer = (char *) xmalloc (size); + if (buffer == buf) + buffer = (char *) xmalloc (size); + else + buffer = (char *) xrealloc (buffer, size); } string = make_string (buffer, used); diff --git a/src/font.c b/src/font.c index 7fe0815d80e..f4950d39189 100644 --- a/src/font.c +++ b/src/font.c @@ -1795,14 +1795,16 @@ check_otf_features (otf_features) { CHECK_SYMBOL (Fcar (val)); if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) - error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val))); + error ("Invalid OTF GSUB feature: %s", + SDATA (SYMBOL_NAME (XCAR (val)))); } otf_features = XCDR (otf_features); for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) { CHECK_SYMBOL (Fcar (val)); if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) - error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val))); + error ("Invalid OTF GPOS feature: %s", + SDATA (SYMBOL_NAME (XCAR (val)))); } } diff --git a/src/lisp.h b/src/lisp.h index 581835dd32b..07b2cb0b1ef 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2760,6 +2760,9 @@ extern Lisp_Object internal_with_output_to_temp_buffer extern void float_to_string (char *, double); extern void syms_of_print (void); +/* Defined in doprnt.c */ +extern size_t doprnt (char *, size_t, const char *, const char *, va_list); + /* Defined in lread.c. */ extern Lisp_Object Qvariable_documentation, Qstandard_input; extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 62c40ca1f94..9d2c3d8f83f 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -469,6 +469,7 @@ $(BLD)/callint.$(O) : \ $(EMACS_ROOT)/nt/inc/sys/time.h \ $(LISP_H) \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ diff --git a/src/xdisp.c b/src/xdisp.c index 19fef35fce8..91d1b6ea2e3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8373,22 +8373,10 @@ vmessage (const char *m, va_list ap) { if (m) { - char *buf = FRAME_MESSAGE_BUF (f); - size_t bufsize = FRAME_MESSAGE_BUF_SIZE (f); - int len; + size_t len; - memset (buf, 0, bufsize); - len = vsnprintf (buf, bufsize, m, ap); - - /* Do any truncation at a character boundary. */ - if (! (0 <= len && len < bufsize)) - { - char *end = memchr (buf, 0, bufsize); - for (len = end ? end - buf : bufsize; - len && ! CHAR_HEAD_P (buf[len - 1]); - len--) - continue; - } + len = doprnt (FRAME_MESSAGE_BUF (f), + FRAME_MESSAGE_BUF_SIZE (f), m, (char *)0, ap); message2 (FRAME_MESSAGE_BUF (f), len, 0); } From 224a3131ee87cf4d59d8cf035b924171b73a25b6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 23 Apr 2011 20:19:56 +0300 Subject: [PATCH 44/77] Fix typos in comments in character.c and textprop.c. --- src/character.c | 15 +++++++-------- src/textprop.c | 2 +- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/character.c b/src/character.c index 4087e8984d0..6d27371c7e9 100644 --- a/src/character.c +++ b/src/character.c @@ -162,11 +162,11 @@ char_string (unsigned int c, unsigned char *p) } -/* Return a character whose multibyte form is at P. Set LEN is not +/* Return a character whose multibyte form is at P. If LEN is not NULL, it must be a pointer to integer. In that case, set *LEN to - the byte length of the multibyte form. If ADVANCED is not NULL, is + the byte length of the multibyte form. If ADVANCED is not NULL, it must be a pointer to unsigned char. In that case, set *ADVANCED to - the ending address (i.e. the starting address of the next + the ending address (i.e., the starting address of the next character) of the multibyte form. */ int @@ -206,11 +206,10 @@ string_char (const unsigned char *p, const unsigned char **advanced, int *len) } -/* Translate character C by translation table TABLE. If C is - negative, translate a character specified by CHARSET and CODE. If - no translation is found in TABLE, return the untranslated - character. If TABLE is a list, elements are char tables. In this - case, translace C by all tables. */ +/* Translate character C by translation table TABLE. If no translation is + found in TABLE, return the untranslated character. If TABLE is a list, + elements are char tables. In that case, recursively translate C by all the + tables in the list. */ int translate_char (Lisp_Object table, int c) diff --git a/src/textprop.c b/src/textprop.c index d9da36bf36b..1c56dfc0cf0 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -233,7 +233,7 @@ interval_has_all_properties (Lisp_Object plist, INTERVAL i) if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2)))) return 0; - /* Property has same value on both lists; go to next one. */ + /* Property has same value on both lists; go to next one. */ found = 1; break; } From 4ef177aa26537bdbbe9d60cc87b973435390c271 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 23 Apr 2011 20:15:26 -0400 Subject: [PATCH 45/77] Improve apropos buffer highlighting. * lisp/apropos.el (apropos-label-face): Avoid variable-pitch face. (apropos-accumulator): Doc fix. (apropos-function, apropos-macro, apropos-command) (apropos-variable, apropos-face, apropos-group, apropos-widget) (apropos-plist): Add face property. (apropos-symbols-internal): Fix indentation. (apropos-print): Simplify help, and recognize apropos-multi-type. (apropos-print-doc): Use button-type-get to extract the button's face property. Fill docstring (Bug#8352). --- lisp/ChangeLog | 12 +++++ lisp/apropos.el | 123 ++++++++++++++++++++++++++++++------------------ 2 files changed, 89 insertions(+), 46 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index af58ef47b28..4b8389877a2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-04-24 Chong Yidong + + * apropos.el (apropos-label-face): Avoid variable-pitch face. + (apropos-accumulator): Doc fix. + (apropos-function, apropos-macro, apropos-command) + (apropos-variable, apropos-face, apropos-group, apropos-widget) + (apropos-plist): Add face property. + (apropos-symbols-internal): Fix indentation. + (apropos-print): Simplify help, and recognize apropos-multi-type. + (apropos-print-doc): Use button-type-get to extract the button's + face property. Fill docstring (Bug#8352). + 2011-04-23 Juanma Barranquero * buff-menu.el (Buffer-menu--buffers): Fix typo in docstring (bug#8535). diff --git a/lisp/apropos.el b/lisp/apropos.el index 35a3ac3c09a..f1baee8dafe 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -83,7 +83,7 @@ Slows them down more or less. Set this non-nil if you have a fast machine." :group 'apropos :type 'face) -(defcustom apropos-label-face '(italic variable-pitch) +(defcustom apropos-label-face '(italic) "Face for label (`Command', `Variable' ...) in Apropos output. A value of nil means don't use any special font for them, and also turns off mouse highlighting." @@ -155,7 +155,17 @@ If value is `verbose', the computed score is shown for each match." "List of elc files already scanned in current run of `apropos-documentation'.") (defvar apropos-accumulator () - "Alist of symbols already found in current apropos run.") + "Alist of symbols already found in current apropos run. +Each element has the form + + (SYMBOL SCORE FUN-DOC VAR-DOC PLIST WIDGET-DOC FACE-DOC CUS-GROUP-DOC) + +where SYMBOL is the symbol name, SCORE is its relevance score (a +number), FUN-DOC is the function docstring, VAR-DOC is the +variable docstring, PLIST is the list of the symbols names in the +property list, WIDGET-DOC is the widget docstring, FACE-DOC is +the face docstring, and CUS-GROUP-DOC is the custom group +docstring. Each docstring is either nil or a string.") (defvar apropos-item () "Current item in or for `apropos-accumulator'.") @@ -187,6 +197,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-function 'apropos-label "Function" 'apropos-short-label "f" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this function" 'follow-link t 'action (lambda (button) @@ -195,6 +206,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-macro 'apropos-label "Macro" 'apropos-short-label "m" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this macro" 'follow-link t 'action (lambda (button) @@ -203,6 +215,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-command 'apropos-label "Command" 'apropos-short-label "c" + 'face '(font-lock-function-name-face button) 'help-echo "mouse-2, RET: Display more help on this command" 'follow-link t 'action (lambda (button) @@ -216,6 +229,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-variable 'apropos-label "Variable" 'apropos-short-label "v" + 'face '(font-lock-variable-name-face button) 'help-echo "mouse-2, RET: Display more help on this variable" 'follow-link t 'action (lambda (button) @@ -224,6 +238,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-face 'apropos-label "Face" 'apropos-short-label "F" + 'face '(font-lock-variable-name-face button) 'help-echo "mouse-2, RET: Display more help on this face" 'follow-link t 'action (lambda (button) @@ -232,6 +247,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-group 'apropos-label "Group" 'apropos-short-label "g" + 'face '(font-lock-builtin-face button) 'help-echo "mouse-2, RET: Display more help on this group" 'follow-link t 'action (lambda (button) @@ -241,14 +257,16 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-widget 'apropos-label "Widget" 'apropos-short-label "w" + 'face '(font-lock-builtin-face button) 'help-echo "mouse-2, RET: Display more help on this widget" 'follow-link t 'action (lambda (button) (widget-browse-other-window (button-get button 'apropos-symbol)))) (define-button-type 'apropos-plist - 'apropos-label "Plist" + 'apropos-label "Properties" 'apropos-short-label "p" + 'face '(font-lock-keyword-face button) 'help-echo "mouse-2, RET: Display more help on this plist" 'follow-link t 'action (lambda (button) @@ -636,15 +654,15 @@ thus be found in `load-history'." "(not documented)")) (when (boundp symbol) (apropos-documentation-property - symbol 'variable-documentation t)) - (when (setq properties (symbol-plist symbol)) - (setq doc (list (car properties))) - (while (setq properties (cdr (cdr properties))) - (setq doc (cons (car properties) doc))) - (mapconcat #'symbol-name (nreverse doc) " ")) - (when (get symbol 'widget-type) - (apropos-documentation-property - symbol 'widget-documentation t)) + symbol 'variable-documentation t)) + (when (setq properties (symbol-plist symbol)) + (setq doc (list (car properties))) + (while (setq properties (cdr (cdr properties))) + (setq doc (cons (car properties) doc))) + (mapconcat #'symbol-name (nreverse doc) " ")) + (when (get symbol 'widget-type) + (apropos-documentation-property + symbol 'widget-documentation t)) (when (facep symbol) (let ((alias (get symbol 'face-alias))) (if alias @@ -660,8 +678,8 @@ thus be found in `load-history'." (apropos-documentation-property symbol 'face-documentation t)))) (when (get symbol 'custom-group) - (apropos-documentation-property - symbol 'group-documentation t))))) + (apropos-documentation-property + symbol 'group-documentation t))))) symbols))) (apropos-print keys nil text))) @@ -976,15 +994,9 @@ If non-nil TEXT is a string that will be printed as a heading." symbol item) (set-buffer standard-output) (apropos-mode) - (if (display-mouse-p) - (insert - "If moving the mouse over text changes the text's color, " - "you can click\n" - "or press return on that text to get more information.\n")) - (insert "In this buffer, go to the name of the command, or function," - " or variable,\n" - (substitute-command-keys - "and type \\[apropos-follow] to get full documentation.\n\n")) + (insert (substitute-command-keys "Type \\[apropos-follow] on ") + (if apropos-multi-type "a type label" "an entry") + " to view its full documentation.\n\n") (if text (insert text "\n\n")) (dolist (apropos-item p) (when (and spacing (not (bobp))) @@ -1082,30 +1094,49 @@ If non-nil TEXT is a string that will be printed as a heading." (defun apropos-print-doc (i type do-keys) - (when (stringp (setq i (nth i apropos-item))) - (if apropos-compact-layout - (insert (propertize "\t" 'display '(space :align-to 32)) " ") - (insert " ")) - (if (null apropos-multi-type) - ;; If the query is only for a single type, there's no point - ;; writing it over and over again. Insert a blank button, and - ;; put the 'apropos-label property there (needed by - ;; apropos-symbol-button-display-help). - (insert-text-button + (let ((doc (nth i apropos-item))) + (when (stringp doc) + (if apropos-compact-layout + (insert (propertize "\t" 'display '(space :align-to 32)) " ") + (insert " ")) + (if apropos-multi-type + (let ((button-face (button-type-get type 'face))) + (unless (consp button-face) + (setq button-face (list button-face))) + (insert-text-button + (if apropos-compact-layout + (format "<%s>" (button-type-get type 'apropos-short-label)) + (button-type-get type 'apropos-label)) + 'type type + ;; Can't use the default button face, since user may have changed the + ;; variable! Just say `no' to variables containing faces! + 'face (append button-face apropos-label-face) + 'apropos-symbol (car apropos-item)) + (insert (if apropos-compact-layout " " ": "))) + + ;; If the query is only for a single type, there's no point + ;; writing it over and over again. Insert a blank button, and + ;; put the 'apropos-label property there (needed by + ;; apropos-symbol-button-display-help). + (insert-text-button " " 'type type 'skip t - 'face 'default 'apropos-symbol (car apropos-item)) - (insert-text-button - (if apropos-compact-layout - (format "<%s>" (button-type-get type 'apropos-short-label)) - (button-type-get type 'apropos-label)) - 'type type - ;; Can't use the default button face, since user may have changed the - ;; variable! Just say `no' to variables containing faces! - 'face apropos-label-face - 'apropos-symbol (car apropos-item)) - (insert (if apropos-compact-layout " " ": "))) - (insert (if do-keys (substitute-command-keys i) i)) - (or (bolp) (terpri)))) + 'face 'default 'apropos-symbol (car apropos-item))) + + (let ((opoint (point)) + (ocol (current-column))) + (cond ((equal doc "") + (setq doc "(not documented)")) + (do-keys + (setq doc (substitute-command-keys doc)))) + (insert doc) + (if (equal doc "(not documented)") + (put-text-property opoint (point) 'font-lock-face 'shadow)) + ;; The labeling buttons might make the line too long, so fill it if + ;; necessary. + (let ((fill-column (+ 5 emacs-lisp-docstring-fill-column)) + (fill-prefix (make-string ocol ?\s))) + (fill-region opoint (point) nil t))) + (or (bolp) (terpri))))) (defun apropos-follow () "Invokes any button at point, otherwise invokes the nearest label button." From c8d173eb1e2475af9d972efafb684f57f18c8374 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 23 Apr 2011 20:24:30 -0400 Subject: [PATCH 46/77] * files.el (auto-mode-alist): Use js-mode for .json (Bug#8529). --- lisp/ChangeLog | 2 ++ lisp/files.el | 1 + 2 files changed, 3 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4b8389877a2..c83f8d5102f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2011-04-24 Chong Yidong + * files.el (auto-mode-alist): Use js-mode for .json (Bug#8529). + * apropos.el (apropos-label-face): Avoid variable-pitch face. (apropos-accumulator): Doc fix. (apropos-function, apropos-macro, apropos-command) diff --git a/lisp/files.el b/lisp/files.el index 8cd5699eb9a..72cfc89ef8c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2386,6 +2386,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) ("\\.js\\'" . js-mode) ; javascript-mode would be better + ("\\.json\\'" . js-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix, MSDOG or VMS syntax. From fa6996bcd4d4c2acc4434e61bc266841c53e9d33 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 10:11:56 +0300 Subject: [PATCH 47/77] Delete char-direction-table and char-direction. See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00675.html for the reasons. src/character.c (Fchar_direction): Function deleted. (syms_of_character): Don't defsubr it. : Deleted. etc/NEWS: Document the removal. --- etc/NEWS | 9 ++++++++- src/ChangeLog | 6 ++++++ src/character.c | 18 ------------------ 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index aed90764fa1..09d54c41d69 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -134,7 +134,7 @@ image formats in Emacs. By default, Emacs links with the ImageMagick libraries if they are present at build time. This needs ImageMagick 6.2.8 or newer (versions newer than 6.0.7 _may_ work but have not been tested). To disable ImageMagick support, use the configure option -`--without-imagemagick'. +`--without-imagemagick'. The new function `imagemagick-types' returns a list of image file extensions that your installation of ImageMagick supports. The @@ -720,6 +720,13 @@ soap-inspect.el is an interactive inspector for SOAP WSDL structures. * Incompatible Lisp Changes in Emacs 24.1 +--- +** `char-direction-table' and the associated function `char-direction' +were deleted. They were buggy and inferior to the new support of +bidirectional editing introduced in Emacs 24. If you need the +bidirectional properties of a character, use `get-char-code-property' +with the last argument `bidi-class'. + ** `copy-directory' now copies the source directory as a subdirectory of the target directory, if the latter is an existing directory. The new optional arg COPY-CONTENTS, if non-nil, makes the function copy diff --git a/src/ChangeLog b/src/ChangeLog index 831fb6afcd0..e939a575c6a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-04-24 Eli Zaretskii + + * character.c (Fchar_direction): Function deleted. + (syms_of_character): Don't defsubr it. + : Deleted. + 2011-04-23 Eli Zaretskii Fix doprnt so it could be used again safely in `verror'. (Bug#8435) diff --git a/src/character.c b/src/character.c index 6d27371c7e9..8bab709480b 100644 --- a/src/character.c +++ b/src/character.c @@ -493,19 +493,6 @@ usage: (string-width STRING) */) return val; } -DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0, - doc: /* Return the direction of CHAR. -The returned value is 0 for left-to-right and 1 for right-to-left. -usage: (char-direction CHAR) */) - (Lisp_Object ch) -{ - int c; - - CHECK_CHARACTER (ch); - c = XINT (ch); - return CHAR_TABLE_REF (Vchar_direction_table, c); -} - /* Return the number of characters in the NBYTES bytes at PTR. This works by looking at the contents and checking for multibyte sequences while assuming that there's no invalid sequence. @@ -1037,7 +1024,6 @@ syms_of_character (void) defsubr (&Smultibyte_char_to_unibyte); defsubr (&Schar_width); defsubr (&Sstring_width); - defsubr (&Schar_direction); defsubr (&Sstring); defsubr (&Sunibyte_string); defsubr (&Schar_resolve_modifiers); @@ -1066,10 +1052,6 @@ A char-table for width (columns) of each character. */); char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR, make_number (4)); - DEFVAR_LISP ("char-direction-table", Vchar_direction_table, - doc: /* A char-table for direction of each character. */); - Vchar_direction_table = Fmake_char_table (Qnil, make_number (1)); - DEFVAR_LISP ("printable-chars", Vprintable_chars, doc: /* A char-table for each printable character. */); Vprintable_chars = Fmake_char_table (Qnil, Qnil); From f1052e5d1b134c255b4fe7cd948681a0a9af9b63 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 10:15:17 +0300 Subject: [PATCH 48/77] Fix a minor bug in src/makefile.w32-in. src/makefile.w32-in (globals.h): Add a dummy recipe, to make any changes in globals.h immediately force recompilation. --- src/ChangeLog | 3 +++ src/makefile.w32-in | 1 + 2 files changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index e939a575c6a..537acb712b9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,8 @@ 2011-04-24 Eli Zaretskii + * makefile.w32-in (globals.h): Add a dummy recipe, to make any + changes in globals.h immediately force recompilation. + * character.c (Fchar_direction): Function deleted. (syms_of_character): Don't defsubr it. : Deleted. diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 9d2c3d8f83f..eebc4006bc3 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -225,6 +225,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ obj = $(GLOBAL_SOURCES:.c=.o) globals.h: gl-stamp + @cmd /c rem true gl-stamp: ../lib-src/$(BLD)/make-docfile.exe $(GLOBAL_SOURCES) - $(DEL) gl-tmp From 762b15be8c7925c661e839fa41d46189513dfda6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 12:00:03 +0300 Subject: [PATCH 49/77] Fallout from resurrecting doprnt. src/doc.c (get_doc_string): Improve the format passed to `error'. src/doprnt.c (doprnt): Improve commentary. src/term.c (init_tty) [MSDOS]: Fix 1st argument to maybe_fatal. src/Makefile.in (TAGS): Depend on $(M_FILE) and $(S_FILE), and scan them with etags. src/makefile.w32-in (TAGS): Depend on $(CURDIR)/m/intel386.h and $(CURDIR)/s/ms-w32.h. (TAGS-gmake): Scan $(CURDIR)/m/intel386.h and $(CURDIR)/s/ms-w32.h. --- src/ChangeLog | 12 ++++++++++++ src/Makefile.in | 4 ++-- src/doc.c | 4 +++- src/doprnt.c | 33 +++++++++++++++++++++++++++++++-- src/makefile.w32-in | 4 ++-- src/term.c | 4 ++-- 6 files changed, 52 insertions(+), 9 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 537acb712b9..478a5aa2512 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,7 +1,19 @@ 2011-04-24 Eli Zaretskii + * doc.c (get_doc_string): Improve the format passed to `error'. + + * doprnt.c (doprnt): Improve commentary. + + * term.c (init_tty) [MSDOS]: Fix 1st argument to maybe_fatal. + + * Makefile.in (TAGS): Depend on $(M_FILE) and $(S_FILE), and scan + them with etags. + * makefile.w32-in (globals.h): Add a dummy recipe, to make any changes in globals.h immediately force recompilation. + (TAGS): Depend on $(CURDIR)/m/intel386.h and + $(CURDIR)/s/ms-w32.h. + (TAGS-gmake): Scan $(CURDIR)/m/intel386.h and $(CURDIR)/s/ms-w32.h. * character.c (Fchar_direction): Function deleted. (syms_of_character): Don't defsubr it. diff --git a/src/Makefile.in b/src/Makefile.in index e1195968f7f..8b596430cf5 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -748,10 +748,10 @@ extraclean: distclean ctagsfiles1 = [xyzXYZ]*.[hcm] ctagsfiles2 = [a-wA-W]*.[hcm] -TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) +TAGS: $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE) ../lib-src/etags --include=TAGS-LISP --include=$(lwlibdir)/TAGS \ --regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \ - $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) + $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2) $(M_FILE) $(S_FILE) frc: TAGS-LISP: frc $(MAKE) -f $(lispdir)/Makefile TAGS-LISP ETAGS=../lib-src/etags diff --git a/src/doc.c b/src/doc.c index 354aff84979..4b75deaba5c 100644 --- a/src/doc.c +++ b/src/doc.c @@ -253,7 +253,9 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition) else if (c == '_') *to++ = 037; else - error ("Invalid data in documentation file -- ^A followed by code 0%o", c); + error ("\ +Invalid data in documentation file -- %c followed by code %03o", + 1, (unsigned)c); } else *to++ = *from++; diff --git a/src/doprnt.c b/src/doprnt.c index f182529b801..f124db13221 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -1,6 +1,6 @@ /* Output like sprintf to a buffer of specified size. - Also takes args differently: pass one pointer to an array of strings - in addition to the format string which is separate. + Also takes args differently: pass one pointer to the end + of the format string in addition to the format string itself. Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,6 +18,35 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +/* If you think about replacing this with some similar standard C function of + the printf family (such as vsnprintf), please note that this function + supports the following Emacs-specific features: + + . For %c conversions, it produces a string with the multibyte representation + of the (`int') argument, suitable for display in an Emacs buffer. + + . For %s and %c, when field width is specified (e.g., %25s), it accounts for + the diplay width of each character, according to char-width-table. That + is, it does not assume that each character takes one column on display. + + . If the size of the buffer is not enough to produce the formatted string in + its entirety, it makes sure that truncation does not chop the last + character in the middle of its multibyte sequence, producing an invalid + sequence. + + . It accepts a pointer to the end of the format string, so the format string + could include embedded null characters. + + . It signals an error if the length of the formatted string is about to + overflow MOST_POSITIVE_FIXNUM, to avoid producing strings longer than what + Emacs can handle. + + OTOH, this function supports only a small subset of the standard C formatted + output facilities. E.g., %u and %ll are not supported, and precision is + largely ignored except for converting floating-point values. However, this + is okay, as this function is supposed to be called from `error' and similar + functions, and thus does not need to support features beyond those in + `Fformat', which is used by `error' on the Lisp level. */ #include #include diff --git a/src/makefile.w32-in b/src/makefile.w32-in index eebc4006bc3..0dd06b7efc3 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -330,7 +330,7 @@ cleanall: clean ## ## This works only with GNU Make. -TAGS: $(OBJ0) $(OBJ1) $(OBJ2) +TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h $(MAKE) $(MFLAGS) TAGS-$(MAKETYPE) TAGS-LISP: $(OBJ0) $(OBJ1) $(OBJ2) @@ -344,7 +344,7 @@ TAGS-gmake: $(patsubst $(BLD)%.$(O),$(CURDIR)%.c,$(OBJ1)) ../lib-src/$(BLD)/etags.exe -a --regex=@../nt/emacs-src.tags \ $(patsubst $(BLD)%.$(O),$(CURDIR)%.c,$(OBJ2)) \ - $(CURDIR)/*.h + $(CURDIR)/*.h $(CURDIR)/m/intel386.h $(CURDIR)/s/ms-w32.h TAGS-nmake: echo This target is not supported with NMake diff --git a/src/term.c b/src/term.c index cae83f4d269..28709138a17 100644 --- a/src/term.c +++ b/src/term.c @@ -3121,7 +3121,7 @@ init_tty (const char *name, const char *terminal_type, int must_succeed) terminal = create_terminal (); #ifdef MSDOS if (been_here > 0) - maybe_fatal (1, 0, "Attempt to create another terminal %s", "", + maybe_fatal (0, 0, "Attempt to create another terminal %s", "", name, ""); been_here = 1; tty = &the_only_display_info; @@ -3627,7 +3627,7 @@ vfatal (const char *str, va_list ap) /* Auxiliary error-handling function for init_tty. Delete TERMINAL, then call error or fatal with str1 or str2, - respectively, according to MUST_SUCCEED. */ + respectively, according to whether MUST_SUCCEED is zero or not. */ static void maybe_fatal (int must_succeed, struct terminal *terminal, From 1b2de274591d07480256539c4be65299d1dde3e9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 15:48:30 +0300 Subject: [PATCH 50/77] Repair the MSDOS build following latest changes. msdos/sedlibmk.inp (am_libgnu_a_OBJECTS): Edit out allocator.$(OBJEXT). Add editing for the new GNULIB_* and REPLACE_* variables. src/msdos.c (XMenuActivate, XMenuAddSelection): Adjust argument list to changes in oldXMenu/XMenu.h from 2011-04-16. : Constify. (IT_menu_make_room): menu->help_text is now `const char **'; adjust. src/msdos.h (XMenuActivate, XMenuAddSelection): Adjust prototypes to changes in oldXMenu/XMenu.h from 2011-04-16. (struct XMenu): Declare `help_text' `const char **'. src/xfaces.c : Make extern again. src/syntax.c: Include sys/types.h before including regex.h, as required by Posix. --- msdos/ChangeLog | 6 ++++++ msdos/sedlibmk.inp | 18 +++++++++++++++++- src/ChangeLog | 15 +++++++++++++++ src/msdos.c | 10 +++++----- src/msdos.h | 8 ++++---- src/syntax.c | 2 ++ src/xfaces.c | 2 +- 7 files changed, 50 insertions(+), 11 deletions(-) diff --git a/msdos/ChangeLog b/msdos/ChangeLog index ebac5b288b6..5c345de5e35 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,9 @@ +2011-04-24 Eli Zaretskii + + * sedlibmk.inp (am_libgnu_a_OBJECTS): Edit out + allocator.$(OBJEXT). Add editing for the new GNULIB_* and + REPLACE_* variables. + 2011-04-06 Eli Zaretskii * sedlibmk.inp: Update checklist. diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index df4dd7ddf75..92313b96421 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -36,7 +36,7 @@ # /^STDDEF_H *=/s/@[^@\n]*@// -- stddef.h is not needed # # . Some of the headers are generated conditionally, and the -# corresponding recipes are guarder by @GL_GENERATE_xxxx_H_TRUE@ +# corresponding recipes are guarded by @GL_GENERATE_xxxx_H_TRUE@ # and @GL_GENERATE_xxxx_H_FALSE@. Depending on whether DJGPP uses # the corresponding header, these should be edited either to # nothing (thus exposing the recipe) or to #, which comments the @@ -160,13 +160,17 @@ am__cd = cd /^GNULIB_FCHMODAT *=/s/@GNULIB_FCHMODAT@/0/ /^GNULIB_FCLOSE *=/s/@GNULIB_FCLOSE@/0/ /^GNULIB_FFLUSH *=/s/@GNULIB_FFLUSH@/0/ +/^GNULIB_FGETC *=/s/@GNULIB_FGETC@/0/ +/^GNULIB_FGETS *=/s/@GNULIB_FGETS@/0/ /^GNULIB_FOPEN *=/s/@GNULIB_FOPEN@/0/ /^GNULIB_FPRINTF *=/s/@GNULIB_FPRINTF@/0/ /^GNULIB_FPRINTF_POSIX *=/s/@GNULIB_FPRINTF_POSIX@/0/ /^GNULIB_FPURGE *=/s/@GNULIB_FPURGE@/0/ /^GNULIB_FPUTC *=/s/@GNULIB_FPUTC@/0/ /^GNULIB_FPUTS *=/s/@GNULIB_FPUTS@/0/ +/^GNULIB_FREAD *=/s/@GNULIB_FREAD@/0/ /^GNULIB_FREOPEN *=/s/@GNULIB_FREOPEN@/0/ +/^GNULIB_FSCANF *=/s/@GNULIB_FSCANF@/0/ /^GNULIB_FSEEK *=/s/@GNULIB_FSEEK@/0/ /^GNULIB_FSEEKO *=/s/@GNULIB_FSEEKO@/0/ /^GNULIB_FSTATAT *=/s/@GNULIB_FSTATAT@/0/ @@ -176,6 +180,8 @@ am__cd = cd /^GNULIB_FTRUNCATE *=/s/@GNULIB_FTRUNCATE@/0/ /^GNULIB_FUTIMENS *=/s/@GNULIB_FUTIMENS@/0/ /^GNULIB_FWRITE *=/s/@GNULIB_FWRITE@/0/ +/^GNULIB_GETC *=/s/@GNULIB_GETC@/0/ +/^GNULIB_GETCHAR *=/s/@GNULIB_GETCHAR@/0/ /^GNULIB_GETCWD *=/s/@GNULIB_GETCWD@/0/ /^GNULIB_GETDELIM *=/s/@GNULIB_GETDELIM@/0/ /^GNULIB_GETDOMAINNAME *=/s/@GNULIB_GETDOMAINNAME@/0/ @@ -187,6 +193,7 @@ am__cd = cd /^GNULIB_GETLOGIN *=/s/@GNULIB_GETLOGIN@/0/ /^GNULIB_GETLOGIN_R *=/s/@GNULIB_GETLOGIN_R@/0/ /^GNULIB_GETPAGESIZE *=/s/@GNULIB_GETPAGESIZE@/0/ +/^GNULIB_GETS *=/s/@GNULIB_GETS@/0/ /^GNULIB_GETSUBOPT *=/s/@GNULIB_GETSUBOPT@/0/ /^GNULIB_GETUSERSHELL *=/s/@GNULIB_GETUSERSHELL@/0/ /^GNULIB_GRANTPT *=/s/@GNULIB_GRANTPT@/0/ @@ -226,6 +233,7 @@ am__cd = cd /^GNULIB_PUTS *=/s/@GNULIB_PUTS@/0/ /^GNULIB_PWRITE *=/s/@GNULIB_PWRITE@/0/ /^GNULIB_RANDOM_R *=/s/@GNULIB_RANDOM_R@/0/ +/^GNULIB_READ *=/s/@GNULIB_READ@/0/ /^GNULIB_READLINK *=/s/@GNULIB_READLINK@/0/ /^GNULIB_READLINKAT *=/s/@GNULIB_READLINKAT@/0/ /^GNULIB_REALLOC_POSIX *=/s/@GNULIB_REALLOC_POSIX@/0/ @@ -235,11 +243,13 @@ am__cd = cd /^GNULIB_RENAMEAT *=/s/@GNULIB_RENAMEAT@/0/ /^GNULIB_RMDIR *=/s/@GNULIB_RMDIR@/0/ /^GNULIB_RPMATCH *=/s/@GNULIB_RPMATCH@/0/ +/^GNULIB_SCANF *=/s/@GNULIB_SCANF@/0/ /^GNULIB_SETENV *=/s/@GNULIB_SETENV@/0/ /^GNULIB_SLEEP *=/s/@GNULIB_SLEEP@/0/ /^GNULIB_SNPRINTF *=/s/@GNULIB_SNPRINTF@/0/ /^GNULIB_SPRINTF_POSIX *=/s/@GNULIB_SPRINTF_POSIX@/0/ /^GNULIB_STAT *=/s/@GNULIB_STAT@/0/ +/^GNULIB_STDIO_H_NONBLOCKING *=/s/@GNULIB_STDIO_H_NONBLOCKING@/0/ /^GNULIB_STDIO_H_SIGPIPE *=/s/@GNULIB_STDIO_H_SIGPIPE@/0/ /^GNULIB_STRPTIME *=/s/@GNULIB_STRPTIME@/0/ /^GNULIB_STRTOD *=/s/@GNULIB_STRTOD@/0/ @@ -253,6 +263,7 @@ am__cd = cd /^GNULIB_TMPFILE *=/s/@GNULIB_TMPFILE@/0/ /^GNULIB_TTYNAME_R *=/s/@GNULIB_TTYNAME_R@/0/ /^GNULIB_UNISTD_H_GETOPT *=/s/@GNULIB_UNISTD_H_GETOPT@/1/ +/^GNULIB_UNISTD_H_NONBLOCKING *=/s/@GNULIB_UNISTD_H_NONBLOCKING@/0/ /^GNULIB_UNISTD_H_SIGPIPE *=/s/@GNULIB_UNISTD_H_SIGPIPE@/0/ /^GNULIB_UNLINK *=/s/@GNULIB_UNLINK@/0/ /^GNULIB_UNLINKAT *=/s/@GNULIB_UNLINKAT@/0/ @@ -264,8 +275,10 @@ am__cd = cd /^GNULIB_VDPRINTF *=/s/@GNULIB_VDPRINTF@/0/ /^GNULIB_VFPRINTF *=/s/@GNULIB_VFPRINTF@/0/ /^GNULIB_VFPRINTF_POSIX *=/s/@GNULIB_VFPRINTF_POSIX@/0/ +/^GNULIB_VFSCANF *=/s/@GNULIB_VFSCANF@/0/ /^GNULIB_VPRINTF *=/s/@GNULIB_VPRINTF@/0/ /^GNULIB_VPRINTF_POSIX *=/s/@GNULIB_VPRINTF_POSIX@/0/ +/^GNULIB_VSCANF *=/s/@GNULIB_VSCANF@/0/ /^GNULIB_VSNPRINTF *=/s/@GNULIB_VSNPRINTF@/0/ /^GNULIB_VSPRINTF_POSIX *=/s/@GNULIB_VSPRINTF_POSIX@/0/ /^GNULIB_WCTOMB *=/s/@GNULIB_WCTOMB@/0/ @@ -457,6 +470,7 @@ am__cd = cd /^REPLACE_PRINTF *=/s/@REPLACE_PRINTF@/0/ /^REPLACE_PUTENV *=/s/@REPLACE_PUTENV@/0/ /^REPLACE_PWRITE *=/s/@REPLACE_PWRITE@/0/ +/^REPLACE_READ *=/s/@REPLACE_READ@/0/ /^REPLACE_READLINK *=/s/@REPLACE_READLINK@/0/ /^REPLACE_REALLOC *=/s/@REPLACE_REALLOC@/0/ /^REPLACE_REALPATH *=/s/@REPLACE_REALPATH@/0/ @@ -469,6 +483,7 @@ am__cd = cd /^REPLACE_SNPRINTF *=/s/@REPLACE_SNPRINTF@/0/ /^REPLACE_SPRINTF *=/s/@REPLACE_SPRINTF@/0/ /^REPLACE_STAT *=/s/@REPLACE_STAT@/0/ +/^REPLACE_STDIO_READ_FUNCS *=/s/@REPLACE_STDIO_READ_FUNCS@/0/ /^REPLACE_STDIO_WRITE_FUNCS *=/s/@REPLACE_STDIO_WRITE_FUNCS@/0/ /^REPLACE_STRTOD *=/s/@REPLACE_STRTOD@/0/ /^REPLACE_SYMLINK *=/s/@REPLACE_SYMLINK@/0/ @@ -501,6 +516,7 @@ am__cd = cd /^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@// /^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o md5.o filemode.o/ /^am_libgnu_a_OBJECTS *=/s/careadlinkat.\$(OBJEXT)// +/^am_libgnu_a_OBJECTS *=/s/allocator.\$(OBJEXT)// /^srcdir *=/s/@[^@\n]*@/./ /^top_srcdir *=/s/@[^@\n]*@/../ /^top_builddir *=/s/@[^@\n]*@/../ diff --git a/src/ChangeLog b/src/ChangeLog index 478a5aa2512..7efd8dad6cc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,20 @@ 2011-04-24 Eli Zaretskii + * msdos.c (XMenuActivate, XMenuAddSelection): Adjust argument list + to changes in oldXMenu/XMenu.h from 2011-04-16. + : Constify. + (IT_menu_make_room): menu->help_text is now `const char **'; + adjust. + + * msdos.h (XMenuActivate, XMenuAddSelection): Adjust prototypes + to changes in oldXMenu/XMenu.h from 2011-04-16. + (struct XMenu): Declare `help_text' `const char **'. + + * xfaces.c : Make extern again. + + * syntax.c: Include sys/types.h before including regex.h, as + required by Posix. + * doc.c (get_doc_string): Improve the format passed to `error'. * doprnt.c (doprnt): Improve commentary. diff --git a/src/msdos.c b/src/msdos.c index 6bff56b3f82..3dc586e42f5 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2812,7 +2812,7 @@ dos_keyread (void) left), but I don't think it's worth the effort. */ /* These hold text of the current and the previous menu help messages. */ -static char *menu_help_message, *prev_menu_help_message; +static const char *menu_help_message, *prev_menu_help_message; /* Pane number and item number of the menu item which generated the last menu help message. */ static int menu_help_paneno, menu_help_itemno; @@ -2839,7 +2839,7 @@ IT_menu_make_room (XMenu *menu) menu->text = (char **) xmalloc (count * sizeof (char *)); menu->submenu = (XMenu **) xmalloc (count * sizeof (XMenu *)); menu->panenumber = (int *) xmalloc (count * sizeof (int)); - menu->help_text = (char **) xmalloc (count * sizeof (char *)); + menu->help_text = (const char **) xmalloc (count * sizeof (char *)); } else if (menu->allocated == menu->count) { @@ -2851,7 +2851,7 @@ IT_menu_make_room (XMenu *menu) menu->panenumber = (int *) xrealloc (menu->panenumber, count * sizeof (int)); menu->help_text - = (char **) xrealloc (menu->help_text, count * sizeof (char *)); + = (const char **) xrealloc (menu->help_text, count * sizeof (char *)); } } @@ -3033,7 +3033,7 @@ XMenuAddPane (Display *foo, XMenu *menu, const char *txt, int enable) int XMenuAddSelection (Display *bar, XMenu *menu, int pane, - int foo, char *txt, int enable, char *help_text) + int foo, char *txt, int enable, char const *help_text) { int len; char *p; @@ -3086,7 +3086,7 @@ struct IT_menu_state int XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx, int x0, int y0, unsigned ButtonMask, char **txt, - void (*help_callback)(char *, int, int)) + void (*help_callback)(char const *, int, int)) { struct IT_menu_state *state; int statecount, x, y, i, b, screensize, leave, result, onepane; diff --git a/src/msdos.h b/src/msdos.h index 5051f2f3837..3048b5f7e35 100644 --- a/src/msdos.h +++ b/src/msdos.h @@ -101,16 +101,16 @@ typedef struct x_menu_struct int allocated; int panecount; int width; - char **help_text; + const char **help_text; } XMenu; XMenu *XMenuCreate (Display *, Window, char *); -int XMenuAddPane (Display *, XMenu *, const char *, int); -int XMenuAddSelection (Display *, XMenu *, int, int, char *, int, char *); +int XMenuAddPane (Display *, XMenu *, char const *, int); +int XMenuAddSelection (Display *, XMenu *, int, int, char *, int, char const *); void XMenuLocate (Display *, XMenu *, int, int, int, int, int *, int *, int *, int *); int XMenuActivate (Display *, XMenu *, int *, int *, int, int, unsigned, - char **, void (*callback)(char *, int, int)); + char **, void (*callback)(char const *, int, int)); void XMenuDestroy (Display *, XMenu *); #endif /* not HAVE_X_WINDOWS */ diff --git a/src/syntax.c b/src/syntax.c index 4be6b8db140..9013a897dd0 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -19,7 +19,9 @@ along with GNU Emacs. If not, see . */ #include + #include +#include #include #include "lisp.h" #include "commands.h" diff --git a/src/xfaces.c b/src/xfaces.c index fbed183522a..8e68b05cd87 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -331,7 +331,7 @@ Lisp_Object Qexpanded; static Lisp_Object Qultra_expanded; static Lisp_Object Qreleased_button, Qpressed_button; static Lisp_Object QCstyle, QCcolor, QCline_width; -static Lisp_Object Qunspecified; +Lisp_Object Qunspecified; /* used in dosfns.c */ static Lisp_Object Qignore_defface; char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; From e2ad650c71e9f0477163532e708e1054452fa34f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 19:28:57 +0300 Subject: [PATCH 51/77] Minor cleanup in src/textprop.c. src/textprop.c (syms_of_textprop): Remove dead code. (copy_text_properties): Delete obsolete commentary about an interface that was deleted long ago. Fix typos in the description of arguments. --- src/ChangeLog | 5 +++++ src/textprop.c | 12 ++---------- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 7efd8dad6cc..f4dd3492001 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-04-24 Eli Zaretskii + * textprop.c (syms_of_textprop): Remove dead code. + (copy_text_properties): Delete obsolete commentary about an + interface that was deleted long ago. Fix typos in the description + of arguments. + * msdos.c (XMenuActivate, XMenuAddSelection): Adjust argument list to changes in oldXMenu/XMenu.h from 2011-04-16. : Constify. diff --git a/src/textprop.c b/src/textprop.c index 1c56dfc0cf0..a224c121e21 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1756,15 +1756,9 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) } -/* I don't think this is the right interface to export; how often do you - want to do something like this, other than when you're copying objects - around? +/* Copying properties between objects. */ - I think it would be better to have a pair of functions, one which - returns the text properties of a region as a list of ranges and - plists, and another which applies such a list to another object. */ - -/* Add properties from SRC to SRC of SRC, starting at POS in DEST. +/* Add properties from START to END of SRC, starting at POS in DEST. SRC and DEST may each refer to strings or buffers. Optional sixth argument PROP causes only that property to be copied. Properties are copied to DEST as if by `add-text-properties'. @@ -2304,6 +2298,4 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and defsubr (&Sremove_list_of_text_properties); defsubr (&Stext_property_any); defsubr (&Stext_property_not_all); -/* defsubr (&Serase_text_properties); */ -/* defsubr (&Scopy_text_properties); */ } From eb35682e38e8a13f776f61c1c5f53cac425495cc Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 24 Apr 2011 19:59:37 +0300 Subject: [PATCH 52/77] Minor cleanup in src/xdisp.c. src/xdisp.c (handle_single_display_spec): Rename the display_replaced_before_p argument into display_replaced_p, to make it consistent with the commentary. Fix typos in the commentary. --- src/ChangeLog | 5 +++++ src/xdisp.c | 8 ++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index f4dd3492001..f1d195c4544 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-04-24 Eli Zaretskii + * xdisp.c (handle_single_display_spec): Rename the + display_replaced_before_p argument into display_replaced_p, to + make it consistent with the commentary. Fix typos in the + commentary. + * textprop.c (syms_of_textprop): Remove dead code. (copy_text_properties): Delete obsolete commentary about an interface that was deleted long ago. Fix typos in the description diff --git a/src/xdisp.c b/src/xdisp.c index 91d1b6ea2e3..219f414c9e8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3855,7 +3855,7 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) } -/* Set up IT from a single `display' specification PROP. OBJECT +/* Set up IT from a single `display' property specification SPEC. OBJECT is the object in which the `display' property was found. *POSITION is the position at which it was found. DISPLAY_REPLACED_P non-zero means that we previously saw a display specification which already @@ -3865,7 +3865,7 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) OVERLAY is the overlay this `display' property came from, or nil if it was a text property. - If PROP is a `space' or `image' specification, and in some other + If SPEC is a `space' or `image' specification, and in some other cases too, set *POSITION to the position where the `display' property ends. @@ -3875,7 +3875,7 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) static int handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object overlay, struct text_pos *position, - int display_replaced_before_p) + int display_replaced_p) { Lisp_Object form; Lisp_Object location, value; @@ -4171,7 +4171,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #endif /* not HAVE_WINDOW_SYSTEM */ || (CONSP (value) && EQ (XCAR (value), Qspace))); - if (valid_p && !display_replaced_before_p) + if (valid_p && !display_replaced_p) { /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ From 6f68a3a29e621368e6b726dcd11532140695dbad Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 24 Apr 2011 14:34:57 -0400 Subject: [PATCH 53/77] Revert undocumented change to .dir-locals.el in 2011-04-01T17:19:52Z!monnier@iro.umontreal.ca. This bumped fill-column from 70 to 79, but was not documented in the commit log, and appears to be a mistake. --- .dir-locals.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.dir-locals.el b/.dir-locals.el index 86410cc8f40..f098f3e7460 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,6 +1,6 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 79))) + (fill-column . 70))) (c-mode . ((c-file-style . "GNU"))) ;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work. ;; See admin/notes/bugtracker. From 7031be6d49cb78d4cc4a2604b899144824abfeca Mon Sep 17 00:00:00 2001 From: Uday S Reddy Date: Sun, 24 Apr 2011 14:47:17 -0400 Subject: [PATCH 54/77] Fix next-file command in etags.el. * lisp/progmodes/etags.el (next-file): Don't use set-buffer to change buffers (Bug#8478). * doc/lisp/maintaining.texi (List Tags): Document next-file. --- doc/emacs/ChangeLog | 5 +++++ doc/emacs/maintaining.texi | 6 ++++++ lisp/ChangeLog | 5 +++++ lisp/progmodes/etags.el | 4 ++-- 4 files changed, 18 insertions(+), 2 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 37825382788..92cd765b492 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2011-04-24 Chong Yidong + + * maintaining.texi (List Tags): Document next-file. Suggested by + Uday S Reddy. + 2011-04-23 Juanma Barranquero * mini.texi (Minibuffer Edit): diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8f395ba9563..dafc9327c74 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2326,6 +2326,12 @@ details. You can also use the collection of tag names to complete a symbol name in the buffer. @xref{Symbol Completion}. + You can use @kbd{M-x next-file} to visit the files in the selected +tags table. The first time this command is called, it visits the +first file in the tags table. Each subsequent call visits the next +file in the table, unless a prefix argument is supplied, in which case +it returns to the first file. + @node EDE @section Emacs Development Environment @cindex EDE (Emacs Development Environment) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c83f8d5102f..efbd08ae6e9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-24 Uday S Reddy (tiny change) + + * progmodes/etags.el (next-file): Don't use set-buffer to change + buffers (Bug#8478). + 2011-04-24 Chong Yidong * files.el (auto-mode-alist): Use js-mode for .json (Bug#8529). diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 49a2971a92a..6bd2de992cb 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1756,9 +1756,9 @@ if the file was newly read in, the value is the filename." (with-current-buffer buffer (revert-buffer t t))) (if (not (and new novisit)) - (set-buffer (find-file-noselect next novisit)) + (find-file next novisit) ;; Like find-file, but avoids random warning messages. - (set-buffer (get-buffer-create " *next-file*")) + (switch-to-buffer (get-buffer-create " *next-file*")) (kill-all-local-variables) (erase-buffer) (setq new next) From 3ba7869ce8386d79d21f8e6f7d3c23088f9838ce Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 24 Apr 2011 15:37:47 -0400 Subject: [PATCH 55/77] Add vc-annotate-goto-line. * vc/vc-annotate.el (vc-annotate-goto-line): New command. Based on a previous implementation by Juanma Barranquero (Bug#8366). (vc-annotate-mode-map): Bind it to RET. --- lisp/ChangeLog | 6 ++++++ lisp/vc/vc-annotate.el | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index efbd08ae6e9..d7eb33fd9a5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2011-04-24 Chong Yidong + + * vc/vc-annotate.el (vc-annotate-goto-line): New command. Based + on a previous implementation by Juanma Barranquero (Bug#8366). + (vc-annotate-mode-map): Bind it to RET. + 2011-04-24 Uday S Reddy (tiny change) * progmodes/etags.el (next-file): Don't use set-buffer to change diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 271fce12429..abd3806d02f 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -128,6 +128,8 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." (define-key m "p" 'vc-annotate-prev-revision) (define-key m "w" 'vc-annotate-working-revision) (define-key m "v" 'vc-annotate-toggle-annotation-visibility) + (define-key m "v" 'vc-annotate-toggle-annotation-visibility) + (define-key m "\C-m" 'vc-annotate-goto-line) m) "Local keymap used for VC-Annotate mode.") @@ -673,6 +675,36 @@ The annotations are relative to the current time, unless overridden by OFFSET." ;; Pretend to font-lock there were no matches. nil) +(defun vc-annotate-goto-line () + "Go to the line corresponding to the current VC Annotate line." + (interactive) + (unless (eq major-mode 'vc-annotate-mode) + (error "Not in a VC-Annotate buffer")) + (let ((line (save-restriction + (widen) + (line-number-at-pos))) + (rev vc-annotate-parent-rev)) + (pop-to-buffer + (or (and (buffer-live-p vc-parent-buffer) + vc-parent-buffer) + (and (file-exists-p vc-annotate-parent-file) + (find-file-noselect vc-annotate-parent-file)) + (error "File not found: %s" vc-annotate-parent-file))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (recenter)) + ;; Issue a warning if the lines might be incorrect. + (cond + ((buffer-modified-p) + (message "Buffer modified; annotated line numbers may be incorrect")) + ((not (eq (vc-state buffer-file-name) 'up-to-date)) + (message "File is not up-to-date; annotated line numbers may be incorrect")) + ((not (equal rev (vc-working-revision buffer-file-name))) + (message "Annotations were for revision %s; line numbers may be incorrect" + rev))))) + (provide 'vc-annotate) ;;; vc-annotate.el ends here From 512e3ae1e91c45a8c49baf1b7ebd09616890b42f Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 24 Apr 2011 16:32:23 -0400 Subject: [PATCH 56/77] Restore ability to show a restricted list of packages in Package Menu. * emacs-lisp/package.el (package-built-in-p): Fix typo. (package-menu--generate): New arg specifying packages to show. (package-menu-refresh, package-menu-execute, list-packages): Callers changed. (package-show-package-list): New function. * finder.el (finder-list-matches): Use package-show-package-list instead of deleted package--list-packages. --- lisp/ChangeLog | 10 +++++++ lisp/emacs-lisp/package.el | 58 ++++++++++++++++++++++++-------------- lisp/finder.el | 2 +- 3 files changed, 48 insertions(+), 22 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d7eb33fd9a5..4d4c93841e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,15 @@ 2011-04-24 Chong Yidong + * emacs-lisp/package.el (package-built-in-p): Fix typo. + (package-menu--generate): New arg specifying packages to show. + (package-menu-refresh, package-menu-execute, list-packages): + Callers changed. + (package-show-package-list): New function, replacing deleted + package--list-packages (renamed because it is non-internal). + + * finder.el (finder-list-matches): Use package-show-package-list + instead of deleted package--list-packages. + * vc/vc-annotate.el (vc-annotate-goto-line): New command. Based on a previous implementation by Juanma Barranquero (Bug#8366). (vc-annotate-mode-map): Bind it to RET. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bdb40dd9dff..e42103a7a01 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -84,10 +84,6 @@ ;; can see what packages are available. This will automatically ;; fetch the latest list of packages from ELPA. ;; -;; M-x package-list-packages-no-fetch -;; Like package-list-packages, but does not automatically fetch the -;; new list of packages. -;; ;; M-x package-install-from-buffer ;; Install a package consisting of a single .el file that appears ;; in the current buffer. This only works for packages which @@ -462,7 +458,7 @@ Optional arg MIN-VERSION, if non-nil, should be a version list specifying the minimum acceptable version." (require 'finder-inf nil t) ; For `package--builtins'. (let ((elt (assq package package--builtins))) - (and elt (min-version-<= min-version (package-desc-vers (cdr elt)))))) + (and elt (version-list-<= min-version (package-desc-vers (cdr elt)))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at @@ -1344,38 +1340,45 @@ a symbol and VERSION-LIST is a version list." (unless (assoc key ,listname) (push (list key ,status (package-desc-doc ,desc)) ,listname)))) -(defun package-menu--generate (&optional remember-pos) +(defun package-menu--generate (remember-pos packages) "Populate the Package Menu. -Optional argument REMEMBER-POS, if non-nil, means to move point -to the entry as before." +If REMEMBER-POS is non-nil, keep point on the same entry. +PACKAGES should be t, which means to display all known packages, +or a list of package names (symbols) to display." ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION). (let (info-list name builtin) ;; Installed packages: (dolist (elt package-alist) (setq name (car elt)) - (package--push name (cdr elt) - (if (stringp (cadr (assq name package-load-list))) - "held" "installed") - info-list)) + (when (or (eq packages t) (memq name packages)) + (package--push name (cdr elt) + (if (stringp (cadr (assq name package-load-list))) + "held" "installed") + info-list))) ;; Built-in packages: (dolist (elt package--builtins) (setq name (car elt)) - (unless (eq name 'emacs) ; Hide the `emacs' package. + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or (eq packages t) (memq name packages))) (package--push name (cdr elt) "built-in" info-list))) ;; Available and disabled packages: (dolist (elt package-archive-contents) (setq name (car elt)) - (let ((hold (assq name package-load-list))) - (package--push name (cdr elt) - (if (and hold (null (cadr hold))) "disabled" "available") - info-list))) + (when (or (eq packages t) (memq name packages)) + (let ((hold (assq name package-load-list))) + (package--push name (cdr elt) + (if (and hold (null (cadr hold))) + "disabled" + "available") + info-list)))) ;; Obsolete packages: (dolist (elt package-obsolete-alist) (dolist (inner-elt (cdr elt)) - (package--push (car elt) (cdr inner-elt) "obsolete" info-list))) + (when (or (eq packages t) (memq (car elt) packages)) + (package--push (car elt) (cdr inner-elt) "obsolete" info-list)))) ;; Print the result. (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list)) @@ -1416,7 +1419,7 @@ This fetches the contents of each archive specified in (unless (eq major-mode 'package-menu-mode) (error "The current buffer is not a Package Menu")) (package-refresh-contents) - (package-menu--generate t)) + (package-menu--generate t t)) (defun package-menu-describe-package (&optional button) "Describe the current package. @@ -1531,7 +1534,7 @@ packages marked for deletion are removed." (and delete-list (null install-list) (package-initialize)) (if (or delete-list install-list) - (package-menu--generate t) + (package-menu--generate t t) (message "No operations specified.")))) (defun package-menu--version-predicate (A B) @@ -1585,7 +1588,7 @@ The list is displayed in a buffer named `*Packages*'." (let ((buf (get-buffer-create "*Packages*"))) (with-current-buffer buf (package-menu-mode) - (package-menu--generate)) + (package-menu--generate nil t)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. (switch-to-buffer buf))) @@ -1593,6 +1596,19 @@ The list is displayed in a buffer named `*Packages*'." ;;;###autoload (defalias 'package-list-packages 'list-packages) +;; Used in finder.el +(defun package-show-package-list (packages) + "Display PACKAGES in a *Packages* buffer. +This is similar to `list-packages', but it does not fetch the +updated list of packages, and it only displays packages with +names in PACKAGES (which should be a list of symbols)." + (require 'finder-inf nil t) + (let ((buf (get-buffer-create "*Packages*"))) + (with-current-buffer buf + (package-menu-mode) + (package-menu--generate nil packages)) + (switch-to-buffer buf))) + (defun package-list-packages-no-fetch () "Display a list of packages. Does not fetch the updated list of packages before displaying. diff --git a/lisp/finder.el b/lisp/finder.el index 784de0a4d4c..ae2afba5bbb 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -316,7 +316,7 @@ not `finder-known-keywords'." (packages (gethash id finder-keywords-hash))) (unless packages (error "No packages matching key `%s'" key)) - (package--list-packages packages))) + (package-show-package-list packages))) (define-button-type 'finder-xref 'action #'finder-goto-xref) From a3af29290ecf2edc793c4e7c13310985a63ffac0 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 24 Apr 2011 22:12:21 +0000 Subject: [PATCH 57/77] shr.el (shr-tag-sup, shr-tag-sub): New functions. --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/shr.el | 10 ++++++++++ 2 files changed, 15 insertions(+) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b683a1563b6..dd079b4f0a1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -2,6 +2,11 @@ * gnus-sum.el (gnus-extra-headers): Bump :version. +2011-04-24 Lars Magne Ingebrigtsen + + * shr.el (shr-tag-sup): New function. + (shr-tag-sub): Ditto. + 2011-04-22 Teodor Zlatanov * gnus-registry.el (gnus-registry-ignore-group-p): Test specifically diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 401ac1a08c6..1f6cb528c5d 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -734,6 +734,16 @@ ones, in case fg and bg are nil." (defun shr-tag-script (cont) ) +(defun shr-tag-sup (cont) + (let ((start (point))) + (shr-generic cont) + (put-text-property start (point) 'display '(raise 0.5)))) + +(defun shr-tag-sub (cont) + (let ((start (point))) + (shr-generic cont) + (put-text-property start (point) 'display '(raise -0.5)))) + (defun shr-tag-label (cont) (shr-generic cont) (shr-ensure-paragraph)) From 05842630f9a2b95a35003ee41aeb10b6df39b1e4 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Sun, 24 Apr 2011 17:31:41 -0700 Subject: [PATCH 58/77] * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use correct match group (bug#8438). --- lisp/ChangeLog | 5 +++++ lisp/progmodes/cc-engine.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4d4c93841e5..0a63e6d5dec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-04-24 Daniel Colascione + + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use + correct match group (bug#8438). + 2011-04-24 Chong Yidong * emacs-lisp/package.el (package-built-in-p): Fix typo. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5ef12300195..0eec54fab6f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6475,7 +6475,7 @@ comment at the start of cc-engine.el for more info." ;; `c-font-lock-declarators'.) (while (and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) - (match-beginning 2)) + (match-beginning 3)) ;; If the second submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. From 418401a53fd8a638a7a44d05b5fea4b4211251f4 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:28:55 -0500 Subject: [PATCH 59/77] Add GnuTLS support for W32. * lib-src/makefile.w32-in (obj): Added gnutls.o. --- lib-src/ChangeLog | 4 ++++ lib-src/makefile.w32-in | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index c45da107a8c..cd6c8d2b955 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,7 @@ +2011-04-24 Teodor Zlatanov + + * makefile.w32-in (obj): Added gnutls.o. + 2011-04-16 Paul Eggert Static checks with GCC 4.6.0 and non-default toolkits. diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index f09ede06900..38d453d5259 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -142,7 +142,8 @@ obj = dosfns.o msdos.o \ syntax.o bytecode.o \ process.o callproc.o unexw32.o \ region-cache.o sound.o atimer.o \ - doprnt.o intervals.o textprop.o composite.o + doprnt.o intervals.o textprop.o composite.o \ + gnutls.o # # These are the lisp files that are loaded up in loadup.el From fd4af8d90220585aa10753735760bc396f089102 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:29:31 -0500 Subject: [PATCH 60/77] Add GnuTLS support for W32. * nt/configure.bat: New options --without-gnutls and --lib, new build variable USER_LIBS, automatically detect GnuTLS. Copies the PNG library setup with trivial modifications. * nt/INSTALL: Add instructions for GnuTLS support. * nt/gmake.defs: Prefix USER_LIBS with -l. --- nt/ChangeLog | 8 ++++++++ nt/INSTALL | 9 +++++++++ nt/configure.bat | 51 ++++++++++++++++++++++++++++++++++++++++++++++++ nt/gmake.defs | 4 ++++ 4 files changed, 72 insertions(+) diff --git a/nt/ChangeLog b/nt/ChangeLog index 19f71ba0af3..255c2fd479d 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,11 @@ +2011-04-24 Teodor Zlatanov + + * configure.bat: New options --without-gnutls and --lib, new build + variable USER_LIBS, automatically detect GnuTLS. Copies the PNG + library setup with trivial modifications. + * INSTALL: Add instructions for GnuTLS support. + * gmake.defs: Prefix USER_LIBS with -l. + 2011-04-15 Ben Key * configure.bat: Modified the code that parses the --cflags and diff --git a/nt/INSTALL b/nt/INSTALL index dfcfa8a205a..cadf6ba690e 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -316,6 +316,15 @@ `dynamic-library-alist' and the value of `libpng-version', and download compatible DLLs if needed. +* Optional GnuTLS support + + You can build Emacs with GnuTLS support. Put the gnutls/gnutls.h header in + the include path and link to the appropriate libraries (gnutls.dll and + gcrypt.dll) with the --lib option. + + You can get pre-built binaries and an installer at + http://josefsson.org/gnutls4win/. + * Experimental SVG support SVG support is currently experimental, and not built by default. diff --git a/nt/configure.bat b/nt/configure.bat index 699a33bc2eb..7642d8244f8 100755 --- a/nt/configure.bat +++ b/nt/configure.bat @@ -99,10 +99,13 @@ set COMPILER= set usercflags= set docflags= set userldflags= +set extrauserlibs= set doldflags= +set doextralibs= set sep1= set sep2= set sep3= +set sep4= set distfiles= rem ---------------------------------------------------------------------- @@ -120,10 +123,12 @@ if "%1" == "--profile" goto profile if "%1" == "--no-cygwin" goto nocygwin if "%1" == "--cflags" goto usercflags if "%1" == "--ldflags" goto userldflags +if "%1" == "--lib" goto extrauserlibs if "%1" == "--without-png" goto withoutpng if "%1" == "--without-jpeg" goto withoutjpeg if "%1" == "--without-gif" goto withoutgif if "%1" == "--without-tiff" goto withouttiff +if "%1" == "--without-gnutls" goto withoutgnutls if "%1" == "--without-xpm" goto withoutxpm if "%1" == "--with-svg" goto withsvg if "%1" == "--distfiles" goto distfiles @@ -142,11 +147,13 @@ echo. --profile enable profiling echo. --no-cygwin use -mno-cygwin option with GCC echo. --cflags FLAG pass FLAG to compiler echo. --ldflags FLAG pass FLAG to compiler when linking +echo. --lib LIB link to extra library LIB echo. --without-png do not use PNG library even if it is installed echo. --without-jpeg do not use JPEG library even if it is installed echo. --without-gif do not use GIF library even if it is installed echo. --without-tiff do not use TIFF library even if it is installed echo. --without-xpm do not use XPM library even if it is installed +echo. --without-gnutls do not use GNUTLS library even if it is installed echo. --with-svg use the RSVG library (experimental) echo. --distfiles path to files for make dist, e.g. libXpm.dll if "%use_extensions%" == "0" goto end @@ -242,6 +249,14 @@ set sep1= %nothing% shift goto again +:extrauserlibs +shift +echo. extrauserlibs: %extrauserlibs% +set extrauserlibs=%extrauserlibs%%sep4%%1 +set sep4= %nothing% +shift +goto again + rem ---------------------------------------------------------------------- :userldflags @@ -288,6 +303,14 @@ goto again rem ---------------------------------------------------------------------- +:withoutgnutls +set tlssupport=N +set HAVE_GNUTLS= +shift +goto again + +rem ---------------------------------------------------------------------- + :withouttiff set tiffsupport=N set HAVE_TIFF= @@ -516,6 +539,30 @@ set HAVE_PNG=1 :pngDone rm -f junk.c junk.obj +if (%tlssupport%) == (N) goto tlsDone + +rem this is a copy of the PNG detection +echo Checking for libgnutls... +echo #include "gnutls/gnutls.h" >junk.c +echo main (){} >>junk.c +rem -o option is ignored with cl, but allows result to be consistent. +echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log +%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 2>>config.log +if exist junk.obj goto haveTls + +echo ...gnutls.h not found, building without TLS support. +echo The failed program was: >>config.log +type junk.c >>config.log +set HAVE_GNUTLS= +goto :tlsDone + +:haveTls +echo ...GNUTLS header available, building with GNUTLS support. +set HAVE_GNUTLS=1 + +:tlsDone +rm -f junk.c junk.obj + if (%jpegsupport%) == (N) goto jpegDone echo Checking for jpeg-6b... @@ -688,6 +735,8 @@ for %%v in (%usercflags%) do if not (%%v)==() set docflags=Y if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings +for %%v in (%extrauserlibs%) do if not (%%v)==() set doextralibs=Y +if (%doextralibs%)==(Y) echo USER_LIBS=%extrauserlibs%>>config.settings echo # End of settings from configure.bat>>config.settings echo. >>config.settings @@ -700,6 +749,7 @@ if (%docflags%) == (Y) echo #define USER_CFLAGS " %usercflags%">>config.tmp if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp +if not "(%HAVE_GNUTLS%)" == "()" echo #define HAVE_GNUTLS 1 >>config.tmp if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp @@ -838,6 +888,7 @@ set distfiles= set HAVE_DISTFILES= set distFilesOk= set pngsupport= +set tlssupport= set jpegsupport= set gifsupport= set tiffsupport= diff --git a/nt/gmake.defs b/nt/gmake.defs index 3dbb97ff65d..7af7fe4ab68 100644 --- a/nt/gmake.defs +++ b/nt/gmake.defs @@ -279,6 +279,10 @@ ifdef NOCYGWIN NOCYGWIN = -mno-cygwin endif +ifdef USER_LIBS +USER_LIBS := $(patsubst %,-l%,$(USER_LIBS)) +endif + ifeq "$(ARCH)" "i386" ifdef NOOPT ARCH_CFLAGS = -c $(DEBUG_FLAG) $(NOCYGWIN) From 33630d51504adc5b2a0289f356c0a1a49f0bd10a Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:30:05 -0500 Subject: [PATCH 61/77] Add certificate verify callback check for GnuTLS. * configure.in: Check for GnuTLS certificate verify callbacks. --- ChangeLog | 4 ++++ configure.in | 10 ++++++++++ 2 files changed, 14 insertions(+) diff --git a/ChangeLog b/ChangeLog index 7fcdef4272b..3a729327bf3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2011-04-24 Teodor Zlatanov + + * configure.in: Check for GnuTLS certificate verify callbacks. + 2011-04-20 Stefan Monnier * Makefile.in (config.status): Don't erase in case of error. diff --git a/configure.in b/configure.in index d20dee81e5b..b4b4330fd17 100644 --- a/configure.in +++ b/configure.in @@ -1972,12 +1972,22 @@ fi AC_SUBST(LIBSELINUX_LIBS) HAVE_GNUTLS=no +HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no if test "${with_gnutls}" = "yes" ; then PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no) if test "${HAVE_GNUTLS}" = "yes"; then AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) fi + + CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS" + LIBS="$LIBGNUTLS_LIBS $LIBS" + AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes) + + if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then + AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.]) + fi fi + AC_SUBST(LIBGNUTLS_LIBS) AC_SUBST(LIBGNUTLS_CFLAGS) From e061a11b5a59f02fac66184e991f01a433f6dc8d Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:30:51 -0500 Subject: [PATCH 62/77] Add GnuTLS support for W32 and certificate and hostname verification in GnuTLS. * src/gnutls.c: Renamed global_initialized to gnutls_global_initialized. Added internals for the :verify-hostname-error, :verify-error, and :verify-flags parameters of `gnutls-boot' and documented those parameters in the docstring. Start callback support. (emacs_gnutls_handshake): Add Woe32 support. Retry handshake unless a fatal error occured. Call gnutls_alert_send_appropriate on error. Return error code. (emacs_gnutls_write): Call emacs_gnutls_handle_error. (emacs_gnutls_read): Likewise. (Fgnutls_boot): Return handshake error code. (emacs_gnutls_handle_error): New function. (wsaerror_to_errno): Likewise. * src/gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the callbacks stage. * src/w32.c (emacs_gnutls_pull): New function for GnuTLS on Woe32. (emacs_gnutls_push): Likewise. * src/w32.h (emacs_gnutls_pull): Add prototype. (emacs_gnutls_push): Likewise. --- src/ChangeLog | 35 +++++ src/gnutls.c | 360 +++++++++++++++++++++++++++++++++++++++----- src/gnutls.h | 2 + src/makefile.w32-in | 10 ++ src/process.c | 16 ++ src/w32.c | 69 ++++++++- src/w32.h | 12 ++ 7 files changed, 464 insertions(+), 40 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index f1d195c4544..410a3b15ffb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,38 @@ +2011-04-24 Teodor Zlatanov + + * gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the + callbacks stage. + + * gnutls.c: Renamed global_initialized to + gnutls_global_initialized. Added internals for the + :verify-hostname-error, :verify-error, and :verify-flags + parameters of `gnutls-boot' and documented those parameters in the + docstring. Start callback support. + (emacs_gnutls_handshake): Add Woe32 support. Retry handshake + unless a fatal error occured. Call gnutls_alert_send_appropriate + on error. Return error code. + (emacs_gnutls_write): Call emacs_gnutls_handle_error. + (emacs_gnutls_read): Likewise. + (Fgnutls_boot): Return handshake error code. + (emacs_gnutls_handle_error): New function. + (wsaerror_to_errno): Likewise. + + * w32.h (emacs_gnutls_pull): Add prototype. + (emacs_gnutls_push): Likewise. + + * w32.c (emacs_gnutls_pull): New function for GnuTLS on Woe32. + (emacs_gnutls_push): Likewise. + +2011-04-24 Claudio Bley (tiny change) + + * process.c (wait_reading_process_output): Check if GnuTLS + buffered some data internally if no FDs are set for TLS + connections. + + * makefile.w32-in (OBJ2): Add gnutls.$(O). + (LIBS): Link to USER_LIBS. + ($(BLD)/gnutls.$(0)): New target. + 2011-04-24 Eli Zaretskii * xdisp.c (handle_single_display_spec): Rename the diff --git a/src/gnutls.c b/src/gnutls.c index f4f2b9bbd35..18ceb79193b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -26,11 +26,20 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_GNUTLS #include +#ifdef WINDOWSNT +#include +#include "w32.h" +#endif + +static int +emacs_gnutls_handle_error (gnutls_session_t, int err); + +Lisp_Object Qgnutls_log_level; Lisp_Object Qgnutls_code; Lisp_Object Qgnutls_anon, Qgnutls_x509pki; Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; -int global_initialized; +int gnutls_global_initialized; /* The following are for the property list of `gnutls-boot'. */ Lisp_Object Qgnutls_bootprop_priority; @@ -38,8 +47,27 @@ Lisp_Object Qgnutls_bootprop_trustfiles; Lisp_Object Qgnutls_bootprop_keyfiles; Lisp_Object Qgnutls_bootprop_callbacks; Lisp_Object Qgnutls_bootprop_loglevel; +Lisp_Object Qgnutls_bootprop_hostname; +Lisp_Object Qgnutls_bootprop_verify_flags; +Lisp_Object Qgnutls_bootprop_verify_error; +Lisp_Object Qgnutls_bootprop_verify_hostname_error; + +/* Callback keys for `gnutls-boot'. Unused currently. */ +Lisp_Object Qgnutls_bootprop_callbacks_verify; static void +gnutls_log_function (int level, const char* string) +{ + message ("gnutls.c: [%d] %s", level, string); +} + +static void +gnutls_log_function2 (int level, const char* string, const char* extra) +{ + message ("gnutls.c: [%d] %s %s", level, string, extra); +} + +static int emacs_gnutls_handshake (struct Lisp_Process *proc) { gnutls_session_t state = proc->gnutls_state; @@ -50,24 +78,55 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) { +#ifdef WINDOWSNT + /* On W32 we cannot transfer socket handles between different runtime + libraries, so we tell GnuTLS to use our special push/pull + functions. */ + gnutls_transport_set_ptr2 (state, + (gnutls_transport_ptr_t) proc, + (gnutls_transport_ptr_t) proc); + gnutls_transport_set_push_function (state, &emacs_gnutls_push); + gnutls_transport_set_pull_function (state, &emacs_gnutls_pull); + + /* For non blocking sockets or other custom made pull/push + functions the gnutls_transport_set_lowat must be called, with + a zero low water mark value. (GnuTLS 2.10.4 documentation) + + (Note: this is probably not strictly necessary as the lowat + value is only used when no custom pull/push functions are + set.) */ + gnutls_transport_set_lowat (state, 0); +#else /* This is how GnuTLS takes sockets: as file descriptors passed in. For an Emacs process socket, infd and outfd are the same but we use this two-argument version for clarity. */ gnutls_transport_set_ptr2 (state, - (gnutls_transport_ptr_t) (long) proc->infd, - (gnutls_transport_ptr_t) (long) proc->outfd); + (gnutls_transport_ptr_t) proc->infd, + (gnutls_transport_ptr_t) proc->outfd); +#endif proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET; } - ret = gnutls_handshake (state); + do + { + ret = gnutls_handshake (state); + emacs_gnutls_handle_error (state, ret); + } + while (ret < 0 && gnutls_error_is_fatal (ret) == 0); + proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED; if (ret == GNUTLS_E_SUCCESS) { - /* here we're finally done. */ + /* Here we're finally done. */ proc->gnutls_initstage = GNUTLS_STAGE_READY; } + else + { + gnutls_alert_send_appropriate (state, ret); + } + return ret; } EMACS_INT @@ -107,6 +166,7 @@ emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, bytes_written += rtnval; } + emacs_gnutls_handle_error (state, rtnval); return (bytes_written); } @@ -122,19 +182,68 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, emacs_gnutls_handshake (proc); return -1; } - rtnval = gnutls_read (state, buf, nbyte); if (rtnval >= 0) return rtnval; + else if (emacs_gnutls_handle_error (state, rtnval) == 0) + /* non-fatal error */ + return -1; else { - if (rtnval == GNUTLS_E_AGAIN || - rtnval == GNUTLS_E_INTERRUPTED) - return -1; - else - return 0; + /* a fatal error occured */ + return 0; } } +/* report a GnuTLS error to the user. + Returns zero if the error code was successfully handled. */ +static int +emacs_gnutls_handle_error (gnutls_session_t session, int err) +{ + Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level); + int max_log_level = 0; + + int alert, ret; + const char *str; + + /* TODO: use a Lisp_Object generated by gnutls_make_error? */ + if (err >= 0) + return 0; + + if (NUMBERP (gnutls_log_level)) + max_log_level = XINT (gnutls_log_level); + + /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ + + str = gnutls_strerror (err); + if (!str) + str = "unknown"; + + if (gnutls_error_is_fatal (err)) + { + ret = err; + GNUTLS_LOG2 (0, max_log_level, "fatal error:", str); + } + else + { + ret = 0; + GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str); + /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */ + } + + if (err == GNUTLS_E_WARNING_ALERT_RECEIVED + || err == GNUTLS_E_FATAL_ALERT_RECEIVED) + { + int alert = gnutls_alert_get (session); + int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1; + str = gnutls_alert_get_name (alert); + if (!str) + str = "unknown"; + + GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str); + } + return ret; +} + /* convert an integer error to a Lisp_Object; it will be either a known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or simply the integer value of the error. GNUTLS_E_SUCCESS is mapped @@ -262,14 +371,14 @@ See also `gnutls-init'. */) Call `gnutls-global-deinit' when GnuTLS usage is no longer needed. Returns zero on success. */ static Lisp_Object -gnutls_emacs_global_init (void) +emacs_gnutls_global_init (void) { int ret = GNUTLS_E_SUCCESS; - if (!global_initialized) + if (!gnutls_global_initialized) ret = gnutls_global_init (); - global_initialized = 1; + gnutls_global_initialized = 1; return gnutls_make_error (ret); } @@ -277,28 +386,16 @@ gnutls_emacs_global_init (void) /* Deinitializes global GnuTLS state. See also `gnutls-global-init'. */ static Lisp_Object -gnutls_emacs_global_deinit (void) +emacs_gnutls_global_deinit (void) { - if (global_initialized) + if (gnutls_global_initialized) gnutls_global_deinit (); - global_initialized = 0; + gnutls_global_initialized = 0; return gnutls_make_error (GNUTLS_E_SUCCESS); } -static void -gnutls_log_function (int level, const char* string) -{ - message ("gnutls.c: [%d] %s", level, string); -} - -static void -gnutls_log_function2 (int level, const char* string, const char* extra) -{ - message ("gnutls.c: [%d] %s %s", level, string, extra); -} - DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. Currently only client mode is supported. Returns a success/failure @@ -307,12 +404,27 @@ value you can check with `gnutls-errorp'. TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. PROPLIST is a property list with the following keys: +:hostname is a string naming the remote host. + :priority is a GnuTLS priority string, defaults to "NORMAL". + :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'. + :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'. -:callbacks is an alist of callback functions (TODO). + +:callbacks is an alist of callback functions, see below. + :loglevel is the debug level requested from GnuTLS, try 4. +:verify-flags is a bitset as per GnuTLS' +gnutls_certificate_set_verify_flags. + +:verify-error, if non-nil, makes failure of the certificate validation +an error. Otherwise it will be just a series of warnings. + +:verify-hostname-error, if non-nil, makes a hostname mismatch an +error. Otherwise it will be just a warning. + The debug level will be set for this process AND globally for GnuTLS. So if you set it higher or lower at any point, it affects global debugging. @@ -325,6 +437,9 @@ Processes must be initialized with this function before other GnuTLS functions are used. This function allocates resources which can only be deallocated by calling `gnutls-deinit' or by calling it again. +The callbacks alist can have a `verify' key, associated with a +verification function (UNUSED). + Each authentication type may need additional information in order to work. For X.509 PKI (`gnutls-x509pki'), you probably need at least one trustfile (usually a CA bundle). */) @@ -337,12 +452,19 @@ one trustfile (usually a CA bundle). */) /* TODO: GNUTLS_X509_FMT_DER is also an option. */ int file_format = GNUTLS_X509_FMT_PEM; + unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT; + gnutls_x509_crt_t gnutls_verify_cert; + unsigned int gnutls_verify_cert_list_size; + const gnutls_datum_t *gnutls_verify_cert_list; + gnutls_session_t state; gnutls_certificate_credentials_t x509_cred; gnutls_anon_client_credentials_t anon_cred; Lisp_Object global_init; char* priority_string_ptr = "NORMAL"; /* default priority string. */ Lisp_Object tail; + int peer_verification; + char* c_hostname; /* Placeholders for the property list elements. */ Lisp_Object priority_string; @@ -350,16 +472,29 @@ one trustfile (usually a CA bundle). */) Lisp_Object keyfiles; Lisp_Object callbacks; Lisp_Object loglevel; + Lisp_Object hostname; + Lisp_Object verify_flags; + Lisp_Object verify_error; + Lisp_Object verify_hostname_error; CHECK_PROCESS (proc); CHECK_SYMBOL (type); CHECK_LIST (proplist); - priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority); - trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles); - keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles); - callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks); - loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel); + hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname); + priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority); + trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles); + keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles); + callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks); + loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel); + verify_flags = Fplist_get (proplist, Qgnutls_bootprop_verify_flags); + verify_error = Fplist_get (proplist, Qgnutls_bootprop_verify_error); + verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error); + + if (!STRINGP (hostname)) + error ("gnutls-boot: invalid :hostname parameter"); + + c_hostname = SSDATA (hostname); state = XPROCESS (proc)->gnutls_state; XPROCESS (proc)->gnutls_p = 1; @@ -373,7 +508,7 @@ one trustfile (usually a CA bundle). */) } /* always initialize globals. */ - global_init = gnutls_emacs_global_init (); + global_init = emacs_gnutls_global_init (); if (! NILP (Fgnutls_errorp (global_init))) return global_init; @@ -417,6 +552,23 @@ one trustfile (usually a CA bundle). */) x509_cred = XPROCESS (proc)->gnutls_x509_cred; if (gnutls_certificate_allocate_credentials (&x509_cred) < 0) memory_full (); + + if (NUMBERP (verify_flags)) + { + gnutls_verify_flags = XINT (verify_flags); + GNUTLS_LOG (2, max_log_level, "setting verification flags"); + } + else if (NILP (verify_flags)) + { + /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ + GNUTLS_LOG (2, max_log_level, "using default verification flags"); + } + else + { + /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ + GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); + } + gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); } else if (EQ (type, Qgnutls_anon)) { @@ -485,6 +637,14 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; + GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; + +#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY +#else +#endif + GNUTLS_LOG (1, max_log_level, "gnutls_init"); ret = gnutls_init (&state, GNUTLS_CLIENT); @@ -542,9 +702,113 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; - emacs_gnutls_handshake (XPROCESS (proc)); + ret = emacs_gnutls_handshake (XPROCESS (proc)); - return gnutls_make_error (GNUTLS_E_SUCCESS); + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + /* Now verify the peer, following + http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html. + The peer should present at least one certificate in the chain; do a + check of the certificate's hostname with + gnutls_x509_crt_check_hostname() against :hostname. */ + + ret = gnutls_certificate_verify_peers2 (state, &peer_verification); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) + message ("%s certificate could not be verified.", + c_hostname); + + if (peer_verification & GNUTLS_CERT_REVOKED) + GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", + c_hostname); + + if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) + GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", + c_hostname); + + if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) + GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:", + c_hostname); + + if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) + GNUTLS_LOG2 (1, max_log_level, + "certificate was signed with an insecure algorithm:", + c_hostname); + + if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) + GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", + c_hostname); + + if (peer_verification & GNUTLS_CERT_EXPIRED) + GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", + c_hostname); + + if (peer_verification != 0) + { + if (NILP (verify_hostname_error)) + { + GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", + c_hostname); + } + else + { + error ("Certificate validation failed %s, verification code %d", + c_hostname, peer_verification); + } + } + + /* Up to here the process is the same for X.509 certificates and + OpenPGP keys. From now on X.509 certificates are assumed. This + can be easily extended to work with openpgp keys as well. */ + if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) + { + ret = gnutls_x509_crt_init (&gnutls_verify_cert); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + gnutls_verify_cert_list = + gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); + + if (NULL == gnutls_verify_cert_list) + { + error ("No x509 certificate was found!\n"); + } + + /* We only check the first certificate in the given chain. */ + ret = gnutls_x509_crt_import (gnutls_verify_cert, + &gnutls_verify_cert_list[0], + GNUTLS_X509_FMT_DER); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_x509_crt_deinit (gnutls_verify_cert); + return gnutls_make_error (ret); + } + + if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) + { + if (NILP (verify_hostname_error)) + { + GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", + c_hostname); + } + else + { + gnutls_x509_crt_deinit (gnutls_verify_cert); + error ("The x509 certificate does not match \"%s\"", + c_hostname); + } + } + + gnutls_x509_crt_deinit (gnutls_verify_cert); + } + + return gnutls_make_error (ret); } DEFUN ("gnutls-bye", Fgnutls_bye, @@ -579,7 +843,10 @@ This function may also return `gnutls-e-again', or void syms_of_gnutls (void) { - global_initialized = 0; + gnutls_global_initialized = 0; + + Qgnutls_log_level = intern_c_string ("gnutls-log-level"); + staticpro (&Qgnutls_log_level); Qgnutls_code = intern_c_string ("gnutls-code"); staticpro (&Qgnutls_code); @@ -590,6 +857,9 @@ syms_of_gnutls (void) Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); staticpro (&Qgnutls_x509pki); + Qgnutls_bootprop_hostname = intern_c_string (":hostname"); + staticpro (&Qgnutls_bootprop_hostname); + Qgnutls_bootprop_priority = intern_c_string (":priority"); staticpro (&Qgnutls_bootprop_priority); @@ -602,9 +872,21 @@ syms_of_gnutls (void) Qgnutls_bootprop_callbacks = intern_c_string (":callbacks"); staticpro (&Qgnutls_bootprop_callbacks); + Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify"); + staticpro (&Qgnutls_bootprop_callbacks_verify); + Qgnutls_bootprop_loglevel = intern_c_string (":loglevel"); staticpro (&Qgnutls_bootprop_loglevel); + Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags"); + staticpro (&Qgnutls_bootprop_verify_flags); + + Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error"); + staticpro (&Qgnutls_bootprop_verify_error); + + Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error"); + staticpro (&Qgnutls_bootprop_verify_hostname_error); + Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted"); staticpro (&Qgnutls_e_interrupted); Fput (Qgnutls_e_interrupted, Qgnutls_code, diff --git a/src/gnutls.h b/src/gnutls.h index 5240d94c2ad..6c2e4c69523 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_GNUTLS #include +#include typedef enum { @@ -28,6 +29,7 @@ typedef enum GNUTLS_STAGE_EMPTY = 0, GNUTLS_STAGE_CRED_ALLOC, GNUTLS_STAGE_FILES, + GNUTLS_STAGE_CALLBACKS, GNUTLS_STAGE_INIT, GNUTLS_STAGE_PRIORITY, GNUTLS_STAGE_CRED_SET, diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 0dd06b7efc3..4ba314318db 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -105,6 +105,7 @@ OBJ2 = $(BLD)/sysdep.$(O) \ $(BLD)/floatfns.$(O) \ $(BLD)/frame.$(O) \ $(BLD)/gmalloc.$(O) \ + $(BLD)/gnutls.$(O) \ $(BLD)/intervals.$(O) \ $(BLD)/composite.$(O) \ $(BLD)/ralloc.$(O) \ @@ -150,6 +151,7 @@ LIBS = $(TLIB0) \ $(OLE32) \ $(COMCTL32) \ $(UNISCRIBE) \ + $(USER_LIBS) \ $(libc) # @@ -950,6 +952,14 @@ $(BLD)/gmalloc.$(O) : \ $(EMACS_ROOT)/nt/inc/unistd.h \ $(SRC)/getpagesize.h +$(BLD)/gnutls.$(O) : \ + $(SRC)/gnutls.h \ + $(SRC)/gnutls.c \ + $(CONFIG_H) \ + $(EMACS_ROOT)/nt/inc/sys/socket.h \ + $(SRC)/lisp.h \ + $(SRC)/process.h + $(BLD)/image.$(O) : \ $(SRC)/image.c \ $(CONFIG_H) \ diff --git a/src/process.c b/src/process.c index d8851c56cf0..4253286196c 100644 --- a/src/process.c +++ b/src/process.c @@ -4532,6 +4532,22 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, &Available, (check_write ? &Writeok : (SELECT_TYPE *)0), (SELECT_TYPE *)0, &timeout); + +#ifdef HAVE_GNUTLS + /* GnuTLS buffers data internally. In lowat mode it leaves + some data in the TCP buffers so that select works, but + with custom pull/push functions we need to check if some + data is available in the buffers manually. */ + if (nfds == 0 && + wait_proc && wait_proc->gnutls_p /* Check for valid process. */ + /* Do we have pending data? */ + && gnutls_record_check_pending (wait_proc->gnutls_state) > 0) + { + nfds = 1; + /* Set to Available. */ + FD_SET (wait_proc->infd, &Available); + } +#endif } xerrno = errno; diff --git a/src/w32.c b/src/w32.c index 85e4a2025b9..065d730333b 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6124,5 +6124,72 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) p->childp = childp2; } -/* end of w32.c */ +#ifdef HAVE_GNUTLS +ssize_t +emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz) +{ + int n, sc, err; + SELECT_TYPE fdset; + EMACS_TIME timeout; + struct Lisp_Process *process = (struct Lisp_Process *)p; + int fd = process->infd; + + for (;;) + { + n = sys_read(fd, (char*)buf, sz); + + if (n >= 0) + return n; + + err = errno; + + if (err == EWOULDBLOCK) + { + /* Set a small timeout. */ + EMACS_SET_SECS_USECS(timeout, 1, 0); + FD_ZERO (&fdset); + FD_SET ((int)fd, &fdset); + + /* Use select with the timeout to poll the selector. */ + sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0, + &timeout); + + if (sc > 0) + continue; /* Try again. */ + + /* Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. + Also accept select return 0 as an indicator to EAGAIN. */ + if (sc == 0 || errno == EWOULDBLOCK) + err = EAGAIN; + else + err = errno; /* Other errors are just passed on. */ + } + + gnutls_transport_set_errno (process->gnutls_state, err); + + return -1; + } +} + +ssize_t +emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz) +{ + struct Lisp_Process *process = (struct Lisp_Process *)p; + int fd = proc->outfd; + ssize_t n = sys_write(fd, buf, sz); + + /* 0 or more bytes written means everything went fine. */ + if (n >= 0) + return n; + + /* Negative bytes written means we got an error in errno. + Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. */ + gnutls_transport_set_errno (process->gnutls_state, + errno == EWOULDBLOCK ? EAGAIN : errno); + + return -1; +} +#endif /* HAVE_GNUTLS */ + +/* end of w32.c */ diff --git a/src/w32.h b/src/w32.h index 9279ddbe579..4086c4190e1 100644 --- a/src/w32.h +++ b/src/w32.h @@ -143,5 +143,17 @@ extern void syms_of_fontset (void); extern int _sys_read_ahead (int fd); extern int _sys_wait_accept (int fd); +#ifdef HAVE_GNUTLS +#include + +/* GnuTLS pull (read from remote) interface. */ +extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p, + void* buf, size_t sz); + +/* GnuTLS push (write to remote) interface. */ +extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, + const void* buf, size_t sz); +#endif /* HAVE_GNUTLS */ + #endif /* EMACS_W32_H */ From 8b492194a904d115258ae59eb522c986860c4c18 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:31:45 -0500 Subject: [PATCH 63/77] Bug fixes and certificate and hostname verification for the Emacs GnuTLS support. * lisp/net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, verify-error, and verify-hostname-error parameters. Check whether default trustfile exists before going to use it. Add missing argument to gnutls-message-maybe call. Return return value. Reported by Claudio Bley . (open-gnutls-stream): Add usage example. * lisp/net/network-stream.el (network-stream-open-starttls): Give host parameter to `gnutls-negotiate'. (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. --- lisp/ChangeLog | 13 +++++++ lisp/net/gnutls.el | 77 +++++++++++++++++++++++++++++++++----- lisp/net/network-stream.el | 5 ++- 3 files changed, 84 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0a63e6d5dec..c4e28b61586 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-04-24 Teodor Zlatanov + + * net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, + verify-error, and verify-hostname-error parameters. Check whether + default trustfile exists before going to use it. Add missing + argument to gnutls-message-maybe call. Return return value. + Reported by Claudio Bley . + (open-gnutls-stream): Add usage example. + + * net/network-stream.el (network-stream-open-starttls): Give host + parameter to `gnutls-negotiate'. + (gnutls-negotiate): Adjust `gnutls-negotiate' declaration. + 2011-04-24 Daniel Colascione * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 0929c31b6c4..46c20e6b344 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -25,7 +25,8 @@ ;;; Commentary: ;; This package provides language bindings for the GnuTLS library -;; using the corresponding core functions in gnutls.c. +;; using the corresponding core functions in gnutls.c. It should NOT +;; be used directly, only through open-protocol-stream. ;; Simple test: ;; @@ -59,26 +60,76 @@ Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to. +Usage example: + + \(with-temp-buffer + \(open-gnutls-stream \"tls\" + \(current-buffer) + \"your server goes here\" + \"imaps\")) + This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (let ((proc (open-network-stream name buffer host service))) - (gnutls-negotiate proc 'gnutls-x509pki))) + (gnutls-negotiate (open-network-stream name buffer host service) + 'gnutls-x509pki + host)) + +(put 'gnutls-error + 'error-conditions + '(error gnutls-error)) +(put 'gnutls-error + 'error-message "GnuTLS error") (declare-function gnutls-boot "gnutls.c" (proc type proplist)) -(defun gnutls-negotiate (proc type &optional priority-string - trustfiles keyfiles) - "Negotiate a SSL/TLS connection. +(defun gnutls-negotiate (proc type hostname &optional priority-string + trustfiles keyfiles verify-flags + verify-error verify-hostname-error) + "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. PROC is a process returned by `open-network-stream'. +HOSTNAME is the remote hostname. It must be a valid string. PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". TRUSTFILES is a list of CA bundles. -KEYFILES is a list of client keys." +KEYFILES is a list of client keys. + +When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised +when the hostname does not match the presented certificate's host +name. The exact verification algorithm is a basic implementation +of the matching described in RFC2818 (HTTPS), which takes into +account wildcards, and the DNSName/IPAddress subject alternative +name PKIX extension. See GnuTLS' gnutls_x509_crt_check_hostname +for details. When VERIFY-HOSTNAME-ERROR is nil, only a warning +will be issued. + +When VERIFY-ERROR is not nil, an error will be raised when the +peer certificate verification fails as per GnuTLS' +gnutls_certificate_verify_peers2. Otherwise, only warnings will +be shown about the verification failure. + +VERIFY-FLAGS is a numeric OR of verification flags only for +`gnutls-x509pki' connections. See GnuTLS' x509.h for details; +here's a recent version of the list. + + GNUTLS_VERIFY_DISABLE_CA_SIGN = 1, + GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2, + GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4, + GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16, + GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32, + GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64, + GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128, + GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256 + +It must be omitted, a number, or nil; if omitted or nil it +defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." (let* ((type (or type 'gnutls-x509pki)) + (default-trustfile "/etc/ssl/certs/ca-certificates.crt") (trustfiles (or trustfiles - '("/etc/ssl/certs/ca-certificates.crt"))) + (when (file-exists-p default-trustfile) + (list default-trustfile)))) (priority-string (or priority-string (cond ((eq type 'gnutls-anon) @@ -86,15 +137,23 @@ KEYFILES is a list of client keys." ((eq type 'gnutls-x509pki) "NORMAL")))) (params `(:priority ,priority-string + :hostname ,hostname :loglevel ,gnutls-log-level :trustfiles ,trustfiles :keyfiles ,keyfiles + :verify-flags ,verify-flags + :verify-error ,verify-error + :verify-hostname-error ,verify-hostname-error :callbacks nil)) ret) (gnutls-message-maybe (setq ret (gnutls-boot proc type params)) - "boot: %s") + "boot: %s" params) + + (when (gnutls-errorp ret) + ;; This is a error from the underlying C code. + (signal 'gnutls-error (list proc ret))) proc)) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 67bb7eae68e..09519e14870 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -46,7 +46,8 @@ (require 'starttls) (declare-function gnutls-negotiate "gnutls" - (proc type &optional priority-string trustfiles keyfiles)) + (proc type host &optional priority-string trustfiles keyfiles + verify-flags verify-error verify-hostname-error)) ;;;###autoload (defun open-network-stream (name buffer host service &rest parameters) @@ -197,7 +198,7 @@ values: (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. (if (fboundp 'open-gnutls-stream) - (gnutls-negotiate stream nil) + (gnutls-negotiate stream nil host) (unless (starttls-negotiate stream) (delete-process stream))) (if (memq (process-status stream) '(open run)) From e2822bd2ea32c577342b9618a301f8661551f7a3 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Mon, 25 Apr 2011 04:32:07 +0000 Subject: [PATCH 64/77] gnus-registry.el (gnus-registry-ignore-group-p): Don't call `gnus-parameter-registry-ignore' if the *Group* buffer doesn't exist. --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/gnus-registry.el | 1 + 2 files changed, 6 insertions(+) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dd079b4f0a1..99a08de633b 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2011-04-25 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-ignore-group-p): Don't call + `gnus-parameter-registry-ignore' if the *Group* buffer doesn't exist. + 2011-04-23 Glenn Morris * gnus-sum.el (gnus-extra-headers): Bump :version. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 3597cbc1584..e6c96ab2b19 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -678,6 +678,7 @@ Consults `gnus-registry-ignored-groups' and ;; `gnus-registry-ignored-groups' is a list of lists ;; (it can be a list of regexes) (and (listp (nth 0 gnus-registry-ignored-groups)) + (get-buffer "*Group*") ; in automatic tests this is false (gnus-parameter-registry-ignore group)) (gnus-grep-in-list group From 825cd63ca98121d602b4a8dcffa55d29841224a0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Apr 2011 11:04:22 +0300 Subject: [PATCH 65/77] Improve doprnt and its use in verror. (Bug#8545) src/doprnt.c (doprnt): Document the set of format control sequences supported by the function. Use SAFE_ALLOCA instead of always using `alloca'. src/eval.c (verror): Don't limit the buffer size at size_max-1, that is one byte too soon. Don't use xrealloc; instead xfree and xmalloc anew. --- src/ChangeLog | 11 +++++++++ src/doprnt.c | 62 ++++++++++++++++++++++++++++++++++++++++++++------- src/eval.c | 11 +++++---- 3 files changed, 70 insertions(+), 14 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 410a3b15ffb..cd03d1fa186 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2011-04-25 Eli Zaretskii + + Improve doprnt and its use in verror. (Bug#8545) + * doprnt.c (doprnt): Document the set of format control sequences + supported by the function. Use SAFE_ALLOCA instead of always + using `alloca'. + + * eval.c (verror): Don't limit the buffer size at size_max-1, that + is one byte too soon. Don't use xrealloc; instead xfree and + xmalloc anew. + 2011-04-24 Teodor Zlatanov * gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the diff --git a/src/doprnt.c b/src/doprnt.c index f124db13221..3ac1d9963a9 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -43,10 +43,54 @@ along with GNU Emacs. If not, see . */ OTOH, this function supports only a small subset of the standard C formatted output facilities. E.g., %u and %ll are not supported, and precision is - largely ignored except for converting floating-point values. However, this - is okay, as this function is supposed to be called from `error' and similar - functions, and thus does not need to support features beyond those in - `Fformat', which is used by `error' on the Lisp level. */ + ignored %s and %c conversions. (See below for the detailed documentation of + what is supported.) However, this is okay, as this function is supposed to + be called from `error' and similar functions, and thus does not need to + support features beyond those in `Fformat', which is used by `error' on the + Lisp level. */ + +/* This function supports the following %-sequences in the `format' + argument: + + %s means print a string argument. + %S is silently treated as %s, for loose compatibility with `Fformat'. + %d means print a `signed int' argument in decimal. + %l means print a `long int' argument in decimal. + %o means print an `unsigned int' argument in octal. + %x means print an `unsigned int' argument in hex. + %e means print a `double' argument in exponential notation. + %f means print a `double' argument in decimal-point notation. + %g means print a `double' argument in exponential notation + or in decimal-point notation, whichever uses fewer characters. + %c means print a `signed int' argument as a single character. + %% means produce a literal % character. + + A %-sequence may contain optional flag, width, and precision specifiers, as + follows: + + %character + + where flags is [+ -0l], width is [0-9]+, and precision is .[0-9]+ + + The + flag character inserts a + before any positive number, while a space + inserts a space before any positive number; these flags only affect %d, %l, + %o, %x, %e, %f, and %g sequences. The - and 0 flags affect the width + specifier, as described below. + + The l (lower-case letter ell) flag is a `long' data type modifier: it is + supported for %d, %o, and %x conversions of integral arguments, and means + that the respective argument is to be treated as `long int' or `unsigned + long int'. The EMACS_INT data type should use this modifier. + + The width specifier supplies a lower limit for the length of the printed + representation. The padding, if any, normally goes on the left, but it goes + on the right if the - flag is present. The padding character is normally a + space, but (for numerical arguments only) it is 0 if the 0 flag is present. + The - flag takes precedence over the 0 flag. + + For %e, %f, and %g sequences, the number after the "." in the precision + specifier says how many decimal places to show; if zero, the decimal point + itself is omitted. For %s and %S, the precision specifier is ignored. */ #include #include @@ -79,9 +123,8 @@ along with GNU Emacs. If not, see . */ terminated at position FORMAT_END. Output goes in BUFFER, which has room for BUFSIZE chars. If the output does not fit, truncate it to fit. - Returns the number of bytes stored into BUFFER. - ARGS points to the vector of arguments, and NARGS says how many. - A double counts as two arguments. + Returns the number of bytes stored into BUFFER, excluding + the terminating null byte. Output is always null-terminated. String arguments are passed as C strings. Integers are passed as C integers. */ @@ -110,6 +153,7 @@ doprnt (char *buffer, register size_t bufsize, const char *format, char *fmtcpy; int minlen; char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ + USE_SAFE_ALLOCA; if (format_end == 0) format_end = format + strlen (format); @@ -117,7 +161,7 @@ doprnt (char *buffer, register size_t bufsize, const char *format, if ((format_end - format + 1) < sizeof (fixed_buffer)) fmtcpy = fixed_buffer; else - fmtcpy = (char *) alloca (format_end - format + 1); + SAFE_ALLOCA (fmtcpy, char *, format_end - format + 1); bufsize--; @@ -342,5 +386,7 @@ doprnt (char *buffer, register size_t bufsize, const char *format, xfree (big_buffer); *bufptr = 0; /* Make sure our string ends with a '\0' */ + + SAFE_FREE (); return bufptr - buffer; } diff --git a/src/eval.c b/src/eval.c index c3676720940..d1f327021e6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2012,15 +2012,14 @@ verror (const char *m, va_list ap) break; if (size <= size_max / 2) size *= 2; - else if (size < size_max - 1) - size = size_max - 1; + else if (size < size_max) + size = size_max; else break; /* and leave the message truncated */ - if (buffer == buf) - buffer = (char *) xmalloc (size); - else - buffer = (char *) xrealloc (buffer, size); + if (buffer != buf) + xfree (buffer); + buffer = (char *) xmalloc (size); } string = make_string (buffer, used); From e7d4e61f1ef1493a479e20db4d26f00f0116ec2a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 25 Apr 2011 06:18:22 -0400 Subject: [PATCH 66/77] Auto-commit of generated files. --- autogen/config.in | 7 +++++++ autogen/configure | 22 ++++++++++++++++++++++ 2 files changed, 29 insertions(+) diff --git a/autogen/config.in b/autogen/config.in index f2ea751e2f8..a105f958ead 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -279,6 +279,13 @@ along with GNU Emacs. If not, see . */ /* Define if using GnuTLS. */ #undef HAVE_GNUTLS +/* Define if using GnuTLS certificate verification callbacks. */ +#undef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY + +/* Define to 1 if you have the `gnutls_certificate_set_verify_function' + function. */ +#undef HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION + /* Define to 1 if you have the gpm library (-lgpm). */ #undef HAVE_GPM diff --git a/autogen/configure b/autogen/configure index f433171636b..7068c284163 100755 --- a/autogen/configure +++ b/autogen/configure @@ -10813,6 +10813,7 @@ fi HAVE_GNUTLS=no +HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no if test "${with_gnutls}" = "yes" ; then succeeded=no @@ -10913,7 +10914,28 @@ $as_echo "no" >&6; } $as_echo "#define HAVE_GNUTLS 1" >>confdefs.h fi + + CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS" + LIBS="$LIBGNUTLS_LIBS $LIBS" + for ac_func in gnutls_certificate_set_verify_function +do : + ac_fn_c_check_func "$LINENO" "gnutls_certificate_set_verify_function" "ac_cv_func_gnutls_certificate_set_verify_function" +if test "x$ac_cv_func_gnutls_certificate_set_verify_function" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION 1 +_ACEOF + HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes fi +done + + + if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then + +$as_echo "#define HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 1" >>confdefs.h + + fi +fi + From fb11d64dc8597a529688bc8bcaa7f3da4b538dc4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 25 Apr 2011 13:42:57 +0300 Subject: [PATCH 67/77] Avoid compilation warnings in gnutls.c on 64-bit hosts. src/gnutls.c (emacs_gnutls_handshake): Avoid compiler warnings about "cast to pointer from integer of different size". --- src/ChangeLog | 3 +++ src/gnutls.c | 4 ++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index cd03d1fa186..9166fe1822f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,8 @@ 2011-04-25 Eli Zaretskii + * gnutls.c (emacs_gnutls_handshake): Avoid compiler warnings about + "cast to pointer from integer of different size". + Improve doprnt and its use in verror. (Bug#8545) * doprnt.c (doprnt): Document the set of format control sequences supported by the function. Use SAFE_ALLOCA instead of always diff --git a/src/gnutls.c b/src/gnutls.c index 18ceb79193b..975fe655072 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -101,8 +101,8 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) in. For an Emacs process socket, infd and outfd are the same but we use this two-argument version for clarity. */ gnutls_transport_set_ptr2 (state, - (gnutls_transport_ptr_t) proc->infd, - (gnutls_transport_ptr_t) proc->outfd); + (gnutls_transport_ptr_t) (long) proc->infd, + (gnutls_transport_ptr_t) (long) proc->outfd); #endif proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET; From 42ce4c631e0d9291399dac0e9787ce2fbb97c8eb Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Mon, 25 Apr 2011 07:48:24 -0500 Subject: [PATCH 68/77] Fix typo in GnuTLS W32 support. * w32.c (emacs_gnutls_push): Fix typo. --- src/ChangeLog | 4 ++++ src/w32.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9166fe1822f..0350d36ea06 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2011-04-25 Teodor Zlatanov + + * w32.c (emacs_gnutls_push): Fix typo. + 2011-04-25 Eli Zaretskii * gnutls.c (emacs_gnutls_handshake): Avoid compiler warnings about diff --git a/src/w32.c b/src/w32.c index 065d730333b..2fbb3b6cb4c 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6176,7 +6176,7 @@ ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz) { struct Lisp_Process *process = (struct Lisp_Process *)p; - int fd = proc->outfd; + int fd = process->outfd; ssize_t n = sys_write(fd, buf, sz); /* 0 or more bytes written means everything went fine. */ From cd22b309b432f65d0191e46a7677e0d9c11ea9fd Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Mon, 25 Apr 2011 15:47:23 +0200 Subject: [PATCH 69/77] lisp/net/gnutls.el (gnutls-errorp): Declare before first use. --- lisp/ChangeLog | 12 ++++++++---- lisp/net/gnutls.el | 2 +- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c4e28b61586..917fe6cf40a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,9 +1,13 @@ +2011-04-25 Juanma Barranquero + + * net/gnutls.el (gnutls-errorp): Declare before first use. + 2011-04-24 Teodor Zlatanov * net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags, verify-error, and verify-hostname-error parameters. Check whether - default trustfile exists before going to use it. Add missing - argument to gnutls-message-maybe call. Return return value. + default trustfile exists before going to use it. Add missing + argument to gnutls-message-maybe call. Return return value. Reported by Claudio Bley . (open-gnutls-stream): Add usage example. @@ -13,8 +17,8 @@ 2011-04-24 Daniel Colascione - * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Use - correct match group (bug#8438). + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): + Use correct match group (bug#8438). 2011-04-24 Chong Yidong diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 46c20e6b344..8b662795665 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -83,6 +83,7 @@ trust and key files, and priority string." 'error-message "GnuTLS error") (declare-function gnutls-boot "gnutls.c" (proc type proplist)) +(declare-function gnutls-errorp "gnutls.c" (error)) (defun gnutls-negotiate (proc type hostname &optional priority-string trustfiles keyfiles verify-flags @@ -157,7 +158,6 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." proc)) -(declare-function gnutls-errorp "gnutls.c" (error)) (declare-function gnutls-error-string "gnutls.c" (error)) (defun gnutls-message-maybe (doit format &rest params) From e92f3bd31bba8010468c91b6af7090652969679b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Apr 2011 13:29:31 -0300 Subject: [PATCH 70/77] Fix octave-inf completion problems reported by Alexander Klimov. * lisp/progmodes/octave-inf.el (inferior-octave-mode-syntax-table): Inherit from octave-mode-syntax-table. (inferior-octave-mode): Set info-lookup-mode. (inferior-octave-completion-at-point): New function. (inferior-octave-complete): Use it and completion-in-region. (inferior-octave-dynamic-complete-functions): Use it as well, and use comint-filename-completion. * lisp/progmodes/octave-mod.el (octave-mode-syntax-table): Use _ syntax for symbol elements which shouldn't be word elements. (octave-font-lock-keywords, octave-beginning-of-defun) (octave-function-header-regexp): Adjust regexps accordingly. (octave-mode-map): Also use info-lookup-symbol for C-c C-h. --- lisp/ChangeLog | 20 +++++++++-- lisp/progmodes/octave-inf.el | 66 ++++++++++++++++++------------------ lisp/progmodes/octave-mod.el | 26 +++++++------- 3 files changed, 64 insertions(+), 48 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 917fe6cf40a..ed4aafa0ef5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2011-04-25 Stefan Monnier + + Fix octave-inf completion problems reported by Alexander Klimov. + * progmodes/octave-inf.el (inferior-octave-mode-syntax-table): + Inherit from octave-mode-syntax-table. + (inferior-octave-mode): Set info-lookup-mode. + (inferior-octave-completion-at-point): New function. + (inferior-octave-complete): Use it and completion-in-region. + (inferior-octave-dynamic-complete-functions): Use it as well, and use + comint-filename-completion. + * progmodes/octave-mod.el (octave-mode-syntax-table): Use _ syntax for + symbol elements which shouldn't be word elements. + (octave-font-lock-keywords, octave-beginning-of-defun) + (octave-function-header-regexp): Adjust regexps accordingly. + (octave-mode-map): Also use info-lookup-symbol for C-c C-h. + 2011-04-25 Juanma Barranquero * net/gnutls.el (gnutls-errorp): Declare before first use. @@ -32,8 +48,8 @@ * finder.el (finder-list-matches): Use package-show-package-list instead of deleted package--list-packages. - * vc/vc-annotate.el (vc-annotate-goto-line): New command. Based - on a previous implementation by Juanma Barranquero (Bug#8366). + * vc/vc-annotate.el (vc-annotate-goto-line): New command. + Based on a previous implementation by Juanma Barranquero (Bug#8366). (vc-annotate-mode-map): Bind it to RET. 2011-04-24 Uday S Reddy (tiny change) diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index 239da3d8cd6..803a542563c 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -73,10 +73,7 @@ mode, set this to (\"-q\" \"--traditional\")." "Keymap used in Inferior Octave mode.") (defvar inferior-octave-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?\` "w" table) - (modify-syntax-entry ?\# "<" table) - (modify-syntax-entry ?\n ">" table) + (let ((table (make-syntax-table octave-mode-syntax-table))) table) "Syntax table in use in inferior-octave-mode buffers.") @@ -115,11 +112,13 @@ the regular expression `comint-prompt-regexp', a buffer local variable." "Non-nil means that Octave has built-in variables.") (defvar inferior-octave-dynamic-complete-functions - '(inferior-octave-complete comint-dynamic-complete-filename) + '(inferior-octave-completion-at-point comint-filename-completion) "List of functions called to perform completion for inferior Octave. This variable is used to initialize `comint-dynamic-complete-functions' in the Inferior Octave buffer.") +(defvar info-lookup-mode) + (define-derived-mode inferior-octave-mode comint-mode "Inferior Octave" "Major mode for interacting with an inferior Octave process. Runs Octave as a subprocess of Emacs, with Octave I/O through an Emacs @@ -139,6 +138,8 @@ Entry to this mode successively runs the hooks `comint-mode-hook' and (set (make-local-variable 'font-lock-defaults) '(inferior-octave-font-lock-keywords nil nil)) + (set (make-local-variable 'info-lookup-mode) 'octave-mode) + (setq comint-input-ring-file-name (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist") comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024)) @@ -259,39 +260,38 @@ startup file, `~/.emacs-octave'." (inferior-octave-resync-dirs))) +(defun inferior-octave-completion-at-point () + "Return the data to complete the Octave symbol at point." + (let* ((end (point)) + (start + (save-excursion + (skip-syntax-backward "w_" (comint-line-beginning-position)) + (point)))) + (cond (inferior-octave-complete-impossible nil) + ((eq start end) nil) + (t + (list + start end + (completion-table-dynamic + (lambda (command) + (inferior-octave-send-list-and-digest + (list (concat "completion_matches (\"" command "\");\n"))) + (sort (delete-dups inferior-octave-output-list) + 'string-lessp)))))))) + (defun inferior-octave-complete () "Perform completion on the Octave symbol preceding point. This is implemented using the Octave command `completion_matches' which is NOT available with versions of Octave prior to 2.0." (interactive) - (let* ((end (point)) - (command - (save-excursion - (skip-syntax-backward "w_" (comint-line-beginning-position)) - (buffer-substring-no-properties (point) end)))) - (cond (inferior-octave-complete-impossible - (error (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X."))) - ((string-equal command "") - (message "Cannot complete an empty string")) - (t - (inferior-octave-send-list-and-digest - (list (concat "completion_matches (\"" command "\");\n"))) - ;; Sort the list - (setq inferior-octave-output-list - (sort inferior-octave-output-list 'string-lessp)) - ;; Remove duplicates - (let* ((x inferior-octave-output-list) - (y (cdr x))) - (while y - (if (string-equal (car x) (car y)) - (setcdr x (setq y (cdr y))) - (setq x y - y (cdr y))))) - ;; And let comint handle the rest - (comint-dynamic-simple-complete - command inferior-octave-output-list))))) + (if inferior-octave-complete-impossible + (error (concat + "Your Octave does not have `completion_matches'. " + "Please upgrade to version 2.X.")) + (let ((data (inferior-octave-completion-at-point))) + (if (null data) + (message "Cannot complete an empty string") + (apply #'completion-in-region data))))) (defun inferior-octave-dynamic-list-input-ring () "List the buffer's input history in a help buffer." diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 241928c8a1c..39d997e1d5e 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -150,8 +150,8 @@ All Octave abbrevs start with a grave accent (`)." "Builtin variables in Octave.") (defvar octave-function-header-regexp - (concat "^\\s-*\\<\\(function\\)\\>" - "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\w+\\)\\>") + (concat "^\\s-*\\_<\\(function\\)\\_>" + "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") "Regexp to match an Octave function header. The string `function' and its name are given by the first and third parenthetical grouping.") @@ -159,10 +159,10 @@ parenthetical grouping.") (defvar octave-font-lock-keywords (list ;; Fontify all builtin keywords. - (cons (concat "\\<\\(" + (cons (concat "\\_<\\(" (regexp-opt (append octave-reserved-words octave-text-functions)) - "\\)\\>") + "\\)\\_>") 'font-lock-keyword-face) ;; Fontify all builtin operators. (cons "\\(&\\||\\|<=\\|>=\\|==\\|<\\|>\\|!=\\|!\\)" @@ -170,7 +170,7 @@ parenthetical grouping.") 'font-lock-builtin-face 'font-lock-preprocessor-face)) ;; Fontify all builtin variables. - (cons (concat "\\<" (regexp-opt octave-variables) "\\>") + (cons (concat "\\_<" (regexp-opt octave-variables) "\\_>") 'font-lock-variable-name-face) ;; Fontify all function declarations. (list octave-function-header-regexp @@ -223,7 +223,7 @@ parenthetical grouping.") (define-key map "\C-c]" 'smie-close-block) (define-key map "\C-c/" 'smie-close-block) (define-key map "\C-c\C-f" 'octave-insert-defun) - (define-key map "\C-c\C-h" 'octave-help) + (define-key map "\C-c\C-h" 'info-lookup-symbol) (define-key map "\C-c\C-il" 'octave-send-line) (define-key map "\C-c\C-ib" 'octave-send-block) (define-key map "\C-c\C-if" 'octave-send-defun) @@ -299,8 +299,8 @@ parenthetical grouping.") ;; Was "w" for abbrevs, but now that it's not necessary any more, (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?\" "\"" table) - (modify-syntax-entry ?. "w" table) - (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?. "_" table) + (modify-syntax-entry ?_ "_" table) ;; The "b" flag only applies to the second letter of the comstart ;; and the first letter of the comend, i.e. the "4b" below is ineffective. ;; If we try to put `b' on the single-line comments, we get a similar @@ -818,11 +818,11 @@ Returns t unless search stops at the beginning or end of the buffer." (found nil) (case-fold-search nil)) (and (not (eobp)) - (not (and (> arg 0) (looking-at "\\"))) + (not (and (> arg 0) (looking-at "\\_"))) (skip-syntax-forward "w")) (while (and (/= arg 0) (setq found - (re-search-backward "\\" inc))) + (re-search-backward "\\_" inc))) (if (octave-not-in-string-or-comment-p) (setq arg (- arg inc)))) (if found @@ -975,12 +975,12 @@ otherwise." (defun octave-completion-at-point-function () "Find the text to complete and the corresponding table." - (let* ((beg (save-excursion (backward-sexp 1) (point))) + (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) (end (point))) (if (< beg (point)) ;; Extend region past point, if applicable. - (save-excursion (goto-char beg) (forward-sexp 1) - (setq end (max end (point))))) + (save-excursion (skip-syntax-forward "w_") + (setq end (point)))) (list beg end octave-completion-alist))) (defun octave-complete-symbol () From 850256b5e9fa9f03008b843e58b1b338d86877f5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Apr 2011 13:52:51 -0300 Subject: [PATCH 71/77] * lisp/custom.el (defcustom): Obey lexical-binding. --- lisp/ChangeLog | 2 ++ lisp/custom.el | 18 +++++++++++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ed4aafa0ef5..13c6bfa2d4c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2011-04-25 Stefan Monnier + * custom.el (defcustom): Obey lexical-binding. + Fix octave-inf completion problems reported by Alexander Klimov. * progmodes/octave-inf.el (inferior-octave-mode-syntax-table): Inherit from octave-mode-syntax-table. diff --git a/lisp/custom.el b/lisp/custom.el index 9673db47ea8..8295777f1f1 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -313,11 +313,19 @@ for more information." ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - (nconc (list 'custom-declare-variable - (list 'quote symbol) - (list 'quote value) - doc) - args)) + `(custom-declare-variable + ',symbol + ,(if lexical-binding ;FIXME: This is not reliable, but is all we have. + ;; The `default' arg should be an expression that evaluates to + ;; the value to use. The use of `eval' for it is spread over + ;; many different places and hence difficult to eliminate, yet + ;; we want to make sure that the `value' expression is checked by the + ;; byte-compiler, and that lexical-binding is obeyed, so quote the + ;; expression with `lambda' rather than with `quote'. + `(list (lambda () ,value)) + `',value) + ,doc + ,@args)) ;;; The `defface' Macro. From bfd31217eac63c0b8a5470f67af9a733713ee126 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 25 Apr 2011 20:10:17 +0200 Subject: [PATCH 72/77] * net/tramp.el (tramp-process-actions): Add POS argument. Delete region between POS and (pos). * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use `nil' position in `tramp-process-actions' call. (tramp-maybe-open-connection): Call `tramp-process-actions' with pos. * net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `nil' position in `tramp-process-actions' call. * net/trampver.el: Update release number. --- lisp/ChangeLog | 14 ++++++++++++++ lisp/net/tramp-sh.el | 8 +++++--- lisp/net/tramp-smb.el | 2 +- lisp/net/tramp.el | 12 +++++++++--- lisp/net/trampver.el | 4 ++-- 5 files changed, 31 insertions(+), 9 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 13c6bfa2d4c..34e2cc4f56e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2011-04-25 Michael Albinus + + * net/tramp.el (tramp-process-actions): Add POS argument. Delete + region between POS and (pos). + + * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use + `nil' position in `tramp-process-actions' call. + (tramp-maybe-open-connection): Call `tramp-process-actions' with pos. + + * net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `nil' + position in `tramp-process-actions' call. + + * net/trampver.el: Update release number. + 2011-04-25 Stefan Monnier * custom.el (defcustom): Obey lexical-binding. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index cb4aca12edb..81e955ebbf8 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2336,7 +2336,8 @@ The method used must be an out-of-band method." orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-compat-set-process-query-on-exit-flag p nil) - (tramp-process-actions p v tramp-actions-copy-out-of-band))) + (tramp-process-actions + p v nil tramp-actions-copy-out-of-band))) ;; Reset the transfer process properties. (tramp-message orig-vec 6 "%s" (buffer-string)) @@ -4212,7 +4213,8 @@ connection if a previous connection has died for some reason." (catch 'uname-changed (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) - (process-environment (copy-sequence process-environment))) + (process-environment (copy-sequence process-environment)) + (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) ;; If too much time has passed since last command was sent, look ;; whether process is still alive. If it isn't, kill it. When @@ -4366,7 +4368,7 @@ connection if a previous connection has died for some reason." ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) (tramp-send-command vec command t t) - (tramp-process-actions p vec tramp-actions-before-shell 60) + (tramp-process-actions p vec pos tramp-actions-before-shell 60) (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host)) ;; Next hop. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 36477f7b439..5a62b71bda1 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1314,7 +1314,7 @@ connection if a previous connection has died for some reason." ;; Play login scenario. (tramp-process-actions - p vec + p vec nil (if share tramp-smb-actions-with-share tramp-smb-actions-without-share)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fc167d6e62e..693e082ecc8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3098,8 +3098,11 @@ The terminal type can be configured with `tramp-terminal-type'." (setq found (funcall action proc vec))))) found)) -(defun tramp-process-actions (proc vec actions &optional timeout) - "Perform actions until success or TIMEOUT." +(defun tramp-process-actions (proc vec pos actions &optional timeout) + "Perform ACTIONS until success or TIMEOUT. +PROC and VEC indicate the remote connection to be used. POS, if +set, is the starting point of the region to be deleted in the +connection buffer." ;; Preserve message for `progress-reporter'. (tramp-compat-with-temp-message "" ;; Enable auth-source and password-cache. @@ -3124,7 +3127,10 @@ The terminal type can be configured with `tramp-terminal-type'." (cond ((eq exit 'permission-denied) "Permission denied") ((eq exit 'process-died) "Process died") - (t "Login failed")))))))) + (t "Login failed")))) + (when (numberp pos) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (buffer-read-only) (delete-region pos (point))))))))) :;; Utility functions: diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 462b8f11397..7b4c6fd75b1 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.1" +(defconst tramp-version "2.2.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.1 is not fit for %s" + (format "Tramp 2.2.2-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) From 69026abaa5924545051086104b3073f860aca36c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 25 Apr 2011 20:14:38 +0200 Subject: [PATCH 73/77] * trampver.texi: Update release number. --- doc/misc/ChangeLog | 4 ++++ doc/misc/trampver.texi | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 1660ed5335b..ff4a3355e54 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2011-04-25 Michael Albinus + + * trampver.texi: Update release number. + 2011-04-14 Michael Albinus * tramp.texi (Frequently Asked Questions): New item for disabling diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index e4c444980c8..6a245f9c28d 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.1 +@set trampver 2.2.2-pre @c Other flags from configuration @set instprefix /usr/local From d090ed6c781562b18042321f6780914ad84ffe2d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 25 Apr 2011 15:17:17 -0300 Subject: [PATCH 74/77] * lisp/emulation/cua-base.el (cua-selection-mode): Make it toggle again. --- lisp/ChangeLog | 12 ++++++++---- lisp/emulation/cua-base.el | 6 +++++- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 34e2cc4f56e..35f663ee3e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,14 @@ +2011-04-25 Stefan Monnier + + * emulation/cua-base.el (cua-selection-mode): Make it toggle again. + 2011-04-25 Michael Albinus - * net/tramp.el (tramp-process-actions): Add POS argument. Delete - region between POS and (pos). + * net/tramp.el (tramp-process-actions): Add POS argument. + Delete region between POS and (pos). - * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use - `nil' position in `tramp-process-actions' call. + * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): + Use `nil' position in `tramp-process-actions' call. (tramp-maybe-open-connection): Call `tramp-process-actions' with pos. * net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `nil' diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 0df9e7b16aa..b643d521ad6 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1627,7 +1627,11 @@ shifted movement key, set `cua-highlight-region-shift-only'." "Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings." (interactive "P") (setq-default cua-enable-cua-keys nil) - (cua-mode arg)) + (if (not (called-interactively-p 'any)) + (cua-mode arg) + ;; Use call-interactive to turn a nil prefix arg into `toggle'. + (call-interactively 'cua-mode) + (customize-mark-as-set 'cua-enable-cua-keys))) (defun cua-debug () From f2d3ba6f13adac8f2fb8595f3425cb8d085bd9c4 Mon Sep 17 00:00:00 2001 From: Dan Nicolaescu Date: Mon, 25 Apr 2011 14:36:06 -0700 Subject: [PATCH 75/77] Convert some function definitions to standard C. * src/alloc.c (check_sblock, check_string_bytes) (check_string_free_list): Convert to standard C. --- src/ChangeLog | 5 +++++ src/alloc.c | 8 +++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 0350d36ea06..1985cdc3768 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-25 Dan Nicolaescu + + * alloc.c (check_sblock, check_string_bytes) + (check_string_free_list): Convert to standard C. + 2011-04-25 Teodor Zlatanov * w32.c (emacs_gnutls_push): Fix typo. diff --git a/src/alloc.c b/src/alloc.c index 412527b41a0..be640b6a52c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1706,8 +1706,7 @@ string_bytes (struct Lisp_String *s) /* Check validity of Lisp strings' string_bytes member in B. */ static void -check_sblock (b) - struct sblock *b; +check_sblock (struct sblock *b) { struct sdata *from, *end, *from_end; @@ -1740,8 +1739,7 @@ check_sblock (b) recently allocated strings. Used for hunting a bug. */ static void -check_string_bytes (all_p) - int all_p; +check_string_bytes (int all_p) { if (all_p) { @@ -1769,7 +1767,7 @@ check_string_bytes (all_p) This may catch buffer overrun from a previous string. */ static void -check_string_free_list () +check_string_free_list (void) { struct Lisp_String *s; From f74c8aebdda87b6e50bb676c79b88884b8330806 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 25 Apr 2011 21:45:37 -0700 Subject: [PATCH 76/77] * admin/notes/years: Small updates. --- admin/notes/years | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/admin/notes/years b/admin/notes/years index cdd7cbe4b5f..e6b38c5aefd 100644 --- a/admin/notes/years +++ b/admin/notes/years @@ -6,6 +6,14 @@ rolls around, add that year to every FSF (and AIST) copyright notice. There's no need to worry about whether an individual file has changed in a given year - it's sufficient that Emacs as a whole has changed. +Therefore the years are updated en-masse near the start of each year, +so basically there is no need for most people to do any updating of them. + +The current (in 2011) version of "Information for Maintainers of GNU +Software" (see that document for more details) says that it is OK to use +ranges in copyright years, so in early 2011 the years were changed to use +ranges, which occupy less space and do not grow in length every year. + For more detailed information on maintaining copyright, see the file "copyright" in this directory. From 0c6b7b19e52ba18b5d4fd2d4b73b133a0a721603 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 25 Apr 2011 21:50:33 -0700 Subject: [PATCH 77/77] * admin/notes/bzr: Small updates. --- admin/notes/bzr | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/admin/notes/bzr b/admin/notes/bzr index 5600c9badb0..f4907063d0b 100644 --- a/admin/notes/bzr +++ b/admin/notes/bzr @@ -12,10 +12,17 @@ difficult. http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01124.html +The exception is, if you know that the change will be difficult to +merge to the trunk (eg because the trunk code has changed a lot). +In that case, it's helpful if you can apply the change to both trunk +and branch yourself (when committing the branch change, indicate +in the commit log that it should not be merged to the trunk; see below). + * Backporting a bug-fix from the trunk to a branch (e.g. "emacs-23"). -Label the commit as a backport, e.g. by starting the commit message with -"Backport:". This is helpful for the person merging the release branch -to the trunk. +Indicate in the commit log that there is no need to merge the commit +to the trunk. Anything that matches `bzrmerge-skip-regexp' will do; +eg start the commit message with "Backport:". This is helpful for the +person merging the release branch to the trunk. http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00262.html