DIRECTORY
AMBridge,
CedarScanner,
FileIO,
Interpreter,
IO,
Menus,
Rope,
RTBasic,
ViewerClasses;

MenuParserImpl: CEDAR  PROGRAM

IMPORTS AMBridge, CedarScanner, FileIO, Interpreter, IO, Rope EXPORTS Menus =

BEGIN OPEN CedarScanner;

<<global data:>>
t: Token;
menus: LIST OF Menus.Menu _ NIL;
globalRope: Rope.ROPE;
errorLog: Rope.ROPE;
syntaxErrorFound: SIGNAL;

<<the user entry>>
ParseDescription: PUBLIC PROC [def: Rope.ROPE, prevlist: LIST OF Menus.Menu _ NIL, errorFile: Rope.ROPE _ NIL] RETURNS [LIST OF 
Menus.Menu] = {
ENABLE syntaxErrorFound => GOTO SyntaxErrorExit;
errorLog _ IF errorFile = NIL THEN "menus.errlog" ELSE errorFile;
globalRope _ def;
GetNext[first: TRUE];
menus _ prevlist;
WHILE t.kind # tokenEOF DO
SELECT t.kind FROM
tokenID => {
MustBe["Relabel"];
ParseRelabel[];
};
tokenSINGLE => {
MustBe["["];
ParseMenu[];
};
ENDCASE => SyntaxError["Was expecting keyword 'relabel' or '[' to start menu definition"];
MustBe["]"];
GetNext;
ENDLOOP;
RETURN[menus];
EXITS SyntaxErrorExit => { RETURN[NIL] };
};


<<utilty procedures:>>
Get: GetProc = {
<<[data: REF, index: INT] RETURNS [CHAR]>>
length: INTEGER _ Rope.Length[globalRope];
IF index >= length THEN RETURN[IO.NUL]
ELSE RETURN Rope.Fetch[globalRope, index];
};

SyntaxError: PROC [msg: Rope.ROPE] = {
<<this routine is called any time a syntax error is discovered.>>
file: IO.STREAM _ FileIO.Open[errorLog, overwrite];
IO.PutF[file, "MenuParse ErrorLog:\n\n"];
IO.PutF[file, "Syntax error found at token beginning in position [%d]\n", IO.int[t.start] ];
IF msg # NIL THEN IO.PutF[file, "TYPE OF ERROR: [%g]\n\n\n", IO.rope[msg] ];
IO.Flush[file];
SIGNAL syntaxErrorFound;
};

ContentsAre: PROC [r: Rope.ROPE] RETURNS [BOOLEAN] = {
RETURN[Rope.Equal[r, CurrentContents[], FALSE] ];
};

CurrentContents: PROC [] RETURNS [Rope.ROPE] = {
<<one special case: A rope literal would normally return with the quote marks still in the string>>
IF t.kind = tokenROPE THEN {
dummy: Rope.ROPE _ ContentsFromToken[[Get,NIL], t];
RETURN[Rope.Substr[dummy, 1, Rope.Length[dummy] - 2] ];
}
ELSE RETURN[ContentsFromToken[[Get,NIL], t] ];
};

GetNext: PROC[kind:TokenKind _ tokenERROR, string: Rope.ROPE _ NIL, first: BOOL _ FALSE] = {
t _ GetToken[[Get, NIL], IF first THEN 0 ELSE t.next];
WHILE t.kind = tokenCOMMENT DO
t _ GetToken[[Get, NIL], t.next];
ENDLOOP;

IF kind # tokenERROR THEN {
IF t.kind # kind THEN {
IF string # NIL THEN SyntaxError[Rope.Cat["Was Expecting the token ->", string, "<-"]]
ELSE SyntaxError[Rope.Cat["Was expecting ",
SELECT kind FROM
tokenID => "an identifier, like a menu name, or an entry name, for example",
tokenINT => "an integer",
tokenREAL => "a real number",
tokenROPE => "a quoted string",
tokenATOM => "an atom",
tokenSINGLE => "a single character token, like '[' or '{', for example",
tokenDOUBLE => "a double character token, like '=>', for example",
ENDCASE => "a different kind of token"]];
};
IF string # NIL THEN IF NOT Rope.Equal[string, CurrentContents[], FALSE ] THEN SyntaxError[Rope.Cat["Was Expecting the token ->", 
string, "<-"]];
};
};

