* Kenny Tilton <[EMAIL PROTECTED]> :
Wrote on Sat, 27 Sep 2008 17:39:14 -0400:
| Can't you just have:
|
| :on-open (lambda (self) (setf (openp self) t))
|
| And have a kids rule:
| (c? (when (^openp)...))
|
| From the code it looks like you understand this. Maybe you ran into an
| issue?
The issue was that I could not figure out how to limit expansions down
the tree using a kids rule at make-instance time. The general idea was
directories should be expanded only when needed. [Further I was using
`expandedp' to ensure that directories got expanded only once, even if
they were opened multiple times by on-open events]. I couldn't combine
these requirements with the desired initial state.
Besides, this was supposed to demo the idea that the tree represented in
the family's hierarchical model is directly displayed by the widget. So
manipulating the model (adding kids, sorting the kids) should reflect in
the displayed tree.
Anyway I figured out how to initalize kids the way I wanted: Don't do it
in the defmodel form (you cant get hold of a parent object there), just
do it in make-tk-instance. FWIW I'm attaching the current version.
There may be an outstanding bug around openp.
BTW, there is a problem with tk-format: if youre passing strings with ~,
FORMAT will barf on strange directives. Dirty workaround:
(defmethod tk-send-value :around ((s string))
(sanitize-string-for-format (call-next-method)))
(defun sanitize-string-for-format (string)
(let ((n (count #\~ string)))
(if (zerop n)
string
(let ((ret (make-string (+ n (length string))
:element-type (type-of (char string 0))))
(i -1))
(loop for c across string
do (setf (aref ret (incf i)) c)
if (eql c #\~) do (setf (aref ret (incf i)) c))
ret))))
--
Regards
Madhu
;;; ----------------------------------------------------------------------
;;;
;;; 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))))
_______________________________________________
cells-devel site list
cells-devel@common-lisp.net
http://common-lisp.net/mailman/listinfo/cells-devel
