(FILECREATED "28-Jun-85 18:39:22" {ERIS}<LISPCORE>SOURCES>INSPECT.;11 81653
changes to: (FNS BKSYSBUF.GENERAL)
previous date: "26-Jun-85 15:53:20" {ERIS}<LISPCORE>SOURCES>INSPECT.;10)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT INSPECTCOMS)
(RPAQQ INSPECTCOMS [(COMS (* functions to implement an item window. An ITEM window is a window that
contains SELECTABLEITEMS. An item from the window is selected using the
left button. The middle button will then bring up a menu of commands
that can be applyed to the selected item. An INSPECTW is a special type
of ITEMW that maintains properties and their values for a datum. It is
used by the inspector.)
(FNS INSPECTW.CREATE INSPECTW.REPAINTFN INSPECTW.REDISPLAY
\INSPECTW.VALUE.MARGIN INSPECTW.REPLACE INSPECTW.SELECTITEM
\INSPECTW.REDISPLAYPROP INSPECTW.FETCH INSPECTW.PROPERTIES
DECODE.WINDOW.ARG DEFAULT.INSPECTW.PROPCOMMANDFN
DEFAULT.INSPECTW.VALUECOMMANDFN DEFAULT.INSPECTW.TITLECOMMANDFN
\SELITEM.FROM.PROPERTY \INSPECT.COMPUTE.TITLE LEVELEDFORM
MAKEWITHINREGION)
(FNS ITEMW.REPAINTFN \ITEM.WINDOW.BUTTON.HANDLER
\ITEM.WINDOW.SELECTION.HANDLER \INSPECTW.COMMAND.HANDLER
ITEM.WINDOW.SET.STACK.ARG REPLACESTKARG IN/ITEM? \ITEMW.DESELECTITEM
\ITEMW.SELECTITEM \ITEMW.CLEARSELECTION \ITEMW.FLIPITEM PRINTANDBOX
PRINTATBOX ITEMOFPROPERTYVALUE)
(FNS \ITEM.WINDOW.COPY.HANDLER \ITEMW.FLIPCOPY BKSYSBUF.GENERAL)
(RECORDS SELECTABLEITEM)
(VARS 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 \TEDIT.INSPECTCODE
\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])
(* functions to implement an item window. An ITEM window is a window that contains
SELECTABLEITEMS. An item from the window is selected using the left button. The middle button
will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is
a special type of ITEMW that maintains properties and their values for a datum. It is used by
the inspector.)
(DEFINEQ
(INSPECTW.CREATE
[LAMBDA (DATUM PROPERTIES FETCHFN STOREFN PROPCOMMANDFN VALUECOMMANDFN TITLECOMMANDFN TITLE
SELECTIONFN WHERE PROPPRINTFN) (* bvm: "26-Jun-85 15:12")
(* creates a window with an item list made up of
properties and values)
(PROG [WINDOW VALUE PROPMENU VALUEMENU VALUEMARGIN SELITEMS MAXVALUEWIDTH
(IWFONT (DEFAULTFONT (QUOTE DISPLAY)))
(PROPERTIESLST (COND
((OR (NULL PROPERTIES)
(LISTP PROPERTIES))
PROPERTIES)
(T (* allow PROPERTIES to be a function)
(APPLY* PROPERTIES DATUM]
(SETQ VALUEMARGIN (\INSPECTW.VALUE.MARGIN PROPERTIESLST IWFONT))
(SETQ MAXVALUEWIDTH (COND
(PROPERTIESLST (IMIN (IMAX (bind X for PROP in PROPERTIESLST
largest (\STRINGWIDTHGUESS (APPLY* FETCHFN DATUM PROP)
IWFONT)
finally (RETURN $$EXTREME))
16)
MaxInspectorPropertyValueWidth))
(T (* no fields to inspect)
30)))
(SETQ WINDOW (DECODE.WINDOW.ARG WHERE (IPLUS VALUEMARGIN MAXVALUEWIDTH)
(IMIN MaxInspectorWindowHeight
(ITIMES (COND
(PROPERTIESLST (LENGTH PROPERTIESLST))
(T 1))
(FONTHEIGHT IWFONT)))
(\INSPECT.COMPUTE.TITLE TITLE DATUM)))
(DSPFONT IWFONT WINDOW)
(DSPRIGHTMARGIN 50000 WINDOW) (* for now, can't handle multiple PROPCOMMANDFN output.
Put right margin way out.)
(WINDOWPROP WINDOW (QUOTE DATUM)
DATUM) (* initialize the properties of the window.)
(WINDOWPROP WINDOW (QUOTE STOREFN)
STOREFN)
(WINDOWPROP WINDOW (QUOTE FETCHFN)
FETCHFN)
(WINDOWPROP WINDOW (QUOTE PROPCOMMANDFN)
PROPCOMMANDFN)
(WINDOWPROP WINDOW (QUOTE VALUECOMMANDFN)
VALUECOMMANDFN)
(WINDOWPROP WINDOW (QUOTE INSPECTWTITLE)
TITLE)
(WINDOWPROP WINDOW (QUOTE TITLECOMMANDFN)
TITLECOMMANDFN)
(WINDOWPROP WINDOW (QUOTE SELECTIONFN)
SELECTIONFN)
(WINDOWPROP WINDOW (QUOTE PROPERTIES)
PROPERTIES)
(WINDOWPROP WINDOW (QUOTE PROPPRINTFN)
PROPPRINTFN)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION \ITEM.WINDOW.BUTTON.HANDLER))
(WINDOWPROP WINDOW (QUOTE COPYBUTTONEVENTFN)
(FUNCTION \ITEM.WINDOW.COPY.HANDLER))
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION INSPECTW.REPAINTFN))
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(RETURN (INSPECTW.REDISPLAY WINDOW NIL VALUEMARGIN])
(INSPECTW.REPAINTFN
[LAMBDA (WINDOW REGION) (* rrb "28-AUG-83 12:13")
(* repaints the selectable items in
(an inspect window. This knows that the items are stored
in increasing order.))
(COND
[REGION (* only clip to region if a region is given.)
(PROG ((SELITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
(WREG (DSPCLIPPINGREGION NIL WINDOW))
LINEBASE SELECTABLEITEMREGION PROPPRINTFN)
(SETQ LINEBASE (fetch (REGION TOP) of WREG))
ABOVELP (* skip those above the window.)
(COND
((NULL SELITEMS)
(RETURN))
((IGREATERP (fetch (REGION BOTTOM) of (fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of (CAR SELITEMS)))
LINEBASE)
(SETQ SELITEMS (CDR SELITEMS))
(GO ABOVELP))) (* determine the bottom line base)
(SETQ LINEBASE (fetch (REGION BOTTOM) of WREG))
PRINTLP (* print them as long as they are visible.)
(COND
((NULL SELITEMS)
(RETURN))
((IGREATERP [fetch (REGION PTOP) of (SETQ SELECTABLEITEMREGION
(fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of (CAR SELITEMS]
LINEBASE) (* still possibly visible, check for horizontal fit
before printing.)
(COND
((REGIONSINTERSECTP REGION SELECTABLEITEMREGION)
(PRINTATBOX [COND
[[AND (EQ (fetch (SELECTABLEITEM ITEMINFOTYPE)
of (CAR SELITEMS))
(QUOTE PROPERTY))
(WINDOWPROP WINDOW (QUOTE DATUM))
(SETQ PROPPRINTFN (WINDOWPROP WINDOW (QUOTE
PROPPRINTFN]
(* hook for property print functions Should be cleaned
up.)
(APPLY* PROPPRINTFN (fetch (SELECTABLEITEM ITEMINFO)
of (CAR SELITEMS))
(WINDOWPROP WINDOW (QUOTE DATUM]
(T (fetch (SELECTABLEITEM ITEMINFO) of (CAR SELITEMS]
WINDOW SELECTABLEITEMREGION)))
(SETQ SELITEMS (CDR SELITEMS))
(GO PRINTLP]
(T (* if no region, use other repaintfn to repaint them
all.)
(ITEMW.REPAINTFN WINDOW))) (* if there is a selected item, flip it too in case some
of it was in the newly exposed area.)
(AND (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
(\ITEMW.FLIPITEM (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
WINDOW])
(INSPECTW.REDISPLAY
[LAMBDA (WINDOW PROPS VALUEMARGIN) (* rrb " 2-May-85 11:44")
(* redisplays an itemw to get the newly updated
fields.)
(COND
[PROPS (COND
((NLISTP PROPS)
(\INSPECTW.REDISPLAYPROP WINDOW PROPS))
(T (for PROP in PROPS do (\INSPECTW.REDISPLAYPROP WINDOW PROP]
(T (PROG ((DATUM (WINDOWPROP WINDOW (QUOTE DATUM)))
(PROPERTIES (INSPECTW.PROPERTIES WINDOW))
(FETCHFN (WINDOWPROP WINDOW (QUOTE FETCHFN)))
(PROPCOMMANDFN (WINDOWPROP WINDOW (QUOTE PROPCOMMANDFN)))
(VALUECOMMANDFN (WINDOWPROP WINDOW (QUOTE VALUECOMMANDFN)))
(PROPPRINTFN (WINDOWPROP WINDOW (QUOTE PROPPRINTFN)))
VALUE PROPMENU VALUEMENU SELITEMS PROPERTYPNAMES)
(SETQ PROPERTYPNAMES (COND
(PROPPRINTFN (for PROP in PROPERTIES collect (APPLY* PROPPRINTFN PROP DATUM)))
(T PROPERTIES)))
[SETQ VALUEMARGIN (OR VALUEMARGIN (\INSPECTW.VALUE.MARGIN PROPERTYPNAMES
(DSPFONT NIL WINDOW]
(* remove old selected item if any)
(\ITEMW.DESELECTITEM NIL WINDOW)
(CLEARW WINDOW)
(WINDOWPROP WINDOW (QUOTE TITLE)
(\INSPECT.COMPUTE.TITLE (WINDOWPROP WINDOW (QUOTE INSPECTWTITLE))
DATUM WINDOW))
(* might be faster to only print and determine positions for the ones that are visible and keep track of which
haven't been seen yet but this is easier for now.)
(MOVETOUPPERLEFT WINDOW (DSPCLIPPINGREGION NIL WINDOW))
[WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)
(SETQ SELITEMS
(for PROP in PROPERTIES as PROPNAME in PROPERTYPNAMES
join (COND
[PROPNAME (LIST (create SELECTABLEITEM
SELECTABLEITEMREGION ←(PRINTANDBOX
PROPNAME WINDOW PropertyLeftMargin)
COMMANDFN ←(OR PROPCOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.PROPCOMMANDFN))
ITEMINFO ← PROP
ITEMINFOTYPE ←(QUOTE PROPERTY))
(create SELECTABLEITEM
SELECTABLEITEMREGION ←(PRINTANDBOX
(COND
((NLSETQ (SETQ VALUE
(APPLY* FETCHFN DATUM
PROP)))
VALUE)
(T
(* error during access.)
(SETQ VALUE
"** error during access **")))
WINDOW VALUEMARGIN
MinSpaceBetweenProperyAndValue)
COMMANDFN ←(OR VALUECOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.VALUECOMMANDFN))
ITEMINFO ← VALUE
ITEMINFOTYPE ←(CONS PROP]
(T (* if property name returns NIL, print value in middle)
(CONS (create SELECTABLEITEM
SELECTABLEITEMREGION ←(PRINTANDBOX
(COND
((NLSETQ (SETQ VALUE
(APPLY* FETCHFN DATUM PROP)))
VALUE)
(T
(* error during access.)
(SETQ VALUE
"** error during access **")))
WINDOW
(LRSH VALUEMARGIN 1))
COMMANDFN ←(OR VALUECOMMANDFN
(FUNCTION
DEFAULT.INSPECTW.VALUECOMMANDFN))
ITEMINFO ← VALUE
ITEMINFOTYPE ←(CONS PROP]
(WINDOWPROP WINDOW (QUOTE EXTENT)
(PROG [(NOWEXTENT (COND
[SELITEMS (create REGION using (fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of (CAR SELITEMS]
(T (* don't have any items; make extent empty.)
(create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← 0
HEIGHT ← 0]
(for SELITEM in (CDR SELITEMS) do (EXTENDREGION NOWEXTENT
(fetch (
SELECTABLEITEM SELECTABLEITEMREGION) of SELITEM)))
(RETURN NOWEXTENT))) (* limit scrolling so that it won't go off the top.)
(WINDOWPROP WINDOW (QUOTE SCROLLEXTENTUSE)
(QUOTE LIMIT))
(RETURN WINDOW])
(\INSPECTW.VALUE.MARGIN
[LAMBDA (PROPS FONT) (* rrb "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) (* bvm: "24-Jun-85 17:40")
(* standard useful routine for decoding a window specification arg. WHERESPEC can be a window, a region, a position
or NIL. If WHERESPEC is a window, the other args are ignored. This allows programs to override defaults by
explicitly providing a window. If a position or NIL, WIDTH and HEIGHT are the dimensions of the new window.
The returned window will be entirely on the screen, dimensions permitting.)
(COND
((WINDOWP WHERESPEC)
WHERESPEC)
(T (CREATEW (COND
((REGIONP WHERESPEC)
(MAKEWITHINREGION WHERESPEC))
[(AND (NUMBERP WIDTH)
(NUMBERP HEIGHT))
(COND
[(POSITIONP WHERESPEC)
(MAKEWITHINREGION (CREATEREGION (fetch (POSITION XCOORD) of WHERESPEC)
(fetch (POSITION YCOORD) of WHERESPEC)
(WIDTHIFWINDOW WIDTH BORDER)
(HEIGHTIFWINDOW HEIGHT TITLE BORDER]
(T (GETBOXREGION (WIDTHIFWINDOW WIDTH BORDER)
(HEIGHTIFWINDOW HEIGHT TITLE BORDER)
NIL NIL NIL (CONCAT "Specify position for " TITLE]
(T NIL))
TITLE BORDER NOOPENFLG])
(DEFAULT.INSPECTW.PROPCOMMANDFN
[LAMBDA (PROPERTY DATUM INSPECTW) (* rrb "30-Apr-85 16:30")
(* allows the user to select a menu item to change the
property in an inspect window.)
(SELECTQ [MENU (COND
((type? MENU SetPropertyMenu)
SetPropertyMenu)
(T (SETQ SetPropertyMenu (create MENU
ITEMS ←(QUOTE ((SET (QUOTE SET)
"Allows a new value to be entered"]
[SET (ERSETQ (PROG ((OLDVALUEITEM (ITEMOFPROPERTYVALUE PROPERTY INSPECTW))
NEWVALUE PWINDOW)
(TTYDISPLAYSTREAM (SETQ PWINDOW (GETPROMPTWINDOW INSPECTW 3)))
(CLEARBUF T T)
(RESETLST (RESETSAVE (\ITEMW.FLIPITEM OLDVALUEITEM INSPECTW)
(LIST (QUOTE \ITEMW.FLIPITEM)
OLDVALUEITEM INSPECTW))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(RESETSAVE (PRINTLEVEL 4 3))
(printout T "Enter the new " PROPERTY " for " DATUM T
"The expression read will be EVALuated."
T "> ")
(SETQ NEWVALUE (LISPX (LISPXREAD T T)
(QUOTE >)))
(* clear tty buffer because it sometimes has stuff
left.)
(CLEARBUF T T))
(CLOSEW PWINDOW)
(RETURN (INSPECTW.REPLACE INSPECTW PROPERTY NEWVALUE]
NIL])
(DEFAULT.INSPECTW.VALUECOMMANDFN
[LAMBDA (VALUE PROPERTY DATUM WINDOW) (* rrb " 9-AUG-83 09:42")
(* allows the user to choose a way to inspect a value in
a window)
(SELECTQ (TYPENAME VALUE)
[LITATOM (COND
(VALUE (INSPECT/ATOM VALUE T))
(T (printout PROMPTWINDOW T "Can't inspect NIL.")
(until (MOUSESTATE UP))
(CLRPROMPT]
(BITMAP (INSPECT/BITMAP VALUE))
((FIXP SMALLP FLOATP)
(printout PROMPTWINDOW T "Can't Inspect " VALUE)
(until (MOUSESTATE UP))
(CLRPROMPT))
(LISTP (* find out how to inspect the list.)
(INSPECT/LISTP VALUE))
(SELECTQ [MENU (COND
((type? MENU InspectMenu)
InspectMenu)
(T (SETQ InspectMenu (create MENU
ITEMS ←(QUOTE ((Inspect (QUOTE
INSPECT/VALUE]
(INSPECT/VALUE (INSPECT VALUE))
NIL])
(DEFAULT.INSPECTW.TITLECOMMANDFN
[LAMBDA (INSPECTW DATUM) (* rrb "18-Apr-84 17:57")
(SELECTQ [MENU (COND
((type? MENU ItemWCommandMenu)
ItemWCommandMenu)
(T (SETQ ItemWCommandMenu (create MENU
ITEMS ←(QUOTE ((ReFetch (QUOTE REFETCH)
"ReFetches and redisplays the object's fields")
(IT←datum
(QUOTE SETIT)
"sets the variable IT to the object inspected in this window.")
(IT←selection
(QUOTE SETITTOSEL)
"sets the variable IT to the item selected in this window."]
(REFETCH (INSPECTW.REDISPLAY INSPECTW))
(SETIT (SETQ IT DATUM))
[SETITTOSEL (COND
[(WINDOWPROP INSPECTW (QUOTE CURRENTITEM))
(SETQ IT (fetch (SELECTABLEITEM ITEMINFO) of (WINDOWPROP INSPECTW
(QUOTE
CURRENTITEM]
(T (PROMPTPRINT "No item has been selected from this window."]
NIL])
(\SELITEM.FROM.PROPERTY
[LAMBDA (INSPECTW PROPERTY) (* rrb " 6-MAR-82 17:50")
(for SELITEM in (WINDOWPROP INSPECTW (QUOTE SELECTABLEITEMS))
when (AND (EQ (fetch (SELECTABLEITEM ITEMINFO) of SELITEM)
PROPERTY)
(EQ (fetch (SELECTABLEITEM ITEMINFOTYPE) of SELITEM)
(QUOTE PROPERTY)))
do (RETURN SELITEM])
(\INSPECT.COMPUTE.TITLE
[LAMBDA (TITLE DATUM WINDOW) (* rrb " 7-AUG-83 19:09")
(* computes the title for an inspectw from its title
field and its datum.)
(PROG (VALUE)
(RETURN (COND
((NULL TITLE)
(CONCAT (LEVELEDFORM DATUM 3 4)
" Inspector"))
((EQ TITLE (QUOTE DON'T)) (* no title)
NIL)
((LITATOM TITLE) (* it is a function to compute the title.)
(COND
((NEQ (SETQ VALUE (APPLY* TITLE DATUM WINDOW))
(QUOTE DON'T))
VALUE)
(T NIL)))
(T TITLE])
(LEVELEDFORM
[LAMBDA (EXP CARLEV CDRLEV) (* rrb "13-MAR-82 12:08")
(* returns a copy of EXP that is abbreviated at CARLEV
depth in the car direction and CDRLEV depth in the CDR
direction)
(COND
((NLISTP EXP)
EXP)
((EQ CARLEV 0)
(QUOTE &))
(T (CONS (LEVELEDFORM (CAR EXP)
(SUB1 CARLEV)
CDRLEV)
(COND
[(EQ CDRLEV 0)
(COND
((CDR EXP)
(QUOTE (--]
(T (LEVELEDFORM (CDR EXP)
CARLEV
(SUB1 CDRLEV])
(MAKEWITHINREGION
[LAMBDA (REGION LIMITREGION) (* rrb "18-Apr-84 20:09")
(* moves REGION so that it is entirely on the screen.)
(DECLARE (GLOBALVARS WHOLEDISPLAY))
(PROG [X (LIMITREGION (COND
(LIMITREGION (OR (REGIONP LIMITREGION)
(\ILLEGAL.ARG LIMITREGION)))
(T WHOLEDISPLAY]
[COND
((ILESSP (fetch (REGION LEFT) of REGION)
(SETQ X (fetch (REGION LEFT) of LIMITREGION)))
(replace (REGION LEFT) of REGION with X))
((IGREATERP (fetch (REGION PRIGHT) of REGION)
(SETQ X (fetch (REGION PRIGHT) of LIMITREGION)))
(replace (REGION LEFT) of REGION with (IMAX 0 (IDIFFERENCE (SUB1 X)
(fetch (REGION WIDTH)
of REGION]
[COND
((ILESSP (fetch (REGION BOTTOM) of REGION)
(SETQ X (fetch (REGION BOTTOM) of LIMITREGION)))
(replace (REGION BOTTOM) of REGION with X))
((IGREATERP (fetch (REGION PTOP) of REGION)
(SETQ X (fetch (REGION PTOP) of LIMITREGION)))
(replace (REGION BOTTOM) of REGION with (IMAX 0 (IDIFFERENCE (SUB1 X)
(fetch (REGION HEIGHT)
of REGION]
(RETURN REGION])
)
(DEFINEQ
(ITEMW.REPAINTFN
[LAMBDA (WINDOW REGION) (* rrb "28-AUG-83 12:13")
(* repaints the selectable items in a window.)
[for SELITEM in (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)) bind SELECTABLEITEMREGION
do (COND
((REGIONSINTERSECTP REGION (SETQ SELECTABLEITEMREGION (fetch (SELECTABLEITEM
SELECTABLEITEMREGION)
of SELITEM)))
(PRINTATBOX (fetch (SELECTABLEITEM ITEMINFO) of SELITEM)
WINDOW SELECTABLEITEMREGION] (* if there is a selected item, flip it too in case some
of it was in the newly exposed area.)
(AND (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
(\ITEMW.FLIPITEM (WINDOWPROP WINDOW (QUOTE CURRENTITEM))
WINDOW])
(\ITEM.WINDOW.BUTTON.HANDLER
[LAMBDA (WINDOW) (* rrb " 6-MAR-82 16:12")
(* handles button events for item windows.
Basically calls left or middle button handler.)
(COND
((LASTMOUSESTATE LEFT)
(\ITEM.WINDOW.SELECTION.HANDLER WINDOW))
((LASTMOUSESTATE MIDDLE)
(\INSPECTW.COMMAND.HANDLER WINDOW])
(\ITEM.WINDOW.SELECTION.HANDLER
[LAMBDA (WINDOW) (* rrb "30-Apr-85 17:04")
(* selects an ITEM from the window. If there is an item selected already, it is deselected. An ITEM is a list whose
CAR is a region.)
(PROG ((SELECTABLEITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
NOW PREVIOUS BUTTON OLDPOS REG)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN))) (* note which button is down.)
(COND
((LASTMOUSESTATE LEFT)
(SETQ BUTTON (QUOTE LEFT)))
((LASTMOUSESTATE MIDDLE)
(SETQ BUTTON (QUOTE MIDDLE)))
(T (* no button down, not interested.)
(RETURN)))
(TOTOPW WINDOW)
(SETQ REG (WINDOWPROP WINDOW (QUOTE REGION))) (* note current item selection.)
[SETQ NOW (IN/ITEM? SELECTABLEITEMS (SETQ OLDPOS (CURSORPOSITION NIL WINDOW]
(SETQ PREVIOUS (WINDOWPROP WINDOW (QUOTE CURRENTITEM)))
FLIP (* turn off old selection.)
(\ITEMW.DESELECTITEM PREVIOUS WINDOW)
(\ITEMW.SELECTITEM (SETQ PREVIOUS NOW)
WINDOW)
LP (* wait for a button up or move out of region)
(GETMOUSESTATE)
(COND
((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* button up, return)
(AND NOW (WINDOWPROP WINDOW (QUOTE SELECTIONFN))
(APPLY* (WINDOWPROP WINDOW (QUOTE SELECTIONFN))
[COND
((EQ (QUOTE PROPERTY)
(fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW))
(fetch (SELECTABLEITEM ITEMINFO) of NOW))
(T (CAR (fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW]
(NEQ (fetch (SELECTABLEITEM ITEMINFOTYPE) of NOW)
(QUOTE PROPERTY))
WINDOW))
(RETURN))
((NOT (INSIDE? REG LASTMOUSEX LASTMOUSEY)) (* outside of region, return)
(\ITEMW.DESELECTITEM PREVIOUS WINDOW)
(RETURN))
([EQ PREVIOUS (SETQ NOW (IN/ITEM? SELECTABLEITEMS (CURSORPOSITION NIL WINDOW OLDPOS]
(GO LP))
(T (GO FLIP])
(\INSPECTW.COMMAND.HANDLER
[LAMBDA (INSPECTW) (* rrb " 7-MAR-82 17:05")
(* the user has middle buttoned in an ITEM window. Apply the selected item's COMMANDFN to the selected item and
the window. Often the commandfn will put up another menu.)
(COND
[(INSIDEP (DSPCLIPPINGREGION NIL INSPECTW)
(LASTMOUSEX INSPECTW)
(LASTMOUSEY INSPECTW)) (* inside of interior)
(PROG ((SELITEM (WINDOWPROP INSPECTW (QUOTE CURRENTITEM)))
COMMANDFN INFO)
(RETURN (COND
[SELITEM (COND
((NULL (SETQ COMMANDFN (fetch (SELECTABLEITEM COMMANDFN)
of SELITEM)))
(* special case of NIL command fn)
(PROMPTPRINT "There is no change function for this window."))
((STRINGP COMMANDFN)
(PROMPTPRINT COMMANDFN))
(T
(* check to see if the selected item is a property or a value. This distinction is because the value one needs an
extra argument. The selected item is considered to be a property if it is one of the properties of the window.)
(ERSETQ (COND
((EQ (SETQ INFO (fetch (SELECTABLEITEM ITEMINFOTYPE)
of SELITEM))
(QUOTE PROPERTY))
(* the selected item is a property.
Call the command fn in property form.)
(APPLY* COMMANDFN (fetch (SELECTABLEITEM ITEMINFO)
of SELITEM)
(WINDOWPROP INSPECTW (QUOTE DATUM))
INSPECTW))
(T
(* the selected item is a value Call the command fn in value form. For values, the item info type is a cons whose
CAR is the property)
(APPLY* COMMANDFN (fetch (SELECTABLEITEM ITEMINFO)
of SELITEM)
(CAR INFO)
(WINDOWPROP INSPECTW (QUOTE DATUM))
INSPECTW]
(T (PROMPTPRINT (QUOTE (This is the command button. % You must select an
item with the left button before choosing a
command.)))
(until (MOUSESTATE UP))
(CLRPROMPT]
(T (* inside border or title Call the window's
TITLECOMMANDFN)
(APPLY* (OR (WINDOWPROP INSPECTW (QUOTE TITLECOMMANDFN))
(FUNCTION DEFAULT.INSPECTW.TITLECOMMANDFN))
INSPECTW
(WINDOWPROP INSPECTW (QUOTE DATUM])
(ITEM.WINDOW.SET.STACK.ARG
[LAMBDA (VARNAME FRAME WINDOW) (* rrb " 9-AUG-83 09:46")
(* the PropCommandFn for itemw windows onto stack
frames.)
(SELECTQ [MENU (COND
((type? MENU SetStackMenu)
SetStackMenu)
(T (SETQ SetStackMenu (create MENU
ITEMS ←(QUOTE ((Set (QUOTE SET)
"Changes the value of this stack variable"]
[SET (OR (STACKP FRAME)
(\ILLEGAL.ARG FRAME))
(ERSETQ (PROG ((OLDVALUEITEM (ITEMOFPROPERTYVALUE VARNAME WINDOW))
NEWVALUE) (* decode the argument position)
(* insist that the arg being set has a real name. following is the code to allow any var to be set:
(SETQ ARGN (COND ((FRAMESCAN VARNAME FRAME)) ((STRPOS VARNAME "*arg" 1 T) (COND ((SMALLP (SUBATOM VARNAME 5 -1)))
(T (PROMPTPRINT "Can't set that arg.") (RETURN)))) ((STRPOS VARNAME "*prg" 1 T) (COND ((SETQ ARGN
(SMALLP (SUBATOM VARNAME 5 -1))) (IPLUS ARGN (STKNARGS FRAME))) (T (PROMPTPRINT "Can't set that arg.")
(RETURN)))))))
(COND
((FRAMESCAN VARNAME FRAME))
(T (PROMPTPRINT "Can't set that arg.")
(RETURN)))
[RESETLST (RESETSAVE (\ITEMW.FLIPITEM OLDVALUEITEM WINDOW)
(LIST (QUOTE \ITEMW.FLIPITEM)
OLDVALUEITEM WINDOW))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(CLRPROMPT)
(printout T "Enter the new value for " VARNAME "." T
"The expression read will be EVALuated."
T "> ")
(SETQ NEWVALUE (EVAL (READ T T]
(RETURN (INSPECTW.REPLACE WINDOW VARNAME NEWVALUE]
NIL])
(REPLACESTKARG
[LAMBDA (FRAMESPEC WHICHSPEC NEWVALUE) (* rrb " 8-AUG-83 16:46")
(* StoreFn for the ITEMW that inspects back trace
frames.)
(COND
((NULL (CDR WHICHSPEC)) (* this is a dummy which is a function name.
it has no value)
NIL)
((LISTP FRAMESPEC)
(REPLACESTKARG (CAR (NTH FRAMESPEC (CAR WHICHSPEC)))
(CDR WHICHSPEC)
NEWVALUE))
(T (PROG NIL
(OR (STACKP FRAMESPEC)
(\ILLEGAL.ARG FRAMESPEC))
(RETURN (SETSTKARG (COND
((LISTP WHICHSPEC) (* CAR is name, CADR is offset)
(CADR WHICHSPEC))
((FRAMESCAN WHICHSPEC FRAMESPEC))
(T (PROMPTPRINT "Can't set that arg.")
(RETURN)))
FRAMESPEC NEWVALUE])
(IN/ITEM?
[LAMBDA (ITEMS POS) (* rrb "28-AUG-83 12:18")
(PROG ((XPOS (fetch XCOORD of POS))
(YPOS (fetch YCOORD of POS)))
(RETURN (for ITEM in ITEMS when (AND (fetch (SELECTABLEITEM SELECTABLEITEMREGION)
of ITEM)
(INSIDE? (fetch (SELECTABLEITEM SELECTABLEITEMREGION)
of ITEM)
XPOS YPOS))
do (RETURN ITEM])
(\ITEMW.DESELECTITEM
[LAMBDA (ITEM WINDOW) (* rrb " 6-MAR-82 15:13")
(* deselects ITEM from window)
(AND ITEM (\ITEMW.FLIPITEM ITEM WINDOW))
(WINDOWPROP WINDOW (QUOTE CURRENTITEM)
NIL])
(\ITEMW.SELECTITEM
[LAMBDA (ITEM WINDOW) (* rrb " 6-MAR-82 15:13")
(* selects an ITEM in WINDOW)
(AND ITEM (\ITEMW.FLIPITEM ITEM WINDOW))
(WINDOWPROP WINDOW (QUOTE CURRENTITEM)
ITEM])
(\ITEMW.CLEARSELECTION
[LAMBDA (INSPECTW) (* rrb "20-JUL-83 09:34")
(* clears the selection from an inspect window)
(PROG [(CURRENTITEM (WINDOWPROP INSPECTW (QUOTE CURRENTITEM]
(AND CURRENTITEM (\ITEMW.DESELECTITEM CURRENTITEM INSPECTW))
(RETURN INSPECTW])
(\ITEMW.FLIPITEM
[LAMBDA (ITEM DS) (* bvm: "26-Jun-85 14:37")
(* flips the region of an item)
(LET ((REG (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of ITEM)))
(BLTSHADE BLACKSHADE DS (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
(fetch HEIGHT of REG)
(QUOTE INVERT])
(PRINTANDBOX
[LAMBDA (EXP STREAM LFTMARGIN MINSPACE) (* rmk: "26-AUG-83 17:56")
(* prints EXP on WINDOW starting at LFTMARGIN and
returns the box taken by the characters.
Leaves at least MINSPACE points.)
(* set the left margin so that at least nothing will CR
past it. This does not handle multiple line values.)
(PROG ((STRM (\OUTSTREAMARG STREAM))
PREVRM PREVLM YSTART YEND HGHT)
(SETQ PREVRM (DSPRIGHTMARGIN 50000 STRM)) (* so that it won't auto carrage return.)
(SETQ PREVLM (DSPLEFTMARGIN LFTMARGIN STRM))
(AND (FIXP MINSPACE)
(RELMOVETO MINSPACE 0 STRM))
(COND
((IGREATERP (DSPXPOSITION NIL STRM)
LFTMARGIN)
(TERPRI STRM)))
(DSPXPOSITION LFTMARGIN STRM)
(SETQ YSTART (DSPYPOSITION NIL STRM))
(RETURN (PROG1 [create REGION
LEFT ← LFTMARGIN
BOTTOM ←[PROGN (RESETFORM (PRINTLEVEL INSPECTPRINTLEVEL)
(PROG ((PLVLFILEFLG T))
(PRIN2 EXP STRM)))
(IDIFFERENCE (SETQ YEND (DSPYPOSITION NIL STRM))
(FONTPROP STRM (QUOTE DESCENT]
HEIGHT ←(IPLUS (SETQ HGHT (IDIFFERENCE YSTART YEND))
(FONTPROP STRM (QUOTE HEIGHT)))
WIDTH ←(COND
((IGREATERP HGHT 0) (* printing the thing did an overflow;
use at least the width of the window.)
(IMAX (IDIFFERENCE (DSPXPOSITION NIL STRM)
LFTMARGIN)
(IDIFFERENCE (fetch (REGION WIDTH)
of (DSPCLIPPINGREGION NIL STRM))
LFTMARGIN)))
(T (IDIFFERENCE (DSPXPOSITION NIL STRM)
LFTMARGIN]
(DSPRIGHTMARGIN PREVRM STRM)
(DSPLEFTMARGIN PREVLM STRM])
(PRINTATBOX
[LAMBDA (EXP WINDOW OLDBOX) (* rrb "21-FEB-83 13:02")
(* prints EXP in place of what used to be in oldbox and
returns the new box.)
(DSPFILL OLDBOX NIL (QUOTE REPLACE)
WINDOW)
(MOVETO (fetch LEFT of OLDBOX)
(IDIFFERENCE (fetch PTOP of OLDBOX)
(FONTPROP (DSPFONT NIL WINDOW)
(QUOTE ASCENT)))
WINDOW)
(PRINTANDBOX EXP WINDOW (fetch LEFT of OLDBOX])
(ITEMOFPROPERTYVALUE
[LAMBDA (PROPERTY WINDOW) (* rrb " 6-MAR-82 18:19")
(* returns the selectableitem structure that corresponds
to the value of a property in an inspectw.
Knows the way INSPECTW are created.)
(CADR (MEMB (\SELITEM.FROM.PROPERTY WINDOW PROPERTY)
(WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS])
)
(DEFINEQ
(\ITEM.WINDOW.COPY.HANDLER
[LAMBDA (WINDOW) (* bvm: "26-Jun-85 15:38")
(* * copy selects an ITEM from the window. An ITEM is an instance of record SELECTABLEITEM.)
(PROG ((SELECTABLEITEMS (WINDOWPROP WINDOW (QUOTE SELECTABLEITEMS)))
CURRENTITEM SMASHPOS NEWITEM)
(COND
((NULL SELECTABLEITEMS) (* no items, don't do anything.)
(RETURN)))
LP (TOTOPW WINDOW) (* note current item selection.)
[SETQ NEWITEM (IN/ITEM? SELECTABLEITEMS (SETQ SMASHPOS (CURSORPOSITION NIL WINDOW]
[COND
((NEQ CURRENTITEM NEWITEM)
(COND
(CURRENTITEM (* turn off old selection.)
(\ITEMW.FLIPCOPY CURRENTITEM WINDOW)))
(COND
((SETQ CURRENTITEM NEWITEM)
(\ITEMW.FLIPCOPY CURRENTITEM WINDOW] (* wait for a button up or move out of region)
LP2 (BLOCK)
(COND
((NOT (.COPYKEYDOWNP.)) (* Finished, copy selected item)
[COND
(CURRENTITEM (\ITEMW.FLIPCOPY CURRENTITEM WINDOW)
(BKSYSBUF.GENERAL (fetch (SELECTABLEITEM ITEMINFO) of CURRENTITEM]
(RETURN))
((MOUSESTATE UP) (* button up, no action)
(GO LP2))
(T (GO LP])
(\ITEMW.FLIPCOPY
[LAMBDA (ITEM DS) (* bvm: "26-Jun-85 15:09")
(* * flips the copy selection region of an item)
(LET ((REG (fetch (SELECTABLEITEM SELECTABLEITEMREGION) of ITEM)))
(BLTSHADE GRAYSHADE DS (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
2
(QUOTE INVERT])
(BKSYSBUF.GENERAL
[LAMBDA (OBJECT) (* bvm: "28-Jun-85 18:15")
(* * Does a slightly more intelligent BKSYSBUF than just stuffing the print name as characters)
(LET ((TYPE (TYPENAME OBJECT)))
(SELECTQ TYPE
((STRINGP LITATOM)
(BKSYSBUF OBJECT T T))
[LISTP (bind (SEPR ←(QUOTE %())
do (BKSYSBUF SEPR)
(SETQ SEPR (QUOTE % ))
(BKSYSBUF.GENERAL (CAR OBJECT))
repeatuntil (NLISTP (SETQ OBJECT (CDR OBJECT)))
finally (COND
(OBJECT (* Dotted cdr)
(BKSYSBUF " . ")
(BKSYSBUF.GENERAL OBJECT)))
(BKSYSBUF (QUOTE %)]
(COND
((OR (NUMBERP OBJECT)
(ASSOC TYPE \DEFPRINTFNS))
(BKSYSBUF OBJECT))
(T (BKSYSBUF "(\VAG2 ")
(BKSYSBUF (OCTALSTRING (\HILOC OBJECT)))
(BKSYSBUF "Q ")
(BKSYSBUF (OCTALSTRING (\LOLOC OBJECT)))
(BKSYSBUF "Q)"])
)
[DECLARE: EVAL@COMPILE
(RECORD SELECTABLEITEM (SELECTABLEITEMREGION COMMANDFN ITEMINFO ITEMINFOTYPE))
]
(RPAQQ 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 "30-Apr-85 16:05")
(* sets up a window that allows inspection.)
(DECLARE (SPECVARS WHERE))
(PROG ((ITEMTYPE (TYPENAME ITEM))
INSPECTINFO)
(RETURN (COND
(ASTYPE (* if ASTYPE is given, always inspect it as that type.
This provides a way of overriding macros.)
(INSPECT/DATATYPE ITEM ASTYPE WHERE))
[(SETQ INSPECTINFO (for IMACRO in INSPECTMACROS
when (COND
[(LISTP (CAR IMACRO))
(COND
((EQ (CAAR IMACRO)
(QUOTE FUNCTION))
(APPLY* (CADAR IMACRO)
ITEM))
(T (ERROR "ERROR in INSPECTMACROS specification"
IMACRO]
(T (EQ (CAR IMACRO)
ITEMTYPE)))
do (RETURN IMACRO)))
(COND
((LISTP (CDR INSPECTINFO)) (* inspect information is a list of arguments to
INSPECTW.CREATE)
(\APPLYINSPECTMACRO ITEM (CDR INSPECTINFO)
WHERE))
(T (* if inspect information is an atom, apply it to the
ITEM.)
(APPLY* (CDR INSPECTINFO)
ITEM
(CAR INSPECTINFO)
WHERE]
(ITEM (SELECTQ ITEMTYPE
(LITATOM (INSPECT/ATOM ITEM NIL WHERE))
(LISTP (* find out how to inspect the list.)
(INSPECT/LISTP ITEM WHERE))
(ARRAYP (INSPECT/ARRAY ITEM NIL WHERE))
(HARRAYP (INSPECT/HARRAYP ITEM WHERE))
(BITMAP (INSPECT/BITMAP ITEM WHERE))
(CCODEP (INSPECTCODE ITEM WHERE))
(NIL (INSPECT/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 "30-Apr-85 16:40")
(* 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))
[(EQUAL ASPECTS (QUOTE (VARS)))
(RETURN (INSPECT (EVALV ATM]
([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 STKP WINDOW) (* bvm: "24-Jun-85 18:00")
(* calls an editor on function ATM. STKP and WINDOW are the stack pointer and window of the break in which this
inspect command was called)
(LET ((EDITOR (SELECT.FNS.EDITOR ATM))
FRAME CODEBASE PROC)
(SELECTQ EDITOR
(NIL NIL)
[INSPECTCODE (COND
([AND (STACKP STKP)
(NOT (fetch (FX INVALIDP) of (SETQ FRAME (fetch (STACKP EDFXP)
of STKP]
(INSPECTCODE (COND
((EQ (fetch (LITATOM DEFPOINTER) of ATM)
(SETQ CODEBASE (fetch (FX FNHEADER) of FRAME)))
ATM)
(T
(* Function executing in this frame is not the one in the definition cell of its name, so fetch the real code.
Have to pass a CCODEP)
(create ARRAYP
BASE ← CODEBASE
LENGTH ←(UNFOLD (\#BLOCKDATACELLS CODEBASE)
BYTESPERCELL)
TYP ← \ST.CODE)))
NIL NIL NIL (fetch (FX PC) of FRAME)))
(T (INSPECTCODE ATM]
(COND
([AND WINDOW (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS]
(* Enter the editor in the process that has the break)
(PROCESS.APPLY PROC EDITOR (LIST ATM)))
(T (APPLY* EDITOR ATM])
(SELECT.FNS.EDITOR
[LAMBDA (FN) (* bvm: "20-Jun-85 12:29")
(* gives the user a menu choice of editors.)
(MENU (create MENU
ITEMS ←[APPEND [COND
((CCODEP FN)
(QUOTE ((InspectCode (QUOTE INSPECTCODE)
"Shows the compiled code."]
(QUOTE ((DisplayEdit (QUOTE DF)
"Edit it with the display editor")
(TtyEdit (QUOTE EF)
"Edit it with the standard editor"]
CENTERFLG ← T])
(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 LVFLG RADIX PC CODEPRINTER) (* bvm: "20-Jun-85 12:43")
(* creates a window that shows the compiled code of a
function.)
(COND
((GETD (QUOTE OPENTEXTSTREAM)) (* Use smarter inspector)
(\TEDIT.INSPECTCODE FN WHERE LVFLG RADIX PC CODEPRINTER))
(T (COND
((NOT (CCODEP FN))
(ERROR "Not a compiled function" FN)))
(LET [(WINDOW (DECODE.WINDOW.ARG WHERE 400 320 (CONCAT FN " Code Window"]
(WINDOWPROP WINDOW (QUOTE DATUM)
FN)
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION \INSPECT/CODE/REPAINTFN))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION \INSPECT/CODE/RESHAPEFN))
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN)) (* call the reshapefn to note the upper left corner and
the extent.)
(\INSPECT/CODE/RESHAPEFN WINDOW])
(\TEDIT.INSPECTCODE
[LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* bvm: "24-Jun-85 18:04")
(PROG ((STREAM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
SEL)
(APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE))
FN LVFLG RADIX STREAM NIL PC)
[SETQ STREAM (OPENTEXTSTREAM STREAM [DECODE.WINDOW.ARG WHERE 400 280
(COND
((OR (LITATOM FN)
(NOT (CCODEP FN)))
(CONCAT "Code for " FN))
(T (CONCAT (COND
(PC "Code for frame ")
(T "CCODEP named "))
(fetch (CODEARRAY
FRAMENAME)
of FN]
NIL NIL (QUOTE (READONLY T PROMPTWINDOW DON'T]
(COND
((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1)))
(* Highlight location of PC)
(TEDIT.SETSEL STREAM (IMAX 1 (IDIFFERENCE SEL 100))
0
(QUOTE LEFT))
(TEDIT.NORMALIZECARET STREAM)))
(RETURN FN])
(\INSPECT/CODE/RESHAPEFN
[LAMBDA (WIN OLDIMAGE OLDREGION) (* rmk: "26-AUG-83 17:05")
(* reshapes a code inspection window.)
(* set the upper left corner for the repaintfn, call the
repaintfn and note the Y position for the extent.)
(PROG [WHEIGHT BOTTOM (FONT (fetch DDFONT of (fetch IMAGEDATA of (WINDOWPROP WIN (QUOTE DSP]
[WINDOWPROP WIN (QUOTE REGIONUPPERLEFT)
(create POSITION
XCOORD ← 0
YCOORD ←(SUB1 (IDIFFERENCE (SETQ WHEIGHT (WINDOWPROP WIN (QUOTE HEIGHT))
)
(FONTPROP FONT (QUOTE ASCENT]
(\INSPECT/CODE/REPAINTFN WIN)
(WINDOWPROP WIN (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←[SETQ BOTTOM (IPLUS (DSPYPOSITION NIL WIN)
(FONTPROP FONT (QUOTE ASCENT]
WIDTH ←(WINDOWPROP WIN (QUOTE WIDTH))
HEIGHT ←(IDIFFERENCE WHEIGHT BOTTOM])
(\INSPECT/CODE/REPAINTFN
[LAMBDA (WIN) (* rrb "16-JUL-82 09:56")
(* moves to the window's upper left corner and prints
the code for the function in WIN.)
(PROG [(UPPERLEFT (WINDOWPROP WIN (QUOTE REGIONUPPERLEFT]
(MOVETO (fetch (POSITION XCOORD) of UPPERLEFT)
(fetch (POSITION YCOORD) of UPPERLEFT)
WIN) (* should be changed to pass WIN as a parameter when
PRINTCODE is changed to take file argument.)
(PRINTCODE (WINDOWPROP WIN (QUOTE DATUM))
NIL 8 WIN])
(SELECT.LIST.INSPECTOR
[LAMBDA (LST) (* rrb "30-Apr-85 15:22")
(* gives the user a choice of how to edit a list.)
(MENU (create MENU
ITEMS ←[APPEND (QUOTE ((DisplayEdit (QUOTE DEDITE)
"Edit it with the display editor")
(TtyEdit (QUOTE STANDARDEDITE)
"Edit it with the standard editor")
(Inspect (QUOTE INSPECT/TOP/LEVEL/LIST)
"Inspect the top level with an inspect window")
("As a record" (QUOTE INSPECT/AS/RECORD)
"Prompts further for the record type of this LIST.")))
[COND
[(ALISTP LST)
(QUOTE (("As an ALIST" (QUOTE INSPECT/ALIST)
"Inspects the list as a A-List"]
((PROPLISTP LST)
(QUOTE (("As a PLIST" (QUOTE INSPECT/PLIST)
"Inspects the list as a property list."]
(PROG [(RECDEC (RECLOOK (CAR LST]
(RETURN (COND
((AND RECDEC (EQ (CAR RECDEC)
(QUOTE TYPERECORD)))
(* this is likely to be an instance of the typed
record.)
(CONS (LIST (CONCAT "As a " (CAR LST))
(QUOTE (QUOTE INSPECT/TYPERECORD))
(CONCAT
"Inspects the selected list as an instance of "
(CAR LST]
CENTERFLG ← T])
(STANDARDEDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* rrb "27-AUG-82 13:59")
(* version of EDITE that always calls the standard
editor.)
(RESETFORM (EDITMODE (QUOTE STANDARD))
(EDITE EXPR COMS ATM TYPE IFCHANGEDFN])
(NTHTOPLEVELELT
[LAMBDA (LST N) (* rrb " 5-FEB-82 07:53")
(* returns the Nth element.)
(COND
((EQ N (QUOTE ...))
(CDR (LAST LST)))
((EQ N (QUOTE &&))
(NTH LST (ADD1 MAXINSPECTCDRLEVEL)))
(T (CAR (NTH LST N])
(SETNTHTOPLEVELELT
[LAMBDA (LST N NEWVALUE) (* rrb " 5-FEB-82 07:54")
(* sets the nth top level eltment of LST to NEWVALUE)
(* undoable but it will almost certainly be undone in
the wrong place.)
(COND
((EQ N (QUOTE ...))
(/RPLACD (LAST LST)
NEWVALUE))
((EQ N (QUOTE &&))
(PROMPTPRINT "Can't set the tail.") (* return current value for printing.)
(NTH LST (ADD1 MAXINSPECTCDRLEVEL)))
(T (PROG NIL
(RETURN (/RPLACA (OR (NTH LST N)
(RETURN))
NEWVALUE])
(DEDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* rrb "11-DEC-81 09:50")
(RESETFORM (EDITMODE (QUOTE DISPLAY))
(EDITE EXPR COMS ATM TYPE IFCHANGEDFN])
(FINDRECDECL
[LAMBDA (DATUM) (* rrb "19-DEC-81 14:34")
(* find the datatype declaration for a datum.)
(PROG (TYPENAME DECL)
(RETURN (AND [SETQ DECL (RECLOOK (SETQ TYPENAME (COND
((LISTP DATUM)
(CAR DATUM))
(T (TYPENAME DATUM]
(TYPENAMEP DATUM TYPENAME)
DECL])
(FINDSYSRECDECL
[LAMBDA (DATUM) (* rrb "19-DEC-81 14:01")
(* find the datatype declaration for a if it is a system
datatype.)
(PROG (TYPENAME DECL)
(AND (SETQ TYPENAME (TYPENAME DATUM))
(SETQ DECL (SYSRECLOOK1 TYPENAME))
(TYPENAMEP DATUM TYPENAME)
(RETURN DECL])
(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) (* bvm: "24-Jun-85 18:00")
(* property command function for inspect windows onto
stack frames. Recognizes certain PROP as function
names.)
(COND
((AND (LISTP PROP)
(NULL (CDR PROP)))
(INSPECT/AS/FUNCTION VALUE DATUM WINDOW))
(T (DEFAULT.INSPECTW.VALUECOMMANDFN VALUE PROP DATUM WINDOW])
(PROPERTIES.FROM.FRAMESPEC
[LAMBDA (POS LOTSFLG EMBEDDEDCALLFLG) (* lmm " 6-Jan-85 18:48")
(* returns a list of properties suitable for an inspect window which prints the frame name{s} and arguments from a
stack pointer or list of stack pointers.)
(COND
[(LISTP POS) (* for the list case, note the number of the frame in
the list.)
(for STKPOS in POS as N from 1 join (for X in (PROPERTIES.FROM.FRAMESPEC STKPOS LOTSFLG T)
collect (CONS N X]
(T (PROG ((NARGS (STKNARGS POS T) (* in Interlisp-D, STKNARGS takes an extra arg which
means to include internally bound names as well as
those in the basic frame)
)
(NARGS1 (STKNARGS POS))
(FNNAME (STKNAME POS))
VALUE VALUEMARGIN ARGNAMES ARGLST (NOVALUE ""))
[AND LOTSFLG (LITATOM FNNAME)
(CCODEP FNNAME)
(SETQ ARGLST (LISTP (SMARTARGLIST FNNAME]
[SETQ ARGNAMES (for I from 1 to NARGS collect
(PROG1 (OR (STKARGNAME I POS)
(AND (CAR ARGLST)
(PACK* "*" (CAR ARGLST)
"*"))
(AND LOTSFLG (PACK* (QUOTE *var*)
I)))
(SETQ ARGLST (CDR ARGLST]
(RETURN (CONS (LIST FNNAME)
(for ARGN from 1 to NARGS as ARGNAME in ARGNAMES
when [AND ARGNAME (NEQ NOVALUE (SETQ VALUE (STKARG ARGN POS NOVALUE]
collect (LIST ARGNAME ARGN])
(PROPERTIES.FROM.FRAMESPEC.LOTS
[LAMBDA (POS)
(PROPERTIES.FROM.FRAMESPEC POS T])
(WINDOWTITLE2
[LAMBDA (DATUM WINDOW) (* rrb " 7-AUG-83 19:18")
(* returns the current title of the window.
Used to compute the title of the back trace frame
window.)
(WINDOWPROP WINDOW (QUOTE TITLE])
(NEWSTKNPVARS
[LAMBDA (POS)
(IDIFFERENCE (STKNARGS POS T)
(STKNARGS POS])
(MYSMARTARGLIST
[LAMBDA (FN NARGS)
(* version of SMARTARGLIST which doesn't generate an error if FN is not a function. It creates a dummy arglist
NARGS long. This is used because some of the frames such as *ENV* don't correspond to functions.)
(COND
((FNCHECK FN T)
(SMARTARGLIST FN))
(T (for I from 1 to NARGS collect (PACK* "*arg" I])
(FETCHSTKARG
[LAMBDA (FRAMESPEC WHICHSPEC) (* rrb " 8-AUG-83 17:06")
(* retrieval function for argument positions)
(COND
((NULL (CDR WHICHSPEC)) (* this is a dummy which is a function name.
it has no value)
(CAR WHICHSPEC))
((LISTP FRAMESPEC)
(FETCHSTKARG (CAR (NTH FRAMESPEC (CAR WHICHSPEC)))
(CDR WHICHSPEC)))
((LISTP WHICHSPEC) (* CAR is name, CADR is offset)
(STKARG (CADR WHICHSPEC)
FRAMESPEC))
(T (* WHICHSPEC is the name)
(STKARG WHICHSPEC FRAMESPEC])
(\RELEASEWINDOWSTKDATUM
[LAMBDA (WINDOW) (* rrb " 7-AUG-83 19:54")
(* Releases the previously stored stack pointer in
WINDOW.)
(PROG (X)
[COND
([STACKP (SETQ X (WINDOWPROP WINDOW (QUOTE DATUM]
(RELSTK X))
((LISTP X)
(for STKPTR in X do (RELSTK STKPTR]
(RETURN X])
(BTITEMWINDOWCLOSEFN
[LAMBDA (W) (* rrb " 7-AUG-83 19:55")
(* close function for a backtrace frame item window.
Releases the stack pointers and removes the selectable
items.)
(\RELEASEWINDOWSTKDATUM W)
(WINDOWPROP W (QUOTE SELECTABLEITEMS)
NIL])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD ARGSPEC (STKPTR . ARGN))
]
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(MOVD? (QUOTE NEWSTKNPVARS)
(QUOTE STKNPVARS))
(MOVD? (QUOTE EDITE)
(QUOTE \BEFOREINSPECTEDITE))
(MOVD (QUOTE \INSPECTEDITE)
(QUOTE EDITE))
)
(PUTPROPS INSPECT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4445 27399 (INSPECTW.CREATE 4455 . 7521) (INSPECTW.REPAINTFN 7523 . 10349) (
INSPECTW.REDISPLAY 10351 . 14876) (\INSPECTW.VALUE.MARGIN 14878 . 15299) (INSPECTW.REPLACE 15301 .
15825) (INSPECTW.SELECTITEM 15827 . 16655) (\INSPECTW.REDISPLAYPROP 16657 . 18323) (INSPECTW.FETCH
18325 . 18761) (INSPECTW.PROPERTIES 18763 . 19306) (DECODE.WINDOW.ARG 19308 . 20599) (
DEFAULT.INSPECTW.PROPCOMMANDFN 20601 . 22174) (DEFAULT.INSPECTW.VALUECOMMANDFN 22176 . 23225) (
DEFAULT.INSPECTW.TITLECOMMANDFN 23227 . 24265) (\SELITEM.FROM.PROPERTY 24267 . 24676) (
\INSPECT.COMPUTE.TITLE 24678 . 25393) (LEVELEDFORM 25395 . 26016) (MAKEWITHINREGION 26018 . 27397)) (
27400 41249 (ITEMW.REPAINTFN 27410 . 28266) (\ITEM.WINDOW.BUTTON.HANDLER 28268 . 28720) (
\ITEM.WINDOW.SELECTION.HANDLER 28722 . 31233) (\INSPECTW.COMMAND.HANDLER 31235 . 33746) (
ITEM.WINDOW.SET.STACK.ARG 33748 . 35521) (REPLACESTKARG 35523 . 36409) (IN/ITEM? 36411 . 36875) (
\ITEMW.DESELECTITEM 36877 . 37188) (\ITEMW.SELECTITEM 37190 . 37499) (\ITEMW.CLEARSELECTION 37501 .
37900) (\ITEMW.FLIPITEM 37902 . 38369) (PRINTANDBOX 38371 . 40239) (PRINTATBOX 40241 . 40789) (
ITEMOFPROPERTYVALUE 40791 . 41247)) (41250 44259 (\ITEM.WINDOW.COPY.HANDLER 41260 . 42758) (
\ITEMW.FLIPCOPY 42760 . 43167) (BKSYSBUF.GENERAL 43169 . 44257)) (44647 75048 (INSPECT 44657 . 46706)
(\APPLYINSPECTMACRO 46708 . 47458) (INSPECT/ATOM 47460 . 50300) (SELECT.ATOM.ASPECT 50302 . 50959) (
INSPECT/AS/FUNCTION 50961 . 52459) (SELECT.FNS.EDITOR 52461 . 53056) (INSPECT/BITMAP 53058 . 53804) (
INSPECT/DATATYPE 53806 . 55231) (INSPECTABLEFIELDNAMES 55233 . 55743) (REMOVEDUPS 55745 . 55897) (
INSPECT/ARRAY 55899 . 56587) (INSPECT/TOP/LEVEL/LIST 56589 . 57276) (INSPECT/PROPLIST 57278 . 57986) (
NONSYSPROPNAMES 57988 . 58339) (INSPECT/HARRAYP 58341 . 58883) (HARRAYKEYS 58885 . 59273) (
INSPECTW.GETHASH 59275 . 59466) (INSPECTW.PUTHASH 59468 . 59666) (INSPECT/LISTP 59668 . 60025) (ALISTP
60027 . 60274) (PROPLISTP 60276 . 60825) (INSPECT/ALIST 60827 . 61208) (ASSOCGET 61210 . 61459) (
/ASSOCPUT 61461 . 61683) (INSPECT/PLIST 61685 . 62074) (INSPECT/TYPERECORD 62076 . 62349) (
INSPECT/AS/RECORD 62351 . 63083) (INSPECT/AS/BLOCKRECORD 63085 . 63787) (INSPECTCODE 63789 . 64887) (
\TEDIT.INSPECTCODE 64889 . 66043) (\INSPECT/CODE/RESHAPEFN 66045 . 67125) (\INSPECT/CODE/REPAINTFN
67127 . 67832) (SELECT.LIST.INSPECTOR 67834 . 69381) (STANDARDEDITE 69383 . 69725) (NTHTOPLEVELELT
69727 . 70076) (SETNTHTOPLEVELELT 70078 . 70788) (DEDITE 70790 . 70982) (FINDRECDECL 70984 . 71424) (
FINDSYSRECDECL 71426 . 71860) (PPVINW 71862 . 71957) (\INSPECTEDITE 71959 . 72356) (
RDTBL\NONOTHERCODES 72358 . 72707) (GETSYNTAXPROP 72709 . 72912) (SETSYNTAXPROP 72914 . 73123) (
GETTTBLPROP 73125 . 74056) (SETTTBLPROP 74058 . 75046)) (75958 81280 (STACKFRAMEPROPPRINTFN 75968 .
76448) (STACKFRAMEVALUECOMMANDFN 76450 . 76980) (PROPERTIES.FROM.FRAMESPEC 76982 . 78715) (
PROPERTIES.FROM.FRAMESPEC.LOTS 78717 . 78807) (WINDOWTITLE2 78809 . 79156) (NEWSTKNPVARS 79158 . 79244
) (MYSMARTARGLIST 79246 . 79646) (FETCHSTKARG 79648 . 80403) (\RELEASEWINDOWSTKDATUM 80405 . 80862) (
BTITEMWINDOWCLOSEFN 80864 . 81278)))))
STOP