Added multi-threading support

[clg] / gtk / gtktree.lisp

diff --git a/gtk/gtktree.lisp b/gtk/gtktree.lisp
index 1ba05f59ecd54fa6a00160e454c4b8cf7e7b3582..81d647424e0ccd53859a404a14ac2a9cd026defa 100644 (file)
--- a/gtk/gtktree.lisp
+++ b/gtk/gtktree.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 

-;; $Id: gtktree.lisp,v 1.11 2005-09-26 21:34:53 espen Exp $
+;; $Id: gtktree.lisp,v 1.18 2006-03-03 19:00:12 espen Exp $

 
 
 (in-package "GTK")
 
 
 (in-package "GTK")


@@ -58,15 +58,15 @@ (defbinding cell-layout-add-attribute (cell-layout cell attribute column) nil
   ((string-downcase attribute) string)
   (column int))
 
   ((string-downcase attribute) string)
   (column int))
 

-(def-callback-marshal %cell-layout-data-func 
-    (nil cell-layout cell-renderer tree-model (copy-of tree-iter)))
+(define-callback-marshal %cell-layout-data-callback nil 
+  (cell-layout cell-renderer tree-model tree-iter))

 
 (defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
   (cell-layout cell-layout)
   (cell cell-renderer)
 
 (defbinding cell-layout-set-cell-data-func (cell-layout cell function) nil
   (cell-layout cell-layout)
   (cell cell-renderer)

-  (%cell-layout-data-func callback)
+  (%cell-layout-data-callback callback)

   ((register-callback-function function) unsigned-int)
   ((register-callback-function function) unsigned-int)

-  (user-data-destroy-func callback))
+  (user-data-destroy-callback callback))

 
 (defbinding cell-layout-clear-attributes () nil
   (cell-layout cell-layout)
 
 (defbinding cell-layout-clear-attributes () nil
   (cell-layout cell-layout)


@@ -81,13 +81,16 @@ (defmethod initialize-instance ((list-store list-store) &key column-types
   (call-next-method)
   (%list-store-set-column-types list-store column-types)
   (when column-names
   (call-next-method)
   (%list-store-set-column-types list-store column-types)
   (when column-names

-    (setf (object-data list-store 'column-names) column-names))
+    (setf 
+     (object-data list-store 'column-names) 
+     (coerce column-names 'vector)))

   (when initial-content
     (loop
      with iter = (make-instance 'tree-iter)
      for row in initial-content
      do (list-store-append list-store row iter))))
 
   (when initial-content
     (loop
      with iter = (make-instance 'tree-iter)
      for row in initial-content
      do (list-store-append list-store row iter))))
 

+(defgeneric column-setter-name (store))

 
 (defmethod column-setter-name ((list-store list-store))
   (declare (ignore list-store))
 
 (defmethod column-setter-name ((list-store list-store))
   (declare (ignore list-store))


@@ -221,66 +224,67 @@ (defun %tree-path-to-vector (location)
       (map-c-vector 'vector #'identity indices 'int depth))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
       (map-c-vector 'vector #'identity indices 'int depth))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)

-  (defmethod alien-type ((type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method alien-type ((type tree-path))
+    (declare (ignore type))

     (alien-type 'pointer))
   
     (alien-type 'pointer))
   

-  (defmethod size-of ((type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method size-of ((type tree-path))
+    (declare (ignore type))

     (size-of 'pointer))
   
     (size-of 'pointer))
   

-  (defmethod to-alien-form (path (type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method to-alien-form ((type tree-path) path)
+    (declare (ignore type))

     `(%make-tree-path ,path))
   
     `(%make-tree-path ,path))
   

-  (defmethod from-alien-form (location (type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method from-alien-form ((type tree-path) location)
+    (declare (ignore type))

     `(let ((location ,location))
        (prog1
            (%tree-path-to-vector location)
         (%tree-path-free location))))
   
     `(let ((location ,location))
        (prog1
            (%tree-path-to-vector location)
         (%tree-path-free location))))
   

-  (defmethod copy-from-alien-form (location (type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method copy-from-alien-form ((type tree-path) location)
+    (declare (ignore type))

     `(%tree-path-to-vector ,location))
   
     `(%tree-path-to-vector ,location))
   

-  (defmethod cleanup-form (location (type (eql 'tree-path)) &rest args)
-    (declare (ignore type args))
+  (define-type-method cleanup-form ((type tree-path) location)
+    (declare (ignore type))

     `(%tree-path-free ,location)))
 
     `(%tree-path-free ,location)))
 

-(defmethod to-alien-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method to-alien-function ((type tree-path))
+  (declare (ignore type))

   #'%make-tree-path)
   
   #'%make-tree-path)
   

-(defmethod from-alien-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method from-alien-function ((type tree-path))
+  (declare (ignore type))

   #'(lambda (location)
       (prog1
          (%tree-path-to-vector location)
        (%tree-path-free location))))
 
   #'(lambda (location)
       (prog1
          (%tree-path-to-vector location)
        (%tree-path-free location))))
 

-(defmethod copy-from-alien-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method copy-from-alien-function ((type tree-path))
+  (declare (ignore type ))

   #'%tree-path-to-vector)
   
   #'%tree-path-to-vector)
   

-(defmethod cleanup-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method cleanup-function ((type tree-path))
+  (declare (ignore type))

   #'%tree-path-free)
 
   #'%tree-path-free)
 

-(defmethod writer-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method writer-function ((type tree-path))
+  (declare (ignore type))

   (let ((writer (writer-function 'pointer)))
     #'(lambda (path location &optional (offset 0))
        (funcall writer (%make-tree-path path) location offset))))
 
   (let ((writer (writer-function 'pointer)))
     #'(lambda (path location &optional (offset 0))
        (funcall writer (%make-tree-path path) location offset))))
 

-(defmethod reader-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method reader-function ((type tree-path))
+  (declare (ignore type))

   (let ((reader (reader-function 'pointer)))
   (let ((reader (reader-function 'pointer)))

-    #'(lambda (location &optional (offset 0))
+    #'(lambda (location &optional (offset 0) weak-p)
+       (declare (ignore weak-p))

        (%tree-path-to-vector (funcall reader location offset)))))
 
        (%tree-path-to-vector (funcall reader location offset)))))
 

-(defmethod destroy-function ((type (eql 'tree-path)) &rest args)
-  (declare (ignore type args))
+(define-type-method destroy-function ((type tree-path))
+  (declare (ignore type))

   (let ((reader (reader-function 'pointer)))
     #'(lambda (location &optional (offset 0))
        (%tree-path-free (funcall reader location offset)))))
   (let ((reader (reader-function 'pointer)))
     #'(lambda (location &optional (offset 0))
        (%tree-path-free (funcall reader location offset)))))


@@ -290,11 +294,8 @@ (defbinding %tree-row-reference-new () pointer
   (model tree-model)
   (path tree-path))
 
   (model tree-model)
   (path tree-path))
 

-(defmethod initialize-instance ((reference tree-row-reference) &key model path)
-  (setf
-   (slot-value reference 'location)
-   (%tree-row-reference-new model path))
-  (call-next-method))
+(defmethod allocate-foreign ((reference tree-row-reference) &key model path)
+  (%tree-row-reference-new model path))

 
 (defbinding tree-row-reference-get-path () tree-path
   (reference tree-row-reference))
 
 (defbinding tree-row-reference-get-path () tree-path
   (reference tree-row-reference))


@@ -323,7 +324,9 @@ (defbinding %tree-model-get-value () nil
   (column int)
   (gvalue gvalue))
 
   (column int)
   (gvalue gvalue))
 

-(defun tree-model-value (model row column)
+(defgeneric tree-model-value (model row column))
+
+(defmethod tree-model-value ((model tree-model) row column)

   (let ((index (column-index model column))
        (iter (etypecase row
                (tree-iter row)
   (let ((index (column-index model column))
        (iter (etypecase row
                (tree-iter row)


@@ -367,12 +370,12 @@ (defbinding tree-model-iter-parent
   (iter tree-iter :return)
   (child tree-iter))
 
   (iter tree-iter :return)
   (child tree-iter))
 

-(def-callback-marshal %tree-model-foreach-func 
-  (boolean tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
+(define-callback-marshal %tree-model-foreach-callback boolean 
+  (tree-model tree-path tree-iter))

 
 

-(defbinding %tree-model-foreach () nil
+(defbinding %tree-model-foreach (tree-model callback-id) nil

   (tree-model tree-model)
   (tree-model tree-model)

-  ((progn %tree-model-foreach-func) callback)
+  (%tree-model-foreach-callback callback)

   (callback-id unsigned-int))
 
 (defun tree-model-foreach (model function)
   (callback-id unsigned-int))
 
 (defun tree-model-foreach (model function)


@@ -407,6 +410,7 @@ (defbinding tree-model-rows-reordered () nil
 
 
 (defun column-types (model columns)
 
 
 (defun column-types (model columns)

+  (declare (ignore model))

   (map 'vector 
        #'(lambda (column)
           (find-type-number (first (mklist column))))
   (map 'vector 
        #'(lambda (column)
           (find-type-number (first (mklist column))))


@@ -461,7 +465,9 @@ (defun tree-model-row-setter (model)
                         (funcall setter value iter))
                 row setters)))))))
 
                         (funcall setter value iter))
                 row setters)))))))
 

-(defun (setf tree-model-value) (value model row column)
+(defgeneric (setf tree-model-value) (value model row column))
+
+(defmethod (setf tree-model-value) (value (model tree-model) row column)

   (let ((iter (etypecase row
                (tree-iter row)
                (tree-path (multiple-value-bind (valid iter)
   (let ((iter (etypecase row
                (tree-iter row)
                (tree-path (multiple-value-bind (valid iter)


@@ -488,13 +494,14 @@ (defun %tree-model-set (model iter data)
 
 ;;; Tree Selection
 
 
 ;;; Tree Selection
 

-(def-callback-marshal %tree-selection-func (boolean tree-selection tree-model (path (copy-of tree-path)) (path-currently-selected boolean)))
+(define-callback-marshal %tree-selection-callback boolean 
+  (tree-selection tree-model tree-path (path-currently-selected boolean)))

 
 (defbinding tree-selection-set-select-function (selection function) nil
   (selection tree-selection)
 
 (defbinding tree-selection-set-select-function (selection function) nil
   (selection tree-selection)

-  (%tree-selection-func callback)
+  (%tree-selection-callback callback)

   ((register-callback-function function) unsigned-int)
   ((register-callback-function function) unsigned-int)

-  (user-data-destroy-func callback))
+  (user-data-destroy-callback callback))

 
 (defbinding tree-selection-get-selected 
     (selection &optional (iter (make-instance 'tree-iter))) boolean
 
 (defbinding tree-selection-get-selected 
     (selection &optional (iter (make-instance 'tree-iter))) boolean


@@ -502,11 +509,11 @@ (defbinding tree-selection-get-selected
   (nil null) 
   (iter tree-iter :return))
 
   (nil null) 
   (iter tree-iter :return))
 

-(def-callback-marshal %tree-selection-foreach-func (nil tree-model (path (copy-of tree-path)) (iter (copy-of tree-iter))))
+(define-callback-marshal %tree-selection-foreach-callback nil (tree-model tree-path tree-iter))

 
 

-(defbinding %tree-selection-selected-foreach () nil
+(defbinding %tree-selection-selected-foreach (tree-selection callback-id) nil

   (tree-selection tree-selection)
   (tree-selection tree-selection)

-  ((progn %tree-selection-foreach-func) callback)
+  (%tree-selection-foreach-callback callback)

   (callback-id unsigned-int))
 
 (defun tree-selection-selected-foreach (selection function)
   (callback-id unsigned-int))
 
 (defun tree-selection-selected-foreach (selection function)


@@ -583,8 +590,8 @@   (define-enum-type sort-column (:default -1) (:unsorted -2))
   (define-enum-type sort-order (:before -1) (:equal 0) (:after 1)))
 
 
   (define-enum-type sort-order (:before -1) (:equal 0) (:after 1)))
 
 

-(def-callback-marshal %tree-iter-compare-func 
-  ((or int sort-order) tree-model (a (copy-of tree-iter)) (b (copy-of tree-iter))))
+(define-callback-marshal %tree-iter-compare-callback (or int sort-order)
+  (tree-model (a tree-iter) (b tree-iter)))

 
 (defbinding tree-sortable-sort-column-changed () nil
   (sortable tree-sortable))
 
 (defbinding tree-sortable-sort-column-changed () nil
   (sortable tree-sortable))


@@ -616,15 +623,15 @@ (defbinding (tree-sortable-set-sort-column
 (defbinding %tree-sortable-set-sort-func (sortable column function) nil
   (sortable tree-sortable)
   ((column-index sortable column) int)
 (defbinding %tree-sortable-set-sort-func (sortable column function) nil
   (sortable tree-sortable)
   ((column-index sortable column) int)

-  (%tree-iter-compare-func callback)
+  (%tree-iter-compare-callback callback)

   ((register-callback-function function) unsigned-int)
   ((register-callback-function function) unsigned-int)

-  (user-data-destroy-func callback))
+  (user-data-destroy-callback callback))

 
 (defbinding %tree-sortable-set-default-sort-func () nil
   (sortable tree-sortable)
 
 (defbinding %tree-sortable-set-default-sort-func () nil
   (sortable tree-sortable)

-  (compare-func (or null pointer))
+  (compare-func (or null callback))

   (callback-id unsigned-int)
   (callback-id unsigned-int)

-  (destroy-func (or null pointer)))
+  (destroy-func (or null callback)))

 
 (defun tree-sortable-set-sort-func (sortable column function)
   "Sets the comparison function used when sorting to be FUNCTION. If
 
 (defun tree-sortable-set-sort-func (sortable column function)
   "Sets the comparison function used when sorting to be FUNCTION. If


@@ -635,9 +642,9 @@ (defun tree-sortable-set-sort-func (sortable column function)
     (%tree-sortable-set-default-sort-func sortable nil 0 nil))
    ((eq column :default) 
     (%tree-sortable-set-default-sort-func sortable 
     (%tree-sortable-set-default-sort-func sortable nil 0 nil))
    ((eq column :default) 
     (%tree-sortable-set-default-sort-func sortable 

-     (callback %tree-iter-compare-func)
+     %tree-iter-compare-callback

      (register-callback-function function)
      (register-callback-function function)

-     (callback user-data-destroy-func)))
+     user-data-destroy-callback))

    ((%tree-sortable-set-sort-func sortable column function))))
 
 (defbinding tree-sortable-has-default-sort-func-p () boolean
    ((%tree-sortable-set-sort-func sortable column function))))
 
 (defbinding tree-sortable-has-default-sort-func-p () boolean


@@ -763,6 +770,7 @@ (defbinding tree-store-move-after () nil
 
 (defmethod initialize-instance ((tree-view tree-view) &rest initargs 
                                &key column)
 
 (defmethod initialize-instance ((tree-view tree-view) &rest initargs 
                                &key column)

+  (declare (ignore column))

   (call-next-method)
   (mapc #'(lambda (column)
            (tree-view-append-column tree-view column))
   (call-next-method)
   (mapc #'(lambda (column)
            (tree-view-append-column tree-view column))


@@ -851,11 +859,11 @@ (defbinding tree-view-collapse-row () nil
   (tree-view tree-view)
   (path tree-path))
 
   (tree-view tree-view)
   (path tree-path))
 

-(def-callback-marshal %tree-view-mapping-func (nil tree-view (path (copy-of tree-path))))
+(define-callback-marshal %tree-view-mapping-callback nil (tree-view tree-path))

 
 

-(defbinding %tree-view-map-expanded-rows () nil
+(defbinding %tree-view-map-expanded-rows (tree-view callback-id) nil

   (tree-view tree-view)
   (tree-view tree-view)

-  ((progn %tree-view-mapping-func) callback)
+  (%tree-view-mapping-callback callback)

   (callback-id unsigned-int))
 
 (defun map-expanded-rows (function tree-view)
   (callback-id unsigned-int))
 
 (defun map-expanded-rows (function tree-view)


@@ -903,12 +911,11 @@   (defbinding icon-view-get-path-at-pos () tree-path
     (icon-view icon-view)
     (x int) (y int))
 
     (icon-view icon-view)
     (x int) (y int))
 

-  (def-callback-marshal %icon-view-foreach-func 
-    (nil icon-view (path (copy-of tree-path))))
+  (define-callback-marshal %icon-view-foreach-callback nil (icon-view tree-path))

 
 

-  (defbinding %icon-view-selected-foreach () tree-path
+  (defbinding %icon-view-selected-foreach (icon-view callback-id) tree-path

     (icon-view icon-view)
     (icon-view icon-view)

-    ((progn %icon-view-foreach-func) callback)
+    (%icon-view-foreach-callback callback)

     (callback-id unsigned-int))
   
   (defun icon-view-foreach (icon-view function)
     (callback-id unsigned-int))
   
   (defun icon-view-foreach (icon-view function)