>From 8eb4913a3d4284b0d3fd3d4df854a983260ef14a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 29 Apr 2018 15:37:45 +0100 Subject: [PATCH 1/2] Fix off-by-one history pruning (bug#31211) * lisp/subr.el (add-to-history): Clarify docstring. Protect against negative history-length and unnecessary variable modification, as per read_minibuf. * lisp/ido.el (ido-record-command): * lisp/international/mule-cmds.el (deactivate-input-method): (set-language-environment-input-method): * lisp/isearch.el (isearch-done): * lisp/minibuffer.el (read-file-name-default): * lisp/net/eww.el (eww-save-history): * lisp/simple.el (edit-and-eval-command, repeat-complex-command): (command-execute, kill-new, push-mark): * src/callint.c (Fcall_interactively): * src/minibuf.c (read_minibuf): Delegate to add-to-history. * test/lisp/simple-tests.el (command-execute-prune-command-history): * test/src/callint-tests.el (call-interactively-prune-command-history): New tests. --- lisp/ido.el | 7 ++--- lisp/international/mule-cmds.el | 13 ++------- lisp/isearch.el | 13 ++++----- lisp/minibuffer.el | 14 ++-------- lisp/net/eww.el | 10 ++----- lisp/simple.el | 49 ++++++++++++++------------------- lisp/subr.el | 8 +++--- src/callint.c | 27 ++++-------------- src/minibuf.c | 40 ++------------------------- test/lisp/simple-tests.el | 11 ++++++++ test/src/callint-tests.el | 8 ++++++ 11 files changed, 68 insertions(+), 132 deletions(-) diff --git a/lisp/ido.el b/lisp/ido.el index 7ff3d6820b..705e7dd630 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1793,11 +1793,8 @@ ido-set-current-home (defun ido-record-command (command arg) "Add (COMMAND ARG) to `command-history' if `ido-record-commands' is non-nil." - (if ido-record-commands ; FIXME: use `when' instead of `if'? - (let ((cmd (list command arg))) - (if (or (not command-history) ; FIXME: ditto - (not (equal cmd (car command-history)))) - (setq command-history (cons cmd command-history)))))) + (when ido-record-commands + (add-to-history 'command-history (list command arg)))) (defun ido-make-prompt (item prompt) ;; Make the prompt for ido-read-internal diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 6c49b8fa6a..c0b329bbae 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1464,12 +1464,7 @@ activate-input-method (defun deactivate-input-method () "Turn off the current input method." (when current-input-method - (if input-method-history - (unless (string= current-input-method (car input-method-history)) - (setq input-method-history - (cons current-input-method - (delete current-input-method input-method-history)))) - (setq input-method-history (list current-input-method))) + (add-to-history 'input-method-history current-input-method) (unwind-protect (progn (setq input-method-function nil @@ -2022,10 +2017,8 @@ set-language-environment-input-method (let ((input-method (get-language-info language-name 'input-method))) (when input-method (setq default-input-method input-method) - (if input-method-history - (setq input-method-history - (cons input-method - (delete input-method input-method-history))))))) + (when input-method-history + (add-to-history 'input-method-history input-method))))) (defun set-language-environment-nonascii-translation (language-name) "Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME." diff --git a/lisp/isearch.el b/lisp/isearch.el index 5cbb4c941a..feadf10e8b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1049,13 +1049,12 @@ isearch-done For going to the minibuffer to edit the search string, NOPUSH is t and EDIT is t." - (if isearch-resume-in-command-history - (let ((command `(isearch-resume ,isearch-string ,isearch-regexp - ,isearch-regexp-function ,isearch-forward - ,isearch-message - ',isearch-case-fold-search))) - (unless (equal (car command-history) command) - (setq command-history (cons command command-history))))) + (when isearch-resume-in-command-history + (add-to-history 'command-history + `(isearch-resume ,isearch-string ,isearch-regexp + ,isearch-regexp-function ,isearch-forward + ,isearch-message + ',isearch-case-fold-search))) (remove-hook 'pre-command-hook 'isearch-pre-command-hook) (remove-hook 'post-command-hook 'isearch-post-command-hook) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index f1cbdc0cc3..a7e6a8761f 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2722,17 +2722,9 @@ read-file-name-default (if (string= val1 (cadr file-name-history)) (pop file-name-history) (setcar file-name-history val1))) - (if add-to-history - ;; Add the value to the history--but not if it matches - ;; the last value already there. - (let ((val1 (minibuffer-maybe-quote-filename val))) - (unless (and (consp file-name-history) - (equal (car file-name-history) val1)) - (setq file-name-history - (cons val1 - (if history-delete-duplicates - (delete val1 file-name-history) - file-name-history))))))) + (when add-to-history + (add-to-history 'file-name-history + (minibuffer-maybe-quote-filename val)))) val)))) (defun internal-complete-buffer-except (&optional buffer) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index e74f661ac7..97fdabd72b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1813,13 +1813,9 @@ eww-bookmark-mode (defun eww-save-history () (plist-put eww-data :point (point)) (plist-put eww-data :text (buffer-string)) - (push eww-data eww-history) - (setq eww-data (list :title "")) - ;; Don't let the history grow infinitely. We store quite a lot of - ;; data per page. - (when-let* ((tail (and eww-history-limit - (nthcdr eww-history-limit eww-history)))) - (setcdr tail nil))) + (let ((history-delete-duplicates nil)) + (add-to-history 'eww-history eww-data eww-history-limit t)) + (setq eww-data (list :title ""))) (defvar eww-current-buffer) diff --git a/lisp/simple.el b/lisp/simple.el index 863547a76b..971e8709f8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1646,13 +1646,10 @@ edit-and-eval-command 'command-history) ;; If command was added to command-history as a string, ;; get rid of that. We want only evaluable expressions there. - (if (stringp (car command-history)) - (setq command-history (cdr command-history))))))) + (when (stringp (car command-history)) + (pop command-history)))))) - ;; If command to be redone does not match front of history, - ;; add it to the history. - (or (equal command (car command-history)) - (setq command-history (cons command command-history))) + (add-to-history 'command-history command) (eval command))) (defun repeat-complex-command (arg) @@ -1682,13 +1679,10 @@ repeat-complex-command ;; If command was added to command-history as a ;; string, get rid of that. We want only ;; evaluable expressions there. - (if (stringp (car command-history)) - (setq command-history (cdr command-history)))))) + (when (stringp (car command-history)) + (pop command-history))))) - ;; If command to be redone does not match front of history, - ;; add it to the history. - (or (equal newcmd (car command-history)) - (setq command-history (cons newcmd command-history))) + (add-to-history 'command-history newcmd) (apply #'funcall-interactively (car newcmd) (mapcar (lambda (e) (eval e t)) (cdr newcmd)))) @@ -1905,11 +1899,8 @@ command-execute ;; If requested, place the macro in the command history. For ;; other sorts of commands, call-interactively takes care of this. (when record-flag - (push `(execute-kbd-macro ,final ,prefixarg) command-history) - ;; Don't keep command history around forever. - (when (and (numberp history-length) (> history-length 0)) - (let ((cell (nthcdr history-length command-history))) - (if (consp cell) (setcdr cell nil))))) + (add-to-history + 'command-history `(execute-kbd-macro ,final ,prefixarg) nil t)) (execute-kbd-macro final prefixarg)) (t ;; Pass `cmd' rather than `final', for the backtrace's sake. @@ -4409,9 +4400,8 @@ kill-new (equal-including-properties string (car kill-ring))) (if (and replace kill-ring) (setcar kill-ring string) - (push string kill-ring) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))) + (let ((history-delete-duplicates nil)) + (add-to-history 'kill-ring string kill-ring-max t)))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function (funcall interprogram-cut-function string))) @@ -5721,10 +5711,11 @@ push-mark In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." (unless (null (mark t)) - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (when (> (length mark-ring) mark-ring-max) - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) + (let ((old (nth mark-ring-max mark-ring)) + (history-delete-duplicates nil)) + (add-to-history 'mark-ring (copy-marker (mark-marker)) mark-ring-max t) + (when old + (set-marker old nil)))) (set-marker (mark-marker) (or location (point)) (current-buffer)) ;; Now push the mark on the global mark ring. (if (and global-mark-ring @@ -5732,10 +5723,12 @@ push-mark ;; The last global mark pushed was in this same buffer. ;; Don't push another one. nil - (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring)) - (when (> (length global-mark-ring) global-mark-ring-max) - (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) - (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))) + (let ((old (nth global-mark-ring-max global-mark-ring)) + (history-delete-duplicates nil)) + (add-to-history + 'global-mark-ring (copy-marker (mark-marker)) global-mark-ring-max t) + (when old + (set-marker old nil)))) (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) diff --git a/lisp/subr.el b/lisp/subr.el index 9f6cade0f7..35e220a10e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1798,7 +1798,7 @@ add-to-history the values of `history-length'. Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even -if it is empty or a duplicate." +if it is empty or duplicates the most recent entry in the history." (unless maxelt (setq maxelt (or (get history-var 'history-length) history-length))) @@ -1814,12 +1814,12 @@ add-to-history (setq history (delete newelt history))) (setq history (cons newelt history)) (when (integerp maxelt) - (if (= 0 maxelt) + (if (>= 0 maxelt) (setq history nil) (setq tail (nthcdr (1- maxelt) history)) (when (consp tail) - (setcdr tail nil))))) - (set history-var history))) + (setcdr tail nil)))) + (set history-var history)))) ;;;; Mode hooks. diff --git a/src/callint.c b/src/callint.c index 08a8bba464..fd44494cfe 100644 --- a/src/callint.c +++ b/src/callint.c @@ -262,7 +262,7 @@ to the function `interactive' at the top level of the function body. See `interactive'. Optional second arg RECORD-FLAG non-nil -means unconditionally put this command in the command-history. +means unconditionally put this command in the variable `command-history'. Otherwise, this is done only if an arg is read using the minibuffer. Optional third arg KEYS, if given, specifies the sequence of events to @@ -328,18 +328,8 @@ invoke it. If KEYS is omitted or nil, the return value of and turn them into things we can eval. */ Lisp_Object values = quotify_args (Fcopy_sequence (specs)); fix_command (input, values); - Lisp_Object this_cmd = Fcons (function, values); - if (history_delete_duplicates) - Vcommand_history = Fdelete (this_cmd, Vcommand_history); - Vcommand_history = Fcons (this_cmd, Vcommand_history); - - /* Don't keep command history around forever. */ - if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) - { - Lisp_Object teml = Fnthcdr (Vhistory_length, Vcommand_history); - if (CONSP (teml)) - XSETCDR (teml, Qnil); - } + call4 (intern ("add-to-history"), intern ("command-history"), + Fcons (function, values), Qnil, Qt); } Vthis_command = save_this_command; @@ -768,15 +758,8 @@ invoke it. If KEYS is omitted or nil, the return value of visargs[i] = (varies[i] > 0 ? list1 (intern (callint_argfuns[varies[i]])) : quotify_arg (args[i])); - Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1), - Vcommand_history); - /* Don't keep command history around forever. */ - if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0) - { - Lisp_Object teml = Fnthcdr (Vhistory_length, Vcommand_history); - if (CONSP (teml)) - XSETCDR (teml, Qnil); - } + call4 (intern ("add-to-history"), intern ("command-history"), + Flist (nargs - 1, visargs + 1), Qnil, Qt); } /* If we used a marker to hold point, mark, or an end of the region, diff --git a/src/minibuf.c b/src/minibuf.c index c41958d85f..e18c99bef2 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -702,44 +702,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, histstring = Qnil; /* Add the value to the appropriate history list, if any. */ - if (!NILP (Vhistory_add_new_input) - && SYMBOLP (Vminibuffer_history_variable) - && !NILP (histstring)) - { - /* If the caller wanted to save the value read on a history list, - then do so if the value is not already the front of the list. */ - - /* The value of the history variable must be a cons or nil. Other - values are unacceptable. We silently ignore these values. */ - - if (NILP (histval) - || (CONSP (histval) - /* Don't duplicate the most recent entry in the history. */ - && (NILP (Fequal (histstring, Fcar (histval)))))) - { - Lisp_Object length; - - if (history_delete_duplicates) Fdelete (histstring, histval); - histval = Fcons (histstring, histval); - Fset (Vminibuffer_history_variable, histval); - - /* Truncate if requested. */ - length = Fget (Vminibuffer_history_variable, Qhistory_length); - if (NILP (length)) length = Vhistory_length; - if (INTEGERP (length)) - { - if (XINT (length) <= 0) - Fset (Vminibuffer_history_variable, Qnil); - else - { - Lisp_Object temp; - - temp = Fnthcdr (Fsub1 (length), histval); - if (CONSP (temp)) Fsetcdr (temp, Qnil); - } - } - } - } + if (! (NILP (Vhistory_add_new_input) || NILP (histstring))) + call2 (intern ("add-to-history"), Vminibuffer_history_variable, histstring); /* If Lisp form desired instead of string, parse it. */ if (expflag) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 64b341bd46..7a10df2058 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -448,6 +448,17 @@ simple-test-undo-with-switched-buffer (call-interactively #'eval-expression) (should (equal (current-message) "66 (#o102, #x42, ?B)")))))) +(ert-deftest command-execute-prune-command-history () + "Check that Bug#31211 is fixed." + (let ((history-length 1) + (command-history ())) + (dotimes (_ (1+ history-length)) + (command-execute "" t)) + (should (= (length command-history) history-length)))) + + +;;; `line-number-at-pos' + (ert-deftest line-number-at-pos-in-widen-buffer () (let ((target-line 3)) (with-temp-buffer diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el index 9a812223ad..feee9b692b 100644 --- a/test/src/callint-tests.el +++ b/test/src/callint-tests.el @@ -43,4 +43,12 @@ (list a b)))) '("a" "b")))) +(ert-deftest call-interactively-prune-command-history () + "Check that Bug#31211 is fixed." + (let ((history-length 1) + (command-history ())) + (dotimes (_ (1+ history-length)) + (call-interactively #'ignore t)) + (should (= (length command-history) history-length)))) + ;;; callint-tests.el ends here -- 2.17.0