
<<BBVExtrasImpl>>
<<Warren Teitelman, April 22, 1983 2:53 pm>>

DIRECTORY
AMTypes USING [DynamicParent, GlobalParent, TypeClass, TVType],
BBAction USING [Action, PeekData],
BBBreak USING [AddBreakToList, BreakId, BreakIndex, ClearBreak, FindBreakId, NullIndex],
BBContext USING [Context, GetContents, FindAction, FindMatchingGlobalFrames],
BBFocus USING [SameLocalFrame],
BBObjectLocation USING [SourceToLocation, EntryLocation, ExitLocation, TVFromLocation, Location],
BBSafety USING [Mother],
BBVForUserExec USING [ReportProc, Severity],
BBVOps USING [ViewerFromLocation, SourceError],
BBVExtras USING [],
Convert USING [ValueToRope],
IO USING [PutF, PutRope, rope, ROPE, STREAM, TV, ROS, GetOutputStreamRope],
MessageWindow USING [Clear],
PrintTV USING [PutClosure, PutProc, Print, PrintArguments, PrintVariables],
Rope USING [Cat, Find, Concat, Text, Length, Fetch, Flatten],
ViewerClasses USING [Viewer],
WorldVM USING [LocalWorld, World]
;


BBVExtrasImpl: CEDAR PROGRAM   

IMPORTS AMTypes, BBAction, BBBreak,  BBContext, BBFocus, BBObjectLocation, BBSafety, BBVOps, Convert, IO, MessageWindow, PrintTV, 
Rope, WorldVM     

EXPORTS BBVExtras 
SHARES IO
= BEGIN OPEN IO; 

ReportProc: TYPE = BBVForUserExec.ReportProc;
Action: TYPE = BBAction.Action;
TV: TYPE = IO.TV;

ShowBreakPoint: PUBLIC PROCEDURE [break: BBBreak.BreakIndex, report: ReportProc] = {
Report: ReportProc = {Report[msg, severity]};
breakId: BBBreak.BreakId;
IF break = BBBreak.NullIndex THEN RETURN;
breakId _  BBBreak.FindBreakId[break];
IF breakId # NIL THEN
[] _ BBVOps.ViewerFromLocation[breakId.loc ! BBVOps.SourceError => {report[reason, fatal]; CONTINUE}];
<<[name, index] _ BBVForUserExec.SourceFromTV[>>
<<tv: BBObjectLocation.TVFromLocation[breakId.loc],>>
<<report: Report];>>
<<IF name # NIL THEN BBVForUserExec.OpenSource[name: name, index: index, report: Report];>>
};

ClearActionBreakPoint: PUBLIC PROC [action: Action, report: ReportProc] = TRUSTED { -- unsafe discrimination   
bx: BBBreak.BreakIndex;
MessageWindow.Clear[];
IF action = NIL THEN {report["Not an action, no break cleared.", fatal]; RETURN};
WITH e: action.event SELECT FROM
break => {
WITH BBAction.PeekData[action] SELECT FROM
breakID: BBBreak.BreakId =>  bx _ breakID.index;
ENDCASE => GOTO Bogus;
};
ENDCASE => GOTO Bogus;
report["Clearing break...", comment];
[] _ BBBreak.ClearBreak[bx];
report[Rope.Concat["Break #", Convert.ValueToRope[[signed[bx]]]], success];
EXITS
Bogus => report["No breakpoint associated with this action.", fatal];
};


WalkContext: PUBLIC PROC [action: Action, context: BBContext.Context, target: TV _ NIL, delta: INT, report: ReportProc] RETURNS 
[lf: TV] =  {
current: TV _ NIL;
IF action = NIL OR context = NIL THEN {report["No context!", fatal]; RETURN};
current _ BBContext.GetContents[context].lf;
IF current = NIL THEN {report["What current frame?", fatal]; RETURN};
IF target # NIL THEN {
lf _ action.event.frame; -- start at top
UNTIL lf = NIL DO
IF BBFocus.SameLocalFrame[lf, target] THEN
EXIT;
lf _ AMTypes.DynamicParent[lf];
REPEAT
FINISHED => report["not found.", fatal];
ENDLOOP;
}
ELSE SELECT delta FROM
= 0 => { -- start at top
lf _ action.event.frame;
};
< 0 => { -- advance one frame "later" in frame order
lag: TV _ lf _ action.event.frame; -- start at top
lagDist: INT _ 0;
IF BBFocus.SameLocalFrame[lf, current] THEN
lf _ NIL;
WHILE lf # NIL DO
next: TV _ AMTypes.DynamicParent[lf];
IF BBFocus.SameLocalFrame[lf, current] THEN
{-- found it! (or something close)
lf _ lag; EXIT};
SELECT delta FROM
= -1 => lag _ lf;
< lagDist => lagDist _ lagDist - 1;
ENDCASE => lag _ AMTypes.DynamicParent[lag];
lf _ next;
IF next = NIL THEN EXIT;
ENDLOOP;
};
> 0 => { -- advance one frame "earlier" in frame order
lf _ AMTypes.DynamicParent[current];
WHILE (delta _ delta - 1) > 0 AND lf # NIL DO
next: TV _ AMTypes.DynamicParent[lf];
IF next = NIL THEN EXIT;
lf _ next;
ENDLOOP;
IF lf = NIL THEN report["Can't go any further.", warning]; 
};
ENDCASE;
};


