[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#62145] [PATCH] home: services: fontutils: Add font specifications.
From: |
Andrew Tropin |
Subject: |
[bug#62145] [PATCH] home: services: fontutils: Add font specifications. |
Date: |
Tue, 14 Mar 2023 11:36:14 +0400 |
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.
--
Best regards,
Andrew Tropin
signature.asc
Description: PGP signature