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

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

[-- Attachment #1: Type: text/plain, Size: 23 bytes --]

tags 31211 patch
quit


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Improve-simple.el-history-and-ring-pruning.patch --]
[-- Type: text/x-diff, Size: 3105 bytes --]

From 6619bb2ace89143b5194af755928bac2157fcd70 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Wed, 18 Apr 2018 18:13:26 +0100
Subject: [PATCH 1/2] Improve simple.el history and ring pruning

* lisp/simple.el (command-execute):
Fix off-by-one error in command-history pruning. (bug#31211)
(kill-new, push-mark): Prune kill-ring, mark-ring and
global-mark-ring in a single pass, as add-to-history does.
---
 lisp/simple.el | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index b51be3a8f8..f7f8da87ad 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1894,8 +1894,8 @@ command-execute
             (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)))))
+              (let ((tail (nthcdr (1- history-length) command-history)))
+                (when (cdr tail) (setcdr tail ())))))
           (execute-kbd-macro final prefixarg))
          (t
           ;; Pass `cmd' rather than `final', for the backtrace's sake.
@@ -4396,8 +4396,8 @@ kill-new
     (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 ((tail (nthcdr (1- kill-ring-max) kill-ring)))
+        (when (cdr tail) (setcdr tail ())))))
   (setq kill-ring-yank-pointer kill-ring)
   (if interprogram-cut-function
       (funcall interprogram-cut-function string)))
@@ -5705,9 +5705,10 @@ 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 ((tail (nthcdr (1- mark-ring-max) mark-ring)))
+      (when (cdr tail)
+        (set-marker (cadr tail) nil)
+        (setcdr tail ()))))
   (set-marker (mark-marker) (or location (point)) (current-buffer))
   ;; Now push the mark on the global mark ring.
   (if (and global-mark-ring
@@ -5716,9 +5717,10 @@ push-mark
       ;; 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 ((tail (nthcdr (1- global-mark-ring-max) global-mark-ring)))
+      (when (cdr tail)
+        (set-marker (cadr tail) nil)
+        (setcdr tail ()))))
   (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
       (message "Mark set"))
   (if (or activate (not transient-mark-mode))
-- 
2.17.0


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

From f9f118d46a065e9a1482300d6879a7d0163921f2 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Wed, 18 Apr 2018 17:45:35 +0100
Subject: [PATCH 2/2] Minor simple.el simplifications (bug#31211)

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

diff --git a/lisp/simple.el b/lisp/simple.el
index f7f8da87ad..0d9abf342b 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4418,18 +4418,18 @@ kill-append
 If `interprogram-cut-function' is set, pass the resulting kill to it."
   (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.
@@ -5703,20 +5703,18 @@ 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))
-    (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
+  (when (mark t)
+    (push (copy-marker (mark-marker)) mark-ring)
     (let ((tail (nthcdr (1- mark-ring-max) mark-ring)))
       (when (cdr tail)
         (set-marker (cadr tail) nil)
         (setcdr tail ()))))
   (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
-    (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
+  ;; 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)))
+    (push (copy-marker (mark-marker)) global-mark-ring)
     (let ((tail (nthcdr (1- global-mark-ring-max) global-mark-ring)))
       (when (cdr tail)
         (set-marker (cadr tail) nil)
@@ -5732,10 +5730,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) (marker-position (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 #4: Type: text/plain, Size: 392 bytes --]


"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> Patch addressing this to follow.

I attach two patches.

The first likens the history and ring pruning in command-execute,
kill-new, and push-mark to that in add-to-history, thus also fixing the
off-by-one error in command-execute.

The second suggests some minor refactors/simplifications in surrounding
functions.

Thanks,

-- 
Basil