diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-05-07 15:02:22 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-07 15:02:22 +0200 |
commit | ac542b079a1aeae51c19b847ec5af6a1fcc9e388 (patch) | |
tree | 5a7e3df610deb5503ae788963e86e2bc424a3fe9 | |
parent | 75cdb3856b7e34f9c22f41f9c5653acfe96e1dc3 (diff) | |
download | guix-artwork-ac542b079a1aeae51c19b847ec5af6a1fcc9e388.tar guix-artwork-ac542b079a1aeae51c19b847ec5af6a1fcc9e388.tar.gz |
website: Add export procedure.
-rw-r--r-- | website/www.scm | 52 |
1 files changed, 51 insertions, 1 deletions
diff --git a/website/www.scm b/website/www.scm index c283ccd..38a0d0d 100644 --- a/website/www.scm +++ b/website/www.scm @@ -1,5 +1,17 @@ (define-module (www) - #:export (main-page)) + #:use-module (www packages) + #:use-module (www download) + #:use-module (www donate) + #:use-module (www about) + #:use-module (www contribute) + #:use-module (www help) + #:use-module (sxml simple) + #:use-module (ice-9 match) + #:export (main-page + + %web-pages + export-web-page + export-web-site)) (define main-page '(html (@ (lange "en")) @@ -277,3 +289,41 @@ lists"))))) ". Made with " (span (@ (class "metta")) "♥") " by humans.")))) + + +;;; +;;; HTML export. +;;; + +(define %web-pages + ;; Mapping of web pages to HTML file names. + `(("index.html" ,main-page) + ("about/index.html" ,about-page) + ("contribute/index.html" ,contribute-page) + ("donate/index.html" ,donate-page) + ("download/index.html" ,download-page) + ("help/index.html" ,help-page) + ("packages/index.html" ,packages-page))) + +(define (mkdir* directory) + "Make DIRECTORY unless it already exists." + (catch 'system-error + (lambda () + (mkdir directory)) + (lambda args + (unless (= EEXIST (system-error-errno args)) + (apply throw args))))) + +(define (export-web-page page file) + "Export PAGE, an SXML tree, to FILE." + (mkdir* (dirname file)) + (call-with-output-file file + (lambda (port) + (sxml->xml page port)))) + +(define (export-web-site) + "Export the whole web site as HTML files created in the current directory." + (for-each (match-lambda + ((file page) + (export-web-page page file))) + %web-pages)) |