From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sun, 17 Nov 2024 22:49:49 +0000 (-0500)
Subject: * cus-face.el: Provide completion for font families (bug#74362)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ef9187d2a4b50c2959601a03f2aa42a875ae0f0a;p=emacs.git

* cus-face.el: Provide completion for font families (bug#74362)

* lisp/cus-edit.el (custom-face--font-cache-timeout): New var.
(custom-face--font-completion): New function.
* lisp/cus-face.el (custom-face-attributes): Use it.

(cherry picked from commit ea550488233833baafda90a3f258f96953381274)
---

diff --git a/etc/NEWS b/etc/NEWS
index be3209f2ca2..19cbc360332 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -119,6 +119,8 @@ These inherit from the 'header-line' face, but the faces actually used
 on the header lines are now these two: the selected window uses
 'header-line-active', non-selected windows use 'header-line-inactive'.
 
+** In 'customize-face', the "Font family" attribute now supports completion.
+
 
 * Editing Changes in Emacs 31.1
 
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 80ec1ee05fa..e6aa65a7113 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3486,6 +3486,28 @@ to switch between two values."
 
 ;;; The `custom-face-edit' Widget.
 
+(defvar custom-face--font-cache-timeout 60
+  "Refresh the cache of font families after at most this many seconds.")
+
+(defalias 'custom-face--font-completion
+  (let ((lastlist nil)
+        (lasttime nil)
+        (lastframe nil))
+    (completion-table-case-fold
+     (completion-table-dynamic
+      (lambda (_string)
+        ;; Flush the cache timeout after a while.
+        (let ((time (float-time)))
+         (if (and lastlist (eq (selected-frame) lastframe)
+                  (> custom-face--font-cache-timeout (- time lasttime)))
+             lastlist
+           ;; (message "last list time: %s" (if lasttime (- time lasttime)))
+           (setq lasttime time)
+           (setq lastframe (selected-frame))
+           (setq lastlist
+                 (nconc (mapcar #'car face-font-family-alternatives)
+                        (font-family-list))))))))))
+
 (define-widget 'custom-face-edit 'checklist
   "Widget for editing face attributes.
 The following properties have special meanings for this widget:
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index d0a1a66e29f..478092c30cb 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -48,7 +48,8 @@
 (defconst custom-face-attributes
   `((:family
      (string :tag "Font Family"
-	     :help-echo "Font family or fontset alias name."))
+	     :completions custom-face--font-completion
+	     :help-echo "Font family or fontset alias name (with completion)."))
 
     (:foundry
      (string :tag "Font Foundry"