diff options
| -rw-r--r-- | guix/import/texlive.scm | 83 | ||||
| -rw-r--r-- | tests/texlive.scm | 152 |
2 files changed, 215 insertions, 20 deletions
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index 5458a43456..554258f20d 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -183,6 +183,7 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned." (srcfiles . list) (runfiles . list) (docfiles . list) + (binfiles . list) (depend . simple-list) (execute . simple-list))) (record @@ -264,6 +265,46 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned." packages) (append packages deps))))))) +(define (formats package-data) + "Return a list of formats to build according to PACKAGE-DATA." + (and=> (assoc-ref package-data 'execute) + (lambda (actions) + (delete-duplicates + (filter-map + (lambda (action) + (match (string-split action #\space) + (("AddFormat" fmt . _) + (string-drop fmt (string-length "name="))) + (_ #f))) + ;; Get the right (alphabetic) order. + (reverse actions)))))) + +(define (linked-scripts name package-database) + "Return a list of script names to symlink from \"bin/\" directory for +package NAME according to PACKAGE-DATABASE. Consider as scripts files with +\".lua\", \".pl\", \".py\", \".sh\" extensions, and files without extension." + (and-let* ((data (assoc-ref package-database name)) + ;; Check if binaries are associated to the package. + (depend (assoc-ref data 'depend)) + ((member (string-append name ".ARCH") depend)) + ;; List those binaries. + (bin-data (assoc-ref package-database + ;; Any *nix-like architecture will do. + (string-append name ".x86_64-linux"))) + (binaries (map basename (assoc-ref bin-data 'binfiles))) + ;; List scripts candidates. Bail out if there are none. + (runfiles (assoc-ref data 'runfiles)) + (scripts (filter (cut string-prefix? "texmf-dist/scripts/" <>) + runfiles)) + ((pair? scripts))) + (filter-map (lambda (script) + (and (any (lambda (ext) + (member (basename script ext) binaries)) + '(".lua" ".pl" ".py" ".sh")) + (basename script))) + ;; Get the right (alphabetic) order. + (reverse scripts)))) + (define* (files-differ? directory package-name #:key (package-database tlpdb) @@ -348,7 +389,9 @@ of those files are returned that are unexpectedly installed." (source (with-store store (download-multi-svn-to-store store ref (string-append name "-svn-multi-checkout"))))) - (let ((meta-package? (null? locs))) + (let* ((meta-package? (null? locs)) + (scripts (and (not meta-package?) + (linked-scripts texlive-name package-database)))) (values `(package (name ,name) @@ -369,25 +412,10 @@ of those files are returned that are unexpectedly installed." (build-system ,(if meta-package? 'trivial-build-system 'texlive-build-system)) + ;; Generate arguments field. ,@(if meta-package? '((arguments (list #:builder #~(mkdir #$output)))) - (let* ((formats - ;; Translate AddFormat execute actions into - ;; a #:create-formats argument. - (and-let* - ((actions (assoc-ref data 'execute)) - (formats - (delete-duplicates - (filter-map - (lambda (action) - (match (string-split action #\space) - (("AddFormat" fmt . _) - (string-drop fmt (string-length "name="))) - (_ #f))) - actions))) - ((pair? formats))) - (reverse formats))) - ;; Check if setting #:texlive-latex-bin? is appropriate. + (let* ((formats (formats data)) (latex-bin-dependency? (member texlive-name (latex-bin-dependency-tree package-database))) @@ -395,14 +423,20 @@ of those files are returned that are unexpectedly installed." (append (if latex-bin-dependency? '(#:texlive-latex-bin? #f) '()) - (if formats + (if (pair? scripts) + `(#:link-scripts #~(list ,@scripts)) + '()) + (if (pair? formats) `(#:create-formats #~(list ,@formats)) '())))) (if (pair? arguments) `((arguments (list ,@arguments))) '()))) + ;; Native inputs. + ;; ;; Texlive build system generates font metrics whenever a font - ;; metrics file has the same base name as a Metafont file. + ;; metrics file has the same base name as a Metafont file. In this + ;; case, provide `texlive-metafont'. ,@(or (and-let* ((runfiles (assoc-ref data 'runfiles)) (metrics (filter-map (lambda (f) @@ -416,6 +450,15 @@ of those files are returned that are unexpectedly installed." runfiles))) '((native-inputs (list texlive-metafont)))) '()) + ;; Inputs. + ,@(match (filter-map (lambda (s) + (cond ((string-suffix? ".pl" s) 'perl) + ((string-suffix? ".py" s) 'python) + (else #f))) + (or scripts '())) + (() '()) + (inputs `((inputs (list ,@inputs))))) + ;; Propagated inputs. ,@(match (translate-depends depends) (() '()) (inputs diff --git a/tests/texlive.scm b/tests/texlive.scm index 063cde6465..98461f7e51 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -69,6 +69,19 @@ "texmf-dist/tex/latex/adforn/adforn.sty" "texmf-dist/tex/latex/adforn/uornementsadf.fd") (catalogue-license . "lppl gpl2")) + ("authorindex" + (name . "authorindex") + (shortdesc . "Index citations by author names") + (longdesc . "This package allows the user to...") + (depend "authorindex.ARCH") + (docfiles "texmf-dist/doc/latex/authorindex/COPYING") + (runfiles + "texmf-dist/scripts/authorindex/authorindex" + "texmf-dist/tex/latex/authorindex/authorindex.sty") + (catalogue-license . "lppl")) + ("authorindex.x86_64-linux" + (name . "authorindex.x86_64-linux") + (binfiles "bin/amd64-netbsd/authorindex")) ("chs-physics-report" . ((name . "ch-physics-report") (shortdesc . "Physics lab reports...") @@ -92,6 +105,22 @@ (shortdesc . "TeXworks editor...") (longdesc . "See http...") (depend "texworks" "collection-basic")) + ("cyrillic-bin" + (name . "cyrillic-bin") + (shortdesc . "Cyrillic bibtex and makeindex") + (depend "cyrillic-bin.ARCH") + (docfiles + "texmf-dist/doc/man/man1/rubibtex.1" + "texmf-dist/doc/man/man1/rubibtex.man1.pdf") + (runfiles + "texmf-dist/scripts/texlive-extra/rumakeindex.sh" + "texmf-dist/scripts/texlive-extra/rubibtex.sh")) + ("cyrillic-bin.x86_64-linux" + (name . "cyrillic-bin.x86_64-linux") + (shortdesc . "x86_64-linux files of cyrillic-bin") + (binfiles + "bin/x86_64-linux/rubibtex" + "bin/x86_64-linux/rumakeindex")) ("example" . ((name . "example") (shortdesc . "Typeset examples...") @@ -133,6 +162,24 @@ "texmf-dist/tex/lollipop/lollipop.ini" "texmf-dist/tex/lollipop/lollipop.tex") (catalogue-license . "gpl3")) + ("pax" + (name . "pax") + (shortdesc . "Extract and reinsert PDF...") + (longdesc . "If PDF files are...") + (depend "pax.ARCH") + (docfiles + "texmf-dist/doc/latex/pax/README") + (srcfiles + "texmf-dist/source/latex/pax/Makefile" + "texmf-dist/source/latex/pax/build.xml") + (runfiles + "texmf-dist/scripts/pax/pdfannotextractor.pl") + (catalogue-license . "lppl gpl")) + ("pax.x86_64-linux" + (name . "pax.x86_64-linux") + (shortdesc . "x86_64-linux files of pax") + (binfiles + "bin/x86_64-linux/pdfannotextractor")) ("stricttex" . ((name . "stricttex") @@ -646,4 +693,109 @@ completely compatible with Plain TeX.") (format #t "~s~%" result) (pk 'fail result #f))))))) +(test-assert "texlive->guix-package, single script, no extension" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "authorindex" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-authorindex") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "authorindex")))) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, multiple scripts, with extensions" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "cyrillic-bin" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-cyrillic-bin") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts + ('gexp ('list "rubibtex.sh" "rumakeindex.sh")))) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, script with associated input" + ;; Replace network resources with sample data. + (mock ((guix build svn) svn-fetch + (lambda* (url revision directory + #:key (svn-command "svn") + (user-name #f) + (password #f) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "pax" + #:package-database + (lambda _ %fake-tlpdb)))) + (match result + (('package + ('name "texlive-pax") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "pdfannotextractor.pl")))) + ('inputs + ('list 'perl)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + (test-end "texlive") |