DisplayLocalFrame: PUBLIC PROC [out: IO.STREAM, lf: TV, report: ReportProc, args, vars, allVars, globals, lfAndPc: BOOL _ FALSE] =  
{
StreamToPutClosure: PROC [stream: STREAM] RETURNS[PrintTV.PutClosure] =  {
RETURN[PrintTV.PutClosure[proc: LOOPHOLE[stream.streamProcs.putChar, PrintTV.PutProc], data: stream]];
};
s: STREAM = IO.ROS[];
r: ROPE;
i: INT;
put: PrintTV.PutClosure;
IF lf = NIL THEN RETURN;
MessageWindow.Clear[];
<<following cloned from BBVOpsImpl.DisplayFrame>>
report["Displaying frame...", comment];
IF AMTypes.TypeClass[AMTypes.TVType[lf]] # localFrame THEN
{report["Not a local frame!", fatal]; RETURN};
PrintTV.Print[tv: lf, put: StreamToPutClosure[s], depth: 1, verbose: lfAndPc];  -- to get the lf and pc
r _ s.GetOutputStreamRope[];
i _ Rope.Find[s1: r, s2: "("];
out.PutF["%g", rope[r]];
put _ StreamToPutClosure[out];
IF args THEN
{out.PutRope["\nA- "];
PrintTV.PrintArguments[tv: lf, put: put, breakBetweenItems: TRUE];
};
IF vars THEN
{out.PutRope["\nV- "];
PrintTV.PrintVariables[tv: lf, put: put, all: allVars, breakBetweenItems: TRUE];
};
IF globals THEN 
{out.PutRope["\nG- "];
PrintTV.PrintVariables[tv: AMTypes.GlobalParent[lf], put: put];
};
out.PutRope["\n"];
report[NIL, success];
MessageWindow.Clear[];  -- to clear out the displaying frame message.
};

SetBreakFromPosition: PUBLIC PROC [report: ReportProc, viewer: ViewerClasses.Viewer, position: INT, world: WorldVM.World _ NIL, 
entry, exit: BOOL _ FALSE]
RETURNS [break: BBBreak.BreakIndex _ BBBreak.NullIndex] = {
<<set a new breakpoint at the current selection>>
<<returns BBBreak.NullIndex if not successful>>
<<world = NIL => use LocalWorld>>
<<entry forces entry-point breakpoint, exit goes to the end>>
<<(can set both entry & exit breakpoints)>>
loc: BBObjectLocation.Location _ NIL;
msg: ROPE _ NIL;
both: BOOL _ entry AND exit;
inner: PROC =  {
break _ BBBreak.AddBreakToList[loc].index;
};
ReportBreak: PROC[report: ReportProc, break: BBBreak.BreakIndex, msg: ROPE _ NIL, entry, exit: BOOL _ FALSE] = {
decimal: ROPE _ Convert.ValueToRope[[signed[break]]];
kind: ROPE _ IF entry THEN " (entry)" ELSE IF exit THEN " (exit)" ELSE NIL;
report[Rope.Cat["Break #", decimal, kind, msg], success];
};
report["Setting break...", comment];
loc _ LocationFromSelection[report, viewer, position, world, entry, exit];
IF loc # NIL THEN {
msg _ BBSafety.Mother[inner];
IF msg # NIL THEN GO TO noGood;
ReportBreak[report, break, " set.", entry, exit];
IF NOT both THEN RETURN;
loc _ BBObjectLocation.ExitLocation[loc];
IF loc = NIL THEN GO TO noGood;
msg _ BBSafety.Mother[inner];
IF msg # NIL THEN GO TO noGood;
ReportBreak[report, break, " set.", FALSE, exit];
RETURN;
EXITS noGood => {};
};
IF msg = NIL THEN msg _ "no such location";
report[Rope.Concat["Break not set: ", msg], fatal];
};

LocationFromSelection: PROC [report: ReportProc, viewer: ViewerClasses.Viewer, pos: INT, world: WorldVM.World _ NIL, entry, exit: 
BOOL _ FALSE] RETURNS [loc: BBObjectLocation.Location _ NIL] =  {
msg: ROPE _ NIL;
inner: PROC =  {
IF viewer = NIL THEN {msg _ "no selected viewer"; RETURN};
{
StripExtension: PROC [name: ROPE, stripDir: BOOL _ FALSE] RETURNS [Rope.Text] = {
pos: INT _ name.Length[];
start: INT _ 0;
WHILE (pos _ pos - 1) >= 0 DO
IF name.Fetch[pos] = '. THEN EXIT;
ENDLOOP;
IF pos < 0 THEN pos _ name.Length[];
IF stripDir THEN
{start _ pos-1;
WHILE start > 0 DO
SELECT name.Fetch[start _ start - 1] FROM
'/, '\\, '[, '], '<, '> => 
{start _ start + 1; EXIT};
ENDCASE;
ENDLOOP; 
};
RETURN [name.Flatten[start, pos-start]];
};

gname: ROPE _ StripExtension[viewer.name, TRUE];
gframe: TV _ NIL; 
foundOne: BBContext.FindAction = TRUSTED {
gframe _ gf; 
gname _ name; 
RETURN [quit]
}; 
TRUSTED {BBContext.FindMatchingGlobalFrames[
IF world = NIL THEN WorldVM.LocalWorld[] ELSE world,
gname, foundOne];
};
IF gframe # NIL THEN 
{-- we found such a frame!
loc _ BBObjectLocation.SourceToLocation[gframe, pos];
IF loc = NIL THEN {msg _ "no such location"; RETURN}; 
SELECT TRUE FROM
entry => loc _ BBObjectLocation.EntryLocation[loc];
exit => loc _ BBObjectLocation.ExitLocation[loc];
ENDCASE;
[] _ BBObjectLocation.TVFromLocation[loc];
RETURN;
};
msg _ Rope.Cat[gname, " not found"];
};
};
err: ROPE _ BBSafety.Mother[inner];
IF err = NIL THEN err _ msg;
IF err # NIL THEN report[err, fatal];
}; 

END.
<<>>