[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3aceae113bc 2/2: Use `completion-table-with-metadata' (bug#74865)
|
From: |
Juri Linkov |
|
Subject: |
master 3aceae113bc 2/2: Use `completion-table-with-metadata' (bug#74865) |
|
Date: |
Mon, 16 Dec 2024 13:21:43 -0500 (EST) |
branch: master
commit 3aceae113bc88e52bf1c791f9dadad749a66ab53
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Juri Linkov <juri@linkov.net>
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.
---
lisp/bookmark.el | 7 ++-----
lisp/calendar/calendar.el | 14 +++++++-------
lisp/faces.el | 24 +++++++++++------------
lisp/international/emoji.el | 35 +++++++++++++++------------------
lisp/net/dictionary.el | 20 ++++++++++---------
lisp/net/eww.el | 47 ++++++++++++++++++++++++---------------------
lisp/net/rcirc.el | 6 ++----
lisp/proced.el | 47 ++++++++++++++++++++-------------------------
lisp/simple.el | 8 +++-----
9 files changed, 99 insertions(+), 109 deletions(-)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index d43f9f740ca..e87b43b3c78 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -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))))
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 7c883617aca..60d8fdd6aee 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -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)))
diff --git a/lisp/faces.el b/lisp/faces.el
index f8ec0f1a187..05df685c679 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -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)
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 7ede6ac8058..337a2914084 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -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
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 42fb8c57b40..8c7d87f56a5 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -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
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 4609755a902..9b4bbca2e3e 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -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 ()
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 33e4008fc0b..87ebdac6211 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -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."
diff --git a/lisp/proced.el b/lisp/proced.el
index da9212f6802..21d1d7c9da4 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -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
diff --git a/lisp/simple.el b/lisp/simple.el
index f2ee4a5df67..e3e6ab6b564 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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