From 7ce20143a7ccddf54b878f51ef856ea3e717587f Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Sun, 4 Jun 2023 10:38:11 +0200
Subject: guix: texlive-build-system: Generate TeX formats.

* guix/build-system/texlive.scm (texlive-build): Add #:CREATE-FORMATS argument.
* doc/guix.texi (Build Systems): Document it.
* guix/build/texlive-build-system.scm (texlive-input?): New function.
(generate-font-metrics): Use new function above.
(create-formats): New function.
(%standard-phases): Add function above to phases.
---
 guix/build-system/texlive.scm       |  2 ++
 guix/build/texlive-build-system.scm | 34 +++++++++++++++++++++++++++++++---
 2 files changed, 33 insertions(+), 3 deletions(-)

(limited to 'guix')

diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index 55e9cfee81..e68cb87589 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -131,6 +131,7 @@ level package ID."
                         source
                         (tests? #f)
                         (build-targets #f)
+                        (create-formats #f)
                         (tex-engine #f)
 
                         ;; FIXME: This would normally default to "luatex" but
@@ -161,6 +162,7 @@ level package ID."
               #~(texlive-build #:name #$name
                                #:source #+source
                                #:build-targets #$build-targets
+                               #:create-formats #$create-formats
                                #:tex-engine #$(if tex-engine
                                                   tex-engine
                                                   tex-format)
diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm
index eeb23c4645..8c56131051 100644
--- a/guix/build/texlive-build-system.scm
+++ b/guix/build/texlive-build-system.scm
@@ -44,6 +44,12 @@
            (negate
             (cut member <> '("." ".." "build" "doc" "source")))))
 
+(define (texlive-input? input)
+  "Return #t if INPUT is a texlive input, #f otherwise."
+  (match input
+    (((or "source" (? (cut string-prefix? "texlive-" <>))) . _) #t)
+    (_ #f)))
+
 (define (install-as-runfiles dir regexp)
   "Install files under DIR matching REGEXP on top of existing runfiles in the
 current tree.  Sub-directories below DIR are preserved when looking for the
@@ -97,8 +103,6 @@ runfile to replace.  If a file has no matching runfile, it is ignored."
   ;; each sub-directory as a separate font source.
   (define (font-sources root metrics)
     (delete-duplicates (map dirname (font-files root metrics))))
-  (define (texlive-input? input)
-    (string-prefix? "texlive-" input))
   (and-let* ((local-metrics (font-metrics "fonts/tfm"))
              (local-sources (font-sources "fonts/source" local-metrics))
              ((not (null? local-sources))) ;nothing to generate: bail out
@@ -113,7 +117,7 @@ runfile to replace.  If a file has no matching runfile, it is ignored."
              (font-inputs
               (delete-duplicates
                (append-map (match-lambda
-                             (((? (negate texlive-input?)) . _) '())
+                             ((? (negate texlive-input?)) '())
                              (("texlive-bin" . _) '())
                              (("texlive-metafont" . _)
                               (list (string-append metafont "/metafont/base")))
@@ -149,6 +153,29 @@ runfile to replace.  If a file has no matching runfile, it is ignored."
        (install-as-runfiles "build" "\\.tfm$"))
      local-sources)))
 
+(define* (create-formats #:key create-formats inputs #:allow-other-keys)
+  (define (collect-locations inputs pred)
+    (delete-duplicates
+     (append-map (match-lambda
+                   ((? (negate texlive-input?)) '())
+                   ((_ . dir)
+                    (if pred
+                        (map dirname (find-files dir pred))
+                        (list dir))))
+                 inputs)))
+  (when create-formats
+    (setenv "TFMFONTS"
+            (string-join (collect-locations inputs "\\.tfm$") ":"))
+    (setenv "TEXINPUTS"
+            (string-join (collect-locations inputs #f) "//:" 'suffix))
+    (setenv "LUAINPUTS"
+            (string-join (collect-locations inputs "\\.lua$") ":"))
+    (mkdir-p "web2c")
+    (for-each (cut invoke "fmtutil-sys" "--byfmt" <> "--fmtdir=web2c")
+              create-formats)
+    ;; Remove cruft.
+    (for-each delete-file (find-files "web2c" "\\.log$"))))
+
 (define (compile-with-latex engine format output file)
   (invoke engine
           "-interaction=nonstopmode"
@@ -224,6 +251,7 @@ runfile to replace.  If a file has no matching runfile, it is ignored."
     (add-before 'build 'delete-drv-files delete-drv-files)
     (add-after 'delete-drv-files 'generate-font-metrics generate-font-metrics)
     (replace 'build build)
+    (add-after 'build 'create-formats create-formats)
     (delete 'check)
     (replace 'install install)))
 
-- 
cgit 1.4.1