<> <> <> <> 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] = { <<--caller trusts that nobody did change referee's int value>> <<--caller promises that he won't change referee's int value>> 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.