[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Sat Jul 21 19:26:39 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv799/gtk
Modified Files:
buttonbox.lisp combo-box.lisp package.lisp tree-model.lisp
tree-selection.lisp tree-view.lisp
Log Message:
Changed GtkTreePath representation in lisp.
It was a pointer, now it is an array to prevent memory leak.
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/buttonbox.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/buttonbox.lisp 2012/07/21 19:26:39 1.2
@@ -9,9 +9,10 @@
(defcfun "gtk_button_box_get_child_secondary" :boolean
(button-box pobject) (widget pobject))
-(defmethod child-secondary ((button-box button-box) (widget widget))
- (gtk-button-box-get-child-secondary button-box widget))
+(defgeneric child-secondary (button-box widget)
+ (:method ((button-box button-box) (widget widget))
+ (gtk-button-box-get-child-secondary button-box widget)))
-(defmethod (setf child-secondary) (secondary
- (button-box button-box) (widget widget))
- (gtk-button-box-set-child-secondary button-box widget secondary))
+(defgeneric (setf child-secondary) (secondary button-box widget)
+ (:method (secondary (button-box button-box) (widget widget))
+ (gtk-button-box-set-child-secondary button-box widget secondary)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/05/08 09:38:07 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/07/21 19:26:39 1.4
@@ -29,8 +29,9 @@
;; separate declaration to avoid auto-adding to initargs
(defcfun gtk-combo-box-set-model :void (combo-box pobject) (model pobject))
-(defmethod (setf model) (tree-model (combo-box combo-box))
- (gtk-combo-box-set-model combo-box tree-model))
+(defgeneric (setf model) (tree-model combo-box)
+ (:method (tree-model (combo-box combo-box))
+ (gtk-combo-box-set-model combo-box tree-model) tree-model))
(defslots combo-box
wrap-width :int
@@ -63,18 +64,20 @@
(combo-box pobject) (func pfunction) (data pdata) (notify :pointer))
-(defmethod (setf row-separator-func) (func (combo-box combo-box)
- &key data destroy-notify)
- (set-callback combo-box gtk-combo-box-set-row-separator-func
- cb-row-separator-func func data destroy-notify))
+(defgeneric (setf row-separator-func) (func combo-box &key data destroy-notify)
+ (:method (func (combo-box combo-box) &key data destroy-notify)
+ (set-callback combo-box gtk-combo-box-set-row-separator-func
+ cb-row-separator-func func data destroy-notify)))
(defcfun gtk-combo-box-set-active-id :boolean
(combo-box pobject) (active-id :string))
-(defmethod (setf active-id) (active-id (combo-box combo-box))
- (values active-id
- (gtk-combo-box-set-active-id combo-box active-id)))
+(defgeneric (setf active-id) (active-id combo-box)
+ (:method (active-id (combo-box combo-box))
+ (values active-id
+ (gtk-combo-box-set-active-id combo-box active-id))))
+(save-setter combo-box active-id)
(defcfun gtk-combo-box-set-active-iter
:void (combo-box pobject) (iter (struct tree-iter :free :none)))
@@ -83,13 +86,14 @@
(defgeneric (setf active-iter) (active-iter combo-box)
(:method (active-iter (combo-box combo-box))
- (gtk-combo-box-set-active-iter combo-box active-iter)))
+ (gtk-combo-box-set-active-iter combo-box active-iter)
+ active-iter))
+(save-setter combo-box active-iter)
(defgeneric active-iter (combo-box)
(:method ((combo-box combo-box))
(let ((res (make-instance 'tree-iter)))
(values res (gtk-combo-box-get-active-iter combo-box res)))))
-(save-setter combo-box active-iter)
(init-slots combo-box)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/05/08 09:38:07 1.20
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/21 19:26:39 1.21
@@ -494,6 +494,7 @@
#:tree-selection
;; tree-selection methods
#:mode
+ #:select-function
#:with-selection
#:get-selected
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/05/08 09:38:07 1.9
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/21 19:26:39 1.10
@@ -1,46 +1,49 @@
(in-package #:gtk-cffi)
-(defclass tree-path (object)
- ())
-
-(defcfun "gtk_tree_path_new" :pointer)
-
-(defcfun "gtk_tree_path_free" :void (path pobject))
-
-(defcfun "gtk_tree_path_new_from_string" :pointer (str :string))
-
-(defcfun "gtk_tree_path_new_from_indices" :pointer &rest)
-
-(defcfun "gtk_tree_path_append_index" :void (path pobject) (index :int))
+;; I think, that tree-path as pointer is not useful on Lisp side
+;; so it will be represented as a lisp array
-(defmethod gconstructor ((tree-path tree-path)
- &key string indices &allow-other-keys)
- (cond
- (string (gtk-tree-path-new-from-string string))
- (indices (let ((ptr (gtk-tree-path-new)))
- (mapc (lambda (x)
- (gtk-tree-path-append-index ptr x))
- indices)
- ptr))
- (t (gtk-tree-path-new))))
+(defcfun gtk-tree-path-new :pointer)
+(defcfun gtk-tree-path-free :void (path :pointer))
+(defcfun gtk-tree-path-new-from-string :pointer (str :string))
+(defcfun gtk-tree-path-append-index :void (path :pointer) (index :int))
+
+(defcfun gtk-tree-path-get-indices-with-depth :pointer
+ (path :pointer) (depth :pointer))
+
+(define-foreign-type tree-path (freeable)
+ ((free :initform :all)) ; NB: except callbacks
+ (:simple-parser tree-path)
+ (:actual-type :pointer))
+
+(defmethod translate-from-foreign (ptr (tree-path tree-path))
+ (unless (null-pointer-p ptr)
+ (with-foreign-object (pdepth :int)
+ (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))))
+
+(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))
+
+(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))
+(defmethod translate-to-foreign ((value string) (tree-path tree-path))
+ (gtk-tree-path-new-from-string value))
-(defmethod free :before ((tree-path tree-path))
- (gtk-tree-path-free tree-path))
+(defmethod free-ptr ((tree-path tree-path) ptr)
+ (gtk-tree-path-free ptr))
-(defcfun "gtk_tree_path_get_depth" :int (path pobject))
-
-(defcfun "gtk_tree_path_get_indices" :pointer (path pobject))
-
-(defmethod get-indices ((tree-path tree-path))
- (let* ((ptr (pointer tree-path))
- (depth (gtk-tree-path-get-depth ptr))
- (array (gtk-tree-path-get-indices ptr)))
- (loop :for i :below depth
- :collect (mem-aref array :int i))))
-
-(defmethod get-index ((tree-path tree-path) &optional (pos 0))
- (mem-aref (gtk-tree-path-get-indices tree-path) :int pos))
(defclass tree-row (object)
())
@@ -135,32 +138,23 @@
(make-foreach tree-model
(model pobject)
- (path (object tree-path))
+ (path tree-path)
(tree-iter (object tree-iter))
(data pdata))
-(defcfun "gtk_tree_model_get_path" (object tree-path)
+(defcfun gtk-tree-model-get-path (object tree-path)
(model pobject) (iter pobject))
(defmethod iter->path ((tree-model tree-model) (tree-iter tree-iter))
-; (warn "Dangerous method: don't forget to use free")
(gtk-tree-model-get-path tree-model tree-iter))
-(defcfun "gtk_tree_model_get_string_from_iter" :string
+(defcfun gtk-tree-model-get-string-from-iter :string
(model pobject) (iter pobject))
(defmethod iter->string ((tree-model tree-model) (tree-iter tree-iter))
(gtk-tree-model-get-string-from-iter tree-model tree-iter))
-(defgeneric tree->indices (tree-model tree-iter)
- (:method ((tree-model tree-model) (tree-iter tree-iter))
- (let ((tree-path (iter->path tree-model tree-iter)))
- (prog1
- (get-indices tree-path)
- (free tree-path)))))
-
-
-(defcfun "gtk_tree_model_get_value" :void (model pobject) (iter pobject)
+(defcfun gtk-tree-model-get-value :void (model pobject) (iter pobject)
(column :int) (g-value pobject))
(defmethod model-values
@@ -175,16 +169,16 @@
iter col *g-value*)))
columns))
-(defcfun "gtk_tree_model_get_iter" :boolean
- (model pobject) (iter pobject) (path pobject))
+(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 tree-path)
&optional (tree-iter (tree-iter tree-model)))
- (gtk-tree-model-get-iter tree-model tree-iter tree-path)
+ (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 pobject) (path :string))
+ (model pobject) (iter (struct tree-iter :out t)) (path :string))
(defmethod path->iter ((tree-model tree-model) tree-path-string
&optional (tree-iter (tree-iter tree-model)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2012/02/20 16:51:37 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2012/07/21 19:26:39 1.3
@@ -1,22 +1,37 @@
(in-package :gtk-cffi)
(defclass tree-selection (g-object)
- ((mode :accessor mode :initarg :mode :initform :single)))
+ ())
(defcenum selection-mode
:none :single :browse :multiple)
-(defcfun "gtk_tree_selection_set_mode" :void
- (selection pobject) (selection-mode selection-mode))
+(defslot tree-selection mode selection-mode)
-(defmethod (setf mode) :after (mode (tree-selection tree-selection))
- (gtk-tree-selection-set-mode tree-selection mode))
+(deffuns tree-selection
+ (:get select-function :pointer)
+ (:get user-data :pointer)
+ (:get tree-view pobject))
+
+(defcallback cb-tree-selection-func :boolean
+ ((selection pobject) (model pobject) (path (object tree-path))
+ (path-currently-selected :boolean) (data pdata))
+ (funcall data selection model path path-currently-selected))
+
+(defcfun gtk-tree-selection-set-select-function :void
+ (selection :pointer) (func :pointer) (data :pointer) (destroy :pointer))
+
+(defgeneric (setf select-function) (tree-selection func
+ &key data destroy-notify)
+ (:method ((tree-selection tree-selection) func &key data destroy-notify)
+ (set-callback tree-selection gtk-tree-selection-set-select-function
+ cb-tree-selection-func func data destroy-notify)))
-(defcfun "gtk_tree_selection_get_selected" :boolean
- (selection :pointer) (model :pointer) (iter :pointer))
+(defcfun gtk-tree-selection-get-selected :boolean
+ (selection pobject) (model pobject) (iter pobject))
-(defcfun "gtk_tree_selection_selected_foreach" :void
- (selection :pointer) (func :pointer) (data :pointer))
+(defcfun gtk-tree-selection-selected-foreach :void
+ (selection pobject) (func :pointer) (data :pointer))
(defvar *tree-selection-foreach* nil)
@@ -55,8 +70,7 @@
(let ((iter (make-instance 'tree-iter)))
(with-foreign-object (model-ptr :pointer)
(when (gtk-tree-selection-get-selected
- (pointer tree-selection)
- model-ptr (pointer iter))
+ tree-selection model-ptr iter)
(list (find-object (mem-ref model-ptr :pointer))
iter))))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/07/21 19:26:39 1.2
@@ -95,12 +95,12 @@
(when
(gtk-tree-view-get-path-at-pos tree-view x y path column cell-x cell-y)
(list
- (make-instance 'tree-path :pointer (mem-ref path :pointer))
+ (mem-ref path 'tree-path)
(mem-ref column 'pobject)
(mem-ref cell-x :int) (mem-ref cell-y :int)))))
-(defmacro with-path-at-pos (tree-view x y &rest body)
- `(with-object (%path (first %path)) (path-at-pos ,tree-view ,x ,y) , at body))
+;(defmacro with-path-at-pos (tree-view x y &rest body)
+; `(with-object (%path (first %path)) (path-at-pos ,tree-view ,x ,y) , at body))
(defcfun "gtk_tree_view_get_cursor" :void (view pobject)
(path :pointer) (column :pointer))
@@ -110,11 +110,11 @@
((path :pointer)
(column :pointer))
(gtk-tree-view-get-cursor tree-view path column)
- (list (make-instance 'tree-path :pointer (mem-ref path :pointer))
+ (list (mem-ref path 'tree-path)
(mem-ref column 'pobject))))
-(defmacro with-get-cursor-path (tree-view &rest body)
- `(with-object (%path (first %path)) (get-cursor ,tree-view) , at body))
+;(defmacro with-get-cursor-path (tree-view &rest body)
+; `(with-object (%path (first %path)) (get-cursor ,tree-view) , at body))
(defcfun "gtk_tree_view_get_columns" g-list-object (tree-view pobject))
More information about the gtk-cffi-cvs
mailing list