X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/584285fba4d518f8d6f581b542ee6b38650ba287..b7c49e0c03879ad0af9fcfd0910357290f32d35a:/glib/gtype.lisp diff --git a/glib/gtype.lisp b/glib/gtype.lisp index 8b41474..747f0a8 100644 --- a/glib/gtype.lisp +++ b/glib/gtype.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtype.lisp,v 1.54 2006-08-16 11:02:46 espen Exp $ +;; $Id: gtype.lisp,v 1.61 2007-02-23 12:53:08 espen Exp $ (in-package "GLIB") @@ -30,7 +30,10 @@ (defbinding type-init () nil) (type-init) -(deftype type-number () 'unsigned-long) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defbinding (bitsize-of-gtype "bitsize_of_gtype") () unsigned-int)) + +(deftype type-number () `(unsigned-byte ,(bitsize-of-gtype))) (deftype gtype () 'symbol) @@ -122,6 +125,9 @@ ((not (zerop type-number)) type-number) (error-p (error "Invalid gtype name: ~A" name))))) +(defun type-from-glib-name (name) + (type-from-number (type-number-from-glib-name name) t)) + (defun register-type (type id) (cond ((find-type-number type)) @@ -151,7 +157,7 @@ *registered-types*) (mapc #'(lambda (type) (apply #'register-new-type type)) - *registered-static-types*) + (reverse *registered-static-types*)) (mapc #'(lambda (type) (register-type-alias (car type) (cdr type))) *registered-type-aliases*)) @@ -205,20 +211,26 @@ (run-program "/usr/bin/nm" #+clisp :arguments - (list "--defined-only" "-D" (namestring (truename pathname))) + (list #-darwin"--defined-only" #-darwin"-D" "-g" #+darwin"-f" + #+darwin"-s" #+darwin"__TEXT" #+darwin"__text" + (namestring (truename pathname))) :output :stream :wait nil))) (unwind-protect (loop - as symbol = (let ((line (read-line - #+(or cmu sbcl) - (process-output process) - #+clisp process - nil))) - (when line - (subseq line (1+ (position #\Space line :from-end t))))) - while symbol + as line = (read-line + #+(or cmu sbcl) (process-output process) + #+clisp process + nil) + as symbol = (when line + (let ((pos (position #\Space line :from-end t))) + #-darwin(subseq line (1+ pos)) + #+darwin + (when (char= (char line (1- pos)) #\T) + (subseq line (+ pos 2))))) + while line when (and - (> (length symbol) 9) + symbol (> (length symbol) 9) + (not (char= (char symbol 0) #\_)) (or (not prefixes) (some #'(lambda (prefix) @@ -359,7 +371,7 @@ ;;;; Superclass for wrapping types in the glib type system (eval-when (:compile-toplevel :load-toplevel :execute) - (defclass ginstance (proxy) + (defclass ginstance (ref-counted-object) (;(class :allocation :alien :type pointer :offset 0) ) (:metaclass proxy-class) @@ -391,12 +403,6 @@ (error "Object at ~A has an unkown type number: ~A" location (%type-number-of-ginstance location))))) -(define-type-method from-alien-form ((type ginstance) form &key (ref :copy)) - (call-next-method type form :ref ref)) - -(define-type-method from-alien-function ((type ginstance) &key (ref :copy)) - (call-next-method type :ref ref)) - ;;;; Registering fundamental types @@ -621,4 +627,4 @@ ;;;; Initialize all non static types in GObject -(init-types-in-library #.(concatenate 'string (pkg-config:pkg-variable "glib-2.0" "libdir") "/libgobject-2.0.so")) +(init-types-in-library #.(concatenate 'string (pkg-config:pkg-variable "glib-2.0" "libdir") "/libgobject-2.0." asdf:*dso-extension*))