;; 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")
(%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*)
(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
;; 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")
(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))
;; 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")
;; Manual override
("GtkWidget"
:slots
- ((child-slots
+ ((child-properties
:allocation :instance
- :accessor widget-child-slots
+ :accessor widget-child-properties
:type container-child)
(window
:allocation :virtual
;; 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")
(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))