Subject: [PATCH] Use `completion-table-with-metadata'
From: Daniel Mendler <[email-masked]>
To: [email-masked]
Cc: Eli Zaretskii <[email-masked]>, Juri Linkov <[email-masked]>
Date: Sat, 14 Dec 2024 13:57:11 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

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

From f9dca5a2a7d27a09c33af662a58a152cb371f65a Mon Sep 17 00:00:00 2001
From: Daniel Mendler <[email-masked]>
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