;;; -*- Mode:Common-Lisp; Package:TV; Base:8; 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) & (c)(1)(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 Texas Instruments Incorporated. All rights reserved.Ï*
;Ï1;; Copyright (C) 1984-1989 Texas Instruments Incorporated. All rights reserved.Ï*

;;; 01-05-88 DAB Fixed (BASIC-INSPECT :OBJECT-LIST). It would lose the last char in a list. For example do:
;;;              INSPECT: (cons 'xx (loop for i from 1 to 100 collect (mod i 10))).
;;; 02/15/89 clm Added code done by PH and DNG to show a compiled functions debug-info-struct.
;;; 03/03/89 clm Patch the inspector to show more information when inspecting an ART-SPECIAL-PDL.
;;               Add special handling for CLOS mapping tables. (for DNG)
;;; 05/01/89 jlm Fixed INSPECT-ARRAY-ITEM-GENERATOR to not let you go past PDL pointer and (potentially) crash machine.
;;; 05/08/89 jlm Added *INSPECT-PDL-SAFE* to allow user override of PDL pointer safety checking
;;; 06/15/89 tac Altered method of basic-inspect :object-instance to recognize and report a CLOS class correctly.
;;; 06/15/89 tac Altered GRIND-INTO-LIST-MAKE-ITEM to add a COND test on LOC parameter before using it in len calculation.

(UNLESS (FBOUNDP 'ticlos::mapping-table-p) ;Ï1;  if not loaded yetÏ*
  (sys::fset 'ticlos::mapping-table-p #'IGNORE)) ;Ï1; clm 03/03/89Ï*

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - being redefined by code in GENERAL-INSPECTOR - it adds mouse-sensitive printing Ï*
;Ï1(DEFUN PRINT-ITEM-CONCISELY (ITEM STREAM &OPTIONAL (LEVEL 0))Ï*

(DEFVAR Ï4*printing-mouse-sensitively*Ï* nil
  "Ï2True when the things that are being printed should be turned into mouse
 sensitive items if you know how to.Ï*")

(DEFVAR Ï4grind-into-list-list)Ï*
(DEFVAR Ï4grind-into-list-string)Ï*
(DEFVAR Ï4grind-into-list-items-p)Ï*
(DEFVAR Ï4grind-into-list-items)Ï*
(DEFVAR Ï4grind-into-list-list-items)Ï*
(DEFVAR Ï4grind-into-list-list-item-stack)Ï*
(DEFVAR Ï4grind-into-list-line)Ï*

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE Grind-Top-Level :Around :Mouse-Sensitivity-Addition nilÏ*
;Ï1    ;;; Bind *printing-mouse-sensitively* because this is a good place toÏ*
;Ï1    ;;; have mouse sensitive objects as long as you are grinding into anÏ*
;Ï1    ;;; inspect pane.Ï*
;Ï1    (IF (AND (SEVENTH arglist)Ï*
;	Ï1     (OR (EQUAL (SEVENTH arglist)  'grind-into-list-make-item)Ï*
;		Ï1 (EQUAL (SEVENTH arglist) #'grind-into-list-make-item))Ï*
;	Ï1     (NOT grind-into-list-string))Ï*
;	Ï1(LET ((*printing-mouse-sensitively* t))Ï*
;	Ï1  (DECLARE (SPECIAL *printing-mouse-sensitively*))Ï*
;	Ï1  :Do-It)Ï*
;	Ï1:Do-It)))Ï*
;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4grind-into-listÏ* (EXP width &optional items-p)
  "Ï2Grind EXP into width WIDTH, recording where each list and atom came out.

The first value returned is the output text, as a list of strings, one for each line of output.

The second and third values returned are constructed only if ITEMS-P is non-NIL.  The second 
 value describes where each atom in EXP was printed.  It has one element for each line of output.  
 This element is a list with an element for each atom printed on that line.  These elements look likeÏ*
	Ï2(location :LOCATIVE flag start-index end-index)
 location is the pointer (part of EXP) whose car is this atom.  If the atom is EXP itself, then 
 location is :TOP-LEVEL.  start-index and end-index are horizontal positions, indices into the 
 string which represents the line (in the first value).

The third value describes where all the lists in EXP ended up.  It has one element for each list
 in EXP.  Elements look like:Ï*
	Ï2(location start-idx start-line-number end-idx end-line-number)
Start-line-number is which line the list starts on, and start-idx is the horizontal position in that line.  
End-line-number and end-idx are similar.Ï*"
  (LET ((grind-into-list-items-p items-p)
	(grind-into-list-items (CONS () ()))
	(grind-into-list-line 0)
	grind-into-list-list
	grind-into-list-string
	grind-into-list-list-items
	grind-into-list-list-item-stack)
    (LET ((*printing-mouse-sensitively* t)) ;Ï1; from advise around grind-top-level commented above Ï*
	  (DECLARE (SPECIAL *printing-mouse-sensitively*))
	  (GRIND-TOP-LEVEL exp width 'grind-into-list-io () 'si::displaced t
			   (AND items-p 'grind-into-list-make-item) 
			   :top-level 'si::grind-as-block))
    (grind-into-list-io :tyo #\Newline)
    (BLOCK ()
      (RETURN (NREVERSE grind-into-list-list) (NREVERSE grind-into-list-items)
	      grind-into-list-list-items))))

;Ï1**************Ï*
;Ï1 TAC 08-03-89 - being redefined in INSPECTOR-ENHANCEMENTS -  FAT-STRING used instead of STRING-CHARÏ*
;Ï1(DEFUN GRIND-INTO-LIST-IO (OP &OPTIONAL ARG1 &REST REST)Ï*

(DEFUN Ï4grind-into-list-make-itemÏ* (thing loc atom-p len)
  (LET ((idx (IF grind-into-list-string
	       (ARRAY-ACTIVE-LENGTH grind-into-list-string)
	       0)))
    (COND
      (atom-p ;Ï1; An atom -- make an item for it.Ï*
       ;Ï1; ***  TAC 06-14-89 - figure out what kind of data loc is - avoid operations on it multiple times. Ï*
       (LET ((data (COND ((CONSP loc) (CAR loc))
			 ((LOCATIVEP loc) (CONTENTS loc))
			 (t loc))))
	 (PUSH (LIST loc :locative idx (+ idx (IF (STRINGP data)
						  (+ 1 (OR (POSITION #\cr data)
							   (1- (FLATSIZE data))))
						  len)))
	       (CAR grind-into-list-items))))
      (t
       ;Ï1; Printing an interesting characterÏ*
       (CASE thing
	 (sys::start-of-object
	  ;Ï1; Start of a list.Ï*
	  (PUSH (LIST loc idx grind-into-list-line () ()) grind-into-list-list-item-stack))
	 (sys::end-of-object
	  ;Ï1; Closing a list.Ï*
	  (LET ((item (POP grind-into-list-list-item-stack)))
		;Ï1; 1+ is to account for close-paren which hasn't beenÏ*
		;Ï1; typed yet. in rel2 next line was (1+ idx)Ï*
	    (SETF (FOURTH item) idx)
	    (SETF (FIFTH item) grind-into-list-line)
	    (PUSH item grind-into-list-list-items))))))))

(DEFUN Ï4concise-flatsizeÏ* (thing)
  "Ï2Return the number of characters it takes to do PRINT-ITEM-CONCISELY on THING.Ï*"
  (LET ((si::*ioch 0))
    (print-item-concisely thing 'concise-flatsize-stream)
    si::*ioch))

(SETF (GET 'concise-flatsize-stream 'si::io-stream-p) t)

(DEFUN Ï4concise-flatsize-streamÏ* (op &optional arg1 &rest rest)
  (IF (EQ op :item1)
    (print-item-concisely arg1 'concise-flatsize-stream (THIRD rest))
    (APPLY #'si::flatsize-stream op arg1 rest))) 

(DEFUN Ï4concise-stringÏ* (thing &optional truncate-at)
  "Ï2Prints thing concisely into a string.
Returns two values: the string, and an item-list in the form:
  (object starting-position-in-string last-position-in-string)Ï*"
  (LET ((concise-string (MAKE-ARRAY (OR truncate-at 100)
				    :element-type 'string-char :leader-list '(0)))
	(concise-items nil)
	(concise-truncate truncate-at))
    (DECLARE (SPECIAL concise-string concise-items concise-truncate))
    (CATCH 'concise-truncate

      (print-item-concisely thing 'concise-string-stream))
    (BLOCK ()
      (RETURN concise-string concise-items)))) 

(SETF (GET 'concise-string-stream 'si::io-stream-p) t)

(DEFUN Ï4concise-string-streamÏ* (op &optional arg1 &rest rest)
  (LOCALLY (DECLARE (SPECIAL concise-string concise-items concise-truncate))
     (CASE op
       (:tyo (VECTOR-PUSH-EXTEND arg1 concise-string)
	(AND concise-truncate
	     (>= (ARRAY-LEADER concise-string 0) concise-truncate)
	     (THROW 'concise-truncate
		    ())))
       (:which-operations '(:tyo))
       (:item1
	(LET ((item (LIST arg1 (ARRAY-LEADER concise-string 0) concise-truncate)))
	  (PUSH item concise-items)
	  (print-item-concisely arg1 'concise-string-stream (THIRD rest))
	  (SETF (THIRD item) (ARRAY-LEADER concise-string 0))))
       (t (STREAM-DEFAULT-HANDLER 'concise-string-stream op arg1 rest))))) 


;Ï1;; ----------- Inspect structures -------------------Ï*

(DEFCONSTANT Ï4inspect-scroll-fontÏ*  fonts:hl12b) 
(DEFCONSTANT Ï4inspect-label-fontÏ*  fonts:hl12b)
(DEFCONSTANT Ï4inspect-standard-fontÏ* fonts:cptfont)

(DEFPARAMETER Ï4*inspector-configuration*Ï* :three-panes
"Ï2Default configuration for the inspectorÏ*")

;Ï1; ----------------------------------------------     Normal,          normal-bold,       italics,          small-bold.Ï*
(DEFPARAMETER Ï4*inspector-font-map*Ï* (LIST fonts:cptfont fonts:hl12b fonts:hl12bi fonts:hl10b)
"Ï2Used for the initialisation of the font maps for Inspectors.
There are four elements; (Normal Font, Normal Bold Font, Italic Font, Small Bold Font)Ï*")

(DEFUN send-if-handles (to-object message &rest other-arguments)
  "Ï3Send a send-if-handles message to to-objectÏ*"
  (LEXPR-SEND to-object :send-if-handles message other-arguments))

;Ï1; This section contains new code for the redesigned inspector taken from John Hogge's flavor-inspector.Ï*
;Ï1; This code is used by special Inspector windows (such as the Flavor Inspector) for constructing and maintaining special data types.Ï*

(DEFVAR Ï4*inspection-data*Ï* nil
  "Ï2Holds data items generated and used by special-purpose inspectors (such as the Flavor Inspector).
The data is organized in an alist of entries (<flavor> . <instances>) where <flavor> is the name of a flavor which
mixes in TV:INSPECTION-DATA and <instances> are a list of instances of <flavor>.  For example, in the Flavor
Inspector, if the user inspects flavor UCL:BASIC-COMMAND-LOOP, the Flavor Inspector adds an instance of 
TV:SHOW-FLAVOR to this list.  This list is used by the inspection history code to conserve memory.  Once
a data item is created to hold a given piece of data, it is stored here and reused when the user pulls it
out of the history to be re-inspectedÏ*")

;Ï1; Looks for an already existing data entry for TYPE and DATA in TV:*INSPECTION-DATA*.Ï*
;Ï1; If there, returns it.  Otherwise creates it, using DATA to initialize instance variable DATA.Ï*
;Ï1; If AUXILIARY-DATA is supplied, it initializes the AUX-DATA instance variable (TYPE should thenÏ*
;Ï1; be a flavor which mixes in TV:AUXILIARY-DATA-MIXIN).Ï*
(DEFUN Ï4allocate-dataÏ* (type data &optional (auxiliary-data nil aux-supplied?))
  (LET ((alist-entry (ASSOC type *inspection-data* :test #'EQ)))
	;Ï1; If this is the first TYPE of its kind, add an alist entry for TYPE.Ï*
     (UNLESS alist-entry
      (PUSH (SETQ alist-entry (LIST type)) *inspection-data*))
    ;Ï1; If DATA already has an entry, return it -  otherwise create and return one.Ï*
    (OR
     (IF aux-supplied?
       (LOOP for entry in (CDR alist-entry)
             when (SEND entry :match? data auxiliary-data)
             return entry)
       (LOOP for entry in (CDR alist-entry)
             when (SEND entry :match? data)
             return entry))
     ;Ï1; Return new instanceÏ*
     (CAR
      (SETF (CDR alist-entry)
	    ;Ï1; Add new entry as the second element.Ï*
	    (CONS
	     (IF aux-supplied?
	       (IF (EQ type 'show-value)
                   (MAKE-INSTANCE type :string nil :data data :aux-data auxiliary-data)
                (MAKE-INSTANCE type :data data :aux-data auxiliary-data))
	       (MAKE-INSTANCE type :data data))
	     (CDR alist-entry))))))) 

;Ï1***************Ï*
;Ï1 TAC 08-01-89 - new definition of inspection data (from TI-ENV-INSPECTOR-INTERFACE) Ï*
;Ï1-------------------------------------------------------------------------------Ï*
;Ï1; Redefine this so that we have :middle-button-result as a new required method.Ï*
(DEFFLAVOR Ï4inspection-dataÏ* (data) ()
  :settable-instance-variables
  (:required-methods :format-concisely :handle-mouse-click :who-line-doc :middle-button-result)
  (:documentation :mixin
		  "Ï3This mixin is used to define different types of information to inspect in custom Inspectors.
Flavors built on this mixin store some piece of data and provide operations which specify how to inspect the data.
Instance variable DATA is provided for storing the inspected data.  (See also flavor TV:AUXILIARY-DATA-MIXIN
which provides additional storage space.)  Flavors which mix in TV:INSPECTION-DATA are expected to define for
themselves a subset of the following methods:

:FORMAT-CONCISELY (stream)
  (required)  Returns a relatively short, one line string to be used in representing DATA in the inspection
   history, and in some cases, in the inspection pane itself.  The string is always made mouse-sensitive
  in either case.  Example: in the Flavor Inspector, \"TV:WINDOW's local methods\" is displayed in the history
  when the user inspects TV:WINDOW's local methods.  STREAM is the output stream.

:HANDLE-MOUSE-CLICK (blip inspector-instance)
  (required)  Handles mouse clicks on the mouse sensitive string (returned by :FORMAT-CONCISELY) which represents DATA.
  BLIP is the mouse blip, which contains the mouse button used and the input pane instance.  INSPECTOR-INSTANCE is
  the inspector constraint frame.  This method is called when the mouse-sensitive string is displayed either in an
  inspection pane or the history pane.  Usually this method should do the following:
    1. on MOUSE-L, (SEND inspector-instance :INSPECT-INFO-LEFT-CLICK)
    2. on MOUSE-M, (SEND inspector-instance :INSPECT-INFO-MIDDLE-CLICK)
    3. on MOUSE-R, pop up a menu of operations relevant to the data (or some other data-specific action)
  #1 will inspect the data, using the :GENERATE-ITEM method described below to generate a text scroll window item list.
  #2 will do the same, but will put (or leave) the contents of the clicked-on inspection pane in the middle inspection
  pane.  For an example of this, look at (:METHOD TV:FLAVOR-OPERATION-MIXIN :HANDLE-MOUSE-CLICK).

:GENERATE-ITEM ()
  (optional)  Provides text scroll window items to display in inspection panes when inspecting DATA.
  This method is optional because some pieces of data may be used only as mouse-sensitive items in another data's
  text scroll window item list (generated by *its* :GENERATE-ITEM method).  For instance, default instance variable
  values (instances of TV:SHOW-VALUE) are displayed in the item list for TV:SHOW-INSTANCE-VARIABLES.  When the user 
  clicks on them, their :HANDLE-MOUSE-CLICK is defined to pretty-print the value on a typeout window.  They are never
  \"inspected\", so they don't need a :GENERATE-ITEM method.

  :GENERATE-ITEM should return two values. The first value is a list of items to display in an inspection pane 
  (text scroll window).  The second value is a string to display in the pane's window label.  This string should
  probably be close to that returned by :FORMAT-CONCISELY, though you have more room to work with since the window
  label is much wider than the history pane.

:WHO-LINE-DOC (inspection-pane? &OPTIONAL no-sensitive-item?)
  (required)  Provides a string to display in the who-line appropriate for DATA. The arguments provide information
  about where the mouse is.
  1. If NO-SENSITIVE-ITEM? is NIL, the mouse is over the mouse-sensitive string (returned by :FORMAT-CONCISELY) 
     which represents DATA.  The string should describe what actions your :HANDLE-MOUSE-CLICK method does.  
        INSPECTION-PANE? is NIL when DATA is being \"moused over\" in the history pane; otherwise it is the 
     inspection pane instance in which DATA is being \"moused over\".  Your :HANDLE-MOUSE-CLICK method may treat 
        mouse clicks  differently when DATA is moused in the history pane, so this argument is provided so that your 
        mouse documentation  can provide different strings for each case.  
  2. If NO-SENSITIVE-ITEM? is non-NIL, the mouse is NOT currently over a mouse sensitive item, but DATA is the 
        currently inspected object of INSPECTION-PANE?.  If your inspector has commands which handle the mouse in 
        this case, you should return a string which describes these commands.  For instance, in the flavor inspector,
       right click brings up a menu of operations on the flavor most relevant to DATA.

:MIDDLE-BUTTON-RESULT ()
  Returns the piece of data that you want the user to get a handle on if the instance is clicked on.  
   This is used in perspectives and such-like.

:HELP ()
  (optional)  Returns a string to display which describes the inspection display of DATA (the text scroll window 
  items returned by :GENERATE-ITEM).  The inspection code does not provide an automatic interface to this method: 
  you can build whatever interface your prefer.  For an example, the Flavor Inspector defines a command on MOUSE-M 
  which displays the help message returned by the object currently being inspected in the clicked-on inspection 
   pane (do meta-point on (:METHOD TV:FLAVOR-INSPECTOR :HELP-ON-INSPECTED-DATA).Ï*"))
;Ï1-------------------------------------------------------------------------------Ï*

;Ï1***************Ï*
;Ï1 TAC 08-01-89 - these three from DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTSÏ*
(DEFUN Ï4data-from-inspection-dataÏ* (thing)
  (OR (SEND thing :send-if-handles :middle-button-result)
      (SEND thing :send-if-handles :aux-data)
      (SEND thing :data)))

(DEFUN Ï4maybe-data-from-inspection-dataÏ* (thing)
  (IF (TYPEP thing 'inspection-data)
      (data-from-inspection-data thing)
      thing))

(DEFUN Ï4do-something-and-inspectÏ* (STRING action)
"Ï2Takes a prompt string and a function argument.  It prompts the user with the
 string, reads in a value, perhaps with the mouse, and calls the function
 with the value returned.Ï*"
   (DECLARE (SPECIAL user history = inspectors frame))
   (FORMAT user string)
   (MULTIPLE-VALUE-BIND (value punt-p)
       (inspect-get-value-from-user user history inspectors)
     (OR punt-p (FUNCALL action value)))
   (SEND frame :handle-prompt))
;Ï1---------------Ï*

;Ï1; Returns appropriate who-line documentation for SELF.  This is used by the :WHO-LINE-DOCUMENTATION-STRING Ï*
;Ï1; methods of both inspection panes and history panes of Inspectors. Ï*
;Ï1; Since the documentation varies slightly between these two flavors in some cases, the second argument specifies Ï*
;Ï1; which type of flavor is requesting documentation.Ï*
;Ï1; If INSPECTION-PANE? is NIL, then the history pane is requesting documentation.  Ï*
;Ï1; Otherwise it is an inspection pane and MUST be the inspection pane instance.Ï*
;Ï1; If NO-SENSITIVE-ITEM? is non-NIL, then INSPECTION-PANE? is non-NIL and the mouse is NOT currently over a mouse sensitive item. Ï*
;Ï1; This is used by flavors such as TV:SHOW-FLAVOR to indicate in the who-line the operations the user can do on theÏ*
;Ï1; currently displayed flavor (on right mouse button).Ï*

(DEFMETHOD Ï4(inspection-data :who-line-docÏ*) (inspection-pane? &optional no-sensitive-item?)
  inspection-pane? no-sensitive-item? ;Ï1; ignoredÏ*
  '(:mouse-l-1 "Ï3Choose an item to inspectÏ*"))

(DEFMETHOD Ï4(inspection-data :match?Ï*) (thing)
  (EQ data thing))

(DEFFLAVOR Ï4auxiliary-data-mixinÏ* ((aux-data nil)) ()
  :inittable-instance-variables
  :settable-instance-variables
  (:documentation
    :mixin 
    "Ï3Mixes in with TV:INSPECTION-DATA to provide a storage slot for additional data.
Must be mixed in *before* TV:INSPECTION-DATA inorder for method :MATCH to work.Ï*")
  (:required-flavors inspection-data))

(DEFMETHOD Ï4(auxiliary-data-mixin :match?Ï*) (thing aux)
  ;Ï1; Takes the auxiliary data into account.  We assume here that EQUAL is adequate but someÏ*
  ;Ï1; flavors who include us may want to define this to use EQ or whatever.Ï*
  (AND (EQ data thing)
       (EQUAL aux-data aux)))

;Ï1; This flavor isn't a great example of TV:INSPECTION-DATA, but it is generally useful.  Ï*
;Ï1; Rather than displaying a value in a inspector pane, the value is pretty-printed on the typeout window.  Ï*
;Ï1; See how the Flavor Inspector makes use of this flavor to display instance variable default values. Ï*
(DEFFLAVOR Ï4show-valueÏ* ((STRING nil))
	   (auxiliary-data-mixin inspection-data)
  :inittable-instance-variables)

(DEFMETHOD Ï4(show-value :format-conciselyÏ*) (STREAM)
 ;Ï1; Instance variable TRUNCATION, if non-nil, is an integer indicating the number of columns to print.Ï*
 ;Ï1; All this is a little excessive.  Too bad there are no print-truncation options.Ï*
 ;Ï1; If STRING has been generated before, use it.  Otherwise, generate it.Ï*
  (UNLESS string
    (SETQ string
	  (IF aux-data
	    (LET* ((*print-length* aux-data)   ;Ï1;chosen output field sizeÏ*
		   (st (WITH-OUTPUT-TO-STRING (STREAM)
			 (print-no-quotes data stream 5))))
	      (IF (> (LENGTH st) aux-data)
		(FORMAT nil "Ï3~va...Ï*" (- aux-data 3) (ucl::string-chop st (- aux-data 3)))
		(FORMAT nil "Ï3~vaÏ*" aux-data st)))
	    (WITH-OUTPUT-TO-STRING (STREAM)
	      (print-no-quotes data stream 5)))))
  (FORMAT stream string)) 

(DEFMETHOD Ï4(show-value :who-line-docÏ*) (IGNORE &optional ignore)
  '(:mouse-l-1 "Ï3Pretty-print this value in the typeout window.Ï*"
    :mouse-m-1 "Ï3Inspect this value using a standard Inspector window.Ï*"))

(DEFMETHOD Ï4(show-value :handle-mouse-clickÏ*) (blip flavor-inspector)
  (SELECTOR (FOURTH blip) =
    (#\Mouse-l-1 (SEND flavor-inspector :pretty-print-thing data))
    (#\Mouse-m-1 (INSPECT data))
    (t
     (BEEP))))

;Ï1; Prints ITEM on STREAM.  If ITEM is a list, occurances of QUOTE are converted to '.Ï*
;Ï1; This was constructed from TV:PRINT-ITEM-CONCISELY.Ï*
(DEFUN Ï4print-no-quotesÏ* (item stream &optional (level 0))
  (LET ((type (DATA-TYPE item)))
    (IF (EQ type 'dtp-list)
        (COND
          ((EQ (CAR item) 'QUOTE)
           (SEND stream :tyo #\') ;Ï1; Print QUOTE as '.Ï*
           (print-no-quotes (CADR item) stream (1+ level)))
          ((AND *print-level* (>= level *print-level*))
           (SEND stream :string-out (si::pttbl-prinlevel *readtable*)))
          (t (DO ()
                 ((OR (NOT (LISTP item)) (NOT (EQ (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*))
                       (print-no-quotes l stream (1+ level))))
                  (SEND stream :tyo (si::pttbl-close-paren *readtable*)))
               (AND flag (FUNCALL stream :tyo (si::pttbl-space *readtable*)))
               (print-no-quotes (CAR l) stream (1+ level))
               (COND
                 ((AND *print-length* (>= i *print-length*))
                  (SEND stream :string-out (si::pttbl-prinlength *readtable*))
                  (RETURN nil))))))
        (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) 24))
                          (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; And now, back to the original inspector...Ï*

;Ï1; Change SYS:DEBUG-UTILITIES;INSPECT.LISP#256 to not use AP but FRAME or FRAME-NUMBER insteadÏ*
(DEFSTRUCT Ï4(stack-frameÏ* :named
			(:print-function
			  (lambda (sf stream &rest ignore)
			    (LET* ((frame (stack-frame-frame-number sf))
                                   (rp (sg-regular-pdl (stack-frame-stack-group sf)))
                                   (FUNCTION (rp-function-word rp frame))
                                   (pc (AND (TYPEP function 'compiled-function)  
                                            (rp-exit-pc rp frame)))
                                   (*print-length* 5) (*print-level* 3))
                              (si:printing-random-object (sf stream :no-pointer)
                                (FORMAT stream "Ï3Stack-Frame ~A ~[PC=~O~;microcoded~;interpreted~]Ï*"
                                        (FUNCTION-NAME function)
                                        (COND (pc 0)
                                              ((TYPEP function 'microcode-function) 1)
                                              (t 2))
                                        pc)))))
			(:alterant nil))
  stack-group
  frame-number
  function-name)

(DEFFLAVOR Ï4inspect-windowÏ*
           ((locked-p nil))
	   (basic-inspect
	    function-text-scroll-window
            mouse-sensitive-text-scroll-window
	    borders-mixin
            scroll-bar-mixin
	    top-label-mixin
	    window)
           :settable-instance-variables
           :gettable-instance-variables
           :inittable-instance-variables
           (:default-init-plist
             :scroll-bar-draw-edge-p t
             :label (LIST nil nil nil nil inspect-label-font "Ï3EmptyÏ*")
             ;Ï1; Normal, normal-bold, italics, small-bold.Ï*
             :font-map *inspector-font-map*
             :locked-p nil)
           (:documentation :combination "Ï3Scroll window for the inspector.Ï*"))

(DEFFLAVOR Ï4basic-inspectÏ* 
	   ((current-object (CONS nil nil))
	    (current-display nil)
	    (displaying-list nil)   ;Ï1; For list structure hackingÏ*
	    (modify-mode nil)
	    (setting-mode nil)
	    (sensitive-inspect-item nil)
	    list-blinker
	    (normal-mouse-documentation
	      '(:mouse-l-1 "Ï3Inspect list itemÏ*"
			   :mouse-m-1 "Ï3Inspect list itemÏ*"
			   :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
			   :mouse-r-1 "Ï3Find its function definitionÏ*"))
	    ;Ï1; Provides a way for special inspectors to calculate who-line doc passed onÏ*
	    ;Ï1; the current displayed object (see flavor inspector).Ï*
	    (current-object-who-line-message #'(lambda (IGNORE) ;Ï1; Arg passed is CURRENT-OBJECT.Ï*
						 '(:mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
							      :mouse-r-1 "Ï3System Menu.Ï*"))))
	   (lisp-help-mixin) ;Ï1; Provides who-line help on expressions typed in the interactor.Ï*
  :settable-instance-variables
  (:gettable-instance-variables modify-mode setting-mode)
  (:required-flavors mouse-sensitive-text-scroll-window function-text-scroll-window))

(DEFMETHOD Ï4(basic-inspect :sensitive-item-pÏ*) (item)
           (LET ((modifying (OR modify-mode (AND (NOT setting-mode) (key-state :hyper)))))
             (EQ
              (NOT
               (NULL
                (GET (displayed-item-type item) (IF modifying 'set-function 'only-when-modify))))
              (NOT (NULL modifying))))) 

(DEFMETHOD Ï4(basic-inspect :after :initÏ*) (IGNORE)
           (SETQ list-blinker (make-blinker self 'follow-list-structure-blinker :visibility nil)
                 sensitive-item-types :sensitive-item-p)) 

;Ï1 TAC 08-04-89 - being redefined in GENERAL-INSPECTOR -  allows available perspectives on inspection-data to be presented Ï*
;Ï1(DEFMETHOD (BASIC-INSPECT :WHO-LINE-DOCUMENTATION-STRING) () Ï*

;Ï1; Return the mouse sensitive text scroll item of WINDOW.Ï*
;Ï1; WINDOW must include TV:MOUSE-SENSITIVE-TEXT-SCROLL-WINDOW as a flavor.Ï*
(DEFUN Ï4get-mouse-sensitive-itemÏ* (&optional (window self)) 
  (DECLARE (:self-flavor mouse-sensitive-text-scroll-window))
  (MULTIPLE-VALUE-BIND (self-x self-y)
      (sheet-calculate-offsets window nil)
    (SEND self :mouse-sensitive-item (- mouse-x self-x) (- mouse-y self-y))))

;Ï1; Given an object and an inspector window, return a display list for the object.Ï*
;Ï1; The elements of this list are:Ï*
;Ï1;  1 the objectÏ*
;Ï1;  2 the printer functionÏ*
;Ï1;  3 an arg to give to the printer functionÏ*
;Ï1;  4 the list of /"items/" (for TEXT-SCROLL-WINDOW) or /"lines/".Ï*
;Ï1;   Each item describes one line of data,Ï*
;Ï1;   and will be passed to the printer function (element 2)Ï*
;Ï1;   which should use it to print out the line.Ï*
;Ï1;   The normal printer function is INSPECT-PRINT,Ï*
;Ï1;   see its documentation for ×what the items (there called LINEs) can look like.Ï*
;Ï1;  5 the top item numberÏ*
;Ï1;  6 the labelÏ*
;Ï1;  7 the ITEM-GENERATOR function (for TEXT-SCROLL-WINDOW), or NIL if none.Ï*
;Ï1***************Ï*
;Ï1 TAC 07-27-89 - this function was broken into several functions  and CLOS object type checking was added to the COND form.Ï*
;Ï1(DEFUN INSPECT-SETUP-OBJECT-DISPLAY-LIST (OBJECT WINDOWÏ*
;					Ï1  &OPTIONAL TOP-ITEM LABELÏ*
;					Ï1  &AUX STR)Ï*

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 TAC 07-27-89 - from TI-ENV-INSPECTOR-INTERFACE - they redefined the function.  Ï*
;Ï1;JPR - Abstracted out of INSPECT-SETUP-OBJECT-DISPLAY-LIST.Ï*
(DEFUN Ï4generic-object-foo-methodÏ* (for-object)
"Ï2Given something (for-object) it returns the name of an :object-foo method that
 will know how to display it in the inspector.Ï*"
  (COND ;Ï1; CLOS instance checking is new, the rest are old. Ï*
	((TYPEP for-object 'stack-frame)     :object-stack-frame)
	((TYPEP for-object 'any-sort-of-clos-instance) :object-clos-instance)
	((TYPEP for-object 'named-structure) :object-named-structure)
	(t (CASE
	     (DATA-TYPE for-object)
	     (dtp-instance :object-instance)
	     (dtp-array :object-array)
	     (dtp-list :object-list)
	     (dtp-stack-list :object-list)
	     (dtp-symbol :object-symbol)
	     (dtp-closure :object-closure)
	     (dtp-lexical-closure :object-lexical-closure)
	     (dtp-function :object-fef)
	     (dtp-locative :object-locative)
	     (dtp-stack-group :object-stack-group)
	     (otherwise :object-other)))))

;Ï1; JPR - Abstracted out of INSPECT-SETUP-OBJECT-DISPLAY-LIST.Ï*
(DEFUN Ï4inspect-object-display-listÏ* (object window)
"Ï2Given an object to inspect and the window in which it is to be inspected
 return the item list for the window.  If Object is an instance of
 encapsulation-for-generic-inspection, then this is taken as a directive to
 circumvent any specialised inspection behaviour added an use the really
 primitive stuff, like :object-named-structure.Ï*"
  (SEND window (generic-object-foo-method object) object))

(DEFUN Ï4inspect-setup-object-display-listÏ*
       (object window &optional top-item label &aux str)
  ;Ï1; A modified version of the original one. This is more general and extensible.Ï*
  (MULTIPLE-VALUE-BIND
    (display-list arg alt-print-fun first-top-item obj-label item-generator)
      ;Ï1; This part abstracted out by JPR.Ï*
      (inspect-object-display-list object window)
    (LIST object
	  (OR alt-print-fun 'inspect-printer)
	  arg display-list (OR top-item first-top-item 0)
	  (OR label
	      obj-label
	      (LIST nil nil nil nil (label-font (SEND window :label))
		    (IF (CONSP object)
			"Ï3a listÏ*"
			(NSUBSTRING (SETQ str (FORMAT nil "Ï3~s~%Ï*" object))
				    0 (POSITION #\cr str)))))
	  item-generator)))
;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4inspect-setup-objectÏ* (object window &optional top-item)
  (LET ((disp (inspect-setup-object-display-list object window top-item)))
    (SEND window :setup (CDR disp))
    (SEND window :set-current-object (CAR disp))
    disp)) 

(DEFMETHOD Ï4(basic-inspect :setup-objectÏ*) (sl) (SEND self :setup (CDR sl))
           (SEND self :set-current-object (CAR sl)) sl) 

;Ï1; This is the default printer for lines in inspect windows.Ï*
;Ï1; ARG is the printer-function-arg as produced by the :OBJECT-... operation.Ï*
;Ï1; ITEM-NO is the item number (a la TEXT-SCROLL-WINDOW) of this line.Ï*
;Ï1; STREAM is the pane we are printing on.Ï*
;Ï1; LINE is a list of elements telling us what to print:Ï*
;Ï1;  a number is a column to tab to,Ï*
;Ï1;  a string is just printed,Ï*
;Ï1;  a list starting with a string is args to FORMAT,Ï*
;Ï1;  a list (:FUNCTION function . args) means apply <function>Ï*
;Ï1;    to ARG, STREAM, ITEM-NO and the elements of <args>, to print.Ï*
;Ï1;  a list (:COLON number) means type a colon and tab to column <number>,Ï*
;Ï1;  a list (:ITEM1 type object printer) specifies a mouse-sensitive itemÏ*
;Ï1;    of type <type> (a symbol) and printed by passing <object> <stream> . <args> to <printer>.Ï*
;Ï1;  If <printer> is omitted, PRINT-ITEM-CONCISELY is used.Ï*

;Ï1 TAC 08-03-89 - being redefined Ï*
;Ï1(DEFUN INSPECT-PRINTER (LINE ARG STREAM ITEM-NO) Ï*

;Ï1***************Ï*
;Ï1 TAC 08-03-89 - this is new definition from INSPECTOR-ENHANCEMENTSÏ*
(DEFUN Ï4inspect-printerÏ* (line arg stream item-no)      ;Ï1fiÏ*
  ;Ï1; Make sure base is consistent since sometimes this is called fromÏ*
  ;Ï1; the mouse process.Ï*
    (DOLIST (ELT line)
      (COND
        ((NUMBERP elt) (FORMAT stream "Ï3~VTÏ*" elt))
        ((STRINGP elt) (PRINC elt stream))
        ((NOT (LISTP elt)) (FERROR nil "Ï3Unknown element type: ~SÏ*" elt))
        ((STRINGP (CAR elt)) (APPLY #'FORMAT stream elt))
        (t
         (CASE (FIRST elt)
               (:function (APPLY (SECOND elt) arg stream item-no (CDDR elt)))
               (:colon (FORMAT stream "Ï3:~VT Ï*" (SECOND elt)))
               ;Ï1; Provides a mechanism for inserting bold or italicized text (for column headers).Ï*
               (:font
                (UNWIND-PROTECT
		    (PROGN 
		      (SEND stream :set-current-font (SECOND elt))
		      ;Ï1; Modified here by JPR.  It used simply to :String outÏ*
		      ;Ï1; (THIRD ELT), which is no good if you want to haveÏ*
		      ;Ï1; items such as (:font 2 (:item1 ...))Ï*
		      (inspect-printer (LIST (THIRD elt)) arg stream item-no))
                  (SEND stream :set-current-font 0)))
	       (:compound
		;Ï1; added by JPR to support compoud items.Ï*
		(MAPCAR #'(lambda (item)
			    (inspect-printer (LIST item) arg stream item-no))
			(THIRD elt)))
               (:item1
                (LEXPR-SEND stream :item1 elt (SECOND elt)
                            #'(lambda (ELT &rest args)
                                (APPLY (OR (FOURTH elt) #'inspection-data-print-item-concisely)
                                       (THIRD elt) args))
                            (NTHCDR 4 elt)))
               (otherwise (FERROR () "Ï3Unknown item type ~AÏ*" (FIRST elt))))))))


;Ï1 TAC 08-04-89 - being redefined by code in GENERAL-INSPECTOR.Ï*
;Ï1(DEFUN inspection-data-print-item-concisely (thing stream &OPTIONAL (level 0))  Ï*
 

;Ï1;; Inspection of each type of object is done by a message, so that some of themÏ*
;Ï1;; may be redefined for some unspecified applicationÏ*

(DEFMETHOD Ï4(basic-inspect :object-named-structureÏ*)
           (obj &aux (maxl -1) alist defstruct-items result nss d)
  (SETQ nss (NAMED-STRUCTURE-P obj))
  (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))
				   obj)
			  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 obj) nil)))
	     result))))
  (IF (TYPEP obj 'hash-table)     ;Ï1; added hash tablesÏ*
      (PROGN (PUSH '("") result)
	     (PUSH '("Ï3Hash Array ElementsÏ*") result)
	     (PUSH '("") result)
	     (LOOP for element in (make-window-items-for-hash-table obj)
	      do (PUSH element result))
	     (PUSH '("") result)))
  (IF (AND (ARRAYP obj) (ARRAY-HAS-LEADER-P obj))
      (SEND self :object-array obj t (NREVERSE result))	;Ï1; mention-leader is always TÏ*
      (VALUES (NREVERSE result) obj 'inspect-printer)))

(DEFUN Ï4(:property named-structure-slot set-functionÏ*) 
       (item new-value object &aux (slotname (THIRD (SECOND item))) (refmac slotname) tem)
  (AND (SETQ tem (GET (NAMED-STRUCTURE-P object) 'si::defstruct-description))
       (SETQ tem (cli:assoc slotname (si::defstruct-description-slot-alist tem) :test #'EQ))
       (SETQ refmac (si::defstruct-slot-description-ref-macro-name (CDR tem))))
  (EVAL `(SETF (,refmac ',object) ',new-value))) 

(DEFPROP Ï4named-structure-slotÏ* t only-when-modify) 

(DEFMETHOD Ï4(basic-inspect :object-instanceÏ*) (obj)     ;Ï1; fi + hash tablesÏ*
  (LET ((maxl -1)
        result flavor class) ;Ï1; *** TAC 6/15/89 - added local class variableÏ*
    ;Ï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 such as the flavor inspector.Ï*
    (IF (AND (send-if-handles superior :inspection-data-active?) (TYPEP obj 'inspection-data))
        (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
	  (WHEN (ticlos:clos-instance-p obj) ;Ï1; *** TAC 6/15/89 - if CLOS instance then get it's classÏ*
	      (SETQ class (ticlos:class-of obj))) 
	  (SETQ flavor (si:instance-flavor obj)) 
	  (IF class
	      (SETQ result ;Ï1; *** TAC 6/15/89 - different label for a class Ï*
                (LIST '("")
                      `("Ï3An object of class Ï*" (:item1 class ,(TYPE-OF obj))
                        "Ï3.  Class object is Ï*" (:item1 class-object ,class)))) 
	      (SETQ result ;Ï1; *** TAC 6/15/89 - same label as always for a flavor Ï*
                (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 (SEND obj :hash-array))))
                    (DOLIST (element window-items) (PUSH element result))))
              ))
          (NREVERSE result)))))

(DEFUN Ï4(:property instance-slot set-functionÏ*) (item new-value object)
  (LET* ((slot (THIRD (SECOND item)))
         (message-name (INTERN (STRING-APPEND "Ï3SET-Ï*" slot) "")))
    (IF (GET-HANDLER-FOR message-name object)
        (CATCH-ERROR (SEND object message-name new-value) t)
        (SET-IN-INSTANCE object slot new-value)))) 

(DEFPROP Ï4instance-slotÏ* t only-when-modify) 

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - better version from GENERAL-INSPECTOR -  replaces old functionÏ*
(DEFUN Ï4make-window-items-for-hash-tableÏ* (hash-table &aux maxlength)
"Ï2Takes the elements in a hash table and turns tham into a set of inspector
 items, sorted so that it's easy to find the ones you want.Ï*"
   (SETQ maxlength 0)
   (maphash #'(lambda (key &rest ignore)
		(SETQ maxlength (MAX (FLATSIZE key) maxlength)))
	    hash-table)
   (LET ((LIST 
	   (maphash-return
	     #'(lambda (key &rest values)
		 (APPEND
		   `((:item1 named-structure-value ,key
			     ,#'(lambda (key stream)
				  (FORMAT stream "Ï3~SÏ*" key)))
		     (:colon ,(+ 2 maxlength)))
		   (MAPCAR #'(lambda (value)
			       `(:item1 named-structure-value
					,value
					,#'(lambda (value stream)
					     (FORMAT stream "Ï3~S Ï*" value))))
			   values)))
	     hash-table)))
     (SORT list #'STRING-LESSP :key 'item-key)))

;Ï1; TAC 09-02-89 - substituted (si::closure-function obj) (si::closure-bindings obj) for (car c) (cdr c)Ï*
;Ï1;  where c was an aux arg (c (si:convert-closure-to-list obj)) -  David Gray's prefered way to handle closuresÏ*
(DEFMETHOD Ï4(basic-inspect :object-closureÏ*) (obj &aux result) ;Ï1; added common lisp closureÏ*
  (SETQ result `("Ï3Function is Ï*"
		 (:item1 closure-function ,(inspect-function-from (si::closure-function obj)))))
  (SETQ result (LIST '("") result))
  (LET ((sym nil)
	(maxl -1))
    (DO ((l (si::closure-bindings obj) (CDDR l)))
        ((NULL l))
      (SETQ sym (%find-structure-header (CAR l)))
      (SETQ maxl (MAX (FLATSIZE sym) maxl)))
    (DO ((l (si::closure-bindings obj) (CDDR l)))
        ((NULL l))	
      (SETQ sym (%find-structure-header (CAR l)))
      (PUSH `((:item1 closure-slot ,sym)
              (:colon ,(+ 2 maxl))
              ,(IF (= (%p-data-type (CADR l)) dtp-null)
                   "Ï3unboundÏ*"
                   `(:item1 closure-value ,(CAADR l))))
            result)))
  (NREVERSE result))

;Ï1; TAC 09-02-89 - substituted (si::closure-function obj) (si::closure-bindings obj) for (car c) (cdr c)Ï*
;Ï1;  where c was an aux arg (c (si:convert-closure-to-list obj)) -  David Gray's prefered way to handle closuresÏ*
(DEFMETHOD Ï4(basic-inspect :object-lexical-closureÏ*) (obj &aux result) 
  (SETQ result `("Ï3Function is Ï*"
		 (:item1 closure-function ,(inspect-function-from (si::closure-function obj)))))
  (SETQ result (LIST '("") result))
  (LET ((sym nil)
	(maxl -1))
    (DO ((l (si::closure-bindings obj) (CDDR l)))
        ((NULL l))
      (SETQ sym (%find-structure-header (CAR l)))
      (SETQ maxl (MAX (FLATSIZE sym) maxl)))
    (PUSH '("Ï3Common Lisp Lexical Closure:Ï*") result)
    (LET* ((env (si::closure-bindings obj))
           (env-vec (si:%make-pointer sys:dtp-list env))
           (dbi (si:get-debug-info-struct (si::closure-function obj)))
           (parent-info (si:get-debug-info-field dbi :lexical-parent-debug-info)))
      (DO* ((i 0 (1+ i))
            (levels (closure-levels? env-vec))
            (env-vec env-vec (si:%make-pointer sys:dtp-list (CAR env-vec)))
            (pnt-info parent-info (si:get-debug-info-field pnt-info :lexical-parent-debug-info))
            (vars (si:get-debug-info-field pnt-info :variables-used-in-lexical-closures)
                  (si:get-debug-info-field pnt-info :variables-used-in-lexical-closures)))
           ((> i levels))
        (PUSH '("") result)
        (PUSH `(,(FORMAT nil "Ï3 CONTEXT ~a: Ï*" i)) result)
        (PUSH '("") result)
        (PUSH `("Ï3Interpreted Definition is Ï*"
                (:item1 list ,(si:get-debug-info-field pnt-info :interpreted-definition))) result)
        (PUSH `(,(FORMAT nil "Ï3 Closure Variables: Ï*" )) result)
        (DO* ((j 0 (1+ j))
              (vals (CDR env-vec) (CDR vals))
              (val (CAR vals) (CAR vals))
              (vrs vars (CDR vrs))
              (var (CAR vrs) (CAR vrs))
              )
             ((NULL vrs))
          (PUSH `((:item1 closure-value ,var
                          ,#'(lambda (IGNORE stream var) (FORMAT stream "Ï3    ~sÏ*" var))
                          ,var)
                  (:colon 5)
                  (:item1 closure-value ,val)) result))))
    (NREVERSE result)))

(DEFUN Ï4closure-levels?Ï* (LIST)
  "Ï2Looks at the top level of a closure's environment vector to see if it
has nested levels of environment vectors. Returns 0 if no nested levels,
otherwise returns the number of nested levels.Ï*"
  (LET ((parent (CAR list)))
    (IF parent 
        (DO ((i 0 (1+ i))
             (prnt parent (CAR (si:%make-pointer si:dtp-list prnt))))
            ((NULL prnt) (RETURN i)))
        (VALUES 0))))

(DEFUN Ï4(:property cl-closure-slot set-functionÏ*) (item new-value object)
  object
  (LET* ((slot (THIRD (SECOND item))))
        (RPLACA slot new-value)))
(DEFPROP Ï4cl-closure-slotÏ* t only-when-modify)

(DEFUN Ï4inspect-function-fromÏ* (from)
  (DO () (nil)
    (COND
      ((SYMBOLP from) (AND (NOT (FBOUNDP from)) (RETURN from))
       (SETQ from (SYMBOL-FUNCTION from)))
      (t (RETURN from))))) 

(DEFUN Ï4(:property closure-slot set-functionÏ*) (item new-value object)
  (LET* ((slot (THIRD (SECOND item)))
         (message-name (INTERN (STRING-APPEND "Ï3SET-Ï*" slot) "")))
    (IF (GET-HANDLER-FOR message-name object)
        (CATCH-ERROR (SEND object message-name new-value) t)
        (SET-IN-CLOSURE object slot new-value)))) 

(DEFPROP Ï4closure-slotÏ* t only-when-modify) 

;Ï1; TAC 09-02-89 - substituted (sm-function (si::closure-function sm)) (sm-bingings (si::closure-bindings sm))  for Ï*
;Ï1;  (SETQ sm (si:convert-closure-to-list sm)) -  David Gray's prefered way to handle closuresÏ*
(DEFMETHOD Ï4(basic-inspect :object-select-methodÏ*) (sm &aux (result nil))
  ;Ï1; Ï*(SETQ sm (si:convert-closure-to-list sm))
  (LET ((sm-function (si::closure-function sm))
	(sm-bindings (si::closure-bindings sm)))
  (DO ((s (LIST sm-function sm-bindings) (CDR s))
       (maxl -1))
      ((SYMBOLP s)
       (SETQ result
	     (SORT result
		   #'(lambda (y x) (ALPHALESSP (THIRD (FIRST x)) (THIRD (FIRST y))))))
       (SETQ maxl (MAX maxl (LENGTH "Ï3Tail pointerÏ*")))
       (DOLIST (r result)
	 (SETF (SECOND (SECOND r)) maxl))
       (PUSH `((:item1 select-method-tail-pointer "Ï3Tail pointerÏ*" princ)
	       (:colon ,(+ 2 maxl))
	       (:item1 select-method-tail-function ,(AND s (inspect-function-from s))))
	     result)
       (NREVERSE result))
    (DO ((kwds (CAAR s) (CDR kwds))
	 (k))
	((NULL kwds))
      (IF (CONSP kwds) (SETQ k (CAR kwds)) (PROGN
					     (SETQ k kwds)
					     (SETQ kwds nil)))
      (PUSH `((:item1 select-method-keyword ,k)
	      ,(LIST :colon 0)
	      (:item1 select-method-function ,(CDAR s)))
	    result)
      (SETQ maxl (MAX maxl (FLATSIZE k))))))) 

;Ï1; TAC 09-02-89 - substituted (sm-function (si::closure-function sm)) (sm-bingings (si::closure-bindings sm))  for Ï*
;Ï1;  (SETQ sm (si:convert-closure-to-list sm)) -  David Gray's prefered way to handle closuresÏ*
(DEFUN Ï4(:property select-method-tail-pointer set-functionÏ*) (IGNORE new-value sm)
  (LET ( ;(sm-function (si::closure-function sm))
	(sm-bindings (si::closure-bindings sm)))
 ;Ï1; Ï*(RPLACD (LAST (si:convert-closure-to-list sm)) new-value))
    (RPLACD sm-bindings new-value)))

(DEFPROP Ï4select-method-tail-pointerÏ* t only-when-modify) 

;Ï1; TAC 09-02-89 - substituted (sm-function (si::closure-function sm)) (sm-bingings (si::closure-bindings sm))  for Ï*
;Ï1;  (SETQ sm (si:convert-closure-to-list sm)) -  David Gray's prefered way to handle closuresÏ*
(DEFUN Ï4(:property select-method-keyword set-functionÏ*) (item new-value sm)
  (SETQ ;Ï1; Ï*sm (si:convert-closure-to-list sm)
    item (THIRD (SECOND item)))
  (LET ((sm-function (si::closure-function sm))
	(sm-bindings (si::closure-bindings sm)))
    (DO ((s (LIST sm-function sm-bindings) (CDR s)))
	((SYMBOLP s))
      (COND
	((IF (SYMBOLP (CAAR s)) (EQ (CAAR s) item) (cli:member item (CAAR s) :test #'EQ))
	 (SETF (CDAR s) new-value) (RETURN)))))) 

(DEFPROP Ï4select-method-keywordÏ* t only-when-modify) 

;Ï1; symeval-in-stack-group returns (value location boundflag), but boundflag is never nil. an unbound variable willÏ*
;Ï1; return (nil nil location). This should be changed and the documentation corrected once it's determined that no oneÏ*
;Ï1; else depends on this anomaly.Ï*
(DEFMETHOD Ï4(basic-inspect :object-symbolÏ*) (obj)
  (DECLARE (SPECIAL eh::current-frame))
  `(((:item1 symbol-value-cell "Ï3Value: Ï*" princ)
     ;Ï1; to inspect symbols from the window debugger in the error stack group.Ï*
     ,(IF  eh:*error-sg*
	   (MULTIPLE-VALUE-BIND (obj-val obj-bound-in-sg?)
               (SYMEVAL-IN-STACK-GROUP  obj eh:*error-sg*  eh::current-frame)	
             (IF obj-bound-in-sg?
                 `(:item1 symbol-value ,obj-val)
                 "Ï3unboundÏ*"))
	   (IF (BOUNDP obj)
	       `(:item1 symbol-value ,(SYMBOL-VALUE obj))
	       "Ï3unboundÏ*")))
     ((:item1 symbol-function-cell "Ï3Function: Ï*" princ)
     ,(IF (FBOUNDP obj)
	  `(:item1 symbol-function ,(SYMBOL-FUNCTION obj))
	  "Ï3unboundÏ*"))
    ((:item1 symbol-property-cell "Ï3Property list: Ï*" princ)
     (:item1 symbol-property-list ,(SYMBOL-PLIST obj)))
    ("Ï3Package: Ï*"
     (:item1 symbol-package ,(CAR (PACKAGE-CELL-LOCATION obj))))))

(DEFUN Ï4(:property symbol-value-cell set-functionÏ*) (IGNORE new-value object)
  (SET object new-value)) 

(DEFPROP Ï4symbol-value-cellÏ* t only-when-modify) 

(DEFUN Ï4(:property symbol-function-cell set-functionÏ*) (IGNORE new-value object)
  (SETF (SYMBOL-FUNCTION object) new-value))

(DEFPROP Ï4symbol-function-cellÏ* t only-when-modify) 

(DEFUN Ï4(:property symbol-property-cell set-functionÏ*) (IGNORE new-value object)
  (SETF (SYMBOL-PLIST object) new-value))

(DEFPROP Ï4symbol-property-cellÏ* t only-when-modify) 

(DEFMETHOD Ï4(basic-inspect :object-fefÏ*) (fef) (fef-display-list fef self)) 

;Ï1; Change SYS:DEBUG-UTILITIES;INSPECT.LISP#256 to not use AP but FRAME or FRAME-NUMBER insteadÏ*

(DEFMETHOD Ï4(basic-inspect :object-stack-frameÏ*) (sf)
  (LET* ((rp (sg-regular-pdl (stack-frame-stack-group sf)))
	 (frame (stack-frame-frame-number sf))
	 (FUNCTION (rp-function-word rp frame)))
    (COND ((CONSP function)
	   (SEND self :object-list function))
	  ((TYPEP function 'compiled-function)
	   (fef-display-list function self (rp-exit-pc rp frame)
			     (LIST nil nil nil nil fonts:hl12b 
				   (stack-frame-function-name sf)))))))

(DEFMETHOD Ï4(basic-inspect :object-stack-groupÏ*) (obj &aux (maxl -1) alist pointer result nss d)
  (SETQ nss (TYPE-OF obj))
  (PUSH `(,(FORMAT nil "Ï3~S Ï*" (sg-name obj))
	  (:item1 stack-group-name stack-group))
	result)
  (PUSH '("") result)
  (WHEN (SETQ d (GET 'STACK-GROUP 'si::defstruct-description))
    (SETQ alist (si::defstruct-description-slot-alist d))
    (DO ((l alist (CDR l)))
        ((NULL l))
	(SETQ maxl (MAX (FLATSIZE (CAAR l)) maxl)))
    ;Ï1; For a stack-group structure, each line contains the name and the valueÏ*
    (DO ((l alist (CDR l)))
        ((NULL l))
	(PUSH `((:item1 stack-group-slot ,(CAAR l))
		(:colon ,(+ 2 maxl))
		,(CONDITION-CASE ()
		     `(:item1 stack-group-value
			      ,(FUNCALL (si::defstruct-slot-description-ref-macro-name (CDAR l))
					obj))
		   (ERROR 
		    (SETQ pointer (AP-LEADER obj (si::defstruct-slot-description-number (CDAR l))))
		    (FORMAT nil "Ï3#<~A ~O>Ï*"
			    (OR (NTH (%p-data-type pointer) q-data-types)
				(%p-data-type pointer))
			    (%p-pointer pointer))))
		,(CASE (si::defstruct-slot-description-ref-macro-name (CDAR l))
		   (sys:sg-current-state
		    (FORMAT nil "Ï3 ==> ~SÏ*" (NTH (sg-current-state obj) sg-states)))
		   (sys:sg-inst-disp
		    (FORMAT nil "Ï3 ==> ~[Normal~;Debug~;Single-step~;Single-step done~]Ï*"
			    (sg-inst-disp obj)))
		   (otherwise "")))
	      result)))
  (VALUES (NREVERSE result) obj 'inspect-printer))

(DEFUN Ï4(:property stack-group-slot set-functionÏ*) (item new-value object
					    &aux (slotname (THIRD (SECOND item)))
						 (refmac slotname)
						 tem)
  (AND (SETQ tem (GET 'STACK-GROUP 'si::defstruct-description))
       (SETQ tem (ASSOC slotname (si::defstruct-description-slot-alist tem) :test #'EQ))
       (SETQ refmac (si::defstruct-slot-description-ref-macro-name (CDR tem))))
  (EVAL `(SETF (,refmac ',object) ',new-value)))

(DEFPROP Ï4stack-group-slotÏ* t only-when-modify)

;Ï1----------------------------------------------------------------------------------------------Ï* 
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1     (ADVISE fef-display-list :around :show-dbis nilÏ*
;Ï1       ;; Print the function name and DBIS for the FEF.  Do this by putting an extra item onto the list of items.Ï*
;Ï1       ;; This item is of a different format from the others but wil be handled by the advice for print-fef-instruction below.Ï*
;Ï1       (LET ((results (MULTIPLE-VALUE-LIST :do-it)))Ï*
;	Ï1    (LET ((struct (CATCH-ERRORÏ*
;			Ï1    (sys:get-debug-info-struct (FIRST arglist))Ï*
;			Ï1    nil))Ï*
;		Ï1  (name (CATCH-ERROR (FUNCTION-NAME (FIRST arglist)) nil)))Ï*
;		Ï1 (IF (AND *show-dbis-for-fefs-in-inspector* name struct)Ï*
;		Ï1     (PROGN (SETF (FIRST results)Ï*
;				Ï1  (CONS (LIST "Function name: "Ï*
;					Ï1      `(:item1 named-structure-p ,name)Ï*
;					Ï1      ", DBIS is: "Ï*
;					Ï1      `(:item1 named-structure-p ,struct))Ï*
;					Ï1(FIRST results)))Ï*
;			Ï1    (VALUES-LIST results))Ï*
;		Ï1     (VALUES-LIST results))))))Ï*
;Ï1---------------------------------------------------------------------------------------------- Ï*

(DEFVAR Ï4*show-dbis-for-fefs-in-inspector*Ï* t
"Ï2When true the name and DBIS for functions is printed in the inspector when
 you inspect a fef.Ï*")

(DEFUN Ï4fef-display-listÏ* (fef window &optional pc-now label &aux list pc-idx)
  (DO ((i 0 (1+ i))
       (pc (fef-initial-pc fef) (+ pc (compiler:disassemble-instruction-length fef pc)))
       (lim-pc (compiler:disassemble-lim-pc fef)))
      ((>= pc lim-pc) 
       (COND ((EQ pc pc-now)         ;Ï1; PC off the endÏ*
	      (SETQ pc-idx i)
	      (PUSH t list))))
    (AND (EQ pc pc-now) (SETQ pc-idx (+ i 2)))
    (PUSH pc list))
  
;Ï1 TAC 08-15-89 - have to add advice around dbisÏ*
;Ï1                      I am guessing that this means the 1st form for the (values ...) function.Ï*
;Ï1                      If that doesn't work, put it around entire (values ...) function call. Ï*
;Ï1  (VALUES (LIST* :debug-info :skip (NREVERSE list))     ;; clm 02/15/89Ï*
;	Ï1  (LIST fef pc-idx)Ï*
;	Ï1  'print-fef-instructionÏ*
;Ï1          (AND pc-now pc-idx                 ;; make sure valid PC-IDX was foundÏ*
;Ï1               (MAX 0Ï*
;Ï1                    (- pc-idxÏ*
;Ï1                       (TRUNCATEÏ*
;Ï1                        (* 3 (TRUNCATE (sheet-inside-height window) (sheet-line-height window)))Ï*
;Ï1                        4))))Ï*
;Ï1          label)Ï*
  
  (VALUES
    ;Ï1; advice around dbis with args substituted for operations on arglist Ï*
    (LET ((results (MULTIPLE-VALUE-LIST
		     ;Ï1; --- original code here ---Ï*
		     (LIST* :debug-info :skip (NREVERSE list)))))
      ;Ï1; ------------------------Ï*
      (LET ((struct (CATCH-ERROR
		      (sys:get-debug-info-struct fef)
		      nil))
	    (name (CATCH-ERROR (FUNCTION-NAME fef) nil)))
	(IF (AND *show-dbis-for-fefs-in-inspector* name struct)
	    (PROGN (SETF (FIRST results)
			 (CONS (LIST "Ï3Function name: Ï*"
				     `(:item1 named-structure-p ,name)
				     "Ï3, DBIS is: Ï*"
				     `(:item1 named-structure-p ,struct))
			       (FIRST results)))
		   (VALUES-LIST results))
	    (VALUES-LIST results))))
    (LIST fef pc-idx)
    'print-fef-instruction
    (AND pc-now pc-idx                 ;Ï1; make sure valid PC-IDX was foundÏ*
	 (MAX 0
	      (- pc-idx
		 (TRUNCATE
		   (* 3 (TRUNCATE (sheet-inside-height window) (sheet-line-height window)))
		   4))))
    label)
  
  )

;Ï1----------------------------------------------------------------------------------Ï*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1     (ADVISE print-fef-instruction :around :show-dbis nilÏ*
;Ï1       ;;; Spots non instruction type items and prints them with the normalÏ*
;Ï1       ;;; inspect printer.Ï*
;Ï1       (IF (CONSP (FIRST arglist))Ï*
;	Ï1   (inspect-printer (FIRST arglist) nil (THIRD arglist) nil)Ï*
;	Ï1   :do-it)))Ï*
;Ï1----------------------------------------------------------------------------------Ï*

(DEFUN Ï4print-fef-instructionÏ* (pc fef-and-pc-idx *standard-output* item-no
				 &aux (fef (FIRST fef-and-pc-idx))
				 (pc-idx (SECOND fef-and-pc-idx)))
  (IF (NUMBERP pc)
      (PROGN
	(SEND *standard-output* :string-out (IF (EQ item-no pc-idx) "Ï3=> Ï*" "Ï3   Ï*"))
	(LET ((compiler:disassemble-object-output-fun
		#'(lambda (obj prefix loc fun-p)
		    (SEND *standard-output* :item1 (LIST obj loc) (IF fun-p 'fef-function 'fef-constant)
			  #'print-fef-constant prefix))))
	  (AND (NUMBERP pc) (compiler:disassemble-instruction fef pc))))
      (IF (CONSP pc) ;Ï1; from advice commented above - with actual args substituted for operations on arglistÏ*
	  (inspect-printer pc nil *standard-output* nil)
	  ;Ï1; --- original code -----------------------------Ï*
	   (WHEN (EQ pc :debug-info) ;Ï1; clm 02/15/89Ï*
	     (SEND *standard-output* :string-out "Ï3Debug INFO Structure Ï*")
	     (SEND *standard-output* :item1 (si:get-debug-info-struct fef) :value #'print-item-concisely)))
          ;Ï1; ---------------------------------------------Ï*
      )) 

(DEFUN Ï4print-fef-constantÏ* (item stream prefix)
  (PRINC prefix stream)
  (SEND stream :item1 (FIRST item) :value #'print-item-concisely)) 

(DEFPROP Ï4fef-constantÏ* t only-when-modify) 

(DEFUN Ï4(:property fef-constant value-functionÏ*) (thing)
  (FIRST (SECOND thing))) 

(DEFUN Ï4(:property fef-constant set-functionÏ*) (item new-value ignore)
  (RPLACD (SECOND (SECOND item)) new-value)) 

;Ï1 TAC 08-03-89  better definition follows Ï*
;Ï1(DEFUN (:PROPERTY FEF-FUNCTION VALUE-FUNCTION) (THING)Ï*
;Ï1  (CDR (SECOND (SECOND THING))))Ï*

(DEFUN Ï4(:property fef-function value-functionÏ*) (thing)
  ;Ï1; Patch by JPR.Ï*
  ;Ï1; sometimes (second (second thing)) is a bad locativeÏ*
  ;Ï1; so (rest of it is a bad thing to do.Ï*
  (IF (CATCH-ERROR (REST (SECOND (SECOND thing))) nil)
      (REST (SECOND (SECOND thing)))
      (SECOND (SECOND thing))))


;Ï1; List structure hackingÏ*

(DEFFLAVOR Ï4follow-list-structure-blinkerÏ* ((list-item nil)) (blinker)
           (:initable-instance-variables list-item)) 

(DEFMETHOD Ï4(follow-list-structure-blinker :set-list-itemÏ*) (new-list-item)
           (AND (NOT (EQ list-item new-list-item))
                (WITHOUT-INTERRUPTS (open-blinker self) (SETQ list-item new-list-item)))) 

(DEFMETHOD Ï4(follow-list-structure-blinker :blinkÏ*)
           (&aux y last-left-x last-right-x item end-item start-xpos end-xpos max-x ) ;Ï1temp-x)Ï*
           (SETQ max-x (sheet-inside-right sheet))
           (MULTIPLE-VALUE-BIND (item-array top-item bottom-item charw lineh il it) (SEND sheet :list-blinker-info)
             (SETQ item (THIRD list-item) start-xpos (1- (SECOND list-item)) end-item
                   (FIFTH list-item) end-xpos (1+ (FOURTH list-item)))
             (SETQ y (+ (* lineh (- item top-item)) it -2) last-left-x (1- il))
             (COND
               ((AND (>= item top-item) (< item bottom-item))	;Ï1; Top is on screen, draw the top lineÏ*
                (sys:%draw-line (SETQ last-left-x start-xpos) y
                            (SETQ last-right-x
                                  (MIN max-x
                                       (IF (/= item end-item)
                                           (+ il 1
                                              (* charw
                                                 (LENGTH (SECOND (AREF item-array item)))))  ;Ï1; 2 was string-lengthÏ*
                                           end-xpos)))
                            y (mouse-alu phase) t sheet)
                ))
             (DO ()
                 ((>= item bottom-item))
               (COND
                 ((>= item top-item)		;Ï1; Item is on screen, so there are side barsÏ*
                  (sys:%draw-line last-left-x (1+ y) last-left-x (+ y (1- lineh)) (mouse-alu phase) t sheet)
                  (sys:%draw-line last-right-x (1+ y) last-right-x (+ y (1- lineh)) (mouse-alu phase) t sheet)
                  ))
               (SETQ y (+ y lineh))		;Ï1; If we just handled the side-bars for the last item, returnÏ*
               (AND (OR (= item end-item) (>= item (1- bottom-item))) (RETURN))
	       ;Ï1; Onto the next item, and take care of the short horizontal bars on the right and leftÏ*
               (COND
                 ((> (SETQ item (1+ item)) top-item)
                  (%draw-line last-left-x y (SETQ last-left-x (1- il)) y (mouse-alu phase) t sheet)
                 (sys:%draw-line last-right-x y
                              (SETQ last-right-x
                                    (MIN max-x
                                         (IF (/= item end-item)
                                             (+ il 1
                                                (* charw
                                                   (LENGTH  
                                                    (SECOND (AREF item-array item)))))
                                             end-xpos)))
                              y (mouse-alu phase) t sheet)
                  )
                 ((= item top-item)
                  (SETQ last-right-x
                        (MIN max-x
                             (IF (/= item end-item)
                                 (+ il 1
                                    (* charw (LENGTH (SECOND (AREF item-array item))))) 
                                 end-xpos))))))
             (AND (= item end-item) (< item bottom-item)  ;Ï1; If didn't run off bottom of screen, draw in bottom lineÏ*
                  (sys:%draw-line last-left-x y last-right-x y (mouse-alu phase) t sheet)
                  ))) 

(DEFMETHOD Ï4(follow-list-structure-blinker :sizeÏ*) nil
             (VALUES (sheet-inside-width sheet) (sheet-inside-height sheet)))

(DEFMETHOD Ï4(basic-inspect :list-blinker-infoÏ*) nil
             (VALUES items top-item (+ top-item (sheet-number-of-inside-lines)) char-width
                     line-height (sheet-inside-left) (sheet-inside-top))) 

(DEFMETHOD Ï4(basic-inspect :after :change-of-size-or-marginsÏ*) (&rest ignore)
           (AND displaying-list;Ï1; If displaying a list, then must regrind when size changesÏ*
                 (inspect-setup-object current-object self top-item))) 

(DEFMETHOD Ï4(basic-inspect :mouse-movesÏ*) (x y &aux item type left top bwidth bheight)
           (mouse-set-blinker-cursorpos)
           (MULTIPLE-VALUE-SETQ (item type left bwidth top)
             (SEND self :mouse-sensitive-item x y))
           (COND
             ((cli:member type '(:list-structure :list-structure-top-level) :test #'EQ)
              (SETQ sensitive-inspect-item t) (blinker-set-visibility item-blinker nil)	;Ï1LEFT, BWIDTH, TOP are invalidÏ*
              (SEND list-blinker :set-list-item item) (blinker-set-visibility list-blinker t))
             (type (SETQ sensitive-inspect-item t) (blinker-set-visibility list-blinker nil)
              (SETQ bwidth (- bwidth left) bheight (+ (font-blinker-height current-font) 1))
              (blinker-set-cursorpos item-blinker (- left (sheet-inside-left))
                                     (- top (sheet-inside-top)))
              (blinker-set-size item-blinker bwidth bheight)
              (blinker-set-visibility item-blinker t))
             (t (blinker-set-visibility list-blinker nil)
              (blinker-set-visibility item-blinker nil) (SETQ sensitive-inspect-item nil)))) 

(DEFMETHOD Ï4(basic-inspect :mouse-sensitive-itemÏ*) (x y)
  (BLOCK found-item 
    (PROG (liln)
          (MULTIPLE-VALUE-BIND (item type left bwidth top) (mouse-sensitive-item x y)
            (COND
              ((< x (sheet-inside-left)) nil)         ;Ï1; .....this is the fix so that sensitive blinker itemÏ*
                                                      ;Ï1; isn't visible while the cursor becomes an up and down arrowÏ*
              (type (RETURN-FROM found-item item type left bwidth top))
              ((NOT displaying-list))
              ((AND (>= y (sheet-inside-top)) (< y (sheet-inside-bottom)))
               ;Ï1; No explicit item on this line -- find list structure if it existsÏ*
               (LET ((line-no (+ top-item (sheet-line-no nil y))))
                 ;Ï1; Starting from this line, work backwards until an enclosing piece of structure is foundÏ*
                 (OR (>= line-no (ARRAY-ACTIVE-LENGTH items))
                     (DOLIST (li (FIRST (AREF items line-no)))
                       (AND
                         (COND
                           ((= line-no (SETQ liln (THIRD li)))   ;Ï1;  Entry starts on this line -- within range on right?Ï*
                            (>= x (SECOND li)))
                           ((> line-no liln)  ;Ï1; Entry starts on some previous line -- so we are okÏ*
                            t))
                         (COND
                           ((= line-no (SETQ liln (FIFTH li)))        ;Ï1 Entry ends on this line, within range on left?Ï*
                            (< x (FOURTH li)))
                           ((< line-no liln);Ï1; Entry starts before -- so this is goodÏ*
                            t))
                         (RETURN-FROM found-item
                           (IF
                             (AND (OR modify-mode (key-state :hyper))
                                  (EQ (FIRST li) :top-level))
                             nil
                             (VALUES li
                                     (IF (EQ (FIRST li) :top-level)
                                         :list-structure-top-level :list-structure))))))))))))))

(DEFMETHOD Ï4(basic-inspect :object-otherÏ*) (ob) ob nil) 

;Ï1***************Ï*
;Ï1 TAC 08-03-89 - being redefined by code in INSPECTOR-ENHANCEMENTSÏ*
;Ï1(DEFMETHOD (BASIC-INSPECT :OBJECT-LOCATIVE) (LOC)Ï*
;Ï1  (SEND self :object-list (LIST (CAR loc))))Ï*

(DEFMETHOD Ï4(basic-inspect :object-listÏ*) (LIST)
  (MULTIPLE-VALUE-BIND (string-list atomic-items list-items)
      (grind-into-list list
		       (1- (TRUNCATE (sheet-inside-width) char-width)) ;Ï101-05-88 DAB Added 1- to fix losing the last charÏ*
		       t)
    ;Ï1; turn string-list into a list of elements, one for each line, of the formÏ*
    ;Ï1; (NIL contents-string atom-item-list line-contains-lozenged-characters-p).Ï*
    (DO ((l string-list (CDR l))
	 (ais atomic-items (CDR ais)))
	((NULL l))
      (LET ((lozenged-characters
	      (DOTIMES (i (LENGTH (CAR l)))
		(IF (>= (AREF (CAR l) i) 200) (RETURN t)))))
	;Ï1; Convert the start and end indices for each atom-item from characters to pixels.Ï*
	;Ï1; If this line contains no lozenged characters,Ï*
	;Ï1; this can be done by multiplying.  Otherwise, SHEET-STRING-LENGTH must be used.Ï*
	(DOLIST (i (CAR ais))
	  (SETF (THIRD i)
		(+ (sheet-inside-left)
		   (IF lozenged-characters
                       (MULTIPLE-VALUE-BIND (IGNORE ignore z)
                           (sheet-string-length self (CAR l) 0 (THIRD i))
                         (VALUES z))
		       (* (THIRD i) char-width))))
	  (SETF (FOURTH i)
		(+ (sheet-inside-left)
		   (IF lozenged-characters
                       (MULTIPLE-VALUE-BIND (IGNORE ignore z)
                           (sheet-string-length self (CAR l) 0 (FOURTH i))
                         (VALUES z))
		       (* (FOURTH i) char-width)))))
	(RPLACA l (LIST nil (CAR l) (CAR ais) lozenged-characters))))
    ;Ï1; Convert the starting and ending hpos of each list-item from characters to pixelsÏ*
    ;Ï1; Must find the line which the start or end appears on and see whether that line had anyÏ*
    ;Ï1; lozenged characters to decide whether a multiplication is sufficient.Ï*
    (DOLIST (i list-items)
      (SETF (SECOND i)
	    (+ (sheet-inside-left)
	       (LET ((line-desc (NTH (THIRD i) string-list)))
		 (IF (FOURTH line-desc)
                       (MULTIPLE-VALUE-BIND (IGNORE ignore z)
                           (sheet-string-length self (SECOND line-desc) 0 (SECOND i))
                         (VALUES z))
		     (* (SECOND i) char-width)))))
      (SETF (FOURTH i)
	    (+ (sheet-inside-left)
	       (LET ((line-desc (NTH (FIFTH i) string-list)))
		 (IF (FOURTH line-desc)
                       (MULTIPLE-VALUE-BIND (IGNORE ignore z)
                           (sheet-string-length self (SECOND line-desc) 0 (FOURTH i))
                         (VALUES z))
		     (* (FOURTH i) char-width))))))
    (SETQ list-items
	  (SORT list-items
		#'(lambda (x y)
		    (COND
		      ((< (THIRD y) (THIRD x)) t)
		      ((> (THIRD y) (THIRD x)) nil)
		      (t (> (SECOND x) (SECOND y)))))))
    (DO ((line (1- (LENGTH string-list)) (1- line))
	 (current list-items))
	((< line 0))
      (DO ()
	  ((OR (NULL current) (<= (THIRD (CAR current)) line)))
	(SETQ current (CDR current)))
      (RPLACA (CAR (NTHCDR line string-list)) current))
	  (VALUES string-list :list-structure 'inspect-list-printer)))

(DEFMETHOD Ï4(basic-inspect :before :setupÏ*) (sl) (SETQ current-display sl displaying-list nil)
           (blinker-set-visibility list-blinker nil)) 

(DEFMETHOD Ï4(basic-inspect :after :setupÏ*) (new-setup)
           (SETQ displaying-list (EQ (SECOND new-setup) :list-structure))) 

(DEFMETHOD Ï4(basic-inspect :after :handle-mouseÏ*) (&rest ignore)
           (blinker-set-visibility list-blinker nil)) 

(DEFUN Ï4inspect-list-printerÏ* (item ignore stream item-no)
  (DECLARE (:self-flavor basic-inspect))
;Ï1  (debug-break )Ï*
  (SETF (AREF displayed-items (- item-no top-item)) (THIRD item))
  (SEND stream :string-out (SECOND item)))

(DEFUN Ï4(:property :list-structure set-functionÏ*) (item new-value ignore)
  (RPLACA (FIRST (SECOND item)) new-value)) 

(DEFUN Ï4(:property :locative set-functionÏ*) (item new-value ignore)
  (RPLACD (SECOND item) new-value)) 


;Ï1; Array hackingÏ*

(DEFVAR Ï4*inspect-pdl-safe*Ï* t "Ï2If t don't allow Inspection of PDL past PDL pointerÏ*")

;Ï1; Values are (DISPLAY-LIST ARG ALT-PRINT-FUN FIRST-TOP-ITEM OBJ-LABEL ITEM-GENERATOR)Ï*
(DEFMETHOD Ï4(basic-inspect :object-arrayÏ*) (obj &optional (mention-leader (ARRAY-HAS-LEADER-P obj)) initial-items)
           (SETQ initial-items (APPEND initial-items '((""))))
           (VALUES nil (LIST obj mention-leader initial-items) 'inspect-array-printer 0 nil
                   'inspect-array-item-generator)) 

;Ï1; This is the item-generator function for displaying an array. Ï*
;Ï1; Our item-list is effectively a list of consecutive integer - that is, item number n's value is just n-m, Ï*
;Ï1;  where m is the number of items in PRINT-FUNCTION-ARG that are used for the array leader.Ï*
;Ï1; All the work of figuring out how to print item n is done by the print function.Ï*
;Ï1; The purpose of our using an item-generator is so we don't have to cons up a very long list of consecutive integers (or anything else).Ï*
(DEFUN Ï4inspect-array-item-generatorÏ* (msg &optional arg1)
  (DECLARE (:self-flavor basic-inspect))
  (CASE msg
    (:number-of-items (+ (IF (CADR print-function-arg)
			     (OR (ARRAY-LEADER-LENGTH (CAR print-function-arg)) 0)
			     0)
                         (LENGTH (CADDR print-function-arg))
			 (LET ((ARRAY (CAR print-function-arg)))
			   (COND ((NOT *inspect-pdl-safe*)
				  (ARRAY-TOTAL-SIZE array))
				 ((EQ (ARRAY-TYPE array) 'art-reg-pdl)		;Ï1; JLM 5/01/89 {Ï*
				  (WITHOUT-INTERRUPTS
				    (CATCH-ERROR
				      (1+ (si:sg-regular-pdl-pointer (ARRAY-LEADER array 0))) nil)))
				 ((EQ (ARRAY-TYPE array) 'art-special-pdl) 
				  (WITHOUT-INTERRUPTS
				    (CATCH-ERROR
				      (1+ (si:sg-special-pdl-pointer (ARRAY-LEADER array 0))) nil)))
				 (t
				  (ARRAY-TOTAL-SIZE array))))))			;Ï1; JLM 5/01/89 }Ï*
    (:number-of-item (IF (NUMBERP arg1)
			 (+ arg1 (LENGTH (CADDR print-function-arg)))
                         (POSITION arg1 (THE list (CADDR print-function-arg)) :test #'EQ)))
    (:item-of-number (IF (< arg1 (LENGTH (CADDR print-function-arg)))
                         (NTH arg1 (CADDR print-function-arg))
                         (- arg1 (LENGTH (CADDR print-function-arg)))))))


;Ï1; clm 03/03/89Ï*
(DEFUN Ï4inspect-array-printerÏ* (item arg stream item-number &aux (obj (CAR arg))
  (leader-length-to-mention (IF (CADR arg) (ARRAY-LEADER-LENGTH obj) 0)))
  "Ï2The print-function used when inspecting an array.Ï*"
  ;Ï1; (CAR ARG) is the array.  (CADR ARG) is T to display the leader.Ï*
  ;Ï1; ITEM is usually a number.  A small number is an index in the leader.Ï*
  ;Ï1; Numbers too big for that start moving through the array elements.Ï*
  ;Ï1; Make sure base is consistent since sometimes this is called from the mouse process.Ï*
  (DECLARE (type stream stream))
    (COND
      ((NOT (NUMBERP item))
       (inspect-printer item obj stream item-number)
       (WHEN (ticlos::mapping-table-p obj)
	 (FORMAT stream "Ï3~26Ta CLOS mapping tableÏ*")))
      ((< item leader-length-to-mention)
       (LET ((pntr (LOCF (ARRAY-LEADER obj item))))
	 (SEND stream :item1 item 'leader-slot
	     #'(lambda (item stream) (FORMAT stream "Ï3Leader ~DÏ*" item)))
       (FORMAT stream "Ï3:~12T Ï*")
       (IF (%p-contents-safe-p pntr)
	   (SEND stream :item1 (ARRAY-LEADER obj item) :value #'print-item-concisely)
	   (FORMAT stream "Ï3#<~A ~O>Ï*"
		   (OR (NTH (%p-data-type pntr) q-data-types)
		       (%p-data-type pntr))
		   (%p-pointer pntr))))
       (WHEN (ticlos::mapping-table-p obj)
	 (IF (< item ticlos::mapping-table-leader-start)
	     (CASE item
	       (1 (FORMAT stream "Ï3~40T = method classÏ*"))
	       (2 (FORMAT stream "Ï3~40T = instance classÏ*")))
	   (UNLESS (NULL (ARRAY-LEADER obj item))
	     (LET ((class (IGNORE-ERRORS
			    (ELT (ticlos::class-mapped-supers (ticlos::mapping-table-method-class obj))
				 (- item ticlos::mapping-table-leader-start)))))
	       (WHEN (sys::classp class)
		 (FORMAT stream "Ï3~40T map for class Ï*")
		 (SEND stream :item1 class :value #'print-item-concisely))))))
       )
      (t
       (LET ((item (- item leader-length-to-mention))
	     (rank (ARRAY-RANK obj))
	     indices)
	 (OR (= rank 1) (SETQ indices (array-indices-from-index obj item)))
	 (SEND stream :item1 (CONS item (IF (= rank 1) item indices)) 'array-slot
	       #'(lambda (datum stream) (FORMAT stream "Ï3Elt ~DÏ*" (CDR datum))))
	 (FORMAT stream "Ï3:~9T Ï*")
	 (IF
	   (OR (CDR (ASSOC (ARRAY-TYPE obj) array-bits-per-element :test #'EQ))
	       (%p-contents-safe-p (AP-1-FORCE obj item)))
	   ;Ï1; Deal with data types that are objects, and with numeric arrays.Ï*
	   (UNLESS (IGNORE-ERRORS
		     (LET ((element (AR-1-FORCE obj item)))
		       (SEND stream :item1 element :value #'print-item-concisely)
		       (WHEN (EQ (ARRAY-TYPE obj) 'art-special-pdl)
			 (WHEN (LOCATIVEP element)
			   (BLOCK show-name
			     (LET ((symbol 
				     (COND ((EQL (%p-data-type-offset element -1) dtp-symbol-header)
					    (%make-pointer dtp-symbol (1- (%pointer element))))
					   ;Ï1; check for some commonly bound A-mem and M-mem variablesÏ*
					   ((DOLIST (symbol '( self self-mapping-table default-cons-area
							      alphabetic-case-affects-string-comparison
							      lexical-environment inhibit-scheduling-flag
							      currently-prepared-sheet background-cons-area) nil)
					      (WHEN (EQ element (%external-value-cell symbol))
						(RETURN symbol))))
					   (t (RETURN-FROM show-name)))))
			       (FORMAT stream "Ï3~35T Ý ~SÏ*" symbol))))
			 (LET ((cdr-code (%p-cdr-code (AP-1-FORCE obj item))))
			   (UNLESS (ZEROP cdr-code)
			     (FORMAT stream "Ï3~64T CDR-CODE=~AÏ*" cdr-code)))
			 )
		       (WHEN (ticlos::mapping-table-p obj)
			 (LET* ((method-class (ticlos::mapping-table-method-class obj))
				(map-s (ticlos::class-mapped-slot-names method-class)))
			   (FORMAT stream "Ï3~38T= ~A slot ~sÏ*"
				   (TYPECASE element
				     (fixnum "Ï3offset ofÏ*")
				     (locative "Ï3address ofÏ*")
				     (NULL "Ï3undefinedÏ*")
				     (FUNCTION "Ï3accessor forÏ*")
				     (t ""))
				   (NTH item map-s))))
		       )
		     t)
	     (WRITE-STRING "Ï3 ...<error in printing>...Ï*" stream))
	   ;Ï1; Deal with data types that aren't really objects.Ï*
	   (LET* ((loc (AP-1-FORCE obj item))
		  (dt (%p-data-type loc)))
	     (FORMAT stream "Ï3#<~A ~O>Ï*"
		     (OR (NTH dt q-data-types)
			 (%p-data-type loc))
		     (%p-pointer loc))
	     (WHEN (EQ (ARRAY-TYPE obj) 'art-special-pdl)
	       (LET ((cdr-code (%p-cdr-code loc)))
		 (UNLESS (ZEROP cdr-code)
		   (FORMAT stream "Ï3~64T CDR-CODE=~AÏ*" cdr-code)))
	       )))
	 )))) 

(DEFUN Ï4(:property leader-slot set-functionÏ*) (item new-value object)
  (STORE-ARRAY-LEADER new-value object (SECOND item))) 

(DEFPROP Ï4leader-slotÏ* t only-when-modify) 

(DEFUN Ï4array-indices-from-indexÏ* (ARRAY index)
  "Ï2Given a single INDEX into ARRAY, compute the equivalent set of indices.
The value is a list whose elements could be used with AREF and ARRAY,
and be equivalent to (AR-1-FORCE ARRAY INDEX).Ï*"
  (LET* ((dims
          (IF array-index-order (REVERSE (ARRAY-DIMENSIONS array)) (ARRAY-DIMENSIONS array)))
         (index1 index)
         (indices (MAKE-LIST (LENGTH dims))))
    (DO ((i indices (CDR i))
         (d dims (CDR d)))
        ((NULL d))
      (SETF (CAR i) (REM index1 (CAR d)))
      (SETQ index1 (TRUNCATE index1 (CAR d))))
    (IF array-index-order (REVERSE indices) indices))) 

(DEFUN Ï4(:property array-slot set-functionÏ*) (item new-value object)
  (SETF (AR-1-FORCE object (CAR (SECOND item))) new-value)) 

(DEFPROP Ï4array-slotÏ* t only-when-modify) 

;Ï1;; Other windows needed for the inspectorÏ*

(DEFFLAVOR Ï4inspect-history-windowÏ* 
           ((cache nil)
            (sensitive-history-item nil)
            (modify-mode nil)
            (setting-mode nil)
            (line-area-mouse-doc
              '(:mouse-l-1 "Ï3Inspect the indicated objectÏ*"
                :mouse-m-1 "Ï3Remove it from the InspectorÏ*"
                :mouse-r-1 "Ï3Find its function definition if it existsÏ*"))
            (normal-mouse-documentation
              '(:mouse-l-1 "Ï3Inspect the indicated objectÏ*"
                :mouse-r-1 "Ï3Find its function definition if it exists - else just inspect.Ï*")))
	   (line-area-text-scroll-mixin
	    function-text-scroll-window
            scroll-bar-mixin
	    mouse-sensitive-text-scroll-window
            borders-mixin
	    margin-region-mixin       ;Ï1; need this for LINE-AREA-TEXT-SCROLL-MIXINÏ*
	    lisp-help-mixin           ;Ï1; Provide who-line help on typed expressions.Ï*
	    any-tyi-mixin window)
  :settable-instance-variables
  (:gettable-instance-variables modify-mode setting-mode)
  (:default-init-plist :label nil
		       :line-area-width 24)
  (:documentation :combination		       
		  "Ï3History window for the inspector.Ï*"))

(DEFMETHOD Ï4(inspect-history-window :line-area-mouse-documentationÏ*) ()
      (COND
	((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
	 line-area-mouse-doc)))

(DEFMETHOD Ï4(inspect-history-window :who-line-documentation-stringÏ*) ()
  (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
              ;Ï1; If mouse is over an item containing an instance of INSPECTION-DATA and we are currentlyÏ*
              ;Ï1; treating INSPECTION-DATA instances specially, let the instance provide the who-line-doc.Ï*
              ;Ï1; This is used in special-purpose inspectors such as the flavor inspector.Ï*
              ((LET ((item (get-mouse-sensitive-item)))
                 ;Ï1; Send changed to Send-if-handles by JPR on 21 May 86.  Frames, which are not inspectÏ*
                 ;Ï1; frames may still have this sort of window (debugger frames).  Such frames may not haveÏ*
                 ;Ï1; the extra IVs to cope with this message.Ï*
                 (WHEN (AND (send-if-handles superior :inspection-data-active?) (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
               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 
               normal-mouse-documentation))))))

(DEFMETHOD Ï4(inspect-history-window :mouse-sensitive-itemÏ*) (x y)
  (BLOCK found-item 
        (MULTIPLE-VALUE-BIND (item type left bwidth top) (mouse-sensitive-item x y)
          (IF type (SETQ sensitive-history-item t) (SETQ sensitive-history-item nil))
          (RETURN-FROM found-item item type left bwidth top)) nil))

(DEFMETHOD Ï4(inspect-history-window :inspect-objectÏ*)
           (object inspector &optional top-item-no -label- dont-propogate from-window-debugger?)
  ;Ï1; First, remember current TOP-ITEM of inspectorÏ*
   (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))
               ))) 


(DEFMETHOD Ï4(inspect-history-window :flush-objectÏ*) (obj) (SEND self :flush-object-from-cache obj)
           (DOTIMES (i (ARRAY-ACTIVE-LENGTH items))
             (AND (EQ obj (AREF items i)) (RETURN (SEND self :delete-item i))))) 

;Ï1; Use a special print function so that inspected instances of INSPECTION-DATA get toÏ*
;Ï1; print themselves on the history pane.Ï*
(DEFMETHOD Ï4(inspect-history-window :after :initÏ*) (IGNORE)
  (SETQ print-function #'(lambda (line ignore stream ignore)
			   (SEND stream :item1 line :value #'inspection-data-print-item-concisely)
	print-function-arg nil)))

(DEFMETHOD Ï4(inspect-history-window :flush-object-from-cacheÏ*) (object)
           (SETQ cache (cli:delete (cli:assoc object cache :test #'EQ) cache :test #'EQ))) 

(DEFMETHOD Ï4(inspect-history-window :flush-contentsÏ*) nil (SETQ cache nil top-item 0)
           (STORE-ARRAY-LEADER 0 items 0) (FILL displayed-items nil)
           (SEND self :new-scroll-position)
           (sheet-force-access (self :no-prepare) (SEND self :clear-screen))) 

(DEFFLAVOR Ï4inspect-paneÏ* nil (inspect-window) :alias-flavor) 

(DEFFLAVOR Ï4inspect-window-with-typeoutÏ* nil (text-scroll-window-typeout-mixin inspect-window)
           (:default-init-plist :typeout-window
            '(typeout-window :deexposed-typeout-action (:expose-for-typeout)))) 

(DEFWRAPPER Ï4(inspect-window-with-typeout :mouse-sensitive-itemÏ*) (IGNORE . body)
            `(COND ((NOT (sheet-exposed-p typeout-window))
	  . ,body))) 

(DEFFLAVOR Ï4inspect-pane-with-typeoutÏ* nil (inspect-window-with-typeout) :alias-flavor) 

(DEFFLAVOR Ï4interaction-paneÏ* nil
           (preemptable-read-any-tyi-mixin notification-mixin autoexposing-more-mixin
            auto-scrolling-mixin window)) 

(DEFFLAVOR Ï4inspector-interaction-paneÏ*
	   ((who-line-message '(:mouse-r-1 "Ï3System Menu.  Type a form to Read-Eval-Inspect.  Press HELP for UCL help.Ï*")))
	   (ucl:command-and-lisp-typein-window
	    preemptable-read-any-tyi-mixin notification-mixin
	    autoexposing-more-mixin auto-scrolling-mixin window)
  :settable-instance-variables)

(DEFMETHOD Ï4(inspector-interaction-pane :who-line-documentation-stringÏ*) ()
  who-line-message) 

;Ï1; Since the inspect windows provide who-line help, refresh their help wheneverÏ*
;Ï1; someone tells us to refresh ours.  (They just use whatever who-line help we offer.)Ï*
;Ï1; The reason we are refreshed and they are not is that we are *STANDARD-INPUT*.Ï*
(DEFMETHOD Ï4(inspector-interaction-pane :after :refresh-helpÏ*)
           (&optional (option t) application (current-package *package*))
  (DOLIST (inspector (SEND superior :inspectors))
    (SEND inspector :refresh-help option application current-package))
  (SEND (SEND superior :history) :refresh-help option application current-package))

(DEFFLAVOR Ï4inspector-menu-paneÏ* nil (w:menu)
           (:default-init-plist
	     :item-list nil
	     :scrolling-p nil
	     :command-menu t
	     :dynamic t)
           (:documentation :combination  "Ï3  Ï*"
            )) 

(DEFFLAVOR Ï4basic-inspect-frameÏ*
	   ((inspectors nil)
	    (typeout-window nil)
	    (menu nil)
	    (user nil)
	    (frame nil)
	    (history nil)
            (inspector-typein-p nil)
	    (inspection-data-active? nil)) ;Ï1; See documentation string below.Ï*
	   (ucl:basic-command-loop
 	    process-mixin
	    full-screen-hack-mixin
	    frame-dont-select-inferiors-with-mouse-mixin
	    bordered-constraint-frame-with-shared-io-buffer
	    constraint-frame-forwarding-mixin
	    borders-mixin label-mixin basic-frame)
  (:default-init-plist
    :active-command-tables '(inspector-menu-cmd-table inspector-other-cmd-table)
    :all-command-tables '(inspector-menu-cmd-table inspector-other-cmd-table)
    :menu-panes '((menu ucl-inspector-menu))
    :typein-handler :handle-typein-input
    :prompt "Ï3Inspect: Ï*"
    ;Ï1; This predicate tells UCL to print command execution results only on typed Lisp formsÏ*
    ;Ï1; during our Lisp Evaluation mode.  It also inspects results when not in that mode.Ï*
    :print-results? 'inspector-print-values?
    :basic-help '(documentation-cmd)
    :save-bits :delayed
    :process '(inspect-top-level
		:special-pdl-size 4000
		:regular-pdl-size 10000))
  :gettable-instance-variables
  :settable-instance-variables
  :inittable-instance-variables
  :special-instance-variables
  (:init-keywords :number-of-inspectors)
  (:documentation :mixin
    "Ï3Basic flavor used to build the inspector and other inspector-like applications.
This flavor may also be used as a mixin to construct special-purpose inspection windows,
such as the Flavor Inspector (TV:FLAVOR-INSPECTOR).  Most any information can be presented using 
it, as long as the Inspector paradigm is appropriate for your application.  Use the code for flavor
TV:FLAVOR-INSPECTOR as a guide for constructing your own inspector.  Basic points to keep in mind
are the following:

1. The inspector command interface makes use of the Universal Command Loop.  Therefore, UCL instance
   variables control much of the command interaction.  Important initializations are:

   :ACTIVE-COMMAND-TABLES --the set of commands your inspector accepts.  Can be NIL.
   :ALL-COMMAND-TABLES    --probably EQ to :ACTIVE-COMMAND-TABLES.  The set of all command tables used in your inspector.
   :MENU-PANES            --an alist which should be ((TV:MENU <your symbol>)).  <your symbol> is a menu symbol used
                            to build your permanent command menu using UCL's BUILD-MENU function.  If for some reason
                            you have arranged your constraint frame to not include a permanent command menu, ommitt this option.
   :TYPEIN-MODES          --the list of symbols set to UCL:TYPEIN-MODE instances which control the processing of typed
                            expressions in the interaction window.   The default just interprets Lisp forms and typed
                            command names; in a special inspector, you might want to design special typein-modes which
                            allow the user to type an expression of some kind to inspect some data.  For instance, in
                            the Flavor Inspector, the user can type flavor names and method specs to inspect them.
 2.  As with the Flavor Inspector, you'll be defining flavors built on TV:INSPECTION-DATA for displaying your various types of data
     in the inspection panes.  Pattern them off of the flavor inspector's.  Use method :INSPECT-THING to create and explicitly inspect 
     a TV:INSPECTION-DATA instance.
 3.  To specify your own window panes and constraints, give your flavor a :BEFORE :INIT method
     similar to (:METHOD TV:FLAVOR-INSPECTOR :BEFORE :INIT).
 3.  If you don't want to handle typed expressions in your inspector, initialize :TYPEIN-HANDLER to NIL.  
 4.  Your inspector should initialize :INSPECTION-DATA-ACTIVE? to T.  Since the regular inspector just inspects Lisp,
     it turns this off so that programmers are able to inspect instances of TV:INSPECTION-DATA in the normal manner.
     Any special inspectors such as the Flavor Inspector have to set this to T in order to activate the special inspection
     features of TV:INSPECTION-DATA instances.  If you have an inspector which mixes the function of Lisp inspection with
     special data inspection, you can flip this variable on and off when switching between Lisp inspection and
     TV:INSPECTION-DATA inspection.
Constructing your own inspector isn't automatic, but if you use the flavor inspector as a model, it'll be pretty easy.Ï*"))

(DEFFLAVOR Ï4inspect-frameÏ*
           ()
           (basic-inspect-frame)
  (:documentation :mixin
                  "Ï3Flavor for the actual Inspector.Ï*")
  )

(DEFMETHOD Ï4( inspect-frame :after :initÏ*)(&rest ignore)
  (LET ((menu-pane (SEND self :get-pane 'menu)))
    (SETF (sheet-background-color menu-pane) w:33%-gray-color)
    (SETF (label-font label) fonts:cptfontb)
    (SETF (label-background label) w:75%-gray-color))
  )

;Ï1; Modified to fit into 604x432 window on MicroExplorer or 688x432 window on ExplorerÏ*
;Ï1; Change menu-history constraint from 3 to 4 lines high - 11/19/87 CATÏ*
;Ï1; Bind the io-buffer, panes and constraints.Ï*
(DEFMETHOD Ï4(basic-inspect-frame :before :initÏ*) (plist)        ;Ï1fiÏ*
  ;Ï1; Unless a higher-level :BEFORE :INIT demon has already initialized INSPECTORS, PANES, and CONSTRAINTS, initialize them.Ï*
  ;Ï1; This condition allows a superior flavor's :BEFORE :INIT demon to set them the way it wants--we don't interfere.Ï*
  (UNLESS inspectors
    (LET ((noi (OR (GET plist :number-of-inspectors) 3))
          (names nil)
          (iobuff (make-default-io-buffer)))
      (SETQ panes
	    (LIST `(interactor inspector-interaction-pane
                               :label nil
                               :font-map ,(LIST (FIRST *inspector-font-map*))
                               :io-buffer ,iobuff
                               :more-p nil)
		  `(history inspect-history-window
                            :font-map ,(LIST (FIRST *inspector-font-map*))
                            :io-buffer ,iobuff)
		  `(menu inspector-menu-pane
                         :font-map ,(LIST (FIRST *inspector-font-map*))
                         :io-buffer ,iobuff)))
      ;Ï1; Add an inspector to PANES, taking into account the number of inspector panes requested.  The firstÏ*
      ;Ï1; inspector is given a typeout pane.  Also initialize INSPECTORS.Ï*
      (DOTIMES (i noi)
	(LET ((name1 (INTERN (FORMAT nil "Ï3INSPECTOR-~DÏ*" i) "Ï3TVÏ*")))
	  (PUSH
	   `(,name1 ,(IF (= i (1- noi))
		       'inspect-pane-with-typeout
		       'inspect-pane)
             :font-map ,(LIST (FIRST *inspector-font-map*)) :io-buffer ,iobuff)
	   panes)
          (PUSH name1 names)))  ;Ï1?Ï*
      (SETQ inspectors names)   ;Ï1?Ï*
      (SETQ constraints
	    `((:three-panes ,(REVERSE `(interactor menu-history ,@inspectors))
                    ((interactor 4 :lines))
                    ((menu-history :horizontal (4 :lines history) (menu history)
                                   ((menu :ask :pane-size))
                                   ((history :even))))
                    ,(MAPCAR
                       #'(lambda (name1)
                           `(,name1 :limit (1 36 :lines)
                             ,(/ 0.3s0 (1- noi)) :lines))
                       (CDR inspectors))
                    ((,(CAR inspectors) :even)))
	      (:one-pane (,(CAR inspectors) menu-history interactor)
                             ((interactor 4 :lines))
                             ((menu-history
                                :horizontal (4 :lines history)
                                (menu history)
                                ((menu :ask :pane-size))
                                ((history :even))))
                             ((,(CAR inspectors) :even)))
              (:two-horizontal-panes ,(REVERSE `(interactor menu-history inspector-2 inspector-1))
                    ((interactor 4 :lines))
                    ((menu-history :horizontal (4 :lines history) (menu history)
                                   ((menu :ask :pane-size))
                                   ((history :even))))
                    ((inspector-1 0.5))
                    ((inspector-2 :even)))
              (:two-vertical-panes ,(REVERSE `(interactor menu-history side-by-side))
                    ((interactor 4 :lines))
                    ((menu-history :horizontal (4 :lines history) (menu history)
                                   ((menu :ask :pane-size))
                                   ((history :even))))
                    ((side-by-side :horizontal (:even)
                                   (inspector-2 inspector-1)
                                   ((inspector-1 0.5))
                                   ((inspector-2 :even)))))
              ;Ï1; This configuration is for debugging purposes. Set *inspector-configuration* to debug. It shouldÏ*
              ;Ï1; not show up in profile or in the pop up config menu as a selectable configuration.Ï*
	      (:debug (,(CAR inspectors) menu-history interactor)
                             ((interactor 40 :lines))
                             ((menu-history
                                :horizontal (4 :lines history)
                                (menu history)
                                ((menu :ask :pane-size))
                                ((history :even))))
                             ((,(CAR inspectors) :even)))
              ))))) 

(DEFMETHOD Ï4(basic-inspect-frame :after :initÏ*) (IGNORE)
  ;Ï1; Bind the pane variables and select the interaction pane.Ï*
  (DO ((is inspectors (CDR is)))
      ((NULL is))
    (RPLACA is (SEND self :get-pane (CAR is))))
  (SETQ typeout-window (SEND (CAR inspectors) :typeout-window) user
        (SEND self :get-pane 'interactor) frame self history
        (SEND self :get-pane 'history))
  (SEND typeout-window :set-io-buffer (SEND user :io-buffer))
  (SEND self :select-pane user)
  ;Ï1; Necessary for the :ask :pane-size constraint for the menu.Ï*
  (SEND self :set-configuration (SEND self :configuration)))

;Ï1;;  03/08/88   LG Ï*	Ï1Correct the calling sequence to agree with :expose.Ï*

(DEFMETHOD Ï4(inspect-frame :before :exposeÏ*) (&rest ignore)
  (SEND self :set-configuration *inspector-configuration*))

(DEFMETHOD Ï4(basic-inspect-frame :designate-io-streamsÏ*) ()
  ;Ï1; Redefine this UCL method to set up the correct io bindings.Ï*
  (SETQ *terminal-io* (SEND self :get-pane 'interactor) *standard-input* *terminal-io*
        *standard-output* *terminal-io* *debug-io*
        (SEND (CAR inspectors) :typeout-window))) 

(DEFMETHOD Ï4(basic-inspect-frame :around :handle-typein-inputÏ*)
           (cont mt ignore &optional (untyi-first-char? t)) 
           "Ï2Make sure io for typein is bound to the interactor pane, and use UCL who line documentation for typein.Ï*"
           (LET ((*terminal-io* user))
             (SETQ inspector-typein-p t)
             (UNWIND-PROTECT (FUNCALL-WITH-MAPPING-TABLE
                              cont
                              mt
                              :handle-typein-input
                              untyi-first-char?)
                             (SETQ inspector-typein-p nil))))

(DEFMETHOD Ï4(basic-inspect-frame :around :handle-promptÏ*) (cont mt ignore)
  ;Ï1;Make sure io for the prompt is bound to the interactor pane.Ï*
  (LET ((*terminal-io* user))
    (FUNCALL-WITH-MAPPING-TABLE cont mt :handle-prompt))) 

(DEFUN Ï4inspector-print-values?Ï* ()
  ;Ï1; Determines whether or not to print values of executed commands.  We never print the values ofÏ*
  ;Ï1; normal UCL (keystroke-style) commands.  We only print the values of typed Lisp forms if we aren't in the Lisp Eval mode.Ï*
  ;Ï1; This is called by (ucl:basic-command-loop :handle-results)Ï*
  (DECLARE (:self-flavor basic-inspect-frame))
  (DECLARE (SPECIAL ucl:prompt ucl:input-mechanism history))
  ;Ï1; This looks weird but is correct.Ï*
  (AND (ucl::abnormal-command?)
       (IF (EQUAL ucl:prompt "Ï3> Ï*")
           (PROGN
	     (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; The inspector top-levelÏ*
;Ï1; Redefine this function to call the UCL command loop.  Ï*
(DEFUN Ï4inspect-command-loopÏ* (frame &aux user inspectors history typeout-window)
  (DECLARE (SPECIAL *print-array* *print-circle* *print-radix* *nopoint 
		    *print-base* *read-base* *print-level* *print-length*))
  (SETQ inspectors (SEND frame :inspectors)
	typeout-window (SEND (CAR inspectors) :typeout-window)
	user (SEND frame :get-pane 'interactor)
	history (SEND frame :get-pane 'history))
  (SEND user :clear-screen)
  (SEND (CAR inspectors) :flush-typeout)
  (SEND user :set-old-typeahead nil)
  ;Ï1; Flush remnants of modify modeÏ*
  (SEND history :set-sensitive-item-types t)
  (DOLIST (i inspectors)
    (SEND i :set-modify-mode nil))
  (LET* (
	 (kbd-intercepted-characters
	   (REMOVE (ASSOC #\Break kbd-intercepted-characters :test #'CHAR-EQUAL)
		   kbd-intercepted-characters))
         (top-item))
    (DECLARE (SPECIAL top-item =))
    (SETQ = nil)
    (SEND frame :command-loop))) 

(DEFMETHOD Ï4(basic-inspect-frame :before :loopÏ*) ()
  ;Ï1; Do an intitial update panes.Ï*
  (update-panes)) 


(DEFMETHOD Ï4(basic-inspect-frame :around :fetch-and-executeÏ*) (cont mt ignore)
  ;Ï1; Check for typeout.Ï*
  (SEND (CAR inspectors) :flush-typeout) (SEND frame :select-pane user)
  (FUNCALL-WITH-MAPPING-TABLE cont mt :fetch-and-execute)) 

;Ï1; Processes mouse sensitive blips.  Ï*
;Ï1; Blips containing instances of TV:INSPECTION-DATA are treated specially; they are sent a message to have Ï*
;Ï1; themselves handle the mouse button which generated the blip.  This allows each type of inspection data to assignÏ*
;Ï1; different operations to each mouse button.  For instance, right clicks on mouse sensitive flavorÏ*
;Ï1; names in the Flavor Inspector bring up a menu of options; left clicks on flavor names cause the flavor to beÏ*
;Ï1; inspected; clicks on instance variable default values are printed on the typeout window; etc."Ï*
(DEFMETHOD Ï4(basic-inspect-frame :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) :send-if-handles :toggle-lock))   
      ((AND (CONSP ucl:kbd-input)
            (EQL (FOURTH ucl::kbd-input) #\Mouse-m-2))
       (SEND (THIRD ucl::kbd-input) :send-if-handles :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 inspection-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.  (Each type of info handles the various mouse buttons differently.)Ï*
       (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))
         (#\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Ï*
      ((AND (= (FOURTH ucl::kbd-input) #\Mouse-m)
            (MEMBER (THIRD ucl::kbd-input) inspectors :test #'EQ))
       (SEND self :inspect-info-middle-click))
      ;Ï1; Right Click on inspected Lisp Object-- inspect its function definition, or itself if no function.Ï*
      ((= (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))))) 

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - being redefined by code below (from GENERAL-INSPECTOR)Ï*
;Ï1(DEFMETHOD (BASIC-INSPECT-FRAME :inspect-info-left-click) () Ï*
;Ï1; Handles middle clicks on mouse sensitive items in inspection and history panes.Ï*
;Ï1; Middle clicks in inspection panes inspect the item, but put (or leave) the current item in theÏ*
;Ï1; middle pane.  Middle cliks in the history pane just inspect the item.  (The item comes from UCL:KBD-INPUT.)Ï*
(DEFMETHOD Ï4(basic-inspect-frame :inspect-info-middle-clickÏ*) ()
  (LET ((1st-thing (inspect-real-value ucl::kbd-input))
	(2nd-thing
	 (WHEN (MEMBER (THIRD ucl::kbd-input) inspectors :test #'EQ)
	   (SEND (THIRD ucl::kbd-input) :current-object))))
	;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history 1st-thing history)
    (WHEN 2nd-thing
      (inspect-flush-from-history 2nd-thing history))
    (WHEN 2nd-thing
      (SEND history :append-item 2nd-thing))
    (SEND history :append-item 1st-thing)
    (update-panes))) 

;Ï1; Handles right clicks on mouse sensitive items in inspection panes.Ï*
;Ï1; On right clicks we try to find the function definition, if the item is a defined function,Ï*
;Ï1; otherwise we just inspect it.  The item comes from UCL:KBD-INPUT.Ï*
(DEFMETHOD Ï4(basic-inspect-frame :inspect-info-right-clickÏ*) ()
  (LET ((thing (inspect-find-function (inspect-real-value ucl:kbd-input))))
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    (update-panes)))

(DEFMETHOD Ï4(basic-inspect-frame :update-*Ï*)  ()
  (LET* ((items (SEND history :items))
	 (nitems (IF items (ARRAY-ACTIVE-LENGTH items) 0)))
    (AND (>= nitems 1) (SETQ * (AREF items (- nitems 1))))
    (AND (>= nitems 2) (SETQ ** (AREF items (- nitems 2))))
    (AND (>= nitems 3) (SETQ *** (AREF items (- nitems 3))))))

;Ï1; Toggle the locked-p status of an inspection pane.Ï*
(DEFMETHOD Ï4(inspect-window :toggle-lockÏ*) () 
  (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
           (COND ((OR (AND (EQUAL config :three-panes) (< num-of-locked-panes 2))
                      (AND (OR (EQUAL config :two-horizontal-panes) (EQUAL config :two-vertical-panes))
                           (< num-of-locked-panes 1)))
                  ;Ï1; (< num-of-locked-panes (1- num-inspectors))Ï*
                  (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)))
                 (t (BEEP)))))))

;Ï1; TYPE is a flavor which mixins in FLAVOR-INFO and THING is the data to inspect.Ï*
;Ï1; AUX-DATA can be additional data to store, if TYPE is a flavor which mixes inÏ*
;Ï1; TV:AUXILIARY-DATA-MIXIN.Ï*
(DEFMETHOD Ï4(basic-inspect-frame :inspect-thingÏ*)
           (type thing &optional (aux-data nil aux-supplied?))
  (LET ((inspected-thing
	 (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(inspect-frame :inspect-objectÏ*) (object-to-inspect)
  (LET ((thing (inspect-real-value
                 `(:value ,object-to-inspect ,history))))
    ;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    (update-panes)))

;Ï1; Grinds THING on the typeout window, then prompts user for input to flush it.Ï*
(DEFMETHOD Ï4(basic-inspect-frame :pretty-print-thingÏ*) (thing)
  (FORMAT typeout-window "Ï3~%Ï*")
  (GRIND-TOP-LEVEL thing nil typeout-window)
  (FORMAT typeout-window "Ï3~2%~aÏ*" tv:*remove-typeout-standard-message*)
  (LET ((CHAR (SEND typeout-window :any-tyi)))
    (UNLESS (= char #\Space)
      (SEND *standard-input* :force-kbd-input char))
    (SEND (CAR inspectors) :flush-typeout)))

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - being redefined by code below (from TI-ENV-FLAVOR-INSPECTOR)Ï*
;Ï1 (DEFMETHOD (BASIC-INSPECT-FRAME :format-message) (string &REST format-args)Ï*
;Ï1; Formats STRING on the typeout window, using FORMAT-ARGS if provided, then prompts user for input to flush it.Ï*
;Ï1; Fixes a bug for mouse blipsÏ*

(DEFMETHOD Ï4(basic-inspect-frame :format-messageÏ*) (STRING &rest format-args)
  (FUNCALL #'FORMAT typeout-window string format-args)
  (FORMAT typeout-window "Ï3~2%~aÏ*" tv:*remove-typeout-standard-message*)
  (LET ((CHAR (SEND typeout-window :any-tyi)))
    (UNLESS (OR (CONSP char) (EQUAL char #\Space))
      ;Ï1; changed from = by JPR.  This could be a mouse blipÏ*
      (SEND *standard-input* :force-kbd-input char))
    (SEND (CAR inspectors) :flush-typeout)))

;Ï1-------------------------------------------------------Ï*
;Ï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*update-panes-base-ok*Ï* t
"Ï2When true this makes sure that when the inspector's panes are updated the
 item cache is not flushed.Ï*")

(DEFUN Ï4update-panesÏ* (&optional (bases-ok? nil))
  "Ï2Update inspection and history panes to current objects.  Should be called
   by each command that effects the inspected objects list.Ï*"
  (DECLARE (SPECIAL top-item history frame inspectors))
  (LET ((items (SEND history :items))
        (iw)
        (idx)
        (noi (LENGTH inspectors))
        (locked-objects nil)
        (history-object nil))   ;Ï1!Ï*
    (SETQ idx (ARRAY-ACTIVE-LENGTH items))
    (SETQ locked-objects nil)
    ;Ï1; Make sure base is correct in case user typed (setq base ...) instead of using print variables menu. Ï*
    (UNLESS (OR bases-ok? *update-panes-base-ok*) ;Ï1; from advice commented aboveÏ*
	(SEND history :set-cache nil)
	(SEND history :refresh))
    ;Ï1; Make sure the inspection windows reflect the state of the history bufferÏ*
    (DOLIST (i inspectors)
      ;Ï1; Update datastructure to reflect current TOP-ITEMsÏ*
      (LET ((disp (SEND i :current-display)))
	(AND disp (SETF (FOURTH disp) (SEND i :top-item))))
      (WHEN (SEND i :locked-p) (SETQ locked-objects (CONS (SEND i :current-object) locked-objects))))
    (DOTIMES (i noi)
      (SETQ iw (NTH i inspectors))
           (COND ((SEND iw :locked-p)
	     (w:prepare-sheet (iw) (w:draw-char
				     (SEND (SEND (SEND iw :superior) :superior) :parse-font-descriptor 'fonts:icons)
				      98. (- (SEND iw :width) 50.) 3. w:alu-andca iw))
	     (SEND history :inspect-object (SEND iw :current-object) iw top-item nil t)
	     (w:prepare-sheet (iw) (w:draw-char
				     (SEND (SEND (SEND iw :superior) :superior) :parse-font-descriptor 'fonts:icons)
				      98. (- (SEND iw :width) 50.) 3. w:alu-xor iw)))
	    (t
	     (SETQ idx (1- idx))
	     (COND
	       ((< idx 0)
		(SEND iw :set-current-display
		      (SEND iw :setup
			    `(inspect-printer nil nil nil
					      (nil nil nil nil
						   ,(label-font (SEND iw :label))
						   "Ï3EmptyÏ*"))))
		(SEND iw :set-current-object (LIST nil)))
	       (t
		(SETQ history-object
		      ;Ï1advance past items displayed in locked panesÏ*
		      (DO* ((history-object (AREF items idx) (IF (>= idx 0) (AREF items idx))))	
			   ((OR (< idx 0)
				(NOT (MEMBER history-object locked-objects :test #'EQ)))
			    history-object)
			(SETQ idx (1- idx))))
		(COND (history-object  ;Ï1got something to inspectÏ*
		       (SEND history :inspect-object history-object iw top-item nil t))
		      
		      (t               ;Ï1nothing to inspect, so need to clear the paneÏ*
		       (SEND iw :set-current-display
			     (SEND iw :setup
				   `(inspect-printer nil nil nil
						     (nil nil nil nil
							  ,(label-font (SEND iw :label))
							  "Ï3EmptyÏ*"))))
		       (SEND iw :set-current-object (LIST nil)))))))) ;Ï1; **The last T should be NIL, but it acts haywire if it is!!!Ï*
      )
    (SETQ top-item nil))                                                         
  ;Ï1; Insure last item in history is on the screenÏ*
  (SEND history :put-last-item-in-window)
  ;Ï1; Give *, ** and *** the right values.Ï*
  (SEND frame :update-*))
	 

(DEFCOMMAND Ï4end-cmdÏ* nil				
             '(:description  "Ï3Exit the Inspector.  Return the value of = if inspect* is called.Ï*"  :names ("Ï3ExitÏ*") 
             :keys (#\End))
            (DECLARE (SPECIAL frame =  inspect*-quit))
	    (IF inspect*-quit
		(SEND frame :quit =) 
		(SEND frame :bury)))

;Ï1***************Ï*
;Ï1 TAC 08-01-89 - being redefined to have keystroke META-R so that CTRL-R can be used for reverse-search like zmacs.Ï*
;Ï1(DEFCOMMAND REFRESH-CMD NILÏ*

;Ï1***************Ï*
;Ï1 TAC 08-01-89 - code from DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTSÏ*
(DEFCOMMAND Ï4refresh-cmdÏ* nil
  '(:description 
"Ï3Redisplay the inspected objects, updating any fields that have changed values.Ï*"
;Ï1; Changed from Control r by JPR.Ï*
    :names ("Ï3RefreshÏ*" "Ï3DecacheÏ*") :keys (#\m-r))
  (DECLARE (SPECIAL history frame))
  (SEND history :set-cache nil)
  (update-panes)
) 

;Ï1***************Ï*
;Ï1 TAC 08-04-89 - being replaced with definition from TI-ENV-FLAVOR-INSPECTOR-INTERFACEÏ*
;Ï1                        sets *INSPECTION-DATA* to nilÏ*
;Ï1(DEFCOMMAND DELETE-ALL-CMD NILÏ*			

(DEFCOMMAND Ï4delete-all-cmdÏ* nil			
            '(:description  "Ï3Delete all inspected objects from history and inspection panes.Ï*"
              :names ("Ï3DeleteÏ*") :keys (#\c-page))
            (DECLARE (SPECIAL history inspectors))
            (SEND history :flush-contents)
            (LOOP for iw in inspectors
                  do (SEND iw :set-locked-p nil))
	    ;Ï1; Added by JPR. - We don't want any old inspection datas if we delete all.  Ï*
            ;Ï1; Mind you, *inspection-data* should really be an IV of the frame.Ï*
	    (SETQ *inspection-data* nil)
            (update-panes)) 

(DEFCOMMAND Ï4modify-cmdÏ* nil
            '(:description 
             "Ï3Modify a slot in an inspected object by clicking on it and then choosing a new value.Ï*"
              :names ("Ï3ModifyÏ*") :keys (#\c-m))
            (DECLARE (SPECIAL top-item user history inspectors frame))
            (SETQ top-item (inspect-modify-object user history inspectors)) (update-panes)
            (SEND frame :handle-prompt)) 

(DEFCOMMAND Ï4set-equal-cmdÏ* nil			
            '(:description 
             "Ï3Set the value of the symbol = by choosing an object.  (useful for storing objects for lisp typein etc.)Ï*"
              :names ("Ï3Set=Ï*") :keys (#\c-=))
            (DECLARE (SPECIAL user history = inspectors frame)) (SEND user :clear-screen)
            (FORMAT user "Ï3~&Value to set = to:Ï*")
            (MULTIPLE-VALUE-BIND (value punt-p) (inspect-get-value-from-user user history inspectors)
              (OR punt-p (SETQ = value)))
            (SEND frame :handle-prompt)) 

(DEFCOMMAND Ï4page-up-cmdÏ* (numarg)	
  '(:description "Ï3Show the next page up for the main inspection pane.Ï*"
    :documentation "Ï3With numeric argument, scrolls the number of pages specified.Ï*"
    :names ("Ï3UpÏ*")
    :keys (#\M-v #\C-up-arrow)		
    :arguments (ucl:numeric-argument))
  (DECLARE (SPECIAL inspectors))
  (SEND (CAR inspectors) :scroll-to
	(* (OR numarg 1) (- 2 (sheet-number-of-inside-lines (CAR inspectors))))
	:relative))

(DEFCOMMAND Ï4page-down-cmdÏ* (numarg)	
  '(:description "Ï3Show the next page down for the main inspection pane.Ï*"
    :documentation "Ï3With numeric argument, scrolls the number of pages specified.Ï*"
    :names ("Ï3DownÏ*")
    :keys (#\C-v #\C-down-arrow)
    :arguments (ucl:numeric-argument))
  (DECLARE (SPECIAL inspectors))
  (SEND (CAR inspectors) :scroll-to
	(* (OR numarg 1) (- (w:sheet-number-of-inside-lines (CAR inspectors)) 2))
 	:relative))

(DEFCOMMAND Ï4page-to-topÏ* ()	
  '(:names       "Ï3TopÏ*"
    :description "Ï3Scrolls the main inspection pane to the top.Ï*"
    :keys        #\Meta-<
    :property-list (:dont-preempt t))  ;Ï1;Don't preempt the equivalent Input Editor command.Ï*
  (DECLARE (SPECIAL inspectors))
  (SEND (CAR inspectors) :scroll-to 0 :absolute))

(DEFCOMMAND Ï4page-to-bottomÏ* ()	
  '(:names       "Ï3BottomÏ*"
    :description "Ï3Scrolls the main inspection pane to the bottom.Ï*"
    :keys        #\Meta->
    :property-list (:dont-preempt t))  ;Ï1;Don't preempt the equivalent Input Editor command.Ï*
  (DECLARE (SPECIAL inspectors))
  (SEND (CAR inspectors) :scroll-to
	(- (NTH-VALUE 1 (SEND (CAR inspectors) :scroll-position)) ;Ï1;total-linesÏ*
	   (SEND (CAR inspectors) :line-height))
	:absolute))

(DEFCOMMAND Ï4break-cmdÏ* nil
            '(:description  "Ï3Enter the break read, eval and print loop.Ï*"  :names ("Ï3BreakÏ*")
             :keys (#\Break))
            (DECLARE (SPECIAL frame inspectors typeout-window))
            (SEND frame :select-pane (CAR inspectors)) (SEND typeout-window :expose-for-typeout)
            (LET ((*terminal-io* typeout-window))
              (CATCH-ERROR-RESTART ((abort error) "Ï3Return to inspector command loop.Ï*")
                                   (BREAK "Ï3inspectÏ*" t)))) 

(DEFCOMMAND Ï4lisp-mode-cmdÏ* nil	
            '(:description  "Ï3Toggle between Lisp mode and Inspect mode.Ï*"  :names ("Ï3ModeÏ*")
             :keys (#\s-m))
            (DECLARE (SPECIAL ucl::prompt frame))
            (IF (EQUAL ucl::prompt "Ï3Inspect: Ï*") (SETQ ucl::prompt "Ï3> Ï*")
                (SETQ ucl::prompt "Ï3Inspect: Ï*"))
            (SEND frame :handle-prompt)) 

(DEFCOMMAND Ï4toggle-config-cmdÏ* nil
            '(:description  "Ï3Select a new inspector pane configuration.Ï*"  :names
             ("Ï3ConfigÏ*") :keys (#\s-c))
            (DECLARE (SPECIAL frame))
            (LET ((new-cfg (w:menu-choose '(:three-panes :one-pane :two-horizontal-panes :two-vertical-panes)
                                          :label "Ï3Choose a new inspector configurationÏ*" :scrolling-p nil)))
              (delaying-screen-management 
                (COND (new-cfg
                       (SETQ *inspector-configuration* new-cfg)
                       (SEND frame :set-configuration new-cfg))))))



;Ï1***************Ï*
; TAC 08-01-89Ï1 - redefined below (from DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTS)Ï*
;(DEFCOMMAND Ï4DOCUMENTATION-CMDÏ* NIL		

;Ï1****************************************************************************************************Ï*
; TAC 08-01-89Ï1 - new code from DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTSÏ*
;Ï1---------------------------------------------------------------------------------Ï*
;Ï1 DOCUMENTATION COMMAND Ï*
;-------------------------------------------------------------------------------
(DEFUN uniquise-commands (commands)
  (IF (AND commands (REST commands))
      (IF (AND (EQUALP (FIRST  (FIRST commands)) (FIRST  (SECOND commands)))
	       (EQUALP (SECOND (FIRST commands)) (SECOND (SECOND commands))))
	  (uniquise-commands (REST commands))
	  (CONS (FIRST commands) (uniquise-commands (REST commands))))
      commands))

(DEFUN show-all-commands-for-frame (frame on-window)
  (FORMAT on-window "~&The following commands are supported on top of the normal input editor commands.~%")
  (LET ((all-commands
	  (MAPCAR #'(lambda (table)
		      (MAPCAR #'(lambda (command)
				  (APPEND
				    (FIRSTN 2 (SEND command :parsed-edit-form))
				    (LIST (SEND command :description)
					  (IF (STRING-EQUAL
						(SEND command :description)
						(SEND command :documentation))
					      ""
					      (SEND command :documentation)))))
			        (LISTARRAY
				  (SEND (SYMBOL-VALUE table) :commands))))
		    (uniqueise (SEND frame :all-command-tables)))))
       (LET ((sorted (SORTCAR (APPLY #'APPEND all-commands) #'STRING-LESSP)))
	    (MAPCAR #'(lambda (LIST)
			(APPLY #'FORMAT on-window "~&~A~25T~A~48T~A ~A" list))
		    (uniquise-commands sorted)))))

(DEFCOMMAND Ï4documentation-cmdÏ* nil		
  '(:description 
    "Ï3Display some brief documentation about each of the Inspector's panes.Ï*"
    :names ("Ï3HelpÏ*")
    :keys (#\c-help #\m-help))
   (DECLARE (SPECIAL frame))
   (si:with-help-stream (window :label "Ï3Documentation for InspectorÏ*"
				:superior frame)
     (FORMAT window
"
 Ï3 Ï*-----------------------------------------------------------------------------------
                    *** Optional Third Inspection Pane ***

    Displays previously inspected item.

 ------------------------------------------------------------------------------------
                    *** Optional Second Inspection Pane ***

    Displays previously inspected item.

 ------------------------------------------------------------------------------------ 
                        *** Main Inspection Pane ***

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

      1) Entering them into the Interaction Pane or,
      2) Clicking left on the mouse sensitive elements of previously inspected items.

    Right click on items here tries to inspect the item's function definition.


 ------------------------------------------------------------------------------------
   * Command * |                  *** History Pane ***
   *  Menu   * |
               |    This pane displays a list of the objects that have been
     For UCL   |  inspected.  To bring an object back into the Main Inspection
     command   |  pane click left on it in this pane.
     display   |
      press    |    To remove an item from the history, click middle in the item's
      HYPER-   |  line area (the area just left of the item where the mouse cursor
     CONTROL-  |  becomes a right pointing arrow).
      HELP.    |
 ------------------------------------------------------------------------------------
                           *** Interaction Pane *** 

      Enter items to inspect in this pane.  This pane may also be used for command
    name typein and for Lisp typein.  For Lisp typein use the Mode command.

      The last three inspected objects are stored in *, ** and ***.
 
 ------------------------------------------------------------------------------------
  ")
     (show-all-commands-for-frame frame window)))
;Ï1****************************************************************************************************Ï*


(DEFCOMMAND Ï4modify-print-cmdÏ* nil		;Ï1!worksÏ*	
  '(:description "Ï3Bring up a menu that will allow the modification of various printing variables.Ï*"
		 :names ("Ï3PrintÏ*") :keys (#\s-p))
  (DECLARE (SPECIAL history frame))
  (DECLARE (SPECIAL *print-array* *print-circle* *print-radix* *nopoint *print-base* *read-base* *print-level* *print-length* ))
  (CATCH 'abort-modify-print-cmd
    (LET ((pc  *print-circle*)
	  (plev *print-level*)
	  (plen *print-length*)
	  (np   *nopoint)
	  (pr   *print-radix*)
	  (pb   *print-base*)
	  (rb   *read-base*))
      (DECLARE (SPECIAL pc plev plen np pr pb rb))
      (w:choose-variable-values
	'((nil "" :number-or-nil)
	  (pc    "Ï3  Print recursive objects concisely?   *PRINT-CIRCLE* Ï*" :assoc (("Ï3YesÏ*" . t) ("Ï3NoÏ*" . nil)))
	  (plev  "Ï3  Set *PRINT-LEVEL*                    *PRINT-LEVEL*  Ï*" :decimal)
	  (plen  "Ï3  Set *PRINT-LENGTH*                   *PRINT-LENGTH* Ï*" :decimal)
	  (nil "" :number-or-nil)
	  (np    "Ï3  Print decimal in base 10             *NOPOINT       Ï*" :assoc (("Ï3YesÏ*" . nil) ("Ï3NoÏ*" . t)))
	  (pr    "Ï3  Print the Radix of all numbers?      *PRINT-RADIX*  Ï*" :assoc (("Ï3YesÏ*" . t) ("Ï3NoÏ*" . nil)))
	  (pb    "Ï3  Set the base to print with.          *PRINT-BASE*   Ï*" :decimal)
	  (rb    "Ï3  Set the base to read with.           *READ-BASE*    Ï*" :decimal)
	  (nil "" :number-or-nil))
	:label "Ï3  UPDATE PRINT OPTIONS  Ï*"
	:margin-choices '(("Ï3AbortÏ*" (THROW 'abort-modify-print-cmd nil)) "Ï3Do ItÏ*" ))
      (SETQ *print-circle*   pc
	    *print-radix*    pr
	    *nopoint         np
	    *print-base*     pb
	    *read-base*      rb
	    *print-level*    plev
	    *print-length*   plen)
      (SEND history :set-cache nil)
      (SEND history :refresh)
      (update-panes))))	;Ï1!Update panes in case base changedÏ*

(DEFPROP Ï4:decimalÏ*
	 ((lambda (number stream) (FORMAT stream "Ï3~dÏ*" number)) read-in-base-10 nil nil nil "Ï3Enter a positive integer.Ï*")
	 choose-variable-values-keyword)

(DEFUN Ï4read-in-base-10Ï* (STREAM)
  (LET ((*read-base* 10.))
    (READ stream)))

;Ï1***************Ï*
;Ï1 TAC 08-01-89  - being replaced with code that is in DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTSÏ*
;Ï1(DEFCOMMAND Inspect-Edit-CMD NILÏ*			
;Ï1(defun try-and-edit (object)Ï*
;Ï1----------------------Ï*

;Ï1******************************************************************************************Ï*
;Ï1 TAC 08-01-89 - new code (from  DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTS) Ï*
;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 The flavor inspect command. It has consistent ZMACS, INSPECTOR, EH interface.  Ï*
;Ï1-------------------------------------------------------------------------------Ï*
;Ï1; For ZmacsÏ*

zwei:
(DEFUN Ï4zwei::safe-inspect-flavorÏ* (object &optional frame)
"Ï2Inspects an object but just beeps if it is not inspectable. Frame may be 
provided if called from an inspector frame command.Ï*"
  (LET ((flavor (COND ((OR (INSTANCEP object) (TYPEP object 'si::flavor))
		       object)
		      ((SYMBOLP object)
		       (GET object 'si::flavor))
		      (t nil))))
       (IF flavor
	   (PROCESS-RUN-FUNCTION "Ï3Flavor InspectorÏ*" 'INSPECT-FLAVOR flavor frame)
           (PROGN (BEEP)
		  (FORMAT *query-io* "Ï3~S is not a flavor.Ï*" object)))))

zwei:
(defcom Ï4zwei::com-flavor-inspectÏ* "Ï3Call the flavor inspector on something.Ï*" ()
  (LET ((flavor (read-function-name "Ï3Flavor InspectÏ*"
				    (relevant-function-name (point) nil t t t) t))
	(*print-case* :capitalize))
       (safe-inspect-flavor flavor))
  dis-none)

zwei:
(set-comtab *standard-comtab* nil
	    (make-command-alist '(com-flavor-inspect)))

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1; For the inspector.Ï*

(DEFCOMMAND Ï4flavor-inspect-cmdÏ* nil			
  '(:description "Ï3Flavor Inspect a Flavor or Method.Ï*"
    :names ("Ï3FlavInsÏ*")
    :keys (#\c-sh-f #\m-sh-f #\h-f))
   (DECLARE (SPECIAL user history = inspectors frame))
   (SEND user :clear-screen)
Ï1 Ï*  (IF (FBOUNDP 'INSPECT-FLAVOR)  ;Ï1 TAC 08-18-89 - it should always be loadedÏ*
       (PROGN
	 (FORMAT user "Ï3~&Object to Flavor Inspect:Ï*")
	 (MULTIPLE-VALUE-BIND (value punt-p)
	     (inspect-get-value-from-user user history inspectors)
	   (OR punt-p
	       (zwei::safe-inspect-flavor value frame)))
	 (SEND frame :handle-prompt))
;Ï1; TAC 08-18-89 this won't work anymore, it's more complicated than just loading one fileÏ*
;Ï1       (PROGNÏ*
;	Ï1 (IF (Y-OR-N-P "The Flavor Inspector is not currently loaded. Do you wish to load it?")Ï*
;	Ï1     (PROGNÏ*
;	Ï1       (LOAD "sys:debug-tools;flavor-inspector")   Ï* 
;	Ï1       (SEND user :clear-screen)Ï*
;	Ï1       (FORMAT user "~&Object to Flavor Inspect:")Ï*
;	Ï1       (MULTIPLE-VALUE-BIND (value punt-p)Ï*
;		Ï1   (inspect-get-value-from-user user history inspectors)Ï*
;		Ï1 (OR punt-pÏ*
;		Ï1     (zwei:safe-inspect-flavor value)))Ï*
;	Ï1       (SEND frame :handle-prompt))))Ï*
       ))

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1; For the window debugger.Ï*

eh:
(DEFCOMMAND Ï4eh::flavor-inspect-cmdÏ* nil			
  '(:description "Ï3Flavor Inspect a Flavor or Method.Ï*"
    :names ("Ï3FlavInsÏ*")
    :keys (#\c-sh-f #\m-sh-f #\h-f))
   (zwei::safe-inspect-flavor (window-read-thing "Ï3~&Object to Flavor Inspect:Ï*")))

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


;Ï1; Add the new commands to the list of inspector menu commands.  Ï*
(DEFPARAMETER Ï4inspector-menu-cmdsÏ*		
              '(flavor-inspect-cmd documentation-cmd end-cmd delete-all-cmd set-equal-cmd refresh-cmd
		modify-cmd toggle-config-cmd lisp-mode-cmd modify-print-cmd inspect-edit-cmd)) 

(DEFPARAMETER Ï4inspector-non-menu-cmdsÏ*	
	  '(page-up-cmd
	     page-down-cmd
	     page-to-top
	     page-to-bottom
	     break-cmd))

(BUILD-COMMAND-TABLE 'inspector-menu-cmd-table 'inspect-frame inspector-menu-cmds :init-options	
                     '(:name "Ï3Inspector menu commandsÏ*")) 

(BUILD-COMMAND-TABLE 'inspector-other-cmd-table 'inspect-frame
  inspector-non-menu-cmds
  :init-options
  '(:name "Ï3Other Inspector commandsÏ*"))

(BUILD-MENU 'ucl-inspector-menu 'inspect-frame :default-item-options `(:font ,(FIRST *inspector-font-map*))	
            :item-list-order inspector-menu-cmds)  

(DEFMETHOD Ï4(basic-inspect-frame :name-for-selectionÏ*) () name) ;Ï1fiÏ*

;Ï1; When we have allocated a background inspector from the resource, tell it about an initial object to inspect.Ï*
;Ï1; This message is only sent to inspectors from the resource, by INSPECT.Ï*
(DEFMETHOD Ï4(basic-inspect-frame :prepare-for-useÏ*) (object objp new-label)
  (SEND self :set-label new-label)
  (LET ((hw (SEND self :get-pane 'history)))
    (SEND hw :flush-contents)
    (DOLIST (iw (SEND self :inspectors))
	  (SEND iw :set-locked-p nil))
    (COND
      (objp                                ;Ï1!as long as something was passed to inspectÏ*
       (with-sheet-deexposed (self) (SEND hw :flush-contents)  
			     (SEND hw :append-item object)
			     (DOLIST (iw (SEND self :inspectors))
			       (SEND iw :set-current-display
				     (SEND iw :setup
					   `(inspect-printer nil nil nil
							     (nil nil nil nil
								  ,(label-font (SEND iw :label))
								  "Ï3EmptyÏ*"))))
			       (SEND iw :set-current-object (LIST nil))))))
    (SEND (SEND self :typeout-window) :make-complete)
    (SEND hw :clear-input))) 

(COMPILE-FLAVOR-METHODS basic-inspect-frame  inspect-frame interaction-pane inspector-interaction-pane
                        inspector-menu-pane ;Ï1INSPECT-HISTORY-WINDOW-WITH-MARGIN-SCROLLINGÏ*
                        inspect-window inspect-window-with-typeout follow-list-structure-blinker) 


;Ï1 TAC 08-04-89 - new version of this in GENERAL-INSPECTORÏ*
;Ï1(DEFUN INSPECT (&OPTIONAL (OBJECT nil OBJP))     ;!so we can tell if something was passed in to inspectÏ*

;Ï1 TAC 08-04-89 - new version of this in GENERAL-INSPECTORÏ*
;Ï1(DEFUN INSPECT* (&OPTIONAL (OBJECT nil objp))Ï*

(DEFUN Ï4locate-a-windowÏ* (flavor &optional (current-window nil) (filter-function nil))
  "Ï2Find a previously selected window whose flavor includes flavor. 
 If current-window is specified that window will be skipped over. 
 If filter function is supplied, it should be a function with one argument
 (a window). This allows testing of the window for meeting other criteria.Ï*"
  ;Ï1; TAC 08-18-89 - this is an extension of of system function called find-window-of-flavorÏ*
  (DOTIMES (window-index (ARRAY-TOTAL-SIZE previously-selected-windows))
    (LET ((w (AREF previously-selected-windows window-index)))
      (WHEN (and w (or (not (mac-system-p))
		       (OR (NULL selected-window)
			   (EQ (sheet-get-screen w)
			       (sheet-get-screen selected-window))))
              (IF filter-function (FUNCALL  filter-function w) t))
        ;Ï1; We now have a real window.  If W is not a superior of current-window then it is a candidate. Ï*
	(WHEN (and (not (sheet-me-or-my-kid-p current-window w)) 
		   (TYPEP w flavor) 
		   (SEND w :name-for-selection))
          ;Ï1; We now have a better candidate window.  Now we need to check W's selection substitute, Ï*
          ;Ï1; since that will be the window which gets selected.  If W's selection substitute is a superior Ï*
          ;Ï1; of the current window then we skip W and go on to the next window.  Ï*
          (WHEN  (let ((w w))
		   ;Ï1; follow the selection substitute to the end to make sure it is not the current windowÏ*
		   ;Ï1; but be sure and return the original W selection.  PMH 4/6/88Ï*
		   (loop (when (sheet-me-or-my-kid-p current-window (send w :selection-substitute))
			   (return nil))
			 (let ((selection-substitute (sheet-selection-substitute w)))
			   (if selection-substitute
			       (setf w selection-substitute)
			       (return T)))))
             (RETURN w)))
        ;Ï1; W was not of the proper flavor.  So let's go to W's selection substitute.  If W's selection substitute is Ï*
        ;Ï1; a superior of the current window then we skip W and go on to the next window.  If it isn'tÏ*
        ;Ï1; then we see if it is of the right flavor and has a name.  If so, we have a proper window which is not current window.Ï*
	(LET ((wss (SEND w :selection-substitute)))
	  (AND wss (not (sheet-me-or-my-kid-p current-window wss)) 
	       (TYPEP wss flavor) 
	       (SEND wss :name-for-selection)
               (RETURN wss)))))))

(DEFUN Ï4find-or-create-windowÏ* (flavor &optional current-window filter-function)
  (LET ((iwin (OR (locate-a-window flavor current-window filter-function) 
		  (make-window flavor))))
    (SEND iwin ':mouse-select)
    iwin))

;Ï1; This is the top-level function for Inspectors with processesÏ*
;Ï1; (the kind you get if you just say (MAKE-WINDOW 'INSPECT-FRAME)).Ï*
(DEFUN Ï4inspect-top-levelÏ* (frame)
  (LET ((inspect*-quit nil)
	(= 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 inspect*-quit = *print-pretty*))
  (LOOP
   (ERROR-RESTART ((abort error) "Ï3Return to Inspector command level.Ï*")
                  (inspect-command-loop frame))
   (deselect-and-maybe-bury-window frame :first))))

;Ï1 TAC 08-04-89 - new version is in GENERAL-INSPECTORÏ*
;Ï1(DEFUN INSPECT-SET-SLOT (SLOT *TERMINAL-IO* HISTORY INSPECTORS)Ï*

(DEFUN Ï4inspect-modify-objectÏ* (*terminal-io* history &optional (inspectors nil) &aux thing osit)	
  "Ï2Handle the menu's MODIFY command.
   Lets user pick a slot with the mouse, then does INSPECT-SET-SLOT.Ï*"
  (SETQ osit (SEND history :sensitive-item-types))
  (UNWIND-PROTECT (PROGN
                   (SEND history :set-sensitive-item-types nil)
                   (DOLIST (i inspectors)
                     (SEND i :set-modify-mode t))
                   (SEND history :set-modify-mode t)
                   (SEND *terminal-io* :clear-screen)
                   (FORMAT *terminal-io* "Ï3~&With the mouse, pick a slot to modify.~%Ï*")
                   (SETQ thing (w:read-list *terminal-io*)))
                  (SEND history :set-sensitive-item-types osit)
    (DOLIST (i inspectors)
      (SEND i :set-modify-mode nil))
    (SEND history :set-modify-mode nil))
  (LET ((set-function (GET (FIRST thing) 'set-function)))
    (IF (CHAR-EQUAL (FOURTH thing) #\Mouse-3-1)
	(FORMAT *terminal-io* "Ï3~&Aborted.~%Ï*")
        (IF (OR (NULL (FIRST thing)) (NULL set-function))
            (PROGN
              (BEEP)
              (FORMAT *terminal-io* "Ï3~&Cannot modify this component.~%Aborted.~%Ï*"))
            (inspect-set-slot thing *terminal-io* history inspectors))))) 

(DEFUN Ï4inspect-flush-from-historyÏ* (thing history)
  "Ï2Remove object THING from the history.  HISTORY should be the INSPECT-HISTORY-WINDOW.Ï*"
  (LET ((items (SEND history :items)))
    (DOTIMES (i (ARRAY-ACTIVE-LENGTH items))
      (AND (EQ thing (AREF items i)) (RETURN (SEND history :delete-item i)))))) 

(DEFUN Ï4inspect-real-valueÏ* (slot &aux fun)
  "Ï2Return the current contents of SLOT, a blip made by clicking on a mouse-sensitive item.Ï*"
  (IF (SETQ fun (GET (FIRST slot) 'value-function)) 
      (FUNCALL fun slot)
      (CASE (FIRST slot)
        ((:value :line-area 1d-array-slot leader-slot) (SECOND slot))
        (:locative (CDR (SECOND slot)))
        (:list-structure-top-level (FUNCALL (THIRD slot) :current-object))
        (:list-structure (CDR (FIRST (SECOND slot))))
        (otherwise (THIRD (SECOND slot)))))) 

;Ï1***************Ï*
;Ï1 TAC 08-01-89 - this is being redefined by code in DEVELOPMENT-TOOLS-CONSISTENCY-ENHANCEMENTSÏ*
;Ï1(DEFUN INSPECT-GET-VALUE-FROM-USER (*TERMINAL-IO* HISTORY INSPECTORS)Ï*	

(DEFUN Ï4inspect-find-functionÏ* (thing)
  "Ï2Given any object THING, return its \"function definition\", or anything like one.Ï*"
  (DO ()
      (nil)
    (SETQ thing
	  (TYPECASE thing
	    (symbol (IF (FBOUNDP thing) (SYMBOL-FUNCTION thing) (RETURN thing)))
	    (instance (si::instance-function thing))
	    (CLOSURE (CLOSURE-FUNCTION thing))
	    (CONS (IF (AND (validate-function-spec thing) (FDEFINEDP thing)) (FDEFINITION thing)
		      (RETURN thing)))
	    (t (RETURN thing))))))

;Ï1; Resource for process-less Inspectors.Ï*
(DEFWINDOW-RESOURCE Ï4inspect-frame-resourceÏ* nil :make-window
                    (inspect-frame :process nil :label "Ï3fooÏ*") :reusable-when :deactivated)

