
 
DIRECTORY
Process,
Rope,
X11PopUpSelection,
Xl,
XlCursor,
XTk,
XTkFriends,
XTkWidgets;

X11PopUpSelectionImplTk: CEDAR MONITOR
IMPORTS Process, Rope, Xl, XlCursor, XTkFriends, XTkWidgets
EXPORTS X11PopUpSelection
~ BEGIN OPEN Xl, XTk, XTkWidgets, X11PopUpSelection;

lastRefInt: INT = 9;
ri: REF ARRAY [0..lastRefInt] OF REF INT = NEW[ARRAY [0..lastRefInt] OF REF INT];
NewInt: PROC [i: INT] RETURNS [REF INT] = {
IF i>=0 AND i<=lastRefInt THEN RETURN [ri[i]];
RETURN [NEW[INTмi]];
};

ROPE: TYPE = Rope.ROPE;

gConnection: Xl.Connection м NIL;
cond: CONDITION;

PositionAndScreen: PROC [connection: Xl.Connection] RETURNS [pos: Point, s: Screen] = { 
pointerQuery: PointerReply м QueryPointer[connection, nullWindow];
pos м pointerQuery.pos; 
s м QueryScreen[connection, pointerQuery.root];
IF s=NIL THEN s м FirstScreen[connection]
};

MakeConnection: ENTRY PROC [] RETURNS [c: Xl.Connection] = {
ENABLE UNWIND => NULL;
c м gConnection;
IF ~Xl.Alive[c] THEN c м gConnection м Xl.CreateConnection[server: NIL];
};

MenuRec: TYPE = RECORD [
shell: XTk.Widget м NIL,
allDone: BOOL м FALSE,
selection: INT м -1
];

ReCheck: ENTRY PROC [] = {
ENABLE UNWIND => NULL;
BROADCAST cond
};

WaitDone: ENTRY PROC [menu: REF MenuRec] = {
ENABLE UNWIND => NULL;
DO 
IF menu.allDone THEN RETURN;
IF menu.shell.fastAccessAllowed#ok THEN RETURN;
IF ~Xl.Alive[menu.shell.connection] THEN RETURN;
WAIT cond;
ENDLOOP;
};

Hit: XTkWidgets.ButtonHitProcType = {
menu: REF MenuRec м NARROW[registerData];
menu.selection м NARROW[callData, REF INT]н;
menu.allDone м TRUE;
ReCheck[];
};

mySpace: Xl.Size = [5, 3];

