GNU bug report logs - #62145
[PATCH] home: services: fontutils: Add font specifications.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 62145 in the body.
You can then email your comments to 62145 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: conses <contact <at> conses.eu>
To: guix-patches <at> gnu.org
Cc: contact <at> conses.eu, Andrew Tropin <andrew <at> trop.in>
Subject: [PATCH] home: services: fontutils: Add font specifications.
Date: Sun, 12 Mar 2023 15:52:12 +0100

* 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 <at> trop.in>
 ;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
 ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023 conses <contact <at> 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

Message #8 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Andrew Tropin <andrew <at> trop.in>
To: Ludovic Courtès <ludo <at> gnu.org>, conses
 <contact <at> conses.eu>, guix-patches <at> gnu.org
Cc: contact <at> conses.eu
Subject: Re: [PATCH] home: services: fontutils: Add font specifications.
Date: Tue, 14 Mar 2023 11:36:14 +0400

[Message part 1 (text/plain, inline)]

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 <at> trop.in>
>  ;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
>  ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul <at> autistici.org>
> +;;; Copyright © 2023 conses <contact <at> 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.

-- 
Best regards,
Andrew Tropin

[signature.asc (application/pgp-signature, inline)]

Message #11 received at 62145 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Andrew Tropin <andrew <at> trop.in>
Cc: contact <at> conses.eu, 62145 <at> debbugs.gnu.org
Subject: Re: bug#62145: [PATCH] home: services: fontutils: Add font
 specifications.
Date: Tue, 18 Apr 2023 22:15:01 +0200

Hi,

Sorry for the delay!

Andrew Tropin <andrew <at> 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’.

Message #16 received at 62145-done <at> debbugs.gnu.org (full text, mbox):

From: Miguel Ángel Moreno <contact <at> conses.eu>
To: 62145-done <at> debbugs.gnu.org
Date: Wed, 07 Jun 2023 19:27:01 +0200

[Message part 1 (text/plain, inline)]

-- 
Best regards,
Miguel Ángel Moreno

[signature.asc (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.