(or (assq tag (cdr (assq category completion-category-overrides)))
(assq tag (cdr (assq category completion-category-defaults)))))
-(defvar completion-style nil
- "The completion style that produced the current completions list.
-
-`minibuffer-completion-help' arranges for this variable to be set
-buffer-locally in the *Completions* buffer.")
-
(defvar completion--matching-style nil
"Last completion style to match user input.")
(substitute-command-keys
(concat
", \\[minibuffer-widen-completions] to clear restrictions ("
- (minibuffer--completion-predicate-description)
+ (completions-predicate-description minibuffer-completion-predicate)
")")))))))
:type 'boolean
:version "28.1")
-(defcustom completions-header-format "%s possible%c completions%t%r:\n"
- "If non-nil, the format string for completions heading line.
-The heading line is inserted before the completions, and is
-intended to summarize the completions. The format string may
-contain the sequences \"%s\", \"%c\", \"%t\" and \"%r\", which
-are substituted as follows:
-
-- \"%s\": the total count of possible completions.
-- \"%c\": the current completion category prefixed with \" \"
- (e.g. \" command\"), or the empty string when the completion
- table does not specify a category.
-- \"%t\": the current completions sort order prefixed with
- \", \" (e.g. \", sorted alphabetically\"), or the empty string
- when using the default sort order.
-- \"%r\": a description of the current completions restriction
- prefixed with \", \" (e.g. \", with property disabled\"), or
- the empty string when there are no restrictions.
-
-If this option is nil, no heading line is shown."
- :type '(choice (const :tag "No heading line" nil)
- (string :tag "Format string for heading line"))
- :version "30.1")
+(defvar-local completions-candidates nil)
+(defvar-local completions-category nil)
+(defvar-local completions-sort-function nil)
+(defvar-local completions-sort-orders nil)
+(defvar-local completions-predicate nil)
+(defvar-local completions-action nil)
+(defvar-local completions-style nil)
+
+(defvar completions-header-count
+ '(completions-candidates
+ ("count:" (:eval (file-size-human-readable (length completions-candidates) 'si)) " ")))
+
+(defvar completions-header-category
+ '(completions-category
+ ("category:" (:eval (symbol-name completions-category)) " ")))
+
+(defvar completions-header-order
+ '(completions-sort-function
+ ("sort:"
+ (:eval (concat
+ (when-let
+ ((sd (nth 4 (seq-find
+ (lambda (order)
+ (eq
+ (nth 3 order)
+ (advice--cd*r
+ completions-sort-function)))
+ completions-sort-orders))))
+ (concat sd " "))
+ (when (advice-function-member-p
+ #'reverse completions-sort-function)
+ "(reversed)")))
+ " ")))
+
+(defvar completions-header-restriction
+ '(completions-predicate
+ ("filter:"
+ (:eval (or (completions-predicate-description
+ completions-predicate)
+ (and (symbolp completions-predicate)
+ (symbol-name completions-predicate))
+ "none"))
+ " ")))
+
+(defvar completions-header-action
+ '(completions-action
+ ("action:" (:eval (cdr completions-action)) " ")))
+
+(defvar completions-header-style
+ '(completions-style
+ ("style:"
+ (:eval (symbol-name completions-style))
+ " ")))
+
+(defvar completions-header-extra nil)
+
+(dolist (sym '(completions-header-count
+ completions-header-category
+ completions-header-order
+ completions-header-restriction
+ completions-header-action
+ completions-header-style
+ completions-header-extra))
+ (put sym 'risky-local-variable t))
+
+(defvar completions-header-format
+ '(" "
+ completions-header-count completions-header-category
+ completions-header-order completions-header-restriction
+ completions-header-action completions-header-style
+ completions-header-extra)
+ "Header line format of the *Completions* buffer.")
(defun completion--insert-strings (strings &optional group-fun)
"Insert a list of STRINGS into the current buffer.
(string-width s)))
strings)))
(window (get-buffer-window (current-buffer) 0))
- (wwidth (if window (1- (window-width window)) 79))
+ (wwidth (if window (1- (window-width window)) (1- (frame-width))))
(columns (min
;; At least 2 spaces between columns.
(max 1 (/ wwidth (+ 2 length)))
completions)
base-size))))
-(defun minibuffer--completion-predicate-description ()
- (and (functionp minibuffer-completion-predicate)
+(defun completions-predicate-description (pred)
+ (and (functionp pred)
(let ((descs nil))
(advice-function-mapc
(lambda (_ alist)
(when-let ((description (alist-get 'description alist)))
(push description descs)))
- minibuffer-completion-predicate)
+ pred)
(when descs (mapconcat #'identity descs ", ")))))
(defvar minibuffer-completions-sort-function nil
(choice string
(const :tag "No description" nil)))))
-(defvar completion-category nil
- "The current completion category.")
-
-(defface completions-heading '((t :inherit shadow))
+(defface completions-heading '((t :background "light cyan" :underline "black"))
"Face for the completions headling line.")
(defface completions-previous-input '((t :underline "violet"))
:version "30.1"
:type 'boolean)
-(defun display-completion-list (completions &optional group-fun)
- "Display the list of completions, COMPLETIONS, using `standard-output'.
-Each element may be just a symbol or string
-or may be a list of two strings to be printed as if concatenated.
-If it is a list of two strings, the first is the actual completion
-alternative, the second serves as annotation.
-`standard-output' must be a buffer.
-The actual completion alternatives, as inserted, are given `mouse-face'
-properties of `highlight'.
-At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'.
-
-Optional argument GROUP-FUN, if non-nil, is a completions grouping
-function as described in the documentation of `completion-metadata'."
- (let ((pred-desc
- (if-let ((pd (minibuffer--completion-predicate-description)))
- (concat ", " pd)
- ""))
- (sort-desc
- (if minibuffer-completions-sort-function
- (concat
- (when-let
- ((sd (nth 4 (seq-find
- (lambda (order)
- (eq
- (nth 3 order)
- (advice--cd*r
- minibuffer-completions-sort-function)))
- minibuffer-completions-sort-orders))))
- (concat ", " sd))
- (when (advice-function-member-p
- #'reverse minibuffer-completions-sort-function)
- ", reversed"))
- ""))
- (cat (if completion-category (format " %s" completion-category) "")))
- (with-current-buffer standard-output
- (goto-char (point-max))
- (when completions-header-format
- (let ((heading
- (format-spec completions-header-format
- (list (cons ?s (length completions))
- (cons ?t sort-desc)
- (cons ?r pred-desc)
- (cons ?c cat)))))
- (add-face-text-property
- 0 (length heading) 'completions-heading t heading)
- (insert heading)))
- (completion--insert-strings completions group-fun)))
-
- (run-hooks 'completion-setup-hook)
- nil)
-
(defvar completion-extra-properties nil
"Property list of extra properties of the current completion job.
These include:
:type '(choice (const nil) natnum)
:version "29.1")
+(defcustom completions-min-height 2
+ "Minimum height for *Completions* buffer window."
+ :type '(choice (const nil) natnum)
+ :version "30.1")
+
(defun completions--fit-window-to-buffer (&optional win &rest _)
"Resize *Completions* buffer window."
(if temp-buffer-resize-mode
(let ((temp-buffer-max-height (or completions-max-height
temp-buffer-max-height)))
(resize-temp-buffer-window win))
- (fit-window-to-buffer win completions-max-height)))
+ (fit-window-to-buffer win completions-max-height completions-min-height)))
(defcustom minibuffer-read-sort-order-with-completion nil
"Whether to use completion for reading minibuffer completions sort order.
(list (let ((styles (completion--styles (completion--field-metadata
(minibuffer-prompt-end))))
(current (when-let ((buf (get-buffer "*Completions*")))
- (buffer-local-value 'completion-style buf)))
+ (buffer-local-value 'completions-style buf)))
(enable-recursive-minibuffers t))
(pcase current-prefix-arg
(`(,_ . ,_) nil) ; \\[universal-argument]
(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
(interactive)
- (let* ((current (when-let ((win (get-buffer-window "*Completions*" 0)))
- (get-text-property (window-point win) 'completion--string
- (get-buffer "*Completions*"))))
- (prev-next (when current
- (with-current-buffer "*Completions*"
- (save-excursion
- (goto-char (point-min))
- (text-property-search-forward 'completion--string current t)
- (cons
- (save-excursion
- (when-let ((pm (text-property-search-backward 'completion--string current)))
- (goto-char (prop-match-end pm))
- (when-let ((pm (text-property-search-backward 'cursor-face nil)))
- (goto-char (prop-match-beginning pm))
- (get-text-property (point) 'completion--string))))
- (save-excursion
- (when-let ((pm (text-property-search-forward 'cursor-face nil t)))
- (goto-char (prop-match-end pm))
- (get-text-property (point) 'completion--string))))))))
- (start (or start (minibuffer--completion-prompt-end)))
+ (let* ((start (or start (minibuffer--completion-prompt-end)))
(end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
(completion--message "Sole completion")
(completion--fail)))
- (let* ((prefix (unless (zerop base-size) (substring string 0 base-size)))
+ (let* ((buf (get-buffer-create "*Completions*"))
+ (current (when-let ((win (get-buffer-window buf 0)))
+ (get-text-property (window-point win) 'completion--string buf)))
+ (prev-next (when current
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (text-property-search-forward 'completion--string current t)
+ (cons
+ (save-excursion
+ (when-let ((pm (text-property-search-backward 'completion--string current)))
+ (goto-char (prop-match-end pm))
+ (when-let ((pm (text-property-search-backward 'cursor-face nil)))
+ (goto-char (prop-match-beginning pm))
+ (get-text-property (point) 'completion--string))))
+ (save-excursion
+ (when-let ((pm (text-property-search-forward 'cursor-face nil t)))
+ (goto-char (prop-match-end pm))
+ (get-text-property (point) 'completion--string))))))))
+ (prefix (unless (zerop base-size) (substring string 0 base-size)))
(full-base (substring string 0 base-size))
(base-prefix (buffer-substring (minibuffer--completion-prompt-end)
(+ start base-size)))
(aff-fun (completion-metadata-get all-md 'affixation-function))
(sort-fun (completion-metadata-get all-md 'display-sort-function))
(group-fun (completion-metadata-get all-md 'group-function))
- (completion-category (completion-metadata-get all-md 'category))
+ (category (completion-metadata-get all-md 'category))
(minibuffer-completion-base
(funcall (or (alist-get 'adjust-base-function all-md) #'identity)
full-base))
- (mainbuf (current-buffer))
+ (explicit-sort-function minibuffer-completions-sort-function)
+ (sort-orders minibuffer-completions-sort-orders)
+ (cpred minibuffer-completion-predicate)
+ (ctable minibuffer-completion-table)
;; 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))
+ (display-buffer-mark-dedicated 'soft)
+ (action (minibuffer-completion-action))
+ (mainbuf (current-buffer)))
(minibuffer--cache-completion-input (substring string base-size)
full-base)
- (with-current-buffer-window
- "*Completions*"
- ;; This is a copy of `display-buffer-fallback-action'
- ;; where `display-buffer-use-some-window' is replaced
- ;; with `display-buffer-at-bottom'.
- `((display-buffer--maybe-same-window
- display-buffer-reuse-window
- display-buffer--maybe-pop-up-frame
- ;; Use `display-buffer-below-selected' for inline completions,
- ;; but not in the minibuffer (e.g. in `eval-expression')
- ;; for which `display-buffer-at-bottom' is used.
- ,(if (eq (selected-window) (minibuffer-window))
- 'display-buffer-at-bottom
- 'display-buffer-below-selected))
- (window-height . completions--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))
-
- ;; Highilight previously used completions.
- (when-let
- ((hist (and completions-highlight-previous-inputs
- (not (eq minibuffer-history-variable t))
- (symbol-value minibuffer-history-variable))))
- (setq completions
- (mapcar
- (lambda (comp)
- (if (member (concat minibuffer-completion-base comp) hist)
- ;; Avoid modifying the original string.
- (let ((copy (copy-sequence comp)))
- (font-lock-append-text-property
- 0 (length copy)
- 'face 'completions-previous-input copy)
- copy)
- comp))
- completions)))
-
- ;; Sort first using the `display-sort-function'.
- ;; FIXME: This function is for the output of
- ;; all-completions, not
- ;; completion-all-completions. Often it's the
- ;; same, but not always.
- (setq completions
- (cond
- (minibuffer-completions-sort-function
- (funcall minibuffer-completions-sort-function
- completions))
- (sort-fun
- (funcall sort-fun completions))
- (t
- (pcase completions-sort
- ('nil completions)
- ('alphabetical (minibuffer-sort-alphabetically completions))
- ('historical (minibuffer-sort-by-history completions))
- (_ (funcall completions-sort completions))))))
-
- ;; After sorting, group the candidates using the
- ;; `group-function'.
- (when group-fun
- (setq completions
- (minibuffer--group-by
- group-fun
- (pcase completions-group-sort
- ('nil #'identity)
- ('alphabetical
- (lambda (groups)
- (sort groups
- (lambda (x y)
- (string< (car x) (car y))))))
- (_ completions-group-sort))
- completions)))
-
- (cond
- (aff-fun
- (setq completions
- (funcall aff-fun completions)))
- (ann-fun
- (setq completions
- (mapcar (lambda (s)
- (let ((ann (funcall ann-fun s)))
- (if ann (list s ann) s)))
- completions))))
-
- (with-current-buffer standard-output
- (setq-local completion-style style)
- (setq-local 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))
- (setq-local completion-base-affixes
- (list base-prefix base-suffix))
- (setq-local completion-list-insert-choice-function
- (let ((ctable minibuffer-completion-table)
- (cpred minibuffer-completion-predicate)
- (cprops completion-extra-properties))
- (lambda (start end choice)
- (if (and (stringp start) (stringp end))
- (progn
- (delete-minibuffer-contents)
- (insert start choice)
- ;; Keep point after completion before suffix
- (save-excursion (insert end)))
- (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 group-fun)
- (with-current-buffer standard-output
- (goto-char (point-min))
- (when-let
- ((pm
- (or (and current (text-property-search-forward 'completion--string current t))
- (when-let ((next (cdr prev-next)))
- (text-property-search-forward 'completion--string next t))
- (when-let ((prev (car prev-next)))
- (text-property-search-forward 'completion--string prev t)))))
- (goto-char (prop-match-beginning pm))
- (setq pm (text-property-search-forward 'cursor-face))
- (setq-local cursor-face-highlight-nonselected-window t)
- (set-window-point (get-buffer-window) (prop-match-beginning pm))))))))
- nil)))
- nil))
+ (when last (setcdr last nil))
+ ;; Highilight previously used completions.
+ (when-let
+ ((hist (and completions-highlight-previous-inputs
+ (not (eq minibuffer-history-variable t))
+ (symbol-value minibuffer-history-variable))))
+ (setq completions
+ (mapcar
+ (lambda (comp)
+ (if (member (concat minibuffer-completion-base comp) hist)
+ ;; Avoid modifying the original string.
+ (let ((copy (copy-sequence comp)))
+ (font-lock-append-text-property
+ 0 (length copy)
+ 'face 'completions-previous-input copy)
+ copy)
+ comp))
+ completions)))
+
+ ;; Sort first using the `display-sort-function'.
+ ;; FIXME: This function is for the output of
+ ;; all-completions, not
+ ;; completion-all-completions. Often it's the
+ ;; same, but not always.
+ (setq completions
+ (cond
+ (explicit-sort-function
+ (funcall explicit-sort-function
+ completions))
+ (sort-fun
+ (funcall sort-fun completions))
+ (t
+ (pcase completions-sort
+ ('nil completions)
+ ('alphabetical (minibuffer-sort-alphabetically completions))
+ ('historical (minibuffer-sort-by-history completions))
+ (_ (funcall completions-sort completions))))))
+
+ ;; After sorting, group the candidates using the
+ ;; `group-function'.
+ (when group-fun
+ (setq completions
+ (minibuffer--group-by
+ group-fun
+ (pcase completions-group-sort
+ ('nil #'identity)
+ ('alphabetical
+ (lambda (groups)
+ (sort groups
+ (lambda (x y)
+ (string< (car x) (car y))))))
+ (_ completions-group-sort))
+ completions)))
+
+ (cond
+ (aff-fun
+ (setq completions
+ (funcall aff-fun completions)))
+ (ann-fun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall ann-fun s)))
+ (if ann (list s ann) s)))
+ completions))))
+ (with-current-buffer buf
+ (completion-list-mode)
+ (setq buffer-read-only nil)
+ (delete-region (point-min) (point-max))
+ (setq-local completions-style style)
+ (setq-local 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))
+ (setq-local completion-base-affixes
+ (list base-prefix base-suffix))
+ (setq-local completion-list-insert-choice-function
+ (let ((cprops completion-extra-properties))
+ (lambda (start end choice)
+ (if (and (stringp start) (stringp end))
+ (progn
+ (delete-minibuffer-contents)
+ (insert start choice)
+ ;; Keep point after completion before suffix
+ (save-excursion (insert end)))
+ (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))))))
+ (setq-local completions-candidates completions)
+ (setq-local completions-category category)
+ (setq-local completions-sort-function explicit-sort-function)
+ (setq-local completions-sort-orders sort-orders)
+ (setq-local completions-predicate cpred)
+ (setq-local completions-action action)
+ (setq-local completion-reference-buffer mainbuf)
+ (when completion-tab-width
+ (setq tab-width completion-tab-width))
+ ;; Maybe enable cursor completions-highlight.
+ (when completions-highlight-face (cursor-face-highlight-mode 1))
+ (face-remap-add-relative 'header-line 'completions-heading)
+ (setq-local header-line-format completions-header-format)
+ (setq-local mode-line-format nil)
+ (completion--insert-strings completions group-fun)
+ (goto-char (point-min))
+ (when-let
+ ((pm
+ (or (and current (text-property-search-forward 'completion--string current t))
+ (when-let ((next (cdr prev-next)))
+ (text-property-search-forward 'completion--string next t))
+ (when-let ((prev (car prev-next)))
+ (text-property-search-forward 'completion--string prev t)))))
+ (goto-char (prop-match-beginning pm))
+ (setq pm (text-property-search-forward 'cursor-face))
+ (setq-local cursor-face-highlight-nonselected-window t)
+ (set-window-point (get-buffer-window) (prop-match-beginning pm)))
+ (setq buffer-read-only t))
+ (setq minibuffer-scroll-window
+ (display-buffer buf
+ '((display-buffer-reuse-window display-buffer-at-bottom)
+ (window-height . completions--fit-window-to-buffer)
+ (preserve-size . (nil . t)))))
+ (run-hooks 'completion-setup-hook)))))
(defun minibuffer-hide-completions ()
"Get rid of an out-of-date *Completions* buffer."
"C-S-a" #'minibuffer-toggle-completion-ignore-case
"?" #'minibuffer-completion-help
"<prior>" #'switch-to-completions
- "M-v" #'switch-to-completions
"M-g M-c" #'switch-to-completions
+ "M-v" #'switch-to-completions
+ "C-v" #'minibuffer-hide-completions
"M-<up>" #'minibuffer-previous-line-completion
"M-<down>" #'minibuffer-next-line-completion
"M-<left>" #'minibuffer-previous-completion
"M-<right>" #'minibuffer-next-completion
"M-RET" #'minibuffer-choose-completion
+ "M-j" #'minibuffer-force-complete-and-exit
"C-x C-v" #'minibuffer-sort-completions
"C-x n" 'minibuffer-narrow-completions-map
"C-x /" #'minibuffer-set-completion-styles
(define-obsolete-function-alias 'internal-complete-buffer
'completion-buffer-name-table "30.1")
-(defvar-local minibuffer-completion-action nil
- "Function that `minibuffer-apply' applies to the current input, or nil.")
+(defvar-local minibuffer-completion-action nil)
(defvar-local minibuffer-completion-command nil
"The command currently reading input from the minibuffer.")
(setq prf (funcall adjust-fn prf)))
(cons str prf)))
+(defun minibuffer--get-action (symbol)
+ (when-let ((action (get symbol 'minibuffer-action)))
+ (cond
+ ((consp action) action)
+ ((symbolp action) (minibuffer--get-action action))
+ (t (cons symbol action)))))
+
(defun minibuffer-completion-action ()
"Return the completion action function for the current minibuffer."
(or minibuffer-completion-action
- (and (symbolp minibuffer-completion-command)
- (get minibuffer-completion-command
- 'minibuffer-action)
- minibuffer-completion-command)
- (error "No applicable action")))
+ (and minibuffer-completion-command
+ (symbolp minibuffer-completion-command)
+ (minibuffer--get-action minibuffer-completion-command))))
-(defun minibuffer-apply (action input &optional prefix)
+(defun minibuffer-apply (input &optional prefix)
"Apply ACTION to current minibuffer INPUT prefixed by PREFIX."
(interactive (let* ((input-prefix (minibuffer-current-input))
(input (car input-prefix))
(prefix (cdr input-prefix)))
- (list (minibuffer-completion-action) input prefix)))
- (funcall action (concat prefix input))
+ (list input prefix)))
+ (funcall
+ (or (car (minibuffer-completion-action))
+ (user-error "No applicable action"))
+ (concat prefix input))
(when-let ((buf (get-buffer "*Completions*"))
(win (get-buffer-window buf 0)))
(with-current-buffer buf
(setq-local minibuffer-completion-predicate #'always))
(add-function :after-while (local 'minibuffer-completion-predicate)
pred `((description . ,desc)))
- (when completion-auto-help (minibuffer-completion-help))
- (when-let ((completions-buffer (get-buffer "*Completions*")))
- (with-current-buffer completions-buffer
- (completions-narrow-mode))))
+ (when completion-auto-help (minibuffer-completion-help)))
(defun minibuffer-narrow-completions ()
"Restrict completion candidates for current minibuffer interaction."
(format-prompt "Remove completions restrictions"
(caar desc-pred-alist))
desc-pred-alist nil t nil nil (caar desc-pred-alist)))))))
- (when completion-auto-help (minibuffer-completion-help))
- (when-let ((completions-buffer (and (not (minibuffer-narrow-completions-p))
- (get-buffer "*Completions*"))))
- (with-current-buffer completions-buffer
- (completions-narrow-mode -1))))
+ (when completion-auto-help (minibuffer-completion-help)))
(defcustom minibuffer-default-prompt-format " (default %s)"
"Format string used to output \"default\" values.
(list (list "M-x " (lambda () read-extended-command-predicate))
(list "M-X " #'command-completion--command-for-this-buffer-function))
"Alist of prompts and what the extended command predicate should be.
-This is used by the \\<minibuffer-local-must-match-map>\\[execute-extended-command-cycle] command when reading an extended command.")
+This is used by the \\<read-extended-command-mode-map>\\[execute-extended-command-cycle] command when reading an extended command.")
(defvar-keymap read-extended-command-mode-map
:doc "Local keymap added to the current map when reading an extended command."
\f
;; Define the major mode for lists of completions.
-(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)
- (define-key map "\C-m" 'choose-completion)
- (define-key map "\e\e\e" 'delete-completion-window)
- (define-key map [remap keyboard-quit] #'delete-completion-window)
- (define-key map [up] 'previous-line-completion)
- (define-key map [down] 'next-line-completion)
- (define-key map [left] 'previous-completion)
- (define-key map [right] 'next-completion)
- (define-key map [?\t] 'next-completion)
- (define-key map [backtab] 'previous-completion)
- (define-key map [M-up] 'minibuffer-previous-completion)
- (define-key map [M-down] 'minibuffer-next-completion)
- (define-key map "\M-\r" 'minibuffer-choose-completion)
- (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.")
-
-;; Completion mode is suitable only for specially formatted data.
-(put 'completion-list-mode 'mode-class 'special)
+(defvar-keymap completion-list-mode-map
+ :doc "Local map for completion list buffers."
+ "RET" #'choose-completion
+ "<mouse-2>" #'choose-completion
+ "<up>" #'previous-line-completion
+ "<down>" #'next-line-completion
+ "<left>" #'previous-completion
+ "<right>" #'next-completion
+ "<backtab>" #'previous-completion
+ "TAB" #'next-completion
+ "p" #'previous-completion
+ "n" #'next-completion
+ "M-g M-c" #'switch-to-minibuffer
+ "<follow-link>" 'mouse-face)
(defvar completion-reference-buffer nil
"Record the buffer that was current when the completion list was requested.
between BEG and END with TEXT. Expected to be set buffer-locally
in the *Completions* buffer.")
-(defun delete-completion-window ()
- "Delete the completion list window.
-Go to the window from which completion was requested."
- (interactive)
- (let ((buf completion-reference-buffer))
- (if (one-window-p t)
- (if (window-dedicated-p) (delete-frame))
- (delete-window (selected-window))
- (if (get-buffer-window buf)
- (select-window (get-buffer-window buf))))))
-
(defcustom completion-auto-wrap t
"Non-nil means to wrap around when selecting completion candidates.
This affects the commands `next-completion', `previous-completion',
(raise-frame (window-frame mini))))
(exit-minibuffer))))))))
-(define-derived-mode completion-list-mode nil
- `("Completions"
- (completion-style
- (:eval (concat "["
- (propertize (symbol-name completion-style)
- 'mouse-face 'mode-line-highlight
- 'help-echo
- (nth 3 (assoc completion-style
- completion-styles-alist)))
- "]"))))
- "Major mode for buffers showing lists of possible completions.
-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 ()
- "Finish setup of the completions buffer.
-Called from `temp-buffer-show-hook'."
- (when (eq major-mode 'completion-list-mode)
- (setq buffer-read-only t)))
-
-(add-hook 'temp-buffer-show-hook 'completion-list-mode-finish)
-
-
-;; Variables and faces used in `completion-setup-function'.
-
-(defcustom completion-show-help t
- "Non-nil means show help message in *Completions* buffer."
- :type 'boolean
- :version "22.1"
- :group 'completion)
-
-(define-minor-mode completions-narrow-mode
- "Minor mode for *Completions* buffer with completions narrowing."
- :interactive nil
- :lighter " CompsNarrow")
-
-;; This function goes in completion-setup-hook, so that it is called
-;; after the text of the completion list buffer is written.
-(defun completion-setup-function ()
- (let* ((mainbuf (current-buffer))
- (base-dir
- ;; FIXME: This is a bad hack. We try to set the default-directory
- ;; in the *Completions* buffer so that the relative file names
- ;; displayed there can be treated as valid file names, independently
- ;; from the completion context. But this suffers from many problems:
- ;; - It's not clear when the completions are file names. With some
- ;; completion tables (e.g. bzr revision specs), the listed
- ;; completions can mix file names and other things.
- ;; - It doesn't pay attention to possible quoting.
- ;; - With fancy completion styles, the code below will not always
- ;; find the right base directory.
- (if minibuffer-completing-file-name
- (file-name-directory
- (expand-file-name
- (buffer-substring (minibuffer-prompt-end) (point))))))
- (narrow (and (functionp minibuffer-completion-predicate)
- (let ((result nil))
- (advice-function-mapc
- (lambda (_ alist)
- (setq result (alist-get 'description alist)))
- minibuffer-completion-predicate)
- result))))
- (with-current-buffer standard-output
- (let ((base-position completion-base-position)
- (base-affixes completion-base-affixes)
- (insert-fun completion-list-insert-choice-function)
- (style completion-style))
- (completion-list-mode)
- (setq-local completion-base-position base-position)
- (setq-local completion-base-affixes base-affixes)
- (setq-local completion-list-insert-choice-function insert-fun)
- (setq-local completion-style style)
- (when narrow (completions-narrow-mode)))
- (setq-local completion-reference-buffer mainbuf)
- (if base-dir (setq default-directory base-dir))
- (when completion-tab-width
- (setq tab-width completion-tab-width))
- ;; Maybe enable cursor completions-highlight.
- (when completions-highlight-face
- (cursor-face-highlight-mode 1))
- ;; Maybe insert help string.
- (when completion-show-help
- (goto-char (point-min))
- (insert (substitute-command-keys
- (if (display-mouse-p)
- "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n"
- "Type \\[minibuffer-choose-completion] on a completion to select it.\n")))
- (insert (substitute-command-keys
- "Type \\[minibuffer-next-completion] or \\[minibuffer-previous-completion] \
-to move point between completions.\n\n"))))))
-
-(add-hook 'completion-setup-hook #'completion-setup-function)
+(define-derived-mode completion-list-mode special-mode "Completions"
+ "Major mode for buffers showing lists of possible completions.")
(defun switch-to-completions ()
"Select the completion list window."
projects / emacs.git / commitdiff