Message ID | 86jzzmt42r.fsf@conses.eu |
---|---|
State | New |
Headers | show |
Series | [bug#62145] home: services: fontutils: Add font specifications. | expand |
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.
Hi, Sorry for the delay! Andrew Tropin <andrew@trop.in> skribis: > On 2023-03-12 15:52, conses wrote: [...] >> (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? How about adding a check to deal with the case where the value is a list of strings and print a deprecation warning when it is? Since the current behavior is documented, we should provide a smooth transition to the new interface. Also, conses, could you update ‘doc/guix.texi’ to describe the new interface? > 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. Yeah, that’s sad because a lot of energy went into it. Maybe there are good ideas to borrow though? Ludo’.
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) + 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.")))