;;; ----------------------------------------------------------------------
;;;
;;; DIRTREE: TREEVIEW DEMO
;;;
(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)
    (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 nil)
  (expandedp (c-in nil))
  (directoryp nil)
  :kids (c-in nil)
  :on-open (lambda (self)
	     (warn "XXX open ~S" self)
	     (unless (^expandedp)
	       (warn "XXX populating ~S: ~S" self (^my-pathname))
	       (setf (kids self) (dirtree-make-kids self)
		     (^expandedp) t))))

(defmd dirtree (treeview)
  :column-ids '("ABSOLUTE-PATHNAME" "SIZE" "DATE")
  :displaycolumns '("SIZE" "DATE")
  :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)")))
  :kids (c? (the-kids
	     (make-kid 'dirtree-node
		       :text "/"
		       :my-pathname #p"/"
		       :openp t
		       :kids (c? (the-kids (dirtree-make-kids self)))))))

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

(defun dirtree-make-kids (self)
  (let ((ret
	 (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))
			 :openp (c-in nil)
			 :values-lst (dirtree-values-lst p)))))
    #+HOWTO ;; populate the directories show they show a dummy expansion
    (map nil (lambda (x)
	       (when (directoryp x)
		 (setf (kids x) (list (make-instance 'dirtree-node
					:fm-parent x
					:text "dummy")))))
	 ret)
    ret))

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