(FILECREATED " 7-JUN-83 15:25:09" {INDIGO}<LOOPS>SOURCES>LOOPSINSPECT.;2 23313
previous date: " 5-JUN-83 21:12:38" {INDIGO}<KBVLSI>LOOPS>SOURCES>LOOPSINSPECT.;9)
(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)
(FNS * INSPFNS)
(ADDVARS (INSPECTMACROS (instance ObjPropertiesFn ObjInspectFetchFn
ObjInspectStoreFn ObjPropCommandFn
ObjValueCommandFn ObjTitleCommand
ObjTitleFn)
(class ObjPropertiesFn ObjInspectFetchFn
ObjInspectStoreFn ObjPropCommandFn
ObjValueCommandFn ObjTitleCommand ObjTitleFn))
)
(* * Functions for producing the ClassTree)
(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)))
(Methods (InspectFetch InspectorClassIVs.InspectFetch args (datum property window)
doc (* Internal Inspector Fn)
)
(InspectProperties InspectorClassIVs.InspectProperties args (datum)
doc (* Compute the list of IVs for the represented class)
)
(InspectStore InspectorClassIVs.InspectStore args (datum property newValue window)
doc
(* 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)
)
(InspectTitle InspectorClassIVs.InspectTitle args (datum)
doc (* Compute the title for this instance which is
representing the ivs of another class)
)
(InspectTitleMenu InspectorClassIVs.InspectTitleMenu args NIL doc
(* Puts up menu for IV inspector title))
(InspectValueCommand InspectorClassIVs.InspectValueCommand args (datum property value
window)
doc (* Puts up menu for IV inspector value selection)
))]
(RPAQQ INSPFNS (Class.InspectFetch Class.InspectPropCommand Class.InspectProperties
Class.InspectStore Class.InspectTitle Class.InspectTitleMenu
Class.InspectValueCommand Class.TitleCommand InspectValProp
InspectorClassIVs.InspectFetch InspectorClassIVs.InspectProperties
InspectorClassIVs.InspectStore InspectorClassIVs.InspectTitle
InspectorClassIVs.InspectTitleMenu
InspectorClassIVs.InspectValueCommand
InspectorClassIVs.TitleCommand ObjAddDelete ObjInspectFetchFn
ObjInspectStoreFn ObjPropCommandFn ObjPropertiesFn ObjTitleCommand
ObjTitleFn ObjValueCommandFn Object.InspectFetch
Object.InspectPropCommand Object.InspectProperties
Object.InspectStore Object.InspectTitle Object.InspectTitleMenu
Object.InspectValueCommand Object.TitleCommand))
(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) (* mjs: "27-JUL-82 14:49")
(* What to do when a class value is selected)
(SELECTQ (MENU InspectMenu)
[INSPECT/VALUE (COND
((EQ property (QUOTE IVs))
(PROG ((civ (← (%$ InspectorClassIVs)
NewTemp)))
(←%@
civ class self)
(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])
(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])
(InspectorClassIVs.InspectFetch
[LAMBDA (self datum property window) (* dgb: "12-JAN-83 14:27")
(* Internal Inspector Fn)
(COND
[(NLISTP datum) (* local values only)
(GetClassIV (%@ class)
(OR (%@ iv)
property)
(AND (%@ iv)
(InspectValProp property]
(T (GetClassIV (%@ class)
(OR (%@ iv)
property)
(AND (%@ iv)
(InspectValProp property])
(InspectorClassIVs.InspectProperties
[LAMBDA (self datum) (* dgb: "26-NOV-82 22:37")
(* 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
((LISTP datum) (* Get inherited info)
(← (%@ class)
List!(QUOTE IVProps)
(%@ iv)))
(T (* Only local info)
(← (%@ class)
List
(QUOTE IVProps)
(%@ iv]
(T (COND
((LISTP datum) (* Get inherited info)
(← (%@ class)
List!(QUOTE IVs)))
(T (← (%@ class)
List
(QUOTE IVs])
(InspectorClassIVs.InspectStore
[LAMBDA (self datum property newValue window) (* dgb: "26-NOV-82 23:24")
(* 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)
(PutValueOnly (%@ class)
(OR (%@ iv)
property)
newValue
(AND (%@ iv)
(InspectValProp property])
(InspectorClassIVs.InspectTitle
[LAMBDA (self datum) (* dgb: "10-JUN-82 21:35")
(* Compute the title for this instance which is
representing the ivs of another class)
(CONCAT (COND
((LISTP datum)
"All ")
(T "Local "))
(COND
((%@ iv)
(CONCAT "properties of " (%@ iv)
" of $"))
(T "IVs of $"))
(ClassName (%@ class])
(InspectorClassIVs.InspectTitleMenu
[LAMBDA (self) (* dgb: " 5-JAN-83 17:01")
(* Puts up menu for IV inspector title)
(MENU (MenuGetOrCreate ClassIVsInspectTitleMenu (QUOTE (Class Local All Add/Delete Redisplay])
(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])
(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])
(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])
)
(ADDTOVAR INSPECTMACROS (instance ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn
ObjPropCommandFn ObjValueCommandFn ObjTitleCommand ObjTitleFn)
(class ObjPropertiesFn ObjInspectFetchFn ObjInspectStoreFn ObjPropCommandFn
ObjValueCommandFn ObjTitleCommand ObjTitleFn))
(* * Functions for producing the ClassTree)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (3824 22811 (Class.InspectFetch 3834 . 4218) (Class.InspectPropCommand 4220 . 4453) (
Class.InspectProperties 4455 . 4717) (Class.InspectStore 4719 . 5027) (Class.InspectTitle 5029 . 5407)
(Class.InspectTitleMenu 5409 . 5717) (Class.InspectValueCommand 5719 . 6278) (Class.TitleCommand 6280
. 6932) (InspectValProp 6934 . 7259) (InspectorClassIVs.InspectFetch 7261 . 7805) (
InspectorClassIVs.InspectProperties 7807 . 8705) (InspectorClassIVs.InspectStore 8707 . 9155) (
InspectorClassIVs.InspectTitle 9157 . 9650) (InspectorClassIVs.InspectTitleMenu 9652 . 9987) (
InspectorClassIVs.InspectValueCommand 9989 . 10809) (InspectorClassIVs.TitleCommand 10811 . 11828) (
ObjAddDelete 11830 . 12699) (ObjInspectFetchFn 12701 . 12980) (ObjInspectStoreFn 12982 . 13270) (
ObjPropCommandFn 13272 . 13570) (ObjPropertiesFn 13572 . 13848) (ObjTitleCommand 13850 . 14132) (
ObjTitleFn 14134 . 14404) (ObjValueCommandFn 14406 . 14712) (Object.InspectFetch 14714 . 15449) (
Object.InspectPropCommand 15451 . 16836) (Object.InspectProperties 16838 . 17448) (Object.InspectStore
17450 . 18069) (Object.InspectTitle 18071 . 18718) (Object.InspectTitleMenu 18720 . 19638) (
Object.InspectValueCommand 19640 . 21372) (Object.TitleCommand 21374 . 22809)))))
STOP