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

fix problems due to HTML anchor case-insensitivity

Browse Source 
svn: r7286

original commit: f0eec285a393a90e5d50c03d30a0126c46113d19
This commit is contained in:
Matthew Flatt 2007-09-06 14:23:20 +00:00
parent 1dc75cffe9
commit 07b383270f
2 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -36,6 +36,21 @@
p p
(main-collects-relative->path p)))) (main-collects-relative->path p))))
;; HTML anchors are case-insenstive. To make them
;; distinct, add a "^" in front of capital letters.
(define (anchor-name v)
(let loop ([s (format "~a" v)])
(cond
[(regexp-match-positions #rx"[A-Z:]" s)
=> (lambda (m)
(string-append
(substring s 0 (caar m))
":"
(substring s (caar m) (cdar m))
(loop (substring s (cdar m)))))]
[else s])))
;; ---------------------------------------- ;; ----------------------------------------
;; main mixin ;; main mixin
@ -134,7 +149,7 @@
"#") "#")
(if (caddr dest) (if (caddr dest)
"" ""
(cadddr dest))))) (anchor-name (cadddr dest))))))
(class ,(if (eq? p mine) (class ,(if (eq? p mine)
"tocviewselflink" "tocviewselflink"
"tocviewlink"))) "tocviewlink")))
@ -240,8 +255,8 @@
'((tt nbsp))))) '((tt nbsp)))))
'("")) '(""))
(a ((href ,(if (part? p) (a ((href ,(if (part? p)
(format "#~a" (tag-key (car (part-tags p)) ri)) (format "#~a" (anchor-name (tag-key (car (part-tags p)) ri)))
(format "#~a" (tag-key (target-element-tag p) ri)))) (format "#~a" (anchor-name (tag-key (target-element-tag p) ri)))))
(class ,(if (part? p) (class ,(if (part? p)
"tocsubseclink" "tocsubseclink"
"tocsublink"))) "tocsublink")))
@ -279,7 +294,7 @@
null null
(if (part-style? d 'hidden) (if (part-style? d 'hidden)
(map (lambda (t) (map (lambda (t)
`(a ((name ,(format "~a" (tag-key t ri)))))) `(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
(part-tags d)) (part-tags d))
`((,(case (length number) `((,(case (length number)
[(0) 'h2] [(0) 'h2]
@ -288,7 +303,7 @@
[else 'h5]) [else 'h5])
,@(format-number number '((tt nbsp))) ,@(format-number number '((tt nbsp)))
,@(map (lambda (t) ,@(map (lambda (t)
`(a ((name ,(format "~a" (tag-key t ri)))))) `(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
(part-tags d)) (part-tags d))
,@(if (part-title-content d) ,@(if (part-title-content d)
(render-content (part-title-content d) d ri) (render-content (part-title-content d) d ri)
@ -331,7 +346,7 @@
[(hover-element? e) [(hover-element? e)
`((span ((title ,(hover-element-text e))) ,@(render-plain-element e part ri)))] `((span ((title ,(hover-element-text e))) ,@(render-plain-element e part ri)))]
[(target-element? e) [(target-element? e)
`((a ((name ,(format "~a" (tag-key (target-element-tag e) ri))))) `((a ((name ,(format "~a" (anchor-name (tag-key (target-element-tag e) ri))))))
,@(render-plain-element e part ri))] ,@(render-plain-element e part ri))]
[(and (link-element? e) [(and (link-element? e)
(not (current-no-links))) (not (current-no-links)))
@ -346,7 +361,7 @@
"#") "#")
(if (caddr dest) (if (caddr dest)
"" ""
(cadddr dest)))) (anchor-name (cadddr dest)))))
,@(if (string? (element-style e)) ,@(if (string? (element-style e))
`((class ,(element-style e))) `((class ,(element-style e)))
null)) null))
@ -483,7 +498,7 @@
(define/override (render-other i part ri) (define/override (render-other i part ri)
(cond (cond
[(string? i) (let ([m (and (extra-breaking?) [(string? i) (let ([m (and (extra-breaking?)
(regexp-match-positions #rx":" i))]) (regexp-match-positions #rx"[:/]" i))])
(if m (if m
(list* (substring i 0 (cdar m)) (list* (substring i 0 (cdar m))
`(span ((class "mywbr")) " ") `(span ((class "mywbr")) " ")

6
collects/scribble/manual.ss
View File

@ -1143,7 +1143,7 @@
form) form)
kw-id))))]) kw-id))))])
(if tag (if tag
(make-toc-target-element (make-target-element
#f #f
(list (list
(make-toc-target-element (make-toc-target-element
@ -1155,8 +1155,8 @@
(list (symbol->string (syntax-e kw-id))) (list (symbol->string (syntax-e kw-id)))
content)) content))
content) content)
tag)) stag))
stag) tag)
(car content))))))))) (car content)))))))))
forms form-procs) forms form-procs)
(if (null? sub-procs) (if (null? sub-procs)