Add GtkListStore binding

diff --git a/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml b/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml
index 59e0149..d6aa133 100644 (file)
--- a/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml
+++ b/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml
@@ -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:30.969849 Z
 references: []
 
@@ -16,3 +16,7 @@ log_events:
   - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
   - created
   - ""
+- - 2009-10-23 22:22:59.660941 Z
+  - Kalyanov Dmitry <Kalyanov.Dmitry@gmail.com>
+  - closed with disposition fixed
+  - ""

diff --git a/gtk/cl-gtk2-gtk.asd b/gtk/cl-gtk2-gtk.asd
index 621a7e9..5829ee2 100644 (file)
--- a/gtk/cl-gtk2-gtk.asd
+++ b/gtk/cl-gtk2-gtk.asd
@@ -47,6 +47,7 @@
                (:file "gtk.builder")
                (:file "gtk.assistant")
                (:file "gtk.link-button")
+               (:file "gtk.list-store")
                
                (:file "gtk.main-loop-events")
                

diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp
index 3899649..eb715e3 100644 (file)
--- a/gtk/gtk.demo.lisp
+++ b/gtk/gtk.demo.lisp
@@ -28,7 +28,8 @@
            #:test-custom-window
            #:test-assistant
            #:test-entry-completion
-           #:test-ui-markup))
+           #:test-ui-markup
+           #:test-list-store))
 
 (in-package :gtk-demo)
 
@@ -959,3 +960,47 @@
                           (text-buffer-insert (text-view-buffer tv)
                                               (entry-text entry))))
         (widget-show w)))))
+
+(defun test-list-store ()
+  "Demonstrates usage of list 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 'list-store :column-types '("gint" "gchararray"))))
+        (iter (for i from 0 below 100)
+              (for n = (random 10000000))
+              (for s = (format nil "~R" n))
+              (list-store-insert-with-values l i n s))
+        (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.list-store.lisp b/gtk/gtk.list-store.lisp
new file mode 100644 (file)
index 0000000..211e4fb
--- /dev/null
+++ b/gtk/gtk.list-store.lisp
@@ -0,0 +1,161 @@
+(in-package :gtk)
+
+(defcfun gtk-list-store-set-column-types :void
+  (list-store (g-object list-store))
+  (n-columns :int)
+  (types :pointer))
+
+(defun call-list-store-set-column-types (list-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-list-store-set-column-types list-store n types-ar))))
+
+(defmethod initialize-instance :after ((store list-store) &rest initargs &key (column-types nil column-types-supplied-p) &allow-other-keys)
+  (declare (ignore initargs))
+  (when column-types-supplied-p
+    (call-list-store-set-column-types store column-types)))
+
+(defcfun (%gtk-list-store-set-value "gtk_list_store_set_value") :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter))
+  (column :int)
+  (value :pointer))
+
+(defun gtk-list-store-set-value (list-store iter column value)
+  (with-foreign-object (v 'g-value)
+    (set-g-value v value (tree-model-column-type list-store column) :zero-g-value t)
+    (%gtk-list-store-set-value list-store iter column v)
+    (g-value-unset v)
+    (values)))
+
+(defun list-store-value (list-store iter column)
+  (tree-model-value list-store iter column))
+
+(defun (setf list-store-value) (new-value list-store iter column)
+  (gtk-list-store-set-value list-store iter column new-value)
+  new-value)
+
+(export 'list-store-value)
+
+; unimplemented
+;void                gtk_list_store_set_valuesv          (GtkListStore *list_store,
+;                                                         GtkTreeIter *iter,
+;                                                         gint *columns,
+;                                                         GValue *values,
+;                                                         gint n_values);
+
+(defcfun (list-store-remove "gtk_list_store_remove") :boolean
+  (list-store (g-object list-store))
+  (tree-iter (g-boxed-foreign tree-iter)))
+
+(export 'list-store-remove)
+
+(defcfun gtk-list-store-insert :void
+  (list-store (g-object list-store))
+  (tree-iter (g-boxed-foreign tree-iter))
+  (position :int))
+
+(defun list-store-insert (list-store position)
+  (let ((iter (make-tree-iter)))
+    (gtk-list-store-insert list-store iter position)
+    iter))
+
+(export 'list-store-insert)
+
+(defcfun gtk-list-store-insert-before :void
+  (list-store (g-object list-store))
+  (tree-iter (g-boxed-foreign tree-iter))
+  (sibling (g-boxed-foreign tree-iter)))
+
+(defcfun gtk-list-store-insert-after :void
+  (list-store (g-object list-store))
+  (tree-iter (g-boxed-foreign tree-iter))
+  (sibling (g-boxed-foreign tree-iter)))
+
+(defun list-store-insert-before (list-store sibling)
+  (let ((iter (make-tree-iter)))
+    (gtk-list-store-insert-before list-store iter sibling)
+    iter))
+
+(defun list-store-insert-after (list-store sibling)
+  (let ((iter (make-tree-iter)))
+    (gtk-list-store-insert-after list-store iter sibling)
+    iter))
+
+(export '(list-store-insert-before list-store-insert-after))
+
+(defcfun gtk-list-store-insert-with-valuesv :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter))
+  (position :int)
+  (columns :pointer)
+  (values :pointer)
+  (n-values :int))
+
+(defun list-store-insert-with-values (list-store 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 list-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-list-store-insert-with-valuesv list-store iter 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 'list-store-insert-with-values)
+
+(defcfun gtk-list-store-prepend :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter)))
+
+(defcfun gtk-list-store-append :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter)))
+
+(defun list-store-append (list-store)
+  (let ((i (make-tree-iter)))
+    (gtk-list-store-append list-store i)
+    i))
+
+(defun list-store-prepend (list-store)
+  (let ((i (make-tree-iter)))
+    (gtk-list-store-prepend list-store i)
+    i))
+
+(export '(list-store-append list-store-prepend))
+
+(defcfun (list-store-clear "gtk_list_store_clear") :void
+  (list-store (g-object list-store)))
+
+(defcfun (list-store-iter-is-valid "gtk_list_store_iter_is_valid") :boolean
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter)))
+
+; not implemented yet
+;(defcfun (list-store-reorder "gtk_list_store_reorder") :void
+;  ())
+
+(defcfun (list-store-swap "gtk_list_store_swap") :void
+  (list-store (g-object list-store))
+  (a (g-boxed-foreign tree-iter))
+  (b (g-boxed-foreign tree-iter)))
+
+(defcfun (list-store-move-before "gtk_list_store_move_before") :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter))
+  (position (g-boxed-foreign tree-iter)))
+
+(defcfun (list-store-move-after "gtk_list_store_move_after") :void
+  (list-store (g-object list-store))
+  (iter (g-boxed-foreign tree-iter))
+  (position (g-boxed-foreign tree-iter)))
+
+(export '(list-store-clear list-store-iter-is-valid list-store-swap list-store-move-before list-store-move-after))