Request: PUBLIC PROC [
header: Rope.ROPE м NIL, choice: LIST OF Rope.ROPE, 
headerDoc: Rope.ROPE м NIL, choiceDoc: LIST OF Rope.ROPE м NIL,
default: NAT м 0, timeOut: NAT м 0, position: REF м NIL,
connection: REF м NIL
] RETURNS [INT] = {
c: Xl.Connection м NIL; transientFor: XTk.Widget м NIL;
point: Xl.Point; screen: Xl.Screen; container: XTk.Widget; i: INT м 0; 
choiceCursor, backCursor: Xl.Cursor;
menu: REF MenuRec м NEW[MenuRec];
WITH connection SELECT FROM
w: XTk.Widget => {c м w.connection; transientFor м w};
connection: Xl.Connection => c м connection;
ENDCASE => c м gConnection;
IF ~Xl.Alive[c] THEN c м MakeConnection[];
choiceCursor м XlCursor.SharedStandardCursor[c, sbLeftArrow];
backCursor м XlCursor.SharedStandardCursor[c, circle];
[point, screen] м PositionAndScreen[c];
container м XTkWidgets.CreateYStack[];
container.attributes.cursor м backCursor;
menu.shell м XTkWidgets.CreateShell[
widgetSpec: [geometry: Xl.Geometry[pos: point]],
windowHeader: """popup"" menu",
child: container, 
dontQueryGeometry: TRUE
];
XTkWidgets.BindScreenShell[menu.shell, c, screen.root];
IF ~Rope.IsEmpty[header] THEN {
hw: Widget м XTkWidgets.CreateLabel[text: header, style: [styleKey: $WhiteOnBlack]];
XTkWidgets.AppendChild[container: container, child: hw]
};
FOR cl: LIST OF Rope.ROPE м choice, cl.rest WHILE cl#NIL DO
help: Rope.ROPE м IF choiceDoc=NIL THEN NIL ELSE choiceDoc.first; 
entry: Widget м XTkWidgets.CreateButton[text: cl.first, style: [space: mySpace], hitProc: Hit, registerData: menu, callData: NewInt[(iмi+1)], help: help];
entry.attributes.cursor м choiceCursor;
XTkWidgets.AppendChild[container: container, child: entry];
IF choiceDoc#NIL THEN choiceDoc м choiceDoc.rest;
ENDLOOP;
BEGIN
entry: Widget м XTkWidgets.CreateButton[text: "DISCARD MENU", style: [space: mySpace], hitProc: Hit, registerData: menu, callData: NewInt[0], help: "no action"];
entry.attributes.cursor м choiceCursor;
XTkWidgets.AppendChild[container: container, child: entry];
END;
BEGIN
compensate: Size ~ [-1, -10]; --compensate for window manager decorations
preferred: Xl.Geometry м XTkFriends.PreferredSizeLR[menu.shell]; --not yet realized!
szh: REF ICCCMHints м XTkWidgets.GetHints[menu.shell];
szh.wmNormalHints.userPos м szh.wmNormalHints.clientPos м TRUE;
szh.wmNormalHints.userSize м szh.wmNormalHints.clientSize м TRUE;
szh.transientFor м transientFor;
point.x м MAX[MIN[point.x, screen.sizeInPixels.width - preferred.size.width - compensate.width], 0];
point.y м MAX[MIN[point.y, screen.sizeInPixels.height - preferred.size.height - compensate.height], 0];
menu.shell.s.geometry.pos м point; 
szh.wmNormalHints.obsoletePos м point;
szh.wmNormalHintsChanged м TRUE;
szh.transientForChanged м TRUE;
END;
XTkWidgets.RealizeShell[menu.shell];
WaitDone[menu];
XTkWidgets.DestroyShell[menu.shell];
RETURN [menu.selection];
};

InitModule: ENTRY PROC = TRUSTED {
ENABLE UNWIND => NULL;
FOR i: INT IN [0..lastRefInt] DO ri[i] м NEW[INTмi] ENDLOOP;
Process.InitializeCondition[@cond, Process.MsecToTicks[10000]];
};

InitModule[];
END.

  V  X11PopUpSelectionImplTk.mesa
Copyright ╙ 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Created by Christian Jacobi, April 21, 1988 2:49:13 pm PDT
Christian Jacobi, March 9, 1992 4:29 pm PST 
--caller trusts that nobody did change referee's int value
--caller promises that he won't change referee's int value
Э╩п  Ц(cedarcode) styleХNewlineDelimiter
Ш ЩIcodeЪЬ
╧eЬIЩTKЩ:KЩ,ЧKШЪ╧k	Ш	KШKШKШKЪЬШKШ	KШKШKШЧKШ Ъ╧nЬЮЬЮШ&KЪЮЬ4Ш;KЪЮЬШЧЪЬЮЬЮЬ(Ш4KШ ЧKЪЬЮЬШKЪЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШQЪЯЬЮЬЮЬЮЬЮЬЮЬШ+JЪ╧c:Щ:JЪа:Щ:KЪЮЬЮЬЮЬЮЬ	Ш.KЪЮЬЮЬЮЬШKШЧKШ KЪЮЬЮЬЮЬШKШ KЪЬЮЬШ!KЪЬЮ	ЬШKШ ЪЯЬЮЬЮЬШXKШBKШKШ/KЪЮЬЮЬЮЬШ)KШЧKШ ЪЯЬЮЬЮЬЮЬШ<KЪЮЬЮЬЮЬШKШKЪЮЬЮЬ/ЮЬШHKШЧKШ ЪЬ	ЮЬЮЬШKЪЬЮЬШKЪЬ	ЮЬЮЬШKЪЬЮЬШKШЧKШ ЪЯЬЮЬЮЬШKЪЮЬЮЬЮЬШKЪЮ	ЬШKШЧKШ ЪЯЬЮЬЮЬЮЬШ,KЪЮЬЮЬЮЬШЪЮЬШKЪЮЬЮЬЮЬШKЪЮЬ!ЮЬЮЬШ/KЪЮЬ"ЮЬЮЬШ0KЪЮЬШ
KЪЮЬШЧKШЧKШ ЪЯЬ"Ш%KЪЬЮЬЮЬШ)KЪЬЮЬЮЬЮЬШ,KЪЬЮЬШKШ
KШЧKШ KЪЬШKШ Ъ,ЯЬЮЬЮЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШюKЪЬЮЬЮЬШ7KЪЬ>ЮЬШGKЪЬ$Ш$KЪЬЮЬЮЬ
Ш!ЪЮЬЮЬЮШKШ6KЪЬ,Ш,KЪЮЬШЧKЪЮЬЮЬШ*KШ=KШ6KШ'KШ&KШ)Ш$KЪЬ0Ш0KШKШKЪЬЮШKШЧKЪЬ7Ш7ЪЮЬЮЬШKЪЬTШTKШ7KШЧЪЮЬЮЬЮЬЮЬЮЬЮЬЮШ;KЪЬЮЬЮЬЮЬЮЬЮЬЮЬШBKШЪKШ'KШ;KЪЮЬЮЬЮЬШ1KЪЮЬШЧЪЮШKШбKШ'KШ;KЪЮЬШЧЪЮШKЪЬа+ШIKЪЬAаШTKЪЬЮЬ.Ш6KЪЬ:ЮЬШ?KЪЬ<ЮЬШAKШ KЪЬ
ЮЬЮЬSШdKЪЬ
ЮЬЮЬVШgKШ#KЪЬ&Ш&KЪЬЮЬШ KЪЬЮЬШKЪЮЬШЧKЪЬ$Ш$KШKШ$KЪЮЬШKШЧKШ ЪЯ
ЬЮЬЮЬЮЬШ"KЪЮЬЮЬЮЬШKЪЮЬЮЬЮЬЮЬ	ЮЬЮЬЮЬШ<KШ?KШЧKШ KШKЪЮЬШKШ Ч ЕЧ       %  