From ab96c8509736a7ed622916ad2749ff356e520d02 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 30 Jan 2017 19:08:57 +0200 Subject: [PATCH 01/62] Avoid crashes on C-g in TTY sessions * src/keyboard.c (handle_interrupt): Don't quit if waiting_for_input is set, as doing that is "unsafe": it will abort. (Bug#25566) --- src/keyboard.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/keyboard.c b/src/keyboard.c index d41603b2e50..0c04d95304c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10448,7 +10448,7 @@ handle_interrupt (bool in_signal_handler) /* If executing a function that wants to be interrupted out of and the user has not deferred quitting by binding `inhibit-quit' then quit right away. */ - if (immediate_quit && NILP (Vinhibit_quit)) + if (immediate_quit && NILP (Vinhibit_quit) && !waiting_for_input) { struct gl_state_s saved; From 998e1976acc554a35cb7064b7fc7f3b323a30fe6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 30 Jan 2017 19:26:02 +0200 Subject: [PATCH 02/62] More fixes to prevent crashes on C-g * src/fns.c (Fassq, Frassq, Fplist_put): Reset immediate_quit before returning, to avoid crashes in quit. (Bug#25566) --- src/fns.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fns.c b/src/fns.c index 5769eac9987..0d93f824748 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1472,7 +1472,7 @@ Elements of LIST that are not conses are ignored. */) immediate_quit = false; return XCAR (tail); } - immediate_quit = true; + immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -1537,7 +1537,7 @@ The value is actually the first element of LIST whose cdr is KEY. */) immediate_quit = false; return XCAR (tail); } - immediate_quit = true; + immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -2090,7 +2090,7 @@ The PLIST is modified by side effects. */) prev = tail; } - immediate_quit = true; + immediate_quit = false; Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); if (NILP (prev)) From f74d496478cd57f252817bd7437fe1b7972ce01f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 30 Jan 2017 13:02:18 -0500 Subject: [PATCH 03/62] * lisp/subr.el (string-make-unibyte, string-make-multibyte): Obsolete. --- etc/NEWS | 1 + lisp/subr.el | 2 ++ 2 files changed, 3 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 12ff21f39ae..e368ff84f81 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -738,6 +738,7 @@ instead. * Lisp Changes in Emacs 26.1 +** string-(to|as|make)-(uni|multi)byte are now declared obsolete. ** New variable 'while-no-input-ignore-events' which allow setting which special events 'while-no-input' should ignore. It is a list of symbols. diff --git a/lisp/subr.el b/lisp/subr.el index a6ba05c2021..a204577ddf9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1417,8 +1417,10 @@ be a list of the form returned by `event-start' and `event-end'." ;; bug#23850 (make-obsolete 'string-to-unibyte "use `encode-coding-string'." "26.1") (make-obsolete 'string-as-unibyte "use `encode-coding-string'." "26.1") +(make-obsolete 'string-make-unibyte "use `encode-coding-string'." "26.1") (make-obsolete 'string-to-multibyte "use `decode-coding-string'." "26.1") (make-obsolete 'string-as-multibyte "use `decode-coding-string'." "26.1") +(make-obsolete 'string-make-multibyte "use `decode-coding-string'." "26.1") (defun log10 (x) "Return (log X 10), the log base 10 of X." From 499780daef5b9c5d426923ac325b111d3b14267f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 30 Jan 2017 13:06:07 -0500 Subject: [PATCH 04/62] * lisp/indent.el (indent-region-line-by-line): New function. Extracted from indent-region. (indent-region, indent-region-function): Use it. --- lisp/indent.el | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lisp/indent.el b/lisp/indent.el index db31f0454ce..fdd184c7998 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -487,9 +487,9 @@ line, but does not move past any whitespace that was explicitly inserted (if (memq (current-justification) '(center right)) (skip-chars-forward " \t"))) -(defvar indent-region-function nil +(defvar indent-region-function #'indent-region-line-by-line "Short cut function to indent region using `indent-according-to-mode'. -A value of nil means really run `indent-according-to-mode' on each line.") +Default is to really run `indent-according-to-mode' on each line.") (defun indent-region (start end &optional column) "Indent each nonblank line in the region. @@ -541,24 +541,26 @@ column to indent to; if it is nil, use one of the three methods above." (funcall indent-region-function start end)) ;; Else, use a default implementation that calls indent-line-function on ;; each line. - (t - (save-excursion - (setq end (copy-marker end)) - (goto-char start) - (let ((pr (unless (minibufferp) - (make-progress-reporter "Indenting region..." (point) end)))) - (while (< (point) end) - (or (and (bolp) (eolp)) - (indent-according-to-mode)) - (forward-line 1) - (and pr (progress-reporter-update pr (point)))) - (and pr (progress-reporter-done pr)) - (move-marker end nil))))) + (t (indent-region-line-by-line start end))) ;; In most cases, reindenting modifies the buffer, but it may also ;; leave it unmodified, in which case we have to deactivate the mark ;; by hand. (setq deactivate-mark t)) +(defun indent-region-line-by-line (start end) + (save-excursion + (setq end (copy-marker end)) + (goto-char start) + (let ((pr (unless (minibufferp) + (make-progress-reporter "Indenting region..." (point) end)))) + (while (< (point) end) + (or (and (bolp) (eolp)) + (indent-according-to-mode)) + (forward-line 1) + (and pr (progress-reporter-update pr (point)))) + (and pr (progress-reporter-done pr)) + (move-marker end nil)))) + (define-obsolete-function-alias 'indent-relative-maybe 'indent-relative-first-indent-point "26.1") From 1056be0b3c6f7f6732bd6f31f78d3a7e1a41f2c2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 28 Jan 2017 16:45:56 -0800 Subject: [PATCH 05/62] Add delq list arg check MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/fns.c (Fdelq): Check that list is a proper list. This is more compatible with what ‘delete’ does. --- src/fns.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fns.c b/src/fns.c index 0d93f824748..136a2198c2c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1589,6 +1589,7 @@ argument. */) else prev = tail; } + CHECK_LIST_END (tail, list); return list; } From 5cebfc4495356376cf1c7191bb18aa6c014f8c31 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 30 Jan 2017 16:59:37 -0500 Subject: [PATCH 06/62] mh-compat.el: remove duplicate definition * lisp/mh-e/mh-compat.el (mh-make-obsolete-variable): Remove duplicate definition. --- lisp/mh-e/mh-compat.el | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index aae751e8d2d..3f3990e8695 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -278,16 +278,6 @@ DOCSTRING arguments." `(define-obsolete-variable-alias ,obsolete-name ,current-name) `(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring))) -(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) - "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. -See documentation for `make-obsolete-variable' for a description -of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN -and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and -ACCESS-TYPE arguments." - (if (featurep 'xemacs) - `(make-obsolete-variable ,obsolete-name ,current-name) - `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))) - (defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. See documentation for `make-obsolete-variable' for a description From 77888c88503861197f5e855d18813eb1f6cb4c80 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 30 Jan 2017 17:22:32 -0500 Subject: [PATCH 07/62] edt-mapper: just loading a library should not run code * lisp/emulation/edt-mapper.el (edt-mapper): New function, containing code previously at top-level. * lisp/emulation/edt.el (edt-load-keys): After loading edt-mapper, run edt-mapper function. --- lisp/emulation/edt-mapper.el | 641 +++++++++++++++++------------------ lisp/emulation/edt.el | 8 +- 2 files changed, 323 insertions(+), 326 deletions(-) diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 24a8f039fa5..457ad55dd6c 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -57,9 +57,9 @@ ;; Usage: ;; Simply load this file into emacs (version 19 or higher) -;; using the following command. +;; and run the function edt-mapper, using the following command. -;; emacs -q -l edt-mapper.el +;; emacs -q -l edt-mapper -f edt-mapper ;; The "-q" option prevents loading of your init file (commands ;; therein might confuse this program). @@ -96,10 +96,6 @@ ;;; Code: -;; Otherwise it just hangs. This seems preferable. -(if noninteractive - (error "edt-mapper cannot be loaded in batch mode")) - ;;; ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). ;;; Determine Window System, and X Server Vendor (if appropriate). @@ -124,6 +120,8 @@ ;;; ;;; Key variables ;;; + +;; FIXME some/all of these should be let-bound, not global. (defvar edt-key nil) (defvar edt-enter nil) (defvar edt-return nil) @@ -136,217 +134,6 @@ (defvar EDT-key-name) (defvar edt-save-function-key-map) -;;; -;;; Determine Terminal Type (if appropriate). -;;; - -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (setq edt-term nil) - (setq edt-term (getenv "TERM"))) - -;;; -;;; Implements a workaround for a feature that was added to simple.el. -;;; -;;; Many function keys have no Emacs functions assigned to them by -;;; default. A subset of these are typically assigned functions in the -;;; EDT emulation. This includes all the keypad keys and a some others -;;; like Delete. -;;; -;;; Logic in simple.el maps some of these unassigned function keys to -;;; ordinary typing keys. Where this is the case, a call to -;;; read-key-sequence, below, does not return the name of the function -;;; key pressed by the user but, instead, it returns the name of the -;;; key to which it has been mapped. It needs to know the name of the -;;; key pressed by the user. As a workaround, we assign a function to -;;; each of the unassigned function keys of interest, here. These -;;; assignments override the mapping to other keys and are only -;;; temporary since, when edt-mapper is finished executing, it causes -;;; Emacs to exit. -;;; - -(mapc - (lambda (function-key) - (if (not (lookup-key (current-global-map) function-key)) - (define-key (current-global-map) function-key 'forward-char))) - '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] - [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] - [kp-space] - [kp-tab] - [kp-enter] - [kp-multiply] - [kp-add] - [kp-separator] - [kp-subtract] - [kp-decimal] - [kp-divide] - [kp-equal] - [backspace] - [delete] - [tab] - [linefeed] - [clear])) - -;;; -;;; Make sure the window is big enough to display the instructions, -;;; except where window cannot be re-sized. -;;; - -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (set-frame-size (selected-frame) 80 36)) - -;;; -;;; Create buffers - Directions and Keys -;;; -(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) -(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) - -;;; -;;; Put header in the Keys buffer -;;; -(set-buffer "Keys") -(insert "\ -;; -;; Key definitions for the EDT emulation within GNU Emacs -;; - -(defconst *EDT-keys* - '( -") - -;;; -;;; Display directions -;;; -(switch-to-buffer "Directions") -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (insert " - EDT MAPPER - - You will be asked to press keys to create a custom mapping (under a - Window Manager) of your keypad keys and function keys so that they can - emulate the LK-201 keypad and function keys or the subset of keys found - on a VT-100 series terminal keyboard. (The LK-201 keyboard is the - standard keyboard attached to VT-200 series terminals, and above.) - - Sometimes, edt-mapper will ignore a key you press, and just continue to - prompt for the same key. This can happen when your window manager sucks - up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. - Either way, there's nothing that edt-mapper can do about it. You must - press RETURN, to skip the current key and continue. Later, you and/or - your local system guru can try to figure out why the key is being ignored. - - Start by pressing the RETURN key, and continue by pressing the keys - specified in the mini-buffer. If you want to entirely omit a key, - because your keyboard does not have a corresponding key, for example, - just press RETURN at the prompt. - -") - (insert " - EDT MAPPER - - You will be asked to press keys to create a custom mapping of your - keypad keys and function keys so that they can emulate the LK-201 - keypad and function keys or the subset of keys found on a VT-100 - series terminal keyboard. (The LK-201 keyboard is the standard - keyboard attached to VT-200 series terminals, and above.) - - If you are using a real LK-201 keyboard, you should map the keys - exactly as they are on the keyboard. - - Start by pressing the RETURN key, and continue by pressing the keys - specified in the mini-buffer. If you want to entirely omit a key, - because your keyboard does not have a corresponding key, for example, - just press RETURN at the prompt. - -")) - -(delete-other-windows) - -;;; -;;; Save for future reference. -;;; -;;; For GNU Emacs, running in a Window System, first hide bindings in -;;; function-key-map. -;;; -(cond - ((featurep 'xemacs) - (setq edt-return-seq (read-key-sequence "Hit carriage-return to continue ")) - (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) - (t - (if edt-window-system - (progn - (setq edt-save-function-key-map function-key-map) - (setq function-key-map (make-sparse-keymap)))) - (setq edt-return (read-key-sequence "Hit carriage-return to continue ")))) - -;;; -;;; Remove prefix-key bindings to F1 and F2 in global-map so they can be -;;; bound in the EDT Emulation mode. -;;; -(global-unset-key [f1]) -(global-unset-key [f2]) - -;;; -;;; Display Keypad Diagram and Begin Prompting for Keys -;;; -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(if (and edt-window-system (not (eq edt-window-system 'tty))) - (insert " - - PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. - - Here's a picture of the standard LK-201 keypad for reference: - - ________________________ _______________________________ - | HELP | DO | | F17 | F18 | F19 | F20 | - | | | | | | | | - |_______|________________| |_______|_______|_______|_______| - ________________________ _______________________________ - | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | - | | | | | | | | | - |_______|________|_______| |_______|_______|_______|_______| - |SELECT |PREVIOUS|NEXT | | KP7 | KP8 | KP9 | KP- | - | | | | | | | | | - |_______|________|_______| |_______|_______|_______|_______| - | UP | | KP4 | KP5 | KP6 | KP, | - | | | | | | | - _______|________|_______ |_______|_______|_______|_______| - | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | - | | | | | | | | | - |_______|________|_______| |_______|_______|_______| KPE | - | KP0 | KPP | | - | | | | - |_______________|_______|_______| - - REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY. - -") - (progn - (insert " - GENERATING A CUSTOM CONFIGURATION FILE FOR TERMINAL TYPE: ") - (insert (format "%s." edt-term)) - (insert " - - PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. - - ________________________ _______________________________ - | HELP | DO | | F17 | F18 | F19 | F20 | - |_______|________________| |_______|_______|_______|_______| - ________________________ _______________________________ - | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | - |_______|________|_______| |_______|_______|_______|_______| - |SELECT |PREVIOUS| NEXT | | KP7 | KP8 | KP9 | KP- | - |_______|________|_______| |_______|_______|_______|_______| - | UP | | KP4 | KP5 | KP6 | KP, | - _______|________|_______ |_______|_______|_______|_______| - | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | - |_______|________|_______| |_______|_______|_______| KPE | - | KP0 | KPP | | - |_______________|_______|_______| - - REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY."))) - - ;;; ;;; Key mapping functions ;;; @@ -381,108 +168,314 @@ (set-buffer "Directions")))) edt-key) -(set-buffer "Keys") -(insert " +(defun edt-mapper () + (if noninteractive + (user-error "edt-mapper cannot be loaded in batch mode")) + ;; Determine Terminal Type (if appropriate). + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (setq edt-term nil) + (setq edt-term (getenv "TERM"))) + ;; + ;; Implements a workaround for a feature that was added to simple.el. + ;; + ;; Many function keys have no Emacs functions assigned to them by + ;; default. A subset of these are typically assigned functions in the + ;; EDT emulation. This includes all the keypad keys and a some others + ;; like Delete. + ;; + ;; Logic in simple.el maps some of these unassigned function keys to + ;; ordinary typing keys. Where this is the case, a call to + ;; read-key-sequence, below, does not return the name of the function + ;; key pressed by the user but, instead, it returns the name of the + ;; key to which it has been mapped. It needs to know the name of the + ;; key pressed by the user. As a workaround, we assign a function to + ;; each of the unassigned function keys of interest, here. These + ;; assignments override the mapping to other keys and are only + ;; temporary since, when edt-mapper is finished executing, it causes + ;; Emacs to exit. + ;; + (mapc + (lambda (function-key) + (if (not (lookup-key (current-global-map) function-key)) + (define-key (current-global-map) function-key 'forward-char))) + '([kp-0] [kp-1] [kp-2] [kp-3] [kp-4] + [kp-5] [kp-6] [kp-7] [kp-8] [kp-9] + [kp-space] + [kp-tab] + [kp-enter] + [kp-multiply] + [kp-add] + [kp-separator] + [kp-subtract] + [kp-decimal] + [kp-divide] + [kp-equal] + [backspace] + [delete] + [tab] + [linefeed] + [clear])) + ;; + ;; Make sure the window is big enough to display the instructions, + ;; except where window cannot be re-sized. + ;; + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (set-frame-size (selected-frame) 80 36)) + ;; + ;; Create buffers - Directions and Keys + ;; + (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) + (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) + ;; + ;; Put header in the Keys buffer + ;; + (set-buffer "Keys") + (insert "\ +;; +;; Key definitions for the EDT emulation within GNU Emacs +;; + +\(defconst *EDT-keys* + '( + ") + + ;; + ;; Display directions + ;; + (switch-to-buffer "Directions") + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (insert " + EDT MAPPER + + You will be asked to press keys to create a custom mapping (under a + Window Manager) of your keypad keys and function keys so that they can + emulate the LK-201 keypad and function keys or the subset of keys found + on a VT-100 series terminal keyboard. (The LK-201 keyboard is the + standard keyboard attached to VT-200 series terminals, and above.) + + Sometimes, edt-mapper will ignore a key you press, and just continue to + prompt for the same key. This can happen when your window manager sucks + up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. + Either way, there's nothing that edt-mapper can do about it. You must + press RETURN, to skip the current key and continue. Later, you and/or + your local system guru can try to figure out why the key is being ignored. + + Start by pressing the RETURN key, and continue by pressing the keys + specified in the mini-buffer. If you want to entirely omit a key, + because your keyboard does not have a corresponding key, for example, + just press RETURN at the prompt. + +") + (insert " + EDT MAPPER + + You will be asked to press keys to create a custom mapping of your + keypad keys and function keys so that they can emulate the LK-201 + keypad and function keys or the subset of keys found on a VT-100 + series terminal keyboard. (The LK-201 keyboard is the standard + keyboard attached to VT-200 series terminals, and above.) + + If you are using a real LK-201 keyboard, you should map the keys + exactly as they are on the keyboard. + + Start by pressing the RETURN key, and continue by pressing the keys + specified in the mini-buffer. If you want to entirely omit a key, + because your keyboard does not have a corresponding key, for example, + just press RETURN at the prompt. + +")) + + (delete-other-windows) + + ;; + ;; Save for future reference. + ;; + ;; For GNU Emacs, running in a Window System, first hide bindings in + ;; function-key-map. + ;; + (cond + ((featurep 'xemacs) + (setq edt-return-seq (read-key-sequence "Hit carriage-return to continue ")) + (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) + (t + (if edt-window-system + (progn + (setq edt-save-function-key-map function-key-map) + (setq function-key-map (make-sparse-keymap)))) + (setq edt-return (read-key-sequence "Hit carriage-return to continue ")))) + + ;; + ;; Remove prefix-key bindings to F1 and F2 in global-map so they can be + ;; bound in the EDT Emulation mode. + ;; + (global-unset-key [f1]) + (global-unset-key [f2]) + + ;; + ;; Display Keypad Diagram and Begin Prompting for Keys + ;; + (set-buffer "Directions") + (delete-region (point-min) (point-max)) + (if (and edt-window-system (not (eq edt-window-system 'tty))) + (insert " + + PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. + + Here's a picture of the standard LK-201 keypad for reference: + + ________________________ _______________________________ + | HELP | DO | | F17 | F18 | F19 | F20 | + | | | | | | | | + |_______|________________| |_______|_______|_______|_______| + ________________________ _______________________________ + | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | + | | | | | | | | | + |_______|________|_______| |_______|_______|_______|_______| + |SELECT |PREVIOUS|NEXT | | KP7 | KP8 | KP9 | KP- | + | | | | | | | | | + |_______|________|_______| |_______|_______|_______|_______| + | UP | | KP4 | KP5 | KP6 | KP, | + | | | | | | | + _______|________|_______ |_______|_______|_______|_______| + | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | + | | | | | | | | | + |_______|________|_______| |_______|_______|_______| KPE | + | KP0 | KPP | | + | | | | + |_______________|_______|_______| + + REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY. + +") + (progn + (insert " + GENERATING A CUSTOM CONFIGURATION FILE FOR TERMINAL TYPE: ") + (insert (format "%s." edt-term)) + (insert " + + PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW. + + ________________________ _______________________________ + | HELP | DO | | F17 | F18 | F19 | F20 | + |_______|________________| |_______|_______|_______|_______| + ________________________ _______________________________ + | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 | + |_______|________|_______| |_______|_______|_______|_______| + |SELECT |PREVIOUS| NEXT | | KP7 | KP8 | KP9 | KP- | + |_______|________|_______| |_______|_______|_______|_______| + | UP | | KP4 | KP5 | KP6 | KP, | + _______|________|_______ |_______|_______|_______|_______| + | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | | + |_______|________|_______| |_______|_______|_______| KPE | + | KP0 | KPP | | + |_______________|_______|_______| + + REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY."))) + + + + (set-buffer "Keys") + (insert " ;; ;; Arrows ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "UP" " - The Up Arrow Key") -(edt-map-key "DOWN" " - The Down Arrow Key") -(edt-map-key "LEFT" " - The Left Arrow Key") -(edt-map-key "RIGHT" " - The Right Arrow Key") + (edt-map-key "UP" " - The Up Arrow Key") + (edt-map-key "DOWN" " - The Down Arrow Key") + (edt-map-key "LEFT" " - The Left Arrow Key") + (edt-map-key "RIGHT" " - The Right Arrow Key") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; PF keys ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "PF1" " - The PF1 (GOLD) Key") -(edt-map-key "PF2" " - The Keypad PF2 Key") -(edt-map-key "PF3" " - The Keypad PF3 Key") -(edt-map-key "PF4" " - The Keypad PF4 Key") + (edt-map-key "PF1" " - The PF1 (GOLD) Key") + (edt-map-key "PF2" " - The Keypad PF2 Key") + (edt-map-key "PF3" " - The Keypad PF3 Key") + (edt-map-key "PF4" " - The Keypad PF4 Key") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; KP0-9 KP- KP, KPP and KPE ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "KP0" " - The Keypad 0 Key") -(edt-map-key "KP1" " - The Keypad 1 Key") -(edt-map-key "KP2" " - The Keypad 2 Key") -(edt-map-key "KP3" " - The Keypad 3 Key") -(edt-map-key "KP4" " - The Keypad 4 Key") -(edt-map-key "KP5" " - The Keypad 5 Key") -(edt-map-key "KP6" " - The Keypad 6 Key") -(edt-map-key "KP7" " - The Keypad 7 Key") -(edt-map-key "KP8" " - The Keypad 8 Key") -(edt-map-key "KP9" " - The Keypad 9 Key") -(edt-map-key "KP-" " - The Keypad - Key") -(edt-map-key "KP," " - The Keypad , Key") -(edt-map-key "KPP" " - The Keypad . Key") -(edt-map-key "KPE" " - The Keypad Enter Key") -;; Save the enter key -(setq edt-enter edt-key) -(setq edt-enter-seq edt-key-seq) + (edt-map-key "KP0" " - The Keypad 0 Key") + (edt-map-key "KP1" " - The Keypad 1 Key") + (edt-map-key "KP2" " - The Keypad 2 Key") + (edt-map-key "KP3" " - The Keypad 3 Key") + (edt-map-key "KP4" " - The Keypad 4 Key") + (edt-map-key "KP5" " - The Keypad 5 Key") + (edt-map-key "KP6" " - The Keypad 6 Key") + (edt-map-key "KP7" " - The Keypad 7 Key") + (edt-map-key "KP8" " - The Keypad 8 Key") + (edt-map-key "KP9" " - The Keypad 9 Key") + (edt-map-key "KP-" " - The Keypad - Key") + (edt-map-key "KP," " - The Keypad , Key") + (edt-map-key "KPP" " - The Keypad . Key") + (edt-map-key "KPE" " - The Keypad Enter Key") + ;; Save the enter key + (setq edt-enter edt-key) + (setq edt-enter-seq edt-key-seq) -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; Editing keypad (FIND, INSERT, REMOVE) ;; (SELECT, PREVIOUS, NEXT) ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "FIND" " - The Find key on the editing keypad") -(edt-map-key "INSERT" " - The Insert key on the editing keypad") -(edt-map-key "REMOVE" " - The Remove key on the editing keypad") -(edt-map-key "SELECT" " - The Select key on the editing keypad") -(edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") -(edt-map-key "NEXT" " - The Next Scr key on the editing keypad") + (edt-map-key "FIND" " - The Find key on the editing keypad") + (edt-map-key "INSERT" " - The Insert key on the editing keypad") + (edt-map-key "REMOVE" " - The Remove key on the editing keypad") + (edt-map-key "SELECT" " - The Select key on the editing keypad") + (edt-map-key "PREVIOUS" " - The Prev Scr key on the editing keypad") + (edt-map-key "NEXT" " - The Next Scr key on the editing keypad") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; ;; F1-14 Help Do F17-F20 ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(edt-map-key "F1" " - F1 Function Key") -(edt-map-key "F2" " - F2 Function Key") -(edt-map-key "F3" " - F3 Function Key") -(edt-map-key "F4" " - F4 Function Key") -(edt-map-key "F5" " - F5 Function Key") -(edt-map-key "F6" " - F6 Function Key") -(edt-map-key "F7" " - F7 Function Key") -(edt-map-key "F8" " - F8 Function Key") -(edt-map-key "F9" " - F9 Function Key") -(edt-map-key "F10" " - F10 Function Key") -(edt-map-key "F11" " - F11 Function Key") -(edt-map-key "F12" " - F12 Function Key") -(edt-map-key "F13" " - F13 Function Key") -(edt-map-key "F14" " - F14 Function Key") -(edt-map-key "HELP" " - HELP Function Key") -(edt-map-key "DO" " - DO Function Key") -(edt-map-key "F17" " - F17 Function Key") -(edt-map-key "F18" " - F18 Function Key") -(edt-map-key "F19" " - F19 Function Key") -(edt-map-key "F20" " - F20 Function Key") + (edt-map-key "F1" " - F1 Function Key") + (edt-map-key "F2" " - F2 Function Key") + (edt-map-key "F3" " - F3 Function Key") + (edt-map-key "F4" " - F4 Function Key") + (edt-map-key "F5" " - F5 Function Key") + (edt-map-key "F6" " - F6 Function Key") + (edt-map-key "F7" " - F7 Function Key") + (edt-map-key "F8" " - F8 Function Key") + (edt-map-key "F9" " - F9 Function Key") + (edt-map-key "F10" " - F10 Function Key") + (edt-map-key "F11" " - F11 Function Key") + (edt-map-key "F12" " - F12 Function Key") + (edt-map-key "F13" " - F13 Function Key") + (edt-map-key "F14" " - F14 Function Key") + (edt-map-key "HELP" " - HELP Function Key") + (edt-map-key "DO" " - DO Function Key") + (edt-map-key "F17" " - F17 Function Key") + (edt-map-key "F18" " - F18 Function Key") + (edt-map-key "F19" " - F19 Function Key") + (edt-map-key "F20" " - F20 Function Key") -(set-buffer "Directions") -(delete-region (point-min) (point-max)) -(insert " + (set-buffer "Directions") + (delete-region (point-min) (point-max)) + (insert " ADDITIONAL FUNCTION KEYS Your keyboard may have additional function keys which do not correspond @@ -501,53 +494,53 @@ When you are done, just press RETURN at the \"EDT Key Name:\" prompt. ") -(switch-to-buffer "Directions") -;;; -;;; Add support for extras keys -;;; -(set-buffer "Keys") -(insert "\ + (switch-to-buffer "Directions") + ;; + ;; Add support for extras keys + ;; + (set-buffer "Keys") + (insert "\ ;; ;; Extra Keys ;; ") -;;; -;;; Restore function-key-map. -;;; -(if (and edt-window-system (not (featurep 'xemacs))) - (setq function-key-map edt-save-function-key-map)) -(setq EDT-key-name "") -(while (not - (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) - (edt-map-key EDT-key-name "")) + ;; + ;; Restore function-key-map. + ;; + (if (and edt-window-system (not (featurep 'xemacs))) + (setq function-key-map edt-save-function-key-map)) + (setq EDT-key-name "") + (while (not + (string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) "")) + (edt-map-key EDT-key-name "")) -; -; No more keys to add, so wrap up. -; -(set-buffer "Keys") -(insert "\ + ;; + ;; No more keys to add, so wrap up. + ;; + (set-buffer "Keys") + (insert "\ ) ) ") -;;; -;;; Save the key mapping program -;;; -;;; -;;; Save the key mapping file -;;; -(let ((file (concat - "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") - (if edt-term (concat "-" edt-term)) - (if edt-xserver (concat "-" edt-xserver)) - (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) - "-keys"))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) -(save-buffer) + ;; + ;; Save the key mapping program + ;; + ;; + ;; Save the key mapping file + ;; + (let ((file (concat + "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") + (if edt-term (concat "-" edt-term)) + (if edt-xserver (concat "-" edt-xserver)) + (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) + "-keys"))) + (set-visited-file-name + (read-file-name (format "Save key mapping to file (default %s): " file) nil file))) + (save-buffer) -(message "That's it! Press any key to exit") -(sit-for 600) -(kill-emacs t) + (message "That's it! Press any key to exit") + (sit-for 600) + (kill-emacs t)) ;;; edt-mapper.el ends here diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 31f555b0326..a6b2d785ac5 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -1928,6 +1928,8 @@ Optional argument NOT-YES changes the default to negative." ;;; INITIALIZATION COMMANDS. ;;; +(declare-function edt-mapper "edt-mapper" ()) + ;;; ;;; Function used to load LK-201 key mapping file generated by edt-mapper.el. ;;; @@ -1968,7 +1970,7 @@ created." You can do this by quitting Emacs and then invoking Emacs again as follows: - emacs -q -l edt-mapper + emacs -q -l edt-mapper -f edt-mapper [NOTE: If you do nothing out of the ordinary in your init file, and the search for edt-mapper is successful, you can try running it now.] @@ -1983,7 +1985,9 @@ created." (insert (format "Ah yes, there it is, in \n\n %s \n\n" path)) (if (edt-y-or-n-p "Do you want to run it now? ") - (load-file path) + (progn + (load-file path) + (edt-mapper)) (error "EDT Emulation not configured"))) (insert (substitute-command-keys "Nope, I can't seem to find it. :-(\n\n")) From 68e8f4bb4aab3076f6b543864a9116d0a206c8f7 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Thu, 19 Jan 2017 21:40:38 -0700 Subject: [PATCH 08/62] css-mode documentation lookup feature * etc/NEWS: Mention new feature. * lisp/textmodes/css-mode.el (css-mode-map): New defvar. (css--mdn-lookup-history): New defvar. (css-lookup-url-format): New defcustom. (css--mdn-property-regexp, css--mdn-completion-list): New defconsts. (css--mdn-after-render, css--mdn-find-symbol, css-lookup-symbol): New defuns. * test/lisp/textmodes/css-mode-tests.el (css-mdn-symbol-guessing): New test. --- etc/NEWS | 7 ++ lisp/textmodes/css-mode.el | 114 ++++++++++++++++++++++++++ test/lisp/textmodes/css-mode-tests.el | 15 ++++ 3 files changed, 136 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index e368ff84f81..18ab162bd23 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -613,6 +613,13 @@ HTML tags, classes and IDs using the 'completion-at-point' command. Completion candidates for HTML classes and IDs are retrieved from open HTML mode buffers. +--- +*** CSS mode now binds 'C-h s' to a function that will show +information about a CSS construct (an at-rule, property, pseudo-class, +pseudo-element, with the default being guessed from context). By +default the information is looked up on the Mozilla Developer Network, +but this can be customized using 'css-lookup-url-format'. + +++ ** Emacs now supports character name escape sequences in character and string literals. The syntax variants \N{character name} and diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index c81c3f62e16..19f74daec63 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -35,6 +35,7 @@ (require 'seq) (require 'sgml-mode) (require 'smie) +(require 'eww) (defgroup css nil "Cascading Style Sheets (CSS) editing mode." @@ -621,6 +622,12 @@ cannot be completed sensibly: `custom-ident', (modify-syntax-entry ?- "_" st) st)) +(defvar css-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap info-lookup-symbol] 'css-lookup-symbol) + map) + "Keymap used in `css-mode'.") + (eval-and-compile (defconst css--uri-re (concat @@ -1087,5 +1094,112 @@ pseudo-elements, pseudo-classes, at-rules, and bang-rules." (setq-local font-lock-defaults (list (scss-font-lock-keywords) nil t))) + + +(defvar css--mdn-lookup-history nil) + +(defcustom css-lookup-url-format + "https://developer.mozilla.org/en-US/docs/Web/CSS/%s?raw¯os" + "Format for a URL where CSS documentation can be found. +The format should include a single \"%s\" substitution. +The name of the CSS property, @-id, pseudo-class, or pseudo-element +to look up will be substituted there." + :version "26.1" + :type 'string + :group 'css) + +(defun css--mdn-after-render () + (setf header-line-format nil) + (goto-char (point-min)) + (let ((window (get-buffer-window (current-buffer) 'visible))) + (when window + (when (re-search-forward "^Summary" nil 'move) + (beginning-of-line) + (set-window-start window (point)))))) + +(defconst css--mdn-symbol-regexp + (concat "\\(" + ;; @-ids. + "\\(@" (regexp-opt css-at-ids) "\\)" + "\\|" + ;; ;; Known properties. + (regexp-opt css-property-ids t) + "\\|" + ;; Pseudo-classes. + "\\(:" (regexp-opt css-pseudo-class-ids) "\\)" + "\\|" + ;; Pseudo-elements with either one or two ":"s. + "\\(::?" (regexp-opt css-pseudo-element-ids) "\\)" + "\\)") + "Regular expression to match the CSS symbol at point.") + +(defconst css--mdn-property-regexp + (concat "\\_<" (regexp-opt css-property-ids t) "\\s-*\\(?:\\=\\|:\\)") + "Regular expression to match a CSS property.") + +(defconst css--mdn-completion-list + (nconc + ;; @-ids. + (mapcar (lambda (atrule) (concat "@" atrule)) css-at-ids) + ;; Pseudo-classes. + (mapcar (lambda (class) (concat ":" class)) css-pseudo-class-ids) + ;; Pseudo-elements with either one or two ":"s. + (mapcar (lambda (elt) (concat ":" elt)) css-pseudo-element-ids) + (mapcar (lambda (elt) (concat "::" elt)) css-pseudo-element-ids) + ;; Properties. + css-property-ids) + "List of all symbols available for lookup via MDN.") + +(defun css--mdn-find-symbol () + "A helper for `css-lookup-symbol' that finds the symbol at point. +Returns the symbol, a string, or nil if none found." + (save-excursion + ;; Skip backward over a word first. + (skip-chars-backward "-[:alnum:] \t") + ;; Now skip ":" or "@" to see if it's a pseudo-element or at-id. + (skip-chars-backward "@:") + (if (looking-at css--mdn-symbol-regexp) + (match-string-no-properties 0) + (let ((bound (save-excursion + (beginning-of-line) + (point)))) + (when (re-search-backward css--mdn-property-regexp bound t) + (match-string-no-properties 1)))))) + +;;;###autoload +(defun css-lookup-symbol (symbol) + "Display the CSS documentation for SYMBOL, as found on MDN. +When this command is used interactively, it picks a default +symbol based on the CSS text before point -- either an @-keyword, +a property name, a pseudo-class, or a pseudo-element, depending +on what is seen near point." + (interactive + (list + (let* ((sym (css--mdn-find-symbol)) + (enable-recursive-minibuffers t) + (value (completing-read + (if sym + (format "Describe CSS symbol (default %s): " sym) + "Describe CSS symbol: ") + css--mdn-completion-list nil nil nil + 'css--mdn-lookup-history sym))) + (if (equal value "") sym value)))) + (when symbol + ;; If we see a single-colon pseudo-element like ":after", turn it + ;; into "::after". + (when (and (eq (aref symbol 0) ?:) + (member (substring symbol 1) css-pseudo-element-ids)) + (setq symbol (concat ":" symbol))) + (let ((url (format css-lookup-url-format symbol)) + (buffer (get-buffer-create "*MDN CSS*"))) + (save-selected-window + ;; Make sure to display the buffer before calling `eww', as + ;; that calls `pop-to-buffer-same-window'. + (switch-to-buffer-other-window buffer) + (with-current-buffer buffer + (eww-mode) + (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t) + (eww url)))))) + (provide 'css-mode) ;;; css-mode.el ends here diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 6eb32ea7fc4..5372c37a179 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -218,5 +218,20 @@ (should (member "body" completions)) (should-not (member "article" completions))))) +(ert-deftest css-mdn-symbol-guessing () + (dolist (item '(("@med" "ia" "@media") + ("@keyframes " "{" "@keyframes") + ("p::after" "" "::after") + ("p:before" "" ":before") + ("a:v" "isited" ":visited") + ("border-" "color: red" "border-color") + ("border-color: red" ";" "border-color") + ("border-color: red; color: green" ";" "color"))) + (with-temp-buffer + (css-mode) + (insert (nth 0 item)) + (save-excursion (insert (nth 1 item))) + (should (equal (nth 2 item) (css--mdn-find-symbol)))))) + (provide 'css-mode-tests) ;;; css-mode-tests.el ends here From 3c941b900007c9e79c00af0f21d88154f6d8af1a Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Fri, 25 Nov 2016 13:15:12 -0800 Subject: [PATCH 09/62] comint-get-old-input-default: behavior follows docstring lisp/comint.el (comint-get-old-input-default): Modify behavior to follow docstring: if `comint-use-prompt-regexp' is nil, then return the CURRENT LINE, if point is on an output field. --- lisp/comint.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index 830f4ca88f9..b23f72ed618 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2239,10 +2239,7 @@ the current line with any initial string matching the regexp (null (get-char-property (setq bof (field-beginning)) 'field))) (field-string-no-properties bof) (comint-bol) - (buffer-substring-no-properties (point) - (if comint-use-prompt-regexp - (line-end-position) - (field-end)))))) + (buffer-substring-no-properties (point) (line-end-position))))) (defun comint-copy-old-input () "Insert after prompt old input at point as new input to be edited. From f3c77d11af65f3b319b1784b4c3cf08c51aa7997 Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Mon, 5 Dec 2016 21:42:20 -0800 Subject: [PATCH 10/62] stash --- lisp/comint.el | 6 ++++- lisp/emacs-lisp/debug.el | 54 ++++++++++++++++++++++++++++++++++++++++ lisp/shell.el | 2 ++ src/data.c | 50 +++++++++++++++++++++++++++++++++++++ src/fns.c | 4 +++ 5 files changed, 115 insertions(+), 1 deletion(-) diff --git a/lisp/comint.el b/lisp/comint.el index b23f72ed618..c82c3d09df3 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1879,6 +1879,7 @@ Similarly for Soar, Scheme, etc." (let ((echo-len (- comint-last-input-end comint-last-input-start))) ;; Wait for all input to be echoed: + (while (and (> (+ comint-last-input-end echo-len) (point-max)) (accept-process-output proc) @@ -1890,6 +1891,7 @@ Similarly for Soar, Scheme, etc." ;; (+ comint-last-input-start ;; (- (point-max) comint-last-input-end)) nil comint-last-input-end (point-max))))) + (if (and (<= (+ comint-last-input-end echo-len) (point-max)) @@ -1901,6 +1903,7 @@ Similarly for Soar, Scheme, etc." ;; Certain parts of the text to be deleted may have ;; been mistaken for prompts. We have to prevent ;; problems when `comint-prompt-read-only' is non-nil. + (let ((inhibit-read-only t)) (delete-region comint-last-input-end (+ comint-last-input-end echo-len)) @@ -1909,6 +1912,7 @@ Similarly for Soar, Scheme, etc." (goto-char comint-last-input-end) (comint-update-fence))))))) + ;; This used to call comint-output-filter-functions, ;; but that scrolled the buffer in undesirable ways. (run-hook-with-args 'comint-output-filter-functions ""))))) @@ -2666,7 +2670,7 @@ This command is like `M-.' in bash." (set-marker comint-insert-previous-argument-last-start-pos (point)) ;; Insert the argument. (let ((input-string (comint-previous-input-string 0))) - (when (string-match "[ \t\n]*&" input-string) + (when (string-match "[ \t\n]*&[ \t\n]*$" input-string) ;; strip terminating '&' (setq input-string (substring input-string 0 (match-beginning 0)))) (insert (comint-arguments input-string index index))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index cb77148c285..faa323f733a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -816,6 +816,60 @@ Redefining FUNCTION also cancels it." '((depth . -100))) function) +;;;###autoload +;; (defun debug-on-set (symbol) +;; "Request FUNCTION to invoke debugger each time it is called. + +;; When called interactively, prompt for FUNCTION in the minibuffer. + +;; This works by modifying the definition of FUNCTION. If you tell the +;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a +;; normal function or a macro written in Lisp, you can also step through +;; its execution. FUNCTION can also be a primitive that is not a special +;; form, in which case stepping is not possible. Break-on-entry for +;; primitive functions only works when that function is called from Lisp. + +;; Use \\[cancel-debug-on-entry] to cancel the effect of this command. +;; Redefining FUNCTION also cancels it." +;; (interactive +;; (let ((v (variable-at-point)) +;; (enable-recursive-minibuffers t) +;; (orig-buffer (current-buffer)) +;; val) +;; (setq val (completing-read +;; (if (symbolp v) +;; (format +;; "Debug on set to symbol (default %s): " v) +;; "Debug on set to symbol: ") +;; #'help--symbol-completion-table +;; (lambda (vv) +;; ;; In case the variable only exists in the buffer +;; ;; the command we switch back to that buffer before +;; ;; we examine the variable. +;; (with-current-buffer orig-buffer +;; (or (get vv 'variable-documentation) +;; (and (boundp vv) (not (keywordp vv)))))) +;; t nil nil +;; (if (symbolp v) (symbol-name v)))) +;; (list (if (equal val "") +;; v (intern val))))) + + + +;; (interactive +;; (let* ((var-default (variable-at-point)) +;; (var (completing-read +;; (if var-default +;; (format "Debug on set to symbol (default %s): " var-default) +;; "Debug on set to symbol: ") +;; nil +;; #'boundp +;; t nil nil (symbol-name var-default)))) +;; (list (if (equal var "") var-default (intern var))))) +;; (advice-add function :before #'debug--implement-debug-on-entry +;; '((depth . -100))) +;; function) + (defun debug--function-list () "List of functions currently set for debug on entry." (let ((funs '())) diff --git a/lisp/shell.el b/lisp/shell.el index c8a8555d632..c7ba64ecf4e 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1000,6 +1000,8 @@ command again." (let ((pt (point)) (regexp (concat + ;; comint-process-echoes is the thing that breaks the + ;; throbber (if comint-process-echoes ;; Skip command echo if the process echoes (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") diff --git a/src/data.c b/src/data.c index 8e07bf01b44..26ff9948828 100644 --- a/src/data.c +++ b/src/data.c @@ -1304,6 +1304,56 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, default: emacs_abort (); } + + const char* symname = SDATA(sym->name); + + if( EQ(Vwatch_object, symbol) ) + { + static int nest_level = 0; + if(nest_level++ == 0) + { + switch(sym->redirect) + { + case SYMBOL_PLAINVAL: + { + AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_PLAINVAL"); + CALLN (Fmessage, format, SYMBOL_NAME (symbol)); + break; + } + case SYMBOL_VARALIAS: + { + AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_VARALIAS"); + CALLN (Fmessage, format, SYMBOL_NAME (symbol)); + break; + } + case SYMBOL_LOCALIZED: + { + AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_LOCALIZED"); + CALLN (Fmessage, format, SYMBOL_NAME (symbol)); + break; + } + case SYMBOL_FORWARDED: + { + AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_FORWARDED"); + CALLN (Fmessage, format, SYMBOL_NAME (symbol)); + break; + } + + default: + { + AUTO_STRING (format, "Setting symbol '%s'; redirect: UNKNOWN"); + CALLN (Fmessage, format, SYMBOL_NAME (symbol)); + break; + } + } + } + nest_level--; + } + + + + + start: switch (sym->redirect) { diff --git a/src/fns.c b/src/fns.c index 136a2198c2c..9eabc1414f4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5120,6 +5120,10 @@ On some platforms, file selection dialogs are also enabled if this is non-nil. */); use_dialog_box = 1; + DEFVAR_LISP("watch-object", Vwatch_object, + doc: /* Symbol to watch. */); + Vwatch_object = Qnil; + DEFVAR_BOOL ("use-file-dialog", use_file_dialog, doc: /* Non-nil means mouse commands use a file dialog to ask for files. This applies to commands from menus and tool bar buttons even when From fbf74c158ea81ff6349f68760f8861c1c497c989 Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Tue, 31 Jan 2017 07:46:10 -0800 Subject: [PATCH 11/62] Revert two accidental commits This reverts commit f3c77d11af65f3b319b1784b4c3cf08c51aa7997. This reverts commit 3c941b900007c9e79c00af0f21d88154f6d8af1a. --- lisp/comint.el | 11 ++++---- lisp/emacs-lisp/debug.el | 54 ---------------------------------------- lisp/shell.el | 2 -- src/data.c | 50 ------------------------------------- src/fns.c | 4 --- 5 files changed, 5 insertions(+), 116 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index c82c3d09df3..830f4ca88f9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1879,7 +1879,6 @@ Similarly for Soar, Scheme, etc." (let ((echo-len (- comint-last-input-end comint-last-input-start))) ;; Wait for all input to be echoed: - (while (and (> (+ comint-last-input-end echo-len) (point-max)) (accept-process-output proc) @@ -1891,7 +1890,6 @@ Similarly for Soar, Scheme, etc." ;; (+ comint-last-input-start ;; (- (point-max) comint-last-input-end)) nil comint-last-input-end (point-max))))) - (if (and (<= (+ comint-last-input-end echo-len) (point-max)) @@ -1903,7 +1901,6 @@ Similarly for Soar, Scheme, etc." ;; Certain parts of the text to be deleted may have ;; been mistaken for prompts. We have to prevent ;; problems when `comint-prompt-read-only' is non-nil. - (let ((inhibit-read-only t)) (delete-region comint-last-input-end (+ comint-last-input-end echo-len)) @@ -1912,7 +1909,6 @@ Similarly for Soar, Scheme, etc." (goto-char comint-last-input-end) (comint-update-fence))))))) - ;; This used to call comint-output-filter-functions, ;; but that scrolled the buffer in undesirable ways. (run-hook-with-args 'comint-output-filter-functions ""))))) @@ -2243,7 +2239,10 @@ the current line with any initial string matching the regexp (null (get-char-property (setq bof (field-beginning)) 'field))) (field-string-no-properties bof) (comint-bol) - (buffer-substring-no-properties (point) (line-end-position))))) + (buffer-substring-no-properties (point) + (if comint-use-prompt-regexp + (line-end-position) + (field-end)))))) (defun comint-copy-old-input () "Insert after prompt old input at point as new input to be edited. @@ -2670,7 +2669,7 @@ This command is like `M-.' in bash." (set-marker comint-insert-previous-argument-last-start-pos (point)) ;; Insert the argument. (let ((input-string (comint-previous-input-string 0))) - (when (string-match "[ \t\n]*&[ \t\n]*$" input-string) + (when (string-match "[ \t\n]*&" input-string) ;; strip terminating '&' (setq input-string (substring input-string 0 (match-beginning 0)))) (insert (comint-arguments input-string index index))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index faa323f733a..cb77148c285 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -816,60 +816,6 @@ Redefining FUNCTION also cancels it." '((depth . -100))) function) -;;;###autoload -;; (defun debug-on-set (symbol) -;; "Request FUNCTION to invoke debugger each time it is called. - -;; When called interactively, prompt for FUNCTION in the minibuffer. - -;; This works by modifying the definition of FUNCTION. If you tell the -;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a -;; normal function or a macro written in Lisp, you can also step through -;; its execution. FUNCTION can also be a primitive that is not a special -;; form, in which case stepping is not possible. Break-on-entry for -;; primitive functions only works when that function is called from Lisp. - -;; Use \\[cancel-debug-on-entry] to cancel the effect of this command. -;; Redefining FUNCTION also cancels it." -;; (interactive -;; (let ((v (variable-at-point)) -;; (enable-recursive-minibuffers t) -;; (orig-buffer (current-buffer)) -;; val) -;; (setq val (completing-read -;; (if (symbolp v) -;; (format -;; "Debug on set to symbol (default %s): " v) -;; "Debug on set to symbol: ") -;; #'help--symbol-completion-table -;; (lambda (vv) -;; ;; In case the variable only exists in the buffer -;; ;; the command we switch back to that buffer before -;; ;; we examine the variable. -;; (with-current-buffer orig-buffer -;; (or (get vv 'variable-documentation) -;; (and (boundp vv) (not (keywordp vv)))))) -;; t nil nil -;; (if (symbolp v) (symbol-name v)))) -;; (list (if (equal val "") -;; v (intern val))))) - - - -;; (interactive -;; (let* ((var-default (variable-at-point)) -;; (var (completing-read -;; (if var-default -;; (format "Debug on set to symbol (default %s): " var-default) -;; "Debug on set to symbol: ") -;; nil -;; #'boundp -;; t nil nil (symbol-name var-default)))) -;; (list (if (equal var "") var-default (intern var))))) -;; (advice-add function :before #'debug--implement-debug-on-entry -;; '((depth . -100))) -;; function) - (defun debug--function-list () "List of functions currently set for debug on entry." (let ((funs '())) diff --git a/lisp/shell.el b/lisp/shell.el index c7ba64ecf4e..c8a8555d632 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1000,8 +1000,6 @@ command again." (let ((pt (point)) (regexp (concat - ;; comint-process-echoes is the thing that breaks the - ;; throbber (if comint-process-echoes ;; Skip command echo if the process echoes (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") diff --git a/src/data.c b/src/data.c index 26ff9948828..8e07bf01b44 100644 --- a/src/data.c +++ b/src/data.c @@ -1304,56 +1304,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, default: emacs_abort (); } - - const char* symname = SDATA(sym->name); - - if( EQ(Vwatch_object, symbol) ) - { - static int nest_level = 0; - if(nest_level++ == 0) - { - switch(sym->redirect) - { - case SYMBOL_PLAINVAL: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_PLAINVAL"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_VARALIAS: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_VARALIAS"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_LOCALIZED: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_LOCALIZED"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_FORWARDED: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_FORWARDED"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - - default: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: UNKNOWN"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - } - } - nest_level--; - } - - - - - start: switch (sym->redirect) { diff --git a/src/fns.c b/src/fns.c index 9eabc1414f4..136a2198c2c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5120,10 +5120,6 @@ On some platforms, file selection dialogs are also enabled if this is non-nil. */); use_dialog_box = 1; - DEFVAR_LISP("watch-object", Vwatch_object, - doc: /* Symbol to watch. */); - Vwatch_object = Qnil; - DEFVAR_BOOL ("use-file-dialog", use_file_dialog, doc: /* Non-nil means mouse commands use a file dialog to ask for files. This applies to commands from menus and tool bar buttons even when From 189df8262e54c486658784801da3e90b29a548df Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Mon, 30 Jan 2017 21:43:32 -0800 Subject: [PATCH 12/62] Handle patch terminators produced by git and bzr patch export Patch by Juri Linkov posted in the #9597 bug report * lisp/vc/diff-mode.el (diff-sanity-check-hunk): Find and ignore terminator (Bug #9597, #5302) --- lisp/vc/diff-mode.el | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index e609ca9f943..7ffa115bde4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -437,6 +437,9 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") (defconst diff-hunk-header-re (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")) (defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1))) + +(defconst diff-separator-re "^--+ ?$") + (defvar diff-narrowed-to nil) (defun diff-hunk-style (&optional style) @@ -1537,15 +1540,20 @@ Only works for unified diffs." (pcase (char-after) (?\s (cl-decf before) (cl-decf after) t) (?- - (if (and (looking-at diff-file-header-re) - (zerop before) (zerop after)) - ;; No need to query: this is a case where two patches - ;; are concatenated and only counting the lines will - ;; give the right result. Let's just add an empty - ;; line so that our code which doesn't count lines - ;; will not get confused. - (progn (save-excursion (insert "\n")) nil) - (cl-decf before) t)) + (cond + ((and (looking-at diff-separator-re) + (zerop before) (zerop after)) + nil) + ((and (looking-at diff-file-header-re) + (zerop before) (zerop after)) + ;; No need to query: this is a case where two patches + ;; are concatenated and only counting the lines will + ;; give the right result. Let's just add an empty + ;; line so that our code which doesn't count lines + ;; will not get confused. + (save-excursion (insert "\n")) nil) + (t + (cl-decf before) t))) (?+ (cl-decf after) t) (_ (cond From 3506ec2b110b7de75e9e41657d97d04b04b9e6ff Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Mon, 30 Jan 2017 23:40:54 -0800 Subject: [PATCH 13/62] New test for diff-mode handling trailing -- test/lisp/vc/diff-mode-tests.el: New test file --- test/lisp/vc/diff-mode-tests.el | 199 ++++++++++++++++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 test/lisp/vc/diff-mode-tests.el diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el new file mode 100644 index 00000000000..3887afb59b9 --- /dev/null +++ b/test/lisp/vc/diff-mode-tests.el @@ -0,0 +1,199 @@ +;; Copyright (C) 2017 Free Software Foundation, Inc + +;; Author: Dima Kogan +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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 . + + +(ert-deftest diff-mode-test-ignore-trailing-dashes () + "Check to make sure we successfully ignore trailing -- made by +'git format-patch'. This is bug #9597" + + ;; I made a test repo, put some files in it, made arbitrary changes + ;; and invoked 'git format-patch' to get a patch out of it. The + ;; patch and the before and after versions of the files appear here. + ;; The test simply tries to apply the patch. The patch contains + ;; trailing --, which confused diff-mode previously + (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17 00:00:00 2001 +From: Dima Kogan +Date: Mon, 30 Jan 2017 22:24:13 -0800 +Subject: [PATCH] test commit + +--- + fil | 3 --- + fil2 | 4 ---- + 2 files changed, 7 deletions(-) + +diff --git a/fil b/fil +index 10344f1..2a56245 100644 +--- a/fil ++++ b/fil +@@ -2,10 +2,8 @@ Afrocentrism + Americanisms + Americanization + Americanizations +-Americanized + Americanizes + Americanizing +-Andrianampoinimerina + Anglicanisms + Antananarivo + Apalachicola +@@ -15,6 +13,5 @@ Aristophanes + Aristotelian + Ashurbanipal + Australopithecus +-Austronesian + Bangladeshis + Barquisimeto +diff --git a/fil2 b/fil2 +index 8858f0d..86e8ea5 100644 +--- a/fil2 ++++ b/fil2 +@@ -1,20 +1,16 @@ + whippoorwills + whitewashing + wholehearted +-wholeheartedly + wholesomeness + wildernesses + windbreakers + wisecracking + withstanding +-woodcarvings + woolgathering + workstations + worthlessness + wretchedness + wristwatches +-wrongfulness + wrongheadedly + wrongheadedness +-xylophonists + youthfulness +-- +2.11.0 + +") + (fil_before "Afrocentrism +Americanisms +Americanization +Americanizations +Americanized +Americanizes +Americanizing +Andrianampoinimerina +Anglicanisms +Antananarivo +Apalachicola +Appalachians +Argentinians +Aristophanes +Aristotelian +Ashurbanipal +Australopithecus +Austronesian +Bangladeshis +Barquisimeto +") + (fil_after "Afrocentrism +Americanisms +Americanization +Americanizations +Americanizes +Americanizing +Anglicanisms +Antananarivo +Apalachicola +Appalachians +Argentinians +Aristophanes +Aristotelian +Ashurbanipal +Australopithecus +Bangladeshis +Barquisimeto +") + (fil2_before "whippoorwills +whitewashing +wholehearted +wholeheartedly +wholesomeness +wildernesses +windbreakers +wisecracking +withstanding +woodcarvings +woolgathering +workstations +worthlessness +wretchedness +wristwatches +wrongfulness +wrongheadedly +wrongheadedness +xylophonists +youthfulness +") + (fil2_after "whippoorwills +whitewashing +wholehearted +wholesomeness +wildernesses +windbreakers +wisecracking +withstanding +woolgathering +workstations +worthlessness +wretchedness +wristwatches +wrongheadedly +wrongheadedness +youthfulness +") + (temp-dir (make-temp-file "diff-mode-test" 'dir))) + + (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" ))) + (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2")))) + (unwind-protect + (progn + (with-current-buffer buf (insert fil_before) (save-buffer)) + (with-current-buffer buf2 (insert fil2_before) (save-buffer)) + + (with-temp-buffer + (cd temp-dir) + (insert patch) + (beginning-of-buffer) + (diff-apply-hunk) + (diff-apply-hunk) + (diff-apply-hunk)) + + (should (equal (with-current-buffer buf (buffer-string)) + fil_after)) + (should (equal (with-current-buffer buf2 (buffer-string)) + fil2_after))) + + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf) + (with-current-buffer buf2 (set-buffer-modified-p nil)) + (kill-buffer buf2) + (delete-directory temp-dir 'recursive)))))) + + +(provide 'diff-mode-tests) From 52a1ce65d693daaa395e7d594ec441ab7b652d70 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Wed, 1 Feb 2017 01:20:46 +0900 Subject: [PATCH 14/62] * test/lisp/vc/diff-mode-tests.el: Require diff-mode. --- test/lisp/vc/diff-mode-tests.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 3887afb59b9..807a411fa5d 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -18,6 +18,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Code: + +(require 'diff-mode) + (ert-deftest diff-mode-test-ignore-trailing-dashes () "Check to make sure we successfully ignore trailing -- made by From a727a0303eb34858389cb4331944e0e63411f2ff Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 31 Jan 2017 08:29:02 -0800 Subject: [PATCH 15/62] * src/alloc.c, src/lisp.h: Fix minor glitches in recent changes. --- src/alloc.c | 24 ++++++++++-------------- src/lisp.h | 4 ++-- 2 files changed, 12 insertions(+), 16 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index dd2b688f91e..b59220c5d84 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5437,7 +5437,8 @@ make_pure_vector (ptrdiff_t len) /* Copy all contents and parameters of TABLE to a new table allocated from pure space, return the purified table. */ static struct Lisp_Hash_Table * -purecopy_hash_table (struct Lisp_Hash_Table *table) { +purecopy_hash_table (struct Lisp_Hash_Table *table) +{ eassert (NILP (table->weak)); eassert (!NILP (table->pure)); @@ -5480,14 +5481,12 @@ Does not copy symbols. Copies strings without text properties. */) return purecopy (obj); } -struct pinned_object +/* Pinned objects are marked before every GC cycle. */ +static struct pinned_object { Lisp_Object object; struct pinned_object *next; -}; - -/* Pinned objects are marked before every GC cycle. */ -static struct pinned_object *pinned_objects; +} *pinned_objects; static Lisp_Object purecopy (Lisp_Object obj) @@ -5519,13 +5518,13 @@ purecopy (Lisp_Object obj) else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *table = XHASH_TABLE (obj); - /* We cannot purify hash tables which haven't been defined with + /* Do not purify hash tables which haven't been defined with :purecopy as non-nil or are weak - they aren't guaranteed to not change. */ if (!NILP (table->weak) || NILP (table->pure)) { - /* Instead, the hash table is added to the list of pinned objects, - and is marked before GC. */ + /* Instead, add the hash table to the list of pinned objects, + so that it will be marked during GC. */ struct pinned_object *o = xmalloc (sizeof *o); o->object = obj; o->next = pinned_objects; @@ -5755,11 +5754,8 @@ compact_undo_list (Lisp_Object list) static void mark_pinned_objects (void) { - struct pinned_object *pobj; - for (pobj = pinned_objects; pobj; pobj = pobj->next) - { - mark_object (pobj->object); - } + for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) + mark_object (pobj->object); } static void diff --git a/src/lisp.h b/src/lisp.h index 91c430fe98d..58e22889889 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1995,8 +1995,8 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ Lisp_Object index; - /* Non-nil if the table can be purecopied. Any changes the table after - purecopy will result in an error. */ + /* Non-nil if the table can be purecopied. The table cannot be + changed afterwards. */ Lisp_Object pure; /* Only the fields above are traced normally by the GC. The ones below From 18a3fccd89d04afc13ce7b4561e224874c317283 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 31 Jan 2017 17:36:06 +0100 Subject: [PATCH 16/62] Allow C-s C-w to yank ' to the search ring in the Gnus article buffer * lisp/gnus/gnus-art.el (gnus-article-mode-syntax-table): Make M-. in article buffers work for `foo' strings, and still allow C-s C-w to yank ' to the search ring (bug#22248). --- lisp/gnus/gnus-art.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 43e1231914c..a4ff840f755 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1713,9 +1713,10 @@ regexp." ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")<" table) (modify-syntax-entry ?< "(>" table) - ;; make M-. in article buffers work for `foo' strings - (modify-syntax-entry ?' " " table) - (modify-syntax-entry ?` " " table) + ;; make M-. in article buffers work for `foo' strings, + ;; and still allow C-s C-w to yank ' to the search ring + (modify-syntax-entry ?' "'" table) + (modify-syntax-entry ?` "'" table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table'.") From d1c931009004aef847105b7bac6b6ffafd985b82 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 31 Jan 2017 17:52:51 +0100 Subject: [PATCH 17/62] DOn't use string-as-unibyte in Gnus * lisp/gnus/nnmail.el (nnmail-parse-active): Don't use string-as-unibyte. (nnmail-insert-xref): Ditto. * lisp/gnus/canlock.el (canlock-make-cancel-key): Ditto. * lisp/gnus/gnus-art.el (gnus-article-browse-html-parts): Ditto. * lisp/gnus/gnus-srvr.el (gnus-browse-foreign-server): Ditto. (gnus-browse-foreign-server): Ditto. (gnus-browse-foreign-server): Ditto. * lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed): Ditto. (gnus-read-newsrc-el-file): Ditto. * lisp/gnus/mml.el (mml-generate-mime-1): Ditto. * lisp/gnus/nnir.el (nnir-get-active): Ditto. (nnir-get-active): Ditto. --- lisp/gnus/canlock.el | 2 +- lisp/gnus/gnus-art.el | 3 ++- lisp/gnus/gnus-srvr.el | 10 ++++++---- lisp/gnus/gnus-start.el | 4 ++-- lisp/gnus/mml.el | 5 +++-- lisp/gnus/nnir.el | 10 ++++++---- lisp/gnus/nnmail.el | 7 ++++--- 7 files changed, 24 insertions(+), 17 deletions(-) diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 9e13ced4670..6c28b1c66df 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -90,7 +90,7 @@ buffer does not look like a news message." (canlock-sha1 (concat opad (canlock-sha1 - (concat ipad (string-as-unibyte message-id)))))))) + (concat ipad (encode-coding-string message-id 'utf-8)))))))) (defun canlock-narrow-to-header () "Narrow the buffer to the head of the message." diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a4ff840f755..d96c511ec0d 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2938,7 +2938,8 @@ message header will be added to the bodies of the \"text/html\" parts." (encode-coding-string title coding)) body content)) - (setq eheader (string-as-unibyte (buffer-string)) + (setq eheader (encode-coding-string + (buffer-string) 'utf-8) body content))) (erase-buffer) (mm-disable-multibyte) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index bed5993b9c1..67744cebc87 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -821,12 +821,13 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (string-as-unibyte + (encode-coding-string (buffer-substring (point) (progn (skip-chars-forward "^ \t") - (point)))) + (point))) + 'utf-8) (let ((last (read cur))) (cons (read cur) last))) groups)) @@ -834,7 +835,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (string-as-unibyte + (encode-coding-string (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -846,7 +847,8 @@ claim them." (skip-chars-forward "^ \t\\\\") (setq name (concat name (buffer-substring p (point))))) - name))) + name)) + 'utf-8) (let ((last (read cur))) (cons (read cur) last))) groups)) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index be46339cd38..2cefc78fb9e 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1990,7 +1990,7 @@ backend check whether the group actually exists." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (string-as-unibyte (car killed)) nil hashtb) + (gnus-sethash (encode-coding-string (car killed) 'utf-8) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2453,7 +2453,7 @@ If FORCE is non-nil, the .newsrc file is read." (dolist (elem gnus-newsrc-alist) ;; Protect against broken .newsrc.el files. (when (car elem) - (setcar elem (string-as-unibyte (car elem))))) + (setcar elem (encode-coding-string (car elem) 'utf-8)))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 3a31349d378..aaadf0c7778 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -696,9 +696,10 @@ be \"related\" or \"alternate\"." (set-buffer-multibyte nil) (cond ((cdr (assq 'buffer cont)) - (insert (string-as-unibyte + (insert (encode-coding-string (with-current-buffer (cdr (assq 'buffer cont)) - (buffer-string))))) + (buffer-string)) + 'utf-8))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 9640f2c746f..174be65035f 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1818,19 +1818,20 @@ article came from is also searched." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (string-as-unibyte + (push (encode-coding-string (gnus-group-full-name (buffer-substring (point) (progn (skip-chars-forward "^ \t") (point))) - method)) + method) + 'utf-8) groups)) (forward-line)) (while (not (eobp)) (ignore-errors - (push (string-as-unibyte + (push (encode-coding-string (if (eq (char-after) ?\") (gnus-group-full-name (read cur) method) (let ((p (point)) (name "")) @@ -1842,7 +1843,8 @@ article came from is also searched." (skip-chars-forward "^ \t\\\\") (setq name (concat name (buffer-substring p (point))))) - (gnus-group-full-name name method)))) + (gnus-group-full-name name method))) + 'utf-8) groups)) (forward-line))))) groups)) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 3f2e08171e0..224d5db5427 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -665,7 +665,7 @@ nn*-request-list should have been called before calling this function." (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list (string-as-unibyte group) (cons min max)) + (push (list (encode-coding-string group 'utf-8) (cons min max)) group-assoc))) (error nil)) (widen) @@ -1251,8 +1251,9 @@ Return the number of characters in the body." (insert (if (mm-multibyte-p) (string-as-multibyte (format " %s:%d" (caar group-alist) (cdar group-alist))) - (string-as-unibyte - (format " %s:%d" (caar group-alist) (cdar group-alist))))) + (encode-coding-string + (format " %s:%d" (caar group-alist) (cdar group-alist)) + 'utf-8))) (setq group-alist (cdr group-alist))) (insert "\n"))) From 5060ea50182f91695bb72622efcd4d1b69f56a1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Tue, 31 Jan 2017 20:08:54 +0100 Subject: [PATCH 18/62] Fix typo in a NEWS entry for CSS mode --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 18ab162bd23..86a8385ae76 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -614,7 +614,7 @@ Completion candidates for HTML classes and IDs are retrieved from open HTML mode buffers. --- -*** CSS mode now binds 'C-h s' to a function that will show +*** CSS mode now binds 'C-h S' to a function that will show information about a CSS construct (an at-rule, property, pseudo-class, pseudo-element, with the default being guessed from context). By default the information is looked up on the Mozilla Developer Network, From 52515f1133f2b87c573524d83c86b08e70ce1c30 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Tue, 31 Jan 2017 14:12:41 -0500 Subject: [PATCH 19/62] auth-source-user-and-password: add forgotten user parameter * lisp/auth-source.el (auth-source-user-and-password): Use accidentally unused "user" parameter. Reported by Oscar Najera . --- lisp/auth-source.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index c26935fcc97..7402ab21d74 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -2129,7 +2129,7 @@ MODE can be \"login\" or \"password\"." (if user (auth-source-search :host host - :user "yourusername" + :user user :max 1 :require '(:user :secret) :create nil) From 5af51bd4451ae6d00ab878a7cfc6782280a81c84 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Tue, 31 Jan 2017 14:17:58 -0500 Subject: [PATCH 20/62] read-multiple-choice: explain dialog popups more * lisp/emacs-lisp/subr-x.el (read-multiple-choice): Explain when a graphical popup is used and how it can be avoided. --- lisp/emacs-lisp/subr-x.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7736225b5fa..52331b9ad36 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -214,6 +214,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses, perform the requested window recentering or scrolling and ask again. +When `use-dialog-box' is t (the default), this function can pop +up a dialog window to collect the user input. That functionality +requires `display-popup-menus-p' to return t. Otherwise, a text +dialog will be used. + The return value is the matching entry from the CHOICES list. Usage example: From 12da2a5beafc4595fe4dd922431ba9f013b84830 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Tue, 31 Jan 2017 19:46:28 -0500 Subject: [PATCH 21/62] ; Bump let-alist * lisp/emacs-lisp/let-alist.el: Bump micro version (bug#24641). --- lisp/emacs-lisp/let-alist.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index a45fc0a05c3..cf82fe3ec63 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -4,7 +4,7 @@ ;; Author: Artur Malabarba ;; Package-Requires: ((emacs "24.1")) -;; Version: 1.0.4 +;; Version: 1.0.5 ;; Keywords: extensions lisp ;; Prefix: let-alist ;; Separator: - From d805757618092d5d46b8a95d2a046146c4916dc6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 1 Feb 2017 10:06:37 +0100 Subject: [PATCH 22/62] Fix a subtle problem in Tramp with timers * lisp/net/tramp.el (tramp-accept-process-output): Change argument list. Make it work when called inside a timer. See . --- lisp/net/tramp.el | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index fc7fdd30850..48dcd5edd11 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3614,18 +3614,36 @@ connection buffer." ;;; Utility functions: -(defun tramp-accept-process-output (&optional proc timeout timeout-msecs) +(defun tramp-accept-process-output (proc timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also." + ;; FIXME: There are problems, when an asynchronous process runs in + ;; parallel, and also timers are active. See + ;; . + (when (and timer-event-last + (string-prefix-p "*tramp/" (process-name proc)) + (let (result) + (maphash + (lambda (key _value) + (and (processp key) + (not (string-prefix-p "*tramp/" (process-name key))) + (tramp-compat-process-live-p key) + (setq result t))) + tramp-cache-data) + result)) + (sit-for 0.01 'nodisp)) (with-current-buffer (process-buffer proc) (let (buffer-read-only last-coding-system-used) ;; Under Windows XP, accept-process-output doesn't return - ;; sometimes. So we add an additional timeout. - (with-timeout ((or timeout 1)) - (accept-process-output proc timeout timeout-msecs (and proc t))) - (tramp-message proc 10 "%s %s\n%s" - proc (process-status proc) (buffer-string))))) + ;; sometimes. So we add an additional timeout. JUST-THIS-ONE + ;; is set due to Bug#12145. + (tramp-message + proc 10 "%s %s %s\n%s" + proc (process-status proc) + (with-timeout (timeout) + (accept-process-output proc timeout nil t)) + (buffer-string))))) (defun tramp-check-for-regexp (proc regexp) "Check, whether REGEXP is contained in process buffer of PROC. From 5d61ef0de9a3f5b1be9e93465cb88aae995975ba Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 1 Feb 2017 13:48:02 +0100 Subject: [PATCH 23/62] Revert "DOn't use string-as-unibyte in Gnus" This reverts commit d1c931009004aef847105b7bac6b6ffafd985b82. Not all the cases where we had string-as-unibyte were characters, so this needs to be considered more thoroughly before being redone. --- lisp/gnus/canlock.el | 2 +- lisp/gnus/gnus-art.el | 3 +-- lisp/gnus/gnus-srvr.el | 10 ++++------ lisp/gnus/gnus-start.el | 4 ++-- lisp/gnus/mml.el | 5 ++--- lisp/gnus/nnir.el | 10 ++++------ lisp/gnus/nnmail.el | 7 +++---- 7 files changed, 17 insertions(+), 24 deletions(-) diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 6c28b1c66df..9e13ced4670 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -90,7 +90,7 @@ buffer does not look like a news message." (canlock-sha1 (concat opad (canlock-sha1 - (concat ipad (encode-coding-string message-id 'utf-8)))))))) + (concat ipad (string-as-unibyte message-id)))))))) (defun canlock-narrow-to-header () "Narrow the buffer to the head of the message." diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d96c511ec0d..a4ff840f755 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2938,8 +2938,7 @@ message header will be added to the bodies of the \"text/html\" parts." (encode-coding-string title coding)) body content)) - (setq eheader (encode-coding-string - (buffer-string) 'utf-8) + (setq eheader (string-as-unibyte (buffer-string)) body content))) (erase-buffer) (mm-disable-multibyte) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 67744cebc87..bed5993b9c1 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -821,13 +821,12 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (encode-coding-string + (string-as-unibyte (buffer-substring (point) (progn (skip-chars-forward "^ \t") - (point))) - 'utf-8) + (point)))) (let ((last (read cur))) (cons (read cur) last))) groups)) @@ -835,7 +834,7 @@ claim them." (while (not (eobp)) (ignore-errors (push (cons - (encode-coding-string + (string-as-unibyte (if (eq (char-after) ?\") (read cur) (let ((p (point)) (name "")) @@ -847,8 +846,7 @@ claim them." (skip-chars-forward "^ \t\\\\") (setq name (concat name (buffer-substring p (point))))) - name)) - 'utf-8) + name))) (let ((last (read cur))) (cons (read cur) last))) groups)) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 2cefc78fb9e..be46339cd38 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1990,7 +1990,7 @@ backend check whether the group actually exists." (while lists (setq killed (car lists)) (while killed - (gnus-sethash (encode-coding-string (car killed) 'utf-8) nil hashtb) + (gnus-sethash (string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2453,7 +2453,7 @@ If FORCE is non-nil, the .newsrc file is read." (dolist (elem gnus-newsrc-alist) ;; Protect against broken .newsrc.el files. (when (car elem) - (setcar elem (encode-coding-string (car elem) 'utf-8)))) + (setcar elem (string-as-unibyte (car elem))))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index aaadf0c7778..3a31349d378 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -696,10 +696,9 @@ be \"related\" or \"alternate\"." (set-buffer-multibyte nil) (cond ((cdr (assq 'buffer cont)) - (insert (encode-coding-string + (insert (string-as-unibyte (with-current-buffer (cdr (assq 'buffer cont)) - (buffer-string)) - 'utf-8))) + (buffer-string))))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 174be65035f..9640f2c746f 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1818,20 +1818,19 @@ article came from is also searched." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (encode-coding-string + (push (string-as-unibyte (gnus-group-full-name (buffer-substring (point) (progn (skip-chars-forward "^ \t") (point))) - method) - 'utf-8) + method)) groups)) (forward-line)) (while (not (eobp)) (ignore-errors - (push (encode-coding-string + (push (string-as-unibyte (if (eq (char-after) ?\") (gnus-group-full-name (read cur) method) (let ((p (point)) (name "")) @@ -1843,8 +1842,7 @@ article came from is also searched." (skip-chars-forward "^ \t\\\\") (setq name (concat name (buffer-substring p (point))))) - (gnus-group-full-name name method))) - 'utf-8) + (gnus-group-full-name name method)))) groups)) (forward-line))))) groups)) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 224d5db5427..3f2e08171e0 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -665,7 +665,7 @@ nn*-request-list should have been called before calling this function." (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list (encode-coding-string group 'utf-8) (cons min max)) + (push (list (string-as-unibyte group) (cons min max)) group-assoc))) (error nil)) (widen) @@ -1251,9 +1251,8 @@ Return the number of characters in the body." (insert (if (mm-multibyte-p) (string-as-multibyte (format " %s:%d" (caar group-alist) (cdar group-alist))) - (encode-coding-string - (format " %s:%d" (caar group-alist) (cdar group-alist)) - 'utf-8))) + (string-as-unibyte + (format " %s:%d" (caar group-alist) (cdar group-alist))))) (setq group-alist (cdr group-alist))) (insert "\n"))) From 94ad13b93c6fc099a353c8eb27c00a68ee79a952 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 1 Feb 2017 20:20:09 +0000 Subject: [PATCH 24/62] Allow C++ nested brace-list-entries to be better indented. This fixes bug #24431. The key change of this bug fix is correctly analyzing nested brace lists when the opening element stands on the same line as both its introductory brace and an enclosing parameter list parenthesis. * list/progmodes/cc-align.el (c-lineup-under-anchor): New line-up function. * list/progmodes/cc-engine.el (c-looking-at-or-maybe-in-bracelist): Accept the presence of exactly an identifier between an open parenthesis and an open brace as evidence of the brace starting a brace list. (c-looking-at-statement-block): New function, extracted from c-looking-at-inexpr-block. Enhance it to analyze inner blocks recursively when needed. (c-looking-at-inexpr-block): Extract new function (see above) and call it. (c-add-stmt-syntax): Enhance, with new &optional parameter, to supply the prime syntactic symbol with a fixed anchor point. When this is used, restrict all added syntactic symbols to those having an anchor point on the same line. Add, in addition to the current additional symbols, c-brace-list-entry when needed; use c-looking-at-statement-block to determine the latter. (c-guess-basic-syntax, CASE 9D): Use c-add-stmt-syntax rather than just c-add-syntax, to assemble the syntactic context of a 'brace-list-entry, thus getting, possibly, several accompanying syntactic entries. * lisp/progmodes/cc-styles.el (c-style-alist, "gnu" style): New entry for 'brace-list-intro, namely c-lineup-arglist-intro-after-paren. * lisp/progmodes/cc-vars.el (c-offsets-alist): Change the factory default offset for 'brace-list-entry from 0 to c-lineup-under-anchor. * doc/misc/cc-mode.texi (Syntactic Symbols): Amend the definition of brace-list-intro. (Brace List Symbols): Amend the example to show the new analysis of brace lists when the first element comes on the same line as the opening brace. (Misc Line-Up): Document the new line-up function c-lineup-under-anchor. --- doc/misc/cc-mode.texi | 31 ++++++++--- lisp/progmodes/cc-align.el | 12 +++++ lisp/progmodes/cc-engine.el | 101 +++++++++++++++++++++++++----------- lisp/progmodes/cc-styles.el | 1 + lisp/progmodes/cc-vars.el | 2 +- 5 files changed, 111 insertions(+), 36 deletions(-) diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 68a16c0ed74..14981c9c58b 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -4141,7 +4141,8 @@ Open brace of an enum or static array list. @ref{Brace List Symbols}. @item brace-list-close Close brace of an enum or static array list. @ref{Brace List Symbols}. @item brace-list-intro -First line in an enum or static array list. @ref{Brace List Symbols}. +First line after the opening @samp{@{} in an enum or static array +list. @ref{Brace List Symbols}. @item brace-list-entry Subsequent lines in an enum or static array list. @ref{Brace List Symbols}. @@ -4635,11 +4636,18 @@ example: Here, you've already seen the analysis of lines 1, 2, 3, and 11. On line 4, things get interesting; this line is assigned -@code{brace-entry-open} syntactic symbol because it's a bracelist entry -line that starts with an open brace. Lines 5 and 6 (and line 9) are -pretty standard, and line 7 is a @code{brace-list-close} as you'd -expect. Once again, line 8 is assigned as @code{brace-entry-open} as is -line 10. +@code{brace-entry-open} syntactic symbol because it's a bracelist +entry line that starts with an open brace. Lines 5 and 6 are pretty +standard, and line 7 is a @code{brace-list-close} as you'd expect. +Once again, line 8 is assigned as @code{brace-entry-open} as is line +10. Line 9 is assigned two syntactic elements, @code{brace-list-intro} +with anchor point at the @samp{@{} of line 8@footnote{This extra +syntactic element was introduced in @ccmode{} 5.33.1 to allow extra +flexibility in indenting the second line of such a construct. You can +preserve the behaviour resulting from the former syntactic analysis by +giving @code{brace-list-entry} an offset of +@code{c-lineup-under-anchor} (@pxref{Misc Line-Up}).}, and +@code{brace-list-entry} anchored on the @samp{1} of line 8. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols @@ -6288,6 +6296,17 @@ already has; think of it as an identity function for lineups. @comment ------------------------------------------------------------ +@defun c-lineup-under-anchor + +Line up a line directly underneath its anchor point. This is like +@samp{0}, except any previously calculated offset contributions are +disregarded. + +@workswith Any syntactic symbol which has an anchor point. +@end defun + +@comment ------------------------------------------------------------ + @defun c-lineup-cpp-define @findex lineup-cpp-define (c-) Line up macro continuation lines according to the indentation of the diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 7cb36c4396b..0f7e4b598dc 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1221,6 +1221,18 @@ Works with: arglist-cont, arglist-cont-nonempty." (vector (progn (goto-char alignto) (current-column))))))) +(defun c-lineup-under-anchor (langelem) + "Line up the current line directly under the anchor position in LANGELEM. + +This is like 0, except it supersedes any indentation already calculated for +previous syntactic elements in the syntactic context. + +Works with: Any syntactic symbol which has an anchor position." + (save-excursion + (goto-char (c-langelem-pos langelem)) + (vector (current-column)))) + + (defun c-lineup-dont-change (langelem) "Do not change the indentation of the current line. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index fd7aa50840f..dfd7aebd569 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10260,13 +10260,22 @@ comment at the start of cc-engine.el for more info." (t nil))))) (setq pos (point)) - (if (and after-type-id-pos - (goto-char after-type-id-pos) - (setq res (c-back-over-member-initializers)) - (goto-char res) - (eq (car (c-beginning-of-decl-1 lim)) 'same)) - (cons (point) nil) ; Return value. - + (cond + ((and after-type-id-pos + (goto-char after-type-id-pos) + (setq res (c-back-over-member-initializers)) + (goto-char res) + (eq (car (c-beginning-of-decl-1 lim)) 'same)) + (cons (point) nil)) ; Return value. + + ((and after-type-id-pos + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\())) + ;; Single identifier between '(' and '{'. We have a bracelist. + (cons after-type-id-pos nil)) + + (t (goto-char pos) ;; Checks to do on all sexps before the brace, up to the ;; beginning of the statement. @@ -10368,7 +10377,7 @@ comment at the start of cc-engine.el for more info." ; languages where ; `c-opt-inexpr-brace-list-key' is ; non-nil and we have macros. - (t t))) ;; The caller can go up one level. + (t t)))) ;; The caller can go up one level. ))) (defun c-inside-bracelist-p (containing-sexp paren-state) @@ -10493,6 +10502,30 @@ comment at the start of cc-engine.el for more info." (c-at-statement-start-p)) (make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") +(defun c-looking-at-statement-block () + ;; Point is at an opening brace. If this is a statement block (i.e. the + ;; elements in it are terminated by semicolons) return t. Otherwise, return + ;; nil. + (let ((here (point))) + (prog1 + (if (c-go-list-forward) + (let ((there (point))) + (backward-char) + (c-syntactic-skip-backward + "^;," here t) + (cond + ((eq (char-before) ?\;) t) + ((eq (char-before) ?,) nil) + (t (goto-char here) + (forward-char) + (and (c-syntactic-re-search-forward "{" there t t) + (progn (backward-char) + (c-looking-at-statement-block)))))) + (forward-char) + (and (c-syntactic-re-search-forward "[;,]" nil t t) + (eq (char-before) ?\;))) + (goto-char here)))) + (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) ;; Return non-nil if we're looking at the beginning of a block ;; inside an expression. The value returned is actually a cons of @@ -10648,15 +10681,7 @@ comment at the start of cc-engine.el for more info." (and (c-major-mode-is 'c++-mode) (save-excursion (goto-char block-follows) - (if (c-go-list-forward) - (progn - (backward-char) - (c-syntactic-skip-backward - "^;," block-follows t) - (not (eq (char-before) ?\;))) - (or (not (c-syntactic-re-search-forward - "[;,]" nil t t)) - (not (eq (char-before) ?\;))))))) + (not (c-looking-at-statement-block))))) nil (cons 'inexpr-statement (point))))) @@ -10792,17 +10817,20 @@ comment at the start of cc-engine.el for more info." syntax-extra-args stop-at-boi-only containing-sexp - paren-state) + paren-state + &optional fixed-anchor) ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as ;; needed with further syntax elements of the types `substatement', - ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', and - ;; `defun-block-intro'. + ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', + ;; `defun-block-intro', and `brace-list-intro'. ;; - ;; Do the generic processing to anchor the given syntax symbol on - ;; the preceding statement: Skip over any labels and containing - ;; statements on the same line, and then search backward until we - ;; find a statement or block start that begins at boi without a - ;; label or comment. + ;; Do the generic processing to anchor the given syntax symbol on the + ;; preceding statement: First skip over any labels and containing statements + ;; on the same line. If FIXED-ANCHOR is non-nil, use this as the + ;; anchor-point for the given syntactic symbol, and don't make syntactic + ;; entries for constructs beginning on lines before that containing + ;; ANCHOR-POINT. Otherwise search backward until we find a statement or + ;; block start that begins at boi without a label or comment. ;; ;; Point is assumed to be at the prospective anchor point for the ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to @@ -10831,6 +10859,7 @@ comment at the start of cc-engine.el for more info." (let ((syntax-last c-syntactic-context) (boi (c-point 'boi)) + (anchor-boi (c-point 'boi)) ;; Set when we're on a label, so that we don't stop there. ;; FIXME: To be complete we should check if we're on a label ;; now at the start. @@ -10908,7 +10937,9 @@ comment at the start of cc-engine.el for more info." (c-add-syntax 'substatement nil)))) ))) - containing-sexp) + containing-sexp + (or (null fixed-anchor) + (> containing-sexp anchor-boi))) ;; Now we have to go out of this block. (goto-char containing-sexp) @@ -10982,6 +11013,14 @@ comment at the start of cc-engine.el for more info." (cdr (assoc (match-string 1) c-other-decl-block-key-in-symbols-alist)) (max (c-point 'boi paren-pos) (point)))) + ((save-excursion + (goto-char paren-pos) + (c-looking-at-or-maybe-in-bracelist containing-sexp)) + (if (save-excursion + (goto-char paren-pos) + (c-looking-at-statement-block)) + (c-add-syntax 'defun-block-intro nil) + (c-add-syntax 'brace-list-intro nil))) (t (c-add-syntax 'defun-block-intro nil)))) (c-add-syntax 'statement-block-intro nil))) @@ -11001,7 +11040,10 @@ comment at the start of cc-engine.el for more info." (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)] (while q (unless (car q) - (setcar q (point))) + (setcar q (if (or (cdr p) + (null fixed-anchor)) + (point) + fixed-anchor))) (setq q (cdr q))) (setq p (cdr p)))) ))) @@ -12354,7 +12396,8 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws (c-point 'eol)) (c-looking-at-special-brace-list (point))))) (c-add-syntax 'brace-entry-open (point)) - (c-add-syntax 'brace-list-entry (point)) + (c-add-stmt-syntax 'brace-list-entry nil t containing-sexp + paren-state (point)) )) )))) @@ -12848,7 +12891,7 @@ Cannot combine absolute offsets %S and %S in `add' method" ;; ;; Note that topmost-intro always has an anchor position at bol, for ;; historical reasons. It's often used together with other symbols - ;; that has more sane positions. Since we always use the first + ;; that have more sane positions. Since we always use the first ;; found anchor position, we rely on that these other symbols always ;; precede topmost-intro in the LANGELEMS list. ;; diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index d3505490505..b3848a74f97 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -67,6 +67,7 @@ (arglist-close . c-lineup-arglist) (inline-open . 0) (brace-list-open . +) + (brace-list-intro . c-lineup-arglist-intro-after-paren) (topmost-intro-cont . (first c-lineup-topmost-intro-cont c-lineup-gnu-DEFUN-intro-cont)))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index a6a96d15188..1114b21381d 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1115,7 +1115,7 @@ can always override the use of `c-default-style' by making calls to ;; Anchor pos: At the brace list decl start(*). (brace-list-intro . +) ;; Anchor pos: At the brace list decl start(*). - (brace-list-entry . 0) + (brace-list-entry . c-lineup-under-anchor) ;; Anchor pos: At the first non-ws char after the open paren if ;; the first token is on the same line, otherwise boi at that ;; token. From 33be50037c2b4cdb002538534e9915c6bad253b7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 1 Feb 2017 15:18:43 -0800 Subject: [PATCH 25/62] Remove immediate_quit. The old code that sets and clears immediate_quit was ineffective except when Emacs is running in terminal mode, and has problematic race conditions anyway, so remove it. This will introduce some hangs when Emacs runs in terminal mode, and these hangs should be fixed in followup patches. * src/keyboard.c (immediate_quit): Remove. All uses removed. --- admin/notes/multi-tty | 5 ++--- src/bytecode.c | 4 ---- src/callproc.c | 8 +------- src/dired.c | 3 --- src/editfns.c | 9 ++------- src/eval.c | 2 -- src/fileio.c | 19 ------------------ src/fns.c | 42 ++++++++-------------------------------- src/indent.c | 2 -- src/keyboard.c | 45 +++++++------------------------------------ src/lisp.h | 8 -------- src/process.c | 10 +--------- src/regex.c | 10 ++++------ src/search.c | 33 ++----------------------------- src/syntax.c | 30 ++--------------------------- src/w32fns.c | 11 +---------- src/window.c | 2 -- 17 files changed, 30 insertions(+), 213 deletions(-) diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index b58180e6fab..d0096adc6d2 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -1239,9 +1239,8 @@ DIARY OF CHANGES (Update: OK, it all seems so easy now (NOT). Input could be done synchronously (with wait_reading_process_input), or asynchronously by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag, - signals a 'quit condition (when immediate_quit), or throws to - 'getcjmp' when Emacs was waiting for input when the C-g event - arrived.) + signals a 'quit condition, or throws to 'getcjmp' when Emacs was + waiting for input when the C-g event arrived.) -- Replace wrong_kboard_jmpbuf with a special return value of read_char. It is absurd that we use setjmp/longjmp just to return diff --git a/src/bytecode.c b/src/bytecode.c index 499fb881e2e..ed58d18c618 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -842,10 +842,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER (v1); EMACS_INT n = XINT (v1); - immediate_quit = true; while (--n >= 0 && CONSP (v2)) v2 = XCDR (v2); - immediate_quit = false; TOP = CAR (v2); NEXT; } @@ -1276,10 +1274,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER (v2); EMACS_INT n = XINT (v2); - immediate_quit = true; while (--n >= 0 && CONSP (v1)) v1 = XCDR (v1); - immediate_quit = false; TOP = CAR (v1); } else diff --git a/src/callproc.c b/src/callproc.c index 301ccf383b5..85674bb7d9b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -198,11 +198,9 @@ call_process_cleanup (Lisp_Object buffer) { kill (-synch_process_pid, SIGINT); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); - immediate_quit = true; maybe_quit (); wait_for_termination (synch_process_pid, 0, 1); synch_process_pid = 0; - immediate_quit = false; message1 ("Waiting for process to die...done"); } #endif /* !MSDOS */ @@ -726,7 +724,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, process_coding.src_multibyte = 0; } - immediate_quit = true; maybe_quit (); if (0 <= fd0) @@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, } /* Now NREAD is the total amount of data in the buffer. */ - immediate_quit = false; if (!nread) ; @@ -842,7 +838,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, we should have already detected a coding system. */ display_on_the_fly = true; } - immediate_quit = true; + maybe_quit (); } give_up: ; @@ -860,8 +856,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, wait_for_termination (pid, &status, fd0 < 0); #endif - immediate_quit = false; - /* Don't kill any children that the subprocess may have left behind when exiting. */ synch_process_pid = 0; diff --git a/src/dired.c b/src/dired.c index 52e81fb380b..5ea00fb8db4 100644 --- a/src/dired.c +++ b/src/dired.c @@ -248,14 +248,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Now that we have unwind_protect in place, we might as well allow matching to be interrupted. */ - immediate_quit = true; maybe_quit (); bool wanted = (NILP (match) || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); - immediate_quit = false; - if (wanted) { if (!NILP (full)) diff --git a/src/editfns.c b/src/editfns.c index 82c6abb9987..b60543702f1 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */) i2 = begp2; i1_byte = buf_charpos_to_bytepos (bp1, i1); i2_byte = buf_charpos_to_bytepos (bp2, i2); - immediate_quit = true; while (i1 < endp1 && i2 < endp2) { @@ -3092,17 +3091,13 @@ determines whether case is significant or ignored. */) c1 = char_table_translate (trt, c1); c2 = char_table_translate (trt, c2); } + if (c1 != c2) - { - immediate_quit = false; - return make_number (c1 < c2 ? -1 - chars : chars + 1); - } + return make_number (c1 < c2 ? -1 - chars : chars + 1); chars++; } - immediate_quit = false; - /* The strings match as far as they go. If one is shorter, that one is less. */ if (chars < endp1 - begp1) diff --git a/src/eval.c b/src/eval.c index 62d4af15e27..844879d6a2d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) /* Restore certain special C variables. */ set_poll_suppress_count (catch->poll_suppress_count); unblock_input_to (catch->interrupt_input_blocked); - immediate_quit = false; do { @@ -1517,7 +1516,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Lisp_Object clause = Qnil; struct handler *h; - immediate_quit = false; if (gc_in_progress || waiting_for_input) emacs_abort (); diff --git a/src/fileio.c b/src/fileio.c index a46cfc7ac69..a109737240f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1960,9 +1960,7 @@ permissions. */) report_file_error ("Copying permissions to", newname); } #else /* not WINDOWSNT */ - immediate_quit = true; ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); - immediate_quit = false; if (ifd < 0) report_file_error ("Opening input file", file); @@ -2024,7 +2022,6 @@ permissions. */) oldsize = out_st.st_size; } - immediate_quit = true; maybe_quit (); if (clone_file (ofd, ifd)) @@ -2047,8 +2044,6 @@ permissions. */) if (newsize < oldsize && ftruncate (ofd, newsize) != 0) report_file_error ("Truncating output file", newname); - immediate_quit = false; - #ifndef MSDOS /* Preserve the original file permissions, and if requested, also its owner and group. */ @@ -3403,13 +3398,11 @@ read_non_regular (Lisp_Object state) { int nbytes; - immediate_quit = true; maybe_quit (); nbytes = emacs_read (XSAVE_INTEGER (state, 0), ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + XSAVE_INTEGER (state, 1)), XSAVE_INTEGER (state, 2)); - immediate_quit = false; /* Fast recycle this object for the likely next call. */ free_misc (state); return make_number (nbytes); @@ -3868,7 +3861,6 @@ by calling `format-decode', which see. */) report_file_error ("Setting file position", orig_filename); } - immediate_quit = true; maybe_quit (); /* Count how many chars at the start of the file match the text at the beginning of the buffer. */ @@ -3907,7 +3899,6 @@ by calling `format-decode', which see. */) if (bufpos != nread) break; } - immediate_quit = false; /* If the file matches the buffer completely, there's no need to replace anything. */ if (same_at_start - BEGV_BYTE == end_offset - beg_offset) @@ -3919,7 +3910,6 @@ by calling `format-decode', which see. */) del_range_1 (same_at_start, same_at_end, 0, 0); goto handled; } - immediate_quit = true; maybe_quit (); /* Count how many chars at the end of the file match the text at the end of the buffer. But, if we have @@ -3977,7 +3967,6 @@ by calling `format-decode', which see. */) if (nread == 0) break; } - immediate_quit = false; if (! giveup_match_end) { @@ -4075,11 +4064,9 @@ by calling `format-decode', which see. */) quitting while reading a huge file. */ /* Allow quitting out of the actual I/O. */ - immediate_quit = true; maybe_quit (); this = emacs_read (fd, read_buf + unprocessed, READ_BUF_SIZE - unprocessed); - immediate_quit = false; if (this <= 0) break; @@ -4294,13 +4281,11 @@ by calling `format-decode', which see. */) /* Allow quitting out of the actual I/O. We don't make text part of the buffer until all the reading is done, so a C-g here doesn't do any harm. */ - immediate_quit = true; maybe_quit (); this = emacs_read (fd, ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + inserted), trytry); - immediate_quit = false; } if (this <= 0) @@ -5002,8 +4987,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, } } - immediate_quit = true; - if (STRINGP (start)) ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); else if (XINT (start) != XINT (end)) @@ -5026,8 +5009,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, save_errno = errno; } - immediate_quit = false; - /* fsync is not crucial for temporary files. Nor for auto-save files, since they might lose some work anyway. */ if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) diff --git a/src/fns.c b/src/fns.c index 136a2198c2c..444339c5259 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1361,18 +1361,15 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, CHECK_NUMBER (n); EMACS_INT num = XINT (n); Lisp_Object tail = list; - immediate_quit = true; for (EMACS_INT i = 0; i < num; i++) { if (! CONSP (tail)) { - immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } tail = XCDR (tail); } - immediate_quit = false; return tail; } @@ -1419,17 +1416,12 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { - immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (EQ (XCAR (tail), elt)) - { - immediate_quit = false; - return tail; - } + return tail; } - immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -1442,18 +1434,13 @@ The value is actually the tail of LIST whose car is ELT. */) if (!FLOATP (elt)) return Fmemq (elt, list); - immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) - { - immediate_quit = false; - return tail; - } + return tail; } - immediate_quit = false; CHECK_LIST_END (tail, list); return Qnil; } @@ -1464,15 +1451,12 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { - immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) - if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) - { - immediate_quit = false; + { + if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) return XCAR (tail); - } - immediate_quit = false; + } CHECK_LIST_END (tail, list); return Qnil; } @@ -1529,15 +1513,12 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, The value is actually the first element of LIST whose cdr is KEY. */) (Lisp_Object key, Lisp_Object list) { - immediate_quit = true; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) - if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) - { - immediate_quit = false; + { + if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) return XCAR (tail); - } - immediate_quit = false; + } CHECK_LIST_END (tail, list); return Qnil; } @@ -2077,21 +2058,18 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { - immediate_quit = true; Lisp_Object prev = Qnil; for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) { if (EQ (prop, XCAR (tail))) { - immediate_quit = false; Fsetcar (XCDR (tail), val); return plist; } prev = tail; } - immediate_quit = false; Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); if (NILP (prev)) @@ -2442,7 +2420,6 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); - immediate_quit = true; Lisp_Object tail; do { @@ -2451,7 +2428,6 @@ usage: (nconc &rest LISTS) */) } while (CONSP (tem)); - immediate_quit = false; rarely_quit (&quit_count); tem = args[argnum + 1]; @@ -2874,13 +2850,11 @@ property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP. */) (Lisp_Object plist, Lisp_Object prop) { - immediate_quit = true; while (CONSP (plist) && !EQ (XCAR (plist), prop)) { plist = XCDR (plist); plist = CDR (plist); } - immediate_quit = false; return plist; } diff --git a/src/indent.c b/src/indent.c index 23951a16eb6..33f709c5041 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1200,7 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, continuation_glyph_width = 0; /* In the fringe. */ #endif - immediate_quit = true; maybe_quit (); /* It's just impossible to be too paranoid here. */ @@ -1694,7 +1693,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, /* Nonzero if have just continued a line */ val_compute_motion.contin = (contin_hpos && prev_hpos == 0); - immediate_quit = false; return &val_compute_motion; } diff --git a/src/keyboard.c b/src/keyboard.c index 0c04d95304c..317669d6a1a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -169,9 +169,6 @@ struct kboard *echo_kboard; Lisp_Object echo_message_buffer; -/* True means C-g should cause immediate error-signal. */ -bool immediate_quit; - /* Character that causes a quit. Normally C-g. If we are running on an ordinary terminal, this must be an ordinary @@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, as input, set quit-flag to cause an interrupt. */ if (!NILP (Vthrow_on_input) && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) - { - Vquit_flag = Vthrow_on_input; - /* If we're inside a function that wants immediate quits, - do it now. */ - if (immediate_quit && NILP (Vinhibit_quit)) - { - immediate_quit = false; - maybe_quit (); - } - } + Vquit_flag = Vthrow_on_input; } @@ -10445,30 +10433,12 @@ handle_interrupt (bool in_signal_handler) } else { - /* If executing a function that wants to be interrupted out of - and the user has not deferred quitting by binding `inhibit-quit' - then quit right away. */ - if (immediate_quit && NILP (Vinhibit_quit) && !waiting_for_input) - { - struct gl_state_s saved; - - immediate_quit = false; - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); - saved = gl_state; - quit (); - gl_state = saved; - } - else - { /* Else request quit when it's safe. */ - int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1; - force_quit_count = count; - if (count == 3) - { - immediate_quit = true; - Vinhibit_quit = Qnil; - } - Vquit_flag = Qt; - } + /* Request quit when it's safe. */ + int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1; + force_quit_count = count; + if (count == 3) + Vinhibit_quit = Qnil; + Vquit_flag = Qt; } pthread_sigmask (SIG_SETMASK, &empty_mask, 0); @@ -10907,7 +10877,6 @@ init_keyboard (void) { /* This is correct before outermost invocation of the editor loop. */ command_loop_level = -1; - immediate_quit = false; quit_char = Ctl ('g'); Vunread_command_events = Qnil; timer_idleness_start_time = invalid_timespec (); diff --git a/src/lisp.h b/src/lisp.h index 58e22889889..a18e4da1cfd 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3131,11 +3131,6 @@ extern Lisp_Object memory_signal_data; impossible, of course. But it is very desirable to avoid creating loops where maybe_quit is impossible. - Exception: if you set immediate_quit, the handler that responds to - the C-g does the quit itself. This is a good thing to do around a - loop that has no side effects and (in particular) cannot call - arbitrary Lisp code. - If quit-flag is set to `kill-emacs' the SIGINT handler has received a request to exit Emacs when it is safe to do. @@ -4348,9 +4343,6 @@ extern char my_edata[]; extern char my_endbss[]; extern char *my_endbss_static; -/* True means ^G can quit instantly. */ -extern bool immediate_quit; - extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); diff --git a/src/process.c b/src/process.c index dbd4358dd1a..434a3955b2c 100644 --- a/src/process.c +++ b/src/process.c @@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, break; } - immediate_quit = true; maybe_quit (); ret = connect (s, sa, addrlen); @@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, if (ret == 0 || xerrno == EISCONN) { - /* The unwind-protect will be discarded afterwards. - Likewise for immediate_quit. */ + /* The unwind-protect will be discarded afterwards. */ break; } @@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, } #endif /* !WINDOWSNT */ - immediate_quit = false; - /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count; emacs_close (s); @@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif } - immediate_quit = false; - if (s < 0) { /* If non-blocking got this far - and failed - assume non-blocking is @@ -4012,7 +4006,6 @@ usage: (make-network-process &rest ARGS) */) struct addrinfo *res, *lres; int ret; - immediate_quit = true; maybe_quit (); struct addrinfo hints; @@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */) #else error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); #endif - immediate_quit = false; for (lres = res; lres; lres = lres->ai_next) addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); diff --git a/src/regex.c b/src/regex.c index f6e67afef4c..796f868d1c2 100644 --- a/src/regex.c +++ b/src/regex.c @@ -1728,10 +1728,8 @@ typedef struct /* Explicit quit checking is needed for Emacs, which uses polling to process input events. */ -#ifdef emacs -# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0) -#else -# define IMMEDIATE_QUIT_CHECK ((void) 0) +#ifndef emacs +static void maybe_quit (void) {} #endif /* Structure to manage work area for range table. */ @@ -5820,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, /* Unconditionally jump (without popping any failure points). */ case jump: unconditional_jump: - IMMEDIATE_QUIT_CHECK; + maybe_quit (); EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ DEBUG_PRINT ("EXECUTING jump %d ", mcnt); p += mcnt; /* Do the jump. */ @@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, /* We goto here if a matching operation fails. */ fail: - IMMEDIATE_QUIT_CHECK; + maybe_quit (); if (!FAIL_STACK_EMPTY ()) { re_char *str, *pat; diff --git a/src/search.c b/src/search.c index f54f44c8818..ed9c12c68fe 100644 --- a/src/search.c +++ b/src/search.c @@ -277,7 +277,6 @@ looking_at_1 (Lisp_Object string, bool posix) !NILP (BVAR (current_buffer, enable_multibyte_characters))); /* Do a pending quit right away, to avoid paradoxical behavior */ - immediate_quit = true; maybe_quit (); /* Get pointers and sizes of the two strings @@ -311,7 +310,6 @@ looking_at_1 (Lisp_Object string, bool posix) (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), ZV_BYTE - BEGV_BYTE); - immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -399,7 +397,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, ? BVAR (current_buffer, case_canon_table) : Qnil), posix, STRING_MULTIBYTE (string)); - immediate_quit = true; re_match_object = string; val = re_search (bufp, SSDATA (string), @@ -407,7 +404,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, SBYTES (string) - pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL)); - immediate_quit = false; /* Set last_thing_searched only when match data is changed. */ if (NILP (Vinhibit_changing_match_data)) @@ -471,13 +467,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, bufp = compile_pattern (regexp, 0, table, 0, STRING_MULTIBYTE (string)); - immediate_quit = true; re_match_object = string; val = re_search (bufp, SSDATA (string), SBYTES (string), 0, SBYTES (string), 0); - immediate_quit = false; return val; } @@ -498,9 +492,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, bufp = compile_pattern (regexp, 0, Vascii_canon_table, 0, 0); - immediate_quit = true; val = re_search (bufp, string, len, 0, len, 0); - immediate_quit = false; return val; } @@ -561,7 +553,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); - immediate_quit = true; #ifdef REL_ALLOC /* Prevent ralloc.c from relocating the current buffer while searching it. */ @@ -572,7 +563,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif - immediate_quit = false; return len; } @@ -649,7 +639,7 @@ newline_cache_on_off (struct buffer *buf) If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding to the returned character position. - If ALLOW_QUIT, set immediate_quit. That's good to do + If ALLOW_QUIT, check for quitting. That's good to do except when inside redisplay. */ ptrdiff_t @@ -685,8 +675,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (shortage != 0) *shortage = 0; - immediate_quit = allow_quit; - if (count > 0) while (start != end) { @@ -704,7 +692,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, ptrdiff_t next_change; int result = 1; - immediate_quit = false; while (start < end && result) { ptrdiff_t lim1; @@ -757,7 +744,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, start_byte = end_byte; break; } - immediate_quit = allow_quit; /* START should never be after END. */ if (start_byte > ceiling_byte) @@ -810,7 +796,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (--count == 0) { - immediate_quit = false; if (bytepos) *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); @@ -833,7 +818,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, ptrdiff_t next_change; int result = 1; - immediate_quit = false; while (start > end && result) { ptrdiff_t lim1; @@ -870,7 +854,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, start_byte = end_byte; break; } - immediate_quit = allow_quit; /* Start should never be at or before end. */ if (start_byte <= ceiling_byte) @@ -918,7 +901,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (++count >= 0) { - immediate_quit = false; if (bytepos) *bytepos = ceiling_byte + prev + 1; return BYTE_TO_CHAR (ceiling_byte + prev + 1); @@ -930,7 +912,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, } } - immediate_quit = false; if (shortage) *shortage = count * direction; if (bytepos) @@ -954,7 +935,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, the number of line boundaries left unfound, and position at the limit we bumped up against. - If ALLOW_QUIT, set immediate_quit. That's good to do + If ALLOW_QUIT, check for quitting. That's good to do except in special cases. */ ptrdiff_t @@ -1197,9 +1178,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, trt, posix, !NILP (BVAR (current_buffer, enable_multibyte_characters))); - immediate_quit = true; /* Quit immediately if user types ^G, - because letting this function finish - can take too long. */ maybe_quit (); /* Do a pending quit right away, to avoid paradoxical behavior */ /* Get pointers and sizes of the two strings @@ -1268,7 +1246,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { - immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -1313,7 +1290,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { - immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -1321,7 +1297,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } n--; } - immediate_quit = false; #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); #endif @@ -3231,8 +3206,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (shortage != 0) *shortage = 0; - immediate_quit = allow_quit; - if (count > 0) while (start != end) { @@ -3275,7 +3248,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, if (--count == 0) { - immediate_quit = false; if (bytepos) *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); @@ -3287,7 +3259,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, } } - immediate_quit = false; if (shortage) *shortage = count; if (bytepos) diff --git a/src/syntax.c b/src/syntax.c index f9e4093765c..e713922bf10 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1426,7 +1426,6 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) int ch0, ch1; Lisp_Object func, pos; - immediate_quit = true; maybe_quit (); SETUP_SYNTAX_TABLE (from, count); @@ -1436,10 +1435,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) while (1) { if (from == end) - { - immediate_quit = false; - return 0; - } + return 0; UPDATE_SYNTAX_TABLE_FORWARD (from); ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch0); @@ -1486,10 +1482,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) while (1) { if (from == beg) - { - immediate_quit = false; - return 0; - } + return 0; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -1536,8 +1529,6 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) count++; } - immediate_quit = false; - return from; } @@ -1921,7 +1912,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; } - immediate_quit = true; /* This code may look up syntax tables using functions that rely on the gl_state object. To make sure this object is not out of date, let's initialize it manually. @@ -2064,7 +2054,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, } SET_PT_BOTH (pos, pos_byte); - immediate_quit = false; SAFE_FREE (); return make_number (PT - start_point); @@ -2138,7 +2127,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) ptrdiff_t pos_byte = PT_BYTE; unsigned char *p, *endp, *stop; - immediate_quit = true; SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); if (forwardp) @@ -2224,7 +2212,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) done: SET_PT_BOTH (pos, pos_byte); - immediate_quit = false; return make_number (PT - start_point); } @@ -2412,7 +2399,6 @@ between them, return t; otherwise return nil. */) count1 = XINT (count); stop = count1 > 0 ? ZV : BEGV; - immediate_quit = true; maybe_quit (); from = PT; @@ -2429,7 +2415,6 @@ between them, return t; otherwise return nil. */) if (from == stop) { SET_PT_BOTH (from, from_byte); - immediate_quit = false; return Qnil; } c = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -2463,7 +2448,6 @@ between them, return t; otherwise return nil. */) comstyle = ST_COMMENT_STYLE; else if (code != Scomment) { - immediate_quit = false; DEC_BOTH (from, from_byte); SET_PT_BOTH (from, from_byte); return Qnil; @@ -2474,7 +2458,6 @@ between them, return t; otherwise return nil. */) from = out_charpos; from_byte = out_bytepos; if (!found) { - immediate_quit = false; SET_PT_BOTH (from, from_byte); return Qnil; } @@ -2494,7 +2477,6 @@ between them, return t; otherwise return nil. */) if (from <= stop) { SET_PT_BOTH (BEGV, BEGV_BYTE); - immediate_quit = false; return Qnil; } @@ -2587,7 +2569,6 @@ between them, return t; otherwise return nil. */) else if (code != Swhitespace || quoted) { leave: - immediate_quit = false; INC_BOTH (from, from_byte); SET_PT_BOTH (from, from_byte); return Qnil; @@ -2598,7 +2579,6 @@ between them, return t; otherwise return nil. */) } SET_PT_BOTH (from, from_byte); - immediate_quit = false; return Qt; } @@ -2640,7 +2620,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) from_byte = CHAR_TO_BYTE (from); - immediate_quit = true; maybe_quit (); SETUP_SYNTAX_TABLE (from, count); @@ -2801,7 +2780,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth) goto lose; - immediate_quit = false; return Qnil; /* End of object reached */ @@ -2984,7 +2962,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth) goto lose; - immediate_quit = false; return Qnil; done2: @@ -2992,7 +2969,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) } - immediate_quit = false; XSETFASTINT (val, from); return val; @@ -3173,7 +3149,6 @@ do { prev_from = from; \ UPDATE_SYNTAX_TABLE_FORWARD (from); \ } while (0) - immediate_quit = true; maybe_quit (); depth = state->depth; @@ -3432,7 +3407,6 @@ do { prev_from = from; \ state->levelstarts); state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) || state->quoted) ? prev_from_syntax : Smax; - immediate_quit = false; } /* Convert a (lisp) parse state to the internal form used in diff --git a/src/w32fns.c b/src/w32fns.c index 6a576fcec27..1b628b0b42e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3168,16 +3168,7 @@ signal_user_input (void) Vquit_flag = Vthrow_on_input; /* Calling maybe_quit from this thread is a bad idea, since this unwinds the stack of the Lisp thread, and the Windows runtime - rightfully barfs. Disabled. */ -#if 0 - /* If we're inside a function that wants immediate quits, - do it now. */ - if (immediate_quit && NILP (Vinhibit_quit)) - { - immediate_quit = false; - maybe_quit (); - } -#endif + rightfully barfs. */ } } diff --git a/src/window.c b/src/window.c index 71a82b522c4..bc3f488f37f 100644 --- a/src/window.c +++ b/src/window.c @@ -4770,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) { ptrdiff_t count = SPECPDL_INDEX (); - immediate_quit = true; n = clip_to_bounds (INT_MIN, n, INT_MAX); wset_redisplay (XWINDOW (window)); @@ -4789,7 +4788,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) /* Bug#15957. */ XWINDOW (window)->window_end_valid = false; - immediate_quit = false; } From b01ac672be1277833964d2d53f6dd26560c70343 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 1 Feb 2017 15:18:44 -0800 Subject: [PATCH 26/62] Revamp quitting and fix infloops This fixes some infinite loops that cannot be quitted out of, e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#))) when byte-compiled and when run under X. See: http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00577.html This also attempts to keep the performance improvements I recently added, as much as possible under the constraint that the infloops must be caught. In some cases this fixes infloop bugs recently introduced when I removed immediate_quit. * src/alloc.c (Fmake_list): Use rarely_quit, not maybe_quit, for speed in the usual case. * src/bytecode.c (exec_byte_code): * src/editfns.c (Fcompare_buffer_substrings): * src/fns.c (Fnthcdr): * src/syntax.c (scan_words, skip_chars, skip_syntaxes) (Fbackward_prefix_chars): Use rarely_quit so that users can C-g out of long loops. * src/callproc.c (call_process_cleanup, call_process): * src/fileio.c (read_non_regular, Finsert_file_contents): * src/indent.c (compute_motion): * src/syntax.c (scan_words, Fforward_comment): Remove now-unnecessary maybe_quit calls. * src/callproc.c (call_process): * src/doc.c (get_doc_string, Fsnarf_documentation): * src/fileio.c (Fcopy_file, read_non_regular, Finsert_file_contents): * src/lread.c (safe_to_load_version): * src/sysdep.c (system_process_attributes) [GNU_LINUX]: Use emacs_read_quit instead of emacs_read in places where C-g handling is safe. * src/eval.c (maybe_quit): Move comment here from lisp.h. * src/fileio.c (Fcopy_file, e_write): Use emacs_write_quit instead of emacs_write_sig in places where C-g handling is safe. * src/filelock.c (create_lock_file): Use emacs_write, not plain write, as emacs_write no longer has a problem. (read_lock_data): Use emacs_read, not read, as emacs_read no longer has a problem. * src/fns.c (rarely_quit): Move to lisp.h and rename to incr_rarely_quit. All uses changed.. * src/fns.c (Fmemq, Fmemql, Fassq, Frassq, Fplist_put, Fplist_member): * src/indent.c (compute_motion): * src/syntax.c (find_defun_start, back_comment, forw_comment) (Fforward_comment, scan_lists, scan_sexps_forward): Use incr_rarely_quit so that users can C-g out of long loops. * src/fns.c (Fnconc): Move incr_rarely_quit call to within inner loop, so that it catches C-g there too. * src/keyboard.c (tty_read_avail_input): Remove commented-out and now-obsolete code dealing with interrupts. * src/lisp.h (rarely_quit, incr_rarely_quit): New functions, the latter moved here from fns.c and renamed from rarely_quit. (emacs_read_quit, emacs_write_quit): New decls. * src/search.c (find_newline, search_buffer, find_newline1): Add maybe_quit to catch C-g. * src/sysdep.c (get_child_status): Always invoke maybe_quit if interruptible, so that the caller need not bother. (emacs_nointr_read, emacs_read_quit, emacs_write_quit): New functions. (emacs_read): Rewrite in terms of emacs_nointr_read. Do not handle C-g or signals; that is now for emacs_read_quit. (emacs_full_write): Replace PROCESS_SIGNALS two-way arg with INTERRUPTIBLE three-way arg. All uses changed. --- src/alloc.c | 2 +- src/bytecode.c | 16 +++--- src/callproc.c | 9 +--- src/doc.c | 9 ++-- src/editfns.c | 1 + src/eval.c | 13 +++++ src/fileio.c | 55 +++++++++----------- src/filelock.c | 7 +-- src/fns.c | 53 +++++++++----------- src/indent.c | 11 ++-- src/keyboard.c | 48 ++++++------------ src/lisp.h | 40 ++++++++++----- src/lread.c | 2 +- src/search.c | 8 +++ src/syntax.c | 112 ++++++++++++++++++++++++++--------------- src/sysdep.c | 133 ++++++++++++++++++++++++++++++++----------------- 16 files changed, 297 insertions(+), 222 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index b59220c5d84..e909d312c4e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2880,7 +2880,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, for (EMACS_INT size = XFASTINT (length); 0 < size; size--) { val = Fcons (init, val); - maybe_quit (); + rarely_quit (size); } return val; diff --git a/src/bytecode.c b/src/bytecode.c index ed58d18c618..0f7420c19ee 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -841,9 +841,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER (v1); - EMACS_INT n = XINT (v1); - while (--n >= 0 && CONSP (v2)) - v2 = XCDR (v2); + for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) + { + v2 = XCDR (v2); + rarely_quit (n); + } TOP = CAR (v2); NEXT; } @@ -1273,9 +1275,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Exchange args and then do nth. */ Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER (v2); - EMACS_INT n = XINT (v2); - while (--n >= 0 && CONSP (v1)) - v1 = XCDR (v1); + for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) + { + v1 = XCDR (v1); + rarely_quit (n); + } TOP = CAR (v1); } else diff --git a/src/callproc.c b/src/callproc.c index 85674bb7d9b..710174c46b0 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -198,7 +198,6 @@ call_process_cleanup (Lisp_Object buffer) { kill (-synch_process_pid, SIGINT); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); - maybe_quit (); wait_for_termination (synch_process_pid, 0, 1); synch_process_pid = 0; message1 ("Waiting for process to die...done"); @@ -724,8 +723,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, process_coding.src_multibyte = 0; } - maybe_quit (); - if (0 <= fd0) { enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; @@ -746,8 +743,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, nread = carryover; while (nread < bufsize - 1024) { - int this_read = emacs_read (fd0, buf + nread, - bufsize - nread); + int this_read = emacs_read_quit (fd0, buf + nread, + bufsize - nread); if (this_read < 0) goto give_up; @@ -838,8 +835,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, we should have already detected a coding system. */ display_on_the_fly = true; } - - maybe_quit (); } give_up: ; diff --git a/src/doc.c b/src/doc.c index 361d09a0878..1e7e3fcf6a6 100644 --- a/src/doc.c +++ b/src/doc.c @@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) If we read the same block last time, maybe skip this? */ if (space_left > 1024 * 8) space_left = 1024 * 8; - nread = emacs_read (fd, p, space_left); + nread = emacs_read_quit (fd, p, space_left); if (nread < 0) report_file_error ("Read error on documentation file", file); p[nread] = 0; @@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */) Vdoc_file_name = filename; filled = 0; pos = 0; - while (1) + while (true) { - register char *end; if (filled < 512) - filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled); + filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled); if (!filled) break; buf[filled] = 0; - end = buf + (filled < 512 ? filled : filled - 128); + char *end = buf + (filled < 512 ? filled : filled - 128); p = memchr (buf, '\037', end - buf); /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ if (p) diff --git a/src/editfns.c b/src/editfns.c index b60543702f1..4618164d008 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3096,6 +3096,7 @@ determines whether case is significant or ignored. */) return make_number (c1 < c2 ? -1 - chars : chars + 1); chars++; + rarely_quit (chars); } /* The strings match as far as they go. diff --git a/src/eval.c b/src/eval.c index 844879d6a2d..22b02b49521 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1461,6 +1461,19 @@ process_quit_flag (void) quit (); } +/* Check quit-flag and quit if it is non-nil. Typing C-g does not + directly cause a quit; it only sets Vquit_flag. So the program + needs to call maybe_quit at times when it is safe to quit. Every + loop that might run for a long time or might not exit ought to call + maybe_quit at least once, at a safe place. Unless that is + impossible, of course. But it is very desirable to avoid creating + loops where maybe_quit is impossible. + + If quit-flag is set to `kill-emacs' the SIGINT handler has received + a request to exit Emacs when it is safe to do. + + When not quitting, process any pending signals. */ + void maybe_quit (void) { diff --git a/src/fileio.c b/src/fileio.c index a109737240f..38400623793 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2030,9 +2030,9 @@ permissions. */) { char buf[MAX_ALLOCA]; ptrdiff_t n; - for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf)); + for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf)); newsize += n) - if (emacs_write_sig (ofd, buf, n) != n) + if (emacs_write_quit (ofd, buf, n) != n) report_file_error ("Write error", newname); if (n < 0) report_file_error ("Read error", file); @@ -3396,13 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data) static Lisp_Object read_non_regular (Lisp_Object state) { - int nbytes; - - maybe_quit (); - nbytes = emacs_read (XSAVE_INTEGER (state, 0), - ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE - + XSAVE_INTEGER (state, 1)), - XSAVE_INTEGER (state, 2)); + int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0), + ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + + XSAVE_INTEGER (state, 1)), + XSAVE_INTEGER (state, 2)); /* Fast recycle this object for the likely next call. */ free_misc (state); return make_number (nbytes); @@ -3746,17 +3743,17 @@ by calling `format-decode', which see. */) int nread; if (st.st_size <= (1024 * 4)) - nread = emacs_read (fd, read_buf, 1024 * 4); + nread = emacs_read_quit (fd, read_buf, 1024 * 4); else { - nread = emacs_read (fd, read_buf, 1024); + nread = emacs_read_quit (fd, read_buf, 1024); if (nread == 1024) { int ntail; if (lseek (fd, - (1024 * 3), SEEK_END) < 0) report_file_error ("Setting file position", orig_filename); - ntail = emacs_read (fd, read_buf + nread, 1024 * 3); + ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3); nread = ntail < 0 ? ntail : nread + ntail; } } @@ -3861,14 +3858,11 @@ by calling `format-decode', which see. */) report_file_error ("Setting file position", orig_filename); } - maybe_quit (); /* Count how many chars at the start of the file match the text at the beginning of the buffer. */ - while (1) + while (true) { - int nread, bufpos; - - nread = emacs_read (fd, read_buf, sizeof read_buf); + int nread = emacs_read_quit (fd, read_buf, sizeof read_buf); if (nread < 0) report_file_error ("Read error", orig_filename); else if (nread == 0) @@ -3890,7 +3884,7 @@ by calling `format-decode', which see. */) break; } - bufpos = 0; + int bufpos = 0; while (bufpos < nread && same_at_start < ZV_BYTE && FETCH_BYTE (same_at_start) == read_buf[bufpos]) same_at_start++, bufpos++; @@ -3910,7 +3904,7 @@ by calling `format-decode', which see. */) del_range_1 (same_at_start, same_at_end, 0, 0); goto handled; } - maybe_quit (); + /* Count how many chars at the end of the file match the text at the end of the buffer. But, if we have already found that decoding is necessary, don't waste time. */ @@ -3932,7 +3926,8 @@ by calling `format-decode', which see. */) total_read = nread = 0; while (total_read < trial) { - nread = emacs_read (fd, read_buf + total_read, trial - total_read); + nread = emacs_read_quit (fd, read_buf + total_read, + trial - total_read); if (nread < 0) report_file_error ("Read error", orig_filename); else if (nread == 0) @@ -4058,16 +4053,13 @@ by calling `format-decode', which see. */) inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ unprocessed = 0; /* Bytes not processed in previous loop. */ - while (1) + while (true) { /* Read at most READ_BUF_SIZE bytes at a time, to allow quitting while reading a huge file. */ - /* Allow quitting out of the actual I/O. */ - maybe_quit (); - this = emacs_read (fd, read_buf + unprocessed, - READ_BUF_SIZE - unprocessed); - + this = emacs_read_quit (fd, read_buf + unprocessed, + READ_BUF_SIZE - unprocessed); if (this <= 0) break; @@ -4281,11 +4273,10 @@ by calling `format-decode', which see. */) /* Allow quitting out of the actual I/O. We don't make text part of the buffer until all the reading is done, so a C-g here doesn't do any harm. */ - maybe_quit (); - this = emacs_read (fd, - ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE - + inserted), - trytry); + this = emacs_read_quit (fd, + ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE + + inserted), + trytry); } if (this <= 0) @@ -5398,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end, : (STRINGP (coding->dst_object) ? SSDATA (coding->dst_object) : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); - coding->produced -= emacs_write_sig (desc, buf, coding->produced); + coding->produced -= emacs_write_quit (desc, buf, coding->produced); if (coding->raw_destination) { diff --git a/src/filelock.c b/src/filelock.c index de65c52efa1..67e8dbd34ed 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) fcntl (fd, F_SETFD, FD_CLOEXEC); lock_info_len = strlen (lock_info_str); err = 0; - /* Use 'write', not 'emacs_write', as garbage collection - might signal an error, which would leak FD. */ - if (write (fd, lock_info_str, lock_info_len) != lock_info_len + if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) err = errno; /* There is no need to call fsync here, as the contents of @@ -490,8 +488,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0); if (0 <= fd) { - /* Use read, not emacs_read, since FD isn't unwind-protected. */ - ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1); + ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1); int read_errno = errno; if (emacs_close (fd) != 0) return -1; diff --git a/src/fns.c b/src/fns.c index 444339c5259..41c0c5856b4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */) return make_number (val); } -/* Heuristic on how many iterations of a tight loop can be safely done - before it's time to do a quit. This must be a power of 2. It - is nice but not necessary for it to equal USHRT_MAX + 1. */ -enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; - -/* Process a quit, but do it only rarely, for efficiency. "Rarely" - means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times, - whichever is smaller. Use *QUIT_COUNT to count this. */ - -static void -rarely_quit (unsigned short int *quit_count) -{ - if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1))) - maybe_quit (); -} - /* Random data-structure functions. */ DEFUN ("length", Flength, Slength, 1, 1, 0, @@ -1359,9 +1343,8 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, (Lisp_Object n, Lisp_Object list) { CHECK_NUMBER (n); - EMACS_INT num = XINT (n); Lisp_Object tail = list; - for (EMACS_INT i = 0; i < num; i++) + for (EMACS_INT num = XINT (n); 0 < num; num--) { if (! CONSP (tail)) { @@ -1369,6 +1352,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, return Qnil; } tail = XCDR (tail); + rarely_quit (num); } return tail; } @@ -1405,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */) { if (! NILP (Fequal (elt, XCAR (tail)))) return tail; - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1416,11 +1400,13 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (EQ (XCAR (tail), elt)) return tail; + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1434,12 +1420,14 @@ The value is actually the tail of LIST whose car is ELT. */) if (!FLOATP (elt)) return Fmemq (elt, list); + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) return tail; + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1451,11 +1439,13 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) return XCAR (tail); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1486,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */) if (CONSP (car) && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) return car; - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1513,11 +1503,13 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, The value is actually the first element of LIST whose cdr is KEY. */) (Lisp_Object key, Lisp_Object list) { + unsigned short int quit_count = 0; Lisp_Object tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) { if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) return XCAR (tail); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1536,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) if (CONSP (car) && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) return car; - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1692,7 +1684,7 @@ changing the value of a sequence `foo'. */) } else prev = tail; - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, seq); } @@ -1717,10 +1709,10 @@ This function may destructively modify SEQ to produce the value. */) for (prev = Qnil, tail = seq; CONSP (tail); tail = next) { - rarely_quit (&quit_count); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, seq); seq = prev; @@ -1766,8 +1758,8 @@ See also the function `nreverse', which is used more often. */) unsigned short int quit_count = 0; for (new = Qnil; CONSP (seq); seq = XCDR (seq)) { - rarely_quit (&quit_count); new = Fcons (XCAR (seq), new); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (seq, seq); } @@ -2058,6 +2050,7 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { + unsigned short int quit_count = 0; Lisp_Object prev = Qnil; for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) @@ -2069,6 +2062,7 @@ The PLIST is modified by side effects. */) } prev = tail; + incr_rarely_quit (&quit_count); } Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); @@ -2106,7 +2100,7 @@ one of the properties on the list. */) { if (! NILP (Fequal (prop, XCAR (tail)))) return XCAR (XCDR (tail)); - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } CHECK_LIST_END (tail, prop); @@ -2136,7 +2130,7 @@ The PLIST is modified by side effects. */) } prev = tail; - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); } Lisp_Object newcell = list2 (prop, val); if (NILP (prev)) @@ -2216,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, unsigned short int quit_count = 0; tail_recurse: - rarely_quit (&quit_count); + incr_rarely_quit (&quit_count); if (EQ (o1, o2)) return 1; if (XTYPE (o1) != XTYPE (o2)) @@ -2425,11 +2419,10 @@ usage: (nconc &rest LISTS) */) { tail = tem; tem = XCDR (tail); + incr_rarely_quit (&quit_count); } while (CONSP (tem)); - rarely_quit (&quit_count); - tem = args[argnum + 1]; Fsetcdr (tail, tem); if (NILP (tem)) @@ -2850,10 +2843,12 @@ property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP. */) (Lisp_Object plist, Lisp_Object prop) { + unsigned short int quit_count = 0; while (CONSP (plist) && !EQ (XCAR (plist), prop)) { plist = XCDR (plist); plist = CDR (plist); + incr_rarely_quit (&quit_count); } return plist; } diff --git a/src/indent.c b/src/indent.c index 33f709c5041..aff14abfd20 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1200,8 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, continuation_glyph_width = 0; /* In the fringe. */ #endif - maybe_quit (); - /* It's just impossible to be too paranoid here. */ eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); @@ -1213,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, cmp_it.id = -1; composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); - while (1) + unsigned short int quit_count = 0; + + while (true) { + incr_rarely_quit (&quit_count); + while (pos == next_boundary) { ptrdiff_t pos_here = pos; @@ -1279,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, pos = newpos; pos_byte = CHAR_TO_BYTE (pos); } + + incr_rarely_quit (&quit_count); } /* Handle right margin. */ @@ -1601,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, pos = find_before_next_newline (pos, to, 1, &pos_byte); if (pos < to) INC_BOTH (pos, pos_byte); + incr_rarely_quit (&quit_count); } while (pos < to && indented_beyond_p (pos, pos_byte, diff --git a/src/keyboard.c b/src/keyboard.c index 317669d6a1a..a86e7c5f8e4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7041,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal, /* Now read; for one reason or another, this will not block. NREAD is set to the number of chars read. */ - do - { - nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); - /* POSIX infers that processes which are not in the session leader's - process group won't get SIGHUPs at logout time. BSDI adheres to - this part standard and returns -1 from read (0) with errno==EIO - when the control tty is taken away. - Jeffrey Honig says this is generally safe. */ - if (nread == -1 && errno == EIO) - return -2; /* Close this terminal. */ -#if defined (AIX) && defined (_BSD) - /* The kernel sometimes fails to deliver SIGHUP for ptys. - This looks incorrect, but it isn't, because _BSD causes - O_NDELAY to be defined in fcntl.h as O_NONBLOCK, - and that causes a value other than 0 when there is no input. */ - if (nread == 0) - return -2; /* Close this terminal. */ + nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); + /* POSIX infers that processes which are not in the session leader's + process group won't get SIGHUPs at logout time. BSDI adheres to + this part standard and returns -1 from read (0) with errno==EIO + when the control tty is taken away. + Jeffrey Honig says this is generally safe. */ + if (nread == -1 && errno == EIO) + return -2; /* Close this terminal. */ +#if defined AIX && defined _BSD + /* The kernel sometimes fails to deliver SIGHUP for ptys. + This looks incorrect, but it isn't, because _BSD causes + O_NDELAY to be defined in fcntl.h as O_NONBLOCK, + and that causes a value other than 0 when there is no input. */ + if (nread == 0) + return -2; /* Close this terminal. */ #endif - } - while ( - /* We used to retry the read if it was interrupted. - But this does the wrong thing when O_NONBLOCK causes - an EAGAIN error. Does anybody know of a situation - where a retry is actually needed? */ -#if 0 - nread < 0 && (errno == EAGAIN || errno == EFAULT -#ifdef EBADSLT - || errno == EBADSLT -#endif - ) -#else - 0 -#endif - ); #ifndef USABLE_FIONREAD #if defined (USG) || defined (CYGWIN) diff --git a/src/lisp.h b/src/lisp.h index a18e4da1cfd..2d67e7edddb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3123,24 +3123,36 @@ struct handler extern Lisp_Object memory_signal_data; -/* Check quit-flag and quit if it is non-nil. Typing C-g does not - directly cause a quit; it only sets Vquit_flag. So the program - needs to call maybe_quit at times when it is safe to quit. Every - loop that might run for a long time or might not exit ought to call - maybe_quit at least once, at a safe place. Unless that is - impossible, of course. But it is very desirable to avoid creating - loops where maybe_quit is impossible. - - If quit-flag is set to `kill-emacs' the SIGINT handler has received - a request to exit Emacs when it is safe to do. - - When not quitting, process any pending signals. */ - extern void maybe_quit (void); /* True if ought to quit now. */ #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) + +/* Heuristic on how many iterations of a tight loop can be safely done + before it's time to do a quit. This must be a power of 2. It + is nice but not necessary for it to equal USHRT_MAX + 1. */ + +enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; + +/* Process a quit rarely, based on a counter COUNT, for efficiency. + "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 + times, whichever is smaller (somewhat arbitrary, but often faster). */ + +INLINE void +rarely_quit (unsigned short int count) +{ + if (! (count & (QUIT_COUNT_HEURISTIC - 1))) + maybe_quit (); +} + +/* Increment *QUIT_COUNT and rarely quit. */ + +INLINE void +incr_rarely_quit (unsigned short int *quit_count) +{ + rarely_quit (++*quit_count); +} extern Lisp_Object Vascii_downcase_table; extern Lisp_Object Vascii_canon_table; @@ -4216,8 +4228,10 @@ extern int emacs_open (const char *, int, int); extern int emacs_pipe (int[2]); extern int emacs_close (int); extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); +extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t); extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); +extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); extern void emacs_perror (char const *); extern void unlock_all_files (void); diff --git a/src/lread.c b/src/lread.c index 17806922a8c..094aa628eec 100644 --- a/src/lread.c +++ b/src/lread.c @@ -910,7 +910,7 @@ safe_to_load_version (int fd) /* Read the first few bytes from the file, and look for a line specifying the byte compiler version used. */ - nbytes = emacs_read (fd, buf, sizeof buf); + nbytes = emacs_read_quit (fd, buf, sizeof buf); if (nbytes > 0) { /* Skip to the next newline, skipping over the initial `ELC' diff --git a/src/search.c b/src/search.c index ed9c12c68fe..084adda097b 100644 --- a/src/search.c +++ b/src/search.c @@ -800,6 +800,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); } + if (allow_quit) + maybe_quit (); } start_byte = lim_byte; @@ -905,6 +907,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, *bytepos = ceiling_byte + prev + 1; return BYTE_TO_CHAR (ceiling_byte + prev + 1); } + if (allow_quit) + maybe_quit (); } start_byte = ceiling_byte; @@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, return (n); } n++; + maybe_quit (); } while (n > 0) { @@ -1296,6 +1301,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, return (0 - n); } n--; + maybe_quit (); } #ifdef REL_ALLOC r_alloc_inhibit_buffer_relocation (0); @@ -3252,6 +3258,8 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end, *bytepos = lim_byte + next; return BYTE_TO_CHAR (lim_byte + next); } + if (allow_quit) + maybe_quit (); } start_byte = lim_byte; diff --git a/src/syntax.c b/src/syntax.c index e713922bf10..06fe50b866b 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -593,6 +593,7 @@ static ptrdiff_t find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) { ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; + unsigned short int quit_count = 0; /* Use previous finding, if it's valid and applies to this inquiry. */ if (current_buffer == find_start_buffer @@ -621,11 +622,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) SETUP_BUFFER_SYNTAX_TABLE (); while (PT > BEGV) { - int c; - /* Open-paren at start of line means we may have found our defun-start. */ - c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); + int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); if (SYNTAX (c) == Sopen) { SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ @@ -637,6 +636,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) } /* Move to beg of previous line. */ scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1); + incr_rarely_quit (&quit_count); } /* Record what we found, for the next try. */ @@ -715,6 +715,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, ptrdiff_t nesting = 1; /* Current comment nesting. */ int c; int syntax = 0; + unsigned short int quit_count = 0; /* FIXME: A }} comment-ender style leads to incorrect behavior in the case of {{ c }}} because we ignore the last two chars which are @@ -724,6 +725,8 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, that determines quote parity to the comment-end. */ while (from != stop) { + incr_rarely_quit (&quit_count); + ptrdiff_t temp_byte; int prev_syntax; bool com2start, com2end, comstart; @@ -951,7 +954,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, defun_start_byte = CHAR_TO_BYTE (defun_start); } } - } while (defun_start < comment_end); + incr_rarely_quit (&quit_count); + } + while (defun_start < comment_end); from_byte = CHAR_TO_BYTE (from); UPDATE_SYNTAX_TABLE_FORWARD (from - 1); @@ -1417,22 +1422,20 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, COUNT negative means scan backward and stop at word beginning. */ ptrdiff_t -scan_words (register ptrdiff_t from, register EMACS_INT count) +scan_words (ptrdiff_t from, EMACS_INT count) { - register ptrdiff_t beg = BEGV; - register ptrdiff_t end = ZV; - register ptrdiff_t from_byte = CHAR_TO_BYTE (from); - register enum syntaxcode code; + ptrdiff_t beg = BEGV; + ptrdiff_t end = ZV; + ptrdiff_t from_byte = CHAR_TO_BYTE (from); + enum syntaxcode code; int ch0, ch1; Lisp_Object func, pos; - maybe_quit (); - SETUP_SYNTAX_TABLE (from, count); while (count > 0) { - while (1) + while (true) { if (from == end) return 0; @@ -1445,6 +1448,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) break; if (code == Sword) break; + rarely_quit (from); } /* Now CH0 is a character which begins a word and FROM is the position of the next character. */ @@ -1473,13 +1477,14 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) break; INC_BOTH (from, from_byte); ch0 = ch1; + rarely_quit (from); } } count--; } while (count < 0) { - while (1) + while (true) { if (from == beg) return 0; @@ -1492,6 +1497,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) break; if (code == Sword) break; + rarely_quit (from); } /* Now CH1 is a character which ends a word and FROM is the position of it. */ @@ -1524,6 +1530,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count) break; } ch1 = ch0; + rarely_quit (from); } } count++; @@ -1961,9 +1968,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, } fwd_ok: p += nbytes, pos++, pos_byte += nbytes; + rarely_quit (pos); } else - while (1) + while (true) { if (p >= stop) { @@ -1985,15 +1993,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, break; fwd_unibyte_ok: p++, pos++, pos_byte++; + rarely_quit (pos); } } else { if (multibyte) - while (1) + while (true) { - unsigned char *prev_p; - if (p <= stop) { if (p <= endp) @@ -2001,8 +2008,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, p = GPT_ADDR; stop = endp; } - prev_p = p; - while (--p >= stop && ! CHAR_HEAD_P (*p)); + unsigned char *prev_p = p; + do + p--; + while (stop <= p && ! CHAR_HEAD_P (*p)); + c = STRING_CHAR (p); if (! NILP (iso_classes) && in_classes (c, iso_classes)) @@ -2026,9 +2036,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, } back_ok: pos--, pos_byte -= prev_p - p; + rarely_quit (pos); } else - while (1) + while (true) { if (p <= stop) { @@ -2050,6 +2061,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, break; back_unibyte_ok: p--, pos--, pos_byte--; + rarely_quit (pos); } } @@ -2155,6 +2167,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) if (! fastmap[SYNTAX (c)]) goto done; p += nbytes, pos++, pos_byte += nbytes; + rarely_quit (pos); } while (!parse_sexp_lookup_properties || pos < gl_state.e_property); @@ -2171,10 +2184,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) if (multibyte) { - while (1) + while (true) { - unsigned char *prev_p; - if (p <= stop) { if (p <= endp) @@ -2183,17 +2194,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) stop = endp; } UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); - prev_p = p; - while (--p >= stop && ! CHAR_HEAD_P (*p)); + + unsigned char *prev_p = p; + do + p--; + while (stop <= p && ! CHAR_HEAD_P (*p)); + c = STRING_CHAR (p); if (! fastmap[SYNTAX (c)]) break; pos--, pos_byte -= prev_p - p; + rarely_quit (pos); } } else { - while (1) + while (true) { if (p <= stop) { @@ -2206,6 +2222,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) if (! fastmap[SYNTAX (p[-1])]) break; p--, pos--, pos_byte--; + rarely_quit (pos); } } } @@ -2273,9 +2290,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, EMACS_INT *incomment_ptr, int *last_syntax_ptr) { - register int c, c1; - register enum syntaxcode code; - register int syntax, other_syntax; + unsigned short int quit_count = 0; + int c, c1; + enum syntaxcode code; + int syntax, other_syntax; if (nesting <= 0) nesting = -1; @@ -2367,6 +2385,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, UPDATE_SYNTAX_TABLE_FORWARD (from); nesting++; } + + incr_rarely_quit (&quit_count); } *charpos_ptr = from; *bytepos_ptr = from_byte; @@ -2394,13 +2414,12 @@ between them, return t; otherwise return nil. */) ptrdiff_t out_charpos, out_bytepos; EMACS_INT dummy; int dummy2; + unsigned short int quit_count = 0; CHECK_NUMBER (count); count1 = XINT (count); stop = count1 > 0 ? ZV : BEGV; - maybe_quit (); - from = PT; from_byte = PT_BYTE; @@ -2441,6 +2460,7 @@ between them, return t; otherwise return nil. */) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } + incr_rarely_quit (&quit_count); } while (code == Swhitespace || (code == Sendcomment && c == '\n')); @@ -2469,11 +2489,8 @@ between them, return t; otherwise return nil. */) while (count1 < 0) { - while (1) + while (true) { - bool quoted; - int syntax; - if (from <= stop) { SET_PT_BOTH (BEGV, BEGV_BYTE); @@ -2482,9 +2499,9 @@ between them, return t; otherwise return nil. */) DEC_BOTH (from, from_byte); /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ - quoted = char_quoted (from, from_byte); + bool quoted = char_quoted (from, from_byte); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - syntax = SYNTAX_WITH_FLAGS (c); + int syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX (c); comstyle = 0; comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); @@ -2527,6 +2544,7 @@ between them, return t; otherwise return nil. */) } else if (from == stop) break; + incr_rarely_quit (&quit_count); } if (fence_found == 0) { @@ -2573,6 +2591,8 @@ between them, return t; otherwise return nil. */) SET_PT_BOTH (from, from_byte); return Qnil; } + + incr_rarely_quit (&quit_count); } count1++; @@ -2612,6 +2632,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) EMACS_INT dummy; int dummy2; bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; + unsigned short int quit_count = 0; if (depth > 0) min_depth = 0; @@ -2627,6 +2648,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { while (from < stop) { + incr_rarely_quit (&quit_count); bool comstart_first, prefix; int syntax, other_syntax; UPDATE_SYNTAX_TABLE_FORWARD (from); @@ -2695,6 +2717,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) goto done; } INC_BOTH (from, from_byte); + incr_rarely_quit (&quit_count); } goto done; @@ -2766,6 +2789,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (c_code == Scharquote || c_code == Sescape) INC_BOTH (from, from_byte); INC_BOTH (from, from_byte); + incr_rarely_quit (&quit_count); } INC_BOTH (from, from_byte); if (!depth && sexpflag) goto done; @@ -2791,11 +2815,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { while (from > stop) { - int syntax; + incr_rarely_quit (&quit_count); DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); - syntax= SYNTAX_WITH_FLAGS (c); + int syntax = SYNTAX_WITH_FLAGS (c); code = syntax_multibyte (c, multibyte_symbol_p); if (depth == min_depth) last_good = from; @@ -2867,6 +2891,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) default: goto done2; } DEC_BOTH (from, from_byte); + incr_rarely_quit (&quit_count); } goto done2; @@ -2929,13 +2954,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (syntax_multibyte (c, multibyte_symbol_p) == code) break; } + incr_rarely_quit (&quit_count); } if (code == Sstring_fence && !depth && sexpflag) goto done2; break; case Sstring: stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); - while (1) + while (true) { if (from == stop) goto lose; @@ -2949,6 +2975,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) == Sstring)) break; } + incr_rarely_quit (&quit_count); } if (!depth && sexpflag) goto done2; break; @@ -3061,6 +3088,7 @@ the prefix syntax flag (p). */) if (pos <= beg) break; DEC_BOTH (pos, pos_byte); + rarely_quit (pos); } SET_PT_BOTH (opoint, opoint_byte); @@ -3131,6 +3159,7 @@ scan_sexps_forward (struct lisp_parse_state *state, bool found; ptrdiff_t out_bytepos, out_charpos; int temp; + unsigned short int quit_count = 0; prev_from = from; prev_from_byte = from_byte; @@ -3200,6 +3229,7 @@ do { prev_from = from; \ while (from < end) { + incr_rarely_quit (&quit_count); INC_FROM; if ((from < end) @@ -3256,6 +3286,7 @@ do { prev_from = from; \ goto symdone; } INC_FROM; + incr_rarely_quit (&quit_count); } symdone: curlevel->prev = curlevel->last; @@ -3366,6 +3397,7 @@ do { prev_from = from; \ break; } INC_FROM; + incr_rarely_quit (&quit_count); } } string_end: diff --git a/src/sysdep.c b/src/sysdep.c index e172dc0aed4..4155c205712 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -382,19 +382,23 @@ get_child_status (pid_t child, int *status, int options, bool interruptible) so that another thread running glib won't find them. */ eassert (child > 0); - while ((pid = waitpid (child, status, options)) < 0) + while (true) { + /* Note: the MS-Windows emulation of waitpid calls maybe_quit + internally. */ + if (interruptible) + maybe_quit (); + + pid = waitpid (child, status, options); + if (0 <= pid) + break; + /* Check that CHILD is a child process that has not been reaped, and that STATUS and OPTIONS are valid. Otherwise abort, as continuing after this internal error could cause Emacs to become confused and kill innocent-victim processes. */ if (errno != EINTR) emacs_abort (); - - /* Note: the MS-Windows emulation of waitpid calls maybe_quit - internally. */ - if (interruptible) - maybe_quit (); } /* If successful and status is requested, tell wait_reading_process_output @@ -2503,78 +2507,113 @@ emacs_close (int fd) #define MAX_RW_COUNT (INT_MAX >> 18 << 18) #endif -/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted. +/* Read from FD to a buffer BUF with size NBYTE. + If interrupted, either quit or retry the read. + Process any quits and pending signals immediately if INTERRUPTIBLE. Return the number of bytes read, which might be less than NBYTE. - On error, set errno and return -1. */ -ptrdiff_t -emacs_read (int fildes, void *buf, ptrdiff_t nbyte) + On error, set errno to a value other than EINTR, and return -1. */ +static ptrdiff_t +emacs_nointr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible) { - ssize_t rtnval; + ssize_t result; /* There is no need to check against MAX_RW_COUNT, since no caller ever passes a size that large to emacs_read. */ + do + { + if (interruptible) + maybe_quit (); + result = read (fd, buf, nbyte); + } + while (result < 0 && errno == EINTR); - while ((rtnval = read (fildes, buf, nbyte)) == -1 - && (errno == EINTR)) - maybe_quit (); - return (rtnval); + return result; } -/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted - or if a partial write occurs. If interrupted, process pending - signals if PROCESS SIGNALS. Return the number of bytes written, setting - errno if this is less than NBYTE. */ +/* Read from FD to a buffer BUF with size NBYTE. + If interrupted, retry the read. Return the number of bytes read, + which might be less than NBYTE. On error, set errno to a value + other than EINTR, and return -1. */ +ptrdiff_t +emacs_read (int fd, void *buf, ptrdiff_t nbyte) +{ + return emacs_nointr_read (fd, buf, nbyte, false); +} + +/* Like emacs_read, but also process quits and pending signals. */ +ptrdiff_t +emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte) +{ + return emacs_nointr_read (fd, buf, nbyte, true); +} + +/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if + interrupted or if a partial write occurs. Process any quits + immediately if INTERRUPTIBLE is positive, and process any pending + signals immediately if INTERRUPTIBLE is nonzero. Return the number + of bytes written; if this is less than NBYTE, set errno to a value + other than EINTR. */ static ptrdiff_t -emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, - bool process_signals) +emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte, + int interruptible) { ptrdiff_t bytes_written = 0; while (nbyte > 0) { - ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); + ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT)); if (n < 0) { - if (errno == EINTR) - { - /* I originally used maybe_quit but that might cause files to - be truncated if you hit C-g in the middle of it. --Stef */ - if (process_signals && pending_signals) - process_pending_signals (); - continue; - } - else + if (errno != EINTR) break; - } - buf += n; - nbyte -= n; - bytes_written += n; + if (interruptible) + { + if (0 < interruptible) + maybe_quit (); + if (pending_signals) + process_pending_signals (); + } + } + else + { + buf += n; + nbyte -= n; + bytes_written += n; + } } return bytes_written; } -/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if - interrupted or if a partial write occurs. Return the number of - bytes written, setting errno if this is less than NBYTE. */ +/* Write to FD from a buffer BUF with size NBYTE, retrying if + interrupted or if a partial write occurs. Do not process quits or + pending signals. Return the number of bytes written, setting errno + if this is less than NBYTE. */ ptrdiff_t -emacs_write (int fildes, void const *buf, ptrdiff_t nbyte) +emacs_write (int fd, void const *buf, ptrdiff_t nbyte) { - return emacs_full_write (fildes, buf, nbyte, 0); + return emacs_full_write (fd, buf, nbyte, 0); } -/* Like emacs_write, but also process pending signals if interrupted. */ +/* Like emacs_write, but also process pending signals. */ ptrdiff_t -emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte) +emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte) { - return emacs_full_write (fildes, buf, nbyte, 1); + return emacs_full_write (fd, buf, nbyte, -1); +} + +/* Like emacs_write, but also process quits and pending signals. */ +ptrdiff_t +emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte) +{ + return emacs_full_write (fd, buf, nbyte, 1); } /* Write a diagnostic to standard error that contains MESSAGE and a string derived from errno. Preserve errno. Do not buffer stderr. - Do not process pending signals if interrupted. */ + Do not process quits or pending signals if interrupted. */ void emacs_perror (char const *message) { @@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid) else { record_unwind_protect_int (close_file_unwind, fd); - nread = emacs_read (fd, procbuf, sizeof procbuf - 1); + nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1); } if (0 < nread) { @@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid) /* Leave room even if every byte needs escaping below. */ readsize = (cmdline_size >> 1) - nread; - nread_incr = emacs_read (fd, cmdline + nread, readsize); + nread_incr = emacs_read_quit (fd, cmdline + nread, readsize); nread += max (0, nread_incr); } while (nread_incr == readsize); @@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid) else { record_unwind_protect_int (close_file_unwind, fd); - nread = emacs_read (fd, &pinfo, sizeof pinfo); + nread = emacs_read_quit (fd, &pinfo, sizeof pinfo); } if (nread == sizeof pinfo) From b4c9f9120d8b0da0593f2fbde69b40374f56451d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 1 Feb 2017 15:18:44 -0800 Subject: [PATCH 27/62] Fix quitting bug when buffers are frozen Problem noted by Eli Zaretskii in: http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00721.html This patch also fixes some other issues in that report. * src/lisp.h (incr_rarely_quit): Remove. All callers changed to use rarely_quit directly. * src/search.c (freeze_buffer_relocation) (thaw_buffer_relocation): New functions. (looking_at_1, fast_looking_at, search_buffer): Use them to fix bug when quitting when buffers are frozen. * src/sysdep.c (emacs_intr_read): Rename from emacs_nointr_read. All uses changed. --- src/callproc.c | 3 +++ src/fns.c | 32 ++++++++++++++-------------- src/indent.c | 6 +++--- src/lisp.h | 8 ------- src/search.c | 57 ++++++++++++++++++++++++-------------------------- src/syntax.c | 34 ++++++++++++++---------------- src/sysdep.c | 10 ++++----- 7 files changed, 70 insertions(+), 80 deletions(-) diff --git a/src/callproc.c b/src/callproc.c index 710174c46b0..84324c48dcf 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -198,7 +198,10 @@ call_process_cleanup (Lisp_Object buffer) { kill (-synch_process_pid, SIGINT); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); + + /* This will quit on C-g. */ wait_for_termination (synch_process_pid, 0, 1); + synch_process_pid = 0; message1 ("Waiting for process to die...done"); } diff --git a/src/fns.c b/src/fns.c index 41c0c5856b4..ac7c1f265a4 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1389,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */) { if (! NILP (Fequal (elt, XCAR (tail)))) return tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1406,7 +1406,7 @@ The value is actually the tail of LIST whose car is ELT. */) { if (EQ (XCAR (tail), elt)) return tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1427,7 +1427,7 @@ The value is actually the tail of LIST whose car is ELT. */) Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) return tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1445,7 +1445,7 @@ Elements of LIST that are not conses are ignored. */) { if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) return XCAR (tail); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1476,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */) if (CONSP (car) && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) return car; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1509,7 +1509,7 @@ The value is actually the first element of LIST whose cdr is KEY. */) { if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) return XCAR (tail); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1528,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) if (CONSP (car) && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) return car; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, list); return Qnil; @@ -1684,7 +1684,7 @@ changing the value of a sequence `foo'. */) } else prev = tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, seq); } @@ -1712,7 +1712,7 @@ This function may destructively modify SEQ to produce the value. */) next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, seq); seq = prev; @@ -1759,7 +1759,7 @@ See also the function `nreverse', which is used more often. */) for (new = Qnil; CONSP (seq); seq = XCDR (seq)) { new = Fcons (XCAR (seq), new); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (seq, seq); } @@ -2062,7 +2062,7 @@ The PLIST is modified by side effects. */) } prev = tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); @@ -2100,7 +2100,7 @@ one of the properties on the list. */) { if (! NILP (Fequal (prop, XCAR (tail)))) return XCAR (XCDR (tail)); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } CHECK_LIST_END (tail, prop); @@ -2130,7 +2130,7 @@ The PLIST is modified by side effects. */) } prev = tail; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } Lisp_Object newcell = list2 (prop, val); if (NILP (prev)) @@ -2210,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, unsigned short int quit_count = 0; tail_recurse: - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); if (EQ (o1, o2)) return 1; if (XTYPE (o1) != XTYPE (o2)) @@ -2419,7 +2419,7 @@ usage: (nconc &rest LISTS) */) { tail = tem; tem = XCDR (tail); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } while (CONSP (tem)); @@ -2848,7 +2848,7 @@ The value is actually the tail of PLIST whose car is PROP. */) { plist = XCDR (plist); plist = CDR (plist); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } return plist; } diff --git a/src/indent.c b/src/indent.c index aff14abfd20..f630ebb847c 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1215,7 +1215,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, while (true) { - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); while (pos == next_boundary) { @@ -1282,7 +1282,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, pos_byte = CHAR_TO_BYTE (pos); } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } /* Handle right margin. */ @@ -1605,7 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, pos = find_before_next_newline (pos, to, 1, &pos_byte); if (pos < to) INC_BOTH (pos, pos_byte); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } while (pos < to && indented_beyond_p (pos, pos_byte, diff --git a/src/lisp.h b/src/lisp.h index 2d67e7edddb..1ac38164c27 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3145,14 +3145,6 @@ rarely_quit (unsigned short int count) if (! (count & (QUIT_COUNT_HEURISTIC - 1))) maybe_quit (); } - -/* Increment *QUIT_COUNT and rarely quit. */ - -INLINE void -incr_rarely_quit (unsigned short int *quit_count) -{ - rarely_quit (++*quit_count); -} extern Lisp_Object Vascii_downcase_table; extern Lisp_Object Vascii_canon_table; diff --git a/src/search.c b/src/search.c index 084adda097b..33cb02aa7af 100644 --- a/src/search.c +++ b/src/search.c @@ -99,6 +99,25 @@ matcher_overflow (void) error ("Stack overflow in regexp matcher"); } +static void +freeze_buffer_relocation (void) +{ +#ifdef REL_ALLOC + /* Prevent ralloc.c from relocating the current buffer while + searching it. */ + r_alloc_inhibit_buffer_relocation (1); + record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0); +#endif +} + +static void +thaw_buffer_relocation (void) +{ +#ifdef REL_ALLOC + unbind_to (SPECPDL_INDEX () - 1, Qnil); +#endif +} + /* Compile a regexp and signal a Lisp error if anything goes wrong. PATTERN is the pattern to compile. CP is the place to put the result. @@ -300,19 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix) re_match_object = Qnil; -#ifdef REL_ALLOC - /* Prevent ralloc.c from relocating the current buffer while - searching it. */ - r_alloc_inhibit_buffer_relocation (1); -#endif + freeze_buffer_relocation (); i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, PT_BYTE - BEGV_BYTE, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), ZV_BYTE - BEGV_BYTE); -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif + thaw_buffer_relocation (); if (i == -2) matcher_overflow (); @@ -553,16 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); -#ifdef REL_ALLOC - /* Prevent ralloc.c from relocating the current buffer while - searching it. */ - r_alloc_inhibit_buffer_relocation (1); -#endif + freeze_buffer_relocation (); len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, pos_byte, NULL, limit_byte); -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif + thaw_buffer_relocation (); return len; } @@ -1204,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } re_match_object = Qnil; -#ifdef REL_ALLOC - /* Prevent ralloc.c from relocating the current buffer while - searching it. */ - r_alloc_inhibit_buffer_relocation (1); -#endif + freeze_buffer_relocation (); while (n < 0) { @@ -1250,9 +1253,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif + thaw_buffer_relocation (); return (n); } n++; @@ -1295,17 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, } else { -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif + thaw_buffer_relocation (); return (0 - n); } n--; maybe_quit (); } -#ifdef REL_ALLOC - r_alloc_inhibit_buffer_relocation (0); -#endif + thaw_buffer_relocation (); return (pos); } else /* non-RE case */ diff --git a/src/syntax.c b/src/syntax.c index 06fe50b866b..7aa43e6e5c7 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -593,7 +593,6 @@ static ptrdiff_t find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) { ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; - unsigned short int quit_count = 0; /* Use previous finding, if it's valid and applies to this inquiry. */ if (current_buffer == find_start_buffer @@ -636,7 +635,6 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) } /* Move to beg of previous line. */ scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1); - incr_rarely_quit (&quit_count); } /* Record what we found, for the next try. */ @@ -725,7 +723,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, that determines quote parity to the comment-end. */ while (from != stop) { - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); ptrdiff_t temp_byte; int prev_syntax; @@ -954,7 +952,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, defun_start_byte = CHAR_TO_BYTE (defun_start); } } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } while (defun_start < comment_end); @@ -2386,7 +2384,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, nesting++; } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } *charpos_ptr = from; *bytepos_ptr = from_byte; @@ -2460,7 +2458,7 @@ between them, return t; otherwise return nil. */) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } while (code == Swhitespace || (code == Sendcomment && c == '\n')); @@ -2544,7 +2542,7 @@ between them, return t; otherwise return nil. */) } else if (from == stop) break; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } if (fence_found == 0) { @@ -2592,7 +2590,7 @@ between them, return t; otherwise return nil. */) return Qnil; } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } count1++; @@ -2648,7 +2646,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { while (from < stop) { - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); bool comstart_first, prefix; int syntax, other_syntax; UPDATE_SYNTAX_TABLE_FORWARD (from); @@ -2717,7 +2715,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) goto done; } INC_BOTH (from, from_byte); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } goto done; @@ -2789,7 +2787,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (c_code == Scharquote || c_code == Sescape) INC_BOTH (from, from_byte); INC_BOTH (from, from_byte); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } INC_BOTH (from, from_byte); if (!depth && sexpflag) goto done; @@ -2815,7 +2813,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { while (from > stop) { - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -2891,7 +2889,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) default: goto done2; } DEC_BOTH (from, from_byte); - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } goto done2; @@ -2954,7 +2952,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (syntax_multibyte (c, multibyte_symbol_p) == code) break; } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } if (code == Sstring_fence && !depth && sexpflag) goto done2; break; @@ -2975,7 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) == Sstring)) break; } - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } if (!depth && sexpflag) goto done2; break; @@ -3229,7 +3227,7 @@ do { prev_from = from; \ while (from < end) { - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); INC_FROM; if ((from < end) @@ -3286,7 +3284,7 @@ do { prev_from = from; \ goto symdone; } INC_FROM; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } symdone: curlevel->prev = curlevel->last; @@ -3397,7 +3395,7 @@ do { prev_from = from; \ break; } INC_FROM; - incr_rarely_quit (&quit_count); + rarely_quit (++quit_count); } } string_end: diff --git a/src/sysdep.c b/src/sysdep.c index 4155c205712..91b2a5cb943 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2508,12 +2508,12 @@ emacs_close (int fd) #endif /* Read from FD to a buffer BUF with size NBYTE. - If interrupted, either quit or retry the read. - Process any quits and pending signals immediately if INTERRUPTIBLE. + If interrupted, process any quits and pending signals immediately + if INTERRUPTIBLE, and then retry the read unless quitting. Return the number of bytes read, which might be less than NBYTE. On error, set errno to a value other than EINTR, and return -1. */ static ptrdiff_t -emacs_nointr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible) +emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible) { ssize_t result; @@ -2537,14 +2537,14 @@ emacs_nointr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible) ptrdiff_t emacs_read (int fd, void *buf, ptrdiff_t nbyte) { - return emacs_nointr_read (fd, buf, nbyte, false); + return emacs_intr_read (fd, buf, nbyte, false); } /* Like emacs_read, but also process quits and pending signals. */ ptrdiff_t emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte) { - return emacs_nointr_read (fd, buf, nbyte, true); + return emacs_intr_read (fd, buf, nbyte, true); } /* Write to FILEDES from a buffer BUF with size NBYTE, retrying if From 910e63de89500e577be266b9cf8c815c5b47cfce Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Wed, 1 Feb 2017 20:51:00 -0500 Subject: [PATCH 28/62] Prevent creating thumbnails of all gif frames With the previous defaults, doing image-dired on a directory with an animated foo.gif would cause creation of foo.thumb-N.gif for each of N frames in foo.gif. By default image-dired looks for foo.thumb.gif, so there additionally is no usable thumbnail after all the needless effort. image-dired never handled animation, regardless. * lisp/image-dired.el: Mention limitation. (image-dired-cmd-create-thumbnail-options): (image-dired-cmd-create-temp-image-options): (image-dired-cmd-create-standard-thumbnail-options): Append [0] to filename to indicate only converting the 0th frame. (image-dired-display-image-mode): Don't show a cursor. --- lisp/image-dired.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 901225fa2e9..2a4064560a7 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -94,6 +94,7 @@ ;; * WARNING: The "database" format used might be changed so keep a ;; backup of `image-dired-db-file' when testing new versions. ;; +;; * `image-dired-display-image-mode' does not support animation ;; ;; TODO ;; ==== @@ -228,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'." :group 'image-dired) (defcustom image-dired-cmd-create-thumbnail-options - '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") "Options of command used to create thumbnail image. Used with `image-dired-cmd-create-thumbnail-program'. Available format specifiers are: %w which is replaced by @@ -246,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'." :group 'image-dired) (defcustom image-dired-cmd-create-temp-image-options - '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") + '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t") "Options of command used to create temporary image for display window. Used together with `image-dired-cmd-create-temp-image-program', Available format specifiers are: %w and %h which are replaced by @@ -316,7 +317,7 @@ Available format specifiers are described in :group 'image-dired) (defcustom image-dired-cmd-create-standard-thumbnail-options - (append '("-size" "%wx%h" "%f") + (append '("-size" "%wx%h" "%f[0]") (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) (list @@ -1626,6 +1627,7 @@ Resized or in full-size." :group 'image-dired (buffer-disable-undo) (image-mode-setup-winprops) + (setq cursor-type nil) (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) (defvar image-dired-minor-mode-map From 70d36dda26465b43c1a63e8e13153e070af86456 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Wed, 1 Feb 2017 21:01:45 -0500 Subject: [PATCH 29/62] Turn on lexical-binding in parse-time.el * lisp/calendar/parse-time.el: Turn on lexical-binding. (parse-time-iso8601-regexp, parse-iso8601-time-string): Remove unused bindings. --- lisp/calendar/parse-time.el | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 7651c5da1f4..b781cb0eb48 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -1,4 +1,4 @@ -;;; parse-time.el --- parsing time strings +;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*- ;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc. @@ -203,12 +203,9 @@ any values that are unknown are returned as nil." (time-second 2digit) (time-secfrac "\\(\\.[0-9]+\\)?") (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) - (time-offset (concat "Z" time-numoffset)) (partial-time (concat time-hour colon time-minute colon time-second time-secfrac)) - (full-date (concat date-fullyear dash date-month dash date-mday)) - (full-time (concat partial-time time-offset)) - (date-time (concat full-date "T" full-time))) + (full-date (concat date-fullyear dash date-month dash date-mday))) (list (concat "^" full-date) (concat "T" partial-time) (concat "\\(Z\\|" time-numoffset "\\)"))) @@ -225,7 +222,7 @@ If DATE-STRING cannot be parsed, it falls back to (time-re (nth 1 parse-time-iso8601-regexp)) (tz-re (nth 2 parse-time-iso8601-regexp)) re-start - time seconds minute hour fractional-seconds + time seconds minute hour day month year day-of-week dst tz) ;; We need to populate 'time' with ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) @@ -240,9 +237,6 @@ If DATE-STRING cannot be parsed, it falls back to (setq hour (string-to-number (match-string 1 date-string)) minute (string-to-number (match-string 2 date-string)) seconds (string-to-number (match-string 3 date-string)) - fractional-seconds (string-to-number (or - (match-string 4 date-string) - "0")) re-start (match-end 0)) (when (string-match tz-re date-string re-start) (if (string= "Z" (match-string 1 date-string)) From 141b085674e2945cc0c42bbe35548c368d1b023e Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Wed, 1 Feb 2017 22:07:03 -0500 Subject: [PATCH 30/62] Treat list-buffers-directory as a string Another step in the long history of list-buffers-directory. A thread branch discussing the meaning/use of the variable starts here https://lists.gnu.org/archive/html/emacs-devel/2009-09/msg00684.html Also see (info "(elisp) Buffer File Name"). * lisp/buff-menu.el: Relocate special case code into info.el. Nix Info-* defvars. (Buffer-menu--pretty-file-name): Remove special case. Use bound-and-true-p. (Buffer-menu-info-node-description): Remove. * lisp/ibuffer.el (ibuffer-buffer-file-name): Treat list-buffers-directory as a string. * lisp/info.el (Info-node-description): New function. (Info-select-node): Use it. --- lisp/buff-menu.el | 19 +------------------ lisp/ibuffer.el | 15 ++++++++------- lisp/info.el | 11 +++++++++++ 3 files changed, 20 insertions(+), 25 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 77b325ff25d..9f618bcb7de 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -102,9 +102,6 @@ This is set by the prefix argument to `buffer-menu' and related commands.") (make-variable-buffer-local 'Buffer-menu-files-only) -(defvar Info-current-file) ; from info.el -(defvar Info-current-node) ; from info.el - (defvar Buffer-menu-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap))) @@ -702,21 +699,7 @@ means list those buffers and no others." (defun Buffer-menu--pretty-file-name (file) (cond (file (abbreviate-file-name file)) - ((and (boundp 'list-buffers-directory) - list-buffers-directory) - list-buffers-directory) - ((eq major-mode 'Info-mode) - (Buffer-menu-info-node-description Info-current-file)) + ((bound-and-true-p list-buffers-directory)) (t ""))) -(defun Buffer-menu-info-node-description (file) - (cond - ((equal file "dir") "*Info Directory*") - ((eq file 'apropos) "*Info Apropos*") - ((eq file 'history) "*Info History*") - ((eq file 'toc) "*Info TOC*") - ((not (stringp file)) "") ; Avoid errors - (t - (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) - ;;; buff-menu.el ends here diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index c6e5e471a36..71bf1d6dcc2 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1319,13 +1319,14 @@ a new window in the current frame, splitting vertically." (cl-assert (derived-mode-p 'ibuffer-mode))) (defun ibuffer-buffer-file-name () - (or buffer-file-name - (let ((dirname (or (and (boundp 'dired-directory) - (if (stringp dired-directory) - dired-directory - (car dired-directory))) - (bound-and-true-p list-buffers-directory)))) - (and dirname (expand-file-name dirname))))) + (cond + ((buffer-file-name)) + ((bound-and-true-p list-buffers-directory)) + ((let ((dirname (and (boundp 'dired-directory) + (if (stringp dired-directory) + dired-directory + (car dired-directory))))) + (and dirname (expand-file-name dirname)))))) (define-ibuffer-op ibuffer-do-save () "Save marked buffers as with `save-buffer'." diff --git a/lisp/info.el b/lisp/info.el index e32b6b35632..0cfcec32f82 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1599,6 +1599,16 @@ escaped (\\\",\\\\)." parameter-alist)) parameter-alist)) +(defun Info-node-description (file) + (cond + ((equal file "dir") "*Info Directory*") + ((eq file 'apropos) "*Info Apropos*") + ((eq file 'history) "*Info History*") + ((eq file 'toc) "*Info TOC*") + ((not (stringp file)) "") ; Avoid errors + (t + (concat "(" (file-name-nondirectory file) ") " Info-current-node)))) + (defun Info-display-images-node () "Display images in current node." (save-excursion @@ -1693,6 +1703,7 @@ escaped (\\\",\\\\)." (setq Info-history-forward nil)) (if (not (eq Info-fontify-maximum-menu-size nil)) (Info-fontify-node)) + (setq list-buffers-directory (Info-node-description Info-current-file)) (Info-display-images-node) (Info-hide-cookies-node) (run-hooks 'Info-selection-hook))))) From 8e871aef10455eefc34790a9ec011c6fec5e93fe Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 2 Feb 2017 19:13:05 +0900 Subject: [PATCH 31/62] Allow occur command to operate on the region See discussion in: https://lists.gnu.org/archive/html/emacs-devel/2016-12/msg01084.html * lisp/replace.el (occur--region-start, occur--region-end) (occur--matches-threshold): New variables. (occur-engine): Use them. (occur): Idem. Add optional arg REGION; if non-nil occur applies in that region. * doc/lispintro/emacs-lisp-intro.texi (Keybindings): Update manual * doc/emacs/search.texi (Other Repeating Search): Idem. ; etc/NEWS: Add entry for the new feature. --- doc/emacs/search.texi | 14 ++++----- doc/lispintro/emacs-lisp-intro.texi | 8 +++-- etc/NEWS | 3 ++ lisp/replace.el | 47 ++++++++++++++++++++++++----- 4 files changed, 55 insertions(+), 17 deletions(-) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index b7282589735..2a67619678b 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1670,8 +1670,9 @@ replacing regexp matches in file names. Here are some other commands that find matches for a regular expression. They all ignore case in matching, if the pattern contains no upper-case letters and @code{case-fold-search} is non-@code{nil}. -Aside from @code{occur} and its variants, all operate on the text from -point to the end of the buffer, or on the region if it is active. +Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, +which always search the whole buffer, all operate on the text from point +to the end of the buffer, or on the region if it is active. @findex list-matching-lines @findex occur @@ -1721,11 +1722,10 @@ Prompt for a regexp, and display a list showing each line in the buffer that contains a match for it. If you type @kbd{M-n} at the prompt, you can reuse search strings from previous incremental searches. The text that matched is highlighted using the @code{match} -face. To limit the search to part of the buffer, narrow to that part -(@pxref{Narrowing}). A numeric argument @var{n} specifies that -@var{n} lines of context are to be displayed before and after each -matching line. The default number of context lines is specified by -the variable @code{list-matching-lines-default-context-lines}. +face. A numeric argument @var{n} specifies that @var{n} lines of +context are to be displayed before and after each matching line. +The default number of context lines is specified by the variable +@code{list-matching-lines-default-context-lines}. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 830c072cf5e..36d767737df 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17151,9 +17151,11 @@ Here is another keybinding, with a comment: @findex occur The @code{occur} command shows all the lines in the current buffer -that contain a match for a regular expression. Matching lines are -shown in a buffer called @file{*Occur*}. That buffer serves as a menu -to jump to occurrences. +that contain a match for a regular expression. When the region is +active, @code{occur} restricts matches to such region. Otherwise it +uses the entire buffer. +Matching lines are shown in a buffer called @file{*Occur*}. +That buffer serves as a menu to jump to occurrences. @findex global-unset-key @cindex Unbinding key diff --git a/etc/NEWS b/etc/NEWS index 86a8385ae76..dcefb75fd55 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -310,6 +310,9 @@ substituted by a home directory by writing it as "/foo:/:/~/file". * Editing Changes in Emacs 26.1 ++++ +** The 'occur' command can now operate on the region. + +++ ** New bindings for 'query-replace-map'. 'undo', undo the last replacement; bound to 'u'. diff --git a/lisp/replace.el b/lisp/replace.el index ff917344453..0a8e4804858 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1360,7 +1360,12 @@ invoke `occur'." "*") (or unique-p (not interactive-p))))) -(defun occur (regexp &optional nlines) +;; Region limits when `occur' applies on a region. +(defvar occur--region-start nil) +(defvar occur--region-end nil) +(defvar occur--matches-threshold nil) + +(defun occur (regexp &optional nlines region) "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. @@ -1369,6 +1374,11 @@ before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. Interactively it is the prefix arg. +Optional arg REGION, if non-nil, mean restrict search to the +specified region. Otherwise search the entire buffer. +REGION must be a list of (START . END) positions as returned by +`region-bounds'. + The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\\\[describe-mode] in that buffer will explain how. @@ -1386,8 +1396,24 @@ For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and program. When there is no parenthesized subexpressions in REGEXP the entire match is collected. In any case the searched buffer is not modified." - (interactive (occur-read-primary-args)) - (occur-1 regexp nlines (list (current-buffer)))) + (interactive + (nconc (occur-read-primary-args) + (and (use-region-p) (list (region-bounds))))) + (let* ((start (and (caar region) (max (caar region) (point-min)))) + (end (and (cdar region) (min (cdar region) (point-max)))) + (in-region-p (or start end))) + (when in-region-p + (or start (setq start (point-min))) + (or end (setq end (point-max)))) + (let ((occur--region-start start) + (occur--region-end end) + (occur--matches-threshold + (and in-region-p + (line-number-at-pos (min start end))))) + (save-excursion ; If no matches `occur-1' doesn't restore the point. + (and in-region-p (narrow-to-region start end)) + (occur-1 regexp nlines (list (current-buffer))) + (and in-region-p (widen)))))) (defvar ido-ignore-item-temp-list) @@ -1545,13 +1571,15 @@ See also `multi-occur'." (let ((global-lines 0) ;; total count of matching lines (global-matches 0) ;; total count of matches (coding nil) - (case-fold-search case-fold)) + (case-fold-search case-fold) + (in-region-p (and occur--region-start occur--region-end))) ;; Map over all the buffers (dolist (buf buffers) (when (buffer-live-p buf) (let ((lines 0) ;; count of matching lines (matches 0) ;; count of matches - (curr-line 1) ;; line count + (curr-line ;; line count + (or occur--matches-threshold 1)) (prev-line nil) ;; line number of prev match endpt (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) @@ -1684,7 +1712,7 @@ See also `multi-occur'." (let ((beg (point)) end) (insert (propertize - (format "%d match%s%s%s in buffer: %s\n" + (format "%d match%s%s%s in buffer: %s%s\n" matches (if (= matches 1) "" "es") ;; Don't display the same number of lines ;; and matches in case of 1 match per line. @@ -1694,7 +1722,12 @@ See also `multi-occur'." ;; Don't display regexp for multi-buffer. (if (> (length buffers) 1) "" (occur-regexp-descr regexp)) - (buffer-name buf)) + (buffer-name buf) + (if in-region-p + (format " within region: %d-%d" + occur--region-start + occur--region-end) + "")) 'read-only t)) (setq end (point)) (add-text-properties beg end `(occur-title ,buf)) From e280b94dcd6ed42439718ddf9dd704169f6bb536 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 2 Feb 2017 19:13:27 +0900 Subject: [PATCH 32/62] Show current line highlighted in *Occur* buffer * lisp/replace.el (list-matching-lines-current-line-face) (list-matching-lines-jump-to-current-line): New user options. (occur--orig-line, occur--orig-line-str): New variables. (occur, occur-engine): Use them. (occur--final-pos): New variable. (occur-1): Use it. (occur-engine): Idem. Show the current line with 'list-matching-lines-current-line-face'. Set point on the first matching line after the current one. * etc/NEWS: Add entry for the new option. --- doc/emacs/search.texi | 4 +++ etc/NEWS | 5 +++ lisp/replace.el | 72 ++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 76 insertions(+), 5 deletions(-) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 2a67619678b..a6cb1a4c9f5 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1726,6 +1726,10 @@ face. A numeric argument @var{n} specifies that @var{n} lines of context are to be displayed before and after each matching line. The default number of context lines is specified by the variable @code{list-matching-lines-default-context-lines}. +When @code{list-matching-lines-jump-to-current-line} is non-nil, +the current line is shown highlighted with face +@code{list-matching-lines-current-line-face} and the point is set +at the first match after such line. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. diff --git a/etc/NEWS b/etc/NEWS index dcefb75fd55..ddd40fa8535 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -310,6 +310,11 @@ substituted by a home directory by writing it as "/foo:/:/~/file". * Editing Changes in Emacs 26.1 ++++ +** Two new user options 'list-matching-lines-jump-to-current-line' and +'list-matching-lines-current-line-face' to show highlighted the current +line in *Occur* buffer. + +++ ** The 'occur' command can now operate on the region. diff --git a/lisp/replace.el b/lisp/replace.el index 0a8e4804858..a825040a979 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1304,6 +1304,19 @@ If the value is nil, don't highlight the buffer names specially." :type 'face :group 'matching) +(defcustom list-matching-lines-current-line-face 'lazy-highlight + "Face used by \\[list-matching-lines] to highlight the current line." + :type 'face + :group 'matching + :version "26.1") + +(defcustom list-matching-lines-jump-to-current-line nil + "If non-nil, \\[list-matching-lines] shows the current line highlighted. +Set the point right after such line when there are matches after it." +:type 'boolean +:group 'matching +:version "26.1") + (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. If the face doesn't differ from the default face, @@ -1364,6 +1377,9 @@ invoke `occur'." (defvar occur--region-start nil) (defvar occur--region-end nil) (defvar occur--matches-threshold nil) +(defvar occur--orig-line nil) +(defvar occur--orig-line-str nil) +(defvar occur--final-pos nil) (defun occur (regexp &optional nlines region) "Show all lines in the current buffer containing a match for REGEXP. @@ -1382,6 +1398,9 @@ REGION must be a list of (START . END) positions as returned by The lines are shown in a buffer named `*Occur*'. It serves as a menu to find any of the occurrences in this buffer. \\\\[describe-mode] in that buffer will explain how. +If `list-matching-lines-jump-to-current-line' is non-nil, then show +the current line highlighted with `list-matching-lines-current-line-face' +and set point at the first match after such line. If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. @@ -1409,7 +1428,13 @@ is not modified." (occur--region-end end) (occur--matches-threshold (and in-region-p - (line-number-at-pos (min start end))))) + (line-number-at-pos (min start end)))) + (occur--orig-line + (line-number-at-pos (point))) + (occur--orig-line-str + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) (save-excursion ; If no matches `occur-1' doesn't restore the point. (and in-region-p (narrow-to-region start end)) (occur-1 regexp nlines (list (current-buffer))) @@ -1508,7 +1533,8 @@ See also `multi-occur'." (occur-mode)) (let ((inhibit-read-only t) ;; Don't generate undo entries for creation of the initial contents. - (buffer-undo-list t)) + (buffer-undo-list t) + (occur--final-pos nil)) (erase-buffer) (let ((count (if (stringp nlines) @@ -1560,6 +1586,10 @@ See also `multi-occur'." (if (= count 0) (kill-buffer occur-buf) (display-buffer occur-buf) + (when occur--final-pos + (set-window-point + (get-buffer-window occur-buf 'all-frames) + occur--final-pos)) (setq next-error-last-buffer occur-buf) (setq buffer-read-only t) (set-buffer-modified-p nil) @@ -1572,7 +1602,8 @@ See also `multi-occur'." (global-matches 0) ;; total count of matches (coding nil) (case-fold-search case-fold) - (in-region-p (and occur--region-start occur--region-end))) + (in-region-p (and occur--region-start occur--region-end)) + (multi-occur-p (cdr buffers))) ;; Map over all the buffers (dolist (buf buffers) (when (buffer-live-p buf) @@ -1580,12 +1611,16 @@ See also `multi-occur'." (matches 0) ;; count of matches (curr-line ;; line count (or occur--matches-threshold 1)) + (orig-line occur--orig-line) + (orig-line-str occur--orig-line-str) + (orig-line-shown-p) (prev-line nil) ;; line number of prev match endpt (prev-after-lines nil) ;; context lines of prev match (matchbeg 0) (origpt nil) (begpt nil) (endpt nil) + (finalpt nil) (marker nil) (curstring "") (ret nil) @@ -1686,6 +1721,18 @@ See also `multi-occur'." (nth 0 ret)))) ;; Actually insert the match display data (with-current-buffer out-buf + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p) + (>= curr-line orig-line)) + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")) + (setq orig-line-shown-p t finalpt (point))) (insert data))) (goto-char endpt)) (if endpt @@ -1699,6 +1746,18 @@ See also `multi-occur'." (forward-line 1)) (goto-char (point-max))) (setq prev-line (1- curr-line))) + ;; Insert original line if haven't done yet. + (when (and list-matching-lines-jump-to-current-line + (not multi-occur-p) + (not orig-line-shown-p)) + (with-current-buffer out-buf + (insert + (concat + (propertize + (format "%7d:%s" orig-line orig-line-str) + 'face list-matching-lines-current-line-face + 'mouse-face 'mode-line-highlight + 'help-echo "Current line") "\n")))) ;; Flush remaining context after-lines. (when prev-after-lines (with-current-buffer out-buf @@ -1732,8 +1791,11 @@ See also `multi-occur'." (setq end (point)) (add-text-properties beg end `(occur-title ,buf)) (when title-face - (add-face-text-property beg end title-face))) - (goto-char (point-min))))))) + (add-face-text-property beg end title-face)) + (goto-char (if finalpt + (setq occur--final-pos + (cl-incf finalpt (- end beg))) + (point-min))))))))) ;; Display total match count and regexp for multi-buffer. (when (and (not (zerop global-lines)) (> (length buffers) 1)) (goto-char (point-min)) From 01d87bf846b478dea0bfe824678e76089f5af2c7 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 2 Feb 2017 22:27:18 +0900 Subject: [PATCH 33/62] Ignore error after kill last file or hunk * lisp/vc/diff-mode.el (diff-hunk-kill): Go to beginning of hunk before kill. Ignore error after kill last hunk (Bug#25570). (diff-file-kill): Idem. --- lisp/vc/diff-mode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 7ffa115bde4..a7ac53953dd 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -671,7 +671,7 @@ If the prefix ARG is given, restrict the view to the current file instead." (inhibit-read-only t)) (apply 'kill-region bounds) (goto-char (car bounds)) - (diff-beginning-of-hunk t))) + (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -723,9 +723,10 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) + (diff-beginning-of-hunk t) (let ((inhibit-read-only t)) (apply 'kill-region (diff-bounds-of-file))) - (diff-beginning-of-hunk t)) + (ignore-errors (diff-beginning-of-hunk t))) (defun diff-kill-junk () "Kill spurious empty diffs." From a362b56b51f49963dbb63cd318967bca9b9fef74 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 2 Feb 2017 22:27:33 +0900 Subject: [PATCH 34/62] Check if there are hunks before kill or refine a hunk * lisp/vc/diff-mode.el (diff--some-hunks-p): New predicate. (diff-hunk-kill, diff-file-kill, diff-refine-hunk): Use it (Bug#25571). --- lisp/vc/diff-mode.el | 155 +++++++++++++++++++++++-------------------- 1 file changed, 83 insertions(+), 72 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a7ac53953dd..31c33e6a720 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -650,28 +650,36 @@ If the prefix ARG is given, restrict the view to the current file instead." (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) +(defun diff--some-hunks-p () + (save-excursion + (goto-char (point-min)) + (re-search-forward diff-hunk-header-re nil t))) + (defun diff-hunk-kill () "Kill the hunk at point." (interactive) - (let* ((hunk-bounds (diff-bounds-of-hunk)) - (file-bounds (ignore-errors (diff-bounds-of-file))) - ;; If the current hunk is the only one for its file, kill the - ;; file header too. - (bounds (if (and file-bounds - (progn (goto-char (car file-bounds)) - (= (progn (diff-hunk-next) (point)) - (car hunk-bounds))) - (progn (goto-char (cadr hunk-bounds)) - ;; bzr puts a newline after the last hunk. - (while (looking-at "^\n") - (forward-char 1)) - (= (point) (cadr file-bounds)))) - file-bounds - hunk-bounds)) - (inhibit-read-only t)) - (apply 'kill-region bounds) - (goto-char (car bounds)) - (ignore-errors (diff-beginning-of-hunk t)))) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (file-bounds (ignore-errors (diff-bounds-of-file))) + ;; If the current hunk is the only one for its file, kill the + ;; file header too. + (bounds (if (and file-bounds + (progn (goto-char (car file-bounds)) + (= (progn (diff-hunk-next) (point)) + (car hunk-bounds))) + (progn (goto-char (cadr hunk-bounds)) + ;; bzr puts a newline after the last hunk. + (while (looking-at "^\n") + (forward-char 1)) + (= (point) (cadr file-bounds)))) + file-bounds + hunk-bounds)) + (inhibit-read-only t)) + (apply 'kill-region bounds) + (goto-char (car bounds)) + (ignore-errors (diff-beginning-of-hunk t))))) (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -723,10 +731,12 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) - (diff-beginning-of-hunk t) - (let ((inhibit-read-only t)) - (apply 'kill-region (diff-bounds-of-file))) - (ignore-errors (diff-beginning-of-hunk t))) + (if (not (diff--some-hunks-p)) + (error "No hunks") + (diff-beginning-of-hunk t) + (let ((inhibit-read-only t)) + (apply 'kill-region (diff-bounds-of-file))) + (ignore-errors (diff-beginning-of-hunk t)))) (defun diff-kill-junk () "Kill spurious empty diffs." @@ -2009,57 +2019,58 @@ Return new point, if it was moved." "Highlight changes of hunk at point at a finer granularity." (interactive) (require 'smerge-mode) - (save-excursion - (diff-beginning-of-hunk t) - (let* ((start (point)) - (style (diff-hunk-style)) ;Skips the hunk header as well. - (beg (point)) - (props-c '((diff-mode . fine) (face diff-refine-changed))) - (props-r '((diff-mode . fine) (face diff-refine-removed))) - (props-a '((diff-mode . fine) (face diff-refine-added))) - ;; Be careful to go back to `start' so diff-end-of-hunk gets - ;; to read the hunk header's line info. - (end (progn (goto-char start) (diff-end-of-hunk) (point)))) + (when (diff--some-hunks-p) + (save-excursion + (diff-beginning-of-hunk t) + (let* ((start (point)) + (style (diff-hunk-style)) ;Skips the hunk header as well. + (beg (point)) + (props-c '((diff-mode . fine) (face diff-refine-changed))) + (props-r '((diff-mode . fine) (face diff-refine-removed))) + (props-a '((diff-mode . fine) (face diff-refine-added))) + ;; Be careful to go back to `start' so diff-end-of-hunk gets + ;; to read the hunk header's line info. + (end (progn (goto-char start) (diff-end-of-hunk) (point)))) - (remove-overlays beg end 'diff-mode 'fine) + (remove-overlays beg end 'diff-mode 'fine) - (goto-char beg) - (pcase style - (`unified - (while (re-search-forward "^-" end t) - (let ((beg-del (progn (beginning-of-line) (point))) - beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) - (smerge-refine-subst beg-del beg-add beg-add end-add - nil 'diff-refine-preproc props-r props-a))))) - (`context - (let* ((middle (save-excursion (re-search-forward "^---"))) - (other middle)) - (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) - (smerge-refine-subst (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - 'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) - (_ ;; Normal diffs. - (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) - ;; It's a combined add&remove, so there's something to do. - (smerge-refine-subst beg1 (match-beginning 0) - (match-end 0) end - nil 'diff-refine-preproc props-r props-a)))))))) + (goto-char beg) + (pcase style + (`unified + (while (re-search-forward "^-" end t) + (let ((beg-del (progn (beginning-of-line) (point))) + beg-add end-add) + (when (and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) + (smerge-refine-subst beg-del beg-add beg-add end-add + nil 'diff-refine-preproc props-r props-a))))) + (`context + (let* ((middle (save-excursion (re-search-forward "^---"))) + (other middle)) + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-subst (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + 'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) + (_ ;; Normal diffs. + (let ((beg1 (1+ (point)))) + (when (re-search-forward "^---.*\n" end t) + ;; It's a combined add&remove, so there's something to do. + (smerge-refine-subst beg1 (match-beginning 0) + (match-end 0) end + nil 'diff-refine-preproc props-r props-a))))))))) (defun diff-undo (&optional arg) "Perform `undo', ignoring the buffer's read-only status." From 46aa9a30095241cabef463fd01f71ce9ee50c4dc Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 2 Feb 2017 07:49:55 -0800 Subject: [PATCH 35/62] Merge from gnulib 2017-01-30 Port to PGI 16.10 x86-64 2017-01-20 time_rz: fix comment typo 2017-01-14 strftime: %z is -00 if unknown This incorporates: * doc/misc/texinfo.tex, lib/c-ctype.h, lib/strftime.c: * lib/time-internal.h, lib/verify.h: Copy from gnulib. --- doc/misc/texinfo.tex | 33 ++++++++++++++------------------- lib/c-ctype.h | 20 ++++++++++---------- lib/strftime.c | 12 ++++++------ lib/time-internal.h | 4 ++-- lib/verify.h | 7 ++++++- 5 files changed, 38 insertions(+), 38 deletions(-) diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index c8913ab918e..338bcf65040 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2016-09-18.18} +\def\texinfoversion{2017-01-14.15} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -165,6 +165,9 @@ % Give the space character the catcode for a space. \def\spaceisspace{\catcode`\ =10\relax} +% Likewise for ^^M, the end of line character. +\def\endlineisspace{\catcode13=10\relax} + \chardef\dashChar = `\- \chardef\slashChar = `\/ \chardef\underChar = `\_ @@ -950,21 +953,14 @@ where each line of input produces a line of output.} % @comment ...line which is ignored... % @c is the same as @comment % @ignore ... @end ignore is another way to write a comment -% -\def\comment{\begingroup \catcode`\^^M=\active% -\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other\commentxxx}% -{\catcode`\^^M=\active% -\gdef\commentxxx#1^^M{\endgroup% -\futurelet\nexttoken\commentxxxx}% -\gdef\commentxxxx{\ifx\nexttoken\aftermacro\expandafter\comment\fi}% -} \def\c{\begingroup \catcode`\^^M=\active% \catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% \cxxx} {\catcode`\^^M=\active \gdef\cxxx#1^^M{\endgroup}} -% See comment in \scanmacro about why the definitions of @c and @comment differ +% +\let\comment\c % @paragraphindent NCHARS % We'll use ems for NCHARS, close enough. @@ -8031,9 +8027,6 @@ end } \fi -\let\aftermacroxxx\relax -\def\aftermacro{\aftermacroxxx} - % alias because \c means cedilla in @tex or @math \let\texinfoc=\c @@ -8055,18 +8048,13 @@ end \catcode`\\=\active % % Process the macro body under the current catcode regime. - \scantokens{#1@texinfoc}\aftermacro% + \scantokens{#1@texinfoc}% % \catcode`\@=\savedcatcodeone \catcode`\\=\savedcatcodetwo % % The \texinfoc is to remove the \newlinechar added by \scantokens, and % can be noticed by \parsearg. - % The \aftermacro allows a \comment at the end of the macro definition - % to duplicate itself past the final \newlinechar added by \scantokens: - % this is used in the definition of \group to comment out a newline. We - % don't do the same for \c to support Texinfo files with macros that ended - % with a @c, which should no longer be necessary. % We avoid surrounding the call to \scantokens with \bgroup and \egroup % to allow macros to open or close groups themselves. } @@ -8538,6 +8526,13 @@ end \ifcase\paramno % 0 \expandafter\xdef\csname\the\macname\endcsname{% + \bgroup + \noexpand\spaceisspace + \noexpand\endlineisspace + \noexpand\expandafter % skip any whitespace after the macro name. + \expandafter\noexpand\csname\the\macname @@@\endcsname}% + \expandafter\xdef\csname\the\macname @@@\endcsname{% + \egroup \noexpand\scanmacro{\macrobody}}% \or % 1 \expandafter\xdef\csname\the\macname\endcsname{% diff --git a/lib/c-ctype.h b/lib/c-ctype.h index faf21581ca0..bcdba6b9962 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -115,16 +115,16 @@ extern "C" { /* Cases for lowercase hex letters, and lowercase letters, all offset by N. */ -#define _C_CTYPE_LOWER_A_THRU_F_N(n) \ - case 'a' + (n): case 'b' + (n): case 'c' + (n): case 'd' + (n): \ - case 'e' + (n): case 'f' + (n) -#define _C_CTYPE_LOWER_N(n) \ - _C_CTYPE_LOWER_A_THRU_F_N(n): \ - case 'g' + (n): case 'h' + (n): case 'i' + (n): case 'j' + (n): \ - case 'k' + (n): case 'l' + (n): case 'm' + (n): case 'n' + (n): \ - case 'o' + (n): case 'p' + (n): case 'q' + (n): case 'r' + (n): \ - case 's' + (n): case 't' + (n): case 'u' + (n): case 'v' + (n): \ - case 'w' + (n): case 'x' + (n): case 'y' + (n): case 'z' + (n) +#define _C_CTYPE_LOWER_A_THRU_F_N(N) \ + case 'a' + (N): case 'b' + (N): case 'c' + (N): case 'd' + (N): \ + case 'e' + (N): case 'f' + (N) +#define _C_CTYPE_LOWER_N(N) \ + _C_CTYPE_LOWER_A_THRU_F_N(N): \ + case 'g' + (N): case 'h' + (N): case 'i' + (N): case 'j' + (N): \ + case 'k' + (N): case 'l' + (N): case 'm' + (N): case 'n' + (N): \ + case 'o' + (N): case 'p' + (N): case 'q' + (N): case 'r' + (N): \ + case 's' + (N): case 't' + (N): case 'u' + (N): case 'v' + (N): \ + case 'w' + (N): case 'x' + (N): case 'y' + (N): case 'z' + (N) /* Cases for hex letters, digits, lower, punct, and upper. */ diff --git a/lib/strftime.c b/lib/strftime.c index 9aabcc6748c..e4d78ef7011 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -739,11 +739,10 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) /* The mask is not what you might think. When the ordinal i'th bit is set, insert a colon before the i'th digit of the time zone representation. */ -#define DO_TZ_OFFSET(d, negative, mask, v) \ +#define DO_TZ_OFFSET(d, mask, v) \ do \ { \ digits = d; \ - negative_number = negative; \ tz_colon_mask = mask; \ u_number_value = v; \ goto do_tz_offset; \ @@ -1444,6 +1443,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) } #endif + negative_number = diff < 0 || (diff == 0 && *zone == '-'); hour_diff = diff / 60 / 60; min_diff = diff / 60 % 60; sec_diff = diff % 60; @@ -1451,13 +1451,13 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) switch (colons) { case 0: /* +hhmm */ - DO_TZ_OFFSET (5, diff < 0, 0, hour_diff * 100 + min_diff); + DO_TZ_OFFSET (5, 0, hour_diff * 100 + min_diff); case 1: tz_hh_mm: /* +hh:mm */ - DO_TZ_OFFSET (6, diff < 0, 04, hour_diff * 100 + min_diff); + DO_TZ_OFFSET (6, 04, hour_diff * 100 + min_diff); case 2: tz_hh_mm_ss: /* +hh:mm:ss */ - DO_TZ_OFFSET (9, diff < 0, 024, + DO_TZ_OFFSET (9, 024, hour_diff * 10000 + min_diff * 100 + sec_diff); case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ @@ -1465,7 +1465,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) goto tz_hh_mm_ss; if (min_diff != 0) goto tz_hh_mm; - DO_TZ_OFFSET (3, diff < 0, 0, hour_diff); + DO_TZ_OFFSET (3, 0, hour_diff); default: goto bad_format; diff --git a/lib/time-internal.h b/lib/time-internal.h index 79cb5621991..bf22834b2e1 100644 --- a/lib/time-internal.h +++ b/lib/time-internal.h @@ -38,8 +38,8 @@ struct tm_zone /* A sequence of null-terminated strings packed next to each other. The strings are followed by an extra null byte. If TZ_IS_SET, there must be at least one string and the first string (which is - actually a TZ environment value value) may be empty. Otherwise - all strings must be nonempty. + actually a TZ environment value) may be empty. Otherwise all + strings must be nonempty. Abbreviations are stored here because otherwise the values of tm_zone and/or tzname would be dead after changing TZ and calling diff --git a/lib/verify.h b/lib/verify.h index dcaf7cab938..dcba9c8cb0a 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -248,7 +248,12 @@ template /* Verify requirement R at compile-time, as a declaration without a trailing ';'. */ -#define verify(R) _GL_VERIFY (R, "verify (" #R ")") +#ifdef __GNUC__ +# define verify(R) _GL_VERIFY (R, "verify (" #R ")") +#else +/* PGI barfs if R is long. Play it safe. */ +# define verify(R) _GL_VERIFY (R, "verify (...)") +#endif #ifndef __has_builtin # define __has_builtin(x) 0 From f5372d411d149e8a34def18074891454ebc47730 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 2 Feb 2017 10:57:37 -0500 Subject: [PATCH 36/62] * lisp/doc-view.el (doc-view-mode): Don't require a final newline (doc-view-revert-buffer): Silence overflow warnings. --- lisp/doc-view.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 2c11cd23a7f..172ea163c18 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -442,6 +442,9 @@ Typically \"page-%s.png\".") (defun doc-view-revert-buffer (&optional ignore-auto noconfirm) "Like `revert-buffer', but preserves the buffer's current modes." (interactive (list (not current-prefix-arg))) + (if (< undo-outer-limit (* 2 (buffer-size))) + ;; It's normal for this operation to result in a very large undo entry. + (setq-local undo-outer-limit (* 2 (buffer-size)))) (cl-labels ((revert () (let (revert-buffer-function) (revert-buffer ignore-auto noconfirm 'preserve-modes)))) @@ -1763,6 +1766,8 @@ toggle between displaying the document or editing it as text. (unless doc-view-doc-type (doc-view-set-doc-type)) (doc-view-set-up-single-converter) + (unless (memq doc-view-doc-type '(ps)) + (setq-local require-final-newline nil)) (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives From eee537267f8d6a2f5a48f0c26c14546ac922936c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 2 Feb 2017 09:52:20 -0800 Subject: [PATCH 37/62] Fix lisp.h underparenthesization * src/lisp.h (STACK_CONS, AUTO_STRING_WITH_LEN): Parenthesize compound literals that are function call args. Although this does not fix any bugs, it is the proper style for macro parenthesization as it means this code will continue to work even if make_lisp_ptr is changed to a macro. --- src/lisp.h | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index 1ac38164c27..a9011b4a8be 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4535,7 +4535,7 @@ enum use these only in macros like AUTO_CONS that declare a local variable whose lifetime will be clear to the programmer. */ #define STACK_CONS(a, b) \ - make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) + make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) #define AUTO_CONS_EXPR(a, b) \ (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) @@ -4581,8 +4581,7 @@ enum Lisp_Object name = \ (USE_STACK_STRING \ ? (make_lisp_ptr \ - ((&(union Aligned_String) \ - {{len, -1, 0, (unsigned char *) (str)}}.s), \ + ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ Lisp_String)) \ : make_unibyte_string (str, len)) From df915775bc4ead095aa37d2b098de748e1821027 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 2 Feb 2017 23:06:48 +0200 Subject: [PATCH 38/62] ; Fix recent documentation changes * doc/emacs/search.texi (Other Repeating Search): Index recently introduced variables and faces. --- doc/emacs/search.texi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index a6cb1a4c9f5..fa69ba48f6a 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1715,6 +1715,8 @@ a multi-file incremental search is activated automatically. @cindex mode, Occur @cindex match (face name) @vindex list-matching-lines-default-context-lines +@vindex list-matching-lines-jump-to-current-line +@cindex list-matching-lines-current-line-face (face name) @kindex M-s o @item M-x occur @itemx M-s o From 53c16c75a57aa486dfc1f46ef5aa538264e6ad47 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 2 Feb 2017 15:52:59 -0800 Subject: [PATCH 39/62] Pacify Oracle Studio 12.5 * src/emacs.c (main): Do not silently convert char * to bool. --- src/emacs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index 28b395c4fb4..3083d0df302 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -688,7 +688,7 @@ main (int argc, char **argv) dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 || strcmp (argv[argc - 1], "bootstrap") == 0 ); - generating_ldefs_boot = getenv ("GENERATE_LDEFS_BOOT"); + generating_ldefs_boot = !!getenv ("GENERATE_LDEFS_BOOT"); /* True if address randomization interferes with memory allocation. */ From 604724e49d7b44dc663ad941998a0a44aa4fc178 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 3 Feb 2017 03:10:30 +0200 Subject: [PATCH 40/62] (xref-collect-matches): Use '-E' together with '-e' * lisp/progmodes/xref.el (xref-collect-matches): Use '-E' together with '-e', as suggested by Noam Postavsky (http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00780.html). --- lisp/progmodes/xref.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a507755d42e..a8933b0103e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -918,11 +918,7 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) - ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'. - ;; while 'grep -e -foo' inexplicably doesn't. - (when (eq (aref regexp 0) ?-) - (setq regexp (concat "\\" regexp))) - (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " + (let* ((grep-find-template (replace-regexp-in-string "" " -E" grep-find-template t t)) (grep-highlight-matches nil) (command (xref--rgrep-command (xref--regexp-to-extended regexp) From d17e92da064cabf376597f5de2a8d5a6484bfea6 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 28 Aug 2016 16:38:04 -0400 Subject: [PATCH 41/62] Refactor uses of scroll_margin to a function Its effective range needs to be clamped between 0 and (window height / 4), so it's better to have this constraint in a single place. * src/window.c (window_scroll_margin): New function. (window_scroll_pixel_based, window_scroll_line_based): (Frecenter, Fmove_to_window_line): * src/xdisp.c (try_scrolling, try_cursor_movement): (redisplay_window, try_window, try_window_id): Use it. --- src/window.c | 44 +++++++++++++++++++++------------- src/window.h | 2 ++ src/xdisp.c | 67 +++++++--------------------------------------------- 3 files changed, 39 insertions(+), 74 deletions(-) diff --git a/src/window.c b/src/window.c index bc3f488f37f..1c83d989aa8 100644 --- a/src/window.c +++ b/src/window.c @@ -4790,6 +4790,29 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) XWINDOW (window)->window_end_valid = false; } +/* Compute scroll margin for WINDOW. + We scroll when point is within this distance from the top or bottom + of the window. The result is measured in lines or in pixels + depending on the second parameter. */ +int +window_scroll_margin (struct window *window, enum margin_unit unit) +{ + if (scroll_margin > 0) + { + int frame_line_height = default_line_pixel_height (window); + int window_total_lines + = window->total_lines * WINDOW_FRAME_LINE_HEIGHT (window) + / frame_line_height; + int margin = min (scroll_margin, window_total_lines / 4); + if (unit == MARGIN_IN_PIXELS) + return margin * frame_line_height; + else + return margin; + } + else + return 0; +} + /* Implementation of window_scroll that works based on pixel line heights. See the comment of window_scroll for parameter @@ -4806,7 +4829,6 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) bool vscrolled = false; int x, y, rtop, rbot, rowh, vpos; void *itdata = NULL; - int window_total_lines; int frame_line_height = default_line_pixel_height (w); bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), Fwindow_old_point (window))); @@ -5062,12 +5084,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* Move PT out of scroll margins. This code wants current_y to be zero at the window start position even if there is a header line. */ - window_total_lines - = w->total_lines * WINDOW_FRAME_LINE_HEIGHT (w) / frame_line_height; - this_scroll_margin = max (0, scroll_margin); - this_scroll_margin - = min (this_scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); if (n > 0) { @@ -5290,9 +5307,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror) if (pos < ZV) { - /* Don't use a scroll margin that is negative or too large. */ - int this_scroll_margin = - max (0, min (scroll_margin, w->total_lines / 4)); + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); set_marker_restricted_both (w->start, w->contents, pos, pos_byte); w->start_at_line_beg = !NILP (bolp); @@ -5722,8 +5737,7 @@ and redisplay normally--don't erase and redraw the frame. */) /* Do this after making BUF current in case scroll_margin is buffer-local. */ - this_scroll_margin - = max (0, min (scroll_margin, w->total_lines / 4)); + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); /* Don't use redisplay code for initial frames, as the necessary data structures might not be set up yet then. */ @@ -5962,10 +5976,6 @@ from the top of the window. */) lines = displayed_window_lines (w); -#if false - this_scroll_margin = max (0, min (scroll_margin, lines / 4)); -#endif - if (NILP (arg)) XSETFASTINT (arg, lines / 2); else @@ -5981,6 +5991,8 @@ from the top of the window. */) it is probably better not to install it. However, it is here inside #if false so as not to lose it. -- rms. */ + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES); + /* Don't let it get into the margin at either top or bottom. */ iarg = max (iarg, this_scroll_margin); iarg = min (iarg, lines - this_scroll_margin - 1); diff --git a/src/window.h b/src/window.h index 061cf244943..acb8a5cabfa 100644 --- a/src/window.h +++ b/src/window.h @@ -1120,6 +1120,8 @@ extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); extern void mark_window_cursors_off (struct window *); extern int window_internal_height (struct window *); extern int window_body_width (struct window *w, bool); +enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS }; +extern int window_scroll_margin (struct window *, enum margin_unit); extern void temp_output_buffer_show (Lisp_Object); extern void replace_buffer_in_windows (Lisp_Object); extern void replace_buffer_in_windows_safely (Lisp_Object); diff --git a/src/xdisp.c b/src/xdisp.c index 33661c882cd..8a450b7a8a4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15316,7 +15316,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, bool temp_scroll_step, bool last_line_misfit) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (w->frame); struct text_pos pos, startp; struct it it; int this_scroll_margin, scroll_max, rc, height; @@ -15327,8 +15326,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* We will never try scrolling more than this number of lines. */ int scroll_limit = SCROLL_LIMIT; int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; #ifdef GLYPH_DEBUG debug_method_add (w, "try_scrolling"); @@ -15336,13 +15333,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, SET_TEXT_POS_FROM_MARKER (startp, w->start); - /* Compute scroll margin height in pixels. We scroll when point is - within this distance from the top or bottom of the window. */ - if (scroll_margin > 0) - this_scroll_margin = min (scroll_margin, window_total_lines / 4) - * frame_line_height; - else - this_scroll_margin = 0; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); /* Force arg_scroll_conservatively to have a reasonable value, to avoid scrolling too far away with slow move_it_* functions. Note @@ -15816,23 +15807,12 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, { int this_scroll_margin, top_scroll_margin; struct glyph_row *row = NULL; - int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; #ifdef GLYPH_DEBUG debug_method_add (w, "cursor movement"); #endif - /* Scroll if point within this distance from the top or bottom - of the window. This is a pixel value. */ - if (scroll_margin > 0) - { - this_scroll_margin = min (scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; - } - else - this_scroll_margin = 0; + this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); top_scroll_margin = this_scroll_margin; if (WINDOW_WANTS_HEADER_LINE_P (w)) @@ -16280,7 +16260,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) int centering_position = -1; bool last_line_misfit = false; ptrdiff_t beg_unchanged, end_unchanged; - int frame_line_height; + int frame_line_height, margin; bool use_desired_matrix; void *itdata = NULL; @@ -16310,6 +16290,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) restart: reconsider_clip_changes (w); frame_line_height = default_line_pixel_height (w); + margin = window_scroll_margin (w, MARGIN_IN_LINES); + /* Has the mode line to be updated? */ update_mode_line = (w->update_mode_line @@ -16614,10 +16596,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* Some people insist on not letting point enter the scroll margin, even though this part handles windows that didn't scroll at all. */ - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin = min (scroll_margin, window_total_lines / 4); - int pixel_margin = margin * frame_line_height; + int pixel_margin = margin * frame_line_height; bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop @@ -16901,12 +16880,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) it.current_y = it.last_visible_y; if (centering_position < 0) { - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin - = scroll_margin > 0 - ? min (scroll_margin, window_total_lines / 4) - : 0; ptrdiff_t margin_pos = CHARPOS (startp); Lisp_Object aggressive; bool scrolling_up; @@ -17150,10 +17123,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) { int window_total_lines = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - int margin = - scroll_margin > 0 - ? min (scroll_margin, window_total_lines / 4) - : 0; bool move_down = w->cursor.vpos >= window_total_lines / 2; move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1)); @@ -17359,7 +17328,6 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) struct it it; struct glyph_row *last_text_row = NULL; struct frame *f = XFRAME (w->frame); - int frame_line_height = default_line_pixel_height (w); /* Make POS the new window start. */ set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); @@ -17385,17 +17353,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) if ((flags & TRY_WINDOW_CHECK_MARGINS) && !MINI_WINDOW_P (w)) { - int this_scroll_margin; - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; - - if (scroll_margin > 0) - { - this_scroll_margin = min (scroll_margin, window_total_lines / 4); - this_scroll_margin *= frame_line_height; - } - else - this_scroll_margin = 0; + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); if ((w->cursor.y >= 0 /* not vscrolled */ && w->cursor.y < this_scroll_margin @@ -18679,15 +18637,8 @@ try_window_id (struct window *w) /* Don't let the cursor end in the scroll margins. */ { - int this_scroll_margin, cursor_height; - int frame_line_height = default_line_pixel_height (w); - int window_total_lines - = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (it.f) / frame_line_height; - - this_scroll_margin = - max (0, min (scroll_margin, window_total_lines / 4)); - this_scroll_margin *= frame_line_height; - cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; + int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); + int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; if ((w->cursor.y < this_scroll_margin && CHARPOS (start) > BEGV) From c92fc7a2156a5939439b7236452d4dfcfc13cc89 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 28 Aug 2016 17:23:04 -0400 Subject: [PATCH 42/62] Don't count mode line for scroll-margin limit * src/window.c (window_scroll_margin): Use window_box_height to avoid counting header line, scrollbars for scroll-margin limit (Bug #5718). --- src/window.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/window.c b/src/window.c index 1c83d989aa8..235c3c1ade8 100644 --- a/src/window.c +++ b/src/window.c @@ -4800,10 +4800,8 @@ window_scroll_margin (struct window *window, enum margin_unit unit) if (scroll_margin > 0) { int frame_line_height = default_line_pixel_height (window); - int window_total_lines - = window->total_lines * WINDOW_FRAME_LINE_HEIGHT (window) - / frame_line_height; - int margin = min (scroll_margin, window_total_lines / 4); + int window_lines = window_box_height (window) / frame_line_height; + int margin = min (scroll_margin, window_lines / 4); if (unit == MARGIN_IN_PIXELS) return margin * frame_line_height; else From e27a91cddc1a66c25e09d3929c5625637ec34a49 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 11 Sep 2016 11:09:57 -0400 Subject: [PATCH 43/62] Make limit on scroll-margin variable * src/xdisp.c (maximum-scroll-margin): New variable. * lisp/cus-start.el: Make it customizable. * etc/NEWS: Mention it. * doc/emacs/display.texi (Auto Scrolling): * doc/lispref/windows.texi (Textual Scrolling): Document it. * src/window.c (window_scroll_pixel_based): Use it instead of hardcoding division by 4 (Bug #5718). --- doc/emacs/display.texi | 12 ++++++++---- doc/lispref/windows.texi | 15 +++++++++++++++ etc/NEWS | 5 +++++ lisp/cus-start.el | 1 + src/window.c | 19 ++++++++++++++----- src/xdisp.c | 8 ++++++++ 6 files changed, 51 insertions(+), 9 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index c6e990d9082..15c700892bc 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -285,13 +285,17 @@ multiple variables, the order of priority is: @code{scroll-up-aggressively} / @code{scroll-down-aggressively}. @vindex scroll-margin +@vindex maximum-scroll-margin The variable @code{scroll-margin} restricts how close point can come to the top or bottom of a window (even if aggressive scrolling specifies a fraction @var{f} that is larger than the window portion -between the top and the bottom margins). Its value is a number of screen -lines; if point comes within that many lines of the top or bottom of -the window, Emacs performs automatic scrolling. By default, -@code{scroll-margin} is 0. +between the top and the bottom margins). Its value is a number of +screen lines; if point comes within that many lines of the top or +bottom of the window, Emacs performs automatic scrolling. By default, +@code{scroll-margin} is 0. The effective margin size is limited to a +quarter of the window height by default, but this limit can be +increased up to half (or decreased down to zero) by customizing +@code{maximum-scroll-margin}. @node Horizontal Scrolling @section Horizontal Scrolling diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 6f3de0c8a0e..affa28c9202 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3924,6 +3924,21 @@ redisplay scrolls the text automatically (if possible) to move point out of the margin, closer to the center of the window. @end defopt +@defopt maximum-scroll-margin +This variable limits the effective value of @code{scroll-margin} to a +fraction of the current window line height. For example, if the +current window has 20 lines and @code{maximum-scroll-margin} is 0.1, +then the scroll margins will never be larger than 2 lines, no matter +how big @code{scroll-margin} is. + +@code{maximum-scroll-margin} itself has a maximum value of 0.5, which +allows setting margins large to keep the cursor at the middle line of +the window (or two middle lines if the window has an even number of +lines). If it's set to a larger value (or any value other than a +float between 0.0 and 0.5) then the default value of 0.25 will be used +instead. +@end defopt + @defopt scroll-conservatively This variable controls how scrolling is done automatically when point moves off the screen (or into the scroll margin). If the value is a diff --git a/etc/NEWS b/etc/NEWS index ddd40fa8535..617f39f9b4c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -307,6 +307,11 @@ local part of a remote file name. Thus, if you have a directory named "/~" on the remote host "foo", you can prevent it from being substituted by a home directory by writing it as "/foo:/:/~/file". ++++ +** The new variable 'maximum-scroll-margin' allows having effective +settings of 'scroll-margin' up to half the window size, instead of +always restricting the margin to a quarter of the window. + * Editing Changes in Emacs 26.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a790419b86f..51c43c7d21a 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -511,6 +511,7 @@ since it could result in memory overflow and make Emacs crash." (scroll-step windows integer) (scroll-conservatively windows integer) (scroll-margin windows integer) + (maximum-scroll-margin windows float "26.1") (hscroll-margin windows integer "22.1") (hscroll-step windows number "22.1") (truncate-partial-width-windows diff --git a/src/window.c b/src/window.c index 235c3c1ade8..ba03780f3df 100644 --- a/src/window.c +++ b/src/window.c @@ -4801,11 +4801,20 @@ window_scroll_margin (struct window *window, enum margin_unit unit) { int frame_line_height = default_line_pixel_height (window); int window_lines = window_box_height (window) / frame_line_height; - int margin = min (scroll_margin, window_lines / 4); - if (unit == MARGIN_IN_PIXELS) - return margin * frame_line_height; - else - return margin; + + double ratio = 0.25; + if (FLOATP (Vmaximum_scroll_margin)) + { + ratio = XFLOAT_DATA (Vmaximum_scroll_margin); + ratio = max (0.0, ratio); + ratio = min (ratio, 0.5); + } + int max_margin = min ((window_lines - 1)/2, + (int) (window_lines * ratio)); + int margin = clip_to_bounds (0, scroll_margin, max_margin); + return (unit == MARGIN_IN_PIXELS) + ? margin * frame_line_height + : margin; } else return 0; diff --git a/src/xdisp.c b/src/xdisp.c index 8a450b7a8a4..134ef6c6196 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -31520,6 +31520,14 @@ Recenter the window whenever point gets within this many lines of the top or bottom of the window. */); scroll_margin = 0; + DEFVAR_LISP ("maximum-scroll-margin", Vmaximum_scroll_margin, + doc: /* Maximum effective value of `scroll-margin'. +Given as a fraction of the current window's lines. The value should +be a floating point number between 0.0 and 0.5. The effective maximum +is limited to (/ (1- window-lines) 2). Non-float values for this +variable are ignored and the default 0.25 is used instead. */); + Vmaximum_scroll_margin = make_float (0.25); + DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch, doc: /* Pixels per inch value for non-window system displays. Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); From b9be4c14e89f5cec08a7a0f0d24033e0e6ff5ef0 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 21 Jan 2017 13:24:47 -0500 Subject: [PATCH 44/62] Fix scrolling with partial lines * src/xdisp.c (partial_line_height): New function. (try_scrolling): * src/window.c (window_scroll_pixel_based): Use it for calculating the pixel scroll margin correctly in a window with partial lines. --- src/dispextern.h | 1 + src/window.c | 2 +- src/xdisp.c | 29 ++++++++++++++++++++++++++++- 3 files changed, 30 insertions(+), 2 deletions(-) diff --git a/src/dispextern.h b/src/dispextern.h index 51222e636be..eb71a82311c 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3263,6 +3263,7 @@ void move_it_past_eol (struct it *); void move_it_in_display_line (struct it *it, ptrdiff_t to_charpos, int to_x, enum move_operation_enum op); +int partial_line_height (struct it *it_origin); bool in_display_vector_p (struct it *); int frame_mode_line_height (struct frame *); extern bool redisplaying_p; diff --git a/src/window.c b/src/window.c index ba03780f3df..95690443f8e 100644 --- a/src/window.c +++ b/src/window.c @@ -5147,7 +5147,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) in the scroll margin at the bottom. */ move_it_to (&it, PT, -1, (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) - - this_scroll_margin - 1), + - partial_line_height (&it) - this_scroll_margin - 1), -1, MOVE_TO_POS | MOVE_TO_Y); diff --git a/src/xdisp.c b/src/xdisp.c index 134ef6c6196..0e329dfe6e9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9859,6 +9859,32 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos) } } +int +partial_line_height (struct it *it_origin) +{ + int partial_height; + void *it_data = NULL; + struct it it; + SAVE_IT (it, *it_origin, it_data); + move_it_to (&it, ZV, -1, it.last_visible_y, -1, + MOVE_TO_POS | MOVE_TO_Y); + if (it.what == IT_EOB) + { + int vis_height = it.last_visible_y - it.current_y; + int height = it.ascent + it.descent; + partial_height = (vis_height < height) ? vis_height : 0; + } + else + { + int last_line_y = it.current_y; + move_it_by_lines (&it, 1); + partial_height = (it.current_y > it.last_visible_y) + ? it.last_visible_y - last_line_y : 0; + } + RESTORE_IT (&it, &it, it_data); + return partial_height; +} + /* Return true if IT points into the middle of a display vector. */ bool @@ -15368,7 +15394,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p, /* Compute the pixel ypos of the scroll margin, then move IT to either that ypos or PT, whichever comes first. */ start_display (&it, w, startp); - scroll_margin_y = it.last_visible_y - this_scroll_margin + scroll_margin_y = it.last_visible_y - partial_line_height (&it) + - this_scroll_margin - frame_line_height * extra_scroll_margin_lines; move_it_to (&it, PT, -1, scroll_margin_y - 1, -1, (MOVE_TO_POS | MOVE_TO_Y)); From da515a0d8e97d89a1c7e60faea190174a8c72618 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 28 Jan 2017 16:54:33 -0500 Subject: [PATCH 45/62] Add tests for scrolling * test/manual/scroll-tests.el: New tests for scroll-margin behavior. --- test/manual/scroll-tests.el | 130 ++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 test/manual/scroll-tests.el diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el new file mode 100644 index 00000000000..1167efd6a66 --- /dev/null +++ b/test/manual/scroll-tests.el @@ -0,0 +1,130 @@ +;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; These are mostly automated ert tests, but they don't work in batch +;; mode which is why they are under test/manual. + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(defun scroll-tests-up-and-down (margin &optional effective-margin) + (unless effective-margin + (setq effective-margin margin)) + (erase-buffer) + (insert (mapconcat #'number-to-string + (number-sequence 1 200) "\n")) + (goto-char 1) + (sit-for 0) + (let ((scroll-margin margin) + (wstart (window-start))) + ;; Stopping before `scroll-margin' so we shouldn't have + ;; scrolled. + (let ((current-prefix-arg (- (window-text-height) 1 effective-margin))) + (call-interactively 'next-line)) + (sit-for 0) + (should (= wstart (window-start))) + ;; Passing `scroll-margin' should trigger scrolling. + (call-interactively 'next-line) + (sit-for 0) + (should (/= wstart (window-start))) + ;; Scroll back to top. + (let ((current-prefix-arg (window-start))) + (call-interactively 'scroll-down-command)) + (sit-for 0) + (should (= 1 (window-start))))) + +(defmacro scroll-tests-with-buffer-window (&rest body) + (declare (debug t)) + `(with-temp-buffer + (with-selected-window (display-buffer (current-buffer)) + ,@body))) + +(ert-deftest scroll-tests-scroll-margin-0 () + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (scroll-tests-up-and-down 0))) + +(ert-deftest scroll-tests-scroll-margin-negative () + "A negative `scroll-margin' should be the same as 0." + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (scroll-tests-up-and-down -10 0))) + +(ert-deftest scroll-tests-scroll-margin-max () + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (let ((max-margin (/ (window-text-height) 4))) + (scroll-tests-up-and-down max-margin)))) + +(ert-deftest scroll-tests-scroll-margin-over-max () + "A `scroll-margin' more than max should be the same as max." + (skip-unless (not noninteractive)) + (scroll-tests-with-buffer-window + (set-window-text-height nil 7) + (let ((max-margin (/ (window-text-height) 4))) + (scroll-tests-up-and-down (+ max-margin 1) max-margin) + (scroll-tests-up-and-down (+ max-margin 2) max-margin)))) + +(defun scroll-tests--point-in-middle-of-window-p () + (= (count-lines (window-start) (window-point)) + (/ (1- (window-text-height)) 2))) + +(cl-defun scroll-tests--scroll-margin-whole-window (&key with-line-spacing) + "Test `maximum-scroll-margin' at 0.5. +With a high `scroll-margin', this should keep cursor in the +middle of the window." + (let ((maximum-scroll-margin 0.5) + (scroll-margin 100)) + (scroll-tests-with-buffer-window + (setq-local line-spacing with-line-spacing) + ;; Choose an odd number, so there is one line in the middle. + (set-window-text-height nil 7) + ;; `set-window-text-height' doesn't count `line-spacing'. + (when with-line-spacing + (window-resize nil (* line-spacing 7) nil nil 'pixels)) + (erase-buffer) + (insert (mapconcat #'number-to-string + (number-sequence 1 200) "\n")) + (goto-char 1) + (sit-for 0) + (call-interactively 'scroll-up-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p)) + (call-interactively 'scroll-up-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p)) + (call-interactively 'scroll-down-command) + (sit-for 0) + (should (scroll-tests--point-in-middle-of-window-p))))) + +(ert-deftest scroll-tests-scroll-margin-whole-window () + (skip-unless (not noninteractive)) + (scroll-tests--scroll-margin-whole-window)) + +(ert-deftest scroll-tests-scroll-margin-whole-window-line-spacing () + ;; `line-spacing' has no effect on tty displays. + (skip-unless (display-graphic-p)) + (scroll-tests--scroll-margin-whole-window :with-line-spacing 3)) + + +;;; scroll-tests.el ends here From e080d019f41d2738ba0db721c1b89ea57413439b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 2 Feb 2017 21:28:45 -0800 Subject: [PATCH 46/62] Re-port alloc.c to Solaris sparc and simplify alloc.c had bitrotted a bit, and used an undefined symbol stack_base when Emacs was built on Solaris sparc, leading to compilation failures. Also, code related to __builtin_unwind_init was unnecessarily duplicated. Fix the bitrot and remove some duplication. * src/alloc.c: Remove uses of GC_SAVE_REGISTERS_ON_STACK, since it is never defined. (test_setjmp) [!HAVE___BUILTIN_UNWIND_INIT && GC_SETJMP_WORKS]: Define a no-op dummy, to simplify use. (test_setjmp) [!GC_SETJMP_WORKS]: Test setjmp_tested_p here rather than in the caller, to simplify use. (stacktop_sentry): New type. (__builtin_unwind_init) [!HAVE___BUILTIN_UNWIND_INIT]: New macro. (SET_STACK_TOP_ADDRESS): New macro, containing code that was duplicated. (flush_stack_call_func, Fgarbage_collect): Use it. (init_alloc): Omit unnecessary initialization. After dumping, Emacs need not re-test setjmp. --- src/alloc.c | 189 +++++++++++++++++++--------------------------------- 1 file changed, 69 insertions(+), 120 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index e909d312c4e..62f43669f2a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4887,12 +4887,19 @@ mark_memory (void *start, void *end) } } -#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS +#ifndef HAVE___BUILTIN_UNWIND_INIT + +# ifdef GC_SETJMP_WORKS +static void +test_setjmp (void) +{ +} +# else static bool setjmp_tested_p; static int longjmps_done; -#define SETJMP_WILL_LIKELY_WORK "\ +# define SETJMP_WILL_LIKELY_WORK "\ \n\ Emacs garbage collector has been changed to use conservative stack\n\ marking. Emacs has determined that the method it uses to do the\n\ @@ -4905,7 +4912,7 @@ verify that the methods used are appropriate for your system.\n\ Please mail the result to .\n\ " -#define SETJMP_WILL_NOT_WORK "\ +# define SETJMP_WILL_NOT_WORK "\ \n\ Emacs garbage collector has been changed to use conservative stack\n\ marking. Emacs has determined that the default method it uses to do the\n\ @@ -4931,6 +4938,9 @@ Please mail the result to .\n\ static void test_setjmp (void) { + if (setjmp_tested_p) + return; + setjmp_tested_p = true; char buf[10]; register int x; sys_jmp_buf jbuf; @@ -4967,9 +4977,60 @@ test_setjmp (void) if (longjmps_done == 1) sys_longjmp (jbuf, 1); } +# endif /* ! GC_SETJMP_WORKS */ +#endif /* ! HAVE___BUILTIN_UNWIND_INIT */ -#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ +/* The type of an object near the stack top, whose address can be used + as a stack scan limit. */ +typedef union +{ + /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT, + jmp_buf may not be aligned enough on darwin-ppc64. */ + max_align_t o; +#ifndef HAVE___BUILTIN_UNWIND_INIT + sys_jmp_buf j; + char c; +#endif +} stacktop_sentry; +/* Force callee-saved registers and register windows onto the stack. + Use the platform-defined __builtin_unwind_init if available, + obviating the need for machine dependent methods. */ +#ifndef HAVE___BUILTIN_UNWIND_INIT +# ifdef __sparc__ + /* This trick flushes the register windows so that all the state of + the process is contained in the stack. + FreeBSD does not have a ta 3 handler, so handle it specially. + FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is + needed on ia64 too. See mach_dep.c, where it also says inline + assembler doesn't work with relevant proprietary compilers. */ +# if defined __sparc64__ && defined __FreeBSD__ +# define __builtin_unwind_init() asm ("flushw") +# else +# define __builtin_unwind_init() asm ("ta 3") +# endif +# else +# define __builtin_unwind_init() ((void) 0) +# endif +#endif + +/* Set *P to the address of the top of the stack. This must be a + macro, not a function, so that it is executed in the caller’s + environment. It is not inside a do-while so that its storage + survives the macro. */ +#ifdef HAVE___BUILTIN_UNWIND_INIT +# define SET_STACK_TOP_ADDRESS(p) \ + stacktop_sentry sentry; \ + __builtin_unwind_init (); \ + *(p) = &sentry +#else +# define SET_STACK_TOP_ADDRESS(p) \ + stacktop_sentry sentry; \ + __builtin_unwind_init (); \ + test_setjmp (); \ + sys_setjmp (sentry.j); \ + *(p) = &sentry + (stack_bottom < &sentry.c) +#endif /* Mark live Lisp objects on the C stack. @@ -4981,12 +5042,7 @@ test_setjmp (void) We have to mark Lisp objects in CPU registers that can hold local variables or are used to pass parameters. - If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to - something that either saves relevant registers on the stack, or - calls mark_maybe_object passing it each register's contents. - - If GC_SAVE_REGISTERS_ON_STACK is not defined, the current - implementation assumes that calling setjmp saves registers we need + This code assumes that calling setjmp saves registers we need to see in a jmp_buf which itself lies on the stack. This doesn't have to be true! It must be verified for each system, possibly by taking a look at the source code of setjmp. @@ -5050,62 +5106,9 @@ flush_stack_call_func (void (*func) (void *arg), void *arg) { void *end; struct thread_state *self = current_thread; - -#ifdef HAVE___BUILTIN_UNWIND_INIT - /* Force callee-saved registers and register windows onto the stack. - This is the preferred method if available, obviating the need for - machine dependent methods. */ - __builtin_unwind_init (); - end = &end; -#else /* not HAVE___BUILTIN_UNWIND_INIT */ -#ifndef GC_SAVE_REGISTERS_ON_STACK - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - sys_jmp_buf j; - } j; - volatile bool stack_grows_down_p = (char *) &j > (char *) stack_bottom; -#endif - /* This trick flushes the register windows so that all the state of - the process is contained in the stack. */ - /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is - needed on ia64 too. See mach_dep.c, where it also says inline - assembler doesn't work with relevant proprietary compilers. */ -#ifdef __sparc__ -#if defined (__sparc64__) && defined (__FreeBSD__) - /* FreeBSD does not have a ta 3 handler. */ - asm ("flushw"); -#else - asm ("ta 3"); -#endif -#endif - - /* Save registers that we need to see on the stack. We need to see - registers used to hold register variables and registers used to - pass parameters. */ -#ifdef GC_SAVE_REGISTERS_ON_STACK - GC_SAVE_REGISTERS_ON_STACK (end); -#else /* not GC_SAVE_REGISTERS_ON_STACK */ - -#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that - setjmp will definitely work, test it - and print a message with the result - of the test. */ - if (!setjmp_tested_p) - { - setjmp_tested_p = 1; - test_setjmp (); - } -#endif /* GC_SETJMP_WORKS */ - - sys_setjmp (j.j); - end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; -#endif /* not GC_SAVE_REGISTERS_ON_STACK */ -#endif /* not HAVE___BUILTIN_UNWIND_INIT */ - + SET_STACK_TOP_ADDRESS (&end); self->stack_top = end; - (*func) (arg); - + func (arg); eassert (current_thread == self); } @@ -6047,58 +6050,7 @@ See Info node `(elisp)Garbage Collection'. */) (void) { void *end; - -#ifdef HAVE___BUILTIN_UNWIND_INIT - /* Force callee-saved registers and register windows onto the stack. - This is the preferred method if available, obviating the need for - machine dependent methods. */ - __builtin_unwind_init (); - end = &end; -#else /* not HAVE___BUILTIN_UNWIND_INIT */ -#ifndef GC_SAVE_REGISTERS_ON_STACK - /* jmp_buf may not be aligned enough on darwin-ppc64 */ - union aligned_jmpbuf { - Lisp_Object o; - sys_jmp_buf j; - } j; - volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base; -#endif - /* This trick flushes the register windows so that all the state of - the process is contained in the stack. */ - /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is - needed on ia64 too. See mach_dep.c, where it also says inline - assembler doesn't work with relevant proprietary compilers. */ -#ifdef __sparc__ -#if defined (__sparc64__) && defined (__FreeBSD__) - /* FreeBSD does not have a ta 3 handler. */ - asm ("flushw"); -#else - asm ("ta 3"); -#endif -#endif - - /* Save registers that we need to see on the stack. We need to see - registers used to hold register variables and registers used to - pass parameters. */ -#ifdef GC_SAVE_REGISTERS_ON_STACK - GC_SAVE_REGISTERS_ON_STACK (end); -#else /* not GC_SAVE_REGISTERS_ON_STACK */ - -#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that - setjmp will definitely work, test it - and print a message with the result - of the test. */ - if (!setjmp_tested_p) - { - setjmp_tested_p = 1; - test_setjmp (); - } -#endif /* GC_SETJMP_WORKS */ - - sys_setjmp (j.j); - end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; -#endif /* not GC_SAVE_REGISTERS_ON_STACK */ -#endif /* not HAVE___BUILTIN_UNWIND_INIT */ + SET_STACK_TOP_ADDRESS (&end); return garbage_collect_1 (end); } @@ -7408,9 +7360,6 @@ init_alloc_once (void) void init_alloc (void) { -#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS - setjmp_tested_p = longjmps_done = 0; -#endif Vgc_elapsed = make_float (0.0); gcs_done = 0; From be10c00d3d64d53a7f31441d42f6c5b1f75b9916 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Fri, 3 Feb 2017 21:42:42 -0500 Subject: [PATCH 47/62] Rename to if-let* and when-let* Make the existing if-let and when-let aliases. * lisp/emacs-lisp/subr-x.el (if-let*, when-let*): New macros. Rewrite docstrings, incorporating that from let* and the existing if-let. (if-let, when-let, and-let*): Alias them. --- etc/NEWS | 4 ++++ lisp/emacs-lisp/subr-x.el | 36 ++++++++++++++++++++++++------------ 2 files changed, 28 insertions(+), 12 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 617f39f9b4c..930e1c893b4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -885,6 +885,10 @@ collection). +++ ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. +--- +** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. +The incumbent 'if-let' and 'when-let' are now aliases. + +++ ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 52331b9ad36..f7a846927c0 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -115,12 +115,16 @@ threading." binding)) bindings))) -(defmacro if-let (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro if-let* (bindings then &rest else) + "Bind variables according to VARLIST and eval THEN or ELSE. +Each binding is evaluated in turn with `let*', and evaluation +stops if a binding value is nil. If all are non-nil, the value +of THEN is returned, or the last form in ELSE is returned. +Each element of VARLIST is a symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST THEN ELSE...)" (declare (indent 2) (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) (when (and (<= (length bindings) 2) @@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple." ,then ,@else))) -(defmacro when-let (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro when-let* (bindings &rest body) + "Bind variables according to VARLIST and conditionally eval BODY. +Each binding is evaluated in turn with `let*', and evaluation +stops if a binding value is nil. If all are non-nil, the value +of the last form in BODY is returned. +Each element of VARLIST is a symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST BODY...)" (declare (indent 1) (debug if-let)) (list 'if-let bindings (macroexp-progn body))) +(defalias 'if-let 'if-let*) +(defalias 'when-let 'when-let*) +(defalias 'and-let* 'when-let*) + (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." (zerop (hash-table-count hash-table))) From 6db5582479bdf6b7b090c5b450534999ef284aa8 Mon Sep 17 00:00:00 2001 From: Richard Stallman Date: Sat, 4 Feb 2017 11:16:55 +0200 Subject: [PATCH 48/62] New defcustom 'save-some-buffers-default-predicate' * lisp/files.el (save-some-buffers-default-predicate): New defcustom. (save-some-buffers): Use it when PRED is nil or omitted. --- etc/NEWS | 5 +++++ lisp/files.el | 12 ++++++++++++ 2 files changed, 17 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 930e1c893b4..25e1d6e8369 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -758,6 +758,11 @@ instead. * Lisp Changes in Emacs 26.1 +** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' +to decide which buffers to ask about, if the PRED argument is nil. +The default value of 'save-some-buffers-default-predicate' is nil, +which means ask about all file-visiting buffers. + ** string-(to|as|make)-(uni|multi)byte are now declared obsolete. ** New variable 'while-no-input-ignore-events' which allow setting which special events 'while-no-input' should ignore. diff --git a/lisp/files.el b/lisp/files.el index 25392fdcc71..2833ec5c124 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5134,6 +5134,13 @@ Before and after saving the buffer, this function runs "Non-nil means `save-some-buffers' should save this buffer without asking.") (make-variable-buffer-local 'buffer-save-without-query) +(defcustom save-some-buffers-default-predicate nil + "Default predicate for `save-some-buffers'. +This allows you to stop `save-some-buffers' from asking +about certain files that you'd usually rather not save." + :group 'auto-save + :type 'function) + (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. You can answer `y' to save, `n' not to save, `C-r' to look at the @@ -5149,10 +5156,13 @@ If PRED is nil, all the file-visiting buffers are considered. If PRED is t, then certain non-file buffers will also be considered. If PRED is a zero-argument function, it indicates for each buffer whether to consider it or not when called with that buffer current. +PRED defaults to the value of `save-some-buffers-default-predicate'. See `save-some-buffers-action-alist' if you want to change the additional actions you can take on files." (interactive "P") + (unless pred + (setq pred save-some-buffers-default-predicate)) (save-window-excursion (let* (queried autosaved-buffers files-done abbrevs-done) @@ -6812,6 +6822,8 @@ asks whether processes should be killed. Runs the members of `kill-emacs-query-functions' in turn and stops if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (interactive "P") + ;; Don't use save-some-buffers-default-predicate, because we want + ;; to ask about all the buffers before killing Emacs. (save-some-buffers arg t) (let ((confirm confirm-kill-emacs)) (and From 12a79dc3cea50435bbd331dc5ec4c12816f1c1b5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 11:33:54 +0200 Subject: [PATCH 49/62] Document 'save-some-buffers-default-predicate' * doc/lispref/files.texi (Saving Buffers): * doc/emacs/files.texi (Save Commands): Document save-some-buffers-default-predicate. --- doc/emacs/files.texi | 6 ++++++ doc/lispref/files.texi | 24 ++++++++++++++---------- etc/NEWS | 1 + 3 files changed, 21 insertions(+), 10 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 5c582e571e2..2b09c69945c 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -417,6 +417,12 @@ changes you would be saving. This calls the command Display a help message about these options. @end table +@noindent +@vindex save-some-buffers-default-predicate +You can customize the value of +@code{save-some-buffers-default-predicate} to control which buffers +Emacs will ask about. + @kbd{C-x C-c}, the key sequence to exit Emacs, invokes @code{save-some-buffers} and therefore asks the same questions. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 853e84477e2..ef373211415 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -368,17 +368,21 @@ asks the user about each buffer. But if @var{save-silently-p} is non-@code{nil}, it saves all the file-visiting buffers without querying the user. -The optional @var{pred} argument controls which buffers to ask about -(or to save silently if @var{save-silently-p} is non-@code{nil}). -If it is @code{nil}, that means to ask only about file-visiting buffers. -If it is @code{t}, that means also offer to save certain other non-file -buffers---those that have a non-@code{nil} buffer-local value of -@code{buffer-offer-save} (@pxref{Killing Buffers}). A user who says -@samp{yes} to saving a non-file buffer is asked to specify the file -name to use. The @code{save-buffers-kill-emacs} function passes the -value @code{t} for @var{pred}. +@vindex save-some-buffers-default-predicate +The optional @var{pred} argument provides a predicate that controls +which buffers to ask about (or to save silently if +@var{save-silently-p} is non-@code{nil}). If @var{pred} is +@code{nil}, that means to use the value of +@code{save-some-buffers-default-predicate} instead of @var{pred}. If +the result is @code{nil}, it means ask only about file-visiting +buffers. If it is @code{t}, that means also offer to save certain +other non-file buffers---those that have a non-@code{nil} buffer-local +value of @code{buffer-offer-save} (@pxref{Killing Buffers}). A user +who says @samp{yes} to saving a non-file buffer is asked to specify +the file name to use. The @code{save-buffers-kill-emacs} function +passes the value @code{t} for @var{pred}. -If @var{pred} is neither @code{t} nor @code{nil}, then it should be +If the predicate is neither @code{t} nor @code{nil}, then it should be a function of no arguments. It will be called in each buffer to decide whether to offer to save that buffer. If it returns a non-@code{nil} value in a certain buffer, that means do offer to save that buffer. diff --git a/etc/NEWS b/etc/NEWS index 25e1d6e8369..270f8803d53 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -758,6 +758,7 @@ instead. * Lisp Changes in Emacs 26.1 ++++ ** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' to decide which buffers to ask about, if the PRED argument is nil. The default value of 'save-some-buffers-default-predicate' is nil, From 331eb6c915a4a12a3a1034615f68cd4dc4bd7e32 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 11:43:50 +0200 Subject: [PATCH 50/62] Add tests for lisp/emacs-lisp/testcover.el * test/lisp/emacs-lisp/testcover-tests.el: New file. * test/lisp/emacs-lisp/testcover-resources/testcases.el: New file. Co-authored-by: Noam Postavsky --- .../testcover-resources/testcases.el | 493 ++++++++++++++++++ test/lisp/emacs-lisp/testcover-tests.el | 186 +++++++ 2 files changed, 679 insertions(+) create mode 100644 test/lisp/emacs-lisp/testcover-resources/testcases.el create mode 100644 test/lisp/emacs-lisp/testcover-tests.el diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el new file mode 100644 index 00000000000..1eb791a993c --- /dev/null +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -0,0 +1,493 @@ +;;;; testcases.el -- Test cases for testcover-tests.el + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; * This file should not be loaded directly. It is meant to be read +;; by `testcover-tests-build-test-cases'. +;; +;; * Test cases begin with ;; ==== name ====. The symbol name between +;; the ===='s is used to create the name of the test. +;; +;; * Following the beginning comment place the test docstring and +;; any tags or keywords for ERT. These will be spliced into the +;; ert-deftest for the test. +;; +;; * To separate the above from the test case code, use another +;; comment: ;; ==== +;; +;; * These special comments should start at the beginning of a line. +;; +;; * `testcover-tests-skeleton' will prompt you for a test name and +;; insert the special comments. +;; +;; * The test case code should be annotated with %%% at the end of +;; each form where a tan splotch is expected, and !!! at the end +;; of each form where a red mark is expected. +;; +;; * If Testcover is working correctly on your code sample, using +;; `testcover-tests-markup-region' and +;; `testcover-tests-unmarkup-region' can make creating test cases +;; easier. + +;;; Code: +;;; Test Cases: + +;; ==== constants-bug-25316 ==== +"Testcover doesn't splotch constants." +:expected-result :failed +;; ==== +(defconst testcover-testcase-const "apples") +(defun testcover-testcase-zero () 0) +(defun testcover-testcase-list-consts () + (list + emacs-version 10 + "hello" + `(a b c ,testcover-testcase-const) + '(1 2 3) + testcover-testcase-const + (testcover-testcase-zero) + nil)) + +(defun testcover-testcase-add-to-const-list (arg) + (cons arg%%% (testcover-testcase-list-consts))%%%) + +(should (equal (testcover-testcase-add-to-const-list 'a) + `(a ,emacs-version 10 "hello" (a b c "apples") (1 2 3) + "apples" 0 nil))) + +;; ==== customize-defcustom-bug-25326 ==== +"Testcover doesn't prevent testing of defcustom values." +:expected-result :failed +;; ==== +(defgroup testcover-testcase nil + "Test case for testcover" + :group 'lisp + :prefix "testcover-testcase-" + :version "26.0") +(defcustom testcover-testcase-flag t + "Test value used by testcover-tests.el" + :type 'boolean + :group 'testcover-testcase) +(defun testcover-testcase-get-flag () + testcover-testcase-flag) + +(testcover-testcase-get-flag) +(setq testcover-testcase-flag (not testcover-testcase-flag)) +(testcover-testcase-get-flag) + +;; ==== no-returns ==== +"Testcover doesn't splotch functions which don't return." +;; ==== +(defun testcover-testcase-play-ball (retval) + (catch 'ball + (throw 'ball retval%%%))%%%) ; catch gets marked but not throw + +(defun testcover-testcase-not-my-favorite-error-message () + (signal 'wrong-type-argument (list 'consp nil))) + +(should (testcover-testcase-play-ball t)) +(condition-case nil + (testcover-testcase-not-my-favorite-error-message) + (error nil)) + +;; ==== noreturn-symbol ==== +"Wrapping a form with noreturn prevents splotching." +;; ==== +(defun testcover-testcase-cancel (spacecraft) + (error "no destination for %s" spacecraft)) +(defun testcover-testcase-launch (spacecraft planet) + (if (null planet) + (noreturn (testcover-testcase-cancel spacecraft%%%)) + (list spacecraft%%% planet%%%)%%%)%%%) +(defun testcover-testcase-launch-2 (spacecraft planet) + (if (null planet%%%)%%% + (testcover-testcase-cancel spacecraft%%%)!!! + (list spacecraft!!! planet!!!)!!!)!!!) +(should (equal (testcover-testcase-launch "Curiosity" "Mars") '("Curiosity" "Mars"))) +(condition-case err + (testcover-testcase-launch "Voyager" nil) + (error err)) +(condition-case err + (testcover-testcase-launch-2 "Voyager II" nil) + (error err)) + +(should-error (testcover-testcase-launch "Voyager" nil)) +(should-error (testcover-testcase-launch-2 "Voyager II" nil)) + +;; ==== 1-value-symbol-bug-25316 ==== +"Wrapping a form with 1value prevents splotching." +:expected-result :failed +;; ==== +(defun testcover-testcase-always-zero (num) + (- num%%% num%%%)%%%) +(defun testcover-testcase-still-always-zero (num) + (1value (- num%%% num%%% (- num%%% num%%%)%%%))) +(defun testcover-testcase-never-called (num) + (1value (/ num!!! num!!!)!!!)!!!) +(should (eql 0 (testcover-testcase-always-zero 3))) +(should (eql 0 (testcover-testcase-still-always-zero 5))) + +;; ==== dotimes-dolist ==== +"Dolist and dotimes with a 1valued return value are 1valued." +;; ==== +(defun testcover-testcase-do-over (things) + (dolist (thing things%%%) + (list thing)) + (dolist (thing things%%% 42) + (list thing)) + (dolist (thing things%%% things%%%) + (list thing))%%%) +(defun testcover-testcase-do-more (count) + (dotimes (num count%%%) + (+ num num)) + (dotimes (num count%%% count%%%) + (+ num num))%%% + (dotimes (num count%%% 0) + (+ num num))) +(should (equal '(a b c) (testcover-testcase-do-over '(a b c)))) +(should (eql 0 (testcover-testcase-do-more 2))) + +;; ==== let-last-form ==== +"A let form is 1valued if its last form is 1valued." +;; ==== +(defun testcover-testcase-double (num) + (let ((double (* num%%% 2)%%%)) + double%%%)%%%) +(defun testcover-testcase-nullbody-let (num) + (let* ((square (* num%%% num%%%)%%%) + (double (* 2 num%%%)%%%)))) +(defun testcover-testcase-answer () + (let ((num 100)) + 42)) +(should-not (testcover-testcase-nullbody-let 3)) +(should (eql (testcover-testcase-answer) 42)) +(should (eql (testcover-testcase-double 10) 20)) + +;; ==== if-with-1value-clauses ==== +"An if is 1valued if both then and else are 1valued." +;; ==== +(defun testcover-testcase-describe (val) + (if (zerop val%%%)%%% + "a number" + "a different number")) +(defun testcover-testcase-describe-2 (val) + (if (zerop val) + "zero" + "not zero")) +(defun testcover-testcase-describe-3 (val) + (if (zerop val%%%)%%% + "zero" + (format "%d" val%%%)%%%)%%%) +(should (equal (testcover-testcase-describe 0) "a number")) +(should (equal (testcover-testcase-describe-2 0) "zero")) +(should (equal (testcover-testcase-describe-2 1) "not zero")) +(should (equal (testcover-testcase-describe-3 1) "1")) + +;; ==== cond-with-1value-clauses ==== +"A cond form is marked 1valued if all clauses are 1valued." +;; ==== +(defun testcover-testcase-cond (num) + (cond + ((eql num%%% 0)%%% 'a) + ((eql num%%% 1)%%% 'b) + ((eql num!!! 2)!!! 'c))) +(defun testcover-testcase-cond-2 (num) + (cond + ((eql num%%% 0)%%% (cons 'a 0)!!!) + ((eql num%%% 1)%%% 'b))%%%) +(should (eql (testcover-testcase-cond 1) 'b)) +(should (eql (testcover-testcase-cond-2 1) 'b)) + +;; ==== condition-case-with-1value-components ==== +"A condition-case is marked 1valued if its body and handlers are." +;; ==== +(defun testcover-testcase-cc (arg) + (condition-case nil + (if (null arg%%%)%%% + (error "foo") + "0")!!! + (error nil))) +(should-not (testcover-testcase-cc nil)) + +;; ==== quotes-within-backquotes-bug-25316 ==== +"Forms to instrument are found within quotes within backquotes." +:expected-result :failed +;; ==== +(defun testcover-testcase-make-list () + (list 'defun 'defvar)) +(defmacro testcover-testcase-bq-macro (arg) + (declare (debug t)) + `(memq ,arg%%% '(defconst ,@(testcover-testcase-make-list)))%%%) +(defun testcover-testcase-use-bq-macro (arg) + (testcover-testcase-bq-macro arg%%%)%%%) +(should (equal '(defun defvar) (testcover-testcase-use-bq-macro 'defun))) + +;; ==== progn-functions ==== +"Some forms are 1value if their last argument is 1value." +;; ==== +(defun testcover-testcase-one (arg) + (progn + (setq arg (1- arg%%%)%%%)%%%)%%% + (progn + (setq arg (1+ arg%%%)%%%)%%% + 1)) + +(should (eql 1 (testcover-testcase-one 0))) +;; ==== prog1-functions ==== +"Some forms are 1value if their first argument is 1value." +;; ==== +(defun testcover-testcase-unwinder (arg) + (unwind-protect + (if ( > arg%%% 0)%%% + 1 + 0) + (format "unwinding %s!" arg%%%)%%%)) +(defun testcover-testcase-divider (arg) + (unwind-protect + (/ 100 arg%%%)%%% + (format "unwinding! %s" arg%%%)%%%)%%%) + +(should (eq 0 (testcover-testcase-unwinder 0))) +(should (eq 1 (testcover-testcase-divider 100))) + +;; ==== compose-functions ==== +"Some functions are 1value if all their arguments are 1value." +;; ==== +(defconst testcover-testcase-count 3) +(defun testcover-testcase-number () + (+ 1 testcover-testcase-count)) +(defun testcover-testcase-more () + (+ 1 (testcover-testcase-number) testcover-testcase-count)) + +(should (equal (testcover-testcase-more) 8)) + +;; ==== apply-quoted-symbol ==== +"Apply with a quoted function symbol treated as 1value if function is." +;; ==== +(defun testcover-testcase-numlist (flag) + (if flag%%% + '(1 2 3) + '(4 5 6))) +(defun testcover-testcase-sum (flag) + (apply '+ (testcover-testcase-numlist flag%%%))) +(defun testcover-testcase-label () + (apply 'message "edebug uses: %s %s" (list 1 2)!!!)!!!) + +(should (equal 6 (testcover-testcase-sum t))) + +;; ==== backquote-1value-bug-24509 ==== +"Commas within backquotes are recognized as non-1value." +:expected-result :failed +;; ==== +(defmacro testcover-testcase-lambda (&rest body) + `(lambda () ,@body)) + +(defun testcover-testcase-example () + (let ((lambda-1 (testcover-testcase-lambda (format "lambda-%d" 1))%%%) + (lambda-2 (testcover-testcase-lambda (format "lambda-%d" 2))%%%)) + (concat (funcall lambda-1%%%)%%% " " + (funcall lambda-2%%%)%%%)%%%)%%%) + +(defmacro testcover-testcase-message-symbol (name) + `(message "%s" ',name)) + +(defun testcover-testcase-example-2 () + (concat + (testcover-testcase-message-symbol foo)%%% + (testcover-testcase-message-symbol bar)%%%)%%%) + +(should (equal "lambda-1 lambda-2" (testcover-testcase-example))) +(should (equal "foobar" (testcover-testcase-example-2))) + +;; ==== pcase-bug-24688 ==== +"Testcover copes with condition-case within backquoted list." +:expected-result :failed +;; ==== +(defun testcover-testcase-pcase (form) + (pcase form%%% + (`(condition-case ,var ,protected-form . ,handlers) + (list var%%% protected-form%%% handlers%%%)%%%) + (_ nil))%%%) + +(should (equal (testcover-testcase-pcase '(condition-case a + (/ 5 a) + (error 0))) + '(a (/ 5 a) ((error 0))))) + +;; ==== defun-in-backquote-bug-11307-and-24743 ==== +"Testcover handles defun forms within backquoted list." +:expected-result :failed +;; ==== +(defmacro testcover-testcase-defun (name &rest body) + (declare (debug (symbolp def-body))) + `(defun ,name () ,@body)) + +(testcover-testcase-defun foo (+ 1 2)) +(testcover-testcase-defun bar (+ 3 4)) +(should (eql (foo) 3)) +(should (eql (bar) 7)) + +;; ==== closure-1value-bug ==== +"Testcover does not mark closures as 1value." +:expected-result :failed +;; ==== +;; -*- lexical-binding:t -*- +(setq testcover-testcase-foo nil) +(setq testcover-testcase-bar 0) + +(defun testcover-testcase-baz (arg) + (setq testcover-testcase-foo + (lambda () (+ arg testcover-testcase-bar%%%)))) + +(testcover-testcase-baz 2) +(should (equal 2 (funcall testcover-testcase-foo))) +(testcover-testcase-baz 3) +(should (equal 3 (funcall testcover-testcase-foo))) + +;; ==== by-value-vs-by-reference-bug-25351 ==== +"An object created by a 1value expression may be modified by other code." +:expected-result :failed +;; ==== +(defun testcover-testcase-ab () + (list 'a 'b)) +(defun testcover-testcase-change-it (arg) + (setf (cadr arg%%%)%%% 'c)%%% + arg%%%) + +(should (equal (testcover-testcase-change-it (testcover-testcase-ab)) '(a c))) +(should (equal (testcover-testcase-ab) '(a b))) + +;; ==== 1value-error-test ==== +"Forms wrapped by `1value' should always return the same value." +;; ==== +(defun testcover-testcase-thing (arg) + (1value (list 1 arg 3))) + +(should (equal '(1 2 3) (testcover-testcase-thing 2))) +(should-error (testcover-testcase-thing 3)) + +;; ==== dotted-backquote ==== +"Testcover correctly instruments dotted backquoted lists." +;; ==== +(defun testcover-testcase-dotted-bq (flag extras) + (let* ((bq + `(a b c . ,(and flag extras%%%)))) + bq)) + +(should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e)))) +(should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e)))) + +;; ==== backquoted-vector-bug-25316 ==== +"Testcover reinstruments within backquoted vectors." +:expected-result :failed +;; ==== +(defun testcover-testcase-vec (a b c) + `[,a%%% ,(list b%%% c%%%)%%%]%%%) + +(defun testcover-testcase-vec-in-list (d e f) + `([[,d%%% ,e%%%] ,f%%%])%%%) + +(defun testcover-testcase-vec-arg (num) + (list `[,num%%%]%%%)%%%) + +(should (equal [1 (2 3)] (testcover-testcase-vec 1 2 3))) +(should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6))) +(should (equal '([100]) (testcover-testcase-vec-arg 100))) + +;; ==== vector-in-macro-spec-bug-25316 ==== +"Testcover reinstruments within vectors." +:expected-result :failed +;; ==== +(defmacro testcover-testcase-nth-case (arg vec) + (declare (indent 1) + (debug (form (vector &rest form)))) + `(eval (aref ,vec%%% ,arg%%%))%%%) + +(defun testcover-testcase-use-nth-case (choice val) + (testcover-testcase-nth-case choice + [(+ 1 val!!!)!!! + (- 1 val%%%)%%% + (* 7 val) + (/ 4 val!!!)!!!])) + +(should (eql 42 (testcover-testcase-use-nth-case 2 6))) +(should (eql 49 (testcover-testcase-use-nth-case 2 7))) +(should (eql 0 (testcover-testcase-use-nth-case 1 1 ))) + +;; ==== mapcar-is-not-compose ==== +"Mapcar with 1value arguments is not 1value." +:expected-result :failed +;; ==== +(defvar testcover-testcase-num 0) +(defun testcover-testcase-add-num (n) + (+ testcover-testcase-num n)) +(defun testcover-testcase-mapcar-sides () + (mapcar 'testcover-testcase-add-num '(1 2 3))) + +(setq testcover-testcase-num 1) +(should (equal (testcover-testcase-mapcar-sides) '(2 3 4))) +(setq testcover-testcase-num 2) +(should (equal (testcover-testcase-mapcar-sides) '(3 4 5))) + +;; ==== function-with-edebug-spec-bug-25316 ==== +"Functions can have edebug specs too. +See c-make-font-lock-search-function for an example in the Emacs +sources. The other issue is that it's ok to use quote in an +edebug spec, so testcover needs to cope with that." +:expected-result :failed +;; ==== +(defun testcover-testcase-make-function (forms) + `(lambda (flag) (if flag 0 ,@forms%%%))%%%) + +(def-edebug-spec testcover-testcase-make-function + (("quote" (&rest def-form)))) + +(defun testcover-testcase-thing () + (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%) + +(defun testcover-testcase-use-thing () + (funcall (testcover-testcase-thing)%%% nil)%%%) + +(should (equal (testcover-testcase-use-thing) 15)) + +;; ==== backquoted-dotted-alist ==== +"Testcover can instrument a dotted alist constructed with backquote." +;; ==== +(defun testcover-testcase-make-alist (expr entries) + `((0 . ,expr%%%) . ,entries%%%)%%%) + +(should (equal (testcover-testcase-make-alist "foo" '((1 . "bar") (2 . "baz"))) + '((0 . "foo") (1 . "bar") (2 . "baz")))) + +;; ==== coverage-of-the-unknown-symbol-bug-25471 ==== +"Testcover correctly records coverage of code which uses `unknown'" +:expected-result :failed +;; ==== +(defun testcover-testcase-how-do-i-know-you (name) + (let ((val 'unknown)) + (when (equal name%%% "Bob")%%% + (setq val 'known)!!!) + val%%%)%%%) + +(should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown)) + +;; testcases.el ends here. diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el new file mode 100644 index 00000000000..d31379c3aa2 --- /dev/null +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -0,0 +1,186 @@ +;;; testcover-tests.el --- Testcover test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; Testcover test suite. +;; * All the test cases are in testcover-resources/testcover-cases.el. +;; See that file for an explanation of the test case format. +;; * `testcover-tests-define-tests', which is run when this file is +;; loaded, reads testcover-resources/testcover-cases.el and defines +;; ERT tests for each test case. + +;;; Code: + +(require 'ert) +(require 'testcover) +(require 'skeleton) + +;; Use `eval-and-compile' around all these definitions because they're +;; used by the macro `testcover-tests-define-tests'. + +(eval-and-compile + (defvar testcover-tests-file-dir + (expand-file-name + "testcover-resources/" + (file-name-directory (or (bound-and-true-p byte-compile-current-file) + load-file-name + buffer-file-name))) + "Directory of the \"testcover-tests.el\" file.")) + +(eval-and-compile + (defvar testcover-tests-test-cases + (expand-file-name "testcases.el" testcover-tests-file-dir) + "File containing marked up code to instrument and check.")) + +;; Convert Testcover's overlays to plain text. + +(eval-and-compile + (defun testcover-tests-markup-region (beg end &rest optargs) + "Mark up test code within region between BEG and END. +Convert Testcover's tan and red splotches to %%% and !!! for +testcases.el. This can be used to create test cases if Testcover +is working correctly on a code sample. OPTARGS are optional +arguments for `testcover-start'." + (interactive "r") + (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")) + (code (buffer-substring beg end)) + (marked-up-code)) + (unwind-protect + (progn + (with-temp-file tempfile + (insert code)) + (save-current-buffer + (let ((buf (find-file-noselect tempfile))) + (set-buffer buf) + (apply 'testcover-start (cons tempfile optargs)) + (testcover-mark-all buf) + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((ov-face (overlay-get overlay 'face))) + (goto-char (overlay-end overlay)) + (cond + ((eq ov-face 'testcover-nohits) (insert "!!!")) + ((eq ov-face 'testcover-1value) (insert "%%%")) + (t nil)))) + (setq marked-up-code (buffer-string))) + (set-buffer-modified-p nil))) + (ignore-errors (kill-buffer (find-file-noselect tempfile))) + (ignore-errors (delete-file tempfile))) + + ;; Now replace the original code with the marked up code. + (delete-region beg end) + (insert marked-up-code)))) + +(eval-and-compile + (defun testcover-tests-unmarkup-region (beg end) + "Remove the markup used in testcases.el between BEG and END." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (re-search-forward "!!!\\|%%%" nil t) + (replace-match "")))))) + +(define-skeleton testcover-tests-skeleton + "Write a testcase for testcover-tests.el." + "Enter name of test: " + ";; ==== " str " ====\n" + "\"docstring\"\n" + ";; Directives for ERT should go here, if any.\n" + ";; ====\n" + ";; Replace this line with annotated test code.\n") + +;; Check a test case. + +(eval-and-compile + (defun testcover-tests-run-test-case (marked-up-code) + "Test the operation of Testcover on the string MARKED-UP-CODE." + (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))) + (unwind-protect + (progn + (with-temp-file tempfile + (insert marked-up-code)) + ;; Remove the marks and mark the code up again. The original + ;; and recreated versions should match. + (save-current-buffer + (set-buffer (find-file-noselect tempfile)) + ;; Fail the test if the debugger tries to become active, + ;; which will happen if Testcover's reinstrumentation + ;; leaves an edebug-enter in the code. This will also + ;; prevent debugging these tests using Edebug. + (cl-letf (((symbol-function #'edebug-enter) + (lambda (&rest _args) + (ert-fail + (concat "Debugger invoked during test run " + "(possible edebug-enter not replaced)"))))) + (dolist (byte-compile '(t nil)) + (testcover-tests-unmarkup-region (point-min) (point-max)) + (unwind-protect + (testcover-tests-markup-region (point-min) (point-max) byte-compile) + (set-buffer-modified-p nil)) + (should (string= marked-up-code + (buffer-string))))))) + (ignore-errors (kill-buffer (find-file-noselect tempfile))) + (ignore-errors (delete-file tempfile)))))) + +;; Convert test case file to ert-defmethod. + +(eval-and-compile + (defun testcover-tests-build-test-cases () + "Parse the test case file and return a list of ERT test definitions. +Construct and return a list of `ert-deftest' forms. See testcases.el +for documentation of the test definition format." + (let (results) + (with-temp-buffer + (insert-file-contents testcover-tests-test-cases) + (goto-char (point-min)) + (while (re-search-forward + (concat "^;; ==== \\([^ ]+?\\) ====\n" + "\\(\\(?:.*\n\\)*?\\)" + ";; ====\n" + "\\(\\(?:.*\n\\)*?\\)" + "\\(\\'\\|;; ====\\)") + nil t) + (let ((name (match-string 1)) + (splice (car (read-from-string + (format "(%s)" (match-string 2))))) + (code (match-string 3))) + (push + `(ert-deftest ,(intern (concat "testcover-tests-" name)) () + ,@splice + (testcover-tests-run-test-case ,code)) + results)) + (beginning-of-line))) + results))) + +;; Define all the tests. + +(defmacro testcover-tests-define-tests () + "Construct and define ERT test methods using the test case file." + (let* ((test-cases (testcover-tests-build-test-cases))) + `(progn ,@test-cases))) + +(testcover-tests-define-tests) + +(provide 'testcover-tests) + +;;; testcover-tests.el ends here From c71b718be86bdda7b51c8ea0da30aa896a7833fe Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 12:02:55 +0200 Subject: [PATCH 51/62] Support options with embedded whitespace in 'dired-listing-switches' * lisp/dired.el (dired-listing-switches): Document how to quote options with embedded whitespace. * lisp/files.el (insert-directory): Use split-string-and-unquote to support dired-listing-switches that specify command-line options with embedded spaces. (Bug#25485) --- lisp/dired.el | 4 ++++ lisp/files.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/dired.el b/lisp/dired.el index 350f6a7d2e3..2733372eb7b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -59,6 +59,10 @@ May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable `dired-ls-F-marks-symlinks' concerning the `F' switch. +Options that include embedded whitespace must be quoted +like this: \\\"--option=value with spaces\\\"; you can use +`combine-and-quote-strings' to produce the correct quoting of +each option. On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp, some of the `ls' switches are not supported; see the doc string of `insert-directory' in `ls-lisp.el' for more details." diff --git a/lisp/files.el b/lisp/files.el index 2833ec5c124..03d6df4c037 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6582,7 +6582,7 @@ normally equivalent short `-D' option is just passed on to (unless (equal switches "") ;; Split the switches at any spaces so we can ;; pass separate options as separate args. - (split-string switches))) + (split-string-and-unquote switches))) ;; Avoid lossage if FILE starts with `-'. '("--") (progn From 78f841d6db77f8b72d6d7d221af26efb956ab6cb Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 12:56:19 +0200 Subject: [PATCH 52/62] Change edebug-max-depth from defconst to defcustom * lisp/emacs-lisp/edebug.el (edebug-max-depth): Add defcustom. (Bug#24713) * etc/NEWS: Mention edebug-max-depth. * doc/lispref/edebug.texi (Checking Whether to Stop): Mention edebug-max-depth and index it. Add cross-references for max-lisp-eval-depth and max-specpdl-size. Co-authored-by: Eli Zaretskii --- doc/lispref/edebug.texi | 10 +++++++--- etc/NEWS | 5 +++++ lisp/emacs-lisp/edebug.el | 13 ++++++++++++- 3 files changed, 24 insertions(+), 4 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index f6f73ea8947..da72c9b700c 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -979,9 +979,13 @@ program. @itemize @bullet @item -@code{max-lisp-eval-depth} and @code{max-specpdl-size} are both -increased to reduce Edebug's impact on the stack. You could, however, -still run out of stack space when using Edebug. +@vindex edebug-max-depth +@code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size} +(@pxref{Local Variables}) are both increased to reduce Edebug's impact +on the stack. You could, however, still run out of stack space when +using Edebug. You can also enlarge the value of +@code{edebug-max-depth} if Edebug reaches the limit of recursion depth +instrumenting code that contains very large quoted lists. @item The state of keyboard macro execution is saved and restored. While diff --git a/etc/NEWS b/etc/NEWS index 270f8803d53..cbf2b70c821 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -464,6 +464,11 @@ viewing HTML files and the like. breakpoint (e.g. with "f" and "o") by customizing the new option 'edebug-sit-on-break'. ++++ +*** New customizable option 'edebug-max-depth' +This allows to enlarge the maximum recursion depth when instrumenting +code. + ** Eshell *** 'eshell-input-filter's value is now a named function diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index db54d1eeb20..ec0f08de356 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." :type 'boolean :group 'edebug) +(defcustom edebug-max-depth 150 + "Maximum recursion depth when instrumenting code. +This limit is intended to stop recursion if an Edebug specification +contains an infinite loop. When Edebug is instrumenting code +containing very large quoted lists, it may reach this limit and give +the error message \"Too deep - perhaps infinite loop in spec?\". +Make this limit larger to countermand that, but you may also need to +increase `max-lisp-eval-depth' and `max-specpdl-size'." + :type 'integer + :group 'edebug + :version "26.1") + (defcustom edebug-save-windows t "If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to @@ -1452,7 +1464,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-after-dotted-spec nil) (defvar edebug-matching-depth 0) ;; initial value -(defconst edebug-max-depth 150) ;; maximum number of matching recursions. ;;; Failure to match From cc84a405f3d3eb99ac8d53721715bbd812cf9772 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 12:59:41 +0200 Subject: [PATCH 53/62] ; * lisp/files.el (save-some-buffers-default-predicate): Add :version. --- lisp/files.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index 03d6df4c037..b7d104853c3 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5139,7 +5139,8 @@ Before and after saving the buffer, this function runs This allows you to stop `save-some-buffers' from asking about certain files that you'd usually rather not save." :group 'auto-save - :type 'function) + :type 'function + :version "26.1") (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. From a46a61904de6cc57e6a740a3006f48023859a1b3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 13:12:14 +0200 Subject: [PATCH 54/62] Fix a syntax error when evaluating pcase.el under Edebug * lisp/emacs-lisp/pcase.el (pcase-MACRO): Replace def-edebug-spec with an explicit 'put' form. Suggested by Gemini Lasswell . (Bug#24717) --- lisp/emacs-lisp/pcase.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 54678c5f324..46a5eedd150 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -89,7 +89,8 @@ (functionp &rest form) sexp)) -(def-edebug-spec pcase-MACRO pcase--edebug-match-macro) +;; See bug#24717 +(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro) ;; Only called from edebug. (declare-function get-edebug-spec "edebug" (symbol)) From 8ba27b7ce2f4a98e3c14fe752042c60fd7576fef Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 13:18:29 +0200 Subject: [PATCH 55/62] Avoid invalid read syntax errors due to 'ert-with-test-buffer' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer): Fix the 'declare' form. (Bug#24722) --- lisp/emacs-lisp/ert-x.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 7d99cb30274..8530253d5b4 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test buffer is killed; if there is an error, the test buffer is kept around on error for further inspection. Its name is derived from the name of the test and the result of NAME-FORM." - (declare (debug ((form) body)) + (declare (debug ((":name" form) body)) (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) From ef3d8d6f7226e570209e913d2754e828d0cb121c Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 13:36:43 +0200 Subject: [PATCH 56/62] New macro 'ert-with-message-capture' * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): New macro. (Bug#25158) * test/lisp/autorevert-tests.el (auto-revert--wait-for-revert) (auto-revert-test00-auto-revert-mode) (auto-revert-test01-auto-revert-several-files) (auto-revert-test02-auto-revert-deleted-file) (auto-revert-test03-auto-revert-tail-mode) (auto-revert-test04-auto-revert-mode-dired): * test/lisp/filenotify-tests.el (file-notify-test03-autorevert): Use ert-with-message-capture. --- lisp/emacs-lisp/ert-x.el | 24 +++++ test/lisp/autorevert-tests.el | 166 +++++++++++++++------------------- test/lisp/filenotify-tests.el | 52 +++++------ 3 files changed, 123 insertions(+), 119 deletions(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 8530253d5b4..4cf9d9609e9 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (kill-buffer clone))))))) +(defmacro ert-with-message-capture (var &rest body) + "Execute BODY while collecting anything written with `message' in VAR. + +Capture all messages produced by `message' when it is called from +Lisp, and concatenate them separated by newlines into one string. + +This is useful for separating the issuance of messages by the +code under test from the behavior of the *Messages* buffer." + (declare (debug (symbolp body)) + (indent 1)) + (let ((g-advice (cl-gensym))) + `(let* ((,var "") + (,g-advice (lambda (func &rest args) + (if (or (null args) (equal (car args) "")) + (apply func args) + (let ((msg (apply #'format-message args))) + (setq ,var (concat ,var msg "\n")) + (funcall func "%s" msg)))))) + (advice-add 'message :around ,g-advice) + (unwind-protect + (progn ,@body) + (advice-remove 'message ,g-advice))))) + + (provide 'ert-x) ;;; ert-x.el ends here diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index aea855ae02f..c082ba95639 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -24,24 +24,29 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'autorevert) (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" auto-revert-stop-on-user-input nil) (defconst auto-revert--timeout 10 - "Time to wait until a message appears in the *Messages* buffer.") + "Time to wait for a message.") + +(defvar auto-revert--messages nil + "Used to collect messages issued during a section of a test.") (defun auto-revert--wait-for-revert (buffer) - "Wait until the *Messages* buffer reports reversion of BUFFER." + "Wait until a message reports reversion of BUFFER. +This expects `auto-revert--messages' to be bound by +`ert-with-message-capture' before calling." (with-timeout (auto-revert--timeout nil) - (with-current-buffer "*Messages*" - (while - (null (string-match - (format-message "Reverting buffer `%s'." (buffer-name buffer)) - (buffer-string))) - (if (with-current-buffer buffer auto-revert-use-notify) - (read-event nil nil 0.1) - (sleep-for 0.1)))))) + (while + (null (string-match + (format-message "Reverting buffer `%s'." (buffer-name buffer)) + auto-revert--messages)) + (if (with-current-buffer buffer auto-revert-use-notify) + (read-event nil nil 0.1) + (sleep-for 0.1))))) (ert-deftest auto-revert-test00-auto-revert-mode () "Check autorevert for a file." @@ -51,41 +56,38 @@ buf) (unwind-protect (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (write-region "any text" nil tmpfile nil 'no-message) + (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (sleep-for 1) + (auto-revert-mode 1) + (should auto-revert-mode) - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) + ;; Modify file. We wait for a second, in order to have + ;; another timestamp. + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf)) (should (string-match "another text" (buffer-string))) ;; When the buffer is modified, it shall not be reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) + (ert-with-message-capture auto-revert--messages + (set-buffer-modified-p t) + (sleep-for 1) + (write-region "any text" nil tmpfile nil 'no-message) - ;; Check, that the buffer hasn't been reverted. - (auto-revert--wait-for-revert buf) + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf)) (should-not (string-match "any text" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) @@ -106,13 +108,11 @@ (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) buf1 buf2) (unwind-protect - (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (write-region "any text" nil tmpfile1 nil 'no-message) - (setq buf1 (find-file-noselect tmpfile1)) - (write-region "any text" nil tmpfile2 nil 'no-message) - (setq buf2 (find-file-noselect tmpfile2)) + (ert-with-message-capture auto-revert--messages + (write-region "any text" nil tmpfile1 nil 'no-message) + (setq buf1 (find-file-noselect tmpfile1)) + (write-region "any text" nil tmpfile2 nil 'no-message) + (setq buf2 (find-file-noselect tmpfile2)) (dolist (buf (list buf1 buf2)) (with-current-buffer buf @@ -148,7 +148,6 @@ (should (string-match "another text" (buffer-string)))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (dolist (buf (list buf1 buf2)) (with-current-buffer buf (set-buffer-modified-p nil)) @@ -165,8 +164,6 @@ buf) (unwind-protect (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf @@ -184,42 +181,36 @@ 'before-revert-hook (lambda () (delete-file buffer-file-name)) nil t) - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - ;; Check, that the buffer hasn't been reverted. File - ;; notification should be disabled, falling back to - ;; polling. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer hasn't been reverted. File + ;; notification should be disabled, falling back to + ;; polling. (should (string-match "any text" (buffer-string))) (should-not auto-revert-use-notify) ;; Once the file has been recreated, the buffer shall be ;; reverted. (kill-local-variable 'before-revert-hook) - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-match "another text" (buffer-string))) ;; An empty file shall still be reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-equal "" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) @@ -232,9 +223,7 @@ (let ((tmpfile (make-temp-file "auto-revert-test")) buf) (unwind-protect - (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) + (ert-with-message-capture auto-revert--messages (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf @@ -259,7 +248,6 @@ (string-match "modified text\nanother text" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (kill-buffer buf)) (ignore-errors (delete-file tmpfile))))) @@ -283,33 +271,29 @@ (should (string-match name (substring-no-properties (buffer-string)))) - ;; Delete file. We wait for a second, in order to have - ;; another timestamp. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (delete-file tmpfile) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + ;; Delete file. We wait for a second, in order to have + ;; another timestamp. + (sleep-for 1) + (delete-file tmpfile) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should-not (string-match name (substring-no-properties (buffer-string)))) - ;; Make dired buffer modified. Check, that the buffer has - ;; been still reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) + (ert-with-message-capture auto-revert--messages + ;; Make dired buffer modified. Check, that the buffer has + ;; been still reverted. + (set-buffer-modified-p t) + (sleep-for 1) + (write-region "any text" nil tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-match name (substring-no-properties (buffer-string)))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index db7f55e8fc5..27434bcef20 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -36,6 +36,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'filenotify) (require 'tramp) @@ -703,21 +704,19 @@ delivered." (should auto-revert-notify-watch-descriptor) ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region - "another text" nil file-notify--test-tmpfile nil 'no-message) + ;; another timestamp. + (ert-with-message-capture captured-messages + (sleep-for 1) + (write-region + "another text" nil file-notify--test-tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (file-notify--wait-for-events - timeout - (string-match + ;; Check, that the buffer has been reverted. + (file-notify--wait-for-events + timeout + (string-match (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "another text" (buffer-string))) + captured-messages)) + (should (string-match "another text" (buffer-string)))) ;; Stop file notification. Autorevert shall still work via polling. (file-notify-rm-watch auto-revert-notify-watch-descriptor) @@ -728,27 +727,24 @@ delivered." ;; Modify file. We wait for two seconds, in order to ;; have another timestamp. One second seems to be too - ;; short. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 2) - (write-region - "foo bla" nil file-notify--test-tmpfile nil 'no-message) + ;; short. + (ert-with-message-capture captured-messages + (sleep-for 2) + (write-region + "foo bla" nil file-notify--test-tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (file-notify--wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "foo bla" (buffer-string)))) + ;; Check, that the buffer has been reverted. + (file-notify--wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + captured-messages)) + (should (string-match "foo bla" (buffer-string))))) ;; The environment shall be cleaned up. (file-notify--test-cleanup-p)) ;; Cleanup. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (kill-buffer buf)) (file-notify--test-cleanup)))) From c8f91b168b0955e1e21acbf291171af1f70725ec Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 13:49:55 +0200 Subject: [PATCH 57/62] Fix autorevert-tests on MS-Windows * test/lisp/autorevert-tests.el (auto-revert-test02-auto-revert-deleted-file): Don't check that auto-revert-use-notify was reset to nil on w32. --- test/lisp/autorevert-tests.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index c082ba95639..c6f103321c6 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -190,7 +190,9 @@ This expects `auto-revert--messages' to be bound by ;; notification should be disabled, falling back to ;; polling. (should (string-match "any text" (buffer-string))) - (should-not auto-revert-use-notify) + ;; With w32notify, the 'stopped' events are not sent. + (or (eq file-notify--library 'w32notify) + (should-not auto-revert-use-notify)) ;; Once the file has been recreated, the buffer shall be ;; reverted. From ff4dd0d39c3f5dfb8f4988f840c2c05621db32db Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 13:55:47 +0200 Subject: [PATCH 58/62] Add tests for lisp/kmacro.el * test/lisp/kmacro-tests.el: New file. (Bug#24939) --- test/lisp/kmacro-tests.el | 890 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 890 insertions(+) create mode 100644 test/lisp/kmacro-tests.el diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el new file mode 100644 index 00000000000..5124cbbf962 --- /dev/null +++ b/test/lisp/kmacro-tests.el @@ -0,0 +1,890 @@ +;;; kmacro-tests.el --- Tests for kmacro.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'kmacro) +(require 'ert) +(require 'ert-x) + +;;; Test fixtures: + +(defmacro kmacro-tests-with-kmacro-clean-slate (&rest body) + "Create a clean environment for a kmacro test BODY to run in." + (declare (debug (body))) + `(cl-letf* ((kmacro-execute-before-append t) + (kmacro-ring-max 8) + (kmacro-repeat-no-prefix t) + (kmacro-call-repeat-key nil) + (kmacro-call-repeat-with-arg nil) + + (kbd-macro-termination-hook nil) + (defining-kbd-macro nil) + (executing-kbd-macro nil) + (executing-kbd-macro-index 0) + (last-kbd-macro nil) + + (kmacro-ring nil) + + (kmacro-counter 0) + (kmacro-default-counter-format "%d") + (kmacro-counter-format "%d") + (kmacro-counter-format-start "%d") + (kmacro-counter-value-start 0) + (kmacro-last-counter 0) + (kmacro-initial-counter-value nil) + + (kmacro-tests-macros nil) + (kmacro-tests-events nil) + (kmacro-tests-sequences nil)) + (advice-add 'end-kbd-macro :after #'kmacro-tests-end-macro-advice) + (advice-add 'read-event :around #'kmacro-tests-read-event-advice ) + (advice-add 'read-key-sequence :around #'kmacro-tests-read-key-sequence-advice) + (unwind-protect + (ert-with-test-buffer (:name "") + (switch-to-buffer (current-buffer)) + ,@body) + (advice-remove 'read-key-sequence #'kmacro-tests-read-key-sequence-advice) + (advice-remove 'read-event #'kmacro-tests-read-event-advice) + (advice-remove 'end-kbd-macro #'kmacro-tests-end-macro-advice)))) + +(defmacro kmacro-tests-deftest (name _args docstring &rest keys-and-body) + "Define a kmacro unit test. +NAME is the name of the test, _ARGS should be nil, and DOCSTRING +is required. To avoid having to duplicate ert's keyword parsing +here, its keywords and values (if any) must be inside a list +after the docstring, preceding the body, here combined with the +body in KEYS-AND-BODY." + (declare (debug (&define name sexp stringp + [&optional (&rest &or [keywordp sexp])] + def-body)) + (doc-string 3) + (indent 2)) + + (let* ((keys (when (and (listp (car keys-and-body)) + (keywordp (caar keys-and-body))) + (car keys-and-body))) + (body (if keys (cdr keys-and-body) + keys-and-body))) + `(ert-deftest ,name () + ,docstring ,@keys + (kmacro-tests-with-kmacro-clean-slate ,@body)))) + +(defvar kmacro-tests-keymap + (let ((map (make-sparse-keymap))) + (dotimes (i 26) + (define-key map (string (+ ?a i)) 'self-insert-command)) + (dotimes (i 10) + (define-key map (string (+ ?0 i)) 'self-insert-command)) + ;; Define a few key sequences of different lengths. + (dolist (item '(("\C-a" . beginning-of-line) + ("\C-b" . backward-char) + ("\C-e" . end-of-line) + ("\C-f" . forward-char) + ("\C-r" . isearch-backward) + ("\C-u" . universal-argument) + ("\C-w" . kill-region) + ("\C-SPC" . set-mark-command) + ("\M-w" . kill-ring-save) + ("\M-x" . execute-extended-command) + ("\C-cd" . downcase-word) + ("\C-cxu" . upcase-word) + ("\C-cxq" . quoted-insert) + ("\C-cxi" . kmacro-insert-counter) + ("\C-x\C-k" . kmacro-keymap))) + (define-key map (car item) (cdr item))) + map) + "Keymap to use for testing keyboard macros. +This is used to obtain consistent results even if tests are run +in an environment with rebound keys.") + +(defvar kmacro-tests-events nil + "Input events used by the kmacro test in progress.") + +(defun kmacro-tests-read-event-advice (orig-func &rest args) + "Pop and return an event from `kmacro-tests-events'. +Return the result of calling ORIG-FUNC with ARGS if +`kmacro-tests-events' is empty, or if a keyboard macro is +running." + (if (or executing-kbd-macro (null kmacro-tests-events)) + (apply orig-func args) + (pop kmacro-tests-events))) + +(defvar kmacro-tests-sequences nil + "Input sequences used by the kmacro test in progress.") + +(defun kmacro-tests-read-key-sequence-advice (orig-func &rest args) + "Pop and return a string from `kmacro-tests-sequences'. +Return the result of calling ORIG-FUNC with ARGS if +`kmacro-tests-sequences' is empty, or if a keyboard macro is +running." + (if (or executing-kbd-macro (null kmacro-tests-sequences)) + (apply orig-func args) + (pop kmacro-tests-sequences))) + +(defvar kmacro-tests-macros nil + "Keyboard macros (in vector form) used by the kmacro test in progress.") + +(defun kmacro-tests-end-macro-advice (&rest _args) + "Pop a macro from `kmacro-tests-macros' and assign it to `last-kbd-macro'. +If `kmacro-tests-macros' is empty, do nothing." + (when kmacro-tests-macros + (setq last-kbd-macro (pop kmacro-tests-macros)))) + +;;; Some more powerful expectations: + +(defmacro kmacro-tests-should-insert (value &rest body) + "Verify that VALUE is inserted by the execution of BODY. +Execute BODY, then check that the string VALUE was inserted +into the current buffer at point." + (declare (debug (stringp body)) + (indent 1)) + (let ((g-p (cl-gensym)) + (g-bsize (cl-gensym))) + `(let ((,g-p (point)) + (,g-bsize (buffer-size))) + ,@body + (should (equal (buffer-substring ,g-p (point)) ,value)) + (should (equal (- (buffer-size) ,g-bsize) (length ,value)))))) + +(defmacro kmacro-tests-should-match-message (value &rest body) + "Verify that a message matching VALUE is issued while executing BODY. +Execute BODY, and then if there is not a regexp match between +VALUE and any text written to *Messages* during the execution, +cause the current test to fail." + (declare (debug (form body)) + (indent 1)) + (let ((g-captured-messages (cl-gensym))) + `(ert-with-message-capture ,g-captured-messages + ,@body + (should (string-match-p ,value ,g-captured-messages))))) + +;;; Tests: + +(kmacro-tests-deftest kmacro-tests-test-insert-counter-01-nil () + "`kmacro-insert-counter' adds one to macro counter with nil arg." + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) + (kmacro-tests-should-insert "1" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) + +(kmacro-tests-deftest kmacro-tests-test-insert-counter-02-int () + "`kmacro-insert-counter' increments by value of list argument." + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-insert-counter 2))) + (kmacro-tests-should-insert "2" + (kmacro-tests-simulate-command '(kmacro-insert-counter 3))) + (kmacro-tests-should-insert "5" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) + +(kmacro-tests-deftest kmacro-tests-test-insert-counter-03-list () + "`kmacro-insert-counter' doesn't increment when given universal argument." + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-insert-counter (16)))) + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-insert-counter (4))))) + +(kmacro-tests-deftest kmacro-tests-test-insert-counter-04-neg () + "`kmacro-insert-counter' decrements with '- prefix argument" + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-insert-counter -))) + (kmacro-tests-should-insert "-1" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) + +(kmacro-tests-deftest kmacro-tests-test-start-format-counter () + "`kmacro-insert-counter' uses start value and format." + (kmacro-tests-simulate-command '(kmacro-set-counter 10)) + (kmacro-tests-should-insert "10" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) + (kmacro-tests-should-insert "11" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) + (kmacro-set-format "c=%s") + (kmacro-tests-simulate-command '(kmacro-set-counter 50)) + (kmacro-tests-should-insert "c=50" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) + +(kmacro-tests-deftest kmacro-tests-test-start-macro-when-defining-macro () + "Starting a macro while defining a macro does not start a second macro." + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + ;; We should now be in the macro-recording state. + (should defining-kbd-macro) + (should-not last-kbd-macro) + ;; Calling it again should leave us in the same state. + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + (should defining-kbd-macro) + (should-not last-kbd-macro)) + + +(kmacro-tests-deftest kmacro-tests-set-macro-counter-while-defining () + "Use of the prefix arg with kmacro-start sets kmacro-counter." + ;; Give kmacro-start-macro an argument. + (kmacro-tests-simulate-command '(kmacro-start-macro 5)) + (should defining-kbd-macro) + ;; Verify that the counter is set to that value. + (kmacro-tests-should-insert "5" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) + ;; Change it while defining a macro. + (kmacro-tests-simulate-command '(kmacro-set-counter 1)) + (kmacro-tests-should-insert "1" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil))) + ;; Using universal arg to to set counter should reset to starting value. + (kmacro-tests-simulate-command '(kmacro-set-counter (4)) '(4)) + (kmacro-tests-should-insert "5" + (kmacro-tests-simulate-command '(kmacro-insert-counter nil)))) + + +(kmacro-tests-deftest kmacro-tests-start-insert-counter-appends-to-macro () + "Use of the universal arg appends to the previous macro." + (let ((kmacro-tests-macros (list (string-to-vector "hello")))) + ;; Start recording a macro. + (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil)) + ;; Make sure we are recording. + (should defining-kbd-macro) + ;; Call it again and it should insert the counter. + (kmacro-tests-should-insert "0" + (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter nil))) + ;; We should still be in the recording state. + (should defining-kbd-macro) + ;; End recording with repeat count. + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 3)) + ;; Recording should be finished. + (should-not defining-kbd-macro) + ;; Now use prefix arg to append to the previous macro. + ;; This should run the previous macro first. + (kmacro-tests-should-insert "hello" + (kmacro-tests-simulate-command + '(kmacro-start-macro-or-insert-counter (4)))) + ;; Verify that the recording state has changed. + (should (equal defining-kbd-macro 'append)))) + +(kmacro-tests-deftest kmacro-tests-end-call-macro-prefix-args () + "kmacro-end-call-macro changes behavior based on prefix arg." + ;; "Record" two macros. + (dotimes (i 2) + (kmacro-tests-define-macro (vconcat (format "macro #%d" (1+ i))))) + ;; With no prefix arg, it should call the second macro. + (kmacro-tests-should-insert "macro #2" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro nil))) + ;; With universal arg, it should call the first one. + (kmacro-tests-should-insert "macro #1" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro (4))))) + +(kmacro-tests-deftest kmacro-tests-end-and-call-macro () + "Keyboard command to end and call macro works under various conditions." + ;; First, try it with no macro to record. + (setq kmacro-tests-macros '("")) + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + (condition-case err + (kmacro-tests-simulate-command '(kmacro-end-and-call-macro 2) 2) + (error (should (string= (cadr err) + "No kbd macro has been defined")))) + + ;; Check that it stopped defining and that no macro was recorded. + (should-not defining-kbd-macro) + (should-not last-kbd-macro) + + ;; Now try it while not recording, but first record a non-nil macro. + (kmacro-tests-define-macro "macro") + (kmacro-tests-should-insert "macro" + (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil)))) + +(kmacro-tests-deftest kmacro-tests-end-and-call-macro-mouse () + "Commands to end and call macro work under various conditions. +This is a regression test for Bug#24992." + (:expected-result :failed) + (cl-letf (((symbol-function #'mouse-set-point) #'ignore)) + ;; First, try it with no macro to record. + (setq kmacro-tests-macros '("")) + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + (condition-case err + (kmacro-tests-simulate-command '(kmacro-end-call-mouse 2) 2) + (error (should (string= (cadr err) + "No kbd macro has been defined")))) + + ;; Check that it stopped defining and that no macro was recorded. + (should-not defining-kbd-macro) + (should-not last-kbd-macro) + + ;; Now try it while not recording, but first record a non-nil macro. + (kmacro-tests-define-macro "macro") + (kmacro-tests-should-insert "macro" + (kmacro-tests-simulate-command '(kmacro-end-call-mouse nil))))) + +(kmacro-tests-deftest kmacro-tests-call-macro-hint-and-repeat () + "`kmacro-call-macro' gives hint in Messages and sets up repeat keymap. +This is a regression test for: Bug#3412, Bug#11817." + (kmacro-tests-define-macro [?m]) + (let ((kmacro-call-repeat-key t) + (kmacro-call-repeat-with-arg t) + (overriding-terminal-local-map overriding-terminal-local-map) + (last-input-event ?e)) + (message "") ; Clear the echo area. (Bug#3412) + (kmacro-tests-should-match-message "Type e to repeat macro" + (kmacro-tests-should-insert "mmmmmm" + (cl-letf (((symbol-function #'this-single-command-keys) (lambda () + [?\C-x ?e]))) + (kmacro-call-macro 3)) + ;; Check that it set up for repeat, and run the repeat. + (funcall (lookup-key overriding-terminal-local-map "e")))))) + +(kmacro-tests-deftest + kmacro-tests-run-macro-command-recorded-in-macro () + "No infinite loop if `kmacro-end-and-call-macro' is recorded in the macro. +\(Bug#15126)" + (:expected-result :failed) + (ert-skip "Skipping due to Bug#24921 (an ERT bug)") + (kmacro-tests-define-macro (vconcat "foo" [return] "\M-x" + "kmacro-end-and-call-macro")) + (use-local-map kmacro-tests-keymap) + (kmacro-tests-simulate-command '(kmacro-end-and-call-macro nil))) + + +(kmacro-tests-deftest kmacro-tests-test-ring-2nd-commands () + "2nd macro in ring is displayed and executed normally and on repeat." + (use-local-map kmacro-tests-keymap) + ;; Record one macro, with count. + (push (vconcat "\C-cxi" "\C-u\C-cxi") kmacro-tests-macros) + (kmacro-tests-simulate-command '(kmacro-start-macro 1)) + (kmacro-tests-simulate-command '(kmacro-end-macro nil)) + ;; Check that execute and display do nothing with no 2nd macro. + (kmacro-tests-should-insert "" + (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil))) + (kmacro-tests-should-match-message "Only one keyboard macro defined" + (kmacro-tests-simulate-command '(kmacro-view-ring-2nd))) + ;; Record another one, with format. + (kmacro-set-format "=%d=") + (kmacro-tests-define-macro (vconcat "bar")) + ;; Execute the first one, mocked up to insert counter. + ;; Should get default format. + (kmacro-tests-should-insert "11" + (kmacro-tests-simulate-command '(kmacro-call-ring-2nd nil))) + ;; Now display the 2nd ring macro and check result. + (kmacro-tests-should-match-message "C-c x i C-u C-c x i" + (kmacro-view-ring-2nd))) + +(kmacro-tests-deftest kmacro-tests-fill-ring-and-rotate () + "Macro ring can shift one way, shift the other way, swap and pop." + (cl-letf ((kmacro-ring-max 4)) + ;; Record enough macros that the first one drops off the history. + (dotimes (n (1+ kmacro-ring-max)) + (kmacro-tests-define-macro (make-vector (1+ n) (+ ?a n)))) + ;; Cycle the ring and check that #2 comes up. + (kmacro-tests-should-match-message "2*b" + (kmacro-tests-simulate-command '(kmacro-cycle-ring-next nil))) + ;; Execute the current macro and check arguments. + (kmacro-tests-should-insert "bbbb" + (kmacro-call-macro 2 t)) + ;; Cycle the ring the other way; #5 expected. + (kmacro-tests-should-match-message "5*e" (kmacro-cycle-ring-previous nil)) + ;; Swapping the top two should give #4. + (kmacro-tests-should-match-message "4*d" (kmacro-swap-ring)) + ;; Delete the top and expect #5. + (kmacro-tests-should-match-message "5*e" (kmacro-delete-ring-head)))) + + +(kmacro-tests-deftest kmacro-tests-test-ring-commands-when-no-macros () + "Ring commands give appropriate message when no macros exist." + (dolist (cmd '((kmacro-cycle-ring-next nil) + (kmacro-cycle-ring-previous nil) + (kmacro-swap-ring) + (kmacro-delete-ring-head) + (kmacro-view-ring-2nd) + (kmacro-call-ring-2nd nil) + (kmacro-view-macro))) + (kmacro-tests-should-match-message "No keyboard macro defined" + (kmacro-tests-simulate-command cmd)))) + +(kmacro-tests-deftest kmacro-tests-repeat-on-last-key () + "Kmacro commands can be run in sequence without prefix keys." + (let* ((prefix (where-is-internal 'kmacro-keymap nil t)) + ;; Make a sequence of events to run. + ;; Comments are expected output of mock macros + ;; on the first and second run of the sequence (see below). + (events (mapcar #'kmacro-tests-get-kmacro-key + '(kmacro-end-or-call-macro-repeat ;c / b + kmacro-end-or-call-macro-repeat ;c / b + kmacro-call-ring-2nd-repeat ;b / a + kmacro-cycle-ring-next + kmacro-end-or-call-macro-repeat ;a / a + kmacro-cycle-ring-previous + kmacro-end-or-call-macro-repeat ;c / b + kmacro-delete-ring-head + kmacro-end-or-call-macro-repeat ;b / a + ))) + (kmacro-tests-macros (list [?a] [?b] [?c])) + ;; What we want kmacro to see as keyboard command sequence + (first-event (seq-concatenate + 'vector + prefix + (vector (kmacro-tests-get-kmacro-key + 'kmacro-end-or-call-macro-repeat))))) + (cl-letf + ;; standardize repeat options + ((kmacro-repeat-no-prefix t) + (kmacro-call-repeat-key t) + (kmacro-call-repeat-with-arg nil)) + ;; "Record" two macros + (dotimes (_n 2) + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + (kmacro-tests-simulate-command '(kmacro-end-macro nil))) + ;; Start recording #3 + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + + ;; Set up pending keyboard events and a fresh buffer + ;; kmacro-set-counter is not one of the repeating kmacro + ;; commands so it should end the sequence. + (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-set-counter)) + (kmacro-tests-events (append events (list end-key)))) + (cl-letf (((symbol-function #'this-single-command-keys) + (lambda () first-event))) + (use-local-map kmacro-tests-keymap) + (kmacro-tests-should-insert "ccbacb" + ;; End #3 and launch loop to read events. + (kmacro-end-or-call-macro-repeat nil)))) + + ;; `kmacro-edit-macro-repeat' should also stop the sequence, + ;; so run it again with that at the end. + (let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-edit-macro-repeat)) + (kmacro-tests-events (append events (list end-key)))) + (cl-letf (((symbol-function #'edit-kbd-macro) #'ignore) + ((symbol-function #'this-single-command-keys) + (lambda () first-event))) + (use-local-map kmacro-tests-keymap) + (kmacro-tests-should-insert "bbbbbaaba" + (kmacro-end-or-call-macro-repeat 3))))))) + +(kmacro-tests-deftest kmacro-tests-repeat-view-and-run () + "Kmacro view cycles through ring and executes macro just viewed." + (let* ((prefix (where-is-internal 'kmacro-keymap nil t)) + (kmacro-tests-events + (mapcar #'kmacro-tests-get-kmacro-key + (append (make-list 5 'kmacro-view-macro-repeat) + '(kmacro-end-or-call-macro-repeat + kmacro-set-counter)))) + ;; Make kmacro see this as keyboard command sequence. + (first-event (seq-concatenate + 'vector + prefix + (vector (kmacro-tests-get-kmacro-key + 'kmacro-view-macro-repeat)))) + ;; Construct a regexp to match the messages which should be + ;; produced by repeated view-repeats. + (macros-regexp (apply #'concat + (mapcar (lambda (c) (format ".+%s\n" c)) + '("d" "c" "b" "a" "d" "c"))))) + (cl-letf ((kmacro-repeat-no-prefix t) + (kmacro-call-repeat-key t) + (kmacro-call-repeat-with-arg nil) + ((symbol-function #'this-single-command-keys) (lambda () + first-event))) + ;; "Record" some macros. + (dotimes (n 4) + (kmacro-tests-define-macro (make-vector 1 (+ ?a n)))) + + (use-local-map kmacro-tests-keymap) + ;; 6 views (the direct call plus the 5 in events) should + ;; cycle through the ring and get to the second-to-last + ;; macro defined. + (kmacro-tests-should-insert "c" + (kmacro-tests-should-match-message macros-regexp + (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil))))))) + +(kmacro-tests-deftest kmacro-tests-bind-to-key-when-recording () + "Bind to key doesn't bind a key during macro recording." + (cl-letf ((global-map global-map) + (saved-binding (key-binding "\C-a")) + (kmacro-tests-sequences (list "\C-a"))) + (kmacro-tests-simulate-command '(kmacro-start-macro 1)) + (kmacro-bind-to-key nil) + (should (eq saved-binding (key-binding "\C-a"))))) + +(kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro () + "Bind to key, symbol or register fails when when no macro exists." + (should-error (kmacro-bind-to-key nil)) + (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)) + (should-error (kmacro-to-register))) + +(kmacro-tests-deftest kmacro-tests-bind-to-key-bad-key-sequence () + "Bind to key fails to bind to ^G." + (let ((global-map global-map) + (saved-binding (key-binding "\C-g")) + (kmacro-tests-sequences (list "\C-g"))) + (kmacro-tests-define-macro [1]) + (kmacro-bind-to-key nil) + (should (eq saved-binding (key-binding "\C-g"))))) + +(kmacro-tests-deftest kmacro-tests-bind-to-key-with-key-sequence-in-use () + "Bind to key respects yes-or-no-p when given already bound key sequence." + (kmacro-tests-define-macro (vconcat "abaab")) + (let ((global-map global-map) + (map (make-sparse-keymap)) + (kmacro-tests-sequences (make-list 2 "\C-hi"))) + (define-key map "\C-hi" 'info) + (use-local-map map) + ;; Try the command with yes-or-no-p set up to say no. + (cl-letf (((symbol-function #'yes-or-no-p) + (lambda (prompt) + (should (string-match-p "info" prompt)) + (should (string-match-p "C-h i" prompt)) + nil))) + (kmacro-bind-to-key nil)) + + (should (equal (where-is-internal 'info nil t) + (vconcat "\C-hi"))) + ;; Try it again with yes. + (cl-letf (((symbol-function #' yes-or-no-p) + (lambda (_prompt) t))) + (kmacro-bind-to-key nil)) + + (should-not (equal (where-is-internal 'info global-map t) + (vconcat "\C-hi"))) + (use-local-map nil) + (kmacro-tests-should-insert "abaab" + (funcall (key-binding "\C-hi"))))) + +(kmacro-tests-deftest kmacro-tests-kmacro-bind-to-single-key () + "Bind to key uses C-x C-k A when asked to bind to A." + (let ((global-map global-map) + (kmacro-tests-macros (list (string-to-vector "\C-cxi")))) + (use-local-map kmacro-tests-keymap) + + ;; Record a macro with counter and format set. + (kmacro-set-format "<%d>") + (kmacro-tests-simulate-command '(kmacro-start-macro-or-insert-counter 5)) + (kmacro-tests-simulate-command '(kmacro-end-macro nil)) + + (let ((kmacro-tests-sequences (list "A"))) + (kmacro-bind-to-key nil)) + + ;; Record a second macro with different counter and format. + (kmacro-set-format "%d") + (kmacro-tests-define-macro [2]) + + ;; Check the bound key and run it and verify correct counter + ;; and format. + (should (equal (string-to-vector "\C-cxi") + (car (kmacro-extract-lambda + (key-binding "\C-x\C-kA"))))) + (kmacro-tests-should-insert "<5>" + (funcall (key-binding "\C-x\C-kA"))))) + +(kmacro-tests-deftest kmacro-tests-name-last-macro-unable-to-bind () + "Name last macro won't bind to symbol which is already bound." + (kmacro-tests-define-macro [1]) + ;; Set up a test symbol which looks like a function. + (setplist 'kmacro-tests-symbol-for-test nil) + (fset 'kmacro-tests-symbol-for-test #'ignore) + (should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test)) + ;; The empty string symbol also can't be bound. + (should-error (kmacro-name-last-macro (make-symbol "")))) + +(kmacro-tests-deftest kmacro-tests-name-last-macro-bind-and-rebind () + "Name last macro can rebind a symbol it binds." + ;; Make sure our symbol is unbound. + (when (fboundp 'kmacro-tests-symbol-for-test) + (fmakunbound 'kmacro-tests-symbol-for-test)) + (setplist 'kmacro-tests-symbol-for-test nil) + ;; Make two macros and bind them to the same symbol. + (dotimes (i 2) + (kmacro-tests-define-macro (make-vector (1+ i) (+ ?a i))) + (kmacro-name-last-macro 'kmacro-tests-symbol-for-test) + (should (fboundp 'kmacro-tests-symbol-for-test))) + + ;; Now run the function bound to the symbol. Result should be the + ;; second macro. + (kmacro-tests-should-insert "bb" + (kmacro-tests-simulate-command '(kmacro-tests-symbol-for-test)))) + +(kmacro-tests-deftest kmacro-tests-store-in-register () + "Macro can be stored in and retrieved from a register." + (use-local-map kmacro-tests-keymap) + ;; Save and restore register 200 so we can use it for the test. + (let ((saved-reg-contents (get-register 200))) + (unwind-protect + (progn + ;; Define a macro, and save it to a register. + (kmacro-tests-define-macro (vconcat "a\C-a\C-cxu")) + (kmacro-to-register 200) + ;; Then make a new different macro. + (kmacro-tests-define-macro (vconcat "bb\C-a\C-cxu")) + ;; When called from the register, result should be first macro. + (kmacro-tests-should-insert "AAA" + (kmacro-tests-simulate-command '(jump-to-register 200 3) 3)) + (kmacro-tests-should-insert "a C-a C-c x u" + (kmacro-tests-simulate-command '(insert-register 200 t) '(4)))) + (set-register 200 saved-reg-contents)))) + +(kmacro-tests-deftest kmacro-tests-step-edit-act () + "Step-edit steps-through a macro with act and act-repeat." + (kmacro-tests-run-step-edit "he\C-u2lo" + :events (make-list 6 'act) + :result "hello" + :macro-result "he\C-u2lo") + + (kmacro-tests-run-step-edit "f\C-aoo\C-abar" + :events (make-list 5 'act-repeat) + :result "baroof" + :macro-result "f\C-aoo\C-abar")) + +(kmacro-tests-deftest kmacro-tests-step-edit-skip () + "Step-editing can skip parts of macro." + (kmacro-tests-run-step-edit "ofoofff" + :events '(skip skip-keep skip-keep skip-keep + skip-rest) + :result "" + :macro-result "foo")) + +(kmacro-tests-deftest kmacro-tests-step-edit-quit () + "Quit while step-editing leaves macro unchanged." + (kmacro-tests-run-step-edit "bar" + :events '(help insert skip help quit) + :sequences '("f" "o" "o" "\C-j") + :result "foo" + :macro-result "bar")) + +(kmacro-tests-deftest kmacro-tests-step-insert () + "Step edit can insert in macro." + (kmacro-tests-run-step-edit "fbazbop" + :events '(insert act insert-1 act-repeat) + :sequences '("o" "o" "\C-a" "\C-j" "\C-e") + :result "foobazbop" + :macro-result "oo\C-af\C-ebazbop")) + +(kmacro-tests-deftest kmacro-tests-step-edit-replace-digit-argument () + "Step-edit replace can replace a numeric argument in a macro. +This is a regression for item 1 in Bug#24991." + (:expected-result :failed) + (kmacro-tests-run-step-edit "\C-u3b\C-a\C-cxu" + :events '(act replace automatic) + :sequences '("8" "x" "\C-j") + :result "XXXXXXXX" + :macro-result "\C-u8x\C-a\C-cxu")) + +(kmacro-tests-deftest kmacro-tests-step-edit-replace () + "Step-edit replace and replace-1 can replace parts of a macro." + (kmacro-tests-run-step-edit "a\C-a\C-cxu" + :events '(act act replace) + :sequences '("b" "c" "\C-j") + :result "bca" + :macro-result "a\C-abc") + (kmacro-tests-run-step-edit "a\C-a\C-cxucd" + :events '(act replace-1 automatic) + :sequences '("b") + :result "abcd" + :macro-result "ab\C-cxucd") + (kmacro-tests-run-step-edit "by" + :events '(act replace) + :sequences '("a" "r" "\C-j") + :result "bar" + :macro-result "bar")) + +(kmacro-tests-deftest kmacro-tests-step-edit-append () + "Step edit append inserts after point, and append-end inserts at end." + (kmacro-tests-run-step-edit "f-b" + :events '(append append-end) + :sequences '("o" "o" "\C-j" "a" "r" "\C-j") + :result "foo-bar" + :macro-result "foo-bar") + (kmacro-tests-run-step-edit "x" + :events '(append) + :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j") + :result "Xy" + :macro-result "x\C-a\C-cxu\C-ey")) + +(kmacro-tests-deftest kmacro-tests-append-end-at-end-appends () + "Append-end when already at end of macro appends to end of macro. +This is a regression for item 2 in Bug#24991." + (:expected-result :failed) + (kmacro-tests-run-step-edit "x" + :events '(append-end) + :sequences '("\C-a" "\C-cxu" "\C-e" "y" "\C-j") + :result "Xy" + :macro-result "x\C-a\C-cxu\C-ey")) + + +(kmacro-tests-deftest kmacro-tests-step-edit-skip-entire () + "Skipping a whole macro in step-edit leaves macro unchanged. +This is a regression for item 3 in Bug#24991." + (:expected-result :failed) + (kmacro-tests-run-step-edit "xyzzy" + :events '(skip-rest) + :result "" + :macro-result "xyzzy")) + +(kmacro-tests-deftest kmacro-tests-step-edit-step-through-negative-argument () + "Step edit works on macros using negative universal argument. +This is a regression for item 4 in Bug#24991." + (:expected-result :failed) + (kmacro-tests-run-step-edit "boo\C-u-\C-cu" + :events '(act-repeat automatic) + :result "BOO" + :macro-result "boo\C-u-\C-cd")) + +(kmacro-tests-deftest kmacro-tests-step-edit-with-quoted-insert () + "Stepping through a macro that uses quoted insert leaves macro unchanged. +This is a regression for item 5 in Bug#24991." + (:expected-result :failed) + (let ((read-quoted-char-radix 8)) + (kmacro-tests-run-step-edit "\C-cxq17051i there" + :events '(act automatic) + :result "ḩi there" + :macro-result "\C-cxq17051i there") + (kmacro-tests-run-step-edit "g\C-cxq17051i" + :events '(act insert-1 automatic) + :sequences '("-") + :result "g-ḩi" + :macro-result "g-\C-cxq17051i"))) + +(kmacro-tests-deftest kmacro-tests-step-edit-can-replace-meta-keys () + "Replacing C-w with M-w produces the expected result. +This is a regression for item 7 in Bug#24991." + (:expected-result :failed) + (kmacro-tests-run-step-edit "abc\C-b\C-b\C-SPC\C-f\C-w\C-e\C-y" + :events '(act-repeat act-repeat + act-repeat act-repeat + replace automatic) + :sequences '("\M-w" "\C-j") + :result "abcb" + :macro-result "abc\C-b\C-b\C-SPC\C-f\M-w\C-e\C-y") + (kmacro-tests-should-insert "abcb" (kmacro-call-macro nil))) + +(kmacro-tests-deftest kmacro-tests-step-edit-ignores-qr-map-commands () + "Unimplemented commands from `query-replace-map' are ignored." + (kmacro-tests-run-step-edit "yep" + :events '(edit-replacement + act-and-show act-and-exit + delete-and-edit + recenter backup + scroll-up scroll-down + scroll-other-window + scroll-other-window-down + exit-prefix + act act act) + :result "yep" + :macro-result "yep")) + +(kmacro-tests-deftest + kmacro-tests-step-edit-edits-macro-with-extended-command () + "Step-editing a macro which uses the minibuffer can change the macro." + (let ((mac (vconcat [?\M-x] "eval-expression" '[return] + "(insert-char (+ ?a \C-e" [?1] "))" '[return])) + (mac-after (vconcat [?\M-x] "eval-expression" '[return] + "(insert-char (+ ?a \C-e" [?2] "))" '[return]))) + + (kmacro-tests-run-step-edit mac + :events '(act act-repeat + act act-repeat act + replace-1 act-repeat act) + :sequences '("2") + :result "c" + :macro-result mac-after))) + +(kmacro-tests-deftest kmacro-tests-step-edit-step-through-isearch () + "Step-editing can edit a macro which uses `isearch-backward' (Bug#22488)." + (:expected-result :failed) + (let ((mac (vconcat "test Input" '[return] + [?\C-r] "inp" '[return] "\C-cxu")) + (mac-after (vconcat "test input" '[return] + [?\C-r] "inp" '[return] "\C-cd"))) + + (kmacro-tests-run-step-edit mac + :events '(act-repeat act act + act-repeat act + replace-1) + :sequences '("\C-cd") + :result "test input\n" + :macro-result mac-after))) + +(kmacro-tests-deftest kmacro-tests-step-edit-cleans-up-hook () + "Step-editing properly cleans up `post-command-hook.' (Bug #18708)" + (:expected-result :failed) + (let (post-command-hook) + (setq-local post-command-hook '(t)) + (kmacro-tests-run-step-edit "x" + :events '(act) + :result "x" + :macro-result "x") + (kmacro-tests-simulate-command '(beginning-of-line)))) + +(cl-defun kmacro-tests-run-step-edit + (macro &key events sequences result macro-result) + "Set up and run a test of `kmacro-step-edit-macro'. + +Run `kmacro-step-edit-macro' with MACRO defined as a keyboard macro +and `read-event' and `read-key-sequence' set up to return items from +EVENTS and SEQUENCES respectively. SEQUENCES may be nil, but +EVENTS should not be. EVENTS should be a list of symbols bound +in `kmacro-step-edit-map' or `query-replace' map, and this function +will do the keymap lookup for you. SEQUENCES should contain +return values for `read-key-sequence'. + +Before running the macro, the current buffer will be erased. +RESULT is the string that should be inserted during the +step-editing process, and MACRO-RESULT is the expected value of +`last-kbd-macro' after the editing is complete." + + (let* ((kmacro-tests-events (mapcar #'kmacro-tests-get-kmacro-step-edit-key events)) + (kmacro-tests-sequences sequences)) + + (kmacro-tests-define-macro (string-to-vector macro)) + (use-local-map kmacro-tests-keymap) + (erase-buffer) + (kmacro-step-edit-macro) + (when result + (should (equal result (buffer-string)))) + (when macro-result + (should (equal last-kbd-macro (string-to-vector macro-result)))))) + +;;; Utilities: + +(defun kmacro-tests-simulate-command (command &optional arg) + "Call `ert-simulate-command' after setting `current-prefix-arg'. +Sets `current-prefix-arg' to ARG if it is non-nil, otherwise to +the second element of COMMAND, before executing COMMAND using +`ert-simulate-command'." + (let ((current-prefix-arg (or arg (cadr command)))) + (ert-simulate-command command))) + +(defun kmacro-tests-define-macro (mac) + "Define MAC as a keyboard macro using kmacro commands." + (push mac kmacro-tests-macros) + (kmacro-tests-simulate-command '(kmacro-start-macro nil)) + (should defining-kbd-macro) + (kmacro-tests-simulate-command '(kmacro-end-macro nil)) + (should (equal mac last-kbd-macro))) + +(defun kmacro-tests-get-kmacro-key (sym) + "Look up kmacro command SYM in kmacro's keymap. +Return the integer key value found." + (aref (where-is-internal sym kmacro-keymap t) 0)) + +(defun kmacro-tests-get-kmacro-step-edit-key (sym) + "Return the first key bound to SYM in `kmacro-step-edit-map'." + (let ((where (aref (where-is-internal sym kmacro-step-edit-map t) 0))) + (if (consp where) + (car where) + where))) + +(provide 'kmacro-tests) + +;;; kmacro-tests.el ends here From f6ff7bb1fcd062fe4ebf6c89890524110501583e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Thu, 2 Feb 2017 20:05:32 +0100 Subject: [PATCH 59/62] Fix indentation of multiline CSS property values * lisp/textmodes/css-mode.el (css-smie-grammar): Give colons belonging to properties higher precedence. (css--colon-inside-selector-p, css--colon-inside-funcall): New functions for helping SMIE during tokenization. (css-smie--forward-token, css-smie--backward-token): Distinguish colons belonging to properties from other colons. * test/manual/indent/css-mode.css: Add tests for the changes above. * test/manual/indent/scss-mode.scss: Ditto. --- lisp/textmodes/css-mode.el | 44 ++++++++++++++++++++++++++++--- test/manual/indent/css-mode.css | 27 +++++++++++++++++++ test/manual/indent/scss-mode.scss | 18 +++++++++++++ 3 files changed, 85 insertions(+), 4 deletions(-) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 19f74daec63..65a599d6d43 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -32,10 +32,11 @@ ;;; Code: +(require 'eww) (require 'seq) (require 'sgml-mode) (require 'smie) -(require 'eww) +(require 'subr-x) (defgroup css nil "Cascading Style Sheets (CSS) editing mode." @@ -741,7 +742,30 @@ cannot be completed sensibly: `custom-ident', (defconst css-smie-grammar (smie-prec2->grammar - (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":"))))) + (smie-precs->prec2 + '((assoc ";") + ;; Colons that belong to a CSS property. These get a higher + ;; precedence than other colons, such as colons in selectors, + ;; which are represented by a plain ":" token. + (left ":-property") + (assoc ",") + (assoc ":"))))) + +(defun css--colon-inside-selector-p () + "Return t if point looks to be inside a CSS selector. +This function is intended to be good enough to help SMIE during +tokenization, but should not be regarded as a reliable function +for determining wheter point is within a selector." + (save-excursion + (re-search-forward "[{};)]" nil t) + (eq (char-before) ?\{))) + +(defun css--colon-inside-funcall () + "Return t if point is inside a function call." + (when-let (opening-paren-pos (nth 1 (syntax-ppss))) + (save-excursion + (goto-char opening-paren-pos) + (eq (char-after) ?\()))) (defun css-smie--forward-token () (cond @@ -755,7 +779,13 @@ cannot be completed sensibly: `custom-ident', ";") ((progn (forward-comment (point-max)) (looking-at "[;,:]")) - (forward-char 1) (match-string 0)) + (forward-char 1) + (if (equal (match-string 0) ":") + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (match-string 0))) (t (smie-default-forward-token)))) (defun css-smie--backward-token () @@ -766,7 +796,13 @@ cannot be completed sensibly: `custom-ident', ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p) (> pos (point))) ";") ((memq (char-before) '(?\; ?\, ?\:)) - (forward-char -1) (string (char-after))) + (forward-char -1) + (if (eq (char-after) ?\:) + (if (or (css--colon-inside-selector-p) + (css--colon-inside-funcall)) + ":" + ":-property") + (string (char-after)))) (t (smie-default-backward-token))))) (defun css-smie-rules (kind token) diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css index 3a00739bfc4..0845c02c299 100644 --- a/test/manual/indent/css-mode.css +++ b/test/manual/indent/css-mode.css @@ -43,3 +43,30 @@ article:hover { color: black; } + +/* bug:13425 */ +div:first-child, +div:last-child, +div[disabled], +div::before { + font: 15px "Helvetica Neue", + Helvetica, + Arial, + "Nimbus Sans L", + sans-serif; + font: 15px "Helvetica Neue", Helvetica, Arial, + "Nimbus Sans L", sans-serif; + transform: matrix(1.0, 2.0, + 3.0, 4.0, + 5.0, 6.0); + transform: matrix( + 1.0, 2.0, + 3.0, 4.0, + 5.0, 6.0 + ); +} +@font-face { + src: url("Sans-Regular.eot") format("eot"), + url("Sans-Regular.woff") format("woff"), + url("Sans-Regular.ttf") format("truetype"); +} diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index e1ec90a5299..d2a4f5cc1d1 100644 --- a/test/manual/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss @@ -74,3 +74,21 @@ $list: ( ('e', #000000, #fff) ('f', #000000, #fff) ); + +// bug:13425 +div:first-child, +div:last-child { + @include foo-mixin( + $foo: 'foo', + $bar: 'bar', + ); + + font: 15px "Helvetica Neue", Helvetica, Arial, + "Nimbus Sans L", sans-serif; + + div:first-child, + div:last-child { + font: 15px "Helvetica Neue", Helvetica, Arial, + "Nimbus Sans L", sans-serif; + } +} From caf31fb5f53aef47bea1cd2e741f5d9c254c1a81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Sat, 4 Feb 2017 20:33:58 +0100 Subject: [PATCH 60/62] * test/manual/indent/scss-mode.scss: Fix indentation --- test/manual/indent/scss-mode.scss | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index d2a4f5cc1d1..f9911ad11b7 100644 --- a/test/manual/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss @@ -16,20 +16,20 @@ nav { } } nav ul { - margin: 0; - padding: 0; - list-style: none; + margin: 0; + padding: 0; + list-style: none; } nav li { - display: inline-block; + display: inline-block; } nav a var { - display: block; - padding: 6px 12px; - text-decoration: none; + display: block; + padding: 6px 12px; + text-decoration: none; } $name: foo; @@ -67,12 +67,12 @@ button { // bug:21230 $list: ( - ('a', #000000, #fff) - ('b', #000000, #fff) - ('c', #000000, #fff) - ('d', #000000, #fff) - ('e', #000000, #fff) - ('f', #000000, #fff) + ('a', #000000, #fff) + ('b', #000000, #fff) + ('c', #000000, #fff) + ('d', #000000, #fff) + ('e', #000000, #fff) + ('f', #000000, #fff) ); // bug:13425 From 394fc3fd030b8fa2f9b97c2ef3fa3b16e6f29474 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 17 Jan 2017 21:50:14 -0700 Subject: [PATCH 61/62] Set comment-multi-line in js-mode Bug#6806: * lisp/progmodes/js.el (js-mode): Set comment-multi-line to t. * test/lisp/progmodes/js-tests.el (js-mode-auto-fill): New test. --- lisp/progmodes/js.el | 1 + test/lisp/progmodes/js-tests.el | 14 ++++++++++++++ 2 files changed, 15 insertions(+) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 74dd4add9e2..e42e01481b6 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3849,6 +3849,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." comment-start-skip "\\(//+\\|/\\*+\\)\\s *") (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local c-block-comment-start-regexp "/\\*") + (setq-local comment-multi-line t) (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 84749efa45b..7cb737c30e2 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -85,6 +85,20 @@ if (!/[ (:,='\"]/.test(value)) { (should (= (current-column) x)) (forward-line)))) +(ert-deftest js-mode-auto-fill () + (with-temp-buffer + (js-mode) + (setq fill-column 70) + (insert "/* ") + (dotimes (_ 16) + (insert "test ")) + (do-auto-fill) + ;; The bug is that, after auto-fill, the second line starts with + ;; "/*", whereas it should start with " * ". + (goto-char (point-min)) + (forward-line) + (should (looking-at " \\* test")))) + (provide 'js-tests) ;;; js-tests.el ends here From 148100d98319499f0ac6f57b8be08cbd14884a5c Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sat, 4 Feb 2017 13:22:39 -0700 Subject: [PATCH 62/62] typo fix (css--colon-inside-selector-p): Fix typo in docstring. --- lisp/textmodes/css-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 65a599d6d43..0c7d76f7924 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -755,7 +755,7 @@ cannot be completed sensibly: `custom-ident', "Return t if point looks to be inside a CSS selector. This function is intended to be good enough to help SMIE during tokenization, but should not be regarded as a reliable function -for determining wheter point is within a selector." +for determining whether point is within a selector." (save-excursion (re-search-forward "[{};)]" nil t) (eq (char-before) ?\{)))