;; Cocoa file dialogs
;; (c) 2004 Brendan Burns <brendanburns at comcast dot net>

(in-package :ccl)
(require 'cocoa)

;; open-dialog
;; Display a file open dialog, returns a list of files selected or 'nil
;; #name-field-label Text next to the buttons
;; #accept-text Text in the "Save" button
;; #message The message to display
;; #title The title of the dialog
;; #type The type of file to open (e.g. "lisp", "txt", etc)
;; #choose-multiple-p Can the user select multiple files?
;; #directory The directory to start in
;; #choose-directories-p Can the user select a directory?
;; #choose-files-p Can the user choose files?
;; #resolve-aliases-p Turn aliases into concrete paths?
;; 
(defmethod open-dialog (type &key 	(name-field-label nil)
					(accept-text nil)
					(message nil)
					(title nil)
					(choose-multiple-p nil) 
			      		(directory nil) 
					(choose-directories-p nil)
					(choose-files-p T)
					(resolve-aliases-p nil))
	(let ((panel (send (@class "NSOpenPanel") 'open-panel))
	      (types (send (@class "NSArray") 
				:array-with-object (%make-nsstring type))))
	(if title (send panel :set-title (%make-nsstring title)))
	(if panel (send panel :set-message (%make-nsstring message)))
	(if accept-text 
		(send panel :set-prompt (%make-nsstring accept-text)))
	(if name-field-label 
		(send panel :set-name-field-label 
					(%make-nsstring name-field-label)))
	(send panel :set-allows-multiple-selection choose-multiple-p)
	(send panel :set-can-choose-files choose-files-p)
	(send panel :set-can-choose-directories choose-directories-p)
	(send panel :set-resolves-aliases resolve-aliases-p)
	(if (= 
	    (if directory 
	       (send panel :run-modal-for-directory (%make-nsstring directory) 
			:file nil :types types) 
		(send panel :run-modal-for-types types)) 1)
		(let ((files (send panel 'filenames)))
		  (loop for i from 0 to (- (send files 'count) 1)
			collect (lisp-string-from-nsstring 
					(send files :object-at-index i))))
		nil)))

;; save-dialog
;; display a save dialog and return the file to save or nil if nothing is selected
;; #title The title of the dialog
;; #message The message text to display
;; #can-hide-extension-p Allow the user to show/hide the file extension
;; #can-create-directories-p Allow the user to create directories
;; #name-field-label Text next to the buttons
;; #accept-text Text in the "Save" button
;; #directory Directory to start the dialog in
;; #file Default file name
;;
(defun save-dialog (&key 	(title nil)
				(message nil)
				(can-hide-extension-p nil)
				(can-create-directories-p T)
				(name-field-label nil)
				(accept-text nil)
				(directory nil)
				(file nil)
				)
	(let ((panel (send (@class "NSSavePanel") 'save-panel)))
		(send panel :set-can-create-directories can-create-directories-p)
		(send panel :set-can-select-hidden-extension can-hide-extension-p)
		(if title (send panel :set-title (%make-nsstring title)))
		(if panel (send panel :set-message (%make-nsstring message)))
		(if accept-text 
			(send panel :set-prompt (%make-nsstring accept-text)))
		(if name-field-label 
			(send panel :set-name-field-label 
					(%make-nsstring name-field-label)))
		(if (and directory (not file))
			(send panel :set-directory (%make-nsstring directory)))
		(if (= (if file
			(send panel :run-modal-for-directory 
				(if directory (%make-nsstring directory) nil)
				:file (%make-nsstring file))
			(send panel 'run-modal)) 1) 
			(lisp-string-from-nsstring (send panel 'filename))
			nil)))