more interning related to Scribble xref

original commit: 17504a960eb552992818a9b303457d58f9171b2a
This commit is contained in:
Matthew Flatt 2011-12-10 10:30:12 -07:00
parent 4dacb9f7a8
commit 9d0ff0cdfd
6 changed files with 42 additions and 38 deletions

View File

@ -326,7 +326,7 @@
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . content?)]
[sizer (-> any)]
[plain (-> any)])))
@ -369,7 +369,7 @@
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct part-relative-element ([collect (collect-info? . -> . list?)]
(struct part-relative-element ([collect (collect-info? . -> . content?)]
[sizer (-> any)]
[plain (-> any)])))

View File

@ -81,6 +81,8 @@
[decode-string (-> string? content?)]
[clean-up-index-string (-> string? string?)])
(define the-part-index-desc (make-part-index-desc))
(define (clean-up-index-string s)
;; Collapse whitespace, and remove leading or trailing spaces, which
;; might appear there due to images or something else that gets
@ -151,7 +153,7 @@
(regexp-replace #px"^\\s+(?:(?:A|An|The)\\s)?"
(content->string title) "")))
(list (make-element #f title))
(make-part-index-desc))
the-part-index-desc)
l)
l))
(decode-accum-para accum)

View File

@ -45,13 +45,12 @@
[vtag (and tag `(sig-val ,taglet))]
[stag (and tag `(sig-form ,taglet))]
[sd (and stag (resolve-get/tentative sec ri stag))])
(list
(make-element
symbol-color
(list
(cond [sd (make-link-element syntax-link-color (list s) stag)]
[vtag (make-link-element value-link-color (list s) vtag)]
[else s]))))))
(make-element
symbol-color
(list
(cond [sd (make-link-element syntax-link-color (list s) stag)]
[vtag (make-link-element value-link-color (list s) vtag)]
[else s])))))
(lambda () s)
(lambda () s))))
@ -68,16 +67,16 @@
(lambda (render p ri)
(let ([from (resolve-get/tentative p ri '(exporting-libraries #f))])
(if (and from (pair? from))
(list (make-element
(intern-hover-style
(string-append
"Provided from: "
(let loop ([from from])
(if (null? (cdr from))
(format "~s" (car from))
(format "~s, ~a" (car from) (loop (cdr from)))))))
e))
(list e))))
(make-element
(intern-hover-style
(string-append
"Provided from: "
(let loop ([from from])
(if (null? (cdr from))
(format "~s" (car from))
(format "~s, ~a" (car from) (loop (cdr from)))))))
e)
e)))
(lambda () e)
(lambda () e)))
@ -163,12 +162,12 @@
,@(if sig (list (syntax-e (sig-id sig))) null)
,(syntax-e id))))])
(if (or sig (not dep?))
(list (mk tag))
(list (make-dep (list lib-taglet (syntax-e id))
(mk tag)))))
(mk tag)
(make-dep (list lib-taglet (syntax-e id))
(mk tag))))
content)))
(lambda () (car content))
(lambda () (car content))))))
(lambda () content)
(lambda () content)))))
(define (defidentifier id
#:form? [form? #f]
@ -184,7 +183,7 @@
(definition-site (syntax-e id) id form?)
(to-element id))])
(if maker
(maker (list elem)
(maker elem
(lambda (tag)
(let ([elem
(if index?

View File

@ -127,20 +127,24 @@
names
modpaths))
(append (map (lambda (modpath)
(make-part-tag-decl `(mod-path ,(read-intern-literal
(element->string modpath)))))
(make-part-tag-decl
(intern-taglet
`(mod-path ,(read-intern-literal
(element->string modpath))))))
modpaths)
(flow-paragraphs (decode-flow content)))))))
(define the-module-path-index-desc (make-module-path-index-desc))
(define (make-defracketmodname mn mp)
(let ([name-str (read-intern-literal (element->string mn))]
[path-str (read-intern-literal (element->string mp))])
(make-index-element #f
(list mn)
`(mod-path ,path-str)
(intern-taglet `(mod-path ,path-str))
(list name-str)
(list mn)
(make-module-path-index-desc))))
the-module-path-index-desc)))
(define-syntax (declare-exporting stx)
(syntax-case stx ()

View File

@ -234,12 +234,11 @@
(let ([content (decode-content s)])
(make-delayed-element
(lambda (r p ri)
(list
(make-link-element
#f
content
(or (find-racket-tag p ri stx-id #f)
`(undef ,(format "--UNDEFINED:~a--" (syntax-e stx-id)))))))
(make-link-element
#f
content
(or (find-racket-tag p ri stx-id #f)
`(undef ,(format "--UNDEFINED:~a--" (syntax-e stx-id))))))
(lambda () content)
(lambda () content))))

View File

@ -878,7 +878,7 @@ Like @racket[traverse-block], but the @racket[traverse] procedure must
eventually produce @tech{content}, rather than a @tech{block}.}
@defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
@defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . content?)]
[sizer (-> any/c)]
[plain (-> any/c)])]{
@ -898,7 +898,7 @@ such as when @racket[element->string] is used before the @tech{collect
pass}.}
@defstruct[part-relative-element ([resolve (collect-info? . -> . list?)]
@defstruct[part-relative-element ([resolve (collect-info? . -> . content?)]
[sizer (-> any/c)]
[plain (-> any/c)])]{