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
This is the service type for generating configurations for Fontconfig.
Its associated value is a list of strings (or gexps) pointing to fonts
locations.
Its associated value is a list of either strings (or gexps) pointing to
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
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
directory.
A typical extension for adding an additional font directory might look
like this:
A typical extension for adding an additional font directory and setting
a font as the default monospace font might look like this:
@lisp
(simple-service 'additional-fonts-service
home-fontconfig-service-type
(list "~/.nix-profile/share/fonts"))
(list "~/.nix-profile/share/fonts"
'(alias
(family "monospace")
(prefer
(family "Liberation Mono")))))
@end lisp
@end defvar

View File

@ -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 Andrew Patterson <andrewpatt7@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,6 +24,8 @@
#:use-module (gnu packages fontutils)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (sxml simple)
#:export (home-fontconfig-service-type))
@ -35,17 +38,36 @@
;;;
;;; 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"
,(mixed-text-file
"fonts.conf"
(apply string-append
`("<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig>\n" ,@(map (lambda (directory)
(string-append " <dir>" directory "</dir>\n"))
directories)
"</fontconfig>\n"))))))
(call-with-output-string
(lambda (port)
(sxml->xml (config->sxml config) port)))))))
(define (regenerate-font-cache-gexp _)
`(("profile/share/fonts"