:version "28.1")
(defvar-local completions-candidates nil)
+(defvar-local completions-group-function nil)
(defvar-local completions-category nil)
(defvar-local completions-sort-function nil)
(defvar-local completions-sort-orders nil)
(completion--message "Sole completion")
(completion--fail)))
- (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)))
+ (let* ((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)))
(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)
- (action (minibuffer-completion-action))
- (mainbuf (current-buffer)))
+ (action (minibuffer-completion-action)))
(minibuffer--cache-completion-input (substring string base-size)
full-base)
(when last (setcdr last nil))
(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)))))
+ (let ((standard-output (get-buffer-create "*Completions*")))
+ (completions-display
+ completions
+ :group-function group-fun
+ :style style
+ :category category
+ :sort-function explicit-sort-function
+ :sort-orders sort-orders
+ :predicate cpred
+ :action action
+ :base-position (list (+ start base-size) end)
+ :base-affixes (list base-prefix base-suffix)
+ :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))))))))))))
+
+(defun completions-setup ()
+ "Set up the current buffer for displaying a list of completions."
+ (completion-list-mode)
+ (when completion-tab-width (setq tab-width completion-tab-width))
+ (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))
+
+(defun completions-display (completions &rest plist)
+ "Display COMPLETIONS in the buffer specified by `standard-output'.
+
+PLIST is a property list with optional extra information about COMPLETIONS."
+ (let* ((mainbuf (current-buffer))
+ (buf standard-output)
+ (group-fun (plist-get plist :group-function))
+ (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)))))))))
+ (with-current-buffer buf
+ (completions-setup)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (delete-all-overlays)
+ (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-local
+ completion-reference-buffer mainbuf
+ completions-candidates completions
+ completions-group-function group-fun
+ completions-style (plist-get plist :style)
+ completion-base-position (plist-get plist :base-position)
+ completion-base-affixes (plist-get plist :base-affixes)
+ completion-list-insert-choice-function (plist-get plist :insert-choice-function)
+ completions-category (plist-get plist :category)
+ completions-sort-function (plist-get plist :sort-function)
+ completions-sort-orders (plist-get plist :sort-orders)
+ completions-predicate (plist-get plist :predicate)
+ completions-action (plist-get plist :action)))
+ (run-hooks 'completion-setup-hook)
+ (display-buffer buf
+ '((display-buffer-reuse-window display-buffer-at-bottom)
+ (window-height . completions--fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (dedicated . soft)))))
+
+(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'."
+ (completions-display completions :group-function group-fun))
(defun minibuffer-hide-completions ()
"Get rid of an out-of-date *Completions* buffer."
projects / emacs.git / commitdiff