bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one

["Basil L. Contovounesios" <contovob@tcd.ie>]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: 0001-Fix-off-by-one-history-pruning-bug-31211.patch --]
[-- Type: text/x-diff, Size: 17405 bytes --]

From 8eb4913a3d4284b0d3fd3d4df854a983260ef14a Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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))))
 
 \f
 ;;;; 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))))
+
+\f
+;;; `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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Minor-simple.el-simplifications.patch --]
[-- Type: text/x-diff, Size: 3601 bytes --]

From 4dd728ff35bc73f77286171dc177bfd8d6fd0b31 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Mon, 30 Apr 2018 00:58:32 +0100
Subject: [PATCH 2/2] Minor simple.el simplifications

* lisp/simple.el (kill-append, push-mark, pop-mark):
Simplify conditionals and surrounding code.
---
 lisp/simple.el | 46 ++++++++++++++++++++++------------------------
 1 file changed, 22 insertions(+), 24 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 971e8709f8..292c5c0d8a 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4420,20 +4420,20 @@ kill-append
 Also removes the last undo boundary in the current buffer,
  depending on `kill-append-merge-undo'.
 If `interprogram-cut-function' is set, pass the resulting kill to it."
-  (let* ((cur (car kill-ring)))
+  (let ((cur (car kill-ring)))
     (kill-new (if before-p (concat string cur) (concat cur string))
-	      (or (= (length cur) 0)
-		  (equal nil (get-text-property 0 'yank-handler cur))))
-    (when (and kill-append-merge-undo (not buffer-read-only))
-      (let ((prev buffer-undo-list)
-            (next (cdr buffer-undo-list)))
-        ;; find the next undo boundary
-        (while (car next)
-          (pop next)
-          (pop prev))
-        ;; remove this undo boundary
-        (when prev
-          (setcdr prev (cdr next)))))))
+              (or (string= cur "")
+                  (null (get-text-property 0 'yank-handler cur)))))
+  (when (and kill-append-merge-undo (not buffer-read-only))
+    (let ((prev buffer-undo-list)
+          (next (cdr buffer-undo-list)))
+      ;; Find the next undo boundary.
+      (while (car next)
+        (pop next)
+        (pop prev))
+      ;; Remove this undo boundary.
+      (when prev
+        (setcdr prev (cdr next))))))
 
 (defcustom yank-pop-change-selection nil
   "Whether rotating the kill ring changes the window system selection.
@@ -5710,19 +5710,17 @@ push-mark
 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))
+  (when (mark t)
     (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
-	   (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
-      ;; The last global mark pushed was in this same buffer.
-      ;; Don't push another one.
-      nil
+  ;; Don't push the mark on the global mark ring if the last global
+  ;; mark pushed was in this same buffer.
+  (unless (and global-mark-ring
+               (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
     (let ((old (nth global-mark-ring-max global-mark-ring))
           (history-delete-duplicates nil))
       (add-to-history
@@ -5740,10 +5738,10 @@ pop-mark
 Does not set point.  Does nothing if mark ring is empty."
   (when mark-ring
     (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
-    (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
-    (move-marker (car mark-ring) nil)
-    (if (null (mark t)) (ding))
-    (setq mark-ring (cdr mark-ring)))
+    (set-marker (mark-marker) (car mark-ring))
+    (set-marker (car mark-ring) nil)
+    (unless (mark t) (ding))
+    (pop mark-ring))
   (deactivate-mark))
 
 (define-obsolete-function-alias
-- 
2.17.0


[-- Attachment #3: Type: text/plain, Size: 470 bytes --]


Noam Postavsky <npostavs@gmail.com> writes:

> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>> The second attachment comprises the same minor lisp/simple.el touch-ups
>> as in my last email.
>
> Thanks, I'll push to master in a few days assuming there are no
> objections.

Thanks.  AFAICT the call to marker-position added in the second patch is
actually redundant, so I'm reattaching the patches with that call
removed.  Sorry about the nuisance.

-- 
Basil