MustBe: PROC[string: Rope.ROPE _ NIL] = {
IF NOT Rope.Equal[string, CurrentContents[], FALSE] THEN SyntaxError[Rope.Cat["Was Expecting the token ->", string, "<-"]];
};

GetForNamesFromRope: GetProc = {
<<[data: REF, index: INT] RETURNS [CHAR]>>
length: INTEGER _ Rope.Length[NARROW[data]];
IF index >= length THEN RETURN[IO.NUL]
ELSE RETURN Rope.Fetch[NARROW[data], index];
};

GetNamesFromRope: PROC[string: Rope.ROPE] RETURNS[answer: LIST OF Rope.ROPE] = {
myToken: Token;
answer _ NIL;
myToken _ GetToken[[GetForNamesFromRope, string], 0];
WHILE myToken.kind = tokenID DO
answer _ CONS[ContentsFromToken[[GetForNamesFromRope, string], myToken], answer];
myToken _ GetToken[[GetForNamesFromRope, string], myToken.next];
ENDLOOP;
RETURN[answer];
};

<<>>
<<internal parsing routines>>
ParseRelabel: PROC [] = {
<<assumes that the first '[' hasn't been read>>
firstParm: Rope.ROPE _ NIL;
secondParm: Rope.ROPE _ NIL;
menuname: Rope.ROPE _ NIL;
oldname: Rope.ROPE;
newname: Rope.ROPE;
GetNext[tokenSINGLE, "["];
GetNext[tokenID];
firstParm _ CurrentContents[];
GetNext[tokenID];
secondParm _ CurrentContents[];
GetNext;
IF t.kind = tokenID THEN {
menuname _ firstParm;
oldname _ secondParm;
newname _ CurrentContents[];
GetNext[tokenSINGLE, "]"];
}
ELSE {
<<the menuname is nil>>
menuname _ NIL;
oldname _ firstParm;
newname _ secondParm;
};
MustBe["]"];

<<now affect the data structure>>
FOR l: LIST OF Menus.Menu _ menus, l.rest UNTIL l = NIL DO
IF menuname = NIL OR Rope.Equal[menuname, l.first.name] THEN
FOR e: LIST OF Menus.Entry _ l.first.entries, e.rest UNTIL e = NIL DO
IF Rope.Equal[e.first.name, oldname] THEN e.first.displayData _ newname;
ENDLOOP;
ENDLOOP;
};

ParseMenu: PROC= {
replacement: BOOLEAN _ FALSE;
prev: LIST OF Menus.Menu _ NIL;
newMenu: REF Menus.Menu _ NEW[Menus.Menu];
GetNext[tokenID];
newMenu.name _ CurrentContents[];
GetNext;
ParseMenuParms[newMenu];
MustBe["["];
ParseEntries[newMenu];
MustBe["]"];
FOR l: LIST OF Menus.Menu _ menus, l.rest UNTIL l = NIL DO
IF Rope.Equal[newMenu.name, l.first.name] THEN  {
l.first _ newMenu^;
replacement _ TRUE;
};
prev _ l;
ENDLOOP;
IF NOT replacement THEN {
IF menus = NIL THEN menus _ LIST[newMenu^]
ELSE prev.rest _ LIST[newMenu^];
};
};


ParseMenuParms: PROC [newMenu: REF Menus.Menu] = {
<<assumes first token already read for it by the caller.>>
WHILE t.kind = tokenID DO
IF ContentsAre["breakBefore"] THEN {
GetNext[tokenSINGLE, ":"];
newMenu.breakBefore _ GetBoolean[];
}
ELSE IF ContentsAre["breakAfter"] THEN {
GetNext[tokenSINGLE, ":"];
newMenu.breakAfter _ GetBoolean[];
}
ELSE IF ContentsAre["beginsActive"] THEN {
GetNext[tokenSINGLE, ":"];
newMenu.beginsActive _ GetBoolean[];
}
ELSE IF ContentsAre["notifyProc"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext[tokenSINGLE, "{"];
newMenu.notify _ GetNotifyProc[];
}
ELSE SyntaxError["Was expecting a menu parameter keyword ('breakBefore', 'breakAfter', 'beginsActive', or 'notifyProc')"];
GetNext;
ENDLOOP; -- while

};

