bug#22629: [PATCH 4/4] self: Build the Info manual.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/self.scm (info-manual): New procedure.
(whole-package): Add #:info and honor it.
(compiled-guix): Pass #:info.
---
 guix/self.scm | 88 +++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 85 insertions(+), 3 deletions(-)

diff --git a/guix/self.scm b/guix/self.scm
index 92e69ffd5..8ed1e1073 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -230,6 +230,81 @@ DOMAIN, a gettext domain."
   (computed-file (string-append "guix-locale-" domain)
                  build))
 
+(define (info-manual source)
+  "Return the Info manual built from SOURCE."
+  (define texinfo
+    (module-ref (resolve-interface '(gnu packages texinfo))
+                'texinfo))
+
+  (define graphviz
+    (module-ref (resolve-interface '(gnu packages graphviz))
+                'graphviz))
+
+  (define build
+    ;; TODO: Don't depend on all of SOURCE to avoid rebuilds.
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+
+          (mkdir #$output)
+
+          ;; Create 'version.texi'.
+          ;; XXX: Can we use a more meaningful version string yet one that
+          ;; doesn't change at each commit?
+          (call-with-output-file "version.texi"
+            (lambda (port)
+              (let ((version "(Git snapshot)"))
+                (format port "
+@set UPDATED 1 January 1970
+@set UPDATED-MONTH January 1970
+@set EDITION ~a
+@set VERSION ~a\n" version version))))
+
+          ;; Copy configuration templates that the manual includes.
+          (for-each (lambda (template)
+                      (copy-file template
+                                 (string-append
+                                  "os-config-"
+                                  (basename template ".tmpl")
+                                  ".texi")))
+                    (find-files #$source "\\.tmpl$"))
+
+          ;; Build graphs.
+          (mkdir-p (string-append #$output "/images"))
+          (for-each (lambda (dot-file)
+                      (invoke #+(file-append graphviz "/bin/dot")
+                              "-Tpng" "-Gratio=.9" "-Gnodesep=.005"
+                              "-Granksep=.00005" "-Nfontsize=9"
+                              "-Nheight=.1" "-Nwidth=.1"
+                              "-o" (string-append #$output "/images/"
+                                                  (basename dot-file ".dot")
+                                                  ".png")
+                              dot-file))
+                    (find-files (string-append #$source "/doc/images")
+                                "\\.dot$"))
+
+          ;; Copy other PNGs.
+          (for-each (lambda (png-file)
+                      (install-file png-file
+                                    (string-append #$output "/images")))
+                    (find-files (string-append #$source "/doc/images")
+                                "\\.png$"))
+
+          ;; Finally build the manual.  Copy it the Texinfo files to $PWD and
+          ;; add a symlink to the 'images' directory so that 'makeinfo' can
+          ;; see those images and produce image references in the Info output.
+          (copy-recursively (string-append #$source "/doc") "."
+                            #:log (%make-void-port "w"))
+          (delete-file-recursively "images")
+          (symlink (string-append #$output "/images") "images")
+          (invoke #+(file-append texinfo "/bin/makeinfo")
+                  "guix.texi"
+                  "-I" (string-append #$source "/doc")
+                  "-I" "."
+                  "-o" (string-append #$output "/guix.info")))))
+
+  (computed-file "guix-manual" build))
+
 (define* (guix-command modules #:key source (dependencies '())
                        (guile-version (effective-version)))
   "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
@@ -275,12 +350,13 @@ load path."
 (define* (whole-package name modules dependencies
                         #:key
                         (guile-version (effective-version))
+                        info
                         (command (guix-command modules
                                                #:dependencies dependencies
                                                #:guile-version guile-version)))
   "Return the whole Guix package NAME that uses MODULES, a derivation of all
 the modules, and DEPENDENCIES, a list of packages depended on.  COMMAND is the
-'guix' program to use."
+'guix' program to use; INFO is the Info manual."
   ;; TODO: Move compiled modules to 'lib/guile' instead of 'share/guile'.
   (computed-file name
                  (with-imported-modules '((guix build utils))
@@ -292,9 +368,14 @@ the modules, and DEPENDENCIES, a list of packages depended on.  COMMAND is the
 
                        (let ((modules (string-append #$output
                                                      "/share/guile/site/"
-                                                     (effective-version))))
+                                                     (effective-version)))
+                             (info    #$info))
                          (mkdir-p (dirname modules))
-                         (symlink #$modules modules))))))
+                         (symlink #$modules modules)
+                         (when info
+                           (symlink #$info
+                                    (string-append #$output
+                                                   "/share/info"))))))))
 
 (define* (compiled-guix source #:key (version %guix-version)
                         (pull-version 1)
@@ -477,6 +558,7 @@ the modules, and DEPENDENCIES, a list of packages depended on.  COMMAND is the
                                       #:guile-version guile-version)))
            (whole-package name built-modules dependencies
                           #:command command
+                          #:info (info-manual source)
                           #:guile-version guile-version)))
         ((= 0 pull-version)
          ;; Legacy 'guix pull': just return the compiled modules.
-- 
2.17.0