;;; -*- 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;;----------------------------------------------------------------------Ï*
;Ï1;; This software developed by:Ï*
;Ï1;;Ï*	Ï1James RiceÏ*
;Ï1;; at the Stanford University Knowledge Systems Lab in 1986, 1987.Ï*
;Ï1;;Ï*
;Ï1;; This work was supported in part by:Ï*
;Ï1;;Ï*	Ï1DARPA Grant F30602-85-C-0012Ï*
;Ï1;;----------------------------------------------------------------------Ï*
;Ï1;;  Much of this file is derived from code licensed from Texas InstrumentsÏ*
;Ï1;;  Inc.  Since we'd like them to adopt these changes, we're claimingÏ*
;Ï1;;  no rights to them, however, the following restrictions apply to theÏ*
;Ï1;;  TI code:Ï*
;Ï1;; Your rights to use and copy Explorer System Software must be obtainedÏ*
;Ï1;; directly by license from Texas Instruments Incorporated.  UnauthorizedÏ*
;Ï1;; use is prohibited.Ï*
;Ï1;;----------------------------------------------------------------------Ï*

#||
;;; How to write your own perspective:
;;; ==================================

;;; The following comment has some hints on how to make your own inspector
;;; perspectives.  There's a detailed worked example.  Clearly, the whole
;;; of the inspector's code is filled with worked examples of one sort or
;;; another, so if the example below doesn't seem to be quite enough, just
;;; look for the code that implements the sort of thing that you want it to
;;; look like that already exists.  As a reasonable heuristic, if you like
;;; the way that CLOS classes are inspected then look for a flavor called
;;; show-clos-class or some such.  Just flavor inspect the dependent flavors
;;; of tv:inspection-data and look for something that approximates what
;;; you're looking for.

;;; Let's pretend that we have a class of thing for which we
;;; want to have special support in the inspector.  Let's define
;;; it as:

(defflavor rule (name knowledge-source body) ()
  :Initable-Instance-Variables
  :Settable-Instance-Variables
  :Gettable-Instance-Variables)

;;; We'll make rules with the DefRule form:

(defmacro defrule (name (knowledge-source) &body body)
 `(progn (setf (get ',name :rule)
	       (make-instance 'rule
			      :Name ',name
			      :knowledge-source ',knowledge-source
			      :Body ',body))
	 (def ,name)
	',name))

;;; Now let's define a rule:

(defrule rabbit-from-a-hat (magic) some clever rule implementation)

;;; Now we wnat to look at rules specially.  This will mean that, by
;;; default, when the inspector sees a Rule it will have our new behaviour,
;;; but when we Mouse-L-2 on it we'd like to be able to see it as the
;;; flavors instance that it really is.

;;; What's more we know that there's a mapping from symbols to rules
;;; (the rule is stored on the PList of the rule's name under the :Rule
;;; property).  We should therefore extend the perspectives for symbols
;;; so that any defined rules will appear as options.

;-------------------------------------------------------------------------------

;;; First we'll define the way to inspect rules.  This is done by defining
;;; a new flavor of inspection data.

(defflavor show-rule () (generic-middle-button-mixin inspection-data))

;;; Inspection-data is the basic flavor that will deal with how to display
;;; the rule.  Generic-Middle-Button-Mixin will give some reasonable behaviour
;;; for when we get middle buttoned on.

;;; The flavor Show-Rule will have one instance variable, called Data,
;;; that will contain the rule instance.

;;; Now we have to define a number of methods for the above flavor to control
;;; the way it's displayed and the way it acts.

;;; First we'll define what gets returned when we're middle buttoned on.
;;; This makes sure that we get the rule.

(defmethod (show-rule :middle-button-result) ()
"Returns the Rule."
  data)

(defmethod (show-rule :format-concisely) (stream)
"Prints out the rule for the history window and such like."

  ;; Note, here we make a special case for history windows so that we'll be
  ;; printed out as "Rule foo" and foo will be mouse-sensitive and will point to
  ;; the name of the rule.  This is just icing on the cake.  When we're not in
  ;; the history window we don't need to say "Rule" because we'll know from
  ;; the context of the display what it is.  We aren't slashifying here because
  ;; we really don't want to have to worry about this sort of thing.  The reason
  ;; for having "Rule" in the history window is to be able to distinguish
  ;; between this rule and the symbol of the same name.

  (if (in-history-window-p stream)
      (format stream "Rule ~ý" (list (send data :Name) nil (send data :Name)))
      (format stream "~A" (send data :Name))))

;;; Now, let's deal with making the display for the rule.  This is controlled
;;; by the :Generate-Item method, which returns two values: the mouse-sensitive
;;; items for the body of the display and then the specification for the
;;; title of the display.

;;; This method can be as complicated as you make it.  However, there are a
;;; number of simple things to make each item out of.
;;; *blank-line-item* - This leaves a blank line.
;;; *one-space-item* - leaves a space.
;;; "string" - Just prints a string without any special fonts or
;;;    mouse-sensitivity.
;;; (:colon <number>) - prints a colon and tabs to column <number>.  This is
;;;    useful in tabulating things like defstruct slots.
;;; (:font <number> "string") - will display String in font <number> non-mouse
;;;    sensitively.
;;; (:item1 <type> value &optional print-fn) - will make a mouse-sensitive
;;;    item of type <type> whose value is Value and whose printing behaviour
;;;    can be modified by supplying Print-Fn.
;;;    The most important values for <Type> are 'instance, which is used for
;;;    displaying things like Show-Rule, and 'Named-Structure-Value, which is
;;;    a convenient way to display normal values.
;;;    print-fn must be a function with arglist:
;;;    (instance stream &optional (level 0)).  Instance is the thing being
;;;    printed, stream is the stream to print it to and Level is the depth of
;;;    nesting that we're at.  A good function to call inside such a print-fn
;;;    is inspection-data-print-item-concisely, which takes the same args.
;;;    For instance, defining a print-fn as below would make sure that in this
;;;    case show-rules are printed as Knowledge-source-name:rule-name.  The
;;;    resulting mouse-sensitive item will still point to the original
;;;    show-rule.

;;; A significant thing to note here is the function Allocate-Data.  This
;;; will create/find in its cache an instance of (in this case) show-rule
;;; that is representing the data item.  This you should always use
;;; (allocate-data 'show-rule <rule-instance>) to get an instance of show-rule,
;;; your should never call make-instance.

(defun print-rule-verbosely (instance stream &optional (level 0))
  (ignore level)
  (let ((name (format nil "~A:~A"
		      (send (send instance :Data) :Knowledge-Source)
		      (send (send instance :Data) :Name)))
	(*print-escape* nil))
       (format stream "~A" name)))

;;; Now let's define that method:

(defmethod (show-rule :generate-item) ()
  (values
    ;; This is the list of inspector items.
    `(,*blank-line-item*
      ((:font 1 "Details of ")
       (:item1 instance ,(allocate-data 'show-rule data) print-rule-verbosely))
      ,*blank-line-item*
      ((:font 1 "Knowledge Source")
       (:Colon 30)
       ,(string (send data :Knowledge-Source)))
      ((:Font 1 "Body")
       (:Colon 30)
       (:Item1 named-structure-value ,(send data :Body))))
    ;; This is the title for the window.
    `(:font fonts:hl12bi :string ,(format nil "Rule ~A" (send data :name)))))

;;; Now let's define a :Help method so that when the user middle buttons on
;;; the display he'll get something useful.  If we'd defined any menus on
;;; the right button this might be a good place to talk about them.

(defmethod (show-rule :help) ()
  (format nil "You're currently looking at a rule called ~S" (send data :name)))

;-------------------------------------------------------------------------------

;;; This is all very well, but what if we wan't to be able to use the modify
;;; command on sundry properties of the rule, for instance , we might want to
;;; be able to smash the knowledge source with which it is associated.

;;; The following will show you how to do this:

;;; First we must define a new sort of inspection type for the knowledge source
;;; itself.  This will have associated with it a function that will know how to
;;; do the modify operation.

;;; Let's call this type Rule-Slot:

(defun (:property Rule-slot set-function)
       (item new-value object)
  ;;; Note: Object is our Show-Rule instance, so we must point to the rule
  ;;; it contains.
  (let ((slot (third (second item))))
       (set-in-instance object slot new-value)))

;;; Rule slot names are only mouse sensitive when they're being modified.
(defprop Rule-slot t only-when-modify) 

;;; Now we'll have to change our generate item method so that we get to see
;;; the new item types:  Note, the symbols Knowledge-source and Body are the
;;; names of the slots in Rules.

(defmethod (show-rule :generate-item) ()
  (values
    ;; This is the list of inspector items.
    `(,*blank-line-item*
      ((:font 1 "Details of ")
       (:item1 instance ,(allocate-data 'show-rule data) print-rule-verbosely))
      ,*blank-line-item*
      ((:Item1 Rule-Slot Knowledge-Source)
       (:Colon 30)
       ,(string (send data :Knowledge-Source)))
      ((:Item1 Rule-Slot Body)
       (:Colon 30)
       (:Item1 named-structure-value ,(send data :Body))))
    ;; This is the title for the window.
    `(:font fonts:hl12bi :string ,(format nil "Rule ~A" (send data :name)))))

;;; This works fine in a simplistic case but, as you'll see if you try it,
;;; we've lost the nice fonts and printing for when we print out the
;;; attribute names.  Let's fix it:

(defun print-rule-slot-name (slot stream &optional (level 0))
  (ignore level)
  (format stream "~A" (string-capitalize (symbol-name slot) :spaces t)))

(defmethod (show-rule :generate-item) ()
  (values
    ;; This is the list of inspector items.
    `(,*blank-line-item*
      ((:font 1 "Details of ")
       (:item1 instance ,(allocate-data 'show-rule data) print-rule-verbosely))
      ,*blank-line-item*
      ((:font 1 (:Item1 Rule-Slot Knowledge-Source print-rule-slot-name))
       (:Colon 30)
       ,(string (send data :Knowledge-Source)))
      ((:font 1 (:Item1 Rule-Slot Body print-rule-slot-name))
       (:Colon 30)
       (:Item1 named-structure-value ,(send data :Body))))
    ;; This is the title for the window.
    `(:font fonts:hl12bi :string ,(format nil "Rule ~A" (send data :name)))))

;;; That's better.  Note we're allowed to make compound items like
;;; (:font 1 (:item1 ...)).
;-------------------------------------------------------------------------------

;;; Now we have to tell the inspector about the new perspectives.

(Defperspective :rule (x show-x)
  :show-x-type-for-perspective Show-rule
  :This-Perspective-Applicable-Function
    (and (not (typep show-x 'Show-Rule))
         (or (and (symbolp x) (get x :rule)) (typep x 'Rule)))
  :menu-item-name "Rule"
  :New-Inspect-Function
    (allocate-data 'Show-Rule (if (symbolp x) (get x :rule) x))
  :Priority 11)

;;; The representation of Rule will automatically get a default perspective
;;; to inspect it as a generic flavors instance.  This has a priority of 10,
;;; so we just make sure that the perspectiev defined above has a higher
;;; perspective and we're well away.

;-------------------------------------------------------------------------------

;;; Now as a final complication, maybe we'd like to have a right button menu
;;; for show-rules.  This might do interesting things to the knowledge base.

;;; First let's define a function to put up the menu:

(defparameter *rule-menu-options*
	    '(("Frob Knowledge Source" :Value :Frob-Knowledge-Source
	       :Documentation "Frob in some way with the knowledge source.")))

(defun select-rule-operation (Rule window)
"Given a rule and the inspector window, selects something to do with the rule
 and does it."
  (let ((choice
	   (ucl::smart-menu-choose
	     *rule-menu-options* :label
	     (format nil "Operations on ~A" (send Rule :Name)))))
       (if choice
	   (send window choice rule)
	   nil)))

;;; The definition above requires that we define a method to implement the
;;; :frob-knowledge-source option.

(defmethod (general-inspector :Frob-Knowledge-Source) (Rule)
"Just a dummy definition, since I don't know what to frob in this toy example."
  (print (send Rule :Knowledge-Source)))

;;; Now we have to trap the mouse-click:

(defwrapper (show-rule :handle-mouse-click)
	    ((blip inspector) &body body)
"Makes sure that show-rule things can have a right button menu."
  `(if (= (fourth blip) #\Mouse-r-1)
       (select-rule-operation data inspector)
       . ,body))

;;; Finally we should make sure that the who-line mouse doc knows about
;;; the new menu.

(defmethod (show-rule :who-line-doc) (ignore &optional ignore)
"Returns a who-line doc string for show-rules."
  '(:Mouse-L-1 "Inspect Rule"
    :Mouse-M-1 "Set *"
    :Mouse-R-1 "Menu of Rule operations"))

;;; Gosh.  That's the end of this example.

||#

;-------------------------------------------------------------------------------
;;; This is where things really start.
;-------------------------------------------------------------------------------

;Ï1*************Ï*
;Ï1 TAC 07-25-89 - tvfont is too small - just use cptfont alwaysÏ*
;Ï1(defvar *general-inspector-menu-item-font*Ï*
;	Ï1(if (eq sys:(processor-type microcode-type-code) :micro-explorer)Ï*
;	Ï1    fonts:cptfontÏ*
;	Ï1    fonts:tvfontÏ*
;	Ï1)Ï*
;Ï1"The font for the command menu in general inspector frames."Ï*
;Ï1)Ï*

(DEFVAR Ï4*general-inspector-menu-item-font*Ï* fonts:cptfont)

;Ï1*************Ï*
;Ï1 TAC 07-25-89 - since font is always cptfont, use 4 lines alwaysÏ*
;Ï1(defvar *general-inspector-number-of-menu-pane-rows*Ï*
;Ï1        (if (equal *general-inspector-menu-item-font*Ï*
;		Ï1   (if (eq (sys:processor-type sys:microcode-type-code)Ï*
;			Ï1   :micro-explorerÏ*
;		Ï1       )Ï*
;		Ï1       fonts:cptfont fonts:tvfontÏ*
;		Ï1   )Ï*
;	Ï1    )Ï*
;	Ï1    4Ï*
;	Ï1    6Ï*
;	Ï1)Ï*
;Ï1"The number of rows for the command menu in general inspector frames."Ï*
;Ï1)Ï*

(DEFVAR Ï4*general-inspector-number-of-menu-pane-rows*Ï* 4)

(DEFVAR Ï4*general-inspector-configuration*Ï* :three-panes
  "Ï2Default configuration for the General InspectorÏ*")

(DEFPARAMETER Ï4*all-command-table-names*Ï*
	      '(general-inspector-command-tables
		inspector-command-tables
		flavor-inspector-command-tables)
  "Ï2The names of all of the command tables used by the general inspector.Ï*")

(DEFPARAMETER Ï4flavor-inspector-command-tablesÏ*
  '((flavor-inspector-cmd-table
     all-flavor-inspector-commands
     "Ï3Flavor Inspector CommandsÏ*"
     flavor-inspector))
"Ï2The command tables used by the Flavor inspector.  This is a list of lists.
 Each element in the list has the elements a) The name of the command table,
 b) the name of a list of all of the command names to be in that table,
 c) a string for the name of the command table and d) the flavor of frame
 for which the commands should work.Ï*")

(DEFPARAMETER Ï4inspector-command-tablesÏ*
  '((inspector-menu-cmd-table
     inspector-menu-cmds
     "Ï3Inspector menu commandsÏ*"
     inspect-frame)
    (inspector-other-cmd-table
     inspector-non-menu-cmds
     "Ï3Inspector menu commandsÏ*"
     inspect-frame))
"Ï2The command tables used by the Inspector.  This is a list of lists.
 Each element in the list has the elements a) The name of the command table,
 b) the name of a list of all of the command names to be in that table,
 c) a string for the name of the command table and d) the flavor of frame
 for which the commands should work.Ï*")

(DEFPARAMETER Ï4general-inspector-command-tablesÏ*
	      (APPEND flavor-inspector-command-tables inspector-command-tables)
"Ï2The command tables used by the General-Inspector.  This is a list of lists.
 Each element in the list has the elements a) The name of the command table,
 b) the name of a list of all of the command names to be in that table,
 c) a string for the name of the command table and d) the flavor of frame
 for which the commands should work.Ï*")

(PUTPROP 'general-inspector *all-command-table-names* :all-command-table-names)

(DEFPARAMETER Ï4*all-menu-specifiers*Ï* '(general-inspector-menu-specifier)
"Ï2A list of all of the names of the command menus in the general inspector
 frame.Ï*")

(DEFPARAMETER Ï4general-inspector-menu-specifierÏ*
  '((general-inspector-menu general-inspector-menu-cmds))
"Ï2A list of lists.  Each element in the list is a two-list.  The first element is
 the name of the menu, the second is the name of a list of the names of the 
 commands to go into the menu named by the first.Ï*")

(PUTPROP 'general-inspector *all-menu-specifiers* :all-menu-specifiers)

(DEFPARAMETER Ï4*all-prompts*Ï*
	      (LIST '("Ï3Inspect: Ï*" :set-inspect nil
		      general-inspector-command-tables)
		    '("Ï3> Ï*" :set-> nil general-inspector-command-tables)
		    `(,(IF (clos-p)
			   "Ï3Flavor\/Class\/Method: Ï*"
			   "Ï3Flavor\/Method: Ï*")
		      :set-flavor/class
		      ,(IF (clos-p)
			   '(method-specs class-instance class-names
			     clos-method-specs flavor-instance flavor-names
			     ucl::command-names)
			   '(method-specs flavor-instance flavor-names
			     ucl::command-names))
		       general-inspector-command-tables))
"Ï2A list which maps prompt names to command table specifications.  Each element
 in the list represents a new prompt and hence typein mode.  The element is a
 list, whose elements are as follows: a) A string to print as the font, b)
 the name of a method to call to select that typein mode and c) the name
 of the command tables to use for that typein mode.Ï*")

(DEFPARAMETER Ï4all-flavor-inspector-commandsÏ*
	     '(:all-fl&cl :help-on-syntax
	       :help-on-inspected-data :end-cmd
	       :options-menu :trace-method :fi-doc-cmd :toggle-config-cmd
	       mode delete-all-cmd refresh-cmd page-up-cmd page-down-cmd
	       page-to-top page-to-bottom break-cmd)
"Ï2A list of the names of all of the commands to be provided in the general
 inspector.Ï*")

(DEFPARAMETER Ï4general-inspector-menu-cmdsÏ*
	     '(:all-fl&cl
	       arglist-cmd
	       break-cmd
	       inspect-compile-cmd
	       :toggle-config-cmd
	       ;Ï1; dbg-sg-cmd   ;; TAC 08-18-89 - do not advertise this on menuÏ*
	       delete-all-cmd
	       document-something-cmd
	       inspect-edit-cmd
	       inspect-eval-cmd
	       end-cmd
	       :documentation-cmd
	       :help-on-syntax
	       inspect-macroexpand-cmd
	       :lisp-mode-cmd
	       modify-cmd
	       modify-print-cmd
	       refresh-cmd
	       trace-cmd)
"Ï2A list of the names of all of the menu commands to be provided in the general
 inspector.Ï*")

;Ï1*************Ï*
;Ï1 TAC 07-26-89 - moved this to TI-ENV-FLAVOR-INSPECTOR-INTERFACE where first referenced.Ï*
;Ï1(defvar *general-inspector-enabled* tÏ*
;Ï1"When true the general inspector is enabled."Ï*
;Ï1)Ï*

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

(DEFMETHOD Ï4(show-method :method-from-show-methodÏ*) ()
"Ï2Extracts a method from a show-method object.  The method is in the second slot
 in the method table entry.Ï*"
  (SECOND data))

(DEFMETHOD Ï4(show-method-details :method-from-show-method-detailsÏ*) ()
"Ï2Extracts a method from a show-method-details object.  The method is in the
 second slot in the method table entry.Ï*"
  (SECOND aux-data))

(DEFFLAVOR Ï4general-inspector-history-windowÏ* () (inspect-history-window)
  (:default-init-plist
    :line-area-mouse-doc
      '(:mouse-l-1 "Ï3Inspect the indicated objectÏ*"
	:mouse-m-1 "Ï3Set=Ï*")
    :normal-mouse-documentation
      '(:mouse-l-1 "Ï3Inspect the indicated objectÏ*")))

(DEFMETHOD Ï4(general-inspector-history-window :who-line-documentation-stringÏ*) ()
"Ï2A who line doc string method for the history window.Ï*"
  (LET ((frame (SEND self :superior)))
       (IF (SEND frame :inspector-typein-p)
	   (SEND (SEND frame :get-pane 'interactor)
		 :who-line-documentation-string)
	   (IF sensitive-history-item
	       (COND
		 ((LET ((item (get-mouse-sensitive-item)))
		       (WHEN (TYPEP item 'inspection-data)
			 (SEND item :who-line-doc nil))))
		 ((OR modify-mode (AND (NOT setting-mode) (key-state :hyper)))
		  '(:mouse-r-2 "Ï3System MenuÏ*"))
		 (setting-mode
		  '(:mouse-l-1 "Ï3Set with this valueÏ*" :mouse-r-1 "Ï3AbortÏ*"))
		 (t (SEND self :get-normal-mouse-documentation)))
	       (COND
		 ((OR modify-mode (AND (NOT setting-mode) (key-state :hyper)))
		  '(:mouse-r-2 "Ï3System MenuÏ*"))
		 (setting-mode
		  '(:mouse-l-1
		     "Ï3Select a value to set withÏ*" :mouse-r-2 "Ï3System MenuÏ*"))
		 (t (SEND self :get-normal-mouse-documentation)))))))

(DEFFLAVOR Ï4general-inspect-windowÏ* ()
	   (inspect-window)
  (:documentation
"Ï3This is a generalised version of the old inspector.  It allows the user to do
 normal inspection things, flavor inspection and class inspection all in one
 tool.  It also supports a perspectives mechanism whereby the user can view
 certain data structures in a number of different ways.  Middle button clicks
 cause things to be set to = and * and echoed in the interactor.  L2 invokes
 the perspectives mechanism.Ï*"))

(DEFMETHOD Ï4(general-inspect-window :after :initÏ*) (IGNORE)
"Ï2Record the new middle button in the who-line doc.  We can't do this in the
 default init plist because the inspect-window flavor sets it in its init
 method.Ï*"
  (SETQ normal-mouse-documentation
      '(:mouse-l-1 "Ï3Inspect list itemÏ*"
	:mouse-m-1 "Ï3Set=Ï*"
	:mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*")))

(DEFFLAVOR Ï4general-inspect-paneÏ* () (general-inspect-window inspect-pane)
  (:documentation
    "Ï3The flavor of inspector window used by the general inspector.Ï*"))

(DEFFLAVOR Ï4general-inspect-pane-with-typeoutÏ* ()
	   (general-inspect-window inspect-pane-with-typeout)
  (:documentation
    "Ï3The flavor of inspector window used by the general inspector's main pane.Ï*"))

(DEFVAR Ï4*inhibit-inspection-data*)Ï*

(DEFMETHOD Ï4(general-inspect-window :object-instanceÏ*) (obj)
  (LET ((maxl -1)
        result flavor)
    ;Ï1; If the instance to inspect is an instance of INSPECTION-DATA and our superior's INSPECTION-DATA-ACTIVE? is T,Ï*
    ;Ï1; let the instance generate the inspection item.  This is used in special-purpose inspectors Ï*
    ;Ï1; such as the flavor inspector.Ï*
    (IF (AND (OR (NOT (BOUNDP '*inhibit-inspection-data*))
		 (NOT *inhibit-inspection-data*))
	     (TYPEP obj 'inspection-data))
	;Ï1; Fix put in here by JPR to support more sophisticated item generation.  Ï*
	;Ï1; This is particularly important for item generators that need to be able Ï*
	;Ï1; to point to the window, not just the flavor inspector.Ï*
	(IF (SEND obj :operation-handled-p :generate-item-specialized)
	    (SEND obj :generate-item-specialized self)
	    (MULTIPLE-VALUE-BIND (text-items inspector-label)
		(SEND obj :generate-item)
	      (VALUES text-items () 'inspect-printer () inspector-label)))
        ;Ï1; Otherwise inspect the flavor instance in the normal fashion.Ï*
        (PROGN
          (SETQ flavor (si:instance-flavor obj))
          (SETQ result
                (LIST '("")
                      `("Ï3An object of flavor Ï*" (:item1 flavor ,(TYPE-OF obj))
                        "Ï3.  Function is Ï*" (:item1 flavor-function ,(si::instance-function obj)))))
          (LET ((ivars
                  (IF flavor
                      (si:flavor-all-instance-variables flavor)
                      (%p-contents-offset (%p-contents-as-locative-offset obj 0)
                                          %instance-descriptor-bindings))))
            (DO ((bindings ivars (CDR bindings))
                 (i 1 (1+ i)))
                ((NULL bindings))
              (SETQ maxl (MAX (FLATSIZE (CAR bindings)) maxl)))
            (DO ((bindings ivars (CDR bindings))
                 (sym)
                 (i 1 (1+ i)))
                ((NULL bindings))
              (SETQ sym (CAR bindings))
              (PUSH
                `((:item1 instance-slot ,sym) (:colon ,(+ 2 maxl))
                  ,(IF (= dtp-null (%p-data-type (%instance-loc obj i)))
                       "Ï3unboundÏ*"
                       `(:item1 instance-value ,(%instance-ref obj i))))
                result)
              (IF (EQUAL (FIRST bindings) 'si::hash-array)
                  (LET ((window-items (make-window-items-for-hash-table obj)))
                    (DOLIST (element window-items) (PUSH element result))))
              ))
          (NREVERSE result)))))