ParseEntries: PROC [newMenu: REF Menus.Menu] = {
newEntry: REF Menus.Entry;
WHILE ContentsAre["["] DO
newEntry _ NEW[Menus.Entry];
GetNext[tokenID];
newEntry.name _ CurrentContents[];
ParseEntryParms[newEntry];
MustBe["=>"];
GetNext;
IF ContentsAre["["] THEN newEntry.actions _ GetComplex[]
ELSE {
newEntry.actions _ LIST[ Menus.EntryNotifyRecord[trigger: LIST[all], notifyData: GetListOfRefAny[]] ];
};
<<add entry to the menu, at the end of the list:>>
IF newMenu.entries = NIL THEN newMenu.entries _ LIST[newEntry^]
ELSE {
prev: LIST OF Menus.Entry _ NIL;
FOR l: LIST OF Menus.Entry _ newMenu.entries, l.rest UNTIL l = NIL DO
prev _ l;
ENDLOOP;
prev.rest _ LIST[newEntry^]; 
};
MustBe["]"];
GetNext[];
ENDLOOP;
MustBe["]"];
};

ParseEntryParms: PROC [newEntry: REF Menus.Entry] = {
<<assumes first token NOT read for it by the caller.>>
GetNext[];
WHILE t.kind = tokenID DO
IF ContentsAre["guarded"] THEN {
GetNext[tokenSINGLE, ":"];
newEntry.guarded _ GetBoolean[];
}
ELSE IF ContentsAre["display"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext;
IF t.kind = tokenROPE OR t.kind = tokenID THEN newEntry.displayData_CurrentContents[]
ELSE IF ContentsAre["{"] THEN newEntry.displayData _ GetDisplayProc[]
ELSE SyntaxError["Was Expecting an word, quoted string, or {...} for display: parameter"];
}
ELSE SyntaxError["Was expecting an entry keyword parameter ('guarded' or 'display')"];
GetNext;
ENDLOOP; -- while
};

GetComplex: PROC [] RETURNS[answer: LIST OF Menus.EntryNotifyRecord] = {
newEntryNotifyRec: REF Menus.EntryNotifyRecord;
<<assumes first token already read for it by the caller.>>
answer _ NIL;
MustBe["["];
WHILE ContentsAre["["] DO
newEntryNotifyRec _ NEW[Menus.EntryNotifyRecord];
newEntryNotifyRec.trigger _ GetTriggers[];
ParseTriggerParms[newEntryNotifyRec];
MustBe["=>"];
GetNext;
newEntryNotifyRec.notifyData _ GetListOfRefAny[];
MustBe["]"];
<<add newEntryNotifyRec to answer, at the end of the list:>>
IF answer = NIL THEN answer _ LIST[newEntryNotifyRec^]
ELSE {
prev: LIST OF Menus.EntryNotifyRecord _ NIL;
FOR l: LIST OF Menus.EntryNotifyRecord _ answer, l.rest UNTIL l = NIL DO
prev _ l;
ENDLOOP;
prev.rest _ LIST[newEntryNotifyRec^]; 
};
GetNext;
ENDLOOP;
MustBe["]"];
RETURN[answer];
};

