(FILECREATED "20-Sep-84 12:27:28" {ERIS}<LISPCORE>SOURCES>INSPECT.;4 75419
changes to: (FNS INSPECTW.CREATE)
previous date: "13-Sep-84 17:27:56" {ERIS}<LISPCORE>SOURCES>INSPECT.;3)
(* Copyright (c) 1982, 1983, 1984 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)
(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) (* rmk: "20-Sep-84 12:27")
(* 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 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])
(DECODE.WINDOW.ARG
[LAMBDA (WHERESPEC WIDTH HEIGHT TITLE BORDER NOOPENFLG) (* rrb "18-Apr-84 20:00")
(* 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 TITLE]
(T NIL))
TITLE BORDER NOOPENFLG])
(DEFAULT.INSPECTW.PROPCOMMANDFN
[LAMBDA (PROPERTY DATUM INSPECTW) (* rrb "18-Apr-84 17:39")
(* 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)))
(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 "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 "18-Apr-84 19:27")
(* 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))
(CCODEP (INSPECTCODE 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 "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) (* 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 WHERE) (* rrb "18-Apr-84 19:27")
(* creates a window that shows the compiled code of a
function.)
(PROG [(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])
(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
(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 "16-Mar-84 17:29")
(* property command function for inspect windows onto
stack frames. Recognizes certain PROP as function
names.)
(COND
[(AND (LISTP PROP)
(NULL (CDR PROP)))
(PROCESS.EVAL (WINDOWPROP WINDOW (QUOTE PROCESS))
(LIST (FUNCTION INSPECT/AS/FUNCTION)
(KWOTE 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 (4497 26674 (INSPECTW.CREATE 4507 . 7460) (INSPECTW.REPAINTFN 7462 . 10288) (
INSPECTW.REDISPLAY 10290 . 14402) (\INSPECTW.VALUE.MARGIN 14404 . 14825) (INSPECTW.REPLACE 14827 .
15351) (INSPECTW.SELECTITEM 15353 . 16181) (\INSPECTW.REDISPLAYPROP 16183 . 17849) (INSPECTW.FETCH
17851 . 18287) (INSPECTW.PROPERTIES 18289 . 18832) (DECODE.WINDOW.ARG 18834 . 20016) (
DEFAULT.INSPECTW.PROPCOMMANDFN 20018 . 21449) (DEFAULT.INSPECTW.VALUECOMMANDFN 21451 . 22500) (
DEFAULT.INSPECTW.TITLECOMMANDFN 22502 . 23540) (\SELITEM.FROM.PROPERTY 23542 . 23951) (
\INSPECT.COMPUTE.TITLE 23953 . 24668) (LEVELEDFORM 24670 . 25291) (MAKEWITHINREGION 25293 . 26672)) (
26675 40239 (ITEMW.REPAINTFN 26685 . 27541) (\ITEM.WINDOW.BUTTON.HANDLER 27543 . 27995) (
\ITEM.WINDOW.SELECTION.HANDLER 27997 . 30170) (\INSPECTW.COMMAND.HANDLER 30172 . 32683) (
ITEM.WINDOW.SET.STACK.ARG 32685 . 34458) (REPLACESTKARG 34460 . 35346) (IN/ITEM? 35348 . 35812) (
\ITEMW.DESELECTITEM 35814 . 36125) (\ITEMW.SELECTITEM 36127 . 36436) (\ITEMW.CLEARSELECTION 36438 .
36837) (\ITEMW.FLIPITEM 36839 . 37359) (PRINTANDBOX 37361 . 39229) (PRINTATBOX 39231 . 39779) (
ITEMOFPROPERTYVALUE 39781 . 40237)) (40627 68582 (INSPECT 40637 . 43091) (\APPLYINSPECTMACRO 43093 .
43843) (INSPECT/ATOM 43845 . 46357) (SELECT.ATOM.ASPECT 46359 . 47016) (INSPECT/AS/FUNCTION 47018 .
47334) (SELECT.FNS.EDITOR 47336 . 47895) (INSPECT/BITMAP 47897 . 48643) (INSPECT/DATATYPE 48645 .
50070) (INSPECTABLEFIELDNAMES 50072 . 50582) (REMOVEDUPS 50584 . 50736) (INSPECT/ARRAY 50738 . 51426)
(INSPECT/TOP/LEVEL/LIST 51428 . 52115) (INSPECT/PROPLIST 52117 . 52825) (NONSYSPROPNAMES 52827 . 53178
) (INSPECT/HARRAYP 53180 . 53722) (HARRAYKEYS 53724 . 54112) (INSPECTW.GETHASH 54114 . 54305) (
INSPECTW.PUTHASH 54307 . 54505) (INSPECT/LISTP 54507 . 54864) (ALISTP 54866 . 55113) (PROPLISTP 55115
. 55664) (INSPECT/ALIST 55666 . 56047) (ASSOCGET 56049 . 56298) (/ASSOCPUT 56300 . 56522) (
INSPECT/PLIST 56524 . 56913) (INSPECT/TYPERECORD 56915 . 57188) (INSPECT/AS/RECORD 57190 . 57922) (
INSPECT/AS/BLOCKRECORD 57924 . 58626) (INSPECTCODE 58628 . 59433) (INSPECTCODEQ 59435 . 59709) (
\INSPECT/CODE/RESHAPEFN 59711 . 60791) (\INSPECT/CODE/REPAINTFN 60793 . 61498) (SELECT.LIST.INSPECTOR
61500 . 62915) (STANDARDEDITE 62917 . 63259) (NTHTOPLEVELELT 63261 . 63610) (SETNTHTOPLEVELELT 63612
. 64322) (DEDITE 64324 . 64516) (FINDRECDECL 64518 . 64958) (FINDSYSRECDECL 64960 . 65394) (PPVINW
65396 . 65491) (\INSPECTEDITE 65493 . 65890) (RDTBL\NONOTHERCODES 65892 . 66241) (GETSYNTAXPROP 66243
. 66446) (SETSYNTAXPROP 66448 . 66657) (GETTTBLPROP 66659 . 67590) (SETTTBLPROP 67592 . 68580)) (
69492 74907 (STACKFRAMEPROPPRINTFN 69502 . 69982) (STACKFRAMEVALUECOMMANDFN 69984 . 70563) (
PROPERTIES.FROM.FRAMESPEC 70565 . 72342) (PROPERTIES.FROM.FRAMESPEC.LOTS 72344 . 72434) (WINDOWTITLE2
72436 . 72783) (NEWSTKNPVARS 72785 . 72871) (MYSMARTARGLIST 72873 . 73273) (FETCHSTKARG 73275 . 74030)
(\RELEASEWINDOWSTKDATUM 74032 . 74489) (BTITEMWINDOWCLOSEFN 74491 . 74905)))))
STOP