(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Jan  5 22:23:30 PST 1993 by meehan                   *)
(*      modified on Mon Jan  4 15:55:55 PST 1993 by mhb                      *)
(*      modified on Tue Jun 16 21:55:39 PDT 1992 by muller                   *)

MODULE FormsEditVBT;

IMPORT Axis, Cursor, FileBrowserVBT, Filename, FileStream, Filter, 
       formseditBundle, FormsVBT, Fmt, Font, FVRuntime, FVTypes, FWr,
       KeyboardKey, KeyTrans, List, Manpage, MForm, MText, MTextRd, PaintOp,
       Palette, Point, Range, Rd, RdUtils, Rect, RefRefTbl, Rsrc, RTutils,
       ScreenType, StableVBT, Sx, SxSymbol, SxSyntax, Text, TextEditVBT,
       TextPort, TextPortClass, TextVBT, TextWr, Thread, Trestle, TrestleComm,
       UnixUtils, VBT, VBTClass, VTDef, VText, Wr, XParam, ZChassisVBT,
       ZChildVBT;

IMPORT SmallIO;                 (* for debugging *)

<* FATAL FormsVBT.Unimplemented *>(* Should never happen here. *)

<* PRAGMA LL *>

CONST
  DummyText = "(Rim (Pen 10) (Text (Name ignoreMe) "
                & "\"This space available for a small fee\"))";
  HelpFile  = "formsedit.txt";
  STACKSIZE = 10000;

REVEAL
  T = Public BRANDED OBJECT
        ed                     : Editor;
        number                                   := 0;
        fullPathname, shortname: TEXT            := "";
        display, geometry      : TEXT;
        rd                     : Rd.T;           (* For manpage *)
        prettyprintWidth       : CARDINAL        := 78;
        root                   : EditorRoot;
        mu                     : MUTEX;
        egrec                  : XParam.Geometry;
        path                   : Rsrc.Path;
      METHODS
        delete   ()                              := DeleteFrame;
        decorate () RAISES {TrestleComm.Failure} := DecorateFrame;
        spawn    ()                              := Spawn
      OVERRIDES
        editor       := GetEditor;
        init         := Init;
        initFromFile := InitFromFile;
      END;
  EditorRoot = PublicRoot BRANDED OBJECT
                 firstFrame: T;
                 mu        : MUTEX;
                 allClosed : NamedCondition;
                 frames    : List.T              := NIL; (* children *)
                 thread    : Thread.T;           (* our own thread *)
                 display   : TEXT;
                 drec      : XParam.Display;
                 trsl      : Trestle.T;
                 array     : Trestle.ScreenArray
               OVERRIDES
                 apply := EditorRootApply;
                 init  := EditorRootInit
               END;

TYPE                             (* in alphabetical order *)

  Attachment = FormsVBT.Closure OBJECT
                 frame: T;
                 proc : KeyProc
               OVERRIDES
                 apply := AttachmentApply
               END;

  ButtonClosure = FormsVBT.Closure OBJECT frame: T END;

  Editor = FormsVBT.T OBJECT
             (* The components to which we need fast access *)
             buffer    : TextEditVBT.T;
             modified  : TextVBT.T       := NIL;
             stderr    : TextEditVBT.T;
             errorPopup: ZChassisVBT.T;
             (* The internals of the buffer *)
             textport: EPort;
             vtext   : VText.T;
             mtext   : MText.T;
             (* The info for SxSyntax *)
             syntax: SxSyntax.T;
             parser: SxParser;
             (* Other things *)
             highlighter : VText.Interval;
             frame       : T;
             modelTsplits: List.T           := NIL;
             rd          : MTextRd.T
           METHODS
             init (Frame: T): Editor RAISES {FormsVBT.Error} := EditorInit;
             <* LL = VBT.mu *>
             decorate () RAISES {TrestleComm.Failure} := DecorateEditor;
           OVERRIDES
             realize := Realize
           END;

  EPort = FVTypes.Port OBJECT
            ed: Editor
          OVERRIDES
            modified := NoteModification;
            filter   := KeyFilter
          END;

  FrameClosure =
    Thread.Closure OBJECT frame: T OVERRIDES apply := FrameApply END;

  Interval = REF RECORD start, end: CARDINAL END;

  JustFVfileBrowser = FVTypes.FVFileBrowser OBJECT
                        ed: Editor
                      OVERRIDES
                        init  := FBinit;
                        error := FBerror
                      END;

  KeyProc = PROCEDURE (frame: T; time: VBT.TimeStamp); <* LL = VBT.mu *>

  Mover = FormsVBT.Closure OBJECT
            id : CARDINAL;
            vbt: VBT.T
          OVERRIDES
            apply := MoverApply
          END;

  NamedCondition = Thread.Condition OBJECT name: TEXT END; (* debugging *)

  ParseClosure = Thread.SizedClosure OBJECT
                   frame  : T;
                 OVERRIDES
                   apply := ParseClosureApply
                 END;

  SxParser = SxSyntax.Parser OBJECT
               intervalTable: RefRefTbl.T;
             OVERRIDES
               apply := SxParserApply
             END;

VAR HighlightOptions: VText.IntervalOptions; (* CONST *)

VAR
  FrameCountLock := NEW (MUTEX);
  FrameCount     := 0;
  formseditPath  := Rsrc.BuildPath ("$formseditPATH", formseditBundle.Get ());

PROCEDURE Init (frame: T; description: TEXT): T
  RAISES {FormsVBT.Error} =
  BEGIN
    <* LL = VBT.mu *>
    IF description = NIL THEN description := DummyText END;
    TRY
      frame.fullPathname := "";
      frame.shortname := "";
      frame.ed := NEW (Editor).init (frame);
      FormsVBT.PutText (frame.ed, "openfile", "");
      FormsVBT.PutText (frame.ed, "shortname", "");
      TextPort.SetText (frame.ed.buffer.port, description);
      (* FormsVBT.MakeDormant (frame.ed, "revertbutton"); *)
      TextPort.SetModified (frame.ed.textport, FALSE);
      SetModified (frame.ed, FALSE);
      frame.path := List.List1 (".");
      Parse (frame);
      RETURN frame
    EXCEPT
    | Rd.Failure (ref) => RAISE FormsVBT.Error (RdUtils.FailureText (ref))
    | Sx.PrintError (z) => RAISE FormsVBT.Error (SxPrintErrorText (z))
    | Thread.Alerted => RAISE FormsVBT.Error ("Thread.Alerted was raised")
    END
  END Init;

