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

Last change on this file since 11900 was 11900, checked in by rme, 10 years ago

Don't be too picky about pathnames/namestrings that the user provides
for :file and :directory. If they're invalid, the NSOpenPanel or
NSSavePanel will ignore them.

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