[gtk-cffi-cvs] CVS gtk-cffi/gi
CVS User rklochkov
rklochkov at common-lisp.net
Sat Mar 23 13:15:23 UTC 2013
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 <kalimehtar at mail.ru>"
: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]
More information about the gtk-cffi-cvs
mailing list