<> <> <> <> DIRECTORY Atom, CD, CDApplications, CDCallSpecific, CDCommandOps, CDBasics, CDEvents, CDOps, CDProperties, CDSequencer, CDValue, RefTab, Rope, SymTab, TerminalIO; CDCommandOpsImpl: CEDAR PROGRAM IMPORTS Atom, CDApplications, CDCallSpecific, CDEvents, CDOps, CDProperties, CDSequencer, CDValue, RefTab, Rope, SymTab, TerminalIO EXPORTS CDCommandOps = BEGIN -- -- -- -- -- -- <<--generic>> ProbablyLastChar: PROC [r: Rope.ROPE] RETURNS [CHAR] = BEGIN l: INT = r.Length[]; IF l<=0 THEN RETURN ['@]; RETURN [r.Fetch[l-1]] END; -- -- -- -- -- -- --ImplementSpecificCommand Entry: TYPE = RECORD [key: ATOM, text: Rope.ROPE_NIL, x: REF]; tableKey: REF = NEW[ATOM_$tableKey]; -- indirect to make inaccessible gTable: SymTab.Ref = SymTab.Create[]; GetTTable: PROC [t: CD.Technology] RETURNS [table: SymTab.Ref] = BEGIN IF t=NIL THEN table_gTable ELSE { x: REF _ CDValue.Fetch[boundTo: t, key: tableKey, propagation: technology]; IF x=NIL THEN { x _ SymTab.Create[7]; CDValue.Store[boundTo: t, key: tableKey, value: x] }; TRUSTED {table _ LOOPHOLE[x]} } END; GetEntry: PROC [tipKey: Rope.ROPE, tech: CD.Technology] RETURNS [entry: REF Entry_NIL] = BEGIN IF tipKey.Length[]>=2 THEN { x: REF; found: BOOL _ FALSE; tipKey _ tipKey.Substr[len: tipKey.Length[]]; IF tech#NIL THEN [found, x] _ SymTab.Fetch[GetTTable[tech], tipKey]; IF NOT found THEN [found, x] _ SymTab.Fetch[gTable, tipKey]; IF found THEN WITH x SELECT FROM e: REF Entry => entry_e ENDCASE => NULL } END; GeneralCommand: PROC [comm: CDSequencer.Command] = BEGIN n: NAT_0; t: Rope.ROPE = Atom.GetPName[comm.a]; entry: REF Entry = GetEntry[t, comm.design.technology]; IF entry=NIL THEN { TerminalIO.WriteRope["unknown command: "]; TerminalIO.WriteRope[t]; } ELSE { TerminalIO.WriteRope[entry.text]; TerminalIO.WriteRope[" "]; SELECT ProbablyLastChar[t] FROM 'S => { TerminalIO.WriteRope["selected "]; n _ CDCallSpecific.CallForSelected[design: comm.design, objectSpecific: entry.key, x: entry.x]; }; 'P => { TerminalIO.WriteRope["pointed "]; n _ CDCallSpecific.CallForPointed[design: comm.design, point: comm.pos, objectSpecific: entry.key, x: entry.x]; }; 'A => { TerminalIO.WriteRope["all "]; n _ CDCallSpecific.CallForAll[design: comm.design, objectSpecific: entry.key, x: entry.x]; }; 'X => { TerminalIO.WriteRope["(if 1 selected) "]; n _ CDCallSpecific.CallIfOneSelected[design: comm.design, objectSpecific: entry.key, x: entry.x]; }; 'F => { TerminalIO.WriteRope["(first selected) "]; n _ CDCallSpecific.CallForOneSelected[design: comm.design, objectSpecific: entry.key, x: entry.x]; }; ENDCASE => TerminalIO.WriteRope["bad modifier"]; }; TerminalIO.WriteRope["\n "]; TerminalIO.WriteInt[n]; TerminalIO.WriteRope[" objects handled\n"]; END; ImplementSpecificCommand: PUBLIC PROC [specificAtom: ATOM, text: Rope.ROPE_NIL, tipBase: Rope.ROPE_NIL, useFor: Rope.ROPE_NIL, x: REF_NIL, technology: CD.Technology_NIL] = <<--Implements a command which is executed by using CDCallSpecific>> <<--specificAtom: handled through to select CDCallSpecific command>> <<--text: logged; defaults to tipBase>> <<--tipBase: How command is called in tiptable; defaults to specificAtom>> <<--useFor: Suffix letters appended to tipBase getting the tip table entry>> <<--x: handled through to CDCallSpecific>> <<--technology: NIL => all technologies >> BEGIN t: SymTab.Ref = GetTTable[technology]; entry: REF Entry; EachKey: Rope.ActionType -- PROC [c: CHAR] RETURNS [quit: BOOL _ FALSE] -- = BEGIN SELECT c FROM 'P, 'S, 'A, 'F, 'X => { fiddledTip: Rope.ROPE _ Rope.Concat[tipBase, Rope.FromChar[c]]; [] _ SymTab.Store[t, fiddledTip, entry]; CDSequencer.ImplementCommand[Atom.MakeAtom[fiddledTip], GeneralCommand, technology]; } ENDCASE => NULL END; <<--set up defaults>> IF useFor=NIL THEN useFor _ "PS"; IF tipBase=NIL THEN tipBase _ Atom.GetPName[specificAtom]; IF text=NIL THEN text _ tipBase; SELECT ProbablyLastChar[text] FROM '\n, ' => text _ text.Substr[len: text.Length[]-1]; ENDCASE => NULL; <<--do it >> entry _ NEW[Entry _ [key: specificAtom, text: text, x: x]]; [] _ Rope.Map[base: useFor, action: EachKey]; END; -- -- -- -- -- -- <<--TheApplication>> TheApplication: PUBLIC PROC[comm: CDSequencer.Command, text: Rope.ROPE_NIL] RETURNS [aptr: CD.ApplicationPtr_NIL] = <<--extracts the application given a command>> <<--if returned application is nil, all the messages are made and caller should return quiet;>> <<--if returned application is not nil; text line is written and object is there>> BEGIN multiple: BOOL; key: Rope.ROPE _ Atom.GetPName[comm.a]; IF text=NIL THEN text _ key; SELECT ProbablyLastChar[text] FROM '\n, ' => text _ text.Substr[len: text.Length[]-1]; ENDCASE => NULL; TerminalIO.WriteRope[text]; TerminalIO.WriteRope[" "]; SELECT ProbablyLastChar[key] FROM 'S => { TerminalIO.WriteRope["selected\n"]; [aptr, multiple] _ CDOps.SelectedApplication[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF aptr=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; 'P => { TerminalIO.WriteRope["pointed\n"]; aptr _ CDApplications.AplicationAt[CDOps.AppList[comm.design], comm.pos]; IF aptr=NIL THEN TerminalIO.WriteRope[" no pointed application\n"]; }; 'X => { TerminalIO.WriteRope["(if 1 selected)\n"]; [aptr, multiple] _ CDOps.SelectedApplication[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF aptr=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; 'F => { -- and specially 'F TerminalIO.WriteRope["(first selected)\n"]; [aptr, multiple] _ CDOps.SelectedApplication[comm.design]; IF aptr=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; ENDCASE => { -- same as 'S TerminalIO.WriteRope["selected\n"]; [aptr, multiple] _ CDOps.SelectedApplication[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF aptr=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; IF aptr#NIL THEN { IF aptr.ob=NIL THEN {aptr_NIL; TerminalIO.WriteRope[" bad object\n"]}; }; END; -- -- -- -- -- -- <<--WriteInfo>> WriteInfo: PUBLIC PROC[aptr: CD.ApplicationPtr, verbosity: INT_0] = BEGIN TerminalIO.WriteRope[" ("]; IF aptr=NIL THEN TerminalIO.WriteRope["no object"] ELSE { Info: PROC[aptr: CD.ApplicationPtr] RETURNS [Rope.ROPE] = BEGIN IF aptr.ob=NIL THEN RETURN ["nil object"] ELSE IF aptr.ob.p.describeApp#NIL THEN RETURN [aptr.ob.p.describeApp[aptr]] ELSE RETURN [CDOps.Info[aptr.ob]] END; TerminalIO.WriteRope[Info[aptr]]; IF verbosity>0 THEN { WITH CDProperties.GetPropFromApplication[aptr, $SignalName] SELECT FROM r: Rope.ROPE => TerminalIO.WriteRope[Rope.Concat[" ", r]]; a: ATOM => TerminalIO.WriteRope[Rope.Concat[" ", Atom.GetPName[a]]]; ENDCASE => NULL; }; }; TerminalIO.WriteRope[")"]; END; RedrawApplication: PUBLIC PROC[design: CD.Design, aptr: CD.ApplicationPtr_NIL, erase: BOOL_TRUE] = BEGIN IF aptr#NIL THEN CDOps.DelayedRedraw[design, CDApplications.ARectO[aptr], erase] ELSE CDOps.DelayedRedraw[design, CDBasics.universe, erase] END; -- -- -- -- -- -- <<--CallWithResource>> CallWithResource: PUBLIC PROC [proc: PROC[CDSequencer.Command], comm: CDSequencer.Command, resource: REF, abortFlag: REF BOOL_NIL] RETURNS [skipped: BOOL] = <<--Monitoring commands using global resourceTab >> <<--proc will be called with comm as parameter, but is skipped if resource is already in use >> <<--resource: typically atom; every resource is called only once at a time>> <<--abortFlag: will be set to TRUE if an abort event occurs while execution of proc>> <<--the procedure message on Terminal if it skipped the call, or, if abortFlag is true on return >> BEGIN ENABLE UNWIND => [] _ RefTab.Delete[resourceTab, resource]; design: CD.Design = IF comm#NIL THEN comm.design ELSE NIL; skipped _ ~RefTab.Insert[resourceTab, resource, design]; IF skipped THEN TerminalIO.WriteRope[" not reentrant; skipped\n"] ELSE { CDValue.Store[boundTo: design, key: abortFlagKey, value: abortFlag]; proc[comm]; IF abortFlag#NIL AND abortFlag^ THEN TerminalIO.WriteRope[" aborted\n"]; [] _ RefTab.Delete[resourceTab, resource]; } END; AbortEvent: CDEvents.EventProc = { <<--PROC [event: REF, design: CD.Design, x: REF] RETURNS [dont: BOOL_FALSE]>> EachResource: RefTab.EachPairAction = { <<--PROC [key: Key, val: Val] RETURNS [quit: BOOLEAN]>> quit _ FALSE; IF (design=NIL OR design=val) AND val#NIL THEN WITH CDValue.Fetch[boundTo: val, key: abortFlagKey] SELECT FROM abortFlag: REF BOOL => abortFlag^ _ TRUE; ENDCASE => NULL; }; -- of EachResource [] _ RefTab.Pairs[resourceTab, EachResource] }; resourceTab: RefTab.Ref = RefTab.Create[3]; abortFlagKey: REF _ resourceTab; CDEvents.RegisterEventProc[$Abort, AbortEvent]; END.