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

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

@ -211,16 +211,14 @@
(eq? d (current-top-part)))
(define/override (collect-part-tags d ci number)
(for-each (lambda (t)
(let ([key (generate-tag t ci)])
(collect-put! ci
key
(vector (path->relative (current-output-file))
(or (part-title-content d)
'("???"))
(current-part-whole-page? d)
key))))
(part-tags d)))
(for ([t (part-tags d)])
(let ([key (generate-tag t ci)])
(collect-put! ci key
(vector (and (current-output-file)
(path->relative (current-output-file)))
(or (part-title-content d) '("???"))
(current-part-whole-page? d)
key)))))
(define/override (collect-target-element i ci)
(let ([key (generate-tag (target-element-tag i) ci)])
@ -447,25 +445,35 @@
(define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn])
(let ([xpr `(html ()
(head
(meta ((http-equiv "content-type")
(content "text-html; charset=utf-8")))
,@(let ([c (part-title-content d)])
(if c
`((title ,@(format-number number '(nbsp)) ,(content->string c this d ri)))
null))
(link ((rel "stylesheet")
(let ([xpr `(html ()
(head
(meta ((http-equiv "content-type")
(content "text-html; charset=utf-8")))
,@(let ([c (part-title-content d)])
(if c
`((title ,@(format-number number '(nbsp))
,(content->string c this d ri)))
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")
(href ,(or css-path "scribble.css"))
(title "default"))))
(body ,@(render-toc-view d ri)
(div ((class "maincolumn"))
(div ((class "main"))
,@(render-version d ri)
,@(navigation d ri #f)
,@(render-part d ri)
,@(navigation d ri #t)))))])
(title "default")))))
(body ,@(render-toc-view d ri)
(div ((class "maincolumn"))
(div ((class "main"))
,@(render-version d ri)
,@(navigation d ri #f)
,@(render-part d ri)
,@(navigation d ri #t)))))])
(unless css-path
(install-file scribble-css))
(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
(define (from-root p d)
(if d
(let ([e-d (explode (path->complete-path d (current-directory)))]
[e-p (explode (path->complete-path p (current-directory)))])
(let loop ([e-d e-d]
[e-p e-p])
(cond
[(null? e-d) (let loop ([e-p e-p])
(cond
[(null? e-p) "/"]
[(null? (cdr e-p)) (car e-p)]
[(eq? 'same (car e-p)) (loop (cdr e-p))]
[(eq? 'up (car e-p))
(string-append "../" (loop (cdr e-p)))]
[else (string-append (car e-p)
"/"
(loop (cdr e-p)))]))]
[(equal? (car e-d) (car e-p))
(loop (cdr e-d) (cdr e-p))]
[(eq? 'same (car e-d))
(loop (cdr e-d) e-p)]
[(eq? 'same (car e-p))
(loop e-d (cdr e-p))]
[else
(string-append
(apply string-append (map (lambda (x) "../") e-d))
(loop null e-p))])))
p))
(if (not d)
p
(let ([e-d (explode (path->complete-path d (current-directory)))]
[e-p (explode (path->complete-path p (current-directory)))])
(let loop ([e-d e-d]
[e-p e-p])
(cond
[(null? e-d)
(let loop ([e-p e-p])
(cond
[(null? e-p) "/"]
[(null? (cdr e-p)) (car e-p)]
[(eq? 'same (car e-p)) (loop (cdr e-p))]
[(eq? 'up (car e-p)) (string-append "../" (loop (cdr e-p)))]
[else (string-append (car e-p) "/" (loop (cdr e-p)))]))]
[(equal? (car e-d) (car e-p)) (loop (cdr e-d) (cdr e-p))]
[(eq? 'same (car e-d)) (loop (cdr e-d) e-p)]
[(eq? 'same (car e-p)) (loop e-d (cdr e-p))]
[else (string-append
(apply string-append (map (lambda (x) "../") e-d))
(loop null e-p))])))))
(define (explode p)
(reverse (let loop ([p p])