* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
@ 2018-04-18 18:36 Basil L. Contovounesios
2018-04-18 18:43 ` Basil L. Contovounesios
0 siblings, 1 reply; 8+ messages in thread
From: Basil L. Contovounesios @ 2018-04-18 18:36 UTC (permalink / raw)
To: 31211
Evaluating the following:
(let ((history-length 1))
(dotimes (_ 2)
(command-execute #'ignore t))
(length command-history))
gives 2, instead of the expected 1.
Patch addressing this to follow.
--
Basil
In GNU Emacs 27.0.50 (build 6, x86_64-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
of 2018-04-18 built on thunk
Repository revision: 5dff4905d73d0d42447ff4b114d1af726a689c6a
Windowing system distributor 'The X.Org Foundation', version 11.0.11906000
System Description: Debian GNU/Linux buster/sid
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-18 18:36 bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one Basil L. Contovounesios
@ 2018-04-18 18:43 ` Basil L. Contovounesios
2018-04-18 18:52 ` Basil L. Contovounesios
2018-04-20 12:53 ` Noam Postavsky
0 siblings, 2 replies; 8+ messages in thread
From: Basil L. Contovounesios @ 2018-04-18 18:43 UTC (permalink / raw)
To: 31211
[-- 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
^ permalink raw reply related [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-18 18:43 ` Basil L. Contovounesios
@ 2018-04-18 18:52 ` Basil L. Contovounesios
2018-04-20 12:53 ` Noam Postavsky
1 sibling, 0 replies; 8+ messages in thread
From: Basil L. Contovounesios @ 2018-04-18 18:52 UTC (permalink / raw)
To: 31211
"Basil L. Contovounesios" <contovob@tcd.ie> writes:
> The second suggests some minor refactors/simplifications in surrounding
> functions.
P.S. I see that, with kill-append-merge-undo enabled, kill-append
removes the next undo boundary it finds in buffer-undo-list.
This search for the next undo boundary, however, starts with the
second element of buffer-undo-list. Is it reasonable to expect
that the first element of buffer-undo-list is never nil here?
--
Basil
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-18 18:43 ` Basil L. Contovounesios
2018-04-18 18:52 ` Basil L. Contovounesios
@ 2018-04-20 12:53 ` Noam Postavsky
2018-04-29 19:54 ` Basil L. Contovounesios
1 sibling, 1 reply; 8+ messages in thread
From: Noam Postavsky @ 2018-04-20 12:53 UTC (permalink / raw)
To: 31211
severity 31211 minor
quit
"Basil L. Contovounesios" <contovob@tcd.ie> writes:
> 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.
You need to change call-interactively in callint.c in order to fix the
test case from your OP though, right? This part:
/* 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);
}
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-20 12:53 ` Noam Postavsky
@ 2018-04-29 19:54 ` Basil L. Contovounesios
2018-04-29 22:43 ` Noam Postavsky
0 siblings, 1 reply; 8+ messages in thread
From: Basil L. Contovounesios @ 2018-04-29 19:54 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 31211
[-- 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: 3619 bytes --]
From d321b7fc54f7fe3d2f7817916ba37131023b4b21 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Sun, 29 Apr 2018 15:44:56 +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..590fb32d83 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) (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 #3: Type: text/plain, Size: 1050 bytes --]
Noam Postavsky <npostavs@gmail.com> writes:
> You need to change call-interactively in callint.c in order to fix the
> test case from your OP though, right? This part:
>
> /* 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);
> }
Whoops, right you are; I jumped the gun on that one.
Is there any reason why we can't use add-to-history in places like
Fcall_interactively in src/callint.c and read_minibuf in src/minibuf.c,
rather than duplicating its logic and falling into off-by-one traps?
I attach a patch which delegates to add-to-history in various such
places, on the assumption this is kosher. Please let me know whether
something like this would be acceptable and/or how it can made so.
The second attachment comprises the same minor lisp/simple.el touch-ups
as in my last email.
Thanks,
--
Basil
^ permalink raw reply related [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-29 19:54 ` Basil L. Contovounesios
@ 2018-04-29 22:43 ` Noam Postavsky
2018-04-30 0:51 ` Basil L. Contovounesios
0 siblings, 1 reply; 8+ messages in thread
From: Noam Postavsky @ 2018-04-29 22:43 UTC (permalink / raw)
To: 31211
"Basil L. Contovounesios" <contovob@tcd.ie> writes:
> Is there any reason why we can't use add-to-history in places like
> Fcall_interactively in src/callint.c and read_minibuf in src/minibuf.c,
> rather than duplicating its logic and falling into off-by-one traps?
Sometimes there can be bootstrapping problems (e.g., the C code tries to
call Lisp code that hasn't been loaded yet). In this case, I don't
think call-interactively should be needed during bootstrap, so it's
probably fine.
> I attach a patch which delegates to add-to-history in various such
> places, on the assumption this is kosher. Please let me know whether
> something like this would be acceptable and/or how it can made so.
>
> 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.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-29 22:43 ` Noam Postavsky
@ 2018-04-30 0:51 ` Basil L. Contovounesios
2018-05-03 0:37 ` Noam Postavsky
0 siblings, 1 reply; 8+ messages in thread
From: Basil L. Contovounesios @ 2018-04-30 0:51 UTC (permalink / raw)
To: Noam Postavsky; +Cc: 31211
[-- 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
^ permalink raw reply related [flat|nested] 8+ messages in thread
* bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one
2018-04-30 0:51 ` Basil L. Contovounesios
@ 2018-05-03 0:37 ` Noam Postavsky
0 siblings, 0 replies; 8+ messages in thread
From: Noam Postavsky @ 2018-05-03 0:37 UTC (permalink / raw)
To: 31211
tags 31211 fixed
close 31211 27.1
quit
"Basil L. Contovounesios" <contovob@tcd.ie> writes:
> 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.
No worries, this kind of thing is exactly why I like to wait a bit
before pushing. I've now pushed to master.
[1: f2c74543ed]: 2018-05-02 20:18:07 -0400
Fix off-by-one history pruning (bug#31211)
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=f2c74543edc7e8d07655b459ba8898eec9b6d4e8
[2: 74ff5ade80]: 2018-05-02 20:20:25 -0400
Minor simple.el simplifications (Bug#31211)
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=74ff5ade8002a1a2cc8956607310e5466f2ed596
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2018-05-03 0:37 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-04-18 18:36 bug#31211: 27.0.50; Pruning of command-history in command-execute is off by one Basil L. Contovounesios
2018-04-18 18:43 ` Basil L. Contovounesios
2018-04-18 18:52 ` Basil L. Contovounesios
2018-04-20 12:53 ` Noam Postavsky
2018-04-29 19:54 ` Basil L. Contovounesios
2018-04-29 22:43 ` Noam Postavsky
2018-04-30 0:51 ` Basil L. Contovounesios
2018-05-03 0:37 ` Noam Postavsky
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).