[bug#62145] [PATCH] home: services: fontutils: Add font specifications.

[conses]

* gnu/home/services/fontutils.scm (add-font-profile-packages): Install font
packages for font spec families;
(home-fontconfig-configuration): New variable;
(add-fontconfig-config-files): Serialize with new values;
(add-fontconfig-extensions): New variable;
(home-fontconfig-service-type): Honor it.
---
 gnu/home/services/fontutils.scm | 100 ++++++++++++++++++++++++++++----
 1 file changed, 88 insertions(+), 12 deletions(-)

diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm
index 3399cb7ec8..4b1681c7d7 100644
--- a/gnu/home/services/fontutils.scm
+++ b/gnu/home/services/fontutils.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2023 conses <contact@conses.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,10 +22,18 @@
 (define-module (gnu home services fontutils)
   #:use-module (gnu home services)
   #:use-module (gnu packages fontutils)
+  #:use-module (gnu services configuration)
   #:use-module (guix gexp)
+  #:use-module (guix records)
   #:use-module (srfi srfi-1)
 
-  #:export (home-fontconfig-service-type))
+  #:export (home-fontconfig-service-type
+            home-fontconfig-configuration
+            font-spec
+            make-font-spec
+            font-spec?
+            font-spec-package
+            font-spec-family))
 
 ;;; Commentary:
 ;;;
@@ -35,37 +44,104 @@ (define-module (gnu home services fontutils)
 ;;;
 ;;; Code:
 
-(define (add-fontconfig-config-file directories)
+(define-record-type* <font-spec>
+  font-spec make-font-spec
+  font-spec?
+  (package font-spec-package)
+  (family font-spec-family))
+
+(define (serialize-font-spec field-name val)
+  (string-append "<alias>
+<family>" (symbol->string field-name) "</family>
+  <prefer>
+    <family>" (font-spec-family val) "</family>
+  </prefer>
+</alias>
+"))
+
+(define (serialize-list field val)
+  (apply string-append
+         (map (lambda (directory)
+                (string-append "  <dir>" directory "</dir>\n"))
+              val)))
+
+(define-maybe font-spec)
+
+(define-configuration home-fontconfig-configuration
+  (sans-serif
+   (maybe-font-spec)
+   "Sans serif font.")
+  (serif
+   (maybe-font-spec)
+   "Serif font.")
+  (monospace
+   (maybe-font-spec)
+   "Monospace font.")
+  (directories
+   (list '("~/.guix-home/profile/share/fonts"))
+   "The directories to add to the default @code{fontconfig} configuration."))
+
+(define (add-fontconfig-config-files config)
   `(("fontconfig/fonts.conf"
      ,(mixed-text-file
        "fonts.conf"
-       (apply string-append
-              `("<?xml version='1.0'?>
+       "<?xml version='1.0'?>
 <!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
-<fontconfig>\n" ,@(map (lambda (directory)
-                         (string-append "  <dir>" directory "</dir>\n"))
-                       directories)
-                "</fontconfig>\n"))))))
+<fontconfig>
+" (serialize-configuration
+   config (filter-configuration-fields
+           home-fontconfig-configuration-fields '(directories)))
+       "</fontconfig>\n"))
+    ("fontconfig/conf.d/50-default-fonts.conf"
+     ,(mixed-text-file
+       "50-user.conf"
+       "<?xml version='1.0'?>
+<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
+<fontconfig>
+" (serialize-configuration
+   config (filter-configuration-fields
+           home-fontconfig-configuration-fields '(directories) #t))
+"
+</fontconfig>"))))
 
 (define (regenerate-font-cache-gexp _)
   `(("profile/share/fonts"
      ,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv"))))
 
+(define (add-font-profile-packages config)
+  (append
+   (list fontconfig)
+   (fold (lambda (field res)
+           (let ((val ((configuration-field-getter field) config)))
+             (if (eq? 'disabled val)
+                 res
+                 (cons (font-spec-package val) res))))
+         '()
+         (filter-configuration-fields
+          home-fontconfig-configuration-fields '(directories) #t))))
+
+(define (add-fontconfig-extensions config extensions)
+  (home-fontconfig-configuration
+   (inherit config)
+   (directories
+    (append (home-fontconfig-configuration-directories config)
+            extensions))))
+
 (define home-fontconfig-service-type
   (service-type (name 'home-fontconfig)
                 (extensions
                  (list (service-extension
                         home-xdg-configuration-files-service-type
-                        add-fontconfig-config-file)
+                        add-fontconfig-config-files)
                        (service-extension
                         home-run-on-change-service-type
                         regenerate-font-cache-gexp)
                        (service-extension
                         home-profile-service-type
-                        (const (list fontconfig)))))
+                        add-font-profile-packages)))
                 (compose concatenate)
-                (extend append)
-                (default-value '("~/.guix-home/profile/share/fonts"))
+                (extend add-fontconfig-extensions)
+                (default-value (home-fontconfig-configuration))
                 (description
                  "Provides configuration file for fontconfig and make
 fc-* utilities aware of font packages installed in Guix Home's profile.")))
-- 
2.39.1



-- 
Best regards,
conses