diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 326 |
1 files changed, 185 insertions, 141 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index 7da315e8692..26c3ff575e2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -241,7 +241,7 @@ all other buffers." (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." + "Return a single visible `next-error' buffer on the selected frame." (let ((window-buffers (delete-dups (delq nil (mapcar (lambda (w) @@ -259,7 +259,7 @@ all other buffers." extra-test-exclusive) "Try the current buffer when outside navigation. But return nil if we navigated to the current buffer by the means -of `next-error' command. Otherwise, return it if it's next-error +of `next-error' command. Otherwise, return it if it's `next-error' capable." ;; Check that next-error-buffer has no buffer-local value ;; (i.e. we never navigated to the current buffer from another), @@ -527,21 +527,28 @@ Other major modes are defined by comparison with this one." (kill-all-local-variables) (run-mode-hooks)) +(define-derived-mode clean-mode fundamental-mode "Clean" + "A mode that removes all overlays and text properties." + (kill-all-local-variables t) + (let ((inhibit-read-only t)) + (dolist (overlay (overlays-in (point-min) (point-max))) + (delete-overlay overlay)) + (set-text-properties (point-min) (point-max) nil) + (setq-local yank-excluded-properties t))) + ;; Special major modes to view specially formatted data rather than files. -(defvar special-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) - (define-key map " " 'scroll-up-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map "\C-?" 'scroll-down-command) - (define-key map "?" 'describe-mode) - (define-key map "h" 'describe-mode) - (define-key map ">" 'end-of-buffer) - (define-key map "<" 'beginning-of-buffer) - (define-key map "g" 'revert-buffer) - map)) +(defvar-keymap special-mode-map + :suppress t + "q" #'quit-window + "SPC" #'scroll-up-command + "S-SPC" #'scroll-down-command + "DEL" #'scroll-down-command + "?" #'describe-mode + "h" #'describe-mode + ">" #'end-of-buffer + "<" #'beginning-of-buffer + "g" #'revert-buffer) (put 'special-mode 'mode-class 'special) (define-derived-mode special-mode nil "Special" @@ -589,6 +596,9 @@ text-property `hard'. A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (interactive "*P\np") (barf-if-buffer-read-only) + (when (and arg + (< (prefix-numeric-value arg) 0)) + (error "Repetition argument has to be non-negative")) ;; Call self-insert so that auto-fill, abbrev expansion etc. happen. ;; Set last-command-event to tell self-insert what to insert. (let* ((was-page-start (and (bolp) (looking-at page-delimiter))) @@ -700,9 +710,10 @@ When called from Lisp code, ARG may be a prefix string to copy." :height 0.1 :background "#505050") (((type graphic) (background light)) :height 0.1 :background "#a0a0a0") - (t :foreground "ForestGreen")) + (t + :foreground "ForestGreen" :underline t)) "Face for separator lines." - :version "28.1" + :version "29.1" :group 'text) (defun make-separator-line (&optional length) @@ -710,11 +721,13 @@ When called from Lisp code, ARG may be a prefix string to copy." This uses the `separator-line' face. If LENGTH is nil, use the window width." - (if (display-graphic-p) + (if (or (display-graphic-p) + (display-supports-face-attributes-p '(:underline t))) (if length (concat (propertize (make-string length ?\s) 'face 'separator-line) "\n") (propertize "\n" 'face '(:inherit separator-line :extend t))) + ;; In terminals (that don't support underline), use a line of dashes. (concat (propertize (make-string (or length (1- (window-width))) ?-) 'face 'separator-line) "\n"))) @@ -2070,7 +2083,7 @@ This function uses the `read-extended-command-predicate' user option." "Say whether SYMBOL has been marked as a mode-specific command in BUFFER." ;; Check the modes. (let ((modes (command-modes symbol))) - ;; Common case: Just a single mode. + ;; Common fast case: Just a single mode. (if (null (cdr modes)) (or (provided-mode-derived-p (buffer-local-value 'major-mode buffer) (car modes)) @@ -2078,13 +2091,7 @@ This function uses the `read-extended-command-predicate' user option." (buffer-local-value 'local-minor-modes buffer)) (memq (car modes) global-minor-modes)) ;; Uncommon case: Multiple modes. - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - modes) - (seq-intersection modes - (buffer-local-value 'local-minor-modes buffer) - #'eq) - (seq-intersection modes global-minor-modes #'eq)))) + (command-completion-with-modes-p modes buffer)))) (defun command-completion-default-include-p (symbol buffer) "Say whether SYMBOL should be offered as a completion. @@ -2139,21 +2146,23 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER." command-names))) (defcustom suggest-key-bindings t - "Non-nil means show the equivalent key-binding when M-x command has one. + "Non-nil means show the equivalent keybinding when \ +\\[execute-extended-command] has one. The value can be a length of time to show the message for. If the value is non-nil and not a number, we wait 2 seconds. Also see `extended-command-suggest-shorter'. Equivalent key-bindings are also shown in the completion list of -M-x for all commands that have them." +\\[execute-extended-command] for all commands that have them." :group 'keyboard :type '(choice (const :tag "off" nil) - (integer :tag "time" 2) + (natnum :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. + "If non-nil, show a shorter \\[execute-extended-command] invocation \ +when there is one. Also see `suggest-key-bindings'." :group 'keyboard @@ -2219,7 +2228,9 @@ invoking, give a prefix argument to `execute-extended-command'." (let* ((function (and (stringp command-name) (intern-soft command-name))) (binding (and suggest-key-bindings (not executing-kbd-macro) - (where-is-internal function overriding-local-map t)))) + (where-is-internal function overriding-local-map t))) + (delay-before-suggest 0) + (find-shorter nil)) (unless (commandp function) (error "`%s' is not a valid command name" command-name)) ;; Some features, such as novice.el, rely on this-command-keys @@ -2234,50 +2245,52 @@ invoking, give a prefix argument to `execute-extended-command'." (setq real-this-command function) (let ((prefix-arg prefixarg)) (command-execute function 'record)) - ;; If enabled, show which key runs this command. - ;; But first wait, and skip the message if there is input. - (let* ((waited - ;; If this command displayed something in the echo area; - ;; wait a few seconds, then display our suggestion message. - ;; FIXME: Wait *after* running post-command-hook! - ;; FIXME: If execute-extended-command--shorter were - ;; faster, we could compute the result here first too. - (when (and suggest-key-bindings - (or binding - (and extended-command-suggest-shorter typed))) - (sit-for (cond - ((zerop (length (current-message))) 0) - ((numberp suggest-key-bindings) suggest-key-bindings) - (t 2)))))) - (when (and waited (not (consp unread-command-events))) - (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. - ;; FIXME: Can be slow. Cache it maybe? - (while-no-input - (setq binding (execute-extended-command--shorter - (symbol-name function) typed)))) - (when binding - ;; This is normally not necessary -- the timer should run - ;; immediately, but be defensive and ensure that we never - ;; have two of these timers in flight. - (when execute-extended-command--binding-timer - (cancel-timer execute-extended-command--binding-timer)) - (setq execute-extended-command--binding-timer - (run-at-time - 0 nil - (lambda () - (with-temp-message - (format-message "You can run the command `%s' with %s" - function - (if (stringp binding) - (concat "M-x " binding " RET") - (key-description binding))) - (sit-for (if (numberp suggest-key-bindings) - suggest-key-bindings - 2))))))))))) + ;; Ensure that we never have two of the suggest-binding timers in + ;; flight. + (when execute-extended-command--binding-timer + (cancel-timer execute-extended-command--binding-timer)) + ;; If this command displayed something in the echo area, then + ;; postpone the display of our suggestion message a bit. + (when (and suggest-key-bindings + (or binding + (and extended-command-suggest-shorter typed))) + (setq delay-before-suggest + (cond + ((zerop (length (current-message))) 0) + ((numberp suggest-key-bindings) suggest-key-bindings) + (t 2))) + (when (and extended-command-suggest-shorter + (not binding) + (not executing-kbd-macro) + (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. + (setq find-shorter t)) + (when (or binding find-shorter) + (setq execute-extended-command--binding-timer + (run-at-time + delay-before-suggest nil + (lambda () + ;; If the user has typed any other commands in the + ;; meantime, then don't display anything. + (when (eq function real-last-command) + ;; Find shorter string. + (when find-shorter + (while-no-input + ;; FIXME: Can be slow. Cache it maybe? + (setq binding (execute-extended-command--shorter + (symbol-name function) typed)))) + (when binding + (with-temp-message + (format-message "You can run the command `%s' with %s" + function + (if (stringp binding) + (concat "M-x " binding " RET") + (key-description binding))) + (sit-for (if (numberp suggest-key-bindings) + suggest-key-bindings + 2)))))))))))) (defun execute-extended-command-for-buffer (prefixarg &optional command-name typed) @@ -2942,8 +2955,9 @@ undo record: if we undo from 4, `pending-undo-list' will be at 3, (defvar undo-in-region nil "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.") -(defvar undo-no-redo nil - "If t, `undo' doesn't go through redo entries.") +(defcustom undo-no-redo nil + "If t, `undo' doesn't go through redo entries." + :type 'boolean) (defvar pending-undo-list nil "Within a run of consecutive undo commands, list remaining to be undone. @@ -3100,7 +3114,7 @@ Interactively, ARG is the prefix numeric argument and defaults to 1." (let ((undo-in-progress t)) (while (and (consp ul) (eq (car ul) nil)) (setq ul (cdr ul))) - (primitive-undo arg ul))) + (primitive-undo (or arg 1) ul))) (new-pul (undo--last-change-was-undo-p new-ul))) (message "Redo%s" (if undo-in-region " in region" "")) (setq this-command 'undo) @@ -3524,7 +3538,7 @@ with < or <= based on USE-<." ;; called or in some cases on a timer called after a change is made in ;; any buffer. (defvar-local undo-auto--last-boundary-cause nil - "Describe the cause of the last undo-boundary. + "Describe the cause of the last `undo-boundary'. If `explicit', the last boundary was caused by an explicit call to `undo-boundary', that is one not called by the code in this @@ -5065,10 +5079,11 @@ interact nicely with `interprogram-cut-function' and interaction; you may want to use them instead of manipulating the kill ring directly.") -(defcustom kill-ring-max 60 +(defcustom kill-ring-max 120 "Maximum length of kill ring before oldest elements are thrown away." :type 'integer - :group 'killing) + :group 'killing + :version "29.1") (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") @@ -5281,12 +5296,16 @@ Lisp programs should use this function for killing text. Supply two arguments, character positions BEG and END indicating the stretch of text to be killed. If the optional argument REGION is non-nil, the function ignores BEG and END, and kills the current - region instead." + region instead. Interactively, REGION is always non-nil, and so + this command always kills the current region." ;; Pass mark first, then point, because the order matters when ;; calling `kill-append'. - (interactive (list (mark) (point) 'region)) - (unless (and beg end) - (user-error "The mark is not set now, so there is no region")) + (interactive (progn + (let ((beg (mark)) + (end (point))) + (unless (and beg end) + (user-error "The mark is not set now, so there is no region")) + (list beg end 'region)))) (condition-case nil (let ((string (if region (funcall region-extract-function 'delete) @@ -6513,13 +6532,13 @@ Display `Mark set' unless the optional second arg NOMSG is non-nil." (defcustom set-mark-command-repeat-pop nil "Non-nil means repeating \\[set-mark-command] after popping mark pops it again. -That means that C-u \\[set-mark-command] \\[set-mark-command] +That means that \\[universal-argument] \\[set-mark-command] \\[set-mark-command] will pop the mark twice, and -C-u \\[set-mark-command] \\[set-mark-command] \\[set-mark-command] +\\[universal-argument] \\[set-mark-command] \\[set-mark-command] \\[set-mark-command] will pop the mark three times. A value of nil means \\[set-mark-command]'s behavior does not change -after C-u \\[set-mark-command]." +after \\[universal-argument] \\[set-mark-command]." :type 'boolean :group 'editing-basics) @@ -6624,7 +6643,6 @@ Does not set point. Does nothing if mark ring is empty." (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) (set-marker (mark-marker) (car mark-ring)) (set-marker (car mark-ring) nil) - (unless (mark t) (ding)) (pop mark-ring)) (deactivate-mark)) @@ -7779,7 +7797,9 @@ other purposes." When Visual Line mode is enabled, `word-wrap' is turned on in this buffer, and simple editing commands are redefined to act on visual lines, not logical lines. See Info node `Visual Line -Mode' for details." +Mode' for details. +Turning on this mode disables line truncation set up by +variables `truncate-lines' and `truncate-partial-width-windows'." :keymap visual-line-mode-map :group 'visual-line :lighter " Wrap" @@ -7912,8 +7932,8 @@ With argument 0, interchanges line point is in with line mark is in." (defun transpose-subr (mover arg &optional special) "Subroutine to do the work of transposing objects. Works for lines, sentences, paragraphs, etc. MOVER is a function that -moves forward by units of the given object (e.g. forward-sentence, -forward-paragraph). If ARG is zero, exchanges the current object +moves forward by units of the given object (e.g. `forward-sentence', +`forward-paragraph'). If ARG is zero, exchanges the current object with the one containing mark. If ARG is an integer, moves the current object past ARG following (if ARG is positive) or preceding (if ARG is negative) objects, leaving point after the @@ -8308,8 +8328,13 @@ non-nil." (if (eq buffer (window-buffer window)) (set-window-hscroll window 0))) nil t))) - (message "Truncate long lines %s" - (if truncate-lines "enabled" "disabled"))) + (message "Truncate long lines %s%s" + (if truncate-lines "enabled" "disabled") + (if (and truncate-lines visual-line-mode) + (progn + (visual-line-mode -1) + (format-message " and `visual-line-mode' disabled")) + ""))) (defun toggle-word-wrap (&optional arg) "Toggle whether to use word-wrapping for continuation lines. @@ -8409,16 +8434,29 @@ presented." (defcustom blink-matching-paren t "Non-nil means show matching open-paren when close-paren is inserted. -If t, highlight the paren. If `jump', briefly move cursor to its -position. If `jump-offscreen', move cursor there even if the -position is off screen. With any other non-nil value, the -off-screen position of the opening paren will be shown in the -echo area." +If this is non-nil, then when you type a closing delimiter, such as a +closing parenthesis or brace, Emacs briefly indicates the location +of the matching opening delimiter. + +The valid values are: + + t Highlight the matching open-paren if it is visible + in the window, otherwise show the text with matching + open-paren in the echo area. This is the default. + `jump' If the matching open-paren is visible in the window, + briefly move cursor to its position; otherwise show + the text with matching open-paren in the echo area. + `jump-offscreen' Briefly move cursor to the matching open-paren + even if it is not visible in the window. + nil Don't show the matching open-paren. + +Any other non-nil value is handled the same as t." + :type '(choice (const :tag "Disable" nil) - (const :tag "Highlight" t) - (const :tag "Move cursor" jump) - (const :tag "Move cursor, even if off screen" jump-offscreen)) + (const :tag "Highlight open-paren if visible" t) + (const :tag "Move cursor to open-paren if visible" jump) + (const :tag "Move cursor even if it's off screen" jump-offscreen)) :group 'paren-blinking) (defcustom blink-matching-paren-on-screen t @@ -8546,40 +8584,43 @@ The function should return non-nil if the two tokens do not match.") (current-buffer)) (sit-for blink-matching-delay)) (delete-overlay blink-matching--overlay))))) - (t - (let ((open-paren-line-string - (save-excursion - (goto-char blinkpos) - ;; Show what precedes the open in its line, if anything. - (cond - ((save-excursion (skip-chars-backward " \t") (not (bolp))) - (buffer-substring (line-beginning-position) - (1+ blinkpos))) - ;; Show what follows the open in its line, if anything. - ((save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring blinkpos - (line-end-position))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) - (concat - (buffer-substring (progn - (skip-chars-backward "\n \t") - (line-beginning-position)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring blinkpos (1+ blinkpos)))) - ;; There is nothing to show except the char itself. - (t (buffer-substring blinkpos (1+ blinkpos))))))) - (minibuffer-message - "Matches %s" - (substring-no-properties open-paren-line-string)))))))) + ((not show-paren-context-when-offscreen) + (minibuffer-message + "Matches %s" + (substring-no-properties + (blink-paren-open-paren-line-string blinkpos)))))))) + +(defun blink-paren-open-paren-line-string (pos) + "Return the line string that contains the openparen at POS." + (save-excursion + (goto-char pos) + ;; Show what precedes the open in its line, if anything. + (cond + ((save-excursion (skip-chars-backward " \t") (not (bolp))) + (buffer-substring (line-beginning-position) + (1+ pos))) + ;; Show what follows the open in its line, if anything. + ((save-excursion + (forward-char 1) + (skip-chars-forward " \t") + (not (eolp))) + (buffer-substring pos + (line-end-position))) + ;; Otherwise show the previous nonblank line, + ;; if there is one. + ((save-excursion (skip-chars-backward "\n \t") (not (bobp))) + (concat + (buffer-substring (progn + (skip-chars-backward "\n \t") + (line-beginning-position)) + (progn (end-of-line) + (skip-chars-backward " \t") + (point))) + ;; Replace the newline and other whitespace with `...'. + "..." + (buffer-substring pos (1+ pos)))) + ;; There is nothing to show except the char itself. + (t (buffer-substring pos (1+ pos)))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. @@ -8725,7 +8766,7 @@ See also `read-mail-command' concerning reading mail." (function-item :tag "Message with full Gnus features" :format "%t\n" gnus-user-agent) - (function :tag "Other")) + (symbol :tag "Other")) :version "23.2" ; sendmail->message :group 'mail) @@ -8871,7 +8912,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally. When called interactively, the user is prompted for VARIABLE and then VALUE. The current value of VARIABLE will be put in the -minibuffer history so that it can be accessed with `M-n', which +minibuffer history so that it can be accessed with \\`M-n', which makes it easier to edit it." (interactive (let* ((default-var (variable-at-point)) @@ -9575,7 +9616,7 @@ call `normal-erase-is-backspace-mode' (which see) instead." (if (if (eq normal-erase-is-backspace 'maybe) (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) - (memq window-system '(w32 ns)) + (memq window-system '(w32 ns pgtk)) (and (eq window-system 'x) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) @@ -9813,11 +9854,13 @@ warning using STRING as the message.") The argument `COMMAND' should be a symbol. -Running `M-x COMMAND RET' for the first time prompts for which +Running `\\[execute-extended-command] COMMAND RET' for \ +the first time prompts for which alternative to use and records the selected command as a custom variable. -Running `C-u M-x COMMAND RET' prompts again for an alternative +Running `\\[universal-argument] \\[execute-extended-command] COMMAND RET' \ +prompts again for an alternative and overwrites the previous choice. The variable `COMMAND-alternatives' contains an alist with @@ -9827,6 +9870,7 @@ does not have any effect until this variable is set. CUSTOMIZATIONS, if non-nil, should be composed of alternating `defcustom' keywords and values to add to the declaration of `COMMAND-alternatives' (typically :group and :version)." + (declare (indent defun)) (let* ((command-name (symbol-name command)) (varalt-name (concat command-name "-alternatives")) (varalt-sym (intern varalt-name)) |