mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
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.
This commit is contained in:
Basil L. Contovounesios
Noam Postavsky
parent
05e9477ab5
commit
f2c74543ed
@ -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
|
||||
|
||||
@ -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."
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user