From rklochkov at common-lisp.net Sat Mar 23 13:13:48 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:13:48 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gi In directory tiger.common-lisp.net:/tmp/cvs-serv6704/gi Log Message: Directory /project/gtk-cffi/cvsroot/gtk-cffi/gi added to the repository From rklochkov at common-lisp.net Sat Mar 23 13:14:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:14:23 -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-serv6738/g-lib Modified Files: loadlib.lisp Log Message: 1 --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/loadlib.lisp 2012/01/25 19:15:08 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/loadlib.lisp 2013/03/23 13:14:23 1.3 @@ -10,7 +10,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (define-foreign-library :g-lib - (:unix "libglib-2.0.so") + (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so")) (:windows "libglib-2.0-0.dll")) (load-foreign-library :g-lib)) From rklochkov at common-lisp.net Sat Mar 23 13:14:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:14:23 -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-serv6738/g-object Modified Files: g-value.lisp loadlib.lisp Log Message: 1 --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2012/12/31 13:33:38 1.9 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-value.lisp 2013/03/23 13:14:23 1.10 @@ -69,8 +69,9 @@ (defun init-g-value (ptr type value value-p) (macrolet ((gtypecase (x &rest body) `(typecase ,x - ,@(mapcar (lambda (x) (list (car x) - (keyword->g-type (cdr x)))) + ,@(mapcar (lambda (x) + (list (car x) + (keyword->g-type (cdr x)))) body)))) (let ((%type (or type (when value-p @@ -146,8 +147,10 @@ ((#.(keyword->g-type :enum) #.(keyword->g-type :flags)) (convert-to-foreign value (g-type->lisp type))) - (#.(keyword->g-type :double) (coerce value 'double-float)) - (#.(keyword->g-type :float) (coerce value 'single-float)) + (#.(keyword->g-type :double) + (coerce value 'double-float)) + (#.(keyword->g-type :float) + (coerce value 'single-float)) ((#.(keyword->g-type :int) #.(keyword->g-type :uint) #.(keyword->g-type :long) @@ -157,7 +160,8 @@ (t value)))) ; (debug-out " converted value ~a~%" val) (when (/= type 0) - (funcall (select-accessor ftype :g-value-set-) ptr val))))) + (funcall (select-accessor ftype :g-value-set-) + ptr val))))) (defun g-value-get (value) (unless (null-pointer-p value) @@ -201,7 +205,8 @@ "This macro allows recursive *g-value* binding" `(progn (let* ((changed? (/= 0 (g-type *g-value*))) - (*g-value* (if changed? (make-instance 'g-value) *g-value*))) + (*g-value* (if changed? (make-instance 'g-value) + *g-value*))) (init *g-value* , at val) (unwind-protect (progn --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/loadlib.lisp 2012/02/12 17:29:41 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/loadlib.lisp 2013/03/23 13:14:23 1.4 @@ -9,7 +9,7 @@ (in-package #:g-object-cffi) (define-foreign-library :g-object - (:unix "libgobject-2.0.so") + (:unix (:or "libgobject-2.0.so.0" "libgobject-2.0.so")) (:windows "libgobject-2.0-0.dll")) (use-foreign-library :g-object) \ No newline at end of file From rklochkov at common-lisp.net Sat Mar 23 13:14:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:14:23 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gdk Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gdk In directory tiger.common-lisp.net:/tmp/cvs-serv6738/gdk Modified Files: loadlib.lisp Log Message: 1 --- /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp 2012/01/27 18:41:31 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gdk/loadlib.lisp 2013/03/23 13:14:23 1.5 @@ -9,7 +9,7 @@ ;(eval-when (:compile-toplevel :load-toplevel :execute) (define-foreign-library :gdk - (:unix "libgdk-3.so.0") + (:unix (:or "libgdk-3.so.0" "libgdk-3.so")) (:windows "libgdk-win32-3xs-0.dll")) (use-foreign-library :gdk) From rklochkov at common-lisp.net Sat Mar 23 13:14:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:14:23 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gio Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gio In directory tiger.common-lisp.net:/tmp/cvs-serv6738/gio Modified Files: loadlib.lisp package.lisp Log Message: 1 --- /project/gtk-cffi/cvsroot/gtk-cffi/gio/loadlib.lisp 2012/02/12 17:29:41 1.2 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gio/loadlib.lisp 2013/03/23 13:14:23 1.3 @@ -1,7 +1,7 @@ (in-package #:gio-cffi) (define-foreign-library :gio - (:unix "libgio-2.0.so") + (:unix (:or "libgio-2.0.so.0" "libgio-2.0.so")) (:windows "libgio-2.0-0.dll")) (use-foreign-library :gio) \ No newline at end of file --- /project/gtk-cffi/cvsroot/gtk-cffi/gio/package.lisp 2012/02/20 16:51:37 1.3 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gio/package.lisp 2013/03/23 13:14:23 1.4 @@ -9,7 +9,26 @@ (defpackage #:gio-cffi (:nicknames #:gio) - (:use #:common-lisp #:cffi-objects #:g-object-cffi #:g-lib-cffi #:iterate)) + (:use #:common-lisp #:cffi-objects #:g-object-cffi #:g-lib-cffi #:iterate) + (:export + #:list-actions + #:action-parameter-type + #:action-state + #:has-action + #:application-id + #:is-registered + #:change-action-state + #:activate-action + #:release + #:action-group + #:hold + #:is-remote + #:action-state-hint + #:action-enabled + #:activate + #:action-state-type + #:inactivity-timeout + #:flags)) (in-package #:gio-cffi) (register-package "G" *package*) From rklochkov at common-lisp.net Sat Mar 23 13:14:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:14:23 -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-serv6738/gtk Modified Files: container.lisp generics.lisp loadlib.lisp package.lisp range.lisp spin-button.lisp tree-view.lisp Log Message: 1 --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2012/12/24 16:32:05 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/container.lisp 2013/03/23 13:14:23 1.8 @@ -121,8 +121,9 @@ (defcfun gtk-container-remove :void (container pobject) (widget pobject)) -(defmethod container-remove ((container container) (widget widget)) - (gtk-container-remove container widget)) +(defgeneric container-remove (container widget) + (:method ((container container) (widget widget)) + (gtk-container-remove container widget))) (defcfun gtk-container-propagate-draw :void (container pobject) (child pobject) (context :pointer)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2012/12/24 16:32:05 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2013/03/23 13:14:23 1.7 @@ -6,6 +6,8 @@ (defgeneric layout-offsets (object)) ;; entry, label, scale (defgeneric (setf model) (model object)) ;; combo-box, list-store, ;; tree-model-filter +(defgeneric (setf increments) (value object)) ;; spin-button, range +(defgeneric (setf range) (value object)) ;; spin-button, range --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2012/07/31 17:57:12 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2013/03/23 13:14:23 1.7 @@ -21,7 +21,7 @@ (unless (find :gtk *features*) (push :gtk *features*) (define-foreign-library :gtk - (:unix "libgtk-3.so.0") ;libgtk-x11-2.0.so") + (:unix (:or "libgtk-3.so.0" "libgtk-3.so")) (:windows "libgtk-win32-3-0.dll")) (use-foreign-library :gtk))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/12/24 16:32:05 1.31 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2013/03/23 13:14:23 1.32 @@ -11,7 +11,8 @@ (:use #:common-lisp #:alexandria #:iterate #:cffi-objects #:g-object-cffi #:g-lib-cffi #:gdk-cffi #:gtk-cffi-utils) - (:shadow #:image #:window #:switch) + (:shadow #:image #:window #:switch) ; gdk + (:shadow #:maximize) ; iterate (:export ;;;; common #:gtk-init @@ -610,7 +611,20 @@ #:rules-hint #:headers-visible #:hover-selection + #:search-equal-func #:tooltip-column + #:search-entry + #:row-sepearator-func + #:fixed-height-mode + #:search-position-func + #:enable-tree-lines + #:grid-lines + #:enable-search ;; tree-view methods + #:is-rubber-banding-active + #:create-row-drag-icon + #:unset-rows-drag-source + #:unset-rows-drag-dest + #:bin-window #:append-column #:insert-column #:selection @@ -618,7 +632,12 @@ #:column #:cursor #:remove-column - + #:row-expanded #:expand-row + #:expand-to-path #:collapse-row + #:expand-all #:row-activated + #:scroll-to-point #:collapse-all + #:move-column-after + #:tree-view-column ;; slots #:sort-column-id --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/range.lisp 2012/05/07 09:02:04 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/range.lisp 2013/03/23 13:14:23 1.2 @@ -22,19 +22,17 @@ (defcfun gtk-range-set-increments :void (range pobject) (step :double) (page :double)) -(defgeneric (setf increments) (increments range) - (:method (increments (range range)) - (destructuring-bind (step page) increments - (gtk-range-set-increments range step page)) - increments)) +(defmethod (setf increments) (increments (range range)) + (destructuring-bind (step page) increments + (gtk-range-set-increments range step page)) + increments) (defcfun gtk-range-set-range :void (range pobject) (min :double) (max :double)) -(defgeneric (setf range) (min-max range) - (:method (min-max (range range)) - (destructuring-bind (min max) min-max +(defmethod (setf range) (min-max (range range)) + (destructuring-bind (min max) min-max (gtk-range-set-increments range min max)) - min-max)) + min-max) (defcfun gtk-range-get-slider-range :void (range pobject) (start :pointer) (end :pointer)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spin-button.lisp 2012/08/21 19:48:02 1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/spin-button.lisp 2013/03/23 13:14:23 1.2 @@ -58,10 +58,9 @@ (with-foreign-outs-list ((step :double) (page :double)) :ignore (gtk-spin-button-get-increments spin-button step page)))) -(defgeneric (setf increments) (value spin-button) - (:method (value (spin-button spin-button)) - (destructuring-bind (step page) value - (gtk-spin-button-set-increments spin-button step page)))) +(defmethod (setf increments) (value (spin-button spin-button)) + (destructuring-bind (step page) value + (gtk-spin-button-set-increments spin-button step page))) (save-setter spin-button increments) (defcfun gtk-spin-button-set-range :void (spin-button pobject) @@ -74,10 +73,9 @@ (with-foreign-outs-list ((min :double) (max :double)) :ignore (gtk-spin-button-get-range spin-button min max)))) -(defgeneric (setf range) (value spin-button) - (:method (value (spin-button spin-button)) - (destructuring-bind (min max) value - (gtk-spin-button-set-range spin-button min max)))) +(defmethod (setf range) (value (spin-button spin-button)) + (destructuring-bind (min max) value + (gtk-spin-button-set-range spin-button min max))) (save-setter spin-button range) --- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2012/12/31 13:33:38 1.7 +++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-view.lisp 2013/03/23 13:14:23 1.8 @@ -19,10 +19,13 @@ (defmethod gconstructor ((tree-view tree-view) &key model &allow-other-keys) + (initialize tree-view 'model) (if model (gtk-tree-view-new-with-model model) (gtk-tree-view-new))) +(defcenum tree-view-grid-lines :nobe :horizontal :vertical :both) + (defslots tree-view level-indentation :int show-expanders :boolean @@ -37,8 +40,17 @@ rubber-banding :boolean search-column :int expander-column pobject - reorderable :boolean) + reorderable :boolean + enable-search :boolean + search-entry pobject + fixed-height-mode :boolean + enable-tree-lines :boolean + grid-lines tree-view-grid-lines + tooltip-column :int) + +(defcenum tree-view-drop-position + :before :after :into-or-before :into-or-after) (deffuns tree-view (remove-column :int (column pobject)) @@ -57,13 +69,18 @@ (expand-row :void (path tree-path) (open-all :boolean)) (collapse-row :void (path tree-path)) (row-expanded :boolean (path tree-path)) - (:get bin-window pobject)) - - + (:get bin-window pobject) + (unset-rows-drag-source :void) + (unset-rows-drag-dest :void) + (create-row-drag-icon :pointer (path tree-path)) + (:get search-equal-func :pointer) + (:get search-position-func :pointer) + (:get row-separator-func :pointer) + (is-rubber-banding-active :boolean)) (defcfun gtk-tree-view-scroll-to-cell :void - (tree-view pobject) (path ptree-path) (column pobject) (use-align :boolean) + (tree-view pobject) (path tree-path) (column pobject) (use-align :boolean) (row-align :float) (col-align :float)) (defgeneric scroll-to-cell (tree-view path column &key row-align col-align) @@ -93,8 +110,8 @@ (save-setter tree-view columns) -(defcfun gtk-tree-view-get-cursor :void (view pobject) - (path :pointer) (column :pointer)) +(defcfun gtk-tree-view-get-cursor :void + (view pobject) (path :pointer) (column :pointer)) (defgeneric cursor (tree-view) (:method ((tree-view tree-view)) @@ -230,6 +247,118 @@ (tree-view pobject) (targets (carray (struct target-entry))) (n-targets :int) (action drag-action)) +(defgeneric enable-model-drag-dest (tree-view targets action) + (:method ((tree-view tree-view) targets action) + (gtk-tree-view-enable-model-drag-dest tree-view targets + (length targets) action))) + +(defcfun gtk-tree-view-enable-model-drag-source :void + (tree-view pobject) (start-button-mask modifier-type) + (targets (carray (struct target-entry))) + (n-targets :int) (action drag-action)) + +(defgeneric enable-model-drag-source (tree-view start-button-mask + targets action) + (:method ((tree-view tree-view) start-button-mask targets action) + (gtk-tree-view-enable-model-drag-source tree-view start-button-mask targets + (length targets) action))) + +(defcfun gtk-tree-view-get-drag-dest-row :void (tree-view pobject) + (tree-path :pointer) (pos :pointer)) + +(defgeneric drag-dest-row (tree-view) + (:method ((tree-view tree-view)) + (with-foreign-outs-list ((path 'tree-path) (pos 'tree-view-drop-position)) + :ignore + (gtk-tree-view-get-drag-dest-row tree-view path pos)))) + +(defcfun gtk-tree-view-set-drag-dest-row :void (tree-view pobject) + (tree-path tree-path) (pos tree-view-drop-position)) + +(defgeneric (setf drag-dest-row) (value tree-view) + (:method (value (tree-view tree-view)) + (destructuring-bind (path pos) value + (gtk-tree-view-set-drag-dest-row tree-view path pos)))) + +(defcfun gtk-tree-view-get-dest-row-at-pos :void (tree-view pobject) + (x :int) (y :int) + (tree-path :pointer) (pos :pointer)) + +(defgeneric dest-row-at-post (tree-view x y) + (:method ((tree-view tree-view) x y) + (with-foreign-outs-list ((path 'tree-path) (pos 'tree-view-drop-position)) + :ignore + (gtk-tree-view-get-dest-row-at-pos tree-view x y path pos)))) + +(defcfun gtk-tree-view-set-search-equal-func :int + (tree-view pobject) + (func pfunction) (data pdata) (destroy pfunction)) + +(defcallback cb-search-equal-func :boolean + ((tree-view pobject) (column :int) (key :string) + (tree-iter (struct tree-iter)) (data pdata)) + (funcall data tree-view column key tree-iter)) + +(defgeneric (setf search-equal-func) (func tree-view &key data destroy-notify) + (:method (func (tree-view tree-view) &key data destroy-notify) + (set-callback tree-view gtk-tree-view-set-search-equal-func + cb-search-equal-func func data destroy-notify))) + +(defcfun gtk-tree-view-set-search-position-func :int + (tree-view pobject) + (func pfunction) (data pdata) (destroy pfunction)) + +(defcallback cb-search-position-func :boolean + ((tree-view pobject) (search-dialog pobject) (data pdata)) + (funcall data tree-view search-dialog)) + +(defgeneric (setf search-position-func) (func tree-view &key data destroy-notify) + (:method (func (tree-view tree-view) &key data destroy-notify) + (set-callback tree-view gtk-tree-view-set-search-position-func + cb-search-position-func func data destroy-notify))) + +(defcfun gtk-tree-view-set-row-separator-func :int + (tree-view pobject) + (func pfunction) (data pdata) (destroy pfunction)) + +(defcallback cb-row-separator-func :boolean + ((tree-view pobject) (tree-iter (struct tree-iter)) (data pdata)) + (funcall data tree-view tree-iter)) + +(defgeneric (setf row-separator-func) (func tree-view &key data destroy-notify) + (:method (func (tree-view tree-view) &key data destroy-notify) + (set-callback tree-view gtk-tree-view-set-row-separator-func + cb-row-separator-func func data destroy-notify))) + +(defcfun gtk-tree-view-set-tooltip-row :void + (tree-view pobject) (tooltip pobject) (tree-path tree-path)) + +(defgeneric (setf tooltip-row) (value tree-view tooltip) + (:method (value (tree-view tree-view) tooltip) + (gtk-tree-view-set-tooltip-row tree-view tooltip value))) + +(defcfun gtk-tree-view-set-tooltip-cell :void + (tree-view pobject) (tooltip pobject) (tree-path tree-path) (column pobject) + (cell pobject)) + +(defgeneric (setf tooltip-cell) (value tree-view tooltip) + (:method (value (tree-view tree-view) tooltip) + (destructuring-bind (path column cell) value + (gtk-tree-view-set-tooltip-cell tree-view tooltip path column cell)))) + +(defcfun gtk-tree-view-get-tooltip-context :boolean + (tree-view pobject) (ptr-x :pointer) (ptr-y :pointer) (keyboard-tip :boolean) + (model :pointer) (path :pointer) (tree-iter (struct tree-iter :out t))) + +(defgeneric tooltip-context (tree-view ptr-x ptr-y keyboard-tip) + (:method ((tree-view tree-view) ptr-x ptr-y keyboard-tip) + (let ((tree-iter (make-instance 'tree-iter))) + (multiple-value-bind (res model path) + (with-foreign-outs ((model 'pobject) (path 'pobject)) :return + (gtk-tree-view-get-tooltip-context + tree-view ptr-x ptr-y keyboard-tip model path tree-iter)) + (when res (list model path tree-iter)))))) + (init-slots tree-view (on-select) (when on-select (setf (gsignal (selection tree-view) :changed) From rklochkov at common-lisp.net Sat Mar 23 13:15:23 2013 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sat, 23 Mar 2013 06:15:23 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/gi In directory tiger.common-lisp.net:/tmp/cvs-serv6982/gi Added Files: arg-info.lisp base-info.lisp callable-info.lisp constant-info.lisp enum-info.lisp field-info.lisp function-info.lisp gi-cffi.asd interface-info.lisp loadlib.lisp object-info.lisp package.lisp property-info.lisp registered-type-info.lisp repository.lisp signal-info.lisp struct-info.lisp type-info.lisp union-info.lisp vfunc-info.lisp Log Message: Preliminary support of g-object-introspection --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/arg-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/arg-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass arg-info (base-info) ()) (defcenum transfer :nothing :container :everything) (defcenum direction :in :out :inout) (defcenum scope-type :invalid :call :async :notified) (deffuns arg-info (:get direction direction) (is-caller-allocates :boolean) (is-return-value :boolean) (is-optional :boolean) (may-be-null :boolean) (:get ownership-transfer transfer) (:get scope scope-type) (:get closure :int) (:get destroy :int) (get-type (object type-info))) (defmethod free-ptr ((type (eql 'arg-info)) ptr) (g-base-info-unref ptr)) (defmethod print-object ((arg-info arg-info) stream) (print-unreadable-object (arg-info stream) (format stream "~a ~a transfer ~a, type ~a" (name arg-info) (direction arg-info) (ownership-transfer arg-info) (get-type arg-info)))) (defun arg->argument (arg &optional value) (cons (get-type arg) value)) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/base-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/base-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass base-info (object) ()) (defcenum info-type :invalid :function :callback :struct :boxed :enum :flags :object :interface :constant :invalid_0 :union :value :signal :vfunc :property :field :arg :type :unresolved) (deffuns base-info (ref :pointer) (unref :void) (get-type info-type) (:get name :string) (:get namespace :string) (is-deprecated :boolean) (:get attribute :string (name :string)) (:get container (object base-info)) ; (:get typelib (object typelib)) ;; useless? ((info-equal . equal) :boolean (info2 pobject))) (defmethod free-ptr ((type (eql 'base-info)) ptr) (g-base-info-unref ptr)) (defmethod print-object ((base-info base-info) stream) (print-unreadable-object (base-info stream) (princ (name base-info) stream))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/callable-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/callable-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass callable-info (base-info) ()) (deffuns callable-info (:get return-type (object type-info)) (:get caller-owns transfer) (may-return-null :boolean) (:get return-attribute :string) (:get n-args :int) (:get arg (object arg-info) (n :int))) (defmethod free-ptr ((type (eql 'callable-info)) ptr) (g-base-info-unref ptr))--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/constant-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/constant-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass constant-info (base-info) ())--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/enum-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/enum-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass enum-info (registered-type-info) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/field-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/field-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass field-info (base-info) ()) (defmethod free-ptr ((type (eql 'field-info)) ptr) (g-base-info-unref ptr))--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/function-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/function-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass function-info (callable-info) ()) (defmethod free-ptr ((type (eql 'function-info)) ptr) (g-base-info-unref ptr)) (defbitfield function-info-flags :method :constructor :getter :setter :wraps-vfunc :throws) (deffuns function-info (get-symbol :string) (:get flags function-info-flags) (:get property (object property-info)) (:get vfunc (object vfunc-info))) (defcfun g-function-info-invoke :boolean (func-info pobject) (in-args arguments) (n-in-args :int) (out-args (arguments :out t)) (n-out-args :int) (return-value (argument :out t)) (g-error pobject)) (defgeneric invoke (func-info &rest args) (:method ((func-info function-info) &rest args) (let (in-args out-args return-value) (dotimes (n-arg (n-args func-info)) (let ((arg (arg func-info n-arg))) (when (member (direction arg) '(:in :inout)) (push (arg->argument arg (nth n-arg args)) in-args)) (when (member (direction arg) '(:out :inout)) (push (arg->argument arg) out-args)))) (setf in-args (nreverse in-args)) (setf out-args (nreverse out-args)) (with-g-error g-error (let ((res (g-function-info-invoke func-info in-args (length in-args) out-args (length out-args) return-value g-error))) (unless res (throw-g-error g-error)) (values-list (cons (arg-value return-value) (mapcar #'arg-value out-args)))))))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/gi-cffi.asd 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/gi-cffi.asd 2013/03/23 13:15:23 1.1 (defpackage #:gi-cffi-system (:use #:cl #:asdf)) (in-package #:gi-cffi-system) (defsystem gi-cffi :description "Interface to GObjectIntrospection via CFFI" :author "Roman Klochkov " :version "0.1" :license "LLGPL" :depends-on (gtk-cffi) :serial t :components ((:file package) (:file loadlib) (:file repository) (:file base-info) (:file constant-info) (:file registered-type-info) (:file struct-info) (:file union-info) (:file enum-info) (:file interface-info) (:file object-info) (:file type-info) (:file arg-info) (:file callable-info) (:file function-info) (:file field-info) (:file property-info) (:file vfunc-info) (:file signal-info)))--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/interface-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/interface-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass interface-info (registered-type-info) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/loadlib.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/loadlib.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (define-foreign-library gi (:unix (:or "libgirepository-1.0.so.1" "libgirepository-1.0.so")) (:windows "libgirepository-win32-1-0.dll")) (use-foreign-library gi)--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/object-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/object-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass object-info (registered-type-info) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/package.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/package.lisp 2013/03/23 13:15:23 1.1 (in-package #:cl-user) (defpackage gi-cffi (:use #:common-lisp #:alexandria #:iterate #:cffi-objects #:g-lib-cffi #:g-object-cffi #:gtk-cffi-utils) (:shadow #:require #:property) (:export #:require #:get-n-infos #:get-info #:ref #:unref #:get-type #:container #:is-deprecated #:namespace #:typelib #:name #:info-equal #:attribute #:ownership-transfer #:destroy #:is-optional #:closure #:get-symbol #:scope #:may-be-null #:flags #:is-return-value #:is-caller-allocates #:direction #:property)) (in-package #:gi-cffi) (g-object-cffi:register-prefix *package* 'g)--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/property-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/property-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass property-info (base-info) ()) (defmethod free-ptr ((type (eql 'property-info)) ptr) (g-base-info-unref ptr))--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/registered-type-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/registered-type-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass registered-type-info (base-info) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/repository.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/repository.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defcenum load-flags (:lazy 1)) (defcfun g-irepository-require :pointer (repo :pointer) (namespace :string) (version :string) (load-flags load-flags) (g-error pobject)) (defun require (namespace &optional (version (null-pointer)) (load-flags :lazy)) (g-lib:with-g-error g-error (let ((res (g-irepository-require (null-pointer) namespace version load-flags g-error))) (if (null-pointer-p res) (throw-g-error g-error) res)))) (defcfun g-irepository-find-by-name :pointer (repo :pointer) (namespace :string) (name :string)) (defcfun g-irepository-find-by-gtype :pointer (repo :pointer) (gtype g-type)) (defcfun g-irepository-get-n-infos :int (repo :pointer) (namespace :string)) (defcfun g-irepository-get-info :pointer (repo :pointer) (namespace :string) (index :int)) (defun get-n-infos (namespace) (g-irepository-get-n-infos (null-pointer) namespace)) (defcfun g-irepository-get-version :string (repo :pointer) (namespace :string)) (defun get-version (namespace) (g-irepository-get-version (null-pointer) namespace)) (defun get-info (&key namespace name gtype index) (let* ((p (cond (name (g-irepository-find-by-name (null-pointer) namespace name)) (gtype (g-irepository-find-by-gtype (null-pointer) gtype)) (index (g-irepository-get-info (null-pointer) namespace index)) (t (error "You should fill one of name+namespace, gtype or index")))) (base (make-instance 'base-info :pointer p))) (case (get-type base) ((:function :callback) (make-instance 'function-info :pointer p)) ((:struct :boxed) (make-instance 'struct-info :pointer p)) ((:enum :flags) (make-instance 'enum-info :pointer p)) (:object (make-instance 'object-info :pointer p)) (:interface (make-instance 'interface-info :pointer p)) (:constant (make-instance 'constant-info :pointer p)) (:union (make-instance 'union-info :pointer p)) (:value (make-instance 'value-info :pointer p)) (:signal (make-instance 'signal-info :pointer p)) (:vfunc (make-instance 'vfunc-info :pointer p)) (:property (make-instance 'property-info :pointer p)) (:field (make-instance 'field-info :pointer p)) (:arg (make-instance 'arg-info :pointer p)) (:type (make-instance 'type-info :pointer p)) (t base)))) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/signal-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/signal-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass signal-info (callable-info) ()) (defmethod free-ptr ((type (eql 'signal-info)) ptr) (g-base-info-unref ptr))--- /project/gtk-cffi/cvsroot/gtk-cffi/gi/struct-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/struct-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defclass struct-info (registered-type-info) ()) --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/type-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/type-info.lisp 2013/03/23 13:15:23 1.1 (in-package #:gi-cffi) (defcenum type-tag :void :boolean :int8 :uint8 :int16 :uint16 :int32 :uint32 :int64 :uint64 :float :double :gtype :utf8 :filename :array :interface :glist :gslist :ghash :error :unichar) (defcenum array-type :c :array :ptr-array :byte-array) (defclass type-info (base-info) ()) (deffuns type-info (is-pointer :boolean) (:get tag type-tag) (:get param-type (object type-info) (n :int)) (:get interface (object base-info)) (get-array-length :int) (:get array-fixed-size :int) (is-zero-terminated :boolean) (:get array-type array-type)) (defmethod free-ptr ((type (eql 'type-info)) ptr) (g-base-info-unref ptr)) (defmethod print-object ((type-info type-info) stream) (print-unreadable-object (type-info stream) (when (is-pointer type-info) (princ "pointer to " stream)) (let ((tag (tag type-info))) (princ tag stream) (when (eq tag :interface) (format stream " to ~a" (interface type-info))) (when (eq tag :array) (format stream " of ~a" (param-type type-info 0)) (format stream ", length: ~a" (get-array-length type-info)) (format stream ", fixed length: ~a" (array-fixed-size type-info)) (when (is-zero-terminated type-info) (princ ", zero terminated" stream))) (when (eq tag :ghash) (format stream " of {~a, ~a}" (param-type type-info 0) (param-type type-info 1)))))) (defcunion giargument (boolean :int) (int8 :int8) (uint8 :uint8) (int16 :int16) (uint16 :uint16) (int32 :int32) (uint32 :uint32) (int64 :int64) (uint64 :uint64) (float :float) (double :double) ; (short :short) ; (ushort :ushort) ; (int :int) ; (uint :uint) ; (long :long) ; (ulong :ulong) ; (ssize :long) (size :ulong) (string :string) (pointer :pointer)) ;;; arg in lisp is (type . value) (defun arg-type (place) (car place)) (defun arg-value (place) (cdr place)) (defun (setf arg-avlue) (value place) (setf (cdr place) value)) (define-foreign-type cffi-giargument (freeable-out) () (:documentation "GIArgument union <-> (cons type-info-expr value)") (:simple-parser argument) (:actual-type :pointer)) (defmethod translate-to-foreign (place (arg cffi-giargument)) (let ((ptr (foreign-alloc 'giargument))) (to-foreign (tag (arg-type place)) place ptr) ptr)) (defmethod translate-from-foreign (ptr (arg cffi-giargument)) (error "GIArgument cannot be returned")) [89 lines skipped] --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/union-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/union-info.lisp 2013/03/23 13:15:23 1.1 [93 lines skipped] --- /project/gtk-cffi/cvsroot/gtk-cffi/gi/vfunc-info.lisp 2013/03/23 13:15:23 NONE +++ /project/gtk-cffi/cvsroot/gtk-cffi/gi/vfunc-info.lisp 2013/03/23 13:15:23 1.1 [100 lines skipped]