[gtk-cffi-cvs] CVS gtk-cffi/gtk

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv6570/gtk

Modified Files:
	addons.lisp text-buffer.lisp text-tag.lisp tree-model.lisp 
Log Message:
Several fixes for struct memory management.
Now we can use cffi-object:struct lisp values in place for cffi-object:pobject
when we don't rerturn value. When you need to fill pointer slot for struct,
just describe it as (object smth) in defcfun



--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp	2011/09/10 16:26:11	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/addons.lisp	2011/09/21 12:03:47	1.2
@@ -16,4 +16,12 @@
                                               seq) 
                                   :columns '(:string)))
                   :columns '("Array"))))))
+
+;; (defun status-tree ()
+;;   (let ((tree-model (make-instance 'tree-strore)))
+;;     (show
+;;      (gtk-model
+;;        'window
+;;        ('scrolled-window
+;;         ('tree-view :model tree-model))))))
                  
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2011/04/25 19:16:08	1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2011/09/21 12:03:47	1.2
@@ -1,7 +1,26 @@
 (in-package :gtk-cffi)
 
-(defcstruct text-iter-struct
-  ""
+(defclass text-tag-table (g-object)
+  ())
+
+(defcfun gtk-text-tag-table-new :pointer)
+
+(defmethod gconstructor ((text-tag-table text-tag-table) &key 
+                         &allow-other-keys)
+  (gtk-text-tag-table-new))
+
+(defgtkfuns text-tag-table
+  (add :void (tag pobject))
+  ((text-tag-table-remove . remove) :void (tag pobject))
+  (lookup pobject (name gtk-string))
+  (:get size :int))
+
+(make-foreach text-tag-table (tag (object text-tag)) (data pdata))
+
+(defclass text-iter (struct)
+  ())
+
+(defcstruct text-iter
   (u1 :pointer)
   (u2 :pointer)
   (u3 :int)
@@ -17,22 +36,36 @@
   (u13 :int)
   (u14 :pointer))
 
-(defclass text-iter (object)
-  ())
-
-(defmethod gconstructor ((text-iter text-iter) &key &allow-other-keys)
-  (foreign-alloc 'text-iter-struct))
+(defcfun gtk-text-iter-free :void (iter pobject))
 
-(defcfun "gtk_text_iter_free" :void (iter pobject))
+(defmethod free-struct ((class (eql 'text-iter)) value)
+  (gtk-text-iter-free value))
 
-(defmethod free :before ((text-iter text-iter))
-  (gtk-text-iter-free text-iter))
+(defgtkslots text-iter
+  line :int
+  offset :int
+  line-offset :int
+  line-index :int
+  visible-line-index :int
+  visible-line-offset :int)
+
+(defgtkfuns text-iter
+  ((text-iter-char . get-char) unichar)
+  (:get slice gtk-string (end pobject))
+  ((text-iter-text . get-text) gtk-string (end pobject))
+  (:get visible-slice gtk-string (end pobject))
+  (:get visible-text gtk-string (end pobject))
+  (:get pixbuf pobject)
+  (:get marks (g-slist text-mark))
+  (:get toggled-tags (g-slist text-mark) (toggle-on :boolean))
+  (:get child-anchor pobject))
+    
 
 (defclass text-buffer (g-object)
   ((start :accessor start)
    (end :accessor end)))
 
-(defcfun "gtk_text_buffer_new" :pointer (tag-table pobject))
+(defcfun gtk-text-buffer-new :pointer (tag-table pobject))
 
 (defmethod gconstructor ((text-buffer text-buffer)
                          &key tag-table &allow-other-keys)
@@ -40,8 +73,8 @@
 
 (defmethod initialize-instance :after ((text-buffer text-buffer)
                                        &key &allow-other-keys)
-  (setf (start text-buffer) (make-instance 'text-iter))
-  (setf (end text-buffer) (make-instance 'text-iter)))
+  (setf (start text-buffer) (make-instance 'text-iter); :new-struct t)
+        (end text-buffer) (make-instance 'text-iter))); :new-struct t)))
 
 
 (defmethod free :before ((text-buffer text-buffer))
@@ -52,10 +85,10 @@
   (start pobject) (end pobject) (include-hidden :boolean))
 
 (defcfun "gtk_text_buffer_get_start_iter" :void
-  (buffer pobject) (iter pobject))
+  (buffer pobject) (iter (struct text-iter :out t)))
 
 (defcfun "gtk_text_buffer_get_end_iter" :void
-  (buffer pobject) (iter pobject))
+  (buffer pobject) (iter (struct text-iter :out t)))
 
 (defmethod get-iter ((text-buffer text-buffer) (text-iter text-iter) pos)
   (case pos
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp	2011/09/18 18:10:48	1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-tag.lisp	2011/09/21 12:03:47	1.4
@@ -61,7 +61,7 @@
 (defmethod new-struct ((class (eql 'text-attributes)))
   (gtk-text-attributes-new))
 
-(defmethod free-struct (class (value text-attributes))
+(defmethod free-struct ((class (eql 'text-attributes)) value)
   (unref value))
 
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp	2011/09/10 16:26:11	1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp	2011/09/21 12:03:47	1.5
@@ -130,21 +130,9 @@
 (defmethod free :before ((tree-model tree-model))
   (free (tree-iter tree-model)))
 
-(defvar *tree-model-foreach* nil)
-
-(defcallback cb-tree-model-foreach :boolean
-  ((model pobject) (path (object tree-path)) 
-   (tree-iter (object tree-iter)) (data pdata))
-  (if *tree-model-foreach*
-      (funcall *tree-model-foreach* model path tree-iter data)
-      t))
-
-(defcfun "gtk_tree_model_foreach" :void
-  (model pobject) (func :pointer) (data pdata))
-
-(defmethod foreach ((tree-model tree-model) func &optional data)
-  (let ((*tree-model-foreach* func))
-    (gtk-tree-model-foreach tree-model (callback cb-tree-model-foreach) data)))
+(make-foreach tree-model 
+              (path (object tree-path)) 
+              (tree-iter (object tree-iter)))
 
 (defcfun "gtk_tree_model_get_path" (object tree-path) 
   (model pobject) (iter pobject))