<> <> <> <> DIRECTORY Atom, List, CD USING [Technology], CDMenus, CDProperties, CDSequencer, RefTab, Rope, TerminalIO; CDMenusImpl: CEDAR MONITOR IMPORTS Atom, List, CDProperties, CDSequencer, RefTab, Rope, TerminalIO EXPORTS CDMenus = BEGIN globalTab: RefTab.Ref = RefTab.Create[]; Menu: TYPE = RECORD [ label: Rope.ROPE_NIL, ropeL: LIST OF Rope.ROPE_NIL, --ropeL and keyL are always used parallel keyL: LIST OF REF_NIL ]; CreateMenu: PUBLIC PROC [label: Rope.ROPE_NIL, globalKey: ATOM_NIL] RETURNS [menu: REF] = BEGIN menu _ NEW[Menu_[label: label]]; IF globalKey#NIL THEN [] _ RefTab.Store[globalTab, globalKey, menu]; END; RefToMenu: PROC [keyOrMenu: REF] RETURNS [menu: REF Menu_NIL] = BEGIN WITH keyOrMenu SELECT FROM a: ATOM => { x: REF; found: BOOL; [found, x] _ globalTab.Fetch[a]; menu _ NARROW[x] }; rm: REF Menu => menu _ rm; ENDCASE => menu _ NIL; END; GetMenu: PUBLIC PROC [globalKey: ATOM] RETURNS [menu: REF] = BEGIN menu _ RefToMenu[globalKey] END; CreateEntry: PUBLIC PROC [menu: REF, entry: Rope.ROPE_NIL, key: REF] = <<--menu: an ATOM => fetch for menu with globalKey>> <<-- a menu => use menu>> <<--key: an ATOM => use CDSequencer>> <<-- a menu => use menu>> BEGIN m: REF Menu = RefToMenu[menu]; IF m=NIL THEN RETURN; <<--check for defaults on entry>> IF Rope.IsEmpty[entry] THEN WITH key SELECT FROM a: ATOM => entry _ Atom.GetPName[a]; rm: REF Menu => entry _ rm.label; ENDCASE => NULL; IF key#NIL THEN { <<--include or replace the entry>> IF m.ropeL=NIL OR m.keyL=NIL THEN { m.ropeL _ LIST[entry]; m.keyL _ LIST[key]; } ELSE { rL: LIST OF Rope.ROPE _ m.ropeL; kL: LIST OF REF _ m.keyL; <<--ASSERT rL # NIL>> DO IF Rope.Equal[rL.first, entry] THEN { kL.first _ key; RETURN }; IF rL.rest=NIL OR kL.rest=NIL THEN { rL.rest _ LIST[entry]; kL.rest _ LIST[key]; RETURN }; rL _ rL.rest; --not nil kL _ kL.rest; ENDLOOP } } ELSE { --key=NIL <<--remove the entry>> IF m.ropeL=NIL OR m.keyL=NIL THEN RETURN; IF Rope.Equal[m.ropeL.first, entry] THEN { m.ropeL _ m.ropeL.rest; m.keyL _ m.keyL.rest } ELSE { rL: LIST OF Rope.ROPE _ m.ropeL; -- not NIL kL: LIST OF REF _ m.keyL; <<--ASSERT rL # NIL>> DO IF rL.rest=NIL OR kL.rest=NIL THEN RETURN ELSE { IF Rope.Equal[rL.rest.first, entry] THEN { rL.rest _ rL.rest.rest; kL.rest _ kL.rest.rest; RETURN }; rL _ rL.rest; kL _ kL.rest; }; ENDLOOP } } END; CallMenu: PUBLIC PROC [menu: REF] RETURNS [key: REF_NIL] = <<--the atom wil be changed to the menu atom>> BEGIN n: INT; m: REF Menu = RefToMenu[menu]; x: REF; IF m=NIL THEN { TerminalIO.WriteRope["**menu not handled\n"]; RETURN }; <<--now call the menu>> IF ~Rope.IsEmpty[m.label] THEN { TerminalIO.WriteRope["menu "]; TerminalIO.WriteRope[m.label]; TerminalIO.WriteRope[" "]; }; IF m.ropeL=NIL THEN { TerminalIO.WriteRope[" no entry for menu\n"]; RETURN [NIL] }; n _ TerminalIO.RequestSelection[m.label, m.ropeL]; IF n=0 THEN { TerminalIO.WriteRope[" discarded\n"]; RETURN [NIL] }; WITH x _ List.NthElement[m.keyL, n] SELECT FROM mm: REF Menu => { TerminalIO.WriteRope[" -> "]; key _ CallMenu[mm]; }; ENDCASE => { TerminalIO.WriteRope["selects "]; TRUSTED{TerminalIO.WriteRope[NARROW[List.NthElement[LOOPHOLE[m.ropeL], n]]]}; TerminalIO.WriteRope["\n"]; key _ x; }; END; CallCommand: PUBLIC PROC [menu: REF, comm: CDSequencer.Command] = <<--the atom will be changed to the menu atom>> BEGIN key: REF = CallMenu[menu].key; WITH key SELECT FROM a: ATOM => CDSequencer.ExecuteCommand[comm: comm, command: a]; ENDCASE => IF key#NIL THEN TerminalIO.WriteRope["** bad menu; not a command\n"]; END; MenuCommand: PROC [comm: CDSequencer.Command] = BEGIN WITH CDProperties.GetPropFromAtom[from: comm.a, prop: menuProperty] SELECT FROM menuList: Atom.PropList => { menu: REF _ Atom.GetPropFromList[menuList, comm.design.technology.key]; IF menu=NIL THEN menu _ Atom.GetPropFromList[menuList, $any]; CallCommand[menu, comm]; }; ENDCASE => TerminalIO.WriteRope["**menu not executed\n"]; END; ImplementMenuCommand: PUBLIC ENTRY PROC[a: ATOM, menu: REF, technology: CD.Technology_NIL] = BEGIN ENABLE UNWIND => NULL; techKey: ATOM = ( IF technology=NIL THEN $any ELSE technology.key ); menuList: Atom.PropList _ NIL; WITH CDProperties.GetPropFromAtom[from: a, prop: menuProperty] SELECT FROM ml: Atom.PropList => menuList_ml; ENDCASE => NULL; menuList _ Atom.PutPropOnList[propList: menuList, prop: techKey, val: menu]; CDProperties.PutPropOnAtom[onto: a, prop: menuProperty, val: menuList]; CDSequencer.ImplementCommand[a, MenuCommand, technology, dontQueue]; END; menuProperty: REF ATOM = NEW[ATOM _ $menuProperty]; --no accessible END.