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

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



;Ï1;; Record of changes:Ï*
;Ï1;; 7/12/88 clm - made changes to prevent entering debugger when encountering Ï*
;Ï1;;               undefined flavors (spr 8232); changes submitted by R.Acuff.Ï*
;Ï1;; 7/13/88 clm - the function SYMBOL-STRING-LENGTH did not always calculate theÏ*
;Ï1;;               PACKAGE correctly; DEFF'd it to use the FORMAT:FLATSIZE functionÏ*
;Ï1;;               instead.Ï*
;Ï1;; 7/14/88 clm - modified to include DEBUG command; implementation provided by Ï*
;Ï1;;               R. Acuff.Ï*
;Ï1;; 4/10/89 jlm - modified method (SHOW-MISCELLANEOUS-DATA :GENERATE-ITEM) to use FLAVOR-DEFINITION-PACKAGEÏ*
;Ï1;;Ï*		Ï1  Instead of FLAVOR-PACKAGEÏ*
;Ï1;; 6/15/89  tac - removed call to compiler:disassemble-current-flavor in SEARCH-POINTER function.Ï*
 
#|
Ï3This file contains a prototype Flavor Inspector.   Load this and press SYSTEM O.
This code was handed off to DSG to refine and add to the Explorer system.
Much of the documentation in the rest of this file is addressed primarily towards
my DSG contact.  --HoggeÏ*
|#

;Ï1(FORMAT T "~%Loading the Flavor Inspector.  When this finishes loading, press SYSTEM O.~%")Ï*

#|
			Ï3     Things to do

Important ones are starred

- starring of method combination type is buggy: method combination not stored always in flavor's method table.

- Like INSPECT function, FLAVOR-INSPECT (thing).

-* Please read any big-bold-faced comments I've made throughout the file.

-Who-Line in inspect panes sometimes give the standard inspector message --right click finds function definition, etc.

-* Show-All-Methods and SHow-All-Methods-Sorted need some work.  Don't assume that inherited primary methods
 which the main flavor has a definition for are shadowed by the main flavor's method.  The shadowing depends
 on the type of method combination.  For instance, with :OR combination, no primary methods are shadowed (all
 of them are used in the combined method).  Speaking of method combination, there's a bug in the flagging of
 special method combination types.  I had assumed that flavor method table entries are of the form
   (<method spec> <combination type> <order> ...)
 but really <combination type> is often NIL, even though an inherited method sets the combination type to
 :OR or something like that.  So for each displayed method, you need to search the flavor components and
 see what the combination type is.  You will be able to use DEBUGGING-INFO on the :COMBINED method spec to
 get at this quickly.

-* typing of method specs should possibly be reworked to behave differently.  Right now it expects a legal
 method spec to inspect the "method details" of.  For instance,  you could type 
   UCL:BAIX-COMMAND-LOOP :CASE :SET :ACTIVE-COMMAND-TABLES
 and get info on that method.  Instead of this, perhaps we should just accept expressions of the form
   <flavor-name> <message>
 and do the "show-message-handlers" on it.  This would speed up completion and might be more what the
 user really wants to see.

-* review on-line doc--make sure terms are consistent (i.e. handler (vs. operations ???) vs. method vs. daemom).

-Make sure I've got rid of all crashing problems.  Traditionally it seems like it was
 crashing on basic input operations (:ANY-TYI), but perhaps there is no real problem and
 I was just being faked out crashes caused in other parts of the code, that I've now fixed.

-Make sure interpreted methods are ok on all commands.

-Fix all commands to do reasonable things on inspected flavors whose components aren't defined yet.
 For example, try inspecting this flavor: (DEFFLAVOR foo () (undefined-flavor)).

b- Perhaps improve how show-message-handlers displays the structure of a combined method.  All it does now is give
 the handlers a roughly correct order; doesn't show imbedding on :WRAPPERS and :AROUNDS well.
 Fix it to show the right order for given special method combination styles, and for :BASE-FLAVOR-FIRST ordering.

b- See comment in (show-dependent-flavors :generate-item)--compiler problem?

e-on-line doc should explain all properties in flavor-plist, for show-misc-info.

e-Some search commands like
  -method apropos. Get flavor name, inspect all methods matching a substring.
  -flavor apropos.  Inspect all flavors having some property, such as instance var or method (difficult).

