source: trunk/source/cocoa-ide/file-dialogs.lisp @ 11895

Last change on this file since 11895 was 11895, checked in by rme, 11 years ago

New function COCOA-CHOOSE-DIRECTORY-DIALOG; other fixes.

File size: 4.4 KB
RevLine 
[11885]1(in-package "GUI")
2
3;;;; MCL-ish file dialogs
4
5(defun %cocoa-choose-file-dialog (directory file-types file)
[11895]6  (assume-cocoa-thread)
[11885]7  (let* ((open-panel (#/openPanel ns:ns-open-panel))
[11895]8         (types-array +null-ptr+))
9    ;; Maybe support multiple file selection later.
[11885]10    (#/setAllowsMultipleSelection: open-panel #$NO)
11    (when directory
12      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
13    (when file
14      (setq file (#/autorelease (%make-nsstring (namestring file)))))
15    (when file-types
16      (setq types-array (make-instance 'ns:ns-mutable-array))
17      (dolist (type file-types)
18        (let ((s (%make-nsstring type)))
19          (#/addObject: types-array s)
20          (#/release s)))
21      (#/autorelease types-array))
[11895]22    (let ((result (#/runModalForDirectory:file:types: open-panel directory
23                                                      file types-array)))
24      (cond ((= result #$NSOKButton)
25             (lisp-string-from-nsstring (#/filename open-panel)))
26            ((= result #$NSCancelButton)
27             nil)
28            (t
29             (error "couldn't run the open panel: error code ~d" result))))))
[11885]30       
31(defun cocoa-choose-file-dialog (&key directory file-types file)
32  (when (and directory (not (directoryp directory)))
[11895]33    (error "~s doesn't designate a directory." directory))
34  (when file-types
35    (unless (and (listp file-types)
36                 (every #'stringp file-types))
37      (error "~s is not a list of strings." file-types)))
[11885]38  (when (and file (not (probe-file file)))
[11895]39    (error "~s doesn't designate a file." file))
[11885]40  (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file))))
41
42(defun %cocoa-choose-new-file-dialog (directory file-types file)
[11895]43  (assume-cocoa-thread)
[11885]44  (let* ((save-panel (#/savePanel ns:ns-save-panel))
[11895]45         (types-array +null-ptr+))
[11885]46    (#/setCanSelectHiddenExtension: save-panel t)
47    (when directory
48      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
49    (when file
50      (setq file (#/autorelease (%make-nsstring (namestring file)))))
51    (when file-types
52      (setq types-array (make-instance 'ns:ns-mutable-array))
53      (dolist (type file-types)
54        (let ((s (%make-nsstring type)))
55          (#/addObject: types-array s)
56          (#/release s)))
57      (#/autorelease types-array))
58    (#/setAllowedFileTypes: save-panel types-array)
[11895]59    (let ((result (#/runModalForDirectory:file: save-panel directory file)))
60      (cond ((= result #$NSOKButton)
61             (lisp-string-from-nsstring (#/filename save-panel)))
62            ((= result #$NSCancelButton)
63             nil)
64            (t
65             (error "couldn't run the save panel: error code ~d" result))))))
[11885]66
67(defun cocoa-choose-new-file-dialog (&key directory file-types file)
68  (when (and directory (not (directoryp directory)))
[11895]69    (error "~s doesn't designate a directory." directory))
70  (when file-types
71    (unless (and (listp file-types)
72                 (every #'stringp file-types))
73      (error "~s is not a list of strings." file-types)))
[11885]74  (when (and file (not (probe-file file)))
[11895]75    (error "~s doesn't designate a file." file))
[11885]76  (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
77
78(defun cocoa-choose-file-dialog-hook-function (must-exist prompt file-types)
79  (declare (ignore prompt))
80  (if must-exist
81    (cocoa-choose-file-dialog :file-types file-types)
82    (cocoa-choose-new-file-dialog :file-types file-types)))
83
84(setq ccl::*choose-file-dialog-hook* 'cocoa-choose-file-dialog-hook-function)
[11895]85
86(defun %cocoa-choose-directory-dialog (directory)
87  (assume-cocoa-thread)
88  (let ((open-panel (#/openPanel ns:ns-open-panel)))
89    (#/setCanChooseFiles: open-panel #$NO)
90    (#/setCanChooseDirectories: open-panel #$YES)
91    (#/setAllowsMultipleSelection: open-panel #$NO)
92    (#/setTitle: open-panel #@"Choose Directory")
93    (#/setPrompt: open-panel #@"Choose")
94    (when directory
95      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
96    (let  ((result (#/runModalForDirectory:file:types: open-panel directory
97                                                       nil nil)))
98      (cond ((= result #$NSOKButton)
99             (make-pathname :directory (lisp-string-from-nsstring
100                                        (#/directory open-panel))))
101            ((= result #$NSCancelButton)
102             nil)
103            (t
104             (error "couldn't run the open panel: error code ~d" result))))))
105
106(defun cocoa-choose-directory-dialog (&key directory)
107  (when (and directory (not (directoryp directory)))
108    (error "~s doesn't designate a directory." directory))
109  (execute-in-gui #'(lambda () (%cocoa-choose-directory-dialog directory))))
Note: See TracBrowser for help on using the repository browser.