ActionAreasOpsImpl.mesa
Warren Teitelman, June 20, 1983 9:15 am
DIRECTORY
ActionAreasDefs USING [actionAreaIcon, RestoreSelection, inactiveActionAreaIcon],
AMBridge USING [GetWorld],
AMEvents USING [Debugging, Debugged],
BBAction USING [Abort, Action, ActionId, TakeData],
BBBreak USING [BreakEntry, ClearBreak, BreakExit, BreakId, NextBreak, NullIndex, FindBreakId, BreakIndex, ClearAllBreaks],
BBContext USING [Context, ContextForLocalFrame, GetContents],
BBEval USING [EvalHead],
BBObjectLocation USING [LocationToSource, TVFromLocation],
BBSafety USING [Mother],
BBVForUserExec USING [ReportProc, Severity, ClearBreak, SourceFromTV, OpenSource],
BBVExtras USING [ClearActionBreakPoint, DisplayLocalFrame, WalkContext, SetBreakFromPosition],
Convert USING [ValueToRope],
IO USING [CurrentPosition, SyntaxError, SkipOver, PeekChar, EndOf, EndOfStream, Flush, GetInt, PutChar, PutF, PutRope, int, rope, ROPE, STREAM, tv, TV, RIS, GetToken, IDProc, WhiteSpace],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, GetLine, Menu, MenuEntry, SetLine],
MessageWindow USING [Append, Blink, Clear],
Process USING [Detach, Pause, MsecToTicks, Ticks],
Rope USING [Equal, Fetch, Find, IsEmpty, Length, Cat, Concat, Substr],
SymTab USING [Fetch],
TiogaOps USING [FirstChild, GetCaret, GetRope, GetSelection, GoToPreviousCharacter, InsertChar, LastLocWithin, Location, LockSel, UnlockSel, LocOffset, LocRelative, Paste, SaveSpanForPaste, SelectionGrain, SelectPoint, AddLooks, SetSelection, ViewerDoc],
UserExec USING [HistoryEvent, RegisterCommand, CommandProc, ExecHandle, Expression, EvaluationFailed, CreateExpr, EvalExpr, Viewer, GetExecHandle, GetStreams, StuffIt, DoIt, RopeSubst],
UserExecPrivate USING [ActionAreaData, CaptionForExec, GetEvalHead, execMenu, ExecPrivateRecord, GoToSleep, execHandleList, GetPrivateStuff, tildas, secondMenuLine, ForAllSplitViewers, SplitViewerProc, StoreInSymTab, GetEventsFromSelection, HistoryEventPrivateRecord],
UserProfile USING [Boolean],
ViewerClasses USING [Viewer],
ViewerOps USING [PaintViewer, SetMenu, CloseViewer, DestroyViewer, FindViewer],
ViewerTools USING [GetSelectedViewer, GetSelectionContents],
WorldVM USING [World, WorldName, LocalWorld]
;
ActionAreasOpsImpl: CEDAR PROGRAM
IMPORTS ActionAreasDefs, AMBridge, AMEvents, BBAction, BBBreak, BBContext, BBObjectLocation, BBSafety, BBVExtras, BBVForUserExec, Convert, IO, Menus, MessageWindow, Process, Rope, SymTab, TiogaOps, UserExec, UserExecPrivate, UserProfile, ViewerOps, ViewerTools, WorldVM
EXPORTS UserExec, UserExecPrivate, ActionAreasDefs
= BEGIN OPEN IO;
tildas: PUBLIC ROPE ← "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~";
Types
ExecHandle: TYPE = UserExec.ExecHandle;
Viewer: TYPE = UserExec.Viewer;
ClickProc: TYPE = Menus.ClickProc;
Action: TYPE = BBAction.Action;
ExecPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExecPrivateRecord;
HistoryEventPrivateRecord: PUBLIC TYPE = UserExecPrivate.HistoryEventPrivateRecord;
for WalkStack command.
Menu buttons
SetBreak: ClickProc = {
viewer: Viewer ← NARROW[parent];
exec: ExecHandle = UserExec.GetExecHandle[viewer: viewer];
start: TiogaOps.Location;
command: ROPE;
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
IF private.execState = suspended THEN {
MessageWindow.Append["That exec is busy. Use another one.", TRUE];
MessageWindow.Blink[];
RETURN;
};
[viewer, start] ← TiogaOps.GetSelection[];
IF viewer = NIL THEN {ReportExec[exec, "Make a selection.", fatal]; RETURN};
SELECT mouseButton FROM
red => command ← "SetBreak";
yellow, blue => {
sel: ROPE = ViewerTools.GetSelectionContents[];
IF mouseButton = yellow THEN command ← "BreakAtEntry"
ELSE command ← "BreakAtExit";
IF Rope.Length[sel] > 1 THEN {
command ← Rope.Cat[command, " ", sel];
viewer ← NIL;
};
};
ENDCASE => ERROR;
IF viewer # NIL THEN command ← Rope.Cat[command, " ", viewer.name, " ", Convert.ValueToRope[[signed[TiogaOps.LocOffset[loc1: [TiogaOps.ViewerDoc[viewer], 0], loc2: start, skipCommentNodes: TRUE]]]]];
IF private.execState = dormant THEN -- dormant, i.e. not waiting for input. must call direct, but have to fork because the command is not supposed to be executed under notifier
TRUSTED {Process.Detach[FORK UserExec.DoIt[input: Rope.Concat[command, "\n"], exec: exec]]}
ELSE MakeExecCommand[NARROW[parent], command, TRUE];
ViewerTools.SetSelection[exec.viewer]; -- Karen didn't like this.
};
ClearBreak: ClickProc = {
viewer: Viewer = NARROW[parent];
exec: ExecHandle = UserExec.GetExecHandle[viewer: viewer];
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
command: ROPE;
command ← SELECT mouseButton FROM
red => IF ViewerTools.GetSelectedViewer[] = viewer THEN "ClearActionBreak" ELSE "ClearSelectedBreak",
yellow => "ClearActionBreak",
blue => "ClearAllBreaks",
ENDCASE => ERROR;
IF private.execState = suspended THEN {
MessageWindow.Append["That exec is busy. Use another one.", TRUE]; MessageWindow.Blink[];
}
ELSE IF private.execState = dormant THEN -- dormant, i.e. not waiting for input. must call direct
TRUSTED {Process.Detach[FORK UserExec.DoIt[input: Rope.Concat[command, "\n"], exec: exec]]}
ELSE MakeExecCommand[NARROW[parent], command, TRUE];
};
Proceed: ClickProc -- PROC [parent: REF ANY, clientData: REF ANY, redButton: BOOL] -- = {
MakeExecCommand[NARROW[parent], SELECT mouseButton FROM
red => "Proceed",
yellow => "Proceed Destroy",
blue => "Proceed Close",
ENDCASE => ERROR];
};
Abort: ClickProc -- PROC [parent: REF ANY, clientData: REF ANY, redButton: BOOL] -- = {
viewer: Viewer = NARROW[parent];
exec: ExecHandle = UserExec.GetExecHandle[viewer: viewer];
AbortExec: PROC [exec: ExecHandle] = {
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
viewer: Viewer = exec.viewer;
IF private.execState = suspended THEN
{
WaitTillReady: PROC [exec: ExecHandle] = {
ticks: Process.Ticks = Process.MsecToTicks[100];
UNTIL private.eventState = readyForNext DO
Process.Pause[ticks];
ENDLOOP;
};
AbortExec[private.spawnedActionArea];-- abort the child first.
WaitTillReady[exec]; -- wait until the abort gets noticed by this work area, since otherwise the "Abort" stuffed in the buffer would be cleared, and therefore never take place.
};
MakeExecCommand[viewer, SELECT mouseButton FROM
red => "Abort",
yellow => "Abort Destroy",
blue => "Abort Close",
ENDCASE => ERROR];
};
IF exec = NIL THEN {ReportProc["Exec = NIL", fatal]; RETURN};
AbortExec[exec];
};
Source: ClickProc -- PROC [parent: REF ANY, clientData: REF ANY, redButton: BOOL] -- = {
r: ROPE ← "Source";
IF control THEN r ← Rope.Concat[r, " global"];
MakeExecCommand[NARROW[parent], r, TRUE];
};
WalkStack: ClickProc -- PROC [parent: REF ANY, clientData: REF ANY, redButton: BOOL] -- = {
viewer: Viewer = NARROW[parent];
target: ROPE;
IF ViewerTools.GetSelectedViewer[] = viewer AND NOT Rope.IsEmpty[ViewerTools.GetSelectionContents[]] THEN {
start, end: UserExec.HistoryEvent;
eventPrivate: REF UserExecPrivate.HistoryEventPrivateRecord;
[start, end] ← UserExecPrivate.GetEventsFromSelection[UserExec.GetExecHandle[viewer: viewer]];
eventPrivate ← start.privateStuff;
target ← Rope.Concat[" &", Convert.ValueToRope[[signed[eventPrivate.eventNum]]]];
};
MakeExecCommand[
NARROW[parent],
SELECT mouseButton FROM
red => Rope.Concat["WalkStack", target],
yellow => "WalkStack 0",
blue => "WalkStack -1",
ENDCASE => ERROR,
TRUE];
};
ShowFrame: ClickProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = {
r: ROPE ← SELECT mouseButton FROM
red => "ShowFrame",
yellow => "ShowFrame args",
blue => "ShowFrame args allVars",
ENDCASE => ERROR;
IF control THEN r ← Rope.Concat[r, " globals"];
MakeExecCommand[NARROW[parent], r, TRUE];
};
ListBreaks: ClickProc -- PROC [parent: REF ANY, clientData: REF ANY, redButton: BOOL] -- = {
MakeExecCommand[NARROW[parent], "ListBreaks"];
};
MakeExecCommand: PROCEDURE [viewer: Viewer, command: ROPE, sameLine: BOOL ← FALSE] = {
exec: ExecHandle = UserExec.GetExecHandle[viewer: viewer];
private: REF ExecPrivateRecord;
IF exec = NIL THEN {ReportProc["Exec = NIL", fatal]; RETURN};
private ← UserExecPrivate.GetPrivateStuff[exec];
IF sameLine THEN {
IF private.eventState = running THEN UserExec.StuffIt[exec, Rope.Cat["\021", command, "\t"]] -- workaround, because currently, changing a typescript look will not take effect until the typescript is waiting for a character, which means the notifier gets wedged until the event that is currently executing finishes
ELSE UserExec.StuffIt[exec: exec, rope: NIL, list: LIST[NEW[INT ← ('S - 'A)], $ApplyTypeScriptLook, "\021", command, NEW[INT ← ('S - 'A)], $RemoveTypeScriptLook, "\t"]]
}
ELSE UserExec.StuffIt[exec, Rope.Cat["\021", command, "\n"]];
};
Corresponding exec commands
SetBreakCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
action: Action = GetAction[exec];
viewerName: ROPE;
viewer: ViewerClasses.Viewer;
position: INT ← -1;
break: BBBreak.BreakIndex;
Report: BBVForUserExec.ReportProc = {
ReportExec[exec, msg, severity];
};
world: WorldVM.World;
IF action # NIL THEN world ← action.event.world;
MessageWindow.Clear[];
viewerName ← event.commandLineStream.GetToken[IO.WhiteSpace ! IO.EndOfStream => CONTINUE];
position ← event.commandLineStream.GetInt[ !
IO.EndOfStream => CONTINUE
];
viewer ← ViewerOps.FindViewer[viewerName];
IF viewer = NIL THEN Report["No such viewer", fatal]
ELSE IF position = -1 THEN Report["No such location", fatal]
ELSE break ← BBVExtras.SetBreakFromPosition[report: Report, viewer: viewer, position: position, world: world];
ShowBreakPoint[exec, break];
};
BreakAtEntryCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
BreakEntryOrExit[event: event, exec: exec, entry: TRUE];
};
BreakAtExitCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
BreakEntryOrExit[event: event, exec: exec, exit: TRUE];
};
BreakEntryOrExit: PROC [event: UserExec.HistoryEvent, exec: ExecHandle, entry: BOOL ← FALSE, exit: BOOL ← FALSE] = {
action: Action = GetAction[exec];
break: BBBreak.BreakIndex;
name: ROPE = IO.GetToken[event.commandLineStream, IO.IDProc];
position: INT ← -1;
Report: BBVForUserExec.ReportProc = {
ReportExec[exec, msg, severity];
};
world: WorldVM.World;
IF NOT entry AND NOT exit THEN RETURN;
IF action # NIL THEN world ← action.event.world;
position ← event.commandLineStream.GetInt[ !
IO.EndOfStream => CONTINUE;
];
IF position # -1 THEN {
viewer: ViewerClasses.Viewer = ViewerOps.FindViewer[name];
IF viewer = NIL THEN Report["No such viewer", fatal]
ELSE break ← BBVExtras.SetBreakFromPosition[viewer: viewer, position: position, report: Report, world: world, entry: entry, exit: exit]
}
ELSE {
inner: PROC = {
IF exit THEN break ← BBBreak.BreakExit[expr.value];
IF entry THEN break ← BBBreak.BreakEntry[expr.value];
};
error: ROPE;
expr: UserExec.Expression = UserExec.CreateExpr[name];
MessageWindow.Append[Rope.Cat["Evaluating ", name, "..."], TRUE];
[] ← UserExec.EvalExpr[expr: expr, exec: exec ! UserExec.EvaluationFailed => {
error ← msg;
CONTINUE
}];
MessageWindow.Clear[];
IF error = NIL THEN error ← BBSafety.Mother[inner];
IF error # NIL THEN Report[error, fatal];
};
ShowBreakPoint[exec, break];
};
ShowBreakPoint: PROCEDURE [exec: UserExec.ExecHandle, break: BBBreak.BreakIndex] = {
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
breakId: BBBreak.BreakId;
index: INT;
name: ROPE;
viewer: Viewer;
breakTV, gf: TV;
MessageWindow.Clear[];
IF break = BBBreak.NullIndex THEN RETURN;
breakId ← BBBreak.FindBreakId[break];
breakTV ← BBObjectLocation.TVFromLocation[breakId.loc];
[gf, index] ← BBObjectLocation.LocationToSource[breakId.loc];
name ← BBVForUserExec.SourceFromTV[tv: gf, report: Report].name;
viewer ← ShowSource[name: name, index: index, exec: exec, onlyIfAlreadyOpen: FALSE -- should be TRUE if this is a break at entry/exit --];
PrintBreak[exec: exec, breakId: breakId, breakTV: breakTV, viewer: viewer, index: index];
out.PutF["in %g, at position %d\n", tv[breakTV], int[index]];
PrintSource[viewer: viewer, index: index, exec: exec];
};
ClearSelectedBreakCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
action: Action = GetAction[exec];
MessageWindow.Clear[];
IF ViewerTools.GetSelectedViewer[] = exec.viewer THEN -- selection is in the action area. clear the break associated with that area
BBVExtras.ClearActionBreakPoint[GetAction[exec], Report]
ELSE [] ← BBVForUserExec.ClearBreak[world: IF action # NIL THEN action.event.world ELSE NIL, report: Report];
};
ClearActionBreakCommand: UserExec.CommandProc = {
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
BBVExtras.ClearActionBreakPoint[GetAction[exec], Report];
};
ClearAllBreaksCommand: UserExec.CommandProc = {
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
Report["Clearing breaks...", comment];
BBBreak.ClearAllBreaks[];
Report["All breaks cleared", success];
};
ClearBreakCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
out: IO.STREAM = UserExec.GetStreams[exec].out;
UNTIL IO.EndOf[event.commandLineStream] DO
ENABLE IO.EndOfStream => CONTINUE;
id: BBBreak.BreakIndex;
id ← IO.GetInt[event.commandLineStream];
IF BBBreak.ClearBreak[id] # NIL THEN out.PutF["*nBreak #%d cleared\n", int[id]]
ELSE out.PutF["*n*eNo such break: %d*s\n", int[id]];
ENDLOOP;
};
ProceedCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
out: STREAM = UserExec.GetStreams[exec].out;
action: Action = GetAction[exec];
r: ROPE;
IF action = NIL THEN {out.PutF["*eNo action associated with this work area."]; RETURN}; -- user typed this to a work area no longer associated with an action. In future, this will simply be disabled via predicate associated with command.
LeaveActionArea[exec: exec, abort: FALSE];
IF action.status = pendingOut THEN [] ← BBAction.TakeData[action]
ELSE IF action.status = busy THEN NULL
ELSE ERROR;
r ← IO.GetToken[event.commandLineStream, IO.IDProc];
SELECT TRUE FROM
Rope.Equal[r, "Destroy", FALSE] => ViewerOps.CloseViewer[exec.viewer];
Rope.Equal[r, "Close", FALSE] => ViewerOps.DestroyViewer[exec.viewer];
ENDCASE;
ERROR UserExecPrivate.GoToSleep[];
};
AbortCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
out: STREAM = UserExec.GetStreams[exec].out;
action: Action = GetAction[exec];
r: ROPE;
IF action = NIL THEN {out.PutF["*eNo action associated with this work area."]; RETURN};
LeaveActionArea[exec: exec, abort: TRUE];
IF action.status = pendingOut THEN [] ← BBAction.Abort[action]
ELSE IF action.status = dead THEN NULL
ELSE ERROR;
r ← IO.GetToken[event.commandLineStream, IO.IDProc];
SELECT TRUE FROM
Rope.Equal[r, "Destroy", FALSE] => ViewerOps.CloseViewer[exec.viewer];
Rope.Equal[r, "Close", FALSE] => ViewerOps.DestroyViewer[exec.viewer];
ENDCASE;
ERROR UserExecPrivate.GoToSleep[];
};
EndSessionCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
out: STREAM = UserExec.GetStreams[exec].out;
action: Action = GetAction[exec];
IF action = NIL THEN {out.PutF["*eNo action associated with this work area."]; RETURN};
LeaveActionArea[exec: exec, abort: FALSE, booted: TRUE];
IF action.status = pendingOut THEN {
[] ← BBAction.Abort[action];
ERROR UserExecPrivate.GoToSleep[];
}
ELSE IF action.status = dead THEN NULL
ELSE ERROR;
};
LeaveActionArea: PUBLIC PROC [exec: ExecHandle, abort: BOOL, booted: BOOL ← FALSE] = {
viewer: Viewer = exec.viewer;
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
out: STREAM = IF booted THEN private.out ELSE UserExec.GetStreams[exec].out;
parentExec: ExecHandle;
parentsPrivate: REF ExecPrivateRecord;
actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData;
action: Action = actionAreaData.action;
msg: ROPE = IF abort THEN "aborted" ELSE "proceeded";
IF booted THEN out.PutF["*n*sEnd Of Session\n"]
ELSE {
out.PutF["*n*s%g Action #%d", rope[msg], int[action.id]];
IF actionAreaData.parentExec # NIL THEN {
parentExec ← actionAreaData.parentExec;
parentsPrivate ← UserExecPrivate.GetPrivateStuff[parentExec];
out.PutF[", returning to %g Area %g", rope[IF parentsPrivate.actionAreaData # NIL THEN "Action" ELSE "Work"], rope[parentsPrivate.id]];
};
};
out.PutF["*n%g\n", rope[UserExecPrivate.tildas]];
IO.Flush[out];
actionAreaData.action ← NIL;
actionAreaData.aborted ← abort;
actionAreaData.booted ← booted;
private.process ← NIL;
IF private.evalHead # NIL THEN {
private.evalHead.context ← NIL;
private.evalHead.globalContext ← NIL;
};
{viewerProc: UserExecPrivate.SplitViewerProc = {
Menus.SetLine[menu: viewer.menu, line: 1, entryList: NIL];
viewer.icon ← ActionAreasDefs.inactiveActionAreaIcon;
ViewerOps.PaintViewer[viewer, IF viewer.iconic THEN all ELSE menu];
};
UserExecPrivate.ForAllSplitViewers[viewer, viewerProc];
};
[] ← UserExecPrivate.CaptionForExec[exec, TRUE];
IF booted THEN RETURN;
IF parentExec # NIL THEN RestoreActionArea[parentExec];
ActionAreasDefs.RestoreSelection[exec];
};
RestoreActionArea: PUBLIC PROC [exec: ExecHandle] = {
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData;
viewerProc: UserExecPrivate.SplitViewerProc = TRUSTED {
IF private.actionAreaData # NIL THEN {
viewer.icon ← ActionAreasDefs.actionAreaIcon;
Menus.SetLine[menu: viewer.menu, line: 1, entryList: UserExecPrivate.secondMenuLine];
ViewerOps.PaintViewer[viewer, IF viewer.iconic THEN all ELSE menu];
}
ELSE viewer.icon ← typescript;
};
private.spawnedActionArea ← NIL;
UserExecPrivate.ForAllSplitViewers[exec.viewer, viewerProc];
private.execState ← listening;
[] ← UserExecPrivate.CaptionForExec[exec, TRUE];
};
SourceCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
commandLineStream: STREAM = IO.RIS[event.commandLine];
useGlobal: BOOL ← FALSE;
ctx: BBContext.Context;
tv, gfTV: TV;
r: ROPE;
name: ROPE;
index: INT;
viewer: Viewer;
Report: BBVForUserExec.ReportProc = {
IF Rope.IsEmpty[msg] THEN RETURN;
SELECT severity FROM
comment => {IF comment THEN RETURN; comment ← TRUE};
fatal => {IF fatal THEN RETURN; fatal ← TRUE};
success => RETURN; -- {IF success THEN RETURN; success ← TRUE};
ENDCASE => RETURN;
ReportExec[exec, msg, severity];
};
UNTIL Rope.IsEmpty[r ← IO.GetToken[commandLineStream, IO.IDProc]] DO
SELECT TRUE FROM
Rope.Equal[r, "global", FALSE] => useGlobal ← TRUE;
ENDCASE;
ENDLOOP;
MessageWindow.Clear[];
ctx ← IF private.evalHead.context # NIL THEN private.evalHead.context ELSE private.evalHead.globalContext;
[, gfTV, tv] ← BBContext.GetContents[ctx];
IF tv = NIL OR useGlobal THEN tv ← gfTV;
[name, index] ← BBVForUserExec.SourceFromTV[tv, Report];
IF name = NIL THEN RETURN; -- something went wrong, would already have been reported
UserExec.GetStreams[exec].out.PutF["%g\t%d\n",
rope[IF (viewer ← ViewerOps.FindViewer[name]) # NIL THEN viewer.name -- gets capitalization right -- ELSE name],
int[index]];
PrintSource[viewer: ShowSource[name, index, exec], index: index, exec: exec];
};
WalkStackCommand: UserExec.CommandProc -- [exec: ExecHandle] RETURNS[ok: BOOLEAN ← TRUE] -- = {
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
commandLineStream: STREAM = event.commandLineStream;
lf, target: TV;
delta: INT ← 1;
MessageWindow.Clear[];
commandLineStream.SkipOver[IO.WhiteSpace];
IF NOT commandLineStream.EndOf[] AND commandLineStream.PeekChar[] = '& THEN {
key: ROPE = commandLineStream.GetToken[];
evalHead: BBEval.EvalHead = UserExecPrivate.GetEvalHead[exec];
target ← SymTab.Fetch[x: evalHead.specials, key: key].val;
}
ELSE delta ← commandLineStream.GetInt[!
IO.SyntaxError => CONTINUE;
IO.EndOfStream => CONTINUE
];
lf ← BBVExtras.WalkContext[action: private.actionAreaData.action, context: private.evalHead.context, target: target, delta: delta, report: Report];
IF lf # NIL THEN {
private.evalHead.context ← BBContext.ContextForLocalFrame[lf];
BBVExtras.DisplayLocalFrame[out: UserExec.GetStreams[exec].out, lf: lf, report: Report];
};
UserExecPrivate.StoreInSymTab[value: lf, event: event, exec: exec];
};
ShowFrameCommand: UserExec.CommandProc = {
args, vars, allVars, globals, lfAndPc: BOOL ← FALSE;
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
commandLineStream: STREAM = event.commandLineStream;
out: STREAM = UserExec.GetStreams[exec].out;
r: ROPE;
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
UNTIL Rope.IsEmpty[r ← IO.GetToken[commandLineStream, IO.IDProc]] DO
SELECT TRUE FROM
Rope.Equal[r, "args", FALSE] => args ← TRUE;
Rope.Equal[r, "vars", FALSE] => {args ← TRUE; vars ← TRUE};
Rope.Equal[r, "allVars", FALSE] => {args ← TRUE; vars ← TRUE; allVars ← TRUE};
Rope.Equal[r, "globals", FALSE] => globals ← TRUE;
Rope.Equal[r, "lfAndPc", FALSE] => lfAndPc ← TRUE;
ENDCASE;
ENDLOOP;
MessageWindow.Clear[];
BBVExtras.DisplayLocalFrame[out: out, lf: BBContext.GetContents[private.evalHead.context].lf, report: Report, args: args, vars: vars, allVars: allVars, globals: globals, lfAndPc: lfAndPc];
};
ListBreaksCommand: UserExec.CommandProc = {
oneFound: BOOL ← FALSE;
FOR i: BBBreak.BreakIndex ← BBBreak.NextBreak[BBBreak.NullIndex], BBBreak.NextBreak[i] WHILE NOT (i = BBBreak.NullIndex) DO
breakId: BBBreak.BreakId ← BBBreak.FindBreakId[i];
IF breakId # NIL THEN { -- display this break
Report: BBVForUserExec.ReportProc = {ReportExec[exec, msg, severity]};
gf: TV;
name: ROPE;
viewer: Viewer;
index: INT;
oneFound ← TRUE;
[gf, index] ← BBObjectLocation.LocationToSource[breakId.loc];
name ← BBVForUserExec.SourceFromTV[tv: gf, report: Report].name;
viewer ← FindViewer[name];
PrintBreak[exec: exec, breakId: breakId, breakTV: BBObjectLocation.TVFromLocation[breakId.loc], viewer: viewer, index: index];
};
ENDLOOP;
IF NOT oneFound THEN UserExec.GetStreams[exec].out.PutF["*nNo Breaks set."];
};
PrintBreak: PROC [exec: UserExec.ExecHandle, breakId: BBBreak.BreakId, breakTV: TV, viewer: Viewer, index: INT] = TRUSTED {
world: WorldVM.World = WorldVM.LocalWorld[];
out: STREAM = UserExec.GetStreams[exec].out;
out.PutF["*nBreak #%d in %g", int[breakId.index], tv[breakTV]];
IF world # AMBridge.GetWorld[breakTV] THEN
out.PutF[", in %g,", rope[WorldVM.WorldName[AMBridge.GetWorld[breakTV]]]];
out.PutF[" (source: %d)\n ", int[index]];
PrintSource[viewer: viewer, index: index, exec: exec]; -- show line of source if viewer exists
};
Miscellaneous
ShowSource: PUBLIC PROC [name: ROPE, index: INT, exec: UserExec.ExecHandle, onlyIfAlreadyOpen: BOOL ← FALSE] RETURNS[viewer: Viewer] = {
Report: BBVForUserExec.ReportProc = {
IF Rope.IsEmpty[msg] OR severity = success THEN RETURN;
ReportExec[exec, msg, severity];
};
IF name = NIL THEN RETURN;
IF NOT onlyIfAlreadyOpen OR ((viewer ← FindViewer[name]) # NIL AND NOT viewer.iconic) THEN {
BBVForUserExec.OpenSource[name: name, index: index, report: Report];
IF viewer = NIL THEN viewer ← FindViewer[name];
};
};
FindViewer: PROC [name: ROPE] RETURNS[viewer: Viewer] = {
name1: ROPE ← name;
IF name = NIL THEN RETURN;
IF Rope.Find[name, "["] # -1 THEN { -- work around because the viewer name would use the / notation. Really want OpenSource to return the name of the viewer.
name1 ← UserExec.RopeSubst["[", "/", name1];
name1 ← UserExec.RopeSubst["]<", "/", name1];
name1 ← UserExec.RopeSubst["<", "/", name1];
name1 ← UserExec.RopeSubst[">", "/", name1];
};
RETURN[ViewerOps.FindViewer[name1]];
};
PrintSource: PUBLIC PROC [viewer: Viewer, index: INT, exec: UserExec.ExecHandle] = {
if there is a viewer, we can still use it to print the source line to the exec
loc: TiogaOps.Location;
start, end, where: INT;
r: ROPE;
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
out: STREAM = UserExec.GetStreams[exec].out; -- problem with getstreams when called from NewAction. Can't debug because of cocedar.
out: STREAM = private.out;
IF viewer = NIL THEN RETURN;
loc ← TiogaOps.LocRelative[location: [TiogaOps.FirstChild[TiogaOps.ViewerDoc[viewer]], 0], count: index, skipCommentNodes: TRUE];
r ← TiogaOps.GetRope[loc.node];
where ← loc.where - 1;
start ← 0;
end ← Rope.Length[r];
FOR i: INT DECREASING IN [0..loc.where) DO
IF Rope.Fetch[r, i] = '\n THEN {start ← i + 1; EXIT}; -- because may not use node structure
ENDLOOP;
FOR i: INT IN [loc.where..end) DO
IF Rope.Fetch[r, i] = '\n THEN {end ← i - 1; EXIT};
ENDLOOP;
IF ViewerTools.GetSelectedViewer[] = exec.viewer THEN { -- if input focus in the work area, then use paste, prettier.
{ ENABLE {
UNWIND, AMEvents.Debugging, AMEvents.Debugged => NULL;
ANY => {TiogaOps.UnlockSel[]; GOTO JustPrintIt};
};
caretLoc: TiogaOps.Location;
IF NOT UserProfile.Boolean["EditTypeScripts", FALSE] THEN GOTO JustPrintIt; -- pasting won't work for noneditable typescripts
out.Flush[];
TiogaOps.LockSel[];
TiogaOps.SaveSelA[];does not save feedback selection.
TiogaOps.SelectPoint[viewer: exec.viewer, caret: TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[exec.viewer]]]; -- go to end. assumes that only one node in typescript
TiogaOps.InsertChar['\n];
TiogaOps.GoToPreviousCharacter[]; -- If we are at the end of the typescript, Paste will act like a stuff, which is not what we want
caretLoc ← TiogaOps.GetCaret[];
TiogaOps.SaveSpanForPaste[startLoc: [loc.node, start], endLoc: [loc.node, end]];
TiogaOps.Paste[];
TiogaOps.SetSelection[viewer: exec.viewer, start: [caretLoc.node, caretLoc.where + (where - start)], end: [caretLoc.node, caretLoc.where + (MIN[where + 3, end] - start)]];
TiogaOps.AddLooks[looks: "z"];
TiogaOps.SelectPoint[viewer: exec.viewer, caret: TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[exec.viewer]]]; -- go to end. assumes that only one node in typescript
TiogaOps.RestoreSelA[]; -- would also have the effect of making the feedback selection go away.
TiogaOps.UnlockSel[];
EXITS
JustPrintIt =>
out.PutF["%g<>%g\n", rope[Rope.Substr[base: r, start: start, len: where - start]], rope[Rope.Substr[base: r, start: where, len: end - where]]];
};
};
GetAction: PROC [exec: ExecHandle] RETURNS [Action] = INLINE {
private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec];
RETURN[IF private.actionAreaData # NIL THEN private.actionAreaData.action ELSE NIL];
};
ReportProc: BBVForUserExec.ReportProc -- [msg: ROPE, severity: Severity] -- = {
MessageWindow.Append[msg];
IF severity = fatal THEN MessageWindow.Blink[];
};
ReportExec: PROC [exec: UserExec.ExecHandle, msg: ROPE, severity: BBVForUserExec.Severity, out: IO.STREAM ← NIL] = {
ReportProc[msg, severity];
IF severity = comment THEN NULL
ELSE IF exec # NIL THEN
{out: STREAM = UserExec.GetStreams[exec].out;
IF out.CurrentPosition[] # 0 THEN out.PutChar['\t];
out.PutF[
SELECT severity FROM
success => "%g",
warning => "*m%g*s",
fatal => "*e%g*s",
ENDCASE => ERROR,
rope[msg]
];
}
ELSE IF out # NIL THEN out.PutRope[msg] -- when outRopeStreams can be given font changes, can handle exec and out case the same.
ELSE ReportProc[msg, severity];
};
Initialization
secondMenuLine: PUBLIC Menus.MenuEntry;
Init: PROCEDURE [] RETURNS [] = {
execMenu: Menus.Menu = UserExecPrivate.execMenu;
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "Proceed", proc: Proceed, documentation: "Proceed with action", fork: FALSE],
line: 1
];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "Abort", proc: Abort, documentation: "Abort action", fork: FALSE],
line: 1
];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "Source", proc: Source, documentation: "Show source for this context", fork: FALSE],
line: 1
];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "WalkStack", proc: WalkStack, documentation: "Walk stack. Red button => advance one frame earlier on call stack, blue button => advance one frame later, yellow button => reset stack.", fork: FALSE],
line: 1
];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "ShowFrame", proc: ShowFrame, documentation: "Display current frame for this context. Yellow button => with args, Blue button => args + allVars, CTRL => globals", fork: FALSE],
line: 1
];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "ListBreaks", proc: ListBreaks, documentation: "Lists current break Points."],
line: 1]; -- if on first line, not enough room for yes and no buttons
secondMenuLine ← Menus.GetLine[menu: execMenu, line: 1];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "Set", proc: SetBreak, documentation: "Set Break Point. Click red to at selected location, yellow at entry to indicated procedure, blue at exit.", fork: FALSE],
line: 0];
Menus.AppendMenuEntry[
menu: execMenu,
entry: Menus.CreateEntry[name: "Clear", proc: ClearBreak, documentation: "Clears current break Point. Blue Button means clear all break points.", fork: FALSE],
line: 0
];
FOR l: LIST OF ExecHandle ← UserExecPrivate.execHandleList, l.rest UNTIL l = NIL DO
viewer: Viewer ← l.first.viewer;
ViewerOps.SetMenu[viewer, execMenu];
ENDLOOP;
};
Init[];
UserExec.RegisterCommand["Proceed", ProceedCommand, "Proceeds current action, if any."];
UserExec.RegisterCommand["Abort", AbortCommand, "Aborts current action, if any."];
UserExec.RegisterCommand["EndSession", EndSessionCommand];
UserExec.RegisterCommand["SetBreak", SetBreakCommand, "Set break point.", "Sets break point at current feedback selection."];
UserExec.RegisterCommand["BreakAtEntry", BreakAtEntryCommand, "Set break point at entry to named procedure. Form is BreakAtEntry <procName>."];
UserExec.RegisterCommand["BreakAtExit", BreakAtExitCommand, "Set break point at exit to named procedure. Form is BreakAtExit <procName>."];
UserExec.RegisterCommand["ClearSelectedBreak", ClearSelectedBreakCommand, "Clears selected break point. If selection in action area, same as ClearActionBreak."];
UserExec.RegisterCommand["ClearActionBreak", ClearActionBreakCommand, "Clears break point associated with this action area."];
UserExec.RegisterCommand["ClearAllBreaks", ClearAllBreaksCommand, "Clears all break points."];
UserExec.RegisterCommand["ClearBreak", ClearBreakCommand, "Clears specified (by break number) break points."];
UserExec.RegisterCommand["ListBreaks", ListBreaksCommand, "Lists current breakpoints."];
UserExec.RegisterCommand["Source", SourceCommand, "Show source for this context.", "Show source for this context. Source global shows source for the global frame associated with the local context. If there is no local context, both Source and Source global shows source for the default global context."];
UserExec.RegisterCommand["WalkStack", WalkStackCommand, "Walk the Stack.", "Walk the Stack. WalkStack n, where n > 0 means advance n frames earlier in frame order. n < 0 means advance n frames later in frame order. WalkStack {cr} is equivalent to WalkStack 1. WalkStack 0 means reset stack to its original state upon entering the action area"];
UserExec.RegisterCommand["ShowFrame", ShowFrameCommand, "Displays the current frame.", "Displays the current frame. Form is ShowFrame ...options... where options can be one of:\nargs:\tinclude arguments,\nvars:\tinclude local variables for this block,\nallVars:\tinclude all local variables of frame, i.e. if this block is nested, show local variables of outer blocks as well,\nglobals:\tinclude globals for the current local frame,\nlfAndPc:\tshow local frame and pc as long cardinals."];
END.
Edited on March 28, 1983 12:21 pm, by Teitelman
break at exit/entry was not working for point selection. Also, died if evaluation caused an error
changes to: DIRECTORY, SetBreak, Report (local of SetBreakCommand), SetBreakCommand, Report (local of BreakEntryOrExit), BreakEntryOrExit, inner (local of BreakEntryOrExit), UserExec, UserExec, DIRECTORY, SetBreak, Report (local of SetBreakCommand), SetBreakCommand, Report (local of BreakEntryOrExit), BreakEntryOrExit, inner (local of BreakEntryOrExit), UserExec, UserExec, END, SetBreak, LeaveActionArea, LeaveActionArea, viewerProc (local of LeaveActionArea), LeaveActionArea
Edited on April 6, 1983 11:43 am, by Teitelman
changes to: DIRECTORY, SetBreak, SetBreakCommand, BreakEntryOrExit, Report (local of BreakEntryOrExit), IMPORTS, SetBreak, SetBreak, SetBreak
Edited on April 20, 1983 9:58 am, by Teitelman
changes to: MakeExecCommand
Edited on May 10, 1983 3:26 pm, by Teitelman
changes to: LeaveActionArea, viewerProc (local of LeaveActionArea), SourceCommand, Report (local of SourceCommand), SourceCommand, WalkStackCommand, DIRECTORY, HistoryEventPrivateRecord, IMPORTS
Edited on May 13, 1983 1:55 pm, by Teitelman
changes to: DIRECTORY, SourceCommand, SourceCommand, IMPORTS, ClearBreakCommand, Report (local of ClearAllBreaksCommand), ClearAllBreaksCommand, SourceCommand, Report (local of SourceCommand), WalkStackCommand, ListBreaksCommand, PrintBreak, ShowSource, Report (local of ShowSource), GetAction, IMPORTS, EXPORTS, SetBreakCommand, ShowBreakPoint, PrintSource, Report (local of ShowBreakPoint), ShowBreakPoint, LeaveActionArea, viewerProc (local of LeaveActionArea), SourceCommand, ShowSource, ShowBreakPoint, ListBreaksCommand, PrintBreak, PrintBreak, ShowSource, FindViewer, PrintSource, ShowBreakPoint, ListBreaksCommand, PrintBreak, ShowBreakPoint, ClearSelectedBreakCommand, ClearBreakCommand, ProceedCommand, UserExec, UserExec, UserExe
Edited on May 24, 1983 11:54 am, by Teitelman
changes to: DIRECTORY, IMPORTS, PrintSource, PrintSource
Edited on June 2, 1983 9:38 am, by Teitelman
changes to: DIRECTORY, PrintSource
Edited on June 20, 1983 9:15 am, by Teitelman
changes to: LeaveActionArea, RestoreActionArea, viewerProc (local of RestoreActionArea), SourceCommand