diff --git a/doc/build.scm b/doc/build.scm index 2bc73f915e..1fa5270771 100644 --- a/doc/build.scm +++ b/doc/build.scm @@ -187,6 +187,10 @@ a list of extra files, such as '(\"contributing\")." %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." @@ -736,6 +740,7 @@ its
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)) @@ -784,6 +789,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")) @@ -830,7 +843,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? @@ -853,9 +901,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 "/static/base/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?) @@ -867,13 +922,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)) @@ -881,6 +936,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")) @@ -891,7 +955,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)))