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

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

New file file-dialogs.lisp. When loaded, sets *CHOOSE-FILE-DIALOG-HOOK*
so that CCL::CHOOSE-FILE-DIALOG and CCL::CHOOSE-NEW-FILE-DIALOG
display Cocoa open and save panels.

Update defsystem.lisp to include file-dialogs.

File size: 3.9 KB
Line 
1(in-package "GUI")
2
3;;;; MCL-ish file dialogs
4
5;;; This needs to run in the event thread.
6(defun %cocoa-choose-file-dialog (directory file-types file)
7  (unless (eq *current-process* *cocoa-event-process*)
8    (error "Must be called in Cocoa event process"))
9  (let* ((open-panel (#/openPanel ns:ns-open-panel))
10         (types-array +null-ptr+)
11         (result nil))
12    ;; for now;  support multiple file selection later.
13    (#/setAllowsMultipleSelection: open-panel #$NO)
14    (when directory
15      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
16    (when file
17      (setq file (#/autorelease (%make-nsstring (namestring file)))))
18    (when file-types
19      (setq types-array (make-instance 'ns:ns-mutable-array))
20      (dolist (type file-types)
21        (let ((s (%make-nsstring type)))
22          (#/addObject: types-array s)
23          (#/release s)))
24      (#/autorelease types-array))
25    (setq result (#/runModalForDirectory:file:types: open-panel directory 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)
34  (when (and directory (not (directoryp directory)))
35    (error "Value ~s supplied for :DIRECTORY doesn't designate a directory." directory))
36  (when (and file-types
37             (not (listp file-types))
38             (not (every #'stringp file-types)))
39    (error "Value ~s supplied for :FILE-TYPES is not a list of strings." file-types))
40  (when (and file (not (probe-file file)))
41    (error "Value ~s supplied for :FILE doesn't designate a file." file))
42  (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file))))
43
44(defun %cocoa-choose-new-file-dialog (directory file-types file)
45  (unless (eq *current-process* *cocoa-event-process*)
46    (error "Must be called in Cocoa event process"))
47  (let* ((save-panel (#/savePanel ns:ns-save-panel))
48         (types-array +null-ptr+)
49         (result nil))
50    (#/setCanSelectHiddenExtension: save-panel t)
51    (when directory
52      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
53    (when file
54      (setq file (#/autorelease (%make-nsstring (namestring file)))))
55    (when file-types
56      (setq types-array (make-instance 'ns:ns-mutable-array))
57      (dolist (type file-types)
58        (let ((s (%make-nsstring type)))
59          (#/addObject: types-array s)
60          (#/release s)))
61      (#/autorelease types-array))
62    (#/setAllowedFileTypes: save-panel types-array)
63    (setq result (#/runModalForDirectory:file: save-panel directory file))
64    (cond ((= result #$NSOKButton)
65           (lisp-string-from-nsstring (#/filename save-panel)))
66          ((= result #$NSCancelButton)
67           nil)
68          (t
69           (error "couldn't run the save panel: error code ~d" result)))))
70
71(defun cocoa-choose-new-file-dialog (&key directory file-types file)
72  (when (and directory (not (directoryp directory)))
73    (error "Value ~s supplied for :DIRECTORY doesn't designate a directory." directory))
74  (when (and file-types
75             (not (listp file-types))
76             (not (every #'stringp file-types)))
77    (error "Value ~s supplied for :FILE-TYPES is not a list of strings." file-types))
78  (when (and file (not (probe-file file)))
79    (error "Value ~s supplied for :FILE doesn't designate a file." file))
80  (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
81
82(defun cocoa-choose-file-dialog-hook-function (must-exist prompt file-types)
83  (declare (ignore prompt))
84  (if must-exist
85    (cocoa-choose-file-dialog :file-types file-types)
86    (cocoa-choose-new-file-dialog :file-types file-types)))
87
88(setq ccl::*choose-file-dialog-hook* 'cocoa-choose-file-dialog-hook-function)
Note: See TracBrowser for help on using the repository browser.