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

66
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
(send (get-info-panel) change-children
(λ (l) (cons uncommon-parent (remq uncommon-parent l))))
(define anchor-message
(new message% (new message%
[font small-control-font] [font small-control-font]
[label (string-constant auto-extend-selection)] [label (string-constant auto-extend-selection)]
[parent (get-info-panel)])] [parent uncommon-parent]))
[overwrite-message (define overwrite-message
(new message% (new message%
[font small-control-font] [font small-control-font]
[label (string-constant overwrite)] [label (string-constant overwrite)]
[parent (get-info-panel)])] [parent uncommon-parent]))
[macro-recording-message (define macro-recording-message
(new message% (new message%
[label "c-x;("] [label "c-x;("]
[font small-control-font] [font small-control-font]
[parent (get-info-panel)])] [parent uncommon-parent]))
[msgs (list anchor-message (define/private (remove-uncommon-child c)
overwrite-message (send uncommon-parent change-children
macro-recording-message)]) (λ (l) (remq c l))))
(send (get-info-panel) change-children (define/private (add-uncommon-child c)
(λ (l) (append msgs (remq* msgs l)))) (define (child->num c)
(values anchor-message (cond
overwrite-message [(eq? c anchor-message) 0]
macro-recording-message))) [(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)))