Package: guix-patches;
Reported by: Taiju HIGASHI <higashi <at> taiju.info>
Date: Wed, 21 Sep 2022 00:28:02 UTC
Severity: normal
Tags: patch
Message #68 received at 57963 <at> debbugs.gnu.org (full text, mbox):
From: Liliana Marie Prikler <liliana.prikler <at> gmail.com> To: Taiju HIGASHI <higashi <at> taiju.info>, ludo <at> gnu.org, andrew <at> trop.in Cc: 57963 <at> debbugs.gnu.org Subject: Re: [PATCH v3] home: fontutils: Support user's fontconfig. Date: Wed, 28 Sep 2022 21:11:30 +0200
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 <at> trop.in>
> ;;; Copyright © 2021 Xinglu Chen <public <at> yoctocell.xyz>
> +;;; Copyright © 2022 Taiju HIGASHI <higashi <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.