From d8f455158c57483e6ab76d06c2f0ec4154284845 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 6 Apr 2013 18:51:14 -0500 Subject: [PATCH] make the get/extend extension more flexible Specifically, allow a name to be specified with an extension such that subsequent uses of those extensions will replace mixins instead of adding new ones --- collects/drracket/private/get-extend.rkt | 57 +++-- collects/drracket/tool-lib.rkt | 254 +++++++++++------------ 2 files changed, 168 insertions(+), 143 deletions(-) diff --git a/collects/drracket/private/get-extend.rkt b/collects/drracket/private/get-extend.rkt index 165c5a1010..9f9f199ef2 100644 --- a/collects/drracket/private/get-extend.rkt +++ b/collects/drracket/private/get-extend.rkt @@ -19,7 +19,9 @@ (define make-extender (λ (get-base% name [final-mixin values]) - (let ([extensions (λ (x) x)] + (define extend-name (string->symbol (format "extend-~a" name))) + (let ([names-for-changes '()] + [extensions '()] [built-yet? #f] [built #f] [verify @@ -29,27 +31,50 @@ (if (and (class? new%) (subclass? new% %)) new% - (error 'extend-% "expected output of extension to create a subclass of its input, got: ~a" + (error extend-name "expected output of extension to create a subclass of its input, got: ~a" new%)))))]) - (define (add-extender extension [before? #t]) - (when built-yet? - (cond - [re-extension-allowed? - (set! built-yet? #f)] - [else - (error 'extender "cannot build a new extension of ~a after initialization" - name)])) - (set! extensions - (if before? - (compose (verify extension) extensions) - (compose extensions (verify extension))))) + (define (add-extender extension [before? #t] #:name-for-changes [name-for-changes #f]) + (cond + [(and (symbol? name-for-changes) (member name-for-changes names-for-changes)) + (cond + [re-extension-allowed? + (set! extensions + (for/list ([e-extension (in-list extensions)] + [e-name (in-list names-for-changes)]) + (if (equal? e-name name-for-changes) + extension + e-extension))) + (set! built-yet? #f) + (set! built #f)] + [else + (error extend-name + "attempted to use name ~s multiple times without first enabling re-extensions" + name-for-changes)])] + [else + (when built-yet? + (cond + [re-extension-allowed? + (set! built-yet? #f) + (set! built #f)] + [else + (error extend-name + "cannot build a new extension of ~a after initialization" + name-for-changes)])) + (set! extensions + (if before? + (cons (verify extension) extensions) + (append extensions (list (verify extension))))) + (set! names-for-changes + (if before? + (cons name-for-changes names-for-changes) + (append names-for-changes (list name-for-changes))))])) (define (get-built) (unless built-yet? (set! built-yet? #t) - (set! built (final-mixin (extensions (get-base%))))) + (set! built (final-mixin ((apply compose extensions) (get-base%))))) built) (values - (procedure-rename add-extender (string->symbol (format "extend-~a" name))) + (procedure-rename add-extender extend-name) (procedure-rename get-built (string->symbol (format "get-~a" name))))))) (define (get-base-tab%) diff --git a/collects/drracket/tool-lib.rkt b/collects/drracket/tool-lib.rkt index a5cb650e07..3396a3c098 100644 --- a/collects/drracket/tool-lib.rkt +++ b/collects/drracket/tool-lib.rkt @@ -969,156 +969,156 @@ all of the names in the tools library, for use defining keybindings ; ;;;; - - (proc-doc/names - drracket:get/extend:extend-tab - (->* ((make-mixin-contract drracket:unit:tab<%>)) - (boolean?) - void?) - ((mixin) ((before? #t))) - - - @{This class implements the tabs in DrRacket. One is created for each tab - in a frame (each frame always has at least one tab, even if the tab bar is not shown) - - The @racket[before] argument controls if the mixin is applied before or - after already installed mixins.}) - - (proc-doc/names - drracket:get/extend:extend-interactions-text - (->* ((make-mixin-contract drracket:rep:text<%>)) - (boolean?) - void?) - ((mixin) ((before? #t))) - - @{This text is used in the bottom window of DrRacket frames. - - The @racket[before] argument controls if the mixin is applied before or - after already installed mixins.}) - - (proc-doc/names - drracket:get/extend:get-interactions-text - (-> (implementation?/c drracket:rep:text<%>)) - () - - @{Once this function is called, - @racket[drracket:get/extend:extend-interactions-text] - raises an error, disallowing any more extensions. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names - drracket:get/extend:extend-definitions-text - (->* ((make-mixin-contract drracket:unit:definitions-text<%>)) - (boolean?) - void?) - ((mixin) ((before? #t))) - - @{This text is used in the top window of DrRacket frames. - - The @racket[before] argument controls if the mixin is applied before or - after already installed mixins. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names - drracket:get/extend:get-definitions-text - (-> (implementation?/c drracket:unit:definitions-text<%>)) - () - - @{Once this function is called, - @racket[drracket:get/extend:extend-definitions-text] - raises an error, disallowing any more extensions. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names - drracket:get/extend:extend-interactions-canvas - (->* ((make-mixin-contract drracket:unit:interactions-canvas%)) - (boolean?) - void?) - ((mixin) ((before? #t))) - - @{This canvas is used in the bottom window of DrRacket frames. - - The @racket[before] argument, controls if the mixin is applied before or - after already installed mixins.}) - - (proc-doc/names - drracket:get/extend:get-interactions-canvas - (-> (subclass?/c drracket:unit:interactions-canvas%)) - () - - @{Once this function is called, - @racket[drracket:get/extend:extend-interactions-canvas] - raises an error, disallowing any more extensions. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names - drracket:get/extend:extend-definitions-canvas - (->* ((make-mixin-contract drracket:unit:definitions-canvas%)) - (boolean?) - void?) - ((mixin) ((before? #t))) - - @{This canvas is used in the top window of DrRacket frames. - - The @racket[before] argument controls if the mixin is applied before or - after already installed mixins. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names - drracket:get/extend:get-definitions-canvas - (-> (subclass?/c drracket:unit:definitions-canvas%)) - () - - @{Once this function is called, - @racket[drracket:get/extend:extend-definitions-canvas] - raises an error, disallowing any more extensions. - - See also @racket[drracket:get/extend:allow-re-extension!].}) - - (proc-doc/names + (proc-doc drracket:get/extend:extend-unit-frame - (->* ((make-mixin-contract drracket:unit:frame%)) - (boolean?) - void?) - ((mixin) ((before? #t))) + (->i ([mixin (make-mixin-contract drracket:unit:frame%)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) - @{This is the frame that implements the main DrRacket window. + @{Extends the class that is used for the frame that implements the main DrRacket window. - The argument, @racket[before], controls if the mixin is applied before or + The @racket[before] argument controls if the mixin is applied before or after already installed mixins. - See also @racket[drracket:get/extend:allow-re-extension!].}) + If @racket[name-for-changes] is a symbol and @racket[drracket:get/extend:allow-re-extension!] + has been called (without a subsequent call to @racket[drracket:get/extend:disallow-re-extension!]) + then calling this function replaces any earlier mixins that have been added + that have the same name. Otherwise, calling this with the same name + twice is an error and calling it once @racket[drracket:get/extend:get-frame] has been + called is an error.}) - (proc-doc/names + (proc-doc drracket:get/extend:get-unit-frame (-> (subclass?/c drracket:unit:frame%)) - () - @{Once this function is called, + @{Returns a class whose objects are used for the DrRacket frames. + + Once this function is called, @racket[drracket:get/extend:extend-unit-frame] raises an error, disallowing any more extensions. See also @racket[drracket:get/extend:allow-re-extension!].}) + + (proc-doc + drracket:get/extend:extend-tab + (->i ([mixin (make-mixin-contract drracket:unit:tab<%>)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) + @{Like @racket[drracket:get/extend:extend-unit-frame], except it extends the class + that implements the tabs in DrRacket. One is created for each tab + in a frame (each frame always has at least one tab, even if the tab bar is not shown).}) - (proc-doc/names + (proc-doc + drracket:get/extend:get-tab + (-> (implementation?/c drracket:unit:tab<%>)) + + @{Like @racket[drracket:get/extend:get-unit-frame], except it + returns the class used for tabs.}) + + (proc-doc + drracket:get/extend:extend-definitions-text + (->i ([mixin (make-mixin-contract drracket:unit:definitions-text<%>)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) + + @{Like @racket[drracket:get/extend:extend-unit-frame], except + this text is used in the top window of DrRacket frames.}) + + (proc-doc + drracket:get/extend:get-definitions-text + (-> (implementation?/c drracket:unit:definitions-text<%>)) + + @{Like @racket[drracket:get/extend:get-unit-frame], except + for the text that is used in the top window of DrRacket frames.}) + + + (proc-doc + drracket:get/extend:extend-interactions-text + (->i ([mixin (make-mixin-contract drracket:rep:text<%>)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) + @{Like @racket[drracket:get/extend:extend-unit-frame], except it extends the class + that implements the the editor in the interactions window.}) + + (proc-doc + drracket:get/extend:get-interactions-text + (-> (implementation?/c drracket:rep:text<%>)) + + @{Like @racket[drracket:get/extend:get-unit-frame] except it returns + the class that implements the editor in the interactions window.}) + + + (proc-doc + drracket:get/extend:extend-definitions-canvas + (->i ([mixin (make-mixin-contract drracket:unit:definitions-canvas%)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) + + @{Like @racket[drracket:get/extend:extend-unit-frame], except it extends the class + that implements the definitions window's @racket[editor-canvas%].}) + + (proc-doc + drracket:get/extend:get-definitions-canvas + (-> (subclass?/c drracket:unit:definitions-canvas%)) + + @{Like @racket[drracket:get/extend:get-unit-frame] except it returns + the class that implements the definitions window's @racket[editor-canvas%].}) + + (proc-doc + drracket:get/extend:extend-interactions-canvas + (->i ([mixin (make-mixin-contract drracket:unit:interactions-canvas%)]) + ([before boolean?] + #:name-for-changes [name-for-changes (or/c #f symbol?)]) + [result void?]) + (#t #f) + + @{Like @racket[drracket:get/extend:extend-unit-frame], except it extends the class + that implements the interactions window's @racket[editor-canvas%].}) + + (proc-doc + drracket:get/extend:get-interactions-canvas + (-> (subclass?/c drracket:unit:interactions-canvas%)) + + @{Like @racket[drracket:get/extend:get-unit-frame] except it returns + the class that implements the definitions window's @racket[editor-canvas%].}) + + + (proc-doc drracket:get/extend:disallow-re-extension! (-> void?) - () @{Once this is called, re-extension of the mixins described in this section is not allowed. This is the default state of mixin extension, but it can be changed by @racket[drracket:get/extend:allow-re-extension!].}) - (proc-doc/names + (proc-doc drracket:get/extend:allow-re-extension! (-> void?) - () @{Once this is called, re-extension of the mixins described in this - section are now allowed.}) + section are now allowed (see @racket[drracket:get/extend:extend-unit-frame] + for details of how to effect a re-extension). + + This mode is intended to support a faster development cycle, not for production code. + Specifically, the issue is that replacing mixins in this manner does not affect any + objects that have already been create and thus + there can, in general, be a mixture of old and new objects in a single DrRacket. + If some kind of systematic change to the classes is wanted, consider instead using + the @racketmodname[racket/surrogate] library. + + Once an extension happens, newly created objects will use the new mixins. + Mostly, however, creating a new frame will create a new set of all of the objects + that are extended in this section, so that can be used to experiment more quickly + with changes. + }) ; ;