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

add the ability to load in new mixins to DrRacket's

Browse Source 
various get/extend:extend functions
This commit is contained in:
Robby Findler 2013-04-05 22:38:01 -05:00
parent b05767ab13
commit 77163fe8d1
3 changed files with 65 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/drracket/private/drsig.rkt
View File

@ -190,7 +190,10 @@
get-definitions-text
get-interactions-canvas
get-definitions-canvas
get-unit-frame))
get-unit-frame
allow-re-extension!
disallow-re-extension!))
(define-signature drracket:unit-cm^
(tab%

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

@ -13,6 +13,10 @@
[prefix drracket:module-language-tools: drracket:module-language-tools^])
(export drracket:get/extend^)
(define re-extension-allowed? #f)
(define (allow-re-extension!) (set! re-extension-allowed? #t))
(define (disallow-re-extension!) (set! re-extension-allowed? #f))
(define make-extender
(λ (get-base% name [final-mixin values])
(let ([extensions (λ (x) x)]
@ -27,22 +31,26 @@
new%
(error 'extend-% "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 (get-built)
(unless built-yet?
(set! built-yet? #t)
(set! built (final-mixin (extensions (get-base%)))))
built)
(values
(letrec ([add-extender
(λ (extension [before? #t])
(when built-yet?
(error 'extender "cannot build a new extension of ~a after initialization"
name))
(set! extensions
(if before?
(compose (verify extension) extensions)
(compose extensions (verify extension)))))])
add-extender)
(λ ()
(unless built-yet?
(set! built-yet? #t)
(set! built (final-mixin (extensions (get-base%)))))
built)))))
(procedure-rename add-extender (string->symbol (format "extend-~a" name)))
(procedure-rename get-built (string->symbol (format "get-~a" name)))))))
(define (get-base-tab%)
(drracket:module-language:module-language-online-expand-tab-mixin

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

@ -969,6 +969,7 @@ 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<%>))
@ -1002,7 +1003,9 @@ all of the names in the tools library, for use defining keybindings
@{Once this function is called,
@racket[drracket:get/extend:extend-interactions-text]
raises an error, disallowing any more extensions.})
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
@ -1014,7 +1017,9 @@ all of the names in the tools library, for use defining keybindings
@{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.})
after already installed mixins.
See also @racket[drracket:get/extend:allow-re-extension!].})
(proc-doc/names
drracket:get/extend:get-definitions-text
@ -1023,7 +1028,9 @@ all of the names in the tools library, for use defining keybindings
@{Once this function is called,
@racket[drracket:get/extend:extend-definitions-text]
raises an error, disallowing any more extensions.})
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
@ -1044,7 +1051,9 @@ all of the names in the tools library, for use defining keybindings
@{Once this function is called,
@racket[drracket:get/extend:extend-interactions-canvas]
raises an error, disallowing any more extensions.})
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
@ -1056,7 +1065,9 @@ all of the names in the tools library, for use defining keybindings
@{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.})
after already installed mixins.
See also @racket[drracket:get/extend:allow-re-extension!].})
(proc-doc/names
drracket:get/extend:get-definitions-canvas
@ -1065,7 +1076,9 @@ all of the names in the tools library, for use defining keybindings
@{Once this function is called,
@racket[drracket:get/extend:extend-definitions-canvas]
raises an error, disallowing any more extensions.})
raises an error, disallowing any more extensions.
See also @racket[drracket:get/extend:allow-re-extension!].})
(proc-doc/names
drracket:get/extend:extend-unit-frame
@ -1077,7 +1090,9 @@ all of the names in the tools library, for use defining keybindings
@{This is the frame that implements the main DrRacket window.
The argument, @racket[before], controls if the mixin is applied before or
after already installed mixins.})
after already installed mixins.
See also @racket[drracket:get/extend:allow-re-extension!].})
(proc-doc/names
drracket:get/extend:get-unit-frame
@ -1086,9 +1101,24 @@ all of the names in the tools library, for use defining keybindings
@{Once this function is called,
@racket[drracket:get/extend:extend-unit-frame]
raises an error, disallowing any more extensions.})
raises an error, disallowing any more extensions.
See also @racket[drracket:get/extend:allow-re-extension!].})
(proc-doc/names
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
drracket:get/extend:allow-re-extension!
(-> void?)
()
@{Once this is called, re-extension of the mixins described in this
section are now allowed.})
;
;