;;; ----------------------------------------------------------------------
;;;
;;; DIRTREE: TREEVIEW DEMO. Revision 2.
;;;
(in-package "CTK")

(defun dirtree-directory-p (p)
  "Return non-nil if directory."
  (and (not (stringp (pathname-name p)))
       (not (stringp (pathname-type p)))))

(defun dirtree-expand (p)
  "Return a list of enrtries in directory p."
  (when (dirtree-directory-p p)
    (mapcar #'truename (remove-if #'null (mapcar #'probe-file
      (directory (make-pathname :name :wild :version :wild :type :wild
				:defaults p)))))))

(defun dirtree-format-date (utime &optional tz)
  "Return a Human readable date string"
  (multiple-value-bind (second minute hour date month year day daylight-p zone)
      (if tz (decode-universal-time utime tz) (decode-universal-time utime))
    (when daylight-p (decf zone))
    (format nil "~a ~a ~2,' d ~2,'0d:~2,'0d:~2,'0d ~4d ~?"
	    (ecase day
	      (0 "Mon") (1 "Tue") (2 "Wed") (3 "Thu") (4 "Fri") (5 "Sat") (6 "Sun"))
	    (ecase month
	      (1 "Jan") (2 "Feb") (3 "Mar") (4 "Apr") (5 "May") (6 "Jun") (7 "Jul") (8 "Aug") (9 "Sep") (10 "Oct") (11 "Nov") (12 "Dec"))
	    date hour minute second year
	    "~:[+~;-~]~2,'0d~2,'0d"
	    (multiple-value-bind (hour min) (truncate zone 1)
	      (list (plusp zone) (abs hour) (* 60 (abs min)))))))

;;; ----------------------------------------------------------------------
;;;
;;;
(defmd dirtree-node (treeview-item)
  my-pathname
  (expandedp (c-in nil))
  (directoryp nil)
  :kids (c-in nil)
  :on-open (lambda (self)
	     (unless (^expandedp)
	       (setf (kids self) (dirtree-make-kids self)
		     (^expandedp) t))))

(defmethod make-tk-instance :after ((self dirtree-node))
  (when (^directoryp)
    (setf (kids self) (list (make-kid 'dirtree-node :text "dummy")))))

(defmd dirtree (treeview)
  :column-ids '("ABSOLUTE-PATHNAME" "SIZE" "DATE")
  :displaycolumns '("SIZE" "DATE")
  :kids (c-in nil)
  :treeview-headings (c? (the-kids
			  (mk-treeview-heading
			   :treeview-column-id "#0" :text "Directory Structure")
			  (mk-treeview-heading
			   :treeview-column-id "SIZE" :text "File Size")
			  (mk-treeview-heading
			   :treeview-column-id "DATE" :text "Write date (utime)"))))

(defmethod make-tk-instance :after ((self dirtree))
  (setf (kids self)
	(list (make-kid 'dirtree-node
			:text "/"
			:openp t
			:my-pathname #p"/"
			:kids (c-in (dirtree-make-kids self))))))

(defun dirtree-values-lst (p)
  "Return a list of values to be displayed for entry p"
  (list (namestring p)
	(or (ignore-errors (with-open-file (stream p) (file-length stream))) "")
	(or (bwhen (utime (file-write-date p)) (dirtree-format-date utime)) "")))

(defun dirtree-make-kids (self)
  (loop for p in (dirtree-expand (etypecase self
				   (dirtree-node (my-pathname self))
				   (dirtree #p"/")))
	for directory-p = (dirtree-directory-p p)
	collect (make-instance 'dirtree-node
		  :directoryp directory-p
		  :fm-parent self
		  :my-pathname p
		  :text (if directory-p
			    (concatenate 'string
			      (car (last (cdr (pathname-directory p)))) "/")
			    (file-namestring p))
		  :values-lst (dirtree-values-lst p))))

#+nil
(test-window 'window t
	     :title$ "DIRTREE: TREEVIEW TEST"
	     :height (c-in 200) :width (c-in 200)
	     :kids (c? (the-kids (make-kid 'dirtree))))