X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/c2480d10422f176bf06081de9d601f3b7249a83c..b8c61a98b5649a63bc5affb03a151918b96db6dd:/doc/build.scm diff --git a/doc/build.scm b/doc/build.scm index ca81d813a9..97f4ab6b83 100644 --- a/doc/build.scm +++ b/doc/build.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright Â© 2019, 2020 Ludovic CourtÃ¨s +;;; Copyright Â© 2020 BjÃ¶rn HÃ¶fling ;;; ;;; This file is part of GNU Guix. ;;; @@ -58,7 +59,10 @@ "guix")) (define %languages - '("de" "en" "es" "fr" "ru" "zh_CN")) + ;; The cookbook is currently only translated into German. + (if (string=? %manual "guix-cookbook") + '("de" "en") + '("de" "en" "es" "fr" "ru" "zh_CN"))) (define (texinfo-manual-images source) "Return a directory containing all the images used by the user manual, taken @@ -137,12 +141,12 @@ as well as images, OS examples, and translations." (date->string date "~B ~Y") version version)))))) - (install-file #$(file-append* documentation "/htmlxref.cnf") + (install-file #$(file-append documentation "/htmlxref.cnf") #$output) (for-each (lambda (texi) (install-file texi #$output)) - (append (find-files #$documentation "\\.(texi|scm)$") + (append (find-files #$documentation "\\.(texi|scm|json)$") (find-files #$(translated-texi-manuals source) "\\.texi$"))) @@ -178,30 +182,27 @@ content=\"width=device-width, initial-scale=1\" />")) ;; Guile-Lib with a hotfix for (htmlprag). (package (inherit guile-lib) - (source (origin - (inherit (package-source guile-lib)) - (modules '(( guix build utils))) - (snippet - '(begin - ;; When parsing - ;; "

foo
\n

", - ;; 'html->shtml' would mistakenly close 'blockquote' right - ;; before

. This patch removes 'p' from the - ;; 'parent-constraints' alist to fix that. - (substitute* "src/htmlprag.scm" - (("^[[:blank:]]*\$p[[:blank:]]+\\. \\(body td th\$\\).*") - "")) - #t)))) (arguments (substitute-keyword-arguments (package-arguments guile-lib) ((#:phases phases '%standard-phases) `(modify-phases ,phases - (add-before 'check 'skip-known-failure - (lambda _ - ;; XXX: The above change causes one test failure among - ;; the htmlprag tests. - (setenv "XFAIL_TESTS" "htmlprag.scm") - #t)))))))) + (add-before 'build 'fix-htmlprag + (lambda _ + ;; When parsing + ;; "

foo
\n

", + ;; 'html->shtml' would mistakenly close 'blockquote' right + ;; before

. This patch removes 'p' from the + ;; 'parent-constraints' alist to fix that. + (substitute* "src/htmlprag.scm" + (("^[[:blank:]]*\$p[[:blank:]]+\\. \\(body td th\$\\).*") + "")) + #t)) + (add-before 'check 'skip-known-failure + (lambda _ + ;; XXX: The above change causes one test failure among + ;; the htmlprag tests. + (setenv "XFAIL_TESTS" "htmlprag.scm") + #t)))))))) (define* (syntax-highlighted-html input #:key @@ -221,6 +222,7 @@ its

 blocks (as produced by 'makeinfo --html')."
                          (syntax-highlight lexers)
                          (guix build utils)
                          (srfi srfi-1)
+                         (srfi srfi-26)
                          (ice-9 match)
                          (ice-9 threads)
                          (ice-9 vlist))
@@ -308,6 +310,8 @@ its  blocks (as produced by 'makeinfo --html')."
                    (loop rest (cons (entity->string entity) strings)))
                   ((('span _ lst ...) . rest)     ;for 
                    (loop (append lst rest) strings))
+                  ((('var name) . rest)           ;for @var{name} within @lisp
+                   (loop rest (cons name strings))) ;XXX: losing formatting
                   (something
                    (pk 'unsupported-code-snippet something)
                    (primitive-exit 1)))))
@@ -358,9 +362,14 @@ its  blocks (as produced by 'makeinfo --html')."
             (define (anchor-id->key id)
               ;; Convert ID, an anchor ID such as
               ;; "index-pam_002dlimits_002dservice" to the corresponding key,
-              ;; "pam-limits-service" in this example.
-              (underscore-decode
-               (string-drop id (string-length "index-"))))
+              ;; "pam-limits-service" in this example.  Drop the suffix of
+              ;; duplicate anchor IDs like "operating_002dsystem-1".
+              (let ((id (if (any (cut string-suffix? <> id)
+                                 '("-1" "-2" "-3" "-4" "-5"))
+                            (string-drop-right id 2)
+                            id)))
+                (underscore-decode
+                 (string-drop id (string-length "index-")))))
 
             (define* (collect-anchors file #:optional (vhash vlist-null))
               ;; Collect the anchors that appear in FILE, a makeinfo-generated
@@ -445,7 +454,9 @@ its  blocks (as produced by 'makeinfo --html')."
                             (lambda (mono)
                               (let ((anchors (collect-anchors mono)))
                                 (process-html mono anchors)))
-                            (find-files #$input "^guix(\\.[a-zA-Z_-]+)?\\.html$"))
+                            (find-files
+                             #$input
+                             "^guix(-cookbook|)(\\.[a-zA-Z_-]+)?\\.html$"))
 
             ;; Next process the multi-node HTML files in two phases: (1)
             ;; collect the list of anchors, and (2) perform