(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* by Steve Glassman, Mark Manasse and Greg Nelson           *)
(* Last modified on Sat Jun 26 15:40:45 PDT 1993 by msm      *)
(*      modified on Tue Mar 10 19:09:11 1992 by steveg   *)
(*      modified on Mon Feb 24 13:53:35 PST 1992 by muller   *)
(*      modified on Sun Nov 10 19:21:31 PST 1991 by gnelson  *)
<*PRAGMA LL*>

MODULE InstalledVBT;

IMPORT VBT, Filter, HighlightVBT, VBTClass, DpyFilter, CostableVBT, JoinedVBT,
  Palette, VBTRep, JoinParent, FilterClass, Point, Trestle, TrestleGoo;

TYPE
  GrandChild = HighlightVBT.T OBJECT
    proc: DeleteProc
  OVERRIDES
    rescreen := Rescreen;
    misc := GCMisc;
  END;

REVEAL
  Join = JoinedVBT.T BRANDED OBJECT
           trueChild: VBT.T;
           link     : CostableVBT.Link := NIL
         END;

REVEAL T = DpyFilter.T BRANDED OBJECT trueChild: VBT.T END;

PROCEDURE New (ch: VBT.T; p: DeleteProc): T =
  VAR j := NEW(Join);
  BEGIN
    j.link := NEW(CostableVBT.Link).init();
    InitChild(j, ch, p);
    RETURN AllocT(j)
  END New;

PROCEDURE InitChild (j: Join; ch: VBT.T; p: DeleteProc) =
  VAR
    grandChild := NEW(GrandChild, proc := p);
    child      := CostableVBT.New(grandChild, link := j.link);
  BEGIN
    EVAL grandChild.init(ch);
    j.trueChild := ch;
    EVAL j.init(child)
  END InitChild;

PROCEDURE InitParent(res:T; ch: Join) =
  BEGIN
    res.trueChild := ch.trueChild;
    EVAL res.init(ch);
    LOCK res DO
      res.props := res.props + VBTRep.Props{VBTRep.Prop.Combiner}
    END;
    TrestleGoo.Alias(res, ch.trueChild)
  END InitParent;

PROCEDURE AllocT (ch: Join): T =
  VAR res := NEW(T);
  BEGIN
    InitParent(res, ch);
    RETURN res
  END AllocT;

PROCEDURE NewParent (ch: VBT.T): T =
  BEGIN
    LOOP
      TYPECASE ch OF
        T (iv) => RETURN AllocT(JoinParent.Child(iv))
      ELSE
        IF ch.parent = NIL THEN RETURN NIL ELSE ch := ch.parent END
      END
    END
  END NewParent;

PROCEDURE Rescreen(v: GrandChild; READONLY cd: VBT.RescreenRec) =
  BEGIN
    Palette.Init(cd.st);
    HighlightVBT.T.rescreen(v, cd) 
  END Rescreen;

PROCEDURE Child (v: VBT.T): VBT.T =
  BEGIN
    LOOP
      TYPECASE v OF
        T (iv) => RETURN iv.trueChild
      ELSE
        IF v.parent = NIL THEN RETURN v ELSE v := v.parent END
      END
    END
  END Child;

PROCEDURE GCMisc(v: GrandChild; READONLY cd: VBT.MiscRec) =
  VAR ch := v.ch; button: VBT.Button := LAST(VBT.Button);
  CONST gone = VBT.CursorPosition{Point.Origin, Trestle.NoScreen, TRUE, TRUE};
  BEGIN
    IF ch = NIL THEN RETURN END;
    IF cd.type = VBT.Deleted OR cd.type = VBT.Disconnected THEN
      VBTClass.Position(v, VBT.PositionRec{gone, 0, VBT.Modifiers{}});
      VBTClass.Mouse(v, 
        VBT.MouseRec{button, 0, gone, VBT.Modifiers{},
          VBT.ClickType.LastUp, 0});
      IF v.proc # NIL THEN v.proc(ch) END;
      EVAL Filter.Replace(v, NIL)
    END;
    VBTClass.Misc(ch, cd);
  END GCMisc;

BEGIN END InstalledVBT.
