(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Thu Dec 31 01:50:11 PST 1992 by meehan                   *)
<* PRAGMA LL *>

MODULE EmacsModel;

IMPORT Char, KeyboardKey, KeyTrans, Latin1Key, MTextUnit, PaintOp, Rd, Text,
       TextPort, TextPortClass, Thread, VBT, VTDef, VText;

REVEAL
  T =
    TextPortClass.Model BRANDED OBJECT
      selection: TextPortClass.SelectionRecord;
      downclick: CARDINAL;
      clipboard                                  := "";
      state                                      := State.Initial;
      append                                     := FALSE
    METHODS
      setMark      (x: CARDINAL)                               := SetMark;
      moveInterval (left, right: CARDINAL; highlight: BOOLEAN) := MoveInterval
    OVERRIDES
      controlChord    := ControlChord;
      copy            := Copy;
      filter          := Filter;
      getSelection    := GetSelection;
      hasVBTselection := HasVBTselection;
      init            := Init;
      misc            := Misc;
      mouse           := Mouse;
      optionChord     := OptionChord;
      paste           := Paste;
      position        := Position;
      putSelectedText := PutSelectedText;
      read            := Read;
      seek            := SetPoint;
      select          := Select;
      takeSelection   := TakeSelection;
      walkIntervals   := WalkIntervals;
      write           := Write;
    END;

TYPE State = {Initial, SawControlK, SawControlQ, SawEscape};

