X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/d92bb6e7fece0cabaac36ef2bb9888fe05d7c21d..8ac82923ec1f3812c5cd309773d847165949900b:/glib/gtype.lisp?ds=sidebyside diff --git a/glib/gtype.lisp b/glib/gtype.lisp index d412132..5141a37 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.53 2006/04/26 10:29:01 espen Exp $ +;; $Id: gtype.lisp,v 1.60 2007/01/12 10:32:43 espen Exp $ (in-package "GLIB") @@ -122,6 +122,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 +154,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 +208,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) @@ -335,6 +344,7 @@ (register-new-type class-name (class-name super) gtype)))) (type-class-ref type-number) type-number)))) + #+nil (when (and (supertype type-number) (not (eq (class-name super) (supertype type-number)))) @@ -358,7 +368,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) @@ -390,12 +400,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 @@ -505,7 +509,8 @@ ;; The argument is a list where each elements is on the form -;; (type . dependencies) +;; (type . dependencies). This function will not handle indirect +;; dependencies and types depending on them selve. (defun sort-types-topologicaly (unsorted) (flet ((depend-p (type1) (find-if #'(lambda (type2) @@ -619,4 +624,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*))