From 8d442e8a53b8ef3727252425afe2cfb922f51368 Mon Sep 17 00:00:00 2001 From: Andrew Patterson Date: Wed, 12 Apr 2023 23:40:59 -0400 Subject: gnu: home: services: fontutils: Add support for SXML fragments. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- doc/guix.texi | 16 +++++++++++----- gnu/home/services/fontutils.scm | 38 ++++++++++++++++++++++++++++++-------- 2 files changed, 41 insertions(+), 13 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index ef2b78baeb..27fc3b1689 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 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 ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2023 Giacomo Leidi +;;; Copyright © 2023 Andrew Patterson ;;; ;;; 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 "")) + +(define (config->sxml config) + "Converts a 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 - `(" - -\n" ,@(map (lambda (directory) - (string-append " " directory "\n")) - directories) - "\n")))))) + (call-with-output-string + (lambda (port) + (sxml->xml (config->sxml config) port))))))) (define (regenerate-font-cache-gexp _) `(("profile/share/fonts" -- cgit 1.4.1