PopUpMenusImpl.mesa
Copyright © 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 26, 1986 10:00:47 am PDT
DIRECTORY
PopUpSelection,
PopUpMenus,
Rope;
PopUpMenusImpl: CEDAR MONITOR
IMPORTS Rope, PopUpSelection
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: ROPENIL, doc: ROPENIL, clientData: REFNIL] 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: ROPENIL, proc: EntryProc←NIL, entryData: REFNIL, doc: ROPENIL] 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 {
--remove entry
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 {
--add entry
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𡤀, proc: EntryProc←NIL, entryData: REFNIL] 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: REFNIL] 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: REFNIL, position: REFNIL, default: REFNIL] 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𡤀
IF menu=NIL THEN RETURN WITH ERROR Error;
docL ← CONS[menu.doc, menu.docs];
IF default#NIL THEN n ← GetDefaultN[menu, default];
n ← PopUpSelection.Request[header: menu.header, choice: menu.entries, headerDoc: menu.doc, choiceDoc: menu.docs, default: n, timeOut: menu.time, position: position];
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.