(require_lisp "Hooks.lsp")
(require_lisp "Modal.lsp")
(require_lisp "PhabTemplate.lsp")

(defvar FSSortFunction strcmp)

(defclass FileSelector nil nil
  ((directory (absolute_path "."))
   (filename "")
   (pattern "*")
   (template "/usr/cogent/require/WFileSelect.wgtw")
   window
   (window_title "File Selector")
   (select_hooks (new Hooks))
   (action_hooks (new Hooks))
   (cancel_hooks (new Hooks))
   (setup_hooks (new Hooks))
   action_function
   (cancel_function '(self Close))
   (directory_widget 'FSTPath)
   (filename_widget 'FSTSelection)
   (pattern_widget 'FSTSpec)
   (file_list 'FSAFiles)
   (directory_list 'FSADirs)
   (action_button 'FSBAction)
   (cancel_button 'FSBCancel)
   (backup_button 'FSBBack)
   (file_label 'FSLFiles)
   (dirs_label 'FSLDirs)
   (detail_label 'FSLDetails)
   (action_text "OK")
   (cancel_text "Cancel")
   modal_complete
   (opendir_icon 'FSBDirOpen)
   (dir_icon 'FSBDir)
   )
  )

(defmethod FileSelector constructor ()
  (if @directory_widget (set @directory_widget _undefined_))
  (if @filename_widget (set @filename_widget _undefined_))
  (if @pattern_widget (set @pattern_widget _undefined_))
  (if @action_button (set @action_button _undefined_))
  (if @cancel_button (set @cancel_button _undefined_))
  (if @file_list (set @file_list _undefined_))
  (if @directory_list (set @directory_list _undefined_))
  (if @backup_button (set @backup_button _undefined_))
  (if @dir_icon (set @dir_icon _undefined_))
  (if @opendir_icon (set @opendir_icon _undefined_))
  (if @file_label (set @file_label _undefined_))
  (if @dirs_label (set @dirs_label _undefined_))
  (if @detail_label (set @detail_label _undefined_))
  )

(defmethod FileSelector Close ()
  (PtDestroyWidget @window))

(defmethod FileSelector UpdateInput ()
  (-> self directory (@ @directory_widget text_string))
  (-> self filename (@ @filename_widget text_string))
  (-> self pattern (@ @pattern_widget text_string))
  )

(defmethod FileSelector Action ()
  (self UpdateInput)
  (@action_hooks Execute)
  (eval @action_function)
  )

(defmethod FileSelector Cancel ()
  (self UpdateInput)
  (@cancel_hooks Execute)
  (eval @cancel_function)
  )

(defmethod FileSelector Select (filename)
  (self UpdateInput)
  (self SetFilename filename)
  (@select_hooks Execute)
  (let ((fullname (string @directory "/" @filename)))
    (-> @detail_label text_string
	(format "%s    %d    %s" filename (file_size fullname)
		(date_of (file_date fullname)))
	)
    )
  )

(defmethod FileSelector SetDirectory (dirname)
  (-> self directory dirname)
  (if (instance_p @directory_widget)
      (progn
	(-> @directory_widget text_string dirname)
	(self RecomputeContents)
	)
    )
  )

(defmethod FileSelector SetFilename (filename)
  (-> self filename filename)
  (if (instance_p @filename_widget)
      (-> @filename_widget text_string filename))
  )

(defmethod FileSelector SetPattern (pattern)
  (-> self pattern pattern)
  (if (instance_p @pattern_widget)
      (progn
	(-> @pattern_widget text_string pattern)
	(self RecomputeContents)
	)
    )
  )

(defmethod FileSelector BackupDir ()
  (let ((newpath (absolute_path (root_path (@ @directory_widget
					      text_string)))))
    (self SetDirectory newpath)
    )
  )

(defmethod FileSelector DownDirectory (path)
  (self SetDirectory (string @directory "/" path)))

(defvar first_time t)

(defun new_icon (widget)
  (let ((lab (new PtLabel)))
    (-> lab area (@ widget area))
    (-> lab label_type Pt_IMAGE)
    (-> lab border_width 0)
    (-> lab margin_width 0)
    (-> lab margin_height 0)
    (-> lab label_data (@ widget label_data))
    lab
    )
  )

(defmethod FileSelector RecomputeContents ()
  (let ((files (directory @directory 1 nil))
	(dirs (directory @directory 2 nil))
	(pattern @pattern)
	line y backpath dirpath indent)
    (if (or (not pattern) (equal pattern ""))
	(setq pattern "*"))
    (if files
	(setq files (for i in files tcollect
			 (if (shell_match i pattern) i nil))))
    (if files (setq files (sort files FSSortFunction)))
    (if dirs (setq dirs (sort dirs FSSortFunction)))
    (PtContainerHold @directory_list)
    (PtContainerHold @file_list)
    (for i in (PtWidgetChildren @file_list) do
	 (PtDestroyWidget i) (PtFlush))
    (for i in (PtWidgetChildren @directory_list) do
	 (PtDestroyWidget i) (PtFlush))

    (setq y 0)
    (PtSetParentWidget @file_list)
    (for i in files do
	 (setq line (new PtLabel))
	 (-> line text_string i)
	 (-> line flags Pt_SELECTABLE)
	 (-> line border_width 0)
	 (line SetPos 3 y)
	 (setq y (+ y 15))
	 (PtRealizeWidget line)
	 (PtAttachCallback line Pt_CB_ACTIVATE `(,self Select ,i))
	 )
    (-> @file_label text_string (string "Files: " (length files)))
    (PtExtentWidget @file_list)
    (-> @file_list scroll_area_max_y (* (+ 1 (length files)) 15))
    
    (setq y 0)
    (setq indent 3)
    (PtSetParentWidget @directory_list)
    (setq dirpath (string_split (absolute_path @directory) "/" 0))
    (setq backpath "/")
    (for i in dirpath do
	 (setq backpath (string backpath "/" i))
	 (setq lab (new_icon @opendir_icon))
	 (PtReParentWidget lab @directory_list)
	 (lab SetPos indent y)
	 (setq line (new PtLabel))
	 (line SetPos (+ indent (+ 3 (@ (@ lab dim) w))) y)
	 (-> line text_string i)
	 (-> line flags Pt_SELECTABLE)
	 (-> line border_width 0)
	 (-> lab flags Pt_SELECTABLE)
	 (setq y (+ y 15))
	 (setq indent (+ 8 indent))
	 (PtRealizeWidget lab)
	 (PtRealizeWidget line)
	 (PtAttachCallback line Pt_CB_ACTIVATE `(,self SetDirectory ,backpath))
	 (PtAttachCallback lab Pt_CB_ACTIVATE `(,self SetDirectory ,backpath))
	 )
    (for i in dirs do
	 (setq line (new PtLabel))
	 (setq lab (new_icon @dir_icon))
	 (PtReParentWidget lab @directory_list)
	 (lab SetPos indent y)
	 (-> line text_string i)
	 (-> line border_width 0)
	 (-> line flags Pt_SELECTABLE)
	 (-> lab flags Pt_SELECTABLE)
	 (line SetPos (+ indent (+ 3 (@ (@ lab dim) w))) y)
	 (setq y (+ y 15))
	 (PtRealizeWidget lab)
	 (PtRealizeWidget line)
	 (PtAttachCallback line Pt_CB_ACTIVATE `(,self DownDirectory ,i))
	 (PtAttachCallback lab Pt_CB_ACTIVATE `(,self DownDirectory ,i)))
    (-> @dirs_label text_string (string "Directories: " (length dirs)))
    (PtExtentWidget @directory_list)
    (PtContainerRelease @file_list)
    (PtContainerRelease @directory_list)
    (-> @directory_list scroll_area_max_y (* (+ 1 (length dirs)) 15))
    )
  )

;;;
;;; Instantiate a previously unseen file dialog.  We must preserve the
;;; parent widget across this call in order to allow modal dialogs and
;;; such to work properly.  Generally speaking, you don't want your
;;; default parent to be set to a pane in the file dialog.
;;;

(defmethod FileSelector Instantiate (&optional (actionfn nil) (cancelfn nil))
  (let ((parent (PtSetParentWidget nil)))
    (PtSetParentWidget parent)
    (if (destroyed_p @window)
	(error "FileSelector: Attempt to re-use destroyed selector window."))
    (-> self window (car (wload @template)))
    (-> self directory_widget (eval @directory_widget))
    (-> self filename_widget (eval @filename_widget))
    (-> self pattern_widget (eval @pattern_widget))
    (-> self action_button (eval @action_button))
    (-> self cancel_button (eval @cancel_button))
    (-> self backup_button (eval @backup_button))
    (-> self file_list (eval @file_list))
    (-> self directory_list (eval @directory_list))
    (-> self dir_icon (eval @dir_icon))
    (-> self opendir_icon (eval @opendir_icon))
    (-> self file_label (eval @file_label))
    (-> self dirs_label (eval @dirs_label))
    (-> self detail_label (eval @detail_label))
    (-> @window title @window_title)

    (if @directory_widget
	(-> @directory_widget text_string @directory))
    (if @filename_widget
	(-> @filename_widget text_string @filename))
    (if @pattern_widget
	(-> @pattern_widget text_string @pattern))
  
    (if actionfn (-> self action_function actionfn))
    (if cancelfn (-> self cancel_function cancelfn))

    (if (string_p @action_text) (-> @action_button text_string @action_text))
    (if (string_p @cancel_text) (-> @cancel_button text_string @cancel_text))

    (PtAttachCallback @action_button Pt_CB_ACTIVATE `(,self Action))
    (PtAttachCallback @cancel_button Pt_CB_ACTIVATE `(,self Cancel))
    (PtAttachCallback @backup_button Pt_CB_ACTIVATE `(,self BackupDir))
    (PtAttachCallback @directory_widget Pt_CB_ACTIVATE
		      `(,self SetDirectory (@ widget text_string)))
    (PtAttachCallback @filename_widget Pt_CB_ACTIVATE
		      `(,self SetFilename (@ widget text_string)))
    (PtAttachCallback @pattern_widget Pt_CB_ACTIVATE
		      `(,self SetPattern (@ widget text_string)))

    (@setup_hooks Execute)
    (self RecomputeContents)
    (PtSetParentWidget parent)
    )
  )

(defmethod FileSelector Modal (&optional (actionfn nil) (cancelfn nil))
  (let (result)
    (self Instantiate actionfn cancelfn)
    (if @window
	(progn
	  (@action_hooks AddHook '_complete `(-> ,self modal_complete
						 'action))
	  (@cancel_hooks AddHook '_complete `(-> ,self modal_complete
						 'cancel))
	  (PtAttachCallback @window Pt_CB_WINDOW
			    `(-> ,self modal_complete 'close) Ph_WM_CLOSE)
	  (-> @window notify_flags Ph_WM_CLOSE)
	  (-> @window managed_flags `(,Ph_WM_CLOSE . nil))
	  (modal nil `(@ ,self modal_complete))
	  (if (eq @modal_complete 'action)
	      (setq result (string @directory "/" @filename))
	    (setq result nil))
	  (if (not (destroyed_p @window))
	      (PtDestroyWidget @window))
	  )
      )
    result
    )
  )

(defmethod FileSelector NonModal (&optional (actionfn nil) (cancelfn nil))
  (self Instantiate actionfn cancelfn)
  (@action_hooks RemoveHook '_complete)
  (@cancel_hooks RemoveHook '_complete)
  (-> @window notify_flags `(Ph_WM_CLOSE . nil))
  (-> @window managed_flags Ph_WM_CLOSE)
  )

;;;
;;; Convenience Functions:
;;;

(defun ModalFileSelector (directory_name &optional (file_pattern "*"))
  (let ((fs (new FileSelector)))
    (-> fs directory directory_name)
    (-> fs pattern file_pattern)
    ;;(setq global fs)
    (fs Modal)
    )
  )

(defun NonModalFileSelector (directory_name &optional (file_pattern "*")
					    (actionfn nil) (cancelfn nil))
  (let ((fs (new FileSelector)))
    (-> fs directory directory_name)
    (-> fs pattern file_pattern)
    ;;(setq global fs)
    (fs NonModal actionfn cancelfn)
    fs
    )
  )
