[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Fri Sep 21 19:00:33 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv8078/gtk
Modified Files:
package.lisp text-tag.lisp tree-model.lisp
Log Message:
Refactor GtkTreeModel. Now it is fully supported
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/08/21 19:48:02 1.28
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/09/21 19:00:33 1.29
@@ -547,22 +547,38 @@
;; frame slots
#:shadow-type
+ #:tree-row-reference
+ #:valid
+ #:copy
+
+ #:tree-path
+
#:tree-model
;; tree-model slots
#:columns
;; tree-model methods
#:tree-model-foreach
- #:get-index
+ #:flags
#:with-tree-iter
#:n-columns
#:column-type
-
- #:%iter
+ #:iter-has-child
+ #:iter-n-children
#:tree-iter
#:iter->path
+ #:iter->string
#:path->iter
- #:get-indices
- #:tree->indices
+ #:iter-first
+ #:iter-next
+ #:iter-previous
+ #:row-changed
+ #:row-inserted
+ #:row-deleted
+ #:row-has-child-toggled
+ #:rows-reordered
+ #:ref-node
+ #:unref-node
+
#:list-store
;; list-store methods
@@ -601,6 +617,10 @@
#:cell-get-position
#:cell-renderers
#:get-cell-at
+
+ #:scrollable
+ #:hscroll-policy
+ #:vscroll-policy
#:scrolled-window
;; scrolled-window slots
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2012/08/24 19:27:54 1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp 2012/09/21 19:00:33 1.7
@@ -31,7 +31,7 @@
(defcstruct* text-attributes
- (appearance (struct text-appearance))
+ (appearance (:struct text-appearance))
(justification justification)
(direction text-direction)
(text-attributes-font pango-cffi:font)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/08/24 19:27:54 1.14
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/09/21 19:00:33 1.15
@@ -29,21 +29,18 @@
(let* ((indices (gtk-tree-path-get-indices-with-depth ptr pdepth))
(depth (mem-ref pdepth :int))
(res (make-array depth :element-type 'fixnum)))
- (dotimes (i depth)
- (setf (aref res i) (mem-aref indices :int i)))
- res))))
+ (dotimes (i depth res)
+ (setf (aref res i) (mem-aref indices :int i)))))))
(defmethod translate-to-foreign ((value array) (tree-path tree-path))
(let ((res (gtk-tree-path-new)))
- (dotimes (i (length value))
- (gtk-tree-path-append-index res (aref value i)))
- res))
+ (dotimes (i (length value) res)
+ (gtk-tree-path-append-index res (aref value i)))))
(defmethod translate-to-foreign ((value list) (tree-path tree-path))
(let ((res (gtk-tree-path-new)))
- (dolist (i value)
- (gtk-tree-path-append-index res i))
- res))
+ (dolist (i value res)
+ (gtk-tree-path-append-index res i))))
(defmethod translate-to-foreign ((value string) (tree-path tree-path))
(gtk-tree-path-new-from-string value))
@@ -87,7 +84,7 @@
(defcstruct tree-model-iface
"GtkTreeModelIface"
- (g-iface g-type-interface)
+ (g-iface (:struct g-type-interface))
(row-changed :pointer)
(row-inserted :pointer)
(has-child-toggled :pointer)
@@ -125,14 +122,14 @@
(tree-iter (object tree-iter))
(data pdata))
-(defcfun gtk-tree-model-get-path (object tree-path)
- (model pobject) (iter pobject))
+(defcfun gtk-tree-model-get-path tree-path
+ (model pobject) (tree-iter (struct tree-iter)))
(defmethod iter->path ((tree-model tree-model) (tree-iter tree-iter))
(gtk-tree-model-get-path tree-model tree-iter))
(defcfun gtk-tree-model-get-string-from-iter :string
- (model pobject) (iter pobject))
+ (model pobject) (tree-iter (struct tree-iter)))
(defmethod iter->string ((tree-model tree-model) (tree-iter tree-iter))
(gtk-tree-model-get-string-from-iter tree-model tree-iter))
@@ -140,47 +137,90 @@
(defcfun gtk-tree-model-get-value :void (model pobject) (iter pobject)
(column :int) (g-value pobject))
-(defmethod model-values
- ((tree-model tree-model) &key
- (tree-iter (tree-iter tree-model)) col (columns (ensure-list col)))
- "columns = num0 &optional num1 num2 ..."
- ;(format t "model-values: ~a ~a ~a~%" tree-model tree-iter cols)
- (mapcar
- (lambda (col)
- (with-g-value ()
- (gtk-tree-model-get-value tree-model
- tree-iter col *g-value*)))
- columns))
+(defgeneric model-values (tree-model &key tree-iter column columns)
+ (:method ((tree-model tree-model)
+ &key (tree-iter (tree-iter tree-model))
+ column
+ (columns (ensure-list column)))
+ "columns = num0 &optional num1 num2 ..."
+ ;(format t "model-values: ~a ~a ~a~%" tree-model tree-iter cols)
+ (mapcar
+ (lambda (col)
+ (with-g-value ()
+ (gtk-tree-model-get-value tree-model
+ tree-iter col *g-value*)))
+ columns)))
(defcfun gtk-tree-model-get-iter :boolean
(model pobject) (iter (struct tree-iter :out t)) (path tree-path))
-(defmethod path->iter ((tree-model tree-model) tree-path
- &optional (tree-iter (tree-iter tree-model)))
- (gtk-tree-model-get-iter tree-model tree-iter tree-path)
- tree-iter)
-
-(defcfun "gtk_tree_model_get_iter_from_string" :boolean
- (model pobject) (iter (struct tree-iter :out t)) (path :string))
-
-(defmethod path->iter ((tree-model tree-model) (tree-path-string string)
- &optional (tree-iter (tree-iter tree-model)))
- (gtk-tree-model-get-iter-from-string tree-model tree-iter tree-path-string)
- tree-iter)
+(defcfun gtk-tree-model-get-iter-from-string :boolean
+ (model pobject) (tree-iter (struct tree-iter :out t)) (path :string))
+
+(defgeneric path->iter (tree-model tree-path-string &optional tree-iter)
+ (:method ((tree-model tree-model) tree-path
+ &optional (tree-iter (tree-iter tree-model)))
+ (when (gtk-tree-model-get-iter tree-model tree-iter tree-path)
+ tree-iter))
+ (:method ((tree-model tree-model) (tree-path-string string)
+ &optional (tree-iter (tree-iter tree-model)))
+ (when (gtk-tree-model-get-iter-from-string tree-model
+ tree-iter tree-path-string)
+ tree-iter)))
(defmacro with-tree-iter (var &body body)
`(with-object (,var) (make-instance 'tree-iter)
, at body))
-(defcfun gtk-tree-model-get-n-columns :int (tree-model pobject))
-
-(defmethod n-columns ((tree-model tree-model))
- (gtk-tree-model-get-n-columns tree-model))
-
-(defcfun gtk-tree-model-get-column-type :int (tree-model pobject) (col :int))
-
-(defmethod column-type ((tree-model tree-model) col)
- (gtk-tree-model-get-column-type tree-model col))
-
-
+(defbitfield tree-model-flags :iters-persist :list-only)
+(deffuns tree-model
+ (:get n-columns :int)
+ (:get column-type g-type (col :int))
+ (:get flags tree-model-flags)
+ (iter-has-child :boolean (tree-iter (struct tree-iter)))
+ (iter-n-children :int (tree-iter (struct tree-iter)))
+ (ref-node :void (tree-iter (struct tree-iter)))
+ (unref-node :void (tree-iter (struct tree-iter)))
+ (row-changed :void (path tree-path) (tree-iter (struct tree-iter)))
+ (row-inserted :void (path tree-path) (tree-iter (struct tree-iter)))
+ (row-has-child-toggled :void (path tree-path) (tree-iter (struct tree-iter)))
+ (row-deleted :void (path tree-path))
+ (rows-reordered :void
+ (path tree-path) (tree-iter (struct tree-iter))
+ (new-order (carray :int))))
+
+(template
+ (name lisp-name)
+ ((get-iter-first iter-first)
+ (iter-next iter-next)
+ (iter-previous iter-previous))
+ (let ((c-name (symbolicate 'gtk-tree-model- name)))
+ `(progn
+ (defcfun ,c-name :boolean
+ (model pobject) (tree-iter (struct tree-iter :out t)))
+ (defgeneric ,lisp-name (tree-model &optional tree-iter)
+ (:method ((tree-model tree-model)
+ &optional (tree-iter (tree-iter tree-model)))
+ (when (,c-name tree-model tree-iter)
+ tree-iter))))))
+
+(defcfun gtk-tree-model-iter-nth-child :boolean
+ (model pobject) (tree-iter (struct tree-iter :out t))
+ (parent (struct tree-iter)) (n :int))
+
+(defgeneric iter-nth-child (tree-model parent n &optional tree-iter)
+ (:method ((tree-model tree-model) parent n
+ &optional (tree-iter (tree-iter tree-model)))
+ (when (gtk-tree-model-iter-nth-child tree-model tree-iter parent n)
+ tree-iter)))
+
+(defcfun gtk-tree-model-iter-parent :boolean
+ (model pobject) (tree-iter (struct tree-iter :out t))
+ (child (struct tree-iter)))
+
+(defgeneric iter-parent (tree-model child &optional tree-iter)
+ (:method ((tree-model tree-model) child
+ &optional (tree-iter (tree-iter tree-model)))
+ (when (gtk-tree-model-iter-parent tree-model tree-iter child)
+ tree-iter)))
More information about the gtk-cffi-cvs
mailing list