change register-toolbar-button so that it accepts a number
argument and uses that to order the buttons in the DrRacket panel. Also, order all of the buttons via these numbers in a more sane way
This commit is contained in:
Robby Findler
parent
df504d482e
commit
f61f0830e5
|
|
@ -54,6 +54,7 @@ remain the same for tools that use them.
|
|||
register-toolbar-button
|
||||
register-toolbar-buttons
|
||||
unregister-toolbar-button
|
||||
sort-toolbar-buttons-panel
|
||||
get-tabs))
|
||||
|
||||
(define unit:definitions-text<%>
|
||||
|
|
|
|||
|
|
@ -21,35 +21,42 @@
|
|||
[prefix drracket: drracket:interface^])
|
||||
(export drracket:module-language-tools^)
|
||||
|
||||
(define-struct opt-out-toolbar-button (make-button id) #:transparent)
|
||||
(define-struct opt-out-toolbar-button (make-button id number) #:transparent)
|
||||
(define opt-out-toolbar-buttons '())
|
||||
|
||||
(define (add-opt-out-toolbar-button make-button id)
|
||||
(define (add-opt-out-toolbar-button make-button id #:number [number #f])
|
||||
(set! opt-out-toolbar-buttons
|
||||
(cons (make-opt-out-toolbar-button make-button id)
|
||||
(cons (make-opt-out-toolbar-button make-button id number)
|
||||
opt-out-toolbar-buttons)))
|
||||
|
||||
(define-local-member-name
|
||||
set-lang-toolbar-buttons
|
||||
get-lang-toolbar-buttons)
|
||||
|
||||
(define tab-mixin
|
||||
(mixin (drracket:unit:tab<%>) (drracket:module-language-tools:tab<%>)
|
||||
(inherit get-frame)
|
||||
(define toolbar-buttons '())
|
||||
(define/public (get-lang-toolbar-buttons) toolbar-buttons)
|
||||
(define/public (set-lang-toolbar-buttons bs)
|
||||
(define/public (set-lang-toolbar-buttons bs ns)
|
||||
(for-each
|
||||
(λ (old-button) (send (get-frame) remove-toolbar-button old-button))
|
||||
toolbar-buttons)
|
||||
(set! toolbar-buttons bs)
|
||||
(send (get-frame) register-toolbar-buttons toolbar-buttons)
|
||||
(send (get-frame) register-toolbar-buttons toolbar-buttons #:numbers ns)
|
||||
(send (get-frame) when-initialized
|
||||
(λ ()
|
||||
(send (send (get-frame) get-toolbar-button-panel) change-children
|
||||
(λ (l) toolbar-buttons)))))
|
||||
(λ (l) toolbar-buttons))))
|
||||
(send (get-frame) sort-toolbar-buttons-panel))
|
||||
(super-new)))
|
||||
|
||||
(define frame-mixin
|
||||
(mixin (drracket:unit:frame<%>) (drracket:module-language-tools:frame<%>)
|
||||
(inherit unregister-toolbar-button get-definitions-text)
|
||||
|
||||
(inherit unregister-toolbar-button
|
||||
get-definitions-text
|
||||
sort-toolbar-buttons-panel)
|
||||
|
||||
(define toolbar-button-panel #f)
|
||||
(define/public (when-initialized thunk)
|
||||
(cond
|
||||
|
|
@ -65,20 +72,19 @@
|
|||
(define/public (get-toolbar-button-panel) toolbar-button-panel)
|
||||
(define/public (remove-toolbar-button button)
|
||||
(send toolbar-button-panel change-children (λ (l) (remq button l)))
|
||||
(unregister-toolbar-button button))
|
||||
(unregister-toolbar-button button)
|
||||
(sort-toolbar-buttons-panel))
|
||||
(define/augment (on-tab-change old-tab new-tab)
|
||||
(inner (void) on-tab-change old-tab new-tab)
|
||||
(when toolbar-button-panel
|
||||
(send toolbar-button-panel change-children
|
||||
(λ (l) (send new-tab get-lang-toolbar-buttons)))))
|
||||
(λ (l) (send new-tab get-lang-toolbar-buttons)))
|
||||
(sort-toolbar-buttons-panel)))
|
||||
(super-new)
|
||||
(inherit get-button-panel)
|
||||
(set! toolbar-button-panel (new horizontal-panel%
|
||||
[parent (get-button-panel)]
|
||||
[stretchable-width #f]))
|
||||
;; move button panel to the front of the list
|
||||
(send (get-button-panel) change-children
|
||||
(λ (l) (cons toolbar-button-panel (remq toolbar-button-panel l))))
|
||||
(after-initialized)
|
||||
(set! after-initialized void)
|
||||
|
||||
|
|
@ -184,9 +190,13 @@
|
|||
'drracket/private/module-language-tools))
|
||||
(when info-result
|
||||
(register-new-buttons
|
||||
(ctc-on-info-proc-result (or/c #f (listof (list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drracket:unit:frame<%>) any))))
|
||||
(ctc-on-info-proc-result (or/c #f (listof (or/c (list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drracket:unit:frame<%>) any))
|
||||
(list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drracket:unit:frame<%>) any)
|
||||
(or/c real? #f)))))
|
||||
(or (info-proc 'drracket:toolbar-buttons #f)
|
||||
(info-proc 'drscheme:toolbar-buttons #f)))
|
||||
(ctc-on-info-proc-result (or/c #f (listof symbol?))
|
||||
|
|
@ -196,6 +206,15 @@
|
|||
(inherit get-tab)
|
||||
|
||||
(define/private (register-new-buttons buttons opt-out-ids)
|
||||
;; cleaned-up-buttons : (listof (list/c string? (is-a?/c bitmap%) (-> (is-a?/c drracket:unit:frame<%>) any) (or/c real? #f)))
|
||||
(define cleaned-up-buttons
|
||||
(cond
|
||||
[(not buttons) '()]
|
||||
[else
|
||||
(for/list ([button (in-list buttons)])
|
||||
(if (= 3 (length button))
|
||||
(append button (list #f))
|
||||
button))]))
|
||||
(let* ([tab (get-tab)]
|
||||
[frame (send tab get-frame)])
|
||||
(send frame when-initialized
|
||||
|
|
@ -203,7 +222,7 @@
|
|||
(send frame begin-container-sequence)
|
||||
|
||||
;; avoid any time with both sets of buttons in the panel so the window doesn't get too wide
|
||||
(send (send frame get-toolbar-button-panel) change-children (λ (x) '()))
|
||||
(send (send frame get-toolbar-button-panel) change-children (λ (prev) '()))
|
||||
|
||||
(let ([directly-specified-buttons
|
||||
(map (λ (button-spec)
|
||||
|
|
@ -214,25 +233,27 @@
|
|||
[callback
|
||||
(lambda (button)
|
||||
((list-ref button-spec 2) frame))]))
|
||||
(or buttons '()))]
|
||||
[opt-out-buttons
|
||||
cleaned-up-buttons)]
|
||||
[directly-specified-button-numbers (map (λ (button-spec) (list-ref button-spec 3))
|
||||
cleaned-up-buttons)]
|
||||
[opt-out-buttons+numbers
|
||||
(if (eq? opt-out-ids #f)
|
||||
'()
|
||||
(map
|
||||
(λ (opt-out-toolbar-button)
|
||||
((opt-out-toolbar-button-make-button opt-out-toolbar-button)
|
||||
frame
|
||||
(send frame get-toolbar-button-panel)))
|
||||
(list ((opt-out-toolbar-button-make-button opt-out-toolbar-button)
|
||||
frame
|
||||
(send frame get-toolbar-button-panel))
|
||||
(opt-out-toolbar-button-number opt-out-toolbar-button)))
|
||||
(filter (λ (opt-out-toolbar-button)
|
||||
(not (member (opt-out-toolbar-button-id opt-out-toolbar-button)
|
||||
opt-out-ids)))
|
||||
opt-out-toolbar-buttons)))])
|
||||
(send tab set-lang-toolbar-buttons
|
||||
(sort
|
||||
(append directly-specified-buttons
|
||||
opt-out-buttons)
|
||||
string<=?
|
||||
#:key (λ (x) (send x get-label)))))
|
||||
(append directly-specified-buttons
|
||||
(map (λ (x) (list-ref x 0)) opt-out-buttons+numbers))
|
||||
(append directly-specified-button-numbers
|
||||
(map (λ (x) (list-ref x 1)) opt-out-buttons+numbers))))
|
||||
(send frame end-container-sequence)))))
|
||||
|
||||
(inherit get-text)
|
||||
|
|
@ -247,7 +268,7 @@
|
|||
|
||||
;; removes language-specific customizations
|
||||
(define/private (clear-things-out)
|
||||
(send (get-tab) set-lang-toolbar-buttons '()))
|
||||
(send (get-tab) set-lang-toolbar-buttons '() '()))
|
||||
|
||||
(define/augment (after-set-next-settings settings)
|
||||
(update-in-module-language?
|
||||
|
|
|
|||
|
|
@ -181,7 +181,8 @@ If the namespace does not, they are colored the unbound color.
|
|||
(alternate-bitmap syncheck-small-bitmap)
|
||||
(parent parent)
|
||||
(callback (λ (button) (send frame syncheck:button-callback)))))
|
||||
'drracket:syncheck)
|
||||
'drracket:syncheck
|
||||
#:number 50)
|
||||
(drracket:unit:add-to-program-editor-mixin clearing-text-mixin))
|
||||
(define (phase2) (void))
|
||||
|
||||
|
|
@ -1544,15 +1545,17 @@ If the namespace does not, they are colored the unbound color.
|
|||
|
||||
(define/private (update-button-visibility/tab tab)
|
||||
(update-button-visibility/settings (send (send tab get-defs) get-next-settings)))
|
||||
(inherit sort-toolbar-buttons-panel)
|
||||
(define/public (update-button-visibility/settings settings)
|
||||
(let* ([lang (drracket:language-configuration:language-settings-language settings)]
|
||||
[visible? (and (not (is-a? lang drracket:module-language:module-language<%>))
|
||||
(send lang capability-value 'drscheme:check-syntax-button))])
|
||||
(send check-syntax-button-parent-panel change-children
|
||||
(send (get-button-panel) change-children
|
||||
(λ (l)
|
||||
(if visible?
|
||||
(list check-syntax-button)
|
||||
'())))))
|
||||
(cons check-syntax-button (remq check-syntax-button l))
|
||||
(remq check-syntax-button l))))
|
||||
(sort-toolbar-buttons-panel)))
|
||||
|
||||
;; set-syncheck-running-mode : (or/c (box boolean?) 'button #f) -> boolean
|
||||
;; records how a particular check syntax is being played out in the editor right now.
|
||||
|
|
@ -2037,25 +2040,16 @@ If the namespace does not, they are colored the unbound color.
|
|||
|
||||
(super-new)
|
||||
|
||||
(define check-syntax-button-parent-panel
|
||||
(new horizontal-panel%
|
||||
[parent (get-button-panel)]
|
||||
[stretchable-width #f]
|
||||
[stretchable-height #f]))
|
||||
(define check-syntax-button
|
||||
(new switchable-button%
|
||||
(label (string-constant check-syntax))
|
||||
(bitmap syncheck-bitmap)
|
||||
(alternate-bitmap syncheck-small-bitmap)
|
||||
(parent check-syntax-button-parent-panel)
|
||||
(callback (λ (button) (syncheck:button-callback)))))
|
||||
[label (string-constant check-syntax)]
|
||||
[bitmap syncheck-bitmap]
|
||||
[alternate-bitmap syncheck-small-bitmap]
|
||||
[parent (get-button-panel)]
|
||||
[callback (λ (button) (syncheck:button-callback))]))
|
||||
(inherit register-toolbar-button)
|
||||
(register-toolbar-button check-syntax-button)
|
||||
(register-toolbar-button check-syntax-button #:number 50)
|
||||
(define/public (syncheck:get-button) check-syntax-button)
|
||||
(send (get-button-panel) change-children
|
||||
(λ (l)
|
||||
(cons check-syntax-button-parent-panel
|
||||
(remove check-syntax-button-parent-panel l))))
|
||||
(update-button-visibility/tab (get-current-tab))))
|
||||
|
||||
(define report-error-style (make-object style-delta% 'change-style 'italic))
|
||||
|
|
|
|||
|
|
@ -1886,12 +1886,11 @@ module browser threading seems wrong.
|
|||
(when (or (is-a? obj vertical-panel%)
|
||||
(is-a? obj horizontal-panel%))
|
||||
(unless (equal? (send obj get-orientation) (not vertical?))
|
||||
(send obj set-orientation (not vertical?))
|
||||
;; have to be careful to avoid reversing the list when the orientation is already proper
|
||||
(send obj change-children reverse)))
|
||||
(send obj set-orientation (not vertical?))))
|
||||
(for-each loop (send obj get-children))))
|
||||
(sort-toolbar-buttons-panel)
|
||||
|
||||
(orient)
|
||||
(set-toolbar-label-visibilities/check-registered)
|
||||
|
||||
(send top-outer-panel stretchable-height vertical?)
|
||||
(send top-outer-panel stretchable-width (not vertical?))
|
||||
|
|
@ -1918,31 +1917,102 @@ module browser threading seems wrong.
|
|||
(send name-panel set-alignment 'left 'center))
|
||||
(end-container-sequence)))
|
||||
|
||||
(define toolbar-buttons '())
|
||||
(define/public (register-toolbar-button b)
|
||||
(set! toolbar-buttons (cons b toolbar-buttons))
|
||||
(orient))
|
||||
;; this table uses object identity on buttons(!)
|
||||
(define toolbar-buttons (make-hasheq))
|
||||
(define smallest #f)
|
||||
|
||||
(define/public (register-toolbar-buttons bs)
|
||||
(set! toolbar-buttons (append bs toolbar-buttons))
|
||||
(orient))
|
||||
(define/public (register-toolbar-button b #:number [number/f #f])
|
||||
(add-to-toolbar-buttons 'register-toolbar-button b number/f)
|
||||
(set-toolbar-label-visibilities/check-registered)
|
||||
(sort-toolbar-buttons-panel))
|
||||
|
||||
(define/public (register-toolbar-buttons bs #:numbers [numbers/fs (make-list (length bs) #f)])
|
||||
(for ([b (in-list bs)]
|
||||
[n (in-list numbers/fs)])
|
||||
(add-to-toolbar-buttons 'register-toolbar-buttons b n))
|
||||
(set-toolbar-label-visibilities/check-registered)
|
||||
|
||||
;; sort panel contents
|
||||
(define panels '())
|
||||
(for ([tb (in-list bs)])
|
||||
(define parent (send tb get-parent))
|
||||
(unless (memq parent panels)
|
||||
(set! panels (cons parent panels))))
|
||||
(for ([panel (in-list panels)])
|
||||
(sort-toolbar-buttons-panel)))
|
||||
|
||||
(define/private (add-to-toolbar-buttons who button number/f)
|
||||
(define number (or number/f (if smallest (- smallest 1) 100)))
|
||||
(define prev (hash-ref toolbar-buttons button #f))
|
||||
(when (and prev (not (= prev number)))
|
||||
(error who "cannot add toolbar button ~s with number ~a; already added with ~a"
|
||||
(send button get-label)
|
||||
number
|
||||
prev))
|
||||
(when (or (not smallest) (< number smallest))
|
||||
(set! smallest number))
|
||||
(hash-set! toolbar-buttons button number))
|
||||
|
||||
(define/private (in-toolbar-list? b) (hash-ref toolbar-buttons b #f))
|
||||
|
||||
(define/public (unregister-toolbar-button b)
|
||||
(set! toolbar-buttons (remq b toolbar-buttons))
|
||||
(hash-remove! toolbar-buttons b)
|
||||
(set! smallest
|
||||
(if (zero? (hash-count toolbar-buttons))
|
||||
#f
|
||||
(apply min (hash-map toolbar-buttons (λ (x y) y)))))
|
||||
(void))
|
||||
|
||||
(define/private (orient)
|
||||
(define/public (sort-toolbar-buttons-panel)
|
||||
(define bp (get-button-panel))
|
||||
(when (is-a? bp panel%)
|
||||
(let sort-loop ([panel bp])
|
||||
(define min #f)
|
||||
(send panel change-children
|
||||
(λ (l)
|
||||
(define sub-panel-nums (make-hash))
|
||||
(for ([x (in-list l)])
|
||||
(when (is-a? x area-container<%>)
|
||||
(hash-set! sub-panel-nums x (sort-loop x))))
|
||||
(define (key i)
|
||||
(or (let loop ([item i])
|
||||
(cond
|
||||
[(is-a? item area-container<%>)
|
||||
(hash-ref sub-panel-nums item)]
|
||||
[else
|
||||
(hash-ref toolbar-buttons item #f)]))
|
||||
-5000))
|
||||
(define (min/f a b)
|
||||
(cond
|
||||
[(and a b) (min a b)]
|
||||
[else (or a b)]))
|
||||
(define cmp
|
||||
(cond
|
||||
[(is-a? panel vertical-pane%) >=]
|
||||
[(is-a? panel horizontal-pane%) <=]
|
||||
[else
|
||||
(if (send panel get-orientation) ;; horizontal is #t
|
||||
<=
|
||||
>=)]))
|
||||
(define ans (sort l cmp #:key key))
|
||||
(set! min (if (null? ans)
|
||||
#f
|
||||
(key (car ans))))
|
||||
ans))
|
||||
min)
|
||||
(void)))
|
||||
|
||||
(define/private (set-toolbar-label-visibilities/check-registered)
|
||||
(let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
|
||||
(for-each
|
||||
(λ (obj) (send obj set-label-visible (not vertical?)))
|
||||
toolbar-buttons))
|
||||
(for ([(button number) (in-hash toolbar-buttons)])
|
||||
(send button set-label-visible (not vertical?))))
|
||||
|
||||
(let loop ([obj button-panel])
|
||||
(cond
|
||||
[(is-a? obj area-container<%>)
|
||||
(for-each loop (send obj get-children))]
|
||||
[(is-a? obj switchable-button%)
|
||||
(unless (memq obj toolbar-buttons)
|
||||
(unless (in-toolbar-list? obj)
|
||||
(error 'register-toolbar-button
|
||||
"found a switchable-button% that is not registered, label ~s"
|
||||
(send obj get-label)))]
|
||||
|
|
@ -4293,7 +4363,7 @@ module browser threading seems wrong.
|
|||
[callback (λ (x) (execute-callback))]
|
||||
[bitmap execute-bitmap]
|
||||
[label (string-constant execute-button-label)]))
|
||||
(register-toolbar-button execute-button)
|
||||
(register-toolbar-button execute-button #:number 100)
|
||||
|
||||
(set! break-button
|
||||
(new switchable-button%
|
||||
|
|
@ -4301,7 +4371,7 @@ module browser threading seems wrong.
|
|||
[callback (λ (x) (send current-tab break-callback))]
|
||||
[bitmap break-bitmap]
|
||||
[label (string-constant break-button-label)]))
|
||||
(register-toolbar-button break-button)
|
||||
(register-toolbar-button break-button #:number 101)
|
||||
|
||||
(send button-panel stretchable-height #f)
|
||||
(send button-panel stretchable-width #f)
|
||||
|
|
|
|||
|
|
@ -87,18 +87,22 @@ all of the names in the tools library, for use defining keybindings
|
|||
|
||||
(proc-doc/names
|
||||
drracket:module-language-tools:add-opt-out-toolbar-button
|
||||
(-> (-> (is-a?/c top-level-window<%>)
|
||||
(is-a?/c area-container<%>)
|
||||
(is-a?/c switchable-button%))
|
||||
symbol?
|
||||
void?)
|
||||
(make-button id)
|
||||
(->* ((-> (is-a?/c top-level-window<%>)
|
||||
(is-a?/c area-container<%>)
|
||||
(is-a?/c switchable-button%))
|
||||
symbol?)
|
||||
(#:number (or/c real? #f))
|
||||
void?)
|
||||
((make-button id) ((number #f)))
|
||||
@{Call this function to add another button to DrRacket's toolbar. When buttons are added this way,
|
||||
DrRacket monitors the @tt{#lang} line at the top of the file; when it changes DrRacket queries
|
||||
the language to see if this button should be included.
|
||||
These buttons are ``opt out'', meaning that if the language doesn't explicitly ask to not
|
||||
have this button (or all such buttons), the button will appear.
|
||||
|
||||
The @racket[number] argument is the same as the @racket[number] argument
|
||||
to @method[drracket:unit:frame<%> register-toolbar-button].
|
||||
|
||||
@language-info-def[drracket:opt-out-toolbar-buttons]{
|
||||
See @racket[read-language] for more details on how a language can opt out.
|
||||
DrRacket will invoke the @tt{get-info} proc from @racket[read-language] with
|
||||
|
|
|
|||
|
|
@ -1382,7 +1382,7 @@
|
|||
[alignment '(center center)]))
|
||||
(callback (λ (button) (debug-callback)))))
|
||||
(inherit register-toolbar-button)
|
||||
(register-toolbar-button debug-button)
|
||||
(register-toolbar-button debug-button #:number 60)
|
||||
|
||||
(define/augment (enable-evaluation)
|
||||
(send debug-button enable #t)
|
||||
|
|
|
|||
|
|
@ -806,7 +806,7 @@
|
|||
get-editor)))])))]))
|
||||
|
||||
(inherit register-toolbar-button)
|
||||
(register-toolbar-button client-button)
|
||||
(register-toolbar-button client-button #:number -1000)
|
||||
|
||||
(send (get-button-panel) change-children
|
||||
(lambda (l) (cons client-panel (remq client-panel l))))))
|
||||
|
|
|
|||
|
|
@ -102,7 +102,8 @@
|
|||
(alternate-bitmap small-macro-debugger-bitmap)
|
||||
(parent parent)
|
||||
(callback (lambda (button) (send frame run-macro-stepper)))))
|
||||
'macro-stepper)
|
||||
'macro-stepper
|
||||
#:number 70)
|
||||
(drracket:language:register-capability
|
||||
'macro-stepper:enabled
|
||||
boolean?
|
||||
|
|
@ -138,7 +139,7 @@
|
|||
(parent macro-debug-panel)
|
||||
(callback (lambda (button) (run-macro-stepper)))))
|
||||
(inherit register-toolbar-button)
|
||||
(register-toolbar-button macro-debug-button)
|
||||
(register-toolbar-button macro-debug-button #:number 70)
|
||||
|
||||
(define/augment (enable-evaluation)
|
||||
(send macro-debug-button enable #t)
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
|
||||
(define original-error-display-handler (error-display-handler))
|
||||
|
||||
(define (make-render-button label bmp mode suffix)
|
||||
(define (make-render-button label bmp mode suffix number)
|
||||
(list
|
||||
label
|
||||
bmp
|
||||
|
|
@ -54,15 +54,16 @@
|
|||
(system (format "open \"~a\"" (path->string (path-replace-suffix fn suffix)))))])))])
|
||||
(send drs-frame execute-callback))]
|
||||
[else
|
||||
(message-box "Scribble" "Cannot render buffer without filename")]))))
|
||||
(message-box "Scribble" "Cannot render buffer without filename")]))
|
||||
number))
|
||||
|
||||
(define drracket-buttons
|
||||
(let ([html-button
|
||||
(make-render-button "Scribble HTML" html.png "--html" #".html")]
|
||||
(make-render-button "Scribble HTML" html.png "--html" #".html" 99)]
|
||||
[pdf-button
|
||||
;; only available on OSX currently
|
||||
;; when we have a general way of opening pdfs, can use that
|
||||
(make-render-button "Scribble PDF" pdf.png "--pdf" #".pdf")])
|
||||
(make-render-button "Scribble PDF" pdf.png "--pdf" #".pdf" 98)])
|
||||
(case (system-type)
|
||||
[(macosx) (list html-button pdf-button)]
|
||||
[else (list html-button)])))
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@
|
|||
(get-definitions-text)))]
|
||||
[parent (get-button-panel)]
|
||||
[bitmap reverse-content-bitmap])])
|
||||
(register-toolbar-button btn)
|
||||
(register-toolbar-button btn #:number 11)
|
||||
(send (get-button-panel) change-children
|
||||
(λ (l)
|
||||
(cons btn (remq btn l)))))))
|
||||
|
|
|
|||
|
|
@ -14,11 +14,15 @@ Specifically, DrRacket will pass @indexed-racket['drracket:toolbar-buttons]
|
|||
to the function and expect back a value matching this contract:
|
||||
@racketblock[(or/c (listof (list/c string?
|
||||
(is-a?/c bitmap%)
|
||||
(-> (is-a?/c drracket:unit:frame<%>) any)))
|
||||
(-> (is-a?/c drracket:unit:frame<%>) any)
|
||||
(or/c real? #f)))
|
||||
#f)]
|
||||
which is then used to create new toolbar buttons, one for each list in the
|
||||
first. The string is the label on the button; the bitmap is the icon
|
||||
(it should be 16x16), and the function is called when the button is clicked.
|
||||
(it should be 16x16); the function is called when the button is clicked;
|
||||
and the number is passed as the @racket[#:number] argument to
|
||||
@method[drracket:unit:frame<%> register-toolbar-button].
|
||||
|
||||
If the result is @racket[#f], then no toolbar buttons are created.
|
||||
|
||||
To implement functionality similar to the Run button, call the
|
||||
|
|
@ -28,6 +32,8 @@ want to use the @racket[drracket:rep:after-expression] parameter.
|
|||
If @racket['drracket:toolbar-buttons] is not recognized, DrRacket will also
|
||||
pass @indexed-racket['drscheme:toolbar-buttons]; this is for backwards
|
||||
compatibility and new code should not use it.
|
||||
Similarly, if the fourth element from the list (the argument to @racket[#:number])
|
||||
is not present, then it is treated as @racket[#f].
|
||||
|
||||
|
||||
@(tools-include "module-language-tools")
|
||||
|
|
|
|||
|
|
@ -724,16 +724,54 @@ Note that the capability must be registered separately, via
|
|||
|
||||
}
|
||||
|
||||
@defmethod[(register-toolbar-button [tb (is-a?/c switchable-button%)]) void?]{
|
||||
Registers the toolbar button @racket[tb]. This is required
|
||||
@defmethod[(register-toolbar-button
|
||||
[tb (is-a?/c switchable-button%)]
|
||||
[#:number num (or/c #f real?) #f])
|
||||
void?]{
|
||||
Registers the toolbar button @racket[tb].
|
||||
|
||||
The @racket[num] argument controls the ordering of @racket[tb]
|
||||
with respect to other toolbar buttons. If it is
|
||||
@racket[#f], then a number one smaller than the currently
|
||||
smallest number is used.
|
||||
|
||||
The buttons are sorted by their numbers, from left to right
|
||||
in horizontal mode and from top to bottom in vertical mode.
|
||||
If buttons are in sub-panels they cannot, in general, be
|
||||
sorted entirely by number without changing the panel
|
||||
structure, but when a sub-panel appears as a sibling of
|
||||
some toolbar buttons, the sorting routine looks for the smallest
|
||||
number appearing in a button in the sub-panel, and uses that
|
||||
number when sorting the panel that appears with the buttons.
|
||||
|
||||
A number of buttons already come with numbers:
|
||||
the @onscreen{Stop} button's number is @racket[101],
|
||||
the @onscreen{Run} button's number is @racket[100],
|
||||
the @onscreen{Scribble PDF} button's number is @racket[99],
|
||||
the @onscreen{Scribble HTML} button's number is @racket[98],
|
||||
the @onscreen{Macro Stepper} button's number is @racket[70],
|
||||
the @onscreen{Debug} button's number is @racket[60],
|
||||
the @onscreen{Stepper} button's number is @racket[59], and
|
||||
the @onscreen{Check Syntax} button's number is @racket[50].
|
||||
|
||||
All three are children of the panel returned by
|
||||
@method[drracket:unit:frame% get-button-panel].
|
||||
|
||||
Registration is required
|
||||
so that the toolbar buttons properly switch orientation when
|
||||
the toolbar's position is moved.
|
||||
the toolbar's position is moved and the ordering via the
|
||||
@racket[number] argument is preserved.
|
||||
See also @method[drracket:unit:frame<%> sort-toolbar-buttons-panel].
|
||||
}
|
||||
|
||||
@defmethod[(register-toolbar-buttons [tbs (listof (is-a?/c switchable-button%))]) void?]{
|
||||
Simultaneously registers the toolbar buttons @racket[tbs]. This is required
|
||||
so that the toolbar buttons properly switch orientation when
|
||||
the toolbar's position is moved.
|
||||
@defmethod[(register-toolbar-buttons
|
||||
[tbs (listof (is-a?/c switchable-button%))]
|
||||
[#:numbers nums (listof (or/c real? #f)) (make-list (length tbs) #f)])
|
||||
void?]{
|
||||
Simultaneously registers the toolbar buttons @racket[tbs].
|
||||
|
||||
See also @method[drracket:unit:frame<%> register-toolbar-button].
|
||||
|
||||
}
|
||||
|
||||
@defmethod[(unregister-toolbar-button [tb (is-a?/c switchable-button%)]) void?]{
|
||||
|
|
@ -741,6 +779,12 @@ Unregisters the toolbar button @racket[tb]. Use this method to ensure
|
|||
that the button is not referenced by this frame and thus can be gc'd.
|
||||
}
|
||||
|
||||
@defmethod[(sort-toolbar-buttons-panel) void?]{
|
||||
Sorts the children of @method[drracket:unit:frame% get-button-panel],
|
||||
according to the @racket[number] argument passed to
|
||||
@method[drracket:unit:frame<%> register-toolbar-button].
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -186,7 +186,7 @@
|
|||
[callback (lambda (dont-care) (send (get-current-tab)
|
||||
stepper-button-callback))]))
|
||||
|
||||
(register-toolbar-button stepper-button)
|
||||
(register-toolbar-button stepper-button #:number 59)
|
||||
|
||||
(define (stepper-button-show)
|
||||
(unless (send stepper-button is-shown?)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
------------------------------
|
||||
Version 5.2.2
|
||||
------------------------------
|
||||
|
||||
. DrRacket's toolbar buttons now have numbers associated with them
|
||||
to control what order they appear in.
|
||||
|
||||
------------------------------
|
||||
Version 5.2.1
|
||||
------------------------------
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user