* bug#74865: [PATCH] Use `completion-table-with-metadata'
@ 2024-12-14 12:57 Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 18:20 ` Juri Linkov
2024-12-16 19:04 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 2 replies; 6+ messages in thread
From: Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-12-14 12:57 UTC (permalink / raw)
To: 74865; +Cc: Eli Zaretskii, Juri Linkov
[-- Attachment #1: Type: text/plain, Size: 304 bytes --]
Tags: patch
This is a small follow-up of bug#74616. There I have introduced the
`completion-table-with-metadata' helper function, which we can now take
advantage of at more places. By using `completion-table-with-metadata'
we avoid problems with completion sessions in recursive minibuffers.
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-completion-table-with-metadata.patch --]
[-- Type: text/patch, Size: 16539 bytes --]
From f9dca5a2a7d27a09c33af662a58a152cb371f65a Mon Sep 17 00:00:00 2001
From: Daniel Mendler <mail@daniel-mendler.de>
Date: Mon, 9 Dec 2024 22:28:08 +0100
Subject: [PATCH] Use `completion-table-with-metadata'
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 @@ bookmark-completing-read
(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 345687d1775..f901e1f1506 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -2335,14 +2335,14 @@ calendar-read-date
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 @@ read-face-name
(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 @@ read-face-name
(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 @@ emoji--read-emoji
(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 @@ dictionary-dictionaries
(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 @@ eww-read-alternate-url
(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 c41e2ec153f..cced386e2d0 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1323,10 +1323,8 @@ rcirc-completion-at-point
(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 @@ proced-with-processes-buffer
(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 @@ proced-send-signal
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 @@ proced-send-signal
(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 @@ read-from-kill-ring
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
--
2.45.2
^ permalink raw reply related [flat|nested] 6+ messages in thread* bug#74865: [PATCH] Use `completion-table-with-metadata'
2024-12-14 12:57 bug#74865: [PATCH] Use `completion-table-with-metadata' Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-12-16 18:20 ` Juri Linkov
2024-12-16 18:29 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 19:04 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 6+ messages in thread
From: Juri Linkov @ 2024-12-16 18:20 UTC (permalink / raw)
To: Daniel Mendler; +Cc: 74865
> This is a small follow-up of bug#74616. There I have introduced the
> `completion-table-with-metadata' helper function, which we can now take
> advantage of at more places. By using `completion-table-with-metadata'
> we avoid problems with completion sessions in recursive minibuffers.
Thanks for the patch, now pushed.
`completion-table-with-metadata' is a very useful function.
I already used it for the new command 'comint-complete-input-ring'
in bug#74694.
Also it could be used in `read-char-by-name' as well.
Maybe `completion-table-with-metadata' should be announced
in the "Lisp Changes" section of etc/NEWS?
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#74865: [PATCH] Use `completion-table-with-metadata'
2024-12-16 18:20 ` Juri Linkov
@ 2024-12-16 18:29 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 19:13 ` Juri Linkov
0 siblings, 1 reply; 6+ messages in thread
From: Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-12-16 18:29 UTC (permalink / raw)
To: Juri Linkov; +Cc: 74865
Juri Linkov <juri@linkov.net> writes:
>> This is a small follow-up of bug#74616. There I have introduced the
>> `completion-table-with-metadata' helper function, which we can now take
>> advantage of at more places. By using `completion-table-with-metadata'
>> we avoid problems with completion sessions in recursive minibuffers.
>
> Thanks for the patch, now pushed.
Thanks!
> `completion-table-with-metadata' is a very useful function.
> I already used it for the new command 'comint-complete-input-ring'
> in bug#74694.
>
> Also it could be used in `read-char-by-name' as well.
Yes, there are certainly more use cases. I didn't use it for
`read-char-by-name' since this would change the caching behavior
slightly. The character names would be loaded a little bit earlier,
which would slow down the initialization of `read-char-by-name'.
My patch only changed the call sites which are exactly equivalent with
and without the patch.
> Maybe `completion-table-with-metadata' should be announced
> in the "Lisp Changes" section of etc/NEWS?
Yes, please go ahead adding it to the NEWS. I will backport the function
also via Compat.
Daniel
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#74865: [PATCH] Use `completion-table-with-metadata'
2024-12-16 18:29 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-12-16 19:13 ` Juri Linkov
2024-12-16 19:26 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 6+ messages in thread
From: Juri Linkov @ 2024-12-16 19:13 UTC (permalink / raw)
To: Daniel Mendler; +Cc: 74865
>> Also it could be used in `read-char-by-name' as well.
>
> Yes, there are certainly more use cases. I didn't use it for
> `read-char-by-name' since this would change the caching behavior
> slightly. The character names would be loaded a little bit earlier,
> which would slow down the initialization of `read-char-by-name'.
Maybe the caching behavior could be preserved by turning
`completion-table-with-metadata' into a macro?
>> Maybe `completion-table-with-metadata' should be announced
>> in the "Lisp Changes" section of etc/NEWS?
>
> Yes, please go ahead adding it to the NEWS. I will backport the function
> also via Compat.
Ok, now added to NEWS.
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#74865: [PATCH] Use `completion-table-with-metadata'
2024-12-16 19:13 ` Juri Linkov
@ 2024-12-16 19:26 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 6+ messages in thread
From: Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-12-16 19:26 UTC (permalink / raw)
To: Juri Linkov; +Cc: 74865
Juri Linkov <juri@linkov.net> writes:
>>> Also it could be used in `read-char-by-name' as well.
>>
>> Yes, there are certainly more use cases. I didn't use it for
>> `read-char-by-name' since this would change the caching behavior
>> slightly. The character names would be loaded a little bit earlier,
>> which would slow down the initialization of `read-char-by-name'.
>
> Maybe the caching behavior could be preserved by turning
> `completion-table-with-metadata' into a macro?
Let us please keep `completion-table-with-metadata' a function for
composeability and ease of reasoning. `completion-table-with-metadata'
follows the many already existing `completion-table-with-*' functions in
minibuffer.el.
In order to delay initialization of the completion candidates we can use
the following code:
(completion-table-with-metadata
(lambda (string pred action)
(complete-with-action action (ucs-names) string pred))
metadata)
(completion-table-with-metadata
(completion-table-dynamic (lambda (_) (ucs-names)))
metadata)
>>> Maybe `completion-table-with-metadata' should be announced
>>> in the "Lisp Changes" section of etc/NEWS?
>>
>> Yes, please go ahead adding it to the NEWS. I will backport the function
>> also via Compat.
>
> Ok, now added to NEWS.
Thanks.
Daniel
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#74865: [PATCH] Use `completion-table-with-metadata'
2024-12-14 12:57 bug#74865: [PATCH] Use `completion-table-with-metadata' Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 18:20 ` Juri Linkov
@ 2024-12-16 19:04 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 0 replies; 6+ messages in thread
From: Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-12-16 19:04 UTC (permalink / raw)
To: 74865-done
Closing.
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2024-12-16 19:26 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-12-14 12:57 bug#74865: [PATCH] Use `completion-table-with-metadata' Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 18:20 ` Juri Linkov
2024-12-16 18:29 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 19:13 ` Juri Linkov
2024-12-16 19:26 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-12-16 19:04 ` Daniel Mendler via Bug reports for GNU Emacs, the Swiss army knife of text editors
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.