From 6c8bf386ec6647d247231fb0ef9acba0b97a85e5 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 31 Aug 2020 17:28:12 +0900 Subject: [PATCH] fixing multi-level menu nesting plus some doc css tweaks --- lib/chibi/doc.scm | 56 ++++++++++++++++++++++++++++------------------- tools/chibi-doc | 16 ++++++++------ 2 files changed, 42 insertions(+), 30 deletions(-) diff --git a/lib/chibi/doc.scm b/lib/chibi/doc.scm index ca6a13fd..be2050cc 100644 --- a/lib/chibi/doc.scm +++ b/lib/chibi/doc.scm @@ -177,9 +177,11 @@ (define (print-module-docs mod-name . o) (let ((out (if (pair? o) (car o) (current-output-port))) (render (or (and (pair? o) (pair? (cdr o)) (cadr o)) - sxml-display-as-text))) + sxml-display-as-text)) + (unexpanded? + (and (pair? o) (pair? (cdr o)) (pair? (cddr o)) (car (cddr o))))) (render - (generate-docs + ((if unexpanded? (lambda (sxml env) (fixup-docs sxml)) generate-docs) `((title ,(write-to-string mod-name)) ,@(extract-module-docs mod-name #f)) (make-module-doc-env mod-name)) @@ -425,7 +427,7 @@ sxml))) (define (expand-procedure sxml env) - ((expand-section 'h3) `(,(car sxml) (rawcode ,@(cdr sxml))) env)) + ((expand-section 'h4) `(,(car sxml) (rawcode ,@(cdr sxml))) env)) (define (expand-macro sxml env) (expand-procedure sxml env)) @@ -464,18 +466,21 @@ (define (get-contents x) (if (null? x) '() - (let ((d (caar x))) - (let lp ((ls (cdr x)) (parent (car (cdar x))) (kids '()) (res '())) - (define (collect) - (cons `(li ,parent ,(get-contents (reverse kids))) res)) - ;; take a span of all sub-headers, recurse and repeat on next span - (cond - ((null? ls) - `(ol ,@(reverse (collect)))) - ((> (caar ls) d) - (lp (cdr ls) parent (cons (car ls) kids) res)) - (else - (lp (cdr ls) (car (cdar ls)) '() (collect)))))))) + (let lp ((ls (cdr x)) + (depth (caar x)) + (parent (cadr (car x))) + (kids '()) + (res '())) + (define (collect) + (cons `(li ,parent ,(get-contents (reverse kids))) res)) + ;; take a span of all sub-headers, recurse and repeat on next span + (cond + ((null? ls) + `(ol ,@(reverse (collect)))) + ((> (caar ls) depth) + (lp (cdr ls) depth parent (cons (car ls) kids) res)) + (else + (lp (cdr ls) (caar ls) (cadr (car ls)) '() (collect))))))) (define (fix-header x) `(html (head ,@(cond ((assq 'title x) => (lambda (x) (list x))) @@ -484,10 +489,14 @@ (style (@ (type . "text/css")) " body {color: #000; background-color: #FFF} -div#menu {font-size: smaller; position: absolute; top: 50px; left: 0; width: 190px; height: 100%} -div#main {position: absolute; top: 0; left: 200px; width: 540px; height: 100%} -div#notes {position: relative; top: 2em; left: 570px; max-width: 200px; height: 0px; font-size: smaller;} +div#menu {font-size: smaller; position: absolute; top: 50px; left: 0; width: 250px; height: 100%} +div#menu a:link {text-decoration: none} +div#main {font-size: large; position: absolute; top: 0; left: 260px; width: 590px; height: 100%} +div#notes {position: relative; top: 2em; left: 620px; max-width: 200px; height: 0px; font-size: smaller;} div#footer {padding-bottom: 50px} +div#menu ol {list-style-position:inside; padding-left: 5px; margin-left: 5px} +div#menu ol ol {list-style: lower-alpha; padding-left: 15px; margin-left: 15px} +div#menu ol ol ol {list-style: decimal; padding-left: 5px; margin-left: 5px} .result { color: #000; background-color: #FFEADF; width: 100%; padding: 3px} .output { color: #000; background-color: beige; width: 100%; padding: 3px} .error { color: #000; background-color: #F0B0B0; width: 100%; padding: 3px} @@ -735,7 +744,7 @@ div#footer {padding-bottom: 50px} (let ((sections '(section subsection subsubsection subsubsubsection))) (lambda (x) (cond ((memq x sections) => length) - ((memq x '(procedure macro)) (section-number 'subsection)) + ((memq x '(procedure macro)) (section-number 'subsubsection)) (else 0))))) (define (section>=? x n) @@ -806,15 +815,16 @@ div#footer {padding-bottom: 50px} (let lp ((ls orig-ls) (rev-pre '())) (cond ((or (null? ls) - (section>=? (car ls) (section-number 'subsection))) + (section>=? (car ls) (section-number 'subsubsection))) `(,@(reverse rev-pre) ,@(if (and (pair? ls) (section-describes? - (extract-sxml '(subsection procedure macro) - (car ls)) + (extract-sxml + '(subsubsection procedure macro) + (car ls)) name)) '() - `((subsection + `((subsubsection tag: ,(write-to-string name) (rawcode ,@(if (and (pair? (car sig)) (eq? 'const: (caar sig))) diff --git a/tools/chibi-doc b/tools/chibi-doc index b50d5791..b3a4dd66 100755 --- a/tools/chibi-doc +++ b/tools/chibi-doc @@ -28,7 +28,7 @@ (string-split str #\.))) ;; main -(define (run args render) +(define (run args render unexpanded?) (case (length args) ((0) (convert-scribble render (current-input-port))) @@ -43,7 +43,7 @@ (else ;; load the module so that examples work (let ((mod-name (split-module-name name))) - (print-module-docs mod-name (current-output-port) render)))))) + (print-module-docs mod-name (current-output-port) render unexpanded?)))))) ((2) (let* ((name (car args)) (var (cadr args)) @@ -55,16 +55,18 @@ ;; parse the command-line (let lp ((args (cdr (command-line))) - (render sxml-display-as-text)) + (render sxml-display-as-text) + (unexpanded? #f)) (cond ((and (pair? args) (not (equal? "" (car args))) (eqv? #\- (string-ref (car args) 0))) (case (string->symbol (substring (car args) 1)) - ((h -html) (lp (cdr args) sxml-display-as-html)) - ((s -sxml) (lp (cdr args) write)) - ((t -text) (lp (cdr args) sxml-display-as-text)) + ((h -html) (lp (cdr args) sxml-display-as-html #f)) + ((s -sxml) (lp (cdr args) write #f)) + ((r -raw) (lp (cdr args) write #t)) + ((t -text) (lp (cdr args) sxml-display-as-text #f)) ((-) (run (cdr args) render)) (else (die "unknown option: " (car args))))) (else - (run args render))) + (run args render unexpanded?))) (newline))