Add GtkTreeStore binding
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Sat, 24 Oct 2009 16:31:11 +0000 (20:31 +0400)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Sat, 24 Oct 2009 16:34:29 +0000 (20:34 +0400)
bugs/issue-bb8c71d21d73d1ad594c73f0ac5ac8a6db82729c.yaml
gtk/cl-gtk2-gtk.asd
gtk/gtk.demo.lisp
gtk/gtk.tree-store.lisp [new file with mode: 0644]

index 1ef53c0..f4a1d49 100644 (file)
@@ -5,8 +5,8 @@ type: :task
 component: cl-gtk2
 release: "0.1"
 reporter: Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
-status: :unstarted
-disposition: 
+status: :closed
+disposition: :fixed
 creation_time: 2009-10-02 21:13:54.989400 Z
 references: []
 
@@ -16,3 +16,7 @@ log_events:
   - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
   - created
   - ""
+- - 2009-10-24 16:20:58.305703 Z
+  - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
+  - closed with disposition fixed
+  - ""
index 5829ee2..8cf74be 100644 (file)
@@ -48,6 +48,7 @@
                (:file "gtk.assistant")
                (:file "gtk.link-button")
                (:file "gtk.list-store")
+               (:file "gtk.tree-store")
                
                (:file "gtk.main-loop-events")
                
index eb715e3..86dc302 100644 (file)
@@ -29,7 +29,8 @@
            #:test-assistant
            #:test-entry-completion
            #:test-ui-markup
-           #:test-list-store))
+           #:test-list-store
+           #:test-tree-store))
 
 (in-package :gtk-demo)
 
                             (dialog-run dialog)
                             (object-destroy dialog)))))
       (widget-show w))))
