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---------- various utilities ----------; 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 NTClientF 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; PROCEDUREDoKill (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;
PROCEDURE---------- connection management ----------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; PROCEDURESetTitle (<* 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; PROCEDURESetDecoration (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; 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 width := ur.width; height := ur.height END GetDomain; PROCEDUREAdjustCoverage (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; PROCEDUREDelete (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; 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 trsl: T END; VAR errMu := NEW(MUTEX); (* LL > any VBT. *) (* protection = errMu *) dpyTable: DpyTable := NIL;
maps dpys to their corresponding Ts.
PROCEDUREConnect (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; 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; BEGIN END NTClientF.