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

adjust the anchor message, keyboard recording message, and overwrite

Browse Source 
message so they don't take up space when they aren't being shown
(to reduce the minimum width of the window)

original commit: a45f94b58ba2aee49c830ecc6379b23ace0c9b16
This commit is contained in:
Robby Findler 2012-11-28 17:46:54 -06:00
parent 98f52ba83d
commit d35f4ceebd
1 changed files with 46 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
collects/framework/private/frame.rkt
View File

@ -1038,7 +1038,9 @@
(define/private (update-macro-recording-icon) (define/private (update-macro-recording-icon)
(unless (eq? (send macro-recording-message is-shown?) (unless (eq? (send macro-recording-message is-shown?)
macro-recording?) macro-recording?)
(send macro-recording-message show macro-recording?))) (if macro-recording?
(add-uncommon-child macro-recording-message)
(remove-uncommon-child macro-recording-message))))
(define/public (set-macro-recording on?) (define/public (set-macro-recording on?)
(set! macro-recording? on?) (set! macro-recording? on?)
(update-macro-recording-icon)) (update-macro-recording-icon))
@ -1049,16 +1051,16 @@
(λ () (λ ()
(unless (eq? anchor-last-state? #f) (unless (eq? anchor-last-state? #f)
(set! anchor-last-state? #f) (set! anchor-last-state? #f)
(send anchor-message show #f)))]) (remove-uncommon-child anchor-message)))])
(cond (cond
[info-edit [info-edit
(let ([anchor-now? (send info-edit get-anchor)]) (let ([anchor-now? (send info-edit get-anchor)])
(unless (eq? anchor-now? anchor-last-state?) (unless (eq? anchor-now? anchor-last-state?)
(cond (cond
[(object? anchor-message) [(object? anchor-message)
(send anchor-message (if anchor-now?
show (add-uncommon-child anchor-message)
anchor-now?) (remove-uncommon-child anchor-message))
(set! anchor-last-state? anchor-now?)] (set! anchor-last-state? anchor-now?)]
[else (failed)])))] [else (failed)])))]
[else [else
@ -1072,16 +1074,16 @@
[failed [failed
(λ () (λ ()
(set! overwrite-last-state? #f) (set! overwrite-last-state? #f)
(send overwrite-message show #f))]) (remove-uncommon-child overwrite-message))])
(cond (cond
[info-edit [info-edit
(let ([overwrite-now? (send info-edit get-overwrite-mode)]) (let ([overwrite-now? (send info-edit get-overwrite-mode)])
(unless (eq? overwrite-now? overwrite-last-state?) (unless (eq? overwrite-now? overwrite-last-state?)
(cond (cond
[(object? overwrite-message) [(object? overwrite-message)
(send overwrite-message (if overwrite-now?
show (add-uncommon-child overwrite-message)
overwrite-now?) (remove-uncommon-child overwrite-message))
(set! overwrite-last-state? overwrite-now?)] (set! overwrite-last-state? overwrite-now?)]
[else [else
(failed)])))] (failed)])))]
@ -1140,37 +1142,43 @@
(λ (l) (λ (l)
(cons file-text-mode-msg-parent (remq file-text-mode-msg-parent l)))) (cons file-text-mode-msg-parent (remq file-text-mode-msg-parent l))))
(define-values (anchor-message (define uncommon-parent (new horizontal-panel%
overwrite-message [parent (get-info-panel)]
macro-recording-message) [stretchable-width #f]))
(let* ([anchor-message
(new message% (send (get-info-panel) change-children
[font small-control-font] (λ (l) (cons uncommon-parent (remq uncommon-parent l))))
[label (string-constant auto-extend-selection)] (define anchor-message
[parent (get-info-panel)])] (new message%
[overwrite-message [font small-control-font]
(new message% [label (string-constant auto-extend-selection)]
[font small-control-font] [parent uncommon-parent]))
[label (string-constant overwrite)] (define overwrite-message
[parent (get-info-panel)])] (new message%
[macro-recording-message [font small-control-font]
(new message% [label (string-constant overwrite)]
[label "c-x;("] [parent uncommon-parent]))
[font small-control-font] (define macro-recording-message
[parent (get-info-panel)])] (new message%
[msgs (list anchor-message [label "c-x;("]
overwrite-message [font small-control-font]
macro-recording-message)]) [parent uncommon-parent]))
(send (get-info-panel) change-children (define/private (remove-uncommon-child c)
(λ (l) (append msgs (remq* msgs l)))) (send uncommon-parent change-children
(values anchor-message (λ (l) (remq c l))))
overwrite-message (define/private (add-uncommon-child c)
macro-recording-message))) (define (child->num c)
(cond
[(eq? c anchor-message) 0]
[(eq? c overwrite-message) 1]
[(eq? c macro-recording-message) 2]))
(send uncommon-parent change-children
(λ (l) (sort (cons c (remq c l))
<
#:key child->num))))
(inherit determine-width) (inherit determine-width)
(send macro-recording-message show #f) (send uncommon-parent change-children (λ (l) '()))
(send anchor-message show #f)
(send overwrite-message show #f)
(editor-position-changed) (editor-position-changed)
(use-file-text-mode-changed))) (use-file-text-mode-changed)))