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

add keyboard shortcuts to unsaved dialog warning on mac os x

Browse Source 
closes PR 12927
closes PR 10708
closes PR 8996

original commit: 64fd649ee573c73499566b7cbb77271842a33ab7
This commit is contained in:
Robby Findler 2014-06-15 04:12:11 -05:00
parent 64c4456dc0
commit 88bac3bab9
1 changed files with 39 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
pkgs/gui-pkgs/gui-lib/framework/gui-utils.rkt
View File

@ -230,23 +230,48 @@
(λ () (thunk)) (λ () (thunk))
(λ () (cursor-off))))]))) (λ () (cursor-off))))])))
(define unsaved-warning (define (unsaved-warning filename action-anyway [can-save-now? #f] [parent #f] [cancel? #t])
(lambda (filename action-anyway (can-save-now? #f) (parent #f) [cancel? #t]) (define key-closed #f)
(let ([mb-res (message-box/custom (define (unsaved-warning-mixin %)
(string-constant warning) (class %
(format (string-constant file-is-not-saved) filename) (inherit show)
(string-constant save) (define/override (on-subwindow-char receiver evt)
(and cancel? (string-constant cancel)) (define (is-menu-key? char)
action-anyway (and (send evt get-meta-down)
parent (equal? (send evt get-key-code) char)))
(if can-save-now? (cond
'(default=1 caution) [(is-menu-key? #\d)
'(default=2 caution)) (set! key-closed 'continue)
2)]) (show #f)]
[(is-menu-key? #\s)
(set! key-closed 'save)
(show #f)]
[(is-menu-key? #\c)
(set! key-closed 'cancel)
(show #f)]
[else
(super on-subwindow-char receiver evt)]))
(super-new)))
(define mb-res
(message-box/custom
(string-constant warning)
(format (string-constant file-is-not-saved) filename)
(string-constant save)
(and cancel? (string-constant cancel))
action-anyway
parent
(if can-save-now?
'(default=1 caution)
'(default=2 caution))
2
#:dialog-mixin (if (equal? (system-type) 'macosx)
unsaved-warning-mixin
values)))
(or key-closed
(case mb-res (case mb-res
[(1) 'save] [(1) 'save]
[(2) 'cancel] [(2) 'cancel]
[(3) 'continue])))) [(3) 'continue])))
(define get-choice (define get-choice
(lambda (message (lambda (message