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

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

Add :button-string keyword arg to COCOA-CHOOSE-NEW-FILE-DIALOG.

File size: 4.5 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 (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))
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 (and directory (not (directoryp directory)))
35    (error "~s doesn't designate a directory." 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 (and file (not (probe-file file)))
41    (error "~s doesn't designate a file." file))
42  (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file button-string))))
43
44(defun %cocoa-choose-new-file-dialog (directory file-types file)
45  (assume-cocoa-thread)
46  (let* ((save-panel (#/savePanel ns:ns-save-panel))
47         (types-array +null-ptr+))
48    (#/setCanSelectHiddenExtension: save-panel t)
49    (when directory
50      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
51    (when file
52      (setq file (#/autorelease (%make-nsstring (namestring file)))))
53    (when file-types
54      (setq types-array (make-instance 'ns:ns-mutable-array))
55      (dolist (type file-types)
56        (let ((s (%make-nsstring type)))
57          (#/addObject: types-array s)
58          (#/release s)))
59      (#/autorelease types-array))
60    (#/setAllowedFileTypes: save-panel types-array)
61    (let ((result (#/runModalForDirectory:file: save-panel directory file)))
62      (cond ((= result #$NSOKButton)
63             (lisp-string-from-nsstring (#/filename save-panel)))
64            ((= result #$NSCancelButton)
65             nil)
66            (t
67             (error "couldn't run the save panel: error code ~d" result))))))
68
69(defun cocoa-choose-new-file-dialog (&key directory file-types file)
70  (when (and directory (not (directoryp directory)))
71    (error "~s doesn't designate a directory." directory))
72  (when file-types
73    (unless (and (listp file-types)
74                 (every #'stringp file-types))
75      (error "~s is not a list of strings." file-types)))
76  (when (and file (not (probe-file file)))
77    (error "~s doesn't designate a file." file))
78  (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
79
80(defun cocoa-choose-file-dialog-hook-function (must-exist prompt file-types)
81  (declare (ignore prompt))
82  (if must-exist
83    (cocoa-choose-file-dialog :file-types file-types)
84    (cocoa-choose-new-file-dialog :file-types file-types)))
85
86(setq ccl::*choose-file-dialog-hook* 'cocoa-choose-file-dialog-hook-function)
87
88(defun %cocoa-choose-directory-dialog (directory)
89  (assume-cocoa-thread)
90  (let ((open-panel (#/openPanel ns:ns-open-panel)))
91    (#/setCanChooseFiles: open-panel #$NO)
92    (#/setCanChooseDirectories: open-panel #$YES)
93    (#/setAllowsMultipleSelection: open-panel #$NO)
94    (#/setTitle: open-panel #@"Choose Directory")
95    (#/setPrompt: open-panel #@"Choose")
96    (when directory
97      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
98    (let  ((result (#/runModalForDirectory:file:types: open-panel directory
99                                                       nil nil)))
100      (cond ((= result #$NSOKButton)
101             (make-pathname :directory (lisp-string-from-nsstring
102                                        (#/directory open-panel))))
103            ((= result #$NSCancelButton)
104             nil)
105            (t
106             (error "couldn't run the open panel: error code ~d" result))))))
107
108(defun cocoa-choose-directory-dialog (&key directory)
109  (when (and directory (not (directoryp directory)))
110    (error "~s doesn't designate a directory." directory))
111  (execute-in-gui #'(lambda () (%cocoa-choose-directory-dialog directory))))
Note: See TracBrowser for help on using the repository browser.