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

fix some Scribble bugs that Jay reported

Browse Source 
svn: r6463

original commit: e645b8a4f327402b32602fac8f6927c60617ac0c
This commit is contained in:
Matthew Flatt 2007-06-02 21:49:12 +00:00
parent 5bf23bcefb
commit b2601a6b8b
3 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,6 +18,7 @@
(define on-separate-page (make-parameter #t))
(define next-separate-page (make-parameter #f))
(define collecting-sub (make-parameter 0))
(define current-no-links (make-parameter #f))
;; ----------------------------------------
;; main mixin
@ -136,28 +137,30 @@
(cond
[(target-element? e)
`((a ((name ,(target-element-tag e))) ,@(render-plain-element e part ht)))]
[(link-element? e)
(let ([dest (lookup part ht (link-element-tag e))])
(if dest
`((a ((href ,(format "~a~a~a"
(from-root (car dest)
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
(link-element-tag e))))
,@(if (string? (element-style e))
`((class ,(element-style e)))
null))
,@(if (null? (element-content e))
(render-content (cadr dest) part ht)
(render-content (element-content e) part ht))))
`((font ((class "badlink"))
,@(if (null? (element-content e))
`(,(format "~s" (link-element-tag e)))
(render-plain-element e part ht))))))]
[(and (link-element? e)
(not (current-no-links)))
(parameterize ([current-no-links #t])
(let ([dest (lookup part ht (link-element-tag e))])
(if dest
`((a ((href ,(format "~a~a~a"
(from-root (car dest)
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
(link-element-tag e))))
,@(if (string? (element-style e))
`((class ,(element-style e)))
null))
,@(if (null? (element-content e))
(render-content (cadr dest) part ht)
(render-content (element-content e) part ht))))
`((font ((class "badlink"))
,@(if (null? (element-content e))
`(,(format "~s" (link-element-tag e)))
(render-plain-element e part ht)))))))]
[else (render-plain-element e part ht)]))
(define/private (render-plain-element e part ht)
@ -177,7 +180,10 @@
[(string? style)
`((span ([class ,style]) ,@(super render-element e part ht)))]
[(target-url? style)
`((a ((href ,(target-url-addr style))) ,@(super render-element e part ht)))]
(if (current-no-links)
(super render-element e part ht)
(parameterize ([current-no-links #t])
`((a ((href ,(target-url-addr style))) ,@(super render-element e part ht)))))]
[(image-file? style) `((img ((src ,(install-file (image-file-path style))))))]
[else (super render-element e part ht)])))

8
collects/scribble/manual.ss
View File

@ -203,8 +203,8 @@
[has-optional? (lambda (arg)
(and (pair? arg)
((length arg) . > . (if (keyword? (car arg))
2
3))))]
3
2))))]
[arg->elem (lambda (v)
(cond
[(pair? v)
@ -221,7 +221,9 @@
(parameterize ([current-variable-list
(map (lambda (i)
(and (pair? i)
(car i)))
(if (keyword? (car i))
(cadr i)
(car i))))
(apply append (map cdr prototypes)))])
(make-splice
(cons

12
collects/scribble/scheme.ss
View File

@ -281,13 +281,17 @@
(if (and (symbol? c)
(char=? (string-ref s 0) #\_))
(values (substring s 1) #t #f)
(values s #f #f))))])
(values s #f #f))))]
[(is-kw?) (and (identifier? c)
(memq (syntax-e c) (current-keyword-list)))]
[(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))])
(if (element? (syntax-e c))
(out (syntax-e c) #f)
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not it?))
(not (or it? is-kw? is-var?)))
(make-delayed-element
(lambda (renderer sec ht)
(let* ([vtag (register-scheme-definition (syntax-e c))]
@ -313,9 +317,9 @@
value-color]
[(identifier? c)
(cond
[(memq (syntax-e c) (current-keyword-list))
[is-kw?
keyword-color]
[(memq (syntax-e c) (current-variable-list))
[is-var?
variable-color]
[it? variable-color]
[else symbol-color])]