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

speed up doc build a little; fix bugs related to getting continuation marks from a thread and using the errortrace profiler

Browse Source 
svn: r12237

original commit: 37aae202c56968d53901b4398a90e096bbe8c754
This commit is contained in:
Matthew Flatt 2008-11-04 23:32:44 +00:00
parent 53f9aad182
commit 4bc0939c57
4 changed files with 41 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/scribble/base-render.ss
View File

@ -383,6 +383,7 @@
(define/public (render-element i part ri)
(cond
[(string? i) (render-other i part ri)] ; short-cut for common case
[(and (link-element? i)
(null? (element-content i)))
(let ([v (resolve-get part ri (link-element-tag i))])

11
collects/scribble/basic.ss
View File

@ -127,11 +127,11 @@
v)))
v)))
(define (module-path-index->taglet mod)
(define (do-module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(build-path (current-directory) "dummy"))])
(lambda () (build-path (current-directory) "dummy")))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
@ -160,6 +160,13 @@
p)])
(intern-taglet p)))))
(define collapsed (make-weak-hasheq))
(define (module-path-index->taglet mod)
(or (hash-ref collapsed mod #f)
(let ([v (do-module-path-index->taglet mod)])
(hash-set! collapsed mod v)
v)))
(define (module-path-prefix->string p)
(format "~a" (module-path-index->taglet (module-path-index-join p #f))))

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

@ -91,18 +91,16 @@
(define (anchor-name v)
(define (encode-byte b)
(string-append (if (< b 16) "~0" "~") (number->string b 16)))
(define (encode-str str)
(if (regexp-match? #px"[^[:ascii:]]" str)
(string-append* (map encode-byte (bytes->list (string->bytes/utf-8 str))))
(encode-byte (char->integer (string-ref str 0)))))
(define (encode-bytes str)
(string->bytes/utf-8 (encode-byte (bytes-ref str 0))))
(if (literal-anchor? v)
(literal-anchor-string v)
(let* ([v (format "~a" v)]
[v (regexp-replace* #rx"[A-Z.]" v ".&")]
[v (regexp-replace* #rx" " v "._")]
[v (regexp-replace* #rx"\"" v ".'")]
[v (regexp-replace* #rx"[^-a-zA-Z0-9_!+*'()/.,]" v encode-str)])
v)))
(let* ([v (string->bytes/utf-8 (format "~a" v))]
[v (regexp-replace* #rx#"[A-Z.]" v #".&")]
[v (regexp-replace* #rx#" " v #"._")]
[v (regexp-replace* #rx#"\"" v #".'")]
[v (regexp-replace* #rx#"[^-a-zA-Z0-9_!+*'()/.,]" v encode-bytes)])
(bytes->string/utf-8 v))))
(define-serializable-struct literal-anchor (string))
@ -826,6 +824,7 @@
(define/override (render-element e part ri)
(cond
[(string? e) (super render-element e part ri)] ; short-cut for common case
[(hover-element? e)
`((span ([title ,(hover-element-text e)])
,@(render-plain-element e part ri)))]
@ -1270,9 +1269,16 @@
(loop (cdr path) (cdr root))))))
roots))))
(define exploded (make-weak-hash))
(define (explode/cache p)
(or (hash-ref exploded p #f)
(let ([v (explode p)])
(hash-set! exploded p v)
v)))
(define (from-root p d)
(define e-p (explode (path->complete-path p (current-directory))))
(define e-d (and d (explode (path->complete-path d (current-directory)))))
(define e-p (explode/cache (path->complete-path p (current-directory))))
(define e-d (and d (explode/cache (path->complete-path d (current-directory)))))
(define p-in? (in-plt? e-p))
(define d-in? (and d (in-plt? e-d)))
;; use an absolute link if the link is from outside the plt tree
@ -1287,12 +1293,13 @@
(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)))]))]
(string-append*
(let loop ([e-p e-p])
(cond [(null? e-p) '("/")]
[(null? (cdr e-p)) (list (car e-p))]
[(eq? 'same (car e-p)) (loop (cdr e-p))]
[(eq? 'up (car e-p)) (cons "../" (loop (cdr e-p)))]
[else (cons (car e-p) (cons "/" (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))]

11
collects/scribble/private/manual-proc.ss
View File

@ -295,8 +295,9 @@
(*sig-elem (sig-id sig) (extract-id prototype))
(to-element (make-just-context (extract-id prototype)
stx-id)))))]))
(define p-depth (prototype-depth prototype))
(define flat-size (+ (prototype-size args + + #f)
(prototype-depth prototype)
p-depth
(element-width tagged)))
(define short? (or (flat-size . < . 40) ((length args) . < . 2)))
(define res
@ -319,7 +320,7 @@
(loop (cdr res))))))))))
res)))
(define tagged+arg-width (+ (prototype-size args max max #t)
(prototype-depth prototype)
p-depth
(element-width tagged)))
(define result-next-line?
((+ (if short? flat-size tagged+arg-width) (block-width res))
@ -339,10 +340,10 @@
(to-flow
(make-element
#f
`(,(make-openers (add1 (prototype-depth prototype)))
`(,(make-openers (add1 p-depth))
,tagged
,@(if (null? args)
(list (make-closers (prototype-depth prototype)))
(list (make-closers p-depth))
(append-map (lambda (arg)
(list spacer ((arg->elem #t) arg)))
args))
@ -363,7 +364,7 @@
(make-element
#f
(list
(make-openers (add1 (prototype-depth prototype)))
(make-openers (add1 p-depth))
tagged)))
(if one-ok?
(list*