* 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.
(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
(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
(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."
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)
(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)
(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)
'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)
;; 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))))
;; 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.
(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)))
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
;; 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))
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)))
(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.
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
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;
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,
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)
(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
(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