e- Other commands which should be implemented:
 -Display in Tree form for some of the outputs     ***I think this would be very important!!!***
 -Debug Flavor (prints all possible sources of errors in flavor, such as method 
  redefinitions, duplicate instance variable entries (both in the same or different 
  packages), shadowed methods, etc.
 -Who-Calls on method names (with disclaimer about what it outputs).



e-Add the means to easily inspect multiple lines of text, instead of just one line.
 This would be useful in designing special purpose inspectors and could also be used in
 the display of method documentations strings.

i-TV:INSPECT-FRAME is now a much more general beast; applications can use it as a mixin to design
 custom inspectors.  Perhaps it, TV:INSPECTION-DATA, ALLOCATE-DATA, etc. should be documented
 in the window system manual.

i-Recommend implementing meta-< and meta-> for inspectors.
 Recommend converting c-v and m-v to accept the ucl numeric argument and
 skip UCL:NUMERIC-ARG pages.Ï*

|#

(DEFPARAMETER Ï4*flavor-inspector-configuration*Ï* :three-panes
"Ï2Default configuration for the Flavor-InspectorÏ*")
 
(EVAL-WHEN (COMPILE eval load)

;Ï1; Help function for WITH-RECURSION.  Ironic, isn't it?Ï*
(DEFUN Ï4replace-recurse-callsÏ* (form)
  (WHEN (CONSP form)
    (COND ((OR (EQ (CAR form) 'recurse)
	       (EQ (CAR form) 'recurse-apply))
	   (SETF (CAR form) '.with-recursion.))
	  ((CONSP (CAR form))
	   (replace-recurse-calls (CAR form))))
    (replace-recurse-calls (CDR form)))
  form))

;Ï1;;  With-Recursion provides the means of putting recursive operations \"in line\".Ï*
;Ï1;;  Instead of having to write a recursive function and make an initial call toÏ*
;Ï1;;  it from some body of code, this macro allows you to specify implicitly a recursiveÏ*
;Ï1;;  function and an initial call.  Ï*
;Ï1;;Ï*
;Ï1;; Arguments:Ï*
;Ï1;;  LAMBDA-LIST specifies the arguments to the recursive function which WITH-RECURSIONÏ*
;Ï1;;  builds.  There are no restrictions on this lambda list.Ï*
;Ï1;;Ï*
;Ï1;;  ARGS-FOR-FIRST-CALL specifies the initial arguments to use in FUNCALLing the recursiveÏ*
;Ï1;;  function.  As with any FUNCALL, they will get evaluated.Ï*
;Ï1;;Ï*
;Ï1;;  BODY is a set of forms used as the body of the recusive function.Ï*
;Ï1;;  Two special forms may be used anywhere in BODY: RECURSE and RECURSE-APPLY.Ï*
;Ï1;;  RECURSE is synonymous with FUNCALL, RECURSE-APPLY is synonymous with APPLY.Ï*
;Ï1;;  They may be used to specify recursive FUNCALLs and APPLYs to the recursive function.Ï*
;Ï1;;  Both take arguments and expand into FUNCALLs and APPLYs, respectively.Ï*
;Ï1;;  If you don't use them in BODY, there's no need to use WITH-RECURSION at all, since theyÏ*
;Ï1;;  provide the only means to recurse.Ï*
;Ï1;;Ï*
;Ï1;; Advantages: Ï*
;Ï1;;  -- Readability.  In some cases you want the recursive code to appear where itÏ*
;Ï1;;     is first called, to better show path of execution.  If you have to mode theÏ*
;Ï1;;     body off to a small help function, JUST because the body is executed recursively,Ï*
;Ï1;;     your code may become hard to read.  Top-Down-Design purists might scoff, butÏ*
;Ï1;;     remember that iterative constructs don't have to be written as help functions. Ï*
;Ï1;;     Why should recursive structures?  If you are only going to use the recursive bodyÏ*
;Ï1;;     once, why shouldn't it be in-line?Ï*
;Ï1;;  --Execution speed.  The BODY argument can reference variables locally bound in codeÏ*
;Ï1;;     surrounding the macro.  The alternative is to use special bindings, which is less efficient.Ï*
;Ï1;;Ï*
;Ï1;; Disadvantages:Ï*
;Ï1;;  -- Reusability.  Whenever you DON'T write a help function to handle some task and insteadÏ*
;Ï1;;     handle the task in-line, you prevent other code from making use of the task handler.Ï*
;Ï1;;     This isn't anything peculiar about WITH-RECURSION, of course.Ï*
;Ï1;;Ï*
;Ï1;;  Example: a simple recursive print of the elements of a list.Ï*
;Ï1;;  (WITH-RECURSION ((x) '(1 2 3))Ï*
;Ï1;;    (WHEN x Ï*
;Ï1;;      (PRINT (CAR x))Ï*
;Ï1;;      (RECURSE (CDR x))))Ï*

(DEFMACRO Ï4with-recursionÏ* ((lambda-list . args-for-first-call) &body body)
  "Ï2With-Recursion provides the means of putting recursive operations \"in line\".
 LAMBDA-LIST specifies the arguments to the recursive function which WITH-RECURSION
 builds.  There are no restrictions on this lambda list. ARGS-FOR-FIRST-CALL specifies the
 initial arguments to use in FUNCALLing the recursive function. They will get evaluated. BODY
 is a set of forms used as the body of the recusive function. Two special forms may be used
 anywhere in BODY: RECURSE and RECURSE-APPLY. RECURSE is synonymous with FUNCALL,
 RECURSE-APPLY is synonymous with APPLY.
 Example: a simple recursive print of the elements of a list.
 (WITH-RECURSION ((x) '(1 2 3))
    (WHEN x 
      (PRINT (CAR x))
      (RECURSE (CDR x))))Ï*"
  `(LABELS ((.with-recursion. ,lambda-list . ,(replace-recurse-calls body)))
     (.with-recursion. . ,args-for-first-call)))

;Ï1; These first three are just some accessor functions.  JPR put them in SI since that's where flavors live.Ï*
;Ï1; Ï*TAC 09-02-89Ï1 - David Gray suggests they should stay in TV package.Ï*

;Ï1; Return the message in METHOD-SPEC.Ï*
(DEFUN Ï4messageÏ* (method-spec)
  (IF (FIFTH method-spec)
      (FOURTH method-spec)
      (CAR (LAST method-spec))))

;Ï1; Return the method type in METHOD-SPEC if there is one, else return NIL.Ï*
;Ï1; Example method types: :AFTER, :BEFORE, :CASE, :AROUND, :WRAPPER, :OR, :AND...Ï*
(DEFUN Ï4method-typeÏ* (method-spec)
  (WHEN (FOURTH method-spec)
    (THIRD method-spec)))

;Ï1; Return the submessage in METHOD-SPEC if there is one.Ï*
;Ï1; Example: :INSPECTORS in (:METHOD TV:FLAVOR-INSPECTOR :CASE :SET :INSPECTORS).Ï*
(DEFUN Ï4submessageÏ* (method-spec)
  (FIFTH method-spec))

;Ï1; Use of these globals avoids some excess consing.Ï*
(DEFPARAMETER Ï4*blank-line-item*Ï* '(""))
(DEFPARAMETER Ï4*one-space-item*Ï* "Ï3 Ï*")
(DEFPARAMETER Ï4*no-items*Ï* '(((:font 2 "Ï3 noneÏ*"))))

#|
Ï3The following is a series of flavors which make up the main smarts of the flavor inspector.
Each flavor is used to represent and provide operations on a particular kind of flavor
information.  The main smarts reside in each flavor's :GENERATE-ITEM method, which
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.
See documentation on flavor TV:INSPECTION-DATA for details of how these flavors work.Ï*
|#

(DEFFLAVOR Ï4flavor-operation-mixinÏ* () (inspection-data))

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

;Ï1; 01/06/89 clm added eval-when - need to combine the following three formsÏ*
(EVAL-WHEN (LOAD compile)
(DEFPARAMETER Ï4*flavor-options-menu*Ï*
   '(("Ï3Instance VariablesÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-instance-variables *flavor-data*)
      :documentation "Ï3Inspect all instance variables of this flavorÏ*")
     ("" :no-select t)
     ("Ï3Local MethodsÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-local-methods *flavor-data*)
      :documentation "Ï3Inspect methods defined locally for this flavorÏ*")
     ("Ï3All MethodsÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-all-methods *flavor-data*)
      :documentation "Ï3Inspect methods defined for and inherited by this flavorÏ*")
     ("Ï3All Methods, SortedÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-all-methods-sorted *flavor-data*)
      :documentation "Ï3Sorted version of the \" ALL METHODS\" optionÏ*")
     ("Ï3All Handled MessagesÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-all-handled-messages *flavor-data*)
      :documentation "Ï3Inspect all messages handled by this flavor.Ï*")
     ("" :no-select t)
     ;Ï1; This needs better who-line doc.  How it differs from Show Flavor.Ï*
     ("Ï3Component FlavorsÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-component-flavors *flavor-data*)
      :documentation "Ï3Inspect flavors which make up this flavor (non-heirarchical display).Ï*")
     ("Ï3Dependent FlavorsÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-dependent-flavors *flavor-data*)
      :documentation "Ï3Inspect flavors which directly or indirectly depend on this flavorÏ*")
     ("" :no-select t)
     ("Ï3Miscellaneous DataÏ*"
      :eval (SEND ucl::this-application :inspect-thing 'show-miscellaneous-data *flavor-data*)
      :documentation "Ï3Display miscellaneous data on this flavorÏ*")
     ("Ï3EditÏ*"
      :eval (SETQ call-edit t)   ;Ï1;;(ed (si:flavor-name *flavor-data*))Ï*
      :documentation "Ï3Edit this flavor in a Zmacs buffer.Ï*")))
;Ï1     ("Debug"Ï*
;Ï1      :EVAL (BEEP)Ï*
;Ï1      :DOCUMENTATION "Find inconsistencies and dangerous characteristics of this flavor"))) Ï*
)

;Ï1; 7/15/88 clm - adding implementation of DEBUG command into flavor inspectorÏ*
;Ï1; 9/19/88 clm - wrapped the eval-when around the form.Ï*
(EVAL-WHEN (LOAD compile)
(DEFPARAMETER Ï4*flavor-options-menu-addition*Ï*
	      '("Ï2DebugÏ*"
		:eval (SEND ucl:this-application :inspect-thing 'debug-flavor *flavor-data*)
		:documentation "Ï3Find inconsistencies and dangerous characteristics of this flavor (can be slow)Ï*"))  
)

(EVAL-WHEN (LOAD compile)
  (IF (NOT (MEMBER *flavor-options-menu-addition* *flavor-options-menu* :test #'EQUALP))
      (SETQ *flavor-options-menu*
	    (APPEND *flavor-options-menu* (LIST *flavor-options-menu-addition*))))  
)

;Ï1; Handles mouse clicks on the mouse-sensitive item which represents the inspection-data.  ForÏ*
;Ï1; example, each piece of flavor info gets a mouse sensitive item in the inspection history.Ï*
;Ï1; Some flavor infos such as SHOW-FLAVOR get mouse sensitive items placed in inspection panes,Ï*
;Ï1; as part of other flavor info displays.  For instance, the SHOW-DEPENDENT-FLAVORS displayÏ*
;Ï1; contains lots of mouse sensitive SHOW-FLAVOR items.Ï*
(DEFMETHOD Ï4(flavor-operation-mixin :handle-mouse-clickÏ*) (blip flavor-inspector)
  (SELECTOR (FOURTH blip) =
    (#\Mouse-l-1 (SEND flavor-inspector :inspect-info-left-click))
    (#\Mouse-m-1 (SEND flavor-inspector :inspect-info-middle-click))
    (#\Mouse-r-1 (LET ((*flavor-data* data) (call-edit nil))
                   (DECLARE (SPECIAL *flavor-data* call-edit))
                   (w:menu-choose *flavor-options-menu*
                                          :label (FORMAT nil "Ï3Operations on ~SÏ*" (si::flavor-name data))
                                          :scrolling-p nil)
		   (IF call-edit
		       (ED (si::flavor-name *flavor-data*)))
		   ))
    (t
     (BEEP))))

(DEFFLAVOR Ï4show-flavorÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-flavor :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~sÏ*" (si::flavor-name data)))

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

(DEFMETHOD Ï4(show-flavor :generate-itemÏ*) ()
  (LET* ((flavor-name (si::flavor-name data))
	 (all-components (flavor-components flavor-name))
	 text-items
	 redundant-included-flavor?
	 redundant-mixin-flavor?)
    (DECLARE (SPECIAL redundant-included-flavor? redundant-mixin-flavor?))
    (SETQ text-items (collect-dependent-flavors flavor-name 1 all-components all-components))
    (VALUES
     `(,*blank-line-item*
       ((:font 1 "Ï3Flavor Ï*")
        (:item1 instance ,(allocate-data 'show-flavor data))
	(:font 1 "Ï3's component flavors.Ï*")
	,@(WHEN redundant-mixin-flavor?
	    '((:font 2 "Ï3  *Ï*")
              (:font 1 "Ï3 = redundant mixin  Ï*")))
	,@(WHEN redundant-included-flavor?
	    '((:font 2 "Ï3  **Ï*")
              (:font 1 "Ï3 = redundant included flavorÏ*"))))
       ,*blank-line-item*
	;Ï1; For each component method, a mouse sensitive method name (METHOD-NAME).Ï*
       ,@(OR text-items *no-items*))
     ;Ï1; Make the label display the flavor name.Ï*
     `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~sÏ*" flavor-name)))))  

(DEFFLAVOR Ï4show-undefined-flavorÏ* ()
	   (flavor-operation-mixin)
  (:documentation :special-purpose
		  "Ï3This flavor is like show-flavor only it is used to display undefined flavors.
   The value of the data field is the name of the undefined flavor.Ï*"))
      
(DEFMETHOD Ï4(show-undefined-flavor :aux-dataÏ*) ()
"Ï2Defined so that * gets set suitably.Ï*"
  data)
      
(DEFMETHOD Ï4(show-undefined-flavor :format-conciselyÏ*) (STREAM)
"Ï2Prints an undefined flavor simply.Ï*"
  (FORMAT stream "Ï3~s (Undefined)Ï*" data))
      
(DEFMETHOD Ï4(show-undefined-flavor :generate-itemÏ*) ()
  "Ï2Displays an undefined flavor in all its glory.Ï*"
  (allocate-data 'show-undefined-flavor data)
  (VALUES
    `(,*blank-line-item*
      ((:font 1 ,(SYMBOL-NAME data))
       (:font 3 "Ï3 (Undefined)Ï*")
       )) 
    ;Ï1;Make the label display the flavor name.Ï*
    `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~sÏ*" data))))
      
(DEFMETHOD Ï4(show-undefined-flavor :who-line-docÏ*) (inspection-pane? &optional no-sensitive-item?)
  (COND
    (no-sensitive-item?
     `(:mouse-l-1 "Ï3Inspect this flavorÏ*"
		  :mouse-r-1 ""))
    (inspection-pane?
     '(:mouse-l-1 "Ï3Inspect this flavorÏ*"
		  :mouse-m-1 "Ï3Inspect this flavor and display this pane's contents in middle paneÏ*" 
		  :mouse-r-1 ""))
    (t
     '(:mouse-l-1 "Ï3Inspect this flavorÏ*"
		  :mouse-m-1 "Ï3Inspect this flavorÏ*"
		  :mouse-r-1 ""))))
      
(DEFMETHOD Ï4(show-undefined-flavor :handle-mouse-clickÏ*) (blip flavor-inspector)
  "Ï2A dummy mouse handler for undefined flavors.Ï*"
  (SELECTOR (FOURTH blip) =
    (#\Mouse-l-1
     (SEND flavor-inspector :inspect-info-left-click))
    (#\Mouse-m-1
     (SEND flavor-inspector :inspect-info-middle-click))
    (t
     (BEEP))))

(DEFUN Ï4flavor-componentsÏ* (flavor-name &optional (top-level? t))
  "Ï2Returns a list (<flavor name> <included flavors> <component flavors>)
 where <flavor name> is argument FLAVOR-NAME,
 <included flavors> is a list of entries representing FLAVOR-NAME's included flavors, and
 <component flavors> is a list of entries representing FLAVOR-NAME's mixins.
 Entries in <included flavors> and <component flavors> are of the same form as the value
 we are returning; in otherwords, we are returning a recursive data structure.Ï*"
  (LET* ((flavor (GET flavor-name 'si::flavor))
	 ;Ï1; 7/12/88 clm - do not enter debugger if flavor undefinedÏ*
	 (result (IF flavor
		     `(,flavor-name
		       ,(LOOP for included in (si::flavor-includes flavor)
			      collect (flavor-components included nil))
		       ,(LOOP for component in (si::flavor-depends-on flavor)
			      collect (flavor-components component nil)))
		     (LIST flavor-name))))
    ;Ï1; Add on vanilla flavor at end of top-level flavor, unless it's an abstract flavor.Ï*
    (WHEN (AND top-level? (NOT (si::flavor-get flavor :no-vanilla-flavor)))
      (SETF (THIRD result) (NCONC (THIRD result) '((si:vanilla-flavor nil nil)))))
    result))

;Ï1; Use of these helps save some memory.Ï*
(DEFPARAMETER Ï4*space-format*Ï* "Ï3~v@tÏ*") 
(DEFPARAMETER Ï4*space-format-2*Ï* "Ï3~v@t Ï*") 

;Ï1; Returns a list of text scroll window items which describe in detail FLAVOR-NAME'sÏ*
;Ï1; makeup, including its mixins, its mixins mixins, and any included flavors.  Any mixins orÏ*
;Ï1; included flavors which occur redundantly are flagged as such.Ï*
;Ï1; Also sets two specials (redundant-included-flavor? and redundant-mixin-flavor? to non-nil ifÏ*
;Ï1; at least one redundant included flavor or one mixin flavor was encountered, respectively.Ï*
;Ï1; PRINT-LEVEL determines indentation level for text scroll window items. Ï*
;Ï1; ALL-COMPONENTS is the structure of FLAVOR-NAME returned by FLAVOR-COMPONENTS.Ï*
;Ï1; POINTER is a pointer into ALL-COMPONENTS, indicating the particular entry we are generating text scroll window items for.Ï*
;Ï1; We do our work by calling ourself recursively; in such calls, ALL-COMPONENTS never changes, while POINTER moves about inÏ*
;Ï1; ALL-COMPONENTS.Ï*
(DEFUN Ï4collect-dependent-flavorsÏ* (flavor-name print-level all-components pointer)
  ;Ï1; 7/12/88 clm - whenever a component is allocated it is done so as a show-flavor if the flavor is defined,Ï*
  ;Ï1; and a show-undefined-flavor if it is not.Ï*
  (DECLARE (SPECIAL redundant-included-flavor? redundant-mixin-flavor?))
  (LET* ((flavor (GET flavor-name 'si::flavor)))
    `(,@(LOOP for included-entry in (SECOND pointer)
	      for included = (CAR included-entry)
	      collect
	      ;Ï1;If this entry is the last included flavor and is not a mixin...Ï*
	      (IF (AND (EQ included-entry (last-included-occurance included all-components))
			;Ï1;We use this to try to find ANY mixin occurance; Ï*
		       (NOT (first-mixin-occurance included all-components))) 
		  `((,*space-format* ,print-level)
		    (:item1 instance ,(IF (GET included 'si::flavor)
					  (allocate-data 'show-flavor (GET included 'si::flavor))
					  (allocate-data 'show-undefined-flavor included)))
		    (:font 1 "Ï3 (included flavor of Ï*")
		    (:item1 instance ,(IF flavor
					  (allocate-data 'show-flavor flavor)
					  (allocate-data 'show-undefined-flavor flavor-name)))
		    (:font 1 "Ï3)Ï*"))
		(SETQ redundant-included-flavor? t)
		`((,*space-format* ,print-level)
		  (:item1 instance ,(IF (GET included 'si::flavor)
					(allocate-data 'show-flavor (GET included 'si::flavor))
					(allocate-data 'show-undefined-flavor included)))
		  (:font 2 "Ï3**Ï*")
		  (:font 1 "Ï3 (included flavor of Ï*")
		  (:item1 instance ,(IF flavor
					(allocate-data 'show-flavor flavor)
					(allocate-data 'show-undefined-flavor flavor-name)))
		  (:font 1 "Ï3)Ï*")))
	      append (collect-dependent-flavors included (+ 2 print-level) all-components included-entry))
      . ,(LOOP for mixin-entry in (THIRD pointer)
	      for mixin = (CAR mixin-entry)
	      collect
	       ;Ï1;If this entry is the first mixin...Ï*
	      (IF (EQ mixin-entry (first-mixin-occurance mixin all-components))
		  `((,*space-format* ,print-level)
		    (:item1 instance ,(IF (GET mixin 'si::flavor)
					  (allocate-data 'show-flavor (GET mixin 'si::flavor))
					  (allocate-data 'show-undefined-flavor mixin))))
		  ;Ï1; elseÏ*
		  (SETQ redundant-mixin-flavor? t)
		  `((,*space-format* ,print-level)
		    (:item1 instance ,(IF (GET mixin 'si::flavor)
					  (allocate-data 'show-flavor (GET mixin 'si::flavor))
					  (allocate-data 'show-undefined-flavor mixin)))
		    (:font 2 "Ï3*Ï*")))
	      append (collect-dependent-flavors mixin (+ 2 print-level) all-components mixin-entry))))) 

(DEFUN Ï4map-with-argsÏ* (some-function over-a-list &rest other-arguments)
"Ï2This function is much like mapcar only more useful.  It takes a function and a 
 list to map the function over and an &Rest arguments feature.  It applies the   
 function to each element in the list, with the element being the first
 argument and any subsequent arguments being taken from the &Rest paremeter. 
 The value of a call to this function is a list of values from this function
 call, one element for each element in the source list.Ï*"  
  (LOOP for element in over-a-list
	collect (APPLY some-function element other-arguments)))

(DEFUN Ï4uniqueiseÏ* (LIST)
"Ï2Takes a list and returns a list which has no duplicates.Ï*"
  (LET ((temp-list list))
       (LOOP for element in temp-list
	     do (SETQ temp-list (REST temp-list))
	     when (NOT (MEMBER element temp-list :test #'EQUALP))
	     collect element into result
	     finally (RETURN result))))

(DEFUN Ï4get-local-defined-componentsÏ* (flavor)
"Ï2Given a flavor structure it returns a list of the flavor structures that
represent its defined local components and locally defined included flavors.Ï*"
  (LET ((local-components (APPEND (si::flavor-depends-on flavor) (si::flavor-includes flavor))))
       (LET ((defined-components (DELETE nil (map-with-args #'GET local-components 'si::flavor))))
	    (VALUES local-components defined-components))))

(DEFUN Ï4get-flavor-depends-on-allÏ* (flavor)
"Ï2Given a flavor structure it returns a list of all of the names of defined
components of that flavor, including itself.Ï*"
  (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
    (IGNORE local-components)
    (CONS (si::flavor-name flavor)
	  (uniqueise (APPEND (MAPCAR #'si::flavor-name defined-components)
			     (APPLY #'APPEND (MAPCAR #'get-flavor-depends-on-all defined-components)))))))

(DEFUN Ï4get-flavor-depends-on-all-even-undefinedÏ* (flavor)
"Ï2Given a flavor structure it returns a list of all of the names of all of the
components of that flavor, including itself, whether defined or not.Ï*"
  (MULTIPLE-VALUE-BIND (local-components defined-components)
      (get-local-defined-components flavor)
    (CONS (si::flavor-name flavor)
	  (uniqueise (APPEND local-components
			     (APPLY #'APPEND
				    (MAPCAR #'get-flavor-depends-on-all-even-undefined defined-components))
			     )))))

(DEFUN Ï4get-all-componentsÏ* (flavor)
  "Ï2Given a flavor structure it returns a list of the flavor structures of
 all of the defined components of that flavor, excluding itself.Ï*"
  (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
    (IGNORE local-components)
    (APPEND defined-components (APPLY #'APPEND (MAPCAR #'get-all-components defined-components)))))

(DEFUN Ï4first-mixin-occuranceÏ* (mixin remaining-components)
  (DOLIST (mixin-entry (THIRD remaining-components))
    ;Ï1; First check a mixin.Ï*
    (IF (EQ mixin (CAR mixin-entry))
	(RETURN mixin-entry))
    ;Ï1; Then check the mixin's mixins.Ï*
    (LET ((found (first-mixin-occurance mixin mixin-entry)))
      (IF found
	  (RETURN found)))))

(DEFUN Ï4last-included-occuranceÏ* (included remaining-components &optional last-encountered)
  ;Ï1; First search the included flavors, in the CADR of REMAINING-COMPONENTS.Ï*
  (DOLIST (included-entry (SECOND remaining-components))
    ;Ï1; First check an included flavor.Ï*
    (IF (EQ included (CAR included-entry))
	(SETQ last-encountered included-entry))
    ;Ï1; Then check the included flavor's mixins' included flavors and mixins.Ï*
    (LET ((found (last-included-occurance included included-entry last-encountered)))
      (IF found
	  (SETQ last-encountered found))))
  ;Ï1; Then check the mixin flavors, in the CADDR of REMAINING-COMPONENTS.Ï*
  (DOLIST (mixin-entry (THIRD remaining-components))
    (LET ((found (last-included-occurance included mixin-entry last-encountered)))
      (IF found
	  (SETQ last-encountered found))))
  last-encountered)

(DEFMETHOD Ï4(show-flavor :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying a heirarchy of flavors which
make up flavor ~s.  Indentation is used to show the origin of each component
flavor.  Flavors displayed along the left margin are \"direct components\" of flavor ~s.
That is, they appear in the component flavors list of the DEFFLAVOR for ~s.  Flavors
indented further from the left margin are \"indirect components\" of ~s, inherited from
its direct components.

Special cases:
  1. Often a flavor will have two or more components which all supply some flavor as an
     inherited component.  In these cases, the redundant component flavors are flagged
     in the displayed heirarchy with an asterisk (*) next to the flavor name.

  2. Often component flavors define an \"included flavor\" which is added to the
     main flavor (in this case, ~s) if the main flavor is not otherwise going to 
     receive it as either a direct or indirect component.  Such included flavors are
     flagged in the displayed heirarchy with a note to the right of the flavor name.
     In addition, if ~s does receive the included flavor as a direct or indirect
     component, the included flavor is flagged with a double asterisk (**).
     For example, if flavor FOO includes BAR and BAR is flagged with **, the main
     flavor did not receive BAR from flavor FOO.Ï*"
	    flavor-name flavor-name  flavor-name flavor-name  flavor-name flavor-name)))

(DEFFLAVOR Ï4show-component-flavorsÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-component-flavors :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's component flavorsÏ*" (si::flavor-name data)))

;Ï1; This differs from SHOW-FLAVOR's in that it just displays a flat list of the component flavors.Ï*
;Ï1; Included and redundant flavors are not tagged.  Doesn't show the flavor heirarchy--just the result.Ï*
;Ï1; This is easier to read, but less informational.Ï*
(DEFMETHOD Ï4(show-component-flavors :generate-itemÏ*) ()
  ;Ï1; 7/121/88 clm - prevent entering debugger if flavor undefinedÏ*
;Ï1  (UNLESS (SI:FLAVOR-DEPENDS-ON-ALL data)Ï*
;Ï1    (SI:COMPOSE-FLAVOR-COMBINATION data))Ï*
  (LET* ((flavor-name (si::flavor-name data))
  ;Ï1;Modded here by JPR.Ï*
	 (component-flavors (CDR (get-flavor-depends-on-all-even-undefined data))))
    (VALUES
      `(,*blank-line-item*
	("Ï3Component flavors of flavor Ï*"
	 (:item1 instance ,(allocate-data 'show-flavor data))
	 "Ï3:Ï*")
	,*blank-line-item*
	. ,(OR (LOOP for component in component-flavors
		     ;Ï1;Modded here by JPR.Ï*
		     collect `(,*one-space-item*
			       (:item1 instance ,(IF (GET component 'si::flavor)
			  				       (allocate-data 'show-flavor (GET component 'si::flavor))
			  				       (allocate-data 'show-undefined-flavor component)))))
	       *no-items*))
      `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s's component flavorsÏ*" flavor-name)))))  

(DEFMETHOD Ï4(show-component-flavors :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the
component flavors which make up flavor ~s.  The display does not show the flavor heirarchy;
for a look at the flavor heirarchy, type ~s followed by RETURN, or click L on any 
mouse sensitive display of ~s in the Flavor Inspector.

This display is useful when you are not interested in examining the flavor heirarchy but
are instead interested in seeing the resultant components of a flavor.Ï*"
	    flavor-name flavor-name flavor-name)))

(DEFFLAVOR Ï4show-dependent-flavorsÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-dependent-flavors :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's dependent flavorsÏ*" (si::flavor-name data)))

(DEFMETHOD Ï4(show-dependent-flavors :generate-itemÏ*) ()
  (LET* ((flavor-name (si::flavor-name data)))
    (VALUES
     `(,*blank-line-item*
       ((:font 1 "Ï3Heirarchy of flavors directly or indirectly dependent on flavor Ï*")
	(:item1 instance ,(allocate-data 'show-flavor data))
        "Ï3:Ï*")
       ,*blank-line-item*
;Ï1; I tried to get this OR to work, but ITEMS always returns NIL.  Compiler problem?Ï*
;	Ï1. ,(OR (LET (itemsÏ*
       ,@(LET (items
	       flavors)
	   (with-recursion ((dependent-flavors indentation) (si::flavor-depended-on-by data) 0)
	    (DOLIST (dependent-flavor dependent-flavors)
	      (UNLESS (MEMBER dependent-flavor flavors :test #'EQ)
		(PUSH dependent-flavor flavors)
		(PUSH-END
		 `((,*space-format* ,(1+ (* 2 indentation)))
		   (:item1 instance ,(allocate-data 'show-flavor (GET dependent-flavor 'si::flavor))))
		 items))
	      (recurse (si::flavor-depended-on-by (GET dependent-flavor 'si::flavor)) (1+ indentation))))
	   items))
;Ï1     Ï*	Ï1       *no-items*))Ï*
     `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s's dependent flavorsÏ*" flavor-name))))) 

(DEFMETHOD Ï4(show-dependent-flavors :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying a heirarchy
of flavors which depend on flavor ~s.  Indentation is used to show the origin of each 
dependency.  Flavors displayed along the left margin are \"direct dependents\" of flavor ~s.
That is, ~s appears in the component flavors list of their DEFFLAVORs.  Flavors
indented further from the left margin are \"indirect dependents\" of ~s, inheriting it from
the flavors displayed above and to the left of them.Ï*"
	    flavor-name flavor-name  flavor-name flavor-name)))

(DEFFLAVOR Ï4show-local-methodsÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-local-methods :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's local methodsÏ*" (si::flavor-name data)))

;Ï1;7/13/88 clm for may - the function below did not always calculate the PACKAGE correctly Ï*
;Ï1;  and the commented IF needed to be in there(?); just use FLATSIZE instead.Ï*
(DEFF Ï4symbol-string-lengthÏ* #'format::flatsize)
;Ï1(DEFUN SYMBOL-STRING-LENGTH (SYMBOL)Ï*
;Ï1  "Return the length of the string that would be returned by (FORMAT NIL \"~S\" SYMBOL).Ï*
;Ï1Use of this function keeps you from having to generate such a string, if all you need is the length."Ï*
;Ï1  (+Ï*
;Ï1   (LET ((PKG (SYMBOL-PACKAGE SYMBOL)))Ï*
;Ï1     (CONDÏ*
;Ï1       ((OR (EQ PKG *PACKAGE*) (EQ PKG PKG-GLOBAL-PACKAGE)) 0)Ï*
;Ï1       ((EQ PKG PKG-KEYWORD-PACKAGE) 1)Ï*
;Ï1       (TÏ*
;	Ï1(+Ï*
;	Ï1 (LENGTH (OR (CAR (PACKAGE-NICKNAMES PKG)) (PACKAGE-NAME PKG)))Ï*
;	Ï1 ;;This could be made more efficient by only doing what you need INTERN-SOFT to do.Ï*
;	Ï1; (IF (EQ (NTH-VALUE 1 (FIND-SYMBOL SYMBOL PKG)) :INTERNAL)Ï*
;	Ï1;   2Ï*
;	Ï1   1))))Ï*
;Ï1   (LENGTH (SYMBOL-NAME SYMBOL)))) Ï*

;Ï1; This is used by most of the operations which display methods.Ï*
;Ï1; Loops through methods stored in METHOD-TABLE, collecting text scroll items for each method.Ï*
;Ï1; ENTRY is bound to a method table entry during each iteration.Ï*
;Ï1; METHOD is bound to an element in the CDDDR of ENTRY on each iteration through ENTRY's combined methods.Ï*
;Ï1; PREDICATE can be supplied to control which methods are collected.Ï*
;Ï1; INCLUDE-COMBINED? controls whether or not :COMBINED methods are included.Ï*
;Ï1; WITH-FLAVOR-NAME? controls whether or not to include the flavor name of each method.  On displays where all the methodsÏ*
;Ï1; are from the same flavor, this option is NIL.Ï*
;Ï1; Returns two values: the item list to display and a flag indicating whether or not any of the displayed methodsÏ*
;Ï1; had special method combination types.Ï*
(EVAL-WHEN (COMPILE eval load)
(DEFMACRO Ï4collect-method-itemsÏ* ((entry method method-table) predicate 
				&optional include-combined? with-flavor-name?)
  `(LOOP with .any-special-method-combination?.
	 for ,entry in ,method-table
	 for .methods. = (LOOP for ,method on (REMOVE-IF-NOT 'si::meth-definedp (CDDDR ,entry)) ;Ï1; subsetÏ*
			       ;Ï1; Automatically exluced any :COMBINED methods, since they are generated by the Ï*
			       ;Ï1; flavor system for internal use.Ï*
			       when ,(IF include-combined?
					 predicate
					 `(AND ,predicate (NEQ (THIRD (CAAR ,method)) :combined)))
			       collect ,(IF with-flavor-name?
					    ``((:item1 instance 
						       ,(allocate-data 'show-flavor 
								       (GET (SECOND (CAAR ,method)) 'si::flavor)))
					       (,*space-format*
						,(+ (- 29. (symbol-string-length (SECOND (CAAR ,method))))
						    (- 15. (IF (FOURTH (CAAR ,method))
							       (symbol-string-length (THIRD (CAAR ,method)))
							       0))))
					       (:item1 instance ,(allocate-data 'show-method (CAR ,method))))
					    ``((,*space-format-2*
						,(- 15. (IF (FOURTH (CAAR ,method))
							    (symbol-string-length (THIRD (CAAR ,method)))
							    0)))
					       (:item1 instance ,(allocate-data 'show-method (CAR ,method)))))
			       and do (WHEN (SECOND (CAR ,method))
					(SETQ .any-special-method-combination?. t)))
	 when .methods.
	 append .methods. into .collection.
	 finally (RETURN .collection. .any-special-method-combination?.))))

;Ï1; The fields sizes were generated haphazardly, since we're using a variable width font.Ï*
(DEFPARAMETER Ï4*method-display-columns*Ï*
   `((:font 2 ,(FORMAT nil "Ï3~8@T~10A~33A~10AÏ*" "Ï3TypeÏ*" "Ï3MessageÏ*" "Ï3ArglistÏ*")))) 

(DEFMETHOD Ï4(show-local-methods :generate-itemÏ*) ()
  (LET* ((flavor-name (si::flavor-name data))
	 ;Ï1; Sort for readability.  There might be a better place to do the sort; for instance,Ï*
	 ;Ï1; always maintain a sorted entry for SHOW-METHOD in *INSPECTION-DATA*.Ï*
	 (method-table (SORTCAR (COPY-LIST (si::flavor-method-table data)) #'STRING-LESSP))
	 (get-methods (get-methods data))
	 (set-methods (set-methods data)))
    (MULTIPLE-VALUE-BIND (items special-comb?)
      (collect-method-items (m tpl method-table)
                            (NOT (OR (MEMBER (CAR m) get-methods :test #'EQ)
                                     (MEMBER (CAR m) set-methods :test #'EQ))))
      (VALUES
       `(,*blank-line-item*
	 ((:font 1 "Ï3Methods defined for flavor Ï*")
	  (:item1 instance ,(allocate-data 'show-flavor data))
	  (:font 1 ,(IF special-comb?
		      "Ï3.  * = special method combination typeÏ*"
		      "Ï3:Ï*")))
	  ;Ï1; Collect the methods, excluding any GET and SET methods, which we want to list separately (for readability).Ï*
	 ,@(IF items
	     (CONS *method-display-columns* items)
	     *no-items*)
	  ;Ï1; Separate the display of :GET and :SET methods from the main body of defined methods,Ï*
	  ;Ï1; since most of these are trivial and automatically generated by the flavor system.Ï*
	 ,*blank-line-item*
	 ((:font 1 "Ï3 GET methods for instance variables of flavor Ï*")
	  (:item1 instance ,(allocate-data 'show-flavor data)) (:font 1 "Ï3:Ï*"))
	 ,@(OR
	    (collect-method-items (m tpl method-table) (MEMBER (CAR m) get-methods :test #'EQ))
	    *no-items*)
	 ,*blank-line-item*
	 ((:font 1 "Ï3 SET methods for instance variables of flavor Ï*")
	  (:item1 instance ,(allocate-data 'show-flavor data))
          (:font 1 "Ï3:Ï*"))
	 ,@(OR
	    (collect-method-items (m tpl method-table) (MEMBER (CAR m) set-methods :test #'EQ))
	    *no-items*))
       `(:font fonts:hl12bi :string ,(FORMAT () "Ï3~s's local methodsÏ*" flavor-name)))))) 

(DEFUN Ï4get-methodsÏ* (flavor)
  "Ï2Returns a list of FLAVOR's GET messages.Ï*"
  (LOOP with keyword-package = (SYMBOL-PACKAGE :foo)
	for ivar in (si::flavor-get flavor :gettable-instance-variables)
	collect (INTERN ivar keyword-package)))

(DEFUN Ï4set-methodsÏ* (flavor)
  "Ï2Returns a list of FLAVOR's SET messages.Ï*"
  ;Ï1; The cons includes the :CASE :SET methods generated for each settable instance variable by the flavor system.Ï*
  (CONS :set
	(LOOP with keyword-package = (SYMBOL-PACKAGE :foo)
	      for ivar in (si::flavor-get flavor :settable-instance-variables)
 	      collect (INTERN (FORMAT nil "Ï3SET-~aÏ*" ivar) keyword-package))))

(DEFUN Ï4assmemqÏ* (x list)
  "Ï2Combined ASSQ and MEMQ.Ï*"
  (DOLIST (entry list)
    (COND
      ((EQ x entry)
       (RETURN entry))
      ((AND (LISTP entry) (EQ x (CAR entry)))
       (RETURN entry)))))

(DEFMETHOD Ï4(show-local-methods :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying the methods
defined for flavor ~s.  Methods inherited from ~s's flavor components are NOT displayed. 
(\"All Methods\" and \"All Methods, Sorted\" options are available for viewing inherited methods.)

This display is divided into three sections:

  1. The first section displays methods defined explictly for ~s via DEFMETHOD.  Typically
     this section is the largest and most interesting of the three sections.

  2. The second section displays methods (usually) generated by the flavor system for
     use in fetching instance variable values.  These methods are commonly termed \"GET methods\".

  3. The last section displays methods (usually) generated by the flavor system for
     use in setting instance variable values.  These methods are commonly termed \"SET methods\".

The separation of GET and SET methods from the main body of methods is done only to help
you better understand flavor ~s.  Within the flavor system these methods are not separated in
any way whatsoever.  In fact, often flavors define their own GET and SET methods,
instead of accepting the versions the flavor system automatically generates.  This display
does not flag such definitions.

Each method is displayed by its type, message name, and argument list.  Further information
can be obtained by using the mouse.  Method types are any of the following:
 :AFTER, :AND, :AROUND, :BEFORE, :CASE, :DEFAULT, :OR, :OVERRIDE, :WRAPPER.
If a type is not present, the displayed method is a \"primary method\".  Type :WRAPPER
indicates wrappers (defined via DEFWRAPPER).  The rest are the standard, documented method
types.  Note that :COMBINED methods are not displayed, since they are seen as relatively
uninteresting and tend to add clutter.

Most methods are combined using the default method combination type :DAEMON.  However,
if a displayed method is combined using one of the other combination types (such as
:OR, :AND, or :CASE), an asterisk (*) is placed to the left of the method type.  Clicking
left on the method will show detailed information which includes the type of method 
combination used.Ï*	Ï3    Ï*"
;Ï1; This doc string brings up two points:Ï*
;Ï1; 1.  We could flag explicitly defined GET and SET methods by examining the method FEFs to see if Ï*
;Ï1;     they contain something other than the machine instructions normally contained in GET and SET methods.Ï*
;Ï1;     However, it might be too inefficient.Ï*
;Ï1; 2.  The display of :COMBINED methods throughout the flavor inspector could be customizable (ON\/OFF)Ï*
;Ï1;      I don't know who wants to see them.Ï*
	    flavor-name  flavor-name flavor-name flavor-name)))

(DEFFLAVOR Ï4show-all-methodsÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-all-methods :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's methods (all)Ï*" (si::flavor-name data)))

(DEFMETHOD Ï4(show-all-methods :generate-itemÏ*) ()
  ;Ï1; 7/12/88 clm - prevent entering debugger if flavor undefinedÏ*
  ;Ï1  (UNLESS (SI:FLAVOR-DEPENDS-ON-ALL data)Ï*
  ;Ï1    (SI:COMPOSE-FLAVOR-COMBINATION data))Ï*
  (VALUES
    ;Ï1; This method borrows alot from SHOW-LOCAL-METHODS :GENERATE-ITEM.Ï*
    ;Ï1; NCONC for efficiency; copy-list to protect last element, which is often *NO-ITEMS*, which must not be destroyed.Ï*
    (NCONC
      (COPY-LIST (SEND (allocate-data 'show-local-methods data) :generate-item))
      (LOOP with top-flavor-method-table = (si::flavor-method-table data)
	    ;Ï1;Modded here by JPR.Ï*
	    for flavor-name in (CDR (get-flavor-depends-on-all data))
	    for flavor = (GET flavor-name 'si::flavor)
	    for method-table = (SORTCAR (COPY-LIST (si::flavor-method-table flavor)) #'STRING-LESSP)
	    for get-methods = (get-methods flavor)
	    for set-methods = (set-methods flavor)
	    nconc (MULTIPLE-VALUE-BIND (items special-com?)
		      (collect-method-items (m tpl method-table) 
					    (AND (NOT (OR (MEMBER (CAR m) get-methods :test #'EQ)
							  (MEMBER (CAR m) set-methods :test #'EQ)))
						 (OR (FOURTH (CAAR tpl))
						     (NOT (ASSOC (THIRD (CAAR tpl))
								 top-flavor-method-table :test #'EQ)))))
		    `(,*blank-line-item*
		      ,*blank-line-item*
		      ((:font 1 "Ï3Methods inherited from flavor Ï*")
		       (:item1 instance ,(allocate-data 'show-flavor flavor))
		       (:font 1 ,(IF special-com? "Ï3.  * = special method combination typeÏ*" "Ï3:Ï*")))
		      ;Ï1; Collect the methods, excluding any GET and SET methods,Ï*
		      ;Ï1; which we want to list separately (for readability)Ï*
		      ;Ï1; and any base (non-demonic) methods which have been defined explicitly for DATA.Ï*
		      ;Ï1; (If DATA has it's ownÏ*
		      ;Ï1; version of method :FOO, it doesn't really inherit it's mixins versions of :FOO).Ï*
		      ;Ï1; The ASSoc isn't enough--need to check previous mixins too and take into accountÏ*
		      ;Ï1; the method combination type and order (:base-flavor-first/:base-flavor-first).Ï*
		      ,@(IF items (CONS *method-display-columns* items) *no-items*)
		      ;Ï1; Separate the display of :GET and :SET methods from the main body of defined methods,Ï*
		      ;Ï1; since most of these are trivial and automatically generated by the flavor system.Ï*
		      ,@(WHEN get-methods
			  `(,*blank-line-item*
			    ((:font 1 "Ï3 GET methods inherited from Ï*")
			     (:item1 instance ,(allocate-data 'show-flavor flavor))
			     (:font 1 "Ï3:Ï*"))
			    . ,(collect-method-items (m tpl method-table)
						     (AND (MEMBER (CAR m) get-methods :test #'EQ)
							  (OR (FOURTH (CAAR tpl))
							      (NOT (ASSOC (THIRD (CAAR tpl))
									  top-flavor-method-table :test #'EQ)))))))
		      ,@(WHEN (> (LENGTH set-methods) 1) ;Ï1;There's always at least a :SET entry.Ï*
			  `(,*blank-line-item*
			    ((:font 1 "Ï3 SET methods inherited from Ï*")
			     (:item1 instance ,(allocate-data 'show-flavor flavor))
			     (:font 1 "Ï3:Ï*"))
			    . ,(collect-method-items (m tpl method-table)
						     (AND (MEMBER (CAR m) set-methods :test #'EQ)
							  (OR (FOURTH (CAAR tpl))
							      (NOT (ASSOC (THIRD (CAAR tpl))
									  top-flavor-method-table :test #'EQ)))))))))))
    `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s's methods (all)Ï*" (si::flavor-name data)))))

(DEFMETHOD Ï4(show-all-methods :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all methods
defined for or inherited by flavor ~s.  The methods are presented under section headers which
indicate which component flavor of ~s provides them.  ~s's local methods are displayed in the
first section; subsequent sections are ordered according to precedence in ~s's flavor
heirarchy.

Each flavor's methods are divided into three sections:

  1. The first section displays methods defined explictly for ~s via DEFMETHOD.  Typically
     this section is the largest and most interesting of the three sections.

  2. The second section displays methods (usually) generated by the flavor system for
     use in fetching instance variable values.  These methods are commonly termed \"GET methods\".

  3. The last section displays methods (usually) generated by the flavor system for
     use in setting instance variable values.  These methods are commonly termed \"SET methods\".

The separation of GET and SET methods from the main body of methods is done only to help
you better understand flavor ~s.  Within the flavor system these methods are not separated in
any way whatsoever.  In fact, often flavors define their own GET and SET methods,
instead of accepting the versions the flavor system automatically generates.  This display
does not flag such definitions.

Each method is displayed by its type, message name, and argument list.  Further information
can be obtained by using the mouse.  Method types are any of the following:
 :AFTER, :AND, :AROUND, :BEFORE, :CASE, :DEFAULT, :OR, :OVERRIDE, :WRAPPER.
If a type is not present, the displayed method is a \"primary method\".  Type :WRAPPER
indicates wrappers (defined via DEFWRAPPER).  The rest are the standard, documented method
types.  Note that :COMBINED methods are not displayed, since they are seen as relatively
uninteresting and tend to add clutter.

Most methods are combined using the default method combination type :DAEMON.  However,
if a displayed method is combined using one of the other combination types (such as
:OR, :AND, or :CASE), an asterisk (*) is placed to the left of the method type.  Clicking
left on the method will show detailed information which includes the type of method 
combination used.Ï*"
	    flavor-name flavor-name flavor-name flavor-name flavor-name)))

(DEFFLAVOR Ï4show-all-methods-sortedÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-all-methods-sorted :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's methods (sorted)Ï*" (si::flavor-name data)))

;Ï1; The fields sizes were generated haphazardly, since we're using a variable width font.Ï*
(DEFPARAMETER Ï4*method-display-columns-2*Ï*
   `((:font 2 ,(FORMAT nil "Ï3~35A~8T~10A~33A~10AÏ*" "Ï3FlavorÏ*" "Ï3TypeÏ*" "Ï3MessageÏ*" "Ï3ArglistÏ*")))) 

;Ï1; This COULD star :GET and :SET methods, to add some of the functionality of SHOW-ALL-METHODS.Ï*
(DEFMETHOD Ï4(show-all-methods-sorted :generate-itemÏ*) ()
  ;Ï1; Modded here by JPR.Ï*
  ;Ï1  (UNLESS (SI:FLAVOR-DEPENDS-ON-ALL data)Ï*
  ;Ï1    (SI:COMPOSE-FLAVOR-COMBINATION data))Ï*
  ;Ï1; Same as (SHOW-ALL-METHODS :generate-item), with output formatted differently.Ï*
  (VALUES
;Ï1; The ASSoc isn't enough--need to check previous mixins too and take into accountÏ*
;Ï1; the method combination type and order (:base-flavor-first/:base-flavor-first).Ï*
    (LET* ((special-comb?)
	   ;Ï1; Modded here by JPR.Ï*
	   (items (LOOP for flavor-name in (get-flavor-depends-on-all data)
			for flavor = (GET flavor-name 'si::flavor)
			for method-table = (si::flavor-method-table flavor)
			nconc (MULTIPLE-VALUE-BIND (items comb?)
				  (collect-method-items (m tpl method-table) t nil t)
				(WHEN comb?
				  (SETQ special-comb? t))
				items))))
      `(,*blank-line-item*
	((:font 1 "Ï3All Methods of flavor Ï*")
	 (:item1 instance ,(allocate-data 'show-flavor data))
	 (:font 1 ,(IF special-comb? "Ï3.  * = special method combination typeÏ*" "Ï3:Ï*")))
	,*blank-line-item*
	,*method-display-columns-2*
	;Ï1; This sorts the methods alphabetically by message, then by method type Ï*
        ;Ï1; (if any), then by submessage (if any).Ï*
	,@(SORT items
		#'(lambda (x y)
		    (LET* ((x-method-spec (CAR (SEND (THIRD (THIRD x)) :data)))
			   (y-method-spec (CAR (SEND (THIRD (THIRD y)) :data)))
			   (x-message (message x-method-spec))
			   (y-message (message y-method-spec)))
		      (IF (EQ x-message y-message)
			  (LET ((x-method-type (method-type x-method-spec)))
			    (IF (AND x-method-type (EQ x-method-type (method-type y-method-spec)))
				(string-lessp-nil-wins (submessage x-method-spec) (submessage y-method-spec))
				(string-lessp-nil-wins x-method-type (method-type y-method-spec))))
			  (STRING-LESSP x-message y-message)))))))
    `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s's methods (all)Ï*" (si::flavor-name data))))) 

(DEFUN Ï4string-lessp-nil-winsÏ* (x y)
  (COND
    ((NULL x) t)
    ((NULL y) nil)
    (t (STRING-LESSP x y))))

(DEFMETHOD Ï4(show-all-methods-sorted :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all methods
defined for or inherited by flavor ~s.  The methods are sorted alphabetically by message name
and method type.  (The \"All Methods\" option provides a more organized display of the methods.)

Each method is displayed by its flavor, type, message name, and argument list.  
Further information can be obtained by using the mouse.  Method types are any of the following:
 :AFTER, :AND, :AROUND, :BEFORE, :CASE, :DEFAULT, :OR, :OVERRIDE, :WRAPPER.
If a type is not present, the displayed method is a \"primary method\".  Type :WRAPPER
indicates wrappers (defined via DEFWRAPPER).  The rest are the standard, documented method
types.  Note that :COMBINED methods are not displayed, since they are seen as relatively
uninteresting and tend to add clutter.

Most methods are combined using the default method combination type :DAEMON.  However,
if a displayed method is combined using one of the other combination types (such as
:OR, :AND, or :CASE), an asterisk (*) is placed to the left of the method type.  Clicking
left on the method will show detailed information which includes the type of method 
combination used.Ï*"
	    flavor-name)))

(DEFFLAVOR Ï4show-all-handled-messagesÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-all-handled-messages :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's messages (all)Ï*" (si::flavor-name data)))

(DEFMETHOD Ï4(show-all-handled-messages :generate-itemÏ*) ()
  (LET ((ops (OR (si::flavor-which-operations data)
		 (LET (messages)
		   (with-recursion ((comp) (si::flavor-name data))
		     ;Ï1;Modded here by JPR.Ï*
		     (IF (GET comp 'si::flavor)
			 (PROGN (DOLIST (method-entry (si::flavor-method-table (GET comp 'si::flavor)))
				  (PUSHNEW (CAR method-entry) messages))
				(DOLIST (comp (si::flavor-includes (GET comp 'si::flavor)))
				  (recurse comp))
				(DOLIST (comp (si::flavor-depends-on (GET comp 'si::flavor)))
				  (recurse comp)))
			 nil))
		   (SORT messages #'STRING-LESSP)))))
    (VALUES
      `(,*blank-line-item*
	((:font 1 "Ï3Messages handled by flavor Ï*")
	 (:item1 instance ,(allocate-data 'show-flavor data))
	 (:font 1 "Ï3:Ï*"))
	,*blank-line-item*
	((:font 2 "Ï3Message                                     Component Flavors Providing HandlersÏ*"))
;Ï1; This probably lists too many component flavors--those just having a :COMBINED method.Ï*
;Ï1; Plus it lists flavor X and Y where flavor X's method shadows flavor Y's method.Ï*
;Ï1; Once again, need to take method combination into account.Ï*
	,@(LOOP for message in ops
		collect `((:item1 instance ,(allocate-data 'show-message data message))
			  ,@(LOOP with first? = t
				  ;Ï1;Modded here by JPR.Ï*
				  for flavor-name in (get-flavor-depends-on-all data)
				  for flavor = (GET flavor-name 'si::flavor)
				  when (flavor-message-handler? flavor message)
				  if first?
				     collect `(:item1 instance ,(allocate-data 'show-flavor flavor))
				     and do (SETQ first? nil)
				  else
				     collect '("Ï3, Ï*")
				     and collect `(:item1 instance ,(allocate-data 'show-flavor flavor))))))
      `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s's messages (all)Ï*" (si::flavor-name data))))))

(DEFUN Ï4flavor-message-handler?Ï* (flavor message)
  "Ï2Returns non-nil if FLAVOR has some method for MESSAGE, not including any :COMBINED method.Ï*"
  (LOOP for entry in (CDDDR (ASSOC message (si::flavor-method-table flavor) :test #'EQ)) when
     (NEQ (THIRD (CAR entry)) :combined) return t)) 

(DEFMETHOD Ï4(show-all-handled-messages :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all messages handled by
flavor ~s.  The left column displays each message, and the right column 
displays all component flavors of ~s which provide a method (including demons 
and wrappers) for the message.  Clicking on a message name inspects the set of methods
which are invoked when instances of ~s are sent the message.Ï*"
	    flavor-name flavor-name flavor-name)))
  
(DEFFLAVOR Ï4show-instance-variablesÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-instance-variables :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's instance variablesÏ*" (si::flavor-name data)))

;Ï1; This makes sure that the flavor's mixin's instance variables have been included into the flavor.Ï*
(DEFMETHOD Ï4(show-instance-variables :generate-itemÏ*) ()
  ;Ï1; 7/12/88 clm - prevent entering debugger if flavor happens to be undefined.Ï*
;Ï1  (UNLESS (SI::FLAVOR-DEPENDS-ON-ALL data)Ï*
;Ï1    (SI:COMPOSE-FLAVOR-COMBINATION data))Ï*
  (LET* ((flavor-name (si::flavor-name data))
	 (instance-size (si::flavor-instance-size data)))
    (VALUES
      `(,*blank-line-item*
	((:font 1 "Ï3Local to flavor Ï*")
	 (:item1 instance ,(allocate-data 'show-flavor data))
	 (:font 1 "Ï3:Ï*"))
	,@(IF (si::flavor-local-instance-variables data)
	      (local-instance-var-item-list (si::flavor-local-instance-variables data) data data) 
	      *no-items*)
	;Ï1;Modded here by JPR.Ï*
	. ,(LOOP for fname in (CDR (get-flavor-depends-on-all data))
		 for fl = (GET fname 'si::flavor)
		 for local-vars = (si::flavor-local-instance-variables fl)
		 append
		 (WHEN local-vars
		   `(,*blank-line-item*
		     ((:font 1 "Ï3Inherited from Ï*")
		      (:item1 instance ,(allocate-data 'show-flavor fl))
		      (:font 1 "Ï3:Ï*"))
		     . ,(local-instance-var-item-list local-vars fl data)))))
      `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~S's ~@[~s ~]instance variablesÏ*" flavor-name instance-size)))))

(DEFPARAMETER Ï4*ivar-column-headers*Ï*
   `(:font 3
     ,(FORMAT nil
	      "Ï3 Variable~40@tGettable  Settable  Inittable  Special  Default-Value                  Ï*"))) 

;Ï1; Help function for (:METHOD GENERAL-INSPECT-PANE :SHOW-INSTANCE-VARIABLES).Ï*
;Ï1; Returns a text scroll item for instance variables INHERITED-VARIABLES (a list of instanceÏ*
;Ï1; variable symbols or symbol consed onto default value).  OF-FLAVOR is passed to allow usÏ*
;Ï1; to have the text indicate whether or not each variable is gettable, settable, and inittable.Ï*
(DEFUN Ï4local-instance-var-item-listÏ* (inherited-variables inherited-flavor of-flavor)
  (LET* ((init-options?)
	 (items
	  (LOOP for entry in inherited-variables
                for var = (ucl::first-if-list entry)	
                collect `(,*one-space-item* (:item1 instance ,(allocate-data 'show-instance-variable var))
                          (,*space-format* ,(- 36 (symbol-string-length var)))
                          ,*one-space-item*
                          ;Ï1; This might be made more efficient by using constant strings separating the X's.Ï*
                          ,(FORMAT () "Ï3 ~:[   ~; G ~]     ~:[   ~; S ~]    ~:[   ~; I ~]    ~:[    ~; Sp ~]   Ï*"
                                   (MEMBER var (si::flavor-gettable-instance-variables inherited-flavor) :test #'EQ)
                                   (MEMBER var (si::flavor-settable-instance-variables inherited-flavor) :test #'EQ)
                                   (MEMBER var (MAPCAR #'CDR
                                                       (si::flavor-inittable-instance-variables inherited-flavor)) 
					   :test #'EQ)
                                   (MEMBER var (si::flavor-special-instance-variables inherited-flavor) :test #'EQ))
                          ,(IF (SYMBOLP entry)
                               '(:font 2 "Ï3unbound        Ï*")
                               `(:item1 instance ,(allocate-data 'show-value (CADR entry) 24)))
			  ,*one-space-item*
                          ,@(LET* ((init (INTERN var 'keyword))
                                   (f-plist (si::flavor-plist of-flavor))
                                   (init-plist (GETF f-plist :default-init-plist))
                                   (value (GETF init-plist init)))
                              (WHEN (AND value
                                         (MEMBER init (GETF f-plist 'si::all-inittable-instance-variables) :test #'EQ))
                                (SETQ init-options? t)
                                `((:item1 instance ,(allocate-data 'show-value value nil)))))))))
    (IF init-options?
      `((,*ivar-column-headers*
	 (:font 3 ,(FORMAT () "Ï3~s's InitializationsÏ*" (si::flavor-name of-flavor))))
	. ,items)
      `((,*ivar-column-headers*) . ,items)))) 

(DEFMETHOD Ï4(show-instance-variables :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all instance variables
of flavor ~s.  The instance variables are presented under section headers which
indicate which component flavor of ~s provides them.  ~s's local instance
variables are displayed in the first section; subsequent sections are ordered according
to precedence in ~s's flavor heiarchy.

The first column displays each instance variable name.  The second through fifth columns
indicate whether each instance variable is gettable, settable, inittable, and special.
The sixth column provides the default value for the variable as defined by the flavor
which provides the variable.  For instance, if ~s mixes in FOO and FOO provides
instance variable BAR, BAR's sixth column will display whatever default value FOO 
specifies.  The seventh column, however, displays the default value which ~s
provides in its :DEFAULT-INIT-PLIST (if it provides any at all).Ï*"
;Ï1; Actually, that probably isn't comprehensive enough.  Need an option which shows Ï*
;Ï1; the ivars alphabetically and which shows what their values will end up beingÏ*
;Ï1; when the flavor is instantiated, taking into account all components' :DEFAULT-INIT-PLIST.Ï*
	    flavor-name flavor-name flavor-name flavor-name flavor-name flavor-name)))


(DEFFLAVOR Ï4show-miscellaneous-dataÏ* () (flavor-operation-mixin))

(DEFMETHOD Ï4(show-miscellaneous-data :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's miscellaneous dataÏ*" (si::flavor-name data)))

(DEFMETHOD Ï4(show-miscellaneous-data :generate-itemÏ*) ()
  (LET* ((flavor-name (si::flavor-name data))
         (init-keywords (si::flavor-init-keywords data)))
	 ;Ï1; There are some nasty conciderations to make here.  If you show the user theÏ*
	 ;Ï1; method hash table and the property list, he may expect to be able to modify componentsÏ*
	 ;Ï1; as in the regular Inspector.  Would recommend that this utility remain informational.Ï*
	 ;Ï1; Might add an Inspect command to allow inspection of flavor defstructs.Ï*
    (VALUES
     `(,*blank-line-item* ((:font 1 "Ï3Keywords in the :INIT message handled by this flavor:Ï*"))
       ;Ï1; What can we do on keywords wrt mouse-sensitivity?? Edit-Init-Method might be nice.Ï*
       ,@(IF init-keywords
	   (LOOP for keyword in init-keywords
                 collect (LIST (FORMAT () "Ï3 ~sÏ*" keyword)))
	   *no-items*)
       ,*blank-line-item*
       ((:font 1 "Ï3Flavor was defined in package Ï*") ,(FORMAT () "Ï3~AÏ*" (si::flavor-definition-package data))) ;Ï1 jlm 4/10/89Ï*
       ,*blank-line-item*
       ((:font 1 "Ï3Included Flavors:Ï*"))
       ,@(OR (LOOP for included in (si::flavor-includes data)
                   collect `(,*one-space-item*
                             (:item1 instance ,(allocate-data 'show-flavor (GET included 'si::flavor)))))
             *no-items*)
       ,*blank-line-item*
       ((:font 1 "Ï3Properties:Ï*"))
       ;Ï1; What can we do on properties wrt mouse-sensitivity??Ï*
       
       ,@(IF (NULL (si::flavor-plist data))
	   *no-items*
	   (LOOP for (property value) on (si::flavor-plist data) by #'CDDR
                 collect (LIST (FORMAT () "Ï3 ~S:Ï*" property))
                 append (break-string-into-lines
                          (WITH-OUTPUT-TO-STRING (STREAM)
                            (GRIND-TOP-LEVEL value () stream () 'si::displaced t () (CONS value ())
				  'si::grind-opti-miser 3)))))
       ,*blank-line-item*
       . ,(COND ((NULL (si::flavor-method-hash-table data))
                 `(((:font 1 ,(FORMAT () "Ï3Flavor ~S does not yet have a method hash table.Ï*" flavor-name)))))
                ((EQ t (si::flavor-method-hash-table data))
                 `(((:font 1 ,(FORMAT ()
				    "Ï3Flavor ~S has been method-composed but has no hash table - it is an :ABSTRACT-FLAVOR.Ï*"
                                   flavor-name)))))
                (t
                 (CONS `((:font 1 ,(FORMAT () "Ï3Flavor ~S has method hash table:Ï*" flavor-name)))
                       (break-string-into-lines (WITH-OUTPUT-TO-STRING (STREAM)
                                                  (LET ((*standard-output* stream))
                                                    (DESCRIBE (si::flavor-method-hash-table data)))))))))
     `(:font fonts:hl12bi :string ,(FORMAT () "Ï3~S' miscellaneous dataÏ*" flavor-name))))) 

(DEFUN Ï4break-string-into-linesÏ* (STRING)
  "Ï2Given a string, returns a list of strings, one for each line in STRING.
Lines are broken up by carriage returns encountered in STRING.Ï*"
  (WITH-INPUT-FROM-STRING (STREAM string)
    (LOOP with line with eof?
	  do (MULTIPLE-VALUE-SETQ (line eof?) (READ-LINE stream nil))
	  collect (LIST (IF (STRINGP line) line ""))
	  until eof?)))

(DEFMETHOD Ï4(show-miscellaneous-data :helpÏ*) ()
  (LET ((flavor-name (si::flavor-name data)))
    (FORMAT nil "
The inspection pane you just selected is currently displaying miscellaneous data
on flavor ~s.  The following data are displayed:

 :INIT Keywords   -- any keywords handled by the :INIT method defined for ~s
 Package          -- the symbol package in which the DEFFLAVOR for ~s was called.
 Included Flavors -- Any flavors declared as :INCLUDED-FLAVORS in the DEFFLAVOR for ~s.
                     Included flavors are used to assure that any flavor mixing in ~s
                     also mix in the included flavors.  If they are not mixed in,
                     they are added right after ~s in the flavor heirarchy.
 Properties       -- The flavor property list of ~s.
 Hash Table       -- The state of ~s's method hash table.  If ~s doesn't have a hash table,
                     its methods haven't been composed (via initial instantiation of ~s or
                     through COMPILE-FLAVOR-METHODS).

Lots of information is displayed in the flavor properties.  The following lists the most
important of the properties:
 SI:ALL-INITTABLE-INSTANCE-VARIABLES
 SI::ALL-SPECIAL-INSTANCE-VARIABLES
 SI::REMAINING-DEFAULT-PLIST     -- ???
 SI:UNHANDLED-INIT-KEYWORDS      -- ???
 SI::REMAINING-INIT-KEYWORD      -- ???
 COMPILE-FLAVOR-METHODS          -- The file in which ~s's methods were compiled.
 SI::UNMAPPED-INSTANCE-VARIABLES -- ???
 :DEFAULT-INIT-PLIST             -- Default values ~s provides for its instance variables.

 Any others???"
	    flavor-name flavor-name flavor-name flavor-name flavor-name flavor-name
	    flavor-name flavor-name flavor-name flavor-name flavor-name flavor-name)))

;Ï1; Odd-ball flavors--those not mixing in FLAVOR-OPERATION-mixin.Ï*

(DEFFLAVOR Ï4show-methodÏ* () (inspection-data))

(DEFMETHOD Ï4(show-method :format-conciselyÏ*) (STREAM)
 ;Ï1; DATA is a method spec (a cons stored in the method table of a flavor defstruct,Ï*
 ;Ï1; so we use the METH- accessor functions here.Ï*
  (LET ((fun-spec (si::meth-function-spec data))
	;Ï1; The CONSP is needed for wrappers.Ï*
	;Ï1; Change to check for :Method.  The method, which is theÏ*
	;Ï1; (second data) could be an interpretted named lambda.Ï*
	(ARGLIST (ARGLIST (IF (AND (CONSP (CADR data)) (EQUAL :method (SECOND data)))
                              (CDADR data)
                              (CADR data)))))
	;Ï1; Blow off the first arg, which is always SI:.OPERATION, except on wrappers. Ï*
    (UNLESS (EQ (si::meth-method-type data) :wrapper)
      (POP arglist))
    ;Ï1; If special method combination type, put an asterisk next to the message name.  Otherwise, just print a space.Ï*
    (IF (CADR
      (ASSOC (OR (FOURTH (CAR data)) (THIRD (CAR data)))
	     (si::flavor-method-table (GET (CADAR data) 'si::flavor)) :test #'EQ))
      (UNWIND-PROTECT (PROGN
		       (SEND stream :set-current-font 1)
		       (FORMAT stream "Ï3*Ï*"))
	(SEND stream :set-current-font 0))
      (FORMAT stream "Ï3 Ï*"))
    (FORMAT stream "Ï3~:[~*~;~S~]~30@< ~S~@[ :~A~]~> ~:[~*()~;~S~]Ï*" (si::meth-method-type data)
	    (si::meth-method-type data)
	    (IF (FIFTH fun-spec)
	      (FOURTH fun-spec)
	      (CAR (LAST fun-spec)))
	    (FIFTH fun-spec) arglist arglist))) 

(DEFMETHOD Ï4(show-method :who-line-docÏ*) (IGNORE &optional ignore)
  '(:mouse-l-1 "Ï3Inspect method detailsÏ*"
    :mouse-m-1 "Ï3Show the combined methods used in handling the message for this flavorÏ*"
    :mouse-r-1 "Ï3Menu of method operationsÏ*"))

(DEFMETHOD Ï4(show-method :handle-mouse-clickÏ*) (blip flavor-inspector)
  (LET ((current-flavor (SEND (SEND (THIRD blip) :current-object) :data)))
    (SELECTOR (FOURTH blip) =
      (#\Mouse-l-1
       (select-method-operations data flavor-inspector current-flavor :inspect))
      (#\Mouse-m-1
       (select-method-operations data flavor-inspector current-flavor :show-combined-methods))
      (#\Mouse-r-1
       (select-method-operations data flavor-inspector current-flavor))
      (t
       (BEEP)))))

(DEFVAR Ï4*method-operations-menu*Ï*
	'(("Ï3InspectÏ*" :value :inspect
	   :documentation "Ï3Show information about this method:
instance variables and messages referenced, arglist, documentation, source fileÏ*")
	  ("Ï3Show Combined MethodsÏ*" :value :show-combined-methods
	   :documentation "Ï3Show the combined methods used in handling the message for this flavorÏ*")
	  ("Ï3DisassembleÏ*" :value :disassemble
	   :documentation "Ï3Use a standard Inspect window to show disassembled code.Ï*")
	  ("Ï3Edit SourceÏ*" :value :edit-source
	   :documentation "Ï3Edit this method in a Zmacs buffer.Ï*")
	  ("Ï3TraceÏ*" :value :trace
	   :documentation "Ï3Invoke a trace window to trace this methodÏ*")))

;Ï1; Used in several parts of the flavor inspector to let the user choose an operation onÏ*
;Ï1; the method stored in METHOD-TABLE-ENTRY.Ï*
(DEFUN Ï4select-method-operationsÏ* (method-table-entry flavor-inspector current-flavor &optional selection)
  (CASE (OR selection
      (ucl::smart-menu-choose *method-operations-menu* :label
	 (FORMAT () "Ï3~sÏ*" (CDAR method-table-entry))))
    (:inspect
     (SEND flavor-inspector :inspect-thing 'show-method-details
	(GET (SECOND (CAR method-table-entry)) 'si::flavor) method-table-entry))
    (:show-combined-methods
     (LET ((found-entry
	    (ASSOC (OR (FOURTH (CAR method-table-entry)) (THIRD (CAR method-table-entry)))
		   (si::flavor-method-table current-flavor) :test #'EQ)))
	   ;Ï1; Use the inspection pane's currently selected flavor (if there is one), instead of the one we are a method for,Ï*
	   ;Ï1; since that's what we want when we are displayed as an inherited method in SHOW-ALL-METHODS.Ï*
       (IF found-entry
	 (SEND flavor-inspector :inspect-thing 'show-message-handlers current-flavor
	    (CAR (FOURTH found-entry)))
	 (SEND flavor-inspector :inspect-thing 'show-message-handlers
	    (GET (SECOND (CAR method-table-entry)) 'si::flavor) (CAR method-table-entry)))))
    (:disassemble (INSPECT (FDEFINITION (CAR method-table-entry))))
    (:edit-source (ED (CAR method-table-entry)))
    (:trace (trace-via-menus (CAR method-table-entry))))) 

  
(DEFFLAVOR Ï4show-method-detailsÏ* () (auxiliary-data-mixin flavor-operation-mixin))

(DEFMETHOD Ï4(show-method-details :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3Method~{ ~s~}Ï*" (CDR (CAR aux-data))))

(DEFWRAPPER Ï4(show-method-details :handle-mouse-clickÏ*) ((blip flavor-inspector) . body)
  `(IF (= (FOURTH blip) #\Mouse-r-1)
       (select-method-operations aux-data flavor-inspector (SEND (SEND (THIRD blip) :current-object) :data))
       . ,body))

(DEFMETHOD Ï4(show-method-details :generate-itemÏ*) ()
 (LET (not-available)
   (VALUES
     (MULTIPLE-VALUE-BIND (referenced-ivars referenced-keywords problem)
         (ivars-and-messages-in-method (CAR aux-data))
       (WHEN problem
         (SETQ not-available (IF (EQ problem :wrapper)
                                 '(((:font 2 "Ï3 not available for wrappersÏ*")))
                                 '(((:font 2 "Ï3 not available for interpreted methodsÏ*"))))))
       (MULTIPLE-VALUE-BIND (args returned-values)
           ;Ï1; Wrappers and interpreted methods have a method table entry format different from the norm.Ï*
           ;Ï1; Wrappers' entries are (<spec> (MACRO . <fef>)...).  Interpreted methods are (<spec> (NAME-LAMBA <spec> <arglist> ...))Ï*
           (COND ((EQ problem :wrapper) (ARGLIST (CDADR aux-data)))
                 ((EQ problem :interpreted) (CDR (THIRD (CADR aux-data)))) ;Ï1;Take CDR to get rid of SI:.OPERATION. arg.Ï*
                 (t (CDR (ARGLIST (CADR aux-data))))) ;Ï1;Take CDR to get rid of SI:.OPERATION. arg.Ï*
         `(,*blank-line-item*
           ((:font 1 "Ï3Details of Ï*")
            (:item1 instance ,(allocate-data 'show-method-details data aux-data)))
           ,*blank-line-item*
           ((:font 1 "Ï3Source File:               Ï*")
	   ;Ï1; Changed by DAN to check for a null source-file property (Third aux-data) for the method,Ï*
	   ;Ï1; since the method may have been typed in interactively or generated automatically.Ï*
	   ,(IF (GETF (THIRD aux-data) :source-file-name)
		(LET ((sf (GETF (THIRD aux-data) :source-file-name)))
		     (FORMAT nil "Ï3~aÏ*" (SEND (IF (CONSP sf) (CADR (ASSOC 'DEFUN sf :test #'EQ)) sf) :string-for-printing)))
		(FORMAT nil "Ï3Not DefinedÏ*")))
           ((:font 1 "Ï3Method combination type:   Ï*")
            ,(LET ((method-entry (ASSOC (OR (FOURTH (CAR aux-data)) (THIRD (CAR aux-data)))
                                        (si::flavor-method-table data) :test #'EQ)))
               (IF (CADR method-entry)
                   `("Ï3~S~@[ ~S~]Ï*" ,(CADR method-entry) ,(CADDR method-entry))
                   "Ï3:DAEMON (the default)Ï*")))
           (,(IF returned-values
                 '(:font 1 "Ï3Arglist Ý Returned Values: Ï*")
                 '(:font 1 "Ï3Arglist:                   Ï*"))
            ("Ï3~:[~*()~;~S~]Ï*" ,args ,args)
            ,@(WHEN returned-values
                `(("Ï3 Ý ~SÏ*" ,returned-values))))
           ,*blank-line-item*
           ((:font 1 "Ï3Documentation:Ï*"))
           ,@(LET ((doc (DOCUMENTATION (CADR aux-data))))
               (IF doc
                   (break-string-into-lines doc)
                   *no-items*))
           ,*blank-line-item*
           ((:font 1 "Ï3Referenced Instance Variables:Ï*"))
           ,@(OR not-available
                 (LOOP for ivar in referenced-ivars
                       collect `(,*one-space-item*
                                 (:item1 instance ,(allocate-data 'show-instance-variable ivar)))))
           ;Ï1; Anything you try to provide other than just printing these out willÏ*
           ;Ï1; be truely inefficient, since you will have to search *ALL-FLAVOR-NAMES* forÏ*
           ;Ï1; all methods of KEYWORD.  So, printing is probably the right thing to do.Ï*
           ,*blank-line-item*
           ((:font 1 "Ï3Referenced Keywords (possibly messages passed):Ï*"))
           ,@(OR not-available
                 (LOOP for keyword in referenced-keywords
                       collect `(("Ï3 ~sÏ*" ,keyword)))))))
     `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3Method~{ ~s~}Ï*" (CDAR aux-data))))))

;Ï1; Taken from DISASSEMBLE.  Returns three values: list of instance variables referenced,Ï*
;Ï1; list of keywords referenced, and NIL if everything went ok.  If third value is :WRAPPER orÏ*
;Ï1; :INTERPRETED, METHOD-SPEC is either a wrapper or isn't compiled, so no search was done.Ï*
;Ï1; We can't gleam any info out of a wrapper's fef, since it's mostly a macro.Ï*
(DEFUN Ï4ivars-and-messages-in-methodÏ* (method-spec)
  (LET ((fef (FDEFINITION method-spec))
	lim-pc
	ilen
	*collected-ivars*
	*collected-messages*)
    (DECLARE
      (SPECIAL *collected-ivars* *collected-messages* *previous-op* *previous-previous-op*))
    (WHEN (SYMBOLP fef)				;Ï1; Obsolete syntax for method definitions mayÏ*
      (SETF fef (SYMBOL-FUNCTION fef)))		;Ï1; return symbols here.  PMH SPR#6810Ï*
    (IF (CONSP fef)
	(VALUES () () (IF (EQ (CAR fef) 'MACRO)
			  :wrapper
			  :interpreted))
	(PROGN
	  (SETQ lim-pc (compiler:disassemble-lim-pc fef))
	  ;Ï1; Loop through the instructions of FEF, searching for ivars and messages.Ï*
	  (DO ((pc (fef-initial-pc fef) (+ pc ilen)))
	      ((>= pc lim-pc))
	    (SETQ ilen (search-instruction fef pc)))
	  (VALUES *collected-ivars* *collected-messages* ()))))) 

;Ï1; Taken from COMPILER:DISASSEMBLE-INSTRUCTION.Ï*
#+elroy
(DEFUN Ï4search-instructionÏ* (fef pc)
  (LET (wd op name no-reg ilen)
    (SETQ ilen (compiler:disassemble-instruction-length fef pc))
    (BLOCK ()
      (SETQ wd (compiler::disassemble-fetch fef pc)
	    op (LDB si:%%qmi-full-opcode wd)
	    name (AREF (compiler:instruction-decode-table) op)
	    no-reg (GET name 'compiler::no-reg))
      (COND
	((EQ no-reg 'nil) ;Ï1; does use registerÏ*
	 (search-address fef (LDB si:%%qmi-register wd) (LDB si:%%qmi-offset wd) nil pc))
	((EQ name 'compiler::push-long-fef)
	 (search-address fef 0 (LDB si:%%qmi-fef-offset wd) nil pc))
	(t nil))
      ilen)))

#-elroy
(DEFUN Ï4search-instructionÏ* (fef pc)
  (LET (wd op subop dest reg disp ilen second-word)
    (SETQ ilen (compiler:disassemble-instruction-length fef pc))
    (BLOCK ()
      (SETQ wd (compiler::disassemble-fetch fef pc))
      (SETQ op (LDB (BYTE 4 11) wd)
            subop (LDB (BYTE 3 15) wd)
            dest (LDB (BYTE 2 16) wd)
            disp (LDB (BYTE 11 0) wd)
            reg (LDB (BYTE 3 6) wd))
      (COND ((= ilen 2)
             (INCF pc)
             (SETQ second-word (compiler::disassemble-fetch fef pc))
             ;Ï1; If a two-word insn has a source address, it must be an extended address,Ï*
             ;Ï1; so set up REG and DISP to be right for that.Ï*
             (UNLESS (= op 14)
               (SETQ reg (LDB (BYTE 3 6) second-word)
                     disp (DPB (LDB (BYTE 4 11) second-word) (BYTE 4 6) (LDB (BYTE 6 0) second-word))))))
      (WHEN (< op 11) (SETQ op (LDB (BYTE 5 11) wd)))
      (COND ((ZEROP wd)) ;Ï1; Don't know what this is, but it's uninteresting.Ï*
            ((< op 14)   ;Ï1; Standard opÏ*
             (search-address fef reg disp second-word pc))
            ((= op 14))  ;Ï1; Branch opÏ*
            ((= op 15)   ;Ï1; Misc opÏ*
             (IF (LOGTEST 1 subop)
                 (SETQ disp (+ disp 1000)))
             (COND ((< disp 240)
                    (AND (ZEROP dest) (RETURN)))
                   ((OR (= disp 460) (= disp 510)) (SETQ dest ()))))
            ;Ï1;Don't know what these are either, but some of them are interesting.Ï*
            ((= op 16)                                ;Ï1ND4Ï*
             (CASE subop
                   (5 (search-address fef reg disp second-word pc))
                   (6 (search-address fef reg disp second-word pc))))))
    ilen))

;Ï1; Searches an instruction source address for instance variables and message (keyword) references.Ï*
;Ï1; REG is the register number of the address, and DISP is the displacement.Ï*
;Ï1; SECOND-WORD should be the instruction's second word if it has two.Ï*
;Ï1; PC should be where the instruction was found in the FEF.Ï*
#+elroy
(DEFUN Ï4search-addressÏ* (fef reg offset ignore &optional pc &aux tem)
  (DECLARE (SPECIAL *collected-ivars*))
  (CASE reg
    (0 (search-pointer fef offset pc))
    (1 (search-pointer fef (+ offset 64.) pc))
    (2 (search-pointer fef (+ offset 128.) pc))
    ;Ï1; Instance variableÏ*
    (4 (LET* ((mapped (LDB-TEST si:%%qmi-ivar-mapped offset)))
	 (SETQ offset (LDB si:%%qmi-ivar-index offset))
	 (IF mapped
	     (WHEN (SETQ tem (compiler::disassemble-mapped-instance-var-name fef offset))
	       (PUSHNEW tem *collected-ivars*))
	     (WHEN (SETQ tem (compiler::disassemble-instance-var-name fef offset))
	       (PUSHNEW tem *collected-ivars*)))))
    (otherwise nil)))

#-elroy
(DEFUN Ï4search-addressÏ* (fef reg disp second-word &optional pc)
  (LET (tem)
    (DECLARE (SPECIAL *collected-ivars*))
    ;Ï1; Taken from COMPILER:DISASSEMBLE-ADDRESSÏ*
    ;Ï1; In a one-word instruction, the displacement for types 4 thru 7 is only 6 bits,Ï*
    ;Ï1; so ignore the rest.  In a two word insn, we have been fed the full disp from word 2.Ï*
    (IF (AND (>= reg 4) (NOT second-word))
        (SETQ disp (LOGAND 77 disp)))
    (COND ((< reg 4)
           (search-pointer fef disp pc))
          ((< reg 7))
          ((AND (NOT second-word) (= disp 77)))
          ;Ï1; I couldn't ever find a case where this one happens, but included it anyway.Ï*
          ((< disp 40)
           (WHEN (SETQ tem (compiler:disassemble-instance-var-name fef disp))
             (PUSHNEW tem *collected-ivars*)))
          ;Ï1; Ditto hereÏ*
          ((< disp 70)
           (WHEN (SETQ tem (compiler:disassemble-mapped-instance-var-name fef (- disp 40)))
             (PUSHNEW tem *collected-ivars*))))))

;Ï1 TAC 09-05-89 - this gets redefined in ti-env-flavor-inspector-interface.lisp Ï*
(DEFUN Ï4search-pointerÏ* (fef disp pc)
  (LET (tem)
    (DECLARE (SPECIAL *collected-ivars* *collected-messages*))
    pc ;Ï1; keep compiler from complainingÏ*
    ;Ï1; Make sure DISP argument is reasonable.Ï*
    (UNLESS (< disp (si:%structure-boxed-size fef))
      (FERROR nil "Ï3Offset ~d. into function is not in function ~s's boxed-Q areaÏ*" disp fef))
    (COND ((= (si:%p-data-type-offset fef disp) dtp-self-ref-pointer)
           (MULTIPLE-VALUE-BIND (ptr component-flavor-flag)
               (si::flavor-decode-self-ref-pointer 
		 (si::fef-flavor-name fef)
                 (si:%p-pointer-offset fef disp))
             (WHEN ptr
               (UNLESS component-flavor-flag
                 (PUSHNEW ptr *collected-ivars*))))) ;Ï1; Collect the instance variable!!Ï*
          ;Ï1; Don't think this ever refers to ivars or keywords.Ï*
          ((= (si:%p-data-type-offset fef disp) dtp-external-value-cell-pointer))
          (t
           (SETQ tem (%p-contents-offset fef disp))
           ;Ï1; When argument is a keyword and the operation is a call (FUNCALL or SEND),Ï*
           ;Ï1; assume it is a message.  There's also a special case caused by the popular (SEND <foo> :SEND-IF-HANDLES :bar) featureÏ*
           ;Ï1; which is covered here.  :BAR is included as a referenced message, even though it is technically just a keyword.Ï*
           (WHEN (AND (SYMBOLP tem) (KEYWORDP tem))
             (PUSHNEW tem *collected-messages*))))))

(DEFMETHOD Ï4(show-method-details :helpÏ*) ()
  (FORMAT nil "
The inspection pane you just selected is currently displaying information about method
~s.  Included are the following:

  Source File                   -- The file in which ~s is defined
  Method Combination Type       -- Determines the manner in which methods are combined.
                                   The standard type is :DAEMON combination. It allows :BEFORE, :AFTER, and :AROUND demons.
  Arglist                       -- The argument list of the method, as specified in DEFMETHOD (or DEFWRAPPER).
                                   Note that this is actually the CDR of the method's argument list.  The first argument
                                   of every method is automatically SI:.OPERATION.
  Documentation                 -- The documentation string of the method, as specified in DEFMETHOD (or DEFWRAPPER).
  Referenced Instance Variables -- The instance variables which the method's compiled code refers to.  These instance
                                   variables are mouse sensitive to allow searching for other methods which reference them.
  Referenced Keywords           -- Symbols in the keyword package which the method's compiled code refers to.
                                   Often this can be used to determine what messages a method sends, since almost all messages
                                   are keywords.  However, there is no way to distinguish a message from any other keyword,
                                   so take this listing at face value."
	  (CDAR aux-data) (CDAR aux-data)))

(DEFFLAVOR Ï4show-messageÏ* () (auxiliary-data-mixin inspection-data))

;Ï1; Print message followed by responsible flavors.Ï*
(DEFMETHOD Ï4(show-message :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~40sÏ*" aux-data))

(DEFMETHOD Ï4(show-message :who-line-docÏ*) (IGNORE &optional ignore)
  '(:mouse-any "Ï3Show the method combination for the message handler for this flavor.Ï*"))

(DEFMETHOD Ï4(show-message :handle-mouse-clickÏ*) (IGNORE flavor-inspector)
  (SEND flavor-inspector :inspect-thing 'show-message-handlers
	;Ï1; Make a fake method spec list.  This doesn't hurt anything.  This flavor may notÏ*
	;Ï1; have a real method spec entry in its method table, in cases where it inherits methods from component flavors.Ï*
	data (LIST :method (si::flavor-name data) aux-data)))

(DEFFLAVOR Ï4show-message-handlersÏ* () (auxiliary-data-mixin flavor-operation-mixin))

(DEFMETHOD Ï4(show-message-handlers :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s's message handlers for ~sÏ*"
	  (SECOND aux-data) (OR (FOURTH aux-data) (THIRD aux-data))))


(DEFMETHOD Ï4(show-message-handlers :generate-itemÏ*) ()
  (LET* ((flavor-name (SECOND aux-data))
         (message (OR (FOURTH aux-data) (THIRD aux-data)))
	 (methods (find-combined-methods flavor-name message)))
	 ;Ï1; Create a fake flavor-method-table for use below in COLLECT-METHOD-ITEMS.  This is a smludge.Ï*
    (SETQ methods (LOOP for method in methods
                        for message = (OR (FOURTH method) (THIRD method))
                        for entry = (ASSOC message (si::flavor-method-table (GET (SECOND method) 'si::flavor)) :test #'EQ)
                        collect `(,message ,(SECOND entry) ,(THIRD entry)
				  ;Ï1,(ASSOC METHOD (CDDDR ENTRY))Ï*
				  ,(CADDDR entry))))
    (MULTIPLE-VALUE-BIND (items special-comb?)
      (collect-method-items (m tpl methods) t nil t)
      (VALUES
       `(,*blank-line-item*
	 ((:font 1 "Ï3Methods called in handling message Ï*")
          (:font 1 ,(FORMAT () "Ï3~sÏ*" message))
	  (:font 1 "Ï3 for flavor Ï*")
          (:item1 instance ,(allocate-data 'show-flavor data))
	  (:font 1 ,(IF special-comb? "Ï3.Ï*" "Ï3:Ï*")))
	 ,@(WHEN special-comb?
	     '(((:font 1 "Ï3 * = special method combination typeÏ*"))))
	 ,*blank-line-item*
         ,*method-display-columns-2*
         ;Ï1; Options are: T=always true predicate; NIL=don't include :COMBINED; T=include flavor names.Ï*
         ,@items)
       `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~s\'s message handlers for ~sÏ*" flavor-name message))))))

;Ï1; Once again, what do you do with non-demons??  Depends on method combination.Ï*
;Ï1; Taken from ZWEI:FIND-COMBINED-METHODSÏ*
(DEFUN Ï4find-combined-methodsÏ* (flavor message)
  "Ï2Return a list of the non-combined methods involved in handling MESSAGE for FLAVORÏ*"
  (LET (fl sm method dbi)
    (COND
      ;Ï1; FLAVOR's methods have been compiled since it has a method hash table, so we can make use of DEBUGGING-INFO.Ï*
      ((si::flavor-method-hash-table (SETQ fl (GET flavor 'si::flavor)))
       (SETQ method
             (FUNCTION-NAME (IF (si::flavor-get fl :abstract-flavor)
                                (NTH-VALUE 1 (FDEFINEDP `(:method ,flavor :combined ,message)))
                                (IGNORE-ERRORS (si::get-flavor-handler-for flavor message)))))
       (SETQ dbi (si:get-debug-info-struct method t))
;Ï1       (COND ((SETQ SM (CDDDR (OR (CADR Ï*
;				Ï1    (ASSOC 'SI::COMBINED-METHOD-DERIVATIONÏ*
;Ï1                                               (DEBUGGING-INFO (SI:UNENCAPSULATE-FUNCTION-SPEC METHOD)) :TEST #'EQ)Ï*
       (COND ((SETQ sm (CDDDR (OR (GETF (si:get-debug-info-field dbi :plist) :combined-method-derivation)  ;Ï1?????Ï*
                                  (si:function-spec-get method 'si::combined-method-derivation))))
              ;Ï1; Try to approximate the orderÏ*	Ï1in which they're calledÏ*
              (NCONC (REVERSE (CDR (ASSOC :wrapper sm :test #'EQ)))
                     (REVERSE (CDR (ASSOC :around sm :test #'EQ)))
                     (REVERSE (CDR (ASSOC :before sm :test #'EQ)))
                     (REVERSE (CDR (ASSOC () sm :test #'EQ)))
                     (COPY-LIST (CDR (ASSOC :after sm :test #'EQ)))
                     (MAPCAN #'(lambda (x)
                                 (AND (NOT (MEMBER (CAR x) '(:wrapper :around :before nil :after) :test #'EQ))
                                      (REVERSE (CDR x))))
                             sm)))
             (t (LIST method))))
      (t
       ;Ï1; FLAVOR's methods haven't been compiled, so we have to search its component flavors for handlers of MESSAGE.Ï*
       (LET (wrappers
             arounds
             afters
             befores
             others)
         (LABELS ((collect-methods 
		    (flavor)
		    ;Ï1; If we find an entry for MESSAGE, loop through whatever methods are defined.Ï*
		    ;Ï1; A given flavor may have several entries; for instance, a :COMBINED, a :BEFORE, and an :AFTER.Ï*
		    (LOOP for (method-spec) in (CDDDR (ASSOC message (si::flavor-method-table flavor)))
			  do
			  (CASE (THIRD method-spec)
			    (:wrapper (PUSH-END method-spec wrappers))
			    (:around (PUSH-END method-spec arounds))
			    (:after (PUSH method-spec afters))
			    (:before (PUSH-END method-spec befores))
			    (:combined) ;Ï1; We ignore combined since they aren't real useful info.Ï*
			    (t (PUSH-END method-spec others))))))
           (with-recursion ((flavor) fl)
             (collect-methods flavor)
             (DOLIST (comp (si::flavor-includes flavor))
               (recurse (GET comp 'si::flavor)))
             (DOLIST (comp (si::flavor-depends-on flavor))
               (recurse (GET comp 'si::flavor))))
           (collect-methods (GET 'si:vanilla-flavor 'si::flavor))
           (APPEND wrappers arounds afters befores others))))))) 

#|
Ï3These are just note I made while exploring the complexities of archain method combination types,
which need to be handled specially for several of the flavor inspection options.

<remember :OVVERRIDE and :DEFAULT methods--find out what they do.>
Using CADR of method entry doesn't cut it.  You have to search component flavors
 for combination style and order.
"Base flavor last" is the way I usually expect it--base flavor means last component.
"Base flavor first" is backwards.
What to do about user-defined method types, combination styles, and orderings?

:DAEMON 
  befores, base, afters
:DAEMON-WITH-OR
  befores, (OR <:OR of main> <:OR of highest comp> <:OR of next highest> <primary>) ,afters.
  Combination is SUPPOSED to have effect, but doesn't.

:DAEMON-WITH-AND befores, (AND <:AND of least comp> <:AND of second to least> <:AND of main> <primary>), afters
  Combination is SUPPOSED to have effect, but doesn't.

:PROGN  
  befores, primary of main, primary of highest comp, ... afters
  Return value of last primary.  Order doesn't matter.  Can be anything.

:OR
  befores, (OR <primary of main> <primary of highest comp> <primary of next hightest>), afters  --on :BASE-FLAVOR-LAST
  befores, (OR <primary of least> <primary of next least> <primary of main>), afters  --on :BASE-FLAVOR-FIRST

:AND
  befores, (AND <primary of main> <primary of highest comp> <primary of next hightest>), afters  --on :BASE-FLAVOR-LAST
  befores, (AND <primary of least> <primary of next least> <primary of main>), afters  --on :BASE-FLAVOR-FIRST

:APPEND and :NCONC
  Like :AND

:INVERSE-LIST
  befores, primarys, afters --combination order DOES affect it.

:PASS-ON
  befores, primarys, afters --combination order DOES affect it.

:CASE 
  befores, <:CASE of highest>, or if none, (OR <:OR of main> <:OR of highest comp>... <highest primary>), then afters
  --combination DOES affect the :CASE: if :BASE-FLAVOR-first, use <:CASE of lowest>.
    But it doesn't effect the OR.

(DEFFLAVOR q1 () () (:METHOD-COMBINATION (:OR :BASE-FLAVOR-last :bar)))
(DEFMETHOD (q1 :bar) () (PRINT 'p1) nil)
(DEFFLAVOR q2 () () (:METHOD-COMBINATION (:OR :BASE-FLAVOR-last :bar)))
(DEFMETHOD (q2 :bar) () (PRINT 'p2) nil)
(DEFFLAVOR q3 () (q2 q1))
(DEFMETHOD (q3 :bar) () (PRINT 'p3) nil)
(SEND (MAKE-INSTANCE 'q3) :bar)Ï*

|#

;Ï1; Explain how :WRAPPER and :AROUND workÏ*
(DEFMETHOD Ï4(show-message-handlers :helpÏ*) ()
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all methods
which execute when an instance of ~s is sent message ~s.
The methods are displayed roughly in the order in which they are called; for instance,
:BEFORE demons are displayed before the primary method, which is displayed before :AFTER
demons.  [[HOW DO :WRAPPER and :AROUND work??]]

Each method is displayed by its flavor, type, message name, and argument list.  
Further information can be obtained by using the mouse.  Method types are any of the following:
 :AFTER, :AND, :AROUND, :BEFORE, :CASE, :DEFAULT, :OR, :OVERRIDE, :WRAPPER.
If a type is not present, the displayed method is a \"primary method\".  Type :WRAPPER
indicates wrappers (defined via DEFWRAPPER).  The rest are the standard, documented method
types.  Note that :COMBINED methods are not displayed, since they are seen as relatively
uninteresting and tend to add clutter.

Most methods are combined using the default method combination type :DAEMON.  However,
if a displayed method is combined using one of the other combination types (such as
:OR, :AND, or :CASE), an asterisk (*) is placed to the left of the method type.  Clicking
left on the method will show detailed information which includes the type of method 
combination used.Ï*"
	    (si::flavor-name data) (message aux-data)))


(DEFFLAVOR Ï4show-instance-variableÏ* () (inspection-data))

(DEFMETHOD Ï4(show-instance-variable :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~sÏ*" data))

(DEFMETHOD Ï4(show-instance-variable :who-line-docÏ*) (inspection-pane? &optional ignore)
  `(:mouse-l-1
    ,(FORMAT () "Ï3Inspect methods of ~s referencing this variableÏ*"
	     (si::flavor-name (SEND (SEND inspection-pane? :current-object) :data)))
    :mouse-m-1 "Ï3Inspect methods of a specified flavor referencing this variableÏ*")) 

;Ï1; Reads and returns flavor name, with all completion and who-line help active.Ï*
;Ï1; This mimics UCL:HANDLE-READ-FUNCTION.Ï*
(DEFUN Ï4read-flavor-nameÏ* ()
  (DECLARE (:self-flavor ucl::basic-command-loop))
  (LET ((ucl::typein-modes '(flavor-names))
	(ucl::command-loop-typein? self)
	flavor-name)
    (DECLARE (SPECIAL ucl::typein-modes ucl::command-loop-typein?))
    (SEND self :handle-prompt t "Ï3Flavor name: Ï*")
    (SETQ flavor-name (sys::internal-read-form-or-implicit-list))
    (COND
      ((AND (SYMBOLP flavor-name)
            (GET flavor-name 'si::flavor))
       (SEND self :handle-prompt)
       flavor-name)
      (t
       (FORMAT t "Ï3** ~s is not a defined flavorÏ*" flavor-name)
       (SEND self :handle-prompt)
       (THROW 'ucl::command-abort nil))))) 

(DEFMETHOD Ï4(show-instance-variable :handle-mouse-clickÏ*) (blip flavor-inspector)
  (IF (NOT (MEMBER (FOURTH blip) '(#\Mouse-l #\Mouse-m) :test #'EQ))
    (BEEP)
    (SEND flavor-inspector :inspect-thing 'show-methods-referencing-instance-variable
       (IF (EQL (FOURTH blip) #\Mouse-l)
	 (SEND (SEND (THIRD blip) :current-object) :data)
	 (GET (SEND flavor-inspector :funcall-inside-yourself (FUNCTION read-flavor-name))
	      'si::flavor))
       data))) 

(DEFFLAVOR Ï4show-methods-referencing-instance-variableÏ*
	   ()
	   (auxiliary-data-mixin flavor-operation-mixin))

(DEFMETHOD Ï4(show-methods-referencing-instance-variable :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3~s references in ~sÏ*" aux-data (si::flavor-name data)))

(DEFMETHOD Ï4(show-methods-referencing-instance-variable :generate-itemÏ*) ()
  (LET* ((flavor-name (si::flavor-name data)))
    (VALUES
     (MULTIPLE-VALUE-BIND (items special-comb?)
       (collect-method-items (m tpl (si::flavor-method-table data))
	(method-uses-symbol?
	 ;Ï1; Catches (MACRO <fef>) case for wrappers.Ï*
	 (IF (CONSP (CADAR tpl))
	   (CDADAR tpl)
	   (CADAR tpl))
	 aux-data))
       `(,*blank-line-item*
	 ((:font 1 "Ï3Methods of Ï*")
          (:item1 instance ,(allocate-data 'show-flavor data))
	  (:font 1 "Ï3 referencing instance variable Ï*")
	  (:item1 instance ,(allocate-data 'show-instance-variable aux-data))
	  (:font 1 ,(IF special-comb? "Ï3.Ï*" "Ï3:Ï*")))
	 ,@(WHEN special-comb?
	     '(((:font 1 "Ï3 * = special method combination typeÏ*"))))
	 ,*blank-line-item* . ,(IF items
				 (CONS *method-display-columns* items)
				 *no-items*)))
     `(:font fonts:hl12bi :string ,(FORMAT () "Ï3~S references in ~sÏ*" aux-data flavor-name)))))
  
;Ï1;  The two specials are expected by SI:FIND-CALLERS-OF-SYMBOLS-AUX-FEFÏ*
(DEFUN Ï4method-uses-symbol?Ï* (method-fef &special symbol &aux (FUNCTION #'(lambda (IGNORE ignore use)
						(THROW 'found
						       use))))
  (CATCH 'found
    (si::find-callers-of-symbols-aux1 method-fef method-fef symbol function))) 

(DEFMETHOD Ï4(show-methods-referencing-instance-variable :helpÏ*) ()
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all methods of flavor
~s which reference instance variable ~s.

Each method is displayed by its method type, message name, and argument list.  
Further information can be obtained by using the mouse.  Method types are any of the following:
 :AFTER, :AND, :AROUND, :BEFORE, :CASE, :DEFAULT, :OR, :OVERRIDE, :WRAPPER.
If a type is not present, the displayed method is a \"primary method\".  Type :WRAPPER
indicates wrappers (defined via DEFWRAPPER).  The rest are the standard, documented method
types.  Note that :COMBINED methods are not displayed, since they are seen as relatively
uninteresting and tend to add clutter.

Most methods are combined using the default method combination type :DAEMON.  However,
if a displayed method is combined using one of the other combination types (such as
:OR, :AND, or :CASE), an asterisk (*) is placed to the left of the method type.  Clicking
left on the method will show detailed information which includes the type of method 
combination used.Ï*"
	    (si::flavor-name data) aux-data))

(DEFFLAVOR Ï4show-all-flavorsÏ* () (inspection-data)
   ;Ï1; Used just to make allocate-data work on it.  See reference to 'IGNORE below.Ï*
  (:default-init-plist :data 'IGNORE))

(DEFMETHOD Ï4(show-all-flavors :format-conciselyÏ*) (STREAM)
  (FORMAT stream "Ï3All flavorsÏ*"))

(DEFMETHOD Ï4(show-all-flavors :who-line-docÏ*) (IGNORE &optional ignore)
  '(:any "Ï3Inspect this flavor informationÏ*"))

(DEFMETHOD Ï4(show-all-flavors :handle-mouse-clickÏ*) (blip flavor-inspector)
  (SELECTOR (FOURTH blip) =
    (#\Mouse-l-1
     (SEND flavor-inspector :inspect-info-left-click))
    (#\Mouse-m-1
     (SEND flavor-inspector :inspect-info-middle-click))
    ;Ï1; Could we put anything interesting on right click?  MaybeÏ*
    ;Ï1; Flavor-name apropos, or some complex query for locating sets of flavors with common characteristics?Ï*
    (t
     (BEEP))))

(DEFMETHOD Ï4(show-all-flavors :generate-itemÏ*) ()
  (VALUES
   `(,*blank-line-item*
     ((:font 1 "Ï3Currently defined flavors: Ï*"))
     ,*blank-line-item*
     ;Ï1; Sort flavors by package, then alphabeticallyÏ*
     ,@(LOOP for flavor in
	  (SORT (COPY-LIST *all-flavor-names*)
		#'(lambda (f1 f2)
		    (LET ((p1 (PACKAGE-NAME (SYMBOL-PACKAGE f1)))
			  (p2 (PACKAGE-NAME (SYMBOL-PACKAGE f2))))
		      (OR (STRING< p1 p2) (AND (STRING= p1 p2) (STRING< f1 f2))))))
	  collect `((:item1 instance ,(allocate-data 'show-flavor (GET flavor 'si::flavor))))))
   '(:font fonts:hl12bi :string "Ï3All flavorsÏ*")))  


(DEFMETHOD Ï4(show-all-flavors :helpÏ*) ()
  (FORMAT nil "
Ï3The inspection pane you just selected is currently displaying all defined flavors.
The flavors are sorted alphabetically, first by symbol package, then by symbol name.
This makes it easier for you to inspect related flavors, since most related flavors
share the same symbol package.Ï*"))

;Ï1;----------------------------------------------------------------------------------------------Ï*
;Ï1; The rest of this defines the user interface.Ï*
;Ï1;Ï*

(DEFFLAVOR Ï4flavor-inspectorÏ* () (basic-inspect-frame)
  (:default-init-plist
    :active-command-tables '(flavor-inspector-cmd-table)
    :all-command-tables '(flavor-inspector-cmd-table)
    :menu-panes '((menu flavor-inspector-menu))
    :typein-modes '(method-specs flavor-instance flavor-names ucl::command-names)
;Ï1;Function needs to be written.  Include the stuff in Help On Syntax.Ï*
    :basic-help '(fi-doc-cmd)
    :prompt "Ï3Flavor\/Method: Ï*"
    ;Ï1; Activate the special handling of instances of TV:INSPECTION-DATA.Ï*
    ;Ï1; This hack keeps the inspector code from treating mouse-sensitive blips containing TV:INSPECTION-DATAÏ*
    ;Ï1; instances as normal Lisp objects to inspect and lets the instances dictate most inspectorÏ*
    ;Ï1; actions, such as who-line-documentation when mouse is over the printed representation of the instance,Ï*
    ;Ï1; mouse button operations when it is clicked upon, and item generation when the blip is inspected.Ï*
    :inspection-data-active? t))

;Ï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Ï*
(DEFMETHOD Ï4(flavor-inspector :before :initÏ*) (plist)
 ;Ï1; Specify our panes and constraints.  This differs from (TV:INSPECT-FRAME :BEFORE :INIT) only Ï*
 ;Ï1; in some of the who-line messages we provide, which are specific to flavor inspectors.Ï*
  (LET ((noi (OR (GET plist :number-of-inspectors) 3)))
        ;Ï1(iobuf (make-default-io-buffer)))Ï*
    (SETQ panes
	  (LIST `(interactor inspector-interaction-pane
                             :label nil
                             :more-p nil
                             ;Ï1:IO-BUFFER ,IOBUFFÏ*
                             :font-map  ,(LIST (FIRST *inspector-font-map*) (SECOND *inspector-font-map*))
                             :who-line-message
                             "Ï3To inspect a flavor, type its name.  To inspect a method, type <flavor name> <method name>
Press HELP for a help menu, META-HELP for help on typed expressions.  R2: System Menu.Ï*")
                `(history inspect-history-window  ;Ï1-WITH-MARGIN-SCROLLINGÏ*
;Ï1                         :SCROLL-BAR 3Ï*
                         :line-area-mouse-doc (:mouse-l-1 "Ï3Inspect the indicated dataÏ*"
                                                          :mouse-m-1 "Ï3Remove it from the Flavor InspectorÏ*")
                         :normal-mouse-documentation (:mouse-l-1 "Ï3Select data to inspectÏ*"
                                                      :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
                                                      :mouse-r-2 "Ï3System MenuÏ*"))
                `(menu inspector-menu-pane)))
    ;Ï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 () "Ï3INSPECTOR-~DÏ*" i) "Ï3TVÏ*")))
	(PUSH `(,name1 ,(IF (= i (1- noi)) 'inspect-window-with-typeout 'inspect-window)
;Ï1                :SCROLL-BAR 2Ï*
;Ï1                :SCROLL-BAR-ALWAYS-DISPLAYED TÏ*
                ;Ï1; Otherwise we get "More Object Above", etc.Ï*
;Ï1                :MARGIN-SCROLL-REGIONS ((:TOP "Top" "More Above" FONTS:TR8B) (:BOTTOM "Bottom" "More Below" FONTS:TR8B))Ï*
                :current-object-who-line-message 
		,(FUNCTION (lambda (current-object)
			     (COND
			       ((EQUAL current-object '(nil))
				"Ï3Flavor Inspection Pane.  To inspect a flavor, type its name.  To inspect a method, type <flavor name> <method name> Press HELP for a help menu, META-HELP for help on typed expressions.  R2: System Menu.Ï*")
			       ((TYPEP current-object 'flavor-operation-mixin)
				`(:mouse-l-1 "Ï3Select data to inspectÏ*"
					     :mouse-m-1 "Ï3Help on currently displayed dataÏ*"
					     :mouse-m-2 "Ï3Lock/Unlock inspector paneÏ*"
					     :mouse-r-1 ,(FORMAT () "Ï3Menu of operations on flavor ~sÏ*"
								 (si::flavor-name (SEND current-object :data)))))
			       (t '(:mouse-l-1 "Ï3Choose an item to inspectÏ*"))))))
              panes)
	(PUSH name1 inspectors)))
    (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)))))
	    (:debug (,(CAR inspectors) menu-history interactor)
                      ((interactor 45 :lines))
                      ((menu-history
                         :horizontal (4 :lines history)
                         (menu history)
                         ((menu :ask :pane-size))
                         ((history :even))))
                      ((,(CAR inspectors) :even)))
            ))))

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


;Ï1----------------------------------------------------------------------Ï*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE (:method flavor-inspector :before :expose) :aroundÏ*
;	Ï1  :dont-run-if-general-inspector nilÏ*
;Ï1    (IF (TYPEP self 'general-inspector)Ï*
;	Ï1nilÏ*
;	Ï1:do-it)))Ï*
;Ï1----------------------------------------------------------------------Ï*

(DEFMETHOD Ï4(flavor-inspector :before :exposeÏ*) ()
  (UNLESS (TYPEP self 'general-inspector)
    (SEND self :set-configuration *flavor-inspector-configuration*)))
;
;Ï1(DEFWRAPPER (flavor-inspector :HANDLE-PROMPT) ((&OPTIONAL IGNORE use-prompt) . body)Ï*
;Ï1  ;; Makes our prompt print in bold font.  This helps the user to see that he is in theÏ*
;Ï1  ;; Flavor Inspector, instead of the normal inspector, since our prompt is different.Ï*
;Ï1  ;; We also accept an optional prompt argument to use instead of the normal prompt.Ï*
;Ï1  `(LET ((old-prompt UCL:PROMPT))Ï*
;Ï1     (UNWIND-PROTECTÏ*
;	Ï1 (PROGNÏ*
;	Ï1   (SEND user :SET-CURRENT-FONT 1)Ï*
;	Ï1   (WHEN use-promptÏ*
;	Ï1     (SETQ UCL:PROMPT use-prompt))Ï*
;	Ï1   . ,body)Ï*
;Ï1       (SEND user :SET-CURRENT-FONT 0)Ï*
;Ï1       (SETQ UCL:PROMPT old-prompt))))Ï*

(DEFMETHOD Ï4(flavor-inspector :around :handle-promptÏ*) (cont mt ignore &optional ignore use-prompt)
  ;Ï1; Makes our prompt print in bold font.  This helps the user to see that he is in theÏ*
  ;Ï1; Flavor Inspector, instead of the normal inspector, since our prompt is different.Ï*
  ;Ï1; We also accept an optional prompt argument to use instead of the normal prompt.Ï*
  (LET ((old-prompt ucl:prompt))
    (UNWIND-PROTECT
        (PROGN
          (SEND user :set-current-font 1)
          (WHEN use-prompt
            (SETQ ucl:prompt use-prompt))
          (FUNCALL-WITH-MAPPING-TABLE cont mt :handle-prompt))
          (SEND user :set-current-font 0)
          (SETQ ucl:prompt old-prompt))))

;Ï1; This cdr-codes *ALL-FLAVOR-NAMES*, resulting in less paging during searches.Ï*
(SETQ *all-flavor-names* (COPY-LIST *all-flavor-names*))

;Ï1; Note--I'm not sure this works all that well, though it should.  Auto-completion is LIGHTENINGÏ*
;Ï1; fast after the first completion--check it out.  This *should* succeed in paging in the same codeÏ*
;Ï1; that the first auto-completion takes time to.Ï*
(DEFMETHOD Ï4(flavor-inspector :after :selectÏ*) (&rest ignore)
  ;Ï1; This is a hack to get the flavors list and the completion code paged in, so that auto-completion is fast.Ï*
  ;Ï1; Of course, if the user does enough stuff while in the window, it will get paged out.Ï*
  ;Ï1; GET-WORD-COMPLETIONS expects a string, not a symbol so quoted si:vanilla-flavor.Ï*
  (w::get-word-completions "Ï3si:vanilla-flavorÏ*" *all-flavor-names*))

(DEFMETHOD Ï4(flavor-inspector :update-*Ï*) ()
  (LET* ((items (SEND history :items))
	 (nitems (IF items (ARRAY-ACTIVE-LENGTH items) 0)))
    (IF(>= nitems 1) (COND ((CONSP (AREF items (- nitems 1)))
			    (SETQ * (CAR (SEND (AREF items (- nitems 1)) :send-if-handles :aux-data))))
			   ((EQ 'IGNORE (SEND (AREF items (- nitems 1)) :data))
			    t)
			   (t (OR (SETQ * (SEND (AREF items (- nitems 1)) :send-if-handles :aux-data))
				  (SETQ * (si::flavor-name (SEND (AREF items (- nitems 1)) :data)))))))
    (IF (>= nitems 2)(COND ((CONSP (AREF items (- nitems 2)))
			    (SETQ ** (CAR (SEND (AREF items (- nitems 2)) :send-if-handles :aux-data))))
			   ((EQ 'IGNORE (SEND (AREF items (- nitems 2)) :data))
			    t)
			   (t (OR (SETQ ** (SEND (AREF items (- nitems 2)) :send-if-handles :aux-data))
				  (SETQ ** (si::flavor-name (SEND (AREF items (- nitems 2)) :data)))))))
    (IF (>= nitems 3)(COND ((CONSP (AREF items (- nitems 3)))
			    (SETQ *** (CAR (SEND (AREF items (- nitems 3)) :send-if-handles :aux-data))))
			   ((EQ 'IGNORE (SEND (AREF items (- nitems 3)) :data))
			    t)
			   (t (OR (SETQ *** (SEND (AREF items (- nitems 3)) :send-if-handles :aux-data))
				  (SETQ *** (si::flavor-name (SEND (AREF items (- nitems 3)) :data)))))))))

(DEFMETHOD Ï4(flavor-inspector :name-for-selectionÏ*) () name)
;Ï1(ADD-SYSTEM-KEY #\o 'flavor-inspector "Flavor Inspector -- A utility for examining the structure of flavors.")Ï*

;Ï1;-------------------------------------------------------------------------------------Ï*
;Ï1; This code implements the expression processors which allow the user to type (and complete on)Ï*
;Ï1; flavor and method names for inspection. It defines two typein-modes: flavor names and method Ï*
;Ï1; specs.Ï*
;Ï1;Ï*

(DEFFLAVOR Ï4flavor-namesÏ* () (ucl:typein-mode)
  (:default-init-plist
   :auto-complete-p t))

(DEFFLAVOR Ï4flavor-instanceÏ* () (ucl:typein-mode)
  (:default-init-plist
    :auto-complete-p t))

;Ï1; Allow completion when flavor name is typed alone AND when it is typed as part of a method specÏ*
(DEFMETHOD Ï4(flavor-names :complete-pÏ*) (syntax)
  (WHEN (MEMBER syntax '(:first-atom :function) :test #'EQ)
    "Ï3Flavor NamesÏ*")) 

(DEFMETHOD Ï4(flavor-names :completeÏ*) (word type)
  (CASE type
    (:recognition (w::get-word-completions word *all-flavor-names*))
    (:apropos
     (MULTIPLE-VALUE-BIND (name pkg)
       (w::separate-name-from-package word)
       (WHEN (PLUSP (LENGTH name))
	 (UNLESS pkg
	   (SETQ pkg *package*))
	 (LOOP for flavor-name in *all-flavor-names*
               when (AND (LET ((fnpkg (SYMBOL-PACKAGE flavor-name)))
                           (OR (EQ fnpkg pkg) (MEMBER fnpkg (PACKAGE-USE-LIST pkg) :test #'EQ)))
                         (SEARCH (THE string (STRING name)) (THE string (STRING flavor-name)) :test
                                 #'CHAR-EQUAL))
               collect flavor-name))))
    (:spelling-corrected
     (MULTIPLE-VALUE-BIND (name pkg)
       (w::separate-name-from-package word)
       (w::spell (INTERN name pkg) *all-flavor-names*))))) 


(DEFMETHOD Ï4(flavor-names :handle-typein-pÏ*) (expression type)
  (COND ((AND (MEMBER type '(first-atom atom symbol) :test #'EQ) (SYMBOLP expression)
       (GET expression 'si::flavor))
	 (VALUES self ()))			
	((AND (SYMBOLP expression) (BOUNDP expression))
	    (SEND   self :handle-typein-p (SYMBOL-VALUE expression) (TYPE-OF (SYMBOL-VALUE expression))))
	(t (VALUES () (FORMAT nil "Ï3~s is not a defined flavor Ï*" expression)))))

(DEFMETHOD Ï4(flavor-instance :handle-typein-pÏ*) (expression type)
  (IF (NOT (CONSP expression))
	   (IF (NOT (AND (SYMBOLP expression) (BOUNDP expression)))
	       (VALUES () (FORMAT nil "Ï3~s is not a defined flavor 2Ï*" expression))
	       (COND ((INSTANCEP (EVAL expression))
		      (IF (AND (MEMBER type '(first-atom atom symbol) :test #'EQ) (SYMBOLP expression)
			       (GET (TYPE-OF (EVAL expression)) 'si::flavor))
			  (VALUES self ())
			  (VALUES () (FORMAT nil "Ï3~s is not a defined flavor Ï*" expression))))
		     ((AND (SYMBOLP expression) (BOUNDP expression))
		      (SEND   self :handle-typein-p (SYMBOL-VALUE expression) (TYPE-OF (SYMBOL-VALUE expression))))
		     (t (VALUES () (FORMAT nil "Ï3~s is not a defined flavorÏ*" expression)))))  
	   (VALUES () (FORMAT nil "Ï3~s is not a defined flavorÏ*" expression))))

(DEFMETHOD Ï4(flavor-names :executeÏ*) (flavor-inspector)
  (DECLARE (SPECIAL ucl::inhibit-results-print?))
  (IF (AND (SYMBOLP -) (BOUNDP -))
      (SETQ - (SYMBOL-VALUE -)))
  (LET* ((history (SEND flavor-inspector :history))
	 (flavor
	  (inspect-real-value
	   `(:value ,(allocate-data 'show-flavor (GET - 'si::flavor)) ,history))))
	 ;Ï1; Might not work since not EQÏ*
    (inspect-flush-from-history flavor history)
    (SEND history :append-item flavor)
    (update-panes)
    ;Ï1; We don't want our result to be printed.Ï*
    (SETQ ucl::inhibit-results-print? t)))

(DEFMETHOD Ï4(flavor-instance :executeÏ*) (flavor-inspector)
  (DECLARE (SPECIAL ucl::inhibit-results-print?))
  (IF (AND (SYMBOLP -) (BOUNDP -))
      (SETQ - (SYMBOL-VALUE -)))
  (LET* ((history (SEND flavor-inspector :history)) 
	 (flavor
	  (inspect-real-value
		`(:value ,(allocate-data 'show-flavor (GET (TYPE-OF (EVAL -)) 'si::flavor)) ,history))))
	 ;Ï1; Might not work since not EQÏ*
    (inspect-flush-from-history flavor history)
    (SEND history :append-item flavor)
    (update-panes)
    ;Ï1; We don't want our result to be printed.Ï*
    (SETQ ucl::inhibit-results-print? t)))

(DEFMETHOD Ï4(flavor-names :arglistÏ*) (symbol)
  (IF (AND (SYMBOLP symbol) (GET symbol 'si::flavor))
      (FORMAT nil "Ï3Flavor ~SÏ*" symbol)
      (VALUES nil (FORMAT nil "Ï3~S is not a defined flavorÏ*" symbol))))

(DEFFLAVOR Ï4method-specsÏ* () (ucl:typein-mode)
  (:default-init-plist
    :auto-complete-p t))

;Ï1; Allow completion when flavor name is typed alone AND when it is typed as part of a method specÏ*
(DEFMETHOD Ï4(method-specs :complete-pÏ*) (syntax)
  (WHEN (EQ syntax :atom)
    "Ï3MethodsÏ*"))

(DEFPARAMETER Ï4*method-types*Ï*
   '(:after :and :around :before :case :default :or :override :wrapper)) 

(defun-rh Ï4get-method-expressionÏ* ()
  (LET* ((first-word-start (rh-word-start 1))
	 (first-word-end (rh-word-end first-word-start))
	 (second-word-start (rh-word-start (1+ first-word-end)))
	 (second-word-end (MIN (rh-word-end second-word-start) (1- (rh-typein-pointer)))))
    (VALUES
      (READ-FROM-STRING (rh-substring-of-buffer first-word-start first-word-end))
      (READ-FROM-STRING (rh-substring-of-buffer second-word-start second-word-end))
      (UNLESS (= second-word-end (1- (rh-typein-pointer)))
	(rh-word-start (1+ second-word-end) t)))))

(DEFMETHOD Ï4(method-specs :completeÏ*) (word type)
  (MULTIPLE-VALUE-BIND (flavor-name second-word more-than-two-words?)
    (SEND *standard-input* :funcall-inside-yourself (FUNCTION get-method-expression))
    (LET* ((flavor (GET flavor-name 'si::flavor))
	   (operations
	    (WHEN flavor
	     ;Ï1; Prevent completion from completing method types more thanÏ*
	     ;Ï1; once (example: TV:WINDOW :AFTER :AFTER :SELECT).Ï*
	      (IF more-than-two-words?
		(WHEN (MEMBER second-word *method-types* :test #'EQ)
		  (si::flavor-method-table flavor))
		(APPEND *method-types* (si::flavor-method-table flavor))))))
      (WHEN flavor
	(LOOP for completion in
	   (CASE type
	     (:recognition (w::get-word-completions word operations))
	     (:apropos (w::list-apropos (SUBSEQ word 1) operations :dont-print t))
	     (:spelling-corrected (w::spell word operations)))
	   collect (ucl::first-if-list completion)))))) 

(DEFMETHOD Ï4(method-specs :handle-typein-pÏ*) (expression type)
  (IF (NOT (CONSP expression))
      (IF (AND (SYMBOLP expression) (BOUNDP expression))
	  (IF (CONSP (SYMBOL-VALUE expression))
	      (SETQ expression (CDR (SYMBOL-VALUE expression)) type ':implicit-list)
	      (SETQ expression (SYMBOL-VALUE expression)))
	  (VALUES () (FORMAT nil "Ï3~s is not a defined flavor Ï*" expression))))
  (WHEN (MEMBER type '(:implicit-list cons) :test #'EQ)
   ;Ï1; Make it (:method <flavor-name> <message-name>) or (:method <flavor-name> <type> <message-name>)Ï*
   ;Ï1; or even (:method <flavor-name> :CASE <message-name> <submessage>)Ï*
    (PUSH :method expression)
    (COND
     ;Ï1; Error if no method suppliedÏ*
     ((NULL (THIRD expression))
      (VALUES () (FORMAT () "Ï3No method supplied.  Press META- for correct syntax.Ï*")))
     ;Ï1; Error if too many args supplied.Ï*
     ((IF (MEMBER (THIRD expression) *method-types* :test #'EQ)
	(IF (EQ (THIRD expression) :case)
	  (SIXTH expression)
	  (FIFTH expression))
	(FOURTH expression))
      (VALUES () (FORMAT () "Ï3Extraneous arguments.  Press META- for correct syntax.Ï*")))
     ;Ï1; Good method spec => we'll :EXECUTE the expression.Ï*
     ((FDEFINEDP expression) (VALUES self ()))
     ;Ï1; Bad method name.Ï*
     ((GET (SECOND expression) 'si::flavor)
      (VALUES () (FORMAT () "Ï3~{~s ~}is not a defined method.Ï*" (CDR expression))))
     ;Ï1; Bad flavor name.Ï*
     (t (VALUES () (FORMAT () "Ï3~s is not a defined flavorÏ*" (SECOND expression))))))) 

(DEFMETHOD Ï4(method-specs :executeÏ*) (flavor-inspector)
  (DECLARE (SPECIAL ucl::inhibit-results-print?))
  (IF (AND (SYMBOLP -) (BOUNDP -))
      (SETQ -(CDR (SYMBOL-VALUE -))))
  (LET* ((history (SEND flavor-inspector :history))
	 (flavor (GET (CAR -) 'si::flavor))
	 (method
	  (inspect-real-value
	   `(:value
	     ,(allocate-data 'show-method-details flavor
	       (CAR
		 (CDDDR
		       (ASSOC (OR (THIRD -) (SECOND -)) (si::flavor-method-table flavor) :test
			      #'EQ))))
	     ,history))))
    (inspect-flush-from-history method history)
    (SEND history :append-item method)
    (update-panes)
    ;Ï1; We don't want our result to be printed.Ï*
    (SETQ ucl::inhibit-results-print? t))) 

(DEFMETHOD Ï4(method-specs :arglistÏ*) (symbol)
  (LET (flavor)
    (WHEN (VARIABLE-BOUNDP ucl::command-loop-typein?)
      (MULTIPLE-VALUE-BIND (flavor-name second-word more-than-two-words?)
          (SEND (SEND ucl::command-loop-typein? :user) :funcall-inside-yourself
                (FUNCTION get-method-expression))
        (COND
          ((NULL (SETQ flavor (GET flavor-name 'si::flavor))))
          ((AND (NOT more-than-two-words?) (MEMBER second-word *method-types* :test #'EQ))
           (FORMAT () "Ï3method type ~sÏ*" second-word))
          (t
           (LET* ((spec
                    (IF more-than-two-words?
                        `(:method ,flavor-name ,second-word ,symbol)
                        `(:method ,flavor-name ,symbol)))
                  (ARGLIST (WHEN (FDEFINEDP spec)
                             (ARGLIST spec))))
             (COND
               ((NULL arglist) (VALUES () "Ï3Not a defined methodÏ*"))
               ((CDR arglist) (FORMAT () "Ï3Method ~s  ~sÏ*" symbol (CDR (ARGLIST spec))))
               (t (FORMAT () "Ï3Method ~s  ()Ï*" symbol)))))))))) 


(DEFPARAMETER Ï4flavor-namesÏ* (MAKE-INSTANCE 'flavor-names)) 
(DEFPARAMETER Ï4method-specsÏ* (MAKE-INSTANCE 'method-specs))
(DEFPARAMETER Ï4flavor-instanceÏ* (MAKE-INSTANCE 'flavor-instance))

;Ï1; The following is that code necessary to link the Flavor Inspector to the normal Inspector.Ï*
 
;Ï1; Define a command to allow the user to inspect flavors and methods from within the normal inspector.Ï*
;Ï1(DEFCOMMAND Flavor-Inspect-CMD NILÏ*			
;Ï1            '(:DESCRIPTION Ï*
;Ï1             "Flavor Inspect a Flavor or Method."Ï*
;Ï1              :NAMES ("FlavIns") :KEYS (#\h-F))Ï*
;Ï1            (DECLARE (SPECIAL USER HISTORY = INSPECTORS FRAME)) (SEND USER :CLEAR-SCREEN)Ï*
;Ï1            (FORMAT USER "~&Object to Flavor Inspect:")Ï*
;Ï1            (MULTIPLE-VALUE-BIND (VALUE PUNT-P) (INSPECT-GET-VALUE-FROM-USER USER HISTORY INSPECTORS)Ï*
;Ï1              (OR PUNT-P (Flavor-Inspect VALUE)))Ï*
;Ï1            (SEND FRAME :HANDLE-PROMPT))Ï*
 
;Ï1; Add the new command to the list of inspector menu commands.  Ï*
;Ï1;;(Setq INSPECTOR-MENU-CMDS (Cons 'Flavor-Inspect-CMD (delete 'Flavor-Inspect-CMD INSPECTOR-MENU-CMDS)))Ï*
 
;Ï1; Now rebuild all of the command tables and menus for the inspector.  Copied from the inspector sources.Ï*
;Ï1(BUILD-COMMAND-TABLE 'INSPECTOR-MENU-CMD-TABLE 'INSPECT-FRAME INSPECTOR-MENU-CMDS :INIT-OPTIONSÏ*	
;Ï1                     '(:NAME "Inspector menu commands")) Ï*
 
;Ï1(BUILD-COMMAND-TABLE 'inspector-other-cmd-table 'inspect-frameÏ*
;Ï1  inspector-non-menu-cmdsÏ*
;Ï1  :INIT-OPTIONSÏ*
;Ï1  '(:NAME "Other Inspector commands"))Ï*
 
;Ï1(BUILD-MENU 'UCL-INSPECTOR-MENU 'INSPECT-FRAME :DEFAULT-ITEM-OPTIONS `(:FONT ,inspect-standard-font)Ï*	
;Ï1            :ITEM-LIST-ORDER INSPECTOR-MENU-CMDS)  Ï*

;Ï1; Now throw away all previous inspector frames which will not have the new command.Ï*
;Ï1(clear-resource 'tv:inspect-frame-resource)Ï*

;Ï1;  Modified to fit into 604x432 window on MicroExplorer or 688x432 window on ExplorerÏ*
;Ï1;  Added :names option to make menu name shorter - 11/19/87 CATÏ*
(DEFCOMMAND Ï4(flavor-inspector :help-on-syntaxÏ*) ()
  '(:names ("Ï3Syntax HelpÏ*")
    :keys #\Meta-help
    :description "Ï3Prints help on the processing of typed expressions.Ï*")
  (SEND self :format-message
	"
You may type any of the following expressions:

-- a flavor name to inspect, terminated by pressing the RETURN key
-- a method specification to inspect.  The syntax is
     (Flavor-Name Method-Name)
   or
     (Flavor-Name Method-Type Method-Name)
   or
     Flavor-Name Method-Name
   or    
     Flavor-Name Method-Type Method-Name

   The last two types of expressions are terminated by pressing the RETURN key.
   Method-Type is one of the following:
     :AFTER :AND :AROUND :BEFORE :CASE :DEFAULT :OR :OVERRIDE :WRAPPER


While typing these expressions, you may press the SPACE Bar to complete a flavor
or method name.  You may also use the Input Editor completion commands summarized
below:

   CTRL-ESCAPE  -- Recognition Completion (same as the SPACE Bar)
   CTRL-\/      -- List Recognition Completions
   SUPER-ESCAPE -- Apropos Completions (complete word as an inner substring)
   SUPER-\/     -- List Apropos Completions
   HYPER-ESCAPE -- Spelling Corrected Completion (corrects minor typos)
   HYPER-\/     -- List Spelling Corrected Completions"))


(DEFCOMMAND Ï4(flavor-inspector :help-on-inspected-dataÏ*) ()  
   '(:keys #\Mouse-m       ;Ï1; mouse-m-1 before xlateÏ*
     :description "Ï3Information about the data currently displayed in an inspection pane.Ï*")
   (IF (MEMBER (THIRD ucl::kbd-input) inspectors :test #'EQ)
     (LET* ((inspection-data (SEND (THIRD ucl::kbd-input) :current-object))
	    (help
	     (WHEN (TYPEP inspection-data 'inspection-data)
	       (SEND inspection-data :send-if-handles :help))))
       (IF (EQUAL inspection-data '(nil))
	 (SEND self :format-message "
Ï3MOUSE M is inactive when the inspection pane is empty.Ï*")
	 (SEND self :format-message (OR help "
Ï3No help is available on this data.Ï*"))))
     (BEEP))) 

(DEFCOMMAND Ï4(flavor-inspector :options-menuÏ*) ()  
   '(:keys #\Mouse-r 
     :description "Ï3A menu of options for the selected (moused) inspection pane.Ï*")
   (IF (MEMBER (THIRD ucl::kbd-input) inspectors :test #'EQ)
     (LET ((inspection-data (SEND (THIRD ucl::kbd-input) :current-object))
	   *flavor-data*)
       (DECLARE (SPECIAL *flavor-data*))
       (COND
	 ((EQUAL inspection-data '(nil))
	  (SEND self :format-message "Ï3MOUSE R is inactive when the inspection pane is empty.Ï*"))
	 ((TYPEP inspection-data 'flavor-operation-mixin)
	  (SETQ *flavor-data* (SEND inspection-data :data))
	  (LET ((call-edit nil))
                   (DECLARE (SPECIAL *flavor-data* call-edit))
                   (w:menu-choose *flavor-options-menu*
                                          :label (FORMAT nil "Ï3Operations on ~SÏ*" (si::flavor-name *flavor-data*))
                                          :scrolling-p nil)
		   (IF call-edit
		       (ED (si::flavor-name *flavor-data*)))
		   ))))
;	Ï1  (w:MENU-CHOOSE *FLAVOR-OPTIONS-MENU*Ï*	
;Ï1                         :LABEL (FORMAT () "Operations on ~S" (SI:FLAVOR-NAME *FLAVOR-DATA*))Ï*	
;Ï1                         :scrolling-p nil))))Ï*
     (BEEP))) 

(DEFCOMMAND Ï4(flavor-inspector :end-cmdÏ*) ()
  '(:description "Ï3Exit the Flavor Inspector.Ï*"
    :names ("Ï3ExitÏ*")
    :keys (#\End))
  (SEND self :bury))    ;Ï1; changed from :bury, this returns the frame to its resourceÏ*

(DEFCOMMAND Ï4(flavor-inspector :all-flavorsÏ*) ()
  '(:description "Ï3Display all flavor names in an inspection frameÏ*"
    :documentation "Ï3...permits user to select a flavor to inspect...Ï*"
    :keys #\Super-a)
  (LET ((flavors (inspect-real-value `(:value ,(allocate-data 'show-all-flavors 'IGNORE) ,history))))
    ;Ï1; Might not work since not EQÏ*
    (inspect-flush-from-history flavors history)
    (SEND history :append-item flavors)
    (update-panes)
    ;Ï1; We don't want our result to be printed.Ï*
    (SETQ ucl:inhibit-results-print? t))) 

(DEFCOMMAND Ï4config-toggle-cmdÏ* nil
            '(:description  "Ï3Select a new Flavor-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 flavor-inspector configurationÏ*" :scrolling-p nil)))
              (delaying-screen-management 
                (COND (new-cfg
                       (SETQ *flavor-inspector-configuration* new-cfg)
                       (SEND frame :set-configuration new-cfg))))))

(DEFCOMMAND Ï4modeÏ* ()
   '(:description "Ï3Toggle between Lisp mode and Inspect mode.Ï*"
     :names ("Ï3ModeÏ*")
     :keys (#\s-m))
   (DECLARE (SPECIAL ucl::typein-modes ucl::prompt))
   (COND
     ((MEMBER 'flavor-names ucl::typein-modes :test #'EQ) (SETQ ucl::prompt "Ï3> Ï*")
      (SETQ ucl::typein-modes ucl::*default-typein-modes*))
     (t (SETQ ucl::prompt "Ï3Flavor\/Method: Ï*")
      (SETQ ucl::typein-modes '(method-specs flavor-instance flavor-names ucl::command-names))))
   (SEND ucl::this-application :handle-prompt)) 


(DEFCOMMAND Ï4(flavor-inspector :trace-methodÏ*) ()
  '(:description "Ï3Traces a specified methodÏ*"
    :names ("Ï3TraceÏ*")
    :keys (#\S-t))
  (DECLARE (SPECIAL ucl:typein-modes ucl:prompt))
  (LET ((method-spec (read-method-spec)))
    (trace-via-menus method-spec)))

;Ï1; Reads and returns flavor spec, with all completion and who-line help active.Ï*
;Ï1; This mimics TV:READ-FLAVOR-NAME.Ï*
(DEFUN Ï4read-method-specÏ* ()
  (DECLARE (:self-flavor ucl::basic-command-loop))
  (LET ((ucl::typein-modes '(method-specs))
	(ucl::command-loop-typein? self)
	method-spec)
    (DECLARE (SPECIAL ucl::typein-modes ucl::command-loop-typein?))
    (SEND self :handle-prompt t "Ï3Method spec: Ï*")
    (SETQ method-spec (CONS :method (sys::internal-read-form-or-implicit-list)))
    (COND
      ((AND (LISTP method-spec) (FDEFINEDP method-spec)) (SEND self :handle-prompt) method-spec)
      (t (FORMAT t "Ï3** ~s is not a defined methodÏ*" method-spec) (SEND self :handle-prompt)
       (THROW 'ucl::command-abort
	      ()))))) 

;Ï1;; Modified to fit into 604x432 window on MicroExplorer or 688x432 window on ExplorerÏ*
;Ï1;; Change command name from doc to help (done in conjunction with changing help-on-syntax name) - 11/19/87 CATÏ*
;Ï1Include the stuff in Help On Syntax.Ï*
(DEFCOMMAND Ï4(flavor-inspector :fi-doc-cmdÏ*) ()
            '(:description 
             "Ï3Display some brief documentation about each of the Flavor-Inspector's panes.Ï*"
             :names ("Ï3HelpÏ*")
             :keys (#\c-help))
  (fi-doc-cmd))

;Ï1;; Modified to fit into 604x432 window on MicroExplorer or 688x432 window on ExplorerÏ*
;Ï1;; Changed text length to to max of 83 char long - 11/19/87 CATÏ*
(DEFUN Ï4fi-doc-cmdÏ* ()
  "Ï2Display some brief documentation about each of the Flavor-Inspector's panes.Ï*"
  (si:with-help-stream (window :label "Ï3Documentation for Flavor-InspectorÏ*" :superior tv:default-screen)
    (FORMAT window
"                                FLAVOR INSPECTOR HELP
-----------------------------------------------------------------------------------
                        *** OPTIONAL THIRD INSPECTION PANE ***

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

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

    This pane displays the structure of the most recently inspected item.
    Specify objects to inspect by either:
      * Entering them into the Interaction Pane or,
      * Clicking Mouse-Left on mouse sensitive elements of previously inspected
        items.

    Clicking Mouse-Right on items in this pane tries to inspect the item's flavor
    definition.
    Click MOUSE-MIDDLE-2 anywhere in the pane toggles the pane's locked status.
    When locked, the insepcted item in that pane will be frozen until unlocked.
    Only two of the 3 panes may be locked.
-----------------------------------------------------------------------------------
     COMMAND     |                         *** HISTORY PANE **
      MENU       |
                 |  This pane shows a list of the objects that have been inspected.
Click Mouse-Left |
to select a      |  To bring an object back into the Main Inspection Pane, click
command.         |  Mouse-Left on that object in this pane.
                 |
                 |  To remove an item from the History Pane, position the
                 |  mouse-cursor to the left of the item until the cursor becomes
                 |  a right-pointing arrow (this is the items \"line area\").
                 |  Now click Mouse-Middle.                 
-----------------------------------------------------------------------------------
                               *** INTERACTION PANE *** 

      Enter items to inspect in this pane.  You may enter any of the following:
           * A flavor name to inspect, terminated by pressing the RETURN key
           * A method specification to inspect.  The syntax is
                  (Flavor-Name Method-Name)   or
                  (Flavor-Name Method-Type Method-Name)   or
                  Flavor-Name Method-Name   or    
                  Flavor-Name Method-Type Method-Name

      The last two types of expressions are terminated by pressing the RETURN key.
      Method-Type is one of the following:
           :AFTER :AND :AROUND :BEFORE :CASE :DEFAULT :OR :OVERRIDE :WRAPPER
      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 the top three Inspection Panes.
-----------------------------------------------------------------------------------")))


#|Ï3 
This documentation describes roughly how the DEBUG option of the flavor menu 
should work.

(DEFCOMMAND (flavor-inspector :debug-flavor) ()
  '(:DESCRIPTION "Displays inconsistencies in a given flavor."
    :DOCUMENTATION "Displays inconsistencies and possibly dangerous aspects of a flavor
whose name is read from the user.  The following lists each condition searched for and
a description of why the condition is considered inconsistent or dangerous.

[flesh this out]
 1. Flavor has an instance variable supplied by two or more of its flavor components.

    Each component probably makes assumptions about the nature of the instance variable
    and their methods will interfere with each other.


 2. Flavor has two or more instance variables having the same name in different packages;
    for instance, TV:FOO and ZWEI:FOO.

    This is buggy, especially if both are gettable and settable.  The methods :FOO and
    :SET-FOO will only operate on one of these variables, whichever's responsible flavor
    is highest in the heirarchy of component flavors.  Yet methods of the other flavor
    will be addressing the wrong variable in their sending of :FOO and :SET-FOO messages.

 3. Flavor defines a basic (non-demonic) method which is defined by one of its flavor
    components.

    This is not actually buggy; in fact, many times it is expected that a flavor specialize
    methods defined by their component flavors.  However, it is handy for you to see a
    list of all methods you have shadowed, in case you redefined a method without realizing
    it.  For instance, if your window flavor defines method :SELECT to have the user
    select something from a menu, your window won't be selectable because :SELECT is
    a low-level window method which shouldn't normally be redefined.  Using the Debug-Flavor
    option of the Flavor Inspector, you would quickly see that you have redefined an important
    method.

 4. ????"
    :KEYS #\SUPER-D)
  (SEND SELF :format-message "Not implemented yet."))Ï*
|#

(BUILD-COMMAND-TABLE 'flavor-inspector-cmd-table 'flavor-inspector
  '(:all-flavors
     :help-on-syntax
     :help-on-inspected-data
     :end-cmd
     :options-menu
     :trace-method
     :fi-doc-cmd
     config-toggle-cmd
     mode
     ;Ï1; These are Inspector commands we are able to borrow.Ï*
     delete-all-cmd
     refresh-cmd
     page-up-cmd
     page-down-cmd
     page-to-top
     page-to-bottom
     break-cmd)
  :init-options '(:name "Ï3Flavor Inspector CommandsÏ*"))



(BUILD-MENU 'flavor-inspector-menu 'flavor-inspector
  :item-list-order
  '(:help-on-syntax
    :all-flavors
     :trace-method
     :end-cmd
     :fi-doc-cmd
     delete-all-cmd
     refresh-cmd
     page-up-cmd
     page-down-cmd
     break-cmd
     mode
     config-toggle-cmd))

;Ï1; Make sure this covers everything.Ï*
(COMPILE-FLAVOR-METHODS 
  show-flavor
  show-component-flavors
  show-dependent-flavors
  show-local-methods
  show-all-methods
  show-all-methods-sorted
  show-all-handled-messages
  show-message
  show-instance-variables
  show-miscellaneous-data
  show-method
  show-method-details
  show-message-handlers
  show-instance-variable
  show-methods-referencing-instance-variable
  show-all-flavors
  flavor-inspector)


;Ï1; The following is the code necessary to define the function Flavor-Inspect, a functionalÏ*
;Ï1; interface to the flavor inspector.Ï*
 
(DEFUN Ï4inspect-flavorÏ* (&optional (object nil objp))
  "Ï2Call the Flavor Inspector to inspect OBJECT.  Selects a Flavor Inspector window.
   The Inspector runs in its own process, so your special variable bindings will not be visible.
   If you type END or use the exit menu option the original object  will
   be returned.Ï*"
  (LET ((iframe (find-or-create-window 'flavor-inspector))
        (top-item nil))
        (DECLARE (SPECIAL top-item))
	(IF objp
	    (COND ((INSTANCEP object)
		   (SEND iframe :inspect-instance object))
		  ((TYPEP object 'si::flavor)
		   (SEND iframe :inspect-structure object))
		  ( t (SEND iframe :inspect-object object)))
	     object)))
 
(DEFMETHOD Ï4(flavor-inspector :inspect-objectÏ*) (object)
  (LET ((thing (inspect-real-value
                 `(:value ,(allocate-data 'show-flavor (GET object 'si::flavor)) ,history))))
    ;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    (update-panes)))

(DEFMETHOD Ï4(flavor-inspector :inspect-structureÏ*) (object)
  (LET ((thing (inspect-real-value
                 `(:value ,(allocate-data 'show-flavor  object) ,history))))
    ;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    (update-panes)))

(DEFMETHOD Ï4(flavor-inspector :inspect-instanceÏ*) (object)
  (LET ((thing (inspect-real-value
                 `(:value ,(allocate-data 'show-flavor (GET (TYPE-OF (EVAL object)) 'si::flavor)) ,history))))
    ;Ï1; First flush item we will be inspectingÏ*
    (inspect-flush-from-history thing history)
    (SEND history :append-item thing)
    (update-panes)))

;Ï1(DEFUN Inspect-FLAVOR* (&OPTIONAL OBJECT)Ï*
;Ï1"Call the Flavor Inspector to inspect OBJECT.  Selects a Flavor Inspector window.Ï*
;Ï1The Inspector runs in calling process, so our special variable bindings are visible.Ï*
;Ï1If you type END or use the exit menu option the original object  willÏ*
;Ï1be returned.Ï*
;Ï1Written by JPR 21 May 86."Ï*
;Ï1  (USING-RESOURCE (IFRAME Flavor-Inspector-Resource DEFAULT-SCREEN)Ï*
;Ï1    (LET ((si:*keep-locals-for-eval* t))Ï*
;Ï1      (if (not (equal (SEND IFRAME :PREPARE-FOR-USE OBJECTÏ*
;Ï1                            (FORMAT NIL "Inspector for ~A" (SEND CURRENT-PROCESS :NAME)))Ï*
;Ï1                      :Object-Not-Found))Ï*
;Ï1          (WINDOW-CALL-WITH-SELECTION-SUBSTITUTE (IFRAME :DEACTIVATE) (INSPECT-COMMAND-LOOP IFRAME))Ï*
;Ï1          nil        ;Do nothing if it couldn't find a flavor or method. (JPR)Ï*
;Ï1          ))Ï*
;Ï1    object))Ï*
 
(DEFUN Ï4find-flavor-inspectable-objectÏ* (initial-object)
"Ï2This function is passed an object which should be coercable into a flavor
examinable object and does that coercion.  It returns either a 'Show-Flavor
object, to denote the flavor that it has managed to coerce, a
'Show-Method-Details object to denote the method its has coerced, or nil
if it can find neither a flavor nor a method in initial-object.
Written by JPR 21 May 86.Ï*"
  (COND
    ((SYMBOLP initial-object)
      (IF (GET initial-object 'si::flavor)
	  (allocate-data 'show-flavor (GET initial-object 'si::flavor))
	  nil))
    ((TYPEP initial-object 'si::flavor) (allocate-data 'show-flavor initial-object))
    ((AND (CONSP initial-object) (EQUAL (FIRST initial-object) :method))
      (LET ((method-spec (system:dwimify-arg-package initial-object 'function-spec)))
	   (LET ((method-data (LIST method-spec (FDEFINITION method-spec) (si::method-plist method-spec))))
		(allocate-data 'show-method-details (GET (SECOND method-spec) 'si::flavor) method-data))))
    ((FUNCTIONP initial-object)
      (LET ((method-spec (FUNCTION-NAME initial-object)))
	   (IF (AND (CONSP method-spec) (EQUAL (FIRST method-spec) :method))
	       (LET ((method-data (LIST method-spec (FDEFINITION method-spec) (si::method-plist method-spec))))
		    (allocate-data 'show-method-details (GET (SECOND method-spec) 'si::flavor) method-data))
	       nil)))
    (t nil)))
 
(DEFMETHOD Ï4(flavor-inspector :prepare-for-useÏ*) (initial-object new-label)
"Ï2This is a modified version of the Inspect-Frame :Prepare-for-use method.
It is passed some object which should be coercable into a flavor examinable
thing, i.e. a symbol, a flavor structure, a method spec or a method.
It coerces the object suitably and puts it into the history list and
starts the window up.
Created by JPR on 21 May 86.Ï*"
  (SEND self :set-label new-label)
  (LET ((object (find-flavor-inspectable-object initial-object)))
       (LET ((hw (SEND self :get-pane 'history)))
	 (IF (AND initial-object (NOT object))
	     ;Ï1; If the initial object is non-nil but the coerced object is nil (i.e. it can't find a flavor or a method)Ï*
	     ;Ï1; then just beep and return an error code.Ï*
	     (PROGN (BEEP) :object-not-found)
	     ;Ï1; Otherwise put the object into the history list.Ï*
	     (PROGN (COND
		      (object
		       (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))))))
 
;Ï1; Resource for process-less Flavor-Inspectors.  Defined by JPR on 21 May 86.Ï*
(DEFWINDOW-RESOURCE Ï4flavor-inspector-resourceÏ* nil :make-window
                    (flavor-inspector :process nil :label "Ï3fooÏ*") :reusable-when :deactivated) ;Ï1:initial-copies 0) Ï*
 
;Ï1(add-to-system-menu-column :debug "Flavor Inspector"Ï*
;			Ï1   '(w:select-or-create-window-of-flavor 'flavor-inspector)Ï*
;			Ï1   "Select a Flavor Inspector, to browse through Flavor structures"Ï*
;			Ï1   :sorted)Ï*

#|
Ï3;; Garr's code.  Be sure to look at all Zmacs flavor commands.  Bug in Dwimifiy???

;; from Bambi: LYSTAD; IPATCHES2.#
zwei:
(DEFCOM COM-METHOD-APROPOS "You supply the flavor at the prompt, and then the extended search string to match
the methods against.  The result is a mouse sensitive typeout display of matching methods of flavor and its
components." ()
  (LET* ((FLAVOR-nameÏ*
	Ï3   (READ-FLAVOR-NAME "Flavor"Ï*
	Ï3      "You are typing a flavor name, to list its methods which match a string you will enter."))Ï*
	Ï3 FLAVOR FUNCTION KEY STR METHOD-LIST)
    ;;Make sure we have a valid flavor name.
    (OR (SYMBOLP FLAVOR-NAME) (BARF "Enter a symbol which is the name of a flavor"))
    (SETQ FLAVOR (GET FLAVOR-NAME 'SI:FLAVOR))
    ;;We should be guaranteed a flavor by read-flavor-name, but to be safe...
    (OR FLAVOR (BARF "~s does not seem to be the name of any flavor in the system." FLAVOR-NAME))
    ;;Get the search function and string.
    (MULTIPLE-VALUE (FUNCTION KEY STR)
      (GET-EXTENDED-SEARCH-STRINGS (FORMAT nil "Find methods for ~s containing substring:" flavor-name)))
    ;;Get the list of matching methods for the flavor.
    (LOOP FOR ELEMENT IN (ALL-METHODS-SORTED FLAVOR)Ï*
	Ï3    AS NAME = (STRING (CAR (LAST ELEMENT)))Ï*
	Ï3    WHEN (FUNCALL FUNCTION KEY NAME)Ï*
	Ï3    DO (PUSH ELEMENT METHOD-LIST) )
    ;;Put up the list on the screen.
    (WITH-TYPEOUT-FONT-MAP-OF ((GET-SEARCH-MINI-BUFFER-WINDOW))
      (EDIT-DEFINITIONS TÏ*
			Ï3'DEFUNÏ*
			Ï3(MAPCAR #'(LAMBDA (OBJ)Ï*
					Ï3(CONS (FORMAT NIL "~S" OBJ) OBJ))Ï*
			Ï3      (REVERSE method-list))Ï*
			Ï3'com-go-to-next-possibilityÏ*
			Ï3#\c-sh-pÏ*
			Ï3"All methods of flavor ~S and its components matching ~a:"Ï*
			Ï3"No methods of flavor ~S matching ~a."Ï*
			Ï3FLAVOR-name str)))
  dis-none)Ï*
|#


;Ï1; 7/15/88 clm - the following code implements a DEBUG feature.Ï*
;Ï1; The code was provided by Rich Acuff.  Ï*

(DEFUN Ï4simplify-ivÏ* (iv)
  "Ï2If passed an instance variable, which is either a symbol or a (symbol default) list.
   It returns the symbol either way.Ï*"
  (IF (CONSP iv)
      (FIRST iv)
      iv))

(DEFUN Ï4get-simple-ivsÏ* (flavor)
  "Ï2If passed a flavor structure returns a list of symbols denoting the names of the
   instance variables of that flavor.Ï*"
  (MAPCAR #'simplify-iv (si::flavor-local-instance-variables flavor)))

(DEFUN Ï4get-ivsÏ* (flavor)
  "Ï2If passed a flavor structure this function returns values which are:
       The components of the flavor, excluding itself
       A list of all of the instance variables for all of the components.Ï*"
  (LET ((components (get-all-components flavor)))
    (VALUES components (MAPCAR #'get-simple-ivs components))))  

(DEFUN Ï4symbols-matchÏ* (symbol-1 symbol-2 depackage-p)
  "Ï2This is a sort of predicate, which tests whether two symbols could be said to    
   match.  It is passed two symbols and a flag, which determines whether the comparison
   is to be made in terms of the symbols themselves (equal test) or of their pnames
    (depackage-p = t). If the symbols are to be compared in terms of their pnames then
   they are said to match if they are no the same symbol and yet their pnames are   
   string-equal.Ï*"
  (IF depackage-p
      (AND (NOT (EQUAL symbol-1 symbol-2)) (STRING-EQUAL (SYMBOL-NAME symbol-1) (SYMBOL-NAME symbol-2)))
      (EQUAL symbol-1 symbol-2)))

(DEFUN Ï4is-inÏ* (symbol list test depackage-p)
  "Ï2This function is passed a symbol, a list of symbols and a test to determine whether
   the symbol can be said to be in the list.  If the symbol is found to be in the list
   then the function returns a two-list having as its elements the symbol and the symbol
   in the list with which it was matched.  The depackage-p flag is used by the test  
   function to determine how it is to perform the test.Ï*"  
  (DECLARE (optimize (safety 0)))
  (IF (EQUAL nil list)
      nil 
      (IF (FUNCALL test symbol (FIRST list) depackage-p)
	  (LIST symbol (FIRST list))
	  (is-in symbol (REST list) test depackage-p))))

(DEFUN Ï4look-for-matchÏ* (flavor ivs other-flavors other-ivs depackage-p)
  "Ï2This function is passed a flavor structure and its local ivs, a list of other 
   flavors, which are other components like the first flavor and a list of lists of
   ivs in the component flavors.  It returns a list of match descriptors, one for   
   each instance of finding an iv in the current flavor redefined in one of the
   other flavors.  Each match descriptor is a three-list.  The first element
   is a two-list holding the two instance variable names for the matching names.  The
   second and thrid elements are the flavor structures for the multiple defining flavor
   and the multiple definee flavor.  The depackage-p argument is non-nil if the type of
   multiple definition looked for is to be one of looking for clashes like tv:foo and
   zwei:foo.Ï*"  
  (DECLARE (optimize (safety 0)))
  (IF (EQUAL other-ivs nil)
      nil 
      (IF (EQUAL flavor (FIRST other-flavors))
	  (look-for-match flavor ivs (REST other-flavors) (REST other-ivs) depackage-p)
	  (LET ((matches (DELETE nil (map-with-args #'is-in ivs (FIRST other-ivs) #'symbols-match depackage-p))))
	    (IF matches
		(APPEND (map-with-args #'LIST matches flavor (FIRST other-flavors))
			(look-for-match flavor ivs (REST other-flavors) (REST other-ivs) depackage-p)
			)
		(look-for-match flavor ivs (REST other-flavors) (REST other-ivs) depackage-p))))))

(DEFUN Ï4find-multiple-definitions-1Ï* (components ivs depackage-p result)
  "Ï2This function is passed a list of flavor structures, which are the components of the
   structure in question, and a list of the instance variables, for which it is look for
   multiple definitions.  It returns a list of match descriptors, one for each multiple
   definition that it finds.  Each match descriptor is a three-list.  The first element
   is a two-list holding the two instance variable names for the matching names.  The
   second and thrid elements are the flavor structures for the multiple defining flavor
   and the multiple definee flavor.  The depackage-p argument is non-nil if the type of
   multiple definition looked for is to be one of looking for clashes like tv:foo and
   zwei:foo.Ï*"  
  (DECLARE (optimize (safety 0)))
  (IF (EQUAL nil components)
      result
      (LET ((matches (look-for-match (FIRST components) (FIRST ivs) (REST components) (REST ivs) depackage-p)))
	(find-multiple-definitions-1 (REST components) (REST ivs) depackage-p (APPEND matches result)))))

(DEFUN Ï4find-multiple-definitionsÏ* (components ivs depackage-p)
  "Ï2This function is passed a list of flavor structures, which are the components of the
   structure in question, and a list of the instance variables, for which it is look for
   multiple definitions.  It returns a list of match descriptors, one for each multiple
   definition that it finds.  Each match descriptor is a three-list.  The first element
   is a two-list holding the two instance variable names for the matching names.  The
   second and thrid elements are the flavor structures for the multiple defining flavor
   and the multiple definee flavor.  The depackage-p argument is non-nil if the type of
   multiple definition looked for is to be one of looking for clashes like tv:foo and
   zwei:foo.Ï*"
  (find-multiple-definitions-1 components ivs depackage-p nil))

(DEFUN Ï4get-primary-methodsÏ* (methods)
  "Ï2Is passed a list of method specs, found in the method table of a flavor structure.
   It returns a list of all of the methods, which are primary methods.  These have a
   method descriptor length of three (:method foo :bar).
   Ï*"  
  (REMOVE-IF-NOT
    #'(lambda (element)
	(AND (= (LENGTH (FIRST (FOURTH element))) 3)
	     (NOT (EQUAL :set (FIRST element)))))   
    methods))  

(DEFUN Ï4reconsÏ* (a b)
  "Ï2Reverse cons.Ï*"
  (CONS b a))  

(DEFUN Ï4associate-all-methodsÏ* (method method-alist)
  "Ï2Is passed a method descriptor and a list of method descriptors.  It returns a     
   list of all of the method descriptors in the alist, which have the same method
   name as Method.Ï*"  
  (REMOVE-IF-NOT
    #'(lambda (element) (EQUAL (FIRST method) (FIRST (FIRST element))))
    method-alist))

(DEFUN Ï4check-for-shadowing-methodsÏ* (flavor)
  "Ï2This function is passed a flavor structure.  It returns a two-list.  The
   first of the list is a list of all of the primary methods in itself and
   its components.  The second is a list of all of the primary methods of its
   components, which are shadowed by either itself or any of its components.Ï*"  
  (LET ((components (DELETE flavor (get-all-components flavor)))
	(primary-methods (DELETE :set (get-primary-methods (si::flavor-method-table flavor)))))  
    (LET ((primary-methods-and-shadows-from-components (MAPCAR #'check-for-shadowing-methods components)))
      (LET ((primary-methods-from-components
	      (uniqueise 
		(APPLY #'APPEND (DELETE nil (MAPCAR #'FIRST primary-methods-and-shadows-from-components)))))
	    (shadows-from-components
	      (APPLY #'APPEND (DELETE nil (MAPCAR #'SECOND primary-methods-and-shadows-from-components))))
	    (primary-methods-and-flavor (map-with-args #'LIST primary-methods flavor)))
	(LET ((new-shadows
		(APPLY #'APPEND
		       (DELETE nil (map-with-args #'associate-all-methods primary-methods
						  primary-methods-from-components)))))     
	  (LIST (APPEND primary-methods-and-flavor primary-methods-from-components)
		(uniqueise (APPEND (map-with-args #'recons new-shadows flavor) shadows-from-components))) 
	  )))))

(DEFUN Ï4get-method-name-from-shadowÏ* (SHADOW)
  "Ï2Given a method structure for a shadowed method, which is a three-list
   whose elements are :- the shadowing flavor, the method as it is found
   in the flavor's method table and the shadowed flavor, this function
   returns the name of the method.Ï*"  
  (FIRST (SECOND shadow)))

(DEFUN Ï4get-shadowed-methodsÏ* (flavor)
  "Ï2Given a flavor structure this function returns a list denoting all of
   the cases in which a primary method of a component of this flavor is
   shadowed by some higher component.  This list is sorted so that the
   method names are in alphabetical order.  Each element in the list is
   a three-list with the following structure :-
    (#<shadowing-flavor> (method-data) #<shadowed-flavor>)Ï*"  
  (SORT (uniqueise (SECOND (check-for-shadowing-methods flavor)))
	#'STRING-LESSP :key #'get-method-name-from-shadow))

(DEFUN Ï4collect-undefined-componentsÏ* (flavor)
  "Ï2Given a flavor structure this function returns a list of all of the
   components of that flavor, which have not yet been defined.Ï*"
  (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
    (LET ((result-from-components (DELETE nil (MAPCAR #'collect-undefined-components defined-components))))
      (uniqueise (APPEND (map-with-args #'LIST
					(SET-DIFFERENCE local-components (MAPCAR #'si::flavor-name defined-components))
					flavor) 
			 (MAPCAR #'APPEND result-from-components))))))

(DEFUN Ï4collect-required-thingsÏ* (flavor selector)
  "Ï2This is a general function which is passed a flavor and a keyword which is
   the name of the property denoting things that are required by the flavor,e.g.  
   methods, ivs.  It returns a list of two-lists.  Each two-list contains, first
   the name of the required component and second the flavor structure in which
   it is required.Ï*"
  (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
    (IGNORE local-components)
    (LET ((local-required-things (GET (CONS nil (si::flavor-plist flavor)) selector))
	  (inherited-required-things 
	    (DELETE nil (map-with-args #'collect-required-things defined-components selector))))
      (APPEND (map-with-args #'LIST local-required-things flavor) (APPLY #'APPEND inherited-required-things)))))

(DEFUN Ï4find-unsatisfied-thingsÏ* (flavor selector test)
  "Ï2Given a flavor structure, a keyword which denotes which sort of things
   is required, e.g. :Required-Methods, and a function which is able to
   determine whether the things that are required are indeed satisfied,
   this function returns a list of two-lists describing all of the required
   things that have not been defined.Ï*"
  (LET ((required-things (collect-required-things flavor selector)))
    (FUNCALL test required-things flavor)))

(DEFUN Ï4filter-out-satisfied-flavorsÏ* (required flavor)
  "Ï2Given a list of two-lists which describe required flavors and a
   flavor structure, this function returns that subset of the
   required components which is not satisfied.Ï*"
  (IGNORE flavor)
  (REMOVE-IF #'(lambda (element) (GET (FIRST element) 'si::flavor))
	     required))

(DEFUN Ï4list-of-unsatisfied-required-flavorsÏ* (flavor)
  "Ï2Given a flavor structure this returns a list of two-lists
   describing the unsatisfied required flavors for that flavor.Ï*"
  (find-unsatisfied-things flavor :required-flavors #'filter-out-satisfied-flavors))

(DEFUN Ï4search-for-methodÏ* (flavor method)
  "Ï2Given a flavor structure and a method name this returns T
   if the method is defined by the flavor or one of its components,
   otherwise it returns nil.Ï*"
  (IF (ASSOC method (si::flavor-method-table flavor))
      t   
      (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
	(IGNORE local-components)
	(NOT (EQUAL nil (DELETE nil (map-with-args #'search-for-method defined-components method)))))))

(DEFUN Ï4filter-out-satisfied-methodsÏ* (required flavor)
  "Ï2Given a list of two-lists which describe required methods and a
   flavor structure, this function returns that subset of the
   required components which is not satisfied.Ï*"
  (REMOVE-IF #'(lambda (element) (search-for-method flavor (FIRST element)))
	     required))

(DEFUN Ï4list-of-unsatisfied-required-methodsÏ* (flavor)
  "Ï2Given a flavor structure this returns a list of two-lists
   describing the unsatisfied required methods for that flavor.Ï*"
  (find-unsatisfied-things flavor :required-methods #'filter-out-satisfied-methods))

(DEFUN Ï4search-for-ivÏ* (flavor iv)
  "Ï2Given a flavor structure and an instance variable name this returns T
   if the instance variable is defined by the flavor or one of its components,
   otherwise it returns nil.Ï*"
  (IF (MEMBER iv (get-simple-ivs flavor))
      t   
      (MULTIPLE-VALUE-BIND (local-components defined-components) (get-local-defined-components flavor)
	(IGNORE local-components)
	(NOT (EQUAL nil (DELETE nil (map-with-args #'search-for-iv defined-components iv)))))))

(DEFUN Ï4filter-out-satisfied-ivsÏ* (required flavor)
  "Ï2Given a list of two-lists which describe required instance
   variables and a flavor structure, this function returns
   that subset of the required components which is not satisfied.Ï*"
  (REMOVE-IF #'(lambda (element) (search-for-iv flavor (FIRST element)))
	     required))

(DEFUN Ï4list-of-unsatisfied-required-ivsÏ* (flavor)
  "Ï2Given a flavor structure this returns a list of two-lists
   describing the unsatisfied required instance variables for
   that flavor.Ï*"
  (find-unsatisfied-things flavor :required-instance-variables #'filter-out-satisfied-ivs))

(DEFFLAVOR Ï4debug-flavorÏ* ()
	   (flavor-operation-mixin)
  (:documentation :special-purpose
		  "Ï3A flavor used by the flavor inspector in order to represent a request be the user to
   execute the debug flavor command for a given flavor.  It is somewhat like Show-Flavor.Ï*"))

(DEFMETHOD Ï4(debug-flavor :format-conciselyÏ*) (STREAM)
  "Ï2Prints the instance of Debug-Flavor in a simple manner.  This is used
   to display the flavor in the flavor inspector's history window and
   such like.Ï*" 
  (FORMAT stream "Ï3~s's debug dataÏ*" (si::flavor-name data)))

(DEFMETHOD Ï4(debug-flavor :generate-itemÏ*) ()
  "Ï2This method generates a window item for displaying in the flavor inspector
   which shows debug information associated with the flavor in question.
   This window item is made up of a number of window items describing the state
   of affairs in detail.Ï*"  
  ;Ï1; This makes sure that the flavor's mixin's instance variables have been included into the flavor.Ï*
  (LET* ((flavor-name (si::flavor-name data))
	 (flavor data)
	 (clashes (MULTIPLE-VALUE-BIND (components ivs) (get-ivs flavor)
		    (find-multiple-definitions components ivs nil)))
	 (package-clashes (MULTIPLE-VALUE-BIND (components ivs) (get-ivs flavor)
			    (find-multiple-definitions components ivs t)))
	 (shadowed-methods (get-shadowed-methods flavor))
	 (undefined-components (collect-undefined-components flavor))
	 (unsatisfied-flavors (list-of-unsatisfied-required-flavors flavor))
	 (unsatisfied-methods (list-of-unsatisfied-required-methods flavor))
	 (unsatisfied-ivs (list-of-unsatisfied-required-ivs flavor))
	 ) 
    (VALUES
      `(,*blank-line-item*
	;Ï1; ------------------------------Ï*
	,@(IF clashes
	      `(((:font 1 "Ï3Multiple declarations of the same instance variable for flavor Ï*")    
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for clash in clashes
		append `(((:font 3 "Ï3  Ï*")
			  (:item1 instance ,(allocate-data 'show-instance-variable (FIRST (FIRST clash))))
			  (:font 3 "Ï3 in flavors Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND clash)))
			  (:font 3 "Ï3 in flavors Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (THIRD clash)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF package-clashes *blank-line-item*)
	,@(IF package-clashes *blank-line-item*)
	,@(IF package-clashes
	      `(((:font 1 "Ï3Declarations of instance variables with the same PName but are in different packages for flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for clash in package-clashes
		append `(((:font 3 "Ï3  Ï*")
			  (:item1 instance ,(allocate-data 'show-instance-variable (FIRST (FIRST clash))))
			  (:font 3 "Ï3 in flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND clash)))
			  (:font 3 "Ï3 and Ï*")
			  (:item1 instance ,(allocate-data 'show-instance-variable (SECOND (FIRST clash))))
			  (:font 3 "Ï3 in flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (THIRD clash)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF undefined-components *blank-line-item*)
	,@(IF undefined-components *blank-line-item*)
	,@(IF undefined-components
	      `(((:font 1 "Ï3Undefined components of flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for undefined in undefined-components
		append `(((:item1 instance ,(allocate-data 'show-undefined-flavor (FIRST undefined)))
			  (:font 3 "Ï3 of flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND undefined)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF unsatisfied-flavors *blank-line-item*)
	,@(IF unsatisfied-flavors *blank-line-item*)
	,@(IF unsatisfied-flavors
	      `(((:font 1 "Ï3Unsatisfied required flavors of flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for unsatisfied in unsatisfied-flavors
		append `(((:item1 instance ,(IF (GET (FIRST unsatisfied) 'si::flavor)
						(allocate-data 'show-flavor (GET (FIRST unsatisfied) 'si::flavor))
						(allocate-data 'show-undefined-flavor (FIRST unsatisfied))))
			  (:font 3 "Ï3 for flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND unsatisfied)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF unsatisfied-methods *blank-line-item*)
	,@(IF unsatisfied-methods *blank-line-item*)
	,@(IF unsatisfied-methods
	      `(((:font 1 "Ï3Unsatisfied required methods of flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for unsatisfied in unsatisfied-methods
		append `(((:font 1 ,(FORMAT nil "Ï3~SÏ*" (FIRST unsatisfied)))
			  (:font 3 "Ï3 for flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND unsatisfied)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF unsatisfied-ivs *blank-line-item*)
	,@(IF unsatisfied-ivs *blank-line-item*)
	,@(IF unsatisfied-ivs
	      `(((:font 1 "Ï3Unsatisfied required instance variables of flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for unsatisfied in unsatisfied-ivs
		append `(((:font 1 ,(FORMAT nil "Ï3~SÏ*" (FIRST unsatisfied)))
			  (:font 3 "Ï3 for flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (SECOND unsatisfied)))))
		)
	;Ï1; ------------------------------Ï*
	,@(IF shadowed-methods *blank-line-item*)
	,@(IF shadowed-methods *blank-line-item*)
	,@(IF shadowed-methods
	      `(((:font 1 "Ï3Primary methods of component flavors shadowed by flavor Ï*")
		 (:item1 instance ,(allocate-data 'show-flavor data))
		 (:font 1 "Ï3:Ï*")))
	      nil
	      )
	,@(LOOP for shadow in shadowed-methods
		append `(((:item1 instance ,(allocate-data 'show-method (FOURTH (SECOND shadow))))
			  (:font 3 "Ï3 of flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (THIRD shadow)))
			  (:font 3 "Ï3 shadowed by flavor Ï*")
			  (:item1 instance ,(allocate-data 'show-flavor (FIRST shadow)))))
		)
	)  
      `(:font fonts:hl12bi :string ,(FORMAT nil "Ï3~S's Debug dataÏ*" flavor-name)))))

(DEFCOMMAND Ï4(flavor-inspector :debug-flavorÏ*) ()
  '(:description "Ï3Displays inconsistencies in a given flavor.Ï*"
		 :documentation "Ï3Displays inconsistencies and possibly dangerous aspects of a flavor
   whose name is read from the user.  The following lists each condition searched for and
   a description of why the condition is considered inconsistent or dangerous.
      
    1. Flavor has an instance variable supplied by two or more of its flavor components.
      
       Each component probably makes assumptions about the nature of the instance variable
       and their methods will interfere with each other.
       
    2. Flavor has two or more instance variables having the same name in different packages;
       for instance, TV:FOO and ZWEI:FOO.
      
       This is buggy, especially if both are gettable and settable.  The methods :FOO and
       :SET-FOO will only operate on one of these variables, whichever's responsible flavor
       is highest in the heirarchy of component flavors.  Yet methods of the other flavor
       will be addressing the wrong variable in their sending of :FOO and :SET-FOO messages.
      
    3. Flavor has undefined components.
      
       This is buggy only if you try to instantiate the flavor.  During development this
       may be reasonable.
      
    4. Flavor has unsatisfied required component flavors.
      
       This is buggy only if you try to instantiate the flavor.  During development this
       may be reasonable.
      
    5. Flavor has unsatisfied required methods.
      
       This is buggy only if you try to instantiate the flavor.  During development this
       may be reasonable.
      
    6. Flavor has unsatisfied required instance variables.
      
       This is buggy only if you try to instantiate the flavor.  During development this
       may be reasonable.
      
    7. Flavor defines a basic (non-demonic) method which is defined by one of its flavor
       components.
      
       This is not actually buggy; in fact, many times it is expected that a flavor specialize
       methods defined by their component flavors.  However, it is handy for you to see a
       list of all methods you have shadowed, in case you redefined a method without realizing
       it.  For instance, if your window flavor defines method :SELECT to have the user
       select something from a menu, your window won't be selectable because :SELECT is
       a low-level window method which shouldn't normally be redefined.  Using the Debug-Flavor
       option of the Flavor Inspector, you would quickly see that you have redefined an important
       method.Ï*"  
		 :keys #\Super-d)
  (DECLARE (SPECIAL *flavor-data* frame))
  (SEND ucl:this-application :inspect-thing 'debug-flavor *flavor-data*))