diff mbox series

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

Message ID 86jzzmt42r.fsf@conses.eu
State New
Headers show
Series [bug#62145] home: services: fontutils: Add font specifications. | expand

Commit Message

Miguel Ángel Moreno March 12, 2023, 2:52 p.m. UTC
* 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(-)

Comments

Andrew Tropin March 14, 2023, 7:36 a.m. UTC | #1
On 2023-03-12 15:52, conses wrote:

> * 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)

Probably maybe-value-set? should be used here.

> +                 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

Overall, it looks good to me, but it's a breaking change for people, who
explicitly initialized this service with the value (probably, there is a
very little number of such people or even none).  I think we can merge
this patch as it unlikely to disturb many people or any at all.

Ludo, WDYT?

Also, there is very long thread https://issues.guix.gnu.org/57963 on
related functionality, but it seems it went in the wrong direction and
never finished with a practical solution.
Ludovic Courtès April 18, 2023, 8:15 p.m. UTC | #2
Hi,

Sorry for the delay!

Andrew Tropin <andrew@trop.in> skribis:

> On 2023-03-12 15:52, conses wrote:

[...]

>>                  (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
>
> Overall, it looks good to me, but it's a breaking change for people, who
> explicitly initialized this service with the value (probably, there is a
> very little number of such people or even none).  I think we can merge
> this patch as it unlikely to disturb many people or any at all.
>
> Ludo, WDYT?

How about adding a check to deal with the case where the value is a list
of strings and print a deprecation warning when it is?

Since the current behavior is documented, we should provide a smooth
transition to the new interface.

Also, conses, could you update ‘doc/guix.texi’ to describe the new
interface?

> Also, there is very long thread https://issues.guix.gnu.org/57963 on
> related functionality, but it seems it went in the wrong direction and
> never finished with a practical solution.

Yeah, that’s sad because a lot of energy went into it.  Maybe there are
good ideas to borrow though?

Ludo’.
diff mbox series

Patch

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.")))