Andrew Patterson wrote 2 years ago
(address . guix-patches@gnu.org)(name . Andrew Patterson)(address . andrewpatt7@gmail.com)
20230413034059.5585-1-andrewpatt7@gmail.com
* 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.
---
One of the main reasons I haven't started using guix home is that I use
fonts.conf for setting default fonts, which guix home doesn't work with.
This patch fixes that issue, by letting you add arbitrary XML to
fonts.conf via SXML.
doc/guix.texi | 16 +++++++++-----
gnu/home/services/fontutils.scm | 38 ++++++++++++++++++++++++++-------
2 files changed, 41 insertions(+), 13 deletions(-)
Toggle diff (108 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index acb6f0c2e1..f1cfdd77f4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42968,8 +42968,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
@@ -42977,13 +42979,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
diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm
index 3399cb7ec8..0e60bc2035 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 Andrew Patterson <andrewpatt7@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,8 @@ (define-module (gnu home services fontutils)
#: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 @@ (define-module (gnu home services fontutils)
;;;
;;; 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"
base-commit: 60c97c60a53686ec321eb541b85e01b6decc2014
--
2.39.2