Copyright (C) 1992, Digital Equipment Corporation
All rights reserved.
See the file COPYRIGHT for a full description.
Last modified on Mon Jan 30 15:16:24 PST 1995 by kalsow
modified on Sun May 30 10:50:33 PDT 1993 by meehan
<* PRAGMA LL *>
MODULE EmacsModel;
IMPORT ASCII, ISOChar, KeyboardKey, KeyFilter, KeyTrans, Latin1Key,
MTextUnit, PaintOp, Rd, Text, TextPort, TextPortClass, Thread, VBT,
VTDef, VText;
FROM TextPortClass IMPORT IRange;
REVEAL
T = TextPortClass.Model BRANDED OBJECT
clipboard := "";
mark : [-1 .. LAST (CARDINAL)] := -1; (* -1 => not set *)
downclick: CARDINAL := 0;
append := FALSE;
lit := FALSE;
OVERRIDES
controlChord := ControlChord;
copy := Copy;
highlight := Highlight;
init := Init;
mouse := Mouse;
optionChord := OptionChord;
paste := Paste;
position := Position;
read := Read;
seek := Seek;
select := Select;
write := Write;
END;
EscapeMetaFilter = KeyFilter.T BRANDED OBJECT
sawEscape := FALSE
OVERRIDES
apply := ApplyEMFilter
END;
TYPE
KQFilter = KeyFilter.T OBJECT
state := State.Initial
OVERRIDES
apply := ApplyKQFilter
END;
State = {Initial, SawControlK, SawControlQ};
EmacsModel.T.filter is a finite-state machine that implements a
1-character lookahead for control-K (successive control-K's append to the
clipboard) and control-Q (quoted insert). Emacs.T.key does the same for
Escape (adding the Option modifier to the KeyRec).
CONST
Primary = TextPort.SelectionType.Primary;
Source = TextPortClass.VType.Source;
PROCEDURE Init (m: T; colorScheme: PaintOp.ColorScheme; keyfilter: KeyFilter.T):
TextPortClass.Model =
BEGIN
TRY
m.selection [Primary] :=
NEW (TextPortClass.SelectionRecord, type := Primary,
interval := VText.CreateInterval (
vtext := m.v.vtext, indexL := 0, indexR := 0,
options := VText.MakeIntervalOptions (
style := VText.IntervalStyle.NoStyle,
whiteBlack := colorScheme,
whiteStroke := colorScheme,
leading := colorScheme.bg)),
mode := VText.SelectionMode.CharSelection, alias := VBT.NilSel)
EXCEPT
| VTDef.Error (ec) => m.v.vterror ("Model Init", ec)
END;
m.keyfilter :=
NEW (EscapeMetaFilter,
next := NEW (KQFilter, next := NEW (TextPortClass.Composer,
next := keyfilter)));
RETURN m
END Init;
PROCEDURE ControlChord (m: T; ch: CHAR; READONLY cd: VBT.KeyRec) =
CONST name = "Control Key";
VAR v := m.v;
BEGIN
TRY
CASE ISOChar.Upper [ch] OF
| ' ', '@' => SetMark (m, 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' => IF NOT v.readOnly THEN Kill (m, v, cd) END
| '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' => v.findSource (cd.time, TextPortClass.Loc.Prev)
| 'S' => v.findSource (cd.time, TextPortClass.Loc.Next)
| '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. *)
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 SetMark (m: T; point: CARDINAL) =
VAR rec := m.selection [Primary];
BEGIN
m.mark := point;
m.downclick := point;
rec.anchor.l := point;
rec.anchor.r := point;
m.highlight (rec, IRange {point, point, point})
END SetMark;
PROCEDURE Highlight ( m : T;
rec: TextPortClass.SelectionRecord;
READONLY r : IRange ) =
CONST name = "Highlight";
BEGIN
TRY
VText.MoveInterval (rec.interval, r.left, r.right);
VText.SwitchInterval (
rec.interval, VAL (ORD (m.lit), VText.OnOffState));
VText.MoveCaret (m.v.vtext, r.middle);
VBT.Mark (m.v)
EXCEPT
| VTDef.Error (ec) => m.v.vterror (name, ec)
| Rd.EndOfFile => m.v.rdeoferror (name)
| Rd.Failure (ref) => m.v.rdfailure (name, ref)
| Thread.Alerted =>
END
END Highlight;
PROCEDURE Select (m : T;
time : VBT.TimeStamp;
begin : CARDINAL := 0;
end : CARDINAL := LAST (CARDINAL);
type := Primary;
replaceMode := FALSE;
caretEnd := VText.WhichEnd.Right) =
BEGIN
m.lit := TRUE; (* Changes the highlighting *)
IF caretEnd = VText.WhichEnd.Right THEN
SetMark (m, begin)
ELSE
SetMark (m, MIN (end, m.v.length ()))
END;
TextPortClass.Model.select (
m, time, begin, end, type, replaceMode, caretEnd)
END Select;
PROCEDURE Seek (m: T; position: CARDINAL) =
CONST name = "Seek";
VAR rec := m.selection [Primary];
BEGIN
TRY
VText.MoveCaret (m.v.vtext, position);
IF m.approachingFromLeft AND position < rec.anchor.r
OR NOT m.approachingFromLeft AND position <= rec.anchor.l THEN
VText.MoveInterval (rec.interval, position, rec.anchor.r)
ELSE
VText.MoveInterval (rec.interval, rec.anchor.l, position)
END;
VBT.Mark (m.v)
EXCEPT
| VTDef.Error (ec) => m.v.vterror (name, ec)
| Rd.EndOfFile => m.v.rdeoferror (name)
| Rd.Failure (ref) => m.v.rdfailure (name, ref)
| Thread.Alerted =>
END
END Seek;
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 (VBT.Source, 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 OptionChord (m: T; ch: CHAR; READONLY cd: VBT.KeyRec) =
CONST name = "Option Key";
VAR
ext: TextPort.Extent;
v := m.v;
BEGIN
TRY
CASE ISOChar.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', ASCII.BS, ASCII.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. *)
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) =
VAR
rec := m.selection [Primary];
r := TextPortClass.GetRange (m.v, cd.cp, rec.mode);
BEGIN
IF NOT m.v.getKFocus (cd.time) THEN RETURN END;
IF m.mark = -1 THEN SetMark (m, r.middle) END;
CASE cd.clickType OF
| VBT.ClickType.FirstDown =>
CASE cd.whatChanged OF
| VBT.Modifier.MouseL => (* Set point *)
(* Needed in case we start dragging: *)
m.downclick := r.middle;
(* Cancel replace-mode and highlighting. *)
m.lit := FALSE;
rec.replaceMode := FALSE;
TRY
TextPortClass.ChangeIntervalOptions (m.v, rec)
EXCEPT
| VTDef.Error (ec) => m.v.vterror ("Mouse", ec)
END;
IF cd.clickCount DIV 2 = 1 THEN
(* double-click => set mark *)
SetMark (m, r.middle)
ELSE (* Left-click redefines anchor *)
rec.anchor.l := m.mark;
rec.anchor.r := m.mark;
IF r.middle < m.mark THEN
m.highlight (rec, IRange {r.middle, r.middle, m.mark})
ELSE
m.highlight (rec, IRange {m.mark, r.middle, r.middle})
END
END;
m.dragging := TRUE
| VBT.Modifier.MouseM => m.copy (cd.time)
| VBT.Modifier.MouseR =>
m.approachingFromLeft :=
r.left < (rec.anchor.l + rec.anchor.r) DIV 2;
m.dragging := TRUE;
m.lit := TRUE;
m.extend (rec, r.left, r.right)
ELSE
m.dragging := FALSE
END
| VBT.ClickType.LastUp =>
IF m.dragging THEN
rec.anchor.l := rec.interval.left ();
rec.anchor.r := rec.interval.right ();
m.dragging := FALSE
END
ELSE
m.dragging := FALSE
END (* CASE *)
END Mouse;
PROCEDURE Position (m: T; READONLY cd: VBT.PositionRec) =
BEGIN
IF m.mark # m.downclick THEN SetMark (m, m.downclick) END;
m.lit := TRUE;
TextPortClass.Model.position (m, cd)
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.v.owns [Source] THEN
RETURN m.clipboard
ELSE
RETURN TextPortClass.Model.read (m, s, time)
END
END Read;
********************** Writing ***************************
PROCEDURE Write (m: T; READONLY s: VBT.Selection; time: VBT.TimeStamp; t: TEXT)
RAISES {VBT.Error} =
BEGIN
IF s = VBT.Source AND m.v.owns [Source] THEN
m.clipboard := t
ELSE
TextPortClass.Model.write (m, s, time, t)
END
END Write;
**************** Other things ************************
PROCEDURE Copy (m: T; time: VBT.TimeStamp) =
VAR t := m.getSelectedText (Primary);
BEGIN
IF NOT Text.Empty (t) AND m.takeSelection (VBT.Source, 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 ApplyEMFilter (self: EscapeMetaFilter; v: VBT.T; cd: VBT.KeyRec) =
VAR c := cd.whatChanged;
BEGIN
IF self.sawEscape THEN
IF KeyFilter.IsModifier (c) THEN (* skip *)
ELSE
cd.modifiers := cd.modifiers + VBT.Modifiers {VBT.Modifier.Option};
self.sawEscape := FALSE;
self.next.apply (v, cd)
END
ELSIF c = KeyboardKey.Escape OR VBT.Modifier.Control IN cd.modifiers
AND c = Latin1Key.bracketleft THEN
self.sawEscape := TRUE
ELSE
self.next.apply (v, cd)
END
END ApplyEMFilter;
PROCEDURE ApplyKQFilter (self: KQFilter; v: VBT.T; cd: VBT.KeyRec) =
VAR
tp : TextPort.T := v;
m : T := tp.m;
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;
BEGIN
m.append := FALSE;
CASE self.state OF
| State.Initial =>
IF cK THEN
self.state := State.SawControlK;
self.next.apply (v, cd)
ELSIF cQ THEN
self.state := State.SawControlQ
ELSE
self.next.apply (v, cd)
END
| State.SawControlK =>
IF cK THEN
m.append := TRUE;
self.next.apply (v, cd)
ELSIF cQ THEN
self.state := State.SawControlQ
ELSIF KeyFilter.IsModifier (c) THEN (* ignore *)
ELSE
self.state := State.Initial;
self.next.apply (v, cd)
END
| State.SawControlQ =>
IF NOT KeyFilter.IsModifier (c) THEN
TextPort.Insert (tp, Text.FromChar (KeyTrans.TTY (cd)));
self.state := State.Initial
END
END
END ApplyKQFilter;
BEGIN
END EmacsModel.