ui/src/nt/NTClientF.m3


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.