[bug#62145] [PATCH] home: services: fontutils: Add font specifications.

[Andrew Tropin]

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