[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/05: doc: Add a language menu in the HTML manual.
|
From: |
guix-commits |
|
Subject: |
02/05: doc: Add a language menu in the HTML manual. |
|
Date: |
Tue, 18 Jan 2022 16:52:14 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 7eb883b7c284c78cc17093bfc4ef2d70e0acad83
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Jan 18 22:20:12 2022 +0100
doc: Add a language menu in the HTML manual.
* doc/build.scm (stylized-html): New procedure.
(html-manual): Use it.
---
doc/build.scm | 156 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 153 insertions(+), 3 deletions(-)
diff --git a/doc/build.scm b/doc/build.scm
index 1057336c65..44c185e5f9 100644
--- a/doc/build.scm
+++ b/doc/build.scm
@@ -600,6 +600,154 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo
--html')."
(computed-file name build))
+(define* (stylized-html source input
+ #:key
+ (languages %languages)
+ (manual %manual)
+ (manual-css-url "/static/base/css/manual.css"))
+ "Process all the HTML files in INPUT; add them MANUAL-CSS-URL as a <style>
+link, and add a menu to choose among LANGUAGES. Use the Guix PO files found
+in SOURCE."
+ (define build
+ (with-extensions (list guile-lib)
+ (with-imported-modules `((guix build utils)
+ ((localization)
+ => ,(localization-helper-module
+ source languages)))
+ #~(begin
+ (use-modules (htmlprag)
+ (localization)
+ (guix build utils)
+ (srfi srfi-1)
+ (ice-9 match)
+ (ice-9 threads))
+
+ (define* (menu-dropdown #:key (label "Item") (url "#") (items '()))
+ ;; Return an SHTML <li> element representing a dropdown for the
+ ;; navbar. LABEL is the text of the dropdown menu, and ITEMS is
+ ;; the list of items in this menu.
+ (define id "visible-dropdown")
+
+ `(li
+ (@ (class "navbar-menu-item dropdown dropdown-btn"))
+ (input (@ (class "navbar-menu-hidden-input")
+ (type "radio")
+ (name "dropdown")
+ (id ,id)))
+ (label (@ (for ,id)) ,label)
+ (label (@ (for "all-dropdowns-hidden")) ,label)
+ (div
+ (@ (class "navbar-submenu")
+ (id "navbar-submenu"))
+ (div (@ (class "navbar-submenu-triangle"))
+ " ")
+ (ul ,@items))))
+
+ (define (menu-item label url)
+ ;; Return an SHTML <li> element for a menu item with the given
+ ;; LABEL and URL.
+ `(li (a (@ (class "navbar-menu-item")
+ (href ,url))
+ ,label)))
+
+ (define* (base-language-url code manual
+ #:key split-node?)
+ ;; Return the base URL of MANUAL for language CODE.
+ (if split-node?
+ (string-append "../../" code "/html_node")
+ (string-append "../" code "/" manual
+ (if (string=? code "en")
+ ""
+ (string-append "." code))
+ ".html")))
+
+ (define (language-menu-items file)
+ ;; Return the language menu items to be inserted in FILE.
+ (define split-node?
+ (string-contains file "/html_node/"))
+
+ (append
+ (map (lambda (code)
+ (menu-item (language-code->native-name code)
+ (base-language-url code #$manual
+ #:split-node?
+ split-node?)))
+ '#$%languages)
+ (list
+ (menu-item "⊕"
+ (if (string=? #$manual "guix-cookbook")
+
"https://translate.fedoraproject.org/projects/guix/documentation-cookbook/";
+
"https://translate.fedoraproject.org/projects/guix/documentation-manual/";)))))
+
+ (define (stylized-html sxml file)
+ ;; Return SXML, which was read from FILE, with additional
+ ;; styling.
+ (let loop ((sxml sxml))
+ (match sxml
+ (('*TOP* decl body ...)
+ `(*TOP* ,decl ,@(map loop body)))
+ (('head elements ...)
+ ;; Add reference to our own manual CSS, which provides
+ ;; support for the language menu.
+ `(head ,@elements
+ (link (@ (rel "stylesheet")
+ (type "text/css")
+ (href #$manual-css-url)))))
+ (('body ('@ attributes ...) elements ...)
+ `(body (@ ,@attributes)
+ (nav (@ (class "navbar-menu"))
+ (ul
+ ;; TODO: Add "Contribute" menu, to report
+ ;; errors, etc.
+ ,(menu-dropdown #:label
+ `(img (@ (alt "Language")
+ (src
"/static/base/img/language-picker.svg")))
+ #:items
+ (language-menu-items file))))
+ ,@elements))
+ ((tag ('@ attributes ...) body ...)
+ `(,tag (@ ,@attributes) ,@(map loop body)))
+ ((tag body ...)
+ `(,tag ,@(map loop body)))
+ ((? string? str)
+ str))))
+
+ (define (process-html file)
+ ;; 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))
+ (base (string-drop file (string-length #$input)))
+ (target (string-append #$output base)))
+ (mkdir-p (dirname target))
+ (call-with-output-file target
+ (lambda (port)
+ (write-shtml-as-html processed port)))))
+
+ ;; Install a UTF-8 locale so we can process UTF-8 files.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales "/lib/locale"))
+ (setlocale LC_ALL "en_US.utf8")
+ (setenv "LC_ALL" "en_US.utf8")
+ (setvbuf (current-error-port) 'line)
+
+ (n-par-for-each (parallel-job-count)
+ (lambda (file)
+ (if (string-suffix? ".html" file)
+ (process-html file)
+ ;; Copy FILE as is to #$output.
+ (let* ((base (string-drop file
(string-length #$input)))
+ (target (string-append #$output
base)))
+ (mkdir-p (dirname target))
+ (if (eq? 'symlink (stat:type (lstat file)))
+ (symlink (readlink file) target)
+ (copy-file file target)))))
+ (find-files #$input))))))
+
+ (computed-file "stylized-html-manual" build))
+
(define* (html-manual source #:key (languages %languages)
(version "0.0")
(manual %manual)
@@ -690,9 +838,11 @@ makeinfo OPTIONS."
(filter (compose file-exists? language->texi-file-name)
'#$languages)))))
- (let* ((name (string-append manual "-html-manual"))
- (manual (computed-file name build #:local-build? #f)))
- (syntax-highlighted-html manual
+ (let* ((name (string-append manual "-html-manual"))
+ (manual* (computed-file name build #:local-build? #f)))
+ (syntax-highlighted-html (stylized-html source manual*
+ #:languages languages
+ #:manual manual)
#:mono-node-indexes mono-node-indexes
#:split-node-indexes split-node-indexes
#:name (string-append name "-highlighted"))))