From rklochkov at common-lisp.net Sat Jul 21 19:26:38 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 21 Jul 2012 12:26:38 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/examples Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples In directory tiger.common-lisp.net:/tmp/cvs-serv799/examples Modified Files: ex7.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/examples/ex7.lisp 2012/05/08 09:38:07 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/07/21 19:26:38 1.6 @@ -77,14 +77,13 @@ (lambda (view event) (when (and (eq (gdk-cffi:get-slot event :type) :button-press) (= (the integer (gdk-cffi:get-slot event :button)) 1)) - (with-path-at-pos view - (round (gdk-cffi:get-slot event :x)) - (round (gdk-cffi:get-slot event :y)) - (on-click view %path)))) + (on-click view + (path-at-pos view + (round (gdk-cffi:get-slot event :x)) + (round (gdk-cffi:get-slot event :y)))))) (gsignal view :cursor-changed) (lambda (view) - (with-get-cursor-path view - (set-bold view (second %path))))) + (set-bold view (second (get-cursor view))))) (setf (property view :enable-grid-lines) :both (property view :rules-hint) t) From rklochkov at common-lisp.net Sat Jul 21 19:26:39 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 21 Jul 2012 12:26:39 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/ext Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/ext In directory tiger.common-lisp.net:/tmp/cvs-serv799/ext Modified Files: lisp-model.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/ext/lisp-model.lisp 2012/05/08 09:38:07 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/ext/lisp-model.lisp 2012/07/21 19:26:38 1.5 @@ -88,13 +88,12 @@ (warn "Undefined implementation of GET-ITER for ~a" lisp-model-impl))) (defun set-iter (iter index) -; (break) (setf (stamp iter) 0 (u1 iter) (make-pointer index)) t) (defmethod get-iter ((lisp-model-list lisp-model-list) iter path) - (let ((index (get-index (make-instance 'tree-path :pointer path)))) + (let ((index (aref path 0))) (when (< index (lisp-model-length lisp-model-list)) (set-iter iter index)))) @@ -106,9 +105,9 @@ (values t (car child) (cdr child)))))) (defmethod get-iter ((lisp-model lisp-model-tree-array) iter path) - (let ((address (get-indices (make-instance 'tree-path :pointer path)))) - (multiple-value-bind (found index) (descend (tree lisp-model) address) - (when found (set-iter iter index))))) + (multiple-value-bind (found index) (descend (tree lisp-model) + (coerce path 'list)) + (when found (set-iter iter index)))) (defun iter->index (iter) (pointer-address (u1 iter))) @@ -118,11 +117,9 @@ (defgeneric get-path (lisp-model-impl iter) (:method ((lisp-model-list lisp-model-list) iter) - (make-instance 'tree-path :indices (list (iter->index iter)) - :free-after nil)) + (list (iter->index iter))) (:method ((lisp-model lisp-model-tree-array) iter) - (make-instance 'tree-path :string (car (iter->aref lisp-model iter)) - :free-after nil))) + (car (iter->aref lisp-model iter)))) (defun set-value (g-value value-list n) (g-object-cffi::init-g-value g-value nil (nth n value-list) t)) @@ -177,6 +174,7 @@ (defgeneric iter-children (lisp-model-impl iter parent) (:method ((lisp-model-list lisp-model-list) iter parent) +; (break) (unless parent (set-iter iter 0))) (:method ((lisp-model lisp-model-tree-array) iter parent) @@ -255,6 +253,7 @@ :collecting `(defcallback ,(symbolicate '#:cb- callback) ,(car args) ((object pobject) ,@(cdr args)) + ;(debug-out "callback: ~a~%" ',callback) (,callback (implementation object) ,@(mapcar #'car (cdr args))))) (defcallback ,(symbolicate '#:cb-init- interface) :void ((class ,interface)) @@ -267,19 +266,23 @@ get-flags (:int) get-n-columns (:int) get-column-type (:int (index :int)) - get-iter (:boolean (iter (struct tree-iter)) (path :pointer)) - get-path (pobject (iter (struct tree-iter))) - get-value (:void (iter (struct tree-iter)) (n :int) (value :pointer)) - iter-next (:boolean (iter (struct tree-iter))) - iter-previous (:boolean (iter (struct tree-iter))) - iter-children (:boolean (iter (struct tree-iter)) (parent (struct tree-iter))) - iter-has-child (:boolean (iter (struct tree-iter))) - iter-n-children (:int (iter (struct tree-iter))) - iter-nth-child (:boolean (iter (struct tree-iter)) - (parent (struct tree-iter)) (n :int)) - iter-parent (:boolean (iter (struct tree-iter)) (child (struct tree-iter))) - ref-node (:void (iter (struct tree-iter))) - unref-node (:void (iter (struct tree-iter)))) + get-iter (:boolean (iter (object tree-iter)) + (path (tree-path :free nil))) + get-path ((tree-path :free nil) (iter (object tree-iter))) + get-value (:void (iter (object tree-iter)) (n :int) + (value :pointer)) + iter-next (:boolean (iter (object tree-iter))) + iter-previous (:boolean (iter (object tree-iter))) + iter-children (:boolean (iter (object tree-iter)) + (parent (object tree-iter))) + iter-has-child (:boolean (iter (object tree-iter))) + iter-n-children (:int (iter (object tree-iter))) + iter-nth-child (:boolean (iter (object tree-iter)) + (parent (object tree-iter)) (n :int)) + iter-parent (:boolean (iter (object tree-iter)) + (child (object tree-iter))) + ref-node (:void (iter (object tree-iter))) + unref-node (:void (iter (object tree-iter)))) (defcstruct g-interface-info From rklochkov at common-lisp.net Sat Jul 21 19:26:39 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 21 Jul 2012 12:26:39 -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-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)) From rklochkov at common-lisp.net Sun Jul 29 15:13:59 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 08:13:59 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/examples Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/examples In directory tiger.common-lisp.net:/tmp/cvs-serv5173/examples Modified Files: ex7.lisp Log Message: Fixed memory leaks --- /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/07/21 19:26:38 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/examples/ex7.lisp 2012/07/29 15:13:59 1.7 @@ -1,3 +1,4 @@ +(proclaim '(optimize debug)) (asdf:oos 'asdf:load-op :gtk-cffi) (defpackage #:ex7 (:use #:common-lisp #:gtk-cffi #:g-object-cffi)) @@ -7,6 +8,7 @@ (defvar *cell-pix*) (defun main () + (declare (optimize debug safety)) (gtk-init) ;; (rc-parse-string "style \"my\" { ;; GtkTreeView::even-row-color = \"#E7EDF6\" @@ -65,9 +67,9 @@ (let ((%col col)) (lambda (cell path new-text) (declare (ignore cell)) + (format t "path: ~a new-text:~a~%" path new-text) (path->iter model path) - (setf (model-values model - :col %col) + (setf (model-values model :col %col) (list new-text))))) (append-column view column)))) @@ -105,6 +107,7 @@ (setf (search-column view) i))))) (defun on-click (view path-list) + (format t "on-click: ~a~%" path-list) (when path-list (destructuring-bind (path column x y) path-list (declare (ignore y)) @@ -118,15 +121,16 @@ (let ((text-view (make-instance 'text-view)) (iter (path->iter (model view) path))) (setf (text (buffer text-view)) - (car (model-values (model view) :columns '(1) :iter iter))) + (car (model-values (model view) :columns '(1) + :tree-iter iter))) (let ((top-area (content-area dialog))) (pack top-area text-view :pack-fill t :expand t) (show text-view)) - (setf (window-position dialog) :center-on-parent) + (setf (position-type dialog) :center-on-parent) ;(pack top-area text-view :fill t :expand t)) (run dialog) - (setf (model-values (model view) :columns '(1) :iter iter) + (setf (model-values (model view) :columns '(1) :tree-iter iter) (list (text (buffer text-view)))) (destroy dialog)))))))) From rklochkov at common-lisp.net Sun Jul 29 15:13:59 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 08:13:59 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv5173/g-object Modified Files: g-object.lisp package.lisp pobject.lisp Log Message: Fixed memory leaks --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/05/07 09:02:04 1.10 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/07/29 15:13:59 1.11 @@ -42,27 +42,34 @@ ;; (object pobject) (name :string) (value pobject)) +(define-foreign-type cffi-keyword () + () + (:simple-parser cffi-keyword) + (:actual-type :string)) + +(defmethod translate-to-foreign (value (type cffi-keyword)) + (convert-to-foreign (string-downcase value) :string)) + (defmacro generate-property-accessors (name object set get type class find prop-slot) `(progn (defgeneric ,type (,object key)) - (defmethod ,type ((,object ,object) (key symbol)) - (,type ,object (string-downcase key))) - (defmethod ,type ((,object ,object) (key string)) + (defmethod ,type ((,object ,object) key) "Should return GType of property KEY." - (or (cdr (assoc key (,prop-slot ,object))) - (let* ((gclass (make-instance ',class :object ,object)) - (prop (,find gclass key))) - (when prop - (let ((g-type (g-type prop))) - (setf (,prop-slot ,object) - (acons key g-type (,prop-slot ,object))) - g-type))) - (error "Incorrect property name ~a" key))) + (let ((skey (string-downcase key))) + (or (cdr (assoc skey (,prop-slot ,object) :test #'string=)) + (let* ((gclass (make-instance ',class :object ,object)) + (prop (,find gclass skey))) + (when prop + (let ((g-type (g-type prop))) + (setf (,prop-slot ,object) + (acons key g-type (,prop-slot ,object))) + g-type))) + (error "Incorrect property name ~a" key)))) ,@(when set `((defcfun ,set :void - (object pobject) (name :string) (value pobject)) + (object pobject) (name cffi-keyword) (value pobject)) (defgeneric (setf ,name) (values ,object &rest keys)) (defmethod (setf ,name) (values (,object ,object) &rest keys) "Usage: @@ -76,7 +83,7 @@ keys (if (listp values) values (list values)))))) (defcfun ,get :void - (object pobject) (name :string) (value pobject)) + (object pobject) (name cffi-keyword) (value pobject)) (defgeneric ,name (,object &rest keys)) (defmethod ,name ((,object ,object) &rest keys) "Usage @@ -84,11 +91,9 @@ (property object :prop1 :prop2 ...) -> (value1 value2 ...)" (funcall (lambda (x) (if (cdr x) x (car x))) (mapcar (lambda (key) - (let* ((skey (string-downcase key)) - (g-type (,type ,object skey))) - (with-g-value - (:g-type g-type) - (,get ,object skey *g-value*)))) + (with-g-value + (:g-type (,type ,object key)) + (,get ,object key *g-value*))) keys))))) (generate-property-accessors property g-object --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/03/06 01:25:26 1.10 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/07/29 15:13:59 1.11 @@ -11,6 +11,8 @@ #:cffi-objects #:g-lib-cffi #:gtk-cffi-utils) (:export + #:cffi-keyword + #:g-object ;; slots #:signals --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/05/07 09:02:04 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/07/29 15:13:59 1.8 @@ -85,9 +85,9 @@ (let ((obj (make-instance 'storage :data any-data))) (values (pointer obj) obj)))) -(defmethod free-translated-object (any-data (type cffi-pdata) param) +(defmethod free-translated-object (ptr (type cffi-pdata) param) (when param - (free-sent-if-needed type param))) + (free-sent-if-needed type param param))) (defctype g-list-object (g-list :elt pobject)) From rklochkov at common-lisp.net Sun Jul 29 15:13:59 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 08:13:59 -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-serv5173/gtk Modified Files: box.lisp cell-layout.lisp container.lisp dialog.lisp enums.lisp gtk-cffi.asd image.lisp list-store.lisp misc.lisp package.lisp progress-bar.lisp statusbar.lisp tree-model.lisp tree-view.lisp Log Message: Fixed memory leaks --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/box.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/box.lisp 2012/07/29 15:13:59 1.2 @@ -1,26 +1,53 @@ (in-package :gtk-cffi) -(defclass box (container) +(defclass box (container orientable) ((expand :initform t :initarg :expand) (fill :initform t :initarg :fill) (padding :initform 0 :initarg :padding) (cur-param :initform nil :allocation :class))) -(defcfun "gtk_box_pack_start" :void (box pobject) (widget pobject) +(defcfun gtk-box-pack-start :void (box pobject) (widget pobject) (expand :boolean) (fill :boolean) (padding :int)) -(defcfun "gtk_box_pack_end" :void (box pobject) (widget pobject) +(defcfun gtk-box-pack-end :void (box pobject) (widget pobject) (expand :boolean) (fill :boolean) (padding :int)) +(defslots box + homogeneous :boolean + spacing :int) + +(deffuns box + (reorder-child :void (child pobject) (position :int))) + +(defcfun gtk-box-query-child-packing :void + (box pobject) (child pobject) (expand :pointer) (fill :pointer) + (padding :pointer) (pack-type :pointer)) + +(defcfun gtk-box-set-child-packing :void + (box pobject) (child pobject) (expand :boolean) (fill :boolean) + (padding :uint) (pack-type pack-type)) + +(defgeneric child-packing (box child) + (:method ((box box) (child widget)) + (with-foreign-outs-list ((expand :boolean) (fill :boolean) + (padding :uint) (pack-type 'pack-type)) :ignore + (gtk-box-query-child-packing box child expand fill padding pack-type)))) + +(defgeneric (setf child-packing) (value box child) + (:method (value (box box) (child widget)) + (destructuring-bind (expand fill padding pack-type) value + (gtk-box-set-child-packing box child expand fill padding pack-type)))) + + (defmethod pack ((box box) (widget widget) &key end (expand :default) (fill :default) (padding :default)) (macrolet ((default (field) `(if (eq ,field :default) (slot-value box ',field) ,field))) - (debug-out "~a~%" (list box widget - expand (default expand) - fill (default fill) - padding (default padding))) +; (debug-out "~a~%" (list box widget +; expand (default expand) +; fill (default fill) +; padding (default padding))) (funcall (if end #'gtk-box-pack-end #'gtk-box-pack-start) box widget --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp 2012/05/08 09:38:07 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/cell-layout.lisp 2012/07/29 15:13:59 1.5 @@ -5,12 +5,11 @@ (defcfun "gtk_cell_layout_add_attribute" :void - (layout pobject) (cell pobject) (attr :string) (column :int)) + (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 - (string-downcase attr) column)) + (gtk-cell-layout-add-attribute cell-layout cell-renderer attr column)) (defcfun "gtk_cell_layout_pack_start" :void (cell-layout pobject) (renderer pobject) (expand :boolean)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/05/07 09:32:47 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/07/29 15:13:59 1.4 @@ -52,38 +52,37 @@ (setf (slot-value ,container param) ,token))))) (defcfun gtk-container-child-get-property :void - (container pobject) (widget pobject) (name :string) (value pobject)) + (container pobject) (widget pobject) (name cffi-keyword) (value pobject)) (defcfun gtk-container-child-set-property :void - (container pobject) (widget pobject) (name :string) (value pobject)) + (container pobject) (widget pobject) (name cffi-keyword) (value pobject)) (defgeneric child-property-type (container key)) (defmethod child-property-type ((container container) (key symbol)) (child-property-type container (string-downcase key))) -(defmethod child-property-type ((container container) (key string)) +(defmethod child-property-type ((container container) key) "Should return GType of property KEY." - (or (cdr (assoc key (%child-properties container))) - (let* ((gclass (make-instance 'g-object-cffi:g-object-class - :object container)) - (prop (find-child-property gclass key))) - (when prop - (let ((g-type (g-type prop))) - (setf (%child-properties container) - (acons key g-type (%child-properties container))) - g-type))) - (error "Incorrect child property name ~a" key))) + (let ((skey (string-downcase key))) + (or (cdr (assoc skey (%child-properties container) :test #'string=)) + (let* ((gclass (make-instance 'g-object-cffi:g-object-class + :object container)) + (prop (find-child-property gclass skey))) + (when prop + (let ((g-type (g-type prop))) + (setf (%child-properties container) + (acons skey g-type (%child-properties container))) + 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) - (let* ((skey (string-downcase key)) - (g-type (child-property-type parent skey))) - (with-g-value - (:g-type g-type) - (gtk-container-child-get-property - parent widget skey *g-value*)))) + (with-g-value + (:g-type (child-property-type parent skey)) + (gtk-container-child-get-property + parent widget key *g-value*))) keys))) (defmethod child-property ((widget widget) (parent null) &rest keys) @@ -97,11 +96,10 @@ (list value1 value2))" (mapc (lambda (key value) (declare (type (or symbol string) key)) - (let ((skey (string-downcase key))) - (with-g-value (:value value - :g-type (child-property-type parent skey)) - (gtk-container-child-set-property parent widget - skey *g-value*)))) + (with-g-value (:value value + :g-type (child-property-type parent skey)) + (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) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/03/08 09:58:12 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/07/29 15:13:59 1.7 @@ -25,39 +25,35 @@ (defcfun gtk-dialog-new :pointer) (defmethod gconstructor ((dialog dialog) - &key title parent (flags 0) &allow-other-keys) - (if title - (gtk-dialog-new-with-buttons title parent flags (null-pointer)) - (gtk-dialog-new))) + &key title parent (flags 0) with-buttons + &allow-other-keys) + (prog1 + (if title + (gtk-dialog-new-with-buttons title parent flags (null-pointer)) + (gtk-dialog-new)) + (dolist (button-description with-buttons) + (destructuring-bind (str resp) button-description + (add-button dialog str resp))))) -(defmethod initialize-instance - :after ((dialog dialog) - &key with-buttons &allow-other-keys) - (mapcar - (lambda (x) - (destructuring-bind (str resp) x - (add-button dialog str resp))) - with-buttons)) - - (defcfun gtk-dialog-run dialog-response (dialog pobject)) (defgeneric run (dialog &key) - (:method ((dialog dialog) &key (keep-alive t)) + (:method ((dialog dialog) &key cleanup) (prog1 (gtk-dialog-run dialog) - (unless keep-alive + (when cleanup (destroy dialog))))) -(defcfun gtk-dialog-add-button pobject (dialog pobject) - (str :string) (resp dialog-response)) +;(defcfun gtk-dialog-add-button pobject (dialog pobject) +; (str :string) (resp dialog-response)) -(defgeneric add-button (dialog string response) - (:method ((dialog dialog) str response) - (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str) - response))) +;(defgeneric add-button (dialog string response) +; (:method ((dialog dialog) str response) +; (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str) +; response))) (deffuns dialog (response :void (resp dialog-response)) + (add-button pobject (name cffi-keyword) (response dialog-response)) (add-action-widget :void (child pobject) &key (response dialog-response)) (:set default-response dialog-response) (:set-last response-sensitive :boolean (response dialog-response)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2011/09/16 17:58:33 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2012/07/29 15:13:59 1.5 @@ -27,4 +27,6 @@ :top-left :bottom-left :top-right :bottom-right) (defcenum justification - :left :right :center :fill) \ No newline at end of file + :left :right :center :fill) + +(defcenum pack-type :start :end) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/05/08 09:38:07 1.19 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/07/29 15:13:59 1.20 @@ -44,7 +44,7 @@ (defsystem gtk-cffi-misc :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-widget) :components @@ -53,7 +53,7 @@ (defsystem gtk-cffi-label :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-misc) :components @@ -122,7 +122,7 @@ (defsystem gtk-cffi-box :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-container) :components @@ -131,7 +131,7 @@ (defsystem gtk-cffi-hbox :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-box) :components @@ -140,7 +140,7 @@ (defsystem gtk-cffi-vbox :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-box) :components @@ -348,6 +348,15 @@ :components ((:file message-dialog))) +(defsystem gtk-cffi-info-bar + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.99" + :license "LLGPL" + :depends-on (gtk-cffi-message-dialog gtk-cffi-box) + :components + ((:file info-bar))) + (defsystem gtk-cffi-file-chooser :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " @@ -379,7 +388,7 @@ (defsystem gtk-cffi-progress-bar :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-widget) :components @@ -451,7 +460,7 @@ (defsystem gtk-cffi-statusbar :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-hbox) :components @@ -460,7 +469,7 @@ (defsystem gtk-cffi-image :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" :depends-on (gtk-cffi-misc) :components --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/05/07 09:02:04 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/07/29 15:13:59 1.4 @@ -50,7 +50,7 @@ (image pobject) (stock-id :string) (size icon-size)) (defcfun gtk-image-set-from-gicon :pointer (image pobject) (gicon pobject) (icon-size icon-size)) -(defcfun gtk-image-clear :void (image pobject)) +;(defcfun gtk-image-clear :void (image pobject)) (defmethod reinitialize-instance ((image image) &key file pixbuf stock-id gicon @@ -63,7 +63,7 @@ (icon-name (gtk-image-set-from-icon-name image icon-name icon-size)) (animation (gtk-image-set-from-animation image animation)) (gicon (gtk-image-set-from-gicon image gicon icon-size)) - (t (gtk-image-clear image)))) + (t (clear image)))) (defcenum image-type :empty :pixbuf :stock :icon-set :animation :icon-name :gicon) @@ -71,7 +71,8 @@ (deffuns image (:get pixbuf pobject) (:get animation pobject) - (:get storage-type image-type)) + (:get storage-type image-type) + (clear :void)) (defcfun gtk-image-get-icon-set :void (image pobject) (icon-set :pointer) (icon-size :pointer)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/03/08 09:58:12 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/07/29 15:13:59 1.4 @@ -30,18 +30,26 @@ (mapc (lambda (row) (append-values list-store row)) values))) -(defcfun "gtk_list_store_append" :void (store pobject) (iter pobject)) +(defcfun "gtk_list_store_append" :void + (store pobject) (iter (struct tree-iter :out t))) + +(defun show-iter (prefix tree-iter) + (format t "~a: ~a ~a ~a~%" prefix tree-iter (pointer tree-iter) + (when (slot-boundp tree-iter 'cffi-objects::value) + (slot-value tree-iter 'cffi-objects::value)))) + (defmethod append-iter ((list-store list-store) &optional (tree-iter (tree-iter list-store))) - (gtk-list-store-append list-store 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 pobject) - (column :int) (g-value pobject)) +(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 (iter (tree-iter list-store)) col (columns (when col (list col)))) + &key (tree-iter (tree-iter list-store)) col (columns (when col (list col)))) "Example: (setf (model-values list-store :col 1) \"val1\")" (declare (type list columns values)) (let ((%cols (append columns (loop :for i @@ -51,8 +59,9 @@ (mapcar (lambda (col val) (with-g-value (:value val :g-type (column-type list-store col)) + (show-iter "set" tree-iter) (gtk-list-store-set-value list-store - iter col *g-value*))) + tree-iter col *g-value*))) %cols values))) (defcfun "gtk_list_store_clear" :void (store pobject)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/misc.lisp 2012/05/07 09:02:04 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/misc.lisp 2012/07/29 15:13:59 1.3 @@ -15,20 +15,23 @@ (defcfun gtk-misc-get-alignment :void (misc pobject) (x :pointer) (y :pointer)) -(defmethod alignment ((misc misc)) - (with-foreign-outs-list ((x :float) (y :float)) :ignore - (gtk-misc-get-alignment misc x y))) +(defgeneric alignment (misc) + (:method ((misc misc)) + (with-foreign-outs-list ((x :float) (y :float)) :ignore + (gtk-misc-get-alignment misc x y)))) (defcfun gtk-misc-set-padding :void (misc pobject) (x :int) (y :int)) -(defmethod (setf padding) (coords (misc misc)) - (gtk-misc-set-padding misc - (first coords) - (second coords))) +(defgeneric (setf padding) (coords misc) + (:method (coords (misc misc)) + (gtk-misc-set-padding misc + (first coords) + (second coords)))) (save-setter misc padding) (defcfun gtk-misc-get-padding :void (misc pobject) (x :pointer) (y :pointer)) -(defmethod padding ((misc misc)) - (with-foreign-outs-list ((x :int) (y :int)) :ignore - (gtk-misc-get-padding misc x y))) +(defgeneric padding (misc) + (:method ((misc misc)) + (with-foreign-outs-list ((x :int) (y :int)) :ignore + (gtk-misc-get-padding misc x y)))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/21 19:26:39 1.21 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/29 15:13:59 1.22 @@ -351,9 +351,14 @@ #:button #:box + ;; box slots + #:spacing + #:homogeneous ;; box methods #:pack #:pack* + #:reorder-child + #:child-packing #:v-box @@ -808,6 +813,8 @@ #:show-text #:ellipsize #:pulse-step + ;; methods + #:pulse #:table ;; table methods --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/progress-bar.lisp 2012/05/07 09:02:04 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/progress-bar.lisp 2012/07/29 15:13:59 1.3 @@ -23,6 +23,7 @@ (deffuns progress-bar (:get text :string &key) - (:set text :string &key)) + (:set text :string &key) + (pulse :void)) (init-slots progress-bar) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/05/13 16:20:07 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/07/29 15:13:59 1.7 @@ -1,6 +1,6 @@ (in-package :gtk-cffi) -(defclass statusbar (h-box) +(defclass statusbar (box) ()) (defcfun "gtk_statusbar_new" :pointer) @@ -8,7 +8,7 @@ (defmethod gconstructor ((statusbar statusbar) &key &allow-other-keys) (gtk-statusbar-new)) -(defgtkfuns statusbar +(deffuns statusbar ((statusbar-push . push) :uint (context-id :uint) (text :string)) ((statusbar-pop . pop) :void (context-id :uint)) (:get context-id :uint (context pstring)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/21 19:26:39 1.10 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/29 15:13:59 1.11 @@ -92,11 +92,11 @@ (defcfun "gtk_tree_iter_free" :void (iter pobject)) -(defmethod free-struct ((class (eql 'tree-iter)) value) - (gtk-tree-iter-free value)) +;(defmethod free-struct ((class (eql 'tree-iter)) value) +; (gtk-tree-iter-free value)) -(defmethod free :before ((tree-iter tree-iter)) - (gtk-tree-iter-free tree-iter)) +;(defmethod free :before ((tree-iter tree-iter)) +; (gtk-tree-iter-free tree-iter)) (defclass tree-model (object) ((columns :accessor columns :initarg :columns) @@ -172,7 +172,7 @@ (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) +(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) @@ -180,7 +180,7 @@ (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 +(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) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/07/21 19:26:39 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/07/29 15:13:59 1.3 @@ -28,7 +28,13 @@ (when (cdr selected) (apply on-select selected))))))) +(deffuns tree-view + (remove-column :int (column pobject))) + + (defmethod (setf columns) (columns (tree-view tree-view)) + (dolist (column (columns tree-view)) + (remove-column tree-view column)) (labels ((mk-column (column colnum) (cond From rklochkov at common-lisp.net Sun Jul 29 15:14:28 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 08:14:28 -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-serv5577/gtk Added Files: info-bar.lisp Log Message: Added GtkInfoBar --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/info-bar.lisp 2012/07/29 15:14:28 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/info-bar.lisp 2012/07/29 15:14:28 1.1 (in-package :gtk-cffi) (defclass info-bar (box) ()) (defslot info-bar message-type message-type) (deffuns info-bar (add-action-widget :void (child pobject) &key (response dialog-response)) (add-button pobject (name cffi-keyword) (response dialog-response)) (:set default-response dialog-response) (:set-last response-sensitive :boolean (response dialog-response)) (response :void (resp dialog-response)) (:get action-area pobject) (:get content-area pobject)) (init-slots info-bar) From rklochkov at common-lisp.net Sun Jul 29 16:11:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 09:11:54 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv2958/g-object Modified Files: g-object.lisp Log Message: Synced with cffi-objects --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/07/29 15:13:59 1.11 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-object.lisp 2012/07/29 16:11:54 1.12 @@ -42,14 +42,6 @@ ;; (object pobject) (name :string) (value pobject)) -(define-foreign-type cffi-keyword () - () - (:simple-parser cffi-keyword) - (:actual-type :string)) - -(defmethod translate-to-foreign (value (type cffi-keyword)) - (convert-to-foreign (string-downcase value) :string)) - (defmacro generate-property-accessors (name object set get type class find prop-slot) `(progn From rklochkov at common-lisp.net Sun Jul 29 16:11:54 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 29 Jul 2012 09:11:54 -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-serv2958/gtk Modified Files: css-provider.lisp tree-model.lisp window.lisp Log Message: Synced with cffi-objects --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/css-provider.lisp 2012/01/25 19:15:08 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/css-provider.lisp 2012/07/29 16:11:54 1.3 @@ -20,7 +20,7 @@ (css-provider pobject) (file g-file) (g-error object)) (defcfun gtk-css-provider-load-from-path :boolean - (css-provider pobject) (path :string) (g-error object)) + (css-provider pobject) (path cffi-pathname) (g-error object)) (defgeneric css-provider-load (css-provider &key data filename gfile) (:method ((css-provider css-provider) &key data filename gfile) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/29 15:13:59 1.11 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-model.lisp 2012/07/29 16:11:54 1.12 @@ -159,14 +159,14 @@ (defmethod model-values ((tree-model tree-model) &key - (iter (tree-iter tree-model)) col (columns (ensure-list col))) + (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 - iter col *g-value*))) + tree-iter col *g-value*))) columns)) (defcfun gtk-tree-model-get-iter :boolean --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/02/20 16:51:37 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/07/29 16:11:54 1.5 @@ -40,8 +40,8 @@ urgency-hint :boolean accept-focus :boolean focus-on-map :boolean - default-icon-list g-list-object - default-icon-name :string +; default-icon-list g-list-object +; default-icon-name :string icon pobject icon-list g-list-object icon-name :string @@ -52,6 +52,20 @@ application pobject screen pobject) +(defcfun gtk-window-set-icon-from-file :boolean + (window pobject) (filename cffi-pathname) (g-error object)) + +(defmethod (setf icon) ((value pathname) (window window)) + (setf (icon window) (namestring value))) + +(defmethod (setf icon) ((value string) (window window)) + (with-g-error g-error + (unless + (gtk-window-set-icon-from-file window value g-error) + (cerror "Continue" "Window icon load error: ~a" g-error)))) + + + (defcfun gtk-window-set-default-size :void (window pobject) (w :int) (h :int)) @@ -169,6 +183,21 @@ (with-foreign-outs-list ((width :int) (height :int)) :ignore (gtk-window-get-size window width height)))) +(defcfun gtk-window-set-default-icon :void (icon pobject)) +(defcfun gtk-window-set-default-icon-from-file :boolean + (filename cffi-pathname) (g-error object)) +(defgeneric (setf default-icon) (icon) + (:method ((icon string)) + (with-g-error g-error + (unless (gtk-window-set-default-icon-from-file icon g-error) + (cerror "Continue" "Default icon load error: ~a" g-error)))) + (:method ((icon pathname)) + (setf (default-icon) (namestring icon))) + (:method (icon) + (gtk-window-set-default-icon icon))) + +(defcfun gtk-window-set-default-icon-list :void (icons g-list-object)) + (init-slots window ((width -1) (height -1) geometry resize) (when (or (/= width -1) (/= height -1)) (let ((sizes (list width height))) From rklochkov at common-lisp.net Tue Jul 31 17:57:12 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Tue, 31 Jul 2012 10:57:12 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv2691/g-lib Modified Files: array.lisp package.lisp variant.lisp Log Message: Added pack of Gtk*Buttons --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/02/20 18:50:27 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/array.lisp 2012/07/31 17:57:11 1.8 @@ -19,3 +19,11 @@ (defmethod free-ptr ((type g-lib-array) ptr) (g-free ptr)) +(define-foreign-type g-lib-string (cffi-objects::cffi-string) + ((free :initform t)) + (:simple-parser g-lib-string) + (:actual-type :pointer)) + + +(defmethod free-ptr ((type cffi-string) ptr) + (g-free ptr)) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2012/05/07 09:02:04 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2012/07/31 17:57:11 1.10 @@ -37,6 +37,9 @@ #:g-intern-static-string #:g-free + + #:g-lib-array + #:g-lib-string #:g-file )) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/02/12 17:29:41 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/variant.lisp 2012/07/31 17:57:11 1.3 @@ -57,6 +57,6 @@ (setf ptr (g-variant-parse (null-pointer) fstr (inc-pointer fstr len) (null-pointer) g-error)) - (when (null-pointer-p ptr) (error "GError: ~a" g-error))) + (when (null-pointer-p ptr) (error "Error in GVariant: ~a" g-error))) (foreign-string-free str) ptr))) From rklochkov at common-lisp.net Tue Jul 31 17:57:12 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Tue, 31 Jul 2012 10:57:12 -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-serv2691/gtk Modified Files: action.lisp button.lisp enums.lisp gtk-cffi.asd image.lisp loadlib.lisp package.lisp widget.lisp window.lisp Added Files: actionable.lisp activatable.lisp color-button.lisp color-chooser.lisp spinner.lisp status-icon.lisp Log Message: Added pack of Gtk*Buttons --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/action.lisp 2011/04/25 19:16:08 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/action.lisp 2012/07/31 17:57:12 1.2 @@ -1,6 +1,6 @@ (in-package :gtk-cffi) -(defclass action (gobject) +(defclass action (g-object) ()) (defcfun gtk-action-new :pointer (name gtk-string) (label gtk-string) @@ -27,3 +27,5 @@ visible-vertical :boolean is-important :boolean) +(init-slots action) + --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/02/12 17:29:42 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/button.lisp 2012/07/31 17:57:12 1.3 @@ -1,15 +1,19 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- +;;; +;;; button.lisp --- Wrapper for GtkButton +;;; +;;; Copyright (C) 2012, Roman Klochkov +;;; + (in-package :gtk-cffi) -(defclass button (bin) +(defclass button (bin actionable activatable) ()) -(defcfun "gtk_button_new" :pointer) - -(defcfun "gtk_button_new_with_label" :pointer (label :string)) - -(defcfun "gtk_button_new_with_mnemonic" :pointer (label :string)) - -(defcfun "gtk_button_new_from_stock" :pointer (label :string)) +(defcfun gtk-button-new :pointer) +(defcfun gtk-button-new-with-label :pointer (label :string)) +(defcfun gtk-button-new-with-mnemonic :pointer (label :string)) +(defcfun gtk-button-new-from-stock :pointer (label cffi-keyword)) (defmethod gconstructor ((button button) &key label type &allow-other-keys) @@ -23,3 +27,72 @@ (funcall creator label)) (gtk-button-new))) +(defslots button + relief relief-style + label :string + use-stock :boolean + use-underline :boolean + focus-on-click :boolean + image pobject + image-position position-type) + +(deffuns button + (clicked :void) + (:get event-window pobject)) + +(defcfun gtk-button-set-alignment :void (button pobject) (x :float) (y :float)) +(defmethod (setf alignment) (coords (button button)) + (gtk-button-set-alignment button + (float (first coords)) + (float (second coords)))) +(save-setter button alignment) + +(defcfun gtk-button-get-alignment :void + (button pobject) (x :pointer) (y :pointer)) + +(defmethod alignment ((button button)) + (with-foreign-outs-list ((x :float) (y :float)) :ignore + (gtk-button-get-alignment button x y))) + +(init-slots button) + +(defclass toggle-button (button) + ()) + +(defcfun gtk-toggle-button-new :pointer) +(defcfun gtk-toggle-button-new-with-label :pointer (label :string)) +(defcfun gtk-toggle-button-new-with-mnemonic :pointer (label :string)) + +(defmethod gconstructor ((toggle-button toggle-button) &key label type) + (if label + (case type + (:mnemonic (gtk-toggle-button-new-with-mnemonic label)) + (otherwise (gtk-toggle-button-new-with-label label))) + (gtk-toggle-button-new))) + +(defslots toggle-button + mode :boolean + active :boolean + inconsistent :boolean) + +(deffuns toggle-button + (toggled :void)) + +(init-slots toggle-button) + +(defclass check-button (toggle-button) + ()) + +(defcfun gtk-check-button-new :pointer) +(defcfun gtk-check-button-new-with-label :pointer (label :string)) +(defcfun gtk-check-button-new-with-mnemonic :pointer (label :string)) + +(defmethod gconstructor ((check-button check-button) &key label type) + (if label + (case type + (:mnemonic (gtk-check-button-new-with-mnemonic label)) + (otherwise (gtk-check-button-new-with-label label))) + (gtk-check-button-new))) + + + --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2012/07/29 15:13:59 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/enums.lisp 2012/07/31 17:57:12 1.6 @@ -29,4 +29,8 @@ (defcenum justification :left :right :center :fill) -(defcenum pack-type :start :end) \ No newline at end of file +(defcenum pack-type :start :end) + +(defcenum relief-style :normal :half :none) + +(defcenum position-type :left :right :top :bottom) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/07/29 15:13:59 1.20 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/07/31 17:57:12 1.21 @@ -29,7 +29,8 @@ (:file window-group :depends-on (loadlib)) (:file orientable :depends-on (loadlib)) (:file buildable :depends-on (loadlib)) - (:file builder :depends-on (loadlib)))) + (:file builder :depends-on (loadlib)) + (:file color-chooser :depends-on (loadlib)))) (defsystem gtk-cffi-widget :description "Interface to GTK/Glib via CFFI" @@ -39,7 +40,9 @@ :depends-on (gtk-cffi-core) :components ((:file widget) - (:file invisible :depends-on (widget)))) + (:file invisible :depends-on (widget)) + (:file actionable :depends-on (widget)) + (:file activatable :depends-on (widget)))) (defsystem gtk-cffi-misc :description "Interface to GTK/Glib via CFFI" @@ -113,9 +116,9 @@ (defsystem gtk-cffi-button :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " - :version "0.1" + :version "0.99" :license "LLGPL" - :depends-on (gtk-cffi-widget) + :depends-on (gtk-cffi-widget gtk-cffi-misc) :components ((:file :button))) @@ -383,7 +386,7 @@ :license "LLGPL" :depends-on (gtk-cffi-file-chooser gtk-cffi-hbox) :components - ((:file :file-chooser-button))) + ((:file file-chooser-button))) (defsystem gtk-cffi-progress-bar :description "Interface to GTK/Glib via CFFI" @@ -392,7 +395,7 @@ :license "LLGPL" :depends-on (gtk-cffi-widget) :components - ((:file :progress-bar))) + ((:file progress-bar))) (defsystem gtk-cffi-table :description "Interface to GTK/Glib via CFFI" @@ -401,7 +404,7 @@ :license "LLGPL" :depends-on (gtk-cffi-container) :components - ((:file :table))) + ((:file table))) (defsystem gtk-cffi-menu-shell :description "Interface to GTK/Glib via CFFI" @@ -410,7 +413,7 @@ :license "LLGPL" :depends-on (gtk-cffi-container) :components - ((:file :menu-shell))) + ((:file menu-shell))) (defsystem gtk-cffi-menu :description "Interface to GTK/Glib via CFFI" @@ -419,7 +422,7 @@ :license "LLGPL" :depends-on (gtk-cffi-menu-shell) :components - ((:file :menu))) + ((:file menu))) (defsystem gtk-cffi-menu-bar :description "Interface to GTK/Glib via CFFI" @@ -428,7 +431,7 @@ :license "LLGPL" :depends-on (gtk-cffi-menu-shell) :components - ((:file :menu-bar))) + ((:file menu-bar))) (defsystem gtk-cffi-tool-shell :description "Interface to GTK/Glib via CFFI" @@ -437,7 +440,7 @@ :license "LLGPL" :depends-on (gtk-cffi-container) :components - ((:file :tool-shell))) + ((:file tool-shell))) (defsystem gtk-cffi-toolbar :description "Interface to GTK/Glib via CFFI" @@ -455,7 +458,7 @@ :license "LLGPL" :depends-on (gtk-cffi-container) :components - ((:file :notebook))) + ((:file notebook))) (defsystem gtk-cffi-statusbar :description "Interface to GTK/Glib via CFFI" @@ -464,7 +467,7 @@ :license "LLGPL" :depends-on (gtk-cffi-hbox) :components - ((:file :statusbar))) + ((:file statusbar))) (defsystem gtk-cffi-image :description "Interface to GTK/Glib via CFFI" @@ -473,19 +476,56 @@ :license "LLGPL" :depends-on (gtk-cffi-misc) :components - ((:file :image))) + ((:file image))) + +(defsystem gtk-cffi-status-icon + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.99" + :license "LLGPL" + :depends-on (gtk-cffi-core) + :components + ((:file status-icon))) + +(defsystem gtk-cffi-spinner + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "1.0" + :license "LLGPL" + :depends-on (gtk-cffi-widget) + :components + ((:file spinner))) + +(defsystem gtk-cffi-action + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.1" + :license "LLGPL" + :depends-on (gtk-cffi-core) + :components + ((:file action))) + +(defsystem gtk-cffi-color-button + :description "Interface to GTK/Glib via CFFI" + :author "Roman Klochkov " + :version "0.99" + :license "LLGPL" + :depends-on (gtk-cffi-button) + :components + ((:file color-button))) + (defsystem gtk-cffi :description "Interface to GTK/Glib via CFFI" :author "Roman Klochkov " :version "0.1" :license "LLGPL" - :depends-on (gtk-cffi-message-dialog + :depends-on (gtk-cffi-info-bar gtk-cffi-file-chooser-dialog gtk-cffi-file-chooser-button gtk-cffi-progress-bar gtk-cffi-entry - gtk-cffi-button + gtk-cffi-color-button gtk-cffi-label gtk-cffi-paned gtk-cffi-frame @@ -505,5 +545,6 @@ gtk-cffi-notebook gtk-cffi-image gtk-cffi-combo-box + gtk-cffi-status-icon gtk-cffi-text-view)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/07/29 15:13:59 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/image.lisp 2012/07/31 17:57:12 1.5 @@ -9,14 +9,15 @@ (defclass image (misc) ()) -(defcfun gtk-image-new-from-file :pointer (filename :string)) +(defcfun gtk-image-new-from-file :pointer (filename cffi-pathname)) (defcfun gtk-image-new-from-icon-set :pointer (icon-set pobject) (icon-size icon-size)) (defcfun gtk-image-new-from-pixbuf :pointer (pixbuf pobject)) -(defcfun gtk-image-new-from-icon-name :pointer (icon-name :string) (icon-size icon-size)) +(defcfun gtk-image-new-from-icon-name :pointer + (icon-name :string) (icon-size icon-size)) (defcfun gtk-image-new-from-animation :pointer (animation pobject)) (defcfun gtk-image-new-from-stock :pointer - (stock-id :string) (size icon-size)) + (stock-id cffi-keyword) (size icon-size)) (defcfun gtk-image-new-from-gicon :pointer (gicon pobject) (icon-size icon-size)) (defcfun gtk-image-new :pointer) @@ -50,7 +51,6 @@ (image pobject) (stock-id :string) (size icon-size)) (defcfun gtk-image-set-from-gicon :pointer (image pobject) (gicon pobject) (icon-size icon-size)) -;(defcfun gtk-image-clear :void (image pobject)) (defmethod reinitialize-instance ((image image) &key file pixbuf stock-id gicon --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2012/02/20 16:51:37 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2012/07/31 17:57:12 1.6 @@ -38,5 +38,7 @@ (defcfun gtk-get-major-version :uint) (defcfun gtk-get-minor-version :uint) (when (and (>= (gtk-get-major-version) 3) (>= (gtk-get-minor-version) 2)) - (push :gtk3.2 *features*))) + (push :gtk3.2 *features*)) + (when (and (>= (gtk-get-major-version) 3) (>= (gtk-get-minor-version) 4)) + (push :gtk3.4 *features*))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/29 15:13:59 1.22 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/07/31 17:57:12 1.23 @@ -349,6 +349,19 @@ #:button + ;; slots + #:relief + #:use-stock + #:image-position + ;; methods + #:clicked + #:event-window + + #:toggle-button + #:inconsistent + #:toggled + + #:check-button #:box ;; box slots @@ -866,6 +879,39 @@ #:objects #:type-from-name #:value-from-string + + #:status-icon + #:size + #:stock + #:is-embedded + #:gicon + #:x11-window-id + #:storage-type + + #:info-bar + + + #:spinner + ;methods + #:start + #:stop + + #:activatable + #:related-action + #:use-action-appearance + #:do-set-related-action + #:sync-action-properties + + #:actionable + #:action-name + #:action-target-value + #:detailed-action-name + + #:color-button + #:rgba + #:color + #:use-alpha + #:title )) (in-package #:gtk-cffi) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/05/13 16:20:07 1.14 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/07/31 17:57:12 1.15 @@ -126,8 +126,8 @@ parent-window pobject parent pobject child-visible :boolean - tooltip-markup :string - tooltip-text :string + tooltip-markup g-lib-string + tooltip-text g-lib-string tooltip-window pobject has-tooltip :boolean can-default :boolean @@ -142,7 +142,7 @@ sensitive :boolean events event-mask visual pobject - composite-name :string + composite-name g-lib-string halign align valign align margin-left :int @@ -162,10 +162,11 @@ (hide :boolean) (size-allocate :void (allocation (struct allocation))) (add-accelerator :void - (accel-signal :string) (accel-group pobject) (accel-key key) - (accel-mods modifier-type) (accel-flags accel-flags)) + (accel-signal :string) (accel-group pobject) (accel-key key) + (accel-mods modifier-type) (accel-flags accel-flags)) (remove-accelerator :boolean - (accel-group pobject) (accel-key key) (accel-mods modifier-type)) + (accel-group pobject) (accel-key key) + (accel-mods modifier-type)) (list-accel-closures g-list) (can-activate-accel :boolean (signal-id :uint)) ((widget-event . event) :boolean (event event)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/07/29 16:11:54 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/07/31 17:57:12 1.6 @@ -196,7 +196,16 @@ (:method (icon) (gtk-window-set-default-icon icon))) +(defcfun (default-icon-list "gtk_window_get_default_icon_list") g-list-object) (defcfun gtk-window-set-default-icon-list :void (icons g-list-object)) +(defun (setf default-icon-list) (value) + (gtk-window-set-default-icon-list value)) + +(defcfun (default-icon-name "gtk_window_get_default_icon_name") :string) +(defcfun gtk-window-set-default-icon-name :void (name :string)) +(defun (setf default-icon-name) (name) + (gtk-window-set-default-icon-name name)) + (init-slots window ((width -1) (height -1) geometry resize) (when (or (/= width -1) (/= height -1)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/actionable.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/actionable.lisp 2012/07/31 17:57:12 1.1 ;;; ;;; actionable.lisp -- GtkActionable ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass actionable (object) ()) #+gtk3.4 (defslots actionable action-name :string action-target-value variant) #+gtk3.4 (deffuns actionable (:set detailed-action-name :string)) #+gtk3.4 (init-slots actionable) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/activatable.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/activatable.lisp 2012/07/31 17:57:12 1.1 ;;; ;;; activatable.lisp -- GtkActivatable ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass activatable (object) ()) (defslots activatable related-action pobject use-action-appearance :boolean) (deffuns activatable (do-set-related-action :void (action pobject)) (sync-action-properties :void (action pobject))) (init-slots activatable) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-button.lisp 2012/07/31 17:57:12 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; ;;; color-button.lisp --- Wrapper for GtkColorButton ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass color-button (button color-chooser) ()) (defcfun gtk-color-button-new :pointer) (defcfun gtk-color-button-new-with-color :pointer (color pcolor)) (defcfun gtk-color-button-new-with-rgba :pointer (rgbd prgba)) (defmethod gconstructor ((color-button color-button) &key color rgba) (cond (color (gtk-color-button-new-with-color color)) (rgba (gtk-color-button-new-with-rgba rgba)) (t (gtk-color-button-new)))) (defslots color-button rgba prgba alpha :uint16 use-alpha :boolean title :string) (deffuns color-button (:get color pcolor &key) (:set color pcolor &key)) (remove-setter color-button color) (remove-setter color-button rgba) (init-slots color-button)--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-chooser.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/color-chooser.lisp 2012/07/31 17:57:12 1.1 ;;; ;;; color-chooser.lisp -- GtkColorChooser ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass color-chooser (object) ()) (defslots color-chooser rgba prgba use-alpha :boolean) (defcfun gtk-color-chooser-add-palette :void (color-chooser pobject) (orientation orientation) (colors-per-line :int) (n-colors :int) (colors :pointer)) (defgeneric add-palette (color-chooser colors colors-per-line &key orientation) (:method ((color-chooser color-chooser) colors colors-per-line &key orientation) (let ((type 'gdk-cffi::rgba-struct) (n-colors (length colors))) (with-foreign-object (pcolors type n-colors) (dotimes (i n-colors) (destructuring-bind (red green blue alpha) (elt colors i) (template (field var) (('gdk-cffi::red red) ('gdk-cffi::green green) ('gdk-cffi::blue blue) ('gdk-cffi::alpha alpha)) `(setf (foreign-slot-value (mem-ref pcolors type i) type ,field) ,var)))) (gtk-color-chooser-add-palette color-chooser orientation colors-per-line n-colors colors)))))--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spinner.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spinner.lisp 2012/07/31 17:57:12 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; ;;; spinner.lisp --- Wrapper for GtkSpinner ;;; ;;; Copyright (C) 2012, Roman Klochkov ;;; (in-package :gtk-cffi) (defclass spinner (widget) ()) (defcfun gtk-spinner-new :pointer) (defmethod gconstructor ((spinner spinner) &key) (gtk-spinner-new)) (deffuns spinner (start :void) (stop :void))--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/status-icon.lisp 2012/07/31 17:57:12 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/status-icon.lisp 2012/07/31 17:57:12 1.1 (in-package :gtk-cffi) (defclass status-icon (g-object) ()) (defcfun gtk-status-icon-new-from-file :pointer (filename cffi-pathname)) (defcfun gtk-status-icon-new-from-pixbuf :pointer (pixbuf pobject)) (defcfun gtk-status-icon-new-from-icon-name :pointer (icon-name :string)) (defcfun gtk-status-icon-new-from-stock :pointer (stock-id cffi-keyword)) (defcfun gtk-status-icon-new-from-gicon :pointer (gicon pobject)) (defcfun gtk-status-icon-new :pointer) (defmethod gconstructor ((status-icon status-icon) &key file pixbuf stock-id gicon icon-name) (cond (file (gtk-status-icon-new-from-file file)) (pixbuf (gtk-status-icon-new-from-pixbuf pixbuf)) (stock-id (gtk-status-icon-new-from-stock stock-id)) (icon-name (gtk-status-icon-new-from-icon-name icon-name)) (gicon (gtk-status-icon-new-from-gicon gicon)) (t (gtk-status-icon-new)))) (defcfun gtk-status-icon-set-from-file :pointer (status-icon pobject) (filename cffi-pathname)) (defcfun gtk-status-icon-set-from-pixbuf :pointer (status-icon pobject) (pixbuf pobject)) (defcfun gtk-status-icon-set-from-icon-name :pointer (status-icon pobject) (icon-name :string)) (defcfun gtk-status-icon-set-from-stock :pointer (status-icon pobject) (stock-id :string)) (defcfun gtk-status-icon-set-from-gicon :pointer (status-icon pobject) (gicon pobject)) (defmethod reinitialize-instance ((status-icon status-icon) &key file pixbuf stock-id gicon icon-name) (cond (file (gtk-status-icon-set-from-file status-icon file)) (pixbuf (gtk-status-icon-set-from-pixbuf status-icon pixbuf)) (stock-id (gtk-status-icon-set-from-stock status-icon stock-id)) (icon-name (gtk-status-icon-set-from-icon-name status-icon icon-name)) (gicon (gtk-status-icon-set-from-gicon status-icon gicon)))) (defslots status-icon screen pobject tooltip-text :string tooltip-markup :string has-tooltip :boolean title :string visible :boolean) (deffuns status-icon ((name . get-icon-name) :string) (:set name :string) (is-embedded :boolean) (:get x11-window-id :uint32) (:get storage-type image-type) (:get pixbuf pobject) (:get stock :string) (:get gicon pobject) (:get size :int)) (defcfun gtk-status-icon-get-geometry :boolean (status-icon pobject) (screen :pointer) (area (struct rectangle :out t)) (orientation :pointer)) (defgeneric geometry (status-icon) (:method ((status-icon status-icon)) (let ((area (make-instance 'rectangle))) (with-foreign-objects ((screen :pointer) (orientation orientation)) (when (gtk-status-icon-get-geometry status-icon screen area orientation) (list (make-instance 'screen :pointer (mem-ref screen :pointer)) area (mem-ref orientation 'orientation))))))) ;; gtk_status_icon_position_menu can be used ;; in menu-popup as :gtk-status-icon-position-menu (init-slots status-icon) From rklochkov at common-lisp.net Tue Jul 31 18:00:59 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Tue, 31 Jul 2012 11:00:59 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/schedule Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/schedule In directory tiger.common-lisp.net:/tmp/cvs-serv4930 Removed Files: database.lisp package.lisp records.fas records.lib records.lisp schedule.asd Log Message: Cleanup old sources From rklochkov at common-lisp.net Tue Jul 31 18:04:15 2012 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Tue, 31 Jul 2012 11:04:15 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk-app Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk-app In directory tiger.common-lisp.net:/tmp/cvs-serv5516 Removed Files: clsql.lisp demo.lisp package.lisp test.lisp ????.lisp ????????????????????.lisp ????????.asd Log Message: Clean up old sources