GetTriggers: PROC [] RETURNS [l: LIST OF Menus.MenuEntryTrigger] = {
<<NOTE: triggers can either be a single ID, or '[' ID* ']'  we do NOT assume that the caller has read our first token!  We DO NOT 
eat the next token, either.>>
r: Rope.ROPE;
l _ NIL;
GetNext;
IF ContentsAre["["] THEN {
GetNext[tokenID];
WHILE t.kind = tokenID DO
<<order for this list doesn't matter, so I can just CONS it onto the front>>
r _ CurrentContents[];
SELECT TRUE FROM
Rope.Equal["notrigger", r, FALSE] => NULL;
Rope.Equal["all", r, FALSE] => l _ CONS[all, l];
Rope.Equal["leftup", r, FALSE] => l _ CONS[leftup, l];
Rope.Equal["middleup", r, FALSE] => l _ CONS[middleup, l];
Rope.Equal["rightup", r, FALSE] => l _ CONS[rightup, l];
Rope.Equal["shiftleftup", r, FALSE] => l _ CONS[shiftleftup, l];
Rope.Equal["shiftmiddleup", r, FALSE] => l _ CONS[shiftmiddleup, l];
Rope.Equal["shiftrightup", r, FALSE] => l _ CONS[shiftrightup, l];
Rope.Equal["allnonshifts", r, FALSE] => {
l _ CONS[leftup, l];
l _ CONS[middleup, l];
l _ CONS[rightup, l]
};
Rope.Equal["allshifts", r, FALSE] => {
l _ CONS[shiftleftup, l];
l _ CONS[shiftmiddleup, l];
l _ CONS[shiftrightup, l]
};
Rope.Equal["allleft", r, FALSE] => {
l _ CONS[leftup, l];
l _ CONS[shiftleftup, l];
};
Rope.Equal["allmiddle", r, FALSE] => {
l _ CONS[middleup, l];
l _ CONS[shiftmiddleup, l];
};
Rope.Equal["allright", r, FALSE] => {
l _ CONS[rightup, l];
l _ CONS[shiftrightup, l];
};
ENDCASE => SyntaxError["Was expecting a trigger keyword ('all', 'leftup', 'leftshiftup', etc)"];
GetNext;
ENDLOOP;
MustBe["]"];
}
ELSE IF t.kind = tokenID THEN {
r _ CurrentContents[];
SELECT TRUE FROM
Rope.Equal["notrigger", r, FALSE] => NULL;
Rope.Equal["all", r, FALSE] => l _ CONS[all, l];
Rope.Equal["leftup", r, FALSE] => l _ CONS[leftup, l];
Rope.Equal["middleup", r, FALSE] => l _ CONS[middleup, l];
Rope.Equal["rightup", r, FALSE] => l _ CONS[rightup, l];
Rope.Equal["shiftleftup", r, FALSE] => l _ CONS[shiftleftup, l];
Rope.Equal["shiftmiddleup", r, FALSE] => l _ CONS[shiftmiddleup, l];
Rope.Equal["shiftrightup", r, FALSE] => l _ CONS[shiftrightup, l];
Rope.Equal["allnonshifts", r, FALSE] => {
l _ CONS[leftup, l];
l _ CONS[middleup, l];
l _ CONS[rightup, l]
};
Rope.Equal["allshifts", r, FALSE] => {
l _ CONS[shiftleftup, l];
l _ CONS[shiftmiddleup, l];
l _ CONS[shiftrightup, l]
};
Rope.Equal["allleft", r, FALSE] => {
l _ CONS[leftup, l];
l _ CONS[shiftleftup, l];
};
Rope.Equal["allmiddle", r, FALSE] => {
l _ CONS[middleup, l];
l _ CONS[shiftmiddleup, l];
};
Rope.Equal["allright", r, FALSE] => {
l _ CONS[rightup, l];
l _ CONS[shiftrightup, l];
};
ENDCASE => SyntaxError["Was expecting a trigger keyword ('all', 'leftup', 'leftshiftup', etc)"];
}
ELSE SyntaxError["Was Expecting a trigger keyword or list of them surrounded by brackets '[' (triggers are 'all', 'leftup', 
'leftshiftup', etc)"];
};

TriggerFromRope: PROC [r: Rope.ROPE, l: LIST OF Menus.MenuEntryTrigger] = {
<<the Trigger(s) the rope indicates are CONSed onto the front of the list>>
};

ParseTriggerParms: PROC [newEntryNotifyRec: REF Menus.EntryNotifyRecord] = {
<<Does NOT assume first token already read for it by the caller.>>
GetNext;
WHILE t.kind = tokenID DO
IF ContentsAre["popUpDoc"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext[tokenROPE];
newEntryNotifyRec.popupDoc _ CurrentContents[];
}
ELSE IF ContentsAre["makeActive"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext[tokenROPE];
newEntryNotifyRec.makeActive _ GetNamesFromRope[CurrentContents[]];
}
ELSE IF ContentsAre["makeInActive"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext[tokenROPE];
newEntryNotifyRec.makeInActive _ GetNamesFromRope[CurrentContents[]];
}
ELSE IF ContentsAre["toggle"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext[tokenROPE];
newEntryNotifyRec.toggle _ GetNamesFromRope[CurrentContents[]];
}
ELSE IF ContentsAre["guardResponse"] THEN {
GetNext[tokenSINGLE, ":"];
GetNext;
IF t.kind = tokenROPE THEN newEntryNotifyRec.guardResponse _ CurrentContents[]
ELSE newEntryNotifyRec.guardResponse _ GetGuardResponseProc[];
}
ELSE SyntaxError["Was expecting a trigger parameter ('popUpDoc', 'makeActive', 'makeInActive', 'toggle', or 'guardResponse')"];
GetNext;
ENDLOOP; -- while
};

