From rklochkov at common-lisp.net Wed Sep 12 12:17:40 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Wed, 12 Sep 2012 05:17:40 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk In directory tiger.common-lisp.net:/tmp/cvs-serv4028/gtk Modified Files: color-button.lisp Log Message: Summary: fix --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/08/04 17:40:25 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/09/12 12:17:40 1.3 @@ -15,7 +15,7 @@ (defcfun gtk-color-button-new-with-rgba :pointer (rgbd prgba)) (defmethod gconstructor ((color-button color-button) &key color rgba) - (initialized color-button '(color rgba)) + (initialize color-button '(color rgba)) (cond (color (gtk-color-button-new-with-color color)) (rgba (gtk-color-button-new-with-rgba rgba)) From rklochkov at common-lisp.net Fri Sep 21 19:00:33 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Fri, 21 Sep 2012 12:00:33 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: 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)))