X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/376809b0b0b214c1af07ee37bae74f56e0e1e9a9..c25641cbd75cb2c32a6693d74bccf8eda828d592:/gtk/gtkobject.lisp diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index 59ff02f..0b7623f 100644 --- a/gtk/gtkobject.lisp +++ b/gtk/gtkobject.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: gtkobject.lisp,v 1.37 2006/08/16 12:09:03 espen Exp $ +;; $Id: gtkobject.lisp,v 1.40 2007/03/12 12:59:22 espen Exp $ (in-package "GTK") @@ -31,7 +31,7 @@ (in-package "GTK") (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." asdf:*dso-extension*)) (defclass %object (gobject) () @@ -170,22 +170,24 @@ (defmethod compute-slot-writer-function ((slotd effective-child-slot-definition) value)))) -(defmethod add-reader-method ((class container-child-class) generic-function slot-name) +(defmethod add-reader-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation) (add-method generic-function (make-instance 'standard-method :specializers (list (find-class 'widget)) :lambda-list '(widget) + :documentation (or #?(sbcl>= 1 0 2)slot-documentation "automatically generated reader method") :function #'(lambda (args next-methods) (declare (ignore next-methods)) (child-property-value (first args) slot-name))))) -(defmethod add-writer-method ((class container-child-class) generic-function slot-name) +(defmethod add-writer-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation) (add-method generic-function (make-instance 'standard-method :specializers (list (find-class t) (find-class 'widget)) :lambda-list '(value widget) + :documentation (or #?(sbcl>= 1 0 2)slot-documentation "automatically generated reader method") :function #'(lambda (args next-methods) (declare (ignore next-methods)) (destructuring-bind (value widget) args @@ -233,5 +235,7 @@ (defclass ,child-class (,(default-container-child-name super)) (:metaclass container-child-class) (:container ,class)))))) +(defun container-child-class (container-class) + (gethash container-class *container-to-child-class-mappings*)) (register-derivable-type 'container "GtkContainer" 'expand-container-type 'gobject-dependencies)