GetListOfRefAny: PROC [] RETURNS [answer: LIST OF REF ANY] = {
<<reads until it hits a ']'  assumes caller has read the first token>>
r: LIST OF REF ANY _ NIL; -- the reversed list  order matters here
answer _ NIL;
WHILE NOT (ContentsAre["]"]  OR ContentsAre["}"]) DO
SELECT t.kind FROM
tokenINT => r _ CONS[NEW[INTEGER _ IntFromToken[[Get,NIL], t]], r];
tokenREAL => r _ CONS[NEW[REAL _ RealFromToken[[Get,NIL], t]], r];
tokenROPE => r _ CONS[RopeFromToken[[Get,NIL], t], r]; -- Rope is already a REF
tokenATOM => r _ CONS[NEW[ATOM _ AtomFromToken[[Get,NIL], t]], r];
ENDCASE => SyntaxError["Was expecting a valid token for a LIST OF REF ANY"];
GetNext;
ENDLOOP;
<<now build the list we really want to return, which has the proper order:>>
FOR l: LIST OF REF ANY _ r, l.rest UNTIL l = NIL DO
answer _ CONS[l.first, answer];
ENDLOOP;
};

GetGuardResponseProc: PROC [] RETURNS [REF Menus.UnGuardRec] = {
RETURN[
NEW [Menus.UnGuardRec _ [NARROW[GeneralGetProc[], REF Menus.UnGuardProc] ^, GetListOfRefAny[] ] ]
];
};

GetNotifyProc: PROC [] RETURNS [answer: ViewerClasses.NotifyProc] = {
answer _ NARROW[GeneralGetProc[], REF ViewerClasses.NotifyProc]^;
MustBe["}"]; -- all the other guys call GetListOfRefAny, but notify procs specs don't get parms
RETURN[ NARROW[GeneralGetProc[], REF ViewerClasses.NotifyProc]^ ];
};

GetDisplayProc: PROC [] RETURNS [REF Menus.DrawingRec] = {
RETURN[
NEW [Menus.DrawingRec _ [NARROW[GeneralGetProc[], REF Menus.DrawingProc] ^, GetListOfRefAny[] ] ]
];
};

GetQualifiedName: PROC [] RETURNS [Rope.ROPE] = {
<<assumes first token not read, doesn't read past where it needs to>>
firstPart: Rope.ROPE;
secondPart: Rope.ROPE;
GetNext[tokenID];
firstPart _ CurrentContents[];
GetNext[tokenSINGLE, "."];
GetNext[tokenID];
secondPart _ CurrentContents[];
RETURN[Rope.Cat[firstPart, ".", secondPart] ];
};

GeneralGetProc: PROC [] RETURNS [REF ANY] = {
<<assumes the "{" read by caller, doesn't read past where it needs to>>
qualifiedName: Rope.ROPE;
temp: RTBasic.TV;
myRef: REF ANY;

MustBe["{"];
qualifiedName _ GetQualifiedName[];
GetNext; -- GetListOfRefAny will always be called right after me, and wants first token read

[temp, ----, ----] _ Interpreter.Evaluate[qualifiedName];
TRUSTED {myRef _ AMBridge.SomeRefFromTV[temp]};
RETURN[myRef];

};

GetBoolean: PROC [] RETURNS [answer: BOOLEAN] = {
GetNext[tokenID];
IF ContentsAre["TRUE"] THEN RETURN[TRUE]
ELSE IF ContentsAre["FALSE"] THEN RETURN[FALSE]
ELSE SyntaxError["Was expecting to find a boolean keyword (either 'TRUE' or 'FALSE')"];
};








END.