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

add a toolbar option for being on the top,

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/drracket/private/main.rkt
View File

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

23
collects/drracket/private/unit.rkt
View File

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

1
collects/string-constants/private/english-string-constants.rkt
View File

@ -931,6 +931,7 @@ please adhere to these guidelines:
(interactions-menu-item-help-string "Show/Hide the interactions window") (interactions-menu-item-help-string "Show/Hide the interactions window")
(toolbar "Toolbar") (toolbar "Toolbar")
(toolbar-on-top "Toolbar On Top") (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-left "Toolbar On Left")
(toolbar-on-right "Toolbar On Right") (toolbar-on-right "Toolbar On Right")
(toolbar-hidden "Toolbar Hidden") (toolbar-hidden "Toolbar Hidden")