(FILECREATED "16-Jul-86 23:03:36" {ERIS}<LISPCORE>SOURCES>INSPECT.;16 125057
changes to: (FNS \TEDIT.INSPECTCODE INSPECT/AS/FUNCTION INSPECT/MAKE/CCODEP)
previous date: "25-Jun-86 12:51:07" {ERIS}<LISPCORE>SOURCES>INSPECT.;15)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT INSPECTCOMS)
(RPAQQ INSPECTCOMS
[(COMS (* * "functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector."
)
(FNS INSPECTW.CREATE INSPECTW.REPAINTFN INSPECTW.REDISPLAY \INSPECTW.VALUE.MARGIN
INSPECTW.REPLACE INSPECTW.SELECTITEM \INSPECTW.REDISPLAYPROP INSPECTW.FETCH
INSPECTW.PROPERTIES DECODE.WINDOW.ARG DEFAULT.INSPECTW.PROPCOMMANDFN
DEFAULT.INSPECTW.VALUECOMMANDFN DEFAULT.INSPECTW.TITLECOMMANDFN
\SELITEM.FROM.PROPERTY \INSPECT.COMPUTE.TITLE LEVELEDFORM MAKEWITHINREGION)
(FNS ITEMW.REPAINTFN \ITEM.WINDOW.BUTTON.HANDLER \ITEM.WINDOW.SELECTION.HANDLER
\INSPECTW.COMMAND.HANDLER ITEM.WINDOW.SET.STACK.ARG REPLACESTKARG IN/ITEM?
\ITEMW.DESELECTITEM \ITEMW.SELECTITEM \ITEMW.CLEARSELECTION \ITEMW.FLIPITEM
PRINTANDBOX PRINTATBOX ITEMOFPROPERTYVALUE)
(FNS \ITEM.WINDOW.COPY.HANDLER \ITEMW.FLIPCOPY BKSYSBUF.GENERAL)
(RECORDS SELECTABLEITEM)
(VARS (MAXINSPECTARRAYLEVEL 300)
(MAXINSPECTCDRLEVEL 50)
MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth MaxValueLeftMargin
PropertyLeftMargin))
(COMS (* "functions for the inspector")
(FNS INSPECT \APPLYINSPECTMACRO INSPECT/BITMAP INSPECT/DATATYPE INSPECTABLEFIELDNAMES
REMOVEDUPS INSPECT/ARRAY INSPECT/TOP/LEVEL/LIST INSPECT/PROPLIST NONSYSPROPNAMES
INSPECT/LISTP ALISTP PROPLISTP INSPECT/ALIST ASSOCGET /ASSOCPUT INSPECT/PLIST
INSPECT/TYPERECORD INSPECT/AS/RECORD SELECT.LIST.INSPECTOR STANDARDEDITE
NTHTOPLEVELELT SETNTHTOPLEVELELT DEDITE FINDRECDECL FINDSYSRECDECL \INSPECTEDITE)
(GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu
PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu
ItemWCommandMenu InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL
MaxInspectorWindowWidth MaxInspectorWindowHeight INSPECT.HUNK.COMMANDS WIZARDFLG
USERRECLST SYSPROPS IT MinSpaceBetweenProperyAndValue
MaxInspectorPropertyValueWidth)
(INITVARS (INSPECTALLFIELDSFLG T)
(MaxInspectorWindowWidth 330)
(MaxInspectorWindowHeight 606))
(VARS INSPECTPRINTLEVEL))
(COMS (* "Atom inspector")
(FNS INSPECT/ATOM SELECT.ATOM.ASPECT INSPECT/AS/FUNCTION SELECT.FNS.EDITOR))
(COMS (* "Compiled code inspector")
(FNS INSPECTCODE \TEDIT.INSPECTCODE \INSPECT/CODE/RESHAPEFN \INSPECT/CODE/REPAINTFN))
(COMS (* "Hash table inspector")
(FNS INSPECT/HARRAYP HARRAYKEYS INSPECTW.GETHASH INSPECTW.PUTHASH))
[COMS (* "Readtable, termtable inspectors")
(FNS RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP GETTTBLPROP SETTTBLPROP)
(ADDVARS (INSPECTMACROS (READTABLEP RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP)
(TERMTABLEP (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL RAISE
ECHOMODE LINEDELETESTR 1STCHDEL NTHCHDEL POSTCHDEL
EMPTYCHDEL ECHODELS? CONTROL 0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
28 29 30 31)
GETTTBLPROP SETTTBLPROP]
[COMS (* "Hunk inspector")
(FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK
\INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR
\INSPECT.FETCH.FATCHAR \INSPECT.FETCH.PTR \INSPECT.STORE.8 \INSPECT.STORE.16
\INSPECT.STORE.32 \INSPECT.STORE.CHAR \INSPECT.STORE.FATCHAR \INSPECT.STORE.PTR
INSPECT/MAKE/CCODEP)
(INITVARS (INSPECT.HUNK.COMMANDS (QUOTE (("As 8-bit array" (QUOTE (8 \GETBASEBYTE
\INSPECT.STORE.8))
)
("As 16-bit array" (QUOTE (16 \GETBASE
\INSPECT.STORE.16
)))
("As 32-bit array" (QUOTE (32
\INSPECT.FETCH.32
\INSPECT.STORE.32
)))
("As Character array" (QUOTE (8
\INSPECT.FETCH.CHAR
\INSPECT.STORE.CHAR
)))
("As Fat Character array" (QUOTE (16
\INSPECT.FETCH.FATCHAR
\INSPECT.STORE.FATCHAR
]
(COMS (* "stack functions")
(FNS STACKFRAMEPROPPRINTFN STACKFRAMEVALUECOMMANDFN PROPERTIES.FROM.FRAMESPEC
PROPERTIES.FROM.FRAMESPEC.LOTS WINDOWTITLE2 NEWSTKNPVARS MYSMARTARGLIST
FETCHSTKARG \RELEASEWINDOWSTKDATUM BTITEMWINDOWCLOSEFN)
(DECLARE: DONTCOPY (RECORDS ARGSPEC))
(DECLARE: DOCOPY DONTEVAL@LOAD (P (MOVD? (QUOTE NEWSTKNPVARS)
(QUOTE STKNPVARS))
(MOVD? (QUOTE EDITE)
(QUOTE \BEFOREINSPECTEDITE))
(MOVD (QUOTE \INSPECTEDITE)
(QUOTE EDITE])
(* *
"functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector."
)
(DEFINEQ
(INSPECTW.CREATE
[LAMBDA (DATUM PROPERTIES FETCHFN STOREFN PROPCOMMANDFN VALUECOMMANDFN TITLECOMMANDFN TITLE
SELECTIONFN WHERE PROPPRINTFN) (* bvm: "26-Jun-85 15:12")
(* creates a window with an item list
made up of properties and values)
(PROG [WINDOW VALUE PROPMENU VALUEMENU VALUEMARGIN SELITEMS MAXVALUEWIDTH
(IWFONT (DEFAULTFONT (QUOTE DISPLAY)))
(PROPERTIESLST (COND
((OR (NULL PROPERTIES)
(LISTP PROPERTIES))
PROPERTIES)
(T (* allow PROPERTIES to be a function)
(APPLY* PROPERTIES DATUM]
(SETQ VALUEMARGIN (\INSPECTW.VALUE.MARGIN PROPERTIESLST IWFONT))
(SETQ MAXVALUEWIDTH (COND
(PROPERTIESLST (IMIN (IMAX (bind X for PROP in PROPERTIESLST
largest (\STRINGWIDTHGUESS
(APPLY* FETCHFN DATUM PROP)
IWFONT)
finally (RETURN $$EXTREME))
16)
MaxInspectorPropertyValueWidth))
(T (* no fields to inspect)
30)))
(SETQ WINDOW (DECODE.WINDOW.ARG WHERE (IPLUS VALUEMARGIN MAXVALUEWIDTH)
(IMIN MaxInspectorWindowHeight (ITIMES (COND
(PROPERTIESLST (LENGTH
PROPERTIESLST
))
(T 1))
(FONTHEIGHT IWFONT)))
(\INSPECT.COMPUTE.TITLE TITLE DATUM)))
(DSPFONT IWFONT WINDOW)
(DSPRIGHTMARGIN 50000 WINDOW) (* for now, can't handle multiple
PROPCOMMANDFN output.
Put right margin way out.)
(WINDOWPROP WINDOW (QUOTE DATUM)
DATUM) (* initialize the properties of the
window.)
(WINDOWPROP WINDOW (QUOTE STOREFN)
STOREFN)
(WINDOWPROP WINDOW (QUOTE FETCHFN)
FETCHFN)
(WINDOWPROP WINDOW (QUOTE PROPCOMMANDFN)
PROPCOMMANDFN)
(WINDOWPROP WINDOW (QUOTE VALUECOMMANDFN)
VALUECOMMANDFN)
(WINDOWPROP WINDOW (QUOTE INSPECTWTITLE)
TITLE)
(WINDOWPROP WINDOW (QUOTE TITLECOMMANDFN)
TITLECOMMANDFN)
(WINDOWPROP WINDOW (QUOTE SELECTIONFN)
SELECTIONFN)
(WINDOWPROP WINDOW (QUOTE PROPERTIES)
PROPERTIES)
(WINDOWPROP WINDOW (QUOTE PROPPRINTFN)
PROPPRINTFN)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION \ITEM.WINDOW.BUTTON.HANDLER))
(WINDOWPROP WINDOW (QUOTE COPYBUTTONEVENTFN)
(FUNCTION \ITEM.WINDOW.COPY.HANDLER))
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION INSPECTW.REPAINTFN))
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(RETURN (INSPECTW.REDISPLAY WINDOW NIL VALUEMARGIN])
(INSPECTW.REPAINTFN
[LAMBDA (WINDOW REGION) (* rrb "28-AUG-83 12:13")
(* repaints the selectable items in
(an inspect window. This knows that
the items are stored in increasing
order.))
(COND
[REGION (* only clip to region if a region is
given.)
(PROG ((SELITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
(WREG (DSPCLIPPINGREGION NIL WINDOW))
LINEBASE SELECTABLEITEMREGION PROPPRINTFN)
(SETQ LINEBASE (fetch (REGION TOP) of WREG))
ABOVELP
(* skip those above the window.)
(COND
((NULL SELITEMS)
(RETURN))
((IGREATERP (fetch (REGION BOTTOM) of (fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of (CAR SELITEMS)))
LINEBASE)
(SETQ SELITEMS (CDR SELITEMS))
(GO ABOVELP))) (* determine the bottom line base)
(SETQ LINEBASE (fetch (REGION BOTTOM) of WREG))
PRINTLP
(* print them as long as they are
visible.)
(COND
((NULL SELITEMS)
(RETURN))
((IGREATERP [fetch (REGION PTOP) of (SETQ SELECTABLEITEMREGION
(fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of (CAR SELITEMS]
LINEBASE) (* still possibly visible, check for
horizontal fit before printing.)
(COND
((REGIONSINTERSECTP REGION SELECTABLEITEMREGION)
(PRINTATBOX [COND
[[AND (EQ (fetch (SELECTABLEITEM ITEMINFOTYPE)
of (CAR SELITEMS))
(QUOTE PROPERTY))
(WINDOWPROP WINDOW (QUOTE DATUM))
(SETQ PROPPRINTFN (WINDOWPROP WINDOW (QUOTE
PROPPRINTFN
]
(* hook for property print functions
Should be cleaned up.)
(APPLY* PROPPRINTFN (fetch (SELECTABLEITEM ITEMINFO)
of (CAR SELITEMS))
(WINDOWPROP WINDOW (QUOTE DATUM]
(T (fetch (SELECTABLEITEM ITEMINFO) of (CAR SELITEMS]
WINDOW SELECTABLEITEMREGION)))
(SETQ SELITEMS (CDR SELITEMS))
(GO PRINTLP]
(T (* if no region, use other repaintfn
to repaint them all.)
(ITEMW.REPAINTFN WINDOW))) (* if there is a selected item, flip
it too in case some of it was in the
newly exposed area.)
(AND (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
(\ITEMW.FLIPITEM (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
WINDOW])
(INSPECTW.REDISPLAY
[LAMBDA (WINDOW PROPS VALUEMARGIN) (* rrb " 2-May-85 11:44")
(* redisplays an itemw to get the
newly updated fields.)
(COND
[PROPS (COND
((NLISTP PROPS)
(\INSPECTW.REDISPLAYPROP WINDOW PROPS))
(T (for PROP in PROPS do (\INSPECTW.REDISPLAYPROP WINDOW PROP]
(T (PROG ((DATUM (WINDOWPROP WINDOW (QUOTE DATUM)))
(PROPERTIES (INSPECTW.PROPERTIES WINDOW))
(FETCHFN (WINDOWPROP WINDOW (QUOTE FETCHFN)))
(PROPCOMMANDFN (WINDOWPROP WINDOW (QUOTE PROPCOMMANDFN)))
(VALUECOMMANDFN (WINDOWPROP WINDOW (QUOTE VALUECOMMANDFN)))
(PROPPRINTFN (WINDOWPROP WINDOW (QUOTE PROPPRINTFN)))
VALUE PROPMENU VALUEMENU SELITEMS PROPERTYPNAMES)
(SETQ PROPERTYPNAMES (COND
(PROPPRINTFN (for PROP in PROPERTIES
collect (APPLY* PROPPRINTFN PROP DATUM)))
(T PROPERTIES)))
[SETQ VALUEMARGIN (OR VALUEMARGIN (\INSPECTW.VALUE.MARGIN PROPERTYPNAMES
(DSPFONT NIL WINDOW]
(* remove old selected item if any)
(\ITEMW.DESELECTITEM NIL WINDOW)
(CLEARW WINDOW)
(WINDOWPROP WINDOW (QUOTE TITLE)
(\INSPECT.COMPUTE.TITLE (WINDOWPROP WINDOW (QUOTE INSPECTWTITLE))
DATUM WINDOW))
(* might be faster to only print and determine positions for the ones that are
visible and keep track of which haven't been seen yet but this is easier for
now.)
(MOVETOUPPERLEFT WINDOW (DSPCLIPPINGREGION NIL WINDOW))
[WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)
(SETQ SELITEMS
(for PROP in PROPERTIES as PROPNAME in PROPERTYPNAMES
join (COND
[PROPNAME (LIST (create SELECTABLEITEM
SELECTABLEITEMREGION ←
(PRINTANDBOX PROPNAME WINDOW
PropertyLeftMargin)
COMMANDFN ← (OR PROPCOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.PROPCOMMANDFN
))
ITEMINFO ← PROP
ITEMINFOTYPE ← (QUOTE PROPERTY))
(create SELECTABLEITEM
SELECTABLEITEMREGION ←
(PRINTANDBOX (COND
((NLSETQ (SETQ VALUE
(APPLY* FETCHFN
DATUM PROP
)))
VALUE)
(T
(* error during access.)
(SETQ VALUE
"** error during access **"
)))
WINDOW VALUEMARGIN
MinSpaceBetweenProperyAndValue)
COMMANDFN ← (OR VALUECOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.VALUECOMMANDFN
))
ITEMINFO ← VALUE
ITEMINFOTYPE ← (CONS PROP]
(T (* if property name returns NIL, print
value in middle)
(CONS (create SELECTABLEITEM
SELECTABLEITEMREGION ←
(PRINTANDBOX (COND
((NLSETQ (SETQ VALUE
(APPLY* FETCHFN DATUM
PROP)))
VALUE)
(T
(* error during access.)
(SETQ VALUE
"** error during access **")))
WINDOW
(LRSH VALUEMARGIN 1))
COMMANDFN ← (OR VALUECOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.VALUECOMMANDFN))
ITEMINFO ← VALUE
ITEMINFOTYPE ← (CONS PROP]
(WINDOWPROP WINDOW (QUOTE EXTENT)
(PROG [(NOWEXTENT (COND
[SELITEMS (create REGION using (fetch (SELECTABLEITEM
SELECTABLEITEMREGION
)
of (CAR SELITEMS]
(T (* don't have any items;
make extent empty.)
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 0
HEIGHT ← 0]
(for SELITEM in (CDR SELITEMS) do (EXTENDREGION NOWEXTENT
(fetch (SELECTABLEITEM
SELECTABLEITEMREGION
) of SELITEM)))
(RETURN NOWEXTENT))) (* limit scrolling so that it won't go
off the top.)
(WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE)
(QUOTE LIMIT))
(RETURN WINDOW])
(\INSPECTW.VALUE.MARGIN
[LAMBDA (PROPS FONT) (* rrb "14-Jan-86 11:42")
(* returns the x position in which the
values of the properties should print.)
(IMIN (IPLUS (IMAX (MAXSTRINGWIDTH PROPS FONT T)
16)
MinSpaceBetweenProperyAndValue PropertyLeftMargin)
MaxValueLeftMargin])
(INSPECTW.REPLACE
[LAMBDA (INSPECTW PROPERTY NEWVALUE) (* rrb "20-JUL-82 19:06")
(PROG [(DATUM (WINDOWPROP INSPECTW (QUOTE DATUM)))
(STOREFN (WINDOWPROP INSPECTW (QUOTE STOREFN]
(OR STOREFN (ERROR INSPECTW " does not have a STOREFN."))
(OR DATUM (ERROR INSPECTW " doesn't have a DATUM"))
(LISPXEVAL (LIST STOREFN (KWOTE DATUM)
(KWOTE PROPERTY)
(KWOTE NEWVALUE))
"↑←>")
(RETURN (\INSPECTW.REDISPLAYPROP INSPECTW PROPERTY])
(INSPECTW.SELECTITEM
[LAMBDA (INSPECTW PROPERTY VALUEFLG) (* rmk: "26-AUG-83 17:11")
(* makes a selection in an inspect window.
If another item is selected, it is deselected.
If VALUEFLG is non-NIL, the value of the property is selected, otherwise the
property name is selected. If PROPERTY is NIL, any selected item is deselected
and no item is selected. Returns the previously selected item structure.)
(PROG [(PREVIOUS (WINDOWPROP INSPECTW (QUOTE CURRENTITEM]
(AND PREVIOUS (\ITEMW.DESELECTITEM PREVIOUS INSPECTW))
(AND PROPERTY (\ITEMW.SELECTITEM (COND
(VALUEFLG (ITEMOFPROPERTYVALUE PROPERTY INSPECTW))
(T (\SELITEM.FROM.PROPERTY INSPECTW PROPERTY)))
INSPECTW))
(RETURN PREVIOUS])
(\INSPECTW.REDISPLAYPROP
[LAMBDA (WINDOW PROPERTY) (* bvm: "16-Jun-86 14:55")
(* refetches and displays a property
of an inspect window.
This is called when a property has
changed, to update the display.)
(LET ((DATUM (WINDOWPROP WINDOW (QUOTE DATUM)))
(OLDVALUEITEM (ITEMOFPROPERTYVALUE PROPERTY WINDOW))
(NEWVALUE (INSPECTW.FETCH WINDOW PROPERTY))
ITEMSELECTED? NEWVALUEREGION)
(OR DATUM (ERROR WINDOW " doesn't have a DATUM"))
(OR OLDVALUEITEM (ERROR "No value for a property in an INSPECTW" WINDOW))
(* if value being replace is selected,
deselect it and reselect it when
finished)
(COND
((EQ OLDVALUEITEM (WINDOWPROP WINDOW (QUOTE CURRENTITEM)))
(SETQ ITEMSELECTED? T)
(\ITEMW.DESELECTITEM OLDVALUEITEM WINDOW)))
(replace ITEMINFO of OLDVALUEITEM with NEWVALUE) (* erase old stuff)
(DSPFILL (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of OLDVALUEITEM)
(DSPTEXTURE NIL WINDOW)
(QUOTE REPLACE)
WINDOW)
(PROG1 [SETQ NEWVALUEREGION (replace (SELECTABLEITEM SELECTABLEITEMREGION) of OLDVALUEITEM
with (PRINTATBOX NEWVALUE WINDOW (fetch (SELECTABLEITEM
SELECTABLEITEMREGION
) of OLDVALUEITEM]
(EXTENDEXTENT WINDOW NEWVALUEREGION)
(COND
(ITEMSELECTED? (\ITEMW.SELECTITEM OLDVALUEITEM WINDOW])
(INSPECTW.FETCH
[LAMBDA (INSPECTW PROPERTY) (* rrb " 6-MAR-82 15:45")
(* retrieves the property value from
an inspect window)
(APPLY* (OR (WINDOWPROP INSPECTW (QUOTE FETCHFN))
(ERROR INSPECTW " doesn't have a FETCHFN"))
(OR (WINDOWPROP INSPECTW (QUOTE DATUM))
(ERROR INSPECTW " doesn't have a DATUM"))
PROPERTY])
(INSPECTW.PROPERTIES
[LAMBDA (INSPECTW) (* rrb " 5-DEC-82 11:36")
(* gets the list of properties from an
INSPECTW.)
(PROG [(PROPERTIES (WINDOWPROP INSPECTW (QUOTE PROPERTIES]
(RETURN (COND
((OR (NULL PROPERTIES)
(LISTP PROPERTIES))
PROPERTIES)
(T (* allow PROPERTIES to be a function)
(APPLY* PROPERTIES (WINDOWPROP INSPECTW (QUOTE DATUM])
(DECODE.WINDOW.ARG
[LAMBDA (WHERESPEC WIDTH HEIGHT TITLE BORDER NOOPENFLG) (* bvm: "24-Jun-85 17:40")
(* standard useful routine for decoding a window specification arg.
WHERESPEC can be a window, a region, a position or NIL.
If WHERESPEC is a window, the other args are ignored.
This allows programs to override defaults by explicitly providing a window.
If a position or NIL, WIDTH and HEIGHT are the dimensions of the new window.
The returned window will be entirely on the screen, dimensions permitting.)
(COND
((WINDOWP WHERESPEC)
WHERESPEC)
(T (CREATEW (COND
((REGIONP WHERESPEC)
(MAKEWITHINREGION WHERESPEC))
[(AND (NUMBERP WIDTH)
(NUMBERP HEIGHT))
(COND
[(POSITIONP WHERESPEC)
(MAKEWITHINREGION (CREATEREGION (fetch (POSITION XCOORD) of WHERESPEC)
(fetch (POSITION YCOORD) of WHERESPEC)
(WIDTHIFWINDOW WIDTH BORDER)
(HEIGHTIFWINDOW HEIGHT TITLE BORDER]
(T (GETBOXREGION (WIDTHIFWINDOW WIDTH BORDER)
(HEIGHTIFWINDOW HEIGHT TITLE BORDER)
NIL NIL NIL (CONCAT "Specify position for " TITLE]
(T NIL))
TITLE BORDER NOOPENFLG])
(DEFAULT.INSPECTW.PROPCOMMANDFN
[LAMBDA (PROPERTY DATUM INSPECTW) (* rrb "30-Apr-85 16:30")
(* allows the user to select a menu
item to change the property in an
inspect window.)
(SELECTQ [MENU (COND
((type? MENU SetPropertyMenu)
SetPropertyMenu)
(T (SETQ SetPropertyMenu (create MENU
ITEMS ← (QUOTE ((SET (QUOTE SET)
"Allows a new value to be entered"
]
(SET [ERSETQ (PROG ((OLDVALUEITEM (ITEMOFPROPERTYVALUE PROPERTY INSPECTW))
NEWVALUE PWINDOW)
(TTYDISPLAYSTREAM (SETQ PWINDOW (GETPROMPTWINDOW INSPECTW 3)))
(CLEARBUF T T)
(RESETLST (RESETSAVE (\ITEMW.FLIPITEM OLDVALUEITEM INSPECTW)
(LIST (QUOTE \ITEMW.FLIPITEM)
OLDVALUEITEM INSPECTW))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(RESETSAVE (PRINTLEVEL 4 3))
(printout T "Enter the new " PROPERTY " for " DATUM T
"The expression read will be EVALuated." T "> ")
(SETQ NEWVALUE (LISPX (LISPXREAD T T)
(QUOTE >)))
(* clear tty buffer because it
sometimes has stuff left.)
(CLEARBUF T T))
(CLOSEW PWINDOW)
(RETURN (INSPECTW.REPLACE INSPECTW PROPERTY NEWVALUE])
NIL])
(DEFAULT.INSPECTW.VALUECOMMANDFN
[LAMBDA (VALUE PROPERTY DATUM WINDOW) (* rrb " 9-AUG-83 09:42")
(* allows the user to choose a way to
inspect a value in a window)
(SELECTQ (TYPENAME VALUE)
(LITATOM (COND
(VALUE (INSPECT/ATOM VALUE T))
(T (printout PROMPTWINDOW T "Can't inspect NIL.")
(until (MOUSESTATE UP))
(CLRPROMPT))))
(BITMAP (INSPECT/BITMAP VALUE))
((FIXP SMALLP FLOATP)
(printout PROMPTWINDOW T "Can't Inspect " VALUE)
(until (MOUSESTATE UP))
(CLRPROMPT))
(LISTP (* find out how to inspect the list.)
(INSPECT/LISTP VALUE))
(SELECTQ [MENU (COND
((type? MENU InspectMenu)
InspectMenu)
(T (SETQ InspectMenu (create MENU
ITEMS ← (QUOTE ((Inspect (QUOTE INSPECT/VALUE]
(INSPECT/VALUE (INSPECT VALUE))
NIL])
(DEFAULT.INSPECTW.TITLECOMMANDFN
[LAMBDA (INSPECTW DATUM) (* rrb "18-Apr-84 17:57")
(SELECTQ [MENU (COND
((type? MENU ItemWCommandMenu)
ItemWCommandMenu)
(T (SETQ ItemWCommandMenu (create MENU
ITEMS ← (QUOTE ((ReFetch (QUOTE REFETCH)
"ReFetches and redisplays the object's fields"
)
(IT←datum (QUOTE SETIT)
"sets the variable IT to the object inspected in this window."
)
(IT←selection (QUOTE
SETITTOSEL
)
"sets the variable IT to the item selected in this window."
]
(REFETCH (INSPECTW.REDISPLAY INSPECTW))
(SETIT (SETQ IT DATUM))
(SETITTOSEL (COND
[(WINDOWPROP INSPECTW (QUOTE CURRENTITEM))
(SETQ IT (fetch (SELECTABLEITEM ITEMINFO) of (WINDOWPROP INSPECTW
(QUOTE CURRENTITEM]
(T (PROMPTPRINT "No item has been selected from this window."))))
NIL])
(\SELITEM.FROM.PROPERTY
[LAMBDA (INSPECTW PROPERTY) (* rrb " 6-MAR-82 17:50")
(for SELITEM in (WINDOWPROP INSPECTW (QUOTE SELECTABLEITEMS))
when (AND (EQ (fetch (SELECTABLEITEM ITEMINFO) of SELITEM)
PROPERTY)
(EQ (fetch (SELECTABLEITEM ITEMINFOTYPE) of SELITEM)
(QUOTE PROPERTY))) do (RETURN SELITEM])
(\INSPECT.COMPUTE.TITLE
[LAMBDA (TITLE DATUM WINDOW) (* rrb " 7-AUG-83 19:09")
(* computes the title for an inspectw
from its title field and its datum.)
(PROG (VALUE)
(RETURN (COND
((NULL TITLE)
(CONCAT (LEVELEDFORM DATUM 3 4)
" Inspector"))
((EQ TITLE (QUOTE DON'T)) (* no title)
NIL)
((LITATOM TITLE) (* it is a function to compute the
title.)
(COND
((NEQ (SETQ VALUE (APPLY* TITLE DATUM WINDOW))
(QUOTE DON'T))
VALUE)
(T NIL)))
(T TITLE])
(LEVELEDFORM
[LAMBDA (EXP CARLEV CDRLEV) (* rrb "13-MAR-82 12:08")
(* returns a copy of EXP that is
abbreviated at CARLEV depth in the car
direction and CDRLEV depth in the CDR
direction)
(COND
((NLISTP EXP)
EXP)
((EQ CARLEV 0)
(QUOTE &))
(T (CONS (LEVELEDFORM (CAR EXP)
(SUB1 CARLEV)
CDRLEV)
(COND
[(EQ CDRLEV 0)
(COND
((CDR EXP)
(QUOTE (--]
(T (LEVELEDFORM (CDR EXP)
CARLEV
(SUB1 CDRLEV])
(MAKEWITHINREGION
[LAMBDA (REGION LIMITREGION) (* rrb "18-Apr-84 20:09")
(* moves REGION so that it is entirely
on the screen.)
(DECLARE (GLOBALVARS WHOLEDISPLAY))
(PROG [X (LIMITREGION (COND
(LIMITREGION (OR (REGIONP LIMITREGION)
(\ILLEGAL.ARG LIMITREGION)))
(T WHOLEDISPLAY]
[COND
((ILESSP (fetch (REGION LEFT) of REGION)
(SETQ X (fetch (REGION LEFT) of LIMITREGION)))
(replace (REGION LEFT) of REGION with X))
((IGREATERP (fetch (REGION PRIGHT) of REGION)
(SETQ X (fetch (REGION PRIGHT) of LIMITREGION)))
(replace (REGION LEFT) of REGION with (IMAX 0 (IDIFFERENCE (SUB1 X)
(fetch (REGION WIDTH) of REGION]
[COND
((ILESSP (fetch (REGION BOTTOM) of REGION)
(SETQ X (fetch (REGION BOTTOM) of LIMITREGION)))
(replace (REGION BOTTOM) of REGION with X))
((IGREATERP (fetch (REGION PTOP) of REGION)
(SETQ X (fetch (REGION PTOP) of LIMITREGION)))
(replace (REGION BOTTOM) of REGION with (IMAX 0 (IDIFFERENCE (SUB1 X)
(fetch (REGION HEIGHT)
of REGION]
(RETURN REGION])
)
(DEFINEQ
(ITEMW.REPAINTFN
[LAMBDA (WINDOW REGION) (* rrb "28-AUG-83 12:13")
(* repaints the selectable items in a
window.)
[for SELITEM in (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)) bind SELECTABLEITEMREGION
do (COND
((REGIONSINTERSECTP REGION (SETQ SELECTABLEITEMREGION (fetch (SELECTABLEITEM
SELECTABLEITEMREGION
) of SELITEM)))
(PRINTATBOX (fetch (SELECTABLEITEM ITEMINFO) of SELITEM)
WINDOW SELECTABLEITEMREGION] (* if there is a selected item, flip
it too in case some of it was in the
newly exposed area.)
(AND (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
(\ITEMW.FLIPITEM (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
WINDOW])
(\ITEM.WINDOW.BUTTON.HANDLER
[LAMBDA (WINDOW) (* rrb " 6-MAR-82 16:12")
(* handles button events for item
windows. Basically calls left or
middle button handler.)
(COND
((LASTMOUSESTATE LEFT)
(\ITEM.WINDOW.SELECTION.HANDLER WINDOW))
((LASTMOUSESTATE MIDDLE)
(\INSPECTW.COMMAND.HANDLER WINDOW])
(\ITEM.WINDOW.SELECTION.HANDLER
[LAMBDA (WINDOW) (* rrb "30-Apr-85 17:04")
(* selects an ITEM from the window. If there is an item selected already, it is
deselected. An ITEM is a list whose CAR is a region.)
(PROG ((SELECTABLEITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
NOW PREVIOUS BUTTON OLDPOS REG)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN))) (* note which button is down.)
(COND
((LASTMOUSESTATE LEFT)
(SETQ BUTTON (QUOTE LEFT)))
((LASTMOUSESTATE MIDDLE)
(SETQ BUTTON (QUOTE MIDDLE)))
(T (* no button down, not interested.)
(RETURN)))
(TOTOPW WINDOW)
(SETQ REG (WINDOWPROP WINDOW (QUOTE REGION))) (* note current item selection.)
[SETQ NOW (IN/ITEM? SELECTABLEITEMS (SETQ OLDPOS (CURSORPOSITION NIL WINDOW]
(SETQ PREVIOUS (WINDOWPROP WINDOW (QUOTE CURRENTITEM)))
FLIP
(* turn off old selection.)
(\ITEMW.DESELECTITEM PREVIOUS WINDOW)
(\ITEMW.SELECTITEM (SETQ PREVIOUS NOW)
WINDOW)
LP (* wait for a button up or move out of
region)
(GETMOUSESTATE)
(COND
((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* button up, return)
(AND NOW (WINDOWPROP WINDOW (QUOTE SELECTIONFN))
(APPLY* (WINDOWPROP WINDOW (QUOTE SELECTIONFN))
[COND
((EQ (QUOTE PROPERTY)
(fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW))
(fetch (SELECTABLEITEM ITEMINFO) of NOW))
(T (CAR (fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW]
(NEQ (fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW)
(QUOTE PROPERTY))
WINDOW))
(RETURN))
((NOT (INSIDE? REG LASTMOUSEX LASTMOUSEY)) (* outside of region, return)
(\ITEMW.DESELECTITEM PREVIOUS WINDOW)
(RETURN))
([EQ PREVIOUS (SETQ NOW (IN/ITEM? SELECTABLEITEMS (CURSORPOSITION NIL WINDOW OLDPOS]
(GO LP))
(T (GO FLIP])
(\INSPECTW.COMMAND.HANDLER
[LAMBDA (INSPECTW) (* rrb " 7-MAR-82 17:05")
(* the user has middle buttoned in an ITEM window.
Apply the selected item's COMMANDFN to the selected item and the window.
Often the commandfn will put up another menu.)
(COND
[(INSIDEP (DSPCLIPPINGREGION NIL INSPECTW)
(LASTMOUSEX INSPECTW)
(LASTMOUSEY INSPECTW)) (* inside of interior)
(PROG ((SELITEM (WINDOWPROP INSPECTW (QUOTE CURRENTITEM)))
COMMANDFN INFO)
(RETURN (COND
[SELITEM (COND
((NULL (SETQ COMMANDFN (fetch (SELECTABLEITEM COMMANDFN)
of SELITEM)))
(* special case of NIL command fn)
(PROMPTPRINT "There is no change function for this window."))
((STRINGP COMMANDFN)
(PROMPTPRINT COMMANDFN))
(T
(* check to see if the selected item is a property or a value.
This distinction is because the value one needs an extra argument.
The selected item is considered to be a property if it is one of the properties
of the window.)
(ERSETQ (COND
((EQ (SETQ INFO (fetch (SELECTABLEITEM
ITEMINFOTYPE)
of SELITEM))
(QUOTE PROPERTY))
(* the selected item is a property.
Call the command fn in property form.)
(APPLY* COMMANDFN (fetch (SELECTABLEITEM ITEMINFO
) of SELITEM)
(WINDOWPROP INSPECTW (QUOTE DATUM))
INSPECTW))
(T
(* the selected item is a value Call the command fn in value form.
For values, the item info type is a cons whose CAR is the property)
(APPLY* COMMANDFN (fetch (SELECTABLEITEM
ITEMINFO)
of SELITEM)
(CAR INFO)
(WINDOWPROP INSPECTW (QUOTE DATUM))
INSPECTW]
(T (PROMPTPRINT (QUOTE (This is the command button. % You must select an
item with the left button before choosing a
command.)))
(until (MOUSESTATE UP))
(CLRPROMPT]
(T (* inside border or title Call the
window's TITLECOMMANDFN)
(APPLY* (OR (WINDOWPROP INSPECTW (QUOTE TITLECOMMANDFN))
(FUNCTION DEFAULT.INSPECTW.TITLECOMMANDFN))
INSPECTW
(WINDOWPROP INSPECTW (QUOTE DATUM])
(ITEM.WINDOW.SET.STACK.ARG
[LAMBDA (VARNAME FRAME WINDOW) (* rrb " 9-AUG-83 09:46")
(* the PropCommandFn for itemw windows
onto stack frames.)
(SELECTQ [MENU (COND
((type? MENU SetStackMenu)
SetStackMenu)
(T (SETQ SetStackMenu (create MENU
ITEMS ← (QUOTE ((Set (QUOTE SET)
"Changes the value of this stack variable"
]
(SET (OR (STACKP FRAME)
(\ILLEGAL.ARG FRAME))
[ERSETQ (PROG ((OLDVALUEITEM (ITEMOFPROPERTYVALUE VARNAME WINDOW))
NEWVALUE) (* decode the argument position)
(* insist that the arg being set has a real name.
following is the code to allow any var to be set:
(SETQ ARGN (COND ((FRAMESCAN VARNAME FRAME))
((STRPOS VARNAME "*arg" 1 T) (COND ((SMALLP
(SUBATOM VARNAME 5 -1))) (T (PROMPTPRINT "Can't set that arg.")
(RETURN)))) ((STRPOS VARNAME "*prg" 1 T)
(COND ((SETQ ARGN (SMALLP (SUBATOM VARNAME 5 -1)))
(IPLUS ARGN (STKNARGS FRAME))) (T (PROMPTPRINT "Can't set that arg.")
(RETURN)))))))
(COND
((FRAMESCAN VARNAME FRAME))
(T (PROMPTPRINT "Can't set that arg.")
(RETURN)))
[RESETLST (RESETSAVE (\ITEMW.FLIPITEM OLDVALUEITEM WINDOW)
(LIST (QUOTE \ITEMW.FLIPITEM)
OLDVALUEITEM WINDOW))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(CLRPROMPT)
(printout T "Enter the new value for " VARNAME "." T
"The expression read will be EVALuated." T "> ")
(SETQ NEWVALUE (EVAL (READ T T]
(RETURN (INSPECTW.REPLACE WINDOW VARNAME NEWVALUE])
NIL])
(REPLACESTKARG
[LAMBDA (FRAMESPEC WHICHSPEC NEWVALUE) (* rrb " 8-AUG-83 16:46")
(* StoreFn for the ITEMW that inspects
back trace frames.)
(COND
((NULL (CDR WHICHSPEC)) (* this is a dummy which is a function
name. it has no value)
NIL)
((LISTP FRAMESPEC)
(REPLACESTKARG (CAR (NTH FRAMESPEC (CAR WHICHSPEC)))
(CDR WHICHSPEC)
NEWVALUE))
(T (PROG NIL
(OR (STACKP FRAMESPEC)
(\ILLEGAL.ARG FRAMESPEC))
(RETURN (SETSTKARG (COND
((LISTP WHICHSPEC) (* CAR is name, CADR is offset)
(CADR WHICHSPEC))
((FRAMESCAN WHICHSPEC FRAMESPEC))
(T (PROMPTPRINT "Can't set that arg.")
(RETURN)))
FRAMESPEC NEWVALUE])
(IN/ITEM?
[LAMBDA (ITEMS POS) (* rrb "28-AUG-83 12:18")
(PROG ((XPOS (fetch XCOORD of POS))
(YPOS (fetch YCOORD of POS)))
(RETURN (for ITEM in ITEMS when (AND (fetch (SELECTABLEITEM SELECTABLEITEMREGION)
of ITEM)
(INSIDE? (fetch (SELECTABLEITEM SELECTABLEITEMREGION)
of ITEM)
XPOS YPOS)) do (RETURN ITEM])
(\ITEMW.DESELECTITEM
[LAMBDA (ITEM WINDOW) (* rrb " 6-MAR-82 15:13")
(* deselects ITEM from window)
(AND ITEM (\ITEMW.FLIPITEM ITEM WINDOW))
(WINDOWPROP WINDOW (QUOTE CURRENTITEM)
NIL])
(\ITEMW.SELECTITEM
[LAMBDA (ITEM WINDOW) (* rrb " 6-MAR-82 15:13")
(* selects an ITEM in WINDOW)
(AND ITEM (\ITEMW.FLIPITEM ITEM WINDOW))
(WINDOWPROP WINDOW (QUOTE CURRENTITEM)
ITEM])
(\ITEMW.CLEARSELECTION
[LAMBDA (INSPECTW) (* rrb "20-JUL-83 09:34")
(* clears the selection from an
inspect window)
(PROG [(CURRENTITEM (WINDOWPROP INSPECTW (QUOTE CURRENTITEM]
(AND CURRENTITEM (\ITEMW.DESELECTITEM CURRENTITEM INSPECTW))
(RETURN INSPECTW])
(\ITEMW.FLIPITEM
[LAMBDA (ITEM DS) (* bvm: "26-Jun-85 14:37")
(* flips the region of an item)
(LET ((REG (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of ITEM)))
(BLTSHADE BLACKSHADE DS (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
(fetch HEIGHT of REG)
(QUOTE INVERT])
(PRINTANDBOX
[LAMBDA (EXP STREAM LFTMARGIN MINSPACE) (* rmk: "26-AUG-83 17:56")
(* prints EXP on WINDOW starting at
LFTMARGIN and returns the box taken by
the characters. Leaves at least
MINSPACE points.)
(* set the left margin so that at
least nothing will CR past it.
This does not handle multiple line
values.)
(PROG ((STRM (\OUTSTREAMARG STREAM))
PREVRM PREVLM YSTART YEND HGHT)
(SETQ PREVRM (DSPRIGHTMARGIN 50000 STRM)) (* so that it won't auto carrage
return.)
(SETQ PREVLM (DSPLEFTMARGIN LFTMARGIN STRM))
(AND (FIXP MINSPACE)
(RELMOVETO MINSPACE 0 STRM))
(COND
((IGREATERP (DSPXPOSITION NIL STRM)
LFTMARGIN)
(TERPRI STRM)))
(DSPXPOSITION LFTMARGIN STRM)
(SETQ YSTART (DSPYPOSITION NIL STRM))
(RETURN (PROG1 [create REGION
LEFT ← LFTMARGIN
BOTTOM ← [PROGN (RESETFORM (PRINTLEVEL INSPECTPRINTLEVEL)
(PROG ((PLVLFILEFLG T))
(PRIN2 EXP STRM)))
(IDIFFERENCE (SETQ YEND (DSPYPOSITION NIL STRM))
(FONTPROP STRM (QUOTE DESCENT]
HEIGHT ← (IPLUS (SETQ HGHT (IDIFFERENCE YSTART YEND))
(FONTPROP STRM (QUOTE HEIGHT)))
WIDTH ← (COND
((IGREATERP HGHT 0)
(* printing the thing did an overflow;
use at least the width of the window.)
(IMAX (IDIFFERENCE (DSPXPOSITION NIL STRM)
LFTMARGIN)
(IDIFFERENCE (fetch (REGION WIDTH)
of (DSPCLIPPINGREGION NIL STRM))
LFTMARGIN)))
(T (IDIFFERENCE (DSPXPOSITION NIL STRM)
LFTMARGIN]
(DSPRIGHTMARGIN PREVRM STRM)
(DSPLEFTMARGIN PREVLM STRM])
(PRINTATBOX
[LAMBDA (EXP WINDOW OLDBOX) (* rrb "21-FEB-83 13:02")
(* prints EXP in place of what used to
be in oldbox and returns the new box.)
(DSPFILL OLDBOX NIL (QUOTE REPLACE)
WINDOW)
(MOVETO (fetch LEFT of OLDBOX)
(IDIFFERENCE (fetch PTOP of OLDBOX)
(FONTPROP (DSPFONT NIL WINDOW)
(QUOTE ASCENT)))
WINDOW)
(PRINTANDBOX EXP WINDOW (fetch LEFT of OLDBOX])
(ITEMOFPROPERTYVALUE
[LAMBDA (PROPERTY WINDOW) (* rrb " 6-MAR-82 18:19")
(* returns the selectableitem
structure that corresponds to the
value of a property in an inspectw.
Knows the way INSPECTW are created.)
(CADR (MEMB (\SELITEM.FROM.PROPERTY WINDOW PROPERTY)
(WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS])
)
(DEFINEQ
(\ITEM.WINDOW.COPY.HANDLER
[LAMBDA (WINDOW) (* bvm: "26-Jun-85 15:38")
(* * copy selects an ITEM from the window.
An ITEM is an instance of record SELECTABLEITEM.)
(PROG ((SELECTABLEITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
CURRENTITEM SMASHPOS NEWITEM)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN)))
LP (TOTOPW WINDOW) (* note current item selection.)
[SETQ NEWITEM (IN/ITEM? SELECTABLEITEMS (SETQ SMASHPOS (CURSORPOSITION NIL WINDOW]
[COND
((NEQ CURRENTITEM NEWITEM)
(COND
(CURRENTITEM (* turn off old selection.)
(\ITEMW.FLIPCOPY CURRENTITEM WINDOW)))
(COND
((SETQ CURRENTITEM NEWITEM)
(\ITEMW.FLIPCOPY CURRENTITEM WINDOW] (* wait for a button up or move out of
region)
LP2 (BLOCK)
(COND
((NOT (.COPYKEYDOWNP.)) (* Finished, copy selected item)
[COND
(CURRENTITEM (\ITEMW.FLIPCOPY CURRENTITEM WINDOW)
(BKSYSBUF.GENERAL (fetch (SELECTABLEITEM ITEMINFO) of CURRENTITEM]
(RETURN))
((MOUSESTATE UP) (* button up, no action)
(GO LP2))
(T (GO LP])
(\ITEMW.FLIPCOPY
[LAMBDA (ITEM DS) (* bvm: "26-Jun-85 15:09")
(* * flips the copy selection region of an item)
(LET ((REG (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of ITEM)))
(BLTSHADE GRAYSHADE DS (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
2
(QUOTE INVERT])
(BKSYSBUF.GENERAL
[LAMBDA (OBJECT) (* bvm: "28-Jun-85 18:15")
(* * Does a slightly more intelligent BKSYSBUF than just stuffing the print
name as characters)
(LET ((TYPE (TYPENAME OBJECT)))
(SELECTQ TYPE
((STRINGP LITATOM)
(BKSYSBUF OBJECT T T))
(LISTP (bind (SEPR ← (QUOTE %()) do (BKSYSBUF SEPR)
(SETQ SEPR (QUOTE % ))
(BKSYSBUF.GENERAL (CAR OBJECT))
repeatuntil (NLISTP (SETQ OBJECT (CDR OBJECT)))
finally (COND
(OBJECT (* Dotted cdr)
(BKSYSBUF " . ")
(BKSYSBUF.GENERAL OBJECT)))
(BKSYSBUF (QUOTE %)))))
(COND
((OR (NUMBERP OBJECT)
(ASSOC TYPE \DEFPRINTFNS))
(BKSYSBUF OBJECT))
(T (BKSYSBUF "(\VAG2 ")
(BKSYSBUF (OCTALSTRING (\HILOC OBJECT)))
(BKSYSBUF "Q ")
(BKSYSBUF (OCTALSTRING (\LOLOC OBJECT)))
(BKSYSBUF "Q)"])
)
[DECLARE: EVAL@COMPILE
(RECORD SELECTABLEITEM (SELECTABLEITEMREGION COMMANDFN ITEMINFO ITEMINFOTYPE))
]
(RPAQQ MAXINSPECTARRAYLEVEL 300)
(RPAQQ MAXINSPECTCDRLEVEL 50)
(RPAQQ MinSpaceBetweenProperyAndValue 8)
(RPAQQ MaxInspectorPropertyValueWidth 250)
(RPAQQ MaxValueLeftMargin 250)
(RPAQQ PropertyLeftMargin 2)
(* "functions for the inspector")
(DEFINEQ
(INSPECT
[LAMBDA (ITEM ASTYPE WHERE) (* bvm: "16-Jun-86 11:47")
(* sets up a window that allows
inspection.)
(DECLARE (SPECVARS WHERE))
(LET ((ITEMTYPE (TYPENAME ITEM))
INSPECTINFO)
(COND
(ASTYPE (* if ASTYPE is given, always inspect
it as that type. This provides a way
of overriding macros.)
(INSPECT/DATATYPE ITEM ASTYPE WHERE))
[(SETQ INSPECTINFO (for IMACRO in INSPECTMACROS
when (COND
[(LISTP (CAR IMACRO))
(COND
((EQ (CAAR IMACRO)
(QUOTE FUNCTION))
(APPLY* (CADAR IMACRO)
ITEM))
(T (ERROR "ERROR in INSPECTMACROS specification" IMACRO
]
(T (EQ (CAR IMACRO)
ITEMTYPE))) do (RETURN IMACRO)))
(COND
((LISTP (CDR INSPECTINFO)) (* inspect information is a list of
arguments to INSPECTW.CREATE)
(\APPLYINSPECTMACRO ITEM (CDR INSPECTINFO)
WHERE))
(T (* if inspect information is an atom,
apply it to the ITEM.)
(APPLY* (CDR INSPECTINFO)
ITEM
(CAR INSPECTINFO)
WHERE]
[ITEM (SELECTQ ITEMTYPE
(LITATOM (INSPECT/ATOM ITEM NIL WHERE))
(LISTP (* find out how to inspect the list.)
(INSPECT/LISTP ITEM WHERE))
(ARRAYP (INSPECT/ARRAY ITEM NIL WHERE))
(HARRAYP (INSPECT/HARRAYP ITEM WHERE))
(BITMAP (INSPECT/BITMAP ITEM WHERE))
(CCODEP (INSPECTCODE ITEM WHERE))
(NIL (INSPECT/TYPELESS ITEM WHERE))
(LET [(DTD (\GETDTD (NTYPX ITEM]
(COND
((fetch DTDHUNKP of DTD)
(INSPECT/HUNK ITEM WHERE (fetch DTDGCTYPE of DTD)
(fetch DTDSIZE of DTD)))
(T (INSPECT/DATATYPE ITEM NIL WHERE]
(T (printout PROMPTWINDOW T "Can't Inspect NIL.")
NIL])
(\APPLYINSPECTMACRO
[LAMBDA (DATUM ARGLST WHERE) (* rrb "12-AUG-83 13:50")
(* function that calls INSPECTW.CREATE
when given the inspect macro
information. Separate because of
difficulty of interpreting WHERE
argument.)
(PROG ((ARGS ARGLST))
(RETURN (INSPECTW.CREATE DATUM (pop ARGS)
(pop ARGS)
(pop ARGS)
(pop ARGS)
(pop ARGS)
(pop ARGS)
(pop ARGS)
(pop ARGS)
(COND
(ARGS (* WHERE argument must be evaluated.)
(EVAL ARGS))
(T WHERE))
(pop ARGS])
(INSPECT/BITMAP
[LAMBDA (BITMAP WHERE) (* rrb "18-Apr-84 19:27")
(* asks whether to use the bitmap
editor or not)
(SELECTQ [MENU (COND
((type? MENU InspectBitmapMenu)
InspectBitmapMenu)
(T (SETQ InspectBitmapMenu (create MENU
ITEMS ← (QUOTE ((fields (QUOTE FIELDS)
"Inspects the fields of the bitmap"
)
(contents (QUOTE CONTENTS)
"Edits the contents of the bitmap."
]
(FIELDS (INSPECT/DATATYPE BITMAP (QUOTE BITMAP)
WHERE))
(CONTENTS (EVAL.AS.PROCESS (LIST (QUOTE EDITBM)
BITMAP)))
NIL])
(INSPECT/DATATYPE
[LAMBDA (DATUM TYPE WHERE) (* bvm: "25-Jun-86 11:35")
(* * "creates an inspector window for datatype or record instance DATUM")
(LET ((SYSREC "System datatype. Not settable with the inspector.")
DEC)
[COND
((AND TYPE (SETQ DEC (RECLOOK TYPE)))
(SETQ SYSREC NIL))
[(AND TYPE (SETQ DEC (SYSRECLOOK1 TYPE]
((SETQ DEC (FINDRECDECL DATUM))
(SETQ SYSREC NIL))
((SETQ DEC (FINDSYSRECDECL DATUM]
(COND
(DEC (COND
((AND SYSREC WIZARDFLG)
(SETQ SYSREC NIL))) (*
"The fetchfn and storefn would be more attractive if we had lexical closures")
(INSPECTW.CREATE DATUM (INSPECTABLEFIELDNAMES DEC (OR (NULL INSPECTALLFIELDSFLG)
SYSREC))
[BQUOTE (LAMBDA (INSTANCE FIELD)
(RECORDACCESS FIELD INSTANCE (QUOTE (\, DEC]
[OR SYSREC (BQUOTE (LAMBDA (INSTANCE FIELD NEWVALUE)
(RECORDACCESS FIELD INSTANCE (QUOTE (\, DEC))
(QUOTE /REPLACE)
NEWVALUE]
SYSREC NIL NIL NIL NIL WHERE))
([SETQ DEC (fetch DTDDESCRS of (\GETDTD (NTYPX DATUM]
(* No user-level declaration, but we
can at least fetch raw fields out of
it)
(INSPECTW.CREATE DATUM (for I to (LENGTH DEC) collect I)
[BQUOTE (LAMBDA (FIELD INSTANCE)
(\INSPECT.DATATYPE.RAW.FETCH FIELD INSTANCE (QUOTE (\, DEC]
NIL SYSREC NIL NIL NIL NIL WHERE))
(T (printout PROMPTWINDOW T "No declaration for " DATUM T "Can not inspect.")
NIL])
(INSPECTABLEFIELDNAMES
[LAMBDA (DECL TOPONLYFLG) (* rrb "21-JUL-82 19:23")
(* returns the list of record field
names suitable for inspecting.
This is everything unless TOPONLYFLG
is T which is the case for system
records.)
(COND
(TOPONLYFLG (for FIELDNAME in (CDR (RECORDFIELDNAMES DECL T)) when (AND FIELDNAME (NLISTP
FIELDNAME))
collect FIELDNAME))
(T (REMOVEDUPS (RECORDFIELDNAMES DECL])
(REMOVEDUPS
[LAMBDA (LST) (* removes the duplicate entries from
LST.)
(INTERSECTION LST LST])
(INSPECT/ARRAY
[LAMBDA (ARRAY BEGINOFFSET WHERE) (* rrb " 9-AUG-83 09:26")
(* inspects an array)
(COND
[(ARRAYP ARRAY)
(PROG [(FIRSTELT (OR (NUMBERP BEGINOFFSET)
(ARRAYORIG ARRAY]
(RETURN (INSPECTW.CREATE ARRAY (for I from FIRSTELT
to (SUB1 (IMIN (IPLUS (ARRAYORIG ARRAY)
(ARRAYSIZE ARRAY))
(IPLUS FIRSTELT MAXINSPECTARRAYLEVEL))
) collect I)
(FUNCTION ELT)
(FUNCTION /SETA)
NIL NIL NIL NIL NIL WHERE]
(T (printout PROMPTWINDOW T ARRAY " not an array")
NIL])
(INSPECT/TOP/LEVEL/LIST
[LAMBDA (LST WHERE) (* rrb " 9-AUG-83 09:22")
(* inspects one level of a list
structure via numbered fields.)
(COND
((LISTP LST)
(INSPECTW.CREATE LST [for I from 1 to MAXINSPECTCDRLEVEL as X on LST collect I
finally (COND
(X (NCONC1 $$VAL (COND
((NLISTP X)
(QUOTE ...))
(T (QUOTE &&]
(FUNCTION NTHTOPLEVELELT)
(FUNCTION SETNTHTOPLEVELELT)
NIL NIL NIL NIL NIL WHERE))
(T (printout PROMPTWINDOW T LST " not a LISTP")
NIL])
(INSPECT/PROPLIST
[LAMBDA (ATOM ALLPROPSFLG WHERE) (* rrb " 9-AUG-83 09:19")
(* opens an inspect window onto the
properties of ATOM)
(PROG [(PROPS (COND
(ALLPROPSFLG (PROPNAMES ATOM))
(T (NONSYSPROPNAMES ATOM]
(RETURN (COND
(PROPS (INSPECTW.CREATE ATOM (COND
(ALLPROPSFLG (FUNCTION PROPNAMES))
(T (FUNCTION NONSYSPROPNAMES)))
(FUNCTION GETPROP)
(FUNCTION /PUTPROP)
NIL NIL NIL NIL NIL WHERE))
(T (PROMPTPRINT (COND
(ALLPROPSFLG "No properties")
(T "No non-system properties")))
NIL])
(NONSYSPROPNAMES
[LAMBDA (ATM) (* rrb " 7-MAR-82 11:09")
(* returns the properties an atom has
that are not SYSPROPS)
(for PROP in (PROPNAMES ATM) when (NOT (FMEMB PROP SYSPROPS)) collect PROP])
(INSPECT/LISTP
[LAMBDA (LST WHERE) (* rrb " 9-AUG-83 09:23")
(* asks how the user wants to inspect
a list and calls the appropriate
function.)
(APPLY* (OR (SELECT.LIST.INSPECTOR LST)
(FUNCTION NILL))
LST WHERE])
(ALISTP
[LAMBDA (LST) (* rrb "15-JUL-82 11:29")
(* is LST in alist format?)
(for ELT in LST always (LISTP ELT])
(PROPLISTP
[LAMBDA (LST) (* rrb "15-JUL-82 11:38")
(* is lst a property list format?
Assumes that property names are
litatoms.)
(AND LST (PROG ((LSTPTR LST))
LP (COND
((NULL LSTPTR)
(RETURN T))
((NLISTP LSTPTR)
(RETURN NIL))
((AND (LITATOM (CAR LSTPTR))
(LISTP (CDR LSTPTR)))
(SETQ LSTPTR (CDDR LSTPTR))
(GO LP))
(T (RETURN NIL])
(INSPECT/ALIST
[LAMBDA (ALST WHERE) (* rrb " 9-AUG-83 09:23")
(* opens an inspect window onto an
ALIST.)
(INSPECTW.CREATE ALST (for X in ALST collect (CAR X))
(FUNCTION ASSOCGET)
(FUNCTION /ASSOCPUT)
NIL NIL NIL NIL NIL WHERE])
(ASSOCGET
[LAMBDA (ALST KEY) (* rrb "15-JUL-82 13:31")
(* gets the value associated with a
key on an ALST.)
(CDR (ASSOC KEY ALST])
(/ASSOCPUT
[LAMBDA (ALST KEY VAL) (* defined to change the order of
arguments from what inspector gives to
what /PUTASSOC wants.)
(/PUTASSOC KEY VAL ALST])
(INSPECT/PLIST
[LAMBDA (PLST WHERE) (* rrb " 9-AUG-83 09:21")
(* opens an inspect window onto an
ALIST.)
(INSPECTW.CREATE PLST (for X in PLST by (CDDR X) collect X)
(FUNCTION LISTGET)
(FUNCTION /LISTPUT)
NIL NIL NIL NIL NIL WHERE])
(INSPECT/TYPERECORD
[LAMBDA (X WHERE) (* rrb " 9-AUG-83 09:21")
(* inspects X assuming it is a
typerecord instance.)
(INSPECT X (CAR X)
WHERE])
(INSPECT/AS/RECORD
[LAMBDA (INSTANCE WHERE) (* rrb "23-SEP-83 14:39")
(* offers the user a choice of record
types to inspect INSTANCE with.)
(PROG (RECORD)
(RETURN (AND [SETQ RECORD (MENU (create MENU
ITEMS ←
(SORT (for RECDEC in USERRECLST
when (FMEMB (CAR RECDEC)
(QUOTE (TYPERECORD RECORD)))
collect (CADR RECDEC)))
WHENHELDFN ← (FUNCTION (LAMBDA (ITEM)
(PROMPTPRINT
"Will inspect the list as if it were an instance of this record type."
]
(INSPECT INSTANCE RECORD WHERE])
(SELECT.LIST.INSPECTOR
[LAMBDA (LST) (* rrb "30-Apr-85 15:22")
(* gives the user a choice of how to
edit a list.)
(MENU (create MENU
ITEMS ← [APPEND (QUOTE ((DisplayEdit (QUOTE DEDITE)
"Edit it with the display editor")
(TtyEdit (QUOTE STANDARDEDITE)
"Edit it with the standard editor")
(Inspect (QUOTE INSPECT/TOP/LEVEL/LIST)
"Inspect the top level with an inspect window")
("As a record" (QUOTE INSPECT/AS/RECORD)
"Prompts further for the record type of this LIST."))
)
[COND
[(ALISTP LST)
(QUOTE (("As an ALIST" (QUOTE INSPECT/ALIST)
"Inspects the list as a A-List"]
((PROPLISTP LST)
(QUOTE (("As a PLIST" (QUOTE INSPECT/PLIST)
"Inspects the list as a property list."]
(PROG [(RECDEC (RECLOOK (CAR LST]
(RETURN (COND
((AND RECDEC (EQ (CAR RECDEC)
(QUOTE TYPERECORD)))
(* this is likely to be an instance of
the typed record.)
(CONS (LIST (CONCAT "As a " (CAR LST))
(QUOTE (QUOTE INSPECT/TYPERECORD))
(CONCAT
"Inspects the selected list as an instance of "
(CAR LST]
CENTERFLG ← T])
(STANDARDEDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* rrb "27-AUG-82 13:59")
(* version of EDITE that always calls
the standard editor.)
(RESETFORM (EDITMODE (QUOTE STANDARD))
(EDITE EXPR COMS ATM TYPE IFCHANGEDFN])
(NTHTOPLEVELELT
[LAMBDA (LST N) (* rrb " 5-FEB-82 07:53")
(* returns the Nth element.)
(COND
((EQ N (QUOTE ...))
(CDR (LAST LST)))
((EQ N (QUOTE &&))
(NTH LST (ADD1 MAXINSPECTCDRLEVEL)))
(T (CAR (NTH LST N])
(SETNTHTOPLEVELELT
[LAMBDA (LST N NEWVALUE) (* rrb " 5-FEB-82 07:54")
(* sets the nth top level eltment of
LST to NEWVALUE)
(* undoable but it will almost
certainly be undone in the wrong
place.)
(COND
((EQ N (QUOTE ...))
(/RPLACD (LAST LST)
NEWVALUE))
((EQ N (QUOTE &&))
(PROMPTPRINT "Can't set the tail.") (* return current value for printing.)
(NTH LST (ADD1 MAXINSPECTCDRLEVEL)))
(T (PROG NIL
(RETURN (/RPLACA (OR (NTH LST N)
(RETURN))
NEWVALUE])
(DEDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* rrb "11-DEC-81 09:50")
(RESETFORM (EDITMODE (QUOTE DISPLAY))
(EDITE EXPR COMS ATM TYPE IFCHANGEDFN])
(FINDRECDECL
[LAMBDA (DATUM) (* rrb "19-DEC-81 14:34")
(* find the datatype declaration for a
datum.)
(PROG (TYPENAME DECL)
(RETURN (AND [SETQ DECL (RECLOOK (SETQ TYPENAME (COND
((LISTP DATUM)
(CAR DATUM))
(T (TYPENAME DATUM]
(TYPENAMEP DATUM TYPENAME)
DECL])
(FINDSYSRECDECL
[LAMBDA (DATUM) (* rrb "19-DEC-81 14:01")
(* find the datatype declaration for a
if it is a system datatype.)
(PROG (TYPENAME DECL)
(AND (SETQ TYPENAME (TYPENAME DATUM))
(SETQ DECL (SYSRECLOOK1 TYPENAME))
(TYPENAMEP DATUM TYPENAME)
(RETURN DECL])
(\INSPECTEDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* rrb "17-JUN-82 14:29")
(* version of EDITE that checks for
non-listps and calls the inspector
instead.)
(COND
((AND EXPR (NLISTP EXPR))
(INSPECT EXPR))
(T (\BEFOREINSPECTEDITE EXPR COMS ATM TYPE IFCHANGEDFN])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu
PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu ItemWCommandMenu
InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL MaxInspectorWindowWidth
MaxInspectorWindowHeight INSPECT.HUNK.COMMANDS WIZARDFLG USERRECLST SYSPROPS IT
MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth)
)
(RPAQ? INSPECTALLFIELDSFLG T)
(RPAQ? MaxInspectorWindowWidth 330)
(RPAQ? MaxInspectorWindowHeight 606)
(RPAQQ INSPECTPRINTLEVEL (2 . 5))
(* "Atom inspector")
(DEFINEQ
(INSPECT/ATOM
[LAMBDA (ATM ALWAYSASKFLG WHERE) (* bvm: "16-Jun-86 14:51")
(* * "asks which aspect to inspect and inspects it.")
(LET ((ASPECTS (TYPESOF ATM NIL NIL (QUOTE ?)))
TYPETOINSPECT)
[COND
((CCODEP ATM)
(push ASPECTS (QUOTE InspectCode]
[COND
((NONSYSPROPNAMES ATM) (*
"add the property list to selectable aspects.")
(push ASPECTS (QUOTE PROPS)))
((AND (NULL ASPECTS)
(GETPROPLIST ATM)) (*
"If there is nothing else to inspect about this atom, offer its propertylist.")
(SETQ ASPECTS (QUOTE (PROPS]
[COND
((AND (MEMB (QUOTE VARS)
ASPECTS)
(LITATOM (EVALV ATM))) (*
"break the loop that can result from inspecting something that has an atom as its value")
(SETQ ASPECTS (REMOVE (QUOTE VARS)
ASPECTS]
(COND
((NOT ASPECTS)
(printout PROMPTWINDOW T ATM " does not have any aspect to inspect.")
NIL)
((EQUAL ASPECTS (QUOTE (VARS)))
(INSPECT (EVALV ATM)))
([SETQ TYPETOINSPECT (COND
((AND (NULL (CDR ASPECTS))
(EQ (CAR ASPECTS)
(QUOTE PROPS)))(* "if there is only one aspect and determining how to inspect that aspect gives the user a chance to quit, don't force a selection at the aspect level.")
(QUOTE PROPS))
(T (SELECT.ATOM.ASPECT ATM ALWAYSASKFLG ASPECTS]
(* "the functions applyed by this EVAL must evalaute their arguments. EDITF works because it is happy to take (QUOTE FN) as an argument too.")
(SELECTQ TYPETOINSPECT
(PROPS (*
"ask what method to use to inspect it.")
(SELECTQ [MENU (COND
((type? MENU InspectPropsMenu)
InspectPropsMenu)
(T (SETQ InspectPropsMenu
(create MENU
ITEMS ← (QUOTE ((EDITP (QUOTE EDITP)
"Calls EDITP on the atom."
)
("InspectProps" (QUOTE INSPECT)
"Inspects the property list with an inspect window."
]
(EDITP (EVAL.AS.PROCESS (LIST (FUNCTION EDITP)
ATM)))
(INSPECT (EVAL.AS.PROCESS (LIST (FUNCTION INSPECT/PROPLIST)
(KWOTE ATM)
NIL
(KWOTE WHERE))))
NIL))
(InspectCode (INSPECTCODE ATM WHERE))
(EVAL.AS.PROCESS (LIST (QUOTE EDITDEF)
(KWOTE ATM)
(KWOTE TYPETOINSPECT])
(SELECT.ATOM.ASPECT
[LAMBDA (ATOM ALWAYSASKFLG ASPECTS) (* rrb "26-JUL-83 16:28")
(* Returns a file package type name corresponding to the type of ATOM The user
is asked to choose if there is more than one or If ALWAYSASKFLG is non-NIL.)
(PROG [(ASPECTS (OR ASPECTS (TYPESOF ATOM NIL NIL (QUOTE ?]
(RETURN (COND
((NULL ASPECTS)
NIL)
((OR ALWAYSASKFLG (CDR ASPECTS)) (* ASPECTS is in menu item format)
(MENU (create MENU
ITEMS ← ASPECTS
TITLE ← (CONCAT "Which defn of " ATOM "?")
CENTERFLG ← T)))
(T (CAR ASPECTS])
(INSPECT/AS/FUNCTION
[LAMBDA (ATM STKP WINDOW) (* bvm: " 7-Jul-86 16:25")
(* calls an editor on function ATM. STKP and WINDOW are the stack pointer and
window of the break in which this inspect command was called)
(LET ((EDITOR (SELECT.FNS.EDITOR ATM))
FRAME CODEBASE PROC)
(SELECTQ EDITOR
(NIL NIL)
(INSPECTCODE (COND
([AND (STACKP STKP)
(NOT (fetch (FX INVALIDP) of (SETQ FRAME (fetch (STACKP EDFXP)
of STKP]
(INSPECTCODE (COND
((EQ (\GET-COMPILED-CODE-BASE ATM)
(SETQ CODEBASE (fetch (FX FNHEADER) of FRAME)))
ATM)
(T
(* Function executing in this frame is not the one in the definition cell of
its name, so fetch the real code. Have to pass a CCODEP)
(MAKE-COMPILED-CLOSURE CODEBASE)))
NIL NIL NIL (fetch (FX PC) of FRAME)))
(T (INSPECTCODE ATM))))
(COND
([AND WINDOW (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS]
(* Enter the editor in the process
that has the break)
(PROCESS.APPLY PROC EDITOR (LIST ATM)))
(T (APPLY* EDITOR ATM])
(SELECT.FNS.EDITOR
[LAMBDA (FN) (* bvm: "20-Jun-85 12:29")
(* gives the user a menu choice of
editors.)
(MENU (create MENU
ITEMS ← [APPEND [COND
((CCODEP FN)
(QUOTE ((InspectCode (QUOTE INSPECTCODE)
"Shows the compiled code."]
(QUOTE ((DisplayEdit (QUOTE DF)
"Edit it with the display editor")
(TtyEdit (QUOTE EF)
"Edit it with the standard editor"]
CENTERFLG ← T])
)
(* "Compiled code inspector")
(DEFINEQ
(INSPECTCODE
[LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* bvm: "20-Jun-85 12:43")
(* creates a window that shows the
compiled code of a function.)
(COND
((GETD (QUOTE OPENTEXTSTREAM)) (* Use smarter inspector)
(\TEDIT.INSPECTCODE FN WHERE LVFLG RADIX PC CODEPRINTER))
(T (COND
((NOT (CCODEP FN))
(ERROR "Not a compiled function" FN)))
(LET [(WINDOW (DECODE.WINDOW.ARG WHERE 400 320 (CONCAT FN " Code Window"]
(WINDOWPROP WINDOW (QUOTE DATUM)
FN)
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION \INSPECT/CODE/REPAINTFN))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION \INSPECT/CODE/RESHAPEFN))
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN)) (* call the reshapefn to note the
upper left corner and the extent.)
(\INSPECT/CODE/RESHAPEFN WINDOW])
(\TEDIT.INSPECTCODE
[LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* bvm: " 7-Jul-86 23:39")
(PROG ((STREAM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
WINDOW SEL)
(APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE))
FN LVFLG RADIX STREAM NIL PC)
[SETQ STREAM (OPENTEXTSTREAM STREAM [SETQ WINDOW (DECODE.WINDOW.ARG
WHERE 400 280
(COND
((OR (LITATOM FN)
(NOT (CCODEP FN)))
(CONCAT "Code for " FN))
(T (CONCAT (COND
(PC "Code for frame ")
(T "CCODEP named "))
(fetch (COMPILED-CLOSURE
FRAMENAME)
of FN]
NIL NIL (QUOTE (READONLY T PROMPTWINDOW DON'T]
(COND
((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1)))
(* Highlight location of PC)
(TEDIT.SETSEL STREAM (IMAX 1 (IDIFFERENCE SEL 100))
0
(QUOTE LEFT))
(TEDIT.NORMALIZECARET STREAM)))
[COND
((DEFINEDP (QUOTE TEXTICON)) (* Override TEdit's icon)
(WINDOWPROP WINDOW (QUOTE ICONFN)
(FUNCTION TEXTICON]
(RETURN FN])
(\INSPECT/CODE/RESHAPEFN
[LAMBDA (WIN OLDIMAGE OLDREGION) (* rmk: "26-AUG-83 17:05")
(* reshapes a code inspection window.)
(* set the upper left corner for the
repaintfn, call the repaintfn and note
the Y position for the extent.)
(PROG [WHEIGHT BOTTOM (FONT (fetch DDFONT of (fetch IMAGEDATA of (WINDOWPROP WIN (QUOTE DSP]
[WINDOWPROP WIN (QUOTE REGIONUPPERLEFT)
(create POSITION
XCOORD ← 0
YCOORD ← (SUB1 (IDIFFERENCE (SETQ WHEIGHT (WINDOWPROP WIN (QUOTE HEIGHT)))
(FONTPROP FONT (QUOTE ASCENT]
(\INSPECT/CODE/REPAINTFN WIN)
(WINDOWPROP WIN (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ← [SETQ BOTTOM (IPLUS (DSPYPOSITION NIL WIN)
(FONTPROP FONT (QUOTE ASCENT]
WIDTH ← (WINDOWPROP WIN (QUOTE WIDTH))
HEIGHT ← (IDIFFERENCE WHEIGHT BOTTOM])
(\INSPECT/CODE/REPAINTFN
[LAMBDA (WIN) (* rrb "16-JUL-82 09:56")
(* moves to the window's upper left
corner and prints the code for the
function in WIN.)
(PROG [(UPPERLEFT (WINDOWPROP WIN (QUOTE REGIONUPPERLEFT]
(MOVETO (fetch (POSITION XCOORD) of UPPERLEFT)
(fetch (POSITION YCOORD) of UPPERLEFT)
WIN) (* should be changed to pass WIN as a
parameter when PRINTCODE is changed to
take file argument.)
(PRINTCODE (WINDOWPROP WIN (QUOTE DATUM))
NIL 8 WIN])
)
(* "Hash table inspector")
(DEFINEQ
(INSPECT/HARRAYP
[LAMBDA (HARRAY WHERE) (* rrb " 9-AUG-83 09:26")
(* opens an inspect window onto the
elements of HARRAY)
(PROG ((PROPS (HARRAYKEYS HARRAY)))
(RETURN (COND
(PROPS (INSPECTW.CREATE HARRAY (FUNCTION HARRAYKEYS)
(FUNCTION INSPECTW.GETHASH)
(FUNCTION INSPECTW.PUTHASH)
NIL NIL NIL NIL NIL WHERE))
(T (PROMPTPRINT "No keys in that Hash array.")
NIL])
(HARRAYKEYS
[LAMBDA (HARRAY) (* rrb "19-MAR-82 17:07")
(* returns a list of all of the keys
in a Hash array.)
(PROG (ITEMLST)
[MAPHASH HARRAY (FUNCTION (LAMBDA (HASHEDVALUE HASHITEM)
(SETQ ITEMLST (CONS HASHITEM ITEMLST]
(RETURN ITEMLST])
(INSPECTW.GETHASH
[LAMBDA (HARRAY ITEM) (* version of GETHASH that switches
the order of arguments.)
(GETHASH ITEM HARRAY])
(INSPECTW.PUTHASH
[LAMBDA (HARRAY ITEM VALUE) (* version of PUTHASH that switches
the order of arguments.)
(/PUTHASH ITEM VALUE HARRAY])
)
(* "Readtable, termtable inspectors")
(DEFINEQ
(RDTBL\NONOTHERCODES
[LAMBDA (RT) (* rrb " 8-OCT-82 10:38")
(* returns the character codes that
are not OTHER.)
(for CH from 0 to 255 when (NEQ (GETSYNTAX CH RT)
(QUOTE OTHER)) collect CH])
(GETSYNTAXPROP
[LAMBDA (RDTBL CH) (* version of GETSYNTAX that has
arguments in the right order for
inspector)
(GETSYNTAX CH RDTBL])
(SETSYNTAXPROP
[LAMBDA (RDTBL CH CLASS) (* version of SETSYNTAX that has
arguments in the right order for
inspector)
(SETSYNTAX CH CLASS RDTBL])
(GETTTBLPROP
[LAMBDA (TTBL PROP) (* rrb "12-AUG-83 15:14")
(* inspector function that returns the value of the property from a terminal
table. Combines several miscellaneous parts of the terminal table into a
uniform interface.)
(COND
((NUMBERP PROP)
(ECHOCONTROL PROP NIL TTBL))
((FMEMB PROP (QUOTE (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL)))
(CAR (GETSYNTAX PROP TTBL)))
((FMEMB PROP (QUOTE (1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL)))
(DELETECONTROL PROP NIL TTBL))
((EQ PROP (QUOTE LINEDELETESTR))
(DELETECONTROL (QUOTE LINEDELETE)
NIL TTBL))
((EQ PROP (QUOTE ECHODELS?))
(EQ (GETDELETECONTROL (QUOTE ECHO)
TTBL)
(QUOTE ECHO)))
((EQ PROP (QUOTE CONTROL))
(GETCONTROL TTBL))
((EQ PROP (QUOTE RAISE))
(GETRAISE TTBL))
((EQ PROP (QUOTE ECHOMODE))
(GETECHOMODE TTBL])
(SETTTBLPROP
[LAMBDA (TTBL PROP NEWVALUE) (* rrb "12-AUG-83 15:12")
(* inspector function that sets the value of the property from a terminal
table. Combines several miscellaneous parts of the terminal table into a
uniform interface.)
(COND
((NUMBERP PROP)
(ECHOCONTROL PROP NEWVALUE TTBL))
((FMEMB PROP (QUOTE (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL)))
(SETSYNTAX NEWVALUE PROP TTBL))
((FMEMB PROP (QUOTE (1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL)))
(DELETECONTROL PROP NEWVALUE TTBL))
((EQ PROP (QUOTE LINEDELETESTR))
(DELETECONTROL (QUOTE LINEDELETE)
NEWVALUE TTBL))
((EQ PROP (QUOTE ECHODELS?))
(DELETECONTROL (COND
(NEWVALUE (QUOTE ECHO))
(T (QUOTE NOECHO)))
NIL TTBL))
((EQ PROP (QUOTE CONTROL))
(CONTROL NEWVALUE TTBL))
((EQ PROP (QUOTE RAISE))
(RAISE NEWVALUE TTBL))
((EQ PROP (QUOTE ECHOMODE))
(ECHOMODE NEWVALUE TTBL])
)
(ADDTOVAR INSPECTMACROS
(READTABLEP RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP)
(TERMTABLEP (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL RAISE ECHOMODE LINEDELETESTR
1STCHDEL NTHCHDEL POSTCHDEL EMPTYCHDEL ECHODELS? CONTROL 0 1 2 3 4 5 6 7
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31)
GETTTBLPROP SETTTBLPROP))
(* "Hunk inspector")
(DEFINEQ
(INSPECT/AS/BLOCKRECORD
[LAMBDA (INSTANCE WHERE CHOICES) (* bvm: "16-Jun-86 14:53")
(* offers the user a choice of record
types to inspect INSTANCE with.)
(LET (RECNAME)
(COND
([NULL (OR CHOICES (SETQ CHOICES (LIST-ALL-BLOCKRECORDS]
(printout PROMPTWINDOW T "Can't Inspect " INSTANCE))
([SETQ RECNAME (MENU (create MENU
ITEMS ← CHOICES
WHENHELDFN ← (FUNCTION (LAMBDA (ITEM)
(PROMPTPRINT
"Will inspect the list as if it were a "
ITEM]
(INSPECT INSTANCE RECNAME WHERE])
(INSPECT/TYPELESS
[LAMBDA (ITEM WHERE) (* bvm: "16-Jun-86 13:41")
(* * "Inspects an object that is typeless. Check very carefully to see if it might be an arrayblock, in which case we can try to inspect it as some kind of array. Otherwise, we might be able to interpret it as some block record.")
(LET (HDR TRLR)
(COND
((AND (type? ARRAYBLOCK ITEM)
[\VALIDADDRESSP (SETQ HDR (\ADDBASE ITEM (IMINUS \ArrayBlockHeaderWords]
(EQ (fetch (ARRAYBLOCK PASSWORD) of HDR)
\ArrayBlockPassword)
(fetch (ARRAYBLOCK INUSE) of HDR)
(\VALIDADDRESSP (SETQ TRLR (fetch (ARRAYBLOCK TRAILER) of HDR)))
(EQ (fetch (ARRAYBLOCK PASSWORD) of TRLR)
\ArrayBlockPassword))
(INSPECT/HUNK ITEM WHERE (fetch (ARRAYBLOCK GCTYPE) of HDR)
(IDIFFERENCE (UNFOLD (fetch (ARRAYBLOCK ARLEN) of HDR)
WORDSPERCELL)
\ArrayBlockOverheadWords)))
(T (INSPECT/AS/BLOCKRECORD ITEM WHERE])
(LIST-ALL-BLOCKRECORDS
[LAMBDA NIL (* bvm: "16-Jun-86 11:22")
(for RECDEC in USERRECLST when (EQ (CAR RECDEC)
(QUOTE BLOCKRECORD)) collect (CADR RECDEC])
(INSPECT/HUNK
[LAMBDA (DATUM WHERE GCTYPE SIZE) (* bvm: "16-Jun-86 13:51")
(* * "Inspects a typeless DATUM, which is either a hunk or an array block, with indicated GCTYPE and SIZE in words.")
(PROG (ELTSPEC BLOCKRECS)
[SELECTC GCTYPE
(CODEBLOCK.GCT (* Compiled code lives here)
(RETURN (INSPECTCODE (INSPECT/MAKE/CCODEP DATUM)
WHERE)))
(PTRBLOCK.GCT (* Pointers live here, so size is
unambiguous)
(SETQ ELTSPEC (QUOTE (32 \INSPECT.FETCH.PTR \INSPECT.STORE.PTR))))
(PROGN (* Completely unboxed, so we don't
know how to interpret it)
(COND
([NULL (SETQ ELTSPEC (MENU (create MENU
ITEMS ←
(COND
((SETQ BLOCKRECS (LIST-ALL-BLOCKRECORDS)
)
(CONS (QUOTE ("As BLOCKRECORD"
(QUOTE BLOCKRECORD)))
INSPECT.HUNK.COMMANDS))
(T INSPECT.HUNK.COMMANDS))
CENTERFLG ← T]
(RETURN NIL))
((EQ ELTSPEC (QUOTE BLOCKRECORD))
(RETURN (INSPECT/AS/BLOCKRECORD DATUM WHERE BLOCKRECS]
(* * "At this point ELTSPEC is a list of (itemsize fetchfn storefn). Create an inspector that inspects the appropriate number of items, based on the size")
(INSPECTW.CREATE DATUM (for I from 0 to (IMIN (SUB1 (IQUOTIENT (UNFOLD SIZE BITSPERWORD)
(CAR ELTSPEC)))
MAXINSPECTARRAYLEVEL) collect I)
(CADR ELTSPEC)
(AND WIZARDFLG (CADDR ELTSPEC))
(AND (NULL WIZARDFLG)
"Cannot set fields in system block data")
NIL NIL NIL NIL WHERE])
(\INSPECT.DATATYPE.RAW.FETCH
[LAMBDA (INSTANCE FIELD DESCRS) (* bvm: "25-Jun-86 11:32")
(* * "Used to fetch fields of datatype where we have only the field descriptors, not the original user declaration")
(FETCHFIELD (CAR (NTH DESCRS FIELD))
INSTANCE])
(\INSPECT.FETCH.8
[LAMBDA (INSTANCE FIELD) (* bvm: "16-Jun-86 11:35")
(\GETBASEBYTE INSTANCE FIELD])
(\INSPECT.FETCH.32
[LAMBDA (INSTANCE FIELD) (* bvm: "16-Jun-86 11:35")
(\GETBASEFIXP INSTANCE (UNFOLD FIELD WORDSPERCELL])
(\INSPECT.FETCH.CHAR
[LAMBDA (INSTANCE FIELD) (* bvm: "16-Jun-86 11:36")
(CHARACTER (\GETBASEBYTE INSTANCE FIELD])
(\INSPECT.FETCH.FATCHAR
[LAMBDA (INSTANCE FIELD) (* bvm: "16-Jun-86 11:36")
(CHARACTER (\GETBASE INSTANCE FIELD])
(\INSPECT.FETCH.PTR
[LAMBDA (INSTANCE FIELD) (* bvm: "16-Jun-86 13:53")
(\GETBASEPTR INSTANCE (UNFOLD FIELD WORDSPERCELL])
(\INSPECT.STORE.8
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 11:59")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.8)
INSTANCE FIELD (\GETBASEBYTE INSTANCE FIELD)))
(\PUTBASEBYTE INSTANCE FIELD NEWVALUE])
(\INSPECT.STORE.16
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 11:59")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.16)
INSTANCE FIELD (\GETBASE INSTANCE FIELD)))
(\PUTBASE INSTANCE FIELD NEWVALUE])
(\INSPECT.STORE.32
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 12:00")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.32)
INSTANCE FIELD (\INSPECT.FETCH.32 INSTANCE FIELD)))
(\PUTBASEFIXP INSTANCE (UNFOLD FIELD WORDSPERCELL)
NEWVALUE])
(\INSPECT.STORE.CHAR
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 12:01")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.8)
INSTANCE FIELD (\GETBASEBYTE INSTANCE FIELD)))
(\PUTBASEBYTE INSTANCE FIELD (CHARCODE.DECODE NEWVALUE])
(\INSPECT.STORE.FATCHAR
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 12:02")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.16)
INSTANCE FIELD (\GETBASE INSTANCE FIELD)))
(\PUTBASE INSTANCE FIELD (CHARCODE.DECODE NEWVALUE])
(\INSPECT.STORE.PTR
[LAMBDA (INSTANCE FIELD NEWVALUE) (* bvm: "16-Jun-86 14:53")
(UNDOSAVE (LIST (QUOTE \INSPECT.STORE.PTR)
INSTANCE FIELD (\GETBASEPTR INSTANCE FIELD)))
(\RPLPTR INSTANCE (UNFOLD FIELD WORDSPERCELL)
NEWVALUE])
(INSPECT/MAKE/CCODEP
[LAMBDA (CODE) (* bvm: " 7-Jul-86 16:25")
(MAKE-COMPILED-CLOSURE CODE])
)
(RPAQ? INSPECT.HUNK.COMMANDS [QUOTE (("As 8-bit array" (QUOTE (8 \GETBASEBYTE \INSPECT.STORE.8)))
("As 16-bit array" (QUOTE (16 \GETBASE \INSPECT.STORE.16)))
("As 32-bit array" (QUOTE (32 \INSPECT.FETCH.32
\INSPECT.STORE.32)))
("As Character array" (QUOTE (8 \INSPECT.FETCH.CHAR
\INSPECT.STORE.CHAR)))
("As Fat Character array" (QUOTE (16 \INSPECT.FETCH.FATCHAR
\INSPECT.STORE.FATCHAR])
(* "stack functions")
(DEFINEQ
(STACKFRAMEPROPPRINTFN
[LAMBDA (PROP DATUM) (* rrb " 8-AUG-83 17:08")
(* returns the thing to be printed as
the value)
(COND
((AND (LISTP PROP)
(NULL (CDR PROP))) (* frame function name)
NIL)
((LISTP DATUM) (* multiple frame window)
(CADR PROP))
(T (CAR PROP])
(STACKFRAMEVALUECOMMANDFN
[LAMBDA (VALUE PROP DATUM WINDOW) (* bvm: "24-Jun-85 18:00")
(* property command function for
inspect windows onto stack frames.
Recognizes certain PROP as function
names.)
(COND
((AND (LISTP PROP)
(NULL (CDR PROP)))
(INSPECT/AS/FUNCTION VALUE DATUM WINDOW))
(T (DEFAULT.INSPECTW.VALUECOMMANDFN VALUE PROP DATUM WINDOW])
(PROPERTIES.FROM.FRAMESPEC
[LAMBDA (POS LOTSFLG EMBEDDEDCALLFLG) (* lmm " 6-Jan-85 18:48")
(* returns a list of properties suitable for an inspect window which prints the
frame name{s} and arguments from a stack pointer or list of stack pointers.)
(COND
[(LISTP POS) (* for the list case, note the number
of the frame in the list.)
(for STKPOS in POS as N from 1 join (for X in (PROPERTIES.FROM.FRAMESPEC STKPOS LOTSFLG T)
collect (CONS N X]
(T (PROG ((NARGS (STKNARGS POS T) (* in Interlisp-D, STKNARGS takes an
extra arg which means to include
internally bound names as well as
those in the basic frame)
)
(NARGS1 (STKNARGS POS))
(FNNAME (STKNAME POS))
VALUE VALUEMARGIN ARGNAMES ARGLST (NOVALUE ""))
[AND LOTSFLG (LITATOM FNNAME)
(CCODEP FNNAME)
(SETQ ARGLST (LISTP (SMARTARGLIST FNNAME]
[SETQ ARGNAMES (for I from 1 to NARGS
collect (PROG1 (OR (STKARGNAME I POS)
(AND (CAR ARGLST)
(PACK* "*" (CAR ARGLST)
"*"))
(AND LOTSFLG (PACK* (QUOTE *var*)
I)))
(SETQ ARGLST (CDR ARGLST]
(RETURN (CONS (LIST FNNAME)
(for ARGN from 1 to NARGS as ARGNAME in ARGNAMES
when [AND ARGNAME (NEQ NOVALUE (SETQ VALUE (STKARG ARGN POS NOVALUE]
collect (LIST ARGNAME ARGN])
(PROPERTIES.FROM.FRAMESPEC.LOTS
[LAMBDA (POS)
(PROPERTIES.FROM.FRAMESPEC POS T])
(WINDOWTITLE2
[LAMBDA (DATUM WINDOW) (* rrb " 7-AUG-83 19:18")
(* returns the current title of the
window. Used to compute the title of
the back trace frame window.)
(WINDOWPROP WINDOW (QUOTE TITLE])
(NEWSTKNPVARS
[LAMBDA (POS)
(IDIFFERENCE (STKNARGS POS T)
(STKNARGS POS])
(MYSMARTARGLIST
[LAMBDA (FN NARGS)
(* version of SMARTARGLIST which doesn't generate an error if FN is not a
function. It creates a dummy arglist NARGS long.
This is used because some of the frames such as *ENV* don't correspond to
functions.)
(COND
((FNCHECK FN T)
(SMARTARGLIST FN))
(T (for I from 1 to NARGS collect (PACK* "*arg" I])
(FETCHSTKARG
[LAMBDA (FRAMESPEC WHICHSPEC) (* rrb " 8-AUG-83 17:06")
(* retrieval function for argument
positions)
(COND
((NULL (CDR WHICHSPEC)) (* this is a dummy which is a function
name. it has no value)
(CAR WHICHSPEC))
((LISTP FRAMESPEC)
(FETCHSTKARG (CAR (NTH FRAMESPEC (CAR WHICHSPEC)))
(CDR WHICHSPEC)))
((LISTP WHICHSPEC) (* CAR is name, CADR is offset)
(STKARG (CADR WHICHSPEC)
FRAMESPEC))
(T (* WHICHSPEC is the name)
(STKARG WHICHSPEC FRAMESPEC])
(\RELEASEWINDOWSTKDATUM
[LAMBDA (WINDOW) (* rrb " 7-AUG-83 19:54")
(* Releases the previously stored
stack pointer in WINDOW.)
(PROG (X)
[COND
([STACKP (SETQ X (WINDOWPROP WINDOW (QUOTE DATUM]
(RELSTK X))
((LISTP X)
(for STKPTR in X do (RELSTK STKPTR]
(RETURN X])
(BTITEMWINDOWCLOSEFN
[LAMBDA (W) (* rrb " 7-AUG-83 19:55")
(* close function for a backtrace
frame item window. Releases the stack
pointers and removes the selectable
items.)
(\RELEASEWINDOWSTKDATUM W)
(WINDOWPROP W (QUOTE SELECTABLEITEMS)
NIL])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD ARGSPEC (STKPTR . ARGN))
]
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(MOVD? (QUOTE NEWSTKNPVARS)
(QUOTE STKNPVARS))
(MOVD? (QUOTE EDITE)
(QUOTE \BEFOREINSPECTEDITE))
(MOVD (QUOTE \INSPECTEDITE)
(QUOTE EDITE))
)
(PUTPROPS INSPECT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7775 42329 (INSPECTW.CREATE 7785 . 11985) (INSPECTW.REPAINTFN 11987 . 16714) (
INSPECTW.REDISPLAY 16716 . 25233) (\INSPECTW.VALUE.MARGIN 25235 . 25746) (INSPECTW.REPLACE 25748 .
26335) (INSPECTW.SELECTITEM 26337 . 27315) (\INSPECTW.REDISPLAYPROP 27317 . 29508) (INSPECTW.FETCH
29510 . 30055) (INSPECTW.PROPERTIES 30057 . 30750) (DECODE.WINDOW.ARG 30752 . 32407) (
DEFAULT.INSPECTW.PROPCOMMANDFN 32409 . 34695) (DEFAULT.INSPECTW.VALUECOMMANDFN 34697 . 35998) (
DEFAULT.INSPECTW.TITLECOMMANDFN 36000 . 38055) (\SELITEM.FROM.PROPERTY 38057 . 38505) (
\INSPECT.COMPUTE.TITLE 38507 . 39540) (LEVELEDFORM 39542 . 40514) (MAKEWITHINREGION 40516 . 42327)) (
42330 61463 (ITEMW.REPAINTFN 42340 . 43572) (\ITEM.WINDOW.BUTTON.HANDLER 43574 . 44162) (
\ITEM.WINDOW.SELECTION.HANDLER 44164 . 46911) (\INSPECTW.COMMAND.HANDLER 46913 . 50954) (
ITEM.WINDOW.SET.STACK.ARG 50956 . 53503) (REPLACESTKARG 53505 . 54725) (IN/ITEM? 54727 . 55368) (
\ITEMW.DESELECTITEM 55370 . 55694) (\ITEMW.SELECTITEM 55696 . 56018) (\ITEMW.CLEARSELECTION 56020 .
56489) (\ITEMW.FLIPITEM 56491 . 57013) (PRINTANDBOX 57015 . 60168) (PRINTATBOX 60170 . 60820) (
ITEMOFPROPERTYVALUE 60822 . 61461)) (61464 64999 (\ITEM.WINDOW.COPY.HANDLER 61474 . 63153) (
\ITEMW.FLIPCOPY 63155 . 63626) (BKSYSBUF.GENERAL 63628 . 64997)) (65389 89108 (INSPECT 65399 . 68660)
(\APPLYINSPECTMACRO 68662 . 69881) (INSPECT/BITMAP 69883 . 71300) (INSPECT/DATATYPE 71302 . 73566) (
INSPECTABLEFIELDNAMES 73568 . 74483) (REMOVEDUPS 74485 . 74703) (INSPECT/ARRAY 74705 . 75691) (
INSPECT/TOP/LEVEL/LIST 75693 . 76699) (INSPECT/PROPLIST 76701 . 77776) (NONSYSPROPNAMES 77778 . 78182)
(INSPECT/LISTP 78184 . 78680) (ALISTP 78682 . 78933) (PROPLISTP 78935 . 79748) (INSPECT/ALIST 79750
. 80213) (ASSOCGET 80215 . 80534) (/ASSOCPUT 80536 . 80873) (INSPECT/PLIST 80875 . 81346) (
INSPECT/TYPERECORD 81348 . 81696) (INSPECT/AS/RECORD 81698 . 82933) (SELECT.LIST.INSPECTOR 82935 .
85404) (STANDARDEDITE 85406 . 85804) (NTHTOPLEVELELT 85806 . 86176) (SETNTHTOPLEVELELT 86178 . 87173)
(DEDITE 87175 . 87374) (FINDRECDECL 87376 . 88067) (FINDSYSRECDECL 88069 . 88578) (\INSPECTEDITE 88580
. 89106)) (89766 97436 (INSPECT/ATOM 89776 . 93877) (SELECT.ATOM.ASPECT 93879 . 94711) (
INSPECT/AS/FUNCTION 94713 . 96543) (SELECT.FNS.EDITOR 96545 . 97434)) (97475 103138 (INSPECTCODE 97485
. 98751) (\TEDIT.INSPECTCODE 98753 . 100773) (\INSPECT/CODE/RESHAPEFN 100775 . 102158) (
\INSPECT/CODE/REPAINTFN 102160 . 103136)) (103174 104901 (INSPECT/HARRAYP 103184 . 103919) (HARRAYKEYS
103921 . 104408) (INSPECTW.GETHASH 104410 . 104650) (INSPECTW.PUTHASH 104652 . 104899)) (104948
108247 (RDTBL\NONOTHERCODES 104958 . 105398) (GETSYNTAXPROP 105400 . 105718) (SETSYNTAXPROP 105720 .
106044) (GETTTBLPROP 106046 . 107100) (SETTTBLPROP 107102 . 108245)) (108727 117086 (
INSPECT/AS/BLOCKRECORD 108737 . 109730) (INSPECT/TYPELESS 109732 . 110986) (LIST-ALL-BLOCKRECORDS
110988 . 111261) (INSPECT/HUNK 111263 . 113996) (\INSPECT.DATATYPE.RAW.FETCH 113998 . 114332) (
\INSPECT.FETCH.8 114334 . 114486) (\INSPECT.FETCH.32 114488 . 114662) (\INSPECT.FETCH.CHAR 114664 .
114830) (\INSPECT.FETCH.FATCHAR 114832 . 114997) (\INSPECT.FETCH.PTR 114999 . 115173) (
\INSPECT.STORE.8 115175 . 115448) (\INSPECT.STORE.16 115450 . 115717) (\INSPECT.STORE.32 115719 .
116036) (\INSPECT.STORE.CHAR 116038 . 116331) (\INSPECT.STORE.FATCHAR 116333 . 116622) (
\INSPECT.STORE.PTR 116624 . 116928) (INSPECT/MAKE/CCODEP 116930 . 117084)) (117870 124679 (
STACKFRAMEPROPPRINTFN 117880 . 118453) (STACKFRAMEVALUECOMMANDFN 118455 . 119149) (
PROPERTIES.FROM.FRAMESPEC 119151 . 121513) (PROPERTIES.FROM.FRAMESPEC.LOTS 121515 . 121609) (
WINDOWTITLE2 121611 . 122061) (NEWSTKNPVARS 122063 . 122157) (MYSMARTARGLIST 122159 . 122613) (
FETCHSTKARG 122615 . 123541) (\RELEASEWINDOWSTKDATUM 123543 . 124083) (BTITEMWINDOWCLOSEFN 124085 .
124677)))))
STOP