MODULE TestWeak EXPORTS Main;

IMPORT Trestle, VBT, FormsVBT, List, ListVBT, Text, TrestleComm, Rd, Thread;

IMPORT WeakRef, WeakDeath;

<* FATAL FormsVBT.Error *>
<* FATAL FormsVBT.Unimplemented *>
<* FATAL Thread.Alerted *>
<* FATAL Rd.Failure *>
<* FATAL TrestleComm.Failure *>

PROCEDURE Panel (): FormsVBT.T =
  VAR fv := FormsVBT.NewFromFile ("TestWeak.fv");
  BEGIN
    FormsVBT.AttachProc (fv, "bQuit", Quit);
    FormsVBT.AttachProc (fv, "bNew", NewObject);
    FormsVBT.AttachProc (fv, "bWref", NewWeakRef);
    FormsVBT.AttachProc (fv, "bKill", KillRef);
    RETURN fv;
  END Panel;

PROCEDURE Quit(
    fv: FormsVBT.T;
    name: TEXT;
    eventData: REFANY;
    time: VBT.TimeStamp) =
  BEGIN
    Trestle.Delete (fv);
  END Quit;

PROCEDURE NewObject(
    fv: FormsVBT.T;
    name: TEXT;
    eventData: REFANY;
    time: VBT.TimeStamp) =
  VAR
    lv: ListVBT.T := FormsVBT.GetVBT(fv, "objects");
    obj := FormsVBT.GetText(fv, "oName");
    cell := lv.count();
  BEGIN
    lv.insertCells(cell, 1);
    lv.setValue(cell, obj);
    FormsVBT.PutText(fv, "transcript", "Created object `" & obj & "'\n", TRUE);
  END NewObject;

PROCEDURE NewWeakRef(
    fv: FormsVBT.T;
    name: TEXT;
    eventData: REFANY;
    time: VBT.TimeStamp) =
  VAR
    olv: ListVBT.T := FormsVBT.GetVBT(fv, "objects");
    wlv: ListVBT.T := FormsVBT.GetVBT(fv, "weakrefs");
    cpName := FormsVBT.GetChoice(fv, "cpName");
    oCell, wCell: ListVBT.Cell;
    w: WeakRef.T;
    obj, wText: TEXT;
  BEGIN
    IF olv.getFirstSelected(oCell) THEN
      obj := olv.getValue(oCell);
      w := WeakRef.FromRef(obj, CleanupProc(cpName));
      wCell := wlv.count();
      wlv.insertCells(wCell, 1);
      wText := "WRef: { nd = `" & obj & "', cp = `" & cpName & "' }";
      wlv.setValue(wCell, wText);
      FormsVBT.PutText(fv, "transcript", "Created " & wText & "\n", TRUE);
    ELSE
      FormsVBT.PutText(fv, "transcript", "No object is selected\n", TRUE);
    END;
  END NewWeakRef;

PROCEDURE KillRef(
    fv: FormsVBT.T;
    name: TEXT;
    eventData: REFANY;
    time: VBT.TimeStamp) =
  VAR
    olv: ListVBT.T := FormsVBT.GetVBT(fv, "objects");
    oCell: ListVBT.Cell;
    obj: TEXT;
  BEGIN
    IF olv.getFirstSelected(oCell) THEN
      obj := olv.getValue(oCell);
      WeakDeath.KillRef(obj);
      FormsVBT.PutText(fv, "transcript", "Killed " & obj & "\n", TRUE);
    ELSE
      FormsVBT.PutText(fv, "transcript", "No object is selected\n", TRUE);
    END;
  END KillRef;

PROCEDURE CleanupProc(cpName: TEXT): WeakRef.CleanUpProc =
  BEGIN
    IF    Text.Equal (cpName, "CleanupA") THEN RETURN CleanA
    ELSIF Text.Equal (cpName, "CleanupB") THEN RETURN CleanB
    ELSE  RETURN CleanC
    END;
  END CleanupProc;

PROCEDURE CleanA(READONLY w: WeakRef.T; r: REFANY) =
  BEGIN
    FormsVBT.PutText(fv, "transcript", "CleanupA called for object `" &
      r & "'\n", TRUE);
  END CleanA;

PROCEDURE CleanB(READONLY w: WeakRef.T; r: REFANY) =
  BEGIN
    FormsVBT.PutText(fv, "transcript", "CleanupB called for object `" &
      r & "'\n", TRUE);
  END CleanB;

PROCEDURE CleanC(READONLY w: WeakRef.T; r: REFANY) =
  BEGIN
    FormsVBT.PutText(fv, "transcript", "CleanupC called for object `" &
      r & "'\n", TRUE);
  END CleanC;

VAR
  fv := Panel ();
BEGIN
  Trestle.Install (fv);
  Trestle.AwaitDelete (fv);
END TestWeak.