<> <> 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 _ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"; <> 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; <> <> 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]; <> }; 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"]]; }; <> 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]; <> <> }; 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; <> < {IF comment THEN RETURN; comment _ TRUE};>> < {IF fatal THEN RETURN; fatal _ TRUE};>> < RETURN; -- {IF success THEN RETURN; success _ TRUE};>> < 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 }; <> 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] = { <> loc: TiogaOps.Location; start, end, where: INT; r: ROPE; private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; <> 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; <> { 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.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.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]; }; <> 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 ]; <> <> <> <> 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 ."]; UserExec.RegisterCommand["BreakAtExit", BreakAtExitCommand, "Set break point at exit to named procedure. Form is BreakAtExit ."]; 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. <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <<>> <> <> <> <> <<>>