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

3.99.0.9: binding links in docs use nominal import sources

Browse Source 
svn: r8196

original commit: 7fc41024c0f09d03bed22c9e68bc2548f9222b77
This commit is contained in:
Matthew Flatt 2008-01-03 19:07:02 +00:00
parent 7de01e897e
commit aee87f3568
18 changed files with 717 additions and 368 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,8 @@
mzlib/class mzlib/class
mzlib/serialize mzlib/serialize
scheme/file scheme/file
scheme/path) scheme/path
setup/main-collects)
(provide render%) (provide render%)
@ -74,7 +75,9 @@
(make-hash-table 'equal) (make-hash-table 'equal)
(make-hash-table) (make-hash-table)
(make-hash-table) (make-hash-table)
"")]) ""
(make-hash-table)
null)])
(start-collect ds fns ci) (start-collect ds fns ci)
ci)) ci))
@ -92,7 +95,9 @@
(string-append (collect-info-gen-prefix ci) (string-append (collect-info-gen-prefix ci)
(part-tag-prefix d) (part-tag-prefix d)
":") ":")
(collect-info-gen-prefix ci)))]) (collect-info-gen-prefix ci))
(collect-info-relatives ci)
(cons d (collect-info-parents ci)))])
(when (part-title-content d) (when (part-title-content d)
(collect-content (part-title-content d) p-ci)) (collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number) (collect-part-tags d p-ci number)
@ -184,16 +189,28 @@
(blockquote-paragraphs i))) (blockquote-paragraphs i)))
(define/public (collect-element i ci) (define/public (collect-element i ci)
(when (target-element? i) (if (part-relative-element? i)
(collect-target-element i ci)) (let ([content
(when (index-element? i) (or (hash-table-get (collect-info-relatives ci)
(collect-index-element i ci)) i
(when (collect-element? i) #f)
((collect-element-collect i) ci)) (let ([v ((part-relative-element-collect i) ci)])
(when (element? i) (hash-table-put! (collect-info-relatives ci)
(for-each (lambda (e) i
(collect-element e ci)) v)
(element-content i)))) v))])
(collect-content content ci))
(begin
(when (target-element? i)
(collect-target-element i ci))
(when (index-element? i)
(collect-index-element i ci))
(when (collect-element? i)
((collect-element-collect i) ci))
(when (element? i)
(for-each (lambda (e)
(collect-element e ci))
(element-content i))))))
(define/public (collect-target-element i ci) (define/public (collect-target-element i ci)
(collect-put! ci (collect-put! ci
@ -213,6 +230,7 @@
(define/public (resolve ds fns ci) (define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci (let ([ri (make-resolve-info ci
(make-hash-table) (make-hash-table)
(make-hash-table 'equal)
(make-hash-table 'equal))]) (make-hash-table 'equal))])
(start-resolve ds fns ri) (start-resolve ds fns ri)
ri)) ri))
@ -269,6 +287,8 @@
(define/public (resolve-element i d ri) (define/public (resolve-element i d ri)
(cond (cond
[(part-relative-element? i)
(resolve-content (part-relative-element-content i ri) d ri)]
[(delayed-element? i) [(delayed-element? i)
(resolve-content (or (hash-table-get (resolve-info-delays ri) (resolve-content (or (hash-table-get (resolve-info-delays ri)
i i
@ -372,6 +392,8 @@
(render-content (element-content i) part ri)] (render-content (element-content i) part ri)]
[(delayed-element? i) [(delayed-element? i)
(render-content (delayed-element-content i ri) part ri)] (render-content (delayed-element-content i ri) part ri)]
[(part-relative-element? i)
(render-content (part-relative-element-content i ri) part ri)]
[else [else
(render-other i part ri)])) (render-other i part ri)]))

8
collects/scribble/basic.ss
View File

@ -47,20 +47,20 @@
style style
content))) content)))
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] . str) (define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-part-start 1 (make-part-start 1
(prefix->string prefix) (prefix->string prefix)
(convert-tag tag content) (convert-tag tag content)
#f style
content))) content)))
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f] . str) (define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-part-start 2 (make-part-start 2
(prefix->string prefix) (prefix->string prefix)
(convert-tag tag content) (convert-tag tag content)
#f style
content))) content)))
(define (subsubsub*section #:tag [tag #f] . str) (define (subsubsub*section #:tag [tag #f] . str)

3
collects/scribble/decode.ss
View File

@ -27,7 +27,8 @@
[splice ([run list?])] [splice ([run list?])]
[part-index-decl ([plain-seq (listof string?)] [part-index-decl ([plain-seq (listof string?)]
[entry-seq list?])] [entry-seq list?])]
[part-collect-decl ([element element?])] [part-collect-decl ([element (or/c element?
part-relative-element?)])]
[part-tag-decl ([tag tag?])]) [part-tag-decl ([tag tag?])])
(define (decode-string s) (define (decode-string s)

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

@ -251,8 +251,11 @@
(append (loop (element-content a)) (append (loop (element-content a))
(loop (cdr c)))] (loop (cdr c)))]
[(delayed-element? a) [(delayed-element? a)
(loop (cons (delayed-element-content a ri) (loop (append (delayed-element-content a ri)
(cdr c)))] (cdr c)))]
[(part-relative-element? a)
(loop (append (part-relative-element-content a ri)
(cdr c)))]
[else [else
(loop (cdr c))]))])))] (loop (cdr c))]))])))]
[table-targets [table-targets

510
collects/scribble/manual.ss
View File

@ -3,6 +3,7 @@
(require "decode.ss" (require "decode.ss"
"struct.ss" "struct.ss"
"scheme.ss" "scheme.ss"
"search.ss"
"config.ss" "config.ss"
"basic.ss" "basic.ss"
"manual-struct.ss" "manual-struct.ss"
@ -10,6 +11,7 @@
scheme/class scheme/class
scheme/stxparam scheme/stxparam
mzlib/serialize mzlib/serialize
setup/main-collects
(for-syntax scheme/base) (for-syntax scheme/base)
(for-label scheme/base (for-label scheme/base
scheme/class)) scheme/class))
@ -309,34 +311,74 @@
;; ---------------------------------------- ;; ----------------------------------------
(define-struct sig (tagstr)) (define (gen-absolute-tag)
`(abs ,(make-generated-tag)))
(define-struct sig (id))
(define (definition-site name stx-id form?) (define (definition-site name stx-id form?)
(let ([sig (current-signature)]) (let ([sig (current-signature)])
(if sig (if sig
(make-link-element (if form? (*sig-elem (sig-id sig) name)
"schemesyntaxlink"
"schemevaluelink")
(list (schemefont (symbol->string name)))
`(,(if form? 'sig-form 'sig-val)
,(format "~a::~a" (sig-tagstr sig) name)))
(annote-exporting-library (annote-exporting-library
(to-element (make-just-context name stx-id)))))) (to-element (make-just-context name stx-id))))))
(define (id-to-tag id) (define (libs->str libs)
(add-signature-tag id #f)) (and (pair? libs)
(format "~a"
(let ([p (resolved-module-path-name
(module-path-index-resolve
(module-path-index-join (car libs) #f)))])
(if (path? p)
(path->main-collects-relative p)
p)))))
(define (id-to-form-tag id) (define (id-to-target-maker id dep?)
(add-signature-tag id #t)) (*id-to-target-maker 'def id dep?))
(define (add-signature-tag id form?) (define (id-to-form-target-maker id dep?)
(*id-to-target-maker 'form id dep?))
(define (*id-to-target-maker sym id dep?)
(let ([sig (current-signature)]) (let ([sig (current-signature)])
(if sig (lambda (content mk)
`(,(if form? 'sig-form 'sig-val) (make-part-relative-element
,(format "~a::~a" (sig-tagstr sig) (syntax-e id))) (lambda (ci)
(if form? (let ([e (ormap (lambda (p)
(register-scheme-form-definition id) (ormap (lambda (e)
(register-scheme-definition id #t))))) (and (exporting-libraries? e) e))
(part-to-collect p)))
(collect-info-parents ci))])
(unless e
;; Call raise-syntax-error to capture error message:
(with-handlers ([exn:fail:syntax? (lambda (exn)
(fprintf (current-error-port)
"~a\n"
(exn-message exn)))])
(raise-syntax-error 'WARNING
"no declared exporting libraries for definition"
id)))
(if e
(let* ([lib-str (libs->str (exporting-libraries-libs e))]
[tag (list (if sig
(case sym
[(def) 'sig-val]
[(form) 'sig-def])
sym)
(format "~a::~a~a~a"
lib-str
(if sig (syntax-e (sig-id sig)) "")
(if sig "::" "")
(syntax-e id)))])
(if (or sig (not dep?))
(list (mk tag))
(list (make-target-element
#f
(list (mk tag))
`(dep ,(format "~a::~a" lib-str (syntax-e id)))))))
content)))
(lambda () (car content))
(lambda () (car content))))))
(define current-signature (make-parameter #f)) (define current-signature (make-parameter #f))
@ -344,21 +386,25 @@
(*sig-elem (quote-syntax sig) 'elem)) (*sig-elem (quote-syntax sig) 'elem))
(define (*sig-elem sig elem) (define (*sig-elem sig elem)
(let ([s (to-element elem)] (let ([s (to-element/no-color elem)])
[tag (format "~a::~a"
(register-scheme-form-definition sig #t)
elem)])
(make-delayed-element (make-delayed-element
(lambda (renderer sec ri) (lambda (renderer sec ri)
(let* ([vtag `(sig-val ,tag)] (let* ([tag (find-scheme-tag sec ri sig 'for-label)]
[stag `(sig-form ,tag)] [str (and tag (format "~a::~a" (cadr tag) elem))]
[sd (resolve-get/tentative sec ri stag)]) [vtag (and tag `(sig-val ,str))]
[stag (and tag `(sig-form ,str))]
[sd (and stag (resolve-get/tentative sec ri stag))])
(list (list
(cond (make-element
[sd "schemesymbol"
(make-link-element "schemesyntaxlink" (list s) stag)] (list
[else (cond
(make-link-element "schemevaluelink" (list s) vtag)])))) [sd
(make-link-element "schemesyntaxlink" (list s) stag)]
[vtag
(make-link-element "schemevaluelink" (list s) vtag)]
[else
s]))))))
(lambda () s) (lambda () s)
(lambda () s)))) (lambda () s))))
@ -379,15 +425,29 @@
(elem (method a b) " in " (scheme a))])) (elem (method a b) " in " (scheme a))]))
(define (*method sym id) (define (*method sym id)
(**method sym (id-to-tag id))) (**method sym id))
(define (**method sym tag) (define (**method sym id/tag)
(make-element (let ([content (list (symbol->string sym))])
"schemesymbol" ((if (identifier? id/tag)
(list (make-link-element (lambda (c mk)
"schemevaluelink" (make-delayed-element
(list (symbol->string sym)) (lambda (ren p ri)
(method-tag tag sym))))) (let ([tag (find-scheme-tag p ri id/tag 'for-label)])
(if tag
(list (mk tag))
content)))
(lambda () (car content))
(lambda () (car content))))
(lambda (c mk) (mk id/tag)))
content
(lambda (tag)
(make-element
"schemesymbol"
(list (make-link-element
"schemevaluelink"
content
(method-tag tag sym))))))))
(define (method-tag vtag sym) (define (method-tag vtag sym)
(list 'meth (list 'meth
@ -458,12 +518,18 @@
(syntax-rules () (syntax-rules ()
[(_ lib ...) (*declare-exporting '(lib ...))])) [(_ lib ...) (*declare-exporting '(lib ...))]))
(define-struct (exporting-libraries element) (libs))
(define (*declare-exporting libs) (define (*declare-exporting libs)
(make-part-collect-decl (make-splice
(make-collect-element #f (list
null (make-part-collect-decl
(lambda (ri) (make-collect-element #f
(collect-put! ri '(exporting-libraries #f)libs))))) null
(lambda (ri)
(collect-put! ri '(exporting-libraries #f) libs))))
(make-part-collect-decl
(make-exporting-libraries #f null libs)))))
(define-syntax (quote-syntax/loc stx) (define-syntax (quote-syntax/loc stx)
(syntax-case stx () (syntax-case stx ()
@ -1016,45 +1082,51 @@
(hspace 1) (hspace 1)
(if first? (if first?
(let* ([mname (extract-id prototype)] (let* ([mname (extract-id prototype)]
[ctag (id-to-tag within-id)] [target-maker (id-to-target-maker within-id #f)]
[tag (method-tag ctag mname)]
[content (list (*method mname within-id))]) [content (list (*method mname within-id))])
(if tag (if target-maker
(make-toc-target-element (target-maker
#f content
(list (make-index-element #f (lambda (ctag)
content (let ([tag (method-tag ctag mname)])
tag (make-toc-target-element
(list (symbol->string mname)) #f
content (list (make-index-element #f
(with-exporting-libraries content
(lambda (libs) tag
(make-method-index-desc (list (symbol->string mname))
(syntax-e within-id) content
libs (with-exporting-libraries
mname (lambda (libs)
ctag))))) (make-method-index-desc
tag) (syntax-e within-id)
libs
mname
ctag)))))
tag))))
(car content))) (car content)))
(*method (extract-id prototype) within-id))))] (*method (extract-id prototype) within-id))))]
[else [else
(if first? (if first?
(let ([tag (id-to-tag stx-id)] (let ([target-maker (id-to-target-maker stx-id #t)]
[content (list (definition-site (extract-id prototype) stx-id #f))]) [content (list (definition-site (extract-id prototype) stx-id #f))])
(if tag (if target-maker
(make-toc-target-element (target-maker
#f content
(list (make-index-element #f (lambda (tag)
content (make-toc-target-element
tag #f
(list (symbol->string (extract-id prototype))) (list (make-index-element #f
content content
(with-exporting-libraries tag
(lambda (libs) (list (symbol->string (extract-id prototype)))
(make-procedure-index-desc content
(extract-id prototype) (with-exporting-libraries
libs))))) (lambda (libs)
tag) (make-procedure-index-desc
(extract-id prototype)
libs)))))
tag)))
(car content))) (car content)))
(annote-exporting-library (annote-exporting-library
(to-element (make-just-context (extract-id prototype) (to-element (make-just-context (extract-id prototype)
@ -1241,27 +1313,31 @@
(let* ([name (let* ([name
(apply string-append (apply string-append
(map symbol->string (cdar wrappers)))] (map symbol->string (cdar wrappers)))]
[tag [target-maker
(id-to-tag (id-to-target-maker
(datum->syntax stx-id (datum->syntax stx-id
(string->symbol (string->symbol
name)))]) name))
(if tag #t)])
(inner-make-target-element (if target-maker
#f (target-maker
(list (list content)
(make-index-element #f (lambda (tag)
(list content) (inner-make-target-element
tag #f
(list name) (list
(list (schemeidfont (make-element "schemevaluelink" (list name)))) (make-index-element #f
(with-exporting-libraries (list content)
(lambda (libs) tag
(let ([name (string->symbol name)]) (list name)
(if (eq? 'info (caar wrappers)) (list (schemeidfont (make-element "schemevaluelink" (list name))))
(make-struct-index-desc name libs) (with-exporting-libraries
(make-procedure-index-desc name libs))))))) (lambda (libs)
tag) (let ([name (string->symbol name)])
(if (eq? 'info (caar wrappers))
(make-struct-index-desc name libs)
(make-procedure-index-desc name libs)))))))
tag)))
content)) content))
(cdr wrappers)))) (cdr wrappers))))
@ -1454,20 +1530,24 @@
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)] (list (let ([target-maker ((if form? id-to-form-target-maker id-to-target-maker) stx-id #t)]
[content (list (definition-site name stx-id form?))]) [content (list (definition-site name stx-id form?))])
(if tag (if target-maker
(make-toc-target-element (target-maker
#f content
(list (make-index-element #f (lambda (tag)
content (make-toc-target-element
tag #f
(list (symbol->string name)) (list
content (make-index-element #f
(with-exporting-libraries content
(lambda (libs) tag
(make-thing-index-desc name libs))))) (list (symbol->string name))
tag) content
(with-exporting-libraries
(lambda (libs)
(make-thing-index-desc name libs)))))
tag)))
(car content))) (car content)))
spacer ":" spacer)))) spacer ":" spacer))))
(make-flow (make-flow
@ -1520,31 +1600,29 @@
`(,x . ,(cdr form))))))) `(,x . ,(cdr form)))))))
(and kw-id (and kw-id
(eq? form (car forms)) (eq? form (car forms))
(let ([tag (id-to-tag kw-id)] (let ([target-maker (id-to-form-target-maker kw-id #t)]
[stag (id-to-form-tag kw-id)]
[content (list (definition-site (if (pair? form) [content (list (definition-site (if (pair? form)
(car form) (car form)
form) form)
kw-id kw-id
#t))]) #t))])
(if tag (if target-maker
(make-target-element (target-maker
#f content
(list (lambda (tag)
(make-toc-target-element (make-toc-target-element
#f #f
(if kw-id (if kw-id
(list (make-index-element #f (list (make-index-element #f
content content
tag tag
(list (symbol->string (syntax-e kw-id))) (list (symbol->string (syntax-e kw-id)))
content content
(with-exporting-libraries (with-exporting-libraries
(lambda (libs) (lambda (libs)
(make-form-index-desc (syntax-e kw-id) libs))))) (make-form-index-desc (syntax-e kw-id) libs)))))
content) content)
stag)) tag)))
tag)
(car content))))))))) (car content)))))))))
forms form-procs) forms form-procs)
(if (null? sub-procs) (if (null? sub-procs)
@ -1680,9 +1758,19 @@
(make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc s)))) (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc s))))
(define (seclink tag #:underline? [u? #t] #:doc [doc #f] . s) (define (seclink tag #:underline? [u? #t] #:doc [doc #f] . s)
(make-link-element (if u? #f "plainlink") (decode-content s) `(part ,(doc-prefix doc tag)))) (make-link-element (if u? #f "plainlink") (decode-content s) `(part ,(doc-prefix doc tag))))
(define (*schemelink stx-id id . s) (define (*schemelink stx-id id . s)
(make-link-element #f (decode-content s) (or (register-scheme-definition stx-id) (let ([content (decode-content s)])
(format "--UNDEFINED:~a--" (syntax-e stx-id))))) (make-delayed-element
(lambda (r p ri)
(list
(make-link-element #f
content
(or (find-scheme-tag p ri stx-id 'for-label)
(format "--UNDEFINED:~a--" (syntax-e stx-id))))))
(lambda () content)
(lambda () content))))
(define-syntax schemelink (define-syntax schemelink
(syntax-rules () (syntax-rules ()
[(_ id . content) (*schemelink (quote-syntax id) 'id . content)])) [(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
@ -1841,28 +1929,45 @@
(define-struct spec (def)) (define-struct spec (def))
(define-struct impl (def)) (define-struct impl (def))
(define (id-info id)
(let ([b (identifier-label-binding id)])
(list (let ([p (resolved-module-path-name (module-path-index-resolve (caddr b)))])
(if (path? p)
(path->main-collects-relative p)
p))
(cadddr b)
(list-ref b 5))))
(define-serializable-struct cls/intf (name-element super intfs methods)) (define-serializable-struct cls/intf (name-element super intfs methods))
(define (make-inherited-table r d ri decl) (define (make-inherited-table r d ri decl)
(let* ([start (let ([key (register-scheme-definition (decl-name decl))]) (let* ([start (let ([key (find-scheme-tag d ri (decl-name decl) 'for-label)])
(list (cons key (lookup-cls/intf d ri key))))] (if key
[supers (cdr (list (cons key (lookup-cls/intf d ri key)))
(let loop ([supers start][accum null]) null))]
(cond [supers (if (null? start)
[(null? supers) (reverse accum)] null
[(memq (car supers) accum) (cdr
(loop (cdr supers) accum)] (let loop ([supers start][accum null])
[else (cond
(let ([super (car supers)]) [(null? supers) (reverse accum)]
(loop (append (map (lambda (i) [(memq (car supers) accum)
(cons i (lookup-cls/intf d ri i))) (loop (cdr supers) accum)]
(reverse (cls/intf-intfs (cdr super)))) [else
(let ([s (cls/intf-super (cdr super))]) (let ([super (car supers)])
(if s (loop (append (filter values
(list (cons s (lookup-cls/intf d ri s))) (map (lambda (i)
null)) (let ([key (find-scheme-tag d ri i 'for-label)])
(cdr supers)) (and key
(cons super accum)))])))] (cons key (lookup-cls/intf d ri key)))))
(reverse (cls/intf-intfs (cdr super)))))
(let ([s (and (cls/intf-super (cdr super))
(find-scheme-tag d ri (cls/intf-super (cdr super)) 'for-label))])
(if s
(list (cons s (lookup-cls/intf d ri s)))
null))
(cdr supers))
(cons super accum)))]))))]
[ht (let ([ht (make-hash-table)]) [ht (let ([ht (make-hash-table)])
(for-each (lambda (i) (for-each (lambda (i)
(when (meth? i) (when (meth? i)
@ -1902,27 +2007,29 @@
(define (make-decl-collect decl) (define (make-decl-collect decl)
(make-part-collect-decl (make-part-collect-decl
(make-collect-element ((id-to-target-maker (decl-name decl) #f)
#f null (list "ignored")
(lambda (ci) (lambda (tag)
(let ([tag (register-scheme-definition (decl-name decl))]) (make-collect-element
(collect-put! ci #f null
`(cls/intf ,tag) (lambda (ci)
(make-cls/intf (collect-put! ci
(make-element `(cls/intf ,(cadr tag))
"schemesymbol" (make-cls/intf
(list (make-link-element (make-element
"schemevaluelink" "schemesymbol"
(list (symbol->string (syntax-e (decl-name decl)))) (list (make-link-element
tag))) "schemevaluelink"
(and (decl-super decl) (list (symbol->string (syntax-e (decl-name decl))))
(not (free-label-identifier=? (quote-syntax object%) tag)))
(decl-super decl))) (and (decl-super decl)
(register-scheme-definition (decl-super decl))) (not (free-label-identifier=? (quote-syntax object%)
(map register-scheme-definition (decl-intfs decl)) (decl-super decl)))
(map (lambda (m) (id-info (decl-super decl)))
(meth-name m)) (map id-info (decl-intfs decl))
(filter meth? (decl-body decl)))))))))) (map (lambda (m)
(meth-name m))
(filter meth? (decl-body decl)))))))))))
(define (build-body decl body) (define (build-body decl body)
(append (append
@ -1969,22 +2076,26 @@
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (let ([tag (id-to-tag stx-id)] (list (let ([target-maker (id-to-target-maker stx-id #t)]
[content (list (annote-exporting-library (to-element stx-id)))]) [content (list (annote-exporting-library (to-element stx-id)))])
(if tag (if target-maker
((if whole-page? (target-maker
make-page-target-element content
make-toc-target-element) (lambda (tag)
#f ((if whole-page?
(list (make-index-element #f make-page-target-element
content make-toc-target-element)
tag #f
(list (symbol->string (syntax-e stx-id))) (list
content (make-index-element #f
(with-exporting-libraries content
(lambda (libs) tag
(make-index-desc (syntax-e stx-id) libs))))) (list (symbol->string (syntax-e stx-id)))
tag) content
(with-exporting-libraries
(lambda (libs)
(make-index-desc (syntax-e stx-id) libs)))))
tag)))
(car content))) (car content)))
spacer ":" spacer spacer ":" spacer
(case kind (case kind
@ -2222,36 +2333,38 @@
(define (*xmethod/super cname name) (define (*xmethod/super cname name)
(let ([get (let ([get
(lambda (d ri key) (lambda (d ri key)
(let ([v (lookup-cls/intf d ri key)]) (if key
(if v (let ([v (lookup-cls/intf d ri key)])
(cons (cls/intf-super v) (if v
(cls/intf-intfs v)) (cons (cls/intf-super v)
null)))] (cls/intf-intfs v))
[ctag (id-to-tag cname)]) null))
null))])
(make-delayed-element (make-delayed-element
(lambda (r d ri) (lambda (r d ri)
(let loop ([search (get d ri ctag)]) (let loop ([search (get d ri (find-scheme-tag d ri cname 'for-label))])
(cond (cond
[(null? search) [(null? search)
(list (make-element #f '("<method not found>")))] (list (make-element #f '("<method not found>")))]
[(not (car search)) [(not (car search))
(loop (cdr search))] (loop (cdr search))]
[else [else
(let ([v (lookup-cls/intf d ri (car search))]) (let* ([a-key (find-scheme-tag d ri (car search) 'for-label)]
[v (and a-key (lookup-cls/intf d ri a-key))])
(if v (if v
(if (member name (cls/intf-methods v)) (if (member name (cls/intf-methods v))
(list (list
(make-element #f (make-element #f
(list (**method name (car search)) (list (**method name a-key)
" in " " in "
(cls/intf-name-element v)))) (cls/intf-name-element v))))
(loop (append (cdr search) (get d ri (car search))))) (loop (append (cdr search) (get d ri (find-scheme-tag d ri (car search) 'for-label)))))
(loop (cdr search))))]))) (loop (cdr search))))])))
(lambda () (format "~a in ~a" (syntax-e cname) name)) (lambda () (format "~a in ~a" (syntax-e cname) name))
(lambda () (format "~a in ~a" (syntax-e cname) name))))) (lambda () (format "~a in ~a" (syntax-e cname) name)))))
(define (lookup-cls/intf d ri name) (define (lookup-cls/intf d ri tag)
(let ([v (resolve-get d ri `(cls/intf ,name))]) (let ([v (resolve-get d ri `(cls/intf ,(cadr tag)))])
(or v (or v
(make-cls/intf "unknown" (make-cls/intf "unknown"
#f #f
@ -2294,8 +2407,7 @@
#t #t
(list (make-element #f '("signature"))) (list (make-element #f '("signature")))
(lambda () (lambda ()
(let ([in (parameterize ([current-signature (make-sig (let ([in (parameterize ([current-signature (make-sig stx-id)])
(id-to-form-tag stx-id))])
(body-thunk))]) (body-thunk))])
(if indent? (if indent?
(let-values ([(pre-body post-body) (let-values ([(pre-body post-body)

77
collects/scribble/scheme.ss
View File

@ -1,10 +1,12 @@
(module scheme scheme/base (module scheme scheme/base
(require "struct.ss" (require "struct.ss"
"basic.ss" "basic.ss"
"search.ss"
mzlib/class mzlib/class
mzlib/for mzlib/for
setup/main-collects setup/main-collects
syntax/modresolve syntax/modresolve
syntax/modcode
(for-syntax scheme/base)) (for-syntax scheme/base))
(provide define-code (provide define-code
@ -12,8 +14,6 @@
to-element/no-color to-element/no-color
to-paragraph to-paragraph
to-paragraph/prefix to-paragraph/prefix
register-scheme-definition
register-scheme-form-definition
syntax-ize syntax-ize
syntax-ize-hook syntax-ize-hook
current-keyword-list current-keyword-list
@ -73,28 +73,30 @@
(values (substring s 1) #t #f) (values (substring s 1) #t #f)
(values s #f #f))))]) (values s #f #f))))])
(if (or (element? (syntax-e c)) (if (or (element? (syntax-e c))
(delayed-element? (syntax-e c))) (delayed-element? (syntax-e c))
(part-relative-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 (or it? is-var?))) (not (or it? is-var?)))
(let ([tag (register-scheme c)]) (if (pair? (identifier-label-binding c))
(if tag (make-delayed-element
(make-delayed-element (lambda (renderer sec ri)
(lambda (renderer sec ri) (let* ([tag (find-scheme-tag sec ri c 'for-label)])
(let* ([vtag `(def ,tag)] (if tag
[stag `(form ,tag)] (list
[sd (resolve-get/tentative sec ri stag)]) (case (car tag)
(list [(form)
(cond (make-link-element "schemesyntaxlink" (list s) tag)]
[sd [else
(make-link-element "schemesyntaxlink" (list s) stag)] (make-link-element "schemevaluelink" (list s) tag)]))
[else (list
(make-link-element "schemevaluelink" (list s) vtag)])))) (make-element "badlink"
(lambda () s) (list (make-element "schemevaluelink" (list s))))))))
(lambda () s)) (lambda () s)
s)) (lambda () s))
s)
(literalize-spaces s)) (literalize-spaces s))
(cond (cond
[(positive? quote-depth) value-color] [(positive? quote-depth) value-color]
@ -155,6 +157,8 @@
(element-width v)] (element-width v)]
[(delayed-element? v) [(delayed-element? v)
(element-width v)] (element-width v)]
[(part-relative-element? v)
(element-width v)]
[(spaces? v) [(spaces? v)
(+ (sz-loop (car (element-content v))) (+ (sz-loop (car (element-content v)))
(spaces-cnt v) (spaces-cnt v)
@ -538,41 +542,6 @@
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)])) [(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
(define (register-scheme stx [warn-if-no-label? #f])
(unless (identifier? stx)
(error 'register-scheme-definition "not an identifier: ~e" (syntax->datum stx)))
(let ([b (identifier-label-binding stx)])
(if (or (not b)
(eq? b 'lexical))
(if warn-if-no-label?
(begin
(fprintf (current-error-port)
"~a\n"
;; Call raise-syntax-error to capture error message:
(with-handlers ([exn:fail:syntax? (lambda (exn)
(exn-message exn))])
(raise-syntax-error 'WARNING
"no for-label binding of identifier"
stx)))
(format ":NOLABEL:~a" (syntax-e stx)))
#f)
(format ":~a:~a"
(let ([p (resolve-module-path-index (car b) #f)])
(if (path? p)
(path->main-collects-relative p)
p))
(cadr b)))))
(define (register-scheme/invent stx warn-if-no-label?)
(or (register-scheme stx warn-if-no-label?)
(format ":UNKNOWN:~a" (syntax-e stx))))
(define (register-scheme-definition stx [warn-if-no-label? #f])
`(def ,(register-scheme/invent stx warn-if-no-label?)))
(define (register-scheme-form-definition stx [warn-if-no-label? #f])
`(form ,(register-scheme/invent stx warn-if-no-label?)))
(define syntax-ize-hook (make-parameter (lambda (v col) #f))) (define syntax-ize-hook (make-parameter (lambda (v col) #f)))
(define (vector->short-list v extract) (define (vector->short-list v extract)

126
collects/scribble/search.ss Normal file
View File

@ -0,0 +1,126 @@
(module search scheme/base
(require "struct.ss"
"basic.ss"
setup/main-collects
syntax/modcode)
(provide find-scheme-tag)
(define module-info-cache (make-hash-table))
(define (module-path-index-rejoin mpi rel-to)
(let-values ([(name base) (module-path-index-split mpi)])
(cond
[(not name) rel-to]
[(not base) mpi]
[else
(module-path-index-join name
(module-path-index-rejoin base rel-to))])))
;; mode is #f, 'for-label, or 'for-run
(define (find-scheme-tag part ri stx/binding mode)
(let ([b (cond
[(identifier? stx/binding)
((case mode
[(for-label) identifier-label-binding]
[(for-syntax) identifier-transformer-binding]
[else identifier-binding])
stx/binding)]
[(and (list? stx/binding)
(= 6 (length stx/binding)))
stx/binding]
[else
(and (not (symbol? (car stx/binding)))
(let ([p (module-path-index-join
(main-collects-relative->path (car stx/binding))
#f)])
(list #f
(cadr stx/binding)
p
(cadr stx/binding)
#f
(if (= 2 (length stx/binding))
mode
(caddr stx/binding)))))])])
(and
(pair? b)
(let ([seen (make-hash-table)]
[search-key #f])
(let loop ([queue (list (list (caddr b) (cadddr b) (eq? mode (list-ref b 5))))]
[rqueue null])
(cond
[(null? queue)
(if (null? rqueue)
;; Not documented
#f
(loop (reverse rqueue) null))]
[else
(let ([mod (caar queue)]
[id (cadar queue)]
[here? (caddar queue)]
[queue (cdr queue)])
(let* ([rmp (module-path-index-resolve mod)]
[eb (and here?
(format "~a::~a"
(let ([p (resolved-module-path-name rmp)])
(if (path? p)
(path->main-collects-relative p)
p))
id))])
(when (and eb
(not search-key))
(set! search-key eb))
(let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))])
(or (and v
(let ([v (resolve-get/tentative part ri `(form ,eb))])
(or (and v `(form ,eb))
`(def ,eb))))
;; Maybe it's re-exported from this module...
;; Try a shortcut:
(if (eq? rmp (and (car b) (module-path-index-resolve (car b))))
;; Not defined through this path, so keep looking
(loop queue rqueue)
;; Check parents, if we can get the source:
(if (and (path? (resolved-module-path-name rmp))
(not (hash-table-get seen rmp #f)))
(let ([exports
(hash-table-get
module-info-cache
rmp
(lambda ()
(let-values ([(run-vals run-stxes
syntax-vals syntax-stxes
label-vals label-stxes)
(module-compiled-exports
(get-module-code (resolved-module-path-name rmp)))])
(let ([t (list (append run-vals run-stxes)
(append syntax-vals syntax-stxes)
(append label-vals label-stxes))])
(hash-table-put! module-info-cache rmp t)
t))))])
(hash-table-put! seen rmp #t)
(let ([a (assq id (list-ref exports
(if here?
0
(case mode
[(for-syntax) 1]
[(for-label) 2]
[else 0]))))])
(if a
(loop queue
(append (map (lambda (m)
(if (pair? m)
(list (module-path-index-rejoin (car m) mod)
(caddr m)
(or here?
(eq? mode (cadr m))))
(list (module-path-index-rejoin m mod)
id
here?)))
(cadr a))
rqueue))
(error 'find-scheme-tag
"dead end when looking for binding source: ~e"
id))))
;; Can't get the module source, so continue with queue:
(loop queue rqueue)))))))])))))))

66
collects/scribble/struct.ss
View File

@ -6,8 +6,8 @@
;; ---------------------------------------- ;; ----------------------------------------
(define-struct collect-info (ht ext-ht parts tags gen-prefix)) (define-struct collect-info (ht ext-ht parts tags gen-prefix relatives parents))
(define-struct resolve-info (ci delays undef)) (define-struct resolve-info (ci delays undef searches))
(define (part-collected-info part ri) (define (part-collected-info part ri)
(hash-table-get (collect-info-parts (resolve-info-ci ri)) (hash-table-get (collect-info-parts (resolve-info-ci ri))
@ -49,6 +49,18 @@
#t)) #t))
v)) v))
(define (resolve-search search-key part ri key)
(let ([s-ht (hash-table-get (resolve-info-searches ri)
search-key
(lambda ()
(let ([s-ht (make-hash-table 'equal)])
(hash-table-put! (resolve-info-searches ri)
search-key
s-ht)
s-ht)))])
(hash-table-put! s-ht key #t))
(resolve-get part ri key))
(define (resolve-get/tentative part ri key) (define (resolve-get/tentative part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)]) (let-values ([(v ext?) (resolve-get/where part ri key)])
v)) v))
@ -69,6 +81,7 @@
part-collected-info part-collected-info
collect-put! collect-put!
resolve-get resolve-get
resolve-search
resolve-get/tentative resolve-get/tentative
resolve-get-keys) resolve-get-keys)
@ -163,12 +176,11 @@
[target-url ([addr string?])] [target-url ([addr string?])]
[image-file ([path path-string?])]) [image-file ([path path-string?])])
;; ---------------------------------------- ;; ----------------------------------------
;; Delayed element has special serialization support: ;; Delayed element has special serialization support:
(define-struct delayed-element (resolve sizer plain) (define-struct delayed-element (resolve sizer plain)
#:mutable
#:property #:property
prop:serializable prop:serializable
(make-serialize-info (make-serialize-info
@ -210,6 +222,47 @@
;; ---------------------------------------- ;; ----------------------------------------
;; part-relative element has special serialization support:
(define-struct part-relative-element (collect sizer plain)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-part-relative-element
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-part-relative-element
"serialization failed (wrong resolve info?); ~a"
(exn-message exn)))])
(vector
(make-element #f (part-relative-element-content d ri))))))
#'deserialize-part-relative-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct part-relative-element ([collect (collect-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
(provide deserialize-part-relative-element)
(define deserialize-part-relative-element
(make-deserialize-info values values))
(provide part-relative-element-content)
(define (part-relative-element-content e ci/ri)
(hash-table-get (collect-info-relatives (if (resolve-info? ci/ri)
(resolve-info-ci ci/ri)
ci/ri))
e))
(provide collect-info-parents)
;; ----------------------------------------
;; Delayed index entry also has special serialization support. ;; Delayed index entry also has special serialization support.
;; It uses the same delay -> value table as delayed-element ;; It uses the same delay -> value table as delayed-element
(define-struct delayed-index-desc (resolve) (define-struct delayed-index-desc (resolve)
@ -336,6 +389,7 @@
[(c) [(c)
(cond (cond
[(element? c) (content->string (element-content c))] [(element? c) (content->string (element-content c))]
[(part-relative-element? c) (element->string ((part-relative-element-plain c)))]
[(delayed-element? c) (element->string ((delayed-element-plain c)))] [(delayed-element? c) (element->string ((delayed-element-plain c)))]
[(string? c) c] [(string? c) c]
[else (case c [else (case c
@ -356,6 +410,9 @@
[(delayed-element? c) [(delayed-element? c)
(content->string (delayed-element-content c ri) (content->string (delayed-element-content c ri)
renderer sec ri)] renderer sec ri)]
[(part-relative-element? c)
(content->string (part-relative-element-content c ri)
renderer sec ri)]
[else (element->string c)])])) [else (element->string c)])]))
(define (strip-aux content) (define (strip-aux content)
@ -376,6 +433,7 @@
[(string? s) (string-length s)] [(string? s) (string-length s)]
[(element? s) (apply + (map element-width (element-content s)))] [(element? s) (apply + (map element-width (element-content s)))]
[(delayed-element? s) (element-width ((delayed-element-sizer s)))] [(delayed-element? s) (element-width ((delayed-element-sizer s)))]
[(part-relative-element? s) (element-width ((part-relative-element-sizer s)))]
[else 1])) [else 1]))
(define (paragraph-width s) (define (paragraph-width s)

81
collects/scribble/xref.ss
View File

@ -4,6 +4,7 @@
scribble/manual-struct scribble/manual-struct
scribble/decode-struct scribble/decode-struct
scribble/base-render scribble/base-render
scribble/search
(prefix-in html: scribble/html-render) (prefix-in html: scribble/html-render)
scheme/class scheme/class
mzlib/serialize mzlib/serialize
@ -74,46 +75,50 @@
(void)))) (void))))
;; Returns (values <tag-or-#f> <form?>) ;; Returns (values <tag-or-#f> <form?>)
(define (xref-binding-tag xrefs src id) (define xref-binding-tag
(let ([search (case-lambda
(lambda (src) [(xrefs id/binding mode)
(let ([base (format ":~a:~a" (let ([search
(if (path? src) (lambda (id/binding)
(path->main-collects-relative src) (let ([tag (find-scheme-tag #f (xrefs-ri xrefs) id/binding mode)])
src) (if tag
id)] (values tag (eq? (car tag) 'form))
[ht (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs)))]) (values #f #f))))])
(let ([form-tag `(form ,base)]
[val-tag `(def ,base)])
(if (hash-table-get ht form-tag #f)
(values form-tag #t)
(if (hash-table-get ht val-tag #f)
(values val-tag #f)
(values #f #f))))))])
(let loop ([src src])
(cond (cond
[(path? src) [(identifier? id/binding)
(if (complete-path? src) (search id/binding)]
(search src) [(and (list? id/binding)
(loop (path->complete-path src)))] (= 6 (length id/binding)))
[(path-string? src) (search id/binding)]
(loop (path->complete-path src))] [(and (list? id/binding)
[(resolved-module-path? src) (= 2 (length id/binding)))
(let ([n (resolved-module-path-name src)]) (let loop ([src (car id/binding)])
(if (pair? n) (cond
(loop n) [(path? src)
(search n)))] (if (complete-path? src)
[(module-path-index? src) (search (list src (cadr id/binding)))
(loop (module-path-index-resolve src))] (loop (path->complete-path src)))]
[(module-path? src) [(path-string? src)
(loop (module-path-index-join src #f))] (loop (path->complete-path src))]
[else [(resolved-module-path? src)
(raise-type-error 'xref-binding-definition->tag (let ([n (resolved-module-path-name src)])
"module path, resolved module path, module path index, path, or string" (if (pair? n)
src)])))) (loop n)
(search n)))]
[(module-path-index? src)
(loop (module-path-index-resolve src))]
[(module-path? src)
(loop (module-path-index-join src #f))]
[else
(raise-type-error 'xref-binding-definition->tag
"list starting with module path, resolved module path, module path index, path, or string"
src)]))]
[else (raise-type-error 'xref-binding-definition->tag
"identifier, 2-element list, or 6-element list"
id/binding)]))]))
(define (xref-binding->definition-tag xrefs src id) (define (xref-binding->definition-tag xrefs id/binding mode)
(let-values ([(tag form?) (xref-binding-tag xrefs src id)]) (let-values ([(tag form?) (xref-binding-tag xrefs id/binding mode)])
tag)) tag))
(define (xref-tag->path+anchor xrefs tag #:render% [render% (html:render-mixin render%)]) (define (xref-tag->path+anchor xrefs tag #:render% [render% (html:render-mixin render%)])

2
collects/scribblings/scribble/bnf.scrbl
View File

@ -3,7 +3,7 @@
"utils.ss" "utils.ss"
(for-label scribble/bnf)) (for-label scribble/bnf))
@title[#:tag "bnf"]{Typesetting Grammars} @title[#:tag "bnf"]{BNF Grammars}
@defmodule[scribble/bnf]{The @scheme[scribble/bnf] library @defmodule[scribble/bnf]{The @scheme[scribble/bnf] library
provides utilities for typesetting grammars.} provides utilities for typesetting grammars.}

2
collects/scribblings/scribble/decode.scrbl
View File

@ -2,7 +2,7 @@
@require[scribble/manual] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "decode"]{Text Decoder} @title[#:tag "decode"]{Decoding Text}
@defmodule[scribble/decode]{The @schememodname[scribble/decode] @defmodule[scribble/decode]{The @schememodname[scribble/decode]
library helps you write document content in a natural way---more like library helps you write document content in a natural way---more like

4
collects/scribblings/scribble/doclang.scrbl
View File

@ -2,9 +2,9 @@
@require[scribble/manual] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "doclang"]{Document Module Language} @title[#:tag "doclang"]{Document Language}
@defmodule[scribble/doclang]{The @schememodname[scribble/doclang] @defmodulelang[scribble/doclang]{The @schememodname[scribble/doclang]
language provides everything from @scheme[scheme/base], except that it language provides everything from @scheme[scheme/base], except that it
replaces the @scheme[#%module-begin] form.} replaces the @scheme[#%module-begin] form.}

2
collects/scribblings/scribble/docreader.scrbl
View File

@ -5,7 +5,7 @@
@title[#:tag "docreader"]{Document Reader} @title[#:tag "docreader"]{Document Reader}
@defmodule[scribble/doc]{The @schememodname[scribble/doc] language is @defmodulelang[scribble/doc]{The @schememodname[scribble/doc] language is
the same as @schememodname[scribble/doclang], except that the same as @schememodname[scribble/doclang], except that
@scheme[read-inside-syntax] is used to read the body of the module. In @scheme[read-inside-syntax] is used to read the body of the module. In
other words, the module body starts in Scribble ``text'' mode instead other words, the module body starts in Scribble ``text'' mode instead

30
collects/scribblings/scribble/how-to.scrbl
View File

@ -292,7 +292,9 @@ hyperlinks.
To document a @scheme[my-helper] procedure that is exported by To document a @scheme[my-helper] procedure that is exported by
@filepath{helper.ss} in the collection that contains @filepath{helper.ss} in the collection that contains
@filepath{manual.scrbl}, first use @scheme[(require (for-label ....))] @filepath{manual.scrbl}, first use @scheme[(require (for-label ....))]
to import the binding information of @filepath{helper.ss}. Then use to import the binding information of @filepath{helper.ss}. Then add a
@scheme[defmodule] declaration, which connects the @scheme[for-label]
binding with the module path as seen by a reader. Finally, use
@scheme[defproc] to document the procedure: @scheme[defproc] to document the procedure:
@verbatim[#<<EOS @verbatim[#<<EOS
@ -303,6 +305,8 @@ to import the binding information of @filepath{helper.ss}. Then use
@title{My Library} @title{My Library}
@defmodule[my-lib/helper]
@defproc[(my-helper [lst list?]) @defproc[(my-helper [lst list?])
(listof (listof
(not/c (one-of/c 'cow)))]{ (not/c (one-of/c 'cow)))]{
@ -320,30 +324,6 @@ of the result must be given; in this case, @scheme[my-helper]
guarantees a result that is a list where none of the elements are guarantees a result that is a list where none of the elements are
@scheme['cow]. @scheme['cow].
Finally, the documentation should declare the module that is being
defined. Use @scheme[defmodule] to declare the module name before any
other definitions.
@verbatim[#<<EOS
#lang scribble/doc
@(require scribble/manual
(for-label scheme
"helper.ss"))
@title{My Library}
@defmodule[my-lib/helper]{The @schememodname[my-lib/helper]
module---now with extra cows!}
@defproc[(my-helper [lst list?])
(listof
(not/c (one-of/c 'cow)))]{
Replaces each @scheme['cow] in @scheme[lst] with
@scheme['aardvark].}
EOS
]
Some things to notice in this example and the documentation that it Some things to notice in this example and the documentation that it
generates: generates:

47
collects/scribblings/scribble/manual.scrbl
View File

@ -4,7 +4,7 @@
(for-syntax scheme/base) (for-syntax scheme/base)
(for-label scribble/manual-struct)) (for-label scribble/manual-struct))
@title[#:tag "manual"]{PLT Manual Forms} @title[#:tag "manual"]{Manual Forms}
@defmodule[scribble/manual]{The @schememodname[scribble/manual] @defmodule[scribble/manual]{The @schememodname[scribble/manual]
library provides all of @schememodname[scribble/basic], plus library provides all of @schememodname[scribble/basic], plus
@ -39,9 +39,9 @@ because that's the way it is idented the use of @scheme[schemeblock].
Furthermore, @scheme[define] is typeset as a keyword (bold and black) Furthermore, @scheme[define] is typeset as a keyword (bold and black)
and as a hyperlink to @scheme[define]'s definition in the reference and as a hyperlink to @scheme[define]'s definition in the reference
manual, because this document was built using a for-label binding of manual, because this document was built using a for-label binding of
@scheme[define] (in the source) that matches the for-label binding of @scheme[define] (in the source) that matches a definition in the
the definition in the reference manual. Similarly, @scheme[not] is a reference manual. Similarly, @scheme[not] is a hyperlink to the its
hyperlink to the its definition in the reference manual. definition in the reference manual.
Use @scheme[unsyntax] to escape back to an expression that produces an Use @scheme[unsyntax] to escape back to an expression that produces an
@scheme[element]. For example, @scheme[element]. For example,
@ -252,10 +252,14 @@ Produces a sequence of flow elements (encapsulated in a
@scheme[prototype]s corresponds to a curried function, as in @scheme[prototype]s corresponds to a curried function, as in
@scheme[define]. The @scheme[id] is indexed, and it also registered so @scheme[define]. The @scheme[id] is indexed, and it also registered so
that @scheme[scheme]-typeset uses of the identifier (with the same that @scheme[scheme]-typeset uses of the identifier (with the same
for-label binding) are hyperlinked to this documentation. The for-label binding) are hyperlinked to this documentation.
@scheme[id] should have a for-label binding (as introduced by
@scheme[require-for-label]) that determines the module binding being A @scheme[defmodule] or @scheme[declare-exporting] form (or one of the
defined. variants) in an enclosing section determines the @scheme[id] binding
that is being defined. The @scheme[id] should also have a for-label
binding (as introduced by @scheme[(require (for-label ...))]) that
matches the definition binding; otherwise, the defined @scheme[id]
will not typeset correctly within the definition.
Each @scheme[arg-spec] must have one of the following forms: Each @scheme[arg-spec] must have one of the following forms:
@ -317,10 +321,11 @@ Produces a a sequence of flow elements (encaptured in a
@scheme[splice]) to document a syntatic form named by @scheme[id]. The @scheme[splice]) to document a syntatic form named by @scheme[id]. The
@scheme[id] is indexed, and it is also registered so that @scheme[id] is indexed, and it is also registered so that
@scheme[scheme]-typeset uses of the identifier (with the same @scheme[scheme]-typeset uses of the identifier (with the same
for-label binding) are hyperlinked to this documentation. The for-label binding) are hyperlinked to this documentation.
@scheme[id] should have a for-label binding (as introduced by
@scheme[require-for-label]) that determines the module binding being The @scheme[defmodule] or @scheme[declare-exporting] requires, as well
defined. as the binding requirements for @scheme[id], are the same as for
@scheme[defproc].
The @tech{decode}d @scheme[pre-flow] documents the procedure. In this The @tech{decode}d @scheme[pre-flow] documents the procedure. In this
description, a reference to any identifier in @scheme[datum] via description, a reference to any identifier in @scheme[datum] via
@ -504,6 +509,19 @@ Like @scheme[defclass], but for an interfaces. Naturally,
Like @scheme[definterface], but for single-page rendering as in Like @scheme[definterface], but for single-page rendering as in
@scheme[defclass/title].} @scheme[defclass/title].}
@defform[(defmixin id (domain-id ...) (range-id ...) pre-flow ...)]{
Like @scheme[defclass], but for a mixin. Any number of
@scheme[domain-id] classes and interfaces are specified for the
mixin's input requires, and any number of result classes and (more
likely) interfaces are specified for the @scheme[range-id]. The
@scheme[domain-id]s supply inherited methods.}
@defform[(defmixin/title id (domain-id ...) (range-id ...) pre-flow ...)]{
Like @scheme[defmixin], but for single-page rendering as in
@scheme[defclass/title].}
@defform/subs[(defconstructor (arg-spec ...) pre-flow ...) @defform/subs[(defconstructor (arg-spec ...) pre-flow ...)
([arg-spec (arg-id contract-expr-datum) ([arg-spec (arg-id contract-expr-datum)
(arg-id contract-expr-datum default-expr)])]{ (arg-id contract-expr-datum default-expr)])]{
@ -867,6 +885,11 @@ class via @scheme[defclass] and company.}
Indicates that the index entry corresponds to the definition of an Indicates that the index entry corresponds to the definition of an
interface via @scheme[definterface] and company.} interface via @scheme[definterface] and company.}
@defstruct[(mixin-index-desc exported-index-desc) ()]{
Indicates that the index entry corresponds to the definition of a
mixin via @scheme[defmixin] and company.}
@defstruct[(method-index-desc exported-index-desc) ([method-name symbol?] @defstruct[(method-index-desc exported-index-desc) ([method-name symbol?]
[class-tag tag?])]{ [class-tag tag?])]{

2
collects/scribblings/scribble/reader.scrbl
View File

@ -5,7 +5,7 @@
@require["utils.ss"] @require["utils.ss"]
@require[(for-syntax scheme/base)] @require[(for-syntax scheme/base)]
@title[#:tag "reader"]{The Scribble Reader} @title[#:tag "reader"]{@"@"-Reader}
The Scribble @"@"-reader is designed to be a convenient facility for The Scribble @"@"-reader is designed to be a convenient facility for
using free-form text in Scheme code, where ``@"@"'' is chosen as one of using free-form text in Scheme code, where ``@"@"'' is chosen as one of

2
collects/scribblings/scribble/struct.scrbl
View File

@ -3,7 +3,7 @@
"utils.ss" "utils.ss"
(for-label scribble/manual-struct)) (for-label scribble/manual-struct))
@title[#:tag "struct"]{Document Structures And Processing} @title[#:tag "struct"]{Structures And Processing}
@defmodule[scribble/struct] @defmodule[scribble/struct]

68
collects/scribblings/scribble/xref.scrbl
View File

@ -39,17 +39,67 @@ get all cross-reference information for installed documentation.}
@defproc[(xref-binding->definition-tag [xref xref?] @defproc[(xref-binding->definition-tag [xref xref?]
[mod (or/c module-path? [binding (or/c identifier?
module-path-index? (list/c (or/c module-path?
path? module-path-index?
resolved-module-path?)] path?
[sym symbol?]) resolved-module-path?)
symbol?)
(listof module-path-index?
symbol?
module-path-index?
symbol?
boolean?
(one-of/c #f 'for-syntax 'for-label))
(list/c (or/c module-path?
module-path-index?
path?
resolved-module-path?)
symbol?
(one-of/c #f 'for-syntax 'for-label)))]
[mode (one-of/c #f 'for-syntax 'for-label)])
(or/c tag? false/c)]{ (or/c tag? false/c)]{
Locates a tag in @scheme[xref] that documents @scheme[sym] as defined Locates a tag in @scheme[xref] that documents a module export. The
by @scheme[mod]. The @scheme[sym] and @scheme[mod] combination binding is specified in one of several ways, as described below; all
correspond to the first two elements of a @scheme[identifier-binding] possibilities encode an exporting module and a symbolic name. The name
list result. must be exported from the specified module. Documentation is found
either for the specified module or, if the exported name is
re-exported from other other module, for the other module
(transitively).
The @scheme[mode] argument specifies more information about the
binding: whether it refers to a normal binding, a @scheme[for-syntax]
binding, or a @scheme[for-label] binding.
The @scheme[binding] is specified in one of four ways:
@itemize{
@item{If @scheme[binding] is an identifier, then
@scheme[identifier-binding],
@scheme[identifier-transformer-binding], or
@scheme[identifier-label-binding] is used to determine the
binding, depending on the value of @scheme[mode].}
@item{If @scheme[binding] is a two-element list, then the first
element provides the exporting module and the second the
exported name. The @scheme[mode] argument is effectively
ignored.}
@item{If @scheme[binding] is a six-element list, then it corresponds
to a result from @scheme[identifier-binding],
@scheme[identifier-transformer-binding], or
@scheme[identifier-label-binding], depending on the value of
@scheme[mode].}
@item{If @scheme[binding] is a three-element list, then the first
element is as for the 2-element-list case, the second element
is like the fourth element of the six-element case, and the
third element is like the sixth element of the six-element
case.}
}
If a documentation point exists in @scheme[xref], a tag is returned, If a documentation point exists in @scheme[xref], a tag is returned,
which might be used with @scheme[xref-tag->path+anchor] or embedded in which might be used with @scheme[xref-tag->path+anchor] or embedded in