;;; -*- mode:lisp; package: graph; base:10.;; Fonts: CPTFONT -*- ;;;

;;;

;;;  This file contains code to implement 


;;; $Log:	/ct/lmcode/graph/utils.l,v $
;;;Revision 1.6  84/08/03  09:26:50  linda
;;;fixed rel5-1 bug
;;;
;;;Revision 1.5  84/07/30  15:13:36  alfred
;;;5.1 bug fix.
;;;
;;;Revision 1.4  84/07/30  14:20:45  alfred
;;;5.1 bug fix.
;;;
;;;Revision 1.2  84/07/06  14:43:50  linda
;;;corrected an apparent typo in with-window-mouse-shape
;;;
;;;Revision 1.1  84/04/25  15:18:16  susan
;;;Initial revision
;;;



;;;  ****************************************************************
;;;  Necessary Loads, Constants, Declarations.
;;;  ****************************************************************

;;;  Seem to use this a lot.
(defconst *pi* 3.14159265358979323)

;;;  The size of circular-blinkers
(defconst *circular-blinker-radius* 8.)

;;  The default magnification
(defconst *default-mag* 10.)

(defconst *line-highlight-width* 6.
  "Width of line used to highlight arcs here and there.")


;;strings used for mouse documentation choices
;;These should correspond to how your :HANDLE-GRAPH-KEYSTROKE method deals
;; with mouse clicks.  These values are just the defaults.
(defconst *over-nothing-doc*
	  '("UNSHIFTED:  L: Make node.            M: Edit view.          R: Graph menu."
	    "CTRL:       L: Make node with name.  M: Refresh screen.     R: Graph menu."
	    "META:       L: Go home.              M: Toggle grid.        R: Graph menu."
	    "SUPER:      L: Inspect form.         M: Delete everything.  R: Graph menu."
	    "HYPER:      L: Save graph.           M: Retrieve graph.     R: Graph menu."))
(defconst *over-node-doc*
	  '("UNSHIFTED:  L: Make arc.             M: Edit node.          R: Node menu."
	    "CTRL:       L: Make arc with name.   M: Move node.          R: Node menu."
	    "META:       L: Swap node with other. M: Delete node.        R: Node menu."
	    "SUPER:      L: Make arc.             M: Edit node.          R: Node menu."
	    "HYPER:      L: Make arc.             M: Edit node.          R: Node menu."))
(defconst *over-arc-doc*
	  '("UNSHIFTED:  L: Add inflection pts.   M: Edit this arc.      R: Arc menu."
	    "CTRL:       L: Beep.                 M: Delete this arc.    R: Arc menu."
	    "META:       L: Beep.                 M: Edit this arc.      R: Arc menu."
	    "SUPER:      L: Beep.                 M: Edit this arc.      R: Arc menu."
	    "HYPER:      L: Beep.                 M: Edit this arc.      R: Arc menu."))
(defconst *over-point-doc*
	  '("UNSHIFTED:  L: Delete this infl pt.  M: Move this infl pt.  R: Beep."
	    "CTRL:       L: Beep.                 M: Beep.               R: Beep."
	    "META:       L: Beep.                 M: Beep.               R: Beep."
	    "SUPER:      L: Beep.                 M: Beep.               R: Beep."
	    "HYPER:      L: Beep.                 M: Beep.               R: Beep."))


;;;   A special to keep around the node being editted.
(defvar *current-node* nil)
(defvar *current-window* nil)

;;;  A special symbol used in the edit attributes facility.
(defvar *zmacs-edit* nil)

(defflavor editing-window ()
    (tv:tracking-mixin
       zwei:standalone-editor-window
       tv:temporary-window-mixin))

