Use `completion-table-with-metadata' (bug#74865)
Prefer `completion-table-with-metadata' over explicit completion table lambdas for clarity. Furthermore prefer it over `completion-extra-properties' to avoid problems with recursive minibuffers and recursive completion sessions, since the completion metadata applies only to the outer completion session. * lisp/bookmark.el (bookmark-completing-read): * lisp/faces.el (read-face-name): * lisp/international/emoji.el (emoji--read-emoji): * lisp/net/dictionary.el (dictionary-completing-read-dictionary): * lisp/net/rcirc.el (rcirc-completion-at-point): * lisp/net/eww.el (eww-read-alternate-url): * lisp/simple.el (read-from-kill-ring): Use it. * lisp/calendar/calendar.el (calendar-read-date): Use `completion-table-with-metadata' and `completion-table-case-fold'. * lisp/proced.el (proced--read-signal): New function. (proced-send-signal): Use it.
This commit is contained in:
Daniel Mendler
Juri Linkov
parent
d2986e79b7
commit
3aceae113b
9 changed files with 99 additions and 109 deletions
|
|
@ -587,11 +587,8 @@ If DEFAULT is nil then return empty string for empty input."
|
|||
(let* ((completion-ignore-case bookmark-completion-ignore-case)
|
||||
(default (unless (equal "" default) default)))
|
||||
(completing-read (format-prompt prompt default)
|
||||
(lambda (string pred action)
|
||||
(if (eq action 'metadata)
|
||||
'(metadata (category . bookmark))
|
||||
(complete-with-action
|
||||
action bookmark-alist string pred)))
|
||||
(completion-table-with-metadata
|
||||
bookmark-alist '((category . bookmark)))
|
||||
nil 0 nil 'bookmark-history default))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2335,14 +2335,14 @@ returned is (month year)."
|
|||
defyear))
|
||||
(month-array calendar-month-name-array)
|
||||
(defmon (aref month-array (1- (calendar-extract-month default-date))))
|
||||
(completion-ignore-case t)
|
||||
(month (cdr (assoc-string
|
||||
(let ((completion-extra-properties
|
||||
'(:category calendar-month)))
|
||||
(completing-read
|
||||
(format-prompt "Month name" defmon)
|
||||
(append month-array nil)
|
||||
nil t nil nil defmon))
|
||||
(completing-read
|
||||
(format-prompt "Month name" defmon)
|
||||
(completion-table-with-metadata
|
||||
(completion-table-case-fold
|
||||
(append month-array nil))
|
||||
`((category . calendar-month)))
|
||||
nil t nil nil defmon)
|
||||
(calendar-make-alist month-array 1) t)))
|
||||
(defday (calendar-extract-day default-date))
|
||||
(last (calendar-last-day-of-month month year)))
|
||||
|
|
|
|||
|
|
@ -1147,17 +1147,6 @@ returned. Otherwise, DEFAULT is returned verbatim."
|
|||
(let ((prompt (if default
|
||||
(format-prompt prompt default)
|
||||
(format "%s: " prompt)))
|
||||
(completion-extra-properties
|
||||
`(:affixation-function
|
||||
,(lambda (faces)
|
||||
(mapcar
|
||||
(lambda (face)
|
||||
(list face
|
||||
(concat (propertize read-face-name-sample-text
|
||||
'face face)
|
||||
"\t")
|
||||
""))
|
||||
faces))))
|
||||
aliasfaces nonaliasfaces faces)
|
||||
;; Build up the completion tables.
|
||||
(mapatoms (lambda (s)
|
||||
|
|
@ -1180,7 +1169,18 @@ returned. Otherwise, DEFAULT is returned verbatim."
|
|||
(nreverse faces))
|
||||
(let ((face (completing-read
|
||||
prompt
|
||||
(completion-table-in-turn nonaliasfaces aliasfaces)
|
||||
(completion-table-with-metadata
|
||||
(completion-table-in-turn nonaliasfaces aliasfaces)
|
||||
`((affixation-function
|
||||
. ,(lambda (faces)
|
||||
(mapcar
|
||||
(lambda (face)
|
||||
(list face
|
||||
(concat (propertize read-face-name-sample-text
|
||||
'face face)
|
||||
"\t")
|
||||
""))
|
||||
faces)))))
|
||||
nil t nil 'face-name-history defaults)))
|
||||
(when (facep face) (if (stringp face)
|
||||
(intern face)
|
||||
|
|
|
|||
|
|
@ -663,25 +663,22 @@ We prefer the earliest unique letter."
|
|||
(name
|
||||
(completing-read
|
||||
"Insert emoji: "
|
||||
(lambda (string pred action)
|
||||
(if (eq action 'metadata)
|
||||
(list 'metadata
|
||||
(cons
|
||||
'affixation-function
|
||||
;; Add the glyphs to the start of the displayed
|
||||
;; strings when TAB-ing.
|
||||
(lambda (strings)
|
||||
(mapcar
|
||||
(lambda (name)
|
||||
(if emoji-alternate-names
|
||||
(list name "" "")
|
||||
(list name
|
||||
(concat
|
||||
(or (gethash name emoji--all-bases) " ")
|
||||
"\t")
|
||||
"")))
|
||||
strings))))
|
||||
(complete-with-action action table string pred)))
|
||||
(completion-table-with-metadata
|
||||
table
|
||||
`((affixation-function
|
||||
;; Add the glyphs to the start of the displayed
|
||||
;; strings when TAB-ing.
|
||||
. ,(lambda (strings)
|
||||
(mapcar
|
||||
(lambda (name)
|
||||
(if emoji-alternate-names
|
||||
(list name "" "")
|
||||
(list name
|
||||
(concat
|
||||
(or (gethash name emoji--all-bases) " ")
|
||||
"\t")
|
||||
"")))
|
||||
strings)))))
|
||||
nil t)))
|
||||
(if (cl-plusp (length name))
|
||||
(let ((glyph (if emoji-alternate-names
|
||||
|
|
|
|||
|
|
@ -1609,15 +1609,17 @@ which usually includes the languages it supports."
|
|||
(defun dictionary-completing-read-dictionary ()
|
||||
"Prompt for a dictionary the server supports."
|
||||
(let* ((dicts (dictionary-dictionaries))
|
||||
(len (apply #'max (mapcar #'length (mapcar #'car dicts))))
|
||||
(completion-extra-properties
|
||||
(list :annotation-function
|
||||
(lambda (key)
|
||||
(concat (make-string (1+ (- len (length key))) ?\s)
|
||||
(alist-get key dicts nil nil #'string=))))))
|
||||
(completing-read (format-prompt "Select dictionary"
|
||||
dictionary-default-dictionary)
|
||||
dicts nil t nil nil dictionary-default-dictionary)))
|
||||
(len (apply #'max (mapcar #'length (mapcar #'car dicts)))))
|
||||
(completing-read
|
||||
(format-prompt "Select dictionary"
|
||||
dictionary-default-dictionary)
|
||||
(completion-table-with-metadata
|
||||
dicts
|
||||
`((annotation-function
|
||||
. ,(lambda (key)
|
||||
(concat (make-string (1+ (- len (length key))) ?\s)
|
||||
(alist-get key dicts nil nil #'string=))))))
|
||||
nil t nil nil dictionary-default-dictionary)))
|
||||
|
||||
(define-button-type 'help-word
|
||||
:supertype 'help-xref
|
||||
|
|
|
|||
|
|
@ -2926,31 +2926,34 @@ with completion. If there are none, return nil."
|
|||
(mapcar #'caddr alternates))))
|
||||
(sep-width (string-pixel-width " ")))
|
||||
(if (cdr alternates)
|
||||
(let ((completion-extra-properties
|
||||
(list :annotation-function
|
||||
(lambda (feed)
|
||||
(let* ((attrs (alist-get feed
|
||||
alternates
|
||||
nil
|
||||
nil
|
||||
#'string=))
|
||||
(type (car attrs))
|
||||
(title (cadr attrs)))
|
||||
(completing-read
|
||||
"Alternate URL: "
|
||||
(completion-table-with-metadata
|
||||
alternates
|
||||
`((annotation-function
|
||||
. ,(lambda (feed)
|
||||
(let* ((attrs (alist-get feed
|
||||
alternates
|
||||
nil
|
||||
nil
|
||||
#'string=))
|
||||
(type (car attrs))
|
||||
(title (cadr attrs)))
|
||||
(concat
|
||||
(propertize " " 'display
|
||||
`(space :align-to
|
||||
(,(+ sep-width
|
||||
url-max-width))))
|
||||
title
|
||||
(when type
|
||||
(concat
|
||||
(propertize " " 'display
|
||||
`(space :align-to
|
||||
(,(+ sep-width
|
||||
url-max-width))))
|
||||
title
|
||||
(when type
|
||||
(concat
|
||||
(propertize " " 'display
|
||||
`(space :align-to
|
||||
(,(+ (* 2 sep-width)
|
||||
url-max-width
|
||||
title-max-width))))
|
||||
"[" type "]"))))))))
|
||||
(completing-read "Alternate URL: " alternates nil t))
|
||||
(,(+ (* 2 sep-width)
|
||||
url-max-width
|
||||
title-max-width))))
|
||||
"[" type "]"))))))))
|
||||
nil t)
|
||||
(caar alternates)))))
|
||||
|
||||
(defun eww-copy-alternate-url ()
|
||||
|
|
|
|||
|
|
@ -1323,10 +1323,8 @@ The list is updated automatically by `defun-rcirc-command'.")
|
|||
(rcirc-channel-nicks (rcirc-buffer-process)
|
||||
rcirc-target))))))
|
||||
(list beg (point)
|
||||
(lambda (str pred action)
|
||||
(if (eq action 'metadata)
|
||||
'(metadata (cycle-sort-function . identity))
|
||||
(complete-with-action action table str pred)))))))
|
||||
(completion-table-with-metadata
|
||||
table '((cycle-sort-function . identity)))))))
|
||||
|
||||
(defun rcirc-set-decode-coding-system (coding-system)
|
||||
"Set the decode CODING-SYSTEM used in this channel."
|
||||
|
|
|
|||
|
|
@ -2110,6 +2110,20 @@ The value returned is the value of the last form in BODY."
|
|||
(window-height . fit-window-to-buffer)))
|
||||
,@body))))
|
||||
|
||||
(defun proced--read-signal (count)
|
||||
"Read a SIGNAL via `completing-read' for COUNT processes."
|
||||
(completing-read
|
||||
(format-prompt "Send signal [%s]"
|
||||
"TERM"
|
||||
(if (= 1 count)
|
||||
"1 process"
|
||||
(format "%d processes" count)))
|
||||
(completion-table-with-metadata
|
||||
(completion-table-case-fold proced-signal-list)
|
||||
`((annotation-function
|
||||
. ,(lambda (s) (cdr (assoc s proced-signal-list))))))
|
||||
nil nil nil nil "TERM"))
|
||||
|
||||
(defun proced-send-signal (&optional signal process-alist)
|
||||
"Send a SIGNAL to processes in PROCESS-ALIST.
|
||||
PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
|
||||
|
|
@ -2124,20 +2138,10 @@ Then PROCESS-ALIST contains the marked processes or the process point is on
|
|||
and SIGNAL is queried interactively. This noninteractive usage is still
|
||||
supported but discouraged. It will be removed in a future version of Emacs."
|
||||
(interactive
|
||||
(let* ((process-alist (proced-marked-processes))
|
||||
(pnum (if (= 1 (length process-alist))
|
||||
"1 process"
|
||||
(format "%d processes" (length process-alist))))
|
||||
(completion-ignore-case t)
|
||||
(completion-extra-properties
|
||||
`(:annotation-function
|
||||
,(lambda (s) (cdr (assoc s proced-signal-list))))))
|
||||
(proced-with-processes-buffer process-alist
|
||||
(list (completing-read (format-prompt "Send signal [%s]"
|
||||
"TERM" pnum)
|
||||
proced-signal-list
|
||||
nil nil nil nil "TERM")
|
||||
process-alist)))
|
||||
(let ((process-alist (proced-marked-processes)))
|
||||
(proced-with-processes-buffer
|
||||
process-alist
|
||||
(list (proced--read-signal (length process-alist)) process-alist)))
|
||||
proced-mode)
|
||||
|
||||
(unless (and signal process-alist)
|
||||
|
|
@ -2151,18 +2155,9 @@ supported but discouraged. It will be removed in a future version of Emacs."
|
|||
(sit-for 2))
|
||||
(setq process-alist (proced-marked-processes))
|
||||
(unless signal
|
||||
(let ((pnum (if (= 1 (length process-alist))
|
||||
"1 process"
|
||||
(format "%d processes" (length process-alist))))
|
||||
(completion-ignore-case t)
|
||||
(completion-extra-properties
|
||||
`(:annotation-function
|
||||
,(lambda (s) (cdr (assoc s proced-signal-list))))))
|
||||
(proced-with-processes-buffer process-alist
|
||||
(setq signal (completing-read (format-prompt "Send signal [%s]"
|
||||
"TERM" pnum)
|
||||
proced-signal-list
|
||||
nil nil nil nil "TERM"))))))
|
||||
(proced-with-processes-buffer
|
||||
process-alist
|
||||
(setq signal (proced--read-signal (length process-alist))))))
|
||||
|
||||
(let (failures)
|
||||
;; Why not always use `signal-process'? See
|
||||
|
|
|
|||
|
|
@ -6511,11 +6511,9 @@ PROMPT is a string to prompt with."
|
|||
map)))
|
||||
(completing-read
|
||||
prompt
|
||||
(lambda (string pred action)
|
||||
(if (eq action 'metadata)
|
||||
;; Keep sorted by recency
|
||||
'(metadata (display-sort-function . identity))
|
||||
(complete-with-action action completions string pred)))
|
||||
;; Keep sorted by recency
|
||||
(completion-table-with-metadata
|
||||
completions '((display-sort-function . identity)))
|
||||
nil nil nil
|
||||
(if history-pos
|
||||
(cons 'read-from-kill-ring-history
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue