From 725f14221b6cb80619bb6787957e9ad2f876dd33 Mon Sep 17 00:00:00 2001
From: Ivan Kozlov <kanichos@yandex.ru>
Date: Fri, 14 Feb 2020 20:17:05 +0300
Subject: Generate font catalogues for the X server
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Actually, I am sending this as a patch.

This should produce a "share/fontpath.d" directory in the profile which is a font catalogue as described in Xserver(1). Then the X server font path can be set to include this catalogue and it will find the installed fonts. This concerns all legacy X11 applications using the core fonts system, and most importantly xterm.

The hook ‘fonts-dir-file’ was originally added for this purpose as the comments can tell; you would include e. g. "share/fonts/X11/misc" from the profile in the font path, which is a union directory with symbolic links to fonts that want to install there and a fonts.dir file describing all of them. This has not been working for ages, since the X.org server stopped following symbolic links to font files for security reasons. It should be removed.
---
 guix/profiles.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0d38b2513f..4b7c557f8a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1293,6 +1293,37 @@ files for the fonts of the @var{manifest} entries."
                     `((type . profile-hook)
                       (hook . fonts-dir))))
 
+(define (fontpath-file manifest)
+  (define build
+    #~(begin
+       (use-modules (srfi srfi-1) (srfi srfi-26) (guix build utils))
+       (let* ((top-font-dirs (filter file-exists?
+                                     (map (cut string-append <>
+                                               "/share/fonts")
+                                          '#$(manifest-inputs manifest))))
+              (font-dirs (append-map (lambda (dir)
+                                       (find-files dir
+                                                   (lambda (file stat)
+                                                     (and (eq? 'directory (stat:type stat))
+                                                          (file-exists? (string-append file "/fonts.dir"))))
+                                                   #:directories? #t)) top-font-dirs))
+              (fonpath-dir (string-append #$output "/share/fontpath.d")))
+         (mkdir-p fontpath-dir)
+         (chdir fontpath-dir)
+         (for-each (lambda (dir pri)
+                     (symlink dir (string-append (basename dir) ":pri=" (number->string pri))))
+                   font-dirs
+                   (iota (length font-dirs) 1)))))
+  (gexp->derivation "fontpath.d" build
+                    #:modules '((guix build utils)
+                                (srfi srfi-1)
+                               (srfi srfi-26))
+                    #:local-build? #t
+                    #:substitutable? #f
+                    #:properties
+                    `((type . profile-hook)
+                      (hook . fontpath-dir))))
+
 (define (manual-database manifest)
   "Return a derivation that builds the manual page database (\"mandb\") for
 the entries in MANIFEST."
@@ -1430,6 +1461,7 @@ MANIFEST."
   (list info-dir-file
         manual-database
         fonts-dir-file
+       fontpath-file
         ghc-package-cache-file
         ca-certificate-bundle
         glib-schemas
-- 
cgit v1.2.3