;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN gi-doc-cmd ()
  "Display some brief documentation about each of the Inspector's panes."
  (DECLARE (SPECIAL frame))
  (si:with-help-stream
    (window :label "Documentation for General Inspector"
	    :superior tv:default-screen)
    (FORMAT window
	    "
                               FLAVOR/CLASS INSPECTOR HELP
  ------------------------------------------------------------------------------
                    *** OPTIONAL THIRD INSPECTION PANE ***

    Displays previously inspected item.
 -------------------------------------------------------------------------------
                        *** OPTIONAL SECOND PANE ***

    Displays previously inspected item.
 -------------------------------------------------------------------------------
                        *** MAIN INSPECTION PANE ***

    This pane displays the structure of the most recently inspected item.
    Specify objects to inspect by either:

      * Entering them into the Interaction Pane or,
      * Clicking Mouse-Left on the mouse sensitive elements of previously
        inspected items.
      * Clicking Mouse-Left-2 will either simply act like Mouse-Left or, if it
        can, will allow you to view the data in a different perspective.  This
        could take the form either of simply changing to a different perspective
        or of popping up a menu if there are a number of different known
        perspectives.
      * Clicking Mouse-Middle on an object will cause that object to be echoed
        in the interaction pane and will make that object the current value of
        both * and of =.  The previous values of * and ** will ripple through
        as appropriate.
      * Clicking Mouse-Middle-2 anywhere in the pane toggles the pane's locked
        status.  When locked, the inspected item in that pane will be frozen
        until unlocked.  Only two of the 3 panes may be locked.
      * Clicking Mouse-Right on items in this pane will put up a menu of
        appropriate operations, when there is such a menu.
 -------------------------------------------------------------------------------
                             *** HISTORY PANE ***

    This pane displays a list of the objects that have been inspected.

    To bring an object back into the Main Inspection Pane, click
    Mouse-Left on that object in this pane.

    To remove an item from the History Pane, position the mouse-cursor to the 
    left of the item until the cursor becomes a right-pointing arrow (this is
    the items \"line area\"). Now click Mouse-Middle.

 -------------------------------------------------------------------------------
                             *** COMMAND MENU ***

    Click Mouse-Left to select a command.

 -------------------------------------------------------------------------------
                           *** INTERACTION PANE *** 

    The behaviour of this pane is sensitive to the current Mode.  This is set
    by either the Mode menu command of the s-m keystroke.  Typeing to these
    modes will do the following:

      Inspect - will cause the VALUE of the expression that you type to be
          inspected.
      > - does not cause anything to be inspected at all.  It allows you to
          do normal lisp interaction.  This is useful when you want to evaluate
          lisp expressions using values seen inthe inspector as arguments. 
          Do this by setting the value of *, ** and *** by using the middle
          button mouse click mentioned above.
      Flavor/Class/Method - This is the most complicated input mode.  It allows
          You to enter a Flavor name, a Class name, a Flavors method, a CLOS
          method or a Generic Function.

          For Flavors input:
	  -- a flavor name to inspect, terminated by pressing the RETURN key
	  -- a method specification to inspect.  The syntax is
	       (Flavor-Name Method-Name)
	     or
	       (Flavor-Name Method-Type Method-Name)
	     or
	       Flavor-Name Method-Name
	     or    
	       Flavor-Name Method-Type Method-Name
	  
	     The last two types of expressions are terminated by pressing
             the RETURN key.
	     Method-Type is one of the following:
	       :AFTER :AND :AROUND :BEFORE :CASE :DEFAULT :OR :OVERRIDE :WRAPPER

          For CLOS input:	  
	  -- a class name to inspect, terminated by pressing the RETURN key
	  -- a method specification to inspect.  The syntax is
	       (Class-Name Generic-Function-Name)
	     or
	       (Class-Name Method-Type Generic-Function-Name)
	     or
	       (Generic-Function-Name Class-Name)
	     or
	       (Generic-Function-Name Method-Type Class-Name)
	     or
	       Class-Name Generic-Function-Name
	     or    
	       Class-Name Method-Type Generic-Function-Name
	     or
	       Generic-Function-Name Class-Name
	     or    
	       Generic-Function-Name Method-Type Class-Name
	  
	     The last four types of expressions are terminated by pressing
             the RETURN key.
	     Method-Type is one of the following:
	       :AFTER :BEFORE :CASE

	  While typing these expressions, you may press the SPACE Bar to
          complete a Class, Flavor or method name.  You may also use the Input
          Editor completion commands summarized below:
	  
	     CTRL-ESCAPE  -- Recognition Completion (same as the SPACE Bar)
	     CTRL-\/      -- List Recognition Completions
	     SUPER-ESCAPE -- Apropos Completions
                             (complete word as an inner substring)
	     SUPER-\/     -- List Apropos Completions
	     HYPER-ESCAPE -- Spelling Corrected Completion
                             (corrects minor typos)
	     HYPER-\/     -- List Spelling Corrected Completions

 -------------------------------------------------------------------------------
  ")
    (show-all-commands-for-frame frame window)))

;-------------------------------------------------------------------------------

(DEFFLAVOR Ï4general-inspectorÏ*
	   ((flavor-inspect-p nil)
	    (all-command-table-names *all-command-table-names*)
	    (all-menu-specifiers *all-menu-specifiers*)
	    (all-prompts *all-prompts*))
	   (flavor-inspector)
  (:default-init-plist
    :active-command-tables
    (MAPCAR #'FIRST
	    (SYMBOL-VALUE (FIRST (SEND self :all-command-table-names))))
    :all-command-tables (get-all-command-table-names (TYPE-OF self))
    :menu-panes '((menu general-inspector-menu))
    :typein-modes nil 
    :basic-help '(gi-doc-cmd)
    :prompt (FIRST (FIRST (SEND self :all-prompts)))
    :print-results? 'general-inspector-print-values?
    :inspection-data-active? nil)
  :gettable-instance-variables
  :initable-instance-variables
  :settable-instance-variables)

;Ï1----------------------------------------------------------------------Ï*
;Ï1 TAC 08-15-89 - advice moved to FLAVOR-INSPECTOR.LISPÏ*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE (:method flavor-inspector :before :expose) :aroundÏ*
;	Ï1  :dont-run-if-general-inspector nilÏ*
;Ï1    (IF (TYPEP self 'general-inspector)Ï*
;	Ï1nilÏ*
;	Ï1:do-it)))Ï*
;Ï1----------------------------------------------------------------------Ï*

(DEFMETHOD Ï4(general-inspector :before :exposeÏ*) (&rest ignore)
"Ï2Make sure that our configuration is what we want it to be.Ï*"
  (SEND self :set-configuration *general-inspector-configuration*))

(DEFPARAMETER Ï4*debugging?*Ï* nil "Ï2Just used by me for debugging.Ï*")
;Ï1(setq *Debugging?* t)Ï*

