DIRECTORY PopUpMenu, PopUpMenus, Rope; PopUpMenusImpl: CEDAR MONITOR IMPORTS Rope, PopUpMenu EXPORTS PopUpMenus = BEGIN OPEN PopUpMenus; MenuInternal: TYPE = RECORD [ header, doc: ROPE, entries, docs: LIST OF ROPE, time: INT, timePair, skipPair: Pair, pairs: LIST OF Pair, data: REF ]; Pair: TYPE = RECORD [proc: EntryProc, entryData: REF]; Error: ERROR = CODE; Create: PUBLIC PROC [header: ROPE_NIL, doc: ROPE_NIL, clientData: REF_NIL] RETURNS [m: Menu] = { m _ NEW[MenuRep_[ impl: NEW[MenuInternal_[ header: header, doc: doc, entries: NIL, docs: NIL, pairs: NIL, time: 0, timePair: [NIL, NIL], skipPair: [NIL, NIL], data: clientData ]] ]] }; Entry: PUBLIC ENTRY PROC [menu: Menu, entry: ROPE_NIL, proc: EntryProc_NIL, entryData: REF_NIL, doc: ROPE_NIL] RETURNS [sameMenu: Menu] = { ENABLE UNWIND => NULL; IF menu=NIL THEN RETURN WITH ERROR Error; sameMenu _ menu; WITH menu.impl SELECT FROM menu: REF MenuInternal => { eL: LIST OF ROPE _ menu.entries; dL: LIST OF ROPE _ menu.docs; pL: LIST OF Pair _ menu.pairs; IF proc=NIL AND entry=NIL THEN { IF eL=NIL OR dL=NIL OR pL=NIL THEN RETURN; IF Rope.Equal[eL.first, entry] THEN { menu.entries _ menu.entries.rest; menu.docs _ menu.docs.rest; menu.pairs _ menu.pairs.rest; RETURN }; DO IF eL.rest=NIL OR dL.rest=NIL OR pL.rest=NIL THEN RETURN; IF Rope.Equal[eL.rest.first, entry] THEN { eL.rest _ eL.rest.rest; dL.rest _ dL.rest.rest; pL.rest _ pL.rest.rest; RETURN }; eL _ eL.rest; --not nil dL _ dL.rest; pL _ pL.rest; ENDLOOP } ELSE { IF eL=NIL OR dL=NIL OR pL=NIL THEN { menu.entries _ LIST[entry]; menu.docs _ LIST[doc]; menu.pairs _ LIST[Pair[proc, entryData]]; RETURN }; DO IF Rope.Equal[eL.first, entry] THEN { dL.first _ doc; pL.first _ Pair[proc, entryData]; RETURN; }; IF eL.rest=NIL OR dL.rest=NIL OR pL.rest=NIL THEN { eL.rest _ LIST[entry]; dL.rest _ LIST[doc]; pL.rest _ LIST[Pair[proc, entryData]]; RETURN }; eL _ eL.rest; --not nil dL _ dL.rest; pL _ pL.rest; ENDLOOP } }; ENDCASE => RETURN WITH ERROR Error }; Timeout: PUBLIC ENTRY PROC [menu: Menu, time: INT_0, proc: EntryProc_NIL, entryData: REF_NIL] RETURNS [sameMenu: Menu] = { ENABLE UNWIND => NULL; IF menu=NIL THEN RETURN WITH ERROR Error; sameMenu _ menu; WITH menu.impl SELECT FROM menu: REF MenuInternal => { menu.timePair _ [proc, entryData]; menu.time _ time; }; ENDCASE => RETURN WITH ERROR Error; }; Skipped: PUBLIC PROC [menu: Menu, proc: EntryProc_NIL, entryData: REF_NIL] RETURNS [sameMenu: Menu] = { ENABLE UNWIND => NULL; IF menu=NIL THEN RETURN WITH ERROR Error; sameMenu _ menu; WITH menu.impl SELECT FROM menu: REF MenuInternal => menu.skipPair _ [proc, entryData]; ENDCASE => RETURN WITH ERROR Error; }; Call: PUBLIC PROC [menu: Menu, callData: REF_NIL, position: REF_NIL, default: REF_NIL] RETURNS [REF] = { NthPair: PROC [menu: REF MenuInternal, n: INT] RETURNS [pair: Pair] = { pl: LIST OF Pair _ menu.pairs; IF n<=0 THEN RETURN[IF n=0 THEN menu.skipPair ELSE menu.timePair]; FOR i: INT IN [0..n-1) DO IF pl#NIL THEN pl _ pl.rest ENDLOOP; IF pl#NIL THEN RETURN[pl.first] ELSE RETURN [menu.skipPair] }; GetDefaultN: PROC [menu: REF MenuInternal, default: REF] RETURNS [n: INT _ 0] = { FOR pl: LIST OF Pair _ menu.pairs, pl.rest WHILE pl#NIL DO n _ n+1; IF pl.first.entryData=default THEN RETURN ENDLOOP; WITH default SELECT FROM r: Rope.ROPE => {n _ 0; FOR rl: LIST OF ROPE _ menu.entries, rl.rest WHILE rl#NIL DO n _ n+1; IF Rope.Equal[rl.first, r] THEN RETURN ENDLOOP }; ENDCASE => NULL; RETURN [0] }; DoIt: ENTRY PROC [menu: REF MenuInternal] RETURNS [pair: Pair] = { ENABLE UNWIND => NULL; docL: LIST OF ROPE; n: INT_0; IF menu=NIL THEN RETURN WITH ERROR Error; docL _ CONS[menu.doc, menu.docs]; IF default#NIL THEN n _ GetDefaultN[menu, default]; n _ PopUpMenu.RequestSelection[label: menu.header, choice: menu.entries, default: n, timeOut: menu.time, mouse: docL]; pair _ NthPair[menu, n]; }; WITH menu.impl SELECT FROM mi: REF MenuInternal => { pair: Pair _ DoIt[mi]; IF pair.proc#NIL THEN RETURN [pair.proc[menu, pair.entryData, callData]]; RETURN [pair.entryData]; }; ENDCASE => ERROR; }; ClientData: PUBLIC PROC [menu: Menu] RETURNS [REF] = { WITH menu.impl SELECT FROM menu: REF MenuInternal => RETURN [menu.data]; ENDCASE => NULL; RETURN WITH ERROR Error; }; END. ςPopUpMenusImpl.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Created by: Christian Jacobi, August 22, 1986 11:00:59 am PDT Last Edited by: Christian Jacobi, August 25, 1986 6:00:53 pm PDT --remove entry --add entry Κš˜codešœ™Kšœ Οmœ1™