;;;  Keep around just one window for editing, to save time.
(defvar *zmacs-window*
	#-LMI
	(tv:make-window 'editing-window
			':borders #+Symbolics '(tv:draw-gray-border tv:draw-gray-border
						tv:draw-gray-border tv:draw-gray-border)
				  #+LMI '(1 1 1 1)
			':width 600. ':height 400.
			':label "Type the <END> key when done")
	#+LMI ;; this gets an error during loading. figure out why later
	#'(lambda (&rest ignored) nil)
	)

(defflavor trackable-temporary-choose-variable-values-window
	()
	(tv:tracking-mixin
	 tv:temporary-choose-variable-values-window))

;;;  Why not just have one of these windows?  This puts in a restriction
;;; that you can only use this one-at-a-time, but that isn't too onerous.
;;; It saves the trouble of having to make new ones, and set the font
;;; maps each time.  You can't just supply a :FONT-MAP init option to
;;; make-window, since the :after :init method munges the filemap
;;; based on the xxx-font init options.
(defvar *cvv-window*
	(tv:make-window 'trackable-temporary-choose-variable-values-window
			':borders '(tv:draw-gray-border tv:draw-gray-border
				    tv:draw-gray-border tv:draw-gray-border)
			':superior tv:mouse-sheet
			':string-font fonts:tr12i
			':name-font fonts:tr12
			':value-font fonts:tr12b
			':unselected-choice-font fonts:tr10
			':selected-choice-font fonts:tr10b))

(defvar *drawing-inhibited* nil
  "Bind to T to prevent draw messages.")

(defvar *mouse-documented* nil
  "Bind to T if you have specific mouse documentation that should not be
   overridden.")



;;;  ****************************************************************
;;;  Internal Macros, Structure Definitions, FLAVOR definitions.
;;;  ****************************************************************

;;;  Computes integer distance between two points
(defmacro dist (x1 y1 x2 y2)
  `(isqrt (+ (sq (- ,x2 ,x1)) (sq (- ,y2 ,y1)))))

(defflavor editable-attributes-mixin
	()
	()
  (:required-instance-variables drawn-p))

;;square of a number
(defmacro sq (x) `(* ,x ,x))


;;;  ****************
;;;  to inhibit drawing
;;;  ****************

(defwrapper (editable-attributes-mixin :draw)
	    (() . body)
  `(unless *drawing-inhibited*
     ,@body))

(defwrapper (editable-attributes-mixin :erase)
	    (() . body)
  `(unless *drawing-inhibited*
     ,@body))

(defmacro with-drawing-inhibited (&body body)
  `(let ((*drawing-inhibited* t))
     ,@body))


;;;  The following three macros were installed because we decided to make
;;; shape a component of the node or arc.  The shape message is of type
;;; ':CASE, which means it dispatches on a sub-operation, which happens
;;; to be the shape of the object.  These macros make it easy to send
;;; messages, since they ask the object for its shape for you.
(defmacro draw (object)
    `(send ,object ':draw (send ,object ':shape)))

(defmacro erase (object)
    `(send ,object ':erase (send ,object ':shape)))

(defun periphery-point (object remote-x remote-y &optional delta headp)
    (send object ':periphery-point (send object ':shape)
	   remote-x remote-y delta headp))


;;;  This is a total kludge.  The old definition didn't work because
;;; the normal who-line documentation definitions don't work correctly
;;; when the mouse is grabbed.
(defmacro with-mouse-documentation (window string-list &body body)
  `(let ((old-doc (send ,window ':mouse-documentation)))
     (let-globally ((tv:mouse-window ,window)
		    (*mouse-documented* t))
       (unwind-protect				
	 (progn (send ,window ':set-mouse-documentation ,string-list)
		,@body)
	 (send ,window ':set-mouse-documentation old-doc)
	 ))))

;;;  A simple way to flash an arc or node.
(defmacro with-object-flashing (object &body body)
  `(unwind-protect (progn (send ,object ':flash t)
			  ,@body)
		   (send ,object ':flash nil)))


(defmacro with-point-flashing (x y window &body body)
  `(let ((blink (tv:make-blinker ,window 'tv:circular-blinker
				 ':x-pos (send ,window ':translate-x ,x)
				 ':y-pos (send ,window ':translate-y ,y)
				 ':radius *circular-blinker-radius*
				 ':visibility ':blink)))
     (unwind-protect (progn ,@body)
		     (send blink ':set-visibility nil))))



;;;  ****************************************************************
;;;  Internal Code
;;;  ****************************************************************

;;;  What a kludge!!  This started out to be something pretty simple.  It
;;; really still is, but it is straining.  With the EDIT-ATTRIBUTES message,
;;; you can modify any instance variable, as long as it is programmed correctly.
;;;  :Edit-Attributes will not let you modify a pair of instance variables
;;; as a unit.  To get the right editing, put properties on the names of the
;;; instance variables:
;;;
;;; :READ-ONLY       The instance variable value is displayed, but can't be modified.
;;; :DONT-EDIT       The iv is not displayed.
;;; :TYPE            The instance variable can be edited.  The type property should
;;;                  be one of the following:
;;;       :STRING   -- The value can be a string or nil.
;;;       :NUMERIC  -- The value can be a number.
;;;       :EDIT     -- The value is a string edited using ZMACS
;;;       :WIDTH    -- Exclusively for editing width of nodes using mouse.
;;;       :HEIGHT   -- Exclusively for editing height of nodes using mouse.
;;;       :BOOLEAN  -- The value is T or NIL
;;;       (ch1 ch2 ...)  -- The value is one of the choices.
;;; :PRETTY-PRINT    Used when :READ-ONLY to format the IV nicely.
;;;  These properties must be installed with graph-putprop.  See NODE for some
;;; examples.  If you make a new flavor of node or arc, you should use
;;; the flavor name for the secondary-indicator to graph-put.
(defmethod (editable-attributes-mixin :edit-attributes)
	   (&optional (copyable-attributes-only nil))
  (let* ((gensym-list nil)
	 (flavor (typep self))
	 (cvv-label (if copyable-attributes-only
			(format nil "Editing object ~A  AND OTHER OBJECTS"
				(or (send self ':send-if-handles ':label) "<unnamed>"))
			(format nil "Editing object ~A, of flavor ~A"
				(or (send self ':send-if-handles ':label)  "<unnamed>")
				(typep self))))
	 (iv-list (loop for iv in (si:flavor-all-instance-variables
				    (get (typep self) 'si:flavor))
			for gs = (gensym)
			unless (graph-get flavor iv ':dont-edit)
			collect iv and do (set gs (send self (intern iv :keyword)))
			and collect gs into temp-list
			finally (setq gensym-list temp-list)))
	 (menu-list (append (list "Changeable Attributes:")
			    (loop for gensym in gensym-list
				  for iv in iv-list
				  unless (or (and copyable-attributes-only
						  (not (graph-get flavor iv ':copyable)))
					     (graph-get flavor iv ':read-only))
				  collect (generate-menu-item gensym iv flavor))
			    (list "" "Non-changeable Attributes: ")
			    (loop for iv in iv-list
				  if (or (and copyable-attributes-only
					      (not (graph-get flavor iv ':copyable)))
					 (graph-get flavor iv ':read-only))
				  collect
				  (format nil "~A: ~A" (string iv)
					  (let ((fn (graph-get flavor
							       iv ':pretty-print)))
					    (if fn
						(funcall fn (send self (intern iv :keyword)))
						(send self (intern iv :keyword)))))))))
    ;; The catch is here for the ABORT
    ;; menu choice that does a *throw with a value of NIL.
    (when (*catch 'tvcvv
	    ;; Bind up object and window to allow some kludges in editing.
	    (let ((*current-node* self)
		  (*current-window* (send self ':window)))
	      (improved-choose-variable-values menu-list cvv-label)) t)
      ;; Check to see if any of the ':printable instance variables
      ;; have changed. ONLY if one of these changes do we actually erase
      ;; and print.
      (let ((p-i-c (loop for iv in iv-list
			 for gs in gensym-list
			 if (and (graph-get flavor iv ':printable)
				 (not (let ((alphabetic-case-affects-string-comparison t))
					(equal (symeval gs)
					       (send self (intern iv :keyword))))))
			 return t))
	    ;; Collect a list which has T if an instance variable has not
	    ;; changed, or NIL if it has.  We have to do this, because later
	    ;; when we send all the SET- messages, there may be side-effects
	    ;; that cause other instance variables to change, and thus thes
	    ;; saved values that we have in the gensyms will APPEAR to be
	    ;; different.  If we had a kind of "parallel" loop down below,
	    ;; it wouldn't be a problem.
	    (ivs (loop for iv in iv-list
		       for gs in gensym-list
		       collect (equal (symeval gs) (send self (intern iv :keyword))))))
	;; If printable instance changed, clear.
	(if p-i-c (erase self))
	;; Don't draw or erase anything while we munge the instance variables.
	(with-drawing-inhibited
	  (loop for gensym in gensym-list
		for iv in iv-list
		for same in ivs
		unless (or (graph-get flavor iv ':read-only) same)
		do (send self (intern (format nil "SET-~A" iv) :keyword) (symeval gensym))))
	;; If printable instance changed, redraw.
	(if p-i-c (draw self))
	;; Return T to indicate we did edit successfully
	t))))

;;;  Generate the item descriptions for CHOOSE-VARIABLE-VALUES.  Perhaps we
;;; should have used better names, but it is too late now.
(defun generate-menu-item (gensym iv flavor)
  (let ((item-type (graph-get flavor iv ':type)))
    (selectq item-type
      (:numeric
       (list gensym (string iv) ':number))
      (:string
       (list gensym (string iv) ':string-or-nil))
      ;; Note the special care that went into these three options.  They
      ;; are set up so that if you click, the CVV menu goes away for a while
      ;; while some other editing operation happens.
      (:edit
       (list gensym (string iv) ':assoc
	     '(("Click here to use ZMACS to edit this."	. :edit-this-variable))))
      (:height
;       (list gensym (format nil "Current height: ~D." (symeval gensym))
;	     ':assoc '(("Click here to modify with mouse." . :change-the-height))))
       (list gensym "Current height" :positive-number))
      (:width
;       (list gensym (format nil "Current width: ~D." (symeval gensym))
;	     ':assoc '(("Click here to modify with mouse" . :change-the-width))))
       (list gensym "Current width" :positive-number))
      (:boolean
       (list gensym (string iv) ':boolean))
      (otherwise
       (list gensym (string iv) ':choose item-type)))))

;;;  Allows you to edit a string.  Pops up a ZMACS window, allows editing
;;; until the user hits the END key, then returns to the CVV menu.
(defun edit-string (string)
  (send *zmacs-window* ':set-interval-string string)
  (send *zmacs-window* ':expose-near '(:mouse))
  (send *zmacs-window* ':select)
  (send *zmacs-window* ':edit)
  (prog1 (send *zmacs-window* ':interval-string)
	 (send *zmacs-window* ':bury)))

;;;  This is similar to the with-mouse-shape macro in gwindow but uses the current
;;; window instead of self
(defmacro with-window-mouse-shape (shape &body body)
  `(unwind-protect
     (progn
       (send *current-window* ':set-mouse-cursor  ,shape)
       ,@body
       )
     (send *current-window* ':set-mouse-cursor  6.))) ;;; #/ )))



;;;  Edits the width of a node.  You get to hold down the mouse button, and
;;; move the mouse around.  The distance from the center of the node to the
;;; mouse is the new half-width.  A rubber-band rectangle shows the new
;;; containing rectangle for the node.  We use the NODE BLINKER that the window
;;; already knows about, since it is the right type.
(defun edit-width (node)
  (let* ((zoomx (send *current-window* ':zoomx))
	 (zoomy (send *current-window* ':zoomy))
	 (width (// (send node ':width) zoomx))
	 (height (// (send node ':height) zoomy))
	 (x (send *current-window* ':translate-x (send node ':x)))
	 (y (send *current-window* ':translate-y (send node ':y)))
	 (sheet-x nil)
	 (blinker (send *current-window* ':node-blinker)))
    (multiple-value (sheet-x nil)
      (tv:sheet-calculate-offsets *current-window* tv:main-screen))
    ;; Adjust the size and position of the blinker to correspond to the
    ;; node's present size and location.
    (send blinker ':set-size-and-cursorpos
	  width height (- x (// width 2)) (- y (// height 2)))
    (tv:with-mouse-grabbed
      (with-mouse-documentation *current-window*
				'("Hold left button down to change the width")
	(with-window-mouse-shape 5. ;;; #/
	  ;; Turn on the blinker
	  (send blinker ':set-visibility t)
	  ;; Wait for user to hold down left button
	  (loop do (tv:mouse-wait) until (= tv:mouse-last-buttons 1.))
	  ;; Keep updating the size of the blinker until the user
	  ;; lets go of the left button.
	  (loop do (tv:mouse-wait)
		for xx = (abs (- x tv:mouse-x))	;Distance from center of node to mouse.
		do (send blinker ':set-size-and-cursorpos
			 (* xx 2.) height
			 (- x xx) (- y (// height 2)))
		until (= tv:mouse-last-buttons 0.))
	  ;; Turn the blinker back off.
	  (send blinker ':set-visibility nil))))
    (setq width (send blinker ':size))
;;    (let ((*drawing-inhibited* nil))		;Temporarily allow drawing.
;;      (send node ':set-width (* zoomx width)))
    (* zoomx width)))

;;;  Works just like edit-width, above.
(defun edit-height (node)
  (let* ((zoomx (send *current-window* ':zoomx))
	 (zoomy (send *current-window* ':zoomy))
	 (width (// (send node ':width) zoomx))
	 (height (// (send node ':height) zoomy))
	 (x (send *current-window* ':translate-x (send node ':x)))
	 (y (send *current-window* ':translate-y (send node ':y)))
	 (sheet-y nil)
	 (blinker (send *current-window* ':node-blinker)))
    (multiple-value (nil sheet-y)
      (tv:sheet-calculate-offsets *current-window* tv:main-screen))
    ;; Adjust the size and position of the blinker to correspond to the
    ;; node's present size and location.
    (send blinker ':set-size-and-cursorpos
	  width height (- x (// width 2)) (- y (// height 2)))
    (tv:with-mouse-grabbed
      (with-mouse-documentation *current-window*
				'("Hold left button down to change the height")
	(with-window-mouse-shape 4. ;;; #/
	  ;; Turn on the blinker
	  (send blinker ':set-visibility t)
	  ;; Wait for user to hold down left button
	  (loop do (tv:mouse-wait) until (= tv:mouse-last-buttons 1.))
	  ;; Keep updating the size of the blinker until the user
	  ;; lets go of the left button.
	  (loop do (tv:mouse-wait)
		for yy = (abs (- y (- tv:mouse-y sheet-y)))
		do (send blinker ':set-size-and-cursorpos
			 width (* yy 2)
			 (- x (// width 2)) (- y yy))
		until (= tv:mouse-last-buttons 0.))
	  ;; Turn the blinker back off.
	  (send blinker ':set-visibility nil))))
    (multiple-value (nil height)
      (send blinker ':size))
;;    (let ((*drawing-inhibited* nil))		;Temporarily allow drawing.
;;      (send node ':set-height (* zoomy height)))
    (* zoomy height)))

;;;  This function runs each time the user makes some selection in the
;;; Choose-Variable-Values menu.  It checks for specific selections which
;;; indicate some other editing operation should occur.  (See GENERATE-MENU-ITEM
;;; for more details.)
(defun after-choice (window var old new)
  (cond ((eq new ':edit-this-variable)
	 (send window ':bury)
	 (set var (edit-string old))
	 (send window ':select))
	((eq new ':change-the-height)
	 (send window ':bury)
	 (set var (edit-height *current-node*))
	 (send window ':select))
	((eq new ':change-the-width)
	 (send window ':bury)
	 (set var (edit-width *current-node*))
	 (send window ':select))))


;;;  Our version of choose-variable values. It has margin choices including 
;;; ABORT which leaves without
;;; making any changes (does this via *throw).  Finally, this automatically
;;; calls the AFTER-CHOICE function each time the user changes anything.
#+LMI
(defun improved-choose-variable-values (menu-list label)
  (tv:choose-variable-values menu-list :label label :margin-choices
			     '("Make changes" ("ABORT, ignore changes" (*throw 'tvcvv nil)))))

#+Symbolics
(defun improved-choose-variable-values
       (menu-list label)
  (let ((width nil)
	(osw nil)				;old selected window
	(margin-choices
	  ;;  This is a "pre-compiled" version of the margin-choices.  If you look
	  ;; at the code for tv:c-v-v, you will see it does a mapcar over the list
	  ;; users are expected to provide.  Here, we go ahead and supply it, to
	  ;; save time and consing.
	  '(("Make Changes" nil tv:choose-variable-values-choice-box-handler
	     nil nil nil)
	    ("ABORT, ignore changes" nil tv:choose-variable-values-choice-box-handler
	     nil nil (*throw 'tvcvv nil)))))
    
    ;;Make sure all variables are bound, while in caller's environment
    (dolist (elem menu-list)  
      (if (listp elem)  (setq elem (car elem)))
      (cond ((symbolp elem) (symeval elem))
	    ((eq (data-type elem) 'locative) (setq elem (car elem)))	;force compiler
	    ((stringp elem))
	    (t (ferror nil "~s is a ~s bad data type for variable"
		       elem (data-type elem)))))
    
    (funcall *cvv-window* ':setup menu-list label #'after-choice margin-choices)
    (setq width (funcall *cvv-window* ':appropriate-width 10.))
    (funcall *cvv-window* ':adjust-geometry-for-new-variables width)
    (setq osw tv:selected-window)
    (unwind-protect				;
      (let ((iob (funcall *cvv-window* ':io-buffer)))
	(tv:io-buffer-clear iob)
	(tv:delaying-screen-management
	  (tv:expose-window-near *cvv-window* '(:mouse))
	  (funcall *cvv-window* ':select)
	  (send *cvv-window* ':select))		;for who-line
	(let-globally ((tv:mouse-window *cvv-window*))
	  (do () (nil)
	    (process-wait
	      "Do something!!" #'(lambda (iob) (not (tv:io-buffer-empty-p iob))) iob)
	    (and (tv:choose-variable-values-process-message
		   *cvv-window* (funcall *cvv-window* ':any-tyi))
		 (return nil)))))
      (tv:delaying-screen-management
	(funcall *cvv-window* ':deactivate)	;formerly ':Deactivate
	(and osw (funcall osw ':select nil))))))


;;;  Improved way of printing strings.  If the string is nil, print lots
;;; of spaces to make it easy to mouse.
;;; *******
;;;  Fix this redefinition by binding fs:inhibit-fdefine-warnings or something like it.
(defun tv:print-string-or-nil (string stream)
  (if string
       (send stream ':string-out string)
       (send stream ':string-out "      ")))

;;;  Send this to an arc to copy instance variables from another arc.  You can optionally
;;; supply a list of instance variables over which to copy instead of the copyable ones.
(defmethod (editable-attributes-mixin :copy-attributes)
	   (source-object &optional (iv-list nil supplied-p))
  (loop for iv in (if supplied-p
		      iv-list
		      (si:flavor-all-instance-variables (get (typep self) 'si:flavor)))
	if (or supplied-p (graph-get (typep self) iv ':copyable))
	do (send self (intern (format nil "SET-~A" iv) :keyword)
		 (send source-object (intern iv :keyword))))
  (send self ':set-drawn-p nil)
  (draw self))


;;;  Returns a list of instance variables.  The user gets to select them from a multiple
;;; choice menu.
(defmethod (editable-attributes-mixin :select-ivs-for-copying)
	   (&optional (label "Select instance variables:"))
  (let* ((items (loop for iv in (si:flavor-all-instance-variables
				  (get (typep self) 'si:flavor))
		      if (graph-get (typep self) iv ':copyable)
		      collect (cons (format nil "~A, with value ~A"
					    iv (send self (intern iv :keyword)))
				    iv)))
	 (menu (tv:make-window 'tv:multiple-menu
			       ':font-map '(fonts:tr12b fonts:hl12i)
			       ':label label
			       ':item-list items
			       ':highlighted-items items
			       )))
    (send menu ':expose-near '(:mouse))
    (prog1 (send menu ':choose)
	   (send menu ':bury)
	   (send (send self ':window) ':select))))

;;;  ****************************************************************
;;;  Arithmetic Stuff
;;;  ****************************************************************

;;;  I suppose we could have put in a condition handler, but this
;;; seems straitforward enough.
;;;  We need to protect ATAN and ATAN2 from getting bad input.
(defun safe-atan (y x)
  (if (and (zerop y) (zerop x)) 0
      (atan y x)))

(defun safe-atan2 (y x)
  (if (and (zerop y) (zerop x)) 0
      (atan2 y x)))


;;;  ****************************************************************
;;;  Graph versions of putprop and get
;;;  ****************************************************************

;;;  The location of all graph properties.  There must be a better
;;; way to do this simply.  CLEARLY, Lisp needs a primitive for
;;; multiple indexing into a property list, or something like that.
(defvar *graph-properties-list* nil)

(defvar *list-of-three* (list t nil t))

(defun graph-putprop (flavor iv-name value indicator)
  (push value
	(si:flavor-plist (get flavor 'si:flavor)))
  (push (cons iv-name indicator)
	(si:flavor-plist (get flavor 'si:flavor))))

(defun graph-get (flavor iv-name indicator)
  (loop for parent in (si:flavor-depends-on-all (get flavor 'si:flavor))
	do (multiple-value-bind (value not-found)
	       (search-plist iv-name indicator (si:flavor-plist (get parent 'si:flavor)))
	     (unless not-found (return value)))
	finally (return nil)))




;;;  Get a flavor object from an object
;;;(get (typep <obj>) 'si:flavor)


;;;  Searches a flavor property list for one of our special two-indicator
;;;properties.  Does this without consing.  If not found, returns a second
;;; value of T.
(defun search-plist (ind1 ind2 plist)
  (loop for (indicator value . rest) on plist by 'cddr
	if (and (not (atom indicator))		;kludge since CONSP not present.
		(eq ind1 (car indicator))
		(eq ind2 (cdr indicator)))
	return value
	finally (return (values nil t))))