Add index entries for @defconstructor (and friends). Also add
code that skips over them when building the search indices. Overall, this means that the only change most people would see is that multiple constructors in the same class will get a warning (and there was one of those, so fixed that too). Also, Rackety. Specifically, transformed this surprising combination of constructs (where all caps are placeholders for something specific): ((if PRED (λ (c mk) BODY2) (λ (c mk) BODY1)) content (lambda (tag) BODY3)) into this one: (define (mk tag) BODY3) (if PRED BODY1{c:=content} BODY2{c:=content}) original commit: 8ee76c9547899f62e6f28eba1cdbba1f4d54c399
This commit is contained in:
parent
9dd4dddb90
commit
8799cd2137
|
@ -9,6 +9,7 @@
|
||||||
[from-libs (listof module-path?)])]
|
[from-libs (listof module-path?)])]
|
||||||
[(method-index-desc exported-index-desc) ([method-name symbol?]
|
[(method-index-desc exported-index-desc) ([method-name symbol?]
|
||||||
[class-tag tag?])]
|
[class-tag tag?])]
|
||||||
|
[(constructor-index-desc exported-index-desc) ([class-tag tag?])]
|
||||||
[(procedure-index-desc exported-index-desc) ()]
|
[(procedure-index-desc exported-index-desc) ()]
|
||||||
[(thing-index-desc exported-index-desc) ()]
|
[(thing-index-desc exported-index-desc) ()]
|
||||||
[(struct-index-desc exported-index-desc) ()]
|
[(struct-index-desc exported-index-desc) ()]
|
||||||
|
|
|
@ -11,6 +11,7 @@
|
||||||
; XXX unknown contracts
|
; XXX unknown contracts
|
||||||
(provide *method **method
|
(provide *method **method
|
||||||
method-tag
|
method-tag
|
||||||
|
constructor-tag
|
||||||
name-this-object)
|
name-this-object)
|
||||||
|
|
||||||
(define-syntax-rule (method a b)
|
(define-syntax-rule (method a b)
|
||||||
|
@ -23,25 +24,26 @@
|
||||||
(**method sym id))
|
(**method sym id))
|
||||||
|
|
||||||
(define (**method sym id/tag)
|
(define (**method sym id/tag)
|
||||||
(let ([content (list (symbol->string sym))])
|
(define content (list (symbol->string sym)))
|
||||||
((if (identifier? id/tag)
|
(define (mk tag)
|
||||||
(lambda (c mk)
|
(make-element symbol-color
|
||||||
(make-delayed-element
|
(list (make-link-element value-link-color content
|
||||||
(lambda (ren p ri)
|
(method-tag tag sym)))))
|
||||||
(let ([tag (find-scheme-tag p ri id/tag #f)])
|
(if (identifier? id/tag)
|
||||||
(if tag (list (mk tag)) content)))
|
(make-delayed-element
|
||||||
(lambda () (car content))
|
(λ (ren p ri)
|
||||||
(lambda () (car content))))
|
(let ([tag (find-scheme-tag p ri id/tag #f)])
|
||||||
(lambda (c mk) (mk id/tag)))
|
(if tag (list (mk tag)) content)))
|
||||||
content
|
(λ () (car content))
|
||||||
(lambda (tag)
|
(λ () (car content)))
|
||||||
(make-element symbol-color
|
(mk id/tag)))
|
||||||
(list (make-link-element value-link-color content
|
|
||||||
(method-tag tag sym))))))))
|
|
||||||
|
|
||||||
(define (method-tag vtag sym)
|
(define (method-tag vtag sym)
|
||||||
(list 'meth (list (cadr vtag) sym)))
|
(list 'meth (list (cadr vtag) sym)))
|
||||||
|
|
||||||
|
(define (constructor-tag vtag)
|
||||||
|
(list 'construtor (cadr vtag)))
|
||||||
|
|
||||||
(define (name-this-object type-sym)
|
(define (name-this-object type-sym)
|
||||||
(to-element
|
(to-element
|
||||||
(string->symbol
|
(string->symbol
|
||||||
|
|
|
@ -283,11 +283,40 @@
|
||||||
(syntax->datum stx-id) names)))
|
(syntax->datum stx-id) names)))
|
||||||
(define tagged
|
(define tagged
|
||||||
(cond
|
(cond
|
||||||
[(eq? mode 'new)
|
[(or (eq? mode 'new)
|
||||||
(make-element #f (list (racket new) spacer (to-element within-id)))]
|
(eq? mode 'make))
|
||||||
[(eq? mode 'make)
|
(define content
|
||||||
(make-element
|
(list (if (eq? mode 'new)
|
||||||
#f (list (racket make-object) spacer (to-element within-id)))]
|
(racket new)
|
||||||
|
(racket make-object))))
|
||||||
|
(define new-elem
|
||||||
|
(if first?
|
||||||
|
(let* ([target-maker (id-to-target-maker within-id #f)])
|
||||||
|
(if target-maker
|
||||||
|
(target-maker
|
||||||
|
content
|
||||||
|
(lambda (ctag)
|
||||||
|
(let ([tag (constructor-tag ctag)])
|
||||||
|
(make-toc-target-element
|
||||||
|
#f
|
||||||
|
(list (make-index-element
|
||||||
|
#f
|
||||||
|
content
|
||||||
|
tag
|
||||||
|
(list (datum-intern-literal (symbol->string (syntax-e within-id)))
|
||||||
|
(if (eq? mode 'new)
|
||||||
|
"new"
|
||||||
|
"make-object"))
|
||||||
|
content
|
||||||
|
(with-exporting-libraries
|
||||||
|
(lambda (libs)
|
||||||
|
(make-constructor-index-desc
|
||||||
|
(syntax-e within-id)
|
||||||
|
libs ctag)))))
|
||||||
|
tag))))
|
||||||
|
(car content)))
|
||||||
|
(car content)))
|
||||||
|
(make-element #f (list new-elem spacer (to-element within-id)))]
|
||||||
[(eq? mode 'send)
|
[(eq? mode 'send)
|
||||||
(make-element
|
(make-element
|
||||||
#f
|
#f
|
||||||
|
|
|
@ -1586,3 +1586,12 @@ from @racket[exported-index-desc] names the class or interface that
|
||||||
contains the method. The @racket[method-name] field names the method.
|
contains the method. The @racket[method-name] field names the method.
|
||||||
The @racket[class-tag] field provides a pointer to the start of the
|
The @racket[class-tag] field provides a pointer to the start of the
|
||||||
documentation for the method's class or interface.}
|
documentation for the method's class or interface.}
|
||||||
|
|
||||||
|
@defstruct[(constructor-index-desc exported-index-desc) ([class-tag tag?])]{
|
||||||
|
|
||||||
|
Indicates that the index entry corresponds to a constructor
|
||||||
|
via @racket[defconstructor] and company. The @racket[_name] field
|
||||||
|
from @racket[exported-index-desc] names the class or interface that
|
||||||
|
contains the method.
|
||||||
|
The @racket[class-tag] field provides a pointer to the start of the
|
||||||
|
documentation for the method's class or interface.}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user