[bug#57963] [PATCH v5 2/2] home: services: Support user's fontconfig configuration.

[Andrew Tropin]

On 2022-10-02 22:15, Taiju HIGASHI wrote:

> * gnu/home/services/fontutils.scm (add-fontconfig-config-file): Support user's
> fontconfig configuration.
> (home-fontconfig-configuration): New configuration for it.
> (string-list, maybe-string, maybe-extra-config-list): New types for it.
> (string-list?, extra-config-list?): New predicate procedures for it.
> (serialize-string-list, serialize-string, serialize-extra-config-list): New
> serialize procedures for it.
> (guix-home-font-dir): New variable.
> ---
>  gnu/home/services/fontutils.scm | 89 ++++++++++++++++++++++++++++++---
>  1 file changed, 83 insertions(+), 6 deletions(-)
>
> diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm
> index 6062eaed6a..4b3caf3985 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,17 @@
>  (define-module (gnu home services fontutils)
>    #:use-module (gnu home services)
>    #:use-module (gnu packages fontutils)
> +  #:use-module (gnu services configuration)
> +  #:use-module (guix diagnostics)
>    #:use-module (guix gexp)
> +  #:use-module (guix i18n)
> +  #: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))
>  
>  ;;; Commentary:
>  ;;;
> @@ -33,15 +42,83 @@ (define-module (gnu home services fontutils)
>  ;;;
>  ;;; Code:
>  
> -(define (add-fontconfig-config-file he-symlink-path)
> +(define (sxml->xml-string sxml)
> +  "Serialize the sxml tree @var{tree} as XML. The output will be string."
> +  (call-with-output-string
> +    (lambda (port)
> +      (sxml->xml sxml port))))
> +
> +(define guix-home-font-dir "~/.guix-home/profile/share/fonts")
> +
> +(define (string-list? value)
> +  (and (pair? value) (every string? value)))

Better to use list? here and in the other places, at least for the
consistency, but also for semantic meaning.

> +
> +(define (serialize-string-list field-name value)
> +  (sxml->xml-string
> +   (map
> +    (lambda (path) `(dir ,path))
> +    (if (member guix-home-font-dir value)
> +        value
> +        (append (list guix-home-font-dir) value)))))
> +
> +(define (serialize-string field-name value)
> +  (define (serialize type value)
> +    (sxml->xml-string
> +     `(alias
> +       (family ,type)
> +       (prefer
> +        (family ,value)))))
> +  (match (list field-name value)
> +    (('default-font-serif-family family)
> +     (serialize 'serif family))
> +    (('default-font-sans-serif-family family)
> +     (serialize 'sans-serif family))
> +    (('default-font-monospace-family family)
> +     (serialize 'monospace family))))
> +
> +(define-maybe string)
> +
> +(define extra-config-list? list?)
> +
> +(define-maybe extra-config-list)
> +
> +(define (serialize-extra-config-list field-name value)
> +  (sxml->xml-string
> +   (map (match-lambda
> +          ((? pair? sxml) sxml)

Other branches would never be visited because it will fail earlier by
define-configuration predicate check for extra-config-list? (which is
basically list?).

Also, making multi-type fields is debatable, but isn't great IMO.

If serialization would support G-exps, we could write 

(list #~"RAW_XML_HERE")

or even something like this:

(list #~(READ-THE-WHOLE-FILE #$(local-file "our-old.xml")))

> +          ((? string? xml) (xml->sxml xml))
> +          (else
> +           (raise (formatted-message
> +                   (G_ "'extra-config' type must be xml string or sxml list, 
> was given: ~a")
> +                   value))))
> +        value)))
> +
> +(define-configuration home-fontconfig-configuration
> +  (font-directories
> +   (string-list (list guix-home-font-dir))

It's not a generic string-list, but a specific font-directories-list
with extra logic inside.

Also, because guix-home-font-dir always added to the list, the default
value should '() and field should be called additional-font-directories
instead.  Otherwise it will be confusing, why guix-home-font-dir is not
removed from the final configuration, when this field is set to a
different value.

I skimmed previous messages, but sorry, if I missed any already
mentioned points.

> +   "The directory list that provides fonts.")
> +  (default-font-serif-family
> +    maybe-string
> +    "The preffered default fonts of serif.")
> +  (default-font-sans-serif-family
> +    maybe-string
> +    "The preffered default fonts of sans-serif.")
> +  (default-font-monospace-family
> +    maybe-string
> +    "The preffered default fonts of monospace.")
> +  (extra-config
> +   maybe-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)

Just a thought for the future and a point for configuration module
improvements: It would be cool if serialize-configuration and all other
serialize- functions returned a G-exps, this way we could write
something like that:

(home-fontconfig-configuration
 (font-directories (list (file-append font-iosevka "/share/fonts"))))

> +       "</fontconfig>\n"))))
>  
>  (define (regenerate-font-cache-gexp _)
>    `(("profile/share/fonts"
> @@ -59,7 +136,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.")))

-- 
Best regards,
Andrew Tropin

signature.asc
Description: PGP signature