<> <> DIRECTORY ActionAreasDefs USING [ShowSource, PrintSource], AMBridge USING [TVToCardinal, GetWorld], AMTypes USING [IsNil], BBAction USING [Abort, Action, ActionId, NextPendingAction, PeekData, WaitForChange], BBBreak USING [BreakId, BreakIndex, ClearAllBreaks, CondProc], BBContext USING [Context, ContextForLocalFrame], BBEval USING [EvalHead], BBVExtras USING [DisplayLocalFrame], BBVForUserExec USING [ReportProc, SourceFromTV, Severity], IconManager USING [IconNotify], Icons USING [IconFlavor, NewIconFromFile], IO USING [card, CurrentPosition, Flush, GetOutputStreamRope, GetToken, int, PutChar, PutF, PutRope, PutSignal, RIS, rope, ROPE, ROS, STREAM, TV, WhiteSpace], Menus USING [ChangeNumberOfLines, ClickProc, FindEntry, Menu, MenuEntry, SetGuarded, SetLine], MessageWindow USING [Append, Blink], Process USING [Detach], Rope USING [Find, IsEmpty, Substr, Cat, Concat], TiogaOps USING [Location, SelectionGrain, SelectPoint, LastLocWithin, ViewerDoc, GetSelection, SetSelection, SelectionError], UserExec USING [CommandProc, CreateUserExecutive, ExecHandle, Expression, GetExecHandle, GetStreams, HistoryEvent, RegisterCommand, StartListening, StuffIt, Viewer], UserExecPrivate USING [ActionAreaData, AdviseExec, CaptionForExec, EvalHeadData, execHandleList, ExecPrivateRecord, GetEvalHead, GetPrivateStuff, secondMenuLine, ForAllSplitViewers, SplitViewerProc], UserProfile USING [Boolean, ProfileChangedProc, CallWhenProfileChanges], ViewerOps USING [PaintViewer, OpenIcon], ViewerTools USING [GetSelectedViewer, SetSelection], WorldVM USING [LocalWorld, WorldName, World] ; ActionAreasImpl: CEDAR PROGRAM IMPORTS ActionAreasDefs, AMBridge, AMTypes, BBAction, BBBreak, BBContext, BBVExtras, BBVForUserExec, IconManager, Icons, IO, Menus, MessageWindow, Process, Rope, TiogaOps, UserExec, UserExecPrivate, UserProfile, ViewerOps, ViewerTools, WorldVM EXPORTS UserExec, ActionAreasDefs SHARES IO = BEGIN OPEN IO; <> ExecHandle: TYPE = UserExec.ExecHandle; HistoryEvent: TYPE = UserExec.HistoryEvent; Viewer: TYPE = UserExec.Viewer; ClickProc: TYPE = Menus.ClickProc; -- [parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL] <> Action: TYPE = BBAction.Action; ExecPrivateRecord: PUBLIC TYPE = UserExecPrivate.ExecPrivateRecord; <> <> spawnWorkAreas: BOOLEAN _ TRUE; <> GetAction: PROC [exec: ExecHandle] RETURNS [Action] = INLINE { private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; RETURN[IF private.actionAreaData # NIL THEN private.actionAreaData.action ELSE NIL]; }; Mother: PROC [proc: PROC [Action]] = { <> <> lastChange: INT _ 0; lastId: BBAction.ActionId _ 0; DO ENABLE ABORTED => EXIT; maxId: BBAction.ActionId _ lastId; lastChange _ BBAction.WaitForChange[lastChange]; FOR action: Action _ BBAction.NextPendingAction[NIL], BBAction.NextPendingAction[action] UNTIL action = NIL DO maxId _ MAX[maxId, action.id]; IF action.status # pendingOut THEN LOOP; IF action.id <= lastId THEN EXIT; -- we have seen all the new ones proc[action]; ENDLOOP; lastId _ maxId; ENDLOOP; }; PrintAction: PROCEDURE [action: Action, parent: UserExec.ExecHandle, out: IO.STREAM] RETURNS[frameTV: TV] = TRUSTED { -- unsafe discrimination, WorldVM.LocalWorld, AMBridge.TVToCardinal kind: ROPE; Report: BBVForUserExec.ReportProc = CHECKED {ReportExec[NIL, msg, severity]}; WITH e: action.event SELECT FROM booted => kind _ "booted"; break => kind _ "break"; call => kind _ "callDebugger"; signal => kind _ "signal"; interrupt => kind _ "interrupt"; unknown => kind _ "unknown"; ENDCASE => ERROR; out.PutF["\nAction #%d", int[action.id]]; out.PutF[" (kind: %g, ", rope[kind]]; IF (action.event.world # WorldVM.LocalWorld[]) THEN out.PutF["world: %g, ", rope[WorldVM.WorldName[action.event.world]]]; out.PutF["process: %bB)", card[AMBridge.TVToCardinal[action.event.process]]]; IF parent # NIL THEN { parentsPrivate: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[parent]; out.PutF[" (from %g)", rope[Rope.Concat[IF parentsPrivate.actionAreaData # NIL THEN "Action Area " ELSE "Work Area ", parentsPrivate.id]]]; }; out.PutChar['\n]; frameTV _ action.event.frame; WITH e: action.event SELECT FROM booted => NULL; break => { WITH BBAction.PeekData[action] SELECT FROM breakID: BBBreak.BreakId => { out.PutF["Break #%d", int[breakID.index]]; IF breakID.entry THEN out.PutRope[" at entry to "] ELSE IF breakID.exit THEN out.PutRope[" at exit to "] ELSE out.PutRope[" in "]; }; ENDCASE => out.PutRope["Break #?? in "]; -- %$#$@#Rovner's break point, came in at a level below where he should. BBVExtras.DisplayLocalFrame[out, frameTV, Report]; }; call => { out.PutRope["from "]; BBVExtras.DisplayLocalFrame[out, frameTV, Report]; IF NOT Rope.IsEmpty[e.msg] THEN out.PutF["msg: %g\n", rope[e.msg]]; }; signal => { out.PutSignal[e.signal, e.args]; out.PutRope[" from "]; BBVExtras.DisplayLocalFrame[out, frameTV, Report]; }; interrupt => NULL; unknown => out.PutF["why: %g\n", rope[e.why]]; ENDCASE; }; NewAction: PROCEDURE [action: Action] = { abbrevMsg, fullMsg, ropeForIcon: ROPE; exec, parent: ExecHandle; break: BOOL _ FALSE; private, parentsPrivate: REF ExecPrivateRecord; viewer: Viewer; evalHead: BBEval.EvalHead; stream: IO.STREAM; frameTV: TV; IF NOT spawnWorkAreas THEN RETURN; TRUSTED -- AMBridge, WorldVM { -- in here if anything goes wrong, don't spawn another work area. ENABLE UNWIND => spawnWorkAreas _ TRUE; spawnWorkAreas _ FALSE; stream _ IO.ROS[]; <> IF NOT AMTypes.IsNil[action.event.process] THEN -- if process is NIL, then can't be coming out of any exec, since this isn't a valid process to be running under. If don't make this check then whenever you get a NIL process (which means something is wrong) would incorrectly assume that the parent was any proceeded or aborted actionarea FOR l: LIST OF ExecHandle _ UserExecPrivate.execHandleList, l.rest UNTIL l = NIL DO private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[l.first]; IF (LOOPHOLE[private.process, CARDINAL] = AMBridge.TVToCardinal[action.event.process]) AND (action.event.world = WorldVM.LocalWorld[]) THEN { parent _ l.first; parentsPrivate _ UserExecPrivate.GetPrivateStuff[parent]; EXIT; }; ENDLOOP; frameTV _ PrintAction[action: action, parent: parent, out: stream]; fullMsg _ stream.GetOutputStreamRope[]; WITH e: action.event SELECT FROM booted => { world: WorldVM.World = action.event.world; ThisWorld: BBBreak.CondProc -- [bid: BreakId, lf: TV, data: REF _ NIL] -- = TRUSTED { RETURN[world = AMBridge.GetWorld[lf]]; }; FOR l: LIST OF ExecHandle _ UserExecPrivate.execHandleList, l.rest UNTIL l = NIL DO private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[l.first]; actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData; action: Action; IF actionAreaData # NIL AND (action _ actionAreaData.action) # NIL AND action.event.world = world THEN { <> <> <> <> IF private.execState = listening THEN UserExec.StuffIt[l.first, "\021EndSession\n"]; EXIT; }; ENDLOOP; BBBreak.ClearAllBreaks[ThisWorld]; IF action.status = pendingOut THEN [] _ BBAction.Abort[action]; spawnWorkAreas _ TRUE; RETURN; }; break => { i: INT = Rope.Find[s1: fullMsg, s2: "Break"]; abbrevMsg _ Rope.Substr[base: fullMsg, start: i, len: Rope.Find[s1: fullMsg, s2: "\n", pos1: i] - i]; <> ropeForIcon _ Rope.Substr[abbrevMsg, Rope.Find[abbrevMsg, "."] + 1]; -- just the name, no Break In break _ TRUE; }; call => { i: INT = Rope.Find[s1: fullMsg, s2: "msg:", pos1: 1]; abbrevMsg _ "Call Debugger"; IF i # -1 THEN { ropeForIcon _ Rope.Substr[base: fullMsg, start: i + 5, len: Rope.Find[s1: fullMsg, s2: "\n", pos1: i] - i - 5]; abbrevMsg _ Rope.Cat[abbrevMsg, " - ", ropeForIcon]; }; }; signal => { i: INT = Rope.Find[s1: fullMsg, s2: "\n", pos1: 1] + 1; j: INT = Rope.Find[s1: fullMsg, s2: "[", pos1: i]; IF j = -1 THEN -- signal/error has no arguments abbrevMsg _ Rope.Substr[base: fullMsg, start: i, len: Rope.Find[s1: fullMsg, s2: "\n", pos1: i] - i] ELSE { k: INT = Rope.Find[s1: fullMsg, s2: "]", pos1: j]; abbrevMsg _ Rope.Concat[Rope.Substr[base: fullMsg, start: i, len: j - i], Rope.Substr[base: fullMsg, start: k + 1, len: Rope.Find[s1: fullMsg, s2: "\n", pos1: k] - k - 1]]; }; <> stream _ IO.RIS[abbrevMsg]; [] _ IO.GetToken[stream, IO.WhiteSpace]; ropeForIcon _ IO.GetToken[stream, IO.WhiteSpace]; -- just the name, no SIGNAL. ropeForIcon _ Rope.Substr[base: ropeForIcon, start: Rope.Find[ropeForIcon, "."] + 1]; -- usually no room for interface }; interrupt => abbrevMsg _ "Interrupt"; unknown => abbrevMsg _ "Unknown"; ENDCASE; IF ropeForIcon = NIL THEN ropeForIcon _ abbrevMsg; <<>> exec _ FindAnArea[parent, action.event.world]; IF exec = NIL THEN -- spawn a new one { exec _ UserExec.CreateUserExecutive[msg: "", paint: FALSE, iconic: TRUE, startListening: FALSE]; private _ exec.privateStuff; Menus.ChangeNumberOfLines[menu: exec.viewer.menu, newLines: 2]; IF break THEN -- guard abort button Menus.SetGuarded[Menus.FindEntry[menu: exec.viewer.menu, entryName: "Abort"], TRUE]; private.actionAreaData _ NEW[UserExecPrivate.ActionAreaData _ [parentExec: parent, action: action, world: action.event.world, fullMsg: fullMsg, abbrevMsg: abbrevMsg, iconMsg: ropeForIcon]]; [] _ UserExecPrivate.CaptionForExec[exec, FALSE]; ViewerOps.OpenIcon[exec.viewer]; -- in lieu of creating full size, paint = FALSE, and then having to paint the column UserExecPrivate.AdviseExec[exec, SaveSel, RestoreSel, exec]; } ELSE -- exec is already an action area of parent { viewerProc: UserExecPrivate.SplitViewerProc = TRUSTED { Menus.SetLine[menu: viewer.menu, line: 1, entryList: UserExecPrivate.secondMenuLine]; Menus.SetGuarded[entry: Menus.FindEntry[menu: viewer.menu, entryName: "Abort"], guard: break]; IF viewer.iconic THEN ViewerOps.OpenIcon[viewer] ELSE ViewerOps.PaintViewer[viewer: viewer, hint: menu]; }; private _ exec.privateStuff; UserExecPrivate.ForAllSplitViewers[exec.viewer, viewerProc]; private.actionAreaData.fullMsg _ fullMsg; private.actionAreaData.abbrevMsg _ abbrevMsg; private.actionAreaData.iconMsg _ ropeForIcon; private.actionAreaData.action _ action; [] _ UserExecPrivate.CaptionForExec[exec, TRUE]; }; evalHead _ UserExecPrivate.GetEvalHead[exec]; evalHead.context _ BBContext.ContextForLocalFrame[frameTV]; IF parent # NIL THEN TRUSTED { viewerProc: UserExecPrivate.SplitViewerProc = TRUSTED { IF parentsPrivate.actionAreaData # NIL THEN { viewer.icon _ inactiveActionAreaIcon; Menus.SetLine[menu: viewer.menu, line: 1, entryList: NIL]; ViewerOps.PaintViewer[viewer, menu]; } ELSE viewer.icon _ inactiveExecIcon; }; UserExecPrivate.ForAllSplitViewers[parent.viewer, viewerProc]; IF parentsPrivate.evalHead # NIL THEN { evalHeadData, parentsEvalHeadData: REF UserExecPrivate.EvalHeadData; evalHeadData _ NARROW[evalHead.data]; parentsEvalHeadData _ NARROW[parentsPrivate.evalHead.data]; IF evalHeadData.defaultInterface = NIL THEN evalHeadData.defaultInterface _ parentsEvalHeadData.defaultInterface; IF evalHead.globalContext = NIL THEN evalHead.globalContext _ parentsPrivate.evalHead.globalContext; }; parentsPrivate.spawnedActionArea _ exec; parentsPrivate.execState _ suspended; InformParent[font: IF break THEN "*n*m" ELSE "*n*e", abbrevMsg: abbrevMsg, id: private.id, out: parentsPrivate.out ! ANY => CONTINUE]; [] _ UserExecPrivate.CaptionForExec[parent, TRUE]; }; private.out.PutF[Rope.Concat["*s", fullMsg]]; SaveSelection[exec]; private.evalMode _ TRUE; [] _ UserExecPrivate.CaptionForExec[exec, TRUE]; {viewerProc: UserExecPrivate.SplitViewerProc = TRUSTED {viewer.icon _ actionAreaIcon}; UserExecPrivate.ForAllSplitViewers[exec.viewer, viewerProc]; }; IF (viewer _ ViewerTools.GetSelectedViewer[]) = NIL OR (parent # NIL AND viewer = parent.viewer) THEN ViewerTools.SetSelection[exec.viewer]; IF break AND UserProfile.Boolean["AutoShowSource", TRUE] THEN { comment, fatal, success: BOOL _ FALSE; Report: BBVForUserExec.ReportProc = CHECKED { IF Rope.IsEmpty[msg] THEN RETURN; SELECT severity FROM comment => {IF comment THEN RETURN; comment _ TRUE}; fatal => {IF fatal THEN RETURN; fatal _ TRUE}; success => {IF success THEN RETURN; success _ TRUE}; ENDCASE => RETURN; ReportExec[NIL, msg, severity]; }; name: ROPE; index: INT; [name, index] _ BBVForUserExec.SourceFromTV[frameTV, Report]; IF name = NIL THEN RETURN; -- something went wrong, would already have been reported ActionAreasDefs.PrintSource[viewer: ActionAreasDefs.ShowSource[name: name, index: index, exec: exec, onlyIfAlreadyOpen: TRUE], index: index, exec: exec]; }; UserExec.StartListening[exec]; spawnWorkAreas _ TRUE; }; -- of enable unwind }; actionAreaIcon, inactiveActionAreaIcon, inactiveExecIcon: PUBLIC Icons.IconFlavor _ typescript; SetIcons: UserProfile.ProfileChangedProc -- [reason: ProfileChangeReason] -- = { IF UserProfile.Boolean["UseExecIcons", TRUE] THEN { actionAreaIcon _ Icons.NewIconFromFile["UserExec.Icons", 0]; inactiveActionAreaIcon _ Icons.NewIconFromFile["UserExec.Icons", 3]; inactiveExecIcon _ Icons.NewIconFromFile["UserExec.Icons", 2]; } ELSE actionAreaIcon _ inactiveActionAreaIcon _ inactiveExecIcon _ typescript; }; InformParent: PROC [font, abbrevMsg, id: ROPE, out: IO.STREAM] = { out.PutF[font]; out.PutF["%g\n*mcomputation suspended, switching to Action Area %g...", rope[abbrevMsg], rope[id]]; out.Flush[]; }; FindAnArea: PROCEDURE [parent: ExecHandle, world: WorldVM.World] RETURNS[exec: ExecHandle] = { FOR l: LIST OF ExecHandle _ UserExecPrivate.execHandleList, l.rest UNTIL l = NIL DO private: REF ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[l.first]; IF private.actionAreaData # NIL -- was an action area AND private.actionAreaData.action = NIL -- that was proceeded or aborted AND private.execState = dormant -- and is not executing a command AND private.actionAreaData.parentExec = parent -- and came from same parent (or no parent) AND private.actionAreaData.world = world -- and same world << -- AND NOT l.first.viewer.iconic and isnt iconic>> THEN RETURN[l.first]; ENDLOOP; }; -- some actions come out of thin air, i.e. not from a particular work area. In this case, reuse an area that also came out of thin air, i.e. parent = NIL. <> SaveSelection: PROC [exec: UserExec.ExecHandle] = TRUSTED { private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData; IF actionAreaData = NIL THEN ERROR; IF actionAreaData.world # WorldVM.LocalWorld[] THEN RETURN; [actionAreaData.viewer, actionAreaData.start, actionAreaData.end, actionAreaData.level, actionAreaData.caretBefore, actionAreaData.pendingDelete] _ TiogaOps.GetSelection[]; IF actionAreaData.viewer = NIL THEN {actionAreaData.viewer _ ViewerTools.GetSelectedViewer[]; actionAreaData.tiogaDoc _ FALSE; } ELSE actionAreaData.tiogaDoc _ TRUE; }; RestoreSelection: PUBLIC PROC [exec: UserExec.ExecHandle] = TRUSTED { private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData; savedViewer: Viewer = actionAreaData.viewer; IF savedViewer = NIL OR savedViewer.destroyed OR ViewerTools.GetSelectedViewer[] # exec.viewer OR actionAreaData.world # WorldVM.LocalWorld[] THEN NULL ELSE IF actionAreaData.tiogaDoc THEN { IF actionAreaData.parentExec # NIL AND savedViewer = actionAreaData.parentExec.viewer THEN { <> TiogaOps.SelectPoint[viewer: savedViewer, caret: TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[savedViewer]] ! TiogaOps.SelectionError => CONTINUE]; -- go to end. assumes that only one node in typescript. } ELSE TiogaOps.SetSelection[viewer: savedViewer, start: actionAreaData.start, end: actionAreaData.end, level: actionAreaData.level, caretBefore: actionAreaData.caretBefore, pendingDelete: actionAreaData.pendingDelete ! TiogaOps.SelectionError => CONTINUE] } ELSE IF savedViewer.iconic THEN IconManager.IconNotify[savedViewer, LIST[$Select]]; }; ShowSelCommandProc: UserExec.CommandProc = { private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData _ private.actionAreaData; IF actionAreaData = NIL THEN {UserExec.GetStreams[exec].out.PutF["*eNot An Action Area\n"]; RETURN[FALSE]}; RestoreSelection[exec]; }; RestoreSelCommandProc: UserExec.CommandProc = { private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData _ private.actionAreaData; IF actionAreaData = NIL THEN {UserExec.GetStreams[exec].out.PutF["*eNot An Action Area\n"]; RETURN[FALSE]}; actionAreaData.restoreSelAfterEachEvent _ NOT actionAreaData.restoreSelAfterEachEvent; }; SaveSel: PROC [data: REF ANY] = { exec: UserExec.ExecHandle = NARROW[data]; private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData; viewer: Viewer = actionAreaData.viewer; IF viewer # NIL AND NOT viewer.destroyed AND ViewerTools.GetSelectedViewer[] = viewer THEN SaveSelection[exec]; -- user has done something which changed the selection. notice it }; RestoreSel: PROC [data: REF ANY] = { exec: UserExec.ExecHandle = NARROW[data]; private: REF UserExecPrivate.ExecPrivateRecord = UserExecPrivate.GetPrivateStuff[exec]; actionAreaData: REF UserExecPrivate.ActionAreaData = private.actionAreaData; IF actionAreaData = NIL THEN ERROR; IF actionAreaData.restoreSelAfterEachEvent THEN RestoreSelection[exec]; }; ReportExec: PROC [exec: UserExec.ExecHandle, msg: ROPE, severity: BBVForUserExec.Severity, out: IO.STREAM _ NIL] = { ReportProc: BBVForUserExec.ReportProc -- [msg: ROPE, severity: Severity] -- = { MessageWindow.Append[msg]; IF severity = fatal THEN MessageWindow.Blink[]; }; 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]; }; <> TRUSTED {Process.Detach[FORK Mother[NewAction]]}; UserProfile.CallWhenProfileChanges[SetIcons]; UserExec.RegisterCommand["ShowSelection", ShowSelCommandProc, "Shows what the current selection was before this action occurred."]; UserExec.RegisterCommand["RestoreSelection", RestoreSelCommandProc, "Restore current selection before each event.", "For use in action areas. Sets a flip/flop that controls whether prior to executing each event, the current selection is to be restored prior to executing each event, to what it was before the action occurred. This allows the user to interpret expressions which use or manipulate the current selection. (Note that the current selection is always restored for a Proceed or Abort.)"]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>> <<>> <> <> <> <> <<>> <<>> <<>>