Message ID | 20220927095525.26431-1-higashi@taiju.info |
---|---|
State | New |
Headers | show |
Series | [bug#57963,v3] home: fontutils: Support user's fontconfig. | expand |
Context | Check | Description |
---|---|---|
cbaines/comparison | success | View comparision |
cbaines/git-branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
Hi, I just sent you the v3 patch. I have changed only the interface of `preferred-defalut-font` slightly from what I suggested the other day. We configure the service as follows. --8<---------------cut here---------------start------------->8--- (simple-service 'my-fontconfig-service home-fontconfig-service-type (home-fontconfig-configuration (font-directories (list "~/fonts")) (preferred-default-font (default-font (serif "Noto Serif CJK JP") (sans-serif "Noto Sans CJK JP") (monospace "PlemolJP Console"))) (extra-config `((match (@ (target font)) (edit (@ (mode assign) (name antialias)) (bool true))))))) --8<---------------cut here---------------end--------------->8--- I didn't understand it properly, but `home-fontconfig-service-type` is pre-registered as `essential-services` and needs to be extended using `simple-service`. > +(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)))) This is the part I am most concerned about, not sure if replacing the preferred-default-font setting with the last setting is the proper way to go about it. I wanted to write a test as well, but since it was to be handled by gexp, I could not figure out how to write a test that would validate the gexp result using only exported methods. (I would like to write tests for serialized functions that are private functions.) Cheers,
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? > +(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. > +(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. > (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
Hi, Taiju HIGASHI <higashi@taiju.info> skribis: > I just sent you the v3 patch. > > I have changed only the interface of `preferred-defalut-font` slightly > from what I suggested the other day. > > We configure the service as follows. > > (simple-service > 'my-fontconfig-service > home-fontconfig-service-type > (home-fontconfig-configuration > (font-directories > (list "~/fonts")) > (preferred-default-font > (default-font > (serif "Noto Serif CJK JP") > (sans-serif "Noto Sans CJK JP") > (monospace "PlemolJP Console"))) > (extra-config > `((match (@ (target font)) > (edit (@ (mode assign) > (name antialias)) > (bool true))))))) Looks nicer IMO! >> +(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)))) > > This is the part I am most concerned about, not sure if replacing the > preferred-default-font setting with the last setting is the proper way > to go about it. It’s unusual for a service to receive extensions that are the full configuration object of that service. Because then, indeed, you have to determine how to “merge” those configuration objects. The common patterns that we have are: 1. The service accepts as extensions things that represent part of its configuration and where merging makes sense. For example, nginx can be extended with <nginx-location-configuration> objects, but not with a full-blown <nginx-configuration>. 2. Similar, but the service has specific records for extensions. The example that comes to mind is ‘home-bash-service-type’, which accepts <home-bash-extension> records as its extensions. So… I wonder, should we, as a first commit, move ‘home-fontconfig-service-type’ out of the essential services to a ‘%base-home-services’ variable yet to be defined? I don’t see any good reason to have it here (“essential” services should be limited to those that may not be replaced or removed; in (gnu system), this includes services that depend on information available in <operating-system>). Once we’ve done that, perhaps we can forget about extensions, at least for now, and let users who need to configure things write: (modify-services %base-home-services (home-fontconfig-service-type config => …)) WDYT? > I wanted to write a test as well, but since it was to be handled by > gexp, I could not figure out how to write a test that would validate the > gexp result using only exported methods. (I would like to write tests > for serialized functions that are private functions.) Hmm. Once we’ve settled on an interface, the commit that makes this change should include an update of doc/guix.texi. Thanks! Ludo’.
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
Ludovic Courtès <ludo@gnu.org> writes: > Hi, > > Taiju HIGASHI <higashi@taiju.info> skribis: > >> I just sent you the v3 patch. >> >> I have changed only the interface of `preferred-defalut-font` slightly >> from what I suggested the other day. >> >> We configure the service as follows. >> >> (simple-service >> 'my-fontconfig-service >> home-fontconfig-service-type >> (home-fontconfig-configuration >> (font-directories >> (list "~/fonts")) >> (preferred-default-font >> (default-font >> (serif "Noto Serif CJK JP") >> (sans-serif "Noto Sans CJK JP") >> (monospace "PlemolJP Console"))) >> (extra-config >> `((match (@ (target font)) >> (edit (@ (mode assign) >> (name antialias)) >> (bool true))))))) > > Looks nicer IMO! > >>> +(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)))) >> >> This is the part I am most concerned about, not sure if replacing the >> preferred-default-font setting with the last setting is the proper way >> to go about it. > > It’s unusual for a service to receive extensions that are the full > configuration object of that service. Because then, indeed, you have to > determine how to “merge” those configuration objects. > > The common patterns that we have are: > > 1. The service accepts as extensions things that represent part of its > configuration and where merging makes sense. > > For example, nginx can be extended with > <nginx-location-configuration> objects, but not with a full-blown > <nginx-configuration>. > > 2. Similar, but the service has specific records for extensions. > > The example that comes to mind is ‘home-bash-service-type’, which > accepts <home-bash-extension> records as its extensions. Thank you. I understand well. I felt out of place because there was no service that can full configuration such this one. > So… > > I wonder, should we, as a first commit, move > ‘home-fontconfig-service-type’ out of the essential services to a > ‘%base-home-services’ variable yet to be defined? > > I don’t see any good reason to have it here (“essential” services should > be limited to those that may not be replaced or removed; in (gnu > system), this includes services that depend on information available in > <operating-system>). > > Once we’ve done that, perhaps we can forget about extensions, at least > for now, and let users who need to configure things write: > > (modify-services %base-home-services > (home-fontconfig-service-type > config => …)) > > WDYT? I found out what essential services should be. I'm going to move it from essential services to base-home-services. >> I wanted to write a test as well, but since it was to be handled by >> gexp, I could not figure out how to write a test that would validate the >> gexp result using only exported methods. (I would like to write tests >> for serialized functions that are private functions.) > > Hmm. > > Once we’ve settled on an interface, the commit that makes this change > should include an update of doc/guix.texi. Yes. I can write the draft, but I may have to ask you to finish it because I'm not good at writing English. It would be a waste of time for you to spend a long time correcting my poor grammar and expressions. Thanks,
Hi, Taiju HIGASHI <higashi@taiju.info> skribis: > I found out what essential services should be. > I'm going to move it from essential services to base-home-services. Alright, let’s do that (in a separate commit). >> Once we’ve settled on an interface, the commit that makes this change >> should include an update of doc/guix.texi. > > Yes. I can write the draft, but I may have to ask you to finish it because > I'm not good at writing English. > It would be a waste of time for you to spend a long time correcting my > poor grammar and expressions. Sure; I’m not a native speaker either but I can help. Thanks, Ludo’.
Hi Liliana, I've sent you the v4 patch. Taiju HIGASHI <higashi@taiju.info> writes: > Liliana Marie Prikler <liliana.prikler@gmail.com> writes: > >>> -(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. I couldn't remove the default value because without a default value, for example, it can't specify only serifs. However, I've changed the serialization of the field so that it is now a comfortable default value. Cheers,
Hi Ludovic, I've sent you the v4 patch. Ludovic Courtès <ludo@gnu.org> writes: > Hi, > > Taiju HIGASHI <higashi@taiju.info> skribis: > >> I found out what essential services should be. >> I'm going to move it from essential services to base-home-services. > > Alright, let’s do that (in a separate commit). I've tried it. In particular, I'm wondering if I defined %home-base-services in the right place. >>> Once we’ve settled on an interface, the commit that makes this change >>> should include an update of doc/guix.texi. >> >> Yes. I can write the draft, but I may have to ask you to finish it because >> I'm not good at writing English. >> It would be a waste of time for you to spend a long time correcting my >> poor grammar and expressions. > > Sure; I’m not a native speaker either but I can help. I know it will take some time, but I'll try my best. By the way, if I edit the texi file, am I correct in confirming that I read the built Info? Thanks,
Hey Taiju and Liliana, On Thu Sep 29, 2022 at 3:51 PM BST, Taiju HIGASHI wrote: > > Sure; I’m not a native speaker either but I can help. > > I know it will take some time, but I'll try my best. If you wish I'll help you with the manual. (I'm a native British English speaker.) -- (
Hi (, "(" <paren@disroot.org> writes: > Hey Taiju and Liliana, > > On Thu Sep 29, 2022 at 3:51 PM BST, Taiju HIGASHI wrote: >> > Sure; I’m not a native speaker either but I can help. >> >> I know it will take some time, but I'll try my best. > > If you wish I'll help you with the manual. (I'm a native > British English speaker.) > > -- ( Thank you, it helps! However, the interface may still change, so it will be a little while before I write documentation. Best Regards,
Am Donnerstag, dem 29.09.2022 um 23:51 +0900 schrieb Taiju HIGASHI: > I know it will take some time, but I'll try my best. By the way, if > I edit the texi file, am I correct in confirming that I read the > built Info? After running `make', you should run `info doc/guix.info' and scroll to the edited section to verify that it reads as you intended. Cheers
liliana.prikler@gmail.com writes: > Am Donnerstag, dem 29.09.2022 um 23:51 +0900 schrieb Taiju HIGASHI: >> I know it will take some time, but I'll try my best. By the way, if >> I edit the texi file, am I correct in confirming that I read the >> built Info? > After running `make', you should run `info doc/guix.info' and scroll to > the edited section to verify that it reads as you intended. > > Cheers Thank you, I will verify the edited documentation that way. Cheers,
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 ""))) + +(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))))))) + +(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")))) (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.")))