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

[Taiju HIGASHI]

Liliana Marie Prikler <liliana.prikler@gmail.com> writes:

> 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?

Sure, It is not meaningful.  I would remove the default value.

>> +(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.

I see.  We can define sanitizer for fields, right?

>> +(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.

OK, I would remove extra newlines.

>>  (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
>

Cheers,
--
Taiju