PROCEDURE InitFromFile (frame: T; filename: TEXT): T
  RAISES {FormsVBT.Error, Thread.Alerted} =
  <* LL = VBT.mu *>
  BEGIN
    IF Text.Empty (filename) THEN RAISE FormsVBT.Error ("No filename.") END;
    TRY
      filename := Filename.ExpandTilde (filename);
      IF Text.GetChar (filename, 0) # '/' THEN
        filename := UnixUtils.GetWD () & "/" & filename
      END
    EXCEPT
    | Filename.Error =>
        RAISE FormsVBT.Error ("Can't expand filename: " & filename)
    | UnixUtils.Error (text) =>
        RAISE FormsVBT.Error ("Can't get current directory: " & text)
    END;
    frame.fullPathname := filename;
    frame.shortname := Filename.Tail (filename);
    frame.ed := NEW (Editor).init (frame);
    (* FormsVBT.MakeDormant (frame.ed, "revertbutton"); *)
    frame.path := NIL;
    Read (frame);
    FormsVBT.PutText (frame.ed, "openfile", filename);
    FormsVBT.PutText (frame.ed, "shortname", frame.shortname);
    RETURN frame
  END InitFromFile;

PROCEDURE Read (frame: T) RAISES {FormsVBT.Error, Thread.Alerted} =
  <* LL = VBT.mu *>
  VAR
    ed        := frame.ed;
    rd : Rd.T;
    dir: TEXT;
  BEGIN
    ClearError (ed);
    TRY
      rd := FileStream.OpenRead (frame.fullPathname);
      TRY
        IF Text.GetChar (frame.fullPathname, 0) = '/' THEN
          dir := Filename.Head (frame.fullPathname);
          IF NOT List.Member (frame.path, dir) THEN
            List.Push (frame.path, dir)
          END
        END;
        TextPort.SetText (ed.textport, Rd.GetText (rd, Rd.Length (rd)));
        TextPort.SetModified (ed.textport, FALSE);
        SetModified (ed, FALSE);
        Parse (frame);
        frame.decorate ();
        ed.decorate ()
      FINALLY
        Rd.Close (rd)
      END
    EXCEPT
    | Rd.Failure (f) =>
        RAISE
          FormsVBT.Error (Fmt.F ("Could not read file %s : %s",
                                 frame.fullPathname, RdUtils.FailureText (f)))
    | TrestleComm.Failure =>
        RAISE
          FormsVBT.Error (
            "TrestleComm.Failure while attempting to change the decoration")
    END
  END Read;

PROCEDURE EditorRootInit (root     : EditorRoot;
                          frame    : T;
                          Xdisplay                := ":0.0";
                          Xgeometry               := "+50+50"): EditorRoot
  RAISES {TrestleComm.Failure, XParam.Error} =
  BEGIN
    root.firstFrame := frame;
    frame.root := root;
    root.display := Xdisplay;
    root.drec := XParam.ParseDisplay (Xdisplay);
    root.trsl := Trestle.Connect (Xdisplay);
    root.array := Trestle.GetScreens (root.trsl);
    IF root.array = NIL OR NUMBER (root.array^) = 0 THEN
      RAISE TrestleComm.Failure
    END;
    Palette.Init (root.array [0].type);
    Palette.Init (root.array [0].type.bits);
    Install (frame, Xgeometry);
    root.mu := NEW (MUTEX);
    LOCK root.mu DO
      root.frames := NIL;
      root.allClosed := NEW (NamedCondition, name := "all editors closed")
    END;
    RETURN root
  END EditorRootInit;

PROCEDURE EditorRootApply (root: EditorRoot): REFANY =
  VAR frames: List.T;
  BEGIN
    root.thread := Thread.Self ();
    root.firstFrame.spawn ();
    TRY
      LOCK root.mu DO
        WHILE root.frames # NIL DO
          Thread.AlertWait (root.mu, root.allClosed)
        END
      END
    EXCEPT
    | Thread.Alerted =>
        Debug (Fmt.F ("EdRoot was alerted. There are %s frames.\n",
                      Fmt.Int (List.Length (root.frames))));
        (* Alert all the frames *)
        LOCK root.mu DO frames := root.frames END;
        WHILE frames # NIL DO AlertFrame (List.Pop (frames)) END;
        LOCK root.mu DO
          WHILE root.frames # NIL DO Thread.Wait (root.mu, root.allClosed) END
        END
    END;
    RETURN NIL
  END EditorRootApply;

PROCEDURE Spawn (frame: T) =
  VAR fc := NEW (FrameClosure, frame := frame);
  BEGIN
    frame.mu := NEW (MUTEX);
    EVAL Thread.Fork (fc);
    LOCK frame.root.mu DO List.Push (frame.root.frames, frame) END
  END Spawn;

PROCEDURE FrameApply (fc: FrameClosure): REFANY =
  <* LL = 0 *>
  BEGIN
    Trestle.AwaitDelete (fc.frame);
    RETURN NIL
  END FrameApply;

PROCEDURE AlertFrame (frame: T) =
  <* LL = 0 *>
  <* FATAL FormsVBT.Error *>
  VAR ed := frame.ed;
  BEGIN
    Debug (Fmt.F ("Frame %s is being alerted.\n", Fmt.Int (frame.number)));
    LOCK VBT.mu DO
      IF TextPort.IsModified (ed.textport) THEN
        FormsVBT.MakeDormant (ed, "dontquit");
        FormsVBT.MakeDormant (ed, "cancelsaveas");
        FormsVBT.PopUp (ed, "quitConfirmation", 0)
      ELSE
        frame.delete ()
      END
    END
  END AlertFrame;


