MODULE RehearseCode EXPORTS Main;

IMPORT AutoRepeat, Axis, CodeView, FileStream, Fmt, FormsVBT,
       HVBar, HVSplit, List, ListVBT, Params, RTMisc, Rd,
       RehearseCodeBundle, Rsrc, Split, Stdio, Text, TextEditVBT,
       TextPort, Thread, Trestle, TrestleComm, VBT, Wr, WrClass;

<* FATAL Rsrc.NotFound, Rd.Failure, Wr.Failure, Thread.Alerted *>
<* FATAL Split.NotAChild, TrestleComm.Failure *>
<* FATAL FormsVBT.Error, FormsVBT.Unimplemented *>

TYPE
  View = REF RECORD
               filename: TEXT         := NIL;
               codeview: CodeView.T;
             END;

  Writer = Wr.T OBJECT
             typescript: TextEditVBT.T;
           OVERRIDES
             seek  := Seek;
             flush := Flush;
           END;

  Repeater = AutoRepeat.T OBJECT OVERRIDES
               repeat := RepeatStep
             END;

VAR
  procNames   : List.T;
  regions     : List.T;
  views       : List.T;
  running                  := FALSE;
  currentProc : TEXT       := NIL;
  fv          : FormsVBT.T;
  typescriptWr: Writer;
  codeViews   : HVSplit.T;
  repeater                 := NEW (Repeater).init (0, 400);

PROCEDURE NewWriter (ts: TextEditVBT.T): Writer =
  CONST BufferSize = 100;
  BEGIN
    RETURN
      NEW (Writer, typescript := ts, lo := 0, cur := 0, hi := BufferSize,
           st := 0, buff := NEW (REF ARRAY OF CHAR, BufferSize),
           closed := FALSE, seekable := FALSE, buffered := FALSE);
  END NewWriter;

PROCEDURE Seek (wr: Writer; <* UNUSED *> n: CARDINAL)
  RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    wr.flush ()
  END Seek;

PROCEDURE Flush (wr: Writer) RAISES {Wr.Failure, Thread.Alerted} =
  BEGIN
    TextPort.PutText (
      wr.typescript.port,
      Text.FromChars (SUBARRAY (wr.buff^, 0, wr.cur - wr.lo)));
    wr.lo := wr.cur;
    wr.hi := wr.lo + NUMBER (wr.buff^);
    IF Thread.TestAlert () THEN RAISE Thread.Alerted END
  END Flush;

PROCEDURE PickAction (             fv  : FormsVBT.T;
                      <* UNUSED *> name: Text.T;
                      <* UNUSED *> cl  : REFANY;
                      <* UNUSED *> time: VBT.TimeStamp) =
  VAR 
    list := views;
    browser : ListVBT.T := FormsVBT.GetVBT (fv, "procedures");
    cell: ListVBT.Cell;
  BEGIN
    IF running THEN AutoRepeat.Stop (repeater); running := FALSE; END;
    IF NOT browser.getFirstSelected (cell) THEN RETURN; END;
    WITH name = List.Nth (procNames, cell) DO
      WHILE list # NIL DO
        WITH view = NARROW (List.Pop (list), View) DO
          view.codeview.exitAll ();
          view.codeview.enter (name, 0);
        END;
      END;
      regions := UnionOfRegions (name, views).tail;
      currentProc := name;
    END;
  END PickAction;

