DIRECTORY
CedarScanner,
FileIO,
IO,
Menus,
Rope,
ViewerClasses;

MenuParser: CEDAR  PROGRAM

IMPORTS FileIO, IO, CedarScanner, Rope =

BEGIN OPEN CedarScanner;

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

<<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];
};

Debug: PROC [msg: Rope.ROPE] =  {
IO.PutF[errorLog, "%g\n", IO.rope[msg]];
IO.Flush[errorLog];
}; -- Debug
 
SyntaxError: PROC = {
<<this routine is called any time a syntax error is discovered.>>
IO.PutF[errorLog, "Syntax error found at token beginning in position [%d]\n",  IO.int[t.start]];
ERROR;
};

CurrentContentsAre: PROC [r: Rope.ROPE] RETURNS [BOOLEAN] = {
RETURN[Rope.Equal[r, ContentsFromToken[[Get,NIL], t] ] ];
};

CurrentContents: PROC [] RETURNS [Rope.ROPE] = {
RETURN[ContentsFromToken[[Get,NIL], t] ];
};

ContentsAre: PROC [r: Rope.ROPE] RETURNS [BOOLEAN] = {
RETURN[ Rope.Equal[r, ContentsFromToken[[Get,NIL],t], FALSE] ];
};

GetNext: PROC[kind:TokenKind _ tokenERROR, string: Rope.ROPE _ NIL, first: BOOL _ FALSE] = {
t _ GetToken[[Get, NIL], IF first THEN 0 ELSE t.next];
Debug[Rope.Cat["Just Got Token -->", ContentsFromToken[[Get, NIL], t], "<--"] ];
IF kind # tokenERROR THEN {
IF t.kind # kind THEN SyntaxError;
IF string # NIL THEN IF NOT Rope.Equal[string, ContentsFromToken[[Get, NIL], t]] THEN SyntaxError;
};
};

MustBe: PROC[string: Rope.ROPE _ NIL] = {
IF NOT Rope.Equal[string, ContentsFromToken[[Get, NIL], t]] THEN SyntaxError;
};

SeparateQualifiedName: PROC[name:Rope.ROPE] RETURNS[first:Rope.ROPE, second:Rope.ROPE] = {
periodIndex: INTEGER _  Rope.Index[s1: name,  s2: "."];
IF periodIndex = Rope.Length[name] THEN SyntaxError;
first _ Rope.Substr[name, 0, periodIndex];
second _ Rope.Substr[name, periodIndex + 1, Rope.Length[name] - periodIndex -1]; 
RETURN[first, second];
};

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[RopeFromToken[[GetForNamesFromRope, string], myToken], answer];
myToken _ GetToken[[GetForNamesFromRope, string], myToken.next];
ENDLOOP;
RETURN[answer];
};




<<the user entry>>
ParseDescription: PROC [def: Rope.ROPE, prevlist: LIST OF Menus.Menu _ NIL, errorFile: Rope.ROPE _ "menuParse.errlog"] RETURNS 
[LIST OF Menus.Menu] = {
errorLog _ FileIO.Open[errorFile, overwrite];
Debug["starting"];
globalRope _ def;
IO.Put[errorLog,  IO.rope["Menu ErrorLog:\n\n"] ];
GetNext[first: TRUE];
menus _ prevlist;
WHILE t.kind # tokenEOF DO
SELECT t.kind FROM
tokenID => {
MustBe["Relabel"];
ParseRelabel[];
};
tokenSINGLE => {
MustBe["["];
ParseMenu[];
};
ENDCASE => SyntaxError;
GetNext;
ENDLOOP;
RETURN[menus];
};

<<>>
<<internal parsing routines>>
ParseRelabel: PROC [] = {
menuname: Rope.ROPE _ NIL;
module: Rope.ROPE;
oldname: Rope.ROPE;
newname: Rope.ROPE;
GetNext[tokenID, "["];
GetNext[tokenROPE];
oldname _ CurrentContents[];
[module, oldname] _ SeparateQualifiedName[oldname];
GetNext[tokenROPE];
newname _ CurrentContents[];
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.name _ 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.first _ 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;
GetNext;
ENDLOOP; -- while

};