(* "EmacsModel.T.filter" is a 4-state machine that implements a 1-character
   lookahead for control-K (successive control-K's append to the clipboard),
   control-Q (quoted insert), and Escape (add the Option modifier to the
   KeyRec). *)

CONST Primary = TextPort.SelectionType.Primary;

PROCEDURE Init (m: T; colorScheme: PaintOp.ColorScheme): TextPortClass.Model =
  BEGIN
    TRY
      m.selection.interval :=
        VText.CreateInterval (
          vtext := m.v.vtext, indexL := 0, indexR := 0,
          options := VText.MakeIntervalOptions (
                       style := VText.IntervalStyle.UnderlineStyle,
                       whiteBlack := colorScheme, whiteStroke := colorScheme,
                       leading := colorScheme.bg));
      m.selection.mode := VText.SelectionMode.CharSelection; (* always *)
    EXCEPT
    | VTDef.Error (ec) => m.v.vterror ("Model Init", ec)
    END;
    RETURN m
  END Init;

PROCEDURE SetPoint (m: T; p: CARDINAL) =
  BEGIN
    TextPortClass.Model.seek (m, p);
    IF p < m.fixed THEN
      m.moveInterval (p, m.fixed, m.dragging)
    ELSE
      m.moveInterval (m.fixed, p, m.dragging)
    END
  END SetPoint;

PROCEDURE SetMark (m: T; p: CARDINAL) =
  BEGIN
    m.fixed := p;
    m.moveInterval (p, p, FALSE)
  END SetMark;

PROCEDURE MoveInterval (m: T; left, right: CARDINAL; highlight: BOOLEAN) =
  BEGIN
    TRY
      VText.MoveInterval (m.selection.interval, left, right);
      VText.SwitchInterval (
        m.selection.interval, VAL (ORD (highlight), VText.OnOffState));
      VBT.Mark (m.v)
    EXCEPT
    | VTDef.Error (ec) => m.v.vterror ("Highlight", ec)
    END
  END MoveInterval;

PROCEDURE ControlChord (m: T; ch: CHAR; READONLY cd: VBT.KeyRec) =
  CONST name = "Control Key";
  VAR v := m.v;
  BEGIN
    TRY
      CASE Char.Upper [ch] OF
      | ' ', '@' => m.setMark (v.index ())
      | '_' => TextPortClass.Undo (v)
      | 'A' => TextPortClass.ToStartOfLine (v)
      | 'B' => TextPortClass.ToPrevChar (v)
      | 'D' => EVAL TextPortClass.DeleteNextChar (v)
      | 'E' => TextPortClass.ToEndOfLine (v)
      | 'F' => TextPortClass.ToNextChar (v)
      | 'H' => m.seek (TextPortClass.DeletePrevChar (v).l)
      | 'I' => m.v.ULtabAction (cd)
      | 'J' => m.v.newlineAndIndent ()
      | 'K' => Kill (m, v, cd)
      | 'M' => m.v.ULreturnAction (cd)
      | 'N' => TextPortClass.DownOneLine (v)
      | 'O' => TextPortClass.InsertNewline (v)
      | 'P' => TextPortClass.UpOneLine (v)
      (* Control-Q is handled by the filter method. *)
      | 'R' => find (m, cd.time, TextPortClass.Direction.Backward)
      | 'S' => find (m, cd.time, TextPortClass.Direction.Forward)
      | 'T' => TextPortClass.SwapChars (v)
      | 'V' => TextPortClass.ScrollOneScreenUp (v); RETURN
      | 'W' => m.cut (cd.time)
      | 'Y' => m.paste (cd.time)
      | 'Z' => TextPortClass.ScrollOneLineUp (v); RETURN
      ELSE
        (* Don't normalize if unknown chord, including just ctrl itself. *)
        m.v.ULdefaultAction (cd);
        RETURN
      END
    EXCEPT
    | VTDef.Error (ec) => m.v.vterror (name, ec)
    | Rd.Failure (ref) => m.v.rdfailure (name, ref)
    | Rd.EndOfFile => m.v.rdeoferror (name)
    | Thread.Alerted =>
    END;
    m.v.normalize (-1)
  END ControlChord;

PROCEDURE Kill (m: T; v: TextPort.T; READONLY cd: VBT.KeyRec) =
  (* Delete to end of line, but also make the deleted text be the source
     selection. *)
  PROCEDURE clip (t: TEXT) =
    BEGIN
      IF m.append THEN
        m.clipboard := m.clipboard & t
      ELSE
        m.clipboard := t
      END
    END clip;
  VAR
    here := v.index ();
    info := MTextUnit.LineInfo (v.vtext.mtext, here);
  BEGIN
    IF NOT m.takeSelection (Primary, cd.time) THEN (* skip *)
    ELSIF here = info.rightEnd THEN
      (* We're already at the end of line. *)
      clip (v.getText (here, info.right));
      EVAL v.replace (here, info.right, "")
    ELSE
      clip (v.getText (here, info.rightEnd));
      EVAL v.replace (here, info.rightEnd, "")
    END
  END Kill;

PROCEDURE find (m: T; time: VBT.TimeStamp; direction: TextPortClass.Direction) =
  BEGIN
    TRY
      WITH t   = m.read (VBT.Source, time),
           ext = TextPortClass.Find (m.v, t, direction) DO
        IF ext # TextPort.NotFound THEN
          m.select (time, ext.l, ext.r, replaceMode := TRUE,
                    caretEnd := VAL (1 - ORD (direction), VText.WhichEnd))
        END
      END
    EXCEPT
    | VBT.Error (ec) => m.v.vbterror ("find", ec)
    END
  END find;

PROCEDURE OptionChord (m: T; ch: CHAR; READONLY cd: VBT.KeyRec) =
  CONST name = "Option Key";
  VAR
    ext: TextPort.Extent;
    v                    := m.v;
  BEGIN
    TRY
      CASE Char.Upper [ch] OF
      | '_' => TextPortClass.Redo (v)
      | '<' => m.seek (0)
      | '>' => m.seek (LAST (CARDINAL))
      | 'B' =>
          ext := TextPortClass.FindPrevWord (v);
          IF ext # TextPort.NotFound THEN m.seek (ext.l) END
      | 'D' => EVAL TextPortClass.DeleteToEndOfWord (v)
      | 'F' =>
          ext := TextPortClass.FindNextWord (v);
          IF ext # TextPort.NotFound THEN m.seek (ext.r) END
      | 'H', Char.BS, Char.DEL =>
          EVAL TextPortClass.DeleteToStartOfWord (v)
      | 'V' => TextPortClass.ScrollOneScreenDown (v); RETURN
      | 'W' => m.copy (cd.time)
      | 'Z' => TextPortClass.ScrollOneLineDown (v); RETURN
      ELSE
        IF cd.whatChanged = KeyboardKey.Left THEN
          OptionChord (m, 'b', cd)
        ELSIF cd.whatChanged = KeyboardKey.Right THEN
          OptionChord (m, 'f', cd)
        ELSE
          (* Don't normalize if unknown chord, including just option
             itself. *)
          m.v.ULdefaultAction (cd)
        END;
        RETURN
      END
    EXCEPT
    | VTDef.Error (ec) => m.v.vterror (name, ec)
    | Rd.Failure (ref) => m.v.rdfailure (name, ref)
    | Rd.EndOfFile => m.v.rdeoferror (name)
    | Thread.Alerted => RETURN
    END;
    m.v.normalize (-1)
  END OptionChord;

PROCEDURE Mouse (m: T; READONLY cd: VBT.MouseRec) =
  BEGIN
    IF cd.clickType = VBT.ClickType.FirstDown
         AND cd.whatChanged = VBT.Modifier.MouseL AND m.v.getKFocus (cd.time) THEN
      m.downclick := TextPortClass.GetRange (
                       m.v, cd.cp, VText.SelectionMode.CharSelection).middle;
      m.seek (m.downclick);
      m.dragging := TRUE
    ELSE
      m.dragging := FALSE
    END
  END Mouse;

PROCEDURE Position (m: T; READONLY cd: VBT.PositionRec) =
  BEGIN
    IF NOT m.dragging THEN       (* skip *)
    ELSIF cd.cp.gone THEN
      VBT.SetCage (m.v, VBT.GoneCage)
    ELSE
      IF m.fixed # m.downclick THEN m.setMark (m.downclick) END;
      m.seek (TextPortClass.GetRange (
                m.v, cd.cp, VText.SelectionMode.CharSelection).middle)
    END
  END Position;

(***********************  Reading  ****************************)

PROCEDURE Read (m: T; READONLY s: VBT.Selection; time: VBT.TimeStamp): TEXT
  RAISES {VBT.Error} =
  BEGIN
    IF s = VBT.Source AND m.selection.owned THEN
      RETURN m.clipboard
    ELSE
      RETURN TextPortClass.Model.read (m, s, time)
    END
  END Read;

(***********************  Writing  ****************************)

PROCEDURE PutSelectedText (m: T; t: TEXT; sel: TextPort.SelectionType) =
  VAR
    interval := m.selection.interval;
    left     := interval.left ();
  BEGIN
    IF sel = Primary
         AND m.v.replace (left, interval.right (), t) # TextPort.NotFound THEN
      (* NB: Replace changes interval! *)
      m.moveInterval (left, left + Text.Length (t), FALSE)
    END
  END PutSelectedText;

PROCEDURE Write (m: T; READONLY s: VBT.Selection; time: VBT.TimeStamp; t: TEXT)
  RAISES {VBT.Error} =
  BEGIN
    IF s = VBT.Source AND m.selection.owned THEN
      m.clipboard := t
    ELSE
      TextPortClass.Model.write (m, s, time, t)
    END
  END Write;

(***************** Other things *************************)

PROCEDURE Misc (m: T; READONLY cd: VBT.MiscRec) =
  CONST name = "Misc";
  BEGIN
    TRY
      IF cd.type = VBT.Lost THEN
        IF cd.selection = VBT.KBFocus AND m.v.hasFocus THEN
          m.v.hasFocus := FALSE;
          VText.SwitchCaret (m.v.vtext, VText.OnOffState.Off);
          m.v.ULfocus (FALSE, cd.time)
        ELSIF cd.selection = VBT.Source AND m.selection.owned THEN
          VText.SwitchInterval (m.selection.interval, VText.OnOffState.Off);
          m.selection.owned := FALSE
        END
      ELSIF cd.type = VBT.TakeSelection AND cd.selection = VBT.KBFocus THEN
        EVAL m.v.getKFocus (cd.time)
      END;
      VBT.Mark (m.v)
    EXCEPT
    | VTDef.Error (ec) => m.v.vterror (name, ec)
    | VBT.Error (ec) => m.v.vbterror (name, ec)
    | Rd.Failure (ref) => m.v.rdfailure (name, ref)
    | Rd.EndOfFile => m.v.rdeoferror (name)
    | Thread.Alerted =>
    END
  END Misc;

PROCEDURE Select (             m          : T;
                               time       : VBT.TimeStamp;
                               begin, end : CARDINAL;
                               sel                          := Primary;
                  <* UNUSED *> replaceMode: BOOLEAN;
                  caretEnd := VText.WhichEnd.Right) =
  BEGIN
    IF sel = Primary AND m.takeSelection (sel, time) THEN
      IF caretEnd = VText.WhichEnd.Right THEN
        m.setMark (begin);
        m.seek (end)
      ELSE
        m.setMark (end);
        m.seek (begin)
      END;
      m.moveInterval (begin, end, TRUE)
    END
  END Select;

PROCEDURE GetSelection (m: T; sel: TextPort.SelectionType): TextPort.Extent =
  BEGIN
    IF sel = Primary THEN
      WITH interval = m.selection.interval DO
        RETURN TextPort.Extent {interval.left (), interval.right ()}
      END
    ELSE
      RETURN TextPort.NotFound
    END
  END GetSelection;

PROCEDURE HasVBTselection (m: T; sel: TextPort.SelectionType): BOOLEAN =
  BEGIN
    RETURN sel = Primary AND m.selection.owned
  END HasVBTselection;

PROCEDURE TakeSelection (m        : T;
                         sel      : TextPort.SelectionType;
                         time     : VBT.TimeStamp;
                         highlight                           := FALSE):
  BOOLEAN =
  CONST name = "TakeSelection";
  BEGIN
    IF sel # Primary THEN RETURN FALSE END;
    WITH rec = m.selection,
         i   = rec.interval DO
      IF NOT rec.owned THEN
        TRY
          VBT.Acquire (m.v, VBT.Source, time);
          IF m.v.getKFocus (time) THEN
            rec.owned := TRUE
          ELSE
            VBT.Release (m.v, VBT.Source)
          END;
          VBT.Mark (m.v)
        EXCEPT
        | VBT.Error (ec) => m.v.vbterror (name, ec)
        END
      END;
      IF rec.owned AND highlight THEN
        m.moveInterval (i.left (), i.right (), TRUE)
      END;
      RETURN rec.owned
    END
  END TakeSelection;

PROCEDURE Copy (m: T; time: VBT.TimeStamp) =
  VAR t := m.getSelectedText (Primary);
  BEGIN
    IF NOT Text.Empty (t) AND m.takeSelection (Primary, time) THEN
      m.clipboard := t
    END
  END Copy;

PROCEDURE Paste (m: T; time: VBT.TimeStamp) =
  BEGIN
    TRY
      WITH t   = m.read (VBT.Source, time),
           p   = m.v.index (),
           len = Text.Length (t)            DO
        IF len # 0 AND m.v.replace (p, p, t) # TextPort.NotFound THEN
          m.select (time, p, p + len)
        END
      END
    EXCEPT
    | VBT.Error (ec) => m.v.vbterror ("Paste", ec)
    END
  END Paste;

PROCEDURE WalkIntervals (m: T; p: TextPortClass.IProc) RAISES {VTDef.Error} =
  BEGIN
    p (m.selection.interval);
  END WalkIntervals;

PROCEDURE Filter (m: T; VAR cd: VBT.KeyRec) =
  VAR
    c       := cd.whatChanged;
    k       := c = Latin1Key.K OR c = Latin1Key.k;
    q       := c = Latin1Key.Q OR c = Latin1Key.q;
    control := VBT.Modifier.Control IN cd.modifiers;
    cK      := control AND k;
    cQ      := control AND q;
    esc := c = KeyboardKey.Escape OR control AND c = Latin1Key.bracketleft;
  BEGIN
    m.append := FALSE;
    CASE m.state OF
    | State.Initial =>
        IF cK THEN
          m.state := State.SawControlK
        ELSIF cQ THEN
          m.state := State.SawControlQ;
          cd.whatChanged := VBT.NoKey
        ELSIF esc THEN
          m.state := State.SawEscape;
          cd.whatChanged := VBT.NoKey
        END
    | State.SawControlK =>
        IF cK THEN
          m.append := TRUE
        ELSIF cQ THEN
          m.state := State.SawControlQ;
          cd.whatChanged := VBT.NoKey
        ELSIF esc THEN
          m.state := State.SawEscape;
          cd.whatChanged := VBT.NoKey
        ELSE
          m.state := State.Initial
        END
    | State.SawControlQ =>
        m.v.insert (Text.FromChar (KeyTrans.TTY (cd)));
        cd.whatChanged := VBT.NoKey;
        m.state := State.Initial
    | State.SawEscape =>
        cd.modifiers := cd.modifiers + VBT.Modifiers {VBT.Modifier.Option};
        m.state := State.Initial
    END
  END Filter;
     
BEGIN
END EmacsModel.