(FILECREATED "20-Jan-84 12:51:06" {PHYLUM}<LISPCORE>SOURCES>INSPECT.;54 73714
changes to: (FNS INSPECT/ATOM)
previous date: "12-NOV-83 22:44:03" {PHYLUM}<LISPCORE>SOURCES>INSPECT.;53)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(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
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)
(RECORDS SELECTABLEITEM)
(VARS PropertyLeftMargin MaxValueLeftMargin MinSpaceBetweenProperyAndValue
MaxInspectorPropertyValueWidth (MAXINSPECTCDRLEVEL 50)
(MAXINSPECTARRAYLEVEL 300)))
(COMS (* functions for the inspector)
(FNS INSPECT \APPLYINSPECTMACRO INSPECT/ATOM SELECT.ATOM.ASPECT INSPECT/AS/FUNCTION
SELECT.FNS.EDITOR INSPECT/BITMAP INSPECT/DATATYPE INSPECTABLEFIELDNAMES REMOVEDUPS
INSPECT/ARRAY INSPECT/TOP/LEVEL/LIST INSPECT/PROPLIST NONSYSPROPNAMES
INSPECT/HARRAYP HARRAYKEYS INSPECTW.GETHASH INSPECTW.PUTHASH INSPECT/LISTP ALISTP
PROPLISTP INSPECT/ALIST ASSOCGET /ASSOCPUT INSPECT/PLIST INSPECT/TYPERECORD
INSPECT/AS/RECORD INSPECT/AS/BLOCKRECORD INSPECTCODE INSPECTCODEQ
\INSPECT/CODE/RESHAPEFN \INSPECT/CODE/REPAINTFN SELECT.LIST.INSPECTOR
STANDARDEDITE NTHTOPLEVELELT SETNTHTOPLEVELELT DEDITE FINDRECDECL FINDSYSRECDECL
PPVINW \INSPECTEDITE RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP GETTTBLPROP
SETTTBLPROP)
(GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu
PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu
ItemWCommandMenu InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL
MaxInspectorWindowWidth MaxInspectorWindowHeight)
(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)))
(INITVARS (INSPECTALLFIELDSFLG T)
(MaxInspectorWindowWidth 330)
(MaxInspectorWindowHeight 606))
(VARS INSPECTPRINTLEVEL))
[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]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML INSPECTCODEQ)
(LAMA])
(* 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) (* rrb " 2-SEP-83 10:32")
(* creates a window with an item list made up of
properties and values)
(PROG [WINDOW VALUE PROPMENU VALUEMENU VALUEMARGIN SELITEMS MAXVALUEWIDTH (IWFONT (CADR
DEFAULTFONT))
(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 (COND
((WINDOWP WHERE)
WHERE)
(T (CREATEW [COND
((REGIONP WHERE)
WHERE)
[(POSITIONP WHERE)
(MAKEWITHINREGION (CREATEREGION
(fetch (POSITION XCOORD) of WHERE)
(fetch (POSITION YCOORD) of WHERE)
(WIDTHIFWINDOW (IPLUS VALUEMARGIN MAXVALUEWIDTH))
(IMIN MaxInspectorWindowHeight
(HEIGHTIFWINDOW (ITIMES
(COND
(PROPERTIESLST
(LENGTH PROPERTIESLST))
(T 1))
(FONTHEIGHT (CADR
DEFAULTFONT)))
T]
(T (GETBOXREGION (WIDTHIFWINDOW (IPLUS VALUEMARGIN MAXVALUEWIDTH))
(IMIN MaxInspectorWindowHeight
(HEIGHTIFWINDOW (ITIMES (COND
(PROPERTIESLST
(LENGTH PROPERTIESLST))
(T 1))
(FONTHEIGHT (CADR
DEFAULTFONT)))
T]
(\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 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 "28-AUG-83 12:13")
(* 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)))
(RETURN WINDOW])
(\INSPECTW.VALUE.MARGIN
[LAMBDA (PROPS FONT) (* rrb "20-FEB-83 15:03")
(* returns the x position in which the values of the
properties should print.)
(IMIN (IPLUS (IMAX (MAXSTRINGWIDTH PROPS FONT)
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) (* rrb "28-AUG-83 12:16")
(* refetches and displays a property of an inspect
window. This is called when a property has changed, to
update the display.)
(PROG ((DATUM (WINDOWPROP WINDOW (QUOTE DATUM)))
(OLDVALUEITEM (ITEMOFPROPERTYVALUE PROPERTY WINDOW))
(NEWVALUE (INSPECTW.FETCH WINDOW PROPERTY))
ITEMSELECTED? NEWVALUEREGION)
(OR DATUM (ERROR INSPECTW " 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)
(RETURN (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])
(DEFAULT.INSPECTW.PROPCOMMANDFN
[LAMBDA (PROPERTY DATUM INSPECTW) (* rrb " 9-AUG-83 09:41")
(* 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)
(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))
(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 " 9-AUG-83 09:47")
(SELECTQ [MENU (COND
((type? MENU ItemWCommandMenu)
ItemWCommandMenu)
(T (SETQ ItemWCommandMenu (create MENU
ITEMS ←(QUOTE ((ReFetch (QUOTE REFETCH)
"ReFetches and redisplays the object's fields"]
(REFETCH (INSPECTW.REDISPLAY INSPECTW))
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 " 8-AUG-83 09:51")
(* moves REGION so that it is entirely on the screen.)
(DECLARE (GLOBALVARS WHOLEDISPLAY))
(PROG (X (LIMITREGION (OR LIMITREGION 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 "24-AUG-82 16:49")
(* 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* (OR (WINDOWPROP WINDOW (QUOTE SELECTIONFN))
(FUNCTION NILL))
(fetch (SELECTABLEITEM ITEMINFO) 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) (* rrb "28-AUG-83 12:18")
(* flips the region of an item)
(PROG ((REG (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of ITEM)))
(RETURN (BITBLT NIL NIL NIL DS (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
(fetch HEIGHT of REG)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(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])
)
[DECLARE: EVAL@COMPILE
(RECORD SELECTABLEITEM (SELECTABLEITEMREGION COMMANDFN ITEMINFO ITEMINFOTYPE))
]
(RPAQQ PropertyLeftMargin 2)
(RPAQQ MaxValueLeftMargin 250)
(RPAQQ MinSpaceBetweenProperyAndValue 8)
(RPAQQ MaxInspectorPropertyValueWidth 250)
(RPAQQ MAXINSPECTCDRLEVEL 50)
(RPAQQ MAXINSPECTARRAYLEVEL 300)
(* functions for the inspector)
(DEFINEQ
(INSPECT
[LAMBDA (ITEM ASTYPE WHERE) (* rrb "12-AUG-83 13:50")
(* sets up a window that allows inspection.)
(DECLARE (SPECVARS WHERE))
(PROG ((ITEMTYPE (TYPENAME ITEM))
INSPECTINFO)
(RETURN (COND
[ASTYPE (* if ASTYPE is given, only look for inspect macros that
have that type named.)
(COND
[(SETQ INSPECTINFO (FASSOC ASTYPE INSPECTMACROS))
(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]
(T (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))
(NIL (INSPECT/AS/BLOCKRECORD ITEM WHERE))
(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/ATOM
[LAMBDA (ATM ALWAYSASKFLG WHERE) (* rrb "20-Jan-84 12:49")
(* asks which aspect to inspect and inspects it.)
(PROG ((ASPECTS (TYPESOF ATM NIL NIL (QUOTE ?)))
TYPETOINSPECT)
[COND
((NONSYSPROPNAMES ATM) (* add the property list to selectable aspects.)
(SETQ ASPECTS (CONS (QUOTE PROPS)
ASPECTS)))
((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
((NULL ASPECTS)
(printout PROMPTWINDOW T ATM " does not have any aspect to inspect.")
(RETURN NIL))
([NULL (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]
(RETURN NIL)))
(* the functions applyed by this EVAL must evalaute their arguments. EDITF works because it is happy to take
(QUOTE FN) as an argument too.)
(RETURN (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.")
(INSPECT
(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))
(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) (* bvm: "12-NOV-83 22:18")
(* calls an editor on a function.)
(PROG ((EDITOR (SELECT.FNS.EDITOR ATM)))
(RETURN (AND EDITOR (APPLY* EDITOR ATM])
(SELECT.FNS.EDITOR
[LAMBDA (FN) (* rrb " 7-SEP-83 17:07")
(* gives the user a menu choice of editors.)
(MENU (create MENU
ITEMS ←[APPEND [COND
((CCODEP FN)
(QUOTE ((InspectCode (QUOTE INSPECTCODEQ)
"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])
(INSPECT/BITMAP
[LAMBDA (BITMAP WHERE) (* rrb " 9-AUG-83 09:44")
(* asks whether to use the bitmap editor or not)
(SELECTQ [MENU (COND
((type? MENU InspectBitmapMenu)
InspectBitmapMenu)
(T (SETQ InspectBitmapMenu (create MENU
ITEMS ←(QUOTE ((fields 'FIELDS
"Inspects the fields of the bitmap")
(contents '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) (* rrb " 9-AUG-83 09:28")
(* creates an inspector window for datatype or record
instance DATUM)
(PROG (DEC SYSREC)
(COND
[(AND TYPE (SETQ DEC (RECLOOK TYPE]
((AND TYPE (SETQ DEC (SYSRECLOOK1 TYPE))
(SETQ SYSREC T)))
((SETQ DEC (FINDRECDECL DATUM)))
((SETQ DEC (FINDSYSRECDECL DATUM))
(SETQ SYSREC T)))
(RETURN (COND
(DEC (INSPECTW.CREATE DATUM (INSPECTABLEFIELDNAMES DEC (OR (NULL
INSPECTALLFIELDSFLG)
SYSREC))
(LIST (QUOTE LAMBDA)
(QUOTE (INSTANCE FIELD))
(LIST (QUOTE RECORDACCESS)
(QUOTE FIELD)
(QUOTE INSTANCE)
(KWOTE DEC)))
(COND
[(NULL SYSREC)
(LIST (QUOTE LAMBDA)
(QUOTE (INSTANCE FIELD NEWVALUE))
(LIST (QUOTE RECORDACCESS)
(QUOTE FIELD)
(QUOTE INSTANCE)
(KWOTE DEC)
(QUOTE (QUOTE /REPLACE))
(QUOTE NEWVALUE]
(T "System datatype. Not settable with the inspector."))
(AND SYSREC
"System Datatype. Not settable with the inspector.")
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/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])
(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])
(INSPECT/AS/BLOCKRECORD
[LAMBDA (INSTANCE WHERE) (* rrb " 9-AUG-83 09:29")
(* offers the user a choice of record types to inspect
INSTANCE with.)
(PROG (RECORD)
(RETURN (AND [SETQ RECORD (MENU (create MENU
ITEMS ←(for RECDEC in USERRECLST
when (EQ (CAR RECDEC)
(QUOTE BLOCKRECORD))
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])
(INSPECTCODE
[LAMBDA (FN) (* rrb " 7-JUL-82 17:11")
(* creates a window that shows the compiled code of a
function.)
(PROG [(WINDOW (CREATEW (GETBOXREGION 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])
(INSPECTCODEQ
[NLAMBDA (FN) (* rrb "11-JAN-83 09:25")
(* nlambda version that is called by
INSPECT/AS/FUNCTION)
(INSPECTCODE 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])
(SELECT.LIST.INSPECTOR
[LAMBDA (LST) (* rrb " 7-SEP-83 16:58")
(* gives the user a choice of how to edit a list.)
(MENU (create MENU
ITEMS ←[APPEND [COND
[(ALISTP LST)
(QUOTE ((AsAList (QUOTE INSPECT/ALIST)
"Inspects the list as a A-List"]
((PROPLISTP LST)
(QUOTE ((AsPList (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" (CAR LST))
(QUOTE (QUOTE INSPECT/TYPERECORD))
(CONCAT
"Inspects the selected list as an instance of "
(CAR LST]
(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")
(AsRecord (QUOTE INSPECT/AS/RECORD)
"Prompts further for the record type of this LIST."]
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])
(PPVINW
[LAMBDA (EXP FILE)
(RESETFORM (OUTPUT FILE)
(PRINTDEF EXP (POSITION])
(\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])
(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])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS INSPECTMACROS INSPECTALLFIELDSFLG SetPropertyMenu SetStackMenu InspectMenu
PropertyLeftMargin MaxValueLeftMargin INSPECTPRINTLEVEL InspectBitmapMenu ItemWCommandMenu
InspectPropsMenu MAXINSPECTARRAYLEVEL MAXINSPECTCDRLEVEL MaxInspectorWindowWidth
MaxInspectorWindowHeight)
)
(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))
(RPAQ? INSPECTALLFIELDSFLG T)
(RPAQ? MaxInspectorWindowWidth 330)
(RPAQ? MaxInspectorWindowHeight 606)
(RPAQQ INSPECTPRINTLEVEL (2 . 5))
(* 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) (* rrb " 8-AUG-83 17:11")
(* 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))
(T (DEFAULT.INSPECTW.VALUECOMMANDFN VALUE PROP DATUM WINDOW])
(PROPERTIES.FROM.FRAMESPEC
[LAMBDA (POS LOTSFLG EMBEDDEDCALLFLG) (* rrb " 2-SEP-83 10:29")
(* 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 (SMARTARGLIST FNNAME)))
[SETQ ARGNAMES (for I from 1 to NARGS collect
(PROG1 (OR (STKARGNAME I POS)
(CAR ARGLST)
(AND LOTSFLG (PACK* (QUOTE *var*)
I)))
(SETQ ARGLST (CDR ARGLST]
(RETURN (NCONC [COND
((OR (NOT EMBEDDEDCALLFLG)
(REALFRAMEP POS T)
WIZARDFLG) (* don't put the name out unless it is REALFRAMEP and
internal to the POS specification eg.
**TRACE**)
(CONS (CONS 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))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML INSPECTCODEQ)
(ADDTOVAR LAMA )
)
(PUTPROPS INSPECT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4447 25134 (INSPECTW.CREATE 4457 . 7875) (INSPECTW.REPAINTFN 7877 . 10703) (
INSPECTW.REDISPLAY 10705 . 14817) (\INSPECTW.VALUE.MARGIN 14819 . 15240) (INSPECTW.REPLACE 15242 .
15766) (INSPECTW.SELECTITEM 15768 . 16596) (\INSPECTW.REDISPLAYPROP 16598 . 18264) (INSPECTW.FETCH
18266 . 18702) (INSPECTW.PROPERTIES 18704 . 19247) (DEFAULT.INSPECTW.PROPCOMMANDFN 19249 . 20570) (
DEFAULT.INSPECTW.VALUECOMMANDFN 20572 . 21621) (DEFAULT.INSPECTW.TITLECOMMANDFN 21623 . 22083) (
\SELITEM.FROM.PROPERTY 22085 . 22494) (\INSPECT.COMPUTE.TITLE 22496 . 23211) (LEVELEDFORM 23213 .
23834) (MAKEWITHINREGION 23836 . 25132)) (25135 38699 (ITEMW.REPAINTFN 25145 . 26001) (
\ITEM.WINDOW.BUTTON.HANDLER 26003 . 26455) (\ITEM.WINDOW.SELECTION.HANDLER 26457 . 28630) (
\INSPECTW.COMMAND.HANDLER 28632 . 31143) (ITEM.WINDOW.SET.STACK.ARG 31145 . 32918) (REPLACESTKARG
32920 . 33806) (IN/ITEM? 33808 . 34272) (\ITEMW.DESELECTITEM 34274 . 34585) (\ITEMW.SELECTITEM 34587
. 34896) (\ITEMW.CLEARSELECTION 34898 . 35297) (\ITEMW.FLIPITEM 35299 . 35819) (PRINTANDBOX 35821 .
37689) (PRINTATBOX 37691 . 38239) (ITEMOFPROPERTYVALUE 38241 . 38697)) (39087 66957 (INSPECT 39097 .
41506) (\APPLYINSPECTMACRO 41508 . 42258) (INSPECT/ATOM 42260 . 44772) (SELECT.ATOM.ASPECT 44774 .
45431) (INSPECT/AS/FUNCTION 45433 . 45749) (SELECT.FNS.EDITOR 45751 . 46310) (INSPECT/BITMAP 46312 .
47016) (INSPECT/DATATYPE 47018 . 48443) (INSPECTABLEFIELDNAMES 48445 . 48955) (REMOVEDUPS 48957 .
49109) (INSPECT/ARRAY 49111 . 49799) (INSPECT/TOP/LEVEL/LIST 49801 . 50488) (INSPECT/PROPLIST 50490 .
51198) (NONSYSPROPNAMES 51200 . 51551) (INSPECT/HARRAYP 51553 . 52095) (HARRAYKEYS 52097 . 52485) (
INSPECTW.GETHASH 52487 . 52678) (INSPECTW.PUTHASH 52680 . 52878) (INSPECT/LISTP 52880 . 53237) (ALISTP
53239 . 53486) (PROPLISTP 53488 . 54037) (INSPECT/ALIST 54039 . 54420) (ASSOCGET 54422 . 54671) (
/ASSOCPUT 54673 . 54895) (INSPECT/PLIST 54897 . 55286) (INSPECT/TYPERECORD 55288 . 55561) (
INSPECT/AS/RECORD 55563 . 56295) (INSPECT/AS/BLOCKRECORD 56297 . 56999) (INSPECTCODE 57001 . 57808) (
INSPECTCODEQ 57810 . 58084) (\INSPECT/CODE/RESHAPEFN 58086 . 59166) (\INSPECT/CODE/REPAINTFN 59168 .
59873) (SELECT.LIST.INSPECTOR 59875 . 61290) (STANDARDEDITE 61292 . 61634) (NTHTOPLEVELELT 61636 .
61985) (SETNTHTOPLEVELELT 61987 . 62697) (DEDITE 62699 . 62891) (FINDRECDECL 62893 . 63333) (
FINDSYSRECDECL 63335 . 63769) (PPVINW 63771 . 63866) (\INSPECTEDITE 63868 . 64265) (
RDTBL\NONOTHERCODES 64267 . 64616) (GETSYNTAXPROP 64618 . 64821) (SETSYNTAXPROP 64823 . 65032) (
GETTTBLPROP 65034 . 65965) (SETTTBLPROP 65967 . 66955)) (67870 73202 (STACKFRAMEPROPPRINTFN 67880 .
68360) (STACKFRAMEVALUECOMMANDFN 68362 . 68858) (PROPERTIES.FROM.FRAMESPEC 68860 . 70637) (
PROPERTIES.FROM.FRAMESPEC.LOTS 70639 . 70729) (WINDOWTITLE2 70731 . 71078) (NEWSTKNPVARS 71080 . 71166
) (MYSMARTARGLIST 71168 . 71568) (FETCHSTKARG 71570 . 72325) (\RELEASEWINDOWSTKDATUM 72327 . 72784) (
BTITEMWINDOWCLOSEFN 72786 . 73200)))))
STOP