Subject: bug#74865: [PATCH] Use `completion-table-with-metadata'

From: Daniel Mendler <[email-masked]>
Date: Mon, 03 Feb 2025 09:59:28 +0100

Juri Linkov <[email-masked]> writes:

> This change removed affixation-function from another if-branch in 'read-face-name'
> for the case when 'multiple' is t that uses completing-read-multiple:

Hello Juri,

I have attached a patch to this mail which corrects this. Please give it
a test. Thank you!

Daniel

>From 50d6f59629f3bc7daf3eb19e52327ff08a08fb23 Mon Sep 17 00:00:00 2001
From: Daniel Mendler <[email-masked]>
Date: Mon, 3 Feb 2025 09:54:47 +0100
Subject: [PATCH] read-face-name: Build common completion table for CR and CRM

* lisp/faces.el (read-face-name): Build a common completion
table for both `completing-read' and `completing-read-multiple'
with completion metadata.
---
 lisp/faces.el | 40 +++++++++++++++++++---------------------
 1 file changed, 19 insertions(+), 21 deletions(-)

diff --git a/lisp/faces.el b/lisp/faces.el
index 5fe3ab1a294..dd8c24f5001 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1137,19 +1137,30 @@ read-face-name
     (let ((prompt (if default
                       (format-prompt prompt default)
                     (format "%s: " prompt)))
-          aliasfaces nonaliasfaces faces)
+          aliasfaces nonaliasfaces table)
       ;; Build up the completion tables.
       (mapatoms (lambda (s)
                   (if (facep s)
                       (if (get s 'face-alias)
                           (push (symbol-name s) aliasfaces)
                         (push (symbol-name s) nonaliasfaces)))))
+      (setq table
+            (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))))))
       (if multiple
-          (progn
-            (dolist (face (completing-read-multiple
-                           prompt
-                           (completion-table-in-turn nonaliasfaces aliasfaces)
-                           nil t nil 'face-name-history default))
+          (let (faces)
+            (dolist (face (completing-read-multiple prompt table nil t nil
+                                                    'face-name-history default))
               ;; Ignore elements that are not faces
               ;; (for example, because DEFAULT was "all faces")
               (if (facep face) (push (if (stringp face)
@@ -1157,21 +1168,8 @@ read-face-name
                                        face)
                                      faces)))
             (nreverse faces))
-        (let ((face (completing-read
-                     prompt
-                     (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)))
+        (let ((face (completing-read prompt table nil t nil
+                                     'face-name-history defaults)))
           (when (facep face) (if (stringp face)
                                  (intern face)
                                face)))))))
-- 
2.47.2