Changeset 11895

Timestamp:

Apr 4, 2009, 9:49:53 PM (10 years ago)

Author:

rme

Message:

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

File:

• trunk/source/cocoa-ide/file-dialogs.lisp (modified) (4 diffs)

trunk/source/cocoa-ide/file-dialogs.lisp

@@ -3 +3 @@
 ;;;; MCL-ish file dialogs
 
-;;; This needs to run in the event thread.
 (defun %cocoa-choose-file-dialog (directory file-types file)
-  (unless (eq *current-process* *cocoa-event-process*)
-    (error "Must be called in Cocoa event process"))
+  (assume-cocoa-thread)
   (let* ((open-panel (#/openPanel ns:ns-open-panel))
-         (types-array +null-ptr+)
-         (result nil))
-    ;; for now;  support multiple file selection later.
+         (types-array +null-ptr+))
+    ;; Maybe support multiple file selection later.
     (#/setAllowsMultipleSelection: open-panel #$NO)
     (when directory
@@ -23 +20 @@
           (#/release s)))
       (#/autorelease types-array))
-    (setq result (#/runModalForDirectory:file:types: open-panel directory file types-array))
-    (cond ((= result #$NSOKButton)
-           (lisp-string-from-nsstring (#/filename open-panel)))
-          ((= result #$NSCancelButton)
-           nil)
-          (t
-           (error "couldn't run the open panel: error code ~d" result)))))
+    (let ((result (#/runModalForDirectory:file:types: open-panel directory
+                                                      file types-array)))
+      (cond ((= result #$NSOKButton)
+             (lisp-string-from-nsstring (#/filename open-panel)))
+            ((= result #$NSCancelButton)
+             nil)
+            (t
+             (error "couldn't run the open panel: error code ~d" result))))))
         
 (defun cocoa-choose-file-dialog (&key directory file-types file)
   (when (and directory (not (directoryp directory)))
-    (error "Value ~s supplied for :DIRECTORY doesn't designate a directory." directory))
-  (when (and file-types
-             (not (listp file-types))
-             (not (every #'stringp file-types)))
-    (error "Value ~s supplied for :FILE-TYPES is not a list of strings." file-types))
+    (error "~s doesn't designate a directory." directory))
+  (when file-types
+    (unless (and (listp file-types)
+                 (every #'stringp file-types))
+      (error "~s is not a list of strings." file-types)))
   (when (and file (not (probe-file file)))
-    (error "Value ~s supplied for :FILE doesn't designate a file." file))
+    (error "~s doesn't designate a file." file))
   (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file))))
 
 (defun %cocoa-choose-new-file-dialog (directory file-types file)
-  (unless (eq *current-process* *cocoa-event-process*)
-    (error "Must be called in Cocoa event process"))
+  (assume-cocoa-thread)
   (let* ((save-panel (#/savePanel ns:ns-save-panel))
-         (types-array +null-ptr+)
-         (result nil))
+         (types-array +null-ptr+))
     (#/setCanSelectHiddenExtension: save-panel t)
     (when directory
@@ -61 +57 @@
       (#/autorelease types-array))
     (#/setAllowedFileTypes: save-panel types-array)
-    (setq result (#/runModalForDirectory:file: save-panel directory file))
-    (cond ((= result #$NSOKButton)
-           (lisp-string-from-nsstring (#/filename save-panel)))
-          ((= result #$NSCancelButton)
-           nil)
-          (t
-           (error "couldn't run the save panel: error code ~d" result)))))
+    (let ((result (#/runModalForDirectory:file: save-panel directory file)))
+      (cond ((= result #$NSOKButton)
+             (lisp-string-from-nsstring (#/filename save-panel)))
+            ((= result #$NSCancelButton)
+             nil)
+            (t
+             (error "couldn't run the save panel: error code ~d" result))))))
 
 (defun cocoa-choose-new-file-dialog (&key directory file-types file)
   (when (and directory (not (directoryp directory)))
-    (error "Value ~s supplied for :DIRECTORY doesn't designate a directory." directory))
-  (when (and file-types
-             (not (listp file-types))
-             (not (every #'stringp file-types)))
-    (error "Value ~s supplied for :FILE-TYPES is not a list of strings." file-types))
+    (error "~s doesn't designate a directory." directory))
+  (when file-types
+    (unless (and (listp file-types)
+                 (every #'stringp file-types))
+      (error "~s is not a list of strings." file-types)))
   (when (and file (not (probe-file file)))
-    (error "Value ~s supplied for :FILE doesn't designate a file." file))
+    (error "~s doesn't designate a file." file))
   (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
 
@@ -87 +83 @@
 
 (setq ccl::*choose-file-dialog-hook* 'cocoa-choose-file-dialog-hook-function)
+
+(defun %cocoa-choose-directory-dialog (directory)
+  (assume-cocoa-thread)
+  (let ((open-panel (#/openPanel ns:ns-open-panel)))
+    (#/setCanChooseFiles: open-panel #$NO)
+    (#/setCanChooseDirectories: open-panel #$YES)
+    (#/setAllowsMultipleSelection: open-panel #$NO)
+    (#/setTitle: open-panel #@"Choose Directory")
+    (#/setPrompt: open-panel #@"Choose")
+    (when directory
+      (setq directory (#/autorelease (%make-nsstring (namestring directory)))))
+    (let  ((result (#/runModalForDirectory:file:types: open-panel directory
+                                                       nil nil)))
+      (cond ((= result #$NSOKButton)
+             (make-pathname :directory (lisp-string-from-nsstring
+                                        (#/directory open-panel))))
+            ((= result #$NSCancelButton)
+             nil)
+            (t
+             (error "couldn't run the open panel: error code ~d" result))))))
+
+(defun cocoa-choose-directory-dialog (&key directory)
+  (when (and directory (not (directoryp directory)))
+    (error "~s doesn't designate a directory." directory))
+  (execute-in-gui #'(lambda () (%cocoa-choose-directory-dialog directory))))