<> <> <> <> DIRECTORY Atom, CDBasics, CD, CDInstances, CDCallSpecific, CDCommandOps, CDCommandOpsExtras, CDCommandOpsExtras2, CDCommandOpsExtras3, CDEvents, CDLayers, CDOps, CDPopUpMenus, CDPrivate, CDProperties, CDSequencer, CDValue, CDViewer, Convert, IO, PopUpMenus, Process, RefTab, Rope, SymTab, TerminalIO, ViewerClasses USING [Viewer], ViewerOps USING [GetViewer]; CDCommandOpsImpl: CEDAR MONITOR IMPORTS Atom, CD, CDBasics, CDInstances, CDCallSpecific, CDCommandOps, CDEvents, CDLayers, CDOps, CDPopUpMenus, CDProperties, CDSequencer, CDValue, CDViewer, Convert, IO, PopUpMenus, Process, RefTab, Rope, SymTab, TerminalIO, ViewerOps EXPORTS CDCommandOps, CDCommandOpsExtras, CDCommandOpsExtras2, CDCommandOpsExtras3 = BEGIN -- -- -- -- -- -- <<--generic>> ProbablyLastChar: PROC [r: Rope.ROPE] RETURNS [CHAR] = { l: INT = r.Length[]; IF l<=0 THEN RETURN ['@]; RETURN [r.Fetch[l-1]] }; -- -- -- -- -- -- --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] = { 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] }; table _ NARROW[x] } }; GetEntry: PROC [tipKey: Rope.ROPE, tech: CD.Technology] RETURNS [entry: REF Entry_NIL] = { 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 } }; GeneralCommand: PROC [comm: CDSequencer.Command] = { n: NAT_0; t: Rope.ROPE = Atom.GetPName[comm.key]; entry: REF Entry = GetEntry[t, comm.design.technology]; IF entry=NIL THEN { TerminalIO.WriteRopes["unknown command: ", t]; } ELSE { TerminalIO.WriteRopes[entry.text, " "]; 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.WriteF["\n%gobjects handled\n", [integer[n]]]; }; 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 >> t: SymTab.Ref = GetTTable[technology]; entry: REF Entry; EachKey: Rope.ActionType -- PROC [c: CHAR] RETURNS [quit: BOOL _ FALSE] -- = { 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 }; <<--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]; }; -- -- -- -- -- -- <<--TheInstance>> TheInstance: PUBLIC PROC[comm: CDSequencer.Command, text: Rope.ROPE_NIL] RETURNS [inst: CD.Instance_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>> multiple: BOOL; key: Rope.ROPE _ Atom.GetPName[comm.key]; IF text=NIL THEN text _ key; SELECT ProbablyLastChar[text] FROM '\n, ' => text _ text.Substr[len: text.Length[]-1]; ENDCASE => NULL; TerminalIO.WriteRopes[text, " "]; SELECT ProbablyLastChar[key] FROM 'S => { TerminalIO.WriteRope["selected\n"]; [inst, multiple] _ CDOps.SelectedInstance[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF inst=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; 'P => { TerminalIO.WriteRope["pointed\n"]; inst _ CDInstances.InstanceAt[CDOps.InstList[comm.design], comm.pos]; IF inst=NIL THEN TerminalIO.WriteRope[" no pointed application\n"]; }; 'X => { TerminalIO.WriteRope["(if 1 selected)\n"]; [inst, multiple] _ CDOps.SelectedInstance[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF inst=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; 'F => { -- and specially 'F TerminalIO.WriteRope["(first selected)\n"]; [inst, multiple] _ CDOps.SelectedInstance[comm.design]; IF inst=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; ENDCASE => { -- same as 'S TerminalIO.WriteRope["selected\n"]; [inst, multiple] _ CDOps.SelectedInstance[comm.design]; IF multiple THEN {TerminalIO.WriteRope[" multiple selection\n"]; RETURN [NIL]}; IF inst=NIL THEN TerminalIO.WriteRope[" no selection\n"]; }; IF inst#NIL THEN { IF inst.ob=NIL THEN {inst_NIL; TerminalIO.WriteRope[" bad object\n"]}; }; }; -- -- -- -- -- -- <<--Vanilla stuff>> BoundingBox: PUBLIC PROC [design: CD.Design, onlySelected: BOOL] RETURNS [r: CD.Rect _ CDBasics.empty] = { IF onlySelected THEN r _ CDInstances.BoundingRectO[CDOps.InstList[design], TRUE] ELSE FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO r _ CDBasics.Surround[r, CDInstances.BoundingRectO[ NARROW[l.first.dummyCell.ob.specificRef, CD.CellPtr].contents ]] ENDLOOP; }; InstRope: PUBLIC PROC[inst: CD.Instance, verbosity: INT_0] RETURNS [r: Rope.ROPE] = { IF inst=NIL THEN r _ "nil instance" ELSE { r _ IF inst.ob=NIL THEN "nil object" ELSE IF inst.ob.class.describeInst#NIL THEN inst.ob.class.describeInst[inst] ELSE CDOps.ObjectInfo[inst.ob]; IF verbosity>0 THEN { WITH CDProperties.GetInstanceProp[inst, $SignalName] SELECT FROM n: Rope.ROPE => r _ Rope.Cat[r, " ", n]; a: ATOM => r _ Rope.Cat[r, " ", Atom.GetPName[a]]; ENDCASE => NULL; }; }; RETURN [Rope.Cat["(", r, ")"]] }; ToRope: PUBLIC PROC [x: REF, whenFailed: REF_NIL] RETURNS [rope: Rope.ROPE_NIL] = { WITH x SELECT FROM r: Rope.ROPE => rope _ r; rt: REF TEXT => rope _ Rope.FromRefText[rt]; ri: REF INT => rope _ Convert.RopeFromInt[ri^]; a: ATOM => rope _ Atom.GetPName[a]; l: CDPrivate.LayerRef => rope _ CDOps.LayerName[l.number]; ob: CD.Object => rope _ CDOps.ObjectInfo[ob]; inst: CD.Instance => rope _ inst.ob.class.describeInst[inst]; d: CD.Design => rope _ d.name; t: CD.Technology => rope _ t.name; rc: REF LONG CARDINAL => rope _ Convert.RopeFromCard[rc^]; ri: REF INTEGER => rope _ Convert.RopeFromInt[ri^]; ri: REF NAT => rope _ Convert.RopeFromInt[ri^]; rc: REF CARDINAL => rope _ Convert.RopeFromCard[rc^]; ENDCASE => SELECT whenFailed FROM NIL => rope _ NIL; $Interactive => { RopeNeeded: SIGNAL [ ref: REF REF ] = CODE; refRef: REF REF = NEW[REF _ x]; TerminalIO.WriteRope["please enter a ROPE using the debugger"]; SIGNAL RopeNeeded[refRef]; rope _ ToRope[refRef^ ! RopeNeeded => ERROR]; }; ENDCASE => rope _ ToRope[whenFailed]; }; LambdaRope: PUBLIC PROC [n: CD.Number, lambda: CD.Number_1] RETURNS [Rope.ROPE] = { IF n MOD lambda = 0 THEN RETURN IO.PutFR1[" %g", IO.int[n/lambda]] ELSE { r: Rope.ROPE _ " ("; IF n<0 THEN {n _ ABS[n]; r _ " -("}; IF n/lambda>0 THEN r _ IO.PutFR["%0g%0g+", IO.rope[r], IO.int[n/lambda]]; RETURN [IO.PutFR["%0g%0g/%0g)", IO.rope[r], IO.int[n MOD lambda], IO.int[lambda]]]; } }; -- -- -- -- -- -- <<--CallWithResource>> reCheck: CONDITION _ [timeout: Process.MsecToTicks[1000]]; Enter: ENTRY PROC [resource: REF, wait: BOOL, design: REF] RETURNS [ok: BOOL] = { IF design=NIL THEN design _ $NIL; DO ok _ RefTab.Insert[resourceTab, resource, design]; IF ok OR ~wait THEN EXIT; WAIT reCheck; ENDLOOP }; Leave: ENTRY PROC [resource: REF] = { [] _ RefTab.Delete[resourceTab, resource]; BROADCAST reCheck }; CallWithResource: PUBLIC PROC [proc: PROC[CDSequencer.Command], comm: CDSequencer.Command, resource: REF, abortFlag: REF BOOL_NIL, waitIfBusy: BOOL _ FALSE] RETURNS [skipped: BOOL_TRUE] = { <<--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 >> ENABLE UNWIND => Leave[resource]; design: CD.Design = IF comm#NIL THEN comm.design ELSE NIL; IF ~Enter[resource, waitIfBusy, design] THEN TerminalIO.WriteRope[" not reentrant; skipped\n"] ELSE { previous: REF _ CDValue.Fetch[design, abortFlagKey]; CDValue.Store[boundTo: design, key: abortFlagKey, value: abortFlag]; IF abortFlag#NIL THEN abortFlag^ _ FALSE; proc[comm]; IF abortFlag#NIL AND abortFlag^ THEN TerminalIO.WriteRope[" aborted\n"] ELSE skipped _ FALSE; CDValue.Store[boundTo: design, key: abortFlagKey, value: previous]; Leave[resource]; } }; PlaceInst: PUBLIC PROC [design: CD.Design, ob: CD.Object, commHint: REF_NIL] RETURNS [inst: CD.Instance] = { GetGrid: PROC [design: CD.Design, commHint: REF_NIL] RETURNS [g: CD.Number_0] = { <<--figures out grid used for a particular design or viewer>> v: ViewerClasses.Viewer _ GetViewer[design, commHint]; IF v#NIL THEN { WITH ViewerOps.GetViewer[v, $Grid] SELECT FROM ri: REF INT => g _ ri^; ENDCASE => NULL; }; IF g<=0 THEN g _ design.technology.lambda; }; GetViewer: PROC [design: CD.Design, commHint: REF_NIL] RETURNS [ViewerClasses.Viewer_NIL] = { <<--figures out "the" viewer issued for a design>> v: ViewerClasses.Viewer_NIL; vL: CDViewer.ViewerList_NIL; WITH commHint SELECT FROM v2: ViewerClasses.Viewer => v _ v2; comm: CDSequencer.Command => IF comm.design=design OR comm.design=NIL THEN v _ CDViewer.GetViewer[comm]; ENDCASE => NULL; IF v#NIL AND CDViewer.DesignOf[v]=design THEN RETURN [v]; vL _ CDViewer.ViewersOf[design]; IF vL#NIL AND CDViewer.DesignOf[vL.first]=design THEN RETURN [vL.first]; }; lambda: CD.Number _ design.technology.lambda; grid: CD.Number _ MAX[1, GetGrid[design, commHint]]; space, w1, w2: CD.Number; bb: CD.Rect _ CDCommandOps.BoundingBox[design]; IF ~CDBasics.NonEmpty[bb] THEN bb _ [0, 0, 0, 0]; w1 _ MAX[lambda*5, bb.x2-bb.x1]; w2 _ MAX[lambda*5, CD.InterestSize[ob].x]; space _ MIN[w1, w2]/8+MAX[w1, w2]/80+lambda*4; inst _ CDInstances.NewInstI[ob: ob, location: [(bb.x2+space+grid-1)/grid*grid, (bb.y1+grid-1)/grid*grid] ]; CDOps.IncludeInstance[design, inst]; }; 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 OR 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] }; cnt: INT _ 0; RegisterWithMenu: PUBLIC PROC [menu: REF_NIL, entry: Rope.ROPE_NIL, doc: Rope.ROPE_NIL, key: ATOM_NIL, proc: CDSequencer.CommandProc_NIL, queue: CDSequencer.QueueMethod_doQueue, tech: CD.Technology_NIL] = { IF key=NIL THEN key _ Atom.MakeAtom[IO.PutFR1["a%g", IO.int[cnt _ cnt+1]]]; IF proc#NIL THEN CDSequencer.ImplementCommand[key: key, proc: proc, queue: queue, technology: tech]; IF menu#NIL THEN [] _ PopUpMenus.Entry[CDPopUpMenus.GetMenu[menu], entry, NIL, key, doc]; }; SetCurrentLayer: PROC [comm: CDSequencer.Command] = { props: CDProperties.PropRef _ GetMyProps[comm.key]; x: REF _ CDProperties.GetProp[props, comm.design.technology.key]; IF x=NIL THEN x _ CDProperties.GetProp[props, $all]; WITH x SELECT FROM lora: LIST OF REF ANY => { lay: CD.Layer _ CD.errorLayer; w: INT _ -1; WITH lora.first SELECT FROM l: REF CD.Layer => lay _ l^; ENDCASE => NULL; IF lora.rest#NIL THEN WITH lora.rest.first SELECT FROM i: REF INT => w _ i^ ENDCASE => NULL; IF w>=0 THEN CDLayers.SetLayerWidth[comm.design, lay, w]; CDLayers.SetCurrentLayer[comm.design, lay]; TerminalIO.WriteRopes["set default layer: ", CDOps.LayerName[lay], "\n"]; }; ENDCASE => TerminalIO.WriteF["command %g failed\n", [atom[comm.key]]]; }; myKey: REF INT _ NEW[INT]; GetMyProps: ENTRY PROC [a: ATOM] RETURNS [props: CDProperties.PropRef_NIL] = { ENABLE UNWIND => NULL; IF a=NIL THEN RETURN WITH ERROR CD.Error[noResource]; WITH CDProperties.GetAtomProp[a, myKey] SELECT FROM pr: CDProperties.PropRef => RETURN [pr]; ENDCASE => NULL; props _ CDProperties.InitPropRef[]; CDProperties.PutAtomProp[a, myKey, props]; }; RegisterCurrentLayerCommand: PUBLIC PROC [key: ATOM, layer: CD.Layer, tech: CD.Technology, w: CD.Number_-1] = { props: CDProperties.PropRef _ GetMyProps[key]; tKey: ATOM _ IF tech#NIL THEN tech.key ELSE $all; CDProperties.PutProp[props, tKey, LIST[NEW[CD.Layer_layer], NEW[INT_w]]]; CDSequencer.ImplementCommand[key: key, proc: SetCurrentLayer, queue: doQueue, technology: tech]; }; resourceTab: RefTab.Ref ~ RefTab.Create[3]; abortFlagKey: REF _ resourceTab; CDEvents.RegisterEventProc[$Abort, AbortEvent]; END.