;;; -*- Mode:Common-Lisp; Package:TV; Base:10; Fonts:(CPTFONT HL10B HL12BI HL12B CPTFONTB)Ï1; Ï*Patch-File: T -*-

;Ï1;;                     RESTRICTED RIGHTS LEGEND          Ï*
;Ï1;; Use, duplication, or disclosure by the Government is subject toÏ*
;Ï1;; restrictions as set forth in subdivision (b)(3)(ii) of the Rights inÏ*
;Ï1;; Technical Data and Computer Software clause at 52.227-7013.Ï*
;Ï1;;                   TEXAS INSTRUMENTS INCORPORATED.Ï*
;Ï1;;                            P.O. BOX 149149Ï*
;Ï1;;                         AUSTIN, TEXAS 78714-9149Ï*
;Ï1;;                             MS 2151Ï*
;Ï1;; Copyright (C) 1986,1987, 1988, 1989 Texas Instruments Incorporated. All rights reserved.Ï*

;Ï1; We need graphs to be able to add them as perspectives.Ï*

(DEFVAR Ï4*default-call-graph-depth*Ï* 2
"Ï2The default depth for call graphs.Ï*")

(DEFTYPE Ï4real-compiled-functionÏ* ()
"Ï2This type is true for any sort of compiled function, be it a ucode entry
 or a normal compiled function.Ï*"
  '(OR compiled-function microcode-function))

(DEFUN Ï4the-fefÏ* (x)
"Ï2Given something tries to coerce it into a fef.  If it is a symbol then it tries
 to do clever things to get a fef that denotes it, e.g. its macro function.
 If it's something it knows about, but can't get a fef for it, then it just
 returns X.  If it doesn't know about its type at all then it barfs.
 The types it knows about are:  Symbols, Compiled functions, ucode functions,
 clos methods, clos generic functions and grapher vertices.Ï*"
  (TYPECASE x
    (symbol (IF (FBOUNDP x)
	        (LET ((DEF (fdefinition-safe x t)))
		    (IF (CONSP def)
		        (IF (TYPEP (REST def) 'real-compiled-function)
			    (REST def)
			    x)
			(IF (TYPEP def 'real-compiled-function)
			    def
			    x)))
	       x))
    (compiled-function x)
    (microcode-function x)
    (any-type-of-clos-method (get-fef-from-object x))
    (any-type-of-clos-gf (get-fef-from-object x))
    (vertex x)
    (CONS (IF (EQUAL (FIRST x) 'MACRO)
	      (REST x)
	      x))
    (otherwise (OR (fdefinition-safe x t)
		   (FERROR nil "Ï3~S is not a function.Ï*" x)))))

(DEFVAR Ï4*selected-filters*Ï* nil
"Ï2The list of filter functions currently selected by the user.  This is a useful
 variable to set in your init file so that you prune call graphs quite a bit
 by default.Ï*")

(DEFUN Ï4maybe-filterÏ* (filters fun as child-of window)
"Ï2Is passed a list of filter functions, function (probably a fef) a comparison
 function and the function of which this is a child.  The comparison function
 is the function that was recorded if filters were selected by mousing on a
 function.  This allows filters such as \"same package as this function\". 
 If any of the functions in the list of funtions returns true for the function
 when funcalled as (filter-fun fun as child-of) then the function is filtered
 out.Ï*"
  (DECLARE (optimize (safety 0)))
  (IF filters
      (IF (FUNCALL (FIRST filters) fun as child-of window)
	  nil
	  (maybe-filter (REST filters) fun as child-of window))
      fun))

(DEFVAR Ï4*as-function*Ï* nil
"Ï2A place where a comparison function is stored.  This is the function on which
 the user last right clicked and put up the filter menu.  This allows filters
 like \"same package as this function\" to work.Ï*")

(DEFUN Ï4filter-called-functionsÏ* (functions child-of window)
"Ï2Given the functions (Functions) that are called by Child-Of, filter out all of
 those that should be filtered out according to the user's currently selected
 set of filter functions.Ï*"
  (DECLARE (SPECIAL *as-function* *selected-filters*))
  (IF *selected-filters*
     (REMOVE-IF-NOT
       #'(lambda (fun)
	   (maybe-filter *selected-filters* fun
			 (IF (BOUNDP '*as-function*)
			     *as-function*
			     nil)
			 child-of window))
         functions)
     functions))

(DEFPARAMETER Ï4*function-details-cache*Ï* (MAKE-HASH-TABLE :test #'EQUAL)
"Ï2A hash table that maps functions to the ivars-and-messages-in-method
 data for that function.  This is used to speed up call graphing for non-first
 time graphs.Ï*")

(DEFUN Ï4maybe-cache-function-valuesÏ* (name fef function)
"Ï2Looks in the cache for the function Fef, whose name is Name and if it
 finds values then returns these, otherwise it calls Function on Fef and caches
 the results returning the values of the function as its values.Ï*" 
  (LET ((cache (GETHASH name *function-details-cache*)))
      (IF cache
	  (VALUES-LIST cache)
          (LET ((results
		  (MULTIPLE-VALUE-LIST (FUNCALL function fef))))
	      (SETF (GETHASH name *function-details-cache*)
		    results)
	      (VALUES-LIST results)))))

(DEFUN Ï4caching-ivars-and-messages-in-methodÏ* (fef)
"Ï2Calls ivars-and-messages-in-method on Fef and caches the results as
 appropriate.  Otherwise it's just like a call to
 ivars-and-messages-in-method.Ï*"
  (maybe-cache-function-values
    (FUNCTION-NAME fef) fef 'ivars-and-messages-in-method))

(DEFUN Ï4functions-called-from-interpretted-definition-1Ï* (FUNCTION)
"Ï2Given an interpretted function it grovels over the function and records all
 of the functions and generic functions called.  These are collected in the
 specials *all-functions-called* *all-gfs-called*.Ï*"
  (DECLARE (SPECIAL *all-functions-called* *all-gfs-called*))
  (DECLARE (optimize (safety 0)))
  (TYPECASE function
    (CONS (functions-called-from-interpretted-definition-1 (FIRST function))
	  (functions-called-from-interpretted-definition-1 (REST function)))
    (symbol (IF (FBOUNDP function)
		(IF (generic-function-p-safe function)
		    (PUSHNEW function *all-gfs-called*)
		    (PUSHNEW function *all-functions-called*))
		nil))
    (otherwise nil)))

(DEFUN Ï4functions-called-from-interpretted-definitionÏ* (FUNCTION)
"Ï2Given an interpretted function or the name of an interpretted function it
 returns values as if ivars-and-messages-in-method had been called for
 a fef, i.e. it returns sundry null values for the things it can't figure out
 and values for the functions called and the generic functions called.Ï*"
  (DECLARE (VALUES ignore ignore ignore functions-called
		    generic-functions-called ignore ignore ignore ignore ignore))
  (DECLARE (optimize (safety 0)))
  (LET ((*all-functions-called* nil)
	(*all-gfs-called* nil))
       (DECLARE (SPECIAL *all-functions-called* *all-gfs-called*))
       (functions-called-from-interpretted-definition-1
	 (IF (AND (SYMBOLP function) (FBOUNDP function))
	     (SYMBOL-FUNCTION function)
	     function))
       (VALUES nil nil nil (NREVERSE *all-functions-called*)
	        (NREVERSE *all-gfs-called*) nil nil nil nil nil)))

(DEFUN Ï4caching-functions-called-from-interpretted-definitionÏ* (name)
"Ï2Just like Functions-Called-From-Interpretted-Definition, only the results
 of calling this function are cached.  It returns, amongst a number of null
 values the functions called by Name and the generic functions called by Name.Ï*"
  (DECLARE (VALUES ignore ignore ignore functions-called
		    generic-functions-called ignore ignore ignore ignore ignore))
  (maybe-cache-function-values
    name name
    #'functions-called-from-interpretted-definition))

(DEFUN Ï4get-function-call-dataÏ* (FUNCTION)
"Ï2Is called with a function, which can be either a compiled function, an
 interpretted function or the name of an interpretted fucntion.  It returns
 three values:  the non-generic functions called by Function (including the
 methods related to Function if Function is a generic function), the generic
 functions called by Function and the macros that were expanded in processing
 Function.Ï*"
  (DECLARE (VALUES functions-called-including-methods-for-gfs
		   generic-functions-called macros-expanded))
  (MULTIPLE-VALUE-BIND
    (referenced-ivars referenced-keywords problem referenced-functions
     referenced-generic-functions args returned-values locals
     specials-referenced specials-bound)
      (IF (COMPILED-FUNCTION-P function)
	  (caching-ivars-and-messages-in-method function)
	  (caching-functions-called-from-interpretted-definition function))
    (IGNORE referenced-ivars referenced-keywords problem
     args returned-values locals specials-referenced specials-bound)
    (VALUES (APPEND (IF (generic-function-p-safe function)
			 (generic-function-methods-safe
			   (function-generic-function-safe function))
			 nil)
		     referenced-functions)
	    referenced-generic-functions
	    (MAPCAR #'ucl::first-if-list
		     (IF (AND (FUNCTIONP function)
			       (sys:get-debug-info-struct function))
			 (GETF (sys:dbis-plist
				 (sys:get-debug-info-struct function))
			       :macros-expanded)
			 nil)))))

(DEFUN Ï4functions-calledÏ* (by-function)
"Ï2Returns two values: the functions called by By-Function and a flag which is
 true if By-Function is recursive, i.e. By-Function is in the first value.
 The functions returned have been passed through the function filter, so only
 those functions not excluded by the filter will be returned.  The functions
 returned are returned as fefs where possible.Ï*"
  (DECLARE (VALUES functions-called by-function-is-recursive-p)
	   (SPECIAL *graph-window*))
  (LET ((fef (the-fef by-function)))
       (MULTIPLE-VALUE-BIND
	 (referenced-functions referenced-generic-functions macros)
	   (get-function-call-data fef)
	 (LET ((kids (MAPCAR #'the-fef
			 (APPEND referenced-functions
				  referenced-generic-functions))))
	      (VALUES (filter-called-functions
			(APPEND
			  (REMOVE fef kids)
			  (MAPCAR #'the-fef macros))
			fef *graph-window*)
		      (MEMBER fef kids))))))

(DEFVAR Ï4*graph-calls-print-package*Ï* "Ï3UserÏ*"
"Ï2The default package to bind to during printing when doing a graph calls.Ï*")
(DEFVAR Ï4*printing-bindings*Ï* nil
"Ï2A list of (*special* value) pairs.  bindings to these specials are made
 with these values whilst printing functions in the call grapher.  e.g.
 `((*print-case* :capitalize) (*package* ,(find-package \"TV\")))Ï*")

(DEFUN Ï4function-calls-othersÏ* (name)
"Ï2Is true if the function named by Name calls any other functions.  This allows
 non-terminal functions to be labeled as such.Ï*" 
  (LET ((fef (the-fef name)))
       (MULTIPLE-VALUE-BIND
	 (referenced-functions referenced-generic-functions macros)
	       (get-function-call-data fef)
	 (OR referenced-functions referenced-generic-functions macros))))

(DEFUN Ï4more-kids-indicatorÏ* (kids)
"Ï2Returns a þ or a Ý if there are kids, otherwise the null string.Ï*"
  (LET ((window (IF (TYPEP self 'vertex)
		      (SEND self :window)
		      (IF (TYPEP self 'basic-x-y-scrolling-window)
			 self
			 nil))))
      (IF (AND window kids)
	 (IF (AND (mx-p)
		  (OR (NOT (TYPEP self 'vertex))
		      (NOT (EQUAL fonts:cptfont (SEND self :font)))))
	     (IF (EQUAL :vertical (SEND window :orientation)) "" "Ï3->Ï*")
	     (IF (EQUAL :vertical (SEND window :orientation)) "Ï3þÏ*" "Ï3ÝÏ*"))
	  "")))

(DEFVAR Ï4*fef-print-functions*Ï*
	`(,#'(lambda (name)
	       (IF (CONSP name) (FORMAT t "Ï3~ÃÏ*" name t) (FORMAT t "Ï3~SÏ*" name)))
	  ,#'(lambda (name fef)
	      (PRINC (more-kids-indicator
		       (IF (AND (TYPEP fef 'vertex-node)
				 (vertex-node-vertex fef))
			  (NOT (SEND (vertex-node-vertex fef) :child-edges))
			  (function-calls-others name))))))
"Ï2Functions to call during the displaying of functions in the call grapher.
 the functions are called in sequence in the list each with the NAME of the
 function being displayed and optionally the vertex node.  These functions
 should print what they think is important about the function to
 *standard-output*.  An example of such a function that puts an arrow at
 the end of a display to indicate that there are children could be as follows:
  #'(lambda (name)
     (if (Function-Calls-Others name)Ï*
	Ï2 (if (equal :Vertical (send (send self :Window):Orientation))Ï*
	Ï2     (format t \"þ\")Ï*
	Ï2     (format t \"Ý\"))Ï*
	Ï2 nil))Ï*")

(DEFUN Ï4simple-print-fefÏ* (fef)
"Ï2A simple print function to print fefs.  Fef is actually either a fef or the
 name of a function.  It returns a string that will be displayed for the
 function.  It does this by calling the functions in *Fef-Print-Functions*.Ï*"
  (LET ((*package*
	  (FIND-PACKAGE
	    (STRING-UPCASE
	      (STRING (IF (TYPEP self 'stand-alone-call-grapher)
			 (SEND self :print-package)
			 *graph-calls-print-package*))))))
       (PROGV (MAPCAR #'FIRST *printing-bindings*)
	      (MAPCAR #'SECOND *printing-bindings*)
         (WITH-OUTPUT-TO-STRING (*standard-output*)
	   (LET ((name (FUNCTION-NAME (coerce-to-node fef))))
	       (LOOP for fn in *fef-print-functions* do
		     (IF (> (LENGTH (ARGLIST fn)) 1)
			 (FUNCALL fn name fef)
			 (FUNCALL fn name))))))))

;Ï1-------------------------------------------------------------------------------Ï*

(DEFFLAVOR Ï4function-vertexÏ* () (boxed-filled-vertex)
  (:default-init-plist :box-myself-p nil :fill-myself-p nil)
  (:documentation "Ï3The flavor of grapher vertex to use for functions.Ï*"))

(DEFUN Ï4interpretted-function-pÏ* (FUNCTION)
"Ï2Is true if Function is an interpretted function.Ï*"
  (EQUAL (the-fef function) function))

(DEFVAR Ï4*function-vertex-boxing-selections*Ï*
	`((,#'MACRO-FUNCTION (t nil))
	  (,#'interpretted-function-p (nil t))
	  (,#'(lambda (FUNCTION) (IGNORE function) t) (nil nil)))
"Ï2A list of pairs, each element of which is of the form:
  (<predicate> (<fill-p> <box-p> <dashed-p>))
 The predicate functions are called successively on functions until one of them
 is true.  When a match is found them the second value is used to set the
 filledness, the boxedness and the dashedness of the vertex on the graph.Ï*")

(DEFMETHOD Ï4(function-vertex :after :initÏ*) (IGNORE)
"Ï2Makes sure that each vertex in the graph is set up so that it's box/fill
 status is right.  It does this by searching though the list
 *Function-Vertex-Boxing-Selections* until it gets a match and using the
 values it finds there.Ï*" 
  (LET ((fn (FUNCTION-NAME (coerce-to-node item))))
       (LOOP for (FUNCTION (FILL box dash))
	     in *function-vertex-boxing-selections*
	     when (FUNCALL function fn)
	     do (PROGN (SET-IN-INSTANCE self 'dashed-p dash)
		       (SET-IN-INSTANCE self 'fill-myself-p fill)
		       (SET-IN-INSTANCE self 'box-myself-p box)
		       (RETURN nil)))))

;Ï1-------------------------------------------------------------------------------Ï*

(DEFMETHOD Ï4(function-vertex :print-selfÏ*) (STREAM &rest ignore)
"Ï2Prints out a function vertex.Ï*"
  (CATCH-ERROR
    (FORMAT stream "Ï3#<Function Vertex ~A>Ï*"
	    (FUNCTION-NAME (coerce-to-node item)))
    nil))

(DEFVAR Ï4*graph-calls-item-type-alist*Ï*
  '((:vertex edit-graphed-function
	     "Ï3L: Edit this Function; M: Drag object; Sh-M/M2: Overview; R: Menu of operationsÏ*"
	     ("Ï3Graph this NodeÏ*" :value maybe-graph-function :documentation
	      "Ï3Start a new grapher whose top node is this function.Ï*"
	     )
	     ("Ï3Extend this NodeÏ*" :value grapher-entend-graph
	      :documentation "Ï3Extend the graph below this node.Ï*"
	     )
	     ("Ï3InspectÏ*" :value graph-calls-inspect :documentation
	      "Ï3Inspect this function.Ï*"
	     )
	     ("Ï3EditÏ*" :value edit-graphed-function :documentation
	      "Ï3Edit the source code definition of this function.Ï*"
	     )
	     ("Ï3FilterÏ*" :value select-grapher-filters :documentation
	      "Ï3Select filtration for what functions to show on the graph.Ï*"
	     )
	     ("Ï3VariablesÏ*" :value set-graph-calls-variables :documentation
	      "Ï3Set sundry variables for the call tree grapher.Ï*")))

"Ï2An item type alist for call tree grapher.  To add new right button menu
entries simply add the relevant menu item to the list after the third element of
the list for the relevant item type.Ï*")

(DEFUN Ï4graph-calls-inspectÏ* (FUNCTION)
"Ï2Inspects a fucntion.  This gets called from the call grapher.Ï*"
  (INSPECT function))

(DEFUN Ï4grapher-entend-graphÏ* (FUNCTION window vertex)
"Ï2Extends the graph for the current node.Ï*"
  (IGNORE vertex)
  (extend-graph-for function window))

;Ï1************* --------------------------------------------------Ï*
;Ï1 TAC 07-25-89 - moved up here from a lower position in this file Ï*

(DEFVAR Ï4*graph-calls-orientation*Ï* :horizontal
"Ï2The default orientation for the call grapher.Ï*")

(DEFVAR Ï4*graph-calls-plot-trees-p*Ï* nil
"Ï2The default for whether a new call grapher should plot trees or graphs.Ï*")

(DEFVAR Ï4*grapher-selection-mode*Ï* :existing
"Ï2The default for the way that new graphers are selected.Ï*")
;Ï1---------------------------------------------------------------Ï*

(DEFFLAVOR Ï4stand-alone-call-grapherÏ*
	   ((depth			*default-call-graph-depth*)
	    (print-package		*graph-calls-print-package*)
	    (orientation		*graph-calls-orientation*)
	    (tree-p			*graph-calls-plot-trees-p*)
	    (grapher-selection-mode	*grapher-selection-mode*)
	   )
	   (stand-alone-grapher)
  :gettable-instance-variables
  :settable-instance-variables
  :initable-instance-variables
  (:documentation
    "Ï3A flavor of stand alone grapher that knows about how to plot call graphs.Ï*"))

(DEFVAR Ï4*call-grapher-mouse-r-menu-items*Ï*
  '(("Ï3VariablesÏ*" :value :set-graph-calls-variables :documentation
     "Ï3Set sundry variables for the call tree grapher.Ï*")
    ("Ï3FilterÏ*" :value :select-grapher-filters :documentation
     "Ï3Select filtration for what functions to show on the graph.Ï*")
    ("Ï3Flush CacheÏ*" :value :flush-function-details-cache
     :documentation "Ï3Flush the functions called cache.Ï*"))
"Ï2The menu items that are used for the menu that gets popped up by right
 clicking on the background of the call grapher.Ï*")

(DEFMETHOD Ï4(stand-alone-call-grapher :flush-function-details-cacheÏ*) (x y)
"Ï2Flushes the cache of functions called by other functions.Ï*"
  (IGNORE x y)
  (CLRHASH *function-details-cache*))

(DEFMETHOD Ï4(stand-alone-call-grapher :set-graph-calls-variablesÏ*) (x y)
"Ï2Sets up sundry instance variables of the call grapher for use later on by
 popping up a menu.Ï*"
  (IGNORE x y)
  (assign-using-menu
    ((depth "Ï3DepthÏ*" :fixnum)
     (print-package "Ï3PackageÏ*" :string-or-nil)
     (orientation "Ï3OrientationÏ*" :assoc
		  (LIST (CONS "Ï3HorizontalÏ*" :horizontal)
		       (CONS "Ï3VerticalÏ*"   :vertical)))
     (tree-p "Ï3Tree or Graph plotÏ*" :assoc
	       (LIST (CONS "Ï3TreeÏ*" t) (CONS "Ï3GraphÏ*" nil)))
     (grapher-selection-mode "Ï3Grapher selection mode.Ï*" :assoc
	(LIST (CONS "Ï3Use an existing oneÏ*" :existing)
	     (CONS "Ï3Create a new oneÏ*" :new)
	     (CONS "Ï3AskÏ*" :ask))))
    :label "Ï3Set a grapher variables.Ï*")
  (SEND self :set-graph-behaviour-changed t)
  (SETQ print-package (STRING-UPCASE (STRING print-package))))

;Ï1 TAC 07-26-89 - moved up to here from a lower position in this fileÏ*
(DEFVAR Ï4*filter-items*Ï*
	'(("Ï3Same PackageÏ*" :value same-package :documentation
	   "Ï3Only those functions in the same package as selected functionÏ*")
	  ("Ï3Not Sys:Ï*" :value not-sys-functions :documentation
	   "Ï3Not the functions in the Sys: package.Ï*")
	  ("Ï3No macrosÏ*" :value no-macros :documentation
	   "Ï3Only those functions which are not (macro-function x).Ï*")
	  ("Ï3No Special FormsÏ*" :value no-special-forms :documentation
	   "Ï3Only those functions which are not special-form-p.Ï*")
	  ("Ï3Not called by Sys:Ï*" :value not-called-by-sys-functions :documentation
	   "Ï3Not the functions called by functions in the Sys: package.Ï*")
	  ("Ï3Not called by Lisp:Ï*" :value not-called-by-lisp-functions :documentation
	   "Ï3Not the functions called by functions in the Lisp: package.Ï*")
	  ("Ï3Not called by MacrosÏ*" :value not-called-by-macros :documentation
	   "Ï3Filter out functions that are called by macros, but not the macros themselves.Ï*")
	  ("Ï3Not called by Special FormsÏ*" :value not-called-by-special-forms
	   :documentation
	   "Ï3Filter out functions that are called by special forms, but not the special forms themselves.Ï*")
	  ("Ï3Not called by Interpretted FunctionsÏ*" :value
	   not-called-by-interpretted-functions :documentation
	   "Ï3Filter out functions that are called by interpretted functions, but not the interpretted functions themselves.Ï*")
	  ("Ï3Not % FunctionsÏ*" :value not-%-functions :documentation
	   "Ï3Not any functions that have a \"%\" in their names.Ï*")
	  ("Ï3Not * FunctionsÏ*" :value not-*-functions :documentation
	   "Ï3Not any functions that have a \"*\" in their names.Ï*")
	  ("Ï3Only methods below generic functionsÏ*" :value
	   only-methods-below-generic-functions :documentation
	   "Ï3Only the methods for generic functions, not the functions called by the generic function itself during method selection.Ï*")
	  ("Ï3Not methods below generic functionsÏ*" :value
	   not-methods-below-generic-functions :documentation
	   "Ï3Not the methods for generic functions, but the functions called by the generic function itself during method selection.Ï*")
	  ("Ï3Same source fileÏ*" :value same-source-file :documentation
	   "Ï3Only those functions that are in the same source file as the selected function.Ï*"))
  "Ï2This is a list of menu items that is called when the user wants to select some
 call grapher filter functions.  The items in the list are normal menu items,
 the value of the :value element must be a function with the following contract:
   arglist = (function as-function child-of)
   where Function is the function that we're trying to filter,
   As-Function is a function with which we may be comparing Function.
   This may be nil if there is no such function and is set when the
   user selects filters by right buttoning on a function and filtering
   from the menu or explicitly setting tv:*As-Function*.
   Child-Of is the parent node that called this function, if known (nil for the root node).
   Returned value = true if the Function arg is to be filtered out, nil otherwise.
 The function cannot guarantee that any of its args will be functions.  They
 should always call coerce-to-node if in doubt to make sure that it isn't a
 grapher internal data structure.  This may result in either function or a
 function name, so the filter function should do the righ thing with either. 
 Any of the functions in this list already will serve as examples.Ï*")

(DEFMETHOD Ï4(stand-alone-call-grapher :select-grapher-filtersÏ*) (x y)
"Ï2Pops up a menu of available filter functions and gets the user to select some.
 These are used in future to remove functions from the call graph.Ï*"
  (IGNORE x y)
  (MULTIPLE-VALUE-BIND (choices chose-p)
      (w:multiple-menu-choose *filter-items*
	:label "Ï3Filter GraphingÏ*"
	:highlighted-items
	(REMOVE-IF-NOT
	  #'(lambda (x) (MEMBER (THIRD x) *selected-filters*))
	  *filter-items*))
      (IF chose-p
	  (PROGN (SETQ *selected-filters* choices)
		 (SEND self :set-graph-behaviour-changed t))
	  nil)))

(DEFMETHOD Ï4(stand-alone-call-grapher :mouse-rÏ*) (x y)
"Ï2Is called when the user right clicks on the background of the call grapher.Ï*"
  (IGNORE x y)
  (LET ((choice (w:menu-choose *call-grapher-mouse-r-menu-items*)))
      (IF choice
	 (SEND self choice x y)
	 nil)))

(DEFMETHOD Ï4(stand-alone-call-grapher :mouse-r-who-line-docÏ*) ()
"Ï2Documents the background right click method in the who line.Ï*"
  '(:mouse-r-1 "Ï3Menu of operations on the call grapher as a wholeÏ*"))

(DEFUN Ï4make-call-grapher-windowÏ* (&rest inits)
"Ï2Makes a stand-alone call grapher window.Ï*"
  (APPLY #'MAKE-INSTANCE 'stand-alone-call-grapher
	  :edges (offsetting-stand-alone-grapher-edges
		    'stand-alone-call-graphers)
	  inits))

;Ï1; A resource of call graphers.Ï*
(DEFWINDOW-RESOURCE Ï4stand-alone-call-graphersÏ* ()
  :initial-copies 0
  :constructor (make-call-grapher-window))

;Ï1(clear-resource 'Stand-Alone-Call-Graphers)Ï*

(DEFUN Ï4graph-callsÏ* (FUNCTION &optional (on :from-resource) (label nil))
"Ï2Graphs the functions called by Function on grapher window On (when defaulted
 it allocates a new window from a resource).  Label is printed at the bottom
 of the window.  Function can be either the name of a function or a Fef.  If
 the display gets too complicated then it can be filtered by sundry filter
 functions.  These can be selected either by using the right button menus in
 grapher windows or by calling the function tv:Select-Grapher-Filters.  In
 your login file you can set the variable tv:*Selected-Filters* to a list of
 the names of the filter functions that you want.  For information on writing
 your own filter functions please look at the documentation/definition of
 tv:*Filter-Items*.Ï*"
  (LET ((fef (the-fef function)))
      (IF (AND (TYPEP function 'vertex)
	       (SEND function :child-edges))
	 fef
	 (LET ((window
		(plot-a-graph
		  fef
		  :on on
		  :child-function 'functions-called
		  :print-function 'simple-print-fef
		  :vertex-flavor 'function-vertex
		  :item-type-alist *graph-calls-item-type-alist*
		  :depth (IF (TYPEP on 'stand-alone-call-grapher)
			     (SEND on :depth)
			     *default-call-graph-depth*)
		  :orientation (IF (TYPEP on 'stand-alone-call-grapher)
				  (SEND on :orientation)
				  *graph-calls-orientation*)
		  :tree-p (IF (TYPEP on 'stand-alone-call-grapher)
			      (SEND on :tree-p)
			      *graph-calls-plot-trees-p*)
		  :resource 'stand-alone-call-graphers
		  :dont-graph-if-already-graphing-this-node t
		  :label (OR label
			     (FORMAT nil "Ï3~S's call graph.Ï*"
				      (FUNCTION-NAME
					(FUNCTION-NAME fef)))))))
	     window))))

(DEFUN Ï4extend-graph-forÏ* (FUNCTION &optional (on :from-resource))
"Ï2Extends the graph on window On below the function Function.Ï*"
  (LET ((*default-call-graph-depth* 1))
      (graph-calls (find-vertex-for (the-fef function) on) on :default)))

(DEFUN Ï4get-a-grapher-windowÏ*
       (&optional (how :existing) (resource 'stand-alone-graphers))
"Ï2Gets a grapher window.  How can be :Existing, :New or :Ask.  This will cause
 either an existing window to be used, a new one to be allocated or you to
 be prompted about what to do.  New windows are allocated out of the resource
 Resource.Ï*"
  (LET ((result nil))
       (MAP-RESOURCE #'(lambda (obj used-p ignore)
			 (IF used-p (PUSH obj result)))
		     resource)
       (LET ((window
	      (CASE how
		(:existing
		  (IF result
		      (LOOP for win in result
			    when (NOT (SEND win :exposed-p))
			    return win
			    finally (RETURN (ucl::first-if-list win)))
		      (ALLOCATE-RESOURCE resource)))
		(:new (ALLOCATE-RESOURCE resource))
		(:ask
		 (IF (AND result (mouse-y-or-n-p "Ï3Use existing window?Ï*"))
		     (get-a-grapher-window :existing resource)
		     (get-a-grapher-window :new resource)))
		(otherwise (FERROR nil "Ï3Unknown selection type ~S.Ï*" how)))))
	   window)))

;Ï1; Make sure we can select call graphers.Ï*

(add-system-key
  #\G '(find-window-of-flavor 'stand-alone-grapher selected-window)
  "Ï2Grapher Window.Ï*" nil)

;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4inspect-graph-function-pÏ* (name &optional (thing nil))
"Ï2Is true if Name names a function which we can graph.  Thing is ignored.Ï*"
  (IGNORE thing)
  (OR (AND (SYMBOLP name) (FBOUNDP name)
	   (OR (COMPILED-FUNCTION-P (SYMBOL-FUNCTION name))
	       (CONSP (SYMBOL-FUNCTION name))))
      (COMPILED-FUNCTION-P name)))

(DEFUN Ï4inspect-graph-functionÏ* (FUNCTION &optional (thing nil))
"Ï2Graphs a function.  This is called from the inspector and such-like.  Thing
 is ignored.  A background process is spun off to do this so that selection
 problems are avoided.Ï*"
  (IGNORE thing)
  (PROCESS-RUN-FUNCTION
    '(:name "Ï3Expose GrapherÏ*" :priority -1)
    #'(lambda (FUNCTION expose-p)
	(LET ((*force-exposure* expose-p))
	    (DECLARE (SPECIAL *force-exposure*))
	    (graph-calls function
			 (get-a-grapher-window
			   *grapher-selection-mode*
			   'stand-alone-call-graphers))))
      function *force-exposure*))

(DEFUN Ï4maybe-graph-functionÏ* (FUNCTION &optional (thing nil) &rest ignore)
"Ï2Graphs Function in a grapher if it knows how to.Ï*"
  (IF (inspect-graph-function-p function thing)
      (inspect-graph-function function thing)
      (tv:notify tv:selected-window "Ï3Could not graph ~S.Ï*" function)))

(DEFFLAVOR Ï4grapher-perspectiveÏ* () (basic-perspective)
  (:documentation "Ï3Perspectives for graphing.Ï*"))

;Ï1; Make sure that we know how to graph functions named by symbols.Ï*
(defperspective Ï4:call-graphÏ* (x show-x)
  :this-perspective-applicable-function
    (OR (AND (OR (SYMBOLP x) (CONSP x)) (si:fdefinition-safe x))
	(COMPILED-FUNCTION-P x))
  :menu-item-name "Ï3Call GraphÏ*"
  :side-effect-function
    (inspect-graph-function
      (IF (COMPILED-FUNCTION-P x) x (si:fdefinition-safe x)))
  :priority -1
  :flavor grapher-perspective)

;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4edit-graphed-functionÏ* (FUNCTION)
"Ï2Invokes Zmacs to edit the source of a function that has been graphed.Ï*"
  (try-and-edit (coerce-to-node function)))

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 Filter function definitions.Ï*
;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4same-packageÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it is not in the same package as As.Ï*"
  (IGNORE child-of window)
  (IF as
      (LET ((fun (FUNCTION-NAME (the-fef function)))
	    (fas (FUNCTION-NAME (the-fef as))))
	  (NOT (AND (SYMBOLP fun) (SYMBOLP fas)
		     (EQUAL (SYMBOL-PACKAGE fun) (SYMBOL-PACKAGE fas)))))
      nil))

(DEFUN Ï4not-sys-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it is in the Sys package.Ï*"
  (IGNORE as child-of window)
  (LET ((fun (FUNCTION-NAME (the-fef function))))
      (AND (SYMBOLP fun) (EQUAL (FIND-PACKAGE "Ï3SYSÏ*") (SYMBOL-PACKAGE fun)))))

(DEFUN Ï4not-called-by-sys-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has been called by a function in the
 Sys package.Ï*"
  (IGNORE function as window)
  (LET ((fun (FUNCTION-NAME (the-fef child-of))))
      (AND (SYMBOLP fun) (EQUAL (FIND-PACKAGE "Ï3SYSÏ*") (SYMBOL-PACKAGE fun)))))

(DEFUN Ï4not-called-by-lisp-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has been called by a function in the
 Lisp package.Ï*"
  (IGNORE function as window)
  (LET ((fun (FUNCTION-NAME (the-fef child-of))))
      (AND (SYMBOLP fun) (EQUAL (FIND-PACKAGE "Ï3LISPÏ*") (SYMBOL-PACKAGE fun)))))

(DEFUN Ï4not-%-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has a name with a % in it.Ï*"
  (IGNORE as child-of window)
  (LET ((fun (FUNCTION-NAME (the-fef function))))
      (AND (SYMBOLP fun) (SEARCH "Ï3%Ï*" (SYMBOL-NAME fun) :test #'STRING-EQUAL))))

(DEFUN Ï4not-*-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has a name with a % in it.  Such functions are
 often generated by compiler optimisers for system functions.Ï*"
  (IGNORE as child-of window)
  (LET ((fun (FUNCTION-NAME (the-fef function))))
      (AND (SYMBOLP fun)
	    (SEARCH "Ï3*Ï*" (SYMBOL-NAME fun) :test #'STRING-EQUAL)
	    (> (LENGTH (THE string (SYMBOL-NAME fun))) 1))))

(DEFUN Ï4only-methods-below-generic-functionsÏ* (FUNCTION as child-of window)
"Ï2Filters out Function if it is called by a generic function but is not a method
 of that generic function.Ï*"
  (IGNORE as window)
  (AND (generic-function-p-safe child-of)
       (LET ((name (FUNCTION-NAME (the-fef function))))
	   (NOT (AND (CONSP name) (EQUAL 'ticlos:method (FIRST name)))))))

(DEFUN Ï4not-methods-below-generic-functionsÏ* (FUNCTION as child-of window)
"Ï2Filters out Function if it is a method on a generic function but is not
 called directly by it.Ï*"
  (IGNORE as window)
  (AND (generic-function-p-safe child-of)
       (LET ((name (FUNCTION-NAME (the-fef function))))
	   (AND (CONSP name) (EQUAL 'ticlos:method (FIRST name))))))

(DEFUN Ï4same-source-fileÏ* (FUNCTION as child-of window)
"Ï2Filters out Filter unless it is defined in the same source file as As.Ï*"
  (IGNORE child-of window)
  (IF as
      (LET ((fun (FUNCTION-NAME (the-fef function)))
	    (fas (FUNCTION-NAME (the-fef as))))
	  (NOT (AND (SYMBOLP fun) (SYMBOLP fas)
		     (GET fun :source-file-name)
		     (GET fas :source-file-name)
		     (fs::pathname-equal
		       (fs:default-pathname (path-string fun 'DEFUN))
		       (fs:default-pathname (path-string fas 'DEFUN))))))
      nil))

(DEFUN Ï4no-macrosÏ* (FUNCTION as child-of window)
"Ï2Filters out Function if it is a macro.Ï*"
  (IGNORE as child-of window)
  (AND (MACRO-FUNCTION (FUNCTION-NAME (the-fef function)))
        (NOT (SPECIAL-FORM-P (FUNCTION-NAME (the-fef function))))))

(DEFUN Ï4no-special-formsÏ* (FUNCTION as child-of window)
"Ï2Filters out Function if it is a special form.Ï*"
  (IGNORE as child-of window)
  (SPECIAL-FORM-P (FUNCTION-NAME (the-fef function))))

(DEFUN Ï4not-called-by-macrosÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has been called by a macro.Ï*"
  (IGNORE function as window)
  (AND (MACRO-FUNCTION (FUNCTION-NAME (the-fef child-of)))
        (NOT (SPECIAL-FORM-P (FUNCTION-NAME (the-fef child-of))))))

(DEFUN Ï4not-called-by-special-formsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has been called by a special form.Ï*"
  (IGNORE function as window)
  (AND (SYMBOLP (FUNCTION-NAME (the-fef child-of)))
        (SPECIAL-FORM-P (FUNCTION-NAME (the-fef child-of)))))

(DEFUN Ï4not-called-by-interpretted-functionsÏ* (FUNCTION as child-of window)
"Ï2Will filter out Function if it has been called by an interpretted function.Ï*"
  (IGNORE function as window)
  (EQUAL child-of (the-fef child-of)))

(DEFUN Ï4select-grapher-filtersÏ* (FUNCTION window &rest ignore)
"Ï2Is called when the user right buttons on a function vertex.  Pops up a menu
 olf filters to select.  If the user selects any then these are recorded, as is
 the currently selected function.Ï*"
  (MULTIPLE-VALUE-BIND (choices chose-p)
        (w:multiple-menu-choose *filter-items*
	  :label (FORMAT nil "Ï3Filter Graphing for ~SÏ*"
			  (FUNCTION-NAME (the-fef function)))
	  :highlighted-items
	  (REMOVE-IF-NOT
	    #'(lambda (x) (MEMBER (THIRD x) *selected-filters*))
	    *filter-items*))
    (IF chose-p
        (PROGN (SETQ *as-function* (the-fef function))
	        (SETQ *selected-filters* choices)
		(SEND window :set-graph-behaviour-changed t))
       nil)))

(DEFUN Ï4set-graph-calls-variablesÏ* (FUNCTION)
"Ï2Sets up interesting variables to do with the function that has been
 clicked on.Ï*"
  (IGNORE function))

;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4graph-somethingÏ* (name)
"Ï2Is called when the user has selected the Graph command from some tool.  It
 tries to find a way to graph Name and, if it can find such a thing, will
 graph it.  If there are multiple options than the user will be prompted with
 a menu.Ï*"
  (MULTIPLE-VALUE-BIND (object inspect-p)
      (map-into-show-x name nil 'grapher-perspective)
    (IF (AND object (NOT inspect-p))
       (FORMAT *query-io* "Ï3~&Graphed ~S.Ï*" object)
       (FORMAT *query-io* "Ï3~&~S not graphed.Ï*" name))))

zwei:
(defcom Ï4zwei::com-graphÏ*
"Ï3Prompt for something and graphs it.Ï*" ()
  (LET ((fcn (zwei::read-function-name "Ï3GraphÏ*"
				 (relevant-function-name (point) nil t t t)
				 'zwei::aarray-ok 'zwei::multiple-ok))
	(*print-case* :capitalize))
       (tv::graph-something fcn))
  dis-none)

;Ï1;; Record the new zmacs commands.Ï*
(zwei::set-comtab zwei::*standard-comtab* '(#\c-sh-g zwei::com-graph)
		 (zwei::make-command-alist '(zwei::com-graph)))

(zwei::set-comtab zwei::*standard-comtab* '(#\m-sh-g zwei::com-graph)
		 (zwei::make-command-alist '(zwei::com-graph)))

(DEFCOMMAND Ï4graph-cmdÏ* nil			
  '(:description "Ï3Graph something.Ï*"
    :names ("Ï3GraphÏ*")
    :keys (#\m-sh-g #\c-sh-g))
   (DECLARE (SPECIAL user history = inspectors frame))
   (SEND user :clear-screen)
   (FORMAT user "Ï3~&Something to graph:Ï*")
   (MULTIPLE-VALUE-BIND (value punt-p)
       (inspect-get-value-from-user user history inspectors)
     (OR punt-p (graph-something value)))
   (SEND frame :handle-prompt))

eh:
(DEFCOMMAND Ï4eh::comw-graphÏ* ()
            '(:description "Ï3Graph something.Ï*"
              :names "Ï3GraphÏ*"
	      :keys (#\m-sh-g #\c-sh-g)) 
   (SEND *window-debugger* :set-who-line-doc-string-overide
	 "Ï3Select something to graph.Ï*")
   (UNWIND-PROTECT
       (tv::graph-something (window-read-thing "Ï3to graphÏ*"))
      (SEND *window-debugger* :set-who-line-doc-string-overide nil)
      (SEND *window-debugger* :handle-prompt)))

;Ï1 TAC 08-08-89 - this is now a parameter in DTCEÏ*
;Ï1; This is defined as a constant in DTCE.Ï*
;Ï1(setf (get '*All-Consistancy-Commands* 'compiler:system-constant) nil)Ï*

(SETQ *all-consistancy-commands* nil) 

;Ï1; Record Graph as a consistency command.Ï*
(PUSHNEW '("Ï3GraphÏ*" :value
	     (((#\c-sh-g zwei::com-graph)
	       (#\m-sh-g zwei::com-graph))
	      ((graph-cmd nil))
	      ((eh::comw-graph nil))))
	    *all-consistancy-commands*
	    :test #'EQUALP)

;Ï1; Reinstall so that we can see Graph as a command.Ï*
(install-consistency-commands)

(reinstall-commands 'general-inspector)

;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4the-classÏ* (the-class)
"Ï2Coerces The-Class into a class or a flavor object.Ï*"
  (TYPECASE the-class
    (symbol (the-class (OR (class-named-safe the-class t)
			   (GET the-class 'si::flavor)
			   (FERROR nil "Ï3~S is not a class.Ï*" the-class))))
    (otherwise (IF (OR (class-p-safe the-class)
		       (TYPEP the-class 'si::flavor))
		   the-class
		   (IF (any-sort-of-clos-instance-p the-class)
		       (class-named-safe (TYPE-OF the-class))
		       (IF (INSTANCEP the-class)
			   (TYPE-OF the-class)
			   (FERROR nil "Ï3~S is not a class.Ï*" the-class)))))))

(DEFUN Ï4class-kidsÏ* (class)
"Ï2Returns a list of the direct superclasses or local component flavors of class.Ï*"
  (IF (class-p-safe (coerce-to-node class))
      (class-local-supers-safe (coerce-to-node class))
      (IF (TYPEP (coerce-to-node class) 'si::flavor)
	  (MAPCAR #'(lambda (x) (GET x 'si::flavor))
		  (si::flavor-depends-on (coerce-to-node class)))
	  nil)))

(DEFUN Ï4class-print-funÏ* (class)
"Ï2Prints out Class neatly as a graph node.Ï*" 
  (LET ((the-class (coerce-to-node class))
        (*package* nil))
      (FORMAT nil "Ï3~S~AÏ*"
	      (IF (class-p-safe the-class)
		  (class-name-safe the-class)
		  (IF (TYPEP the-class 'si::flavor)
		      (si::flavor-name the-class)
		      the-class))
	      (more-kids-indicator
		(IF (AND (TYPEP class 'vertex-node)
			 (vertex-node-vertex class))
		    (AND (NOT (SEND (vertex-node-vertex class) :child-edges))
			 (class-kids (coerce-to-node the-class)))
		    (class-kids the-class))))))

(DEFUN Ï4edit-graphed-thingÏ* (thing)
"Ï2Edits the source of a thing that has been graphed.Ï*"
  (try-and-edit (coerce-to-node thing)))

(DEFUN Ï4inspect-a-graphed-classÏ* (class)
  (INSPECT (allocate-data
	     (IF (class-p-safe class)
		 'show-clos-class
		 'show-flavor)
	     (coerce-to-node class))))

(DEFVAR Ï4*graph-class-item-type-alist*Ï*
  '((:vertex graph-class
     "Ï3L: Graph this Class; M: Drag object; Sh-M/M2: Overview; R: Menu of operationsÏ*"
     ("Ï3InspectÏ*" :value inspect-a-graphed-class :documentation
      "Ï3Inspect this class.Ï*")
     ("Ï3EditÏ*" :value edit-graphed-thing :documentation "Ï3Edit this class.Ï*")))
"Ï2The item type AList for the class grapher.  New menu items should be added to
 the end.Ï*")

(DEFVAR Ï4*default-class-graph-depth*Ï* nil
"Ï2The default depth of class graphs.Ï*")

(DEFFLAVOR Ï4class-vertexÏ* () (boxed-filled-vertex)
  (:documentation
    "Ï3A type of vertex for class graphs.  Classes will be filled flavors won't.Ï*"))

(DEFMETHOD Ï4(class-vertex :after :initÏ*) (IGNORE)
"Ï2Makes sure that each vertex in the graph is set up so that it's box/fill
 status is right.  Classes are filled.  Anything else is boxed.Ï*"
  (LET ((class (the-class (coerce-to-node item))))
      (LET ((class-p (class-p-safe class)))
	  (IF (AND class-p
		    (class-name-safe class)
		    (SYMBOLP (class-name-safe class))
		    (NOT (GET (class-name-safe class) 'si::flavor)))
	     (PROGN (SET-IN-INSTANCE self 'fill-myself-p t)
		    (SET-IN-INSTANCE self 'box-myself-p nil))
	     (PROGN (SET-IN-INSTANCE self 'fill-myself-p nil)
		    (SET-IN-INSTANCE self 'box-myself-p t))))))

(DEFUN Ï4graph-classÏ* (class &optional (on :from-resource) &rest ignore)
"Ï2Graphs Class, which is a class or a flavor on the window On.  If On is
 defaulted then a window is selected from a resource.  The returned value is
 the window that was used.Ï*"
  (LET ((class (the-class class)))
       (plot-a-graph class
	  :on on
	  :child-function 'class-kids
	  :print-function 'class-print-fun
	  :vertex-flavor 'class-vertex
	  :depth *default-class-graph-depth*
	  :tree-p t
	  :item-type-alist *graph-class-item-type-alist*
	  :dont-graph-if-already-graphing-this-node t
	  :label
	    (IF (class-p-safe class)
		(FORMAT nil "Ï3~A's superclassesÏ*" (class-name-safe class))
		(FORMAT nil "Ï3~A's componentsÏ*"
			(TYPECASE class
			  (si::flavor (si::flavor-name class))
			  (symbol (si::flavor-name (GET class 'si::flavor)))
			  (otherwise (FERROR "Ï3~S is not a class or flavor.Ï*"
					     class))))))))

(DEFUN Ï4inspect-graph-classÏ* (class)
"Ï2Graphs a class from the inspector.  Spins off a process to do it so
 that we don't have selection/exposure problems.Ï*"
  (PROCESS-RUN-FUNCTION
    '(:name "Ï3Expose GrapherÏ*" :priority -1)
    #'(lambda (class expose-p)
	(LET ((*force-exposure* expose-p))
	    (DECLARE (SPECIAL *force-exposure*))
	    (graph-class class (get-a-grapher-window))))
    class
    *force-exposure*))

(DEFUN Ï4inspect-graph-class-pÏ* (class &optional (thing nil))
"Ï2Is true if Class is a class or flavor that we can graph, be it a class or
 the name of one.Ï*"
  (IGNORE thing)
  (OR (AND (SYMBOLP class) (class-named-safe class t))
      (AND (SYMBOLP class) (GET class 'si::flavor))
      (class-p-safe class)
      (TYPEP class 'si::flavor)))

;Ï1; Remember that we can graph classes.Ï*

(defperspective Ï4:inheritance-graphÏ* (x show-x)
  :this-perspective-applicable-function (inspect-graph-class-p x)
  :menu-item-name "Ï3Inheritance GraphÏ*"
  :side-effect-function (inspect-graph-class x)
  :priority -1
  :flavor grapher-perspective)

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 TAC 08-17-89 - not going to wire meta-. to the grapher for possibility editting.Ï*
;Ï1;; Maybe wire M-. to the grapher.Ï*

;Ï1(DEFVAR zwei:*wire-grapher-to-m-.* nilÏ*
;Ï1"When true the grapher will be invoked whenever zmacs goes to a new possibilityÏ*
;Ï1 if it can be.")Ï*

;Ï1;---------------------------------------------------------------------------------------------Ï*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE zwei:execute-possibility :around :wire-to-grapher nilÏ*
;Ï1    (LOCALLY (DECLARE (SPECIAL *inside-execute-possibility*))Ï*
;	Ï1     (LET ((results (LET-IF (NOT (BOUNDP '*inside-execute-possibility*))Ï*
;				Ï1    ((*inside-execute-possibility* t))Ï*
;			Ï1      ;; Bind *inside-execute-possibility* so that we only graph once.  Ï*
;			Ï1      ;; Zwei:Execute-Possibility is called recursively.Ï*
;			Ï1      (MULTIPLE-VALUE-LIST :do-it))))Ï*
;	Ï1       (IF (OR (BOUNDP '*inside-execute-possibility*)Ï*
;		Ï1       (NOT zwei:*wire-grapher-to-m-.*)) ;; var is above Ï*
;		Ï1   nilÏ*
;		Ï1   (LET ((*force-exposure* nil)) ;; var is in funtional-interfaceÏ*
;		Ï1     (DECLARE (SPECIAL *force-exposure*))Ï*
;		Ï1     (map-into-show-x (SECOND (SECOND arglist)) nilÏ*
;				Ï1      'grapher-perspective)))Ï*
;	Ï1       (VALUES-LIST results)))))Ï*
;Ï1;---------------------------------------------------------------------------------------------Ï*

;Ï1;---------------------------------------------------------------------------------------------Ï*

;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE zwei:edit-definition-1 :around :wire-to-grapher nilÏ*
;Ï1    (LOCALLY (DECLARE (SPECIAL *inside-execute-possibility*))Ï*
;	Ï1     (LET ((results (LET-IF (NOT (BOUNDP '*inside-execute-possibility*))Ï*
;				Ï1    ((*inside-execute-possibility* t))Ï*
;			Ï1            ;; Bind *inside-execute-possibility* so that we only graph once.  Ï*
;			Ï1            ;; Zwei:Execute-Possibility is called recursively.Ï*
;			Ï1      (MULTIPLE-VALUE-LIST :do-it))))Ï*
;	Ï1       (IF (OR (BOUNDP '*inside-execute-possibility*)Ï*
;		Ï1       (NOT zwei:*wire-grapher-to-m-.*)) ;; var is above Ï*
;		Ï1   nilÏ*
;		Ï1   (LET ((*force-exposure* nil))Ï*
;		Ï1     (DECLARE (SPECIAL *force-exposure*)) ;; var is in funtional-interfaceÏ*
;		Ï1     (map-into-show-x (FIRST arglist) nilÏ*
;				Ï1      'grapher-perspective)))Ï*
;	Ï1       (VALUES-LIST results)))))Ï*
;Ï1;---------------------------------------------------------------------------------------------
