[PATCH] home: services: fontutils: Add font specifications.

Done

Details

3 participants

Andrew Tropin
conses
Ludovic Courtès

Owner: unassigned

Submitted by: conses

Severity: normal

conses wrote on 12 Mar 2023 15:52

Recipients:(address . guix-patches@gnu.org)

Message-ID:86jzzmt42r.fsf@conses.eu

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

Toggle diff (156 lines)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

Andrew Tropin wrote on 14 Mar 2023 08:36

Recipients:(address . contact@conses.eu)

Message-ID:87wn3jaioh.fsf@trop.in

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

Toggle quote (124 lines)> * 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.

Toggle quote (38 lines)> +                 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/57963on

related functionality, but it seems it went in the wrong direction and

never finished with a practical solution.

Best regards,

Andrew Tropin

Ludovic Courtès wrote on 18 Apr 2023 22:15

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

Recipients:(name . Andrew Tropin)(address . andrew@trop.in)

Message-ID:87ttxdgd6i.fsf_-_@gnu.org

Hi,

Sorry for the delay!

Andrew Tropin <andrew@trop.in> skribis:

Toggle quote (2 lines)

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

[...]

Toggle quote (18 lines)>>                  (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?

Toggle quote (4 lines)

> Also, there is very long thread https://issues.guix.gnu.org/57963on

> 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’.

Miguel Ángel Moreno wrote on 7 Jun 2023 19:27

Recipients:(address . 62145-done@debbugs.gnu.org)

Message-ID:86r0qnchei.fsf@conses.eu

-- 
Best regards,
Miguel Ángel Moreno

Closed

Your comment

This issue is archived.

To comment on this conversation send an email to 62145@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it

mumi current 62145

Then, you may apply the latest patchset in this issue (with sign off)

mumi am -- -s

Or, compose a reply to this issue

mumi compose

Or, send patches to this issue

mumi send-email *.patch

is:open	open issues
is:done	closed issues
submitter:<who>	search issue submitter
author:<who>	search by message author
date:yesterday..now	search by issue date
mdate:3m..2d	search by message date