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 >  ;;; Copyright © 2021 Xinglu Chen > +;;; Copyright © 2022 Taiju HIGASHI >  ;;; >  ;;; 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 > +  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 > +    (($ 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" >         " >   > - > -  ~/.guix-home/profile/share/fonts > -")))) > +\n" > +       (serialize-configuration user-config home-fontconfig- > configuration-fields) > +       "\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