diff options
Diffstat (limited to 'lisp/minibuffer.el')
| -rw-r--r-- | lisp/minibuffer.el | 211 |
1 files changed, 118 insertions, 93 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 942fb019fe2..5a41e2f30bd 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -685,13 +685,6 @@ for use at QPOS." completions) qboundary)))) -;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) -;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) -(define-obsolete-function-alias - 'complete-in-turn #'completion-table-in-turn "23.1") -(define-obsolete-function-alias - 'dynamic-completion-table #'completion-table-dynamic "23.1") - ;;; Minibuffer completion (defgroup minibuffer nil @@ -1078,10 +1071,16 @@ in the last `cdr'." (defun completion--replace (beg end newtext) "Replace the buffer text between BEG and END with NEWTEXT. Moves point to the end of the new text." - ;; The properties on `newtext' include things like - ;; completions-first-difference, which we don't want to include - ;; upon insertion. - (set-text-properties 0 (length newtext) nil newtext) + ;; The properties on `newtext' include things like the + ;; `completions-first-difference' face, which we don't want to + ;; include upon insertion. + (if minibuffer-allow-text-properties + ;; If we're preserving properties, then just remove the faces + ;; and other properties added by the completion machinery. + (remove-text-properties 0 (length newtext) '(face completion-score) + newtext) + ;; Remove all text properties. + (set-text-properties 0 (length newtext) nil newtext)) ;; Maybe this should be in subr.el. ;; You'd think this is trivial to do, but details matter if you want ;; to keep markers "at the right place" and be robust in the face of @@ -1776,9 +1775,6 @@ It also eliminates runs of equal strings." ;; Round up to a whole number of columns. (* colwidth (ceiling length colwidth)))))))))))) -(defvar completion-common-substring nil) -(make-obsolete-variable 'completion-common-substring nil "23.1") - (defvar completion-setup-hook nil "Normal hook run at the end of setting up a completion list buffer. When this hook is run, the current buffer is the one in which the @@ -1870,11 +1866,7 @@ It can find the completion buffer in `standard-output'." (insert "Possible completions are:\n") (completion--insert-strings completions)))) - ;; The hilit used to be applied via completion-setup-hook, so there - ;; may still be some code that uses completion-common-substring. - (with-no-warnings - (let ((completion-common-substring common-substring)) - (run-hooks 'completion-setup-hook))) + (run-hooks 'completion-setup-hook) nil) (defvar completion-extra-properties nil @@ -1974,12 +1966,13 @@ variables.") (plist-get completion-extra-properties :annotation-function) completion-annotate-function)) + (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to ;; delete the window or not. (display-buffer-mark-dedicated 'soft)) - (with-displayed-buffer-window + (with-current-buffer-window "*Completions*" ;; This is a copy of `display-buffer-fallback-action' ;; where `display-buffer-use-some-window' is replaced @@ -1993,66 +1986,69 @@ variables.") ,(if (eq (selected-window) (minibuffer-window)) 'display-buffer-at-bottom 'display-buffer-below-selected)) - ,(if temp-buffer-resize-mode - '(window-height . resize-temp-buffer-window) - '(window-height . fit-window-to-buffer)) - ,(when temp-buffer-resize-mode - '(preserve-size . (nil . t)))) - nil - ;; Remove the base-size tail because `sort' requires a properly - ;; nil-terminated list. - (when last (setcdr last nil)) - (setq completions - ;; FIXME: This function is for the output of all-completions, - ;; not completion-all-completions. Often it's the same, but - ;; not always. - (let ((sort-fun (completion-metadata-get - all-md 'display-sort-function))) - (if sort-fun - (funcall sort-fun completions) - (sort completions 'string-lessp)))) - (when afun - (setq completions - (mapcar (lambda (s) - (let ((ann (funcall afun s))) - (if ann (list s ann) s))) - completions))) - - (with-current-buffer standard-output - (set (make-local-variable 'completion-base-position) - (list (+ start base-size) - ;; FIXME: We should pay attention to completion - ;; boundaries here, but currently - ;; completion-all-completions does not give us the - ;; necessary information. - end)) - (set (make-local-variable 'completion-list-insert-choice-function) - (let ((ctable minibuffer-completion-table) - (cpred minibuffer-completion-predicate) - (cprops completion-extra-properties)) - (lambda (start end choice) - (unless (or (zerop (length prefix)) - (equal prefix - (buffer-substring-no-properties - (max (point-min) - (- start (length prefix))) - start))) - (message "*Completions* out of date")) - ;; FIXME: Use `md' to do quoting&terminator here. - (completion--replace start end choice) - (let* ((minibuffer-completion-table ctable) - (minibuffer-completion-predicate cpred) - (completion-extra-properties cprops) - (result (concat prefix choice)) - (bounds (completion-boundaries - result ctable cpred ""))) - ;; If the completion introduces a new field, then - ;; completion is not finished. - (completion--done result - (if (eq (car bounds) (length result)) - 'exact 'finished))))))) - - (display-completion-list completions)))) + ,(if temp-buffer-resize-mode + '(window-height . resize-temp-buffer-window) + '(window-height . fit-window-to-buffer)) + ,(when temp-buffer-resize-mode + '(preserve-size . (nil . t))) + (body-function + . ,#'(lambda (_window) + (with-current-buffer mainbuf + ;; Remove the base-size tail because `sort' requires a properly + ;; nil-terminated list. + (when last (setcdr last nil)) + (setq completions + ;; FIXME: This function is for the output of all-completions, + ;; not completion-all-completions. Often it's the same, but + ;; not always. + (let ((sort-fun (completion-metadata-get + all-md 'display-sort-function))) + (if sort-fun + (funcall sort-fun completions) + (sort completions 'string-lessp)))) + (when afun + (setq completions + (mapcar (lambda (s) + (let ((ann (funcall afun s))) + (if ann (list s ann) s))) + completions))) + + (with-current-buffer standard-output + (set (make-local-variable 'completion-base-position) + (list (+ start base-size) + ;; FIXME: We should pay attention to completion + ;; boundaries here, but currently + ;; completion-all-completions does not give us the + ;; necessary information. + end)) + (set (make-local-variable 'completion-list-insert-choice-function) + (let ((ctable minibuffer-completion-table) + (cpred minibuffer-completion-predicate) + (cprops completion-extra-properties)) + (lambda (start end choice) + (unless (or (zerop (length prefix)) + (equal prefix + (buffer-substring-no-properties + (max (point-min) + (- start (length prefix))) + start))) + (message "*Completions* out of date")) + ;; FIXME: Use `md' to do quoting&terminator here. + (completion--replace start end choice) + (let* ((minibuffer-completion-table ctable) + (minibuffer-completion-predicate cpred) + (completion-extra-properties cprops) + (result (concat prefix choice)) + (bounds (completion-boundaries + result ctable cpred ""))) + ;; If the completion introduces a new field, then + ;; completion is not finished. + (completion--done result + (if (eq (car bounds) (length result)) + 'exact 'finished))))))) + + (display-completion-list completions))))) + nil))) nil)) (defun minibuffer-hide-completions () @@ -2376,8 +2372,6 @@ The completion method is determined by `completion-at-point-functions'." Gets combined either with `minibuffer-local-completion-map' or with `minibuffer-local-must-match-map'.") -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) (make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") @@ -2551,11 +2545,6 @@ same as `substitute-in-file-name'." all)))))) (file-error nil))) ;PCM often calls with invalid directories. -(defvar read-file-name-predicate nil - "Current predicate used by `read-file-name-internal'.") -(make-obsolete-variable 'read-file-name-predicate - "use the regular PRED argument" "23.2") - (defun completion--sifn-requote (upos qstr) ;; We're looking for `qpos' such that: ;; (equal (substring (substitute-in-file-name qstr) 0 upos) @@ -3045,6 +3034,19 @@ the commands start with a \"-\" or a SPC." :version "24.1" :type 'boolean) +(defcustom minibuffer-default-prompt-format " (default %s)" + "Format string used to output \"default\" values. +When prompting for input, there will often be a default value, +leading to prompts like \"Number of articles (default 50): \". +The \"default\" part of that prompt is controlled by this +variable, and can be set to, for instance, \" [%s]\" if you want +a shorter displayed prompt, or \"\", if you don't want to display +the default at all. + +This variable is used by the `format-prompt' function." + :version "28.1" + :type 'string) + (defun completion-pcm--pattern-trivial-p (pattern) (and (stringp (car pattern)) ;; It can be followed by `point' and "" and still be trivial. @@ -3114,12 +3116,12 @@ or a symbol, see `completion-pcm--merge-completions'." (while p (pcase p (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest))) - ;; This is not just a performance improvement: it also turns - ;; a terminating `point' into an implicit `any', which - ;; affects the final position of point (because `point' gets - ;; turned into a non-greedy ".*?" regexp whereas we need - ;; it the be greedy when it's at the end, see bug#38458). - (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'. + ;; This is not just a performance improvement: it turns a + ;; terminating `point' into an implicit `any', which affects + ;; the final position of point (because `point' gets turned + ;; into a non-greedy ".*?" regexp whereas we need it to be + ;; greedy when it's at the end, see bug#38458). + (`(point) (setq p nil)) ;Implicit terminating `any'. (_ (push (pop p) n)))) (nreverse n))) @@ -3862,6 +3864,29 @@ the minibuffer was activated, and execute the forms." (with-minibuffer-selected-window (scroll-other-window-down arg))) +(defun format-prompt (prompt default &rest format-args) + "Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'. +If FORMAT-ARGS is nil, PROMPT is used as a plain string. If +FORMAT-ARGS is non-nil, PROMPT is used as a format control +string, and FORMAT-ARGS are the arguments to be substituted into +it. See `format' for details. + +If DEFAULT is a list, the first element is used as the default. +If not, the element is used as is. + +If DEFAULT is nil, no \"default value\" string is included in the +return value." + (concat + (if (null format-args) + prompt + (apply #'format prompt format-args)) + (and default + (format minibuffer-default-prompt-format + (if (consp default) + (car default) + default))) + ": ")) + (provide 'minibuffer) ;;; minibuffer.el ends here |