Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

specify encoding meta for docs, include doctype

Browse source
This commit is contained in:
Alex Shinn 2020-09-02 15:52:20 +09:00
parent 8597c3eda5
commit d0bd93822e
2 changed files with 61 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
lib/chibi/doc.scm
View file

@ -483,11 +483,13 @@
(lp (cdr ls) (caar ls) (cadr (car ls)) '() (collect)))))))
(define (fix-header x)
`(html (head ,@(cond ((assq 'title x) => (lambda (x) (list x)))
(else '()))
"\n"
(style (@ (type . "text/css"))
"
`((!DOCTYPE html)
(html (head ,@(cond ((assq 'title x) => (lambda (x) (list x)))
(else '()))
"\n"
(meta (@ (charset . "UTF-8")))
(style (@ (type . "text/css"))
"
body {color: #000; background-color: #FFFFF8;}
div#menu {font-size: smaller; position: absolute; top: 50px; left: 0; width: 250px; height: 100%}
div#menu a:link {text-decoration: none}
@ -505,23 +507,23 @@ h4 { color: #222288; border-top: 1px solid #4588ba; }
.error { color: #000; background-color: #F0B0B0; width: 100%; padding: 3px}
.command { color: #000; background-color: #FFEADF; width: 100%; padding: 5px}
"
,(highlight-style))
"\n")
(body
(div (@ (id . "menu"))
,(let ((contents (get-contents (extract-contents x))))
(match contents
;; flatten if we have only a single heading
(('ol (li y sections ...))
sections)
(else contents))))
(div (@ (id . "main"))
,@(map (lambda (x)
(if (and (pair? x) (eq? 'title (car x)))
(cons 'h1 (cdr x))
x))
x)
(div (@ (id . "footer")))))))
,(highlight-style))
"\n")
(body
(div (@ (id . "menu"))
,(let ((contents (get-contents (extract-contents x))))
(match contents
;; flatten if we have only a single heading
(('ol (li y sections ...))
sections)
(else contents))))
(div (@ (id . "main"))
,@(map (lambda (x)
(if (and (pair? x) (eq? 'title (car x)))
(cons 'h1 (cdr x))
x))
x)
(div (@ (id . "footer"))))))))
(define (fix-paragraphs x)
(let lp ((ls x) (p '()) (res '()))

57
lib/chibi/sxml.scm
View file

@ -52,6 +52,9 @@
(apply string-append (reverse (cons ">" res)))
(lp (cdr ls) (cons (html-attr->string (car ls)) (cons " " res))))))
(define void-elements
'(area base br col embed hr img input keygen link meta param source track wbr))
(define (html-display-escaped-string x . o)
(let* ((str (display-to-string x))
(start 0)
@ -81,27 +84,39 @@
;;> \var{@raw} tag is considered safe text and not processed or escaped.
(define (sxml-display-as-html sxml . o)
(let ((out (if (pair? o) (car o) (current-output-port))))
(let lp ((sxml sxml))
(let lp ((sxml (if (and (pair? sxml) (eq? '*TOP* (car sxml)))
(cdr sxml)
sxml)))
(cond
((pair? sxml)
(let ((tag (car sxml)))
(if (symbol? tag)
(let ((rest (cdr sxml)))
(cond
((and (pair? rest)
(pair? (car rest))
(eq? '@ (caar rest)))
(display (html-tag->string tag (cdar rest)) out)
(for-each lp (cdr rest))
(display "</" out) (display tag out) (display ">" out))
((and (eq? '@raw tag)
(string? (car rest)))
(display (car rest) out))
(else
(display (html-tag->string tag '()) out)
(for-each lp rest)
(display "</" out) (display tag out) (display ">" out))))
(for-each lp sxml))))
(let ((tag (car sxml))
(rest (cdr sxml)))
(cond
((symbol? tag)
(cond
((eqv? #\! (string-ref (symbol->string tag) 0))
(display "<" out) (display tag out)
(for-each (lambda (x) (display " " out) (display x out)) rest)
(display ">\n" out))
((and (eq? '@raw tag)
(string? (car rest)))
(if (not (null? (cdr rest)))
(error "@raw takes only one value" sxml))
(display (car rest) out))
((and (pair? rest)
(pair? (car rest))
(eq? '@ (caar rest)))
(display (html-tag->string tag (cdar rest)) out)
(for-each lp (cdr rest))
(unless (and (null? (cdr rest)) (memq tag void-elements))
(display "</" out) (display tag out) (display ">" out)))
(else
(display (html-tag->string tag '()) out)
(for-each lp rest)
(unless (and (null? rest) (memq tag void-elements))
(display "</" out) (display tag out) (display ">" out)))))
(else
(for-each lp sxml)))))
((null? sxml))
(else (html-display-escaped-string sxml out))))))
@ -127,7 +142,9 @@
;;> Render \var{sxml} as text for viewing in a terminal.
(define (sxml-display-as-text sxml . o)
(let ((out (if (pair? o) (car o) (current-output-port))))
(let lp ((sxml sxml))
(let lp ((sxml (if (and (pair? sxml) (eq? '*TOP* (car sxml)))
(cdr sxml)
sxml)))
(cond
((pair? sxml)
(let ((tag (car sxml)))