Copyright (C) 1994, Digital Equipment Corp.
by Steve Glassman, Mark Manasse and Greg Nelson
<*PRAGMA LL*>
Partitioning following the efforts of
Steve.Freeman@computer-lab.cambridge.ac.uk - 92-05-13
UNSAFE MODULE NTClientF;
IMPORT Ctypes, IntRefTbl, M3toC,
NT, NTClient, NTScreenType, ProperSplit, Rect, Scheduler,
Text, Thread, Trestle, TrestleClass, TrestleComm, TrestleOnNT,
VBT, VBTClass, WinDef, WinGDI, WinUser;
FROM NTClient IMPORT T;
REVEAL
T_Abs = T_Rel BRANDED OBJECT
coverage : CARDINAL := 0;
END;
PROCEDURE Kill (trsl: T) <* LL.sup = trsl *> =
BEGIN
LOCK TrestleClass.closeMu DO
IF NOT trsl.closed THEN trsl.closed := TRUE; END
END;
trsl.dead := TRUE;
EVAL Thread.Fork(NEW(KillClosure, trsl := trsl))
END Kill;
TYPE
KillClosure =
Thread.Closure OBJECT trsl: T OVERRIDES apply := DoKill END;
PROCEDURE DoKill (self: KillClosure): REFANY RAISES {} =
BEGIN
Scheduler.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;
---------- various utilities ----------
PROCEDURE ValidateNW (<* UNUSED *> trsl: T; ch: Child; <* UNUSED *> st: NTScreenType.T)
RAISES {TrestleComm.Failure} =
VAR r: WinDef.RECT;
BEGIN
IF NOT ch.nwValid THEN
ch.nwValid := NT.True(WinUser.GetWindowRect(ch.hwnd, ADR(r)));
ch.nw.h := r.left;
ch.nw.v := r.top;
END
END ValidateNW;
PROCEDURE SetTitle (<* UNUSED *>trsl: T; v: VBT.T; ch: Child) =
VAR
s: Ctypes.CharStar;
t: TEXT;
dec: TrestleClass.Decoration := VBT.GetProp(v, TYPECODE(TrestleClass.Decoration));
BEGIN
IF NT.True(WinUser.IsIconic(ch.hwnd)) THEN
t := dec.iconTitle;
ELSE
t := dec.windowTitle;
END;
s := M3toC.TtoS(t);
NT.Assert(WinUser.SetWindowText(ch.hwnd, s));
END SetTitle;
PROCEDURE SetDecoration (trsl : NTClient.T;
v : VBT.T;
ch : Child;
hwnd : WinDef.HWND;
old, new: TrestleClass.Decoration)
RAISES {TrestleComm.Failure} =
(* The decorations for w have changed from old to new; this procedure
relays this change to the NT window manager. LL = trsl. *)
BEGIN
IF new = NIL OR hwnd = NT.CNULL THEN RETURN END;
IF (old = NIL) OR NOT Text.Equal(old.windowTitle, new.windowTitle)
OR NOT Text.Equal(old.iconTitle, new.iconTitle) THEN
SetTitle(trsl, v, ch);
END;
END SetDecoration;
PROCEDURE GetDomain (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
width := ur.width;
height := ur.height
END GetDomain;
PROCEDURE AdjustCoverage (xcon: T; d: [-1 .. 1] := 0)
RAISES {TrestleComm.Failure} =
BEGIN
INC(xcon.coverage, d);
IF xcon.coverage = 0 THEN NT.Assert(WinGDI.GdiFlush()) END;
END AdjustCoverage;
PROCEDURE Delete (trsl: NTClient.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(LOOPHOLE(ur.hwnd, INTEGER), 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;
END;
ProperSplit.Delete(trsl, ur);
VBTClass.Misc(ch, VBT.MiscRec{code, VBT.NullDetail, 0, VBT.NilSel});
VBT.Discard(ch)
END Delete;
PROCEDURE Reshape (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;
---------- connection management ----------
TYPE
DpyTable = REF ARRAY OF
RECORD
trsl: T
END;
VAR
errMu := NEW(MUTEX); (* LL > any VBT. *)
(* protection = errMu *)
dpyTable: DpyTable := NIL;
maps dpys to their corresponding Ts.
PROCEDURE Connect (inst: TEXT; trsl: T := NIL): Trestle.T
RAISES {TrestleComm.Failure} =
BEGIN
IF trsl = NIL THEN trsl := NEW(T) END;
IF trsl.st = NIL THEN trsl.st := NEW(VBT.ScreenType) END;
trsl.inst := inst;
(* The st is irrelevant except that it must be non-NIL so that marking
the trsl for redisplay is not a noop. *)
TrestleOnNT.Enter(trsl);
TRY
LOCK errMu DO
WITH table = dpyTable DO
IF table = NIL THEN
table := NEW(DpyTable, 1);
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;
END;
table[0].trsl := trsl;
END
END;
trsl.sel := NEW(SelArray, 0);
trsl.vbts := NEW(IntRefTbl.T).init();
trsl.screens :=
NEW(REF ARRAY OF NTScreenType.T, 1);
FINALLY
TrestleOnNT.Exit(trsl, 1)
END;
FOR i := 0 TO LAST(trsl.screens^) DO
trsl.screens[i] := NTScreenType.New(trsl, i)
END;
RETURN trsl
END Connect;
PROCEDURE DoConnect (<*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;
BEGIN
END NTClientF.