doc: Add links to versions and variants as a drop-down menu.

* doc/build.scm (%latest-guix-version): New variable.
(stylized-html): Add #:latest-version.
[build](menu-item-separator): New variable.
(version-menu-items, input-file-language): New procedures.
(stylized-html, process-html): Add ‘language’ parameter.  Update
callers.

Change-Id: If7cea2410802eec5af1d3c0407d5569250eb15ef

1 files changed, 71 insertions, 6 deletions

diff --git a/doc/build.scm b/doc/build.scm
index a745b4c25b..1ecc9aac3e 100644
--- a/doc/build.scm
+++ b/doc/build.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019-2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2025 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
@@ -78,6 +78,10 @@
       %cookbook-languages
       %manual-languages))
 
+(define %latest-guix-version
+  ;; Latest released version.
+  "1.4.0")
+
 (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."
@@ -627,6 +631,7 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo --html')."
 
 (define* (stylized-html source input
                         #:key
+                        (latest-version %latest-guix-version)
                         (languages %languages)
                         (manual %manual)
                         (manual-css-url %manual-css-url))
@@ -675,6 +680,14 @@ in SOURCE."
 	                 (href ,url))
                       ,label)))
 
+            (define menu-item-separator
+              ;; Thin horizontal line to separate drop-down menu items.
+              `(img (@ (class "hline")
+                       (src ,(in-vicinity
+                              #$%web-site-url
+                              "themes/initial/img/h-separator.png"))
+                       (alt ""))))
+
             (define* (navigation-bar menus #:key split-node?)
               ;; Return the navigation bar showing all of MENUS.
               `(header (@ (class "navbar"))
@@ -721,7 +734,42 @@ in SOURCE."
                                   "https://translate.fedoraproject.org/projects/guix/documentation-cookbook/"
                                   "https://translate.fedoraproject.org/projects/guix/documentation-manual/")))))
 
-            (define (stylized-html sxml file)
+            (define (version-menu-items language split-node?)
+              ;; Return the menu items to select the version of the manual of
+              ;; the type of medium (PDF, split-node, etc.).
+              (define language-extension
+                (if (string=? language "en")
+                    ""
+                    (string-append "." language)))
+
+              (define pdf-link
+                (string-append (if split-node? "../" "")
+                               #$manual language-extension ".pdf"))
+
+              (define version-links
+                (list (menu-item #$latest-version
+                                 (string-append
+                                  "/manual/" language
+                                  (if split-node? "/html_node" "")))
+                      (menu-item "development"
+                                 (string-append
+                                  "/manual/devel/" language
+                                  (if split-node? "/html_node" "")))
+                      menu-item-separator))
+
+              (append (if (string=? #$manual "guix")
+                          version-links
+                          '())
+                      (list (if split-node?
+                                (menu-item "single page"
+                                           (string-append "../" #$manual
+                                                          language-extension
+                                                          ".html"))
+                                (menu-item "multiple pages"
+                                           "html_node"))
+                            (menu-item "PDF" pdf-link))))
+
+            (define (stylized-html sxml file language)
               ;; Return SXML, which was read from FILE, with additional
               ;; styling.
               (define split-node?
@@ -744,9 +792,16 @@ in SOURCE."
                             ;; TODO: Add "Contribute" menu, to report
                             ;; errors, etc.
                             (list (menu-dropdown
+                                   #:label "Version"
+                                   #:items
+                                   (version-menu-items language
+                                                       split-node?))
+                                  (menu-dropdown
                                    #:label
                                    `(img (@ (alt "Language")
-                                            (src "/themes/initial/img/language-picker.svg")))
+                                            (src #$(string-append
+                                                    %web-site-url
+                                                    "/themes/initial/img/language-picker.svg"))))
                                    #:items
                                    (language-menu-items file)))
                             #:split-node? split-node?)
@@ -758,13 +813,13 @@ in SOURCE."
                   ((? string? str)
                    str))))
 
-            (define (process-html file)
+            (define (process-html file language)
               ;; Parse FILE and add links to translations.  Install the result
               ;; to #$output.
               (format (current-error-port) "processing ~a...~%" file)
               (let* ((shtml        (parameterize ((%strict-tokenizer? #t))
                                      (call-with-input-file file html->shtml)))
-                     (processed    (stylized-html shtml file))
+                     (processed    (stylized-html shtml file language))
                      (base         (string-drop file (string-length #$input)))
                      (target       (string-append #$output base)))
                 (mkdir-p (dirname target))
@@ -772,6 +827,15 @@ in SOURCE."
                   (lambda (port)
                     (write-shtml-as-html processed port)))))
 
+            (define (input-file-language file)
+              ;; Return the language code of FILE, an input file, as a string
+              ;; like "sv" or "zh-cn".
+              (match (string-tokenize (string-drop file
+                                                   (string-length #$input))
+                                      (char-set-complement
+                                       (char-set #\/)))
+                ((language _ ...) language)))
+
             ;; Install a UTF-8 locale so we can process UTF-8 files.
             (setenv "GUIX_LOCPATH"
                     #+(file-append glibc-utf8-locales "/lib/locale"))
@@ -782,7 +846,8 @@ in SOURCE."
             (n-par-for-each (parallel-job-count)
                             (lambda (file)
                               (if (string-suffix? ".html" file)
-                                  (process-html file)
+                                  (let ((language (input-file-language file)))
+                                    (process-html file language))
                                   ;; Copy FILE as is to #$output.
                                   (let* ((base   (string-drop file (string-length #$input)))
                                          (target (string-append #$output base)))