suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

* Made it possible to pass 'inline for css-path to have the css

Browse Source 
inlined in the result
* Make it possible to use #f for dest-file in one more place, aiming
  to make it possible to render search results directly into a string.

svn: r8573

original commit: 52854f54bb9588c97159ed5466cd8aad8618e4bd
This commit is contained in:
Eli Barzilay 2008-02-07 21:00:14 +00:00
parent 84271feef5
commit 1b2c9f88dd
1 changed files with 56 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -211,16 +211,14 @@
(eq? d (current-top-part))) (eq? d (current-top-part)))
(define/override (collect-part-tags d ci number) (define/override (collect-part-tags d ci number)
(for-each (lambda (t) (for ([t (part-tags d)])
(let ([key (generate-tag t ci)]) (let ([key (generate-tag t ci)])
(collect-put! ci (collect-put! ci key
key (vector (and (current-output-file)
(vector (path->relative (current-output-file)) (path->relative (current-output-file)))
(or (part-title-content d) (or (part-title-content d) '("???"))
'("???")) (current-part-whole-page? d)
(current-part-whole-page? d) key)))))
key))))
(part-tags d)))
(define/override (collect-target-element i ci) (define/override (collect-target-element i ci)
(let ([key (generate-tag (target-element-tag i) ci)]) (let ([key (generate-tag (target-element-tag i) ci)])
@ -448,24 +446,34 @@
(define/public (render-one-part d ri fn number) (define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn]) (parameterize ([current-output-file fn])
(let ([xpr `(html () (let ([xpr `(html ()
(head (head
(meta ((http-equiv "content-type") (meta ((http-equiv "content-type")
(content "text-html; charset=utf-8"))) (content "text-html; charset=utf-8")))
,@(let ([c (part-title-content d)]) ,@(let ([c (part-title-content d)])
(if c (if c
`((title ,@(format-number number '(nbsp)) ,(content->string c this d ri))) `((title ,@(format-number number '(nbsp))
null)) ,(content->string c this d ri)))
(link ((rel "stylesheet") null))
,(if (eq? 'inline css-path)
`(style ([type "text/css"])
"\n"
,(with-input-from-file scribble-css
(lambda ()
;; note: file-size can be bigger that the
;; string, but that's fine.
(read-string (file-size scribble-css))))
"\n")
`(link ((rel "stylesheet")
(type "text/css") (type "text/css")
(href ,(or css-path "scribble.css")) (href ,(or css-path "scribble.css"))
(title "default")))) (title "default")))))
(body ,@(render-toc-view d ri) (body ,@(render-toc-view d ri)
(div ((class "maincolumn")) (div ((class "maincolumn"))
(div ((class "main")) (div ((class "main"))
,@(render-version d ri) ,@(render-version d ri)
,@(navigation d ri #f) ,@(navigation d ri #f)
,@(render-part d ri) ,@(render-part d ri)
,@(navigation d ri #t)))))]) ,@(navigation d ri #t)))))])
(unless css-path (unless css-path
(install-file scribble-css)) (install-file scribble-css))
(printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n") (printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n")
@ -978,33 +986,27 @@
;; utils ;; utils
(define (from-root p d) (define (from-root p d)
(if d (if (not d)
(let ([e-d (explode (path->complete-path d (current-directory)))] p
[e-p (explode (path->complete-path p (current-directory)))]) (let ([e-d (explode (path->complete-path d (current-directory)))]
(let loop ([e-d e-d] [e-p (explode (path->complete-path p (current-directory)))])
[e-p e-p]) (let loop ([e-d e-d]
(cond [e-p e-p])
[(null? e-d) (let loop ([e-p e-p]) (cond
(cond [(null? e-d)
[(null? e-p) "/"] (let loop ([e-p e-p])
[(null? (cdr e-p)) (car e-p)] (cond
[(eq? 'same (car e-p)) (loop (cdr e-p))] [(null? e-p) "/"]
[(eq? 'up (car e-p)) [(null? (cdr e-p)) (car e-p)]
(string-append "../" (loop (cdr e-p)))] [(eq? 'same (car e-p)) (loop (cdr e-p))]
[else (string-append (car e-p) [(eq? 'up (car e-p)) (string-append "../" (loop (cdr e-p)))]
"/" [else (string-append (car e-p) "/" (loop (cdr e-p)))]))]
(loop (cdr e-p)))]))] [(equal? (car e-d) (car e-p)) (loop (cdr e-d) (cdr e-p))]
[(equal? (car e-d) (car e-p)) [(eq? 'same (car e-d)) (loop (cdr e-d) e-p)]
(loop (cdr e-d) (cdr e-p))] [(eq? 'same (car e-p)) (loop e-d (cdr e-p))]
[(eq? 'same (car e-d)) [else (string-append
(loop (cdr e-d) e-p)] (apply string-append (map (lambda (x) "../") e-d))
[(eq? 'same (car e-p)) (loop null e-p))])))))
(loop e-d (cdr e-p))]
[else
(string-append
(apply string-append (map (lambda (x) "../") e-d))
(loop null e-p))])))
p))
(define (explode p) (define (explode p)
(reverse (let loop ([p p]) (reverse (let loop ([p p])