From c289d0845a6b7307eab27e92590a03daf200f7c8 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Mon, 20 Dec 2004 20:09:53 +0000 Subject: [PATCH] Renamed CHILD-SLOTS to CHILD-PROPERTIES Organization: Straylight/Edgeware From: espen --- gtk/gtkcontainer.lisp | 6 +++--- gtk/gtkobject.lisp | 26 ++++++++++++-------------- gtk/gtktypes.lisp | 6 +++--- gtk/gtkwidget.lisp | 20 ++++++++++---------- 4 files changed, 28 insertions(+), 30 deletions(-) diff --git a/gtk/gtkcontainer.lisp b/gtk/gtkcontainer.lisp index 29a4316..24de83d 100644 --- a/gtk/gtkcontainer.lisp +++ b/gtk/gtkcontainer.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: gtkcontainer.lisp,v 1.13 2004-12-17 00:15:16 espen Exp $ +;; $Id: gtkcontainer.lisp,v 1.14 2004-12-20 20:09:54 espen Exp $ (in-package "GTK") @@ -38,7 +38,7 @@ (defmethod container-add ((container container) (widget widget) &rest args) (%container-add container widget) (when args (setf - (slot-value widget 'child-slots) + (slot-value widget 'child-properties) (apply #'make-instance (gethash (class-of container) *container-to-child-class-mappings*) @@ -51,7 +51,7 @@ (defbinding %container-remove () nil (defmethod container-remove ((container container) (widget widget)) (%container-remove container widget) - (slot-makunbound widget 'child-slots)) + (slot-makunbound widget 'child-properties)) (defbinding %container-child-get-property () nil diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index e0fb99e..eb6cdb2 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.20 2004-12-17 00:21:34 espen Exp $ +;; $Id: gtkobject.lisp,v 1.21 2004-12-20 20:09:53 espen Exp $ (in-package "GTK") @@ -162,25 +162,23 @@ (defmethod pcl::add-reader-method ((class child-class) generic-function slot-nam (add-method generic-function (make-instance 'standard-method - :specializers (list (find-class 'widget)) - :lambda-list '(widget) - :function #'(lambda (args next-methods) - (declare (ignore next-methods)) - (child-slot-value (first args) slot-name))))) + :specializers (list (find-class 'widget)) + :lambda-list '(widget) + :function #'(lambda (args next-methods) + (declare (ignore next-methods)) + (child-property-value (first args) slot-name))))) (defmethod pcl::add-writer-method ((class child-class) generic-function slot-name) (add-method generic-function (make-instance 'standard-method - :specializers (list (find-class t) (find-class 'widget)) - :lambda-list '(value widget) - :function #'(lambda (args next-methods) - (declare (ignore next-methods)) - (destructuring-bind (value widget) args - (setf - (child-slot-value widget slot-name) - value)))))) + :specializers (list (find-class t) (find-class 'widget)) + :lambda-list '(value widget) + :function #'(lambda (args next-methods) + (declare (ignore next-methods)) + (destructuring-bind (value widget) args + (setf (child-property-value widget slot-name) value)))))) (defmethod validate-superclass ((class child-class) (super pcl::standard-class)) diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index 3e068f7..a1d4b25 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.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: gtktypes.lisp,v 1.23 2004-12-20 20:00:07 espen Exp $ +;; $Id: gtktypes.lisp,v 1.24 2004-12-20 20:09:53 espen Exp $ (in-package "GTK") @@ -139,9 +139,9 @@ (define-types-by-introspection "Gtk" ;; Manual override ("GtkWidget" :slots - ((child-slots + ((child-properties :allocation :instance - :accessor widget-child-slots + :accessor widget-child-properties :type container-child) (window :allocation :virtual diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index def5569..0320921 100644 --- a/gtk/gtkwidget.lisp +++ b/gtk/gtkwidget.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: gtkwidget.lisp,v 1.12 2004-12-20 00:53:48 espen Exp $ +;; $Id: gtkwidget.lisp,v 1.13 2004-12-20 20:09:53 espen Exp $ (in-package "GTK") @@ -40,24 +40,24 @@ (defmethod shared-initialize :after ((widget widget) names &rest initargs (defmethod slot-unbound ((class gobject-class) (object widget) slot) (cond - ((and (eq slot 'child-slots) (slot-value object 'parent)) - (with-slots (parent child-slots) object + ((and (eq slot 'child-properties) (slot-value object 'parent)) + (with-slots (parent child-properties) object (setf - child-slots + child-properties (make-instance (gethash (class-of parent) *container-to-child-class-mappings*) :parent parent :child object)))) (t (call-next-method)))) -(defun child-slot-value (widget slot) - (slot-value (widget-child-slots widget) slot)) +(defun child-property-value (widget slot) + (slot-value (widget-child-properties widget) slot)) -(defun (setf child-slot-value) (value widget slot) - (setf (slot-value (widget-child-slots widget) slot) value)) +(defun (setf child-property-value) (value widget slot) + (setf (slot-value (widget-child-properties widget) slot) value)) -(defmacro with-child-slots (slots widget &body body) - `(with-slots ,slots (widget-child-slots ,widget) +(defmacro with-child-properties (slots widget &body body) + `(with-slots ,slots (widget-child-properties ,widget) ,@body)) -- [mdw]