<*PRAGMA LL*>Partitioning following the efforts of Steve.Freeman@computer-lab.cambridge.ac.uk - 92-05-13
UNSAFE MODULE---------- various utilities ----------; IMPORT XClient, TrestleOnX, TrestleClass, Trestle, Rect, ProperSplit, IntRefTbl, IntTextTbl, TextIntTbl, X, XEventQueue, Thread, XAtomQueue, XScreenType, VBT, Ctypes, TrestleComm, Fmt, XProperties, RTParams, KeyboardKey, RTHeapRep, VBTClass, Env, M3toC, XInput, XMessenger, Split, Text, IP, ASCII, XExtensions, IntIntTbl, XClientExt, TrslOnXF; FROM XClient IMPORT T; REVEAL SimpleWaitFor = SimpleWaitForPublic BRANDED OBJECT OVERRIDES match := SimpleMatch; notify := SimpleNotify; END; T_Abs = T_Ext BRANDED OBJECT await: WaitFor := NIL; (* list of awaited events *) awaitCount := ARRAY [0 .. X.LASTEvent - 1] OF INTEGER{0, ..}; (* awaitCount[i] is the number of awaited events that might match an event of type i. *) awaitCountExt: IntIntTbl.T := NIL; (* X extensions use event types > X.LastEvent, but we don't know what values, so keep any extension values in a table *) coverage : CARDINAL := 0; atomQ := XAtomQueue.Empty; atomCount := 0; (* atomQ contains atoms that are available for transferring selections; atomCount is the number of atoms that have been created solely for this purpose. *) meterMaid: Thread.T := NIL; gcCursor : X.Cursor := X.None; END; PROCEDURE XClientF SimpleMatch (wf: SimpleWaitFor; READONLY ev: X.XEvent): BOOLEAN = VAR match: BOOLEAN; BEGIN WITH e = LOOPHOLE(ADR(ev), X.XAnyEventStar), type = e.type DO IF type = 0 THEN match := LOOPHOLE(ADR(ev), X.XErrorEventStar).serial = wf.reqno ELSE match := e.window = wf.d END; IF match THEN FOR i := FIRST(wf.types) TO LAST(wf.types) DO IF wf.types[i] = type THEN RETURN TRUE END END END; RETURN FALSE END END SimpleMatch; PROCEDURESimpleNotify ( wf : SimpleWaitFor; READONLY evRec: X.XEvent; xcon : XClient.T ) = BEGIN wf.turn := TRUE; wf.ev := evRec; wf.timeout := FALSE; Thread.Signal(wf); WHILE wf.turn AND NOT xcon.dead DO Thread.Wait(xcon, wf); END; END SimpleNotify; PROCEDUREStartMeterMaid (trsl: T; stackSize := 20000) = BEGIN EVAL Thread.Fork( NEW(MeterMaidClosure, trsl := trsl, stackSize := stackSize)); END StartMeterMaid; TYPE MeterMaidClosure = Thread.SizedClosure OBJECT trsl: XClient.T OVERRIDES apply := MeterMaid END; PROCEDUREMeterMaid (cl: MeterMaidClosure): REFANY RAISES {} = VAR prev, wf: WaitFor; BEGIN WITH trsl = cl.trsl DO LOOP Thread.Pause(1.0D0); LOCK trsl DO prev := NIL; wf := trsl.await; WHILE wf # NIL DO IF wf.timelimit = 0 OR trsl.dead THEN DeleteWait(trsl, prev, wf); wf.turn := TRUE; wf.timeout := TRUE; Thread.Signal(wf); wf := prev ELSIF wf.timelimit > 0 THEN DEC(wf.timelimit) END; IF wf = NIL THEN wf := trsl.await ELSE prev := wf; wf := wf.next END; END; IF trsl.await = NIL THEN trsl.meterMaid := NIL; RETURN NIL END END END END END MeterMaid; PROCEDUREKill (trsl: T) <* LL.sup = trsl *> = BEGIN LOCK TrestleClass.closeMu DO IF NOT trsl.closed THEN trsl.closed := TRUE; END END; trsl.dead := TRUE; Thread.Broadcast(trsl.qEmpty); Thread.Broadcast(trsl.qNonEmpty); Thread.Broadcast(trsl.evc); IF trsl.meterMaid = NIL AND trsl.await # NIL THEN StartMeterMaid(trsl) END; EVAL Thread.Fork(NEW(KillClosure, trsl := trsl)) END Kill; TYPE KillClosure = Thread.Closure OBJECT trsl: T OVERRIDES apply := DoKill END; PROCEDUREDoKill (self: KillClosure): REFANY RAISES {} = BEGIN LOCK self.trsl DO TRY X.XCloseDisplay(self.trsl.dpy) EXCEPT X.Error => (* skip *) END END; Thread.Pause(60.0D0); LOCK errMu DO FOR i := 0 TO LAST(dpyTable^) DO IF dpyTable[i].trsl = self.trsl THEN dpyTable[i].trsl := NIL END END END; RETURN NIL END DoKill; PROCEDUREAwait (trsl: T_Abs; wf: WaitFor; timelimit: INTEGER := -1): INTEGER RAISES {TrestleComm.Failure} = (* LL = trsl *) BEGIN IF trsl.dead THEN RETURN Timeout END; RegisterWaiter(trsl, wf); RETURN WaitWaiter(trsl, wf, timelimit); END Await; PROCEDUREDeleteWait (trsl: T; prev, wf: WaitFor) = VAR count: INTEGER; type : X.Int; BEGIN IF prev = NIL THEN trsl.await := wf.next ELSE prev.next := wf.next END; wf.next := NIL; FOR i := FIRST(wf.types) TO LAST(wf.types) DO type := wf.types[i]; WITH tbl = trsl.awaitCountExt DO CASE type OF | -1 => (* skip *) | 0 .. X.LASTEvent - 1 => DEC(trsl.awaitCount[type]); ELSE IF tbl # NIL AND tbl.get(type, count) THEN DEC(count); IF count = 0 THEN EVAL tbl.delete(type, count); IF tbl.size() = 0 THEN trsl.awaitCountExt := NIL; END; ELSE EVAL tbl.put(type, count); END; END; END; END; END END DeleteWait; PROCEDUREFindWaiter (trsl: T; READONLY ev: X.XEvent): WaitFor = (* LL = trsl *) VAR res, prev: WaitFor; count: INTEGER; BEGIN WITH e = LOOPHOLE(ADR(ev), X.XAnyEventStar) DO CASE e.type OF | 0..X.LASTEvent - 1 => IF trsl.awaitCount[e.type] = 0 THEN RETURN NIL; END; ELSE IF trsl.awaitCountExt = NIL OR NOT trsl.awaitCountExt.get(e.type, count) OR count = 0 THEN RETURN NIL; END; END; prev := NIL; res := trsl.await; WHILE (res # NIL) AND NOT res.match(ev) DO prev := res; res := res.next END; IF res # NIL THEN DeleteWait(trsl, prev, res) END; RETURN res END END FindWaiter; PROCEDURERegisterWaiter (trsl: T_Abs; wf: WaitFor) = VAR count: INTEGER; type : X.Int; BEGIN FOR i := FIRST(wf.types) TO LAST(wf.types) DO type := wf.types[i]; CASE type OF | -1 => (* skip *) | 0 .. X.LASTEvent - 1 => INC(trsl.awaitCount[type]); ELSE IF trsl.awaitCountExt = NIL THEN trsl.awaitCountExt := NEW(IntIntTbl.Default).init(1); END; IF trsl.awaitCountExt.get(type, count) THEN INC(count); ELSE count := 1; END; EVAL trsl.awaitCountExt.put(type, count); END; END; wf.next := trsl.await; trsl.await := wf; END RegisterWaiter; PROCEDUREWaitWaiter (trsl: T_Abs; wf: WaitFor; timelimit: INTEGER := -1): INTEGER RAISES {TrestleComm.Failure} = BEGIN TRY IF trsl.dead THEN RETURN Timeout END; wf.timelimit := timelimit; IF trsl.meterMaid = NIL THEN trsl.meterMaid := Thread.Fork(NEW(MeterMaidClosure, trsl := trsl, stackSize := 20000)) END; X.XFlush(trsl.dpy); IF X.XEventsQueued(trsl.dpy, X.QueuedAfterReading) # 0 THEN Thread.Signal(trsl.qNonEmpty) END; WHILE NOT wf.turn DO Thread.Wait(trsl, wf) END; wf.turn := FALSE; Thread.Signal(wf); IF wf.timeout THEN RETURN Timeout; END; WITH e = LOOPHOLE(ADR(wf.ev), X.XAnyEventStar) DO RETURN e.type END; EXCEPT X.Error => RAISE TrestleComm.Failure END; END WaitWaiter;
PROCEDURE---------- connection management ----------ToRect (x, y, width, height: INTEGER): Rect.T = BEGIN RETURN Rect.T{west := x, north := y, east := x + width, south := y + height} END ToRect; PROCEDURENewAtom (v: T): X.Atom RAISES {TrestleComm.Failure} = <*FATAL XAtomQueue.Exhausted*> BEGIN IF XAtomQueue.IsEmpty(v.atomQ) THEN INC(v.atomCount); RETURN XClient.ToAtom(v, "_DEC_TRESTLE_NEWATOM_" & Fmt.Int(v.atomCount)) END; RETURN XAtomQueue.Remove(v.atomQ) END NewAtom; PROCEDUREFreeAtom (v: T; VAR sym: X.Atom) = BEGIN IF sym # X.None THEN XAtomQueue.Insert(v.atomQ, sym); sym := X.None END END FreeAtom; PROCEDUREBackDoor (v: T; READONLY ev: X.XEvent) = BEGIN XEventQueue.Insert(v.errq, ev); Thread.Signal(v.qNonEmpty) END BackDoor; PROCEDURESetUngrabs (trsl: T) RAISES {TrestleComm.Failure} = BEGIN TRY FOR i := FIRST(Ungrab) TO LAST(Ungrab) DO trsl.ungrab[i] := X.XKeysymToKeycode(trsl.dpy, Ungrab[i]) END; EXCEPT X.Error => RAISE TrestleComm.Failure END; (* for all vbts, fix the grabs they have by ungrabbing all, and regrabbing what we want -- someday. *) END SetUngrabs; PROCEDUREValidateNW (trsl: T; ch: Child; st: XScreenType.T) RAISES {TrestleComm.Failure} = VAR chw: X.Window; h, v: Ctypes.int; BEGIN TRY IF NOT ch.nwValid THEN ch.nwValid := X.XTranslateCoordinates( trsl.dpy, ch.w, st.root, 0, 0, ADR(h), ADR(v), ADR(chw)) # X.False; ch.nw.v := v; ch.nw.h := h END; EXCEPT X.Error => RAISE TrestleComm.Failure END; END ValidateNW; PROCEDUREGetDomain (ur: Child; VAR (*OUT*) width, height: CARDINAL) = (* Return the domain of ur's X window, or 0,0 when the window is unmapped, and clear ur.reshapeComing. LL = ur.ch.parent *) BEGIN IF ur.mapped THEN width := ur.width; height := ur.height ELSE width := 0; height := 0 END; ur.reshapeComing := FALSE END GetDomain; PROCEDUREAdjustCoverage (xcon: T; d: [-1 .. 1] := 0) RAISES {TrestleComm.Failure} = BEGIN TRY INC(xcon.coverage, d); IF xcon.coverage = 0 THEN X.XFlush(xcon.dpy) END; IF X.XEventsQueued(xcon.dpy, X.QueuedAfterReading) # 0 THEN Thread.Signal(xcon.qNonEmpty) END; EXCEPT X.Error => RAISE TrestleComm.Failure END; END AdjustCoverage; PROCEDUREDelete (trsl: XClient.T; ch: VBT.T; ur: Child) RAISES {} = VAR junk: REFANY; code := VBT.Deleted; BEGIN IF ur = NIL THEN RETURN END; LOCK trsl DO EVAL trsl.vbts.delete(ur.w, junk); FOR s := FIRST(trsl.sel^) TO LAST(trsl.sel^) DO IF trsl.sel[s].v = ch THEN trsl.sel[s].v := NIL END END; IF trsl.dead THEN code := VBT.Disconnected END; ur.xcage := X.None END; ProperSplit.Delete(trsl, ur); VBTClass.Misc(ch, VBT.MiscRec{code, VBT.NullDetail, 0, VBT.NilSel}); VBT.Discard(ch) END Delete; PROCEDUREReshape (ch: VBT.T; width, height: CARDINAL; sendMoved := FALSE) = (* Reshape ch to new width and height. If this is a no-op, but sendMoved is true, then send a miscellaneous code. LL = VBT.mu *) BEGIN IF (ch.domain.east # width) OR (ch.domain.south # height) THEN WITH new = Rect.FromSize(width, height) DO VBTClass.Reshape(ch, new, Rect.Meet(ch.domain, new)) END ELSIF sendMoved THEN VBTClass.Misc( ch, VBT.MiscRec{VBT.Moved, VBT.NullDetail, 0, VBT.NilSel}) END END Reshape;
TYPE DpyTable = REF ARRAY OF RECORD dpy : X.DisplayStar; trsl: T END; VAR errMu := NEW(MUTEX); (* LL > any VBT. *) (* protection = errMu *) dpyTable, hackDpyTable: DpyTable := NIL;
maps dpys and hack dpys to their corresponding Ts.
VAR openMu := NEW(MUTEX); (* LL maximal *) opening := FALSE; firstTime := TRUE; PROCEDUREConnect (inst: TEXT; trsl: T := NIL): Trestle.T RAISES {TrestleComm.Failure} = VAR dpy, hackdpy : X.DisplayStar := NIL; cpos, dpos : INTEGER; machine, rest, fullinst: TEXT; BEGIN TRY IF inst = NIL AND Env.Get("ARGOENABLED") # NIL THEN inst := Env.Get("TRUE_DISPLAY"); END; IF inst = NIL THEN inst := Env.Get("DISPLAY"); END; IF inst = NIL THEN inst := ":0" END; cpos := Text.FindChar(inst, ':'); dpos := Text.FindCharR(inst, '.'); IF cpos >= 0 AND Text.Length(inst) > cpos + 1 AND Text.GetChar(inst, cpos + 1) IN ASCII.Digits THEN TRY IF cpos = 0 THEN machine := IP.GetCanonicalByAddr(IP.GetHostAddr()); ELSE machine := Text.Sub(inst, 0, cpos); rest := IP.GetCanonicalByName(machine); IF rest # NIL THEN machine := rest END END; IF machine = NIL THEN machine := "localhost"; END; EXCEPT IP.Error => END; IF dpos <= cpos THEN rest := Text.Sub(inst, cpos) ELSE rest := Text.Sub(inst, cpos, dpos - cpos) END; IF machine = NIL THEN machine := "localhost"; END; fullinst := machine & rest; ELSE fullinst := inst END; WITH s = M3toC.SharedTtoS(inst) DO TRY LOCK openMu DO IF firstTime THEN TrslOnXF.Init(); firstTime := FALSE; EVAL Thread.Fork(NEW(InitClosure)) END; opening := TRUE END; dpy := X.XOpenDisplay(s); IF doHack THEN TRY hackdpy := X.XOpenDisplay(s) EXCEPT X.Error => hackdpy := NIL END END FINALLY M3toC.FreeSharedS(inst, s); LOCK openMu DO opening := FALSE END; END END; IF dpy = NIL THEN IF hackdpy = NIL THEN RAISE TrestleComm.Failure ELSE dpy := hackdpy; hackdpy := NIL END END; IF trsl = NIL THEN trsl := NEW(T) END; trsl.dpy := dpy; IF trsl.st = NIL THEN trsl.st := NEW(VBT.ScreenType) END; trsl.inst := inst; trsl.fullinst := fullinst; (* The st is irrelevant except that it must be non-NIL so that marking the trsl for redisplay is not a noop. *) trsl.gcCursor := X.None; TrestleOnX.Enter(trsl); TRY LOCK errMu DO WITH table = dpyTable, hack = hackDpyTable DO IF table = NIL THEN table := NEW(DpyTable, 1); IF doHack THEN hack := NEW(DpyTable, 1) END ELSE WITH new = NEW(DpyTable, NUMBER(table^) + 1) DO FOR i := 0 TO LAST(table^) DO new[i + 1] := table[i] END; table := new END; IF doHack AND hackdpy # NIL THEN WITH new = NEW(DpyTable, NUMBER(hack^) + 1) DO FOR i := 0 TO LAST(hack^) DO new[i + 1] := hack[i] END; hack := new END END END; table[0].trsl := trsl; table[0].dpy := trsl.dpy; IF doHack AND hackdpy # NIL THEN hack[0].trsl := trsl; hack[0].dpy := hackdpy END END END; trsl.sel := NEW(SelArray, 0); trsl.vbts := NEW(IntRefTbl.Default).init(); trsl.atoms := NEW(IntTextTbl.Default).init(); trsl.names := NEW(TextIntTbl.Default).init(); trsl.evc := NEW(Thread.Condition); trsl.qEmpty := NEW(Thread.Condition); trsl.qNonEmpty := NEW(Thread.Condition); trsl.defaultScreen := X.XDefaultScreen(trsl.dpy); trsl.screens := NEW(REF ARRAY OF XScreenType.T, X.XScreenCount(trsl.dpy)); trsl.takeFocus := XClient.ToAtom(trsl, "WM_TAKE_FOCUS"); trsl.wmMoved := XClient.ToAtom(trsl, "WM_MOVED"); trsl.decTakeFocus := XClient.ToAtom(trsl, "DEC_WM_TAKE_FOCUS"); trsl.protocols := XClient.ToAtom(trsl, "WM_PROTOCOLS"); trsl.deleteWindow := XClient.ToAtom(trsl, "WM_DELETE_WINDOW"); trsl.miscAtom := XClient.ToAtom(trsl, "_DEC_TRESTLE_MISCCODE"); trsl.paNewScreen := XClient.ToAtom(trsl, "_PALO_ALTO_NEW_SCREEN"); trsl.paNewDisplay := XClient.ToAtom(trsl, "_PALO_ALTO_NEW_DISPLAY"); trsl.paAddDisplay := XClient.ToAtom(trsl, "_PALO_ALTO_ADD_DISPLAY"); SetUngrabs(trsl); XProperties.ExtendSel(trsl.sel, VBT.Target); trsl.sel[VBT.Target.sel].name := XClient.ToAtom(trsl, "SECONDARY"); XProperties.ExtendSel(trsl.sel, VBT.Source); trsl.sel[VBT.Source.sel].name := XClient.ToAtom(trsl, "PRIMARY"); XProperties.ExtendSel(trsl.sel, VBT.KBFocus); trsl.sel[VBT.KBFocus.sel].name := X.None; FixForOpenWin(trsl); IF hackdpy # NIL THEN TRY trsl.gcCursor := X.XCreateFontCursor(hackdpy, 142 (*X.XC_trek*)); IF trsl.gcCursor # X.None THEN VAR bg, fg: X.XColor; BEGIN bg.red := 65535; bg.green := 65535; bg.blue := 65535; bg.flags := X.DoRed + X.DoGreen + X.DoBlue; fg.red := 65535; fg.green := 0; fg.blue := 0; fg.flags := X.DoRed + X.DoGreen + X.DoBlue; X.XRecolorCursor(hackdpy, trsl.gcCursor, ADR(fg), ADR(bg)) END END EXCEPT X.Error => trsl.gcCursor := X.None END END; XProperties.InitialiseXClient(trsl); XExtensions.InitXClient(trsl); FINALLY TrestleOnX.Exit(trsl, 1) END; FOR i := 0 TO LAST(trsl.screens^) DO trsl.screens[i] := XScreenType.New(trsl, trsl.dpy, i) END; XInput.Start(trsl); XMessenger.Start(trsl); TrestleOnX.Enter(trsl); TRY FOR i := 0 TO LAST(trsl.screens^) DO X.XSelectInput(trsl.dpy, trsl.screens[i].root, X.EnterWindowMask) END FINALLY TrestleOnX.Exit(trsl, -1) END; EXCEPT X.Error => RAISE TrestleComm.Failure END; RETURN trsl END Connect; PROCEDUREFixForOpenWin (trsl: T) RAISES {TrestleComm.Failure} = VAR selAtom := XClient.ToAtom(trsl, "_SUN_QUICK_SELECTION_KEY_STATE"); dupAtom := XClient.ToAtom(trsl, "DUPLICATE"); w := X.XRootWindow(trsl.dpy, X.XDefaultScreen(trsl.dpy)); type : X.Atom := X.None; len, remaining: INTEGER; format: Ctypes.int; data : Ctypes.unsigned_char_star; BEGIN TRY EVAL X.XGetWindowProperty( trsl.dpy, w, selAtom, 0, 1, X.False, X.AnyPropertyType, ADR(type), ADR(format), ADR(len), ADR(remaining), ADR(data)); IF type = X.None THEN X.XChangeProperty(trsl.dpy, w, selAtom, 4 (*atom*), 32, X.PropModeReplace, LOOPHOLE(ADR(dupAtom), Ctypes.unsigned_char_star), 1) END; EXCEPT X.Error => RAISE TrestleComm.Failure END; END FixForOpenWin; PROCEDUREDoConnect (<*UNUSED*> self : TrestleClass.ConnectClosure; inst : TEXT; <*UNUSED*> localOnly: BOOLEAN; VAR (*OUT*) t: Trestle.T): BOOLEAN = BEGIN TRY t := Connect(inst); RETURN TRUE EXCEPT TrestleComm.Failure => t := NIL; RETURN FALSE END END DoConnect; CONST Ungrab = ARRAY [0 .. 12] OF INTEGER{ KeyboardKey.Caps_Lock, KeyboardKey.Shift_Lock, KeyboardKey.Meta_L, KeyboardKey.Meta_R, KeyboardKey.Alt_L, KeyboardKey.Alt_R, KeyboardKey.Super_L, KeyboardKey.Super_R, KeyboardKey.Hyper_L, KeyboardKey.Hyper_R, KeyboardKey.Scroll_Lock, KeyboardKey.Kana_Lock, KeyboardKey.Num_Lock}; PROCEDUREIOError (dpy: X.DisplayStar): Ctypes.int RAISES {X.Error} = VAR trsl : T := NIL; found := FALSE; BEGIN IF doHack AND hackDpyTable # NIL THEN FOR i := 0 TO LAST(hackDpyTable^) DO IF dpy = hackDpyTable[i].dpy THEN RAISE X.Error END END END; LOCK errMu DO IF dpyTable # NIL THEN FOR i := 0 TO LAST(dpyTable^) DO IF dpyTable[i].dpy = dpy THEN trsl := dpyTable[i].trsl; found := TRUE; EXIT END END END END; IF trsl # NIL AND NOT trsl.dead THEN Kill(trsl) ELSIF NOT found THEN LOCK openMu DO IF NOT opening THEN RETURN iohandler(dpy) END END END; RAISE X.Error END IOError; PROCEDUREError (dpy: X.DisplayStar; errEv: X.XErrorEventStar): Ctypes.int = VAR trsl : T := NIL; ev : X.XEvent; found := FALSE; <* FATAL X.Error *> BEGIN IF doHack AND hackDpyTable # NIL THEN FOR i := 0 TO LAST(hackDpyTable^) DO IF dpy = hackDpyTable[i].dpy THEN RETURN 0 END END END; WITH evp = LOOPHOLE(ADR(ev), X.XErrorEventStar) DO evp^ := errEv^ END; LOCK errMu DO IF dpyTable = NIL THEN RETURN ehandler(dpy, errEv) END; FOR i := 0 TO LAST(dpyTable^) DO IF dpyTable[i].dpy = dpy THEN trsl := dpyTable[i].trsl; found := TRUE; EXIT END END END; IF trsl # NIL THEN BackDoor(trsl, ev); RETURN 0 ELSIF NOT found THEN RETURN ehandler(dpy, errEv) ELSE RETURN 0 END; END Error; VAR doHack := RTParams.IsPresent("StarTrek");
If doHack is TRUE, XClient will change the cursor of every installed window to the Star Trek cursor whenever the garbage collector is running. You can enable this with @M3StarTrek.
TYPE GCClosure = RTHeapRep.MonitorClosure OBJECT OVERRIDES before := HackOn; after := HackOff END; TYPE InitClosure = Thread.Closure OBJECT OVERRIDES apply := DoHackInit END; PROCEDUREDoHackInit (<*UNUSED*> self: InitClosure): REFANY = BEGIN IF doHack THEN RTHeapRep.RegisterMonitor(NEW(GCClosure)) END; RETURN NIL END DoHackInit; VAR hacking := FALSE; PROCEDUREHackOn (<*UNUSED*> cl: GCClosure) = BEGIN HackToggle(TRUE); hacking := TRUE END HackOn; PROCEDUREHackOff (<*UNUSED*> cl: GCClosure) = BEGIN IF hacking THEN HackToggle(FALSE); hacking := FALSE END END HackOff; PROCEDUREHackToggle (on: BOOLEAN) = <*FATAL Split.NotAChild*> VAR dead: BOOLEAN; BEGIN IF hackDpyTable = NIL THEN RETURN END; FOR i := 0 TO LAST(hackDpyTable^) DO WITH dpy = hackDpyTable[i].dpy, trsl = hackDpyTable[i].trsl DO dead := dpy # NIL; IF dpy # NIL AND trsl # NIL AND NOT trsl.dead THEN TRY VAR v := Split.Succ(trsl, NIL); BEGIN WHILE v # NIL DO VAR ur: Child := v.upRef; BEGIN IF ur # NIL AND ur.w # X.None AND ur.xcage # X.None THEN IF on THEN X.XDefineCursor(dpy, ur.w, trsl.gcCursor) ELSE X.XDefineCursor(dpy, ur.w, ur.csid) END END END; v := Split.Succ(trsl, v) END END; X.XSync(dpy, X.True); dead := FALSE EXCEPT X.Error => (* skip *) END END; IF dead THEN TRY X.XCloseDisplay(dpy) EXCEPT X.Error => (* skip *) END; dpy := NIL END END END; END HackToggle; VAR ehandler := X.XSetErrorHandler(Error); iohandler := X.XSetIOErrorHandler(IOError); BEGIN END XClientF.