Changeset 11895


Ignore:
Timestamp:
Apr 4, 2009, 9:49:53 PM (10 years ago)
Author:
rme
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/file-dialogs.lisp

    r11885 r11895  
    33;;;; MCL-ish file dialogs
    44
    5 ;;; This needs to run in the event thread.
    65(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"))
     6  (assume-cocoa-thread)
    97  (let* ((open-panel (#/openPanel ns:ns-open-panel))
    10          (types-array +null-ptr+)
    11          (result nil))
    12     ;; for now;  support multiple file selection later.
     8         (types-array +null-ptr+))
     9    ;; Maybe support multiple file selection later.
    1310    (#/setAllowsMultipleSelection: open-panel #$NO)
    1411    (when directory
     
    2320          (#/release s)))
    2421      (#/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)))))
     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))))))
    3230       
    3331(defun cocoa-choose-file-dialog (&key directory file-types file)
    3432  (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))
     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)))
    4038  (when (and file (not (probe-file file)))
    41     (error "Value ~s supplied for :FILE doesn't designate a file." file))
     39    (error "~s doesn't designate a file." file))
    4240  (execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-types file))))
    4341
    4442(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"))
     43  (assume-cocoa-thread)
    4744  (let* ((save-panel (#/savePanel ns:ns-save-panel))
    48          (types-array +null-ptr+)
    49          (result nil))
     45         (types-array +null-ptr+))
    5046    (#/setCanSelectHiddenExtension: save-panel t)
    5147    (when directory
     
    6157      (#/autorelease types-array))
    6258    (#/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)))))
     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))))))
    7066
    7167(defun cocoa-choose-new-file-dialog (&key directory file-types file)
    7268  (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))
     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)))
    7874  (when (and file (not (probe-file file)))
    79     (error "Value ~s supplied for :FILE doesn't designate a file." file))
     75    (error "~s doesn't designate a file." file))
    8076  (execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory file-types file))))
    8177
     
    8783
    8884(setq ccl::*choose-file-dialog-hook* 'cocoa-choose-file-dialog-hook-function)
     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 TracChangeset for help on using the changeset viewer.