[jackhill/guix/guix.git] / doc / build.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.


;; This file contains machinery to build HTML and PDF copies of the manual
;; that can be readily published on the web site.  To do that, run:
;;
;;  guix build -f build.scm
;;
;; The result is a directory hierarchy that can be used as the manual/
;; sub-directory of the web site.

(use-modules (guix)
             (guix gexp)
             (guix git)
             (guix git-download)
             (git)
             (gnu packages base)
             (gnu packages gawk)
             (gnu packages gettext)
             (gnu packages guile)
             (gnu packages texinfo)
             (gnu packages tex)
             (srfi srfi-19)
             (srfi srfi-71))

(define file-append*
  (@@ (guix self) file-append*))

(define translated-texi-manuals
  (@@ (guix self) translate-texi-manuals))

(define info-manual
  (@@ (guix self) info-manual))

(define %languages
  '("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
from SOURCE, the root of the source tree."
  (define graphviz
    (module-ref (resolve-interface '(gnu packages graphviz))
                'graphviz))

  (define images
    (file-append* source "doc/images"))

  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (srfi srfi-26))

          (define (dot->image dot-file format)
            (invoke #+(file-append graphviz "/bin/dot")
                    "-T" format "-Gratio=.9" "-Gnodesep=.005"
                    "-Granksep=.00005" "-Nfontsize=9"
                    "-Nheight=.1" "-Nwidth=.1"
                    "-o" (string-append #$output "/"
                                        (basename dot-file ".dot")
                                        "." format)
                    dot-file))

          ;; Build graphs.
          (mkdir-p #$output)
          (for-each (lambda (dot-file)
                      (for-each (cut dot->image dot-file <>)
                                '("png" "pdf")))
                    (find-files #$images "\\.dot$"))

          ;; Copy other PNGs.
          (for-each (lambda (png-file)
                      (install-file png-file #$output))
                    (find-files #$images "\\.png$")))))

  (computed-file "texinfo-manual-images" build))

(define* (texinfo-manual-source source #:key
                                (version "0.0")
                                (languages %languages)
                                (date 1))
  "Gather all the source files of the Texinfo manuals from SOURCE--.texi file
as well as images, OS examples, and translations."
  (define documentation
    (file-append* source "doc"))

  (define examples
    (file-append* source "gnu/system/examples"))

  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (srfi srfi-19))

          (define (make-version-texi language)
            ;; Create the 'version.texi' file for LANGUAGE.
            (let ((file (if (string=? language "en")
                            "version.texi"
                            (string-append "version-" language ".texi"))))
              (call-with-output-file (string-append #$output "/" file)
                (lambda (port)
                  (let* ((version #$version)
                         (time    (make-time time-utc 0 #$date))
                         (date    (time-utc->date time)))
                    (format port "
@set UPDATED ~a
@set UPDATED-MONTH ~a
@set EDITION ~a
@set VERSION ~a\n"
                            (date->string date "~e ~B ~Y")
                            (date->string date "~B ~Y")
                            version version))))))

          (install-file #$(file-append* documentation "/htmlxref.cnf")
                        #$output)

          (for-each (lambda (texi)
                      (install-file texi #$output))
                    (append (find-files #$documentation "\\.(texi|scm)$")
                            (find-files #$(translated-texi-manuals source)
                                        "\\.texi$")))

          ;; Create 'version.texi'.
          (for-each make-version-texi '#$languages)

          ;; Copy configuration templates that the manual includes.
          (for-each (lambda (template)
                      (copy-file template
                                 (string-append
                                  #$output "/os-config-"
                                  (basename template ".tmpl")
                                  ".texi")))
                    (find-files #$examples "\\.tmpl$"))

          (symlink #$(texinfo-manual-images source)
                   (string-append #$output "/images")))))

  (computed-file "texinfo-manual-source" build))

(define %web-site-url
  ;; URL of the web site home page.
  (or (getenv "GUIX_WEB_SITE_URL")
      "/software/guix/"))

(define %makeinfo-html-options
  ;; Options passed to 'makeinfo --html'.
  '("--css-ref=https://www.gnu.org/software/gnulib/manual.css"))

(define* (html-manual source #:key (languages %languages)
                      (version "0.0")
                      (manual "guix")
                      (date 1)
                      (options %makeinfo-html-options))
  "Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
makeinfo OPTIONS."
  (define manual-source
    (texinfo-manual-source source
                           #:version version
                           #:languages languages
                           #:date date))

  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (ice-9 match))

          (define (normalize language)
            ;; Normalize LANGUAGE.  For instance, "zh_CN" become "zh-cn".
            (string-map (match-lambda
                          (#\_ #\-)
                          (chr chr))
                        (string-downcase language)))

          ;; Install a UTF-8 locale so that 'makeinfo' is at ease.
          (setenv "GUIX_LOCPATH"
                  #+(file-append glibc-utf8-locales "/lib/locale"))
          (setenv "LC_ALL" "en_US.utf8")

          (setvbuf (current-output-port) 'line)
          (setvbuf (current-error-port) 'line)

          (for-each (lambda (language)
                      (let ((opts `("--html"
                                    "-c" ,(string-append "TOP_NODE_UP_URL=/manual/"
                                                         language)
                                    #$@options
                                    ,(if (string=? language "en")
                                         (string-append #$manual-source "/"
                                                        #$manual ".texi")
                                         (string-append #$manual-source "/"
                                                        #$manual "." language ".texi")))))
                        (format #t "building HTML manual for language '~a'...~%"
                                language)
                        (mkdir-p (string-append #$output "/"
                                                (normalize language)))
                        (setenv "LANGUAGE" language)
                        (apply invoke #$(file-append texinfo "/bin/makeinfo")
                               "-o" (string-append #$output "/"
                                                   (normalize language)
                                                   "/html_node")
                               opts)
                        (apply invoke #$(file-append texinfo "/bin/makeinfo")
                               "--no-split"
                               "-o"
                               (string-append #$output "/"
                                              (normalize language)
                                              "/" #$manual
                                              (if (string=? language "en")
                                                  ""
                                                  (string-append "." language))
                                              ".html")
                               opts)))
                    '#$languages))))

  (computed-file (string-append manual "-html-manual") build))

(define* (pdf-manual source #:key (languages %languages)
                     (version "0.0")
                     (manual "guix")
                     (date 1)
                     (options '()))
  "Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
makeinfo OPTIONS."
  (define manual-source
    (texinfo-manual-source source
                           #:version version
                           #:languages languages
                           #:date date))

  ;; FIXME: This union works, except for the table of contents of non-English
  ;; manuals, which contains escape sequences like "^^ca^^fe" instead of
  ;; accented letters.
  ;;
  ;; (define texlive
  ;;   (texlive-union (list texlive-tex-texinfo
  ;;                        texlive-generic-epsf
  ;;                        texlive-fonts-ec)))

  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (srfi srfi-34)
                       (ice-9 match))

          (define (normalize language)            ;XXX: deduplicate
            ;; Normalize LANGUAGE.  For instance, "zh_CN" becomes "zh-cn".
            (string-map (match-lambda
                          (#\_ #\-)
                          (chr chr))
                        (string-downcase language)))

          ;; Install a UTF-8 locale so that 'makeinfo' is at ease.
          (setenv "GUIX_LOCPATH"
                  #+(file-append glibc-utf8-locales "/lib/locale"))
          (setenv "LC_ALL" "en_US.utf8")
          (setenv "PATH"
                  (string-append #+(file-append texlive "/bin") ":"
                                 #+(file-append texinfo "/bin") ":"

                                 ;; Below are command-line tools needed by
                                 ;; 'texi2dvi' and friends.
                                 #+(file-append sed "/bin") ":"
                                 #+(file-append grep "/bin") ":"
                                 #+(file-append coreutils "/bin") ":"
                                 #+(file-append gawk "/bin") ":"
                                 #+(file-append tar "/bin") ":"
                                 #+(file-append diffutils "/bin")))

          (setvbuf (current-output-port) 'line)
          (setvbuf (current-error-port) 'line)

          (setenv "HOME" (getcwd))                ;for kpathsea/mktextfm

          ;; 'SOURCE_DATE_EPOCH' is honored by pdftex.
          (setenv "SOURCE_DATE_EPOCH" "1")

          (for-each (lambda (language)
                      (let ((opts `("--pdf"
                                    "-I" "."
                                    #$@options
                                    ,(if (string=? language "en")
                                         (string-append #$manual-source "/"
                                                        #$manual ".texi")
                                         (string-append #$manual-source "/"
                                                        #$manual "." language ".texi")))))
                        (format #t "building PDF manual for language '~a'...~%"
                                language)
                        (mkdir-p (string-append #$output "/"
                                                (normalize language)))
                        (setenv "LANGUAGE" language)


                        ;; FIXME: Unfortunately building PDFs for non-Latin
                        ;; alphabets doesn't work:
                        ;; <https://lists.gnu.org/archive/html/help-texinfo/2012-01/msg00014.html>.
                        (guard (c ((invoke-error? c)
                                   (format (current-error-port)
                                           "~%~%Failed to produce \
PDF for language '~a'!~%~%"
                                           language)))
                         (apply invoke #$(file-append texinfo "/bin/makeinfo")
                                "--pdf" "-o"
                                (string-append #$output "/"
                                               (normalize language)
                                               "/" #$manual
                                               (if (string=? language "en")
                                                   ""
                                                   (string-append "."
                                                                  language))
                                               ".pdf")
                                opts))))
                    '#$languages))))

  (computed-file (string-append manual "-pdf-manual") build))

(define (guix-manual-text-domain source languages)
  "Return the PO files for LANGUAGES of the 'guix-manual' text domain taken
from SOURCE."
  (define po-directory
    (file-append* source "/po/doc"))

  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils))

          (mkdir-p #$output)
          (for-each (lambda (language)
                      (define directory
                        (string-append #$output "/" language
                                       "/LC_MESSAGES"))

                      (mkdir-p directory)
                      (invoke #+(file-append gnu-gettext "/bin/msgfmt")
                              "-c" "-o"
                              (string-append directory "/guix-manual.mo")
                              (string-append #$po-directory "/guix-manual."
                                             language ".po")))
                    '#$(delete "en" languages)))))

  (computed-file "guix-manual-po" build))

(define* (html-manual-indexes source
                              #:key (languages %languages)
                              (version "0.0")
                              (manual "guix")
                              (date 1))
  (define build
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils)
                       (ice-9 match)
                       (ice-9 popen)
                       (sxml simple)
                       (srfi srfi-19))

          (define (normalize language)            ;XXX: deduplicate
            ;; Normalize LANGUAGE.  For instance, "zh_CN" become "zh-cn".
            (string-map (match-lambda
                          (#\_ #\-)
                          (chr chr))
                        (string-downcase language)))

          (define-syntax-rule (with-language language exp ...)
            (let ((lang (getenv "LANGUAGE")))
              (dynamic-wind
                (lambda ()
                  (setenv "LANGUAGE" language)
                  (setlocale LC_MESSAGES))
                (lambda () exp ...)
                (lambda ()
                  (if lang
                      (setenv "LANGUAGE" lang)
                      (unsetenv "LANGUAGE"))
                  (setlocale LC_MESSAGES)))))

          ;; (put 'with-language 'scheme-indent-function 1)
          (define* (translate str language
                              #:key (domain "guix-manual"))
            (define exp
              `(begin
                 (bindtextdomain "guix-manual"
                                 #+(guix-manual-text-domain
                                    source
                                    languages))
                 (write (gettext ,str "guix-manual"))))

            (with-language language
              ;; Since the 'gettext' function caches msgid translations,
              ;; regardless of $LANGUAGE, we have to spawn a new process each
              ;; time we want to translate to a different language.  Bah!
              (let* ((pipe (open-pipe* OPEN_READ
                                       #+(file-append guile-2.2
                                                      "/bin/guile")
                                       "-c" (object->string exp)))
                     (str  (read pipe)))
                (close-pipe pipe)
                str)))

          (define (seconds->string seconds language)
            (let* ((time (make-time time-utc 0 seconds))
                   (date (time-utc->date time)))
              (with-language language (date->string date "~e ~B ~Y"))))

          (define (guix-url path)
            (string-append #$%web-site-url path))

          (define (sxml-index language)
            (define title
              (translate "GNU Guix Reference Manual" language))

            ;; FIXME: Avoid duplicating styling info from guix-artwork.git.
            `(html (@ (lang ,language))
                   (head
                    (title ,(string-append title " — GNU Guix"))
                    (meta (@ (charset "UTF-8")))
                    (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
                    ;; Menu prefetch.
                    (link (@ (rel "prefetch") (href ,(guix-url "menu/index.html"))))
                    ;; Base CSS.
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/elements.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/common.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/messages.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/navbar.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/breadcrumbs.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/buttons.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/footer.css"))))

                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/page.css"))))
                    (link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/post.css")))))
                   (body
                    (header (@ (class "navbar"))
                            (h1 (a (@ (class "branding")
                                      (href #$%web-site-url)))
                                (span (@ (class "a11y-offset"))
                                      "Guix"))
                            (nav (@ (class "menu"))))
                    (nav (@ (class "breadcrumbs"))
                         (a (@ (class "crumb")
                               (href #$%web-site-url))
                            "Home"))
                    (main
                     (article
                      (@ (class "page centered-block limit-width"))
                      (h2 ,title)
                      (p (@ (class "post-metadata centered-text"))
                         #$version " — "
                         ,(seconds->string #$date language))

                      (div
                       (ul
                        (li (a (@ (href "html_node"))
                               "HTML, with one page per node"))
                        (li (a (@ (href
                                   ,(string-append
                                     #$manual
                                     (if (string=? language
                                                   "en")
                                         ""
                                         (string-append "."
                                                        language))
                                     ".html")))
                               "HTML, entirely on one page"))
                        ,@(if (member language '("ru" "zh_CN"))
                              '()
                              `((li (a (@ (href ,(string-append
                                                  #$manual
                                                  (if (string=? language "en")
                                                      ""
                                                      (string-append "."
                                                                     language))
                                                  ".pdf"))))
                                    "PDF")))))))
                    (footer))))

          (define (write-index language file)
            (call-with-output-file file
              (lambda (port)
                (display "<!DOCTYPE html>\n" port)
                (sxml->xml (sxml-index language) port))))

          (setenv "GUIX_LOCPATH"
                  #+(file-append glibc-utf8-locales "/lib/locale"))
          (setenv "LC_ALL" "en_US.utf8")
          (setlocale LC_ALL "en_US.utf8")

          (bindtextdomain "guix-manual"
                          #+(guix-manual-text-domain source languages))

          (for-each (lambda (language)
                      (define directory
                        (string-append #$output "/"
                                       (normalize language)))

                      (mkdir-p directory)
                      (write-index language
                                   (string-append directory
                                                  "/index.html")))
                    '#$languages))))

  (computed-file "html-indexes" build))

(define* (pdf+html-manual source
                          #:key (languages %languages)
                          (version "0.0")
                          (date (time-second (current-time time-utc)))
                          (manual "guix"))
  "Return the union of the HTML and PDF manuals, as well as the indexes."
  (directory-union (string-append manual "-manual")
                   (map (lambda (proc)
                          (proc source
                                #:date date
                                #:languages languages
                                #:version version
                                #:manual manual))
                        (list html-manual-indexes
                              html-manual pdf-manual))
                   #:copy? #t))

(define (latest-commit+date directory)
  "Return two values: the last commit ID (a hex string) for DIRECTORY, and its
commit date (an integer)."
  (let* ((repository (repository-open directory))
         (head       (repository-head repository))
         (oid        (reference-target head))
         (commit     (commit-lookup repository oid)))
    ;; TODO: Use (git describe) when it's widely available.
    (values (oid->string oid) (commit-time commit))))

\f
(let* ((root (canonicalize-path
              (string-append (current-source-directory) "/..")))
       (commit date (latest-commit+date root)))
  (format (current-error-port)
          "building manual from work tree around commit ~a, ~a~%"
          commit
          (let* ((time (make-time time-utc 0 date))
                 (date (time-utc->date time)))
            (date->string date "~e ~B ~Y")))
  (pdf+html-manual (local-file root "guix" #:recursive? #t
                               #:select? (git-predicate root))
                   #:version (or (getenv "GUIX_MANUAL_VERSION")
                                 (string-take commit 7))
                   #:date date))
Commit	Line	Data
ccadafdc LC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19
	20	;; This file contains machinery to build HTML and PDF copies of the manual
	21	;; that can be readily published on the web site. To do that, run:
	22	;;
	23	;; guix build -f build.scm
	24	;;
	25	;; The result is a directory hierarchy that can be used as the manual/
	26	;; sub-directory of the web site.
	27
	28	(use-modules (guix)
	29	(guix gexp)
	30	(guix git)
	31	(guix git-download)
	32	(git)
	33	(gnu packages base)
	34	(gnu packages gawk)
	35	(gnu packages gettext)
	36	(gnu packages guile)
	37	(gnu packages texinfo)
	38	(gnu packages tex)
	39	(srfi srfi-19)
	40	(srfi srfi-71))
	41
	42	(define file-append*
	43	(@@ (guix self) file-append*))
	44
	45	(define translated-texi-manuals
	46	(@@ (guix self) translate-texi-manuals))
	47
	48	(define info-manual
	49	(@@ (guix self) info-manual))
	50
	51	(define %languages
	52	'("de" "en" "es" "fr" "ru" "zh_CN"))
	53
	54	(define (texinfo-manual-images source)
	55	"Return a directory containing all the images used by the user manual, taken
	56	from SOURCE, the root of the source tree."
	57	(define graphviz
	58	(module-ref (resolve-interface '(gnu packages graphviz))
	59	'graphviz))
	60
	61	(define images
	62	(file-append* source "doc/images"))
	63
	64	(define build
65	(with-imported-modules '((guix build utils))
66	#~(begin
67	(use-modules (guix build utils)
68	(srfi srfi-26))
69
70	(define (dot->image dot-file format)
71	(invoke #+(file-append graphviz "/bin/dot")
72	"-T" format "-Gratio=.9" "-Gnodesep=.005"
73	"-Granksep=.00005" "-Nfontsize=9"
74	"-Nheight=.1" "-Nwidth=.1"
75	"-o" (string-append #$output "/"
76	(basename dot-file ".dot")
77	"." format)
78	dot-file))
79
80	;; Build graphs.
81	(mkdir-p #$output)
82	(for-each (lambda (dot-file)
83	(for-each (cut dot->image dot-file <>)
84	'("png" "pdf")))
85	(find-files #$images "\\.dot$"))
86
87	;; Copy other PNGs.
88	(for-each (lambda (png-file)
89	(install-file png-file #$output))
90	(find-files #$images "\\.png$")))))
91
92	(computed-file "texinfo-manual-images" build))
93
94	(define* (texinfo-manual-source source #:key
95	(version "0.0")
96	(languages %languages)
97	(date 1))
98	"Gather all the source files of the Texinfo manuals from SOURCE--.texi file
99	as well as images, OS examples, and translations."
100	(define documentation
101	(file-append* source "doc"))
102
103	(define examples
104	(file-append* source "gnu/system/examples"))
105
106	(define build
107	(with-imported-modules '((guix build utils))
108	#~(begin
109	(use-modules (guix build utils)
110	(srfi srfi-19))
111
112	(define (make-version-texi language)
113	;; Create the 'version.texi' file for LANGUAGE.
114	(let ((file (if (string=? language "en")
115	"version.texi"
116	(string-append "version-" language ".texi"))))
117	(call-with-output-file (string-append #$output "/" file)
118	(lambda (port)
119	(let* ((version #$version)
120	(time (make-time time-utc 0 #$date))
121	(date (time-utc->date time)))
122	(format port "
123	@set UPDATED ~a
124	@set UPDATED-MONTH ~a
125	@set EDITION ~a
126	@set VERSION ~a\n"
127	(date->string date "~e ~B ~Y")
128	(date->string date "~B ~Y")
129	version version))))))
130
131	(install-file #$(file-append* documentation "/htmlxref.cnf")
132	#$output)
133
134	(for-each (lambda (texi)
135	(install-file texi #$output))
136	(append (find-files #$documentation "\\.(texi\|scm)$")
137	(find-files #$(translated-texi-manuals source)
138	"\\.texi$")))
139
140	;; Create 'version.texi'.
141	(for-each make-version-texi '#$languages)
142
143	;; Copy configuration templates that the manual includes.
144	(for-each (lambda (template)
145	(copy-file template
146	(string-append
147	#$output "/os-config-"
148	(basename template ".tmpl")
149	".texi")))
150	(find-files #$examples "\\.tmpl$"))
151
152	(symlink #$(texinfo-manual-images source)
153	(string-append #$output "/images")))))
154
155	(computed-file "texinfo-manual-source" build))
156
157	(define %web-site-url
158	;; URL of the web site home page.
159	(or (getenv "GUIX_WEB_SITE_URL")
160	"/software/guix/"))
161
162	(define %makeinfo-html-options
163	;; Options passed to 'makeinfo --html'.
164	'("--css-ref=https://www.gnu.org/software/gnulib/manual.css"))
165
166	(define* (html-manual source #:key (languages %languages)
167	(version "0.0")
168	(manual "guix")
169	(date 1)
170	(options %makeinfo-html-options))
171	"Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
172	makeinfo OPTIONS."
173	(define manual-source
174	(texinfo-manual-source source
175	#:version version
176	#:languages languages
177	#:date date))
178
179	(define build
180	(with-imported-modules '((guix build utils))
181	#~(begin
182	(use-modules (guix build utils)
183	(ice-9 match))
184
185	(define (normalize language)
186	;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
187	(string-map (match-lambda
188	(#\_ #\-)
189	(chr chr))
190	(string-downcase language)))
191
192	;; Install a UTF-8 locale so that 'makeinfo' is at ease.
193	(setenv "GUIX_LOCPATH"
194	#+(file-append glibc-utf8-locales "/lib/locale"))
195	(setenv "LC_ALL" "en_US.utf8")
196
197	(setvbuf (current-output-port) 'line)
198	(setvbuf (current-error-port) 'line)
199
200	(for-each (lambda (language)
201	(let ((opts `("--html"
202	"-c" ,(string-append "TOP_NODE_UP_URL=/manual/"
203	language)
204	#$@options
205	,(if (string=? language "en")
206	(string-append #$manual-source "/"
207	#$manual ".texi")
208	(string-append #$manual-source "/"
209	#$manual "." language ".texi")))))
210	(format #t "building HTML manual for language '~a'...~%"
211	language)
212	(mkdir-p (string-append #$output "/"
213	(normalize language)))
214	(setenv "LANGUAGE" language)
215	(apply invoke #$(file-append texinfo "/bin/makeinfo")
216	"-o" (string-append #$output "/"
217	(normalize language)
218	"/html_node")
219	opts)
220	(apply invoke #$(file-append texinfo "/bin/makeinfo")
221	"--no-split"
222	"-o"
223	(string-append #$output "/"
224	(normalize language)
225	"/" #$manual
226	(if (string=? language "en")
227	""
228	(string-append "." language))
229	".html")
230	opts)))
231	'#$languages))))
232
233	(computed-file (string-append manual "-html-manual") build))
234
235	(define* (pdf-manual source #:key (languages %languages)
236	(version "0.0")
237	(manual "guix")
238	(date 1)
239	(options '()))
240	"Return the HTML manuals built from SOURCE for all LANGUAGES, with the given
241	makeinfo OPTIONS."
242	(define manual-source
243	(texinfo-manual-source source
244	#:version version
245	#:languages languages
246	#:date date))
247
248	;; FIXME: This union works, except for the table of contents of non-English
249	;; manuals, which contains escape sequences like "^^ca^^fe" instead of
250	;; accented letters.
251	;;
252	;; (define texlive
253	;; (texlive-union (list texlive-tex-texinfo
254	;; texlive-generic-epsf
255	;; texlive-fonts-ec)))
256
257	(define build
258	(with-imported-modules '((guix build utils))
259	#~(begin
260	(use-modules (guix build utils)
261	(srfi srfi-34)
262	(ice-9 match))
263
264	(define (normalize language) ;XXX: deduplicate
265	;; Normalize LANGUAGE. For instance, "zh_CN" becomes "zh-cn".
266	(string-map (match-lambda
267	(#\_ #\-)
268	(chr chr))
269	(string-downcase language)))
270
271	;; Install a UTF-8 locale so that 'makeinfo' is at ease.
272	(setenv "GUIX_LOCPATH"
273	#+(file-append glibc-utf8-locales "/lib/locale"))
274	(setenv "LC_ALL" "en_US.utf8")
275	(setenv "PATH"
276	(string-append #+(file-append texlive "/bin") ":"
277	#+(file-append texinfo "/bin") ":"
278
279	;; Below are command-line tools needed by
280	;; 'texi2dvi' and friends.
281	#+(file-append sed "/bin") ":"
282	#+(file-append grep "/bin") ":"
283	#+(file-append coreutils "/bin") ":"
284	#+(file-append gawk "/bin") ":"
285	#+(file-append tar "/bin") ":"
286	#+(file-append diffutils "/bin")))
287
288	(setvbuf (current-output-port) 'line)
289	(setvbuf (current-error-port) 'line)
290
291	(setenv "HOME" (getcwd)) ;for kpathsea/mktextfm
292
293	;; 'SOURCE_DATE_EPOCH' is honored by pdftex.
294	(setenv "SOURCE_DATE_EPOCH" "1")
295
296	(for-each (lambda (language)
297	(let ((opts `("--pdf"
298	"-I" "."
299	#$@options
300	,(if (string=? language "en")
301	(string-append #$manual-source "/"
302	#$manual ".texi")
303	(string-append #$manual-source "/"
304	#$manual "." language ".texi")))))
305	(format #t "building PDF manual for language '~a'...~%"
306	language)
307	(mkdir-p (string-append #$output "/"
308	(normalize language)))
309	(setenv "LANGUAGE" language)
310
311
312	;; FIXME: Unfortunately building PDFs for non-Latin
313	;; alphabets doesn't work:
314	;; <https://lists.gnu.org/archive/html/help-texinfo/2012-01/msg00014.html>.
315	(guard (c ((invoke-error? c)
316	(format (current-error-port)
317	"~%~%Failed to produce \
318	PDF for language '~a'!~%~%"
319	language)))
320	(apply invoke #$(file-append texinfo "/bin/makeinfo")
321	"--pdf" "-o"
322	(string-append #$output "/"
323	(normalize language)
324	"/" #$manual
325	(if (string=? language "en")
326	""
327	(string-append "."
328	language))
329	".pdf")
330	opts))))
331	'#$languages))))
332
333	(computed-file (string-append manual "-pdf-manual") build))
334
335	(define (guix-manual-text-domain source languages)
336	"Return the PO files for LANGUAGES of the 'guix-manual' text domain taken
337	from SOURCE."
338	(define po-directory
339	(file-append* source "/po/doc"))
340
341	(define build
342	(with-imported-modules '((guix build utils))
343	#~(begin
344	(use-modules (guix build utils))
345
346	(mkdir-p #$output)
347	(for-each (lambda (language)
348	(define directory
349	(string-append #$output "/" language
350	"/LC_MESSAGES"))
351
352	(mkdir-p directory)
353	(invoke #+(file-append gnu-gettext "/bin/msgfmt")
354	"-c" "-o"
355	(string-append directory "/guix-manual.mo")
356	(string-append #$po-directory "/guix-manual."
357	language ".po")))
358	'#$(delete "en" languages)))))
359
360	(computed-file "guix-manual-po" build))
361
362	(define* (html-manual-indexes source
363	#:key (languages %languages)
364	(version "0.0")
365	(manual "guix")
366	(date 1))
367	(define build
368	(with-imported-modules '((guix build utils))
369	#~(begin
370	(use-modules (guix build utils)
371	(ice-9 match)
372	(ice-9 popen)
373	(sxml simple)
374	(srfi srfi-19))
375
376	(define (normalize language) ;XXX: deduplicate
377	;; Normalize LANGUAGE. For instance, "zh_CN" become "zh-cn".
378	(string-map (match-lambda
379	(#\_ #\-)
380	(chr chr))
381	(string-downcase language)))
382
383	(define-syntax-rule (with-language language exp ...)
384	(let ((lang (getenv "LANGUAGE")))
385	(dynamic-wind
386	(lambda ()
387	(setenv "LANGUAGE" language)
388	(setlocale LC_MESSAGES))
389	(lambda () exp ...)
390	(lambda ()
391	(if lang
392	(setenv "LANGUAGE" lang)
393	(unsetenv "LANGUAGE"))
394	(setlocale LC_MESSAGES)))))
395
396	;; (put 'with-language 'scheme-indent-function 1)
397	(define* (translate str language
398	#:key (domain "guix-manual"))
399	(define exp
400	`(begin
401	(bindtextdomain "guix-manual"
402	#+(guix-manual-text-domain
403	source
404	languages))
405	(write (gettext ,str "guix-manual"))))
406
407	(with-language language
408	;; Since the 'gettext' function caches msgid translations,
409	;; regardless of $LANGUAGE, we have to spawn a new process each
410	;; time we want to translate to a different language. Bah!
411	(let* ((pipe (open-pipe* OPEN_READ
412	#+(file-append guile-2.2
413	"/bin/guile")
414	"-c" (object->string exp)))
415	(str (read pipe)))
416	(close-pipe pipe)
417	str)))
418
419	(define (seconds->string seconds language)
420	(let* ((time (make-time time-utc 0 seconds))
421	(date (time-utc->date time)))
422	(with-language language (date->string date "~e ~B ~Y"))))
423
424	(define (guix-url path)
425	(string-append #$%web-site-url path))
426
427	(define (sxml-index language)
428	(define title
429	(translate "GNU Guix Reference Manual" language))
430
431	;; FIXME: Avoid duplicating styling info from guix-artwork.git.
432	`(html (@ (lang ,language))
433	(head
434	(title ,(string-append title " — GNU Guix"))
435	(meta (@ (charset "UTF-8")))
436	(meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
437	;; Menu prefetch.
438	(link (@ (rel "prefetch") (href ,(guix-url "menu/index.html"))))
439	;; Base CSS.
440	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/elements.css"))))
441	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/common.css"))))
442	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/messages.css"))))
443	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/navbar.css"))))
444	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/breadcrumbs.css"))))
445	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/buttons.css"))))
446	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/footer.css"))))
447
448	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/page.css"))))
449	(link (@ (rel "stylesheet") (href ,(guix-url "static/base/css/post.css")))))
450	(body
451	(header (@ (class "navbar"))
452	(h1 (a (@ (class "branding")
453	(href #$%web-site-url)))
454	(span (@ (class "a11y-offset"))
455	"Guix"))
456	(nav (@ (class "menu"))))
457	(nav (@ (class "breadcrumbs"))
458	(a (@ (class "crumb")
459	(href #$%web-site-url))
460	"Home"))
461	(main
462	(article
463	(@ (class "page centered-block limit-width"))
464	(h2 ,title)
465	(p (@ (class "post-metadata centered-text"))
466	#$version " — "
467	,(seconds->string #$date language))
468
469	(div
470	(ul
471	(li (a (@ (href "html_node"))
472	"HTML, with one page per node"))
473	(li (a (@ (href
474	,(string-append
475	#$manual
476	(if (string=? language
477	"en")
478	""
479	(string-append "."
480	language))
481	".html")))
482	"HTML, entirely on one page"))
483	,@(if (member language '("ru" "zh_CN"))
484	'()
485	`((li (a (@ (href ,(string-append
486	#$manual
487	(if (string=? language "en")
488	""
489	(string-append "."
490	language))
491	".pdf"))))
492	"PDF")))))))
493	(footer))))
494
495	(define (write-index language file)
496	(call-with-output-file file
497	(lambda (port)
498	(display "<!DOCTYPE html>\n" port)
499	(sxml->xml (sxml-index language) port))))
500
501	(setenv "GUIX_LOCPATH"
502	#+(file-append glibc-utf8-locales "/lib/locale"))
503	(setenv "LC_ALL" "en_US.utf8")
504	(setlocale LC_ALL "en_US.utf8")
505
506	(bindtextdomain "guix-manual"
507	#+(guix-manual-text-domain source languages))
508
509	(for-each (lambda (language)
510	(define directory
511	(string-append #$output "/"
512	(normalize language)))
513
514	(mkdir-p directory)
515	(write-index language
516	(string-append directory
517	"/index.html")))
518	'#$languages))))
519
520	(computed-file "html-indexes" build))
521
522	(define* (pdf+html-manual source
523	#:key (languages %languages)
524	(version "0.0")
525	(date (time-second (current-time time-utc)))
526	(manual "guix"))
527	"Return the union of the HTML and PDF manuals, as well as the indexes."
528	(directory-union (string-append manual "-manual")
529	(map (lambda (proc)
530	(proc source
531	#:date date
532	#:languages languages
533	#:version version
534	#:manual manual))
535	(list html-manual-indexes
536	html-manual pdf-manual))
537	#:copy? #t))
538
539	(define (latest-commit+date directory)
540	"Return two values: the last commit ID (a hex string) for DIRECTORY, and its
541	commit date (an integer)."
542	(let* ((repository (repository-open directory))
543	(head (repository-head repository))
544	(oid (reference-target head))
545	(commit (commit-lookup repository oid)))
546	;; TODO: Use (git describe) when it's widely available.
547	(values (oid->string oid) (commit-time commit))))
548
549	\f
550	(let* ((root (canonicalize-path
551	(string-append (current-source-directory) "/..")))
552	(commit date (latest-commit+date root)))
553	(format (current-error-port)
554	"building manual from work tree around commit ~a, ~a~%"
555	commit
556	(let* ((time (make-time time-utc 0 date))
557	(date (time-utc->date time)))
558	(date->string date "~e ~B ~Y")))
559	(pdf+html-manual (local-file root "guix" #:recursive? #t
560	#:select? (git-predicate root))
561	#:version (or (getenv "GUIX_MANUAL_VERSION")
562	(string-take commit 7))
563	#:date date))