[elpa] externals/fontaine 752a0af5df: Accept optional FRAME for font changes

[ELPA Syncer]

branch: externals/fontaine
commit 752a0af5df1722c10da141d28147c1528fc9eda9
Author: Protesilaos Stavrou <info@protesilaos.com>
Commit: Protesilaos Stavrou <info@protesilaos.com>

    Accept optional FRAME for font changes
---
 README.org  |  17 +++++-
 fontaine.el | 175 ++++++++++++++++++++++++++++++++++++++----------------------
 2 files changed, 126 insertions(+), 66 deletions(-)

diff --git a/README.org b/README.org
index 843370d81f..956ef6e7b9 100644
--- a/README.org
+++ b/README.org
@@ -69,8 +69,8 @@ modify this GNU manual.”
 
 #+vindex: fontaine-presets
 Fontaine lets the user specify presets of font configurations and set
-them on demand.  The user option ~fontaine-presets~ holds all such
-presets.
+them on demand on graphical Emacs frames.  The user option
+~fontaine-presets~ holds all such presets.
 
 Presets consist of a list of properties that govern the family, weight,
 and height of the faces ~default~, ~fixed-pitch~, ~variable-pitch~,
@@ -112,6 +112,16 @@ such as:
 (fontaine-set-preset 'regular)
 #+end_src
 
+The default behaviour of ~fontaine-set-preset~ is to change fonts across
+all graphical frames.  The user can, however, limit the changes to a
+given frame.  For interactive use, this is done by invoking the command
+with a universal prefix argument (=C-u= by default), which changes fonts
+only in the current frame.  When used in Lisp, the FRAME argument can be
+a frame object (satisfies ~framep~) or a non-nil value: the former
+applies the effects to the given object, while the latter means the
+current frame and thus is the same as interactively supplying the prefix
+argument.
+
 #+findex: fontaine-set-face-font
 #+vindex: fontaine-font-families
 The command ~fontaine-set-face-font~ prompts with completion for a face
@@ -132,6 +142,9 @@ Changing the ~bold~ and ~italic~ faces only has a 
noticeable effect if
 the underlying theme does not hardcode a weight and slant but inherits
 from those faces instead (e.g. the ~modus-themes~).
 
+The ~fontaine-set-face-font~ also accepts an optional FRAME argument,
+which is the same as what was described above for ~fontaine-set-preset~.
+
 #+vindex: fontaine-latest-state-file
 #+findex: fontaine-store-latest-preset
 #+findex: fontaine-restore-latest-preset
diff --git a/fontaine.el b/fontaine.el
index 5e5aff698f..babbb7c9c7 100644
--- a/fontaine.el
+++ b/fontaine.el
@@ -26,8 +26,8 @@
 ;;; Commentary:
 ;;
 ;; Fontaine lets the user specify presets of font configurations and set
-;; them on demand.  The user option `fontaine-presets' holds all such
-;; presets.
+;; them on demand on graphical Emacs frames.  The user option
+;; `fontaine-presets' holds all such presets.
 ;;
 ;; Presets consist of a list of properties that govern the family, weight,
 ;; and height of the faces `default', `fixed-pitch', `variable-pitch',
@@ -64,6 +64,16 @@
 ;;
 ;;     (fontaine-set-preset 'regular)
 ;;
+;; The default behaviour of `fontaine-set-preset' is to change fonts across
+;; all graphical frames.  The user can, however, limit the changes to a
+;; given frame.  For interactive use, this is done by invoking the command
+;; with a universal prefix argument (`C-u' by default), which changes fonts
+;; only in the current frame.  When used in Lisp, the FRAME argument can be
+;; a frame object (satisfies `framep') or a non-nil value: the former
+;; applies the effects to the given object, while the latter means the
+;; current frame and thus is the same as interactively supplying the prefix
+;; argument.
+;;
 ;; The command `fontaine-set-face-font' prompts with completion for a face
 ;; and then asks the user to specify the value of the relevant properties.
 ;; Preferred font families can be defined in the user option
@@ -82,6 +92,9 @@
 ;; the underlying theme does not hardcode a weight and slant but inherits
 ;; from those faces instead (e.g. the `modus-themes').
 ;;
+;; The `fontaine-set-face-font' also accepts an optional FRAME argument,
+;; which is the same as what was described above for `fontaine-set-preset'.
+;;
 ;; The latest value of `fontaine-set-preset' is stored in a file whose
 ;; location is defined in `fontaine-latest-state-file'.  Saving is done by
 ;; the `fontaine-store-latest-preset' function, which should be assigned to
@@ -298,80 +311,94 @@ combine the other two lists."
 
 ;;;; General utilities
 
-(defun fontaine--set-face-attributes (face family &optional weight height)
-  "Set FACE font to FAMILY, with optional HEIGHT and WEIGHT."
+(defun fontaine--frame (frame)
+  "Return FRAME for `internal-set-lisp-face-attribute'."
+  (cond
+   ((framep frame) frame)
+   (frame nil)
+   (t 0)))
+
+(defun fontaine--set-face-attributes (face family &optional weight height 
frame)
+  "Set FACE font to FAMILY, with optional HEIGHT, WEIGHT, FRAME."
   (let ((family (or family "Monospace"))
         (height (or height (if (eq face 'default) 100 1.0)))
-        (weight (or weight 'normal)))
+        (weight (or weight 'normal))
+        (frames (fontaine--frame frame)))
     ;; ;; Read this: <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=45920>
     ;; ;; Hence why the following fails.  Keeping it for posterity...
     ;; (set-face-attribute face nil :family family :weight weight :height 
height)
     (if (eq (face-attribute face :weight) weight)
-        (internal-set-lisp-face-attribute face :family family 0)
-      (internal-set-lisp-face-attribute face :weight weight 0)
-      (internal-set-lisp-face-attribute face :family family 0)
-      (internal-set-lisp-face-attribute face :weight weight 0))
-    (internal-set-lisp-face-attribute face :height height 0)))
-
-(defun fontaine--set-italic-slant (family slant)
-  "Set FAMILY and SLANT of `italic' face."
+        (internal-set-lisp-face-attribute face :family family frames)
+      (internal-set-lisp-face-attribute face :weight weight frames)
+      (internal-set-lisp-face-attribute face :family family frames)
+      (internal-set-lisp-face-attribute face :weight weight frames))
+    (internal-set-lisp-face-attribute face :height height frames)))
+
+(defun fontaine--set-italic-slant (family slant &optional frame)
+  "Set FAMILY and SLANT of `italic' face on optional FRAME."
   (let ((slant (or slant 'italic))
-        (family (or family 'unspecified)))
+        (family (or family 'unspecified))
+        (frames (fontaine--frame frame)))
     (if (eq (face-attribute 'italic :slant) slant)
-        (internal-set-lisp-face-attribute 'italic :family family 0)
-      (internal-set-lisp-face-attribute 'italic :slant slant 0)
-      (internal-set-lisp-face-attribute 'italic :family family 0)
-      (internal-set-lisp-face-attribute 'italic :slant slant 0))))
+        (internal-set-lisp-face-attribute 'italic :family family frames)
+      (internal-set-lisp-face-attribute 'italic :slant slant frames)
+      (internal-set-lisp-face-attribute 'italic :family family frames)
+      (internal-set-lisp-face-attribute 'italic :slant slant frames))))
 
 ;;;; Apply preset configurations
 
-(defun fontaine--apply-default-preset (preset)
-  "Set `default' face attributes based on PRESET."
+(defun fontaine--apply-default-preset (preset &optional frame)
+  "Set `default' face attributes based on PRESET for optional FRAME."
   (if-let ((properties (alist-get preset fontaine-presets)))
       (progn
         (fontaine--set-face-attributes
          'default
          (plist-get properties :default-family)
          (plist-get properties :default-weight)
-         (plist-get properties :default-height))
+         (plist-get properties :default-height)
+         frame)
         (setq-default line-spacing (plist-get properties :line-spacing)))
     (user-error "%s is not in `fontaine-presets'" preset)))
 
-(defun fontaine--apply-fixed-pitch-preset (preset)
-  "Set `fixed-pitch' face attributes based on PRESET."
+(defun fontaine--apply-fixed-pitch-preset (preset &optional frame)
+  "Set `fixed-pitch' face attributes based on PRESET for optional FRAME."
   (if-let ((properties (alist-get preset fontaine-presets)))
       (fontaine--set-face-attributes
        'fixed-pitch
        (or (plist-get properties :fixed-pitch-family) (plist-get properties 
:default-family))
        (or (plist-get properties :fixed-pitch-weight) (plist-get properties 
:default-weight))
-       (or (plist-get properties :fixed-pitch-height) 1.0))
+       (or (plist-get properties :fixed-pitch-height) 1.0)
+       frame)
     (user-error "%s is not in `fontaine-presets'" preset)))
 
-(defun fontaine--apply-variable-pitch-preset (preset)
-  "Set `variable-pitch' face attributes based on PRESET."
+(defun fontaine--apply-variable-pitch-preset (preset &optional frame)
+  "Set `variable-pitch' face attributes based on PRESET for optional FRAME."
   (if-let ((properties (alist-get preset fontaine-presets)))
       (fontaine--set-face-attributes
        'variable-pitch
        (or (plist-get properties :variable-pitch-family) (plist-get properties 
:default-family))
        (or (plist-get properties :variable-pitch-weight) (plist-get properties 
:default-weight))
-       (or (plist-get properties :variable-pitch-height) 1.0))
+       (or (plist-get properties :variable-pitch-height) 1.0)
+       frame)
     (user-error "%s is not in `fontaine-presets'" preset)))
 
-(defun fontaine--apply-bold-preset (preset)
-  "Set `bold' face attributes based on PRESET."
+(defun fontaine--apply-bold-preset (preset &optional frame)
+  "Set `bold' face attributes based on PRESET for optional FRAME."
   (if-let ((properties (alist-get preset fontaine-presets)))
       (fontaine--set-face-attributes
        'bold
        (or (plist-get properties :bold-family) 'unspecified)
-       (or (plist-get properties :bold-weight) 'bold))
+       (or (plist-get properties :bold-weight) 'bold)
+       frame)
     (user-error "%s is not in `fontaine-presets'" preset)))
 
-(defun fontaine--apply-italic-preset (preset)
-  "Set `italic' face attributes based on PRESET."
+(defun fontaine--apply-italic-preset (preset &optional frame)
+  "Set `italic' face attributes based on PRESET for optional FRAME."
   (if-let ((properties (alist-get preset fontaine-presets)))
       (fontaine--set-italic-slant
        (or (plist-get properties :italic-family) 'unspecified)
-       (or (plist-get properties :italic-slant) 'italic))
+       (or (plist-get properties :italic-slant) 'italic)
+       frame)
     (user-error "%s is not in `fontaine-presets'" preset)))
 
 (defvar fontaine--font-display-hist '()
@@ -396,23 +423,33 @@ combine the other two lists."
   "Current font set in `fontaine-presets'.")
 
 ;;;###autoload
-(defun fontaine-set-preset (preset)
+(defun fontaine-set-preset (preset &optional frame)
   "Set font configurations specified in PRESET.
 PRESET is a symbol that represents the car of a list in
 `fontaine-presets'.  If there is only one available, apply it
-outright, else prompt with completion."
+outright, else prompt with completion.
+
+Unless optional FRAME argument is supplied, apply the change to
+all frames.  If FRAME satisfies `framep', then make the changes
+affect only it.  If FRAME is non-nil, interpret it as the current
+frame and apply the effects to it.
+
+When called interactively with a universal prefix
+argument (\\[universal-argument]), FRAME is interpreted as
+non-nil."
   (interactive
    (list
     (if (= (length fontaine-presets) 1)
         (caar fontaine-presets)
-      (fontaine--set-fonts-prompt))))
+      (fontaine--set-fonts-prompt))
+    current-prefix-arg))
   (if (not window-system)
       (user-error "Cannot use this in a terminal emulator; try the Emacs GUI")
-    (fontaine--apply-default-preset preset)
-    (fontaine--apply-fixed-pitch-preset preset)
-    (fontaine--apply-variable-pitch-preset preset)
-    (fontaine--apply-bold-preset preset)
-    (fontaine--apply-italic-preset preset)
+    (fontaine--apply-default-preset preset frame)
+    (fontaine--apply-fixed-pitch-preset preset frame)
+    (fontaine--apply-variable-pitch-preset preset frame)
+    (fontaine--apply-bold-preset preset frame)
+    (fontaine--apply-italic-preset preset frame)
     (setq fontaine--current-preset preset)
     (add-to-history 'fontaine--preset-history (format "%s" preset))
     (run-hooks 'fontaine-set-preset-hook)))
@@ -479,8 +516,8 @@ Target FRAME, if provided as an optional argument."
 (defvar fontaine--natnum-history '()
   "Minibuffer history for natural numbers.")
 
-(defun fontaine--set-default ()
-  "Set `default' attributes interactively."
+(defun fontaine--set-default (&optional frame)
+  "Set `default' attributes, optionally for FRAME."
   (let* ((families (or (alist-get 'default fontaine-font-families)
                        (append (alist-get 'fixed-pitch fontaine-font-families)
                                (alist-get 'variable-pitch 
fontaine-font-families))
@@ -494,7 +531,7 @@ Target FRAME, if provided as an optional argument."
                               (or (string-to-number (nth 0 
fontaine--natnum-history)))
                               'fontaine--natnum-history)))
     (if (natnump height)
-        (fontaine--set-face-attributes 'default family weight height)
+        (fontaine--set-face-attributes 'default family weight height frame)
       (user-error "Height of `default' face must be a natural number"))))
 
 (defvar fontaine--float-history '()
@@ -503,8 +540,8 @@ Target FRAME, if provided as an optional argument."
 (defvar fontaine--fixed-pitch-font-family-history '()
   "Minibuffer history of selected `fixed-pitch' font families.")
 
-(defun fontaine--set-fixed-pitch ()
-  "Set `fixed-pitch' attributes interactively."
+(defun fontaine--set-fixed-pitch (&optional frame)
+  "Set `fixed-pitch' attributes, optionally for FRAME."
   (let* ((families (or (alist-get 'fixed-pitch fontaine-font-families)
                        (fontaine--family-list-fixed-pitch)))
          (family (completing-read "Font family of `fixed-pitch': "
@@ -515,14 +552,14 @@ Target FRAME, if provided as an optional argument."
          (height (read-number "Height of `fixed-pitch' face (must be a 
floating point): "
                               1.0 'fontaine--float-history)))
     (if (floatp height)
-        (fontaine--set-face-attributes 'fixed-pitch family weight height)
+        (fontaine--set-face-attributes 'fixed-pitch family weight height frame)
       (user-error "Height of `fixed-pitch' face must be a floating point"))))
 
 (defvar fontaine--variable-pitch-font-family-history '()
   "Minibuffer history of selected `variable-pitch' font families.")
 
-(defun fontaine--set-variable-pitch ()
-  "Set `variable-pitch' attributes interactively."
+(defun fontaine--set-variable-pitch (&optional frame)
+  "Set `variable-pitch' attributes, optionally for FRAME."
   (let* ((families (or (alist-get 'variable-pitch fontaine-font-families)
                        (fontaine--family-list-variable-pitch)))
          (family (completing-read "Font family of `variable-pitch': "
@@ -533,23 +570,23 @@ Target FRAME, if provided as an optional argument."
          (height (read-number "Height of `variable-pitch' face (must be a 
floating point): "
                               1.0 'fontaine--float-history)))
     (if (floatp height)
-        (fontaine--set-face-attributes 'variable-pitch family weight height)
+        (fontaine--set-face-attributes 'variable-pitch family weight height 
frame)
       (user-error "Height of `variable-pitch' face must be a floating 
point"))))
 
-(defun fontaine--set-bold ()
-  "Set `bold' attributes interactively."
+(defun fontaine--set-bold (&optional frame)
+  "Set `bold' attributes, optionally for FRAME."
   (let ((weight (intern (completing-read "Select weight for `bold': "
                                          fontaine--font-weights nil t))))
-    (fontaine--set-face-attributes 'bold 'unspecified weight)))
+    (fontaine--set-face-attributes 'bold 'unspecified weight frame)))
 
-(defun fontaine--set-italic ()
-  "Set `italic' attributes interactively."
+(defun fontaine--set-italic (&optional frame)
+  "Set `italic' attributes, optionally for FRAME."
   (let ((slant (intern (completing-read "Select slant for `italic': "
                                         fontaine--font-slants nil t))))
-    (fontaine--set-italic-slant 'unspecified slant)))
+    (fontaine--set-italic-slant 'unspecified slant frame)))
 
 ;;;###autoload
-(defun fontaine-set-face-font (face)
+(defun fontaine-set-face-font (face &optional frame)
   "Set font and/or other attributes of FACE.
 
 When called interactively, prompt for FACE and then continue
@@ -571,20 +608,30 @@ and slant but inherits from those faces instead (e.g. the
 
 When called from Lisp (albeit discouraged), if FACE is not part
 of `fontaine--font-faces', fall back to interactively calling
-`fontaine-set-preset'."
+`fontaine-set-preset'.
+
+Unless optional FRAME argument is supplied, apply the change to
+all frames.  If FRAME satisfies `framep', then make the changes
+affect only it.  If FRAME is non-nil, interpret it as the current
+frame and apply the effects to it.
+
+When called interactively with a universal prefix
+argument (\\[universal-argument]), FRAME is interpreted as
+non-nil."
   (declare (interactive-only t))
   (interactive
    (list
     (intern
      (completing-read "Which face to change? "
                       fontaine--font-faces nil t nil
-                      'fontaine--face-history))))
+                      'fontaine--face-history))
+    current-prefix-arg))
   (pcase face
-    ('bold (fontaine--set-bold))
-    ('default (fontaine--set-default))
-    ('fixed-pitch (fontaine--set-fixed-pitch))
-    ('italic (fontaine--set-italic))
-    ('variable-pitch (fontaine--set-variable-pitch))
+    ('bold (fontaine--set-bold frame))
+    ('default (fontaine--set-default frame))
+    ('fixed-pitch (fontaine--set-fixed-pitch frame))
+    ('italic (fontaine--set-italic frame))
+    ('variable-pitch (fontaine--set-variable-pitch frame))
     (_ (call-interactively #'fontaine-set-preset))))
 
 ;;;; Store and restore preset