PopUpMenusImpl.mesa
Copyright Ó 1986, 1991 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:
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
]]
]]
};
ReLabel:
PUBLIC ENTRY PROC [menu: Menu, header:
ROPE¬
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 => {
menu.header ¬ header;
menu.doc ¬ doc;
};
ENDCASE => RETURN WITH ERROR Error
};
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 {
--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¬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 ¬ 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.