From 535fccbbf9ad65d1a5e57511e344af5129ff81c8 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 24 Oct 2009 02:23:28 +0400 Subject: [PATCH] Add GtkListStore binding --- ...e-23861ef1324f6316848582a5636055e9497cbd92.yaml | 8 +- gtk/cl-gtk2-gtk.asd | 1 + gtk/gtk.demo.lisp | 47 +++++- gtk/gtk.list-store.lisp | 161 ++++++++++++++++++++ 4 files changed, 214 insertions(+), 3 deletions(-) create mode 100644 gtk/gtk.list-store.lisp diff --git a/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml b/bugs/issue-23861ef1324f6316848582a5636055e9497cbd92.yaml index 59e0149..d6aa133 100644 --- 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 -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 - created - "" +- - 2009-10-23 22:22:59.660941 Z + - Kalyanov Dmitry + - closed with disposition fixed + - "" diff --git a/gtk/cl-gtk2-gtk.asd b/gtk/cl-gtk2-gtk.asd index 621a7e9..5829ee2 100644 --- 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 --- 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 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)) -- 1.7.10.4