From 8ee76c9547899f62e6f28eba1cdbba1f4d54c399 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}) --- collects/scribble/manual-struct.rkt | 1 + collects/scribble/private/manual-method.rkt | 32 ++++++++------- collects/scribble/private/manual-proc.rkt | 39 ++++++++++++++++--- .../scribblings/main/private/make-search.rkt | 5 ++- collects/scribblings/scribble/manual.scrbl | 9 +++++ collects/scribblings/tools/unit.scrbl | 4 -- 6 files changed, 65 insertions(+), 25 deletions(-) diff --git a/collects/scribble/manual-struct.rkt b/collects/scribble/manual-struct.rkt index 0e229abdfa..ef1f2f3f9d 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 ab095ce349..cd3023f15a 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 6507086910..7cac0409f3 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/main/private/make-search.rkt b/collects/scribblings/main/private/make-search.rkt index 573aa4b740..09ff68f86e 100644 --- a/collects/scribblings/main/private/make-search.rkt +++ b/collects/scribblings/main/private/make-search.rkt @@ -94,7 +94,10 @@ (string-append* `("[" ,@(add-between body ",") "]"))))))) (define manual-refs (make-hash)) (define l - (for/list ([i (get-index-entries sec ri)] [idx (in-naturals)]) + (for/list ([i (get-index-entries sec ri)] + [idx (in-naturals)] + ;; don't index constructors (the class itself is already indexed) + #:unless (constructor-index-desc? (list-ref i 3))) ;; i is (list tag (text ...) (element ...) index-desc) (define-values (tag texts elts desc) (apply values i)) (define text (string-downcase (string-join texts))) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 296f4ad53d..545dfbe2cf 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.} diff --git a/collects/scribblings/tools/unit.scrbl b/collects/scribblings/tools/unit.scrbl index e82cd3dfbe..c1b326ab01 100644 --- a/collects/scribblings/tools/unit.scrbl +++ b/collects/scribblings/tools/unit.scrbl @@ -230,10 +230,6 @@ This frame inserts the @onscreen{Racket} and @onscreen{Language} menus into the Passes all arguments to @racket[super-init]. } -@defconstructor[()]{ -Passes all arguments to @racket[super-init]. -} - @defmethod[#:mode override (add-show-menu-items [show-menu (is-a?/c menu%)]) void?]{