doc/build.scm

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