Archived
1
0
Fork 0

gnu: home: services: fontutils: Add support for SXML fragments.

* gnu/home/services/fontutils.scm (add-fontconfig-config-file): Add
support for adding arbitrary SXML configuration into fonts.conf;
* doc/guix.texi (Fonts Services): Update the documentation.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Andrew Patterson 2023-04-12 23:40:59 -04:00 committed by Ludovic Courtès
parent ef0aa7ff8b
commit 8d442e8a53
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 13 deletions

View file

@ -43084,8 +43084,10 @@ library is used by many applications to access fonts on the system.
@defvar home-fontconfig-service-type @defvar home-fontconfig-service-type
This is the service type for generating configurations for Fontconfig. This is the service type for generating configurations for Fontconfig.
Its associated value is a list of strings (or gexps) pointing to fonts Its associated value is a list of either strings (or gexps) pointing to
locations. fonts locations, or SXML (@pxref{SXML,,, guile, GNU Guile Reference
Manual}) fragments to be converted into XML and put inside the main
@code{fontconfig} node.
Generally, it is better to extend this service than to directly Generally, it is better to extend this service than to directly
configure it, as its default value is the default Guix Home's profile configure it, as its default value is the default Guix Home's profile
@ -43093,13 +43095,17 @@ font installation path (@file{~/.guix-home/profile/share/fonts}). If
you configure this service directly, be sure to include the above you configure this service directly, be sure to include the above
directory. directory.
A typical extension for adding an additional font directory might look A typical extension for adding an additional font directory and setting
like this: a font as the default monospace font might look like this:
@lisp @lisp
(simple-service 'additional-fonts-service (simple-service 'additional-fonts-service
home-fontconfig-service-type home-fontconfig-service-type
(list "~/.nix-profile/share/fonts")) (list "~/.nix-profile/share/fonts"
'(alias
(family "monospace")
(prefer
(family "Liberation Mono")))))
@end lisp @end lisp
@end defvar @end defvar

View file

@ -2,6 +2,7 @@
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org> ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2023 Andrew Patterson <andrewpatt7@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -23,6 +24,8 @@
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (sxml simple)
#:export (home-fontconfig-service-type)) #:export (home-fontconfig-service-type))
@ -35,17 +38,36 @@
;;; ;;;
;;; Code: ;;; Code:
(define (add-fontconfig-config-file directories) (define (write-fontconfig-doctype)
"Prints fontconfig's DOCTYPE to current-output-port."
;; This is necessary because SXML doesn't seem to have a way to represent a doctype,
;; but sxml->xml /does/ currently call any thunks in the SXML with the XML output port
;; as current-output-port, allowing the output to include arbitrary text instead of
;; just properly quoted XML.
(format #t "<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>"))
(define (config->sxml config)
"Converts a <home-fontconfig-configuration> record into the SXML representation
of fontconfig's fonts.conf file."
(define (snippets->sxml snippet)
(match snippet
((or (? string? dir)
(? gexp? dir))
`(dir ,dir))
((? list?)
snippet)))
`(*TOP* (*PI* xml "version='1.0'")
,write-fontconfig-doctype
(fontconfig
,@(map snippets->sxml config))))
(define (add-fontconfig-config-file config)
`(("fontconfig/fonts.conf" `(("fontconfig/fonts.conf"
,(mixed-text-file ,(mixed-text-file
"fonts.conf" "fonts.conf"
(apply string-append (call-with-output-string
`("<?xml version='1.0'?> (lambda (port)
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'> (sxml->xml (config->sxml config) port)))))))
<fontconfig>\n" ,@(map (lambda (directory)
(string-append " <dir>" directory "</dir>\n"))
directories)
"</fontconfig>\n"))))))
(define (regenerate-font-cache-gexp _) (define (regenerate-font-cache-gexp _)
`(("profile/share/fonts" `(("profile/share/fonts"