From 735a29da709fc1701f77f0c051abde6043532ab3 Mon Sep 17 00:00:00 2001 From: espen Date: Fri, 11 Mar 2005 10:56:56 +0000 Subject: [PATCH] Fix to avoid having to rely on internal _get_type functions --- gdk/gdktypes.lisp | 4 ++-- glib/gboxed.lisp | 4 ++-- glib/ginterface.lisp | 15 +++++++++------ glib/gobject.lisp | 17 +++++++++-------- glib/gtype.lisp | 22 +++++++++++++--------- gtk/gtkobject.lisp | 4 ++-- 6 files changed, 37 insertions(+), 29 deletions(-) diff --git a/gdk/gdktypes.lisp b/gdk/gdktypes.lisp index 6cfbc7f..1168b55 100644 --- a/gdk/gdktypes.lisp +++ b/gdk/gdktypes.lisp @@ -15,14 +15,14 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gdktypes.lisp,v 1.16 2005-03-06 17:26:22 espen Exp $ +;; $Id: gdktypes.lisp,v 1.17 2005-03-11 10:56:56 espen Exp $ (in-package "GDK") (eval-when (:compile-toplevel :load-toplevel :execute) (init-types-in-library #.(concatenate 'string (pkg-config:pkg-variable "gtk+-2.0" "libdir") - "/libgdk-x11-2.0.so") :prefix ("gdk_" "_gdk_")) + "/libgdk-x11-2.0.so") :prefix "gdk_") (init-types-in-library #.(concatenate 'string (pkg-config:pkg-variable "gtk+-2.0" "libdir") "/libgdk_pixbuf-2.0.so") :prefix "gdk_")) diff --git a/glib/gboxed.lisp b/glib/gboxed.lisp index 1bb152b..8e621aa 100644 --- a/glib/gboxed.lisp +++ b/glib/gboxed.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gboxed.lisp,v 1.17 2005-03-06 17:26:23 espen Exp $ +;; $Id: gboxed.lisp,v 1.18 2005-03-11 10:56:58 espen Exp $ (in-package "GLIB") @@ -72,7 +72,7 @@ ,(unless forward-p slots) (:metaclass boxed-class) - (:gtype ,(find-type-init-function type-number)))) + (:gtype ,(register-type-as type-number)))) (register-derivable-type 'boxed "GBoxed" 'expand-boxed-type) diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp index b9a42b5..64cc0b6 100644 --- a/glib/ginterface.lisp +++ b/glib/ginterface.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: ginterface.lisp,v 1.9 2005-03-06 17:26:23 espen Exp $ +;; $Id: ginterface.lisp,v 1.10 2005-03-11 10:56:58 espen Exp $ (in-package "GLIB") @@ -56,10 +56,13 @@ (defmethod shared-initialize ((class ginterface-class) names &key name gtype) (declare (ignore names)) - (let ((class-name (or name (class-name class)))) - (unless (find-type-number class-name) - (register-type class-name - (or (first gtype) (default-type-init-name class-name))))) + (let* ((class-name (or name (class-name class))) + (type-number + (or + (find-type-number class-name) + (register-type class-name + (or (first gtype) (default-type-init-name class-name)))))) + (type-default-interface-ref type-number)) (call-next-method)) @@ -142,7 +145,7 @@ ,(unless forward-p (slot-definitions class (query-object-interface-properties type) slots)) (:metaclass ginterface-class) - (:gtype ,(find-type-init-function type))))) + (:gtype ,(register-type-as type))))) (defun ginterface-dependencies (type) (delete-duplicates diff --git a/glib/gobject.lisp b/glib/gobject.lisp index 5b5bf4e..f354992 100644 --- a/glib/gobject.lisp +++ b/glib/gobject.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gobject.lisp,v 1.34 2005-03-06 17:26:23 espen Exp $ +;; $Id: gobject.lisp,v 1.35 2005-03-11 10:56:58 espen Exp $ (in-package "GLIB") @@ -332,7 +332,7 @@ (nreverse properties)))) (defun query-object-class-properties (type &optional inherited-p) - (let* ((type-number (find-type-number type)) + (let* ((type-number (find-type-number type t)) (class (type-class-ref type-number))) (unwind-protect (multiple-value-bind (array length) @@ -364,8 +364,9 @@ `(,slot-name :allocation :property :pname ,name - ,@(cond - ((find :unbound args) (list :unbound (getf args :unbound)))) + ,@(when (find :unbound args) (list :unbound (getf args :unbound))) + ,@(when (find :getter args) (list :getter (getf args :getter))) + ,@(when (find :setter args) (list :setter (getf args :setter))) ;; accessors ,@(cond @@ -427,10 +428,10 @@ (class (type-from-number type)) (slots (getf options :slots))) `(defclass ,class ,supers - ,(unless forward-p - (slot-definitions class (query-object-class-properties type) slots)) - (:metaclass ,metaclass) - (:gtype ,(find-type-init-function type))))) + ,(unless forward-p + (slot-definitions class (query-object-class-properties type) slots)) + (:metaclass ,metaclass) + (:gtype ,(register-type-as type))))) (defun gobject-dependencies (type) (delete-duplicates diff --git a/glib/gtype.lisp b/glib/gtype.lisp index 33c8baf..766af01 100644 --- a/glib/gtype.lisp +++ b/glib/gtype.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtype.lisp,v 1.27 2005-03-06 17:26:23 espen Exp $ +;; $Id: gtype.lisp,v 1.28 2005-03-11 10:56:58 espen Exp $ (in-package "GLIB") @@ -201,7 +201,7 @@ (process-close process))))) -(defmacro init-types-in-library (filename &key (prefix "") ignore) +(defmacro init-types-in-library (filename &key prefix ignore) (let ((names (%find-types-in-library filename prefix ignore))) `(progn ,@(mapcar #'(lambda (name) @@ -212,12 +212,16 @@ names)))) (defun find-type-init-function (type-number) - (or - (loop - for type-init in *type-initializers* - when (= type-number (funcall type-init)) - do (return type-init)) - (error "Can't find init function for type number ~D" type-number))) + (loop + for type-init in *type-initializers* + when (= type-number (funcall type-init)) + do (return type-init))) + +(defun register-type-as (type-number) + (or + (find-type-init-function type-number) + (find-foreign-type-name type-number) + (error "Unknown type-number: ~A" type-number))) (defun default-type-init-name (type) (find-symbol (format nil "~A_~A_get_type" @@ -442,7 +446,7 @@ (let ((name (find-foreign-type-name type-number))) (register-type (getf (type-options type-number) :type (default-type-name name)) - (find-type-init-function type-number)))) + (register-type-as type-number)))) (let ((sorted-type-list (%sort-types-topologicaly type-list))) `(progn diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index d759227..6da0c48 100644 --- a/gtk/gtkobject.lisp +++ b/gtk/gtkobject.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtkobject.lisp,v 1.24 2005-03-06 17:26:23 espen Exp $ +;; $Id: gtkobject.lisp,v 1.25 2005-03-11 10:58:41 espen Exp $ (in-package "GTK") @@ -36,7 +36,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (init-types-in-library #.(concatenate 'string (pkg-config:pkg-variable "gtk+-2.0" "libdir") - "/libgtk-x11-2.0.so")) + "/libgtk-x11-2.0.so") :prefix "gtk_") (defclass %object (gobject) () -- 2.11.0