From 56870989dbc7e351ff54408ee325e1ac3d6c3f5e Mon Sep 17 00:00:00 2001 Message-Id: <56870989dbc7e351ff54408ee325e1ac3d6c3f5e.1714966444.git.mdw@distorted.org.uk> From: Mark Wooding Date: Mon, 3 Jan 2005 16:40:45 +0000 Subject: [PATCH] Small changes Organization: Straylight/Edgeware From: espen --- glib/gobject.lisp | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/glib/gobject.lisp b/glib/gobject.lisp index 01f3998..f1f04d3 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.26 2004-12-29 21:07:46 espen Exp $ +;; $Id: gobject.lisp,v 1.27 2005-01-03 16:40:45 espen Exp $ (in-package "GLIB") @@ -136,18 +136,21 @@ (defmethod initialize-internal-slot-functions ((slotd effective-property-slot-de (defmethod initialize-internal-slot-functions ((slotd effective-user-data-slot-definition)) (let ((slot-name (slot-definition-name slotd))) - (setf - (slot-value slotd 'getter) - #'(lambda (object) - (prog1 (user-data object slot-name)))) - (setf - (slot-value slotd 'setter) - #'(lambda (value object) - (setf (user-data object slot-name) value))) - (setf - (slot-value slotd 'boundp) - #'(lambda (object) - (user-data-p object slot-name)))) + (unless (slot-boundp slotd 'getter) + (setf + (slot-value slotd 'getter) + #'(lambda (object) + (prog1 (user-data object slot-name))))) + (unless (slot-boundp slotd 'setter) + (setf + (slot-value slotd 'setter) + #'(lambda (value object) + (setf (user-data object slot-name) value)))) + (unless (slot-boundp slotd 'boundp) + (setf + (slot-value slotd 'boundp) + #'(lambda (object) + (user-data-p object slot-name))))) (call-next-method)) @@ -380,6 +383,8 @@ (defun slot-definition-from-property (class property &optional args) (member :construct-only flags) (member :writable flags)) (list :initarg (intern (string slot-name) "KEYWORD"))) + ,@(cond + ((find :initarg args) (list :initarg (getf args :initarg)))) :type ,slot-type :documentation ,documentation)))) -- [mdw]