suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

simple navigation for HTML output

Browse Source 
svn: r6254

original commit: 8ab6ad2c9cb30395bc85423ebe943f7e36166e9f
This commit is contained in:
Matthew Flatt 2007-05-24 06:03:29 +00:00
parent a2bc335965
commit 74516bd363
2 changed files with 76 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/scribble/html-render.ss
View File

@ -42,16 +42,20 @@
fns) fns)
ht)) ht))
(define/public (part-whole-page? d)
#f)
(define/override (collect-part-tag d ht) (define/override (collect-part-tag d ht)
(hash-table-put! ht (hash-table-put! ht
`(part ,(part-tag d)) `(part ,(part-tag d))
(list (current-output-file) (list (current-output-file)
(part-title-content d)))) (part-title-content d)
(part-whole-page? d))))
(define/override (collect-target-element i ht) (define/override (collect-target-element i ht)
(hash-table-put! ht (hash-table-put! ht
(target-element-tag i) (target-element-tag i)
(list (current-output-file) #f))) (list (current-output-file) #f #f)))
;; ---------------------------------------- ;; ----------------------------------------
@ -129,10 +133,15 @@
[(link-element? e) [(link-element? e)
(let ([dest (hash-table-get ht (link-element-tag e) #f)]) (let ([dest (hash-table-get ht (link-element-tag e) #f)])
(if dest (if dest
`((a ((href ,(format "~a#~a" `((a ((href ,(format "~a~a~a"
(from-root (car dest) (from-root (car dest)
(get-dest-directory)) (get-dest-directory))
(link-element-tag e))) (if (caddr dest)
""
"#")
(if (caddr dest)
""
(link-element-tag e))))
,@(if (string? (element-style e)) ,@(if (string? (element-style e))
`((class ,(element-style e))) `((class ,(element-style e)))
null)) null))
@ -170,6 +179,7 @@
`((table ((cellspacing "0") ,@(case (table-style t) `((table ((cellspacing "0") ,@(case (table-style t)
[(boxed) '((width "100%") (bgcolor "lightgray"))] [(boxed) '((width "100%") (bgcolor "lightgray"))]
[(centered) '((align "center"))] [(centered) '((align "center"))]
[(at-right) '((align "right"))]
[else null])) [else null]))
,@(map (lambda (flows) ,@(map (lambda (flows)
`(tr ,@(map (lambda (d a) `(tr ,@(map (lambda (d a)
@ -229,6 +239,9 @@
(build-path fn "index.html")) (build-path fn "index.html"))
fns))) fns)))
(define/override (part-whole-page? d)
(= 2 (collecting-sub)))
(define/override (collect-part d parent ht number) (define/override (collect-part d parent ht number)
(let ([prev-sub (collecting-sub)]) (let ([prev-sub (collecting-sub)])
(parameterize ([collecting-sub (add1 prev-sub)]) (parameterize ([collecting-sub (add1 prev-sub)])
@ -253,6 +266,56 @@
ds ds
fns)) fns))
(define prev-content '(larr " prev"))
(define up-content '("up"))
(define next-content '("next " rarr))
(define no-next-content next-content)
(define sep-element (make-element #f '(nbsp nbsp)))
(inherit render-table)
(define/private (navigation d ht)
(let ([parent (collected-info-parent (part-collected-info d))])
(let-values ([(prev next)
(let loop ([l (if parent
(part-parts parent)
(if (null? (part-parts d))
(list d)
(list d (car (part-parts d)))))]
[prev #f])
(cond
[(eq? (car l) d) (values prev (and (pair? (cdr l))
(cadr l)))]
[else (loop (cdr l) (car l))]))])
(render-table (make-table
'at-right
(list
(list
(make-flow
(list
(make-paragraph
(list
(if parent
(make-element
(make-target-url (if prev
(derive-filename prev)
"index.html"))
prev-content)
"")
sep-element
(if parent
(make-element
(make-target-url "index.html")
up-content)
"")
sep-element
(make-element
(and next
(make-target-url (derive-filename next)))
next-content))))))))
d
ht))))
(define/override (render-part d ht) (define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d))]) (let ([number (collected-info-number (part-collected-info d))])
(cond (cond
@ -268,14 +331,15 @@
(lambda () (lambda ()
(render-one-part d ht full-path number)) (render-one-part d ht full-path number))
'truncate/replace) 'truncate/replace)
null null))]
#;
`((table
((width "90%") (cellspacing "0") (align "center"))
,@(render-toc-entry d filename ht number)))))]
[else [else
;; Normal section render (if ((length number) . <= . 1)
(super render-part d ht)]))) ;; Navigation bars;
`(,@(navigation d ht)
,@(super render-part d ht)
,@(navigation d ht))
;; Normal section render
(super render-part d ht))])))
(super-new))) (super-new)))

2
collects/scribble/manual.ss
View File

@ -112,7 +112,7 @@
(define/kw (exec #:body str) (define/kw (exec #:body str)
(make-element 'tt (decode-content str))) (make-element 'tt (decode-content str)))
(define/kw (procedure #:body str) (define/kw (procedure #:body str)
(make-element 'tt (append (list "#<procedure:") (decode-content str) (list ">")))) (make-element "schemeresult" (append (list "#<procedure:") (decode-content str) (list ">"))))
(define/kw (link url #:body str) (define/kw (link url #:body str)
(make-element (make-target-url url) (decode-content str))) (make-element (make-target-url url) (decode-content str)))