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

8
collects/scribble/manual.ss
View File

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

12
collects/scribble/scheme.ss
View File

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