diff options
| author | Pjotr Prins | 2023-08-10 08:06:48 +0200 |
|---|---|---|
| committer | Pjotr Prins | 2023-08-10 08:06:48 +0200 |
| commit | a9062989c2c7f54258b7fb4d399129f1d2453d1f (patch) | |
| tree | 88d5d62c0dda815dc487ebefdc6018fb60766c97 /web | |
| parent | 34ccdfe012cf11775ad3771e12e649aeabfae3ad (diff) | |
| download | gn-guile-a9062989c2c7f54258b7fb4d399129f1d2453d1f.tar.gz | |
HTML viewing
Diffstat (limited to 'web')
| -rw-r--r-- | web/view/doc.scm | 21 | ||||
| -rwxr-xr-x | web/webserver.scm | 2 |
2 files changed, 13 insertions, 10 deletions
diff --git a/web/view/doc.scm b/web/view/doc.scm index c934a2a..1125147 100644 --- a/web/view/doc.scm +++ b/web/view/doc.scm @@ -5,16 +5,17 @@ #:use-module (ice-9 iconv) #:use-module (ice-9 receive) #:use-module (ice-9 string-fun) - ; #:use-module (sxml simple) + #:use-module (sxml simple) #:use-module (web sxml) - #:export (view-doc)) +(define (parse-html buf) + (car (cdr (xml->sxml buf)))) (define* (layout #:key (head '()) (body '()) - (title "Guix issue tracker")) + (title "GeneNetwork.org API")) `((doctype "html") (html (@ (lang "en")) (head @@ -29,13 +30,15 @@ (type "text/css") (href "./css/gn-doc.css"))) ,@head) - (body (h1 page) + (body (h1 ,body) + ; ,body + ; (p ,(parse-html "<b>some raw really <i>text</i> here</b>")) (footer - (p "Copyright © 2005—2023 by the GeneNetwork community with " (span (@ (class "lambda")) "λ") "!") - (p "This is free software. Download the " - (a (@ (href "https://ci.genenetwork.org/")) - "source code") ".")) + (p "Copyright © 2005—2023 by the GeneNetwork community with a touch of " (span (@ (class "lambda")) "λ") "!") + (p "This is free software. Download the " + (a (@ (href "https://ci.genenetwork.org/")) + "source code") ".")) )))) (define (view-doc path page) - (layout)) + (layout #:body page)) diff --git a/web/webserver.scm b/web/webserver.scm index d6f78fe..2619319 100755 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -203,7 +203,7 @@ (list (append extra-headers '((content-type . (text/html)))) (lambda (port) - (sxml->html (view-doc path page) port)))) + (sxml->html (view-doc (pk path) (pk page)) port)))) (define (render-json json) (list '((content-type . (application/json))) |