Re: initialize-instance

[David C. Martin <dcmartin%postgres.Berkeley.EDU@Berkeley.EDU>]

Richard's answer is correct, but I find it a little bit annoying to have
the init-plist as my argument.  What I have done is define a method on OBJECT
which is called new-instance.  The method defined on OBJECT does nothing, but
will be called *after* the initialize method is called.

The order of function is then initialize, initialize-from-defaults,
initialize-from-init-plist and then new-instance.  For example:

(defclass foo (object)
  ((a :initform 10 :type integer :accessor foo-a)
   (b :initform 20 :type integer :accessor foo-b)
   (c :initform 30 :type integer :accessor foo-c))
  (:constructor make-foo))

(defmethod new-instance ((self foo)
			 &key
			 (a nil ap)
			 (b nil bp)
			 (c nil cp)
			 (all nil allp)
			 &allow-other-keys)
  "Initialize a new-instance of the foo class"
  (when (and allp (integerp all))
	(setf (slot-value self 'a) all)
	(setf (slot-value self 'b) all)
	(setf (slot-value self 'c) all)))

This functionality makes it easy to define any additional initialization
on the instances.  The code is at the end of the file (I use a different
initialize-from-init-plist function since the original did not allow you
to specify keywords which didn't correspond to slots - Gregor, is this 
still true?)

Hope this helps.

dcm
--------

(in-package 'pcl :use '(lisp))

;;;
;;; Top-level new-instance function
;;;
(defmethod new-instance ((self object)
			 &key
			 (ignore nil)
			 &allow-other-keys)
  ;; do nothing
  (declare (ignore self ignore)))

;;;
;;; initialize-from-arg-list
;;;
(defmethod initialize-from-arg-list ((self object) arg-list)
  (if (not (null arg-list))
      (let* ((class (class-of self))
	     (instance-slots (class-instance-slots class))
	     (non-instance-slots (class-non-instance-slots class)))
	(macrolet
	 ((find-slotd (keyword)
		      `(or (find-slotd-1 ,keyword instance-slots)
			   (find-slotd-1 ,keyword non-instance-slots)))
	  (find-slotd-1 (keyword slotds)
			`(dolist (slotd ,slotds)
				 (when (eq (slotd-keyword slotd)
					   ,keyword)
				       (return slotd)))))
	 (do* ((keyword-loc arg-list (cdr value-loc))
	       (value-loc (cdr keyword-loc) (cdr keyword-loc))
	       (slotd () ()))
	      (())
	      (cond ((null keyword-loc) (return nil))
		    ((null value-loc)
		     (error "No value supplied for the init-keyword ~S."
			    (car keyword-loc)))
		    ((not (null (setq slotd (find-slotd (car keyword-loc)))))
		     (setf (slot-value self (slotd-name slotd))
			   (car value-loc)))))))))

;;;
;;; Initialize an object
;;;
(defmethod initialize ((self object) arg-list)
  ;; intialize from defaults
  (initialize-from-defaults self)
  ;; use my initialize from argument list
  (initialize-from-arg-list self arg-list)
  ;; call user specifiable new method
  (apply #'new-instance self arg-list)
  ;; return object
  self)