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

58
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)])
@ -453,12 +451,22 @@
(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))
,(content->string c this d ri)))
null)) null))
(link ((rel "stylesheet") ,(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"))
@ -978,33 +986,27 @@
;; utils ;; utils
(define (from-root p d) (define (from-root p d)
(if d (if (not d)
p
(let ([e-d (explode (path->complete-path d (current-directory)))] (let ([e-d (explode (path->complete-path d (current-directory)))]
[e-p (explode (path->complete-path p (current-directory)))]) [e-p (explode (path->complete-path p (current-directory)))])
(let loop ([e-d e-d] (let loop ([e-d e-d]
[e-p e-p]) [e-p e-p])
(cond (cond
[(null? e-d) (let loop ([e-p e-p]) [(null? e-d)
(let loop ([e-p e-p])
(cond (cond
[(null? e-p) "/"] [(null? e-p) "/"]
[(null? (cdr e-p)) (car e-p)] [(null? (cdr e-p)) (car e-p)]
[(eq? 'same (car e-p)) (loop (cdr e-p))] [(eq? 'same (car e-p)) (loop (cdr e-p))]
[(eq? 'up (car e-p)) [(eq? 'up (car e-p)) (string-append "../" (loop (cdr e-p)))]
(string-append "../" (loop (cdr e-p)))] [else (string-append (car e-p) "/" (loop (cdr e-p)))]))]
[else (string-append (car 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)]
(loop (cdr e-p)))]))] [(eq? 'same (car e-p)) (loop e-d (cdr e-p))]
[(equal? (car e-d) (car e-p)) [else (string-append
(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)) (apply string-append (map (lambda (x) "../") e-d))
(loop null e-p))]))) (loop null e-p))])))))
p))
(define (explode p) (define (explode p)
(reverse (let loop ([p p]) (reverse (let loop ([p p])