(FILECREATED "18-Jul-86 18:06:58" {ERIS}<LISPCORE>SOURCES>WBREAK.;20 40779
changes to: (FNS GETBREAKWINDOW CREATETRACEWINDOW)
(VARS WBREAKCOMS)
previous date: " 3-Jun-86 15:25:40" {ERIS}<LISPCORE>SOURCES>WBREAK.;19)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT WBREAKCOMS)
(RPAQQ WBREAKCOMS
[(FNS WBREAK \WINDOWBREAK1A CREATETRACEWINDOW GETBREAKWINDOW \BREAKTITLEABBREV \NEARBYREGION
SETBREAKTTY RELEASEBREAKWINDOW)
(FNS BACKTRACEITEMWINDOW BREAKWINDOWEVENTFN BKITEMSELECTEDFN BREAKWCLOSEFN DISPBAKTRACE
DISPBAKTRACE1 REGIONNEXTTO)
(DECLARE: DOCOPY DONTEVAL@LOAD
(INITVARS (BTPRINTLEVEL 3)
(WIZARDFLG)
(BREAKREGIONSPEC (create REGION LEFT ← 17 BOTTOM ← -120 WIDTH ← 400 HEIGHT ←
120))
(TRACEREGION (create REGION LEFT ← 8 BOTTOM ← 3 WIDTH ← 547 HEIGHT ← 310))
[BREAKMENUITEMS (QUOTE ((!EVAL (QUOTE !EVAL)
"Evaluates the break expression without recursive breaks"
)
(EVAL (QUOTE EVAL)
"Evaluates the break expression")
(EDIT (QUOTE EDIT)
"Calls the editor on the selected frame form")
(revert (QUOTE revert)
"Unwinds the stack to the selected frame")
(↑ (QUOTE ↑)
"Exits to the next higher break via (ERROR!)")
(proceed (QUOTE proceed)
"Returns control to a higher PROCEED-CASE")
(OK (QUOTE OK)
"Leaves the break, returning the value of the break expression"
)
(BT (QUOTE BT)
"Back trace of important functions in a menu")
(BT! (QUOTE BT!)
"Back trace of all functions in a menu")
(?= (QUOTE ?=)
"Prints the variables bound in the selected frame"]
(MaxBkMenuWidth 125)
(MaxBkMenuHeight 300)
(AUTOBACKTRACEFLG NIL)
(CLOSEBREAKWINDOWFLG T)
(TRACEWINDOW (CREATETRACEWINDOW NIL))
(BACKTRACEFONT)
(BreakMenu)))
(GLOBALVARS BREAKMENUITEMS BreakMenu BTPRINTLEVEL MaxBkMenuWidth MaxBkMenuHeight TRACEWINDOW
TRACEREGION BREAKREGIONSPEC)
(INITVARS (TTYSTREAMS))
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS BKMENUITEM))
(ADDVARS (WINDOWUSERFORMS (WBREAK T))
(ENDOFWINDOWUSERFORMS (WBREAK NIL)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (WBREAK T))
(ADDVARS (BREAKMACROS [DBT (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP]
(DBT! (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL NIL])
(DEFINEQ
(WBREAK
[LAMBDA (ONFLG) (* rrb "29-JUL-83 11:08")
(* starts and stops the window break package.
Returns the previous setting.)
(COND
[ONFLG (OR (MEMBER (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)
(/SET (QUOTE BREAKRESETFORMS)
(CONS (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)))
(OR (type? FONTDESCRIPTOR BACKTRACEFONT)
(SETQ BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
8)))
(OR (type? MENU BreakMenu)
(SETQ BreakMenu (create MENU
ITEMS ← BREAKMENUITEMS)))
(NOT (CHANGENAME (QUOTE BREAK1)
(QUOTE BREAK1A)
(QUOTE \WINDOWBREAK1A]
(T (AND (MEMBER (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)
(/SET (QUOTE BREAKRESETFORMS)
(REMOVE (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)))
(AND (CHANGENAME (QUOTE BREAK1)
(QUOTE \WINDOWBREAK1A)
(QUOTE BREAK1A))
T])
(\WINDOWBREAK1A
(LAMBDA (NBREAKS) (* lmm "17-Jan-86 20:27") (* binds the variables which hold the new and old tty display streams and process handles for the window break package and sets up the break window.) (* must be implemented as changename in BREAK1 because the break package expects variables such as LASTPOS to be bound at BREAK1A.) (* must have the argument NBREAKS so that functions called by it are taken to be inside of the break code not the user code.) (COND ((AND (ILESSP NBREAKS 0) (WFROMDS (TTYDISPLAYSTREAM))) (PROG ((BRKWINDOW (GETBREAKWINDOW BRKFN (IMINUS NBREAKS))) TTYSTREAMS) (DECLARE (SPECVARS BRKWINDOW TTYSTREAMS)) (COND ((WINDOWP BRKWINDOW) (* if there was not array space for a new window, none was created.) (SETQ TTYSTREAMS (CONS (TTYDISPLAYSTREAM) (WINDOWPROP BRKWINDOW (QUOTE DSP))))) (T (printout PROMPTWINDOW T "Ran out of space " "running in process '" (PROCESSPROP (THIS.PROCESS) (QUOTE NAME)) "' ") (COND ((NOT (HASTTYWINDOWP)) (* if this process doesn't have a tty then it is a background process that ran out of array space. Switch its tty to the PROMPT window because it should not have a process associated with it yet.) (WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN) NIL) (* clobber PAGEFULLFN so that when user does BT it doesn't just scroll off screen. This changes PROMPTWINDOW but with arrays full they shouldn't be in this sysout long anyway.) (printout PROMPTWINDOW "which does not have a TTY window." "Using PROMPTWINDOW as TTY window." T) (TTYDISPLAYSTREAM PROMPTWINDOW))))) (RETURN (BREAK1A NBREAKS)))) (T (* called from break within a break.) (BREAK1A NBREAKS))))
)
(CREATETRACEWINDOW
[LAMBDA (OPEN?) (* hdj "18-Jul-86 17:38")
(DECLARE (GLOBALVARS TRACEREGION))
(CREATEW TRACEREGION "Trace window" NIL (NOT OPEN?])
(GETBREAKWINDOW
[LAMBDA (BRKFN NBRKS) (* hdj "18-Jul-86 17:44")
(* * "returns the window that this break should use. If this is a trace break, it is the trace window. If the global break window is available, it should be used, otherwise one is created.")
(COND
[(AND (EQ BRKTYPE NIL)
(EQ (CAR BRKCOMS)
(QUOTE TRACE))) (* "tracing")
(COND
((AND TRACEWINDOW (OPENP TRACEWINDOW))
TRACEWINDOW)
(T (SETQ TRACEWINDOW (CREATETRACEWINDOW T]
(T (PROG (WINDOW ERRN) (*
"generate a new window close to the tty window.")
(COND
((MEMB (CAR (LISTP ERRORN))
(QUOTE (21 31))) (*
"arrays full or storage full error, don't try creating a break window.")
(RETURN NIL)))
(UNINTERRUPTABLY
(SETQ WINDOW (CREATEW (COND
((HASTTYWINDOWP)
(\NEARBYREGION (WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
(QUOTE REGION))
(COND
((REGIONP BREAKREGIONSPEC))
(T (*
"only happens if the user sets BREAKREGIONSPEC to a non-region.")
(CREATEREGION 20 -20 100 100)))
NBRKS))
(T (*
"in the case of break in a process that doesn't have a real tty yet. create one")
DEFAULTTTYREGION))
"BREAK WINDOW"))
(WINDOWPROP WINDOW (QUOTE BRKFN)
BRKFN) (* "set title for this break.")
[WINDOWPROP WINDOW (QUOTE TITLE)
(SELECTQ BRKTYPE
((NIL REVERT) (* "user break")
(COND
((AND (EQ BRKFN (QUOTE HELP))
(LISTP ERRORN)) (* "user called HELP")
(CONCAT "HELP: " (\BREAKTITLEABBREV (CAR (SETQ ERRN ERRORN)))
" "
(\BREAKTITLEABBREV (CADR ERRN))
" break:" NBRKS))
(T (CONCAT (\BREAKTITLEABBREV BRKFN)
" break: " NBRKS))))
(INTERRUPT (CONCAT "keyboard interrupt - " (\BREAKTITLEABBREV BRKFN)
" break: " NBRKS))
(COND
((EQ BRKFN (QUOTE HELP)) (* "HELP doesn't set the error number because there isn't any error number for help. so this special mechanism of using ERRORN arg from BREAK1 is necessary")
(*
"if the brktype is ERRORX this call came from HELP so use that in title.")
(CONCAT "SHOULDNT " ": " (\BREAKTITLEABBREV (CADR ERRORN))
" break:" NBRKS))
((EQ (CAR (SETQ ERRN (ERRORN)))
17) (* "ERROR break")
(CONCAT [\BREAKTITLEABBREV (CAR (SETQ ERRN (CADR ERRN]
": "
(\BREAKTITLEABBREV (CDR ERRN))
" ERROR break:" NBRKS))
(*DEBUGGED-CONDITION* (CONCAT (\BREAKTITLEABBREV (CONDITION-TYPE-OF
*DEBUGGED-CONDITION*
))
" - break: " NBRKS))
(T (CONCAT (\BREAKTITLEABBREV (CADR ERRN))
" - "
(ERRORSTRING (CAR ERRN))
" break: " NBRKS]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION BREAKWINDOWEVENTFN))
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION BREAKWCLOSEFN))
(WINDOWPROP WINDOW (QUOTE PROCESS)
(THIS.PROCESS)))
(RETURN WINDOW])
(\BREAKTITLEABBREV
[LAMBDA (BFN) (* lmm "12-Jan-85 12:35")
(* returns a small thing which can be CONCATed into a title for a break window. This keeps CONCAT from going into an
infinite loop if BRKFN happens to be a circular structure.)
(COND
((NLISTP BFN)
BFN)
(T (CONS (COND
((LISTP (CAR BFN))
(QUOTE &))
(T (CAR BFN)))
(COND
((SETQ BFN (CDR BFN))
(IF (LISTP BFN)
THEN [CONS (COND
((LISTP (CAR BFN))
(QUOTE &))
(T (CAR BFN)))
(COND
((SETQ BFN (CDR BFN))
(QUOTE (...]
ELSE BFN])
(\NEARBYREGION
(LAMBDA (REGION REGIONTEMPLATE N) (* kbr:
"26-Feb-86 01:15")
(* returns a region
that is close to the
given region on the
screen.)
(PROG (X WIDTH HEIGHT)
(RETURN (create REGION
LEFT ←(COND
((OR (IGREATERP (IPLUS (SETQ X (IPLUS (fetch (REGION LEFT)
of REGION)
(ITIMES (fetch
(REGION LEFT)
of
REGIONTEMPLATE
)
N)))
(SETQ WIDTH (fetch (REGION WIDTH)
of REGIONTEMPLATE)))
\CURSORDESTWIDTH)
(ILESSP X 0)) (* if it runs into the
right or left edge, move
it back.)
(IMOD X (IDIFFERENCE \CURSORDESTWIDTH WIDTH)))
(T X))
BOTTOM ←(COND
((OR (IGREATERP (IPLUS (SETQ X (IPLUS (fetch (REGION BOTTOM)
of REGION)
(ITIMES (fetch
(REGION BOTTOM)
of
REGIONTEMPLATE
)
N)))
(SETQ HEIGHT (fetch (REGION HEIGHT)
of REGIONTEMPLATE)))
\CURSORDESTHEIGHT)
(ILESSP X 0)) (* if it runs into the
bottom or top edge, move
it back.)
(IMOD X (IDIFFERENCE \CURSORDESTHEIGHT HEIGHT)))
(T X))
WIDTH ← WIDTH
HEIGHT ← HEIGHT)))))
(SETBREAKTTY
[LAMBDA (STREAMPAIR) (* bvm: " 6-Oct-85 15:39")
(* switches the TTYDISPLAYSTREAM to the break window on entry and to the previous tty displaystream on exit.
STREAMPAIR is a CONS of the old stream and break stream.)
(COND
(STREAMPAIR (* if STREAMPAIR is NIL, a break window was not
created because the system ran out of space so don't
futz with ttydisplaystream.)
(PROG ((OLDTTY (CAR STREAMPAIR))
(BREAKTTY (CDR STREAMPAIR))
X)
(SELECTQ BREAKSTATE
(ENTERING
(* associate pointer to break frame with the break window This is used so that the backtrace menu commands can set
LASTPOS in the context of the break)
[RELSTK (WINDOWPROP (WFROMDS BREAKTTY)
(QUOTE BREAKPOS)
(STKPOS (QUOTE BREAK1A]
(* Have to be sure to release any old value that might
have been there. BREAK can set ENTERING more than
once)
[COND
((OR (MEMB AUTOBACKTRACEFLG (QUOTE
(ALWAYS ALWAYS!)))
(AND BRKTYPE AUTOBACKTRACEFLG))
(* do auto backtrace unless this is a user break)
(SETQ BRKCOMS (CONS (SELECTQ
AUTOBACKTRACEFLG
((BT! ALWAYS!)
(QUOTE
DBT!))
(QUOTE DBT))
BRKCOMS]
(TTYDISPLAYSTREAM BREAKTTY))
[REENTERING (* check for the case of the expression that was
evaluated having changed the ttydisplaystream.)
(COND
([AND (NEQ (SETQ X (TTYDISPLAYSTREAM
BREAKTTY))
OLDTTY)
(NOT (AND (EQ OLDTTY
\DEFAULTTTYDISPLAYSTREAM)
(NEQ X BREAKTTY]
(* return the TTYDISPLAYSTREAM as returned from the
evaluation if it is different from what it was set to
by the EVALUATING breakstate.)
(RETURN (CONS (TTYDISPLAYSTREAM BREAKTTY)
BREAKTTY]
((LEAVING REVERTING RESTORE)
(TTYDISPLAYSTREAM OLDTTY)
(* Do this first so that caret comes down before the
window closes)
(RELEASEBREAKWINDOW BREAKTTY OLDTTY))
(EVALUATING (* if the old tty is the default, this process doesn't
have any T stream yet; use the break window.)
(OR (EQ OLDTTY \DEFAULTTTYDISPLAYSTREAM)
(TTYDISPLAYSTREAM OLDTTY)))
(SHOULDNT))
(RETURN STREAMPAIR])
(RELEASEBREAKWINDOW
[LAMBDA (BRKDS PREVIOUSDS) (* rrb "16-Mar-84 18:22")
(* releases a break window)
(PROG ((WINDOW (WFROMDS BRKDS))) (* close backtrace window if there is one.)
(COND
((EQ WINDOW TRACEWINDOW)
(RETURN WINDOW))
((AND (NOT CLOSEBREAKWINDOWFLG)
(OPENWP WINDOW))
(WINDOWPROP WINDOW (QUOTE TITLE)
" BREAK WINDOW") (* remove process link before calling close fn.)
))
(WINDOWPROP WINDOW (QUOTE PROCESS)
NIL) (* releases the windows BREAKPOS)
(RELSTK (WINDOWPROP WINDOW (QUOTE BREAKPOS)
NIL)) (* clobber the previously set fields.)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION TOTOPW))
[COND
(CLOSEBREAKWINDOWFLG (CLOSEW WINDOW))
(T (* close attached windows even if not the main break
window.)
(for ATW in (ATTACHEDWINDOWS WINDOW)
do (CLOSEW ATW)
(DETACHWINDOW ATW]
(RETURN])
)
(DEFINEQ
(BACKTRACEITEMWINDOW
[LAMBDA (TTYWINDOW) (* rrb "26-Apr-84 14:18")
(* returns a backtrace frame window)
(PROG (TTYREGION BTWINDOW)
(COND
((SETQ BTWINDOW (for ATW in (ATTACHEDWINDOWS TTYWINDOW)
when (MEMB (FUNCTION BTITEMWINDOWCLOSEFN)
(WINDOWPROP ATW (QUOTE CLOSEFN)))
do (* test for an attached window that is the frame
window.)
(RETURN ATW)))
(\RELEASEWINDOWSTKDATUM BTWINDOW))
(T (SETQ TTYREGION (WINDOWREGION TTYWINDOW)) (* create frame window and set its fixed properties.)
(SETQ BTWINDOW (CREATEW (REGIONNEXTTO TTYREGION NIL 150 (QUOTE TOP))
"Back Trace Frame Window"))
(* keep size of frame window fixed so that tty portion
can grow. No very elegant way to do this but ...)
(WINDOWPROP BTWINDOW (QUOTE MAXSIZE)
(QUOTE (300 . 150))) (* save backtrace window with window.)
(WINDOWPROP BTWINDOW (QUOTE PROCESS)
(WINDOWPROP TTYWINDOW (QUOTE PROCESS)))
(WINDOWADDPROP BTWINDOW (QUOTE CLOSEFN)
(FUNCTION BTITEMWINDOWCLOSEFN)
T)))
(RETURN BTWINDOW])
(BREAKWINDOWEVENTFN
[LAMBDA (WINDOW) (* amd "15-May-86 15:53")
(* handles a button in a break window)
(AND (LASTMOUSESTATE MIDDLE)
(SELECTQ [MENU (COND
((type? MENU BreakMenu)
BreakMenu)
(T (SETQ BreakMenu (create MENU
ITEMS ← BREAKMENUITEMS]
(!EVAL (CLEARBUF T)
(BKSYSBUF "!EVAL
!VALUE
"))
(EVAL (CLEARBUF T)
(BKSYSBUF "EVAL
"))
(EDIT (CLEARBUF T)
(BKSYSBUF "EDIT
"))
(revert (CLEARBUF T)
(BKSYSBUF "REVERT @
"))
(proceed (BKSYSBUF "(PROCEED-USING-MENU)"))
(↑ (CLEARBUF T)
(BKSYSBUF "↑
"))
(OK (CLEARBUF T)
(BKSYSBUF "OK
"))
(BT (DISPBAKTRACE (WINDOWPROP WINDOW (QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP))
WINDOW))
(BT! (DISPBAKTRACE (WINDOWPROP WINDOW (QUOTE BREAKPOS))
NIL NIL WINDOW))
(?= (CLEARBUF T)
(BKSYSBUF "?=
"))
NIL])
(BKITEMSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* rrb "26-Apr-84 14:10")
(* selection function for back trace window.
It grays the selected frame, sets LASTPOS to it and
prints it in a window.)
(PROG (OLDITEM TTYWINDOW BKPOS POS POSITIONS FRAMEWINDOW (FRAMESPECN (fetch (BKMENUITEM
BKMENUINFO)
of ITEM)))
(COND
((SETQ OLDITEM (fetch (MENU MENUUSERDATA) of MENU))
(MENUDESELECT OLDITEM MENU)))
(MENUSELECT ITEM MENU)
(SETQ BKPOS (WINDOWPROP (SETQ TTYWINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(QUOTE BREAKPOS))) (* FRAMESPECN is a number offset from BKPOS of the frame
or a dotted pair of two such numbers for a group of
frames.)
(SETQ FRAMEWINDOW (INSPECTW.CREATE [COND
((NUMBERP FRAMESPECN)
(SETQ POS (STKNTH FRAMESPECN BKPOS)))
(T (* multiple frame stack name.)
(SETQ POS (STKNTH (CAR FRAMESPECN)
BKPOS))
(* set title and save first frame pointer for LASTPOS.)
(for I from (CAR FRAMESPECN) to (CDR FRAMESPECN)
by -1
collect
(* collect the frame pointer)
(STKNTH I BKPOS]
(COND
((EQ BUTTON (QUOTE MIDDLE))
(FUNCTION PROPERTIES.FROM.FRAMESPEC.LOTS))
(T (FUNCTION PROPERTIES.FROM.FRAMESPEC)))
(FUNCTION FETCHSTKARG)
(FUNCTION REPLACESTKARG)
NIL
(FUNCTION STACKFRAMEVALUECOMMANDFN)
NIL
(CONCAT (STKNAME POS)
" Frame")
NIL
(BACKTRACEITEMWINDOW TTYWINDOW)
(FUNCTION STACKFRAMEPROPPRINTFN)))
[COND
((NOT (WINDOWPROP FRAMEWINDOW (QUOTE MAINWINDOW)))
(ATTACHWINDOW FRAMEWINDOW TTYWINDOW (COND
([IGREATERP (fetch (REGION BOTTOM) of (WINDOWPROP FRAMEWINDOW
(QUOTE REGION)))
(fetch (REGION BOTTOM) of (WINDOWPROP TTYWINDOW
(QUOTE REGION]
(QUOTE TOP))
(T (QUOTE BOTTOM)))
NIL
(QUOTE LOCALCLOSE))
(WINDOWADDPROP FRAMEWINDOW (QUOTE CLOSEFN)
(FUNCTION DETACHWINDOW]
[COND
((NEQ POS (EVALV (QUOTE LASTPOS)
BKPOS)) (* smash the value of LASTPOS in the break window
position to point to selected frame)
(STKNTH 0 POS (EVALV (QUOTE LASTPOS)
BKPOS]
(RETURN])
(BREAKWCLOSEFN
[LAMBDA (W) (* rrb " 6-Apr-84 11:40")
(* releases the windows BREAKPOS)
(RELSTK (WINDOWPROP W (QUOTE BREAKPOS)
NIL))
(PROG ((PROC (WINDOWPROP W (QUOTE PROCESS)
NIL)))
(COND
([AND (PROCESSP PROC)
(EQ W (WFROMDS (PROCESS.TTY PROC]
(COND
((EQ PROC (THIS.PROCESS)) (* don't flush the process if it is the process that is
executing this function or the window won't actually get
closed.)
(* try the hack of unreading a command to leave the
break.)
(CLEARBUF T)
(BKSYSBUF "↑
") (* return DON'T because the window will be closed by the
↑)
(WINDOWDELPROP W (QUOTE CLOSEFN)
(QUOTE BREAKWCLOSEFN))
(RETURN (QUOTE DON'T)))
(T (EQ (PROCESS.EVAL PROC (QUOTE (STKNAME -3))
T)
(QUOTE \TTYBACKGROUND)) (* if the process associated with this window has its
tty as this window and is tty waiting, flush it.)
(PROCESS.EVAL PROC (QUOTE (\BREAKSTOP])
(DISPBAKTRACE
[LAMBDA (IPOS EPOS SKIPFNS TTYWINDOW) (* rrb "20-Jun-84 18:07")
(* version of BAKTRACE that builds a display data
structure and sets up a backtrace window.)
(PROG [BTW BKMENU TTYREGION (TTYWINDOW (OR TTYWINDOW (WFROMDS (TTYDISPLAYSTREAM]
(SETQ BKMENU (create MENU
ITEMS ←(DISPBAKTRACE1 IPOS EPOS SKIPFNS)
WHENSELECTEDFN ←(FUNCTION BKITEMSELECTEDFN)
MENUOUTLINESIZE ← 0
MENUFONT ←[COND
((type? FONTDESCRIPTOR BACKTRACEFONT)
BACKTRACEFONT)
((SETQ BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
8]
MENUCOLUMNS ← 1))
(SETQ TTYREGION (WINDOWPROP TTYWINDOW (QUOTE REGION)))
[COND
((SETQ BTW (for ATW in (ATTACHEDWINDOWS TTYWINDOW)
when (AND (SETQ BTW (WINDOWPROP ATW (QUOTE MENU)))
(EQ (fetch (MENU WHENSELECTEDFN) of (CAR BTW))
(FUNCTION BKITEMSELECTEDFN)))
do (* test for an attached window that has a backtrace menu
in it.)
(RETURN ATW))) (* if there is already a backtrace window, delete the
old menu from it.)
(DELETEMENU (CAR (WINDOWPROP BTW (QUOTE MENU)))
NIL BTW)
(WINDOWPROP BTW (QUOTE EXTENT)
NIL)
(CLEARW BTW))
([SETQ BTW (CREATEW (REGIONNEXTTO (WINDOWPROP TTYWINDOW (QUOTE REGION))
(WIDTHIFWINDOW (IMIN (fetch (MENU IMAGEWIDTH)
of BKMENU)
MaxBkMenuWidth))
(fetch (REGION HEIGHT) of TTYREGION)
(QUOTE LEFT] (* put bt window at left of TTY window unless ttywindow
is near left edge.)
(ATTACHWINDOW BTW TTYWINDOW (COND
((IGREATERP (fetch (REGION LEFT) of (WINDOWPROP BTW (QUOTE REGION)))
(fetch (REGION LEFT) of TTYREGION))
(QUOTE RIGHT))
(T (QUOTE LEFT)))
NIL
(QUOTE LOCALCLOSE))
(WINDOWADDPROP BTW (QUOTE CLOSEFN)
(FUNCTION DETACHWINDOW))
(* put process on bt menu so that button clicks will switch tty and so that it is available for frame inspect
window to grab and pass to edit calls.)
(WINDOWPROP BTW (QUOTE PROCESS)
(WINDOWPROP TTYWINDOW (QUOTE PROCESS]
(* position menu so that the top of the stack is at the
top of the menu.)
[ADDMENU BKMENU BTW (create POSITION
XCOORD ← 0
YCOORD ←(IDIFFERENCE (WINDOWPROP BTW (QUOTE HEIGHT))
(fetch (MENU IMAGEHEIGHT) of BKMENU]
(RETURN BTW])
(DISPBAKTRACE1
[LAMBDA (IPOS EPOS SKIPFNS) (* bvm: " 9-MAY-82 00:00")
(* version of BAKTRACE that builds a display data
structure.)
(PROG ((POS (STKNTH 0 IPOS))
(N 0)
FN X Y Z DISPBAKTRACELIST)
(AND (NEQ CLEARSTKLST T)
(SETQ CLEARSTKLST (CONS POS CLEARSTKLST)))
(* POS is used as a scratch-position. N is an offset from FROM. whenever baktrace needs to look at a stkname or
stack position, it (re) uses POS and computes (STKNTH N IPOS POS).)
SKIPLP
(COND
((MEMB (STKNAME POS)
(QUOTE (BREAK1A \WINDOWBREAK1A BREAK1)))
(* pop BREAK1A entry off stack. It is needed because it is the binding frame for LASTPOS but it should not appear
in the back trace)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)
(GO SKIPLP)))
(COND
((AND (EQ (STKNAME POS)
(QUOTE \EVALFORM))
(EQ (CAR (LISTP (STKARG 1 POS)))
(QUOTE BREAK1))) (* Interpreter frame for BREAK1 entry)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)))
SKIP2LP
(COND
((MEMB (STKNAME POS)
(QUOTE (\EVALA EVALA))) (* Skip funny EVALA entry to break)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)
(GO SKIP2LP)))
LP (SETQ FN (STKNAME POS))
[COND
([AND (SETQ X (FASSOC FN BAKTRACELST))
(COND
((ATOM (SETQ Z (CADR X)))
(SETQ Y (BAKTRACE1 (CDDR X)
N IPOS POS)))
(T (SOME (CDR X)
(FUNCTION (LAMBDA (X)
(SETQ Z (CAR X))
(SETQ Y (BAKTRACE1 (CDR X)
N IPOS POS]
(* BAKTRACELST allows grouping of many function frames
under a single heading.)
(* HITTOKEN is either the fn offset or a dotted pair of
first and last.)
[COND
(Z (push DISPBAKTRACELIST (create BKMENUITEM
LABEL ← Z
BKMENUINFO ←(CONS N Y]
(SETQ N Y))
[(AND SKIPFNS (SOME SKIPFNS (FUNCTION (LAMBDA (SKIPFN)
(APPLY* SKIPFN POS]
(T (push DISPBAKTRACELIST (create BKMENUITEM
LABEL ←(COND
((LISTP FN)
(* LAMBDA expression is sometimes returned as STKNAME)
(CAR FN))
(T FN))
BKMENUINFO ← N]
(COND
((AND (SETQ POS (STKNTH (SETQ N (SUB1 N))
IPOS POS))
(NOT (EQP POS EPOS)))
(GO LP)))
(RELSTK POS)
(RETURN (DREVERSE DISPBAKTRACELIST])
(REGIONNEXTTO
(LAMBDA (REGION WIDTH HEIGHT WHERE INTERNALFLG) (* kbr:
"26-Feb-86 01:18")
(* returns the region that is next to REGION and has a width of WIDTH
and a height of HEIGHT. WHERE can be TOP BOTTOM LEFT or RIGHT.
If the region would not fit on the screen it is put on the opposite of
WHERE.)
(PROG (NLFT NBTM RLEFT RBOTTOM RWIDTH RHEIGHT)
(SETQ RLEFT (fetch (REGION LEFT) of REGION))
(SETQ RBOTTOM (fetch (REGION BOTTOM) of REGION))
(SETQ RWIDTH (fetch (REGION WIDTH) of REGION))
(SETQ RHEIGHT (fetch (REGION HEIGHT) of REGION))
(OR WIDTH (SETQ WIDTH RWIDTH))
(OR HEIGHT (SETQ HEIGHT RHEIGHT))
(SELECTQ WHERE
(TOP (COND
((IGREATERP (IPLUS (SETQ NBTM (fetch (REGION TOP) of REGION))
HEIGHT)
\CURSORDESTHEIGHT)
(COND
(INTERNALFLG (* top was tried since
bottom wouldn't fit)
(SETQ NBTM 0))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE BOTTOM)
T)))))
(T (SETQ NBTM (ADD1 NBTM))))
(SETQ NLFT RLEFT))
(BOTTOM (COND
((ILESSP (SETQ NBTM (IDIFFERENCE RBOTTOM HEIGHT))
0)
(COND
(INTERNALFLG (* doesn't fit either
place, put it down from
top.)
(SETQ NBTM (IDIFFERENCE \CURSORDESTHEIGHT HEIGHT)))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE TOP)
T))))))
(SETQ NLFT RLEFT))
(LEFT (COND
((ILESSP (SETQ NLFT (IDIFFERENCE RLEFT WIDTH))
0)
(COND
(INTERNALFLG (* doesn't fit either
place put at right of
screen)
(SETQ NLFT (IDIFFERENCE \CURSORDESTWIDTH WIDTH)))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE RIGHT)
T))))))
(SETQ NBTM (IMAX (IPLUS RBOTTOM (IDIFFERENCE RHEIGHT HEIGHT))
0)))
(PROGN (COND
((IGREATERP (IPLUS (SETQ NLFT (IPLUS RLEFT RWIDTH))
(SUB1 WIDTH))
\CURSORDESTWIDTH)
(COND
(INTERNALFLG (* doesn't fit either
place put at left of
screen)
(SETQ NLFT 0))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE LEFT)
T))))))
(SETQ NBTM (IMAX (IPLUS RBOTTOM (IDIFFERENCE RHEIGHT HEIGHT))
0))))
(RETURN (CREATEREGION NLFT NBTM WIDTH HEIGHT)))))
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(RPAQ? BTPRINTLEVEL 3)
(RPAQ? WIZARDFLG )
(RPAQ? BREAKREGIONSPEC (create REGION LEFT ← 17 BOTTOM ← -120 WIDTH ← 400 HEIGHT ← 120))
(RPAQ? TRACEREGION (create REGION LEFT ← 8 BOTTOM ← 3 WIDTH ← 547 HEIGHT ← 310))
(RPAQ? BREAKMENUITEMS (QUOTE ((!EVAL (QUOTE !EVAL)
"Evaluates the break expression without recursive breaks")
(EVAL (QUOTE EVAL)
"Evaluates the break expression")
(EDIT (QUOTE EDIT)
"Calls the editor on the selected frame form")
(revert (QUOTE revert)
"Unwinds the stack to the selected frame")
(↑ (QUOTE ↑)
"Exits to the next higher break via (ERROR!)")
(proceed (QUOTE proceed)
"Returns control to a higher PROCEED-CASE")
(OK (QUOTE OK)
"Leaves the break, returning the value of the break expression")
(BT (QUOTE BT)
"Back trace of important functions in a menu")
(BT! (QUOTE BT!)
"Back trace of all functions in a menu")
(?= (QUOTE ?=)
"Prints the variables bound in the selected frame"))))
(RPAQ? MaxBkMenuWidth 125)
(RPAQ? MaxBkMenuHeight 300)
(RPAQ? AUTOBACKTRACEFLG NIL)
(RPAQ? CLOSEBREAKWINDOWFLG T)
(RPAQ? TRACEWINDOW (CREATETRACEWINDOW NIL))
(RPAQ? BACKTRACEFONT )
(RPAQ? BreakMenu )
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BREAKMENUITEMS BreakMenu BTPRINTLEVEL MaxBkMenuWidth MaxBkMenuHeight TRACEWINDOW
TRACEREGION BREAKREGIONSPEC)
)
(RPAQ? TTYSTREAMS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD BKMENUITEM (LABEL BKMENUINFO))
]
)
(ADDTOVAR WINDOWUSERFORMS (WBREAK T))
(ADDTOVAR ENDOFWINDOWUSERFORMS (WBREAK NIL))
(DECLARE: DONTEVAL@LOAD DOCOPY
(WBREAK T)
(ADDTOVAR BREAKMACROS [DBT (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP]
(DBT! (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL NIL)))
)
(PUTPROPS WBREAK COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4083 21177 (WBREAK 4093 . 5163) (\WINDOWBREAK1A 5165 . 6780) (CREATETRACEWINDOW 6782 .
6999) (GETBREAKWINDOW 7001 . 12478) (\BREAKTITLEABBREV 12480 . 13247) (\NEARBYREGION 13249 . 16875) (
SETBREAKTTY 16877 . 19922) (RELEASEBREAKWINDOW 19924 . 21175)) (21178 37999 (BACKTRACEITEMWINDOW 21188
. 22573) (BREAKWINDOWEVENTFN 22575 . 23958) (BKITEMSELECTEDFN 23960 . 26732) (BREAKWCLOSEFN 26734 .
28048) (DISPBAKTRACE 28050 . 30831) (DISPBAKTRACE1 30833 . 33587) (REGIONNEXTTO 33589 . 37997)))))
STOP