PROCEDURE ReparseAction (             fv  : FormsVBT.T;
                         <* UNUSED *> name: Text.T;
                         <* UNUSED *> cl  : REFANY;
                         <* UNUSED *> time: VBT.TimeStamp) =
  VAR list := views;
  BEGIN
    IF running THEN AutoRepeat.Stop (repeater); running := FALSE; END;
    WHILE list # NIL DO
      WITH view = NARROW (List.Pop (list), View) DO
        Wr.PutText (
          typescriptWr, Fmt.F ("Reloading file %s ...\n", view.filename));
        WITH new = CodeView.New (
                     FileStream.OpenRead (view.filename), typescriptWr) DO
          TRY
            Split.Replace (VBT.Parent (view.codeview), view.codeview, new);
            view.codeview := new;
          EXCEPT
            Rd.Failure =>
              Wr.PutText (
                typescriptWr,
                Fmt.F ("*** Rd.Failure on file %s\n", view.filename));
          END;
        END;
      END;
    END;
    WITH view = NARROW (views.first, View) DO
      procNames := view.codeview.listNames ();
    END;
    StuffBrowser (fv, procNames);
    regions := NIL;
    currentProc := NIL;
  END ReparseAction;

PROCEDURE StepAction (<* UNUSED *> fv  : FormsVBT.T;
                      <* UNUSED *> name: Text.T;
                      <* UNUSED *> cl  : REFANY;
                      <* UNUSED *> time: VBT.TimeStamp) =
  BEGIN
    IF running THEN AutoRepeat.Stop (repeater); running := FALSE; END;
    IF (regions = NIL) AND (currentProc # NIL) THEN
      regions := UnionOfRegions (currentProc, views);
    END;
    IF regions # NIL THEN
      WITH region = NARROW (List.Pop (regions), REF INTEGER) DO
        At (region^, views);
      END;
    END;
  END StepAction;

PROCEDURE RunAction (<* UNUSED *> fv  : FormsVBT.T;
                     <* UNUSED *> name: Text.T;
                     <* UNUSED *> cl  : REFANY;
                     <* UNUSED *> time: VBT.TimeStamp) =
  BEGIN
    IF running THEN AutoRepeat.Stop (repeater); running := FALSE; RETURN; END;
    IF (regions = NIL) AND (currentProc # NIL) THEN
      regions := UnionOfRegions (currentProc, views);
    END; 
   AutoRepeat.Start (repeater);
    running := TRUE;
  END RunAction;

PROCEDURE RepeatStep (repeater: Repeater) =
  BEGIN
    IF regions = NIL THEN
      AutoRepeat.Stop (repeater);
      running := FALSE;
    ELSE
      WITH region = NARROW (List.Pop (regions), REF INTEGER) DO
        LOCK VBT.mu DO At (region^, views); END;
      END;
    END;
  END RepeatStep;

PROCEDURE ExitAction (             fv  : FormsVBT.T;
                      <* UNUSED *> name: Text.T;
                      <* UNUSED *> cl  : REFANY;
                      <* UNUSED *> time: VBT.TimeStamp) =
  BEGIN
    IF running THEN AutoRepeat.Stop (repeater); running := FALSE; END;
    Trestle.Delete (codeViews);
    Trestle.Delete (fv);
  END ExitAction;

PROCEDURE At (line: INTEGER; viewList: List.T) =
  BEGIN
    WHILE viewList # NIL DO
      WITH view = NARROW (List.Pop (viewList), View) DO
        view.codeview.at (line, 0);
      END;
    END;
  END At;

PROCEDURE StuffBrowser (fv: FormsVBT.T; names: List.T) =
  VAR
    browser : ListVBT.T := FormsVBT.GetVBT (fv, "procedures");
    oldCount            := browser.count ();
    newCount            := List.Length (names);
    delta               := oldCount - newCount;
  BEGIN
    IF delta < 0 THEN
      browser.insertCells (oldCount, -delta);
    ELSIF delta > 0 THEN
      browser.removeCells (newCount, delta)
    END;
    FOR j := 0 TO newCount - 1 DO
      browser.setValue (j, List.Pop (names))
    END;
  END StuffBrowser;

PROCEDURE CheckNames (names: List.T; viewList: List.T) =
  VAR missing: List.T;
  BEGIN
    WHILE viewList # NIL DO
      WITH view = NARROW (List.Pop (viewList), View) DO
        missing := List.Difference (names, view.codeview.listNames ());
        WHILE missing # NIL DO
          WITH name = NARROW (List.Pop (missing), TEXT) DO
            Wr.PutText (typescriptWr,
                        Fmt.F ("procedure annotation %s not in file %s\n",
                               name, view.filename));
          END;
        END;
      END;
    END;
  END CheckNames;

PROCEDURE UnionOfNames (viewList: List.T): List.T =
  VAR list: List.T;
  BEGIN
    WHILE viewList # NIL DO
      WITH view = NARROW (List.Pop (viewList), View) DO
        list := List.Union (list, view.codeview.listNames ());
      END;
    END;
    RETURN List.Sort (list);
  END UnionOfNames;

PROCEDURE UnionOfRegions (proc: TEXT; viewList: List.T): List.T =
  VAR list: List.T;
  BEGIN
    WHILE viewList # NIL DO
      WITH view = NARROW (List.Pop (viewList), View) DO
        list := List.Union (list, view.codeview.listRegions (proc));
      END;
    END;
    RETURN List.Sort (list);
  END UnionOfRegions;

PROCEDURE Main () =
  VAR hsplit, vsplit: HVSplit.T;
  BEGIN
    fv := NEW(FormsVBT.T).initFromRsrc (
            "RehearseCode.fv",
            Rsrc.BuildPath ("$REHEARSECODE",  RehearseCodeBundle.Get()));
    FormsVBT.AttachProc (fv, "reparse", ReparseAction);
    FormsVBT.AttachProc (fv, "step", StepAction);
    FormsVBT.AttachProc (fv, "run", RunAction);
    FormsVBT.AttachProc (fv, "exit", ExitAction);
    FormsVBT.AttachProc (fv, "procedures", PickAction);

    typescriptWr := NewWriter (FormsVBT.GetVBT (fv, "typescript"));

    IF (Params.Count < 2) OR (Params.Count > 5) THEN
      Wr.PutText (
        typescriptWr, "usage: RehearseCode filename1 [... filename4]\n");
      RTMisc.Exit (1);
    END;

    FOR i := 1 TO Params.Count - 1 DO
      WITH source = Params.Get (i),
           view   = NEW (View)      DO
        TRY
          Wr.PutText (
            typescriptWr, Fmt.F ("Loading file %s ...\n", source));
          view.filename := source;
          view.codeview :=
            CodeView.New (FileStream.OpenRead (source), typescriptWr);
          List.Push (views, view);
          IF vsplit = NIL THEN
            vsplit := HVSplit.Cons (Axis.T.Ver, view.codeview);
          ELSE
            Split.AddChild (vsplit, HVBar.New (1.5), view.codeview);
            IF hsplit = NIL THEN
              hsplit := HVSplit.Cons (Axis.T.Hor, vsplit);
            ELSE
              Split.AddChild (hsplit, HVBar.New (1.5), vsplit);
            END;
            vsplit := NIL;
          END;
        EXCEPT
          Rd.Failure =>
            Wr.PutText (
              Stdio.stderr,
              Fmt.F ("RehearseCode: Rd.Failure on file %s\n", source));
            Wr.PutText (
              typescriptWr, Fmt.F ("*** Rd.Failure on file %s\n", source));
        END;
      END;
    END;

    IF views = NIL THEN
      Wr.PutText (Stdio.stderr, "RehearseCode: no source files found\n");
      RTMisc.Exit (3);
    END;

    IF hsplit = NIL THEN
      codeViews := vsplit;
    ELSE
      codeViews := hsplit;
    END;

    procNames := UnionOfNames (views);
    CheckNames (procNames, views);
    StuffBrowser (fv, procNames);
    Trestle.Install (
      codeViews, "RehearseCode", NIL, "RehearseCode Code Views");
    Trestle.Install (fv, "RehearseCode", NIL, "RehearseCode Controller");
    Trestle.AwaitDelete (fv);
  END Main;

BEGIN
  Main ();
END RehearseCode.