From 8799cd213719d3c149b18dfabe1b5a4127f61062 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 11 Aug 2012 21:50:16 -0500 Subject: [PATCH] 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). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- collects/scribble/manual-struct.rkt | 1 + collects/scribble/private/manual-method.rkt | 32 +++++++++-------- collects/scribble/private/manual-proc.rkt | 39 ++++++++++++++++++--- collects/scribblings/scribble/manual.scrbl | 9 +++++ 4 files changed, 61 insertions(+), 20 deletions(-) diff --git a/collects/scribble/manual-struct.rkt b/collects/scribble/manual-struct.rkt index 0e229abd..ef1f2f3f 100644 --- a/collects/scribble/manual-struct.rkt +++ b/collects/scribble/manual-struct.rkt @@ -9,6 +9,7 @@ [from-libs (listof module-path?)])] [(method-index-desc exported-index-desc) ([method-name symbol?] [class-tag tag?])] + [(constructor-index-desc exported-index-desc) ([class-tag tag?])] [(procedure-index-desc exported-index-desc) ()] [(thing-index-desc exported-index-desc) ()] [(struct-index-desc exported-index-desc) ()] diff --git a/collects/scribble/private/manual-method.rkt b/collects/scribble/private/manual-method.rkt index ab095ce3..cd3023f1 100644 --- a/collects/scribble/private/manual-method.rkt +++ b/collects/scribble/private/manual-method.rkt @@ -11,6 +11,7 @@ ; XXX unknown contracts (provide *method **method method-tag + constructor-tag name-this-object) (define-syntax-rule (method a b) @@ -23,25 +24,26 @@ (**method sym id)) (define (**method sym id/tag) - (let ([content (list (symbol->string sym))]) - ((if (identifier? id/tag) - (lambda (c mk) - (make-delayed-element - (lambda (ren p ri) - (let ([tag (find-scheme-tag p ri id/tag #f)]) - (if tag (list (mk tag)) content))) - (lambda () (car content)) - (lambda () (car content)))) - (lambda (c mk) (mk id/tag))) - content - (lambda (tag) - (make-element symbol-color - (list (make-link-element value-link-color content - (method-tag tag sym)))))))) + (define content (list (symbol->string sym))) + (define (mk tag) + (make-element symbol-color + (list (make-link-element value-link-color content + (method-tag tag sym))))) + (if (identifier? id/tag) + (make-delayed-element + (λ (ren p ri) + (let ([tag (find-scheme-tag p ri id/tag #f)]) + (if tag (list (mk tag)) content))) + (λ () (car content)) + (λ () (car content))) + (mk id/tag))) (define (method-tag vtag sym) (list 'meth (list (cadr vtag) sym))) +(define (constructor-tag vtag) + (list 'construtor (cadr vtag))) + (define (name-this-object type-sym) (to-element (string->symbol diff --git a/collects/scribble/private/manual-proc.rkt b/collects/scribble/private/manual-proc.rkt index 65070869..7cac0409 100644 --- a/collects/scribble/private/manual-proc.rkt +++ b/collects/scribble/private/manual-proc.rkt @@ -283,11 +283,40 @@ (syntax->datum stx-id) names))) (define tagged (cond - [(eq? mode 'new) - (make-element #f (list (racket new) spacer (to-element within-id)))] - [(eq? mode 'make) - (make-element - #f (list (racket make-object) spacer (to-element within-id)))] + [(or (eq? mode 'new) + (eq? mode 'make)) + (define content + (list (if (eq? mode 'new) + (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) (make-element #f diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 296f4ad5..545dfbe2 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -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. The @racket[class-tag] field provides a pointer to the start of the 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.}