From 1f9c939a43d645eaf55e4d375f6b1b609dd1c5bd Mon Sep 17 00:00:00 2001 From: Andrey Kutejko Date: Thu, 27 May 2010 01:47:54 +0300 Subject: [PATCH] added construction of tree-view columns to ui-markup eDSL. --- gtk/ui-markup.lisp | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/gtk/ui-markup.lisp b/gtk/ui-markup.lisp index bb3c090..799b309 100644 --- a/gtk/ui-markup.lisp +++ b/gtk/ui-markup.lisp @@ -104,6 +104,22 @@ (when y-padding (list :y-padding y-padding))))) +(def-ui-child-packer tree-view (w d child) + (declare (ignore d)) + `(tree-view-append-column ,w ,child)) + +(def-ui-child-packer tree-view-column (w d child) + (declare (ignore d)) + (let ((expand-prop (find :expand (ui-child-props d) :key #'ui-prop-name))) + `(progn + (tree-view-column-pack-start ,w ,child + ,@(when expand-prop (list :expand (ui-prop-value expand-prop)))) + ,@(iter (for prop in (ui-child-props d)) + (when (eql (ui-prop-name prop) :attribute) + (collect `(tree-view-column-add-attribute ,w ,child + ,(first (ui-prop-value prop)) + ,(second (ui-prop-value prop))))))))) + (defun get-child-packer-fn (d) (iter (for class first (find-class (ui-d-class d)) then (first (c2mop:class-direct-superclasses class))) (while class) -- 1.7.10.4