CDCommandOpsImpl.mesa
Copyright © 1984 by Xerox Corporation.  All rights reserved.
by Christian Jacobi   July 12, 1984 3:49:16 pm PDT 
last edited Christian Jacobi   November 5, 1984 10:21:20 am PST
 
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𡤎 ENDCASE => NULL 
 
}
 
END;
 
GeneralCommand: 
PROC [comm: CDSequencer.Command] =
BEGIN
n: NAT𡤀
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𡤀] =
BEGIN
TerminalIO.WriteRope["  ("];
IF aptr=NIL THEN TerminalIO.WriteRope["no object"]
ELSE {
TerminalIO.WriteRope[CDOps.Info[aptr.ob]];
IF verbosity>0 
THEN {
x: REF ~ CDProperties.GetPropFromApplication[aptr, $SignalName];
IF x#
NIL 
THEN
WITH x 
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: BOOLLSE]
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.