[bug#57963] [PATCH v3] home: fontutils: Support user's fontconfig.

[Liliana Marie Prikler]

Am Dienstag, dem 27.09.2022 um 18:55 +0900 schrieb Taiju HIGASHI:
> * gnu/home/services/fontutils.scm (add-fontconfig-config-file):
> Support user's
> fontconfig.
> ---
>  gnu/home/services/fontutils.scm | 103
> ++++++++++++++++++++++++++++++--
>  1 file changed, 97 insertions(+), 6 deletions(-)
> 
> diff --git a/gnu/home/services/fontutils.scm
> b/gnu/home/services/fontutils.scm
> index 6062eaed6a..b02f43a4fc 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,96 @@ (define-module (gnu home services fontutils)
>  ;;;
>  ;;; Code:
>  
> -(define (add-fontconfig-config-file he-symlink-path)
> +(define-record-type* <default-font> default-font
> +  make-default-font
> +  default-font?
> +  (serif default-font-serif (default ""))
> +  (sans-serif defalut-font-sans-serif (default ""))
> +  (monospace default-font-monospace (default "")))
Is the empty string a meaningful value in these places?

> +(define (sxml->xmlstring sxml)
> +  (if (null? sxml)
> +      ""
> +      (call-with-output-string
> +        (lambda (port)
> +          (sxml->xml sxml port)
> +          (newline 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
> +      (fold (lambda (pair sxml)
> +              (if (string-null? (cdr pair))
> +                  sxml
> +                  (append sxml
> +                      `((alias
> +                         (family ,(car pair))
> +                         (prefer
> +                          (family ,(cdr pair))))))))
> +            '()
> +            `((serif . ,serif)
> +              (sans-serif . ,sans-serif)
> +              (monospace . ,monospace)))))))
You can greatly simplify these by serializing the fields to SXML and
only taking the final SXML and serializing it to a string.

> +(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 (home-fontconfig-extend original-config extend-configs)
> +  (home-fontconfig-configuration
> +   (inherit original-config)
> +   (font-directories
> +    (append
> +        (home-fontconfig-configuration-font-directories original-
> config)
> +        (append-map home-fontconfig-configuration-font-directories
> extend-configs)))
> +   (preferred-default-font
> +    (home-fontconfig-configuration-preferred-default-font
> +     (if (null? extend-configs)
> +         original-config
> +         (last extend-configs))))
> +   (extra-config
> +    (append
> +        (home-fontconfig-configuration-extra-config original-config)
> +        (append-map home-fontconfig-configuration-extra-config
> extend-configs)))))
> +
> +(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>\n"
> +       (serialize-configuration user-config home-fontconfig-
> configuration-fields)
> +       "</fontconfig>\n"))))
Is it expected that our configuration will be pretty?  If so, you might
want to use a tree fold (there sadly doesn't seem to be a built-in XML
pretty printer, which is a shame imho.)

If not, those extra newlines do little.

>  (define (regenerate-font-cache-gexp _)
>    `(("profile/share/fonts"
> @@ -49,6 +138,8 @@ (define (regenerate-font-cache-gexp _)
>  
>  (define home-fontconfig-service-type
>    (service-type (name 'home-fontconfig)
> +                (compose identity)
> +                (extend home-fontconfig-extend)
>                  (extensions
>                   (list (service-extension
>                          home-xdg-configuration-files-service-type
> @@ -59,7 +150,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.")))

Cheers