01/02: gnu: Add texlive-amsfonts/patched.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 9db67988242ad514fa900e840b1494bda6001d6b
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Wed May 5 15:28:06 2021 +0200

    gnu: Add texlive-amsfonts/patched.
    
    * gnu/packages/tex.scm (texlive-amsfonts/patched): New variable.
---
 gnu/packages/tex.scm | 150 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 150 insertions(+)

diff --git a/gnu/packages/tex.scm b/gnu/packages/tex.scm
index 486b1a3..b9eeb0e 100644
--- a/gnu/packages/tex.scm
+++ b/gnu/packages/tex.scm
@@ -1227,6 +1227,156 @@ Modern family of fonts.  The Euler fonts are supported 
by separate packages;
 details can be found in the documentation.")
       (license license:silofl1.1))))
 
+;; XXX: we can only change texlive-amsfonts on the core-updates branch.  This
+;; patched version generates only tfm files for fonts provided by the source
+;; files of this package, not variants of the fonts provided by texlive-cm.
+(define-public texlive-amsfonts/patched
+  (let ((template (simple-texlive-package
+                   "texlive-amsfonts"
+                   (list "/source/latex/amsfonts/"
+                         "/fonts/source/public/amsfonts/"
+                         "/fonts/type1/public/amsfonts/"
+                         "/fonts/afm/public/amsfonts/"
+                         "/fonts/map/dvips/amsfonts/"
+                         "/tex/plain/amsfonts/"
+                         "/doc/fonts/amsfonts/")
+                   (base32
+                    "15q70nkjf8wqzbd5ivcdx3i2sdgqxjb38q0qn9a2qw9i0qcnx6zw"))))
+    (package
+      (inherit template)
+      (arguments
+       (substitute-keyword-arguments (package-arguments template)
+         ((#:build-targets _ #t)
+          '(list "amsfonts.ins"))
+         ((#:tex-directory _ #t)
+          "latex/amsfonts")
+         ((#:modules modules '())
+          `((guix build texlive-build-system)
+            (guix build utils)
+            (ice-9 match)
+            (srfi srfi-1)
+            (srfi srfi-26)))
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (add-before 'build 'build-fonts
+               (lambda* (#:key inputs #:allow-other-keys)
+                 (let ((mf  (assoc-ref inputs "texlive-union"))
+                       (src (string-append (getcwd) 
"/fonts/source/public/amsfonts/")))
+                   ;; Make METAFONT reproducible
+                   (setenv "SOURCE_DATE_EPOCH" "1")
+                   ;; Tell mf where to find mf.base
+                   (setenv "MFBASES" (string-append mf 
"/share/texmf-dist/web2c"))
+                   ;; Tell mf where to look for source files
+                   (setenv "MFINPUTS"
+                           (string-append src ":"
+                                          src "/cmextra:"
+                                          src "/cyrillic:"
+                                          src "/dummy:"
+                                          src "/symbols:"
+                                          mf "/share/texmf-dist/metafont/base:"
+                                          (assoc-ref inputs "texlive-cm")
+                                          
"/share/texmf-dist/fonts/source/public/cm")))
+                 (let ((build (string-append (getcwd) "/build-fonts")))
+                   (mkdir-p build)
+                   (with-directory-excursion "fonts/source/public/amsfonts"
+                     (for-each (lambda (font)
+                                 (format #t "building font ~a\n" (basename 
font ".mf"))
+                                 (with-directory-excursion (dirname font)
+                                   (invoke "mf" "-progname=mf"
+                                           (string-append "-output-directory=" 
build)
+                                           (string-append "\\"
+                                                          "mode:=ljfour; "
+                                                          "mag:=1; "
+                                                          "nonstopmode; "
+                                                          "input "
+                                                          (getcwd) "/"
+                                                          (basename font 
".mf")))))
+                               (find-files "." "[0-9]+\\.mf$"))))
+
+                 ;; There are no metafont sources for the Euler fonts, so we
+                 ;; convert the afm files instead.
+                 (let ((build (string-append (getcwd) "/build-fonts/euler")))
+                   (mkdir build)
+                   (with-directory-excursion "fonts/afm/public/amsfonts/"
+                     (for-each (lambda (font)
+                                 (format #t "converting afm font ~a\n" 
(basename font ".afm"))
+                                 (invoke "afm2tfm" font
+                                         (string-append build "/"
+                                                        (basename font 
".tfm"))))
+                               (find-files 
"(cmextra|cyrillic|dummy|euler|symbols)"
+                                           "\\.afm$")))
+
+                   ;; Frustratingly, not all fonts can be created this way.  To
+                   ;; generate eufm8.tfm, for example, we first scale down
+                   ;; eufm10.afm to eufm8.pl, and then generate the tfm file 
from
+                   ;; the pl file.
+                   (setenv "TEXINPUTS"
+                           (string-append build "//:"
+                                          (getcwd) 
"/fonts/afm/public/amsfonts//:"
+                                          (getcwd) "/source/latex/amsfonts//:"
+                                          (assoc-ref inputs "texlive-union") 
"//"))
+                   (with-directory-excursion build
+                     (for-each (match-lambda
+                                 (((target-base target-size)
+                                   (source-base source-size))
+                                  (let ((factor (number->string
+                                                 (truncate/ (* 1000 
target-size)
+                                                            source-size))))
+                                    (invoke "tex"
+                                            "-interaction=scrollmode"
+                                            (string-append "\\input 
fontinst.sty "
+                                                           "\\transformfont{" 
target-base "}"
+                                                           "{\\scalefont{" 
factor "}"
+                                                           "{\\fromafm{" 
source-base "}}} "
+                                                           "\\bye")))
+                                  (invoke "pltotf"
+                                          (string-append target-base ".pl")
+                                          (string-append target-base ".tfm"))
+                                  (delete-file (string-append target-base 
".pl"))))
+
+                               '((("eufm8" 8) ("eufm10" 10))
+
+                                 (("eufb6" 6) ("eufb7" 7))
+                                 (("eufb8" 8) ("eufb10" 10))
+                                 (("eufb9" 9) ("eufb10" 10))
+
+                                 (("eufm6" 6) ("eufb7" 7))
+                                 (("eufm9" 9) ("eufb10" 10))
+
+                                 (("eurb6" 6) ("eurb7" 7))
+                                 (("eurb8" 8) ("eurb10" 10))
+                                 (("eurb9" 9) ("eurb10" 10))
+
+                                 (("eurm6" 6) ("eurm7" 7))
+                                 (("eurm8" 8) ("eurm10" 10))
+                                 (("eurm9" 9) ("eurm10" 10))))))
+                 #t))
+             (add-after 'install 'install-generated-fonts
+               (lambda* (#:key inputs outputs #:allow-other-keys)
+                 (copy-recursively "build-fonts"
+                                   (string-append
+                                    (assoc-ref outputs "out")
+                                    
"/share/texmf-dist/fonts/tfm/public/amsfonts"))
+                 #t))))))
+      (native-inputs
+       `(("texlive-union" ,(texlive-union (list texlive-tex-fontinst-base
+                                                texlive-cm
+                                                texlive-metafont-base)))))
+      (home-page "https://www.ctan.org/pkg/amsfonts";)
+      (synopsis "TeX fonts from the American Mathematical Society")
+      (description
+       "This package provides an extended set of fonts for use in mathematics,
+including: extra mathematical symbols; blackboard bold letters (uppercase
+only); fraktur letters; subscript sizes of bold math italic and bold Greek
+letters; subscript sizes of large symbols such as sum and product; added sizes
+of the Computer Modern small caps font; cyrillic fonts (from the University of
+Washington); Euler mathematical fonts.  All fonts are provided as Adobe Type 1
+files, and all except the Euler fonts are provided as Metafont source.  The
+distribution also includes the canonical Type 1 versions of the Computer
+Modern family of fonts.  The Euler fonts are supported by separate packages;
+details can be found in the documentation.")
+      (license license:silofl1.1))))
+
 (define-public texlive-fonts-amsfonts
   (deprecated-package "texlive-fonts-amsfonts" texlive-amsfonts))