Improve 'read-face-name' completions alignment

* lisp/faces.el (read-face-name-sample-text): Add new possible values
that specify whether to show sample text before, or after, face names.
(completion-face-name-affixation): Pixel-align face names and samples.

* etc/NEWS: Improve wording.

* doc/lispref/display.texi (Face Functions): Update.

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 240ca3215e862b7874d2ff16a058c020a289db67..fc1e1a457e14de176b88d2a31f84ab7b208fe706 100644 (file)
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -3581,11 +3581,15 @@ This user option controls display of @dfn{face samples} in the
 @file{*Completions*} buffer of @code{read-face-name}.  If this user
 option is non-@code{nil}, @code{read-face-name} shows alongside each
 candidate face name a sample text with that face.  If
-@code{read-face-name-sample-text} is a string, @code{read-face-name}
-uses that string as the sample text.  If it is a non-@code{nil} value
-that is not a string, the face names act as their own sample
-text---@code{read-face-name} fontifies each face name in the
-@file{*Completions*} buffer with the face that it refers to.
+@code{read-face-name-sample-text} is a string @var{text}, or a cons
+cell @code{(@var{text} . before)}, @code{read-face-name} displays
+@var{text} as the sample text @emph{before} each face name.  If it is
+@code{(@var{text} . after)}, @code{read-face-name} displays @var{text}
+as the sample text @emph{after} each face name.  Any other
+non-@code{nil} value, such as @code{t}, means that the face names act
+as their own sample text---@code{read-face-name} fontifies each face
+name in the @file{*Completions*} buffer with the face that the name
+refers to.
 @end defopt
 
 @node Auto Faces

diff --git a/etc/NEWS b/etc/NEWS
index 05e2a630ec888c98dc596ff189e751fcaadc2fb2..a0b459dce5f26efa5bc8791017db5a52a0303872 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1306,7 +1306,7 @@ chat buffers use by default.
 *** New user option 'read-face-name-sample-text'.
 This user option lets you customize the sample text that
 'read-face-name' and commands that invoke 'read-face-name', such as
-'M-x describe-face', use to visually display faces in the
+'M-x describe-face', use to visually demonstrate faces in the
 "*Completions*" buffer.  By default this is set to the string
 "SAMPLE", which retains compatibility with Emacs 29.
 

diff --git a/lisp/faces.el b/lisp/faces.el
index d28839bd538242961eda06f232ce02b27838f754..bdc737a17bb39abc6ec3cf60d7bff52ef0214a07 100644 (file)
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1105,16 +1105,28 @@ If this user option is a string, as it is by default,
 the *Completions* buffer, fontifying each sample text with the
 candidate face it appears besides, so you can see how it looks.
 
-If this is non-nil and not a string, `read-face-name' fontifies
-the face names themselves with the faces they denote, so each
-face name acts as its own sample text.
+Emacs can display the sample text either before or after the face
+name: to specify where the sample text should appear, set this
+optionto a cons cell (TEXT . WHERE) where TEXT is the sample
+text, and WHERE is either `before' or `after'.  The sample text
+appears before the face name if WHERE is `before', and after the
+face name if WHERE is `after'.  In case this option is just a
+string, the sample text appears before the face name.
+
+Any other non-nil value, such as t, tells `read-face-name' to
+fontify the face names themselves with the faces they denote, so
+each face name acts as its own sample text.
 
 If this is nil, `read-face-name' does not show face samples in
 the *Completions* buffer."
   :version "30.1"
-  :type '(choice string
+  :type '(choice (string :tag "Sample text")
                  (const :tag "No sample text" nil)
-                 (const :tag "Use face names" t))
+                 (const :tag "Use face names" t)
+                 (cons :tag "Text and position"
+                       (string :tag "Sample text")
+                       (choice (const :tag "Before face name" before)
+                               (const :tag "After face name" after))))
   :group 'faces)
 
 (defun completion-face-name-affixation (names)
@@ -1124,14 +1136,44 @@ The affixation that this function performs depends on the value
 of `read-face-name-sample-text', which see."
   (mapcar
    (cond
-    ((stringp read-face-name-sample-text)
-     (let ((max-name (seq-max (mapcar #'string-width names))))
-       (lambda (name)
-         (list name
-               ""
-               (concat
-                (make-string (- (+ max-name 2) (string-width name)) ?\s)
-                (propertize read-face-name-sample-text 'face name))))))
+    ((or (stringp read-face-name-sample-text)
+         (consp read-face-name-sample-text))
+     (let* ((text (or (car-safe read-face-name-sample-text)
+                      read-face-name-sample-text))
+            (samp-list (mapcar (lambda (name)
+                                 (cons name (propertize text 'face name)))
+                               names))
+            (max-samp (seq-max (mapcar #'string-pixel-width
+                                       (mapcar #'cdr samp-list)))))
+       (if (eq (cdr-safe read-face-name-sample-text) 'after)
+           ;; Sample comes after the face name.
+           (let ((max-name (seq-max (mapcar #'string-width names))))
+             (lambda (name)
+               (let* ((samp (cdr (assoc name samp-list)))
+                      (padw (- max-samp (string-pixel-width samp))))
+                 (list name ""
+                       (concat
+                        (make-string (- (+ max-name 2) (string-width name))
+                                     ?\s)
+                        samp
+                        ;; Add invisible padding such that
+                        ;; `string-width' approximates display width,
+                        ;; for `completion--insert-strings'.
+                        (propertize
+                         (make-string (ceiling padw (default-font-width)) ?\s)
+                         'invisible t))))))
+         ;; Sample comes before the face name.
+         (lambda (name)
+           (let* ((samp (cdr (assoc name samp-list)))
+                  (padw (- max-samp (string-pixel-width samp))))
+             (list name
+                   (concat
+                    samp
+                    (propertize
+                     (make-string (ceiling padw (default-font-width)) ?\s)
+                     'display `(space :width (,padw)))
+                    " ")
+                   ""))))))
     (read-face-name-sample-text
      (lambda (name) (list (propertize name 'face name) "" "")))
     (t