emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master f2c7454 1/3: Fix off-by-one history pruning (bug#31


From: Noam Postavsky
Subject: [Emacs-diffs] master f2c7454 1/3: Fix off-by-one history pruning (bug#31211)
Date: Wed, 2 May 2018 20:36:00 -0400 (EDT)

branch: master
commit f2c74543edc7e8d07655b459ba8898eec9b6d4e8
Author: Basil L. Contovounesios <address@hidden>
Commit: Noam Postavsky <address@hidden>

    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 7ff3d68..705e7dd 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1793,11 +1793,8 @@ is enabled then some keybindings are changed in the 
keymap."
 
 (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 6c49b8f..c0b329b 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1464,12 +1464,7 @@ If INPUT-METHOD is nil, deactivate any current 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 @@ See `set-language-info-alist' for use in programs."
   (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 5cbb4c9..feadf10 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1049,13 +1049,12 @@ For a failing search, NOPUSH is t.
 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 f1cbdc0..a7e6a87 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2722,17 +2722,9 @@ See `read-file-name' for the meaning of the arguments."
               (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 e74f661..97fdabd 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1813,13 +1813,9 @@ If CHARSET is nil then use UTF-8."
 (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 5446159..9fde9a5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1646,13 +1646,10 @@ the minibuffer, then read and evaluate the result."
                                     '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 @@ to get different commands to edit and resubmit."
                    ;; 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 @@ a special event, so ignore the prefix argument and don't 
clear it."
           ;; 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.
@@ -4408,9 +4399,8 @@ argument should still be a \"useful\" string for such 
uses."
               (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)))
@@ -5724,10 +5714,11 @@ purposes.  See the documentation of `set-mark' for more 
information.
 
 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
@@ -5735,10 +5726,12 @@ In Transient Mark mode, activate mark if optional third 
arg ACTIVATE non-nil."
       ;; 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 9f6cade..35e220a 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1798,7 +1798,7 @@ variable.  The possible values of maximum length have the 
same meaning as
 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 @@ if it is empty or a duplicate."
          (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 08a8bba..fd44494 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 c41958d..e18c99b 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 64b341b..7a10df2 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -448,6 +448,17 @@ See Bug#21722."
         (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 9a81222..feee9b6 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]