;;; -*- Mode:LISP; Package:USER; Base:10 -*-

(defflavor object
	 (name status)
	 ()
  :inittable-instance-variables
  :gettable-instance-variables)

(defmethod (object :activate)()
  (setq status 'active))

(defmethod (object :deactivate)()
  (setq status 'inactive))

(defmethod (object :ignore)())

(defvar objlist nil)

(defun foo(n s)
  (let((x (make-instance 'object
			 :name n
			 :status s)))
    (push x objlist)))

(defun test()
  (setq objlist nil)
  (foo 'hi 'active)
  (foo 'thing 'inactive)
  (foo 'another 'active))

(defun status-choose()
  (let*((itemlist
	 (mapcar #'(lambda(obj)
		     (cons obj (list (write-to-string (send obj :name))
				     (if (eq (send obj :status)
					     'active)
					 '((:activate t) :deactivate)
				       '(:activate (:deactivate t))))))
		 objlist))
       (resultlist
	 (tv:multiple-choose "object-status" itemlist
;;;use copy-tree to avoid access violation in 2.0
			     (copy-tree
			       '((:activate "Active" nil t t nil)
			       (:deactivate "Inactive" nil t t nil))))))
    (dolist (ans resultlist)
      (send (car ans) (cadr ans))
      (describe (car ans)))))

;(defun status-choose()
;  (let*((itemlist
;	  (copy-list(mapcar #'(lambda(obj)
;				(list (write-to-string (send obj :name))
;				      (write-to-string (send obj :name))
;				      (if (eq (send obj :status)
;					      'active)
;					  '((:activate t) :deactivate)
;					'(:activate (:deactivate t)))))
;				objlist)))
;	  (resultlist
;	    (tv:multiple-choose "object-status" itemlist
;				(copy-tree '((:activate "Active" nil t nil nil)
;					     (:deactivate "Inactive" nil t nil nil))))))
;	(pprint resultlist)
;	(loop for obj in objlist
;	      for ans in resultlist
;	      do
;	      (if (not(string-equal
;			(write-to-string (send obj :name))
;			(car ans)))
;		  (format t "~&Error, out of sequence ~s ~s"
;			  obj ans)
;		(progn
;		  (send obj (or (cadr ans) :ignore))
;		  (describe obj))))))