add a toolbar option for being on the top,

but with the small size buttons

closes PR 13281
This commit is contained in:
Robby Findler 2012-11-21 21:42:50 -06:00
parent 07c6e89899
commit c359e371bf
3 changed files with 24 additions and 8 deletions

View File

@ -98,10 +98,10 @@
(drr:set-default 'drracket:show-line-numbers? #f boolean?)
(drr:set-default 'drracket:toolbar-state
'(#f . top)
(λ (x) (and (pair? x)
(boolean? (car x))
(memq (cdr x) '(left top right)))))
'(#f . top)
(λ (x) (and (pair? x)
(boolean? (car x))
(memq (cdr x) '(left top top-no-label right)))))
(drr:set-default 'drracket:htdp:last-set-teachpacks
'()

View File

@ -1822,6 +1822,7 @@ module browser threading seems wrong.
(inherit show-info hide-info is-info-hidden?)
(field [toolbar-state (preferences:get 'drracket:toolbar-state)]
[toolbar-top-menu-item #f]
[toolbar-top-no-label-menu-item #f]
[toolbar-left-menu-item #f]
[toolbar-right-menu-item #f]
[toolbar-hidden-menu-item #f]
@ -1840,17 +1841,20 @@ module browser threading seems wrong.
(define/private (set-toolbar-left) (change-toolbar-state (cons #f 'left)))
(define/private (set-toolbar-right) (change-toolbar-state (cons #f 'right)))
(define/private (set-toolbar-top) (change-toolbar-state (cons #f 'top)))
(define/private (set-toolbar-top-no-label) (change-toolbar-state (cons #f 'top-no-label)))
(define/private (set-toolbar-hidden) (change-toolbar-state (cons #t (cdr toolbar-state))))
(define/public (update-toolbar-visibility)
(let* ([hidden? (toolbar-is-hidden?)]
[left? (toolbar-is-left?)]
[right? (toolbar-is-right?)]
[top? (toolbar-is-top?)])
[top? (toolbar-is-top?)]
[top-no-label? (toolbar-is-top-no-label?)])
(send toolbar-left-menu-item check left?)
(send toolbar-right-menu-item check right?)
(send toolbar-top-menu-item check top?)
(send toolbar-top-no-label-menu-item check top-no-label?)
(send toolbar-hidden-menu-item check hidden?)
(cond
@ -1859,6 +1863,7 @@ module browser threading seems wrong.
(send top-outer-panel change-children (λ (l) '()))
(send transcript-parent-panel change-children (λ (l) '()))]
[top? (orient/show #t)]
[top-no-label? (orient/show #t)]
[left? (orient/show #t)]
[right? (orient/show #f)]))
(update-defs/ints-resize-corner))
@ -1877,6 +1882,10 @@ module browser threading seems wrong.
(and (not (toolbar-is-hidden?))
(eq? (cdr (preferences:get 'drracket:toolbar-state))
'left)))
(define/private (toolbar-is-top-no-label?)
(and (not (toolbar-is-hidden?))
(eq? (cdr (preferences:get 'drracket:toolbar-state))
'top-no-label)))
(define/private (orient/show bar-at-beginning?)
(let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
@ -2006,9 +2015,9 @@ module browser threading seems wrong.
(void)))
(define/private (set-toolbar-label-visibilities/check-registered)
(let ([vertical? (or (toolbar-is-left?) (toolbar-is-right?))])
(for ([(button number) (in-hash toolbar-buttons)])
(send button set-label-visible (not vertical?))))
(define label-visible? (toolbar-is-top?))
(for ([(button number) (in-hash toolbar-buttons)])
(send button set-label-visible label-visible?))
(let loop ([obj button-panel])
(cond
@ -3286,6 +3295,12 @@ module browser threading seems wrong.
[parent toolbar-menu]
[callback (λ (x y) (set-toolbar-top))]
[checked #f]))
(set! toolbar-top-no-label-menu-item
(new checkable-menu-item%
[label (string-constant toolbar-on-top-no-label)]
[parent toolbar-menu]
[callback (λ (x y) (set-toolbar-top-no-label))]
[checked #f]))
(set! toolbar-right-menu-item
(new checkable-menu-item%
[label (string-constant toolbar-on-right)]

View File

@ -931,6 +931,7 @@ please adhere to these guidelines:
(interactions-menu-item-help-string "Show/Hide the interactions window")
(toolbar "Toolbar")
(toolbar-on-top "Toolbar On Top")
(toolbar-on-top-no-label "Toolbar On Top With Small Buttons")
(toolbar-on-left "Toolbar On Left")
(toolbar-on-right "Toolbar On Right")
(toolbar-hidden "Toolbar Hidden")