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

cocoa: fix placement of the file dialog as a sheet

Browse Source
This commit is contained in:
Matthew Flatt 2015-09-04 07:53:48 -06:00
parent fc0e6a2ce4
commit 580e49f520
2 changed files with 27 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gui-lib/info.rkt
View File

@ -4,7 +4,7 @@
(define deps '("srfi-lite-lib" (define deps '("srfi-lite-lib"
"data-lib" "data-lib"
["base" #:version "6.2.900.11"] ["base" #:version "6.2.900.14"]
"syntax-color-lib" "syntax-color-lib"
("draw-lib" #:version "1.6") ("draw-lib" #:version "1.6")
"snip-lib" "snip-lib"

30
gui-lib/mred/private/wx/cocoa/filedialog.rkt
View File

@ -91,12 +91,35 @@
(atomically (atomically
(let ([front (get-front)] (let ([front (get-front)]
[parent (and (version-10.6-or-later?) [parent (and (version-10.6-or-later?)
parent)]) parent)]
[completion (and (version-10.10-or-later?)
parent
;; retain until done:
(box null))]
[completion-result 0])
(when parent (when parent
(tellv ns beginSheetModalForWindow: (send parent get-cocoa-window) (tellv ns beginSheetModalForWindow: (send parent get-cocoa-window)
completionHandler: #f)) completionHandler: #:type _pointer (and completion
(objc-block
(_fun #:atomic? #t #:keep completion _pointer _int -> _void)
(lambda (blk val)
(set! completion-result val)
(tellv app stopModal))
#:keep completion))))
(begin0 (begin0
(tell #:type _NSInteger ns runModal) (if completion
;; For 10.10, using `runModal` centers the sheet before
;; running the model loop, so we have to use a completion
;; handler as installed above plus `runModalForWindow:`
;; (and this works despite the docs's claim that
;; `runModalForWindow:` centers its argument).
(begin
(tell app runModalForWindow: ns)
(set-box! completion #f)
completion-result)
;; For 10.9 and earlier, runModel will do the hard part
;; for us:
(tell #:type _NSInteger ns runModal))
(when parent (tell app endSheet: ns)) (when parent (tell app endSheet: ns))
(when front (tellv (send front get-cocoa-window) (when front (tellv (send front get-cocoa-window)
makeKeyAndOrderFront: #f)))))]) makeKeyAndOrderFront: #f)))))])
@ -111,4 +134,3 @@
(let ([url (tell ns URL)]) (let ([url (tell ns URL)])
(nsurl->string url))))) (nsurl->string url)))))
(release ns))))) (release ns)))))