(DEFMETHOD Ï4(general-inspector :inspect-thingÏ*)
           (type thing &optional (aux-data nil aux-supplied?))
  (LET ((inspected-thing
	  ;Ï1;; this is just in case we get really screwed up.Ï*
	  (IF *debugging?*
	      (LIST type thing aux-data)
	      (inspect-real-value
	       `(:value
		 ,(IF aux-supplied?
		    (allocate-data type thing aux-data)
		    (allocate-data type thing))
		 ,history)))))
    (inspect-flush-from-history inspected-thing history)
    (SEND history :append-item inspected-thing)
    (update-panes)))

(DEFMETHOD Ï4(general-inspector :pseudo-update-*Ï*) (value)
  "Ï2This is sort of like the normal update-*, only it doesn't do any of the
 frobbing around with the history window.  We don't want to do any of that if
 the user just middle buttons on something.Ï*"
  (LET ((items (SEND history :items)))
    (LET ((nitems (+ 1 (IF items (ARRAY-ACTIVE-LENGTH items) 0))))
      (SETF (AREF items (+ 1 nitems)) value)
      (IF (>= nitems 1) (set-element-from-history '=   -1 nitems items))
      (IF (>= nitems 1) (set-element-from-history '*   -1 nitems items))
      (IF (>= nitems 1) (set-element-from-history '**   1 nitems items))
      (IF (>= nitems 2) (set-element-from-history '***  2 nitems items)))))

(DEFMETHOD Ï4(general-inspector :set-up-equalÏ*) (value)
"Ï2Sets up = and * to point to Value.  ** and *** ripple up.Ï*"
  (DECLARE (SPECIAL =))
  (LET ((*print-level* 3)
	(*print-length* 5))
       (SEND self :pseudo-update-* value)
       (PRIN1 * *terminal-io*))
  (SEND self :handle-prompt))

(DEFMETHOD Ï4(general-inspector :inspect-info-middle-clickÏ*)
	   (&optional something)
"Ï2Makes the value that was clicked on the current value of * and =.Ï*"
  (LET ((thing (IF something
		   something
		   (inspect-real-value ucl:kbd-input))))
       (SEND self :set-up-equal thing)))

(DEFUN Ï4find-inspection-objectÏ* (blip)
"Ï2Given a mouse blip extracts something from it to inspect.  Mouse blips
 have a number of different formats so we have to frob around a bit.Ï*"
  (COND ((TYPEP (SECOND blip) 'inspection-data) (SECOND blip))
        ((TYPEP (THIRD  blip) 'inspection-data) (THIRD  blip))
	((AND (CONSP (SECOND blip))
	      (find-inspection-object (SECOND blip))))
        ((TYPEP (FOURTH blip) 'inspection-data) (FOURTH blip))
	((EQUAL :value (FIRST blip))
	 (allocate-data 'show-generic-object-thing (SECOND blip)))
	((INSTANCEP (THIRD blip))
	 (SEND (THIRD blip) :send-if-handles :current-object))
	(t nil)))

(DEFUN Ï4method-pÏ* (x)
  "Ï2Is true if x is a (flavors) method.Ï*"
  (AND (FUNCTIONP x)
       (CONSP (FUNCTION-NAME x))
       (OR (EQUAL :method (FIRST (FUNCTION-NAME x)))
	   (EQUAL 'ticlos:method (FIRST (FUNCTION-NAME x))))))

(DEFTYPE Ï4:methodÏ* ()
"Ï2Is a method.Ï*"
  `(satisfies method-p))

(DEFTYPE Ï4method-functionÏ* ()
"Ï2Is a method.Ï*"
  `(satisfies method-p))

(DEFTYPE Ï4type-specifierÏ* ()
  "Ï2The type which denotes type specifiers.Ï*"
  `(satisfies type-specifier-p))

(DEFUN Ï4data-from-methodÏ* (method)
"Ï2Given a flavors method turns it into data suitable to ge given to allocate
 data, i.e. it finds the flavor and the method table entry and returns these
 as a list.Ï*"
  (LET ((method-spec (FUNCTION-NAME method)))
       (LET ((method-data (LIST method-spec method
				(si::method-plist method-spec))))
	    (LIST (GET (SECOND method-spec) 'si::flavor) method-data))))

(DEFUN Ï4data-from-clos-methodÏ* (method)
"Ï2Given a clos method turns it into data suitable to ge given to allocate data,
 i.e. it finds a class and returns it and the method as a list.Ï*"
  (LIST (FIRST (method-type-specifiers-safe method)) method))

(DEFUN Ï4data-from-clos-generic-functionÏ* (gf)
"Ï2Given a generic function turns it into data suitable to ge given to allocate
 data, i.e. it just returns a list of itself twice.Ï*"
  (LIST (function-generic-function-safe gf) (function-generic-function-safe gf)))

(DEFUN Ï4data-from-classÏ* (instance)
"Ï2Maps an instance into the class of the instance.Ï*"
  (LIST (class-named-safe (class-of-safe instance))))

(DEFWRAPPER Ï4(inspection-data :handle-mouse-clickÏ*)
	    ((blip flavor-inspector) &body body)
  "Ï2Supports the mouse-l-2 click as well as the others.Ï*"
  `(LET ((object (find-inspection-object (SEND flavor-inspector :kbd-input))))
     (IF (AND (= (FOURTH blip) #\mouse-l-2) object)
	 (SEND flavor-inspector :inspect-info-left-2-click
	       object)
	 . ,body)))

(DEFMETHOD Ï4(general-inspector :around :handle-unknown-inputÏ*) (cont mt ignore)
  (LET (inspection-data)
    (COND
      ;Ï1; first see if they toggled a pane's locked statusÏ*
      ((AND (CONSP ucl:kbd-input)
            (EQ (FIRST ucl::kbd-input) :mouse-button)
            (EQL (SECOND ucl::kbd-input) #\Mouse-m-2))
       (SEND (THIRD ucl::kbd-input) :toggle-lock))   
      ((AND (CONSP ucl:kbd-input)
            (EQL (FOURTH ucl::kbd-input) #\Mouse-m-2))
       (SEND (THIRD ucl::kbd-input) :toggle-lock))   
      ;Ï1; If not a blip, let UCL's method handle unknown inputÏ*
      ((NEQ ucl::input-mechanism 'ucl::unknown)
       (FUNCALL-WITH-MAPPING-TABLE cont mt :handle-unknown-input))
      ;Ï1; Blip contains an inspection-data instance and we are currently inspecting treating them specially.Ï*
      ((AND ;Ï1INSPECTION-DATA-ACTIVE?Ï*
            (OR
              ;Ï1; Blip in form (INSTANCE (:ITEM1 INSTANCE <inspection-data instance>) <window> <mouse button>).Ï*
              ;Ï1; These are the standard inspection-data blips from the inspection panes.Ï*
              (AND (EQ (FIRST ucl::kbd-input) 'instance)
                   (EQ (FIRST (SECOND ucl::kbd-input)) :item1)
                   (TYPEP (THIRD (SECOND ucl::kbd-input)) 'inspection-data)
                   (SETQ inspection-data (THIRD (SECOND ucl::kbd-input))))
              ;Ï1; Blip in form (:VALUE <inspection-data instance> <window> <mouse button>).  These blips come fromÏ*
              ;Ï1; the inspection history and always have flavor information in them.Ï*
              (AND (EQ (FIRST ucl::kbd-input) :value)
                   (TYPEP (SECOND ucl::kbd-input) 'inspection-data)
                   (SETQ inspection-data (SECOND ucl::kbd-input)))
	      ))
       ;Ï1; Have the INSPECTION-DATA handle the mouse blip.  (Ï*
       ;Ï1; Each type of info handles the various mouse buttons differently.)Ï*
       (SEND inspection-data :handle-mouse-click ucl::kbd-input self))
      ((AND *general-inspector-enabled*
	    (EQ (FIRST ucl::kbd-input) :value)
	    (SETQ inspection-data (map-into-show-x (SECOND ucl::kbd-input) t)))
       (SEND inspection-data :handle-mouse-click ucl::kbd-input self))
      ((EQ (FIRST ucl::kbd-input) :line-area)
       (SELECTOR (FOURTH ucl::kbd-input) eql
         (#\Mouse-l   (SEND self :inspect-info-left-click))
	 ;Ï1; modeed here by JPR to support perspectives.Ï*
	 (#\Mouse-l-2 (SEND self :inspect-info-left-2-click))
	 ;Ï1;; This only gets called when the line area mouse blinker is onÏ*
	 ;Ï1;; i.e. we only get removal in this special case, otherwise normalÏ*
	 ;Ï1;; mouse-m action applies.Ï*
         (#\Mouse-m
          ;Ï1; Delete from line areaÏ*
          (SEND history :flush-object (inspect-real-value ucl::kbd-input))
          (SEND history :set-cache nil)
          ;Ï1; make sure the pane is unlocked if they deleted that itemÏ*
          (LOOP for iw in inspectors
                when (EQ (inspect-real-value ucl::kbd-input) (SEND iw :current-object))
                do (SEND iw :set-locked-p nil))
          (update-panes))
	 (t
          (SEND self :inspect-info-right-click))))
      ;Ï1; Middle click on inspected Lisp object--inspect it, leaving source in one of the windowsÏ*
      ((EQL (FOURTH ucl::kbd-input) #\Mouse-m)
       (SEND self :set-up-equal (inspect-real-value ucl::kbd-input)))
      ((EQL (FOURTH ucl::kbd-input) #\Mouse-l-2)
       ;Ï1; modded here by JPR to support perspectives.Ï*
       (SEND self :inspect-info-left-2-click))
      ;Ï1; right Click on inspected Lisp Object-- inspect its function definition, or itself if no function.Ï*
      ((EQL (FOURTH ucl::kbd-input) #\Mouse-r)
       (SEND self :inspect-info-right-click))
      ((key-state :hyper)
       ;Ï1; Hyper means modify the slot we are pointing at.Ï*
       (IF (OR (NULL (FIRST ucl::kbd-input)) (NULL (GET (FIRST ucl::kbd-input) 'set-function)))
           (FORMAT user "Ï3~&Cannot set this component.Ï*")
           (PROGN
             (inspect-set-slot ucl::kbd-input user history inspectors)
             (update-panes)))
       (SEND self :handle-prompt))
      (t ;Ï1; Otherwise inspect UCL:KBD-INPUT.Ï*
       (SEND self :inspect-info-left-click)))))

(DEFMETHOD Ï4(general-inspector :inspect-info-right-clickÏ*) ()
  (BEEP))

(DEFUN Ï4get-all-menu-specifiersÏ* (flavor-name)
"Ï2Gets the menu specifiers property from the flavor.Ï*"
  (LET ((menus (GET flavor-name :all-menu-specifiers)))
       (IF menus
	   (APPLY #'APPEND (MAPCAR #'SYMBOL-VALUE menus))
	   (FERROR nil
		   "Ï3~A frame does not have a :all-menu-specifiers propertyÏ*"
		   flavor-name))))

(DEFUN Ï4get-all-command-tablesÏ* (flavor-name)
"Ï2Gets the all-command-tables property from the flavor.Ï*"
  (LET ((names (GET flavor-name :all-command-table-names)))
       (IF names
	   (APPLY #'APPEND (MAPCAR #'SYMBOL-VALUE names))
	   (FERROR nil
		   "Ï3~A frame does not have a :all-command-table-names propertyÏ*"
		   flavor-name))))

(DEFUN Ï4get-all-command-table-namesÏ* (flavor-name)
"Ï2Gets the all-command-table-names property from the flavor.Ï*"
  (LET ((names (GET flavor-name :all-command-table-names)))
       (IF names
	   (APPLY #'APPEND
		  (MAPCAR #'(lambda (a-name)
			      (MAPCAR #'FIRST (SYMBOL-VALUE a-name)))
			    names))
	   (FERROR nil
		   "Ï3~A frame does not have a :all-command-table-names propertyÏ*"
		   flavor-name))))

(DEFMETHOD Ï4(general-inspector :number-of-menu-pane-rowsÏ*) ()
"Ï2Returns the number of menu pane rows to have in the general inspector.Ï*"
  *general-inspector-number-of-menu-pane-rows*)

(DEFSTRUCT Ï4(inspector-constraintÏ* :named)
  menu-string
  menu-doc-string
  number-of-inspectors
  constraint)

(DEFVAR Ï4*all-inspector-constraints*Ï*
       `(,#'(lambda (window inspectors noi)
	      (make-inspector-constraint
		:menu-string "Ï3Three PanesÏ*"
	        :menu-doc-string "Ï3Three panes stacked one above the other.Ï*"
	        :number-of-inspectors 3
		:constraint
		`(:three-panes
		   ,(REVERSE `(interactor menu history ,@inspectors))
		   ((interactor 5 :lines))
		   ((menu ,(SEND window :number-of-menu-pane-rows) :lines))
		   ((history 4 :lines))
		   ,(MAPCAR
		      #'(lambda (name1)
			  `(,name1 :limit (1 36 :lines)
			    ,(/ 0.3s0 (1- noi)) :lines))
		      (CDR inspectors))
		   ((,(CAR inspectors) :even)))))
	 ,#'(lambda (window inspectors noi)
	      (IGNORE noi)
	      (make-inspector-constraint
		:menu-string "Ï3One big inspectorÏ*"
		:menu-doc-string "Ï3Just one king-sized inspect pane.Ï*"
		:number-of-inspectors 1
		:constraint
		`(:one-pane
		   (,(CAR inspectors) menu history interactor)
		   ((interactor 4 :lines))
		   ((menu ,(SEND window :number-of-menu-pane-rows) :lines))
		   ((history 4 :lines))
		   ((,(CAR inspectors) :even)))))
	 ,#'(lambda (window inspectors noi)
	      (IGNORE inspectors noi)
	      (make-inspector-constraint
		:menu-string "Ï3Two panes one above the otherÏ*"
		:menu-doc-string "Ï3Two panes of equal size, one above the otherÏ*"
		:number-of-inspectors 2
		:constraint
		`(:two-horizontal-panes
		   ,(REVERSE `(interactor menu history inspector-2 inspector-1))
		   ((interactor 4 :lines))
		   ((menu ,(SEND window :number-of-menu-pane-rows) :lines))
		   ((history 4 :lines))
		   ((inspector-1 0.5))
		   ((inspector-2 :even)))))
	 ,#'(lambda (window inspectors noi)
	      (IGNORE inspectors noi)
	      (make-inspector-constraint
		:menu-string "Ï3Two panes one beside the otherÏ*"
		:menu-doc-string "Ï3Two panes of equal size, one beside the otherÏ*"
		:number-of-inspectors 2
		:constraint
		`(:two-vertical-panes
		   ,(REVERSE `(interactor menu history side-by-side))
		   ((interactor 4 :lines))
		   ((menu ,(SEND window :number-of-menu-pane-rows) :lines))
		   ((history 4 :lines))
		   ((side-by-side :horizontal (:even)
				  (inspector-2 inspector-1)
				  ((inspector-1 0.5))
				  ((inspector-2 :even)))))))
	 ,#'(lambda (window inspectors noi)
	      (IGNORE noi)
	      (make-inspector-constraint
		:menu-string "Ï3DebugÏ*"
		:menu-doc-string
		"Ï3One small inspect pane and a huge interactor pane.Ï*"
		:number-of-inspectors 1
		:constraint
		`(:debug
		   (,(CAR inspectors) menu history interactor)
		   ((interactor 35 :lines))
		   ((menu ,(SEND window :number-of-menu-pane-rows) :lines))
		   ((history 4 :lines))
		   ((,(CAR inspectors) :even)))))
	)
"Ï2A list of functions that deal with constraints for general inspectors.
Each function takes (frame list-of-inspectors number-of-inspectors) as its
args.  It must return a defstruct instance of the type Inspector-Constraint.Ï*")

(DEFMETHOD Ï4(general-inspector :get-constraintsÏ*) (noi)
"Ï2Gets the constraints for the general inspector, given the number of
 inspect panes.  This was abstracted from the :before :init method.Ï*"
  (MAPCAR #'(lambda (item)
	      (inspector-constraint-constraint
		(FUNCALL item self inspectors noi)))
	    *all-inspector-constraints*))

(DEFMETHOD Ï4(general-inspector :choose-constraint-with-menuÏ*) ()
"Ï2Gets the constraints for the general inspector, given the number of
 inspect panes.  This was abstracted from the :before :init method.Ï*"
  (w:menu-choose
    (MAPCAR #'(lambda (item)
		(LET ((spec (FUNCALL item self inspectors (LENGTH inspectors))))
		     (LIST (inspector-constraint-menu-string spec)
			   :value (FIRST (inspector-constraint-constraint spec))
			   :documentation
			     (inspector-constraint-menu-doc-string spec))))
	      *all-inspector-constraints*)
    :label "Ï3Choose a new inspector configurationÏ*"
    :scrolling-p nil))

;Ï1;; TI code patched by JPR.Ï*
(DEFMETHOD Ï4(general-inspect-window :toggle-lockÏ*) ()	;Ï1!Ï*
  (LET* ((iframe (SEND self :superior))
         (inspectors (SEND iframe :inspectors))
						;Ï1(num-inspectors (LENGTH inspectors))Ï*
         (config (SEND iframe :configuration))
         (num-of-locked-panes (LOOP for el in inspectors
                                    counting (SEND el :locked-p) into x
                                    finally (RETURN x)))
         (lock-x (- (SEND self :width) 50.))
         (lock-y 3.))
    (COND (locked-p (SETQ locked-p nil)
		    (w:prepare-sheet (self)
		      (w:draw-char
			(SEND (SEND iframe :superior)
			      :parse-font-descriptor 'fonts:icons)
			98. lock-x lock-y w:alu-andca self)))
          (t
	   (LET ((entry (FIND-IF #'(lambda (spec)
				     (EQ config
					 (FIRST
					   (inspector-constraint-constraint
					     (FUNCALL spec iframe inspectors
						      (LENGTH inspectors))))))
				 *all-inspector-constraints*)))
	     (IF (AND entry
		      (< num-of-locked-panes
			 (- (inspector-constraint-number-of-inspectors
			      (FUNCALL entry iframe inspectors
				       (LENGTH inspectors)))
			    1)))
		 (PROGN (SETQ locked-p t)
			(w:prepare-sheet (self)
			  (w:draw-char
			    (SEND (SEND iframe :superior)
				  :parse-font-descriptor 'fonts:icons)
			    98. lock-x lock-y w:alu-xor self)))
		 (BEEP)))))))

(DEFMETHOD Ï4(general-inspect-window :help-stringÏ*) ()
"Ï2Returns the help string for the general inspector.  This was abstracted from
 the :before :init method.Ï*"
  (IF (SEND superior :flavor-inspect-p)
      (IF (clos-p)
          "Ï3Inspection Pane.  To inspect a flavor or class, type its name.  To inspect a method, type <flavor name> <method name>
Press HELP for a help menu, META-HELP for help on typed expressions.  R2: System Menu.Ï*"
	  "Ï3Inspection Pane.  To inspect a flavor, type its name.  To inspect a method, type <flavor name> <method name>
Press HELP for a help menu, META-HELP for help on typed expressions.  R2: System Menu.Ï*" )
      "Ï3Inspection Pane.Ï*"))

(DEFMETHOD Ï4(general-inspector :set-up-inspectorsÏ*) (noi)
"Ï2Sets up Noi inspect panes for self.  This is done at frame init time.Ï*"
  (DOTIMES (i noi)
    (LET ((name1 (INTERN (FORMAT () "Ï3INSPECTOR-~DÏ*" i) "Ï3TVÏ*")))
	(PUSH `(,name1 ,(IF (= i (1- noi))
			    'general-inspect-pane-with-typeout
			    'general-inspect-pane)
                :current-object-who-line-message
		,(FUNCTION (lambda (current-object)
			     (COND
			       ((EQUAL current-object '(nil))
				(SEND (tv:window-under-mouse) :help-string)
			       )
			       ((TYPEP current-object 'flavor-operation-mixin)
				`(:mouse-l-1 "Ï3Select data to inspectÏ*"
				  :mouse-m-1 "Ï3Help on currently displayed dataÏ*"
				  :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
				  :mouse-r-1
				  ,(OR (CATCH-ERROR
					 (FORMAT
					   () "Ï3Menu of operations on ~sÏ*"
					   (flavor-or-class-name
					     (SEND current-object :data)))
					 nil)
				       "")))
			       (t '(:mouse-l-1
				     "Ï3Choose an item to inspectÏ*"))))))
              panes)
	(PUSH name1 inspectors))))

(DEFMETHOD Ï4(general-inspector :non-inspect-panesÏ*) ()
"Ï2Returns a list of the non inspect panes for self.  This is used at init time.Ï*"
  (LIST `(interactor inspector-interaction-pane
	  :label nil
	  :more-p nil
	  :font-map  ,(LIST (FIRST *inspector-font-map*)
			    (SECOND *inspector-font-map*))
	  :who-line-message
	  "Ï3To inspect something use the <Mode> menu option to get the right input behaviour and then type what you want to inspect.
Press HELP for a help menu, META-HELP for help on typed expressions.  R2: System Menu.Ï*")
	`(history general-inspector-history-window
          :line-area-mouse-doc
	  (:mouse-l-1 "Ï3Inspect the indicated dataÏ*"
	   :mouse-m-1 "Ï3Remove it from the InspectorÏ*"
	  )
	  :normal-mouse-documentation
	  (:mouse-l-1 "Ï3Select data to inspectÏ*"
	   :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
	   :mouse-r-2 "Ï3System MenuÏ*"))
	`(menu inspector-menu-pane)))

(DEFMETHOD Ï4(general-inspector :before :initÏ*) (plist)
"Ï2Sets up a general inspector.  I don't like doing it like this.  I inherited it
 from the flavor inspector.  In fact we have to advisingly shadow the method
 for the flavor inspector in order to get it to work at all.Ï*"
  (UNLESS inspectors
	  (LET ((noi (OR (GET plist :number-of-inspectors) 3)))
	       (SETQ panes (SEND self :non-inspect-panes))
	       (SEND self :set-up-inspectors noi)
	       (SETQ constraints (SEND self :get-constraints noi)))))

(DEFCOMMAND Ï4:toggle-config-cmdÏ* nil
  '(:description  "Ï3Select a new inspector pane configuration.Ï*"
    :names ("Ï3ConfigÏ*") 
    :keys (#\s-c))
  (DECLARE (SPECIAL frame))
  (LET ((new-cfg (IF (AND *general-inspector-enabled*
			  (TYPEP frame 'general-inspect-window))
		     (SEND frame :choose-constraint-with-menu)
		     ;Ï1; Ï*TAC 08-17-89Ï1 - until old flavor inspectors go away entirely, keep old way around.Ï*
		     (w:menu-choose '(:three-panes :one-pane :two-horizontal-panes :two-vertical-panes)
                                        :label "Ï3Choose a new flavor-inspector configurationÏ*" :scrolling-p nil))))
       (delaying-screen-management 
	 (COND (new-cfg
		(SETQ *general-inspector-configuration* new-cfg)
		(SEND frame :set-configuration new-cfg))))))

(DEFCOMMAND Ï4(general-inspector :documentation-cmdÏ*) ()
  '(:description 
    "Ï3Display some brief documentation about each of the Inspector's panes.Ï*"
    :names ("Ï3HelpÏ*")
    :keys (#\c-help))
  (gi-doc-cmd))

(DEFUN Ï4mode-undo-functionÏ* (mode-spec)
"Ï2If a mode has an undo function to be executed when the mode is exited then this
 is the function that gets it.Ï*"
  (SIXTH mode-spec))

(DEFUN Ï4mode-setup-functionÏ* (mode-spec)
"Ï2If a mode has an setup function to be executed when the mode is entered
 then this is the function that gets it.Ï*"
  (FIFTH mode-spec))

(DEFCOMMAND Ï4:lisp-mode-cmdÏ* nil	
  '(:description
    "Ï3Toggle between Lisp mode, Inspect mode and Flavor\/Class Inspect Mode....Ï*" 
    :names ("Ï3ModeÏ*")
    :keys (#\s-m))
  (DECLARE (SPECIAL ucl::prompt frame))
  (MULTIPLE-VALUE-BIND (IGNORE current-index)
      (FIND ucl::prompt (SEND frame :all-prompts)
	    :key #'FIRST :test #'STRING-EQUAL)
      
       (LET ((old (IF current-index
		      (NTH current-index (SEND frame :all-prompts))
		      nil))
	     ;Ï1; Finds the index for the current mode in the mode list and findsÏ*
	     ;Ï1; the next one as appropriate.  It sets upt the typein modesÏ*
	     ;Ï1; and all that sort of thing for the incoming mode and calls anyÏ*
	     ;Ï1; mode undo/setup functions that apply.Ï*
	     (selected (NTH (IF (OR (NOT current-index)
				    (EQUAL (+ 1 current-index)
					   (LENGTH (SEND frame :all-prompts))))
			        0
			        (+ 1 current-index))
			    (SEND frame :all-prompts))))
            (IF (mode-undo-function old)
		(FUNCALL (mode-undo-function old))
		nil)
	    (SETQ ucl::prompt (FIRST selected))
	    (SEND frame (SECOND selected))
	    (SEND frame :set-typein-modes (THIRD selected))
	    (SEND frame :set-active-command-tables
		  (MAPCAR #'FIRST (SYMBOL-VALUE (FOURTH selected))))
	    (IF (mode-setup-function selected)
		(FUNCALL (mode-setup-function selected))
		nil)
	    (SEND frame :handle-prompt))))

(DEFCOMMAND Ï4modeÏ* ()
   '(:description "Ï3Toggle between Lisp mode and Inspect mode.Ï*"
     :names ("Ï3ModeÏ*")
     :keys (#\s-m))
   (DECLARE (SPECIAL ucl::typein-modes ucl::prompt frame))
   ;Ï1;; Patch put in here by JPR.Ï*
   (IF (AND *general-inspector-enabled* 
	    (TYPEP frame 'general-inspect-window))
       (:lisp-mode-cmd)
       (PROGN (COND
		((MEMBER 'flavor-names ucl::typein-modes :test #'EQ)
		 (SETQ ucl::prompt "Ï3> Ï*")
		 (SETQ ucl::typein-modes ucl::*default-typein-modes*))
		(t (SETQ ucl::prompt (IF (clos-p) "Ï3Flavor\/Class\/Method: Ï*" "Ï3Flavor\/Method: Ï*"))
		   (SETQ ucl::typein-modes
			 '(method-specs flavor-instance flavor-names ucl::command-names))))
	      (SEND ucl::this-application :handle-prompt))))

(DEFMETHOD Ï4(general-inspector :set-inspectÏ*) ()
"Ï2Turns on inspect mode, switching off flavor inspecting.Ï*"
  (SETQ flavor-inspect-p nil)
  (SEND self :set-inspection-data-active? nil))

(DEFMETHOD Ï4(general-inspector :set->Ï*) ()
"Ï2Switches on lisp interaction mode.Ï*"
  (SETQ flavor-inspect-p nil)
  (SEND self :set-inspection-data-active? nil))

(DEFMETHOD Ï4(general-inspector :set-flavor/classÏ*) ()
"Ï2Switches on flavor/class/method input mode.Ï*"
  (SETQ flavor-inspect-p t)
  (SEND self :set-inspection-data-active? t))

(BUILD-MENU 'general-inspector-menu
	    'general-inspector
  :default-item-options `(:font ,*general-inspector-menu-item-font*)	
  :item-list-order general-inspector-menu-cmds)

(DEFUN Ï4assure-is-a-frameÏ* (window)
"Ï2Looks up the superiors of window until it finds a frame.Ï*"
  (IF window
      (IF (TYPEP window 'basic-frame)
	  window
	  (assure-is-a-frame (SEND window :superior)))
      nil))

(DEFUN Ï4find-or-create-inspect-windowÏ*
       (flavor &optional (current-window nil) (expose-p t) filter-function)
"Ï2Finds or creates an inspect window of the flavor Flavor.
 If filter function is supplied, it should be a function that can be applied to
 a window. This allows discrimination among windows sharing component flavors.Ï*"
  (LET ((iwin (OR current-window
		  (LET ((old-window ;Ï1; Ï*(find-window-of-flavor flavor)))
			  ;Ï1; TAC 08-18-89 - use a more discriminating function built from find-window-of-flavorÏ* 
			  (locate-a-window flavor current-window filter-function)))
		       (IF old-window
			   (assure-is-a-frame old-window)
			   nil))
		  (make-window flavor))))
       (IF expose-p
	   (SEND iwin ':mouse-select)
	   nil)
       iwin))

(DEFUN Ï4reinstall-commandsÏ* (frame)
"Ï2Reinstalls all inspector commands just in case they have changed.Ï*"
  (MAPCAR #'(lambda (table)
	      (BUILD-COMMAND-TABLE (FIRST table) (FOURTH table)
		(SYMBOL-VALUE (SECOND table))
		:init-options `(:name ,(THIRD table))))
	    (get-all-command-tables frame))
  (MAPCAR #'(lambda (menu)
	      (BUILD-MENU (FIRST menu) frame
		:default-item-options
		`(:font ,*general-inspector-menu-item-font*)
		:item-list-order (SYMBOL-VALUE (SECOND menu))))
	    (get-all-menu-specifiers frame))
  nil)

(DEFUN Ï4set-element-from-historyÏ* (symbol n nitems items)
"Ï2This is rather a complicated on.  It sets up something like the value of **
 from the inspector history.  Symbol is the thing to set.  N is the index to use
 into the history, for instance we would use 1 for *, 2 for **.  Nitems is the
 total number of items in the history and items is the items in the history (an
 array).  It gets the thing from the history and then transforms it into
 something suitable to put into the symbol.  For instance, if it is a show-x
 data thing, then it sees if it knows about :middle-button-result and :aux-data
 methods to find something suitable.Ï*"
  (IF (AND (INSTANCEP (AREF items (- nitems n)))
	   (SEND (AREF items (- nitems n)) :send-if-handles :data))
      (COND ((AND (CONSP (AREF items (- nitems n)))
		  (SEND (AREF items (- nitems n)) :send-if-handles
			:middle-button-result))
	     (SET symbol
		  (CAR (SEND (AREF items (- nitems n)) :middle-button-result)))
	     t)
	    ((AND (CONSP (AREF items (- nitems n)))
		  (SEND (AREF items (- nitems n)) :send-if-handles :aux-data))
	     (SET symbol (CAR (SEND (AREF items (- nitems n)) :aux-data)))
	     t)
	    ((EQ 'IGNORE (SEND (AREF items (- nitems n)) :data)) t)
	    (t (OR (SET symbol
			(SEND (AREF items (- nitems n))
			      :send-if-handles :middle-button-result))
		   (SET symbol
			(SEND (AREF items (- nitems n))
			      :send-if-handles :aux-data))
		   (SET symbol
			(LET ((data (SEND (AREF items (- nitems n)) :data)))
			     (TYPECASE data
			       (si::flavor (si::flavor-name data))
			       (otherwise data)))))))
      (SET symbol (AREF items (- nitems n)))))

(DEFMETHOD Ï4(general-inspector :update-*Ï*) ()
  (LET ((items (SEND history :items)))
       (LET ((nitems (IF items (ARRAY-ACTIVE-LENGTH items) 0)))
            (IF (>= nitems 1) (set-element-from-history '*   1 nitems items))
	    (IF (>= nitems 2) (set-element-from-history '**  2 nitems items))
	    (IF (>= nitems 3) (set-element-from-history '*** 3 nitems items)))))

(DEFUN Ï4swap-system-keysÏ*
       (from to &optional (froms-window-type-was nil) (for-system nil))
"Ï2Moves the system key whose key stroke is From to the key To.  If From's window
 type was is specified then it checks to make sure that the window type of the
 system key definition on From is what you think is should be, i.e. it hasn't
 been redefined by soneone.  If it has been then you don't want to do the swap,
 since you'll be moving the wrong functionality onto To.  If For-System is
 specified, then it is the name of the system that defined the tool that's on
 the system key.  This is important, since the system definition can have a
 pointer to the system key that it thinks it should be using.  This means that
 unless this is updated you can loose after warm boots/band builds because
 these system keys are often reset in warm initializations.Ï*"
  (LET ((old (ASSOC from tv:*system-keys*))
	(target (ASSOC to tv:*system-keys*)))
       (IF (REST target)
	   (FORMAT *error-output* "Ï3~&Target system-key ~A already defined.Ï*" to)
	   (IF (AND froms-window-type-was
		    (NOT (EQUALP (SECOND old) froms-window-type-was)))
	       (FORMAT *error-output*
		       "Ï3~&System key ~A already seems to have been swapped.Ï*"
		       from)
	       (IF (REST old)
		   (PROGN (tv:remove-system-key from)
			  (APPLY #'tv:add-system-key to (REST old))
			  (IF for-system
			      (LET ((system (sys::find-system-named for-system)))
				   (IF (AND (TYPEP system 'sys::system)
					    (GETF (sys::system-plist system)
						  :instance-type))
				       (SETF (GETF (sys::system-plist system)
						   :default-system-key)
					     to)
				       nil))
			      nil))
		   nil)
	       nil))))

(DEFUN Ï4general-inspector-print-values?Ï* ()
  (DECLARE (:self-flavor basic-inspect-frame))
  (DECLARE (SPECIAL ucl:prompt ucl:input-mechanism history))
  (AND (ucl::abnormal-command?)
       (IF (STRING-EQUAL ucl:prompt "Ï3> Ï*")
           (PROGN
	     ;Ï1;; I see no reason why it should update panes here, even thoughÏ*
	     ;Ï1;; the patch to the inspector does.Ï*
	     ;Ï1;; The user can always hit refresh if he has typed something thatÏ*
	     ;Ï1;; might affect something on the screen.Ï*
;Ï1            (update-panes)Ï*
             t)
	   (UNLESS (EQ ucl:input-mechanism 'ucl::unknown)
	     (LET ((thing (inspect-real-value `(:value ,(CAR \/) ,history))))
	          (inspect-flush-from-history thing history)
		  (SEND history :append-item thing)
		  (update-panes)
		  nil)))))

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

;Ï1;; Patches....Ï*

;Ï1; RDA: fix this so exiting from INSPECT* with the END key worksÏ*
(DEFCOMMAND Ï4(flavor-inspector :end-cmdÏ*) ()
  '(:description "Ï3Exit the Flavor Inspector.Ï*"
    :names ("Ï3ExitÏ*")
    :keys (#\End))
  (DECLARE (SPECIAL = inspect*-quit))
  (IF (AND (BOUNDP 'inspect*-quit)
	   inspect*-quit)
      (SEND self :quit =) 
      (SEND self :bury)))

(DEFMETHOD Ï4(show-flavor :format-conciselyÏ*) (STREAM)
  (IF (AND *general-inspector-enabled* (TYPEP stream 'inspect-history-window))
      (FORMAT stream "Ï3Flavor ~sÏ*" (si::flavor-name data))
      (FORMAT stream "Ï3~sÏ*" (si::flavor-name data))))

(DEFUN Ï4select-flavor-inspectÏ* (window)
"Ï2Keeps setting the input mode of window until it sees that it's in flavor/class
 input mode.Ï*"
  (IF (SEARCH "Ï3flavorÏ*" (SEND window :prompt) :test #'STRING-EQUAL)
      nil
      (LET ((frame window)
	    (ucl:prompt (SEND window :prompt)))
	   (DECLARE (SPECIAL ucl::prompt frame))
	   (:lisp-mode-cmd)
	   (select-flavor-inspect window))))

;Ï1-------------------------------------------------------------------------Ï*
;Ï1 TAC 08-15-89 - this binding already seems to be there, this advise is not needed.Ï*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE Print-Item-Concisely :Around :Mouse-Sensitivity-Addition nilÏ*
;Ï1    ;; Bind *printing-mouse-sensitively* because this is a good place to have mouse sensitive objects.Ï*
;Ï1    (LET ((*printing-mouse-sensitively* t))Ï*
;Ï1      (DECLARE (SPECIAL *printing-mouse-sensitively*))Ï*
;Ï1      :Do-It)))Ï*
;Ï1-------------------------------------------------------------------------Ï*
;Ï1;; TI code.Ï*
(DEFUN Ï4print-item-conciselyÏ* (item stream &optional (level 0))
  "Ï2Print ITEM on STREAM in a summarized fashion.
LEVEL is the depth in recursive calls to this function.Ï*"
  ;Ï1; Modded here by JPR to subsume inspection-data-print-item-concisely.Ï*
  ;Ï1; Too many bits of the inspector call this function directly.Ï*
  ;Ï1; Bind *printing-mouse-sensitively* because this is a good place to have mouse sensitive objects.Ï*
  (LET ((*printing-mouse-sensitively* t))
       (DECLARE (SPECIAL *printing-mouse-sensitively*))
       (IF (AND (TYPEP item 'inspection-data)
		;Ï1; This test added by JPR.Ï*
		(OR (AND *general-inspector-enabled*
			 (TYPEP (SEND stream :superior) 'general-inspector))
		    (send-if-handles (SEND stream :superior)
					:inspection-data-active?)))
	   (SEND item :format-concisely stream)
	   (LET ((type (DATA-TYPE item)))
	     (IF (MEMBER type '(dtp-list dtp-stack-list))
		 (COND
		   ((EQ (CAR item) 'QUOTE)
		    (SEND stream :tyo #\')
		    (SEND stream :item1 (CADR item) :value #'print-item-concisely (1+ level)))
		   ((AND *print-level* (>= level *print-level*))
		    (SEND stream :string-out (si::pttbl-prinlevel *readtable*)))
		   (t (DO ()
			  ((OR (ATOM item) (NEQ (CAR item) 'QUOTE)))
			(SETQ item (CADR item)))
		      (SEND stream :tyo (si::pttbl-open-paren *readtable*))
		      (DO ((l item (CDR l))
			   (flag nil t)
			   (i 1 (1+ i)))
			  ((ATOM l)
			   (COND
			     (l (SEND stream :string-out (si::pttbl-cons-dot *readtable*))
				(SEND stream :item1 l :value #'print-item-concisely (1+ level))))
			   (SEND stream :tyo (si::pttbl-close-paren *readtable*)))
			(AND flag
			     (SEND stream :tyo (si::pttbl-space *readtable*)))
			(SEND stream :item1 (CAR l) :value #'print-item-concisely (1+ level))
			(COND
			  ((AND *print-length* (>= i *print-length*))
			   (SEND stream :string-out (si::pttbl-prinlength *readtable*))
			   (FUNCALL stream ':tyo (si::pttbl-close-paren *readtable*)) ;Ï1?Ï*
			   (RETURN ()))))))
		 (PROGN
		   (CASE type
			 (('compiled-function 'microcode-function) (FUNCALL stream :string-out "Ï3#'Ï*"))
			 (dtp-array
			   (AND (STRINGP item)
				(OR (AND (NOT (= level 0))
					 (> (ARRAY-ACTIVE-LENGTH item) 20))
				    (POSITION #\Newline (THE string (STRING item)) :test #'CHAR-EQUAL))
				(SETQ item "Ï3...Ï*"))))
		   (PRIN1
		     (CASE type
			   (dtp-symbol
			     (IF (POSITION #\Newline (THE string (STRING (SYMBOL-NAME item))) :test #'CHAR-EQUAL)
				 (INTERN (STRING-SUBST-CHAR #\Space #\Newline (SYMBOL-NAME item))
					 (SYMBOL-PACKAGE item))
				 item))
			   (('compiled-function 'microcode-function)
			    (si:get-debug-info-field (si:get-debug-info-struct item) :name))
			   (otherwise item))
		     stream)))))))

;Ï1;; TI Code, modified by JPR.Ï*
(DEFUN Ï4inspection-data-print-item-conciselyÏ* (thing stream &optional (level 0))  ;Ï1fiÏ*
  ;Ï1; Send changed to Send-if-handles.  Frames, which are not inspect frames mayÏ*
  ;Ï1; still have this sort of window (debugger frames).  Such frames may notÏ*
  ;Ï1; have the extra IVs to cope with this message.Ï*
  ;Ï1; This binding added by JPR.Ï*
  (print-item-concisely thing stream level))

;Ï1;; Changed by JPR to allow for Mouse-L-2 behaviour.Ï*
(DEFMETHOD Ï4(basic-inspect :who-line-documentation-stringÏ*) ()  ;Ï1fiÏ*
  (COND 
    ;Ï1; If mouse is over an item containing an instance of INSPECTION-DATA, let the instance Ï*
    ;Ï1; provide the who-line-doc.  This is used in special-purpose inspectors (flavor inspector).Ï*
    ((AND sensitive-inspect-item 
	  (LET ((item (get-mouse-sensitive-item)))
	    (WHEN (AND (LISTP item) (TYPEP (THIRD item) 'inspection-data))
	      (SEND (THIRD item) :who-line-doc self)
	      ))))
    (sensitive-inspect-item
     (IF displaying-list
	 (COND (modify-mode
		'(:mouse-l-1 "Ï3Modify list itemÏ*" :mouse-r-1 "Ï3AbortÏ*"))
	       ((AND (NOT setting-mode) (key-state :hyper))
		'(:mouse-l-1 "Ï3Modify list itemÏ*"))
	       (setting-mode
		'(:mouse-l-1 "Ï3Set with this valueÏ*" :mouse-r-1 "Ï3AbortÏ*"))
	       (t
		(SEND self :get-normal-mouse-documentation)))
	 (COND (modify-mode
		'(:mouse-l-1 "Ï3Modify slotÏ*" :mouse-r-1 "Ï3AbortÏ*"))
	       ((AND (NOT setting-mode) (key-state :hyper)) 
		'(:mouse-l-1 "Ï3Modify slotÏ*"))
	       (setting-mode
		'(:mouse-l-1 "Ï3Set with this valueÏ*" :mouse-r-1 "Ï3AbortÏ*"))
	       (t
		(SEND self :get-normal-mouse-documentation)))))
    (displaying-list
     (COND ((OR modify-mode (AND (NOT setting-mode) (key-state :hyper)))
	    '(:mouse-l-1 "Ï3Choose a list item to modifyÏ*" :mouse-r-2 "Ï3System MenuÏ*"))
	   (setting-mode
	    '(:mouse-l-1 "Ï3Choose a list item to set withÏ*" :mouse-r-2 "Ï3System MenuÏ*"))
	   (t
	    '(:mouse-l-1 "Ï3Choose a list item to inspectÏ*" :mouse-r-1 "Ï3System MenuÏ*"))))
    (t
     (COND ((OR modify-mode (AND (NOT setting-mode) (key-state :hyper))) 
	    '(:mouse-l-1 "Ï3Choose a slot to modifyÏ*" :mouse-r-2 "Ï3System MenuÏ*"))
	   (setting-mode
	    '(:mouse-l-1 "Ï3Choose a value to set withÏ*" :mouse-r-2 "Ï3System MenuÏ*"))
	   (t
	    (SEND self :funcall-inside-yourself current-object-who-line-message current-object))))))

(DEFMETHOD Ï4(show-clos-class :who-line-docÏ*)
	   (inspection-pane? &optional no-sensitive-item?)
  (COND
    (no-sensitive-item?
     `(:mouse-l-1 "Ï3Choose an item to inspectÏ*"
       :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
       :mouse-r-1 ,(FORMAT nil "Ï3Menu of operations on ~AÏ*"
			   (class-pretty-name data))))
    (inspection-pane?
      '(:mouse-l-1 "Ï3Inspect this CLOS classÏ*"
        :mouse-m-1 "Ï3Set *Ï*"   ;Ï1; JPR.Ï*
        :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
	:mouse-r-1 "Ï3Menu of other operationsÏ*"))
    (t
     '(:mouse-l-1 "Ï3Inspect this CLOS ClassÏ*"
       :mouse-m-1 "Ï3Set *Ï*"   ;Ï1; JPR.Ï*
       :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
       :mouse-r-1 "Ï3Menu of other operationsÏ*"))))

(DEFMETHOD Ï4(flavor-operation-mixin :who-line-docÏ*)
	   (inspection-pane? &optional no-sensitive-item?)
  (COND
    (no-sensitive-item?
     `(:mouse-l-1 "Ï3Choose an item to inspectÏ*"
       :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
       :mouse-r-1 ,(FORMAT nil "Ï3Menu of operations on ~sÏ*"
			   (si::flavor-name data))))
    (inspection-pane?
      '(:mouse-l-1 "Ï3Inspect this flavor informationÏ*"
	:mouse-m-1 "Ï3Set *Ï*"  ;Ï1; JPR.Ï*
        :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
	:mouse-r-1 "Ï3Menu of other operationsÏ*"))
    (t
     '(:mouse-l-1 "Ï3Inspect this flavor informationÏ*"
       :mouse-m-1 "Ï3Set *Ï*"   ;Ï1; JPR.Ï*
       :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
       :mouse-r-1 "Ï3Menu of other operationsÏ*"))))


(DEFMETHOD Ï4(show-clos-method :who-line-docÏ*) (IGNORE &optional ignore)
  '(:mouse-l-1 "Ï3Inspect method detailsÏ*"
    :mouse-m-1 "Ï3Set *Ï*"   ;Ï1; JPR.Ï*
    :mouse-r-1 "Ï3Menu of method operationsÏ*"))


(DEFMETHOD Ï4(show-clos-generic-function :who-line-docÏ*) (IGNORE &optional ignore)
  '(:mouse-l-1 "Ï3Inspect generic function detailsÏ*"
    :mouse-m-1 "Ï3Set *Ï*"   ;Ï1; JPR.Ï*
    :mouse-r-1 "Ï3Menu of generic function operationsÏ*"))

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

(DEFUN Ï4maybe-allocate-locativeÏ* (something)
  "Ï2Returns an item for the inspector to represent Something.  If Something is a
 cons then it is of the form (<value> <locative-to-value>).  If the locative
 item is :No-Locative then a :List-structure (non-modifiable) item is generated,
 otherwise a Show-Data-With-Locative item is generated.  If something is not a
 cons then it is itemised non mouse sensitively in font 2.Ï*"
  (IF (CONSP something)
      (IF (EQUAL :no-locative (SECOND something))
	  (LIST :item1 :list-structure (FIRST something))
	  (LIST :item1 'show-data-with-locative
		(allocate-data 'show-data-with-locative (FIRST something)
			       (SECOND something))))
      (fontify-string (FORMAT nil "Ï3~aÏ*" something) 2)))

(DEFUN Ï4take-first-off-listsÏ* (lists)
"Ï2Is passed a list of lists of the form ((a b c) (d e f) (g h i)).  It returns
 the list ((a d g) (b e h) (c f i)).Ï*"
  (IF (FIRST lists)
      (CONS (MAPCAR #'FIRST lists)
	    (take-first-off-lists (MAPCAR #'REST lists)))
      nil))

(DEFUN Ï4join-value-listÏ* (value-list)
"Ï2Is passed a value list which will be itemised.  It returns a list like the
 value-list only any element which is of the form (:wide (...)) is appended
 into the list.  Thus (a b c (:wide (d e f)) g h) turns into (a b c d e f g h).Ï*"
  (IF value-list
      (IF (AND (CONSP (FIRST value-list))
	       (EQUAL :wide (FIRST (FIRST value-list))))
	  (APPEND (SECOND (FIRST value-list))
		  (join-value-list (REST value-list)))
	  (CONS (FIRST value-list) (join-value-list (REST value-list))))
      nil))

(DEFMETHOD Ï4(basic-inspect :object-generic-locatised-thingsÏ*)
 (title obj top-value top-value-title first-element-specialp &rest values
  &aux (maxl -1) result )
"Ï2 A generalised method which generates items for the inspector.
 Title - is a string used to describe Obj at the top of the display.
 Obj - is the thing which is actually being inspected.
 Top-Value - is either something to print out under the title, or :No
 Top-Value-Title - is a string used to describe Top-Value, unless Top-Values=:no
 First-Element-Specialp - Tells the method that the first list in Values is toÏ*
			Ï2  be treated specially (as row headers).
 Values - is a list of column specs for the columns of things to be printed.
          Each column spec is a list of the elements to be inspected.  Each
          element in the spec should be of the form:Ï*
		Ï2(<value> <locative-to-value>) - Modifiable mouse sensitive item.Ï*
		Ï2(<value> :No-Locative) - NonModifiable mouse sensitive item.Ï*
		Ï2<non-cons> - Non mouse sensitive value (error message)Ï*"
  (PUSH `(,title (:item1 named-structure-p ,obj)) result)
  (PUSH '("") result)
  (IF (NOT (EQUAL :no top-value))
      (PROGN (PUSH `(,top-value-title (:item1 named-structure-p ,top-value))
		   result)
	     (PUSH '("") result)))
  (IF (REST values)
      (IF first-element-specialp
	  (LET ((lists (take-first-off-lists (REST values))))
	       (DO ((l (FIRST values) (CDR l)))
		   ((NULL l) nil)
		 (SETQ maxl (MAX (FLATSIZE l) maxl)))
	       (LOOP for a-name in (FIRST values)
		     for value-list in lists
		     do
		     (PUSH `((,@(maybe-allocate-locative a-name))
			     (:colon ,(+ 2 (MIN 30 maxl)))
			     ,@(APPLY #'APPEND
				(LOOP for value
				      in (join-value-list value-list) collect
				  `((,@(maybe-allocate-locative value)) "Ï3 Ï*"))))
			    result)))
	  (LET ((lists (take-first-off-lists values)))
	       (LOOP for value-list in lists
		     do
		     (PUSH `(,@(APPLY #'APPEND
				(LOOP for value
				      in (join-value-list value-list) collect
				  `((,@(maybe-allocate-locative value)) "Ï3 Ï*"))))
			    result))))
      (LOOP for a-name in (FIRST values) do
	    (PUSH `((,@(maybe-allocate-locative a-name))) result)))
  (VALUES (NREVERSE result) obj 'inspect-printer))

(DEFMETHOD Ï4(basic-inspect :object-paired-thingÏ*)
           (title obj top-value names values
	    &optional (top-value-string "Ï3First value: Ï*"))
"Ï2 A generalised method which generates items for the inspector for pairs of
 things.
 Title - is a string used to describe Obj at the top of the display.
 Obj - is the thing which is actually being inspected.
 Top-Value - is either something to print out under the title, or :No
 Top-Value-Sting - is a string used to describe Top-Value, unless Top-Values=:no
 First-Element-Specialp - Tells the method that the first list in Values is toÏ*
			Ï2  be treated specially (as row headers).
 Names and Values - Are column specs for the columns of things to be printed.
          Each column spec is a list of the elements to be inspected.  Each
          element in the spec should be of the form:Ï*
		Ï2(<value> <locative-to-value>) - Modifiable mouse sensitive item.Ï*
		Ï2(<value> :No-Locative) - NonModifiable mouse sensitive item.Ï*
		Ï2<non-cons> - Non mouse sensitive value (error message)Ï*"
  (SEND self :object-generic-locatised-things
	title obj top-value top-value-string t names values))

(DEFUN Ï4maybe-show-list-named-structureÏ* (LIST)
"Ï2Is passed a list.  If it thinks that it can inspect it as a named structure
 then it allocates a Show-List-Named-Structure item.  If it can't inspect it
 then it returns the list, barfing.Ï*"
  (IF (GET (FIRST list) 'si::defstruct-description)
      (allocate-data 'show-list-named-structure list)
      (PROGN (BEEP)
	     (FORMAT *query-io* "Ï3~&~S is not the name of a defstruct type.Ï*"
		     (FIRST list))
	     list)))

;Ï1 TAC 09-05-89 - replaced belowÏ*
;(DEFUN Ï4get-typeÏ* (prompt)
;"Ï2Reads something from the user, prompting with Prompt.Ï*"
;  (DECLARE (SPECIAL user history = inspectors frame))
;  (letf ((#'inspect-get-value-from-user #'my-inspect-get-value-from-user))
;        (FORMAT user prompt)
;        (MULTIPLE-VALUE-BIND (value punt-p)
;	    (inspect-get-value-from-user user history inspectors)
;	  (IF punt-p
;	      (THROW :abort-tag nil)
;	      value))))

;Ï1 TAC 09-05-89 - from Sept 5th, 1989 message from JPRÏ*
(DEFUN Ï4get-typeÏ* (prompt)
"Ï2Reads something from the user, prompting with Prompt.Ï*"
  (DECLARE (SPECIAL user history = inspectors frame))
  (LET-IF (AND (NOT (BOUNDP 'user)) (BOUNDP 'eh::*window-debugger*))
	  ;Ï1; This big, hairy let-if put in so that this function can be called reasonably from the window debugger.Ï*
	  ((user (SEND eh::*window-debugger* :lisp-window))
	   (history (SEND eh:*window-debugger* :inspect-history-window))
	   (= nil)
	   (inspectors (LIST (SEND eh::*window-debugger* :inspect-window)))
	   (frame eh::*window-debugger*))
    (LETF ((#'inspect-get-value-from-user #'my-inspect-get-value-from-user))
	  (FORMAT user prompt)
	  (MULTIPLE-VALUE-BIND (value punt-p)
	      (inspect-get-value-from-user user history inspectors)
	    (IF punt-p
		(THROW :Abort-tag nil)
		value)))))

; TAC 09-05-89Ï1 - replaced with code below Ï*
;(DEFUN Ï4can-be-coerced-to-typeÏ* (something)
;"Ï2If something can be coerced into a defstruct type name then it is, otherwiseÏ*
;Ï2 it returns nil.Ï*"
;  (COND ((AND (SYMBOLP something) (GET something 'si::defstruct-description))
;	 something)
;	((AND (SYMBOLP something) (BOUNDP something))
;	 (can-be-coerced-to-type (SYMBOL-VALUE something)))
;	((AND (CONSP something) (CATCH-ERROR (EVAL something) nil))
;	 (can-be-coerced-to-type (EVAL something)))
;	(t nil)))

;Ï1 TAC 09-05-89 - from Sept 5th, 1989 message from JPRÏ*
(DEFUN Ï4can-be-coerced-to-typeÏ* (something)
"Ï2If something can be coerced into a defstruct type name then it is, otherwise
 it returns nil.Ï*"
  (COND ((AND (SYMBOLP something) (GET something 'si::defstruct-description))
	 something)
	((AND (SYMBOLP something) (BOUNDP something)
	      ;Ï1; Fix put in here by JPR to watch for something being self-evaluating.Ï*
	      (NOT (EQUAL something (SYMBOL-VALUE something))))
	 (can-be-coerced-to-type (SYMBOL-VALUE something)))
	((AND (CONSP something) (CATCH-ERROR (EVAL something) nil))
	 (can-be-coerced-to-type (EVAL something)))
	(t nil)))
      
(DEFUN Ï4read-type-nameÏ* ()
"Ï2Prompts the user for the name of a defstruct type and returns it.Ï*"
  (LET ((name (get-type "Ï3~&Name of structure type: Ï*")))
       (IF (can-be-coerced-to-type name)
	   (can-be-coerced-to-type name)
	   (PROGN (BEEP)
		  (FORMAT *query-io* "Ï3~&~S is not the name of a defstruct type.Ï*"
			  name)
		  (read-type-name)))))

(DEFUN Ï4maybe-show-list-unnamed-structureÏ* (LIST)
"Ï2Is passed a list and allocates a Show-List-Unnamed-Structure item to inspect
 it as a structure which is asked of the user.Ï*"
  (LET ((type-name (read-type-name)))
       (allocate-data 'show-list-unnamed-structure list type-name)))

(DEFUN Ï4maybe-show-list-offset-unnamed-structureÏ* (LIST)
"Ï2Is passed a list and allocates a Show-List-Offset-Unnamed-Structure item to
 inspect it as a structure which is asked of the user.Ï*"
  (LET ((type-name (read-type-name)))
       (allocate-data 'show-list-offset-unnamed-structure list type-name)))

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

(DEFFLAVOR Ï4list-inspection-mixinÏ*
	   () (data-as-aux-data-mixin inspection-data)
  :gettable-instance-variables
  :abstract-flavor
  (:documentation :mixin
"Ï3 A mixin which allows the system to inspect lists from different perspectives.
 Flavors are built on this one which hold the list in their Data slots and
 know how to print them specially.Ï*"))

(DEFMETHOD Ï4(list-inspection-mixin :handle-mouse-clickÏ*) (blip flavor-inspector)
"Ï2A mouse click handler for list perspectives.Ï*"
  (SELECTOR (FOURTH blip) =
    (#\mouse-l-1 (SEND flavor-inspector :inspect-info-left-click))
    (#\mouse-m-1 (SEND flavor-inspector :inspect-info-middle-click))
    (t (BEEP))))

(DEFWRAPPER Ï4(list-inspection-mixin :handle-mouse-clickÏ*)
	    ((blip flavor-inspector) &body body)
"Ï2A mouse click handler for list perspectives that knows about l2 behaviour.Ï*"
  `(LET ((object (find-inspection-object (SEND flavor-inspector :kbd-input))))
        (IF (AND (= (FOURTH blip) #\mouse-l-2) object)
	    (SEND flavor-inspector :inspect-info-left-2-click
		  object)
            . ,body)))

(DEFMETHOD Ï4(list-inspection-mixin :print-selfÏ*) (STREAM depth slashify)
"Ï2A print method for all things built on list-inspection-mixin.  This means
 that when one of these is inspected the Data is printed at the top of the
 screen, not #<list-inspection-mixin...>.Ï*"
  (IGNORE depth)
  (FORMAT stream "Ï3~ýÏ*" (LIST data t data) slashify))

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

(DEFFLAVOR Ï4data-as-aux-data-mixinÏ*
	   () (inspection-data)
  :abstract-flavor
  (:documentation :mixin
"Ï3 A mixin which provides an :aux-data method, which simply returns Data.  This is
 used so that Update-Panes sets * and such to the right thing.Ï*" )
)

(DEFMETHOD Ï4(data-as-aux-data-mixin :aux-dataÏ*) ()
"Ï2An :aux-data method, which simply returns Data.  This is
 used so that Update-Panes sets * and such to the right thing.Ï*"
  data)

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

(DEFFLAVOR Ï4show-data-with-locativeÏ*
	   (aux-data)
	   (list-inspection-mixin)
  :initable-instance-variables
  (:documentation
"Ï3 A Show-X flavor which shows Data in a simple way but also has a locative to
 Data stored in Aux-Data.  This allows the user to Modify the data that this
 represents.Ï*"))

(DEFMETHOD Ï4(show-data-with-locative :format-conciselyÏ*) (STREAM)
"Ï2A simple print method for show data with locatives.  It just prints the Data.Ï*"
  (FORMAT stream "Ï3~ýÏ*" (LIST data t data)))

(DEFMETHOD Ï4(show-data-with-locative :locativeÏ*) ()
"Ï2The locative is stored in the Aux-Data slot.  Perversely the :Aux-Data method
 actually returns Data.Ï*"
  aux-data)

(DEFMETHOD Ï4(show-data-with-locative :generate-item-specializedÏ*) (window)
"Ï2Generates an item for the Data.Ï*"
  (inspect-object-display-list data window))

(DEFMETHOD Ï4(show-data-with-locative :match?Ï*) (thing locative)
"Ï2Will match to any existing allocated data eq to Thing.Ï*"
  (IGNORE locative)
  (EQ data thing))

(DEFUN Ï4(:property show-data-with-locative set-functionÏ*)
       (item new-value object)
"Ï2Finds a show-data-with-locative [(third (second item))] and sets its data
 slot, smashing the locative so that they both have the value New-Value.Ï*"
  (IGNORE object)
  (LET ((show-thing (THIRD (SECOND item))))
       (SEND show-thing :set-data new-value)
       (SETF (CONTENTS (SEND show-thing :locative)) new-value)
       (SEND show-thing :data)))

(DEFMETHOD Ï4(basic-inspect :object-show-data-with-locativeÏ*) (object)
"Ï2A method which is used by the top level inspect-setup-object-display-list to
 inspect this.  In fact it just inspects the data slot.Ï*"
  (inspect-object-display-list (SEND object :data) self))

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

(DEFUN Ï4split-up-list-into-pairsÏ* (LIST)
"Ï2Given a plist (:a 42 :b 20 :c) is returns the values:
 i)  ((:a <locative to :a>) (:b <locative to :b>) (:c <locative to :c>))
 ii) ((42 <locative to 42>) (20 <locative to 20>) 
     \"No value matching this key\")Ï*"
  (IF (CONSP list)
      (IF (REST list)
	  (IF (AND (CONSP (REST list))
		   (OR (CONSP (REST (REST list)))
		       (NOT (REST (REST list)))))
	      (MULTIPLE-VALUE-BIND (names values)
		  (split-up-list-into-pairs (REST (REST list)))
		(VALUES (CONS (LIST (FIRST  list) (LOCF (FIRST  list))) names)
			(CONS (LIST (SECOND list) (LOCF (SECOND list))) values)))
	      (IF (CONSP (REST list))
		  (VALUES (LIST (LIST (FIRST  list) (LOCF (FIRST  list)))
				(LIST (REST (REST list))
				      (LOCF (REST (REST list)))))
			  (LIST (LIST (SECOND list) (LOCF (SECOND list)))
			      "Ï3 - Mal-formed PList (dotted before this element)Ï*"))
		  (VALUES (LIST (LIST (FIRST list) (LOCF (FIRST list)))
				(LIST (REST  list) (LOCF (REST  list))))
			  (LIST (LIST (REST list) (LOCF (REST list)))
			      "Ï3 - Mal-formed PList (dotted before this element)Ï*"))))
	  (VALUES (LIST (LIST (FIRST  list) (LOCF (FIRST  list))))
		  (LIST "Ï3No value matching this keyÏ*")))
      (IF list
	  (VALUES (LIST (LIST list :no-locative))
		  (LIST "Ï3Mal-formed PList (dotted at the end)Ï*"))
	  (VALUES nil nil))))

(DEFFLAVOR Ï4show-plistÏ*
	   () (list-inspection-mixin)
  (:documentation "Ï3A flavor of show-x, which displays a list as a Plist.Ï*"))

(DEFMETHOD Ï4(show-plist :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is a Plist representation of a
 list.Ï*"
  (FORMAT stream "Ï3Plist ~ýÏ*" (LIST data t data)))

(DEFMETHOD Ï4(show-plist :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it is displayed as a Plist.Ï*"
  (MULTIPLE-VALUE-BIND (names values) (split-up-list-into-pairs data)
    (SEND window :object-paired-thing
	  "Ï3PList representation of: Ï*" data :no names values)))

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

(DEFFLAVOR Ï4show-offset-plistÏ*
	   () (list-inspection-mixin)
  (:documentation 
"Ï3 A flavor of show-x, which displays a list as a Plist.  This differs from
 Show-Plist in that the display is offset by one.  This gives the user an
 alternative for aligning the keys with the values in the plist.Ï*"))

(DEFMETHOD Ï4(show-offset-plist :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is an offset Plist representation
 of a list.Ï*"
  (FORMAT stream "Ï3Offset Plist ~ýÏ*" (LIST data t data)))
	  
(DEFMETHOD Ï4(show-offset-plist :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it is displayed as an offset Plist.Ï*"
  (MULTIPLE-VALUE-BIND (names values) (split-up-list-into-pairs (REST data))
    (SEND window :object-paired-thing
	  "Ï3Offset PList representation of: Ï*" data (FIRST data) names values)))

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

(DEFUN Ï4locatise-elementsÏ* (LIST)
"Ï2Given the list (a b c)  it returns the list:
 ((a <locative to a>) (b <locative to b>) (c <locative to c>).Ï*"
  (IF (CONSP list)
      (CONS (LIST (FIRST list) (LOCF (FIRST list)))
	    (IF (OR (CONSP (REST list)) (NOT (REST list)))
		(locatise-elements (REST list))
		(LIST "Ï3.Ï*" (LIST (REST list) (LOCF (REST list))))))
      (IF list ;Ï1;; dotted listÏ*
	  (LIST (LIST list :no-locative))
	  nil)))

(DEFUN Ï4split-alist-upÏ* (LIST)
"Ï2Given an Alist of the form ((a 42) b (c 20 30)) [n.b. b is a bogus element] it
 returns the values:
 i)  ((a <locative to a>) (b <locative to b>) (c <locative to c>))
 ii) ((:wide (42 <locative to 42>)) \"This element was not a cons\"
      (:wide (20 <locative to 20>) (30 <locative to 30>)))Ï*"
  (IF (CONSP list)
      (MULTIPLE-VALUE-BIND (names values)
	  (IF (OR (CONSP (REST list)) (NOT (REST list)))
	      (split-alist-up (REST list))
	      (VALUES (LIST (LIST (REST list) (LOCF (REST list))))
		      (LIST "Ï3Mal-formed AList (dotted at the end)Ï*")))
	(IF (CONSP (FIRST list))
	    (IF (CONSP (REST (FIRST list)))
	        (VALUES (CONS (LIST (FIRST (FIRST list))
				    (LOCF (FIRST (FIRST list))))
			      names)
			(CONS (LIST :wide
				    (locatise-elements (REST (FIRST list))))
			      values))
		(VALUES (CONS (LIST (FIRST (FIRST list))
				    (LOCF (FIRST (FIRST list))))
			      names)
			(CONS (LIST :wide
				    (LIST "Ï3.Ï*"
					  (LIST (REST (FIRST list))
						(LOCF (REST (FIRST list))))))
			      values)))
	    (VALUES (CONS (LIST (FIRST list) (LOCF (FIRST list))) names)
		    (CONS "Ï3This element was not a consÏ*" values))))
      (IF list
	  (VALUES (LIST (LIST list :no-locative))
		  (LIST "Ï3Mal-formed AList (dotted at the end)Ï*"))
	  (VALUES nil nil))))

(DEFFLAVOR Ï4show-alistÏ*
	   () (list-inspection-mixin)
  (:documentation "Ï3A flavor of show-x, which displays a list as an Alist.Ï*"))

(DEFMETHOD Ï4(show-alist :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is an AList representation of a
 list.Ï*"
  (FORMAT stream "Ï3AList ~ýÏ*" (LIST data t data)))

(DEFMETHOD Ï4(show-alist :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it is displayed as an AList.Ï*"
  (MULTIPLE-VALUE-BIND (names values)
      (split-alist-up data)
    (SEND window :object-paired-thing
	  "Ï3AList representation of: Ï*" data :no names values)))

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

(DEFFLAVOR Ï4show-one-on-a-lineÏ*
	   () (list-inspection-mixin)
  (:documentation 
"Ï3 A flavor of show-x, which displays a list in such a way that each element is
 printed on a different line.Ï*"))

(DEFMETHOD Ï4(show-one-on-a-line :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is a one element on each line
 representation of a list.Ï*"
  (FORMAT stream "Ï3One-on-a-line ~ýÏ*" (LIST data t data)))

(DEFUN Ï4split-up-list-into-individual-elementsÏ* (LIST)
"Ï2Given the list (:a :b :c), it returns the list:
 ((:a <locative to :a>) (:b <locative to :b>) (:c <locative to :c>))Ï*"
  (IF (CONSP list)
      (LET ((REST (IF (OR (CONSP (REST list)) (NOT (REST list)))
		      (split-up-list-into-individual-elements (REST list))
		      (LIST "Ï3.Ï*" (LIST (REST list) (LOCF (REST list)))))))
	   (CONS (LIST (FIRST list) (LOCF (FIRST list))) rest))
      (IF list
	  (LIST "Ï3.Ï*" (LIST list :no-locative))
	  nil)))

(DEFMETHOD Ï4(show-one-on-a-line :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it displays each element on a fresh line.Ï*"
  (SEND window :object-generic-locatised-things
	"Ï3One-on-a-line representation of: Ï*" data :no nil nil
	(split-up-list-into-individual-elements data)))

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

(DEFUN Ï4split-up-into-defstruct-slotsÏ* (slots list)
"Ï2Is passed a list of slot names and a list of elements, which are to be
 interpressed as elements of an instance of the structure with the slots. 
 The special cases of there being too many or too few slot names are catered
 for.  Given the lists: (:a :b :c) (:d :e :f :g) it returns the values:
 i)  ((:a :no-locative) (:b :no-locative)
      (:c :no-locative) \"Slot names exhausted\")
 ii) ((:d <locative to :d>) (:e <locative to :e>)
      (:f <locative to :f>) (:g <locative to :g>))Ï*"
  (IF (CONSP list)
      (IF slots
	  (MULTIPLE-VALUE-BIND (names values)
	      (IF (OR (CONSP (REST list)) (NOT (REST list)))
		  (split-up-into-defstruct-slots (REST slots) (REST list))
		  (VALUES (LIST (LIST (FIRST slots) :no-locative)
				(LIST (REST list) (LOCF (REST list))))
			  (LIST
			    "Ï3******Ï*"
			     "Ï3Mal-formed defstruct (dotted before this element)Ï*")))
	    (VALUES (CONS (LIST (FIRST slots) :no-locative)        names)
		    (CONS (LIST (FIRST list)  (LOCF (FIRST list))) values)))
	  (MULTIPLE-VALUE-BIND (names values)
	      (IF (OR (CONSP (REST list)) (NOT (REST list)))
		  (split-up-into-defstruct-slots slots (REST list))
		  (VALUES (LIST "Ï3Slot names exhaustedÏ*"
				(LIST (REST list) (LOCF (REST list))))
			  (LIST "Ï3******Ï*" "Ï3Mal-formed defstruct (dotted at end)Ï*")))
	    (VALUES (CONS "Ï3Slot names exhaustedÏ*"                    names)
		    (CONS (LIST (FIRST list)  (LOCF (FIRST list))) values))))
      (IF list
	  (IF slots
	      (VALUES (LIST (LIST (FIRST slots) :no-locative)
			    (LIST list :no-locative))
		      (LIST "Ï3******Ï*"
			    "Ï3Mal-formed defstruct (dotted before this element)Ï*"))
	      (VALUES (LIST "Ï3Slot names exhaustedÏ*" (LIST list :no-locative))
		      (LIST "Ï3******Ï*" "Ï3Mal-formed defstruct (dotted at end)Ï*")))
	  (IF slots
	      (MULTIPLE-VALUE-BIND (names values)
		  (split-up-into-defstruct-slots (REST slots) (REST list))
		(VALUES (CONS (LIST (FIRST slots) :no-locative) names)
			(CONS "Ï3List elements exhaustedÏ*"          values)))
	      (VALUES nil nil)))))

(DEFFLAVOR Ï4show-list-named-structureÏ*
	   () (list-inspection-mixin)
  (:documentation
    "Ï3A flavor of show-x, which displays a list as a named structure.Ï*"))

(DEFMETHOD Ï4(show-list-named-structure :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is a Named structure
 representation of a list, whose type is (first Data).Ï*"
  (FORMAT stream "Ï3List as ~ý instance: ~ýÏ*"
	  (LIST (FIRST data) t (FIRST data)) (LIST data t data)))

(DEFMETHOD Ï4(show-list-named-structure :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it is displayed as a Named Structure.Ï*"
  (LET ((slot-names
	  (MAPCAR #'FIRST (si::defstruct-description-slot-alist
			    (GET (FIRST data) 'si::defstruct-description)))))
       (MULTIPLE-VALUE-BIND (names values)
	   (split-up-into-defstruct-slots (REST slot-names) (REST data))
	 (SEND window :object-paired-thing
	       "Ï3Named Structure representation of: Ï*" data (FIRST data)
	       names values "Ï3Type: Ï*"))))

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

(DEFFLAVOR Ï4show-list-unnamed-structureÏ*
	   (aux-data)
	   (list-inspection-mixin)
  (:documentation
"Ï3A flavor of show-x, which displays a list as a structure, whose name is
 specified by the user.Ï*"  )
  :initable-instance-variables)

(DEFMETHOD Ï4(show-list-unnamed-structure :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is a Named structure
 representation of a list, whose type is Aux-Data.Ï*"
  (FORMAT stream "Ï3List as ~ý instance: ~ýÏ*"
	  (LIST aux-data t aux-data) (LIST data t data)))

(DEFMETHOD Ï4(show-list-unnamed-structure :match?Ï*) (thing type)
"Ï2Will match to any existing allocated data eq to Thing and whose Aux-Data
 matches too.Ï*"
  (AND (EQ data thing) (EQ type aux-data)))

(DEFMETHOD Ï4(show-list-unnamed-structure :generate-item-specializedÏ*) (window)
"Ï2Generates items for Data so that it is displayed as a Structure, whose type is
 stored in Aux-Data.Ï*"
  (LET ((slot-names
	  (MAPCAR #'FIRST (si::defstruct-description-slot-alist
			    (GET aux-data 'si::defstruct-description)))))
       (MULTIPLE-VALUE-BIND (names values)
	   (IF (EQUAL (SECOND (GET aux-data 'si::defstruct-description))
		      'sys::named-list)
	       (split-up-into-defstruct-slots (REST slot-names) data)
	       (split-up-into-defstruct-slots slot-names data))
	 (SEND window :object-paired-thing
	       "Ï3Named Structure representation of: Ï*" data aux-data
	       names values "Ï3Type: Ï*"))))

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

(DEFFLAVOR Ï4show-list-offset-unnamed-structureÏ*
	   (aux-data)
	   (list-inspection-mixin)
  (:documentation
"Ï3A flavor of show-x, which displays a list as a structure, whose name is
 specified by the user, which is displayed offset to allow for a type name.Ï*")
  :initable-instance-variables)

(DEFMETHOD Ï4(show-list-offset-unnamed-structure :format-conciselyÏ*) (STREAM)
"Ï2Prints in the history panel showing that it is a Named structure
 representation of a list, whose type is Aux-Data.Ï*"
  (FORMAT stream "Ï3List as ~ý instance (offset): ~ýÏ*"
	  (LIST aux-data t aux-data) (LIST data t data)))

(DEFMETHOD Ï4(show-list-offset-unnamed-structure :match?Ï*) (thing type)
"Ï2Will match to any existing allocated data eq to Thing and whose Aux-Data
 matches too.Ï*"
  (AND (EQ data thing) (EQ type aux-data)))

(DEFMETHOD Ï4(show-list-offset-unnamed-structure :generate-item-specializedÏ*)
	   (window)
"Ï2Generates items for Data so that it is displayed as a Structure, whose type is
 stored in Aux-Data, which is offset to allow for an ignored type in the first
 of the list.Ï*"
  (LET ((slot-names
	  (MAPCAR #'FIRST (si::defstruct-description-slot-alist
			    (GET aux-data 'si::defstruct-description)))))
       (MULTIPLE-VALUE-BIND (names values)
	   (IF (EQUAL (SECOND (GET aux-data 'si::defstruct-description))
		      'sys::named-list)
	       (split-up-into-defstruct-slots (REST slot-names) (REST data))
	       (split-up-into-defstruct-slots slot-names (REST data)))
	 (SEND window :object-paired-thing
	       "Ï3Named Structure representation of: Ï*" data aux-data
	       names values "Ï3Type: Ï*"))))

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 TAC 08-15-89 - var moved to INSPECT.LISPÏ*

;Ï1(DEFVAR *update-panes-base-ok* tÏ*
;Ï1"When true this makes sure that when the inspector's panes are updated the item cache is not flushed.")Ï*

;Ï1 TAC 08-15-89 - advice moved to INSPECT.LISPÏ*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1     (ADVISE tv:update-panes :around :base-ok nilÏ*
;Ï1       (IF *update-panes-base-ok*Ï*
;	Ï1   (SETQ arglist (LIST t))Ï*
;	Ï1   nil)Ï*
;Ï1       :do-it))Ï*
;Ï1-------------------------------------------------------Ï*

(DEFVAR Ï4*flush-cache-if-left-button-on-something*Ï* nil
"Ï2When true this makes sure that when you left click on something in the
 inspector its cache entry will be flushed so that it will be completely
 recomputed.  Keeping this as Nil saved a lot of time.  If it is set to :really
 then all cache entries are flushed.Ï*")

;Ï1;; TI CodeÏ*
(DEFMETHOD Ï4(basic-inspect-frame :inspect-info-left-clickÏ*) ()  ;Ï1fiÏ*
  (LET ((thing (inspect-real-value ucl:kbd-input)))
    ;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    ;Ï1;; Modded here by JPR.Ï*
    (IF *flush-cache-if-left-button-on-something*
	(IF (EQUAL *flush-cache-if-left-button-on-something* :really)
	    (SEND history :set-cache nil)
	    (SEND history :flush-object-from-cache thing)))
    (update-panes)))

(DEFUN Ï4item-keyÏ* (x)
"Ï2Makes a key for sorting that we can sort with string-lessp. out of an
 itemised hash table entry.Ï*"
  (FORMAT nil "Ï3~SÏ*" (THIRD (FIRST x))))

(DEFMETHOD Ï4(basic-inspect :object-hash-tableÏ*) (obj)
"Ï2Inspects a hash table in the normal, useful way.Ï*"
  
  (VALUES (CONS `("Ï3Hash Table Elements:Ï*")
		 (make-window-items-for-hash-table obj))
	  obj 'inspect-printer))

;Ï1*************Ï*
;Ï1 TAC 08-04-89 - this code moved to INSPECT.LISPÏ*
;Ï1(defun make-window-items-for-hash-table (hash-table &Aux maxlength)Ï*
;Ï1"Takes the elements in a hash table and turns tham into a set of inspectorÏ*
;Ï1 items, sorted so that it's easy to find the ones you want.Ï*
;Ï1"Ï*
;Ï1   (Setq maxlength 0)Ï*
;Ï1   (sys:maphash #'(Lambda (key &Rest Ignore)Ï*
;Ï1                 (Setq maxlength (max (flatsize key) maxlength)))Ï*
;Ï1             hash-table)Ï*
;Ï1   (let ((list Ï*
;	Ï1   (sys:MapHash-ReturnÏ*
;	Ï1     #'(Lambda (key &Rest values)Ï*
;		Ï1 (AppendÏ*
;		Ï1   `((:Item1 Named-Structure-Value ,KeyÏ*
;			Ï1     ,#'(lambda (key stream)Ï*
;				Ï1  (format stream "~S" key)))Ï*
;		Ï1     (:colon ,(+ 2 maxlength)))Ï*
;		Ï1   (Mapcar #'(Lambda (value)Ï*
;			Ï1       `(:Item1 Named-Structure-ValueÏ*
;					Ï1,valueÏ*
;					Ï1,#'(lambda (value stream)Ï*
;					Ï1     (format stream "~S " value))))Ï*
;			Ï1   values)))Ï*
;	Ï1     hash-table)))Ï*
;Ï1     (sort list #'string-lessp :key 'item-key)))Ï*

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

(DEFFLAVOR Ï4show-hash-tableÏ*
	   ()
	   (generic-middle-button-mixin inspection-data)
  (:documentation
    "Ï3Shows a hash tables hash array elements.Ï*"))

(DEFMETHOD Ï4(show-hash-table :format-conciselyÏ*) (STREAM)
"Ï2Just prints it out.Ï*"
  (FORMAT stream "Ï3~SÏ*" data))

(DEFMETHOD Ï4(show-hash-table :generate-itemÏ*) (&aux result)
"Ï2Makes the inspector items for a hash-table.Ï*"
  (PUSH '("") result)
  (PUSH '("Ï3Hash Array ElementsÏ*") result)
  (PUSH '("") result)
  (LOOP for element in (make-window-items-for-hash-table data)
	do (PUSH element result)  )
  (PUSH '("") result)
  (VALUES (NREVERSE result)
	 `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~sÏ*" data))))

(DEFMETHOD Ï4(show-hash-table :helpÏ*) ()
"Ï2Gives help when you middle button on a defstruct.Ï*"
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the defstruct
instance ~S simply as a defstruct instance.  Mousing L2 on it should show it
to you in some other way.Ï*"
	  data))

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

(DEFFLAVOR Ï4show-generic-defstructÏ*
	   ()
	   (generic-middle-button-mixin inspection-data)
  (:documentation
    "Ï3A fall-back option perspective which allows defstruct instances that
 have their own magic inspector behaviour to be inspected also as the
 defstructs that implement them.Ï*"))

(DEFMETHOD Ï4(show-generic-defstruct :format-conciselyÏ*) (STREAM)
"Ï2Just prints it out but notes that it is a defstruct perspective.Ï*"
  (FORMAT stream "Ï3~ý as a Defstruct InstanceÏ*" (LIST data t data)))

(DEFMETHOD Ï4(show-generic-defstruct :generate-item-specializedÏ*)
           (window &aux (maxl -1) alist defstruct-items result nss d)
"Ï2Makes the inspector items for a defstruct.  The body of this was stolen
 from :object-named-structure (but with the hash-table stuff removed.Ï*"
  (SETQ nss (NAMED-STRUCTURE-P data))
  (PUSH `("Ï3Named structure of type Ï*" (:item1 named-structure-p ,nss)) result)
  (PUSH '("") result)
  (COND
    ((SETQ d (GET nss 'si::defstruct-description))
     (SETQ alist (si::defstruct-description-slot-alist d))
     (DO ((l alist (CDR l)))
	 ((NULL l) nil)
       (SETQ maxl (MAX (FLATSIZE (CAAR l)) maxl)))
     ;Ï1; For a named structure, each line contains the name and the valueÏ*
     (DO ((l alist (CDR l)))
	 ((NULL l) nil)
       (PUSH `((:item1 named-structure-slot ,(CAAR l))
	       (:colon ,(+ 2 maxl))
	       (:item1 named-structure-value
		       ,(CATCH-ERROR
			  (FUNCALL
			    (si::defstruct-slot-description-ref-macro-name
			      (CDAR l))
			    data)
			  nil)))
	     result)))
    ((SETQ defstruct-items (GET nss 'si::defstruct-items))
     (DOLIST (ELT defstruct-items)
       (SETQ maxl (MAX (FLATSIZE elt) maxl)))
     ;Ï1; For a named structure, each line contains the name and the valueÏ*
     (DOLIST (ELT defstruct-items)
       (PUSH `((:item1 named-structure-slot ,elt)
	       (:colon ,(+ 2 maxl))
	       (:item1 named-structure-value
		       ,(CATCH-ERROR (FUNCALL elt data) nil)))
	     result))))
  (IF (AND (ARRAYP data) (ARRAY-HAS-LEADER-P data))
      (SEND window :object-array data t (NREVERSE result))
      ;Ï1mention-leader is always TÏ*
      (VALUES (NREVERSE result) data 'inspect-printer)))

(DEFMETHOD Ï4(show-generic-defstruct :helpÏ*) ()
"Ï2Gives help when you middle button on a defstruct.Ï*"
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the defstruct
instance ~S simply as a defstruct instance.  Mousing L2 on it should show it
to you in some other way.Ï*"
	  data))

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

(DEFFLAVOR Ï4show-instanceÏ*
	   ()
	   (generic-middle-button-mixin inspection-data)
  (:documentation
"Ï3A fall-back option perspective which allows instances that
 have their own magic inspector behaviour to be inspected also as the
 instances that implement them.Ï*"))

(DEFMETHOD Ï4(show-instance :format-conciselyÏ*) (STREAM)
"Ï2Just prints it out but notes that it is an instance perspective.Ï*"
  (FORMAT stream "Ï3~ý as an InstanceÏ*" (LIST data t data)))

(DEFMETHOD Ï4(show-instance :generate-item-specializedÏ*) (window)
"Ï2Makes the inspector items for an instance.Ï*"
  (LET ((*inhibit-inspection-data* t))
       (MULTIPLE-VALUE-BIND (items ignore ignore ignore title)
	  (SEND window
		(IF (TYPEP data 'any-sort-of-clos-instance)
		    :object-clos-instance
		    :object-instance)
		data)
	  (VALUES items title))))

(DEFMETHOD Ï4(show-instance :helpÏ*) ()
"Ï2Gives help when you middle button on an instance.Ï*"
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the
instance ~S simply as an instance.  Mousing L2 on it should show it
to you in some other way.Ï*"
	  data))
;Ï1-------------------------------------------------------------------------------Ï*

(DEFFLAVOR Ï4show-generic-object-thingÏ*
	   ()
	   (generic-middle-button-mixin inspection-data)
  (:documentation
"Ï3A fall-back option perspective which allows things to be inspected in the
 old way :object-foo and all that.Ï*"))

(DEFMETHOD Ï4(show-generic-object-thing :format-conciselyÏ*) (STREAM)
"Ï2Just prints it.Ï*"
  (inspection-data-print-item-concisely data stream))

;Ï1; *** from Rice's message Mods to Gen. Insp. 8 Jun 1989 13:45:21 PDTÏ*
(DEFUN Ï4only-first-lineÏ* (STRING window font)
"Ï2Makes sure that String can be printed easily on window in font Font.  If there
 are newlines in String then only the first line is taken, also the substring
 of string which will fit onto about one line in font Font it taken.  The
 (maybe) shorter string is returned.Ï*"
  (DECLARE (type string string))
  (LET ((index (SEARCH (STRING #\newline) string :test #'STRING-EQUAL)))
       (LET ((shorter-string (IF index (SUBSEQ string 0 index) string)))
	    (SUBSEQ (THE string shorter-string) 0
		    (FLOOR (/ (SEND window :inside-width)
			      (font-char-width font)))))))

;Ï1(defmethod (show-generic-object-thing :generate-item-specialized) (window)Ï*
;Ï1"Makes the inspector items for something."Ï*
;Ï1  (let ((*inhibit-inspection-data* t))Ï*
;Ï1       (let ((results (multiple-value-listÏ*
;			Ï1(send window (generic-object-foo-method data) data)Ï*
;		Ï1      )Ï*
;	Ï1     )Ï*
;	Ï1    )Ï*
;	Ï1    (if (fifth results)Ï*
;		Ï1(values-list results)Ï*
;		Ï1(values-listÏ*
;		Ï1 (append (list (first results) (second results) (third results)Ï*
;			Ï1       (fourth results)Ï*
;			Ï1       `(:font fonts:hl12bi :StringÏ*
;				Ï1       ,(format nil "~s" data)Ï*
;				Ï1)Ï*
;			Ï1 )Ï*
;			Ï1 (nthcdr 5 results)Ï*
;		Ï1 )Ï*
;		Ï1)Ï*
;	Ï1    )Ï*
;Ï1       )Ï*
;Ï1  )Ï*
;Ï1)Ï*

;Ï1; *** from Rice's message Mods to Gen. Insp. 8 Jun 1989 13:45:21 PDTÏ*
(DEFMETHOD Ï4(show-generic-object-thing :generate-item-specializedÏ*) (window)
"Ï2Makes the inspector items for something.Ï*"
  (LET ((*inhibit-inspection-data* t))
       (LET ((results (MULTIPLE-VALUE-LIST
			(SEND window (generic-object-foo-method data) data))))
	    (IF (FIFTH results)
		(VALUES-LIST results)
		(VALUES-LIST
		 (APPEND (LIST (FIRST results) (SECOND results) (THIRD results)
			       (FOURTH results)
			       `(:font fonts:hl12bi :string
				       ,(only-first-line
					  ;Ï1;; If this is a defstruct, thenÏ*
					  ;Ï1;; just show the #< form, sinceÏ*
					  ;Ï1;; we're already looking inside it.Ï*
					  (LET ((*print-structure* nil))
					       (FORMAT nil "Ï3~sÏ*" data))
					  window fonts:hl12bi)))
			 (NTHCDR 5 results)))))))

(DEFMETHOD Ï4(show-generic-object-thing :helpÏ*) ()
"Ï2Gives help when you middle button on something.Ï*"
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the
~S ~S.Ï*"
	  (TYPE-OF data) data))

(DEFMETHOD Ï4(show-generic-object-thing :middle-button-resultÏ*) ()
  data)

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

(DEFFLAVOR Ï4show-functionÏ* () (inspection-data)
  (:documentation
"Ï3A different perspective on functions, which allow you
 to see all sorts of interesting things about them.Ï*"))

(DEFMETHOD Ï4(show-function :format-conciselyÏ*) (STREAM)
"Ï2Prints out the function name.  The whole #'fn expression point to the function
 inspected in this way.  The name itself points to the function name.Ï*"
  (FORMAT stream "Ï3#'~ýÏ*" (LIST (FUNCTION-NAME data) t (FUNCTION-NAME data))))

(DEFMETHOD Ï4(show-function :handle-mouse-clickÏ*) (blip flavor-inspector)
"Ï2A simple mouse click handler for functions.Ï*"
  (SELECTOR (FOURTH blip) =
    (#\mouse-l-1 (SEND flavor-inspector :inspect-info-left-click))
    (#\mouse-l-2 (SEND flavor-inspector :inspect-info-left-2-click))
    (#\mouse-m-1 (SEND flavor-inspector :inspect-info-middle-click))
    (otherwise (BEEP))))

(DEFMETHOD Ï4(show-function :generate-itemÏ*) ()
"Ï2An item generator for functions.  This is handled much like CLOS methods and
 generic functions and like flavors methods.  Any interesting seeming aspects of
 the functions are displayed.Ï*"
   (VALUES
     (MULTIPLE-VALUE-BIND
       (referenced-ivars referenced-keywords problem
	referenced-functions referenced-generic-functions args returned-values
	locals specials-referenced specials-bound)
         (ivars-and-messages-in-method data)
       (IGNORE problem)
      `(,*blank-line-item*
	((:font 1 "Ï3Details of Ï*")
	 (:item1 instance
		 ,(allocate-data 'show-function data)))
	,*blank-line-item*
	((:font 1 "Ï3Source File:               Ï*")
	,(IF (si:function-spec-get (FUNCTION-NAME data) :source-file-name)
	     (path-string (FUNCTION-NAME data) 'DEFUN)
	     (FORMAT nil "Ï3Not DefinedÏ*")))
	(,(IF returned-values
	      '(:font 1 "Ï3Arglist Ý Returned Values: Ï*")
	      '(:font 1 "Ï3Arglist:                   Ï*"))
	 ("Ï3~:[~*()~;~S~]Ï*" ,args ,args)
	 ,@(WHEN returned-values
	     `(("Ï3 Ý ~sÏ*" ,returned-values))))
	,*blank-line-item*
	((:font 1 "Ï3Documentation:Ï*"))
	,@(LET ((doc (DOCUMENTATION data)))
	    (IF doc
		(break-string-into-lines doc)
		*no-items*))
	,*blank-line-item*
	;Ï1; TAC 08-18-89 - removing PCL support Ï*
       ;Ï1; ((:font 1 ,(IF (iwmc-class-p-safe data)Ï*
       ;Ï1; Ï*		Ï1       ""Ï*
       ;Ï1;Ï*		Ï1       "Referenced Instance Variables:")))Ï*
       ((:font 1 "Ï3Referenced Instance Variables:Ï*"))
	,@(referenced-instance-variables-details data referenced-ivars)
	,*blank-line-item*
	((:font 1 "Ï3Referenced Keywords (possibly messages passed):Ï*"))
	,@(referenced-keywords-details referenced-keywords)
	,*blank-line-item*
	((:font 1 "Ï3Referenced Generic Functions:Ï*"))
	,@(referenced-generic-functions-details
	     referenced-generic-functions
	  )
	,*blank-line-item*
	((:font 1 "Ï3Referenced Functions:Ï*"))
	,@(referenced-functions-details referenced-functions)
	,*blank-line-item*
	((:font 1 "Ï3Locals:Ï*"))
	,@(locals-details locals)
	,*blank-line-item*
	((:font 1 "Ï3Referenced Specials:Ï*"))
	,@(referenced-specials-details specials-referenced)
	,*blank-line-item*
	((:font 1 "Ï3Specials Bound:Ï*"))
	,@(bound-specials-details specials-bound)
	,*blank-line-item*
	((:font 1 "Ï3Macros Expanded:Ï*"))
	,@(macros-expanded-details data)
	,*blank-line-item*
	((:font 1 "Ï3Interpreted Definition:Ï*"))
	,@(interpreted-definition-details data)
	))
     `(:font fonts:hl12bi
	     :string ,(FORMAT nil "Ï3Function ~SÏ*" (FUNCTION-NAME data)))))

(DEFMETHOD Ï4(show-function :helpÏ*) ()
  (LET ((name (FUNCTION-NAME data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying sundry details
about the compiled function ~S.Ï*"
	    name)))

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

;Ï1;; Make a resource for general inspectors.Ï*
(DEFWINDOW-RESOURCE Ï4general-inspect-frame-resourceÏ* nil :make-window
  (general-inspector :process nil :label "Ï3fooÏ*")
  :reusable-when :deactivated)

(reinstall-commands 'general-inspector)

;Ï1;; Puts the general inspector on System-i, and moves the old inspector onto sym-sh-iÏ*
;(swap-system-keys #\I #\Í 'inspect-frame :inspector)
;Ï1;;  TAC 09-05-89 sym-sh-i already has a definition. Try System-yÏ*

;Ï1;; Puts the general inspector on System-i, and moves the old inspector onto System-yÏ*
(swap-system-keys #\I #\Y 'inspect-frame :inspector)

(w:add-system-key
  #\I
  '(IF *general-inspector-enabled* 'general-inspector 'inspect-frame)
  "Ï2Inspector - examine complex data structures.Ï*"
  t)

(DEFUN Ï4enable-general-inspectorÏ* ()
"Ï2Make all inspectors General-Inspectors.Ï*"
  (SETQ *general-inspector-enabled* t)
  (LET ((sys::inhibit-fdefine-warnings t))
       (DEFWINDOW-RESOURCE eh::debugger-frame nil
	 :make-window (eh::new-debugger-frame)
	 :reusable-when :deactivated
	 :initial-copies 0))
  (CLEAR-RESOURCE 'eh::debugger-frame))


(DEFUN Ï4disable-general-inspectorÏ* ()
"Ï2Make all inspectors normal Inspectors.Ï*"
  (SETQ *general-inspector-enabled* nil)
  (LET ((sys::inhibit-fdefine-warnings t))
       (DEFWINDOW-RESOURCE eh::debugger-frame nil
	 :make-window (eh::debugger-frame)
	 :reusable-when :deactivated
	 :initial-copies 0))
  (CLEAR-RESOURCE 'eh::debugger-frame))

;Ï1(compile-flavor-methodsÏ*
;Ï1  data-as-aux-data-mixinÏ*
;Ï1  general-inspect-paneÏ*
;Ï1  general-inspect-pane-with-typeoutÏ*
;Ï1  general-inspect-windowÏ*
;Ï1  general-inspectorÏ*
;Ï1  general-inspector-history-windowÏ*
;Ï1  list-inspection-mixinÏ*
;Ï1  show-alistÏ*
;Ï1  show-data-with-locativeÏ*
;Ï1  show-list-named-structureÏ*
;Ï1  show-list-offset-unnamed-structureÏ*
;Ï1  show-list-unnamed-structureÏ*
;Ï1  show-offset-plistÏ*
;Ï1  show-one-on-a-lineÏ*
;Ï1  show-plistÏ*
;Ï1)Ï*

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

;Ï1;; Representations...Ï*

(DEFFLAVOR Ï4basic-perspectiveÏ*
	   ((name nil)
	    (already-this-type-function nil)
	    (show-x-type-for-perspective nil)
	    (this-perspective-applicable-function nil)
	    (menu-item-name nil)
	    (new-inspect-function nil)
	    (menu-who-line-doc-string nil)
	    (side-effect-function nil)
	    (priority 0)
	    (prefer-over nil)
	   )
	   ()
  :initable-instance-variables
  :gettable-instance-variables
  :settable-instance-variables
  (:documentation
"Ï3The encapsulation of the behaviour that lets things have multiple
 perspectives.  Each instance knows about the mapping from one
 particular type to another.Ï*"))

(DEFMETHOD Ï4(basic-perspective :print-selfÏ*) (STREAM depth slashify)
"Ï2Justs prints self out so that we can see its name.Ï*"
  (IGNORE depth slashify)
  (FORMAT stream "Ï3#<Perspective ~S>Ï*" name))

(DEFMETHOD Ï4(basic-perspective :after :initÏ*) (IGNORE)
"Ï2Does a little error checking and makes sure that we have useful values for
 the menu item name and the mouse doc string.Ï*"
  (IF (NOT name)
      (FERROR nil "Ï3No name supplied for perspective.Ï*")
      nil)
  (IF (NOT menu-item-name)
      (SETQ menu-item-name (FORMAT nil "Ï3~SÏ*" name))
      nil)
  (IF (NOT menu-who-line-doc-string)
      (SETQ menu-who-line-doc-string menu-item-name)
      nil)
  (IF (NOT (OR new-inspect-function side-effect-function ))
      (FERROR nil "Ï3No mapping function provided.Ï*")
      nil))

(DEFMETHOD Ï4(basic-perspective :menu-itemÏ*) (x show-x)
"Ï2Given a piece of data that's being inspected and the instance of
 inspection-data that's representing it (or nil if not yet allocated),
 returns a menu item for the perspective self.  If the item name or doc string
 values are functions then these are called otherwise the strings are returned.Ï*"
  (LET ((title (IF (FUNCTIONP menu-item-name)
		   (FUNCALL menu-item-name x show-x)
		   menu-item-name))
	(doc (IF (FUNCTIONP menu-who-line-doc-string)
		 (FUNCALL menu-who-line-doc-string x show-x)
		 menu-who-line-doc-string)))
       (LIST title :value self :documentation
	     (FORMAT nil "Ï3~A [~S]Ï*" doc name))))

(DEFMETHOD Ï4(basic-perspective :get-value-to-inspectÏ*) (x show-x)
"Ï2Given a piece of data that's being inspected and the instance of
 inspection-data that's representing it (or nil if not yet allocated),
 returns two values; either:
  a) the value to inspect (calling new-inspect-function) and T, to show that
     we should inspect.
  b) x and nil, in which case side-effect-function will have been called.
     The second value tells the inspector not to do anything about this.Ï*"
  (IF side-effect-function
      (PROGN (FUNCALL side-effect-function x show-x)
	     (VALUES (OR x :processed) nil))
      (VALUES (FUNCALL new-inspect-function x show-x) t)))

(DEFMETHOD Ï4(basic-perspective :applicable-pÏ*) (x show-x)
"Ï2Given a piece of data that's being inspected and the instance of
 inspection-data that's representing it (or nil if not yet allocated),
 returns true if this perspective is a good one, given that we're inspecting x
 and that x is currently viewed as show-x.  The selection is done by checking
 the already-this-type-function, if provided, then the
 This-Perspective-Applicable-Function if provided and finally, if the latter
 was not provided passes if show-x-type-for-perspective is not the same as
 show-x.Ï*"
  (AND (NOT (AND already-this-type-function
		 (FUNCALL already-this-type-function x show-x)))
       (OR (AND this-perspective-applicable-function
		(FUNCALL this-perspective-applicable-function x show-x))
	   (AND (NOT this-perspective-applicable-function)
		show-x-type-for-perspective
		(NOT (EQUAL show-x show-x-type-for-perspective))))))

(DEFVAR Ï4*all-perspective-names*Ï* nil
"Ï2A list of the names of all of the perspectives that have been defined.Ï*")

;Ï1; *** from Rice's message Mods to Gen. Insp. 8 Jun 1989 13:45:21 PDTÏ*
(DEFMACRO Ï4defperspectiveÏ*
	  (name (&rest arglist)
	   &key
	   (flavor 'basic-perspective)
	   (priority 0)
	   (prefer-over nil)
	   (show-x-type-for-perspective nil)
	   (menu-item-name nil)
	   (menu-who-line-doc-string nil)
	   (already-this-type-function nil)
	   (this-perspective-applicable-function nil)
	   (new-inspect-function nil)
	   (side-effect-function nil)
	   (other-keys nil)
	  )
"Ï2The way that the user defines new perspectives.  A perspective is the
 encapsulation of the mapping from one way of inspecting something into
 another way, with sundry conditionality.  For instance, using defperspective
 we can express the mapping that says:
    if we're currently inspecting a method then one way of viewing it is
    to show its method details a la flavor inspector, but don't use this
    perspective if we're already looking at it this way.

 Defperspective takes a number of arguments and keyword arguments, which
 have the following meanings:

 Name - The name of the perspective.  This should be a symbol.  It will be
        included in the list *All-Perspective-Names*.  The perspective object
        that is created is stored on the :perspective property of this symbol.
 Arglist - this is the arglist that will be used in the functions that are
        created by defperspective, so that you can name the args.  The arglist
        must be a two-list.  The first element is the name to be given to the
        actual object to inspect and the second is the name to be given to
        the instance of inspection-data (show-foo) that is currently
        encapsulating the first arg.  An example of this argument might be:
            (defperspective :symbol-as-rule (symbol show-x) ...
 Flavor - the flavor of perspective object that is created.  Only significant
        if, for some reason you want to have different behaviour for your
        perspectives.  See the definition of tv:basic-perspective and its
        protocol if you want to see what a perspective object must be able
        to do.
 Priority - A number used to order perspectives.  This is significant if you
        want to make sure that one particular perspective comes out as being
        the default.  Most perspectives have a priority of 0, but the
        perspective that displays things just as generic data structures
        (:generic-data-structure) has priority 10, so your priority should
        be higher than this if you want to override this behaviour by default.
 Prefer-Over - If you don't like the idea of putting priority numbers on your
        perspectives then you can express relative priorities by the use of this
        arg.  It should be a list of the names of perspectives that you should
        use this one rather than, e.g. :prefer-over (:generic-data-structure).
 Show-X-Type-For-Perspective - is the name of the type of inspection-data
        allocated by this perspective.
 -----------------------

 Perspective functions
 =====================
  All functions called during perspectivisation or generated by defperspective
  have the same arglists: (item show-item).  This always the case (that's why
  the Arglist argument must have two items.  The first argument is always the
  thing that's being inspected and the second is either nil or the instance
  of inspection-data (show-foo) that's being used to represent the item.  The
  second arg is nil in the event of no perspective having been allocated yet.
  Two arguments can optionally be functions.

 Menu-Item-Name - This can be one of three values: defaulted, in which case
        if a menu is generated then the name of the perspective will be used;
        a string, in which case this will be used as the name of the item in
        the menu; or a function in which case this will be called as above
        and the result of this will be used as the menu item name.
 Menu-Who-Line-Doc-String - This can be one of three values: defaulted, in
        which case if a menu is generated then the value of Menu-Item-Name
        will be used; a string, in which case this will be used as the who
        line doc string for this item in the menu; or a function in which
        case this will be called as above and the result of this will be
        used as the who line doc string.

  The following arguments are functions generated by defperspective.  You can
  provide the body code for them.  See the definition of
  Already-This-Type-Function for an example of this:

 Already-This-Type-Function -  A function body which, when true says that
        the thing that we're already inspecting is aready of this type, so we
        don't want to use this perspective.  The args defined in the Arglist
        arg above are used in the construction of the function.  For example,
        if our perspective is intended to show flavors defstruct instances
        simply as generic defstructs then we might say:
          (Defperspective :flavor-as-defstruct (x show-x)
            :already-this-type-function
               (and (typep x 'si:flavor)
                    (typep show-x 'Show-Generic-Object-Thing))
        Note how in this case we're using the arglist (x show-x).  If the thing
        we're inspecting is a flavor and it's encapsulated within a
        Show-Generic-Object-Thing then we don't want this perspective.
 This-Perspective-Applicable-Function - A function body, which when true says
        that this perspective is, indeed applicable.  Example:
          (Defperspective :flavor-as-flavor-inspect (x show-x)
            :This-Perspective-Applicable-Function
              (or (typep x 'si:flavor) (and (symbolp x) (get x 'si:flavor)))
        Note how this perspective will work for for any flavor object or symbol
        that names a flavor.
 New-Inspect-Function - An optional function body which is called when the
        perspective mechanism has decided that this perspective is applicable.
        It must return the new thing to inspect, calling allocate data as
        appropriate.  This argument cannot be used with Side-Effect-Function.
        Example:
          (Defperspective :flavor-as-flavor-inspect (x show-x)
            :New-Inspect-Function
              (allocate-data 'show-flavor
                (if (typep x 'si:flavor) x (get x 'si:flavor)))
        Note, in this case we've decided that X can be either s flavor or a
        symbol that names a flavor.
 Side-Effect-Function - An optional function body which is called when the
        perspective mechanism has decided that this perspective is applicable.
        It must perform whatever side effects are needed to implement this
        perspective.  This argument cannot be used with New-Inspect-Function.
        Example:
          (defperspective :flavor-as-graph (x show-x)
            :Side-Effect-Function
              (inspect-graph-class
                (if (typep x 'si:flavor) x (get x 'si:flavor)))


 Other-keys - If the :flavor option is used then this might take other
        init-args.  Other-keys are used to encapsulate these.Ï*
"
 `(LET ((instance (MAKE-INSTANCE
		    ',flavor
		    :name ,name
		    :already-this-type-function
		     ,(AND already-this-type-function
			  `#'(lambda ,arglist (IGNORE ,@arglist)
				     ,already-this-type-function))
		    :show-x-type-for-perspective ',show-x-type-for-perspective
		    :this-perspective-applicable-function
		     ,(AND this-perspective-applicable-function
			  `#'(lambda ,arglist (IGNORE ,@arglist)
			       ,this-perspective-applicable-function))
		    :menu-item-name ,menu-item-name
		    :new-inspect-function
		     ,(AND new-inspect-function
			   `#'(lambda ,arglist (IGNORE ,@arglist)
				      ,new-inspect-function))
		    :menu-who-line-doc-string ,menu-who-line-doc-string
		    :side-effect-function
		     ,(AND side-effect-function
			   `#'(lambda ,arglist (IGNORE ,@arglist)
				      ,side-effect-function))
		    :priority ,(AND priority
				    `#'(lambda ,arglist (IGNORE ,@arglist)
					       ,priority))
		    :prefer-over ',prefer-over
		    ,@other-keys)))
       (SETF (GET ',name :perspective) instance)
       (PUSHNEW ',name *all-perspective-names*)
       (DEF ,name)))

(defperspective Ï4:locativeÏ* (x show-x)
  :already-this-type-function
  (AND (LOCATIVEP x) (TYPEP show-x 'show-data-with-locative))
  :this-perspective-applicable-function
  (LOCATIVEP x)
  :menu-item-name "Ï3LocativeÏ*"
  :menu-who-line-doc-string
  "Ï3As a locativeÏ*"
  :new-inspect-function
  (allocate-data 'show-data-with-locative x x)
  :prefer-over '(:generic-data-structure))

(defperspective Ï4:class-instanceÏ* (x show-x)
  :already-this-type-function
    (AND (class-p-safe x)
	 (ticlos-p)
	 (TYPEP x 'clos:class)
	 (OR (TYPEP show-x 'show-generic-object-thing)
	     (TYPEP show-x 'show-instance)))
  :this-perspective-applicable-function
    (OR (AND (class-p-safe x)
	     (ticlos-p)
	     (TYPEP x 'clos:class))
	(AND (SYMBOLP x) (ticlos-p) (ticlos::class-named x t)))
  :menu-item-name "Ï3Class instanceÏ*"
  :menu-who-line-doc-string
    "Ï3As an instance of the data structure used to implement the classÏ*"
  :new-inspect-function
   (allocate-data (IF (INSTANCEP x)
		      'show-instance
		      'show-generic-object-thing)
		  (IF (class-p-safe x) x (ticlos::class-named x t)))
;Ï1 TAC 08-17-89 - removing pcl supportÏ*
;Ï1  :prefer-over '(:pcl-class-instance))Ï*
   )

;Ï1 TAC 08-17-89 - removing pcl supportÏ*
;Ï1(defperspective :pcl-class-instance (x show-x)Ï*
;Ï1  :already-this-type-functionÏ*
;Ï1    (AND (class-p-safe x)Ï*
;	Ï1 (pcl-p)Ï*
;	Ï1 (pcl-class-p x)Ï*
;	Ï1 (OR (TYPEP show-x 'show-generic-object-thing)Ï*
;	Ï1     (TYPEP show-x 'show-instance)))Ï*
;Ï1  :this-perspective-applicable-functionÏ*
;Ï1    (OR (AND (class-p-safe x)Ï*
;	Ï1     (pcl-p)Ï*
;	Ï1     (pcl-class-p x))Ï*
;	Ï1(AND (SYMBOLP x) (pcl-p) (pcl:find-class x nil)))Ï*
;Ï1  :menu-item-name "PCL Class instance"Ï*
;Ï1  :menu-who-line-doc-stringÏ*
;Ï1    "As an instance of the data structure used to implement the class"Ï*
;Ï1  :new-inspect-functionÏ*
;Ï1   (allocate-data (IF (INSTANCEP x)Ï*
;		Ï1      'show-instanceÏ*
;		Ï1      'show-generic-object-thing)Ï*
;		Ï1  (IF (class-p-safe x) x (pcl:find-class x nil))))Ï*

;Ï1 TAC 08-17-89 - removing pcl supportÏ*
;Ï1(defperspective :pcl-object-implementation (x show-x)Ï*
;Ï1  :already-this-type-functionÏ*
;Ï1    (AND (pcl-p)Ï*
;	Ï1 (iwmc-class-p-safe x)Ï*
;	Ï1 (TYPEP show-x 'show-generic-defstruct))Ï*
;Ï1  :this-perspective-applicable-functionÏ*
;Ï1    (AND (pcl-p) (iwmc-class-p-safe x))Ï*
;Ï1  :menu-item-name "PCL implementation using defstruct"Ï*
;Ï1  :menu-who-line-doc-stringÏ*
;Ï1    "As an instance of the defstruct used to implement the object"Ï*
;Ï1  :new-inspect-functionÏ*
;Ï1   (allocate-data 'show-generic-defstruct x)Ï*
;Ï1  :priority -1)Ï*

;Ï1 TAC 08-17-89 - removing pcl supportÏ*
;Ï1(defperspective :pcl-generic-function-implementation (x show-x)Ï*
;Ï1  :already-this-type-functionÏ*
;Ï1    (AND (pcl-p)Ï*
;	Ï1 (pcl:generic-function-p x)Ï*
;	Ï1 (TYPEP show-x 'show-generic-object-thing))Ï*
;Ï1  :this-perspective-applicable-functionÏ*
;Ï1    (AND (pcl-p) (pcl:generic-function-p x))Ï*
;Ï1  :menu-item-name "PCL generic function implementation"Ï*
;Ï1  :menu-who-line-doc-stringÏ*
;Ï1    "As an instance of the closure used to implement the generic function"Ï*
;Ï1  :new-inspect-functionÏ*
;Ï1   (allocate-data 'show-generic-object-thing x)Ï*
;Ï1  :priority -1)Ï*

(defperspective Ï4:classÏ* (x show-x)
  :show-x-type-for-perspective show-clos-class
  :this-perspective-applicable-function
    (AND (OR (AND (class-p-safe x) (ticlos-p)
		  (TYPEP x 'clos:class))
	     (AND (SYMBOLP x) (class-named-safe x t)
		  (ticlos-p) (ticlos::class-named x t)))
	 (NOT (TYPEP show-x 'show-clos-class)))
  :menu-item-name "Ï3ClassÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as a CLOS class, showing its inheritance hierarchy.Ï*"
  :new-inspect-function
   (allocate-data 'show-clos-class
		  (IF (class-p-safe x) x (ticlos::class-named x)))
;Ï1 TAC 08-17-89 - removing pcl supportÏ*   
;Ï1  :prefer-over (:pcl-class :class-instance))Ï*
   )

;Ï1 TAC 08-17-89 - removing pcl supportÏ*
;Ï1(defperspective :pcl-class (x show-x)Ï*
;Ï1  :show-x-type-for-perspective show-clos-classÏ*
;Ï1  :this-perspective-applicable-functionÏ*
;Ï1    (AND (OR (AND (class-p-safe x) (pcl-p)Ï*
;		Ï1  (pcl-class-p x))Ï*
;	Ï1     (AND (SYMBOLP x) (class-named-safe x t)Ï*
;		Ï1  (pcl-p) (pcl:find-class x nil)))Ï*
;	Ï1 (NOT (TYPEP show-x 'show-clos-class)))Ï*
;Ï1  :menu-item-name "PCL Class"Ï*
;Ï1  :menu-who-line-doc-stringÏ*
;Ï1    "Inspect this as a PCL class, showing its inheritance hierarchy."Ï*
;Ï1  :new-inspect-functionÏ*
;Ï1   (allocate-data 'show-clos-class (IF (class-p-safe x) x (pcl:find-class x)))Ï*
;Ï1  :prefer-over (:pcl-class-instance))Ï*

(defperspective Ï4:flavor-instanceÏ* (x show-x)
  :already-this-type-function
    (AND (TYPEP x 'si::flavor) (TYPEP show-x 'show-generic-object-thing))
  :this-perspective-applicable-function
    (OR (TYPEP x 'si::flavor) (AND (SYMBOLP x) (GET x 'si::flavor)))
  :menu-item-name "Ï3Flavor instanceÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as the defstruct instance that implements the flavor.Ï*"
  :new-inspect-function
   (allocate-data 'show-generic-object-thing
		  (IF (TYPEP x 'si::flavor) x (GET x 'si::flavor))))

(defperspective Ï4:flavorÏ* (x show-x)
  :show-x-type-for-perspective show-flavor
  :already-this-type-function (TYPEP show-x 'show-flavor)
  :this-perspective-applicable-function
    (OR (TYPEP x 'si::flavor) (AND (SYMBOLP x) (GET x 'si::flavor)))
  :menu-item-name "Ï3FlavorÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as a Flavor, showing its inheritance hierarchy.Ï*"
  :new-inspect-function
    (allocate-data 'show-flavor (IF (TYPEP x 'si::flavor) x (GET x 'si::flavor))))

(defperspective Ï4:normal-listÏ* (x show-x)
  :show-x-type-for-perspective show-list
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3Unstructured listÏ*"
  :menu-who-line-doc-string "Ï3Show this list as a normal ground list.Ï*"
  :new-inspect-function (allocate-data 'show-list x))

(defperspective Ï4:plistÏ* (x show-x)
  :show-x-type-for-perspective show-plist
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3PListÏ*"
  :menu-who-line-doc-string "Ï3Show it as if it was a PList.Ï*"
  :new-inspect-function (allocate-data 'show-plist x))

(defperspective Ï4:offset-plistÏ* (x show-x)
  :show-x-type-for-perspective show-offset-plist
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3Offset PListÏ*"
  :menu-who-line-doc-string "Ï3Show it as if it was a PList, offset at the start.Ï*"
  :new-inspect-function (allocate-data 'show-offset-plist x))

(defperspective Ï4:alistÏ* (x show-x)
  :show-x-type-for-perspective show-alist
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3AListÏ*"
  :menu-who-line-doc-string "Ï3Show it as if it was an AList.Ï*"
  :new-inspect-function (allocate-data 'show-alist x))

(defperspective Ï4:one-on-a-lineÏ* (x show-x)
  :show-x-type-for-perspective show-one-on-a-line
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3One on a lineÏ*"
  :menu-who-line-doc-string "Ï3Each element of the line on a separate line.Ï*"
  :new-inspect-function (allocate-data 'show-one-on-a-line x))

(defperspective Ï4:named-structureÏ* (x show-x)
  :show-x-type-for-perspective show-list-named-structure
  :this-perspective-applicable-function
   (AND (LISTP x)
	(SYMBOLP (FIRST x))
	(GET (FIRST x) 'si::defstruct-description))
  :menu-item-name "Ï3Named StructureÏ*"
  :menu-who-line-doc-string
    "Ï3As if it is a defstruct instance whose type is (first <list>).Ï*"
  :new-inspect-function (allocate-data 'show-list-named-structure x))

(defperspective Ï4:unnamed-structureÏ* (x show-x)
  :show-x-type-for-perspective show-list-unnamed-structure
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3StructureÏ*"
  :menu-who-line-doc-string
    "Ï3As if it is a defstruct instance whose type you specify.Ï*"
  :new-inspect-function
    (LET ((type-name (read-type-name)))
         (allocate-data 'show-list-unnamed-structure x type-name)))

(defperspective Ï4:offset-unnamed-structureÏ* (x show-x)
  :show-x-type-for-perspective show-list-offset-unnamed-structure
  :this-perspective-applicable-function (LISTP x)
  :menu-item-name "Ï3Offset StructureÏ*"
  :menu-who-line-doc-string
    "Ï3As if it is a defstruct instance whose type you specify (offset).Ï*"
  :new-inspect-function
    (LET ((type-name (read-type-name)))
         (allocate-data 'show-list-offset-unnamed-structure x type-name)))

(defperspective Ï4:hash-tableÏ* (x show-x)
  :show-x-type-for-perspective show-hash-table
  :this-perspective-applicable-function
    (AND (HASH-TABLE-P x) (NOT (TYPEP show-x 'show-hash-table)))
  :menu-item-name "Ï3Hash Table elementsÏ*"
  :new-inspect-function (allocate-data 'show-hash-table x)
  :prefer-over (:hash-table-instance))

(defperspective Ï4:hash-table-instanceÏ* (x show-x)
  :show-x-type-for-perspective show-generic-defstruct
  :this-perspective-applicable-function
    (AND (HASH-TABLE-P x) (NOT (TYPEP show-x 'show-generic-defstruct)))
  :menu-item-name "Ï3Hash Table instanceÏ*"
  :new-inspect-function (allocate-data 'show-generic-defstruct x))

(defperspective Ï4:packageÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :this-perspective-applicable-function (AND (SYMBOLP x) (FIND-PACKAGE x))
  :menu-item-name "Ï3PackageÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as the package named by this symbol.Ï*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing (FIND-PACKAGE x)))

(defperspective Ï4:resourceÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :this-perspective-applicable-function
    (AND (SYMBOLP x) (GET x 'DEFRESOURCE))
  :menu-item-name "Ï3ResourceÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as the resource named by this symbol.Ï*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing (GET x 'DEFRESOURCE)))

(DEFPARAMETER Ï4*types-to-exclude-from-generic-display*Ï*
  '(COMPILED-FUNCTION-P
    hash-table
    method-function
    clos:class
    si::flavor
    si::hash-table
    locative))

(defperspective Ï4:generic-data-structureÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :already-this-type-function (TYPEP show-x 'show-generic-object-thing)
  :this-perspective-applicable-function
    (AND (NOT (TYPEP show-x 'show-generic-object-thing))
	 (NOT (MEMBER x *types-to-exclude-from-generic-display*
		      :test #'(lambda (a b)
				(IF (TYPE-SPECIFIER-P b)
				    (TYPEP a b)
				    (FUNCALL b a))))))
  :menu-item-name "Ï3Simply inspectÏ*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing x)
  :priority 10)

(defperspective Ï4:defstruct-descriptionÏ* (x show-x)
  :show-x-type-for-perspective show-list-unnamed-structure
  :this-perspective-applicable-function
    (AND (SYMBOLP x) (GET x 'si::defstruct-description))
  :menu-item-name "Ï3Defstruct DescriptionÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this as the defstruct description named by this symbol.Ï*"
  :new-inspect-function
    (allocate-data 'show-list-unnamed-structure
		   (GET x 'si::defstruct-description)
		   'si::defstruct-description))

(defperspective Ï4:method-detailsÏ* (x show-x)
  :show-x-type-for-perspective show-method-details
  :this-perspective-applicable-function
    (AND (TYPEP x 'method-function)
	 (NOT (TYPEP show-x 'show-method-details))
	 (NOT (TYPEP show-x 'show-clos-method-details)))
  :menu-item-name "Ï3Method DetailsÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this method, showing interesting information about it, e.g. IVs referenced, specials bound etc..Ï*"
  :new-inspect-function
    (IF (EQUAL :method (FIRST (FUNCTION-NAME x)))
        (APPLY #'allocate-data 'show-method-details (data-from-method x))
	(APPLY #'allocate-data 'show-clos-method-details
	       (data-from-clos-method
		 (method-from-method-function-safe x))))
  :priority 1)

(defperspective Ï4:disassembled-functionÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :this-perspective-applicable-function
    (OR (AND (TYPEP x 'compiled-function)
	     (NOT (TYPEP show-x 'show-generic-object-thing)))
	(AND (SYMBOLP x) (COMPILED-FUNCTION-P (fdefinition-safe x))))
  :menu-item-name "Ï3Disassembled FunctionÏ*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing
		   (IF (SYMBOLP x) (fdefinition-safe x) x)))

(defperspective Ï4:function-detailsÏ* (x show-x)
  :already-this-type-function (TYPEP show-x 'show-function)
  :show-x-type-for-perspective show-function
  :this-perspective-applicable-function
    (OR (AND (TYPEP x 'compiled-function)
	     (NOT (fef-of-gf-p x))
	     (NOT (TYPEP x 'method-function)))
	(AND (SYMBOLP x) (FBOUNDP x)
	     (NOT (fef-of-gf-p (fdefinition-safe x t)))))
  :menu-item-name "Ï3Function detailsÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this function, showing interesting information about it, e.g. specials bound, functions called etc..Ï*"
  :new-inspect-function
    (allocate-data 'show-function (IF (SYMBOLP x) (fdefinition-safe x) x)))

(defperspective Ï4:generic-function-detailsÏ* (x show-x)
  :already-this-type-function
    (TYPEP show-x 'show-clos-generic-function-details)
  :show-x-type-for-perspective show-clos-generic-function-details
  :this-perspective-applicable-function
    (OR (AND (TYPEP x 'compiled-function) (fef-of-gf-p x))
	(AND (SYMBOLP x) (FBOUNDP x)
	     (fef-of-gf-p (fdefinition-safe x t)))
	(TYPEP x 'any-type-of-clos-gf))
  :menu-item-name "Ï3Generic Function details.Ï*"
  :menu-who-line-doc-string
    "Ï3Inspect this generic function, showing interesting information about it, e.g. specials bound, functions called etc..Ï*"
  :new-inspect-function
    (LET ((gf (IF (SYMBOLP x)
		  (function-generic-function-safe (fdefinition-safe x t))
		  (IF (TYPEP x 'any-type-of-clos-gf)
		      x
		      (function-generic-function-safe x)))))
         (allocate-data 'show-clos-generic-function-details gf gf))
  :prefer-over (:generic-data-structure :disassembled-function)
  :priority (IF (SYMBOLP x) 9 11))

(defperspective Ï4:clos-method-detailsÏ* (x show-x)
  :show-x-type-for-perspective show-clos-method-details
  :this-perspective-applicable-function
    (AND (TYPEP x 'any-type-of-clos-method)
	 (NOT (TYPEP show-x 'show-clos-method-details)))
  :menu-item-name "Ï3Method DetailsÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect this method, showing interesting information about it, e.g. IVs referenced, specials bound etc..Ï*"
  :new-inspect-function
    (APPLY #'allocate-data 'show-method-details (data-from-clos-method x)))

(defperspective Ï4:clos-method-functionÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :this-perspective-applicable-function (TYPEP x 'any-type-of-clos-method)
  :menu-item-name "Ï3Method functionÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect the method function of this method.Ï*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing (method-function-safe x)))

(defperspective Ï4:generic-function-fefÏ* (x show-x)
  :show-x-type-for-perspective show-generic-object-thing
  :this-perspective-applicable-function (TYPEP x 'any-type-of-clos-gf)
  :menu-item-name "Ï3Generic Function disassembledÏ*"
  :menu-who-line-doc-string
    "Ï3Inspect the generic function in disassembled form.Ï*"
  :new-inspect-function
    (allocate-data 'show-generic-object-thing (get-fef-from-object x)))

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

(DEFUN Ï4perspective-greaterpÏ* (a b x show-x)
  (OR (MEMBER (SEND b :name) (SEND a :prefer-over))
      (> (LET ((pr (SEND a :priority)))
	   (IF (FUNCTIONP pr)
	       (FUNCALL pr x show-x)
	       pr))
	 (LET ((pr (SEND b :priority)))
	   (IF (FUNCTIONP pr)
	       (FUNCALL pr x show-x)
	       pr)))))

(DEFUN Ï4perspective-equalpÏ* (a b x show-x)
  (= (LET ((pr (SEND a :priority)))
	  (IF (FUNCTIONP pr)
	      (FUNCALL pr x show-x)
	      pr))
     (LET ((pr (SEND b :priority)))
	  (IF (FUNCTIONP pr)
	      (FUNCALL pr x show-x)
	      pr))))

(DEFUN Ï4perspective-really-greater-pÏ* (a b x show-x)
  (OR (perspective-greaterp a b x show-x)
      (AND (NOT (perspective-greaterp b a x show-x))
	   (NOT (perspective-equalp a b x show-x)))))

(DEFUN Ï4sort-perspectivesÏ* (LIST x show-x)
"Ï2Given a list of perspectives, sorts them into priority order.  Priority is
 assessed on the basis first of the prefer-over slot
 and then the priority.Ï*"
  (STABLE-SORT
    list #'(lambda (a b) (perspective-really-greater-p a b x show-x))))

(DEFUN Ï4get-perspectivesÏ* (something)
"Ï2Given a thing, which might be an instance of Inspection-data, returns a list of
 all the perspectives that apply to it, sorted into order of highest priority
 first.Ï*"
  (LET ((value (IF (TYPEP something 'inspection-data)
		   (OR (SEND something :middle-button-result)
		       something)
		   something))
	(show-x (IF (TYPEP something 'inspection-data) something nil)))
       (sort-perspectives
	 (LOOP for name in *all-perspective-names*
	       when (SEND (GET name :perspective) :applicable-p value show-x)
	       collect (GET name :perspective))
	 something show-x)))

(DEFUN Ï4map-into-show-xÏ* (something &optional (no-menu-p nil) (only-of-type nil))
"Ï2Takes Something and maps it into something else to inspect.  If there is more
 than one available perspective it pops up a menu of applicable perspectives.Ï*"
  (LET ((value (IF (TYPEP something 'inspection-data)
		   (OR (SEND something :middle-button-result)
		       something)
		   something))
	(show-x (IF (TYPEP something 'inspection-data) something nil)))
       (LET ((unfiltered-entries (get-perspectives something)))
	    (LET ((entries
		    (IF only-of-type
			(REMOVE-IF-NOT #'(lambda (x) (TYPEP x only-of-type))
				       unfiltered-entries)
			unfiltered-entries)))
		 (IF entries
		     (LET ((selected
			     (IF (AND (NOT no-menu-p) (REST entries))
				 ;Ï1;; More than one.Ï*
				 (w:menu-choose
				   (MAPCAR
				     #'(lambda (x) (SEND x :menu-item x show-x))
				     entries)
				   :label "Ï3Which perspective?Ï*"
				   :columns)
				 (FIRST entries))))
			  (IF selected
			      (SEND selected :get-value-to-inspect value show-x)
			      nil))
		     nil)))))

(DEFUN Ï4inspectÏ* (&optional (object nil objp) (in-perspective nil)) 
  "Ï2Call the Inspector to inspect OBJECT.  Selects an Inspector window.
   If in-perspective is the name of a perspective that is applicable to Object
   then this perspective is used.  If In-perspective is :menu then a menu of
   perspectives will be popped up if there are more than one.  If
   in-perspective is :generic, then generic inspection will be used
   (no fancy flavor inspection or anything like that).
   The Inspector runs in its own process, so your special variable bindings
   will not be visible. If you want to see special variable bindings, use INSPECT*.Ï*"
  (DECLARE (SPECIAL frame))
  (LET ((iframe (IF *general-inspector-enabled*
		    ;Ï1; Modded here by JPR.Ï*
		    (find-or-create-inspect-window
		      'general-inspector
		      (IF (AND (BOUNDP 'frame) (TYPEP frame 'general-inspector))
			  frame ;Ï1; this will skip over current frame and make a new one Ï*
			  nil))
		    (find-or-create-inspect-window 'inspect-frame)))
        (top-item nil)
	(inspect*-quit nil)
	(*print-pretty* nil)
	(*print-array* *print-array*)
	(*print-circle* *print-circle*)
	(*print-radix* *print-radix* )
	(*nopoint *nopoint )
	(*print-base* *print-base* )
	(*read-base* *read-base* )
	(*print-level* *print-level* )
	(*print-length* *print-length*  ))
    (DECLARE (SPECIAL top-item = inspect*-quit *print-pretty*))
    (DECLARE (SPECIAL *print-array* *print-circle* *print-radix* *nopoint *print-base* 
		      *read-base* *print-level* *print-length* ))
    (SETQ = nil)
    ;Ï1(send iframe :prepare-for-use object objp)))Ï*
    (IF objp
	(IF *general-inspector-enabled*
	    (SEND iframe :inspect-object object in-perspective)
	    (SEND iframe :inspect-object object)))))

(DEFUN Ï4inspect*Ï* (&optional (object nil objp) (in-perspective nil))
  "Ï2Call the Inspector to inspect OBJECT.  Selects an Inspector window.
   If in-perspective is the name of a perspective that is applicable to Object
   then this perspective is used.  If In-perspective is :menu then a menu of
   perspectives will be popped up if there are more than one.  If in-perspective 
   is :generic, then generic inspection will be used (no fancy flavor inspection 
   or anything like that). The Inspector runs in the calling process, so our 
   special variable bindings are visible. If you type END in the inspector, the 
   value of = will be returned from the function INSPECT.Ï*"
  (WITH-STACK-LIST (env si::*interpreter-environment*
			si::*interpreter-function-environment*
			nil)
    (LET ((top-item nil)    ;Ï1; RDA: addedÏ*
	  (inspect*-quit t)
	  (*print-pretty* nil)
	  (*print-array* *print-array*)
	  (*print-circle* *print-circle*)
	  (*print-radix* *print-radix*)
	  (*nopoint *nopoint)
	  (*print-base* *print-base*)
	  (*read-base* *read-base*)
	  (*print-level* *print-level*)
	  (*print-length* *print-length*))
      (DECLARE (SPECIAL top-item inspect*-quit *print-pretty*))
      (SETQ ucl::*env* env) ;Ï1; NOTE - side effect here - TAC 08-04-89Ï*

      ;Ï1; RDA: Pulled this IF out of the USING-RESOURCE as the resource name isn't evaled.Ï*
      (IF *general-inspector-enabled*

	  (USING-RESOURCE (iframe general-inspect-frame-resource default-screen)
	    (SEND iframe :inspect-object object in-perspective)
	    (window-call-with-selection-substitute (iframe :deactivate)
	      (inspect-command-loop iframe)))
	  
	  (USING-RESOURCE (iframe inspect-frame-resource default-screen)
	    (SEND iframe :prepare-for-use object	    objp
		  (FORMAT nil "Ï3Inspector for ~AÏ*" (SEND current-process :name)))
	    (window-call-with-selection-substitute (iframe :deactivate)
	      (inspect-command-loop iframe)))))))

(DEFUN Ï4not-a-gen-insp-window Ï*(w)
  (NOT (TYPEP w 'general-inspector)))

(DEFUN Ï4inspect-flavorÏ* (&optional (object nil objp) frame)
  "Ï2Call the Inspector to inspect OBJECT.  Selects an Inspector window.
   Inspects Object as if it was a flavor using the  :Flavor-As-Flavor-Inspect perspective.
   The Inspector runs in its own process, so your special variable bindings will not be visible.
   If you type END or use the exit menu option the original object  will be returned. 
  This function will become obsolete in release 7.0 . You can use (Inspect object :perspective...)Ï*"
  (IF (AND *general-inspector-enabled*;Ï1; JPR.Ï*
	   frame ;Ï1; next 2 TAC - wait until rel 7.0 to make this obsoleteÏ*
	   (TYPEP (assure-is-a-frame frame) 'general-inspector))
      (IF objp (INSPECT object :flavor) (INSPECT))
      (LET ((iframe (find-or-create-window 'flavor-inspector 
					   (assure-is-a-frame frame) 
					   #'not-a-gen-insp-window))
	    (top-item nil))
	    (DECLARE (SPECIAL top-item))
	    (IF objp
		(COND ((INSTANCEP object)
		       (SEND iframe :inspect-instance object))
		      ((TYPEP object 'si::flavor)
		       (SEND iframe :inspect-structure object))
                      ;Ï1; TAC 08-18-89 - removing PCL support Ï*
		      ;Ï1; ((iwmc-class-p-safe object)Ï*
		      ;Ï1;  (SEND iframe :inspect-class object))Ï*
		      (t (SEND iframe :inspect-object object)))
		 object))))

(DEFMETHOD Ï4(general-inspector :inspect-objectÏ*)
	   (object &optional (perspective nil))
"Ï2Inspects an object.  Looks at the perspective arg and does the right hing.
 Perspective can be any of :Menu (use a menu if appropriate),
 :generic (use generic inspection), nil (pick the best perspective [default])
 or the name of a perspective to use.Ï*"
  (MULTIPLE-VALUE-BIND (show-x inspect-p)
      (CASE perspective
	(:menu (map-into-show-x object))
	(:generic (VALUES (allocate-data 'show-generic-object-thing object) t))
	(nil (map-into-show-x object t))
	(otherwise
	 (IF (MEMBER perspective *all-perspective-names*)
	     (LET ((object (IF (TYPEP object 'inspection-data)
			       (SEND object :middle-button-result)
			       object))
		   (show-x (IF (TYPEP object 'inspection-data) object nil)))
	          (IF (SEND (GET perspective :perspective) :applicable-p
			    object show-x)
		      (SEND (GET perspective :perspective)
			    :get-value-to-inspect object show-x)
		      (PROGN (CERROR "Ï3Just inspect it anywayÏ*"
			       "Ï3Perspective ~S is not applicable to ~S.Ï*"
			       perspective object)
			     (map-into-show-x object t))))
	     (PROGN (CERROR "Ï3Just inspect it anywayÏ*"
			    "Ï3~S is not the name of a perspective.Ï*" perspective)
		    (map-into-show-x object t)))))
    (IF inspect-p
	(LET ((thing (inspect-real-value `(:value ,show-x ,history))))
	     (inspect-flush-from-history thing history)
	     (SEND history :append-item thing)
	     (update-panes))
	nil)))

(DEFMETHOD Ï4(general-inspector-history-window :inspect-objectÏ*)
           (object inspector &optional top-item-no -label- dont-propogate from-window-debugger?)
  ;Ï1; First, remember current TOP-ITEM of inspectorÏ*
  (MULTIPLE-VALUE-BIND (object inspect-p)
      (IF (TYPEP object 'inspection-data)
	  (VALUES object t)
	  (map-into-show-x object t))
    (IF inspect-p
        (LET ((disp (SEND inspector :current-display)))
		  (AND disp (SETF (FOURTH disp) (SEND inspector :top-item)))
		  (OR
		   (DOTIMES (i (ARRAY-ACTIVE-LENGTH items))
		     (COND
		       ((NEQ object (AREF items i)))
		       (dont-propogate (RETURN t))
		       (t (SEND self :delete-item i) (RETURN nil))))
		   (SEND self :append-item object))
		  (SEND self :put-item-in-window object)
		  (LET ((ce (cli:assoc object cache :test #'EQ)))
		    (IF from-window-debugger?	;Ï1..Ï*
			(PUSH (SETQ ce (inspect-setup-object-display-list object inspector top-item-no -label-)) cache)
			(OR ce
			(PUSH (SETQ ce (inspect-setup-object-display-list object inspector top-item-no -label-)) cache)))
		    (OR (EQ (CDR ce) disp) (SEND inspector :setup-object ce))
		    ))
	nil)))

(DEFMETHOD Ï4(general-inspector :inspect-info-left-2-clickÏ*)
	   (&optional something)
"Ï2This is the generic left-2 click method that knows how to support the
 perspectives mechanism and inspect the thing that was selected.Ï*"
  (LET ((thing (IF something
		   something
		   (inspect-real-value ucl:kbd-input))))
       (MULTIPLE-VALUE-BIND (real-thing inspect-p)
	   (map-into-show-x thing)
	  (IF inspect-p
	      (PROGN (inspect-flush-from-history real-thing history)
		     (SEND history :append-item real-thing)
		     (SEND history :set-cache nil)
		     (update-panes))
	      nil))))

(DEFUN Ï4general-inspector-print-values?Ï* ()
  (DECLARE (:self-flavor basic-inspect-frame))
  (DECLARE (SPECIAL ucl:prompt ucl:input-mechanism history))
  (AND (ucl::abnormal-command?)
       (IF (STRING-EQUAL ucl:prompt "Ï3> Ï*")
           (PROGN
	     ;Ï1;; I see no reason why it should update panes here, even thoughÏ*
	     ;Ï1;; the patch to the inspector does.Ï*
	     ;Ï1;; The user can always hit refresh if he has typed something thatÏ*
	     ;Ï1;; might affect something on the screen.Ï*
;Ï1            (update-panes)Ï*
             t)
	   (UNLESS (EQ ucl:input-mechanism 'ucl::unknown)
	     (MULTIPLE-VALUE-BIND (thing inspect-p)
		 (map-into-show-x (CAR \/) t)
	       (IF inspect-p
		   (LET ((thing (inspect-real-value `(:value ,thing ,history))))
			(inspect-flush-from-history thing history)
			(SEND history :append-item thing)
			(update-panes)
			nil)
		   nil))))))

(DEFUN Ï4perspective-doc-string-additionÏ* (thing perspectives existing-docs)
  "Ï2Is passed the thing that the mouse is over, a list of perspectives for it
 and the rest of the doc string.  It modifies the doc string if there are
 any applicable perspectives so that a) it mentions #\mouse-l-2 and b)
 it enumerates the names of the applicable perspectives.Ï*"
  (IF (OR (AND (NOT (TYPEP thing 'inspection-data))
	       (REST perspectives))
	  (AND (TYPEP thing 'inspection-data) perspectives))
      (APPEND (LIST (FIRST existing-docs) (SECOND existing-docs)
		    :mouse-l-2 "Ï3View another perspective, Ï*"
		    :documentation
		    (LET ((names (MAPCAR #'(lambda (x) (SEND x :name))
					 perspectives))
			  (*print-case* :capitalize))
		      (FORMAT nil "Ï3[~S~{, ~S~}]Ï*" (FIRST names)
			      (REST names))))
	      (REST (REST existing-docs)))
      existing-docs))

(DEFWRAPPER Ï4(inspection-data :who-line-docÏ*) (args  &body body)
  "Ï2Supports the mouse-l-2 click as well as the others.Ï*"
  `(LET ((result . ,body))
     ;;Ï1 only add perspectives if this inspection data is from a general-inspect-window -  TAC 08-16-89Ï*
     (IF (AND (FIRST args) (TYPEP (FIRST args) 'general-inspect-window)
	      *general-inspector-enabled*)
	 (perspective-doc-string-addition
	   self
	   (IF *general-inspector-enabled* (get-perspectives self) nil) 
	   result)
	 result)))

(DEFUN Ï4allocated-perspectivesÏ* (of)
  (IF (TYPEP of 'inspection-data)
      (get-perspectives of)
      (get-perspectives ;Ï1 (allocate-data 'show-generic-object-thing of)Ï*
        (map-into-show-x of t))))

(DEFMETHOD Ï4(basic-inspect :get-normal-mouse-documentationÏ*) ()
  "Ï2Knows how to get the mouse doc string for inspect panes.  If the object that
 we're over has perspectives then these are mentioned in the mouse docs.Ï*"
  (LET ((item (IF sensitive-inspect-item (get-mouse-sensitive-item) nil)))
    (MULTIPLE-VALUE-BIND (perspectives thing)
	(IF (AND (CONSP item) (THIRD item)
		 (EQUAL :item1 (FIRST item)))
	    (IF (allocated-perspectives (THIRD item))
		(VALUES (allocated-perspectives (THIRD item)) (THIRD item))
		(VALUES nil (THIRD item)))
	    (IF (AND item (allocated-perspectives item))
		(VALUES (allocated-perspectives item) item)
		(IF (AND (EQUAL print-function-arg :list-structure)
			 (LOCATIVEP item)
			 (%p-contents-safe-p item)
			 (allocated-perspectives (FIRST item)))
		    (VALUES (allocated-perspectives (FIRST item))
			    (FIRST item))
		    nil)))
      (IGNORE perspectives)
      (APPEND (SEND (IF (TYPEP thing 'inspection-data)
			thing
			(map-into-show-x thing t))
		    :who-line-doc ;Ï1; 1st arg to who-line doc must be pane, not t - TAC 08-16-89Ï*
		    self (NOT thing))
	      '(:allow-override "")
	      normal-mouse-documentation))))

(DEFMETHOD Ï4(general-inspector-history-window :get-normal-mouse-documentationÏ*) ()
"Ï2Knows how to get the mouse doc string for inspector histor panes.  If the
 object that we're over has perspectives then these are mentioned in the mouse docs.Ï*"
  (LET ((item (IF sensitive-history-item (get-mouse-sensitive-item) nil)))
       (perspective-doc-string-addition item (AND item (get-perspectives item))
					normal-mouse-documentation)))

(DEFMETHOD Ï4(show-hash-table :middle-button-resultÏ*) ()
"Ï2Just returns the data slot.Ï*"
  data)

(DEFMETHOD Ï4(show-flavor :middle-button-resultÏ*) ()
"Ï2Just returns the data slot.Ï*"
  data)

(DEFMETHOD Ï4(show-function :middle-button-resultÏ*) ()
"Ï2Just returns the data slot.Ï*"
  data)

(DEFMETHOD Ï4(show-method :middle-button-resultÏ*) ()
"Ï2Returns the method we represent.Ï*"
  (SEND self :method-from-show-method))

(DEFMETHOD Ï4(show-generic-defstruct :middle-button-resultÏ*) ()
"Ï2Just returns the data slot.Ï*"
  data)

(DEFMETHOD Ï4(list-inspection-mixin :middle-button-resultÏ*) ()
"Ï2Just returns the data slot.Ï*"
  data)

;Ï1(defmethod (show-related-methods :middle-button-result) ()Ï*
;Ï1"Just returns the data slot."Ï*
;Ï1  dataÏ*
;Ï1)Ï*

;Ï1(defmethod (show-method-call-tree :middle-button-result) ()Ï*
;Ï1"Just returns the data slot."Ï*
;Ï1  dataÏ*
;Ï1)Ï*

(DEFMETHOD Ï4(debug-flavor :middle-button-resultÏ*) ()
  data)

(DEFMETHOD Ï4(show-undefined-flavor :middle-button-resultÏ*) ()
  data)

(DEFMETHOD Ï4(show-value :middle-button-resultÏ*) ()
  data)

;Ï1(defmethod (General-Inspector-History-Window :Before :Append-Item) (item)Ï*
;Ï1"This is just for debugging purposes.  It should not be called now."Ï*
;Ï1  (if (not (typep item 'tv:inspection-data))Ï*
;Ï1      (dbg)Ï*
;Ï1  )Ï*
;Ï1)Ï*

(DEFMETHOD Ï4(basic-inspect-frame :inspect-info-left-clickÏ*) ()  ;Ï1fiÏ*
  (LET ((thing (inspect-real-value ucl:kbd-input)))
    ;Ï1; First flush item we will be inspectingÏ*
    (MULTIPLE-VALUE-BIND (thing inspect-p)
	(IF (OR (TYPEP thing 'inspection-data)
		(NOT *general-inspector-enabled*))
	    (VALUES thing t)
	    (map-into-show-x thing t))
      (IF inspect-p
	  (PROGN (inspect-flush-from-history thing history)
		 (SEND history :append-item thing)
		 ;Ï1; Modded here by JPR.Ï*
		 (IF *flush-cache-if-left-button-on-something*
		     (IF (EQUAL *flush-cache-if-left-button-on-something*
				:really)
			 (SEND history :set-cache nil)
			 (SEND history :flush-object-from-cache thing)))
		 (update-panes))))))


(DEFMETHOD Ï4(inspection-data :print-selfÏ*) (STREAM &rest ignore)
"Ï2Just a simple print method for inspection datas, so that we can see what
 we're inspecting.Ï*"
  (CATCH-ERROR (FORMAT stream "Ï3#<~S ~S>Ï*"
		       (TYPE-OF self)
		       (SEND self :send-if-handles :middle-button-result))
	       nil))

;Ï1;; PatchÏ*
;Ï1;; TI code.Ï*

(DEFUN Ï4inspect-set-slotÏ* (slot *terminal-io* history inspectors)
  "Ï2Set the contents of SLOT to a value we obtain with the mouse or by reading.
SLOT is a blip produced by clicking on a mouse-sensitive item.
HISTORY should be the INSPECT-HISTORY-WINDOW;
we tell it to forget cached data on the slot.Ï*"
  (LET ((set-function (GET (FIRST slot) 'set-function)))
    (SEND *terminal-io* :clear-screen)
    (FORMAT *terminal-io* "Ï3~&New value to set with:Ï*")
    (MULTIPLE-VALUE-BIND (new-value punt-p)
	(inspect-get-value-from-user *terminal-io* history inspectors)
      (OR punt-p
	  (SEND set-function slot new-value
		(IF (AND *general-inspector-enabled*
			 (TYPEP (SEND (THIRD slot) :current-object) 'inspection-data))
		    (SEND (SEND (THIRD slot) :current-object) :data)
		    (SEND (THIRD slot) :current-object)))))
    ;Ï1; We must recompute object we modifiedÏ*
    (SEND history :flush-object-from-cache (SEND (THIRD slot) :current-object))
    (PROG1
      (SEND (THIRD slot) :top-item)
      (SEND (THIRD slot) :set-current-object (LIST nil)))))

;Ï1*************Ï*
;Ï1 TAC 08-04-89 - this has already been put in INSPECT.LISPÏ*
;Ï1(DEFCOMMAND DELETE-ALL-CMD NILÏ*			
;Ï1            '(:DESCRIPTION  "Delete all inspected objects from history and inspection panes."Ï*
;Ï1              :NAMES ("Delete") :KEYS (#\c-PAGE))Ï*
;Ï1            (DECLARE (SPECIAL HISTORY inspectors))Ï*
;Ï1            (SEND HISTORY :FLUSH-CONTENTS)Ï*
;Ï1            (LOOP for iw in inspectorsÏ*
;Ï1                  do (SEND iw :set-locked-p nil))Ï*
;	Ï1    ;;; This line added by JPR.  We don't want any old inspection datasÏ*
;	Ï1    ;;; is we delete all.  Mind you, *inspection-data* should reallyÏ*
;	Ï1    ;;; be an IV of the frame.Ï*
;	Ï1    (setq *inspection-data* nil)Ï*
;Ï1            (UPDATE-PANES))Ï*


(DEFMETHOD Ï4(flavor-inspector :disassemble-clos-methodÏ*) (method)
"Ï2Given a method, inspects its disassembled code.Ï*"
  (INSPECT method :clos-method-function))

(DEFMETHOD Ï4(flavor-inspector :disassemble-generic-functionÏ*)
	   (generic-function  class)
"Ï2Given a generic function disassembles it.Ï*"
  (IGNORE class)
  (INSPECT generic-function :generic-function-fef))

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

;Ï1;; The following fixes extend the behaviour of who-line docs.Ï*
;Ï1;; there were a number of major restrictions:Ï*

;Ï1;; a) It expected to have everything in the right order.  This is not theÏ*
;Ï1;;    case if mouse docs are added by whoppers and such.Ï*
;Ï1;; b) It assumed that you would only want line breaks if you were using theÏ*
;Ï1;;    no-comma option, which is bogus.Ï*
;Ï1;; c) It failed to compute a reasonable place for a line break if you wantedÏ*
;Ï1;;    it to.Ï*
;Ï1;; d) It failed to allow you to override mouse docs.  Thus if you had a wrapperÏ*
;Ï1;;    that added mouse docs, you had to go through the old list and remove anyÏ*
;Ï1;;    mouse docs with the same name (and get it all back in the right order).Ï*

;Ï1;; Patch from WhoLinÏ*
(DEFVAR Ï4*newline-thrown*Ï* nil)
(DEFVAR Ï4*non-printing-command*Ï* nil)

;Ï1;; TI code.Ï*
(DEFUN Ï4display-who-line-mouse-infoÏ* (who-sheet mouse-keyword documentation comma)
  "Ï2Display mouse information in the who line documentation window.Ï*"
  ;Ï1; Do the things which need to be done before writing out the documentation string.Ï*
  (LET ((page-overflow-encountered t)) 
    (COND (string-together
           ;Ï1; If we are stringing everything together and this is not the first lineÏ*
           ;Ï1; then we need to output a comma to separate this string from the previous string.Ï*
	   (IF *newline-thrown*
	       ;Ï1;; Patched here by JPR.Ï*
	       (SETQ *newline-thrown* nil)
	       (IF *non-printing-command*
		   (SETQ *non-printing-command* nil)
		   (WHEN (AND not-first? (NOT comma)
			      (NOT (GET mouse-keyword 'non-printing-mouse-keyword)))
		     ;Ï1; if not-first? is T and the value of  :no-comma is nil, Ï*
		     (sheet-string-out who-sheet "Ï3, Ï*")))))   ;Ï1; then we output a comma.Ï*
          (t
           ;Ï1; If we are formatting the lines, then we need to position the cursor to the correct place.Ï*
           (APPLY 'sheet-set-cursorpos who-sheet
                  (CASE mouse-keyword
                        ((:mouse-any                 ) `(,left-click-loc   ,mouse-single-loc))
                        ((:mouse-1-1    :mouse-l-1   ) `(,left-click-loc   ,mouse-single-loc))
                        ((:mouse-1-2    :mouse-l-2   ) `(,left-click-loc   ,mouse-double-loc))
                        ((:mouse-1-hold :mouse-l-hold) `(,left-click-loc   ,mouse-hold-loc  ))
                        ((:mouse-2-1    :mouse-m-1   ) `(,middle-click-loc ,mouse-single-loc))
                        ((:mouse-2-2    :mouse-m-2   ) `(,middle-click-loc ,mouse-double-loc))
                        ((:mouse-2-hold :mouse-m-hold) `(,middle-click-loc ,mouse-hold-loc  ))
                        ((:mouse-3-1    :mouse-r-1   ) `(,right-click-loc  ,mouse-single-loc))
                        ((:mouse-3-2    :mouse-r-2   ) `(,right-click-loc  ,mouse-double-loc))
                        ((:mouse-3-hold :mouse-r-hold) `(,right-click-loc  ,mouse-hold-loc  ))))))
    ;Ï1; We change the font for the mouse prefix to distinguish the prefix from the mouse documentation.Ï*
    (SEND who-sheet :set-current-font *mouse-documentation-line-buttons-standard-font* t)
    ;Ï1;; Patched by JPR.Ï*
    (IF (EQUAL :newline mouse-keyword)
        (PROGN (TERPRI who-sheet)
	        (SETQ *newline-thrown* t))
	(IF (GET mouse-keyword 'non-printing-mouse-keyword)
	    (SETQ *non-printing-command* t) ;Ï1;; do nothing.Ï*
	    (CATCH 'page-overflow
	      (sheet-string-out who-sheet
				(OR (CADR (IF (EQ mouse-handedness :left)
					      (ASSOC mouse-keyword
						     '((:mouse-any "Ï3L,M,RÏ*") (:any "Ï3L,M,RÏ*")
						       (:mouse-r-1 "Ï3LÏ*")   (:mouse-r-2 "Ï3L2Ï*")   (:mouse-r-hold "Ï3LHÏ*")
						       (:mouse-3-1 "Ï3LÏ*")   (:mouse-3-2 "Ï3L2Ï*")
						       (:mouse-m-1 "Ï3MÏ*")   (:mouse-m-2 "Ï3M2Ï*")   (:mouse-m-hold "Ï3MHÏ*")
						       (:mouse-2-1 "Ï3MÏ*")   (:mouse-2-2 "Ï3M2Ï*")
						       (:mouse-l-1 "Ï3RÏ*")   (:mouse-l-2 "Ï3R2Ï*")   (:mouse-l-hold "Ï3RHÏ*")
						       (:mouse-1-1 "Ï3RÏ*")   (:mouse-1-2 "Ï3R2Ï*")) :test #'EQ)
					      ;Ï1;ELSEÏ*
					      (ASSOC mouse-keyword
						     '((:mouse-any "Ï3L,M,RÏ*") (:any "Ï3L,M,RÏ*")
						       (:mouse-r-1 "Ï3RÏ*")   (:mouse-r-2 "Ï3R2Ï*")   (:mouse-r-hold "Ï3RHÏ*")
						       (:mouse-3-1 "Ï3RÏ*")   (:mouse-3-2 "Ï3R2Ï*")
						       (:mouse-m-1 "Ï3MÏ*")   (:mouse-m-2 "Ï3M2Ï*")   (:mouse-m-hold "Ï3MHÏ*")
						       (:mouse-2-1 "Ï3MÏ*")   (:mouse-2-2 "Ï3M2Ï*")
						       (:mouse-l-1 "Ï3LÏ*")   (:mouse-l-2 "Ï3L2Ï*")   (:mouse-l-hold "Ï3LHÏ*")
						       (:mouse-1-1 "Ï3LÏ*")   (:mouse-1-2 "Ï3L2Ï*")) :test #'EQ)))
				    ;Ï1; If the caller specified an illegal mouse buttonÏ*
				    ;Ï1; then use the following string as the mouse prefix.Ï*
				    "Ï3Bad doc keywordÏ*"))
	      (sheet-string-out who-sheet "Ï3: Ï*" 0
				(IF (STRING-EQUAL "" documentation)
				    ;Ï1; If the documentation for this button is empty then we doÏ*
				    ;Ï1; not want to have the space after the mouse prefix.  InÏ*
				    ;Ï1; this case there are two mouse buttons which do the sameÏ*
				    ;Ï1; thing.  The next mouse button will have the documentationÏ*
				    ;Ï1; for this mouse button.  See the EDIT SCREEN menu item ofÏ*
				    ;Ï1; the System Menu for an example of this.Ï*
				    ;Ï1; may 9-9-88 NOTE:Ï*
				    ;Ï1; Above reference to EDIT-SCREEN is/was no longer true.Ï*
				    ;Ï1; No doc on this "feature" exists and it seems to beÏ*
				    ;Ï1; pretty much worthless.Ï*
				    1
				    ;Ï1;ELSEÏ*
				    nil))
	      (SEND who-sheet :set-current-font new-who-line-font t)
	      (sheet-string-out who-sheet documentation)
	      (SETQ page-overflow-encountered nil))))

    (IF page-overflow-encountered
      (SETQ maximum-who-line-mouse-x (sheet-inside-width who-sheet))
      ;Ï1;ELSEÏ*
      (WHEN (>= (sheet-cursor-y who-sheet) maximum-who-line-mouse-y)
	(SETQ maximum-who-line-mouse-y (sheet-cursor-y who-sheet)
	      maximum-who-line-mouse-x (sheet-cursor-x who-sheet))))))

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

(DEFUN Ï4order-mouse-itemsÏ* (items)
"Ï2Given a list of mouse doc items e.g. (:mouse-r-2 \"system menu\") it orders
 them in mouse button order.Ï*"
  (SORTCAR (COPY-LIST items)
	 #'(lambda (x y)
	     (IF (AND (>= (LENGTH (THE string (SYMBOL-NAME x))) 8)
		       (>= (LENGTH (THE string (SYMBOL-NAME y))) 8)
		       (SEARCH "Ï3MOUSE-Ï*" (THE string (SYMBOL-NAME x))
			        :end2 1)
		       (SEARCH "Ï3MOUSE-Ï*" (THE string (SYMBOL-NAME y))
			        :end2 1))
		 (LET ((key-x (AREF (SYMBOL-NAME x) 6))
		      (key-y (AREF (SYMBOL-NAME y) 6)))
		     (IF (EQUAL key-x key-y)
			 (LET ((num-x (AREF (SYMBOL-NAME x) 8))
			      (num-y (AREF (SYMBOL-NAME y) 8)))
			     (< (CHAR-INT num-x) (CHAR-INT num-y)))
			 (OR (AND (EQUAL #\L key-x)
				   (MEMBER key-y '(#\M #\R)))
			     (AND (EQUAL #\M key-x) (EQUAL #\R key-y)))))
		  (STRING-LESSP (THE string (SYMBOL-NAME x))
			       (THE string (SYMBOL-NAME y)))))))

;Ï1*************Ï*
;Ï1 TAC 07-27-89 - moved from FUNCTIONAL-INTERFACE (grapher file) Ï*
(DEFUN Ï4doc-sizeÏ* (spec intro-offset length-so-far)
"Ï2Returns the x y motion for a mouse doc spec like (:mouse-r-2 \"system menu\")
 in the mouse doc sheet.  Intro-offset is the motion for a string like
 \"M2: ,\" so that we allow for this.  Length-so-far is the length of the
 current output so that we can compute whether we throw a newline.Ï*"
  (sheet-compute-motion
    who-line-documentation-window
    (+ intro-offset length-so-far) 0 (SECOND spec) 0 nil nil 0 nil nil nil
    (get-default-font who-line-documentation-window)))

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

(DEFUN Ï4maybe-split-doc-specÏ* (specs intro-offset length-so-far)
"Ï2Given a list of mouse doc specs of the form (:mouse-r-2 \"system menu\"),
 the length of a string like \"M2: ,\" and the current length of the line
 it returns a flattened version of the specs list with :newline \"\" inserted
 where the mouse doc printer should output a newline.Ï*"
  (IF specs
      (MULTIPLE-VALUE-BIND (x y)
	  (doc-size (FIRST specs) intro-offset length-so-far)
	(IF (AND (NOT (EQUAL 0 length-so-far)) (> y 0))
	    (APPEND '(:newline "")
		      (maybe-split-doc-spec specs intro-offset intro-offset))
	    (APPEND (FIRST specs)
		     (maybe-split-doc-spec (REST specs)
					   intro-offset (+ x intro-offset)))))
     nil))

(SETF (GET :allow-override 'non-printing-mouse-keyword) t)
(SETF (GET :sort 'non-printing-mouse-keyword) t)
(SETF (GET :smart-newlines 'non-printing-mouse-keyword) t)

(DEFUN Ï4process-who-line-documentation-listÏ* (who-sheet new-state) 
  "This function displays who line mouse documentation from a keyword
list.  The list is organized in keyword, value pairs.  That is each odd
item is a keyword and the following item is the value for that keyword.
The keywords that are recognized are:

	:DOCUMENTATION	a general documentation string which will be displayed
			below the mouse button documentation lines.
	:KEYSTROKE	used to indicate that a particular keystroke corresponds
			to this who line documentation.  This can be either a
			a string or a character.  For effeciency reasons it is
			recommended that this be a string.
        :NO-COMMA       if in list, then items in who line documentation are not
                        delimited by a comma. Users are responsible for delimiters.
	:FONT		cause the following items in the list to be displayed in
			the specified font.  The font is not required to be in
			the font map for the who line documentation window.
        :ALLOW-OVERRIDE with :Allow-Override \"\" it wil allow elements in the
                        new state to override other ones.  Thus if the state is
                        (:Allow-Override \"\" :mouse-l-1 \"Hello\" :mouse-l-1 \"foo\")
                        then the result will be L: Hello, not L: Hello, L: foo.
        :SORT           if :sort \"\" is provided then it will sort the items into
                        a reasonable order.
        :NEWLINE        if :newline \"\" is provided then it will throw a newline
                        in the designated place.
        :SMART-NEWLINES if :Smart-Newlines \"\" is provided then it will attempt
                        to compute a good place to throw a newline, trying not
                        to wrap any of the mouse docs.
	:MOUSE-ANY	documentation for clicking ANY mouse button clicked once.
	:MOUSE-L-1	documentation for the left   mouse button clicked once.
	:MOUSE-L-2	documentation for the left   mouse button clicked twice.
	:MOUSE-L-HOLD   documentation for the left   mouse button held down.
	:MOUSE-M-1	documentation for the middle mouse button clicked once.
	:MOUSE-M-2	documentation for the middle mouse button clicked twice.
	:MOUSE-M-HOLD   documentation for the middle mouse button held down.
	:MOUSE-R-1	documentation for the right  mouse button clicked once
	:MOUSE-R-2	documentation for the right  mouse button clicked twice.
	:MOUSE-R-HOLD   documentation for the right  mouse button held down.
        

The documentation display varies based on how many who line
documentation lines are available.  If there are less than three lines all
of the mouse documentation is squeezed onto one line instead of being
displayed at separate locations."
  ;Ï1; Note that the old forms of the mouse keywords are supported too.Ï*
  ;Ï1; That is writing :MOUSE-1-1 instead of :MOUSE-L-1.  This is doneÏ*
  ;Ï1; only in case someone out there is using that form.  We want usersÏ*
  ;Ï1; to use the newer form because it makes for better documentation,Ï*
  ;Ï1; that is why we do not advertise the old form in the documentationÏ*
  ;Ï1; line for this function.Ï*
  (LET ((have-documentation (OR (MEMBER  :documentation new-state :test #'EQ)
                                (MEMBER :keystroke     new-state :test #'EQ)))
			
	;Ï1; when comma is nil, we will NOT output a comma in documentation line. Ï*
	(comma (MEMBER :no-comma new-state :test #'EQ))
	;Ï1; says that we should sort the new state list.Ï*
	(should-sort (MEMBER :sort new-state :test #'EQ))
	;Ï1; says that we should let items to the left of the state override the same namedÏ*
	;Ï1; items to the right.Ï*
	(should-allow-override (MEMBER :allow-override new-state :test #'EQ))
	;Ï1; says try to find a good place to put in newlines rather than wrapping.Ï*
	(smart-newlines (MEMBER :smart-newlines new-state :test #'EQ))
	;Ï1; holds the list if it is split into pairs.Ï*
	(split-up nil))
	;Ï1; We string the documentation components together in certain cases.  If thereÏ*
	;Ï1; is only 1 or 2 lines then there isn't much choice.  If there are 3 lines,Ï*
	;Ï1; then we also have to have a :DOCUMENTATION component too.  If there are 4 orÏ*
	;Ï1; more lines then we can display the documentation in a 3 column format.Ï*
    (SETQ string-together (OR t  ;Ï1; may 9-9-88Ï*
			      ;Ï1; Ï*
			      ;Ï1; *** HACK ALERT - When (3)4 or more doc lines exist, specialÏ*
			      ;Ï1; formatting was done to put the 9 possible keys in 3 rowsÏ*
			      ;Ï1; of 3 columns. Problem with this is that long strings willÏ*
			      ;Ï1; get trashed ( overwritten ) even though the # of wholineÏ*
			      ;Ï1; lines is GREATER then before. This was a good idea thatÏ*
			      ;Ï1; is just unworkable for the benefit it adds. We can't expectÏ*
			      ;Ï1; every doc-string to be tested for multiple conditions ofÏ*
			      ;Ï1; who-line lines. As a result much of this code is now obsoleteÏ*
			      (= number-of-who-line-documentation-lines 1)
                              (= number-of-who-line-documentation-lines 2)
                              (AND have-documentation
                                   (= number-of-who-line-documentation-lines 3))))

    ;Ï1; Initialize constants for this function execution.Ï*
    (SETQ left-click-loc 2
	  middle-click-loc (IF (NOT string-together) (TRUNCATE (sheet-inside-width who-sheet) 3))
	  right-click-loc (IF (NOT string-together)
                              (- (sheet-inside-width who-sheet) middle-click-loc))
	  mouse-single-loc 2
	  mouse-double-loc (AND (NOT string-together)
                                (IF (OR (MEMBER :mouse-l-1 new-state :test #'EQ)
                                        (MEMBER :mouse-m-1 new-state :test #'EQ)
                                        (MEMBER :mouse-r-1 new-state :test #'EQ)
                                        (MEMBER :mouse-1-1 new-state :test #'EQ)
                                        (MEMBER :mouse-2-1 new-state :test #'EQ)
                                        (MEMBER :mouse-3-1 new-state :test #'EQ))
                                    ;Ï1; We have single click info, put this on the second line.Ï*
                                    (+ mouse-single-loc who-line-documentation-line-height)
                                    ;Ï1;ELSE Don't have single click info, put this on the first line.Ï*
                                    mouse-single-loc))
	  mouse-hold-loc (AND
                           (NOT string-together)
                           (IF (OR (MEMBER :mouse-l-2 new-state :test #'EQ)
                                   (MEMBER :mouse-m-2 new-state :test #'EQ)
                                   (MEMBER :mouse-r-2 new-state :test #'EQ)
                                   (MEMBER :mouse-1-2 new-state :test #'EQ)
                                   (MEMBER :mouse-2-2 new-state :test #'EQ)
                                   (MEMBER :mouse-3-2 new-state :test #'EQ))
                               ;Ï1; We have both double click info.  The hold info must on the line after that.Ï*
                               (+ mouse-double-loc who-line-documentation-line-height)
                               ;Ï1;ELSEÏ*
                               (IF (NOT (= mouse-single-loc mouse-double-loc))
                                   ;Ï1; There was single click info. put this after that.Ï*
                                   (+ mouse-single-loc who-line-documentation-line-height)
                                   ;Ï1; ELSE This is the only mouse documentation. put on the first line.Ï*
                                   mouse-single-loc))))

    (IF should-allow-override
       ;Ï1; we should uniqify.  This'll invokve consing a new list butÏ*
       ;Ï1; that won't cost too much.Ï*
       (PROGN (SETQ new-state (COPY-LIST new-state))
	      (LOOP for (name value) on new-state by #'CDDR
		    for here on new-state by #'CDDR
		    for rest = (REST here)
		    do (LET ((index (POSITION name rest :test #'EQ)))
			   (IF index
			        (SETF (NTHCDR index rest)
				      (NTHCDR (+ 2 index) rest))
				nil))))
       nil)
    (IF (OR should-sort smart-newlines)
        (SETQ split-up
	      (LOOP for (name value) on new-state by #'CDDR
		    collect (LIST name value)))
	nil)
    (IF should-sort
       ;Ï1; ok, we know that this'll be a little expensive but that's ok.Ï*
       (PROGN (SETQ split-up (order-mouse-items split-up))
	      (SETQ new-state (APPLY #'APPEND split-up)))
       nil)
    (IF smart-newlines
       ;Ï1; xxÏ*
       (LET ((intro-offset (sheet-compute-motion
			   who-line-documentation-window
			   0 0 "Ï3M2: , Ï*" 0 nil nil 0 nil nil nil
			   *mouse-documentation-line-buttons-standard-font*))) 
	   (SETQ new-state
		 (maybe-split-doc-spec split-up intro-offset intro-offset)))
       nil)

    (SETQ old-who-line-font        (get-default-font who-sheet)
	  new-who-line-font        old-who-line-font
	  not-first?               nil
	  maximum-who-line-mouse-x 0
	  maximum-who-line-mouse-y 0)


    ;Ï1; This loops through all of the non-documentation keywords.  We process them first so we can put theÏ*
    ;Ï1; documentation strings towards the bottom of the window.  If we didn't then we might intersperse them.Ï*
    (LOOP for doc-spec = new-state then (CDDR doc-spec)
          while doc-spec
          for old-key = nil then key
          for key     = (FIRST  doc-spec)
          for value   = (SECOND doc-spec)
          finally (UNLESS (EQ (sheet-current-font who-sheet) old-who-line-font)
                    (SEND who-sheet :set-current-font old-who-line-font))
          do
          (PROGN
            (WHEN (AND (NOT not-first?) old-key)
              (SETQ not-first? (AND (NOT (EQ old-key :font))
                                    (NOT (EQ old-key :keystroke))
				   ;Ï1; (NOT (EQ OLD-KEY :NO-COMMA))Ï*
                                    (NOT (EQ old-key :documentation)))))
            (IF (EQ key :font)
                (PROGN
                  ;Ï1; Change the current font.  The T argument says toÏ*
                  ;Ï1; change the font even if it isn't in the FONT-MAP.Ï*
                  (SEND who-sheet :set-current-font value t)
                  (SETQ new-who-line-font value))
                ;Ï1;ELSEÏ*
                (IF (AND (NOT (EQ key :keystroke))
                         (NOT (EQ key :documentation))
			 (NOT (EQ key :no-comma)))
                    (display-who-line-mouse-info who-sheet key value comma)))))

    (WHEN have-documentation
      (sheet-set-cursorpos who-sheet maximum-who-line-mouse-x maximum-who-line-mouse-y)
      ;Ï1; If the mouse info wraps onto the last line available then we start the :DOCUMENTATION infoÏ*
      ;Ï1; there.  Otherwise we put the :DOCUMENTATION on the next line.Ï*
      (SETQ not-first? (AND string-together
			    (= (1+ (TRUNCATE maximum-who-line-mouse-y who-line-documentation-line-height))
                               number-of-who-line-documentation-lines)
                            (NOT (ZEROP maximum-who-line-mouse-x)))) 

      (SETQ new-who-line-font (get-default-font who-sheet))
      (CATCH 'page-overflow
	(WHEN (NOT not-first?)
	  (SEND who-sheet :fresh-line))
	;Ï1; Now we loop through again to get all of the :DOCUMENTATION info.Ï*
	(LOOP for documentation-keyword in '(:documentation :keystroke) ;Ï1;;:no-comma)Ï*
	      do
	      (LOOP for doc-spec = new-state then (CDDR doc-spec)
		    while doc-spec
		    with old-key = nil
		    for key      = (FIRST  doc-spec)
		    for value    = (SECOND doc-spec)
		    finally (UNLESS (EQ (sheet-current-font who-sheet) old-who-line-font)
			      (SEND who-sheet :set-current-font old-who-line-font))
		    when (OR (EQ key :font) (EQ key documentation-keyword))
		    do
		    (PROGN
		      (IF (EQ key :font)
			  (PROGN
			    ;Ï1; Change the current font.  The T argument says toÏ*
			    ;Ï1; change the font even if it isn't in the FONT-MAP.Ï*
			    (SEND who-sheet :set-current-font value t)
			    (SETQ new-who-line-font value))
			  ;Ï1;ELSEÏ*
			  (WHEN (NOT (EQ key :font))
				(WHEN (AND not-first? (NOT comma))
				       (sheet-string-out who-sheet "Ï3,  Ï*")
				       ;Ï1;elseÏ*
				    (SETQ not-first? t)))
			    (WHEN (EQ key :keystroke)
			      (SEND who-sheet :set-current-font *mouse-documentation-line-buttons-standard-font* t)
			      (sheet-string-out who-sheet "Ï3Keystroke: Ï*")
			      ;Ï1; Make sure the value is a string.Ï*
			      (WHEN (OR (CHARACTERP value) (INTEGERP value))
				(SETQ value (FORMAT nil "Ï3~:CÏ*" value)))
			      (SEND who-sheet :set-current-font new-who-line-font t))
			    (sheet-string-out who-sheet value))
		      (SETQ old-key key))
		    ))))))

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

(enable-general-inspector)

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

;Ï1; *** from Rice's message Mods to Gen. Insp. 8 Jun 1989 13:45:21 PDTÏ*
;Ï1; this function was already hereÏ*
(DEFMETHOD Ï4(inspection-data :handle-mouse-clickÏ*) (blip flavor-inspector)
  (SELECTOR (FOURTH blip) =
    (#\mouse-l-1 (SEND flavor-inspector :inspect-info-left-click))
    (t (BEEP))))