PROCEDURE Install (frame: T; editorGeo: TEXT)
  RAISES {TrestleComm.Failure, XParam.Error} =
  <* FATAL FormsVBT.Error *>(* In here, they're all our fault. *)
  VAR
    frameGeo := "+10+10";        (* NW corner *)
    ed       := frame.ed;
    drec     := frame.root.drec;
    trsl     := frame.root.trsl;
    array    := frame.root.array;
  VAR
    egrec, fgrec: XParam.Geometry;
    name        : TEXT;
  BEGIN
    frame.geometry := editorGeo;
    egrec := XParam.ParseGeometry(editorGeo);
    frame.egrec := egrec;
    fgrec := XParam.ParseGeometry(frameGeo);
    (* Set up Rescreen menu-items. *)
    IF NUMBER(array^) = 1 THEN
      FormsVBT.MakeDormant(ed, "rescreenFilter")
    ELSE
      FOR i := LAST(array^) TO FIRST(array^) BY -1 DO
        name := "Edit" & Fmt.Int(i);
        EVAL
          FormsVBT.Insert(
            ed, "rescreenMenu",
            Fmt.F("(MButton %%s (Text RightAlign \"%s:%s.%s\"))",
                  name, drec.hostname, Fmt.Int(drec.display),
                  Fmt.Int(i)), 0);
        FormsVBT.Attach(ed, name, NEW(Mover, id := i, vbt := ed))
      END;
      EVAL FormsVBT.Insert(
             ed, "rescreenMenu", "\"Move Editor to\"", 0);
      EVAL FormsVBT.Insert(ed, "rescreenMenu", "(Bar 1)", 0);
      FOR i := LAST(array^) TO FIRST(array^) BY -1 DO
        name := "Frame" & Fmt.Int(i);
        EVAL
          FormsVBT.Insert(
            ed, "rescreenMenu",
            Fmt.F("(MButton %%s (Text RightAlign \"%s:%s.%s\"))",
                  name, drec.hostname, Fmt.Int(drec.display),
                  Fmt.Int(i)), 0);
        FormsVBT.Attach(
          ed, name, NEW(Mover, id := i, vbt := frame))
      END;
      EVAL FormsVBT.Insert(
             ed, "rescreenMenu", "\"Move Result to\"", 0);
    END;

    PROCEDURE FixSize (v: VBT.T; VAR g: XParam.Geometry) =
      BEGIN
        VBTClass.Rescreen(v, array[0].type);
        IF g.size = XParam.Missing THEN
          WITH shapes = VBTClass.GetShapes(v) DO
            g.size.h := shapes[Axis.T.Hor].pref;
            g.size.v := shapes[Axis.T.Ver].pref;
          END
        END
      END FixSize;
    BEGIN
      FixSize(ed, egrec);
      FixSize(frame, fgrec)
    END;

    Trestle.Attach(ed, trsl);
    ed.decorate();
    StableVBT.SetShape(ed, egrec.size.h, egrec.size.v);
    Trestle.Overlap(
      ed, drec.screen, XParam.Position(trsl, drec.screen, egrec));

    Trestle.Attach(frame, trsl);
    frame.decorate();
    Trestle.Overlap(frame, drec.screen,
                    XParam.Position(trsl, drec.screen, fgrec));
  END Install;

PROCEDURE DecorateFrame (frame: T) RAISES {TrestleComm.Failure} =
  BEGIN
    Trestle.Decorate (frame,
                      windowTitle :=
                        Fmt.F ("FV Result %s: %s", Fmt.Int (frame.number),
                               Last40 (frame.fullPathname)),
                      iconTitle := Fmt.F ("R %s: %s", Fmt.Int (frame.number),
                                          frame.shortname),
                      applName := "FormsEdit Result View", bgColorR := 0.7,
                      bgColorG := 0.7, bgColorB := 1.0)
  END DecorateFrame;

PROCEDURE DecorateEditor (ed: Editor) RAISES {TrestleComm.Failure} =
  VAR frame := ed.frame;
  BEGIN
    Trestle.Decorate (ed, windowTitle :=
                            Fmt.F ("FV Editor %s: %s", Fmt.Int (frame.number),
                                   Last40 (frame.fullPathname)),
                      iconTitle := Fmt.F ("E %s: %s", Fmt.Int (frame.number),
                                          frame.shortname),
                      applName := "FormsEdit", bgColorR := 1.0,
                      bgColorG := 0.7, bgColorB := 0.7)
  END DecorateEditor;

PROCEDURE Last40 (t: TEXT): TEXT =
  VAR n := Text.Length (t);
  BEGIN
    IF n <= 40 THEN RETURN t ELSE RETURN "..." & Text.Sub (t, n - 40, n) END
  END Last40;

PROCEDURE GetEditor (frame: T): FormsVBT.T =
  BEGIN
    RETURN frame.ed
  END GetEditor;

PROCEDURE Realize (ed: Editor; type, name: TEXT): VBT.T
  RAISES {FormsVBT.Error} =
  BEGIN
    IF Text.Equal (name, "openfile") AND Text.Equal (type, "FileBrowser") THEN
      RETURN NEW (JustFVfileBrowser, ed := ed)
    END;
    IF Text.Equal (name, "buffer") AND Text.Equal (type, "TextEdit") THEN
      RETURN NEW (FVTypes.FVTextEdit, port := NEW (EPort, ed := ed))
    END;
    IF Text.Length (name) > 6 AND Text.Equal (Text.Sub (name, 0, 6), "Model_") THEN
      List.Push (ed.modelTsplits, name)
    END;
    RETURN FormsVBT.T.realize (ed, type, name)
  END Realize;

PROCEDURE FBinit (fb    : JustFVfileBrowser;
                  font  : Font.T              := Font.BuiltIn;
                  colors: PaintOp.ColorQuad   := NIL           ):
  FileBrowserVBT.T =
  BEGIN
    EVAL FVTypes.FVFileBrowser.init (fb, font, colors);
    FileBrowserVBT.SetSuffixes (fb, "fv");
    RETURN fb
  END FBinit;

PROCEDURE FBerror (fb: JustFVfileBrowser; err: FileBrowserVBT.E) =
  <* LL = VBT.mu *>
  BEGIN
    Gripe (fb.ed, "Error in %s: %s", err.path, err.text)
  END FBerror;

PROCEDURE ChangeSuffixes (<* UNUSED *> fbcl: FormsVBT.Closure;
                                       fv  : FormsVBT.T;
                                       name: TEXT;
                          <* UNUSED *> time: VBT.TimeStamp  ) =
  VAR fb: FileBrowserVBT.T;
  BEGIN
    TRY
      fb := FormsVBT.GetVBT (fv, "openfile");
      IF Text.Equal (name, "fvonly") THEN
        FileBrowserVBT.SetSuffixes (fb, "fv")
      ELSE
        FileBrowserVBT.SetSuffixes (fb, "")
      END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (fv, msg)
    END
  END ChangeSuffixes;

TYPE
  FindClosure = ButtonClosure OBJECT
                  caseSensitive := TRUE
                OVERRIDES
                  apply := ShowFindWindow
                END;
    
PROCEDURE ShowFindWindow (cl  : FindClosure;
                          fv  : FormsVBT.T;
                          name: TEXT;
                          time: VBT.TimeStamp) =
  VAR
    pattern  : TEXT;
    pos      : INTEGER;
    n        : CARDINAL;
    x        : TextPort.Extent;
    ed       : Editor          := fv;
    rd, revRd: MTextRd.T;
    length   : CARDINAL;
  BEGIN
    TRY
      IF Text.Equal (name, "findMButton") THEN
        FormsVBT.PutInteger (fv, "FindInBuffer", 1);
        FormsVBT.TakeFocus (fv, "bhelpfindtext", time, TRUE)
      ELSIF Text.Equal (name, "bhelpcase") THEN
        cl.caseSensitive := FormsVBT.GetBoolean (fv, name)
      ELSE
        x := TextPort.GetSelection (ed.textport);
        pattern := FormsVBT.GetText (fv, "bhelpfindtext");
        n := Text.Length (pattern);
        IF n = 0 THEN            (* return *)
        ELSIF Text.Equal (name, "bhelpfindfirst")
                OR Text.Equal (name, "bhelpfindtext")
                OR Text.Equal (name, "bhelpfindnext") THEN
          rd := ed.rd.init ();
          IF Text.Equal (name, "bhelpfindnext") THEN Rd.Seek (rd, x.r) END;
          pos := RdUtils.Find (rd, pattern, NOT cl.caseSensitive);
          IF pos # -1 THEN
            TextPort.Select (
              ed.textport, time, pos, pos + n, replaceMode := TRUE);
            TextPort.Normalize (ed.textport, pos)
          END;
          IF Text.Equal (name, "bhelpfindtext") THEN
            FormsVBT.PutInteger (fv, "FindInBuffer", 0) (* disappear *)
          END
        ELSIF Text.Equal (name, "bhelpfindprev") THEN
          revRd := ed.rd.init (reverse := TRUE);
          length := MText.Length (ed.mtext);
          Rd.Seek (revRd, length - x.l);
          pos :=
            RdUtils.Find (
              revRd, Manpage.TextReverse (pattern), NOT cl.caseSensitive);
          IF pos # -1 THEN
            TextPort.Select (ed.textport, time, length - pos - n,
                             length - pos, replaceMode := TRUE);
            TextPort.Normalize (ed.textport, length - pos - n)
          END
        END
      END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (fv, msg)
    | Rd.Failure (ref) => Gripe (fv, RdUtils.FailureText (ref))
    | Range.Error, Thread.Alerted => (* ignore *)
    END
  END ShowFindWindow;

TYPE
  ER = Manpage.ErrorReporter OBJECT
         ed: Editor
       OVERRIDES
         apply := CallGripe
       END;

PROCEDURE CallGripe (er: ER; msg: TEXT) =
  <* LL = VBT.mu *>
  BEGIN
    Gripe (er.ed, msg)
  END CallGripe;

TYPE
  ModelClosure = MForm.RadioClosure OBJECT OVERRIDES apply := ApplyModel END;

PROCEDURE ApplyModel (cl  : ModelClosure;
                      fv  : FormsVBT.T;
                      name: TEXT;
                      time: VBT.TimeStamp ) =
  VAR
    ed     : Editor   := fv;
    frames            := ed.frame.root.frames;
    frame  : T;
    choice : TEXT;
  BEGIN
    MForm.RadioClosure.apply (cl, fv, name, time);
    TRY
      choice := FormsVBT.GetChoice (fv, name);
      WHILE frames # NIL DO
        frame := List.Pop (frames);
        IF frame # ed.frame THEN
          FormsVBT.PutChoice (frame.ed, name, choice)
        END;
        UpdateKeybindingLabels (frame.ed)
      END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (fv, msg)
    END
  END ApplyModel;

PROCEDURE UpdateKeybindingLabels (ed: Editor) RAISES {FormsVBT.Error} =
  VAR
    index   := ORD (TextPort.DefaultModel) - 1;
    tsplits := ed.modelTsplits;
  BEGIN
    WHILE tsplits # NIL DO
      FormsVBT.PutInteger (ed, List.Pop (tsplits), index)
    END
  END UpdateKeybindingLabels;

PROCEDURE EditorInit (ed: Editor; frame: T): Editor RAISES {FormsVBT.Error} =
  <* LL = VBT.mu *>
  <* FATAL Rsrc.NotFound *>
  CONST
    ModelMap = MForm.Map {
                 NIL, "ivyModel", "emacsModel", "macModel", "xtermModel"};
  VAR
    qcl   := NEW (ButtonClosure, apply := DoQuit);
    ccl   := NEW (ButtonClosure, apply := DoClose);
    fbcl  := NEW (ButtonClosure, apply := ChangeSuffixes);
    scl   := NEW (ButtonClosure, apply := SaveAs);
    fmbcl := NEW (FindClosure);
    mcl   := NEW (ModelClosure).init (ModelMap);
  PROCEDURE attach (name: TEXT; proc: KeyProc) RAISES {FormsVBT.Error} =
    BEGIN
      FormsVBT.Attach (
        ed, name, NEW (Attachment, frame := frame, proc := proc))
    END attach;
  PROCEDURE button (name: TEXT; bc: ButtonClosure) RAISES {FormsVBT.Error} =
    BEGIN
      bc.frame := frame;
      FormsVBT.Attach (ed, name, bc)
    END button;
  BEGIN
    ed.frame := frame;
    LOCK FrameCountLock DO INC (FrameCount); frame.number := FrameCount END;
    EVAL Filter.T.init (frame, NIL);
    TRY
      EVAL ed.initFromRsrc ("formseditvbt.fv", formseditPath);
      Manpage.Init (ed, HelpFile, NEW (ER, ed := ed), path := formseditPath);
      ed.buffer := FormsVBT.GetVBT (ed, "buffer");
      ed.modified := FormsVBT.GetVBT (ed, "modified");
      ed.stderr := FormsVBT.GetVBT (ed, "stderr");
      ed.errorPopup := FormsVBT.GetVBT (ed, "errorPopup");
      ed.textport := TextEditVBT.GetPort (ed.buffer);
      ed.vtext := TextPort.GetVText (ed.textport);
      ed.mtext := ed.vtext.mtext;
      ed.rd := NEW (MTextRd.T).init (ed.mtext);
      ed.syntax := FormsVBT.FVSyntax.Copy ();
      ed.parser :=
        NEW (SxParser, intervalTable := RefRefTbl.New (Hash, List.Equal));
      SxSyntax.SetCharParser (ed.syntax, '(', ed.parser);
      VBT.SetCursor (ed.textport, Cursor.TextPointer);
      button ("bhelpfindfirst", fmbcl);
      button ("bhelpfindnext", fmbcl);
      button ("bhelpfindprev", fmbcl);
      button ("bhelpcase", fmbcl);
      button ("bhelpfindtext", fmbcl);
      attach ("clear", Clear);
      button ("close", ccl);
      button ("closeAnyway", ccl);
      attach ("closeError", Reset);
      attach ("copy", Copy);
      attach ("cut", Cut);
      attach ("dumpTable", DumpTheTable);
      button ("findMButton", fmbcl);
      button ("fvonly", fbcl);
      FormsVBT.Attach (ed, "Model", mcl);
      FormsVBT.PutChoice (ed, "Model", ModelMap [TextPort.DefaultModel]);
      UpdateKeybindingLabels (ed);
      attach ("new", New);
      button ("notfvonly", fbcl);
      attach ("open", DoOpen);   (* the Open button in the dialog *)
      attach ("openfile", DoOpen); (* typing Return in the helper *)
      attach ("openMButton", OpenDialog); (* the Open...  menu item *)
      button ("overwrite", scl); (* the Yes button in the overwrite
                                    confirmation *)
      attach ("parse", Parse);
      attach ("paste", Paste);
      attach ("PPrint", PrettyPrint);
      attach ("ppwidth", ChangePPW);
      attach ("ppwidthPopMButton", PPwidthDialog); (* the PPsetup ...  menu
                                                      item *)
      button ("quit", qcl);
      button ("quit2", qcl);
      button ("quitAnyway", qcl);
      attach ("revert", Revert);
      attach ("save", Save);
      button ("saveandclose", ccl);
      button ("saveandquit", qcl);
      attach ("saveandswitch", SaveAndSwitch);
      button ("saveas", scl);    (* the Save button in the dialog *)
      button ("saveasfile", scl); (* typing Return in the helper *)
      attach ("saveasMButton", SaveAsDialog); (* the Save As...  menu item *)
      attach ("selectAll", SelectAll);
      attach ("snapshot", Snapshot);
      attach ("switchAnyway", SwitchAnyway);
      attach ("undo", Undo);
      attach ("redo", Redo);
      ed.highlighter :=
        VText.CreateInterval (ed.vtext, 0, 0, HighlightOptions)
    EXCEPT
    | VTDef.Error (code) => RAISE FormsVBT.Error (VTDef.ErrorCodeTexts [code])
    | Rd.Failure (ref) => RAISE FormsVBT.Error (RdUtils.FailureText (ref))
    | Thread.Alerted => RAISE FormsVBT.Error ("Alerted")
    END;
    RETURN ed
  END EditorInit;

PROCEDURE AttachmentApply (             cl  : Attachment;
                           <* UNUSED *> v   : FormsVBT.T;
                           <* UNUSED *> name: TEXT;
                                        time: VBT.TimeStamp) =
  BEGIN
    cl.proc (cl.frame, time)
  END AttachmentApply;

PROCEDURE KeyFilter (eport: EPort; VAR cd: VBT.KeyRec) =
  <* LL = VBT.mu *>
  VAR
    frame   := eport.ed.frame;
    time    := cd.time;
    handled := TRUE;             (* Did we recognize this key? *)
  BEGIN
    TRY
      IF cd.whatChanged = 16_FF67
        (* Should have been KeyboardKey.Execute *) THEN
        Parse (frame, time)
      ELSIF cd.whatChanged = KeyboardKey.Help THEN
        Help (frame, time)
      ELSIF VBT.Modifier.Option IN cd.modifiers THEN
        CASE KeyTrans.Latin1 (cd.whatChanged) OF
        | 'a' => SelectAll (frame, time)
        | 'f' =>
            IF eport.getModel () # TextPort.Model.Emacs THEN
              FormsVBT.MakeEvent (eport.ed, "findMButton", time)
            ELSE
              handled := FALSE
            END
        | 'h' => Help (frame, time)
        | 'n' => New (frame, time)
        | 'o' => OpenDialog (frame, time)
        | 'p' => PrettyPrint (frame, time)
        | 'q' => FormsVBT.MakeEvent (eport.ed, "quit", time)
        | 's' => Save (frame, time)
        ELSE
          handled := FALSE
        END
      ELSE
        handled := FALSE
      END;
      IF handled THEN cd.whatChanged := VBT.NoKey END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (frame.ed, msg)
    END
  END KeyFilter;

(*********************** Editing Commands **********************************)

PROCEDURE Copy (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO frame.ed.textport.m.copy (time) END
  END Copy;

PROCEDURE Paste (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO frame.ed.textport.m.paste (time) END
  END Paste;

PROCEDURE Cut (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO frame.ed.textport.m.cut (time) END
  END Cut;

PROCEDURE Clear (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO frame.ed.textport.m.clear () END
  END Clear;

PROCEDURE Undo (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO TextPortClass.Undo (frame.ed.textport) END
  END Undo;

PROCEDURE Redo (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    LOCK frame.ed.textport.mu DO TextPortClass.Redo (frame.ed.textport) END
  END Redo;

PROCEDURE SelectAll (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TextPort.Select (
      frame.ed.textport, time, 0, LAST (CARDINAL), replaceMode := TRUE)
  END SelectAll;

(*********************** Control Commands **********************************)

PROCEDURE DoQuit (             qcl : ButtonClosure;
                  <* UNUSED *> fv  : FormsVBT.T;
                               name: TEXT;
                               time: VBT.TimeStamp  ) =
  <* LL = VBT.mu *>
  VAR
    frame  := qcl.frame;
    ed := frame.ed;
  BEGIN
    TRY
      IF Text.Equal (name, "quit") OR Text.Equal (name, "quit2") THEN
        IF NOT TextPort.IsModified (ed.textport) THEN
          frame.delete ();
          Thread.Alert (frame.root.thread) (* Alert the EdRoot *)
        ELSE
          FormsVBT.PopUp (ed, "quitConfirmation", time)
        END
      ELSIF Text.Equal (name, "quitAnyway") THEN
        frame.delete ();
        Thread.Alert (frame.root.thread)
      ELSIF NOT Text.Equal (name, "saveandquit") THEN (* skip *)
      ELSIF NOT Text.Empty (frame.fullPathname) THEN
        Save (frame, time);
        frame.delete ();
        Thread.Alert (frame.root.thread)
      ELSE
        FormsVBT.PopUp (ed, "SaveAsDialog", time);
        FormsVBT.PopDown (ed, "quitConfirmation")
      END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (ed, msg)
    END;
  END DoQuit;

PROCEDURE DoClose (             ccl : ButtonClosure;
                   <* UNUSED *> fv  : FormsVBT.T;
                                name: TEXT;
                                time: VBT.TimeStamp  ) =
  <* LL = VBT.mu *>
  VAR
    frame  := ccl.frame;
    ed := frame.ed;
  BEGIN
    TRY
      IF Text.Equal (name, "close") THEN
        IF NOT TextPort.IsModified (ed.textport) THEN
          frame.delete ()
        ELSE
          FormsVBT.PopUp (ed, "closeConfirmation", time)
        END
      ELSIF Text.Equal (name, "closeAnyway") THEN
        frame.delete ()
      ELSIF NOT Text.Equal (name, "saveandclose") THEN (* skip *)
      ELSIF Text.Empty (frame.fullPathname) THEN
        FormsVBT.PopUp (frame.ed, "SaveAsDialog", time);
        FormsVBT.PopDown (ed, "closeConfirmation")
      ELSE
        Save (frame, time);
        frame.delete ()
      END
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (ed, msg)
    END
  END DoClose;

PROCEDURE DeleteFrame (frame: T) =
  <* LL = VBT.mu *>
  VAR root := frame.root;
  BEGIN
    Debug (Fmt.F ("Frame %s is terminating.\n", Fmt.Int (frame.number)));
    LOCK frame.mu DO
      Trestle.Delete (frame);
      Trestle.Delete (frame.ed);
      LOCK root.mu DO
        IF NOT List.Member (root.frames, frame) THEN
          Debug ("Error: Unknown frame\n")
        END;
        root.frames := List.DeleteQ (root.frames, frame);
        IF root.frames = NIL THEN Thread.Signal (root.allClosed) END
      END
    END
  END DeleteFrame;

PROCEDURE New (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR newframe: T;
  BEGIN
    TRY
      newframe := NEW (T, root := frame.root).init ();
      Install (newframe, MoveGeometry (frame));
      newframe.spawn ()
    EXCEPT
    | TrestleComm.Failure, XParam.Error, FormsVBT.Error =>
        Gripe (frame.ed, "Couldn't install new window")
    END
  END New;

PROCEDURE MoveGeometry (frame: T): TEXT =
  <* LL = VBT.mu *>
  CONST
    Displacement = ARRAY Rect.Vertex OF
                     Point.T {Point.T {50, 50}, Point.T {-50, 50},
                              Point.T {50, -50}, Point.T {-50, -50}};
  VAR g := frame.egrec; d := VBT.Domain (frame.ed);
  BEGIN
    g.dp := Point.Add (g.dp, Displacement [g.vertex]);
    g.size := Point.T {Rect.HorSize (d), Rect.VerSize (d)}; 
    RETURN XParam.UnparseGeometry (g)
  END MoveGeometry;

(*********************** Help Command **********************************)

PROCEDURE Help (frame: T; time: VBT.TimeStamp)
  RAISES {FormsVBT.Error} =
  <* LL = VBT.mu *>
  BEGIN
    FormsVBT.PopUp (frame.ed, "manpage", time)
  END Help;

PROCEDURE Revert (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      Read (frame);
      FormsVBT.PopDown (frame.ed, "RevertDialog")
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (frame.ed, msg)
    | Thread.Alerted =>
    END
  END Revert;

(****************** Snapshot/Restore Command *****************************)

PROCEDURE Snapshot (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  <* FATAL Wr.Failure, Thread.Alerted *>(* Can't happen with TextWr *)
  BEGIN
    WITH ed = frame.ed,
         ch = NARROW (Filter.Child (frame), FormsVBT.T),
         wr = TextWr.New ()                              DO
      TRY
        TRY
          FormsVBT.PutText (ed, "SnapshotText", "");
          ch.snapshot (wr);
          FormsVBT.PutText (ed, "SnapshotText", TextWr.ToText (wr));
        EXCEPT
        | FormsVBT.Error (msg) => Gripe (ed, msg)
        END
      FINALLY
        Wr.Close (wr)
      END;
    END
  END Snapshot;

<* UNUSED *>
  PROCEDURE SnapshotToFile (             frame: T;
                            <* UNUSED *> time : VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR
    wr      : Wr.T;
    filename: TEXT;
  BEGIN
    WITH ed = frame.ed,
         ch = NARROW(Filter.Child(frame), FormsVBT.T) DO
      ClearError(ed);
      TRY
        filename := FormsVBT.GetText(ed, "snapshot");
        wr := FileStream.OpenWrite(filename);
        TRY ch.snapshot(wr) FINALLY Wr.Close(wr) END;
        FormsVBT.PopDown(ed, "SnapshotDialog");
      EXCEPT
      | FormsVBT.Error (msg) => Gripe(ed, msg)
      | Wr.Failure (refany) =>
          Gripe(ed, "Couldn't write %s: %s", filename,
                RdUtils.FailureText(refany))
      | Thread.Alerted =>
      END
    END
  END SnapshotToFile;

<* UNUSED *>
  PROCEDURE RestoreFromFile (             frame: T;
                             <* UNUSED *> time : VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR
    rd      : Rd.T;
    filename: TEXT;
  BEGIN
    WITH ed = frame.ed,
         ch = NARROW(Filter.Child(frame), FormsVBT.T) DO
      ClearError(ed);
      TRY
        filename := FormsVBT.GetText(ed, "restore");
        rd := FileStream.OpenRead(filename);
        TRY ch.restore(rd) FINALLY Rd.Close(rd) END;
        FormsVBT.PopDown(ed, "RestoreDialog");
      EXCEPT
      | FormsVBT.Mismatch =>
          Gripe(
            ed, "Snapshot contains components not in current form")
      | FormsVBT.Error (msg) => Gripe(ed, msg)
      | Rd.Failure (refany) =>
          Gripe(ed, "Couldn't read %s: %s", filename,
                RdUtils.FailureText(refany))
      | Thread.Alerted =>
      END
    END
  END RestoreFromFile;


(*********************** Open Command **********************************)

PROCEDURE OpenDialog (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      FormsVBT.PutBoolean (frame.ed, "newwindow", TRUE);
      FormsVBT.PopUp (frame.ed, "OpenDialog", time);
      FormsVBT.TakeFocus (frame.ed, "fbh", time, TRUE)
    EXCEPT
    | FormsVBT.Error (text) => Gripe (frame.ed, text)
    END
  END OpenDialog;

PROCEDURE DoOpen (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR ed := frame.ed;
  BEGIN
    TRY
      IF NOT FormsVBT.GetBoolean (ed, "reuse") THEN
        OpenNewWindow (frame, FormsVBT.GetText (ed, "openfile"))
      ELSIF TextPort.IsModified (ed.textport) THEN
        FormsVBT.PopUp (ed, "switchConfirmation", time)
      ELSE
        OpenInCurrentWindow (
          frame, FormsVBT.GetText (ed, "openfile"))
      END;
      FormsVBT.PopDown (ed, "OpenDialog")
    EXCEPT
    | FormsVBT.Error (text) => Gripe (ed, text)
    END
  END DoOpen;

PROCEDURE OpenNewWindow (frame: T; filename: TEXT) =
  BEGIN
    TRY
      WITH newframe = NEW (T, root := frame.root).initFromFile (filename) DO
        Install (newframe, MoveGeometry (frame));
        newframe.spawn ()
      END
    EXCEPT
    | TrestleComm.Failure, XParam.Error =>
        Gripe (frame.ed, "Couldn't install new window")
    | FormsVBT.Error (text) => Gripe (frame.ed, text)
    | Thread.Alerted =>
    END
  END OpenNewWindow;

PROCEDURE SwitchAnyway (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR ed := frame.ed;
  BEGIN
    TRY
      ClearError (ed);
      FormsVBT.PopDown (ed, "switchConfirmation");
      OpenInCurrentWindow (frame, FormsVBT.GetText (ed, "openfile"))
    EXCEPT
    | FormsVBT.Error (text) => Gripe (ed, text)
    END
  END SwitchAnyway;

PROCEDURE OpenInCurrentWindow (frame: T; filename: TEXT) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      frame.fullPathname := filename;
      frame.shortname := Filename.Tail (filename);
      FormsVBT.PutText (frame.ed, "shortname", frame.shortname);
      Read (frame)
    EXCEPT
    | FormsVBT.Error (text) => Gripe (frame.ed, text)
    | Thread.Alerted =>
    END
  END OpenInCurrentWindow;
  
PROCEDURE SaveAndSwitch (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR ed := frame.ed;
  BEGIN
    TRY
      ClearError (ed);
      Save (frame, time);
      OpenInCurrentWindow (frame, FormsVBT.GetText (ed, "openfile"));
      FormsVBT.PopDown (ed, "switchConfirmation")
    EXCEPT
    | FormsVBT.Error (text) => Gripe (ed, text)
    END
  END SaveAndSwitch;


(*********************** Error-handling **********************************)

PROCEDURE Gripe (ed: Editor; fmt: TEXT; a, b, c, d, e: TEXT := NIL) =
  <* LL = VBT.mu *>
  BEGIN
    IF a # NIL THEN fmt := Fmt.F (fmt, a, b, c, d, e) END;
    TextPort.SetText (ed.stderr.port, fmt);
    ZChildVBT.Pop (ed.errorPopup)
  END Gripe;

PROCEDURE LockNGripe (ed: Editor; fmt: TEXT; a, b, c, d, e: TEXT := NIL) =
  <* LL = 0 *>
  BEGIN
    LOCK VBT.mu DO Gripe (ed, fmt, a, b, c, d, e) END
  END LockNGripe; 

PROCEDURE ClearError (ed: Editor) =
  <* LL = VBT.mu *>
  <* FATAL FormsVBT.Error *>(* "errorPopup" exists. *)
  BEGIN
    FormsVBT.PopDown (ed, "errorPopup");
    TextPort.SetText (ed.stderr.port, "")
  END ClearError;

PROCEDURE NoteModification (eport: EPort) =
  <* LL = VBT.mu *>
  BEGIN
    SetModified (eport.ed, TRUE)
  END NoteModification;
  
PROCEDURE SetModified (ed: Editor; value: BOOLEAN) =
  <* LL = VBT.mu *>
  <* FATAL FormsVBT.Error *>(* "revertbutton" exists. *)
  CONST marks = ARRAY BOOLEAN OF TEXT {" ", "*"};
  BEGIN
    IF ed.modified # NIL THEN TextVBT.Put (ed.modified, marks [value]) END;
    (* IF value AND NOT Text.Empty (ed.frame.fullPathname) THEN
       FormsVBT.MakeActive (ed, "revertbutton") END *)
  END SetModified;

PROCEDURE Reset (frame: T; <* UNUSED *> time: VBT.TimeStamp := 0) =
  <* LL = VBT.mu *>
  VAR ed := frame.ed;
  BEGIN
    ClearError (ed);
    ed.parser.intervalTable.clear ();
    TRY
      VText.SwitchInterval (ed.highlighter, VText.OnOffState.Off);
      VBT.Mark (ed.textport)
    EXCEPT
    | VTDef.Error (code) => Gripe (ed, VTDef.ErrorCodeTexts [code])
    END
  END Reset;

(*********************** PPrint Command **********************************)

PROCEDURE PPwidthDialog (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      FormsVBT.TakeFocus (frame.ed, "ppwidth", time, TRUE);
    EXCEPT
    | FormsVBT.Error (text) => Gripe (frame.ed, text)
    END
  END PPwidthDialog;
  
PROCEDURE ChangePPW (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  <* FATAL FormsVBT.Error, FormsVBT.Unimplemented *>
  BEGIN
    frame.prettyprintWidth :=
      FormsVBT.GetInteger (frame.ed, "ppwidth");
    TRY
      FormsVBT.PopDown (frame.ed, "PPwidthNumeric")
    EXCEPT
      FormsVBT.Error (msg) => Gripe (frame.ed, msg)
    END;
    PrettyPrint (frame, time)
  END ChangePPW;

PROCEDURE PrettyPrint (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  <* FATAL Thread.Alerted *>
  (* This is fast enough that we can do it in event-time. *)
  VAR ed := frame.ed;
  BEGIN
    Reset (frame);
    TRY
      WITH oldtext     = TextPort.GetText (ed.textport),
           oldlength   = Text.Length (oldtext),
           oldposition = TextPort.Index (ed.textport),
           s   = Sx.FromText (oldtext, syntax := FormsVBT.FVSyntax),
           wr  = TextWr.New (),
           fwr = FWr.New (wr, frame.prettyprintWidth)                DO
        Sx.PrintNL (fwr, s, syntax := FormsVBT.FVSyntax);
        FWr.Flush (fwr);
        WITH newtext     = TextWr.ToText (wr),
             newlength   = Text.Length (newtext),
             newposition = (oldposition * newlength) DIV oldlength DO
          TextPort.SetText (ed.textport, newtext);
          TextPort.Normalize (ed.textport, newposition);
          FWr.Close (fwr);
          Wr.Close (wr)
        END
      END
    EXCEPT
    | Sx.ReadError (msg) => Gripe (ed, "S-expression error: %s", msg)
    | Sx.PrintError (ref) => Gripe (ed, SxPrintErrorText (ref))
    | Rd.EndOfFile => Gripe (ed, "Premature end of file")
    | Wr.Failure (ref) => Gripe (ed, RdUtils.FailureText (ref))
    END
  END PrettyPrint;

PROCEDURE SxPrintErrorText (ref: REFANY): TEXT =
  BEGIN
    TYPECASE ref OF
    | TEXT (msg) => RETURN "S-expression print error: " & msg
    ELSE
      RETURN "Unknown Sx.PrintError"
    END
  END SxPrintErrorText;
  
(******************* Parse ("Do It") Command ******************************)

PROCEDURE Parse (frame: T; <* UNUSED *> time: VBT.TimeStamp := 0) =
  <* LL = VBT.mu *>
  <* FATAL FormsVBT.Error *>
  BEGIN
    Reset (frame);
    FormsVBT.MakePassive (frame.ed, "top");
    EVAL Thread.Fork (NEW (ParseClosure, stackSize := STACKSIZE,
                           frame := frame))
  END Parse;

PROCEDURE ParseClosureApply (cl: ParseClosure): REFANY =
  <* LL = 0 *>
  <* FATAL FormsVBT.Error *>(* "top" exists. *)
  VAR
    frame             := cl.frame;
    ed                := frame.ed;
    new  : FormsVBT.T;
    old  : VBT.T;
    form : REFANY;
  BEGIN
    TRY                          (* EXCEPT *)
      TRY                        (* FINALLY *)
        form := Sx.Read (ed.rd.init (), syntax := ed.syntax);
        (* As it reads, start/end intervals will be added to the table. *)
        LOCK VBT.mu DO
          new := NEW (FormsVBT.T).initFromSx (form, path := frame.path);
          StableVBT.Disable (frame);
          old := Filter.Replace (frame, new);
          IF old # NIL THEN
            FVRuntime.SetAttachments (new, FVRuntime.GetAttachments (old));
            VBT.Discard (old)
          END;
          ClearError (ed)
        END
      FINALLY
        LOCK VBT.mu DO FormsVBT.MakeActive (ed, "top") END;
      END
    EXCEPT
    | FormsVBT.Error (msg) =>
        LOCK VBT.mu DO Gripe (ed, msg); HighlightError (frame) END
    | Sx.ReadError (msg) => LOCK VBT.mu DO Gripe (ed, msg) END
    | Rd.EndOfFile => LockNGripe (ed, "Premature end of file ")
    | Rd.Failure (ref) => LockNGripe (ed, RdUtils.FailureText (ref))
    | Thread.Alerted =>
    END;
    RETURN NIL
  END ParseClosureApply;

PROCEDURE SxParserApply (p     : SxParser;
                         rd    : Rd.T;
                         ch    : CHAR;
                         root  : SxSymbol.T;
                         syntax: SxSyntax.T  ): REFANY
  RAISES {Sx.ReadError, Rd.Failure, Thread.Alerted} =
  (* Record the starting and ending positions of every list we read, so
     that we can highlight the list if there's a syntax error. *)
  BEGIN
    <* ASSERT ch = '(' *>
    WITH start = Rd.Index (rd) - 1,
         exp   = syntax.ReadUntil (rd, ')', root),
         end   = Rd.Index (rd)                     DO
      EVAL p.intervalTable.put (
             exp, NEW (Interval, start := start, end := end));
      RETURN exp
    END
  END SxParserApply;

PROCEDURE HighlightError (frame: T) =
  <* LL = VBT.mu *>
  VAR
    ed              := frame.ed;
    stack           := FVRuntime.formstack;
    i    : Interval;
    ref  : REFANY;
  BEGIN
    LOOP
      IF stack = NIL THEN RETURN END;
      TYPECASE List.Pop (stack) OF
      | NULL =>
      | List.T (x) =>
          IF ed.parser.intervalTable.in (x, ref) THEN
            i := ref;
            TRY
              TextPort.Normalize (ed.textport, i.start);
              VText.MoveInterval (ed.highlighter, i.start, i.end);
              VText.SwitchInterval (ed.highlighter, VText.OnOffState.On);
              VBT.Mark (ed.textport)
            EXCEPT
              VTDef.Error =>    (* ignore *)
            END;
            RETURN
          END                   (* IF *)
      ELSE
      END                       (* TYPECASE *)
    END                         (* LOOP *)
  END HighlightError;

(******************* Save and SaveAs Commands ******************************)

PROCEDURE Save (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  VAR
    ed             := frame.ed;
    filename       := frame.fullPathname;
    wr      : Wr.T;
  BEGIN
    ClearError (ed);
    TRY
      IF Text.Empty (filename) THEN
        FormsVBT.PopUp (ed, "SaveAsDialog", time);
        RETURN
      END;
      wr := FileStream.OpenWrite (filename);
      TRY
        Wr.PutText (wr, TextPort.GetText (ed.textport))
      FINALLY
        Wr.Close (wr)
      END;
      TextPort.SetModified (ed.textport, FALSE);
      SetModified (ed, FALSE);
      (* FormsVBT.MakeDormant (ed, "revertbutton") *)
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (ed, msg)
    | Wr.Failure (refany) =>
        Gripe (
          ed, "Couldn't write %s: %s", filename, RdUtils.FailureText (refany))
    | Thread.Alerted =>
    END
  END Save;

PROCEDURE SaveAsDialog (frame: T; time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      FormsVBT.TakeFocus (frame.ed, "sfbh", time, TRUE)
    EXCEPT
    | FormsVBT.Error (text) => Gripe (frame.ed, text)
    END
  END SaveAsDialog;
  
PROCEDURE SaveAs (             cl  : ButtonClosure;
                  <* UNUSED *> fv  : FormsVBT.T;
                               name: TEXT;
                               time: VBT.TimeStamp  ) =
  <* LL = VBT.mu *>
  <* FATAL UnixUtils.Error *>(* Can't happen *)
  VAR
    frame          := cl.frame;
    ed             := frame.ed;
    filename: TEXT;
    wr      : Wr.T;
  BEGIN
    ClearError (ed);
    TRY
      filename := FormsVBT.GetText (ed, "saveasfile");
      IF Text.Empty (filename) THEN Gripe (ed, "No filename!"); RETURN END;
      IF Text.Equal (name, "overwrite") THEN (* Don't ask *)
        FormsVBT.PopDown (ed, "overwriteConfirmation")
      ELSIF UnixUtils.ProbeFile (filename, FALSE) THEN
        FormsVBT.PopUp (ed, "overwriteConfirmation", time);
        FormsVBT.PopDown (ed, "SaveAsDialog");
        RETURN
      END;
      wr := FileStream.OpenWrite (filename);
      TRY
        Wr.PutText (wr, TextPort.GetText (ed.buffer.port));
      FINALLY
        Wr.Close (wr)
      END;
      frame.fullPathname := filename;
      frame.shortname := Filename.Tail (filename);
      FormsVBT.PutText (ed, "shortname", frame.shortname);
      (* FormsVBT.MakeDormant (ed, "revertbutton"); *)
      TextPort.SetModified (ed.textport, FALSE);
      SetModified (ed, FALSE);
      FormsVBT.PopDown (ed, "SaveAsDialog");
      frame.decorate ();
      ed.decorate ()
    EXCEPT
    | FormsVBT.Error (msg) => Gripe (ed, msg)
    | Wr.Failure (refany) =>
        Gripe (
          ed, "Couldn't write %s: %s", filename, RdUtils.FailureText (refany))
    | Thread.Alerted =>
    | TrestleComm.Failure => Gripe (ed, "Couldn't change window labels")
    END
  END SaveAs;

PROCEDURE DumpTheTable (frame: T; <* UNUSED *> time: VBT.TimeStamp) =
  <* LL = VBT.mu *>
  <* FATAL Wr.Failure, Thread.Alerted *>(* all in-memory *)
  BEGIN
    VAR
      ed          := frame.ed;
      ch          := Filter.Child (frame);
      alist       := FVRuntime.NamedVBTs (ch);
      alist2      := alist;
      attachments := FVRuntime.GetAttachments (ch);
      maxlen      := 0;
    VAR
      value: REFANY;
      key  : TEXT;
      pair : List.T;
      vbt  : VBT.T;
      sr   : VBT.SizeRange;
    BEGIN
      WHILE alist2 # NIL DO
        pair := List.Pop (alist2);
        maxlen := MAX (maxlen, Text.Length (pair.first))
      END;
      WITH wr = TextWr.New () DO
        TRY
          WHILE alist # NIL DO
            pair := List.Pop (alist);
            key := List.Pop (pair);
            value := pair.first;
            Wr.PutText (wr, Fmt.F ("%s : %s", Fmt.Pad (key, maxlen),
                                   RTutils.TypeName (value)));
            IF List.Assoc (attachments, key) # NIL THEN
              Wr.PutChar (wr, '*')
            END;
            vbt := value;
            FOR ax := FIRST (Axis.T) TO LAST (Axis.T) DO
              sr := vbt.shape (ax, 0);
              Wr.PutText (
                wr, Fmt.F ("  [%s, %s, %s]", Fmt.Int (sr.lo),
                           Fmt.Int (sr.pref), Fmt.Int (sr.hi)))
            END;
            Wr.PutChar (wr, '\n')
          END;
          TRY
            FormsVBT.PutText (ed, "VBTtable", TextWr.ToText (wr))
          EXCEPT
          | FormsVBT.Error (msg) => Gripe (ed, msg)
          END
        FINALLY
          Wr.Close (wr)
        END
      END
    END
  END DumpTheTable;

PROCEDURE Hash (x: REFANY): INTEGER =
  BEGIN
    RETURN List.Hash (NIL, x)
  END Hash;

PROCEDURE MoverApply (             m         : Mover;
                                   ed        : FormsVBT.T;
                      <* UNUSED *> buttonName: TEXT;
                      <* UNUSED *> time      : VBT.TimeStamp) =
  <* LL = VBT.mu *>
  BEGIN
    TRY
      WITH nw  = Rect.NorthWest (VBT.Domain (m.vbt)),
           rec = Trestle.ScreenOf (m.vbt, nw)         DO
        Trestle.Overlap (m.vbt, m.id, rec.q)
      END
    EXCEPT
    | TrestleComm.Failure => Gripe (ed, "Can't move. Trestle.Overlap failed.")
    END
  END MoverApply;

VAR doDebug := FALSE;

PROCEDURE Debug (t: TEXT) =
  BEGIN
    IF doDebug THEN SmallIO.PutText (SmallIO.stderr, t) END
  END Debug;
  
BEGIN
  HighlightOptions :=
    VText.MakeIntervalOptions (
      VText.IntervalStyle.BoxStyle, PaintOp.bgFg, PaintOp.bgFg, PaintOp.Bg)
END FormsEditVBT.