(FILECREATED "31-OCT-83 10:47:17" {INDIGO}<LOOPS>SOURCES>LOOPSINSPECT.;5 24759
previous date: "19-OCT-83 00:15:52" {INDIGO}<LOOPS>SOURCES>LOOPSINSPECT.;4)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT LOOPSINSPECTCOMS)
(RPAQQ LOOPSINSPECTCOMS [(* Copyright (c)
1982 by Xerox Corporation)
(* Classes and functions which make instances and classes be inspectable through the ordinary
LISP inspector)
(CLASSES InspectorClassIVs)
(ADDVARS (INSPECTMACROS (instance ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn
ObjPropCommandFn ObjValueCommandFn ObjTitleCommand
ObjTitleFn)
(class ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn
ObjPropCommandFn ObjValueCommandFn ObjTitleCommand ObjTitleFn))
)
(* * Functions for producing the ClassTree)
(METHODS Class.InspectFetch Class.InspectPropCommand Class.InspectProperties
Class.InspectStore Class.InspectTitle Class.InspectTitleMenu
Class.InspectValueCommand Class.TitleCommand InspectorClassIVs.InspectFetch
InspectorClassIVs.InspectProperties InspectorClassIVs.InspectStore
InspectorClassIVs.InspectTitle InspectorClassIVs.InspectTitleMenu
InspectorClassIVs.InspectValueCommand InspectorClassIVs.TitleCommand
Object.InspectFetch Object.InspectPropCommand Object.InspectProperties
Object.InspectStore Object.InspectTitle Object.InspectTitleMenu
Object.InspectValueCommand Object.TitleCommand)
(FNS * INSPFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(* Copyright (c) 1982 by Xerox Corporation)
(* Classes and functions which make instances and classes be inspectable through the ordinary
LISP inspector)
(DEFCLASSES InspectorClassIVs)
[DEFCLASS InspectorClassIVs
(MetaClass Class doc
(* * Special class used by inspector to keep track of whether it is displaying all IVs or only local IVs.)
Edited: (* dgb: "22-JUN-82 11:57")
)
(Supers Object)
(ClassVariables)
(InstanceVariables (class NIL doc (* class whose IVs are being examined))
(iv NIL doc (* name of IV whose properties are being examined in
class))
(localFlg NIL doc (* T when only local properties are to be seen)
))]
(ADDTOVAR INSPECTMACROS (instance ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn
ObjPropCommandFn ObjValueCommandFn ObjTitleCommand ObjTitleFn)
(class ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn ObjPropCommandFn
ObjValueCommandFn ObjTitleCommand ObjTitleFn))
(* * Functions for producing the ClassTree)
[METH Class InspectFetch (datum property)
(* fetch summaries of class for the inspector -- different for Metaclass Supers etc)]
[METH Class InspectPropCommand NIL
(* No changes allowed on properties)]
[METH Class InspectProperties (datum)
(* (part of Class Inspector))]
[METH Class InspectStore (datum property newValue window)
(* Can't change the class from the inspector using the summary)]
[METH Class InspectTitle (datum)
(* Return a string for a title in inspect window)]
[METH Class InspectTitleMenu NIL
(* Menu for commands for the inspector)]
[METH Class InspectValueCommand (datum property value window)
(* What to do when a class value is selected)]
[METH Class TitleCommand (datum window)
(* Do commands in title field)]
[METH InspectorClassIVs InspectFetch (datum property window)
(* Internal Inspector Fn)]
[METH InspectorClassIVs InspectProperties (datum)
(* Compute the list of IVs for the represented class)]
[METH InspectorClassIVs InspectStore (datum property newValue window)
(* Put in a new default value for iv in class.)]
[METH InspectorClassIVs InspectTitle (datum)
(* Compute the title for this instance which is representing the ivs of another class)]
[METH InspectorClassIVs InspectTitleMenu NIL
(* Puts up menu for IV inspector title)]
[METH InspectorClassIVs InspectValueCommand (datum property value window)
(* Puts up menu for IV inspector value selection)]
[METH InspectorClassIVs TitleCommand (datum window)
(* Puts up menu of selections for class instance variables for the Inspector)]
[METH Object InspectFetch (datum property window)
(* part of Object Inspector)]
[METH Object InspectPropCommand (datum property window)
(* Part of object inspector)]
[METH Object InspectProperties (datum)
(* List the set of IVs for an instance)]
[METH Object InspectStore (datum property newValue window)
(* Store a value in the instance)]
[METH Object InspectTitle (datum)
(* part of Object Inspector)]
[METH Object InspectTitleMenu NIL
(* Put a menu for the Instance Title Command)]
[METH Object InspectValueCommand (datum property value window)
(* part of Object Inspector)]
[METH Object TitleCommand (datum window)
(* Puts up menu of selections for instances for the Inspector)]
(DEFINEQ
(Class.InspectFetch
[LAMBDA (self datum property) (* dgb: "11-JUN-82 09:51")
(* fetch summaries of class for the inspector --
different for Metaclass Supers etc)
(COND
((LISTP datum)
(← (CAR datum)
List! property))
(T (← datum List property])
(Class.InspectPropCommand
[LAMBDA (self) (* dgb: "10-JUN-82 16:47")
(* No changes allowed on properties)
NIL])
(Class.InspectProperties
[LAMBDA (self datum) (* dgb: "27-AUG-82 13:01")
(* (part of Class Inspector))
(QUOTE (MetaClass Supers IVs CVs Methods])
(Class.InspectStore
[LAMBDA (self datum property newValue window) (* dgb: "11-JUN-82 09:52")
(* Can't change the class from the inspector using the
summary)
(ERROR "Can't Store into class this way"])
(Class.InspectTitle
[LAMBDA (self datum) (* dgb: "11-JUN-82 09:53")
(* Return a string for a title in inspect window)
(CONCAT (COND
((LISTP datum)
"All properties of ")
(T "Local properties of "))
"Class "
(ClassName (ExtractObj self])
(Class.InspectTitleMenu
[LAMBDA (self) (* dgb: "11-JUN-82 09:53")
(* Menu for commands for the inspector)
(MENU (MenuGetOrCreate ClassInspectTitleMenu (QUOTE (Edit All Local Redisplay])
(Class.InspectValueCommand
[LAMBDA (self datum property value window) (* dgb: "13-OCT-83 22:06")
(* What to do when a class value is selected)
(SELECTQ [MENU (MenuGetOrCreate InspectMenu (QUOTE (Inspect]
[Inspect (COND
[(EQ property (QUOTE IVs))
(PROG ((civ (← ($ InspectorClassIVs)
New)))
(←@
civ class self)
(INSPECT civ) (* (WINDOWPROP window (QUOTE DATUM) civ))
]
(T (INSPECT value]
NIL)
(INSPECTW.REDISPLAY window])
(Class.TitleCommand
[LAMBDA (self datum window) (* dgb: "11-JUN-82 09:53")
(* Do commands in title field)
(PROG NIL
(SELECTQ (← self InspectTitleMenu)
(Edit (← self Edit))
[All (COND
((NLISTP datum)
(WINDOWPROP window (QUOTE DATUM)
(LIST datum]
[Local (COND
((LISTP datum)
(WINDOWPROP window (QUOTE DATUM)
self]
(Redisplay (* Will happen anyway if we avoid the return)
)
(RETURN NIL))
(INSPECTW.REDISPLAY window])
(InspectorClassIVs.InspectFetch
[LAMBDA (self datum property window) (* dgb: "13-OCT-83 22:06")
(* Internal Inspector Fn)
(GetClassIV (@ class)
(OR (@ iv)
property)
(AND (@ iv)
(InspectValProp property])
(InspectorClassIVs.InspectProperties
[LAMBDA (self datum) (* dgb: "13-OCT-83 22:06")
(* Compute the list of IVs for the represented class)
(COND
[(@ iv) (* examining the properties of an iv.
NIL is for the value)
(CONS (QUOTE Value)
(COND
((@ localFlg) (* Only local info)
(← (@ class)
List
(QUOTE IVProps)
(@ iv)))
(T (* Get inherited info)
(← (@ class)
List!(QUOTE IVProps)
(@ iv]
(T (COND
((@ localFlg)
(← (@ class)
List
(QUOTE IVs)))
(T (* Get inherited info)
(← (@ class)
List!(QUOTE IVs])
(InspectorClassIVs.InspectStore
[LAMBDA (self datum property newValue window) (* dgb: "13-OCT-83 22:06")
(* Put in a new default value for iv in class.)
(* The OR and AND are a trick to compute correct
arguments. iv is a varname if it exists, otherwise it is
the property)
(PutClassIV (@ class)
(OR (@ iv)
property)
newValue
(AND (@ iv)
(InspectValProp property])
(InspectorClassIVs.InspectTitle
[LAMBDA (self datum) (* dgb: "13-OCT-83 22:06")
(* Compute the title for this instance which is
representing the ivs of another class)
(CONCAT (COND
((@ localFlg)
"Local ")
(T "All "))
(COND
((@ iv)
(CONCAT "properties of " (@ iv)
" of $"))
(T "IVs of $"))
(ClassName (@ class])
(InspectorClassIVs.InspectTitleMenu
[LAMBDA (self) (* dgb: "13-OCT-83 22:06")
(* Puts up menu for IV inspector title)
(SELECTQ [MENU (MenuGetOrCreate ClassIVsInspectTitleMenu (QUOTE (All Local IVs]
(All (←@
localFlg NIL))
(Local (←@
localFlg T))
(IVs (←@
iv NIL))
NIL])
(InspectorClassIVs.InspectValueCommand
[LAMBDA (self datum property value window) (* dgb: "21-FEB-83 11:10")
(* Puts up menu for IV inspector value selection)
(SELECTQ [MENU (MenuGetOrCreate InspectOrPropsMenu (QUOTE ((Inspect (QUOTE Inspect)
"Inspect value of item")
("Save in IT" (QUOTE SaveIt)
"IT←<selected item>")
(Properties (QUOTE Props)
"Inspect Properties of this Variable"]
(Inspect (INSPECT value))
(SaveIt (printout PROMPTWINDOW "IT←" (SETQ IT value)
T))
(Props (←%@
iv property) (* Store away the iv to be examined, and redisplay)
(INSPECTW.REDISPLAY window))
NIL])
(InspectorClassIVs.TitleCommand
[LAMBDA (self datum window) (* dgb: "10-JUN-82 21:48")
(* Puts up menu of selections for class instance
variables for the Inspector)
(PROG NIL
(SELECTQ (← self InspectTitleMenu)
(Class (* Inspect the class of this instance)
(WINDOWPROP window (QUOTE DATUM)
(%@ class)))
(Add/Delete (ClassIVAddDelete self datum window))
(All (* Reset to inherited mode)
(WINDOWPROP window (QUOTE DATUM)
(LIST self)))
(Local (* Show only those values which are in instance itself)
(WINDOWPROP window (QUOTE DATUM)
self))
(Redisplay)
(RETURN NIL)) (* Redisplay for most selections)
(INSPECTW.REDISPLAY window)
(RETURN datum])
(Object.InspectFetch
[LAMBDA (self datum property window) (* dgb: "26-NOV-82 23:25")
(* part of Object Inspector)
(COND
((NLISTP datum) (* getting the usual value)
(GetValueOnly self property))
(T (PROG (varName prop (vp (CADR datum)))
(COND
(vp (SETQ varName vp)
(SETQ prop (InspectValProp property)))
(T (SETQ varName property)))
(RETURN (COND
((EQ (QUOTE LocalValues)
(CADDR datum)) (* These are the values not stored in the class)
(GetIVHere self varName prop))
(T (GetValueOnly self varName prop])
(Object.InspectPropCommand
[LAMBDA (self datum property window) (* dgb: "28-APR-83 18:03")
(* Part of object inspector)
(PROG (newValue varName prop op)
(AND (type? instance datum)
(← datum InstOf (QUOTE InspectorClassIVs))
(RETURN NIL)) (* Can't set class values from inspector)
(OR [SETQ op (MENU (MenuGetOrCreate ObjPropInspectMenu (QUOTE ((PutValueOnly (QUOTE
PutValueOnly)
"Overwrite existing value")
(PutValue (QUOTE PutValue)
"Set value, possibly invoking activeValues"]
(RETURN NIL))
(* * Get a new value, or RETURN NIL if ERROR or ↑E)
[SETQ newValue (CAR (OR (ERSETQ (PromptEval (CONCAT "Enter the new " property " for " datum)
))
(RETURN NIL]
(* * Set up varName and property)
[COND
((OR (NLISTP datum)
(NULL (CADR datum)))
(SETQ varName property))
(T (SETQ varName (CADR datum))
(SETQ prop (InspectValProp property]
(COND
((EQ op (QUOTE PutValue))
(PutValue self varName newValue prop))
(T (PutValueOnly self varName newValue prop)))
(INSPECTW.REDISPLAY window])
(Object.InspectProperties
[LAMBDA (self datum) (* dgb: "26-NOV-82 22:46")
(* List the set of IVs for an instance)
(COND
((OR (NLISTP datum)
(NULL (CADR datum)))
(← self List (QUOTE IVS)))
(T (CONS (QUOTE Value)
(COND
((CADDR datum) (* only local properties)
(← self List (QUOTE IV)
(CADR datum)))
(T (* all properties)
(← self List!(QUOTE IV)
(CADR datum])
(Object.InspectStore
[LAMBDA (self datum property newValue window) (* dgb: "26-NOV-82 23:26")
(* Store a value in the instance)
(COND
((NLISTP datum)
(PutValueOnly self property newValue))
(T (* If (CADR datum) NEQ NIL then it is varName, and
property is propName, else property is varName)
(PROG ((varName (CADR datum)))
(PutValueOnly self (OR varName property)
newValue
(AND varName (InspectValProp property])
(Object.InspectTitle
[LAMBDA (self datum) (* dgb: " 5-JUN-83 20:47")
(* part of Object Inspector)
(PROG ((names (GetObjectNames self T)))
(OR (LISTP datum)
(SETQ datum (LIST datum NIL NIL)))
(RETURN (CONCAT (COND
((CADDR datum)
"Local ")
(T "All "))
(COND
((CADR datum)
"IVProps of ")
(T "Values of "))
(ClassName self)
" "
(COND
(names (CONCAT "$" (CAR names)))
(T (LOC self)))
"."
(OR (CADR datum)
""])
(Object.InspectTitleMenu
[LAMBDA (self) (* dgb: " 5-JAN-83 17:06")
(* Put a menu for the Instance Title Command)
(MENU (MenuGetOrCreate InstanceTitleMenu (QUOTE ((Class (QUOTE Class)
"Inspect the class of this instance")
(AllValues (QUOTE AllValues)
"Look at inherited values as well as local values")
(LocalValues (QUOTE LocalValues)
"Show only values actually in instance")
(Add/Delete (QUOTE Add/Delete)
"Add or delete from the IVs or props")
(IVs (QUOTE IVs)
"Show object's instance variables")
("Save in IT" (QUOTE SaveIt)
"IT←<object being inspected>")
(Redisplay (QUOTE Redisplay)
"Redisplay current values"])
(Object.InspectValueCommand
[LAMBDA (self datum property value window) (* dgb: "21-FEB-83 11:15")
(* part of Object Inspector)
(SELECTQ [MENU (COND
[(AND (LISTP datum)
(CADR datum)) (* Inspecting properties)
(MenuGetOrCreate InspectOrSaveMenu (QUOTE ((Inspect (QUOTE Inspect)
"Inspect value of item")
("Save in IT" (QUOTE SaveIt)
"IT←<selected value>"]
(T (MenuGetOrCreate InspectOrPropsMenu (QUOTE ((Inspect (QUOTE Inspect)
"Inspect value of item")
("Save in IT" (QUOTE SaveIt)
"IT←<selected value>")
(Properties (QUOTE Props)
"Inspect Properties of this Variable"]
(SaveIt (printout PROMPTWINDOW (CHARACTER 7)
"IT←"
(SETQ IT value)
T))
(Inspect (INSPECT value))
(Props (PROG [goodSize (reg (WINDOWPROP window (QUOTE REGION]
(COND
[(NLISTP datum)
(WINDOWPROP window (QUOTE DATUM)
(SETQ datum (LIST self property NIL]
(T (RPLACA (CDR datum)
property)))
[COND
([ILESSP (fetch HEIGHT of reg)
(SETQ goodSize (IMIN 200
(ITIMES (IPLUS 2
(LENGTH (← (CAR datum)
List!(QUOTE
IVProps)
property)))
13]
(* Won't contain the items. Reshape window)
(SHAPEW window (create REGION copying reg HEIGHT ← goodSize]
(INSPECTW.REDISPLAY window)))
NIL])
(Object.TitleCommand
[LAMBDA (self datum window) (* dgb: " 5-JAN-83 17:08")
(* Puts up menu of selections for instances for the
Inspector)
(PROG NIL
(SELECTQ (← self InspectTitleMenu)
(Class (* Inspect the class of this instance)
(INSPECT (Class self)))
(Add/Delete (ObjAddDelete self datum window))
[AllValues (* Reset to default mode)
(COND
((LISTP datum) (* Remove Local Flag from list)
(RPLACA (CDDR datum)
NIL]
[LocalValues (* Show only those values which are in instance itself)
(COND
[(NLISTP datum)
(WINDOWPROP window (QUOTE DATUM)
(SETQ datum (LIST self NIL (QUOTE LocalValues]
(T (* Put in Local values flag in list)
(RPLACA (CDDR datum)
(QUOTE LocalValues]
(SaveIt (SETTOPVAL (QUOTE IT)
(ExtractObj datum)))
[IVs (* Make it be back to the instance, with All Values)
(COND
((LISTP datum)
(RPLACA (CDR datum]
NIL) (* Redisplay for all selections)
(INSPECTW.REDISPLAY window)
(RETURN datum])
)
(RPAQQ INSPFNS (InspectValProp ObjAddDelete ObjInspectFetchFn ObjInspectStoreFn ObjPropCommandFn
ObjPropertiesFn ObjTitleCommand ObjTitleFn ObjValueCommandFn))
(DEFINEQ
(InspectValProp
[LAMBDA (property) (* dgb: "26-NOV-82 23:27")
(* Used to convert Value to NIL for access in the
inspector)
(COND
((EQ property (QUOTE Value))
NIL)
(T property])
(ObjAddDelete
[LAMBDA (self datum window) (* dgb: " 5-JUN-83 20:05")
(* Used in the inspector. The inspect datum is either an object, or a list (obj varName locOrFree) If varName is
NIL then examining all IVs, else the properties of the named var. locOrFree is NIL (showing all values) or
LocalValues, meaning show only values set in object itself)
(PROG [name (varName (CADR (LISTP datum]
(SELECTQ [MENU (MenuGetOrCreate AddDeleteMenu (QUOTE (Add Delete]
[Add (SETQ name (PromptRead "Type name to be added: "))
(COND
(varName (PutValueOnly self varName NIL name))
(T (← self AddIV name NIL]
[Delete (SETQ name (PromptRead "Type name to be deleted: "))
(COND
(varName (← self DeleteIV varName name))
(T (← self DeleteIV name]
NIL])
(ObjInspectFetchFn
[LAMBDA (datum property window) (* dgb: "10-JUN-82 03:20")
(* InspectMacro FetchFn for Objects)
(← (ExtractObj datum)
InspectFetch datum property])
(ObjInspectStoreFn
[LAMBDA (datum property newValue) (* dgb: " 9-JUN-82 23:01")
(* InspectMacro StoreFn for Objects)
(← (ExtractObj datum)
InspectStore datum property newValue])
(ObjPropCommandFn
[LAMBDA (property datum window) (* dgb: " 9-JUN-82 23:01")
(* InspectMacro TitleCommandFn for Objects)
(← (ExtractObj datum)
InspectPropCommand datum property window])
(ObjPropertiesFn
[LAMBDA (datum) (* dgb: " 9-JUN-82 23:40")
(* InspectMacro PropertyFn for Objects)
(← (ExtractObj datum)
InspectProperties datum])
(ObjTitleCommand
[LAMBDA (window datum) (* dgb: " 9-JUN-82 23:03")
(* InspectMacro TitleCommandFn for Objects)
(← (ExtractObj datum)
TitleCommand datum window])
(ObjTitleFn
[LAMBDA (datum window) (* dgb: " 9-JUN-82 23:56")
(* InspectMacro TitleFn for Objects)
(← (ExtractObj datum)
InspectTitle datum window])
(ObjValueCommandFn
[LAMBDA (value property datum window) (* dgb: " 9-JUN-82 23:01")
(* InspectMacro TitleCommandFn for Objects)
(← (ExtractObj datum)
InspectValueCommand datum property value window])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS LOOPSINSPECT COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5311 21146 (Class.InspectFetch 5321 . 5705) (Class.InspectPropCommand 5707 . 5940) (
Class.InspectProperties 5942 . 6204) (Class.InspectStore 6206 . 6514) (Class.InspectTitle 6516 . 6894)
(Class.InspectTitleMenu 6896 . 7204) (Class.InspectValueCommand 7206 . 7808) (Class.TitleCommand 7810
. 8462) (InspectorClassIVs.InspectFetch 8464 . 8789) (InspectorClassIVs.InspectProperties 8791 . 9699
) (InspectorClassIVs.InspectStore 9701 . 10277) (InspectorClassIVs.InspectTitle 10279 . 10768) (
InspectorClassIVs.InspectTitleMenu 10770 . 11206) (InspectorClassIVs.InspectValueCommand 11208 . 12028
) (InspectorClassIVs.TitleCommand 12030 . 13047) (Object.InspectFetch 13049 . 13784) (
Object.InspectPropCommand 13786 . 15171) (Object.InspectProperties 15173 . 15783) (Object.InspectStore
15785 . 16404) (Object.InspectTitle 16406 . 17053) (Object.InspectTitleMenu 17055 . 17973) (
Object.InspectValueCommand 17975 . 19707) (Object.TitleCommand 19709 . 21144)) (21323 24544 (
InspectValProp 21333 . 21658) (ObjAddDelete 21660 . 22529) (ObjInspectFetchFn 22531 . 22810) (
ObjInspectStoreFn 22812 . 23100) (ObjPropCommandFn 23102 . 23400) (ObjPropertiesFn 23402 . 23678) (
ObjTitleCommand 23680 . 23962) (ObjTitleFn 23964 . 24234) (ObjValueCommandFn 24236 . 24542)))))
STOP