+
+(defun test-tree-store ()
+  "Demonstrates usage of tree store"
+  (within-main-loop
+    (let-ui (gtk-window
+             :type :toplevel
+             :title "GtkListStore"
+             :default-width 600
+             :default-height 400
+             :var w
+             (v-box
+              (label :label "A GtkListStore") :expand nil
+              (scrolled-window
+               :hscrollbar-policy :automatic
+               :vscrollbar-policy :automatic
+               (tree-view :var tv))))
+      (let ((l (make-instance 'tree-store :column-types '("gint" "gchararray"))))
+        (iter (for i from 0 below 100)
+              (for n = (random 10000000))
+              (for s = (format nil "~R" n))
+              (for it = (tree-store-insert-with-values l nil i n s))
+              (iter (for j from 0 below 10)
+                    (for n2 = (random 10000000))
+                    (for s2 = (format nil "~R" n))
+                    (tree-store-insert-with-values l it j n2 s2)))
+        (setf (tree-view-model tv) l)
+        (let ((column (make-instance 'tree-view-column :title "Number" :sort-column-id 0))
+              (renderer (make-instance 'cell-renderer-text :text "A text")))
+          (tree-view-column-pack-start column renderer)
+          (tree-view-column-add-attribute column renderer "text" 0)
+          (tree-view-append-column tv column))
+        (let ((column (make-instance 'tree-view-column :title "As string" :sort-column-id 1))
+              (renderer (make-instance 'cell-renderer-text :text "A text")))
+          (tree-view-column-pack-start column renderer)
+          (tree-view-column-add-attribute column renderer "text" 1)
+          (tree-view-append-column tv column))
+        (connect-signal tv "row-activated"
+                        (lambda (w path column)
+                          (declare (ignore w column))
+                          (let* ((iter (tree-model-iter-by-path l path))
+                                 (n (tree-model-value l iter 0))
+                                 (dialog (make-instance 'message-dialog
+                                                        :title "Clicked"
+                                                        :text (format nil "Number ~A was clicked" n)
+                                                        :buttons :ok)))
+                            (dialog-run dialog)
+                            (object-destroy dialog)))))
+      (widget-show w))))
diff --git a/gtk/gtk.tree-store.lisp b/gtk/gtk.tree-store.lisp
new file mode 100644 (file)
index 0000000..cb765b2
--- /dev/null
@@ -0,0 +1,188 @@
+(in-package :gtk)
+
+(defcfun gtk-tree-store-set-column-types :void
+  (tree-store (g-object tree-store))
+  (n-columns :int)
+  (types :pointer))
+
+(defun call-tree-store-set-column-types (tree-store column-types)
+  (let ((n (length column-types)))
+    (with-foreign-object (types-ar 'g-type-designator n)
+      (iter (for i from 0 below n)
+            (for type in column-types)
+            (setf (mem-aref types-ar 'g-type-designator i) type))
+      (gtk-tree-store-set-column-types tree-store n types-ar))))
+
+(defmethod initialize-instance :after ((store tree-store) &rest initargs &key (column-types nil column-types-supplied-p) &allow-other-keys)
+  (declare (ignore initargs))
+  (when column-types-supplied-p
+    (call-tree-store-set-column-types store column-types)))
+
+(defcfun (%gtk-tree-store-set-value "gtk_tree_store_set_value") :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (column :int)
+  (value :pointer))
+
+(defun gtk-tree-store-set-value (tree-store iter column value)
+  (with-foreign-object (v 'g-value)
+    (set-g-value v value (tree-model-column-type tree-store column) :zero-g-value t)
+    (%gtk-tree-store-set-value tree-store iter column v)
+    (g-value-unset v)
+    (values)))
+
+(defun tree-store-value (tree-store iter column)
+  (tree-model-value tree-store iter column))
+
+(defun (setf tree-store-value) (new-value tree-store iter column)
+  (gtk-tree-store-set-value tree-store iter column new-value)
+  new-value)
+
+(export 'tree-store-value)
+
+;; not implemented
+;; void                gtk_tree_store_set_valuesv          (GtkTreeStore *tree_store,
+;;                                                          GtkTreeIter *iter,
+;;                                                          gint *columns,
+;;                                                          GValue *values,
+;;                                                          gint n_values);
+
+(defcfun (tree-store-remove "gtk_tree_store_remove") :boolean
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-remove)
+
+(defcfun gtk-tree-store-insert :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter))
+  (position :int))
+
+(defun tree-store-insert (tree-store parent position)
+  (let ((iter (make-tree-iter)))
+    (gtk-tree-store-insert tree-store iter parent position)
+    iter))
+
+(defcfun gtk-tree-store-insert-before :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter))
+  (sibling (g-boxed-foreign tree-iter)))
+
+(defun tree-store-insert-before (tree-store parent sibling)
+  (let ((iter (make-tree-iter)))
+    (gtk-tree-store-insert-before tree-store iter parent sibling)
+    iter))
+
+(defcfun gtk-tree-store-insert-after :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter))
+  (sibling (g-boxed-foreign tree-iter)))
+
+(defun tree-store-insert-after (tree-store parent sibling)
+  (let ((iter (make-tree-iter)))
+    (gtk-tree-store-insert-after tree-store iter parent sibling)
+    iter))
+
+(export '(tree-store-insert tree-store-insert-before tree-store-insert-after))
+
+(defcfun gtk-tree-store-insert-with-valuesv :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter))
+  (position :int)
+  (columns :pointer)
+  (values :pointer)
+  (n-values :int))
+
+(defun tree-store-insert-with-values (tree-store parent position &rest values)
+  (let ((n (length values))
+        (iter (make-tree-iter)))
+    (with-foreign-objects ((v-ar 'g-value n)
+                           (columns-ar :int n))
+      (iter (for i from 0 below n)
+            (for value in values)
+            (for type = (tree-model-column-type tree-store i))
+            (setf (mem-aref columns-ar :int i) i)
+            (set-g-value (mem-aref v-ar 'g-value i) value type :zero-g-value t))
+      (gtk-tree-store-insert-with-valuesv tree-store iter parent position columns-ar v-ar n)
+      (iter (for i from 0 below n)
+            (g-value-unset (mem-aref v-ar 'g-value i)))
+      iter)))
+
+(export 'tree-store-insert-with-values)
+
+(defcfun gtk-tree-store-prepend :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter)))
+
+(defun tree-store-prepend (tree-store parent)
+  (let ((iter (make-tree-iter)))
+    (gtk-tree-store-prepend tree-store iter parent)
+    iter))
+
+(defcfun gtk-tree-store-append :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (parent (g-boxed-foreign tree-iter)))
+
+(defun tree-store-append (tree-store parent)
+  (let ((iter (make-tree-iter)))
+    (gtk-tree-store-append tree-store iter parent)
+    iter))
+
+(export '(tree-store-prepend tree-store-append))
+
+(defcfun (tree-store-is-ancestor "gtk_tree_store_is_ancestor") :boolean
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (descendant (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-is-ancestor)
+
+(defcfun (tree-store-iter-depth "gtk_tree_store_iter_depth") :int
+  (tree-store (g-object tree-store))
+  (tree-iter (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-iter-depth)
+
+(defcfun (tree-store-clear "gtk_tree_store_clear") :void
+  (tree-store (g-object tree-store)))
+
+(export 'tree-store-clear)
+
+(defcfun (tree-store-iter-is-valid "gtk_tree_store_iter_is_valid") :boolean
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-iter-is-valid)
+
+;; not implemented
+;; void                gtk_tree_store_reorder              (GtkTreeStore *tree_store,
+;;                                                          GtkTreeIter *parent,
+;;                                                          gint *new_order);
+
+
+(defcfun (tree-store-swap "gtk_tree_store_swap") :void
+  (tree-store (g-object tree-store))
+  (a (g-boxed-foreign tree-iter))
+  (b (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-swap)
+
+(defcfun (tree-store-move-before "gtk_tree_store_move_before") :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (position (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-move-before)
+
+(defcfun (tree-store-move-after "gtk_tree_store_move_after") :void
+  (tree-store (g-object tree-store))
+  (iter (g-boxed-foreign tree-iter))
+  (position (g-boxed-foreign tree-iter)))
+
+(export 'tree-store-move-after)