[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Sun Oct 7 12:02:11 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv28209/gtk
Modified Files:
assistant.lisp cell-layout.lisp combo-box.lisp container.lisp
entry.lisp enums.lisp generics.lisp gtk-cffi.asd label.lisp
list-store.lisp package.lisp tree-model-filter.lisp
tree-model.lisp tree-selection.lisp tree-view-column.lisp
tree-view.lisp widget.lisp
Log Message:
Fixed examples. Changed cell properties for tree-column to be set as :attributes
Fixed double init in g-value.
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/05/07 09:02:04 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/10/07 12:02:11 1.4
@@ -44,7 +44,7 @@
(funcall data cur-page))
(defcfun gtk-assistant-set-forward-page-func :void
- (assistant pobject) (func pfunction) (data pdata) (notify :pointer))
+ (assistant pobject) (func pfunction) (data pdata) (notify pfunction))
(defmethod (setf forward-page-func) (func (assistant assistant)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp 2012/07/29 15:13:59 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp 2012/10/07 12:02:11 1.6
@@ -3,18 +3,10 @@
(defclass cell-layout (g-object)
())
-
-(defcfun "gtk_cell_layout_add_attribute" :void
- (layout pobject) (cell pobject) (attr cffi-keyword) (column :int))
-
-(defmethod add-attribute ((cell-layout cell-layout)
- (cell-renderer cell-renderer) attr column)
- (gtk-cell-layout-add-attribute cell-layout cell-renderer attr column))
-
-(defcfun "gtk_cell_layout_pack_start" :void
+(defcfun gtk-cell-layout-pack-start :void
(cell-layout pobject) (renderer pobject) (expand :boolean))
-(defcfun "gtk_cell_layout_pack_end" :void
+(defcfun gtk-cell-layout-pack-end :void
(cell-layout pobject) (renderer pobject) (expand :boolean))
(defmethod pack ((cell-layout cell-layout)
@@ -22,57 +14,33 @@
&key end expand)
(funcall (if end
#'gtk-cell-layout-pack-end
- #'gtk-cell-layout-pack-start)
+ #'gtk-cell-layout-pack-start)
cell-layout cell-renderer expand)
(iter
(for (attr column) in (attributes cell-renderer))
- (add-attribute cell-layout cell-renderer
- attr column)))
-
+ (add-attribute cell-layout cell-renderer attr column)))
-(defcfun "gtk_cell_layout_get_cells" g-list-object (cell-layout pobject))
-
-(defmethod cell-renderers ((cell-layout cell-layout))
- (gtk-cell-layout-get-cells cell-layout))
+(deffuns cell-layout
+ (add-attribute :void (cell pobject) (attr cffi-keyword) (column :int))
+ (:get cells g-list-object)
+ (:get area pobject)
+ (reorder :void (cell pobject) (poisition :int))
+ (clear-attributes :void (cell-renderer pobject))
+ (clear :void))
(defcallback cb-cell-data-func :void
((cell-layout pobject) (cell-renderer pobject)
- (model pobject) (iter :pointer) (data pdata))
- (funcall data cell-layout cell-renderer model
- (make-instance 'tree-iter :pointer iter)))
+ (model pobject) (tree-iter (struct tree-iter)) (data pdata))
+ (funcall data cell-layout cell-renderer model tree-iter))
-(defcfun "gtk_cell_layout_set_cell_data_func" :void
+(defcfun gtk-cell-layout-set-cell-data-func :void
(cell-layout pobject) (renderer pobject) (func pfunction)
(data pdata) (notify :pointer))
-(defmethod (setf cell-data-func) (c-handler
+(defmethod (setf cell-data-func) (func
(cell-layout cell-layout)
(cell-renderer cell-renderer)
&key data destroy-notify)
-
- (if (functionp c-handler)
- (gtk-cell-layout-set-cell-data-func
- cell-layout cell-renderer
- (callback cb-cell-data-func)
- (pointer (make-instance 'storage :data c-handler))
- (callback free-storage))
- (gtk-cell-layout-set-cell-data-func
- cell-layout cell-renderer
- c-handler
- data
- ;; destroy-notify
- (or destroy-notify
- (if (or (null data) (pointerp data) (typep data 'g-object))
- (null-pointer) (callback free-storage))))))
-
-(defcfun "gtk_cell_layout_clear_attributes" :void
- (cell-layout pobject) (cell-renderer pobject))
-
-(defmethod clear-attributes ((cell-layout cell-layout)
- (cell-renderer cell-renderer))
- (gtk-cell-layout-clear-attributes cell-layout cell-renderer))
-
-(defcfun "gtk_cell_layout_clear" :void (cell-layout pobject))
+ (set-callback cell-layout gtk-cell-layout-set-cell-data-func
+ cb-cell-data-func func data destroy-notify cell-renderer))
-(defmethod clear ((cell-layout cell-layout))
- (gtk-cell-layout-clear cell-layout))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/08/12 17:42:30 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/combo-box.lisp 2012/10/07 12:02:11 1.6
@@ -61,7 +61,7 @@
(funcall data model iter))
(defcfun gtk-combo-box-set-row-separator-func :void
- (combo-box pobject) (func pfunction) (data pdata) (notify :pointer))
+ (combo-box pobject) (func pfunction) (data pdata) (notify pfunction))
(defgeneric (setf row-separator-func) (func combo-box &key data destroy-notify)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/08/12 17:42:30 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/10/07 12:02:11 1.6
@@ -19,9 +19,10 @@
(defmethod add ((container container) (widget widget))
(gtk-container-add container widget))
-(defmethod pack ((container container) (widget widget) &rest rest)
- (declare (ignore rest))
- (add container widget))
+(defgeneric pack (container widget &rest rest)
+ (:method ((container container) (widget widget) &rest rest)
+ (declare (ignore rest))
+ (add container widget)))
(defmacro pack* (box &rest widgets)
`(progn
@@ -76,43 +77,44 @@
g-type)))
(error "Incorrect child property name ~a" key))))
-(defmethod child-property ((widget widget) (parent container) &rest keys)
- (funcall (lambda (x) (if (cdr x) x (car x)))
- (mapcar (lambda (key)
- (with-g-value
- (:g-type (child-property-type parent key))
- (gtk-container-child-get-property
- parent widget key *g-value*)))
- keys)))
-
-(defmethod child-property ((widget widget) (parent null) &rest keys)
- (apply #'child-property `(,widget ,(parent widget) , at keys)))
-
-(defmethod (setf child-property) (values (widget widget) (parent container)
- &rest keys)
- "
+(defgeneric child-property (widget parent &key keys)
+ (:method ((widget widget) (parent container) &rest keys)
+ (funcall (lambda (x) (if (cdr x) x (car x)))
+ (mapcar (lambda (key)
+ (with-g-value
+ (:g-type (child-property-type parent key))
+ (gtk-container-child-get-property
+ parent widget key *g-value*)))
+ keys)))
+
+ (:method ((widget widget) (parent null) &rest keys)
+ (apply #'child-property `(,widget ,(parent widget) , at keys))))
+
+(defgeneric (setf child-property) (values widget parent &key keys)
+ (:documentation "
Usage: (setf (child-property object parent :property) value)
(setf (child-property object parent :prop1 :prop2)
- (list value1 value2))"
- (mapc (lambda (key value)
- (declare (type (or symbol string) key))
- (with-g-value (:value value
- :g-type (child-property-type parent key))
- (gtk-container-child-set-property parent widget
- key *g-value*)))
- keys (if (listp values) values (list values))))
-
-(defmethod (setf child-property) (values (widget widget) (parent null)
- &rest keys)
- (apply #'(setf child-property) `(,values ,widget ,(parent widget) , at keys)))
+ (list value1 value2))")
+ (:method (values (widget widget) (parent container) &rest keys)
+ (mapc (lambda (key value)
+ (declare (type (or symbol string) key))
+ (with-g-value (:value value
+ :g-type (child-property-type parent key))
+ (gtk-container-child-set-property parent widget
+ key *g-value*)))
+ keys (if (listp values) values (list values))))
+
+ (:method (values (widget widget) (parent null) &rest keys)
+ (apply #'(setf child-property) `(,values ,widget ,(parent widget) , at keys))))
(defcfun "gtk_container_class_find_child_property" :pointer
(obj-class pobject) (key :string))
-(defmethod find-child-property ((container container) key)
- (let ((ptr (gtk-container-class-find-child-property container key)))
- (unless (null-pointer-p ptr)
- (make-instance 'g-object-cffi:g-param-spec :pointer ptr))))
+(defgeneric find-child-property (container key)
+ (:method ((container container) key)
+ (let ((ptr (gtk-container-class-find-child-property container key)))
+ (unless (null-pointer-p ptr)
+ (make-instance 'g-object-cffi:g-param-spec :pointer ptr)))))
(defcfun gtk-container-remove :void (container pobject) (widget pobject))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/08/21 19:48:02 1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/10/07 12:02:11 1.9
@@ -108,7 +108,7 @@
(delete-action :void (index :int)))
(defcfun gtk-entry-completion-set-match-func :void
- (entry-completion pobject) (func pfunction) (data pdata) (notify :pointer))
+ (entry-completion pobject) (func pfunction) (data pdata) (notify pfunction))
(defcallback cb-match-func :boolean
((entry-completion pobject) (key :string) (tree-iter (object tree-iter))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2012/07/31 17:57:12 1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2012/10/07 12:02:11 1.7
@@ -33,4 +33,6 @@
(defcenum relief-style :normal :half :none)
-(defcenum position-type :left :right :top :bottom)
\ No newline at end of file
+(defcenum position-type :left :right :top :bottom)
+
+(defcenum sort-type :ascending :descending)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2012/03/08 09:58:12 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2012/10/07 12:02:11 1.5
@@ -3,5 +3,6 @@
(defgeneric selection-bounds (widget &key)) ;; text-buffer, label
(defgeneric text (widget &key)) ;; entry, label, text-buffer
(defgeneric (setf text) (value widget &key))
+(defgeneric layout-offsets (object)) ;; entry, label, scale
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/08/24 19:27:54 1.28
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/10/07 12:02:11 1.29
@@ -273,7 +273,7 @@
(defsystem gtk-cffi-tree-selection
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
:depends-on (gtk-cffi-tree-model)
:components
@@ -282,7 +282,7 @@
(defsystem gtk-cffi-tree-view-column
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
:depends-on (gtk-cffi-cell-layout gtk-cffi-cell-renderer gtk-cffi-widget)
:components
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/03/08 09:58:12 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/10/07 12:02:11 1.5
@@ -75,10 +75,9 @@
(defcfun gtk-label-get-layout-offsets :void (label pobject)
(x :pointer) (y :pointer))
-(defgeneric layout-offsets (label)
- (:method ((label label))
- (with-foreign-outs-list ((x :int) (y :int)) :ignore
- (gtk-label-get-layout-offsets label x y))))
+(defmethod layout-offsets ((label label))
+ (with-foreign-outs-list ((x :int) (y :int)) :ignore
+ (gtk-label-get-layout-offsets label x y)))
(defcfun gtk-label-get-selection-bounds :void (label pobject)
(start :pointer) (end :pointer))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/07/29 15:13:59 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/10/07 12:02:11 1.5
@@ -5,7 +5,7 @@
;;;
;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
;;;
-
+(declaim (optimize debug))
(in-package :gtk-cffi)
(defclass list-store (g-object tree-model)
@@ -41,15 +41,16 @@
(defmethod append-iter ((list-store list-store) &optional
(tree-iter (tree-iter list-store)))
- (gtk-list-store-append list-store tree-iter)
- (show-iter "appended" tree-iter))
+ (gtk-list-store-append list-store tree-iter))
+; (show-iter "appended" tree-iter))
(defcfun "gtk_list_store_set_value" :void (store pobject)
(iter (struct tree-iter)) (column :int) (g-value pobject))
(defmethod (setf model-values)
(values (list-store list-store)
- &key (tree-iter (tree-iter list-store)) col (columns (when col (list col))))
+ &key (tree-iter (tree-iter list-store)) column
+ (columns (when column (list column))))
"Example: (setf (model-values list-store :col 1) \"val1\")"
(declare (type list columns values))
(let ((%cols (append columns (loop :for i
@@ -59,9 +60,12 @@
(mapcar
(lambda (col val)
(with-g-value (:value val :g-type (column-type list-store col))
- (show-iter "set" tree-iter)
+ ;(show-iter "set" tree-iter)
+; (format t "set val: ~a type: ~a~%" val (column-type list-store col))
+ (assert (/= (g-type *g-value*) 0))
(gtk-list-store-set-value list-store
- tree-iter col *g-value*)))
+ tree-iter col *g-value*)
+ (unless (/= (g-type *g-value*) 0) (cerror "Bad g-val" *g-value*))))
%cols values)))
(defcfun "gtk_list_store_clear" :void (store pobject))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/09/21 19:00:33 1.29
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/10/07 12:02:11 1.30
@@ -20,6 +20,8 @@
#:gtk-model
#:defmodel ; recommended way
+ #:foreach
+
;; reexport
#:object-by-id
#:gsignal
@@ -496,6 +498,8 @@
#:cell-renderer-pixbuf
#:cell-layout
+ #:reorder
+ #:area
#:cell-editable
@@ -596,8 +600,18 @@
;; tree-view slots
#:model
#:search-column
+ #:level-indentation
+ #:selection
+ #:hover-expand
+ #:rubber-banding
+ #:headers-clickable
+ #:show-expanders
+ #:rules-hint
+ #:headers-visible
+ #:hover-selection
;; tree-view methods
#:append-column
+ #:insert-column
#:get-selection
#:path-at-pos
#:with-path-at-pos
@@ -608,15 +622,29 @@
#:remove-column
#:tree-view-column
- ;; tree-view-column slots
+ ;; slots
#:sort-column-id
#:alignment
#:reorderable
- ;; tree-view-column methods
+ #:fixed-width
+ #:max-width
+ #:min-width
+ #:expand
+ #:sort-indicator
+ #:sizing
+ #:sort-order
+ #:clickable
+ ;; methods
+ #:add-attribute
#:cell-data-func
#:cell-get-position
- #:cell-renderers
+ #:cells
#:get-cell-at
+ #:clear-attributes
+ #:x-offset
+ #:cell-is-visible
+ #:focus-cell
+ #:cell-set-cell-data
#:scrollable
#:hscroll-policy
@@ -638,11 +666,21 @@
#:tree-selection
;; slots
#:user-data
- ;; methods
#:mode
#:select-function
- #:with-selection
- #:get-selected
+ ;; methods
+ #:select-path
+ #:unselect-path
+ #:select-iter
+ #:unselect-iter
+ #:select-all
+ #:path-is-selected
+ #:iter-is-selected
+ #:unselect-range
+ #:unselect-all
+ #:count-selected-rows
+ #:selected
+ #:selected-rows
#:text-mark
;; slots
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model-filter.lisp 2011/08/26 17:16:14 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model-filter.lisp 2012/10/07 12:02:11 1.3
@@ -35,8 +35,9 @@
(progn , at body)
(when ,path (free ,path)))))
-(defcfun "gtk_tree_model_filter_convert_iter_to_child_iter" :void
- (model pobject) (child-iter pobject) (iter pobject))
+(defcfun gtk-tree-model-filter-convert-iter-to-child-iter :void
+ (model pobject) (child-iter (struct tree-iter :out t))
+ (iter (struct tree-iter)))
(defmethod iter-to-child ((tree-model-filter tree-model-filter)
(tree-iter tree-iter))
@@ -45,8 +46,8 @@
tree-model-filter child-iter tree-iter)
child-iter))
-(defmacro with-child-iter (child-iter parent iter &body body)
- `(let ((,child-iter (iter-to-child ,parent ,iter)))
+(defmacro with-child-iter (child-iter parent tree-iter &body body)
+ `(let ((,child-iter (iter-to-child ,parent ,tree-iter)))
(unwind-protect
(progn , at body)
(when ,child-iter (free ,child-iter)))))
@@ -55,11 +56,11 @@
(defmethod (setf model-values)
(values (tree-model-filter tree-model-filter)
- &key (iter (iter tree-model-filter)) col
- (columns (when col (list col))))
- (with-child-iter child-iter tree-model-filter iter
+ &key (tree-iter (tree-iter tree-model-filter)) column
+ (columns (when column (list column))))
+ (with-child-iter child-iter tree-model-filter tree-iter
(setf (model-values (model tree-model-filter)
- :iter child-iter :columns columns) values)))
+ :tree-iter child-iter :columns columns) values)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/09/21 19:00:33 1.15
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/10/07 12:02:11 1.16
@@ -48,6 +48,14 @@
(defmethod free-ptr ((tree-path (eql 'tree-path)) ptr)
(gtk-tree-path-free ptr))
+(define-foreign-type cb-tree-path (tree-path)
+ ((free-from-foreign :initform nil))
+ (:documentation "Tree path for callbacks")
+ (:simple-parser cb-tree-path)
+ (:actual-type :pointer))
+
+(defmethod free-ptr ((tree-path (eql 'cb-tree-path)) ptr)
+ (gtk-tree-path-free ptr))
(defclass tree-row-reference (object)
())
@@ -118,21 +126,23 @@
(make-foreach tree-model
(model pobject)
- (path tree-path)
+ (path cb-tree-path)
(tree-iter (object tree-iter))
(data pdata))
(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))
+(defgeneric iter->path (tree-model tree-iter)
+ (:method ((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) (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))
+(defgeneric iter->string (tree-model tree-iter)
+ (:method ((tree-model tree-model) (tree-iter tree-iter))
+ (gtk-tree-model-get-string-from-iter tree-model tree-iter)))
(defcfun gtk-tree-model-get-value :void (model pobject) (iter pobject)
(column :int) (g-value pobject))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2012/07/21 19:26:39 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2012/10/07 12:02:11 1.4
@@ -10,16 +10,28 @@
(deffuns tree-selection
(:get select-function :pointer)
- (:get user-data :pointer)
- (:get tree-view pobject))
+ (:get user-data pdata)
+ (:get tree-view pobject)
+ (count-selected-rows :int)
+ (select-path :void (path tree-path))
+ (unselect-path :void (path tree-path))
+ (path-is-selected :boolean (path tree-path))
+ (select-iter :void (tree-iter (struct tree-iter)))
+ (unselect-iter :void (tree-iter (struct tree-iter)))
+ (iter-is-selected :boolean (tree-iter (struct tree-iter)))
+ (select-all :void)
+ (unselect-all :void)
+ (select-range :void (start-path tree-path) (end-path tree-path))
+ (unselect-range :void (start-path tree-path) (end-path tree-path)))
+
(defcallback cb-tree-selection-func :boolean
- ((selection pobject) (model pobject) (path (object tree-path))
+ ((selection pobject) (model pobject) (path cb-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))
+ (selection pobject) (func pfunction) (data pdata) (destroy pfunction))
(defgeneric (setf select-function) (tree-selection func
&key data destroy-notify)
@@ -28,65 +40,46 @@
cb-tree-selection-func func data destroy-notify)))
(defcfun gtk-tree-selection-get-selected :boolean
- (selection pobject) (model pobject) (iter pobject))
+ (selection pobject) (model :pointer) (tree-iter (struct tree-iter :out t)))
+
+(defgeneric selected (tree-selection)
+ (:method ((tree-selection tree-selection))
+ (let ((tree-iter (make-instance 'tree-iter)))
+ (with-foreign-object (p :pointer)
+ (when (gtk-tree-selection-get-selected tree-selection p tree-iter)
+ (values tree-iter (convert-from-foreign (mem-ref p :pointer)
+ 'pobject)))))))
+
+(defcfun gtk-tree-selection-get-selected-rows (g-list :elt tree-path)
+ (selection pobject) (model :pointer))
+
+(defgeneric selected-rows (tree-selection)
+ (:method ((tree-selection tree-selection))
+ (with-foreign-object (p :pointer)
+ (values (gtk-tree-selection-get-selected-rows tree-selection p)
+ (mem-ref p 'pobject)))))
+
(defcfun gtk-tree-selection-selected-foreach :void
- (selection pobject) (func :pointer) (data :pointer))
+ (selection pobject) (func pfunction) (data pdata))
(defvar *tree-selection-foreach* nil)
(defcallback cb-tree-selection-foreach :boolean
- ((model :pointer) (path :pointer) (iter :pointer) (data :pointer))
+ ((model pobject) (path tree-path :free-from-foreign nil)
+ (tree-iter (struct tree-iter)) (data pdata))
(when *tree-selection-foreach*
- (funcall *tree-selection-foreach*
- (find-object model)
- (make-instance 'tree-path :pointer path)
- (make-instance 'tree-iter :pointer iter)
- (find-object data))))
+ (funcall *tree-selection-foreach* model path tree-iter data)))
-(defmethod tree-selection-foreach ((tree-selection tree-selection)
+(defmethod foreach ((tree-selection tree-selection)
func &optional (data (null-pointer)))
- (let ((*tree-selection-foreach* func))
- (gtk-tree-selection-selected-foreach (pointer tree-selection)
- (callback cb-tree-selection-foreach) data)))
-
-(defvar *selected* nil)
-
-(defmethod get-selected ((tree-selection tree-selection))
- "Returns list (model iter &optional iter2 iter3 ...)"
- (if (eq (mode tree-selection) :multiple)
- (progn
- (let ((*selected* nil))
- (tree-selection-foreach tree-selection
- (lambda (model path iter data)
- (declare (ignore data path))
- (unless *selected*
- (push model *selected*))
- (push (copy iter) *selected*)))
- (when *selected*
- (debug-out "selected: ~a~%" *selected*)
- (nreverse *selected*))))
-
- (let ((iter (make-instance 'tree-iter)))
- (with-foreign-object (model-ptr :pointer)
- (when (gtk-tree-selection-get-selected
- tree-selection model-ptr iter)
- (list (find-object (mem-ref model-ptr :pointer))
- iter))))))
-
-(defmacro with-selection (selection tree-selection &body body)
- `(let ((,selection (get-selected ,tree-selection)))
- (unwind-protect
- (progn , at body)
- (mapc #'free (cdr ,selection)))))
-
-(defmethod initialize-instance
- :after ((tree-selection tree-selection)
- &key (mode :single) &allow-other-keys)
-; (when pointer
-; (setf (pointer tree-selection) pointer)) ;; to save in *objects*
- (unless (eq mode :single)
- (setf (mode tree-selection) mode)))
+ (when func
+ (let ((*tree-selection-foreach* func))
+ (gtk-tree-selection-selected-foreach
+ tree-selection (if (functionp func)
+ (callback cb-tree-selection-foreach) func)
+ data))))
+
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view-column.lisp 2012/03/06 01:25:26 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view-column.lisp 2012/10/07 12:02:11 1.4
@@ -3,110 +3,114 @@
(defclass tree-view-column (cell-layout)
())
-(defcfun "gtk_tree_view_column_new" :pointer)
+(defcfun gtk-tree-view-column-new :pointer)
+(defcfun gtk-tree-view-column-new-with-area :pointer (area pobject))
(defmethod gconstructor ((tree-view-column tree-view-column)
- &key &allow-other-keys)
- (gtk-tree-view-column-new))
+ &key area
+ &allow-other-keys)
+ (initialize tree-view-column '(area))
+ (if area
+ (gtk-tree-view-column-new-with-area area)
+ (gtk-tree-view-column-new)))
-(defmethod initialize-instance
- :after ((tree-view-column tree-view-column)
- &rest initargs &key title cell &allow-other-keys)
- "other attributes = (:text 2 :color 3)"
- (setf-init tree-view-column title)
- (when cell
- (pack tree-view-column cell)
- (labels ((process (x)
- (when x
- (let ((key (first x))
- (val (second x)))
- (when (and (keywordp key)
- (not (member key '(:title :cell))))
- (add-attribute tree-view-column cell key val)))
- (process (cddr x)))))
- (process initargs))))
-
-(defcfun "gtk_tree_view_column_set_title" :void
- (column pobject) (title :string))
-
-(defcfun "gtk_tree_view_column_get_title" :string (column pobject))
+(defcenum tree-view-column-sizing :grow-only :autosize :fixed)
-(defmethod (setf title) (value (tree-view-column tree-view-column))
- (gtk-tree-view-column-set-title tree-view-column value))
-
-(defmethod title ((tree-view-column tree-view-column))
- (gtk-tree-view-column-get-title tree-view-column))
-
-(defcfun "gtk_tree_view_column_set_sort_column_id" :void
- (column :pointer) (id :int))
-
-(defmethod (setf sort-column-id) (id (tree-view-column tree-view-column))
- (gtk-tree-view-column-set-sort-column-id (pointer tree-view-column) id))
-
-(defcfun "gtk_tree_view_column_set_alignment" :void
- (column :pointer) (xalign :float))
-
-(defmethod (setf alignment) (xalign (tree-view-column tree-view-column))
- (gtk-tree-view-column-set-alignment (pointer tree-view-column)
- (float xalign)))
-(defcfun "gtk_tree_view_column_set_reorderable" :void
- (column :pointer) (reorderable :boolean))
+(defslots tree-view-column
+ title :string
+ spacing :int
+ visible :boolean
+ resizable :boolean
+ sizing tree-view-column-sizing
+ fixed-width :int
+ min-width :int
+ max-width :int
+ expand :boolean
+ clickable :boolean
+ widget pobject
+ alignment :float
+ reorderable :boolean
+ sort-column-id :int
+ sort-indicator :boolean
+ sort-order sort-type)
+
+(defcfun gtk-tree-view-column-pack-start :void
+ (tree-view-column pobject) (renderer pobject) (expand :boolean))
+
+(defcfun gtk-tree-view-column-pack-end :void
+ (tree-view-column pobject) (renderer pobject) (expand :boolean))
+
+(defmethod pack ((tree-view-column tree-view-column)
+ (cell-renderer cell-renderer)
+ &key end expand)
+ (funcall (if end
+ #'gtk-tree-view-column-pack-end
+ #'gtk-tree-view-column-pack-start)
+ tree-view-column cell-renderer expand)
+ (iter
+ (for (attr column) in (attributes cell-renderer))
+ (add-attribute tree-view-column cell-renderer attr column)))
+
+(deffuns tree-view-column
+ (add-attribute :void (cell pobject) (attr cffi-keyword) (column :int))
+ (clear-attributes :void (cell-renderer pobject))
+ (clear :void)
+ (clicked :void)
+ (cell-is-visible :boolean)
+ (queue-resize :void &key)
+ (:get tree-view pobject)
+ (:get x-offset :int)
+ (focus-cell :void (cell-renderer pobject))
+ (cell-set-cell-data :void (model pobject) (iter (struct tree-iter))
+ (is-expander :boolean) (is-expanded :boolean)))
-(defmethod (setf reorderable) (reorderable (tree-view-column tree-view-column))
- (gtk-tree-view-column-set-reorderable (pointer tree-view-column)
- reorderable))
-
-(defcfun "gtk_tree_view_column_get_reorderable" :boolean
- (column :pointer))
-
-(defmethod reorderable ((tree-view-column tree-view-column))
- (gtk-tree-view-column-get-reorderable (pointer tree-view-column)))
-
-(defcfun "gtk_tree_view_column_set_cell_data_func" :void
- (column pobject) (renderer pobject) (func :pointer)
+(defcfun gtk-tree-view-column-set-cell-data-func :void
+ (tree-view-column pobject) (renderer pobject) (func pfunction)
(data pdata) (notify :pointer))
-(defmethod (setf cell-data-func) (c-handler (tree-view-column tree-view-column)
- (cell-renderer cell-renderer)
- &key
- (data (null-pointer))
- (destroy-notify (null-pointer)))
- (gtk-tree-view-column-set-cell-data-func tree-view-column cell-renderer
- c-handler data destroy-notify))
-
-(defcfun "gtk_tree_view_column_set_widget" :void
- (column pobject) (widget pobject))
+(defmethod (setf cell-data-func) (func
+ (tree-view-column tree-view-column)
+ (cell-renderer cell-renderer)
+ &key data destroy-notify)
+ (set-callback tree-view-column gtk-tree-view-column-set-cell-data-func
+ cb-cell-data-func func data destroy-notify cell-renderer))
-(defmethod (setf widget) ((widget widget)
- (tree-view-column tree-view-column))
- (gtk-tree-view-column-set-widget tree-view-column widget))
-(defcfun "gtk_tree_view_column_get_widget" pobject
- (column pobject))
-(defmethod widget ((tree-view-column tree-view-column))
- (gtk-tree-view-column-get-widget tree-view-column))
+(defcfun gtk-tree-view-column-cell-get-size :void
+ (column pobject) (cell-renderer pobject) (area (struct rectangle))
+ (x-offset :pointer) (y-offset :pointer) (width :pointer) (height :pointer))
+
+(defmethod cell-get-size ((tree-view-column tree-view-column)
+ (cell-renderer cell-renderer) area)
+ (with-foreign-outs-list
+ ((x-offset :int) (y-offset :int) (width :int) (height :int)) :ignore
+ (gtk-tree-view-column-cell-get-size tree-view-column cell-renderer area
+ x-offset y-offset width height)))
-
-
-(defcfun "gtk_tree_view_column_cell_get_position" :boolean
+(defcfun gtk-tree-view-column-cell-get-position :boolean
(column pobject) (cell-renderer pobject)
(start-pos :pointer) (width :pointer))
(defmethod cell-get-position ((tree-view-column tree-view-column)
(cell-renderer cell-renderer))
- (with-foreign-objects
- ((start-pos :int)
- (width :int))
- (gtk-tree-view-column-cell-get-position tree-view-column
- cell-renderer start-pos width)
- (list (mem-ref start-pos :int) (mem-ref width :int))))
+ (with-foreign-outs-list
+ ((start-pos :int) (width :int)) :if-success
+ (gtk-tree-view-column-cell-get-position tree-view-column
+ cell-renderer start-pos width)))
(defmethod get-cell-at ((tree-view-column tree-view-column) x)
- (loop :for cell in (cell-renderers tree-view-column)
+ (loop :for cell in (cells tree-view-column)
:when (destructuring-bind (start-pos width)
(cell-get-position tree-view-column cell)
(and (>= x start-pos) (>= (+ start-pos width) x)))
:return cell))
+
+(init-slots tree-view-column (cell attributes)
+ (when cell
+ (pack tree-view-column cell)
+ (iter
+ (for (key value) on attributes by #'cddr)
+ (add-attribute tree-view-column cell key value))))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/07/29 15:13:59 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/10/07 12:02:11 1.4
@@ -6,9 +6,8 @@
(defcenum tree-view-grid-lines
:none :horizontal :vertical :both)
-(defcfun "gtk_tree_view_new" :pointer)
-
-(defcfun "gtk_tree_view_new_with_model" :pointer (model pobject))
+(defcfun gtk-tree-view-new :pointer)
+(defcfun gtk-tree-view-new-with-model :pointer (model pobject))
(defmethod gconstructor ((tree-view tree-view)
&key model &allow-other-keys)
@@ -16,128 +15,80 @@
(gtk-tree-view-new-with-model model)
(gtk-tree-view-new)))
-
-(defmethod initialize-instance
- :after ((tree-view tree-view)
- &key columns on-select &allow-other-keys)
- (setf-init tree-view columns)
- (when on-select
- (setf (gsignal (get-selection tree-view) :changed)
- (lambda (selection)
- (let ((selected (get-selected selection)))
- (when (cdr selected)
- (apply on-select selected)))))))
+(defslots tree-view
+ level-indentation :int
+ show-expanders :boolean
+ model pobject
+ hadjustment pobject
+ vadjustment pobject
+ headers-visible :boolean
+ headers-clickable :boolean
+ rules-hint :boolean
+ hover-selection :boolean
+ hover-expand :boolean
+ rubber-banding :boolean
+ search-column :int)
(deffuns tree-view
- (remove-column :int (column pobject)))
+ (remove-column :int (column pobject))
+ (append-column :int (column pobject))
+ (insert-column :int (column pobject) (position :int) &key)
+ (:get selection pobject)
+ (:get columns g-list-object)
+ (:get column pobject (n :int)))
(defmethod (setf columns) (columns (tree-view tree-view))
(dolist (column (columns tree-view))
(remove-column tree-view column))
(labels
- ((mk-column (column colnum)
- (cond
- ((stringp column)
- (mk-column (list :title column
- :cell (make-instance 'cell-renderer-text)
- :text colnum) colnum))
- ((consp column) (apply #'make-instance
- (cons 'tree-view-column column)))
- (t column)))
-
- (process (columns colnum)
- (let* ((col (car columns))
- (col-obj (mk-column col colnum)))
- (append-column tree-view col-obj))
- (when (cdr columns)
- (process (cdr columns) (1+ colnum)))))
-
- (process columns 0)))
-
+ ((mk-column (column num)
+ (typecase column
+ (string (make-instance 'tree-view-column
+ :title column
+ :cell (make-instance 'cell-renderer-text)
+ :attributes `(:text ,num)))
+ (cons (apply #'make-instance
+ 'tree-view-column column))
+ (t column))))
+ (reduce (lambda (num column)
+ (append-column tree-view (mk-column column num)))
+ columns :initial-value 0)))
+(save-setter tree-view columns)
-(defcfun "gtk_tree_view_append_column" :int
- (view pobject) (column pobject))
-
-(defmethod append-column ((tree-view tree-view)
- (tree-view-column tree-view-column))
- (gtk-tree-view-append-column tree-view tree-view-column))
-
-(defcfun "gtk_tree_view_set_model" :void
- (view pobject) (model pobject))
-
-(defmethod (setf model) ((tree-model tree-model)
- (tree-view tree-view))
- (gtk-tree-view-set-model tree-view tree-model))
-
-(defmethod (setf model) ((tree-model null)
- (tree-view tree-view))
- (gtk-tree-view-set-model tree-view tree-model))
-
-
-(defcfun "gtk_tree_view_get_model" pobject
- (view pobject))
-
-(defmethod model ((tree-view tree-view))
- (gtk-tree-view-get-model tree-view))
-
-(defcfun "gtk_tree_view_get_selection" :pointer (view pobject))
-
-(defmethod get-selection ((tree-view tree-view))
- (make-instance 'tree-selection :pointer
- (gtk-tree-view-get-selection tree-view)))
-
-(defcfun "gtk_tree_view_get_path_at_pos" :boolean (view pobject)
+(defcfun gtk-tree-view-get-path-at-pos :boolean (view pobject)
(x :int) (y :int) (path :pointer) (column :pointer)
(cell-x :pointer) (cell-y :pointer))
(defmethod path-at-pos ((tree-view tree-view) x y)
- (with-foreign-objects
- ((path :pointer)
- (column :pointer)
- (cell-x :pointer)
- (cell-y :pointer))
- (when
- (gtk-tree-view-get-path-at-pos tree-view x y path column cell-x cell-y)
- (list
- (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))
+ (with-foreign-outs-list
+ ((path 'tree-path) (column 'pobject)
+ (cell-x :int) (cell-y :int)) :if-success
+ (gtk-tree-view-get-path-at-pos tree-view x y path column cell-x cell-y)))
-(defcfun "gtk_tree_view_get_cursor" :void (view pobject)
+(defcfun gtk-tree-view-get-cursor :void (view pobject)
(path :pointer) (column :pointer))
(defmethod get-cursor ((tree-view tree-view))
- (with-foreign-objects
- ((path :pointer)
- (column :pointer))
- (gtk-tree-view-get-cursor tree-view path column)
- (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))
-
-(defcfun "gtk_tree_view_get_columns" g-list-object (tree-view pobject))
-
-(defmethod columns ((tree-view tree-view))
- (gtk-tree-view-get-columns tree-view))
+ (with-foreign-outs-list ((path 'tree-path) (column 'pobject)) :ignore
+ (gtk-tree-view-get-cursor tree-view path column)))
-(defcfun "gtk_tree_view_get_column" pobject (tree-view pobject) (n :int))
+(defcfun gtk-tree-view-insert-column-with-data-func :int
+ (tree-view pobject) (postion :int) (title :string) (cell pobject)
+ (data-func pfunction) (data pdata) (destroy pfunction))
+
+(defmethod insert-column ((tree-view tree-view) (cell cell-renderer) position
+ &key title func data destroy-notify)
+ (set-callback tree-view gtk-tree-view-insert-column-with-data-func
+ cb-cell-data-func func data destroy-notify
+ position title cell))
+
-(defmethod column ((tree-view tree-view) n)
- (gtk-tree-view-get-column tree-view n))
-
-(defcfun "gtk_tree_view_set_search_column" :void (tree-view pobject) (n :int))
-
-(defmethod (setf search-column) (n (tree-view tree-view))
- (gtk-tree-view-set-search-column tree-view n))
-
-(defcfun "gtk_tree_view_get_search_column" :int (tree-view pobject))
-
-(defmethod search-column ((tree-view tree-view))
- (gtk-tree-view-get-search-column tree-view))
\ No newline at end of file
+(init-slots tree-view (on-select)
+ (when on-select
+ (setf (gsignal (selection tree-view) :changed)
+ (lambda (selection)
+ (destructuring-bind (rows model) (selected-rows selection)
+ (when rows
+ (apply on-select model rows)))))))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/08/12 17:42:30 1.16
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/10/07 12:02:11 1.17
@@ -44,61 +44,61 @@
(defcfun gtk-widget-show-now :boolean (widget pobject))
(defgeneric show (widget &key all now)
- (:documentation "gtk_widget_show[_now|_all] ALL and NOW are booleans"))
-(defmethod show ((widget widget) &key (all t) now)
- (funcall (cond
- (now #'gtk-widget-show-now)
- (all #'gtk-widget-show-all)
- (t #'gtk-widget-show)) widget))
+ (:documentation "gtk_widget_show[_now|_all] ALL and NOW are booleans")
+ (:method ((widget widget) &key (all t) now)
+ (funcall (cond
+ (now #'gtk-widget-show-now)
+ (all #'gtk-widget-show-all)
+ (t #'gtk-widget-show)) widget)))
(defcfun gtk-widget-draw :void (widget pobject) (context :pointer))
(defgeneric draw (widget &optional context)
- (:documentation "context is cl-cairo2 context"))
-(defmethod draw ((widget widget) &optional (context cl-cairo2:*context*))
+ (:documentation "context is cl-cairo2 context")
+ (:method ((widget widget) &optional (context cl-cairo2:*context*))
(cl-cairo2::with-context-pointer (context cntx-pointer)
- (gtk-widget-draw widget cntx-pointer)))
+ (gtk-widget-draw widget cntx-pointer))))
(defcfun gtk-widget-queue-draw-area :void
(widget pobject) (x :int) (y :int) (width :int) (height :int))
(defcfun gtk-widget-queue-draw-region :void (widget pobject) (region pobject))
(defcfun gtk-widget-queue-draw :void (widget pobject))
-(defgeneric queue-draw (widget &key area region))
-(defmethod queue-draw ((widget widget) &key area region)
- (cond
- (area (apply #'gtk-widget-queue-draw-area widget area))
- (region (gtk-widget-queue-draw-region widget region))
- (t (gtk-widget-queue-draw widget))))
+(defgeneric queue-draw (widget &key area region)
+ (:method ((widget widget) &key area region)
+ (cond
+ (area (apply #'gtk-widget-queue-draw-area widget area))
+ (region (gtk-widget-queue-draw-region widget region))
+ (t (gtk-widget-queue-draw widget)))))
(defcfun gtk-widget-queue-resize :void (widget pobject))
(defcfun gtk-widget-queue-resize-no-redraw :void (widget pobject))
-(defgeneric queue-resize (widget &key no-redraw))
-(defmethod queue-resize ((widget widget) &key no-redraw)
- (if no-redraw
- (gtk-widget-queue-resize-no-redraw widget)
- (gtk-widget-queue-resize widget)))
+(defgeneric queue-resize (widget &key no-redraw)
+ (:method ((widget widget) &key no-redraw)
+ (if no-redraw
+ (gtk-widget-queue-resize-no-redraw widget)
+ (gtk-widget-queue-resize widget))))
-(defcfun "gtk_widget_get_size_request" :void
+(defcfun gtk-widget-get-size-request :void
(widget pobject) (width :pointer) (height :pointer))
-(defgeneric size-request (widget))
-(defmethod size-request ((widget widget))
- "returns (width height)"
- (with-foreign-outs-list ((width :int) (height :int)) :ignore
- (gtk-widget-get-size-request widget width height)))
+(defgeneric size-request (widget)
+ (:method ((widget widget))
+ "returns (width height)"
+ (with-foreign-outs-list ((width :int) (height :int)) :ignore
+ (gtk-widget-get-size-request widget width height))))
-(defcfun "gtk_widget_set_size_request"
+(defcfun gtk-widget-set-size-request
:void (widget pobject) (w :int) (h :int))
-(defgeneric (setf size-request) (coords widget))
-(defmethod (setf size-request) (coords (widget widget))
- "coords = (width height)"
- (gtk-widget-set-size-request widget
- (first coords)
- (second coords)))
+(defgeneric (setf size-request) (coords widget)
+ (:method (coords (widget widget))
+ "coords = (width height)"
+ (gtk-widget-set-size-request widget
+ (first coords)
+ (second coords))))
(save-setter widget size-request)
(defcfun gtk-widget-intersect :boolean
More information about the gtk-cffi-cvs
mailing list