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

make the get/extend extension more flexible

Browse Source 
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
This commit is contained in:
Robby Findler 2013-04-06 18:51:14 -05:00
parent 8ce213bf1c
commit d8f455158c
2 changed files with 168 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/drracket/private/get-extend.rkt
View File

@ -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%)

254
collects/drracket/tool-lib.rkt
View File

@ -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.
})
;
;