X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/74821f759d3bf3cfdd55aac54a8f0b5bde6289b6..839796c126e325a563260ac711b5bda43adcc764:/glib/gtype.lisp diff --git a/glib/gtype.lisp b/glib/gtype.lisp index 2ad9498..d6b1535 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.52 2006-04-25 22:10:37 espen Exp $ +;; $Id: gtype.lisp,v 1.58 2006-08-31 20:40:56 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,25 @@ (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) (or (not prefixes) (some #'(lambda (prefix) @@ -335,6 +343,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)))) @@ -505,7 +514,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) @@ -614,9 +624,9 @@ (expand-type-definitions prefix args)) (defexport define-types-by-introspection (prefix &rest args) - (list-autoexported-symbols (expand-type-definitions prefix args)))) + (list-autoexported-symbols (expand-type-definitions prefix args))) ;;;; 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*))