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

[Taiju HIGASHI <higashi@taiju.info>]

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,
-- 
Taiju