diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 282 |
1 files changed, 205 insertions, 77 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index c85e2cdb177..b72e75d169b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -37,6 +37,27 @@ (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 set the point in the output buffer +once the command complete. +The value `beg-last-out' set point at the beginning of the output, +`end-last-out' set point at the end of the buffer, `save-point' +restore 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 + "Point position in the output buffer after command complete. +It is an alist (BUFFER . POS), where BUFFER is the output +buffer, and POS is the point position in BUFFER once the command finish. +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 @@ -581,6 +602,11 @@ is called on the entire buffer (rather than an active region)." :group 'editing :version "24.3") +(defun region-modifiable-p (start end) + "Return non-nil if the region contains no read-only text." + (and (not (get-text-property start 'read-only)) + (eq end (next-single-property-change start 'read-only nil end)))) + (defun delete-trailing-whitespace (&optional start end) "Delete trailing whitespace between START and END. If called interactively, START and END are the start/end of the @@ -602,24 +628,26 @@ buffer if the variable `delete-trailing-lines' is non-nil." (list nil nil)))) (save-match-data (save-excursion - (let ((end-marker (copy-marker (or end (point-max)))) - (start (or start (point-min)))) - (goto-char start) - (while (re-search-forward "\\s-$" end-marker t) - (skip-syntax-backward "-" (line-beginning-position)) + (let ((end-marker (and end (copy-marker end)))) + (goto-char (or start (point-min))) + (with-syntax-table (make-syntax-table (syntax-table)) ;; Don't delete formfeeds, even if they are considered whitespace. - (if (looking-at-p ".*\f") - (goto-char (match-end 0))) - (delete-region (point) (match-end 0))) - ;; Delete trailing empty lines. - (goto-char end-marker) - (when (and (not end) - delete-trailing-lines - ;; Really the end of buffer. - (= (point-max) (1+ (buffer-size))) - (<= (skip-chars-backward "\n") -2)) - (delete-region (1+ (point)) end-marker)) - (set-marker end-marker nil)))) + (modify-syntax-entry ?\f "_") + ;; Treating \n as non-whitespace makes things easier. + (modify-syntax-entry ?\n "_") + (while (re-search-forward "\\s-+$" end-marker t) + (let ((b (match-beginning 0)) (e (match-end 0))) + (when (region-modifiable-p b e) + (delete-region b e))))) + (if end + (set-marker end-marker nil) + ;; Delete trailing empty lines. + (and delete-trailing-lines + ;; Really the end of buffer. + (= (goto-char (point-max)) (1+ (buffer-size))) + (<= (skip-chars-backward "\n") -2) + (region-modifiable-p (1+ (point)) (point-max)) + (delete-region (1+ (point)) (point-max))))))) ;; Return nil for the benefit of `write-file-functions'. nil) @@ -1079,7 +1107,9 @@ that uses or sets the mark." (interactive) (push-mark (point)) (push-mark (point-max) nil t) - (goto-char (point-min))) + ;; This is really `point-min' in most cases, but if we're in the + ;; minibuffer, this is at the end of the prompt. + (goto-char (minibuffer-prompt-end))) ;; Counting lines, one way or another. @@ -1637,6 +1667,12 @@ If the value is non-nil and not a number, we wait 2 seconds." (integer :tag "time" 2) (other :tag "on"))) +(defcustom extended-command-suggest-shorter t + "If non-nil, show a shorter M-x invocation when there is one." + :group 'keyboard + :type 'boolean + :version "26.1") + (defun execute-extended-command--shorter-1 (name length) (cond ((zerop length) (list "")) @@ -1720,7 +1756,8 @@ invoking, give a prefix argument to `execute-extended-command'." ((numberp suggest-key-bindings) suggest-key-bindings) (t 2)))))) (when (and waited (not (consp unread-command-events))) - (unless (or binding executing-kbd-macro (not (symbolp function)) + (unless (or (not extended-command-suggest-shorter) + binding executing-kbd-macro (not (symbolp function)) (<= (length (symbol-name function)) 2)) ;; There's no binding for CMD. Let's try and find the shortest ;; string to use in M-x. @@ -2880,6 +2917,10 @@ REASON describes the reason that the boundary is being added; see "Check recently changed buffers and add a boundary if necessary. REASON describes the reason that the boundary is being added; see `undo-last-boundary' for more information." + ;; (Bug #23785) All commands should ensure that there is an undo + ;; boundary whether they have changed the current buffer or not. + (when (eq cause 'command) + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))) (dolist (b undo-auto--undoably-changed-buffers) (when (buffer-live-p b) (with-current-buffer b @@ -2945,20 +2986,47 @@ behavior." (cdr buffer-undo-list)))))) (setq undo-auto--last-boundary-cause 0))))) -;; This function is called also from one place in fileio.c. We call -;; this function, rather than undoable-change because it reduces the -;; number of lisp functions we have to use fboundp for to avoid -;; bootstrap issues. -(defun undo-auto--undoable-change-no-timer () - "Record `current-buffer' as changed." - (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))) - (defun undo-auto--undoable-change () "Called after every undoable buffer change." - (undo-auto--undoable-change-no-timer) + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)) (undo-auto--boundary-ensure-timer)) ;; End auto-boundary section +(defun undo-amalgamate-change-group (handle) + "Amalgamate changes in change-group since HANDLE. +Remove all undo boundaries between the state of HANDLE and now. +HANDLE is as returned by `prepare-change-group'." + (dolist (elt handle) + (with-current-buffer (car elt) + (setq elt (cdr elt)) + (when (consp buffer-undo-list) + (let ((old-car (car-safe elt)) + (old-cdr (cdr-safe elt))) + (unwind-protect + (progn + ;; Temporarily truncate the undo log at ELT. + (when (consp elt) + (setcar elt t) (setcdr elt nil)) + (when + (or (null elt) ;The undo-log was empty. + ;; `elt' is still in the log: normal case. + (eq elt (last buffer-undo-list)) + ;; `elt' is not in the log any more, but that's because + ;; the log is "all new", so we should remove all + ;; boundaries from it. + (not (eq (last buffer-undo-list) (last old-cdr)))) + (cl-callf (lambda (x) (delq nil x)) + (if (car buffer-undo-list) + buffer-undo-list + ;; Preserve the undo-boundaries at either ends of the + ;; change-groups. + (cdr buffer-undo-list))))) + ;; Reset the modified cons cell ELT to its original content. + (when (consp elt) + (setcar elt old-car) + (setcdr elt old-cdr)))))))) + + (defcustom undo-ask-before-discard nil "If non-nil ask about discarding undo info for the current command. Normally, Emacs discards the undo info for the current command if @@ -3176,6 +3244,53 @@ output buffer and running a new command in the default buffer, :group 'shell :version "24.3") +(defun shell-command--save-pos-or-erase () + "Store a buffer position or erase the buffer. +See `shell-command-dont-erase-buffer'." + (let ((sym shell-command-dont-erase-buffer) + pos) + (setq buffer-read-only nil) + ;; Setting buffer-read-only to nil doesn't suffice + ;; if some text has a non-nil read-only property, + ;; which comint sometimes adds for prompts. + (setq pos + (cond ((eq sym 'save-point) (point)) + ((eq sym 'beg-last-out) (point-max)) + ((not sym) + (let ((inhibit-read-only t)) + (erase-buffer) nil)))) + (when pos + (goto-char (point-max)) + (push (cons (current-buffer) pos) + shell-command-saved-pos)))) + +(defun shell-command--set-point-after-cmd (&optional buffer) + "Set point in BUFFER after command complete. +BUFFER is the output buffer of the command; if nil, then defaults +to the current BUFFER. +Set point to the `cdr' of the element in `shell-command-saved-pos' +whose `car' is BUFFER." + (when shell-command-dont-erase-buffer + (let* ((sym shell-command-dont-erase-buffer) + (buf (or buffer (current-buffer))) + (pos (alist-get buf shell-command-saved-pos))) + (setq shell-command-saved-pos + (assq-delete-all buf shell-command-saved-pos)) + (when (buffer-live-p buf) + (let ((win (car (get-buffer-window-list buf))) + (pmax (with-current-buffer buf (point-max)))) + (unless (and pos (memq sym '(save-point beg-last-out))) + (setq pos pmax)) + ;; Set point in the window displaying buf, if any; otherwise + ;; display buf temporary in selected frame and set the point. + (if win + (set-window-point win pos) + (save-window-excursion + (let ((win (display-buffer + buf + '(nil (inhibit-switch-frame . t))))) + (set-window-point win pos))))))))) + (defun async-shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND asynchronously in background. @@ -3236,11 +3351,12 @@ Noninteractive callers can specify coding systems by binding The optional second argument OUTPUT-BUFFER, if non-nil, says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in current buffer. (This cannot be done asynchronously.) -In either case, the buffer is first erased, and the output is -inserted after point (leaving mark after it). +If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer +and insert the output there; a non-nil value of +`shell-command-dont-erase-buffer' prevent to erase the buffer. +If OUTPUT-BUFFER is not a buffer and not nil, insert the output +in current buffer after point leaving mark after it. +This cannot be done asynchronously. If the command terminates without error, but generates output, and you did not specify \"insert it in the current buffer\", @@ -3254,9 +3370,6 @@ If there is output and an error, and you did not specify \"insert it in the current buffer\", a message about the error goes at the end of the output. -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - If the optional third argument ERROR-BUFFER is non-nil, it is a buffer or buffer name to which to direct the command's standard error output. If it is nil, error output is mingled with regular output. @@ -3329,6 +3442,8 @@ the use of a shell (with its need to quote arguments)." (current-buffer))))) ;; Output goes in a separate buffer. ;; Preserve the match data in case called from a program. + ;; FIXME: It'd be ridiculous for an Elisp function to call + ;; shell-command and assume that it won't mess the match-data! (save-match-data (if (string-match "[ \t]*&[ \t]*\\'" command) ;; Command ending with ampersand means asynchronous. @@ -3375,13 +3490,8 @@ the use of a shell (with its need to quote arguments)." (setq buffer (get-buffer-create (or output-buffer "*Async Shell Command*")))))) (with-current-buffer buffer - (setq buffer-read-only nil) - ;; Setting buffer-read-only to nil doesn't suffice - ;; if some text has a non-nil read-only property, - ;; which comint sometimes adds for prompts. - (let ((inhibit-read-only t)) - (erase-buffer)) (display-buffer buffer '(nil (allow-no-window . t))) + (shell-command--save-pos-or-erase) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name shell-command-switch command)) @@ -3464,12 +3574,14 @@ and are only used if a pop-up buffer is displayed." ;; We have a sentinel to prevent insertion of a termination message -;; in the buffer itself. +;; in the buffer itself, and to set the point in the buffer when +;; `shell-command-dont-erase-buffer' is non-nil. (defun shell-command-sentinel (process signal) - (if (memq (process-status process) '(exit signal)) - (message "%s: %s." - (car (cdr (cdr (process-command process)))) - (substring signal 0 -1)))) + (when (memq (process-status process) '(exit signal)) + (shell-command--set-point-after-cmd (process-buffer process)) + (message "%s: %s." + (car (cdr (cdr (process-command process)))) + (substring signal 0 -1)))) (defun shell-command-on-region (start end command &optional output-buffer replace @@ -3499,16 +3611,15 @@ Otherwise it is displayed in the buffer `*Shell Command Output*'. The output is available in that buffer in both cases. If there is output and an error, a message about the error -appears at the end of the output. If there is no output, or if -output is inserted in the current buffer, the buffer `*Shell -Command Output*' is deleted. +appears at the end of the output. Optional fourth arg OUTPUT-BUFFER specifies where to put the command's output. If the value is a buffer or buffer name, -put the output there. If the value is nil, use the buffer -`*Shell Command Output*'. Any other value, excluding nil, -means to insert the output in the current buffer. In either case, -the output is inserted after point (leaving mark after it). +erase that buffer and insert the output there; a non-nil value of +`shell-command-dont-erase-buffer' prevent to erase the buffer. +If the value is nil, use the buffer `*Shell Command Output*'. +Any other non-nil value means to insert the output in the +current buffer after START. Optional fifth arg REPLACE, if non-nil, means to insert the output in place of text from START to END, putting point and mark @@ -3569,11 +3680,10 @@ interactively, this is t." (goto-char start) (and replace (push-mark (point) 'nomsg)) (setq exit-status - (call-process-region start end shell-file-name replace + (call-shell-region start end command replace (if error-file (list t error-file) - t) - nil shell-command-switch command)) + t))) ;; It is rude to delete a buffer which the command is not using. ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) @@ -3585,7 +3695,10 @@ interactively, this is t." (let ((buffer (get-buffer-create (or output-buffer "*Shell Command Output*")))) (unwind-protect - (if (eq buffer (current-buffer)) + (if (and (eq buffer (current-buffer)) + (or (not shell-command-dont-erase-buffer) + (and (not (eq buffer (get-buffer "*Shell Command Output*"))) + (not (region-active-p))))) ;; If the input is the same buffer as the output, ;; delete everything but the specified region, ;; then replace that region with the output. @@ -3604,16 +3717,14 @@ interactively, this is t." ;; output there. (let ((directory default-directory)) (with-current-buffer buffer - (setq buffer-read-only nil) (if (not output-buffer) (setq default-directory directory)) - (erase-buffer))) + (shell-command--save-pos-or-erase))) (setq exit-status - (call-process-region start end shell-file-name nil + (call-shell-region start end command nil (if error-file (list buffer error-file) - buffer) - nil shell-command-switch command))) + buffer)))) ;; Report the output. (with-current-buffer buffer (setq mode-line-process @@ -3625,8 +3736,10 @@ interactively, this is t." (format " - Exit [%d]" exit-status))))) (if (with-current-buffer buffer (> (point-max) (point-min))) ;; There's some output, display it - (display-message-or-buffer buffer) - ;; No output; error? + (progn + (display-message-or-buffer buffer) + (shell-command--set-point-after-cmd buffer)) + ;; No output; error? (let ((output (if (and error-file (< 0 (nth 7 (file-attributes error-file)))) @@ -3754,6 +3867,7 @@ support pty association, if PROGRAM is nil." (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." (setq tabulated-list-format [("Process" 15 t) + ("PID" 7 t) ("Status" 7 t) ("Buffer" 15 t) ("TTY" 12 t) @@ -3766,8 +3880,13 @@ support pty association, if PROGRAM is nil." (defun process-menu-delete-process () "Kill process at point in a `list-processes' buffer." (interactive) - (delete-process (tabulated-list-get-id)) - (revert-buffer)) + (let ((pos (point))) + (delete-process (tabulated-list-get-id)) + (revert-buffer) + (goto-char (min pos (point-max))) + (if (eobp) + (forward-line -1) + (beginning-of-line)))) (defun list-processes--refresh () "Recompute the list of processes for the Process List buffer. @@ -3780,6 +3899,7 @@ Also, delete any process that is exited or signaled." (process-query-on-exit-flag p)) (let* ((buf (process-buffer p)) (type (process-type p)) + (pid (if (process-id p) (format "%d" (process-id p)) "--")) (name (process-name p)) (status (symbol-name (process-status p))) (buf-label (if (buffer-live-p buf) @@ -3815,7 +3935,7 @@ Also, delete any process that is exited or signaled." (format " at %s b/s" speed) ""))))) (mapconcat 'identity (process-command p) " ")))) - (push (list p (vector name status buf-label tty cmd)) + (push (list p (vector name pid status buf-label tty cmd)) tabulated-list-entries)))))) (defun process-menu-visit-buffer (button) @@ -4060,7 +4180,8 @@ Also respects the obsolete wrapper hook `filter-buffer-substring-functions' \(see `with-wrapper-hook' for details about wrapper hooks), and the abnormal hook `buffer-substring-filters'. No filtering is done unless a hook says to." - (with-wrapper-hook filter-buffer-substring-functions (beg end delete) + (subr--with-wrapper-hook-no-warnings + filter-buffer-substring-functions (beg end delete) (cond ((or delete buffer-substring-filters) (save-excursion @@ -5241,6 +5362,7 @@ store it in a Lisp variable. Example: (defmacro save-mark-and-excursion (&rest body) "Like `save-excursion', but also save and restore the mark state. This macro does what `save-excursion' did before Emacs 25.1." + (declare (indent 0) (debug t)) (let ((saved-marker-sym (make-symbol "saved-marker"))) `(let ((,saved-marker-sym (save-mark-and-excursion--save))) (unwind-protect @@ -5862,7 +5984,7 @@ The value is a floating-point number." (/ (float (- (nth 3 edges) (nth 1 edges))) dlh))) ;; Returns non-nil if partial move was done. -(defun line-move-partial (arg noerror to-end) +(defun line-move-partial (arg noerror &optional _to-end) (if (< arg 0) ;; Move backward (up). ;; If already vscrolled, reduce vscroll @@ -5960,7 +6082,7 @@ The value is a floating-point number." ;; discrepancies between that and DLH. (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1)) (set-window-vscroll nil dlh t)) - (line-move-1 arg noerror to-end) + (line-move-1 arg noerror) t) ;; If there are lines above the last line, scroll-up one line. ((and vpos (> vpos 0)) @@ -5977,7 +6099,7 @@ The value is a floating-point number." ;; scrolling with cursor motion. But so far we don't have ;; a cleaner solution to the problem of making C-n do something ;; useful given a tall image. -(defun line-move (arg &optional noerror to-end try-vscroll) +(defun line-move (arg &optional noerror _to-end try-vscroll) "Move forward ARG lines. If NOERROR, don't signal an error if we can't move ARG lines. TO-END is unused. @@ -5985,7 +6107,7 @@ TRY-VSCROLL controls whether to vscroll tall lines: if either `auto-window-vscroll' or TRY-VSCROLL is nil, this function will not vscroll." (if noninteractive - (line-move-1 arg noerror to-end) + (line-move-1 arg noerror) (unless (and auto-window-vscroll try-vscroll ;; Only vscroll for single line moves (= (abs arg) 1) @@ -5995,7 +6117,7 @@ not vscroll." ;; But don't vscroll in a keyboard macro. (not defining-kbd-macro) (not executing-kbd-macro) - (line-move-partial arg noerror to-end)) + (line-move-partial arg noerror)) (set-window-vscroll nil 0 t) (if (and line-move-visual ;; Display-based column are incompatible with goal-column. @@ -6027,7 +6149,7 @@ not vscroll." (set-window-vscroll nil (- lh dlh) t)))) - (line-move-1 arg noerror to-end))))) + (line-move-1 arg noerror))))) ;; Display-based alternative to line-move-1. ;; Arg says how many lines to move. The value is t if we can move the @@ -6065,7 +6187,13 @@ If NOERROR, don't signal an error if we can't move that many lines." (setq temporary-goal-column (cons (/ (float x-pos) (frame-char-width)) - hscroll)))))) + hscroll))) + (executing-kbd-macro + ;; When we move beyond the first/last character visible in + ;; the window, posn-at-point will return nil, so we need to + ;; approximate the goal column as below. + (setq temporary-goal-column + (mod (current-column) (window-text-width))))))) (if target-hscroll (set-window-hscroll (selected-window) target-hscroll)) ;; vertical-motion can move more than it was asked to if it moves @@ -8339,7 +8467,7 @@ Returns the newly created indirect buffer." (with-current-buffer buffer (run-hooks 'clone-indirect-buffer-hook)) (when display-flag - (pop-to-buffer buffer norecord)) + (pop-to-buffer buffer nil norecord)) buffer)) |