[bug#57963,v4,2/2] home: fontutils: Support user's fontconfig.

* gnu/home/services/fontutils.scm: Support user's fontconfig.
---
 gnu/home/services/fontutils.scm | 86 ++++++++++++++++++++++++++++++---
 1 file changed, 80 insertions(+), 6 deletions(-)
  

The new way to extend the service is as follows.

--8<---------------cut here---------------start------------->8---
(home-environment
 (packages (list font-google-noto))
 (services
  (append
      (list
       (service home-bash-service-type))
      (modify-services %home-base-services
        (home-fontconfig-service-type
         config => (home-fontconfig-configuration
                    (font-directories
                     (list "~/fonts"))
                    (preferred-default-font
                     (default-font
                       (serif "Noto Serif CJK JP")
                       (sans-serif "Noto Sans CJK JP")))
                    (extra-config
                     `((match (@ (target font))
                         (edit (@ (mode assign)
                                  (name antialias))
                               (bool true)))))))))))
--8<---------------cut here---------------end--------------->8---


Taiju HIGASHI <higashi@taiju.info> writes:

> * gnu/home/services/fontutils.scm: Support user's fontconfig.
> ---
>  gnu/home/services/fontutils.scm | 86 ++++++++++++++++++++++++++++++---
>  1 file changed, 80 insertions(+), 6 deletions(-)
>
> diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm
> index 6062eaed6a..32127740f6 100644
> --- a/gnu/home/services/fontutils.scm
> +++ b/gnu/home/services/fontutils.scm
> @@ -1,6 +1,7 @@
>  ;;; GNU Guix --- Functional package management for GNU
>  ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
>  ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
> +;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -20,9 +21,16 @@
>  (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)
> +  #:use-module (sxml simple)
> +  #:use-module (ice-9 match)
>
> -  #:export (home-fontconfig-service-type))
> +  #:export (home-fontconfig-service-type
> +            home-fontconfig-configuration
> +            default-font))
>
>  ;;; Commentary:
>  ;;;
> @@ -33,15 +41,81 @@ (define-module (gnu home services fontutils)
>  ;;;
>  ;;; Code:
>
> -(define (add-fontconfig-config-file he-symlink-path)
> +(define (default-font-sanitizer type)
> +  (lambda (value)
> +    (if (null? value)
> +        value
> +        `(alias
> +          (family ,type)
> +          (prefer
> +           (family ,value))))))
> +
> +(define-record-type* <default-font> default-font
> +  make-default-font
> +  default-font?
> +  (serif default-font-serif
> +         (default '())
> +         (sanitize (default-font-sanitizer 'serif)))
> +  (sans-serif defalut-font-sans-serif
> +              (default '())
> +              (sanitize (default-font-sanitizer 'sans-serif)))
> +  (monospace default-font-monospace
> +             (default '())
> +             (sanitize (default-font-sanitizer 'monospace))))
> +
> +(define (sxml->xmlstring sxml)
> +  (if (null? sxml)
> +      ""
> +      (call-with-output-string
> +        (lambda (port)
> +          (sxml->xml sxml port)))))
> +
> +(define font-directories? list?)
> +
> +(define (serialize-font-directories field-name value)
> +  (sxml->xmlstring
> +   (append
> +       '((dir "~/.guix-home/profile/share/fonts"))
> +       (map
> +        (lambda (path)
> +          `(dir ,path))
> +        value))))
> +
> +(define extra-config-list? list?)
> +
> +(define (serialize-extra-config-list field-name value)
> +  (sxml->xmlstring
> +   (map (match-lambda
> +          ((? pair? sxml) sxml)
> +          ((? string? xml) (xml->sxml xml))
> +          (_ (error "extra-config value must be xml string or sxml list.")))
> +        value)))
> +
> +(define (serialize-default-font field-name value)
> +  (match value
> +    (($ <default-font> serif sans-serif monospace)
> +     (sxml->xmlstring (list serif sans-serif monospace)))))
> +
> +(define-configuration home-fontconfig-configuration
> +  (font-directories
> +   (font-directories '())
> +   "The directory list that provides fonts.")
> +  (preferred-default-font
> +   (default-font (default-font))
> +   "The preffered default fonts for serif, sans-serif, and monospace.")
> +  (extra-config
> +   (extra-config-list '())
> +   "Extra configuration values to append to the fonts.conf."))
> +
> +(define (add-fontconfig-config-file user-config)
>    `(("fontconfig/fonts.conf"
>       ,(mixed-text-file
>         "fonts.conf"
>         "<?xml version='1.0'?>
>  <!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
> -<fontconfig>
> -  <dir>~/.guix-home/profile/share/fonts</dir>
> -</fontconfig>"))))
> +<fontconfig>"
> +       (serialize-configuration user-config home-fontconfig-configuration-fields)
> +       "</fontconfig>\n"))))
>
>  (define (regenerate-font-cache-gexp _)
>    `(("profile/share/fonts"
> @@ -59,7 +133,7 @@ (define home-fontconfig-service-type
>                         (service-extension
>                          home-profile-service-type
>                          (const (list fontconfig)))))
> -                (default-value #f)
> +                (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.")))

Thanks,
  

Am Donnerstag, dem 29.09.2022 um 23:36 +0900 schrieb Taiju HIGASHI:
> * gnu/home/services/fontutils.scm: Support user's fontconfig.
> ---
>  gnu/home/services/fontutils.scm | 86 ++++++++++++++++++++++++++++++-
> --
>  1 file changed, 80 insertions(+), 6 deletions(-)
> 
> diff --git a/gnu/home/services/fontutils.scm
> b/gnu/home/services/fontutils.scm
> index 6062eaed6a..32127740f6 100644
> --- a/gnu/home/services/fontutils.scm
> +++ b/gnu/home/services/fontutils.scm
> @@ -1,6 +1,7 @@
>  ;;; GNU Guix --- Functional package management for GNU
>  ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
>  ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
> +;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -20,9 +21,16 @@
>  (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)
> +  #:use-module (sxml simple)
> +  #:use-module (ice-9 match)
>  
> -  #:export (home-fontconfig-service-type))
> +  #:export (home-fontconfig-service-type
> +            home-fontconfig-configuration
> +            default-font))
>  
>  ;;; Commentary:
>  ;;;
> @@ -33,15 +41,81 @@ (define-module (gnu home services fontutils)
>  ;;;
>  ;;; Code:
>  
> -(define (add-fontconfig-config-file he-symlink-path)
> +(define (default-font-sanitizer type)
> +  (lambda (value)
> +    (if (null? value)
> +        value
> +        `(alias
> +          (family ,type)
> +          (prefer
> +           (family ,value))))))
> +
> +(define-record-type* <default-font> default-font
> +  make-default-font
> +  default-font?
> +  (serif default-font-serif
> +         (default '())
> +         (sanitize (default-font-sanitizer 'serif)))
> +  (sans-serif defalut-font-sans-serif
default-font-sans-serif
> +              (default '())
> +              (sanitize (default-font-sanitizer 'sans-serif)))
> +  (monospace default-font-monospace
> +             (default '())
> +             (sanitize (default-font-sanitizer 'monospace))))
Rather than having a null default and sanitizing the field as here, can
we have an #f default and omit the field?

Btw. I'm not sure whether making this an extra record is the right
idea.  Wouldn't "default-(serif|sans-serif|monospace)-family" at the
root make more sense?

Cheers
  

liliana.prikler@gmail.com writes:

> Am Donnerstag, dem 29.09.2022 um 23:36 +0900 schrieb Taiju HIGASHI:
>> * gnu/home/services/fontutils.scm: Support user's fontconfig.
>> ---
>>  gnu/home/services/fontutils.scm | 86 ++++++++++++++++++++++++++++++-
>> --
>>  1 file changed, 80 insertions(+), 6 deletions(-)
>>
>> diff --git a/gnu/home/services/fontutils.scm
>> b/gnu/home/services/fontutils.scm
>> index 6062eaed6a..32127740f6 100644
>> --- a/gnu/home/services/fontutils.scm
>> +++ b/gnu/home/services/fontutils.scm
>> @@ -1,6 +1,7 @@
>>  ;;; GNU Guix --- Functional package management for GNU
>>  ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
>>  ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
>> +;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
>>  ;;;
>>  ;;; This file is part of GNU Guix.
>>  ;;;
>> @@ -20,9 +21,16 @@
>>  (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)
>> +  #:use-module (sxml simple)
>> +  #:use-module (ice-9 match)
>>
>> -  #:export (home-fontconfig-service-type))
>> +  #:export (home-fontconfig-service-type
>> +            home-fontconfig-configuration
>> +            default-font))
>>
>>  ;;; Commentary:
>>  ;;;
>> @@ -33,15 +41,81 @@ (define-module (gnu home services fontutils)
>>  ;;;
>>  ;;; Code:
>>
>> -(define (add-fontconfig-config-file he-symlink-path)
>> +(define (default-font-sanitizer type)
>> +  (lambda (value)
>> +    (if (null? value)
>> +        value
>> +        `(alias
>> +          (family ,type)
>> +          (prefer
>> +           (family ,value))))))
>> +
>> +(define-record-type* <default-font> default-font
>> +  make-default-font
>> +  default-font?
>> +  (serif default-font-serif
>> +         (default '())
>> +         (sanitize (default-font-sanitizer 'serif)))
>> +  (sans-serif defalut-font-sans-serif
> default-font-sans-serif
>> +              (default '())
>> +              (sanitize (default-font-sanitizer 'sans-serif)))
>> +  (monospace default-font-monospace
>> +             (default '())
>> +             (sanitize (default-font-sanitizer 'monospace))))
> Rather than having a null default and sanitizing the field as here, can
> we have an #f default and omit the field?
>
> Btw. I'm not sure whether making this an extra record is the right
> idea.  Wouldn't "default-(serif|sans-serif|monospace)-family" at the
> root make more sense?
>
> Cheers

Do you mean to write as follows?

--8<---------------cut here---------------start------------->8---
(home-environment
 (packages (list font-google-noto))
 (services
  (append
      (list
       (service home-bash-service-type))
      (modify-services %home-base-services
        (home-fontconfig-service-type
         config => (home-fontconfig-configuration
                    (font-directories
                     (list "~/fonts"))
                    (default-serif-family "Noto Serif CJK JP")
                    (default-sans-serif-family "Noto Sans CJK JP")
                    (extra-config
                     `((match (@ (target font))
                         (edit (@ (mode assign)
                                  (name antialias))
                               (bool true)))))))))))
--8<---------------cut here---------------end--------------->8---

Cheers,
  

Am Samstag, dem 01.10.2022 um 20:19 +0900 schrieb Taiju HIGASHI:
> liliana.prikler@gmail.com writes:
> 
> > Am Donnerstag, dem 29.09.2022 um 23:36 +0900 schrieb Taiju HIGASHI:
> > > * gnu/home/services/fontutils.scm: Support user's fontconfig.
> > > ---
> > >  gnu/home/services/fontutils.scm | 86
> > > ++++++++++++++++++++++++++++++-
> > > --
> > >  1 file changed, 80 insertions(+), 6 deletions(-)
> > > 
> > > diff --git a/gnu/home/services/fontutils.scm
> > > b/gnu/home/services/fontutils.scm
> > > index 6062eaed6a..32127740f6 100644
> > > --- a/gnu/home/services/fontutils.scm
> > > +++ b/gnu/home/services/fontutils.scm
> > > @@ -1,6 +1,7 @@
> > >  ;;; GNU Guix --- Functional package management for GNU
> > >  ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
> > >  ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
> > > +;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
> > >  ;;;
> > >  ;;; This file is part of GNU Guix.
> > >  ;;;
> > > @@ -20,9 +21,16 @@
> > >  (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)
> > > +  #:use-module (sxml simple)
> > > +  #:use-module (ice-9 match)
> > > 
> > > -  #:export (home-fontconfig-service-type))
> > > +  #:export (home-fontconfig-service-type
> > > +            home-fontconfig-configuration
> > > +            default-font))
> > > 
> > >  ;;; Commentary:
> > >  ;;;
> > > @@ -33,15 +41,81 @@ (define-module (gnu home services fontutils)
> > >  ;;;
> > >  ;;; Code:
> > > 
> > > -(define (add-fontconfig-config-file he-symlink-path)
> > > +(define (default-font-sanitizer type)
> > > +  (lambda (value)
> > > +    (if (null? value)
> > > +        value
> > > +        `(alias
> > > +          (family ,type)
> > > +          (prefer
> > > +           (family ,value))))))
> > > +
> > > +(define-record-type* <default-font> default-font
> > > +  make-default-font
> > > +  default-font?
> > > +  (serif default-font-serif
> > > +         (default '())
> > > +         (sanitize (default-font-sanitizer 'serif)))
> > > +  (sans-serif defalut-font-sans-serif
> > default-font-sans-serif
> > > +              (default '())
> > > +              (sanitize (default-font-sanitizer 'sans-serif)))
> > > +  (monospace default-font-monospace
> > > +             (default '())
> > > +             (sanitize (default-font-sanitizer 'monospace))))
> > Rather than having a null default and sanitizing the field as here,
> > can
> > we have an #f default and omit the field?
> > 
> > Btw. I'm not sure whether making this an extra record is the right
> > idea.  Wouldn't "default-(serif|sans-serif|monospace)-family" at
> > the
> > root make more sense?
> > 
> > Cheers
> 
> Do you mean to write as follows?
> 
> --8<---------------cut here---------------start------------->8---
> (home-environment
>  (packages (list font-google-noto))
>  (services
>   (append
>       (list
>        (service home-bash-service-type))
>       (modify-services %home-base-services
>         (home-fontconfig-service-type
>          config => (home-fontconfig-configuration
>                     (font-directories
>                      (list "~/fonts"))
>                     (default-serif-family "Noto Serif CJK JP")
>                     (default-sans-serif-family "Noto Sans CJK JP")
>                     (extra-config
>                      `((match (@ (target font))
>                          (edit (@ (mode assign)
>                                   (name antialias))
>                                (bool true)))))))))))
> --8<---------------cut here---------------end--------------->8---
Yep.  Feels more natural imho.
  

Taiju HIGASHI <higashi@taiju.info> skribis:

> * gnu/home/services/fontutils.scm: Support user's fontconfig.

I’m nitpicking a bit, but here we would describe all the
variables/procedures added, removed, or modified.  Please check ‘git
log’ for examples.

Regarding code, there’s a convention to add a docstring to each
top-level procedure:

  https://guix.gnu.org/manual/devel/en/html_node/Formatting-Code.html

It would be nice to follow it here.

> +(define (default-font-sanitizer type)
> +  (lambda (value)
> +    (if (null? value)
> +        value
> +        `(alias
> +          (family ,type)
> +          (prefer
> +           (family ,value))))))

Giving '() special meaning here looks quite unusual.  As Liliana wrote,
we’d usually use #f as the value denoting “nothing”.

> +(define (sxml->xmlstring sxml)
> +  (if (null? sxml)
> +      ""
> +      (call-with-output-string
> +        (lambda (port)
> +          (sxml->xml sxml port)))))

Same here.  Also, “xml-string” rather than “xmlstring”.

> +(define font-directories? list?)

Is it really needed?

> +(define (serialize-font-directories field-name value)
> +  (sxml->xmlstring
> +   (append
> +       '((dir "~/.guix-home/profile/share/fonts"))
> +       (map
> +        (lambda (path)
> +          `(dir ,path))
> +        value))))

The indentation would rather be:

  (append '((dir …))
          (map (lambda (directory)
                 `(dir ,directory))
               value))

> +   (map (match-lambda
> +          ((? pair? sxml) sxml)
> +          ((? string? xml) (xml->sxml xml))
> +          (_ (error "extra-config value must be xml string or sxml list.")))

Instead of ‘error’, which would lead to an ugly backtrace and an
untranslated error message, write:

  (raise (formatted-message (G_ "'extra-config' …")))

without a trailing dot in the message.

The rest LGTM!  Like I wrote, could you please add documentation in
‘doc/guix.texi’, with a configuration example like the one you gave?

Thanks for all the work!

Ludo’.
  

>> > > +(define-record-type* <default-font> default-font
>> > > +  make-default-font
>> > > +  default-font?
>> > > +  (serif default-font-serif
>> > > +         (default '())
>> > > +         (sanitize (default-font-sanitizer 'serif)))
>> > > +  (sans-serif defalut-font-sans-serif
>> > default-font-sans-serif
>> > > +              (default '())
>> > > +              (sanitize (default-font-sanitizer 'sans-serif)))
>> > > +  (monospace default-font-monospace
>> > > +             (default '())
>> > > +             (sanitize (default-font-sanitizer 'monospace))))
>> > Rather than having a null default and sanitizing the field as here,
>> > can
>> > we have an #f default and omit the field?
>> >
>> > Btw. I'm not sure whether making this an extra record is the right
>> > idea.  Wouldn't "default-(serif|sans-serif|monospace)-family" at
>> > the
>> > root make more sense?
>> >
>> > Cheers
>>
>> Do you mean to write as follows?
>>
>> --8<---------------cut here---------------start------------->8---
>> (home-environment
>>  (packages (list font-google-noto))
>>  (services
>>   (append
>>       (list
>>        (service home-bash-service-type))
>>       (modify-services %home-base-services
>>         (home-fontconfig-service-type
>>          config => (home-fontconfig-configuration
>>                     (font-directories
>>                      (list "~/fonts"))
>>                     (default-serif-family "Noto Serif CJK JP")
>>                     (default-sans-serif-family "Noto Sans CJK JP")
>>                     (extra-config
>>                      `((match (@ (target font))
>>                          (edit (@ (mode assign)
>>                                   (name antialias))
>>                                (bool true)))))))))))
>> --8<---------------cut here---------------end--------------->8---
> Yep.  Feels more natural imho.

I have changed the interface as you suggested in the v5 patch.

Cheers,
  

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> Taiju HIGASHI <higashi@taiju.info> skribis:
>
>> * gnu/home/services/fontutils.scm: Support user's fontconfig.
>
> I’m nitpicking a bit, but here we would describe all the
> variables/procedures added, removed, or modified.  Please check ‘git
> log’ for examples.
>
> Regarding code, there’s a convention to add a docstring to each
> top-level procedure:
>
>   https://guix.gnu.org/manual/devel/en/html_node/Formatting-Code.html
>
> It would be nice to follow it here.

I have listed them all in the v5 patch.
As for the serializer/predicate procedure, I did not add it because
there was no docstring in the existing procedure.

>> +(define (default-font-sanitizer type)
>> +  (lambda (value)
>> +    (if (null? value)
>> +        value
>> +        `(alias
>> +          (family ,type)
>> +          (prefer
>> +           (family ,value))))))
>
> Giving '() special meaning here looks quite unusual.  As Liliana wrote,
> we’d usually use #f as the value denoting “nothing”.

I may have confused it with Common Lisp.  I have eliminated the field
with the empty list as the default value.

>> +(define (sxml->xmlstring sxml)
>> +  (if (null? sxml)
>> +      ""
>> +      (call-with-output-string
>> +        (lambda (port)
>> +          (sxml->xml sxml port)))))
>
> Same here.  Also, “xml-string” rather than “xmlstring”.

Fixed to xml-string.

>> +(define font-directories? list?)
>
> Is it really needed?

I may not have addressed this point yet. Is it possible to not define a
predicate procedure to be used for a configuration field?

>> +(define (serialize-font-directories field-name value)
>> +  (sxml->xmlstring
>> +   (append
>> +       '((dir "~/.guix-home/profile/share/fonts"))
>> +       (map
>> +        (lambda (path)
>> +          `(dir ,path))
>> +        value))))
>
> The indentation would rather be:
>
>   (append '((dir …))
>           (map (lambda (directory)
>                  `(dir ,directory))
>                value))

I think I fixed it by refactoring.

>> +   (map (match-lambda
>> +          ((? pair? sxml) sxml)
>> +          ((? string? xml) (xml->sxml xml))
>> +          (_ (error "extra-config value must be xml string or sxml list.")))
>
> Instead of ‘error’, which would lead to an ugly backtrace and an
> untranslated error message, write:
>
>   (raise (formatted-message (G_ "'extra-config' …")))
>
> without a trailing dot in the message.

I have fixed it.

> The rest LGTM!  Like I wrote, could you please add documentation in
> ‘doc/guix.texi’, with a configuration example like the one you gave?

Since there were many points raised and interface changes in this case,
I will revise the document after the review is complete.

Thanks,
--
Taiju