;;; -*- Mode:LISP; Package:USER; Fonts:(MEDFNT MEDFNB); Readtable:CL; Base:10 -*-

1;;; DEFOBEDIT.LISP*

;;; Author: Keith Corbett, 6/23/87.  Copyright GigaMOS Systems Inc., 1987

1;;; Provide an ObjectLISP interfac*e1 to TV:CHOOSE-VARIABLE-VALUES, the* 1window
;;; system popup menu for editing with a variable list.  See the window
;;; system* 1manual for documentation on variable types, etc.*

;;; Following are the steps required to use an editable object, with example code at
;;; each step.

;;; 1. To make an object class editable, you must DEFKIND it (or a class from which
;;; it inherits) as an EDITABLE-THING.

;;;    (defkind foothing other-things editable-thing)
;;;    (definstancevars foothing (name "<unnamed>") foo-p)

;;; 2. Each editable class is defined with its own class variable, EDITLIST, which is
;;; its contributing portion of the choose-variable-values 'alist'.  Each element of
;;; the EDITLIST is either a variable name or a sublist which has the form:

;;;     (<varname> <string label> <type> <args...>

;;; The class or instance binding of EDITLABEL will appear as the menu label.

;;;     (defclassvars foothing
;;;         (editlist '((name "Name" :string)
;;;   		        (foo-p "Is this a foo?" :choose (t nil))))
;;;         (editlabel "Edit this FOO object"))

;;; The EDITLABEL can also be specified for an instance by supplying the keyword
;;; argument :LABEL to ONEOF or EXIST.

;;; 3. Each class which has an EDITLIST must also define its own obfun which makes it
;;; EDITABLE; to do this, call DEFOBEDIT on the class name.

;;;    (defobedit foothing)

;;; 4. To edit an instance of the class (it must first 'exist') call the obfun EDIT.
;;; EDIT returns T if the user proceeded through the menu; two values, NIL and
;;; :ABORT, are returned if the menu was aborted.

;;;    (ask (setq foo (oneof foothing)) (edit))

;;; 5. Each instance possesses its own EDIT-FUNC, an instance variable which is the
;;; object-specific function which EDIT calls.  The advantage of this redundancy is
;;; that each instance can manipulate its own EDITLIST, which for an instance is the
;;; accumulated total EDITLIST of each editable class it has inherited from.
;;; Since the EDITLIST is inherited from each class, duplicate EQUAL elements are
;;; removed from the end, but watch out for multiple (redundant) inheritances, since
;;; the edit list might not be what you want, and surgery could be required.

;;;    (ask foo (have 'stuff nil))
;;;    (ask foo (push '(stuff "More stuff" :sexp) editlist))
;;;    (ask foo (edit))


(in-package 'user)

(eval-when(eval compile)
  (unintern 'editable-thing))

(defkind editable-thing)

(defclassvars editable-thing
  editlist editlabel)

(definstancevars editable-thing
  (edit-func #'identity))

(defobfun editable ()() nil)

(defobfun (editable-label editable-thing) ()
  (string-append "Edit "
		 class-name
		 " class object"))

(defobfun (editable editable-thing) (&optional edit)
  (have 'editlist
	(remove-duplicates edit
			   :key #'zl:car-safe
			   :test #'(lambda(x y)
				     (and x y
					  (eq x y)))
			   :from-end nil))
  editlist)

(defmacro defobedit(class)
  "Setup CLASS, an EDITABLE-THING, for editing objects
via TV:CHOOSE-VARIABLE-VALUES.  Defines EDITABLE which rolls up
the class EDITLIST variable(s) for the instance."
  `(defobfun(editable ,class)(&optional edit)
     (funcall #'shadowed-editable (append (ask ,class editlist) edit))))

(defobfun (editfunc editable-thing) ()
  (let((vars (remove nil (mapcar #'car-safe (ask (current-obj) editlist))))
       (func (intern(gensym))))
    (eval
      `(defobfun (,func editable-thing) ()
	 (let(,@(mapcar #'list vars vars))
	   (declare(special ,@vars))
	   (catch 'abort
	     (tv:choose-variable-values
	       ',editlist
	       :label editlabel
	       :margin-choices '("Continue"
				 ("Abort" (throw 'abort (values nil :abort))))
	       )
	     ,@(mapcar #'(lambda (var val)
			   (list 'ask '(current-obj)
				 (list 'have
				       (list 'quote var)
				       val)))
		       vars vars)
	     t))))
    (have 'edit-func func)
    func))

(defobfun (exist editable-thing) (&rest args &key label &allow-other-keys)
  (apply #'shadowed-exist args)
  (editable)
  (have 'editlabel
	(or label editlabel (editable-label)))
  (editfunc))

(defobfun (edit editable-thing) ()
  (funcall edit-func))

;;; Display-only variable type

;;; You can specify a variable name in the editlist as type :DISPLAY-ONLY to display
;;; it but prevent it from being edited

(defprop :display-only
	 (princ nil nil nil nil
		"Display only; value cannot be changed")
  tv:choose-variable-values-keyword)