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 25, 1986 6:00:53 pm PDT
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 {
--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:
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𡤀
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.