X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/ae88ce7f338a0eff4ceea7b2041a0d1c8bfa0204..d29a425f2418532e0af66a33c922fa975e39fd3f:/gtk/gtkobject.lisp diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index 8ff2b3c..bd4385f 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.39 2006/09/05 13:23:40 espen Exp $ +;; $Id: gtkobject.lisp,v 1.42 2007/06/06 10:43:54 espen Exp $ (in-package "GTK") @@ -29,9 +29,7 @@ ;;;; Superclass for the gtk class hierarchy (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." asdf:*dso-extension*)) + (init-types-in-library gtk "libgtk-2.0") (defclass %object (gobject) () @@ -170,22 +168,24 @@ 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 @@ -236,4 +236,10 @@ (defun container-child-class (container-class) (gethash container-class *container-to-child-class-mappings*)) -(register-derivable-type 'container "GtkContainer" 'expand-container-type 'gobject-dependencies) +(defun container-dependencies (type options) + (delete-duplicates + (append + (gobject-dependencies type options) + (mapcar #'param-value-type (query-container-class-child-properties type))))) + +(register-derivable-type 'container "GtkContainer" 'expand-container-type 'container-dependencies)