<*PRAGMA LL*>

MODULE DpyFilter;

IMPORT VBT, InstalledVBT, Trestle, TrestleComm, TextRefTbl,
       OSError, Point, MiscDetail, VBTClass, Thread, Split, Rd, FileRd,
       Env, Text, JoinParent, JoinedVBT, TrestleImpl;

REVEAL
  T = Public BRANDED OBJECT
        enabled         := TRUE;
        pass   : TEXT := NIL;
      OVERRIDES
        misc := Misc;
        init := Init
      END;

VAR
  mu     := NEW(Thread.Mutex);
  inited := FALSE;

PROCEDURE Init (v: T; ch: JoinedVBT.T; enabled: BOOLEAN): T =
  VAR fn: TEXT;
  CONST DefaultFile = "~/.pa_new_display";
  BEGIN
    LOCK mu DO
      IF NOT inited THEN
        ChangeDisplay := VBT.GetMiscCodeType("ChangeDisplay");
        AddDisplay := VBT.GetMiscCodeType("AddDisplay");
        inited := TRUE;
        fn := Env.Get("PA_NEW_DISPLAY");
        IF fn = NIL THEN fn := DefaultFile END;
        TRY
          (* !!! fn := Filename.ExpandTilde(fn); *)
          VAR rd := FileRd.Open(fn);
          BEGIN
            DefaultPassword := Rd.GetLine(rd);
            Rd.Close(rd)
          END
        EXCEPT
          (* Filename.Error, *) OSError.E, Rd.Failure, Rd.EndOfFile, Thread.Alerted =>
        END
      END
    END;
    v.pass := DefaultPassword;
    v.enabled := enabled;
    EVAL JoinParent.T.init(v, ch);
    RETURN v
  END Init;

PROCEDURE New (ch: JoinedVBT.T; enabled := TRUE): T =
  VAR res := NEW(T);
  BEGIN
    EVAL res.init(ch, enabled);
    RETURN res
  END New;

VAR trsls := NEW(TextRefTbl.Default).init();

PROCEDURE Connect (servers: REF ARRAY OF TEXT): Trestle.T =
  VAR
    res: Trestle.T;
    ra : REFANY;
  BEGIN
    IF servers = NIL THEN RETURN NIL END;
    FOR i := FIRST(servers^) TO LAST(servers^) DO
      IF trsls.get(servers[i], ra) THEN RETURN ra END
    END;
    FOR i := FIRST(servers^) TO LAST(servers^) DO
      TRY
        res := Trestle.Connect(servers[i]);
        IF res # NIL THEN EVAL trsls.put(servers[i], res); RETURN res END
      EXCEPT
        TrestleComm.Failure =>  (* skip *)
      END
    END;
    RETURN NIL
  END Connect;

VAR
  DefaultPassword: TEXT := NIL;

PROCEDURE Misc (v: T; READONLY cd: VBT.MiscRec) =
  <* FATAL Split.NotAChild *>
  BEGIN
    IF v.enabled AND (cd.type = ChangeDisplay OR cd.type = AddDisplay) THEN
      VAR
        m   : Message := MiscDetail.ToRef(cd.detail[0]);
        d             := MiscDetail.ToRef(cd.detail[1]);
        trsl          := Connect(m.newDisplay);
      BEGIN
        IF trsl # NIL AND v.pass = NIL
             OR m.oldAuth # NIL AND Text.Equal(m.oldAuth, v.pass) THEN
          VAR
            decor := TrestleImpl.GetDecor(v);
            w := InstalledVBT.NewParent(v);
          BEGIN
            IF w = NIL THEN m.status := FALSE; RETURN END;
            w.pass := m.newAuth;
            IF w.pass # NIL AND Text.Equal(w.pass, "") THEN
              w.pass := NIL
            END;
            IF d # NIL THEN VBT.PutProp(w, d) END;
            TRY
              trsl.attach(w);
              IF decor # NIL THEN
                TrestleImpl.InnerDecorate(trsl, w, decor)
              END;
              IF m.iconic THEN
                trsl.iconize(w)
              ELSE
                trsl.overlap(w, m.screen, Point.T{m.x, m.y})
              END;
              m.status := TRUE;
              IF cd.type = ChangeDisplay AND v.parent # NIL THEN
                Split.Delete(v.parent, v)
              END
            EXCEPT
              TrestleComm.Failure => m.status := FALSE; JoinParent.Rem(w)
            END
          END
        ELSE
          m.status := FALSE
        END
      END
    ELSE
      Public.misc(v, cd)
    END
  END Misc;

PROCEDURE Parent (v: VBT.T): T =
  BEGIN
    LOOP TYPECASE v OF T (p) => RETURN p ELSE v := v.parent END END
  END Parent;

PROCEDURE SetEnabled (ch: VBT.T; enabled := TRUE) =
  VAR v := Parent(ch);
  BEGIN
    IF v # NIL THEN v.enabled := enabled END
  END SetEnabled;

PROCEDURE GetEnabled (ch: VBT.T): BOOLEAN =
  VAR v := Parent(ch);
  BEGIN
    IF v # NIL THEN RETURN v.enabled ELSE RETURN TRUE END
  END GetEnabled;

BEGIN
END DpyFilter.