419/458: guix: texlive-build-system: Generate TeX formats.

[guix-commits]

ngz pushed a commit to branch tex-team-next
in repository guix.

commit 3cc04242bb6a86d587d1cf524ff8c80e2dbb9dc4
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
AuthorDate: Sun Jun 4 10:38:11 2023 +0200

    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.
---
 doc/guix.texi                       |  4 +++-
 guix/build-system/texlive.scm       |  2 ++
 guix/build/texlive-build-system.scm | 34 +++++++++++++++++++++++++++++++---
 3 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0fd86242a9..f78358fcaf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9814,7 +9814,9 @@ Different build targets can be specified with the 
@code{#:build-targets}
 argument, which expects a list of file names.
 
 It also generates font metrics (i.e., @file{.tfm} files) out of METAFONT
-files whenever possible.
+files whenever possible.  Likewise, it can also create TeX formats
+(i.e., @file{.fmt} files) listed in the @code{#:create-formats}
+argument.
 
 The build system adds only @code{texlive-bin} and
 @code{texlive-latex-base} (both from @code{(gnu packages tex}) to the
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)))