diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 9d57a817b2..3f700803b6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -121,6 +117,9 @@ completion-metadata - `annotation-function': function to add annotations in *Completions*. Takes one argument (STRING), which is a possible completion and returns a string to append to STRING. +- `affix-function': function to prepend/append a prefix/suffix to entries. + Takes one argument (COMPLETIONS) and should return a list + of completions with a completion, its prefix and suffix. - `display-sort-function': function to sort entries in *Completions*. Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. @@ -1689,8 +1688,7 @@ completion--insert-strings (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) - (+ (string-width (car s)) - (string-width (cadr s))) + (cl-reduce #'+ (mapcar #'string-width s)) (string-width s))) strings))) (window (get-buffer-window (current-buffer) 0)) @@ -1715,8 +1713,7 @@ completion--insert-strings ;; FIXME: `string-width' doesn't pay attention to ;; `display' properties. (let ((length (if (consp str) - (+ (string-width (car str)) - (string-width (cadr str))) + (cl-reduce #'+ (mapcar #'string-width str)) (string-width str)))) (cond ((eq completions-format 'vertical) @@ -1754,13 +1751,21 @@ completion--insert-strings (if (not (consp str)) (put-text-property (point) (progn (insert str) (point)) 'mouse-face 'highlight) - (put-text-property (point) (progn (insert (car str)) (point)) - 'mouse-face 'highlight) - (let ((beg (point)) - (end (progn (insert (cadr str)) (point)))) - (put-text-property beg end 'mouse-face nil) - (font-lock-prepend-text-property beg end 'face - 'completions-annotations))) + (let* ((prefix (when (nth 2 str) (nth 1 str))) + (suffix (or (nth 2 str) (nth 1 str)))) + (when prefix + (let ((beg (point)) + (end (progn (insert prefix) (point)))) + (put-text-property beg end 'mouse-face nil) + (font-lock-prepend-text-property beg end 'face + 'completions-annotations))) + (put-text-property (point) (progn (insert (car str)) (point)) + 'mouse-face 'highlight) + (let ((beg (point)) + (end (progn (insert suffix) (point)))) + (put-text-property beg end 'mouse-face nil) + (font-lock-prepend-text-property beg end 'face + 'completions-annotations)))) (cond ((eq completions-format 'vertical) ;; Vertical format @@ -1880,6 +1885,9 @@ completion-extra-properties completion). The function can access the completion data via `minibuffer-completion-table' and related variables. +`:affix-function': Function to prepend/append a prefix/suffix to completions. + The function must accept one argument, a list of completions. + `:exit-function': Function to run after completion is performed. The function must accept two arguments, STRING and STATUS. @@ -1966,6 +1974,9 @@ minibuffer-completion-help (plist-get completion-extra-properties :annotation-function) completion-annotate-function)) + (xfun (or (completion-metadata-get all-md 'affix-function) + (plist-get completion-extra-properties + :affix-function))) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in @@ -2012,6 +2023,9 @@ minibuffer-completion-help (let ((ann (funcall afun s))) (if ann (list s ann) s))) completions))) + (when xfun + (setq completions + (funcall xfun completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position)