[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Program to build the on-line manuals (HTML + PDF)
|
From: |
Ludovic Courtès |
|
Subject: |
Program to build the on-line manuals (HTML + PDF) |
|
Date: |
Mon, 20 May 2019 12:27:30 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) |
Hello Guix!
Here’s a build program I used to generate all the gnu.org/s/guix/manual
hierarchy, with all the languages, HTML and PDF.
You can drop in your Guix tree and run, say:
GUIX_MANUAL_VERSION=1.0.1 guix build -f build.scm
to build the manual for 1.0.1.
It’s rough on the edges so I’d like to polish it and then commit it
under doc/ I guess. In the meantime, it can be used, for instance to
update the copy of the manual at guix.info.
Regarding PDFs, I failed to use something smaller than the big ‘texlive’
package. I’d very much welcome help in that area!
Unfortunately, Texinfo cannot produce PDFs for non-Latin alphabets
currently. It would be nice to see how we can fix it or work around it.
Feedback welcome!
Ludo’.
;;; Copyright © 2019 Ludovic Courtès
;;;
;;; This file is under the GNU General Public License, version 3 or any later
;;; version.
(use-modules (guix)
(guix gexp)
(guix git)
(gnu packages base)
(gnu packages gawk)
(gnu packages gettext)
(gnu packages guile)
(gnu packages texinfo)
(gnu packages tex)
(srfi srfi-11)
(srfi srfi-19))
(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)))
;; FIXME: Date.
(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 %makeinfo-html-options
'("--css-ref=/software/gnulib/manual.css"))
(define texinfo-dot-tex
;; FIXME: This file is not versioned, we should fetch it from Git.
(origin
(method url-fetch)
(uri "mirror://gnu/texinfo/texinfo.tex")
(sha256
(base32
"1pqwixq53g9w58yb8c1l18md09ls68rpr8fi6l9rssh74hb456mi"))))
(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)
address@hidden
,(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: Fails with:
;; texi2dvi: pdftex exited with bad status, quitting.
;; Thus we end up using the huge 'texlive' package instead.
;;
;; (define texlive
;; (texlive-union (list texlive-tex-texinfo 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" 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")
(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)
(copy-file #$texinfo-dot-tex "texinfo.tex")
(setenv "TEXINPUTS" (string-append (getcwd) ":"))
(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" "."
address@hidden
,(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")
"-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 #$(or (getenv "GUIX_WEB_SITE_URL")
"/software/guix/")
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 "/software/guix")))
(span (@ (class "a11y-offset"))
"Guix"))
(nav (@ (class "menu"))))
(nav (@ (class "breadcrumbs"))
(a (@ (class "crumb")
(href "/software/guix"))
"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))
(with-store store
(let*-values (((repo)
(pk 'repo (string-append (current-source-directory) "/..")))
((checkout commit)
(latest-repository-commit store (canonicalize-path repo)
#:ref '(branch . "version-1.0.1"))))
(pk 'checkout checkout commit)
(pdf+html-manual checkout
#:version (or (getenv "GUIX_MANUAL_VERSION")
(string-take commit 7)))))
- Program to build the on-line manuals (HTML + PDF),
Ludovic Courtès <=