diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 475 |
1 files changed, 255 insertions, 220 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index cbad75193a4..f8c02c1dbfe 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -37,28 +37,6 @@ (defvar compilation-current-error) (defvar compilation-context-lines) -(defcustom shell-command-dont-erase-buffer nil - "If non-nil, output buffer is not erased between shell commands. -Also, a non-nil value sets the point in the output buffer -once the command completes. -The value `beg-last-out' sets point at the beginning of the output, -`end-last-out' sets point at the end of the buffer, `save-point' -restores the buffer position before the command." - :type '(choice - (const :tag "Erase buffer" nil) - (const :tag "Set point to beginning of last output" beg-last-out) - (const :tag "Set point to end of last output" end-last-out) - (const :tag "Save point" save-point)) - :group 'shell - :version "26.1") - -(defvar shell-command-saved-pos nil - "Record of point positions in output buffers after command completion. -The value is an alist whose elements are of the form (BUFFER . POS), -where BUFFER is the output buffer, and POS is the point position -in BUFFER once the command finishes. -This variable is used when `shell-command-dont-erase-buffer' is non-nil.") - (defcustom idle-update-delay 0.5 "Idle time delay before updating various things on the screen. Various Emacs features that update auxiliary information when point moves @@ -144,6 +122,14 @@ A buffer becomes most recent when its compilation, grep, or similar mode is started, or when it is used with \\[next-error] or \\[compile-goto-error].") +(defvar next-error-buffer nil + "The buffer-local value of the most recent `next-error' buffer.") +;; next-error-buffer is made buffer-local to keep the reference +;; to the parent buffer used to navigate to the current buffer, so the +;; next call of next-buffer will use the same parent buffer to +;; continue navigation from it. +(make-variable-buffer-local 'next-error-buffer) + (defvar next-error-function nil "Function to use to find the next error in the current buffer. The function is called with 2 parameters: @@ -191,6 +177,47 @@ rejected, and the function returns nil." (and extra-test-inclusive (funcall extra-test-inclusive)))))) +(defcustom next-error-find-buffer-function #'ignore + "Function called to find a `next-error' capable buffer. +This functions takes the same three arguments as the function +`next-error-find-buffer', and should return the buffer to be +used by the subsequent invocation of the command `next-error' +and `previous-error'. +If the function returns nil, `next-error-find-buffer' will +try to use the buffer it used previously, and failing that +all other buffers." + :type '(choice (const :tag "No default" ignore) + (const :tag "Single next-error capable buffer on selected frame" + next-error-buffer-on-selected-frame) + (function :tag "Other function")) + :group 'next-error + :version "27.1") + +(defcustom next-error-found-function #'ignore + "Function called when a next locus is found and displayed. +Function is called with two arguments: a FROM-BUFFER buffer +from which next-error navigated, and a target buffer TO-BUFFER." + :type '(choice (const :tag "No default" ignore) + (function :tag "Other function")) + :group 'next-error + :version "27.1") + +(defun next-error-buffer-on-selected-frame (&optional _avoid-current + extra-test-inclusive + extra-test-exclusive) + "Return a single visible next-error buffer on the selected frame." + (let ((window-buffers + (delete-dups + (delq nil (mapcar (lambda (w) + (if (next-error-buffer-p + (window-buffer w) + t + extra-test-inclusive extra-test-exclusive) + (window-buffer w))) + (window-list)))))) + (if (eq (length window-buffers) 1) + (car window-buffers)))) + (defun next-error-find-buffer (&optional avoid-current extra-test-inclusive extra-test-exclusive) @@ -207,28 +234,28 @@ The function EXTRA-TEST-EXCLUSIVE, if non-nil, is called in each buffer that would normally be considered usable. If it returns nil, that buffer is rejected." (or - ;; 1. If one window on the selected frame displays such buffer, return it. - (let ((window-buffers - (delete-dups - (delq nil (mapcar (lambda (w) - (if (next-error-buffer-p - (window-buffer w) - avoid-current - extra-test-inclusive extra-test-exclusive) - (window-buffer w))) - (window-list)))))) - (if (eq (length window-buffers) 1) - (car window-buffers))) - ;; 2. If next-error-last-buffer is an acceptable buffer, use that. + ;; 1. If a customizable function returns a buffer, use it. + (funcall next-error-find-buffer-function avoid-current + extra-test-inclusive + extra-test-exclusive) + ;; 2. If next-error-buffer has no buffer-local value + ;; (i.e. never navigated to the current buffer from another), + ;; and the current buffer is a `next-error' capable buffer, + ;; use it unconditionally, so next-error will always use it. + (if (and (not (local-variable-p 'next-error-buffer)) + (next-error-buffer-p (current-buffer) avoid-current + extra-test-inclusive extra-test-exclusive)) + (current-buffer)) + ;; 3. If next-error-last-buffer is an acceptable buffer, use that. (if (and next-error-last-buffer (next-error-buffer-p next-error-last-buffer avoid-current extra-test-inclusive extra-test-exclusive)) next-error-last-buffer) - ;; 3. If the current buffer is acceptable, choose it. + ;; 4. If the current buffer is acceptable, choose it. (if (next-error-buffer-p (current-buffer) avoid-current extra-test-inclusive extra-test-exclusive) (current-buffer)) - ;; 4. Look for any acceptable buffer. + ;; 5. Look for any acceptable buffer. (let ((buffers (buffer-list))) (while (and buffers (not (next-error-buffer-p @@ -236,7 +263,7 @@ that buffer is rejected." extra-test-inclusive extra-test-exclusive))) (setq buffers (cdr buffers))) (car buffers)) - ;; 5. Use the current buffer as a last resort if it qualifies, + ;; 6. Use the current buffer as a last resort if it qualifies, ;; even despite AVOID-CURRENT. (and avoid-current (next-error-buffer-p (current-buffer) nil @@ -244,7 +271,7 @@ that buffer is rejected." (progn (message "This is the only buffer with error message locations") (current-buffer))) - ;; 6. Give up. + ;; 7. Give up. (error "No buffers contain error message locations"))) (defun next-error (&optional arg reset) @@ -267,8 +294,9 @@ more generally, on any buffer in Compilation mode or with Compilation Minor mode enabled, or any buffer in which `next-error-function' is bound to an appropriate function. To specify use of a particular buffer for error messages, type -\\[next-error] in that buffer when it is the only one displayed -in the current frame. +\\[next-error] in that buffer. You can also use the command +`next-error-select-buffer' to select the buffer to use for the subsequent +invocation of `next-error'. Once \\[next-error] has chosen the buffer for error messages, it runs `next-error-hook' with `run-hooks', and stays with that buffer @@ -279,23 +307,51 @@ To control which errors are matched, customize the variable `compilation-error-regexp-alist'." (interactive "P") (if (consp arg) (setq reset t arg nil)) - (when (setq next-error-last-buffer (next-error-find-buffer)) - ;; we know here that next-error-function is a valid symbol we can funcall - (with-current-buffer next-error-last-buffer - (funcall next-error-function (prefix-numeric-value arg) reset) - (when next-error-recenter - (recenter next-error-recenter)) - (run-hooks 'next-error-hook)))) + (let ((buffer (next-error-find-buffer))) + (when buffer + ;; We know here that next-error-function is a valid symbol we can funcall + (with-current-buffer buffer + (funcall next-error-function (prefix-numeric-value arg) reset) + (next-error-found buffer (current-buffer)) + (message "%s locus from %s" + (cond (reset "First") + ((eq (prefix-numeric-value arg) 0) "Current") + ((< (prefix-numeric-value arg) 0) "Previous") + (t "Next")) + next-error-last-buffer))))) (defun next-error-internal () "Visit the source code corresponding to the `next-error' message at point." - (setq next-error-last-buffer (current-buffer)) - ;; we know here that next-error-function is a valid symbol we can funcall - (with-current-buffer next-error-last-buffer + (let ((buffer (current-buffer))) + ;; We know here that next-error-function is a valid symbol we can funcall (funcall next-error-function 0 nil) - (when next-error-recenter - (recenter next-error-recenter)) - (run-hooks 'next-error-hook))) + (next-error-found buffer (current-buffer)) + (message "Current locus from %s" next-error-last-buffer))) + +(defun next-error-found (&optional from-buffer to-buffer) + "Function to call when the next locus is found and displayed. +FROM-BUFFER is a buffer from which next-error navigated, +and TO-BUFFER is a target buffer." + (setq next-error-last-buffer (or from-buffer (current-buffer))) + (when to-buffer + (with-current-buffer to-buffer + (setq next-error-buffer from-buffer))) + (when next-error-recenter + (recenter next-error-recenter)) + (funcall next-error-found-function from-buffer to-buffer) + (run-hooks 'next-error-hook)) + +(defun next-error-select-buffer (buffer) + "Select a `next-error' capable BUFFER and set it as the last used. +This means that the selected buffer becomes the source of locations +for the subsequent invocation of `next-error' or `previous-error'. +Interactively, this command allows selection only among buffers +where `next-error-function' is bound to an appropriate function." + (interactive + (list (get-buffer + (read-buffer "Select next-error buffer: " nil nil + (lambda (b) (next-error-buffer-p (cdr b))))))) + (setq next-error-last-buffer buffer)) (defalias 'goto-next-locus 'next-error) (defalias 'next-match 'next-error) @@ -306,7 +362,9 @@ To control which errors are matched, customize the variable Prefix arg N says how many error messages to move backwards (or forwards, if negative). -This operates on the output from the \\[compile] and \\[grep] commands." +This operates on the output from the \\[compile] and \\[grep] commands. + +See `next-error' for the details." (interactive "p") (next-error (- (or n 1)))) @@ -1103,6 +1161,7 @@ the actual saved text might be different from what was killed." (defun mark-whole-buffer () "Put point at beginning and mark at end of buffer. +Also push mark at point before pushing mark at end of buffer. If narrowing is in effect, only uses the accessible part of the buffer. You probably should not use this function in Lisp programs; it is usually a mistake for a Lisp function to use any subroutine @@ -1588,13 +1647,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) @@ -1624,13 +1680,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)))) @@ -1847,11 +1900,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. @@ -2941,7 +2991,7 @@ that calls `undo-auto-amalgamate'." (defun undo-auto--ensure-boundary (cause) "Add an `undo-boundary' to the current buffer if needed. REASON describes the reason that the boundary is being added; see -`undo-auto--last-boundary' for more information." +`undo-auto--last-boundary-cause' for more information." (when (and (undo-auto--needs-boundary-p)) (let ((last-amalgamating @@ -2990,10 +3040,10 @@ default values.") "Add an `undo-boundary' in appropriate buffers." (undo-auto--boundaries (let ((amal undo-auto--this-command-amalgamating)) - (setq undo-auto--this-command-amalgamating nil) - (if amal - 'amalgamate - 'command)))) + (setq undo-auto--this-command-amalgamating nil) + (if amal + 'amalgamate + 'command)))) (defun undo-auto-amalgamate () "Amalgamate undo if necessary. @@ -3006,30 +3056,38 @@ behavior." (let ((last-amalgamating-count (undo-auto--last-boundary-amalgamating-number))) (setq undo-auto--this-command-amalgamating t) - (when - last-amalgamating-count - (if - (and - (< last-amalgamating-count 20) - (eq this-command last-command)) + (when last-amalgamating-count + (if (and (< last-amalgamating-count 20) + (eq this-command last-command)) ;; Amalgamate all buffers that have changed. + ;; This may be needed for example if some *-change-functions + ;; reflected these changes in some other buffer. (dolist (b (cdr undo-auto--last-boundary-cause)) (when (buffer-live-p b) (with-current-buffer b - (when - ;; The head of `buffer-undo-list' is nil. - ;; `car-safe' doesn't work because - ;; `buffer-undo-list' need not be a list! - (and (listp buffer-undo-list) - (not (car buffer-undo-list))) + (when (and (consp buffer-undo-list) + ;; `car-safe' doesn't work because + ;; `buffer-undo-list' need not be a list! + (null (car buffer-undo-list))) + ;; The head of `buffer-undo-list' is nil. (setq buffer-undo-list (cdr buffer-undo-list)))))) (setq undo-auto--last-boundary-cause 0))))) (defun undo-auto--undoable-change () "Called after every undoable buffer change." - (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)) + (unless (memq (current-buffer) undo-auto--undoably-changed-buffers) + (let ((bufs undo-auto--undoably-changed-buffers)) + ;; Drop dead buffers from the list, to avoid memory leak in + ;; (while t (with-temp-buffer (setq buffer-undo-list nil) (insert "a"))) + (while bufs + (let ((next (cdr bufs))) + (if (or (buffer-live-p (car bufs)) (null next)) + (setq bufs next) + (setcar bufs (car next)) + (setcdr bufs (cdr next)))))) + (push (current-buffer) undo-auto--undoably-changed-buffers)) (undo-auto--boundary-ensure-timer)) ;; End auto-boundary section @@ -3142,61 +3200,6 @@ which is defined in the `warnings' library.\n") (setq buffer-undo-list nil) t)) -(defcustom password-word-equivalents - '("password" "passcode" "passphrase" "pass phrase" - ; These are sorted according to the GNU en_US locale. - "암호" ; ko - "パスワード" ; ja - "ପ୍ରବେଶ ସଙ୍କେତ" ; or - "ពាក្យសម្ងាត់" ; km - "adgangskode" ; da - "contraseña" ; es - "contrasenya" ; ca - "geslo" ; sl - "hasło" ; pl - "heslo" ; cs, sk - "iphasiwedi" ; zu - "jelszó" ; hu - "lösenord" ; sv - "lozinka" ; hr, sr - "mật khẩu" ; vi - "mot de passe" ; fr - "parola" ; tr - "pasahitza" ; eu - "passord" ; nb - "passwort" ; de - "pasvorto" ; eo - "salasana" ; fi - "senha" ; pt - "slaptažodis" ; lt - "wachtwoord" ; nl - "كلمة السر" ; ar - "ססמה" ; he - "лозинка" ; sr - "пароль" ; kk, ru, uk - "गुप्तशब्द" ; mr - "शब्दकूट" ; hi - "પાસવર્ડ" ; gu - "సంకేతపదము" ; te - "ਪਾਸਵਰਡ" ; pa - "ಗುಪ್ತಪದ" ; kn - "கடவுச்சொல்" ; ta - "അടയാളവാക്ക്" ; ml - "গুপ্তশব্দ" ; as - "পাসওয়ার্ড" ; bn_IN - "රහස්පදය" ; si - "密码" ; zh_CN - "密碼" ; zh_TW - ) - "List of words equivalent to \"password\". -This is used by Shell mode and other parts of Emacs to recognize -password prompts, including prompts in languages other than -English. Different case choices should not be assumed to be -included; callers should bind `case-fold-search' to t." - :type '(repeat string) - :version "24.4" - :group 'processes) - (defvar shell-command-history nil "History list for some commands that read shell commands. @@ -3296,6 +3299,28 @@ is output." :group 'shell :version "26.1") +(defcustom shell-command-dont-erase-buffer nil + "If non-nil, output buffer is not erased between shell commands. +Also, a non-nil value sets the point in the output buffer +once the command completes. +The value `beg-last-out' sets point at the beginning of the output, +`end-last-out' sets point at the end of the buffer, `save-point' +restores the buffer position before the command." + :type '(choice + (const :tag "Erase buffer" nil) + (const :tag "Set point to beginning of last output" beg-last-out) + (const :tag "Set point to end of last output" end-last-out) + (const :tag "Save point" save-point)) + :group 'shell + :version "26.1") + +(defvar shell-command-saved-pos nil + "Record of point positions in output buffers after command completion. +The value is an alist whose elements are of the form (BUFFER . POS), +where BUFFER is the output buffer, and POS is the point position +in BUFFER once the command finishes. +This variable is used when `shell-command-dont-erase-buffer' is non-nil.") + (defun shell-command--save-pos-or-erase () "Store a buffer position or erase the buffer. See `shell-command-dont-erase-buffer'." @@ -3376,6 +3401,8 @@ a shell (with its need to quote arguments)." (setq command (concat command " &"))) (shell-command command output-buffer error-buffer)) +(declare-function comint-output-filter "comint" (process string)) + (defun shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND in inferior shell; display output, if any. With prefix argument, insert the COMMAND's output at point. @@ -3453,12 +3480,11 @@ impose the use of a shell (with its need to quote arguments)." (not (or (bufferp output-buffer) (stringp output-buffer)))) ;; Output goes in current buffer. (let ((error-file - (if error-buffer - (make-temp-file - (expand-file-name "scor" - (or small-temporary-file-directory - temporary-file-directory))) - nil))) + (and error-buffer + (make-temp-file + (expand-file-name "scor" + (or small-temporary-file-directory + temporary-file-directory)))))) (barf-if-buffer-read-only) (push-mark nil t) ;; We do not use -f for csh; we will not support broken use of @@ -3466,24 +3492,22 @@ impose the use of a shell (with its need to quote arguments)." ;; "if ($?prompt) exit" before things which are not useful ;; non-interactively. Besides, if someone wants their other ;; aliases for shell commands then they can still have them. - (call-process shell-file-name nil - (if error-file - (list t error-file) - t) - nil shell-command-switch command) + (call-process-shell-command command nil (if error-file + (list t error-file) + t)) (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) - (with-current-buffer (get-buffer-create error-buffer) - (let ((pos-from-end (- (point-max) (point)))) - (or (bobp) - (insert "\f\n")) - ;; Do no formatting while reading error file, - ;; because that can run a shell command, and we - ;; don't want that to cause an infinite recursion. - (format-insert-file error-file nil) - ;; Put point after the inserted errors. - (goto-char (- (point-max) pos-from-end))) - (display-buffer (current-buffer)))) + (when (< 0 (file-attribute-size (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (display-buffer (current-buffer)))) (delete-file error-file)) ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -3502,12 +3526,11 @@ impose the use of a shell (with its need to quote arguments)." (let* ((buffer (get-buffer-create (or output-buffer "*Async Shell Command*"))) (bname (buffer-name buffer)) - (directory default-directory) - proc) + (proc (get-buffer-process buffer)) + (directory default-directory)) ;; Remove the ampersand. (setq command (substring command 0 (match-beginning 0))) ;; Ask the user what to do with already running process. - (setq proc (get-buffer-process buffer)) (when proc (cond ((eq async-shell-command-buffer 'confirm-kill-process) @@ -3539,14 +3562,14 @@ impose the use of a shell (with its need to quote arguments)." (with-current-buffer buffer (shell-command--save-pos-or-erase) (setq default-directory directory) - (setq proc (start-process "Shell" buffer shell-file-name - shell-command-switch command)) + (setq proc + (start-process-shell-command "Shell" buffer command)) (setq mode-line-process '(":%s")) (require 'shell) (shell-mode) - (set-process-sentinel proc 'shell-command-sentinel) + (set-process-sentinel proc #'shell-command-sentinel) ;; Use the comint filter for proper handling of ;; carriage motion (see comint-inhibit-carriage-motion). - (set-process-filter proc 'comint-output-filter) + (set-process-filter proc #'comint-output-filter) (if async-shell-command-display-buffer ;; Display buffer immediately. (display-buffer buffer '(nil (allow-no-window . t))) @@ -3846,7 +3869,7 @@ interactively, this is t." (with-output-to-string (with-current-buffer standard-output - (process-file shell-file-name nil t nil shell-command-switch command)))) + (shell-command command t)))) (defun process-file (program &optional infile buffer display &rest args) "Process files synchronously in a separate process. @@ -3929,7 +3952,9 @@ support pty association, if PROGRAM is nil." (setq tabulated-list-format [("Process" 15 t) ("PID" 7 t) ("Status" 7 t) - ("Buffer" 15 t) + ;; 25 is the length of the long standard buffer + ;; name "*Async Shell Command*<10>" (bug#30016) + ("Buffer" 25 t) ("TTY" 12 t) ("Command" 0 t)]) (make-local-variable 'process-menu-query-only) @@ -4363,7 +4388,8 @@ argument should still be a \"useful\" string for such uses." (funcall interprogram-paste-function)))) (when interprogram-paste (dolist (s (if (listp interprogram-paste) - (nreverse interprogram-paste) + ;; Use `reverse' to avoid modifying external data. + (reverse interprogram-paste) (list interprogram-paste))) (unless (and kill-do-not-save-duplicates (equal-including-properties s (car kill-ring))) @@ -4372,9 +4398,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))) @@ -4397,20 +4422,20 @@ If `interprogram-cut-function' is non-nil, call it with the resulting kill. If `kill-append-merge-undo' is non-nil, remove the last undo boundary in the current buffer." - (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. @@ -4444,9 +4469,13 @@ move the yanking point; just return the Nth kill forward." ;; Disable the interprogram cut function when we add the new ;; text to the kill ring, so Emacs doesn't try to own the ;; selection, with identical text. - (let ((interprogram-cut-function nil)) + ;; Also disable the interprogram paste function, so that + ;; `kill-new' doesn't call it repeatedly. + (let ((interprogram-cut-function nil) + (interprogram-paste-function nil)) (if (listp interprogram-paste) - (mapc 'kill-new (nreverse interprogram-paste)) + ;; Use `reverse' to avoid modifying external data. + (mapc #'kill-new (reverse interprogram-paste)) (kill-new interprogram-paste))) (car kill-ring)) (or kill-ring (error "Kill ring is empty")) @@ -5683,22 +5712,23 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong 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))) + (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 - (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))) + ;; 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 + '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)) @@ -5710,10 +5740,10 @@ In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil." 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 @@ -7859,7 +7889,7 @@ buffer buried." (eq mail-user-agent 'message-user-agent) (let (warn-vars) (dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook - mail-yank-hooks mail-archive-file-name + mail-citation-hook mail-archive-file-name mail-default-reply-to mail-mailing-lists mail-self-blind)) (and (boundp var) @@ -7877,6 +7907,8 @@ To disable this warning, set `compose-mail-user-agent-warnings' to nil." warn-vars " ")))))) (let ((function (get mail-user-agent 'composefunc))) + (unless function + (error "Invalid value for `mail-user-agent'")) (funcall function to subject other-headers continue switch-function yank-action send-actions return-action))) @@ -8520,13 +8552,16 @@ after it has been set up properly in other respects." ;; Set up other local variables. (mapc (lambda (v) - (condition-case () ;in case var is read-only + (condition-case () (if (symbolp v) (makunbound v) (set (make-local-variable (car v)) (cdr v))) - (error nil))) + (setting-constant nil))) ;E.g. for enable-multibyte-characters. lvars) + (setq mark-ring (mapcar (lambda (mk) (copy-marker (marker-position mk))) + mark-ring)) + ;; Run any hooks (typically set up by the major mode ;; for cloning to work properly). (run-hooks 'clone-buffer-hook)) @@ -8951,7 +8986,7 @@ Otherwise, it calls `upcase-word', with prefix argument passed to it to upcase ARG words." (interactive "*p") (if (use-region-p) - (upcase-region (region-beginning) (region-end)) + (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) (upcase-word arg))) (defun downcase-dwim (arg) @@ -8961,7 +8996,7 @@ Otherwise, it calls `downcase-word', with prefix argument passed to it to downcase ARG words." (interactive "*p") (if (use-region-p) - (downcase-region (region-beginning) (region-end)) + (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) (downcase-word arg))) (defun capitalize-dwim (arg) |