diff options
Diffstat (limited to 'lisp/simple.el')
| -rw-r--r-- | lisp/simple.el | 875 |
1 files changed, 622 insertions, 253 deletions
diff --git a/lisp/simple.el b/lisp/simple.el index 568debaa612..7da315e8692 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -138,6 +138,10 @@ messages are highlighted; this helps to see what messages were visited." nil "Overlay highlighting the current error message in the `next-error' buffer.") +(defvar global-minor-modes nil + "A list of the currently enabled global minor modes. +This is a list of symbols.") + (defcustom next-error-hook nil "List of hook functions run by `next-error' after visiting source file." :type 'hook @@ -186,7 +190,7 @@ to navigate in it.") It takes two arguments, a buffer position in the error buffer and a buffer position in the error locus buffer. The buffer for the error locus should already be current. -nil means use goto-char using the second argument position.") +nil means use `goto-char' using the second argument position.") (defsubst next-error-buffer-p (buffer &optional avoid-current @@ -234,15 +238,6 @@ all other buffers." :group 'next-error :version "28.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) @@ -382,9 +377,29 @@ To control which errors are matched, customize the variable (not (eq prev next-error-last-buffer))) (message "Current locus from %s" next-error-last-buffer))))) +(defun next-error-quit-window (from-buffer to-buffer) + "Quit window of FROM-BUFFER when the prefix arg is 0. +Intended to be used in `next-error-found-function'." + (when (and (eq current-prefix-arg 0) from-buffer + (not (eq from-buffer to-buffer))) + (let ((window (get-buffer-window from-buffer))) + (when (window-live-p window) + (quit-restore-window window))))) + +(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) + (const :tag "Quit previous window with M-0" + next-error-quit-window) + (function :tag "Other function")) + :group 'next-error + :version "27.1") + (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, +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 @@ -545,7 +560,7 @@ It must be called via `run-hook-with-args-until-success' with no arguments. If any function on this hook returns a non-nil value, `delete-selection-mode' will act on that value (see `delete-selection-helper') and will usually delete the region. If all the functions on this hook return -nil, it is an indiction that `self-insert-command' needs the region +nil, it is an indication that `self-insert-command' needs the region untouched by `delete-selection-mode' and will itself do whatever is appropriate with the region. Any function on `post-self-insert-hook' that acts on the region should @@ -582,10 +597,12 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; Don't auto-fill if we have a prefix argument. (auto-fill-function (if arg nil auto-fill-function)) (arg (prefix-numeric-value arg)) + (procsym (make-symbol "newline-postproc")) ;(bug#46326) (postproc ;; Do the rest in post-self-insert-hook, because we want to do it ;; *before* other functions on that hook. (lambda () + (remove-hook 'post-self-insert-hook procsym t) ;; Mark the newline(s) `hard'. (if use-hard-newlines (set-hard-newline-properties @@ -604,6 +621,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; starts a page. (or was-page-start (move-to-left-margin nil t))))) + (fset procsym postproc) (if (not interactive) ;; FIXME: For non-interactive uses, many calls actually ;; just want (insert "\n"), so maybe we should do just @@ -613,13 +631,13 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (self-insert-command arg)) (unwind-protect (progn - (add-hook 'post-self-insert-hook postproc nil t) + (add-hook 'post-self-insert-hook procsym nil t) (self-insert-command arg)) ;; We first used let-binding to protect the hook, but that ;; was naive since add-hook affects the symbol-default ;; value of the variable, whereas the let-binding might ;; protect only the buffer-local value. - (remove-hook 'post-self-insert-hook postproc t)))) + (remove-hook 'post-self-insert-hook procsym t)))) nil) (defun set-hard-newline-properties (from to) @@ -677,6 +695,30 @@ When called from Lisp code, ARG may be a prefix string to copy." (indent-to col 0) (goto-char pos))) +(defface separator-line + '((((type graphic) (background dark)) + :height 0.1 :background "#505050") + (((type graphic) (background light)) + :height 0.1 :background "#a0a0a0") + (t :foreground "ForestGreen")) + "Face for separator lines." + :version "28.1" + :group 'text) + +(defun make-separator-line (&optional length) + "Make a string appropriate for usage as a visual separator line. +This uses the `separator-line' face. + +If LENGTH is nil, use the window width." + (if (display-graphic-p) + (if length + (concat (propertize (make-string length ?\s) 'face 'separator-line) + "\n") + (propertize "\n" 'face '(:inherit separator-line :extend t))) + (concat (propertize (make-string (or length (1- (window-width))) ?-) + 'face 'separator-line) + "\n"))) + (defun delete-indentation (&optional arg beg end) "Join this line to previous and fix up whitespace at join. If there is a fill prefix, delete it from the beginning of this @@ -821,7 +863,10 @@ In programming language modes, this is the same as TAB. In some text modes, where TAB inserts a tab, this command indents to the column specified by the function `current-left-margin'. -With ARG, perform this action that many times." +With ARG, perform this action that many times. + +Also see `open-line' (bound to \\[open-line]) for a command that +just inserts a newline without doing any indentation." (interactive "*p") (delete-horizontal-space t) (unless arg @@ -1274,7 +1319,19 @@ that uses or sets the mark." ;; Counting lines, one way or another. -(defvar-local goto-line-history nil +(defcustom goto-line-history-local nil + "If this option is nil, `goto-line-history' is shared between all buffers. +If it is non-nil, each buffer has its own value of this history list. + +Note that on changing from non-nil to nil, the former contents of +`goto-line-history' for each buffer are discarded on use of +`goto-line' in that buffer." + :group 'editing + :type 'boolean + :safe #'booleanp + :version "28.1") + +(defvar goto-line-history nil "History of values entered with `goto-line'.") (defun goto-line-read-args (&optional relative) @@ -1292,6 +1349,11 @@ that uses or sets the mark." (if buffer (concat " in " (buffer-name buffer)) ""))) + ;; Has the buffer locality of `goto-line-history' changed? + (cond ((and goto-line-history-local (not (local-variable-p 'goto-line-history))) + (make-local-variable 'goto-line-history)) + ((and (not goto-line-history-local) (local-variable-p 'goto-line-history)) + (kill-local-variable 'goto-line-history))) ;; Read the argument, offering that number (if any) as default. (list (read-number (format "Goto%s line%s: " (if (buffer-narrowed-p) @@ -1623,6 +1685,7 @@ in *Help* buffer. See also the command `describe-char'." (define-key m "\t" 'completion-at-point) (define-key m "\r" 'read--expression-try-read) (define-key m "\n" 'read--expression-try-read) + (define-key m "\M-g\M-c" 'read-expression-switch-to-completions) (set-keymap-parent m minibuffer-local-map) m)) @@ -1765,8 +1828,8 @@ moving point." (defun eval-expression-get-print-arguments (prefix-argument) "Get arguments for commands that print an expression result. -Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) -based on PREFIX-ARG. This function determines the interpretation +Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) based +on PREFIX-ARGUMENT. This function determines the interpretation of the prefix argument for `eval-expression' and `eval-last-sexp'." (let ((num (prefix-numeric-value prefix-argument))) @@ -1809,31 +1872,34 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (if (null eval-expression-debug-on-error) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) - - (let ((print-length (unless no-truncate eval-expression-print-length)) - (print-level (unless no-truncate eval-expression-print-level)) - (eval-expression-print-maximum-character char-print-limit) - (deactivate-mark)) - (let ((out (if insert-value (current-buffer) t))) - (prog1 - (prin1 (car values) out) - (let ((str (and char-print-limit - (eval-expression-print-format (car values))))) - (when str (princ str out))))))) + (let (result) + (if (null eval-expression-debug-on-error) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) + + (let ((print-length (unless no-truncate eval-expression-print-length)) + (print-level (unless no-truncate eval-expression-print-level)) + (eval-expression-print-maximum-character char-print-limit) + (deactivate-mark)) + (let ((out (if insert-value (current-buffer) t))) + (prog1 + (prin1 result out) + (let ((str (and char-print-limit + (eval-expression-print-format result)))) + (when str (princ str out)))))))) (defun edit-and-eval-command (prompt command) "Prompting with PROMPT, let user edit COMMAND and eval result. @@ -1897,55 +1963,160 @@ to get different commands to edit and resubmit." (defvar extended-command-history nil) (defvar execute-extended-command--last-typed nil) +(defcustom read-extended-command-predicate nil + "Predicate to use to determine which commands to include when completing. +If it's nil, include all the commands. +If it's a function, it will be called with two parameters: the +symbol of the command and a buffer. The predicate should return +non-nil if the command should be present when doing `M-x TAB' +in that buffer." + :version "28.1" + :group 'completion + :type '(choice (const :tag "Don't exclude any commands" nil) + (const :tag "Exclude commands irrelevant to current buffer's mode" + command-completion-default-include-p) + (function :tag "Other function"))) + (defun read-extended-command () - "Read command name to invoke in `execute-extended-command'." - (minibuffer-with-setup-hook - (lambda () - (add-hook 'post-self-insert-hook - (lambda () - (setq execute-extended-command--last-typed - (minibuffer-contents))) - nil 'local) - (setq-local minibuffer-default-add-function - (lambda () - ;; Get a command name at point in the original buffer - ;; to propose it after M-n. - (let ((def (with-current-buffer - (window-buffer (minibuffer-selected-window)) - (and (commandp (function-called-at-point)) - (format "%S" (function-called-at-point))))) - (all (sort (minibuffer-default-add-completions) - #'string<))) - (if def - (cons def (delete def all)) - all))))) - ;; Read a string, completing from and restricting to the set of - ;; all defined commands. Don't provide any initial input. - ;; Save the command read on the extended-command history list. - (completing-read - (concat (cond - ((eq current-prefix-arg '-) "- ") - ((and (consp current-prefix-arg) - (eq (car current-prefix-arg) 4)) "C-u ") - ((and (consp current-prefix-arg) - (integerp (car current-prefix-arg))) - (format "%d " (car current-prefix-arg))) - ((integerp current-prefix-arg) - (format "%d " current-prefix-arg))) - ;; This isn't strictly correct if `execute-extended-command' - ;; is bound to anything else (e.g. [menu]). - ;; It could use (key-description (this-single-command-keys)), - ;; but actually a prompt other than "M-x" would be confusing, - ;; because "M-x" is a well-known prompt to read a command - ;; and it serves as a shorthand for "Extended command: ". - "M-x ") - (lambda (string pred action) - (if (and suggest-key-bindings (eq action 'metadata)) - '(metadata - (affixation-function . read-extended-command--affixation) - (category . command)) - (complete-with-action action obarray string pred))) - #'commandp t nil 'extended-command-history))) + "Read command name to invoke in `execute-extended-command'. +This function uses the `read-extended-command-predicate' user option." + (let ((buffer (current-buffer))) + (minibuffer-with-setup-hook + (lambda () + (add-hook 'post-self-insert-hook + (lambda () + (setq execute-extended-command--last-typed + (minibuffer-contents))) + nil 'local) + (setq-local minibuffer-default-add-function + (lambda () + ;; Get a command name at point in the original buffer + ;; to propose it after M-n. + (let ((def + (with-current-buffer + (window-buffer (minibuffer-selected-window)) + (and (commandp (function-called-at-point)) + (format + "%S" (function-called-at-point))))) + (all (sort (minibuffer-default-add-completions) + #'string<))) + (if def + (cons def (delete def all)) + all))))) + ;; Read a string, completing from and restricting to the set of + ;; all defined commands. Don't provide any initial input. + ;; Save the command read on the extended-command history list. + (completing-read + (concat (cond + ((eq current-prefix-arg '-) "- ") + ((and (consp current-prefix-arg) + (eq (car current-prefix-arg) 4)) + "C-u ") + ((and (consp current-prefix-arg) + (integerp (car current-prefix-arg))) + (format "%d " (car current-prefix-arg))) + ((integerp current-prefix-arg) + (format "%d " current-prefix-arg))) + ;; This isn't strictly correct if `execute-extended-command' + ;; is bound to anything else (e.g. [menu]). + ;; It could use (key-description (this-single-command-keys)), + ;; but actually a prompt other than "M-x" would be confusing, + ;; because "M-x" is a well-known prompt to read a command + ;; and it serves as a shorthand for "Extended command: ". + (if (memq 'shift (event-modifiers last-command-event)) + "M-X " + "M-x ")) + (lambda (string pred action) + (if (and suggest-key-bindings (eq action 'metadata)) + '(metadata + (affixation-function . read-extended-command--affixation) + (category . command)) + (let ((pred + (if (memq action '(nil t)) + ;; Exclude from completions obsolete commands + ;; lacking a `current-name', or where `when' is + ;; not the current major version. + (lambda (sym) + (let ((obsolete (get sym 'byte-obsolete-info))) + (and (funcall pred sym) + (or (equal string (symbol-name sym)) + (not obsolete) + (and + ;; Has a current-name. + (functionp (car obsolete)) + ;; when >= emacs-major-version + (condition-case nil + (>= (car (version-to-list + (caddr obsolete))) + emacs-major-version) + ;; If the obsoletion version isn't + ;; valid, include the command. + (error t))))))) + pred))) + (complete-with-action action obarray string pred)))) + (lambda (sym) + (and (commandp sym) + (cond ((null read-extended-command-predicate)) + ((functionp read-extended-command-predicate) + ;; Don't let bugs break M-x completion; interpret + ;; them as the absence of a predicate. + (condition-case-unless-debug err + (funcall read-extended-command-predicate sym buffer) + (error (message "read-extended-command-predicate: %s: %s" + sym (error-message-string err)))))))) + t nil 'extended-command-history)))) + +(defun command-completion-using-modes-p (symbol buffer) + "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. + (if (null (cdr modes)) + (or (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) (car modes)) + (memq (car modes) + (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)))) + +(defun command-completion-default-include-p (symbol buffer) + "Say whether SYMBOL should be offered as a completion. +If there's a `completion-predicate' for SYMBOL, the result from +calling that predicate is called. If there isn't one, this +predicate is true if the command SYMBOL is applicable to the +major mode in BUFFER, or any of the active minor modes in +BUFFER." + (if (get symbol 'completion-predicate) + ;; An explicit completion predicate takes precedence. + (funcall (get symbol 'completion-predicate) symbol buffer) + (or (null (command-modes symbol)) + (command-completion-using-modes-p symbol buffer)))) + +(defun command-completion-with-modes-p (modes buffer) + "Say whether MODES are in action in BUFFER. +This is the case if either the major mode is derived from one of MODES, +or (if one of MODES is a minor mode), if it is switched on in BUFFER." + (or (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes) + ;; It's a minor mode. + (seq-intersection modes + (buffer-local-value 'local-minor-modes buffer) + #'eq) + (seq-intersection modes global-minor-modes #'eq))) + +(defun command-completion-button-p (category buffer) + "Return non-nil if there's a button of CATEGORY at point in BUFFER." + (with-current-buffer buffer + (and (get-text-property (point) 'button) + (eq (get-text-property (point) 'category) category)))) (defun read-extended-command--affixation (command-names) (with-selected-window (or (minibuffer-selected-window) (selected-window)) @@ -1960,8 +2131,11 @@ to get different commands to edit and resubmit." (obsolete (format " (%s)" (car obsolete))) ((and binding (not (stringp binding))) - (format " (%s)" (key-description binding)))))) - (if suffix (list command-name suffix) command-name))) + (format " (%s)" (key-description binding))) + (t "")))) + (put-text-property 0 (length suffix) + 'face 'completions-annotations suffix) + (list command-name "" suffix))) command-names))) (defcustom suggest-key-bindings t @@ -2020,6 +2194,8 @@ Also see `suggest-key-bindings'." (setq binding candidate)))) binding)) +(defvar execute-extended-command--binding-timer nil) + (defun execute-extended-command (prefixarg &optional command-name typed) ;; Based on Fexecute_extended_command in keyboard.c of Emacs. ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 @@ -2084,15 +2260,56 @@ invoking, give a prefix argument to `execute-extended-command'." (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)))))))) + ;; 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))))))))))) + +(defun execute-extended-command-for-buffer (prefixarg &optional + command-name typed) + "Query user for a command relevant for the current mode, and then execute it. +This is like `execute-extended-command', but it limits the +completions to commands that are particularly relevant to the +current buffer. This includes commands that have been marked as +being specially designed for the current major mode (and enabled +minor modes), as well as commands bound in the active local key +maps." + (declare (interactive-only command-execute)) + (interactive + (let* ((execute-extended-command--last-typed nil) + (keymaps + ;; The major mode's keymap and any active minor modes. + (cons + (current-local-map) + (mapcar + #'cdr + (seq-filter + (lambda (elem) + (symbol-value (car elem))) + minor-mode-map-alist)))) + (read-extended-command-predicate + (lambda (symbol buffer) + (or (command-completion-using-modes-p symbol buffer) + (where-is-internal symbol keymaps))))) + (list current-prefix-arg + (read-extended-command) + execute-extended-command--last-typed))) + (with-suppressed-warnings ((interactive-only execute-extended-command)) + (execute-extended-command prefixarg command-name typed))) (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. @@ -2646,7 +2863,6 @@ or to the last history element for a backward search." (if isearch-forward (goto-history-element (length (minibuffer-history-value))) (goto-history-element 0)) - (setq isearch-success t) (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max)))) (defun minibuffer-history-isearch-push-state () @@ -2674,8 +2890,10 @@ Go to the history element by the absolute history position HIST-POS." The same as `command-error-default-function' but display error messages at the end of the minibuffer using `minibuffer-message' to not obscure the minibuffer contents." - (discard-input) - (ding) + (if (memq 'minibuffer-quit (get (car data) 'error-conditions)) + (ding t) + (discard-input) + (ding)) (let ((string (error-message-string data))) ;; If we know from where the error was signaled, show it in ;; *Messages*. @@ -2691,8 +2909,35 @@ the minibuffer contents." (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t) "Table mapping redo records to the corresponding undo one. -A redo record for undo-in-region maps to t. -A redo record for ordinary undo maps to the following (earlier) undo.") +A redo record for an undo in region maps to 'undo-in-region. +A redo record for ordinary undo maps to the following (earlier) undo. +A redo record that undoes to the beginning of the undo list maps to t. +In the rare case where there are (erroneously) consecutive nil's in +`buffer-undo-list', `undo' maps the previous valid undo record to +'empty, if the previous record is a redo record, `undo' doesn't change +its mapping. + +To be clear, a redo record is just an undo record, the only difference +is that it is created by an undo command (instead of an ordinary buffer +edit). Since a record used to undo ordinary change is called undo +record, a record used to undo an undo is called redo record. + +`undo' uses this table to make sure the previous command is `undo'. +`undo-redo' uses this table to set the correct `pending-undo-list'. + +When you undo, `pending-undo-list' shrinks and `buffer-undo-list' +grows, and Emacs maps the tip of `buffer-undo-list' to the tip of +`pending-undo-list' in this table. + +For example, consider this undo list where each node represents an +undo record: if we undo from 4, `pending-undo-list' will be at 3, +`buffer-undo-list' at 5, and 5 will map to 3. + + | + 3 5 + | / + |/ + 4") (defvar undo-in-region nil "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.") @@ -2739,7 +2984,9 @@ as an argument limits undo to changes within the current region." ;; the next command should not be a "consecutive undo". ;; So set `this-command' to something other than `undo'. (setq this-command 'undo-start) - + ;; Here we decide whether to break the undo chain. If the + ;; previous command is `undo', we don't call `undo-start', i.e., + ;; don't break the undo chain. (unless (and (eq last-command 'undo) (or (eq pending-undo-list t) ;; If something (a timer or filter?) changed the buffer @@ -2768,7 +3015,7 @@ as an argument limits undo to changes within the current region." ;; undo-redo-undo-redo-... so skip to the very last equiv. (while (let ((next (gethash equiv undo-equiv-table))) (if next (setq equiv next)))) - (setq pending-undo-list equiv))) + (setq pending-undo-list (if (consp equiv) equiv t)))) (undo-more (if (numberp arg) (prefix-numeric-value arg) @@ -2784,11 +3031,17 @@ as an argument limits undo to changes within the current region." (while (eq (car list) nil) (setq list (cdr list))) (puthash list - ;; Prevent identity mapping. This can happen if - ;; consecutive nils are erroneously in undo list. - (if (or undo-in-region (eq list pending-undo-list)) - t - pending-undo-list) + (cond + (undo-in-region 'undo-in-region) + ;; Prevent identity mapping. This can happen if + ;; consecutive nils are erroneously in undo list. It + ;; has to map to _something_ so that the next `undo' + ;; command recognizes that the previous command is + ;; `undo' and doesn't break the undo chain. + ((eq list pending-undo-list) + (or (gethash list undo-equiv-table) + 'empty)) + (t pending-undo-list)) undo-equiv-table)) ;; Don't specify a position in the undo record for the undo command. ;; Instead, undoing this should move point to where the change is. @@ -2910,8 +3163,7 @@ Return what remains of the list." (and (consp time) (equal (list (car time) (cdr time)) (visited-file-modtime)))) - (when (fboundp 'unlock-buffer) - (unlock-buffer)) + (unlock-buffer) (set-buffer-modified-p nil))) ;; Element (nil PROP VAL BEG . END) is property change. (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) @@ -3102,7 +3354,7 @@ list can be applied to the current buffer." undo-elt) (while ulist (when undo-no-redo - (while (gethash ulist undo-equiv-table) + (while (consp (gethash ulist undo-equiv-table)) (setq ulist (gethash ulist undo-equiv-table)))) (setq undo-elt (car ulist)) (cond @@ -3188,8 +3440,7 @@ is not *inside* the region START...END." (> (cdr undo-elt) start))))) (defun undo-adjust-elt (elt deltas) - "Return adjustment of undo element ELT by the undo DELTAS -list." + "Return adjustment of undo element ELT by the undo DELTAS list." (pcase elt ;; POSITION ((pred integerp) @@ -3233,8 +3484,7 @@ list." ;; There was no strong reason to prefer one or the other, except that ;; the first is more consistent with prior undo in region behavior. (defun undo-adjust-beg-end (beg end deltas) - "Return cons of adjustments to BEG and END by the undo DELTAS -list." + "Return cons of adjustments to BEG and END by the undo DELTAS list." (let ((adj-beg (undo-adjust-pos beg deltas))) ;; Note: option 2 above would be like (cons (min ...) adj-end) (cons adj-beg @@ -4004,12 +4254,22 @@ impose the use of a shell (with its need to quote arguments)." (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) +(defun max-mini-window-lines (&optional frame) + "Compute maximum number of lines for echo area in FRAME. +As defined by `max-mini-window-height'. FRAME defaults to the +selected frame. Result may be a floating-point number, +i.e. include a fractional number of lines." + (cond ((floatp max-mini-window-height) (* (frame-height frame) + max-mini-window-height)) + ((integerp max-mini-window-height) max-mini-window-height) + (t 1))) + (defun display-message-or-buffer (message &optional buffer-name action frame) "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer. MESSAGE may be either a string or a buffer. A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long -for maximum height of the echo area, as defined by `max-mini-window-height' +for maximum height of the echo area, as defined by `max-mini-window-lines' if `resize-mini-windows' is non-nil. Returns either the string shown in the echo area, or when a pop-up @@ -4023,11 +4283,11 @@ the contents are inserted into the buffer anyway. Optional arguments ACTION and FRAME are as for `display-buffer', and are used only if a pop-up buffer is displayed." - (cond ((and (stringp message) (not (string-match "\n" message))) + (cond ((and (stringp message) (not (string-search "\n" message))) ;; Trivial case where we can use the echo area (message "%s" message)) ((and (stringp message) - (= (string-match "\n" message) (1- (length message)))) + (= (string-search "\n" message) (1- (length message)))) ;; Trivial case where we can just remove single trailing newline (message "%s" (substring message 0 (1- (length message))))) (t @@ -4048,14 +4308,7 @@ and are used only if a pop-up buffer is displayed." (cond ((= lines 0)) ((and (or (<= lines 1) (<= lines - (if resize-mini-windows - (cond ((floatp max-mini-window-height) - (* (frame-height) - max-mini-window-height)) - ((integerp max-mini-window-height) - max-mini-window-height) - (t - 1)) + (if resize-mini-windows (max-mini-window-lines) 1))) ;; Don't use the echo area if the output buffer is ;; already displayed in the selected frame. @@ -4121,7 +4374,7 @@ 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 -around it. +around it. If REPLACE is the symbol `no-mark', don't set the mark. Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer or buffer name to which to direct the command's standard error @@ -4196,7 +4449,9 @@ characters." (let ((swap (and replace (< start end)))) ;; Don't muck with mark unless REPLACE says we should. (goto-char start) - (and replace (push-mark (point) 'nomsg)) + (when (and replace + (not (eq replace 'no-mark))) + (push-mark (point) 'nomsg)) (setq exit-status (call-shell-region start end command replace (if error-file @@ -4207,7 +4462,9 @@ characters." ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) ;; (kill-buffer shell-buffer))) ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark))) + (when (and replace swap + (not (eq replace 'no-mark))) + (exchange-point-and-mark))) ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. (let ((buffer (get-buffer-create @@ -4537,7 +4794,7 @@ see other processes running on the system, use `list-system-processes'." (setq prefix-command--last-echo (let ((strs nil)) (run-hook-wrapped 'prefix-command-echo-keystrokes-functions - (lambda (fun) (push (funcall fun) strs))) + (lambda (fun) (push (funcall fun) strs) nil)) (setq strs (delq nil strs)) (when strs (mapconcat #'identity strs " ")))))) @@ -4817,12 +5074,19 @@ ring directly.") "The tail of the kill ring whose car is the last thing yanked.") (defcustom save-interprogram-paste-before-kill nil - "Save existing clipboard text into kill ring before replacing it. -A non-nil value ensures that Emacs kill operations do not -irrevocably overwrite existing clipboard text by saving it to the -`kill-ring' prior to the kill. Such text can subsequently be -retrieved via \\[yank] \\[yank-pop]." - :type 'boolean + "Whether to save existing clipboard text into kill ring before replacing it. +A non-nil value means the clipboard text is saved to the `kill-ring' +prior to any kill command. Such text can subsequently be retrieved +via \\[yank] \\[yank-pop]. This ensures that Emacs kill operations +do not irrevocably overwrite existing clipboard text. + +The value of this variable can also be a number, in which case the +clipboard data is only saved to the `kill-ring' if it's shorter +(in characters) than that number. Any other non-nil value will save +the clipboard data unconditionally." + :type '(choice (const nil) + number + (other :tag "Always" t)) :group 'killing :version "23.2") @@ -4833,6 +5097,16 @@ The comparison is done using `equal-including-properties'." :group 'killing :version "23.2") +(defcustom kill-transform-function nil + "Function to call to transform a string before it's put on the kill ring. +The function is called with one parameter (the string that's to +be put on the kill ring). It should return a string or nil. If +the latter, the string is not put on the kill ring." + :type '(choice (const :tag "No transform" nil) + function) + :group 'killing + :version "28.1") + (defun kill-new (string &optional replace) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. @@ -4848,33 +5122,41 @@ When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code may access and use elements from the kill ring directly, the STRING argument should still be a \"useful\" string for such uses." - (unless (and kill-do-not-save-duplicates - ;; Due to text properties such as 'yank-handler that - ;; can alter the contents to yank, comparison using - ;; `equal' is unsafe. - (equal-including-properties string (car kill-ring))) - (if (fboundp 'menu-bar-update-yank-menu) - (menu-bar-update-yank-menu string (and replace (car kill-ring))))) - (when save-interprogram-paste-before-kill - (let ((interprogram-paste (and interprogram-paste-function - (funcall interprogram-paste-function)))) - (when interprogram-paste - (dolist (s (if (listp 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))) - (push s kill-ring)))))) - (unless (and kill-do-not-save-duplicates - (equal-including-properties string (car kill-ring))) - (if (and replace kill-ring) - (setcar kill-ring string) - (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))) + ;; Allow the user to transform or ignore the string. + (when (or (not kill-transform-function) + (setq string (funcall kill-transform-function string))) + (unless (and kill-do-not-save-duplicates + ;; Due to text properties such as 'yank-handler that + ;; can alter the contents to yank, comparison using + ;; `equal' is unsafe. + (equal-including-properties string (car kill-ring))) + (if (fboundp 'menu-bar-update-yank-menu) + (menu-bar-update-yank-menu string (and replace (car kill-ring))))) + (when save-interprogram-paste-before-kill + (let ((interprogram-paste (and interprogram-paste-function + (funcall interprogram-paste-function)))) + (when interprogram-paste + (setq interprogram-paste + (if (listp interprogram-paste) + ;; Use `reverse' to avoid modifying external data. + (reverse interprogram-paste) + (list interprogram-paste))) + (when (or (not (numberp save-interprogram-paste-before-kill)) + (< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0) + save-interprogram-paste-before-kill)) + (dolist (s interprogram-paste) + (unless (and kill-do-not-save-duplicates + (equal-including-properties s (car kill-ring))) + (push s kill-ring))))))) + (unless (and kill-do-not-save-duplicates + (equal-including-properties string (car kill-ring))) + (if (and replace kill-ring) + (setcar kill-ring string) + (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)))) ;; It has been argued that this should work like `self-insert-command' ;; which merges insertions in `buffer-undo-list' in groups of 20 @@ -5056,8 +5338,7 @@ region instead. This command's old key binding has been given to `kill-ring-save'." ;; Pass mark first, then point, because the order matters when ;; calling `kill-append'. - (interactive (list (mark) (point) - (prefix-numeric-value current-prefix-arg))) + (interactive (list (mark) (point) 'region)) (let ((str (if region (funcall region-extract-function nil) (filter-buffer-substring beg end)))) @@ -5089,8 +5370,7 @@ This command is similar to `copy-region-as-kill', except that it gives visual feedback indicating the extent of the region being copied." ;; Pass mark first, then point, because the order matters when ;; calling `kill-append'. - (interactive (list (mark) (point) - (prefix-numeric-value current-prefix-arg))) + (interactive (list (mark) (point) 'region)) (copy-region-as-kill beg end region) ;; This use of called-interactively-p is correct because the code it ;; controls just gives the user visual feedback. @@ -5356,29 +5636,29 @@ Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.") "Replace just-yanked stretch of killed text with a different stretch. The main use of this command is immediately after a `yank' or a `yank-pop'. At such a time, the region contains a stretch of -reinserted previously-killed text. `yank-pop' deletes that text -and inserts in its place a different stretch of killed text by -traversing the value of the `kill-ring' variable. +reinserted (\"pasted\") previously-killed text. `yank-pop' deletes +that text and inserts in its place a different stretch of killed text +by traversing the value of the `kill-ring' variable and selecting +another kill from there. With no argument, the previous kill is inserted. With argument N, insert the Nth previous kill. -If N is negative, this is a more recent kill. +If N is negative, it means to use a more recent kill. -The sequence of kills wraps around, so that after the oldest one -comes the newest one. +The sequence of kills wraps around, so if you keep invoking this command +time after time, and pass the oldest kill, you get the newest one. + +You can also invoke this command after a command other than `yank' +or `yank-pop'. This is the same as invoking `yank-from-kill-ring', +including the effect of the prefix argument; see there for the details. This command honors the `yank-handled-properties' and `yank-excluded-properties' variables, and the `yank-handler' text -property, in the way that `yank' does. - -When this command is called not immediately after a `yank' or a -`yank-pop', then it activates the minibuffer with its completion -and history filled with previously-killed items from the -`kill-ring' variable, and reads a string to yank at point. -See `yank-from-kill-ring' for more details." +property, in the way that `yank' does." (interactive "p") (if (not (eq last-command 'yank)) - (yank-from-kill-ring (read-from-kill-ring) current-prefix-arg) + (yank-from-kill-ring (read-from-kill-ring "Yank from kill-ring: ") + current-prefix-arg) (setq this-command 'yank) (unless arg (setq arg 1)) (let ((inhibit-read-only t) @@ -5467,11 +5747,15 @@ With ARG, rotate that many kills forward (or backward, if negative)." (current-kill arg)) (defvar read-from-kill-ring-history) -(defun read-from-kill-ring () - "Read a string from `kill-ring' using completion and minibuffer history." +(defun read-from-kill-ring (prompt) + "Read a `kill-ring' entry using completion and minibuffer history. +PROMPT is a string to prompt with." ;; `current-kill' updates `kill-ring' with a possible interprogram-paste (current-kill 0) (let* ((history-add-new-input nil) + (history-pos (when yank-from-kill-ring-rotate + (- (length kill-ring) + (length kill-ring-yank-pointer)))) (ellipsis (if (char-displayable-p ?…) "…" "...")) ;; Remove keymaps from text properties of copied string, ;; because typing RET in the minibuffer might call @@ -5512,32 +5796,61 @@ With ARG, rotate that many kills forward (or backward, if negative)." (define-key map "?" nil) map))) (completing-read - "Yank from kill-ring: " + prompt (lambda (string pred action) (if (eq action 'metadata) ;; Keep sorted by recency '(metadata (display-sort-function . identity)) (complete-with-action action completions string pred))) nil nil nil - 'read-from-kill-ring-history)))) + (if history-pos + (cons 'read-from-kill-ring-history + (if (zerop history-pos) history-pos (1+ history-pos))) + 'read-from-kill-ring-history))))) + +(defcustom yank-from-kill-ring-rotate t + "Whether using `yank-from-kill-ring' should rotate `kill-ring-yank-pointer'. +If non-nil, the kill ring is rotated after selecting previously killed text." + :type 'boolean + :group 'killing + :version "28.1") (defun yank-from-kill-ring (string &optional arg) - "Insert the `kill-ring' item selected from the minibuffer history. -Use minibuffer navigation and search commands to browse the -previously-killed items from the `kill-ring' variable in the -minibuffer history before typing RET to insert the selected item, -or use completion on the elements of `kill-ring'. You can edit -the item in the minibuffer before inserting it. - -With \\[universal-argument] as argument, put point at beginning, -and mark at end, like `yank' does." - (interactive (list (read-from-kill-ring) current-prefix-arg)) + "Select a stretch of previously killed text and insert (\"paste\") it. +This command allows to choose one of the stretches of text killed +or yanked by previous commands, which are recorded in `kill-ring', +and reinsert the chosen kill at point. + +This command prompts for a previously-killed text in the minibuffer. +Use the minibuffer history and search commands, or the minibuffer +completion commands, to select a previously-killed text. In +particular, typing \\<minibuffer-local-completion-map>\\[minibuffer-complete] at the prompt will pop up a buffer showing +all the previously-killed stretches of text from which you can +choose the one you want to reinsert. +Once you select the text you want to reinsert, type \\<minibuffer-local-map>\\[exit-minibuffer] to actually +insert it and exit the minibuffer. +You can also edit the selected text in the minibuffer before +inserting it. + +With \\[universal-argument] as argument, this command puts point at +beginning of the inserted text and mark at the end, like `yank' does. + +When called from Lisp, insert STRING like `insert-for-yank' does." + (interactive (list (read-from-kill-ring "Yank from kill-ring: ") + current-prefix-arg)) + (setq yank-window-start (window-start)) (push-mark) (insert-for-yank string) + (when yank-from-kill-ring-rotate + (let ((pos (seq-position kill-ring string))) + (if pos + (setq kill-ring-yank-pointer (nthcdr pos kill-ring)) + (kill-new string)))) (if (consp arg) - ;; Swap point and mark like in `yank'. + ;; Swap point and mark like in `yank' and `yank-pop'. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))))) + ;; Some kill commands. @@ -5566,7 +5879,13 @@ Can be `untabify' -- turn a tab to many spaces, then delete one space; (defun backward-delete-char-untabify (arg &optional killp) "Delete characters backward, changing tabs into spaces. The exact behavior depends on `backward-delete-char-untabify-method'. + Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. + +If Transient Mark mode is enabled, the mark is active, and ARG is 1, +delete the text in the region and deactivate the mark instead. +To disable this, set option ‘delete-active-region’ to nil. + Interactively, ARG is the prefix arg (default 1) and KILLP is t if a prefix arg was specified." (interactive "*p\nP") @@ -5881,8 +6200,9 @@ START and END specify the portion of the current buffer to be copied." (defvar activate-mark-hook nil "Hook run when the mark becomes active. -It is also run at the end of a command, if the mark is active and -it is possible that the region may have changed.") +It is also run when the region is reactivated, for instance after +using a command that switches back to a buffer that has an active +mark.") (defvar deactivate-mark-hook nil "Hook run when the mark becomes inactive.") @@ -6340,9 +6660,16 @@ is temporarily turned on. Furthermore, the mark will be deactivated by any subsequent point motion key that was not shift-translated, or by any action that normally deactivates the mark in Transient Mark mode. +When the value is `permanent', the mark will be deactivated by any +action which normally does that, but not by motion keys that were +not shift-translated. + See `this-command-keys-shift-translated' for the meaning of shift-translation." - :type 'boolean + :type '(choice (const :tag "Off" nil) + (const :tag "Permanent" permanent) + (other :tag "On" t)) + :version "28.1" :group 'editing-basics) (defun handle-shift-selection () @@ -6360,7 +6687,12 @@ translation. Otherwise, if the region has been activated temporarily, deactivate it, and restore the variable `transient-mark-mode' to its earlier value." - (cond ((and shift-select-mode this-command-keys-shift-translated) + (cond ((and (eq shift-select-mode 'permanent) + this-command-keys-shift-translated) + (unless mark-active + (push-mark nil nil t))) + ((and shift-select-mode + this-command-keys-shift-translated) (unless (and mark-active (eq (car-safe transient-mark-mode) 'only)) (setq-local transient-mark-mode @@ -6399,6 +6731,10 @@ or \"mark.*active\" at the prompt." ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. :variable (default-value 'transient-mark-mode)) +(define-minor-mode indent-tabs-mode + "Toggle whether indentation can insert TAB characters." + :global t :group 'indent :variable indent-tabs-mode) + (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. Some commands will do this in order to go to positions outside @@ -6729,11 +7065,13 @@ The value is a floating-point number." (or (null rbot) (= rbot 0))) nil) ;; If cursor is not in the bottom scroll margin, and the - ;; current line is not too tall, move forward. + ;; current line is not too tall, or if there's a continuation + ;; line below this one, move forward. ((and (or (null this-height) (<= this-height winh)) vpos (> vpos 0) - (< py last-line)) + (or (< py last-line) + (display--line-is-continued-p))) nil) ;; When already vscrolled, we vscroll some more if we can, ;; or clear vscroll and move forward at end of tall image. @@ -7502,44 +7840,53 @@ are interchanged." (interactive "*p") (transpose-subr 'forward-word arg)) -(defun transpose-sexps (arg) +(defun transpose-sexps (arg &optional interactive) "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps. Unlike `transpose-words', point must be between the two sexps and not in the middle of a sexp to be transposed. With non-zero prefix arg ARG, effect is to take the sexp before point and drag it forward past ARG other sexps (backward if ARG is negative). If ARG is zero, the sexps ending at or after point and at or after mark -are interchanged." - (interactive "*p") - (transpose-subr - (lambda (arg) - ;; Here we should try to simulate the behavior of - ;; (cons (progn (forward-sexp x) (point)) - ;; (progn (forward-sexp (- x)) (point))) - ;; Except that we don't want to rely on the second forward-sexp - ;; putting us back to where we want to be, since forward-sexp-function - ;; might do funny things like infix-precedence. - (if (if (> arg 0) - (looking-at "\\sw\\|\\s_") - (and (not (bobp)) - (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_")))) - ;; Jumping over a symbol. We might be inside it, mind you. - (progn (funcall (if (> arg 0) - 'skip-syntax-backward 'skip-syntax-forward) - "w_") - (cons (save-excursion (forward-sexp arg) (point)) (point))) - ;; Otherwise, we're between sexps. Take a step back before jumping - ;; to make sure we'll obey the same precedence no matter which direction - ;; we're going. - (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .") - (cons (save-excursion (forward-sexp arg) (point)) - (progn (while (or (forward-comment (if (> arg 0) 1 -1)) - (not (zerop (funcall (if (> arg 0) - 'skip-syntax-forward - 'skip-syntax-backward) - "."))))) - (point))))) - arg 'special)) +are interchanged. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "*p\nd") + (if interactive + (condition-case nil + (transpose-sexps arg nil) + (scan-error (user-error "Not between two complete sexps"))) + (transpose-subr + (lambda (arg) + ;; Here we should try to simulate the behavior of + ;; (cons (progn (forward-sexp x) (point)) + ;; (progn (forward-sexp (- x)) (point))) + ;; Except that we don't want to rely on the second forward-sexp + ;; putting us back to where we want to be, since forward-sexp-function + ;; might do funny things like infix-precedence. + (if (if (> arg 0) + (looking-at "\\sw\\|\\s_") + (and (not (bobp)) + (save-excursion + (forward-char -1) + (looking-at "\\sw\\|\\s_")))) + ;; Jumping over a symbol. We might be inside it, mind you. + (progn (funcall (if (> arg 0) + 'skip-syntax-backward 'skip-syntax-forward) + "w_") + (cons (save-excursion (forward-sexp arg) (point)) (point))) + ;; Otherwise, we're between sexps. Take a step back before jumping + ;; to make sure we'll obey the same precedence no matter which + ;; direction we're going. + (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) + " .") + (cons (save-excursion (forward-sexp arg) (point)) + (progn (while (or (forward-comment (if (> arg 0) 1 -1)) + (not (zerop (funcall (if (> arg 0) + 'skip-syntax-forward + 'skip-syntax-backward) + "."))))) + (point))))) + arg 'special))) (defun transpose-lines (arg) "Exchange current line and previous line, leaving point after both. @@ -7819,15 +8166,19 @@ is defined. The function should take a single optional argument, which is a flag indicating whether it should use soft newlines.") -(defun default-indent-new-line (&optional soft) +(defun default-indent-new-line (&optional soft force) "Break line at point and indent. If a comment syntax is defined, call `comment-line-break-function'. The inserted newline is marked hard if variable `use-hard-newlines' is true, unless optional argument SOFT is non-nil." - (interactive) + (interactive (list nil t)) (if comment-start - (funcall comment-line-break-function soft) + ;; Force breaking the line when called interactively. + (if force + (let ((comment-auto-fill-only-comments nil)) + (funcall comment-line-break-function soft)) + (funcall comment-line-break-function soft)) ;; Insert the newline before removing empty space so that markers ;; get preserved better. (if soft (insert-and-inherit ?\n) (newline 1)) @@ -8581,6 +8932,8 @@ makes it easier to edit it." (defvar completion-list-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) + (define-key map "g" nil) ;; There's nothing to revert from. (define-key map [mouse-2] 'choose-completion) (define-key map [follow-link] 'mouse-face) (define-key map [down-mouse-2] nil) @@ -8590,8 +8943,10 @@ makes it easier to edit it." (define-key map [right] 'next-completion) (define-key map [?\t] 'next-completion) (define-key map [backtab] 'previous-completion) - (define-key map "q" 'quit-window) (define-key map "z" 'kill-current-buffer) + (define-key map "n" 'next-completion) + (define-key map "p" 'previous-completion) + (define-key map "\M-g\M-c" 'switch-to-minibuffer) map) "Local map for completion list buffers.") @@ -8678,18 +9033,17 @@ If EVENT, use EVENT's position to determine the starting position." (choice (save-excursion (goto-char (posn-point (event-start event))) - (let (beg end) + (let (beg) (cond ((and (not (eobp)) (get-text-property (point) 'mouse-face)) - (setq end (point) beg (1+ (point)))) + (setq beg (1+ (point)))) ((and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) - (setq end (1- (point)) beg (point))) + (setq beg (point))) (t (error "No completion here"))) (setq beg (previous-single-property-change beg 'mouse-face)) - (setq end (or (next-single-property-change end 'mouse-face) - (point-max))) - (buffer-substring-no-properties beg end))))) + (substring-no-properties + (get-text-property beg 'completion--string)))))) (unless (buffer-live-p buffer) (error "Destination buffer is dead")) @@ -8809,6 +9163,9 @@ Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\ to select the completion near point. Or click to select one with the mouse. +See the `completions-format' user option to control how this +buffer is formatted. + \\{completion-list-mode-map}") (defun completion-list-mode-finish () @@ -8881,6 +9238,18 @@ select the completion near point.\n\n")))))) ;; FIXME: Perhaps this should be done in `minibuffer-completion-help'. (when (bobp) (next-completion 1))))) + +(defun read-expression-switch-to-completions () + "Select the completion list window while reading an expression." + (interactive) + (completion-help-at-point) + (switch-to-completions)) + +(defun switch-to-minibuffer () + "Select the minibuffer window." + (interactive) + (when (active-minibuffer-window) + (select-window (active-minibuffer-window)))) ;;; Support keyboard commands to turn on various modifiers. @@ -9193,9 +9562,9 @@ call `normal-erase-is-backspace-mode' (which see) instead." :set (lambda (symbol value) ;; The fboundp is because of a problem with :set when ;; dumping Emacs. It doesn't really matter. - (if (fboundp 'normal-erase-is-backspace-mode) - (normal-erase-is-backspace-mode (or value 0)) - (set-default symbol value)))) + (when (fboundp 'normal-erase-is-backspace-mode) + (normal-erase-is-backspace-mode (or value 0))) + (set-default symbol value))) (defun normal-erase-is-backspace-setup-frame (&optional frame) "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary." |