aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/help-fns.el60
-rw-r--r--lisp/minibuffer.el19
-rw-r--r--lisp/simple.el37
3 files changed, 63 insertions, 53 deletions
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0b0ae4364c8..4d625879de8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -126,38 +126,40 @@ with the current prefix. The files are chosen according to
126 :group 'help 126 :group 'help
127 :version "26.3") 127 :version "26.3")
128 128
129(defun help--symbol-completion-table-affixation (completions) 129(defun help--symbol-completion-table-annotation (completion)
130 (mapcar (lambda (c) 130 (let* ((s (intern completion))
131 (let* ((s (intern c)) 131 (doc (ignore-errors (documentation s)))
132 (doc (condition-case nil (documentation s) (error nil))) 132 (doc (and doc (substring doc 0 (string-match "\n" doc))))
133 (doc (and doc (substring doc 0 (string-match "\n" doc))))) 133 (annotation (and doc
134 (list c (propertize 134 (propertize (format " -- %s" doc)
135 (concat (cond ((commandp s) 135 'face 'completions-annotations))))
136 "c") ; command 136 (when annotation
137 ((eq (car-safe (symbol-function s)) 'macro) 137 (propertize
138 "m") ; macro 138 annotation
139 ((fboundp s) 139 'prefix (propertize
140 "f") ; function 140 (concat (cond ((commandp s)
141 ((custom-variable-p s) 141 "c") ; command
142 "u") ; user option 142 ((eq (car-safe (symbol-function s)) 'macro)
143 ((boundp s) 143 "m") ; macro
144 "v") ; variable 144 ((fboundp s)
145 ((facep s) 145 "f") ; function
146 "a") ; fAce 146 ((custom-variable-p s)
147 ((and (fboundp 'cl-find-class) 147 "u") ; user option
148 (cl-find-class s)) 148 ((boundp s)
149 "t") ; CL type 149 "v") ; variable
150 (" ")) ; something else 150 ((facep s)
151 " ") ; prefix separator 151 "a") ; fAce
152 'face 'completions-annotations) 152 ((and (fboundp 'cl-find-class)
153 (if doc (propertize (format " -- %s" doc) 153 (cl-find-class s))
154 'face 'completions-annotations) 154 "t") ; CL type
155 "")))) 155 (" ")) ; something else
156 completions)) 156 " ") ; prefix separator
157 'face 'completions-annotations)
158 'suffix annotation))))
157 159
158(defun help--symbol-completion-table (string pred action) 160(defun help--symbol-completion-table (string pred action)
159 (if (and completions-detailed (eq action 'metadata)) 161 (if (and completions-detailed (eq action 'metadata))
160 '(metadata (affixation-function . help--symbol-completion-table-affixation)) 162 '(metadata (annotation-function . help--symbol-completion-table-annotation))
161 (when help-enable-completion-autoload 163 (when help-enable-completion-autoload
162 (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) 164 (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
163 (help--load-prefixes prefixes))) 165 (help--load-prefixes prefixes)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e04f1040b38..966613aa99c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,11 +2251,20 @@ variables.")
2251 (funcall aff-fun completions))) 2251 (funcall aff-fun completions)))
2252 (ann-fun 2252 (ann-fun
2253 (setq completions 2253 (setq completions
2254 (mapcar (lambda (s) 2254 (mapcar
2255 (let ((ann (funcall ann-fun s))) 2255 (lambda (s)
2256 (if ann (list s ann) s))) 2256 (let* ((ann (funcall ann-fun s))
2257 completions)))) 2257 (prefix-hint
2258 2258 (and ann
2259 (get-text-property 0 'prefix ann)))
2260 (suffix-hint
2261 (and ann
2262 (get-text-property 0 'suffix ann))))
2263 (cond (prefix-hint
2264 (list s prefix-hint (or suffix-hint "")))
2265 (ann (list s ann))
2266 (t s))))
2267 completions))))
2259 (with-current-buffer standard-output 2268 (with-current-buffer standard-output
2260 (setq-local completion-base-position 2269 (setq-local completion-base-position
2261 (list (+ start base-size) 2270 (list (+ start base-size)
diff --git a/lisp/simple.el b/lisp/simple.el
index 2a90a076315..aaed17cb9ea 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2004,7 +2004,7 @@ This function uses the `read-extended-command-predicate' user option."
2004 (lambda (string pred action) 2004 (lambda (string pred action)
2005 (if (and suggest-key-bindings (eq action 'metadata)) 2005 (if (and suggest-key-bindings (eq action 'metadata))
2006 '(metadata 2006 '(metadata
2007 (affixation-function . read-extended-command--affixation) 2007 (annotation-function . read-extended-command--annotation)
2008 (category . command)) 2008 (category . command))
2009 (let ((pred 2009 (let ((pred
2010 (if (memq action '(nil t)) 2010 (if (memq action '(nil t))
@@ -2093,25 +2093,24 @@ or (if one of MODES is a minor mode), if it is switched on in BUFFER."
2093 (and (get-text-property (point) 'button) 2093 (and (get-text-property (point) 'button)
2094 (eq (get-text-property (point) 'category) category)))) 2094 (eq (get-text-property (point) 'category) category))))
2095 2095
2096(defun read-extended-command--affixation (command-names) 2096(defun read-extended-command--annotation (command-name)
2097 ;; why is this `with-selected-window' here?
2097 (with-selected-window (or (minibuffer-selected-window) (selected-window)) 2098 (with-selected-window (or (minibuffer-selected-window) (selected-window))
2098 (mapcar 2099 (let* ((fun (and (stringp command-name) (intern-soft command-name)))
2099 (lambda (command-name) 2100 (binding (where-is-internal fun overriding-local-map t))
2100 (let* ((fun (and (stringp command-name) (intern-soft command-name))) 2101 (obsolete (get fun 'byte-obsolete-info))
2101 (binding (where-is-internal fun overriding-local-map t)) 2102 (alias (symbol-function fun))
2102 (obsolete (get fun 'byte-obsolete-info)) 2103 (annotation (cond ((symbolp alias)
2103 (alias (symbol-function fun)) 2104 (format " (%s)" alias))
2104 (suffix (cond ((symbolp alias) 2105 (obsolete
2105 (format " (%s)" alias)) 2106 (format " (%s)" (car obsolete)))
2106 (obsolete 2107 ((and binding (not (stringp binding)))
2107 (format " (%s)" (car obsolete))) 2108 (format " (%s)" (key-description binding)))
2108 ((and binding (not (stringp binding))) 2109 (t ""))))
2109 (format " (%s)" (key-description binding))) 2110 (put-text-property 0 (length annotation)
2110 (t "")))) 2111 'face 'completions-annotations annotation)
2111 (put-text-property 0 (length suffix) 2112 (when annotation
2112 'face 'completions-annotations suffix) 2113 (propertize annotation 'prefix "" 'suffix annotation)))))
2113 (list command-name "" suffix)))
2114 command-names)))
2115 2114
2116(defcustom suggest-key-bindings t 2115(defcustom suggest-key-bindings t
2117 "Non-nil means show the equivalent key-binding when M-x command has one. 2116 "Non-nil means show the equivalent key-binding when M-x command has one.