ParseEntries: PROC [newMenu: REF Menus.Menu] = {
newEntry: REF Menus.Entry;
WHILE CurrentContentsAre["["] DO
newEntry _ NEW[Menus.Entry];
GetNext[tokenID];
newEntry.name _ CurrentContents[];
ParseEntryParms[newEntry];
GetNext[tokenDOUBLE, "=>"];
GetNext;
IF CurrentContentsAre["["] THEN newEntry.actions _ GetComplex[]
ELSE {
MustBe["=>"];
newEntry.actions _ LIST[ Menus.EntryNotifyRecord[trigger: LIST[all], notifyData: GetListOfRefAny[]] ];
GetNext[tokenSINGLE, "]"]; 
};
<<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^]; 
};
ENDLOOP;
};

ParseEntryParms: PROC [newEntry: REF Menus.Entry] = {
<<assumes first token already read for it by the caller.>>
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 THEN newEntry.displayData _ CurrentContents[]
ELSE newEntry.displayData _ GetDisplayProc[];
}
ELSE SyntaxError;
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 CurrentContentsAre["["] DO
newEntryNotifyRec _ NEW[Menus.EntryNotifyRecord];
newEntryNotifyRec.trigger _ GetTriggers[];
ParseTriggerParms[newEntryNotifyRec];
MustBe["=>"];
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;
RETURN[answer];
};

GetTriggers: PROC [] RETURNS [answer: 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.>>
answer _ NIL;
GetNext;
IF CurrentContentsAre["["] THEN {
GetNext[tokenID];
WHILE t.kind = tokenID DO
<<order for this list doesn't matter, so I can just CONS it onto the front>>
TriggerFromRope[CurrentContents[], answer];
ENDLOOP;
MustBe["]"];
}
ELSE IF t.kind = tokenID THEN TriggerFromRope[CurrentContents[], answer]
ELSE SyntaxError;
};

TriggerFromRope: PROC [r: Rope.ROPE, l: LIST OF Menus.MenuEntryTrigger] = {
<<the Trigger(s) the rope indicates are CONSed onto the front of the list>>
SELECT TRUE FROM
Rope.Equal["notrigger", r] => NULL;
Rope.Equal["all", r] => l _ CONS[all, l];
Rope.Equal["leftup", r] => l _ CONS[leftup, l];
Rope.Equal["middleup", r] => l _ CONS[middleup, l];
Rope.Equal["rightup", r] => l _ CONS[rightup, l];
Rope.Equal["shiftleftup", r] => l _ CONS[shiftleftup, l];
Rope.Equal["shiftmiddleup", r] => l _ CONS[shiftmiddleup, l];
Rope.Equal["shiftrightup", r] => l _ CONS[shiftrightup, l];
Rope.Equal["allnonshifts", r] => {
l _ CONS[leftup, l];
l _ CONS[middleup, l];
l _ CONS[rightup, l]
};
Rope.Equal["allshifts", r] => {
l _ CONS[shiftleftup, l];
l _ CONS[shiftmiddleup, l];
l _ CONS[shiftrightup, l]
};
ENDCASE => SyntaxError;
};

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;
GetNext;
ENDLOOP; -- while
};

GetListOfRefAny: PROC [] RETURNS [answer: LIST OF REF ANY] = {
<<reads until it hits a ']'  assumes caller has NOT read the first token>>
r: LIST OF REF ANY _ NIL; -- the reversed list  order matters here
answer _ NIL;
MustBe["=>"];
GetNext;
WHILE NOT CurrentContentsAre["]"] 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];
tokenCOMMENT => NULL;
ENDCASE => SyntaxError;
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] = {
<<runtime stuff>>
ERROR;
};

GetNotifyProc: PROC [] RETURNS [ViewerClasses.NotifyProc] = {
<<runtime stuff>>
ERROR;
};

GetDisplayProc: PROC [] RETURNS [REF Menus.DrawingRec] = {
<<runtime stuff>>
ERROR;
};

GetBoolean: PROC [] RETURNS [answer: BOOLEAN] = {
GetNext[tokenID];
IF ContentsAre["TRUE"] THEN RETURN[TRUE]
ELSE IF ContentsAre["FALSE"] THEN RETURN[FALSE]
ELSE SyntaxError;
};








END.