Copyright (C) 1994, Digital Equipment Corp.
<* PRAGMA LL *> <* PRAGMA EXPORTED *> MODULE************************** Client Interface **************************; IMPORT Axis, Cursor, Env, Font, ISOChar, KeyboardKey, KeyFilter, KeyTrans, MacModel, MText, MTextUnit, PaintOp, Palette, Pts, Rd, RdUtils, Rect, Region, ScrollerVBTClass, Stdio, Text, TextPortClass, Thread, VBT, VBTRep, VTDef, VText, WeakRef, Wr; FROM TextPortClass IMPORT IRange; IMPORT EmacsModel, IvyModel, XtermModel; IMPORT VBTutils, TextWr; CONST Backspace = '\010'; Tab = '\t'; Return = '\n'; Del = '\177'; Primary = SelectionType.Primary; Secondary = SelectionType.Secondary; Focus = TextPortClass.VType.Focus; REVEAL T = TextPortClass.T BRANDED OBJECT <* LL = v.mu *> modifiedP : BOOLEAN; linesShown: CARDINAL; OVERRIDES (* Exported methods *) init := Init; filter := Filter; getFont := GetFont; setFont := SetFont; getColorScheme := GetColorScheme; setColorScheme := SetColorScheme; getModel := GetModel; setModel := SetModel; getReadOnly := GetReadOnly; setReadOnly := SetReadOnly; getKFocus := GetKFocus; (* Callbacks *) returnAction := ReturnAction; tabAction := Insert4spaces; focus := IgnoreFocus; modified := IgnoreModification; error := Error; (* VBT.T overrides *) key := Key; misc := Misc; mouse := Mouse; position := Position; read := Read; redisplay := Redisplay; repaint := Repaint; rescreen := Rescreen; reshape := Reshape; shape := Shape; write := Write; (* Exception handlers *) rdeoferror := rdeoferror; rdfailure := rdfailure; vbterror := vbterror; vterror := vterror; (* Locked methods *) getText := LockedGetText; index := LockedIndex; isReplaceMode := LockedIsReplaceMode; length := LockedLength; normalize := LockedNormalize; replace := LockedReplace; unsafeReplace := UnsafeReplace; insert := LockedInsert; unsafeInsert := UnsafeInsert; newlineAndIndent := LockedNewlineAndIndent; findSource := FindSource; notFound := NotFoundProc; (* Unlocked methods for callbacks *) ULreturnAction := UnlockedReturnAction; ULtabAction := UnlockedTabAction; ULfocus := UnlockedFocus; ULmodified := UnlockedModified; ULerror := UnlockedError; END; VAR debug, UseDiacritical: BOOLEAN; PROCEDURE TextPort Init (v : T; hMargin, vMargin := 0.5; font := Font.BuiltIn; colorScheme : PaintOp.ColorScheme := NIL; wrap := TRUE; readOnly := FALSE; turnMargin := 0.5; model := Model.Default ): T = CONST PRINTABLE = (ISOChar.All - ISOChar.Controls) + SET OF CHAR {'\t'}; VAR vFont : VText.VFont; vOptions: VText.VOptions; BEGIN TRY IF colorScheme = NIL THEN colorScheme := PaintOp.bgFg END; vFont := VText.MakeVFont ( font := font, printable := PRINTABLE, whiteTabs := TRUE); vOptions := VText.MakeVOptions ( vFont := vFont, leftMargin := Pts.FromMM (hMargin), rightMargin := Pts.FromMM (hMargin), turnMargin := Pts.FromMM (turnMargin), topMargin := Pts.FromMM (vMargin), leading := 0.0, whiteBlack := colorScheme, whiteStroke := colorScheme, leftOffset := 0.0, wrap := wrap, eob := FALSE, intervalStylePrecedence := NIL); v.font := font; v.mu := NEW (MUTEX); v.vtext := VText.New (MText.New ("", 256), v, VBT.Domain (v), vOptions); v.readOnly := readOnly; v.modifiedP := FALSE; v.typeinStart := 0; v.cur := NEW (TextPortClass.UndoRec); LockedSetModel (v, model); Register (v); VBT.SetCursor (v, Cursor.TextPointer); RETURN v EXCEPT | VTDef.Error (ec) => v.vterror ("Init", ec) | Rd.EndOfFile => v.rdeoferror ("Init") | Rd.Failure (ref) => v.rdfailure ("Init", ref) | Thread.Alerted => END; RETURN NIL END Init;
PROCEDUREUNUSED PROCEDURE SetWrap (v: T; wrap: BOOLEAN) = BEGIN LOCK v.mu DO IF v.vtext.vOptions.wrap # wrap THEN v.vtext.vOptions.wrap := wrap; TRY VText.ChangeVOptions (v.vtext, v.vtext.vOptions); VBT.Mark (v) EXCEPTGetReadOnly (v: T): BOOLEAN = BEGIN LOCK v.mu DO RETURN v.readOnly END END GetReadOnly; PROCEDURESetReadOnly (v: T; flag: BOOLEAN) = BEGIN LOCK v.mu DO v.readOnly := flag; FixIntervals (v) END END SetReadOnly;
VTDef.Error (ec) => v.vterror ("SetWrap", ec) Rd.EndOfFile => v.rdeoferror ("SetWrap") Rd.Failure (ref) => v.rdfailure ("SetWrap", ref) Thread.Alerted =>END END END END SetWrap;
<* EXPORTED *> PROCEDUREUNUSED PROCEDURE Width (v: T): CARDINAL = (* Return the number of characters that will fit on a line, given the current size ofLength (v: T): CARDINAL = BEGIN LOCK v.mu DO RETURN v.length () END END Length; PROCEDURELockedLength (v: T): CARDINAL = BEGIN RETURN MText.Length (v.vtext.mtext) END LockedLength; <* EXPORTED *> PROCEDUREGetText (v : T; begin: CARDINAL := 0; end : CARDINAL := LAST (CARDINAL)): TEXT = <* LL = VBT.mu *> BEGIN LOCK v.mu DO RETURN v.getText (begin, end) END END GetText; PROCEDURELockedGetText (v: T; begin, end: CARDINAL): TEXT = <* LL = v.mu *> BEGIN RETURN MText.GetText (v.vtext.mtext, begin, end) END LockedGetText; <* EXPORTED *> PROCEDURESetText (v: T; t: TEXT) = <* LL <= VBT.mu *> BEGIN LOCK v.mu DO EVAL v.unsafeReplace (0, LAST (CARDINAL), t); TRY VText.SetStart (v.vtext, 0, 0); VBT.Mark (v) EXCEPT | VTDef.Error (ec) => v.vterror ("SetText", ec) | Rd.EndOfFile => v.rdeoferror ("SetText") | Rd.Failure (ref) => v.rdfailure ("SetText", ref) | Thread.Alerted => END; END END SetText; <* EXPORTED *> PROCEDUREPutText (v: T; t: TEXT) = <* LL <= VBT.mu *> BEGIN LOCK v.mu DO EVAL v.unsafeReplace (LAST (CARDINAL), LAST (CARDINAL), t); VBT.Mark (v) END END PutText; PROCEDUREGetFont (v: T): Font.T = BEGIN LOCK v.mu DO RETURN v.font END END GetFont; PROCEDURESetFont (v: T; font: Font.T) = (* By the book, we should call ExplodeVText, ExplodeVOptions, ExplodeVFont, MakeVFont, and MakeVOptions before calling ChangeVOptions, but we cheat by looking at the implementation and consing only a new VFont. *) VAR vtext : VText.T; vOptions: VText.VOptions; vFont : VText.VFont; BEGIN LOCK v.mu DO IF font = v.font THEN RETURN END; vtext := v.vtext; vOptions := vtext.vOptions; vFont := vOptions.vFontxxx; TRY vOptions.vFontxxx := VText.MakeVFont (font := font, printable := vFont.vFont.printable, whiteTabs := vFont.vFont.whiteTabs); v.font := font; (* For convenience only *) VText.ChangeVOptions (vtext, vOptions); SetFontDimensions (v); VBT.NewShape (v); VBT.Mark (v) EXCEPT | VTDef.Error (ec) => v.vterror ("SetFont", ec) | Rd.EndOfFile => v.rdeoferror ("SetFont") | Rd.Failure (ref) => v.rdfailure ("SetFont", ref) | Thread.Alerted => END; END END SetFont; PROCEDUREGetColorScheme (v: T): PaintOp.ColorScheme = BEGIN LOCK v.mu DO RETURN v.vtext.vOptions.whiteBlack (* one of several choices *) END END GetColorScheme; PROCEDURESetColorScheme (v: T; colorScheme: PaintOp.ColorScheme) = CONST name = "SetColorScheme"; VAR vOptions: VText.VOptions; BEGIN LOCK v.mu DO TRY vOptions := v.vtext.vOptions; vOptions.whiteBlack := colorScheme; vOptions.whiteStroke := colorScheme; VText.ChangeVOptions (v.vtext, vOptions); IF v.scrollbar # NIL THEN ScrollerVBTClass.Colorize (v.scrollbar, colorScheme) END; VBT.Mark (v) EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END END SetColorScheme; PROCEDUREGetModel (v: T): [Model.Ivy .. Model.Xterm] = BEGIN LOCK v.mu DO TYPECASE v.m OF | IvyModel.T => RETURN Model.Ivy | EmacsModel.T => RETURN Model.Emacs | XtermModel.T => RETURN Model.Xterm | MacModel.T => RETURN Model.Mac ELSE <* ASSERT FALSE *> END END END GetModel; PROCEDURESetModel (v: T; model: Model) = BEGIN LOCK v.mu DO LockedSetModel (v, model) END END SetModel; TYPE StandardKeyFilter = KeyFilter.T OBJECT OVERRIDES apply := ApplyStandardKeyFilter END; PROCEDURELockedSetModel (v: T; model: Model) = VAR cs := v.vtext.vOptions.whiteBlack; f : KeyFilter.T := NEW (StandardKeyFilter); BEGIN IF v.m # NIL THEN v.m.close () END; IF model = Model.Default THEN model := DefaultModel END; IF UseDiacritical THEN f := NEW (KeyFilter.Diacritical, next := f) END; CASE model OF | Model.Ivy => v.m := NEW (IvyModel.T, v := v).init (cs, f) | Model.Xterm => v.m := NEW (XtermModel.T, v := v).init (cs, f) | Model.Emacs => v.m := NEW (EmacsModel.T, v := v).init (cs, f) | Model.Mac => v.m := NEW (MacModel.T, v := v).init (cs, f) ELSE <* ASSERT FALSE *> END; FixIntervals (v) END LockedSetModel; PROCEDUREGetKFocus (v: T; t: VBT.TimeStamp): BOOLEAN = <* LL = v.mu *> CONST name = "GetKFocus"; BEGIN IF NOT v.owns [Focus] THEN v.ULfocus (TRUE, t); TRY VBT.Acquire (v, VBT.KBFocus, t); VText.SwitchCaret (v.vtext, VText.OnOffState.On); v.owns [Focus] := TRUE EXCEPT | VBT.Error (ec) => v.vbterror (name, ec) | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END; RETURN v.owns [Focus] END GetKFocus; TYPE WeakRefList = REF RECORD first: WeakRef.T; tail : WeakRefList := NIL END; VAR mu := NEW (MUTEX); ports: WeakRefList := NIL; <* LL = mu *> PROCEDUREChangeAllTextPorts (newModel := Model.Default) = VAR a : WeakRefList; port: T; BEGIN LOCK mu DO a := ports; WHILE a # NIL DO port := WeakRef.ToRef (a.first); IF port # NIL THEN port.setModel (newModel); VBT.Mark (port) END; a := a.tail END END END ChangeAllTextPorts; PROCEDURERegister (v: T) = BEGIN LOCK mu DO ports := NEW (WeakRefList, first := WeakRef.FromRef (v, Cleanup), tail := ports) END END Register; PROCEDURECleanup (READONLY w: WeakRef.T; <* UNUSED *> r: REFANY) = (* Delete "w" from "ports". *) BEGIN LOCK mu DO IF ports = NIL THEN (* skip *) ELSIF ports.first = w THEN ports := ports.tail ELSE VAR a := ports; b: WeakRefList; BEGIN LOOP b := a.tail; IF b = NIL THEN RETURN END; IF b.first = w THEN a.tail := b.tail; RETURN END; a := b END END END END END Cleanup; PROCEDURESetFontDimensions (v: T) = <* LL = v.mu *> BEGIN (* metrics := FontClass.FontMetrics(vbt, v.font); *) WITH st = VBT.ScreenTypeOf (v) DO IF st # NIL THEN WITH bounds = Palette.ResolveFont ( st, v.font).metrics.maxBounds, box = bounds.boundingBox DO v.fontHeight := Rect.VerSize (box); v.charWidth := bounds.printWidth (* not "Rect.HorSize (box)", alas *) END END END END SetFontDimensions;
v
. If v
has no width (because its window is iconic, for
example), return 0. If v
's font is not fixed-pitch, the result will be
computed in terms of the width of the widest character in the font.
This code is wrong. It ignores the margins. See TypeinVBT.Shape and NumericVBT.Reshape. VAR n := Rect.HorSize (VBT.Domain (v)); BEGIN LOCK v.mu DO IF v.charWidth = 0 THEN RETURN 0 ELSE RETURN n DIV v.charWidth END END END Width; *)UNUSED PROCEDURE Height (v: T): CARDINAL = BEGIN RETURN v.shape (Axis.T.Ver, 0).pref END Height;
*************** Focus, selections, etc. ****************
<* EXPORTED *> PROCEDURE************************** Replace & Insert ***************************TryFocus (v: T; t: VBT.TimeStamp): BOOLEAN = <* LL < v.mu, LL.sup = VBT.mu *> BEGIN (* Force all pending redisplays: *) VBTRep.Redisplay (); IF Rect.IsEmpty (VBT.Domain (v)) THEN RETURN FALSE ELSE LOCK v.mu DO IF NOT v.getKFocus (t) THEN RETURN FALSE ELSIF v.m.selection [Primary].alias = VBT.Source AND NOT v.m.takeSelection (VBT.Source, Primary, t) OR v.m.selection [Primary].alias = VBT.Target AND NOT v.m.takeSelection (VBT.Target, Primary, t) THEN VBT.Release (v, VBT.KBFocus); v.owns [Focus] := FALSE; RETURN FALSE ELSE VBT.Mark (v); RETURN TRUE END END END END TryFocus; <* EXPORTED *> PROCEDUREHasFocus (v: T): BOOLEAN = BEGIN LOCK v.mu DO RETURN v.owns [Focus] END END HasFocus; <* EXPORTED *> PROCEDURESelect (v : T; time : VBT.TimeStamp; begin : CARDINAL := 0; end : CARDINAL := LAST (CARDINAL); sel := SelectionType.Primary; replaceMode := FALSE; caretEnd := VText.WhichEnd.Right ) = BEGIN LOCK v.mu DO v.m.select (time, begin, end, sel, replaceMode, caretEnd) END END Select; <* EXPORTED *> PROCEDUREIsReplaceMode (v: T): BOOLEAN = BEGIN LOCK v.mu DO RETURN v.isReplaceMode () END END IsReplaceMode; PROCEDURELockedIsReplaceMode (v: T): BOOLEAN = BEGIN RETURN NOT v.readOnly AND v.m.selection [Primary].replaceMode END LockedIsReplaceMode; <* EXPORTED *> PROCEDUREGetSelection (v: T; sel := SelectionType.Primary): Extent = BEGIN LOCK v.mu DO RETURN v.m.getSelection (sel) END END GetSelection; <* EXPORTED *> PROCEDUREGetSelectedText (v: T; sel := SelectionType.Primary): TEXT = <* LL.sup = VBT.mu *> BEGIN LOCK v.mu DO RETURN v.m.getSelectedText (sel) END END GetSelectedText; <* EXPORTED *> PROCEDUREPutSelectedText (v: T; t: TEXT; sel := SelectionType.Primary) = <* LL.sup = VBT.mu *> BEGIN LOCK v.mu DO v.m.putSelectedText (t, sel) END END PutSelectedText; <* EXPORTED *> PROCEDUREIndex (v: T): CARDINAL = BEGIN LOCK v.mu DO RETURN v.index () END END Index; <* EXPORTED *> PROCEDURESeek (v: T; n: CARDINAL) = BEGIN LOCK v.mu DO v.m.seek (n) END END Seek; PROCEDURELockedIndex (v: T): CARDINAL = BEGIN TRY RETURN VText.CaretIndex (v.vtext) EXCEPT | VTDef.Error (ec) => v.vterror ("Index", ec); RETURN 0 END END LockedIndex; <* EXPORTED *> PROCEDUREIsVisible (v: T; pos: CARDINAL): BOOLEAN = CONST name = "IsVisible"; BEGIN TRY RETURN VText.InRegion (v.vtext, 0, pos) EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END; RETURN FALSE END IsVisible; <* EXPORTED *> PROCEDUREIsModified (v: T): BOOLEAN = BEGIN RETURN v.modifiedP END IsModified; <* EXPORTED *> PROCEDURESetModified (v: T; modified: BOOLEAN) = BEGIN v.modifiedP := modified END SetModified; <* EXPORTED *> PROCEDUREGetVText (v: T): VText.T = BEGIN LOCK v.mu DO RETURN v.vtext END END GetVText;
<* EXPORTED *> PROCEDURE*********************** Shape of current text ************************Replace (v: T; begin, end: CARDINAL; newText: TEXT) = BEGIN LOCK v.mu DO EVAL v.unsafeReplace (begin, end, newText) END END Replace; PROCEDURELockedReplace (v: T; begin, end: CARDINAL; newText: TEXT): Extent = <* LL = v.mu *> BEGIN IF v.readOnly OR begin < v.typeinStart THEN RETURN NotFound ELSE RETURN v.unsafeReplace (begin, end, newText) END END LockedReplace; PROCEDUREUnsafeReplace (v: T; begin, end: CARDINAL; newText: TEXT): Extent = <* LL = v.mu *> CONST name = "Replace"; VAR len := v.length (); BEGIN begin := MIN (begin, len); end := MIN (MAX (begin, end), len); IF begin <= end THEN TextPortClass.AddToUndo (v, begin, end, newText); TRY VText.Replace (v.vtext, begin, end, newText); IF NOT v.modifiedP THEN v.modifiedP := TRUE; v.ULmodified () END; VBT.Mark (v); RETURN Extent {begin, begin + Text.Length (newText)} EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END; RETURN NotFound END UnsafeReplace; <* EXPORTED *> PROCEDUREInsert (v: T; t: TEXT) = BEGIN IF NOT Text.Empty (t) THEN LOCK v.mu DO v.unsafeInsert (t) END END END Insert; PROCEDURELockedInsert (v: T; t: TEXT) = BEGIN IF NOT v.readOnly THEN v.unsafeInsert (t) END END LockedInsert; PROCEDUREUnsafeInsert (v: T; t: TEXT) = VAR m := v.m; rec := m.selection [Primary]; VAR p: CARDINAL; BEGIN IF v.isReplaceMode () THEN m.putSelectedText (t, Primary) ELSE p := v.index (); IF p < v.typeinStart THEN p := v.length (); m.seek (p) END; EVAL v.unsafeReplace (p, p, t) END; p := v.index (); m.highlight (rec, IRange {p, p, p}); rec.anchor.l := p; rec.anchor.r := p END UnsafeInsert;
PROCEDUREUNUSED PROCEDURE ShapeInfo (v: T; VAR lineCount, lineLength: INTEGER) = (* Return the number of lines in the text and the number of characters in the longest line (excluding the newline). A client may use this information in conjunction withShape (v: T; ax: Axis.T; n: CARDINAL): VBT.SizeRange = BEGIN IF ax = Axis.T.Ver THEN v.lastNonEmptyWidth := n END; RETURN TextPortClass.T.shape(v, ax, n); END Shape; PROCEDUREReshape (v: T; READONLY cd: VBT.ReshapeRec) = CONST name = "Reshape"; VAR newRect := cd.new; dividers: ARRAY [0 .. 0] OF VText.Pixels; BEGIN IF Rect.IsEmpty(newRect) THEN RETURN END; VAR old := v.lastNonEmptyWidth; new := Rect.HorSize(newRect); BEGIN IF new # old THEN VAR oldShape := v.shape(Axis.T.Ver, old); newShape := v.shape(Axis.T.Ver, new); BEGIN IF oldShape # newShape THEN VBT.NewShape(v) END END END END; LOCK v.mu DO IF NOT v.vtext.vOptions.wrap THEN newRect.east := LAST(INTEGER) DIV 2 END; TRY VText.Move(v.vtext, newRect, cd.saved, dividers); VText.Update(v.vtext); v.linesShown := 1 + VText.WhichLine(v.vtext, 0, cd.new.south); (* if it will all fit, normalize to fit *) IF Rect.IsEmpty(cd.prev) AND NOT Rect.IsEmpty(cd.new) AND VText.LinesBetween( v.vtext, 0, v.length(), v.linesShown) < v.linesShown THEN v.normalize(0) (* Normalize calls VBT.Mark *) ELSE VBT.Mark(v) END EXCEPT | VTDef.Error (ec) => v.vterror(name, ec) | Rd.EndOfFile => v.rdeoferror(name) | Rd.Failure (ref) => v.rdfailure(name, ref) | Thread.Alerted => END END END Reshape;
VBTShape.Set
to shape v
to fit its text. Having done so,
it should be prepared to do it again on a rescreen to a screen
of different density.
BEGIN LOCK v.mu DO VAR e := MTextUnit.Extent {0, 0, TRUE}; length := v.length (); BEGIN lineCount := 0; lineLength := 0; IF length = 0 THEN RETURN END; WHILE e.right < length DO e := MTextUnit.LineExtent (v.vtext.mtext, e.right); INC (lineCount); lineLength := MAX (lineLength, e.right - e.left - 1) END; (* adjust for last line: if ends with \n, increment lineCount; otherwise, len of last line is right-left, not right-left-1. *) IF MText.GetChar (v.vtext.mtext, length - 1) = '\n' THEN INC (lineCount); lineLength := MAX (lineLength, e.right - e.left - 1) ELSE lineLength := MAX (lineLength, e.right - e.left) END (* IF *) END (* BEGIN *) END (* LOCK *) END ShapeInfo; *) PROCEDURE*************************** callback methods ***************************Key (v: T; READONLY cd: VBT.KeyRec) = VAR OK: BOOLEAN; BEGIN LOCK v.mu DO OK := cd.wentDown AND v.owns [Focus] AND NOT Rect.IsEmpty (VBT.Domain (v)) END; IF OK THEN v.m.keyfilter.apply (v, cd) END END Key; PROCEDUREApplyStandardKeyFilter (<* UNUSED *> self: StandardKeyFilter; vbt: VBT.T; cd : VBT.KeyRec) = VAR v: T := vbt; BEGIN v.filter (cd) END ApplyStandardKeyFilter; PROCEDUREFilter (v: T; cd: VBT.KeyRec) = VAR ch: CHAR; m := v.m; BEGIN IF cd.whatChanged = VBT.NoKey THEN RETURN END; LOCK v.mu DO v.lastCmdKind := v.thisCmdKind; v.thisCmdKind := TextPortClass.CommandKind.OtherCommand; ch := KeyTrans.Latin1 (cd.whatChanged); IF ch = Return THEN IF VBT.Modifier.Shift IN cd.modifiers THEN v.insert ("\n") ELSIF VBT.Modifier.Option IN cd.modifiers THEN TextPortClass.InsertNewline (v) ELSE v.ULreturnAction (cd) END ELSIF ch = Tab THEN v.ULtabAction (cd) ELSIF KeyboardKey.Left <= cd.whatChanged AND cd.whatChanged <= KeyboardKey.Down THEN m.arrowKey (cd) ELSIF VBT.Modifier.Control IN cd.modifiers THEN m.controlChord (ch, cd); RETURN ELSIF VBT.Modifier.Option IN cd.modifiers THEN m.optionChord (ch, cd); RETURN ELSIF ch = Backspace OR ch = Del THEN VAR interval := v.m.selection [Primary].interval; BEGIN (* Treat an empty interval as if it were not replace-mode *) IF v.isReplaceMode () AND interval.left () # interval.right () THEN m.putSelectedText ("") ELSE EVAL TextPortClass.DeletePrevChar (v) END END ELSIF ch IN ISOChar.Graphics THEN v.insert (Text.FromChar (ch)) ELSE (* including NullKey, for untranslatable keys *) RETURN END; v.normalize () END (* LOCK *) END Filter; <* EXPORTED *> PROCEDURENewline (v: T) = BEGIN LOCK v.mu DO IF NOT v.readOnly THEN v.insert ("\n") END END END Newline; <* EXPORTED *> PROCEDURENewlineAndIndent (v: T) = BEGIN LOCK v.mu DO v.newlineAndIndent () END END NewlineAndIndent; PROCEDURELockedNewlineAndIndent (v: T) = BEGIN IF v.readOnly THEN RETURN END; VAR index := v.index (); a := MTextUnit.LineInfo (v.vtext.mtext, index); BEGIN IF a.leftMargin = a.rightEnd AND index = a.rightEnd AND NOT v.isReplaceMode () THEN (* We're at the end of an all-blank line. *) EVAL v.replace (a.left, a.left, "\n") ELSIF a.leftMargin = a.rightMargin THEN (* line is all blanks *) v.insert ("\n") ELSE (* Copy all the leading blanks onto the new line. *) v.insert ( "\n" & MText.GetText (v.vtext.mtext, a.left, a.leftMargin)) END END END LockedNewlineAndIndent; PROCEDURERepaint (v: T; READONLY rgn: Region.T) = CONST name = "Repaint"; BEGIN TRY LOCK v.mu DO VText.Bad (v.vtext, Region.BoundingBox (rgn)); VText.Update (v.vtext) END EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END Repaint; PROCEDUREFixIntervals (v: T) = <* LL = v.mu *> BEGIN TRY FOR t := Primary TO Secondary DO IF v.m.selection [t] # NIL THEN TextPortClass.ChangeIntervalOptions (v, v.m.selection [t]) END END EXCEPT | VTDef.Error (ec) => v.vterror ("Rescreen", ec) END END FixIntervals; PROCEDURERescreen (v: T; READONLY cd: VBT.RescreenRec) = BEGIN LOCK v.mu DO VText.Rescreen (v.vtext, cd); SetFontDimensions (v); FixIntervals (v); VBT.NewShape (v) END END Rescreen; PROCEDURERedisplay (v: T) = CONST name = "Redisplay"; BEGIN TRY LOCK v.mu DO VText.Update (v.vtext); IF v.scrollbar # NIL THEN v.scrollbar.update () END END EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END Redisplay;
PROCEDURE************************ Miscellany ***********************ReturnAction (v: T; <* UNUSED *> READONLY event: VBT.KeyRec) = BEGIN NewlineAndIndent (v) END ReturnAction; PROCEDUREUnlockedReturnAction (v: T; READONLY event: VBT.KeyRec) = BEGIN Thread.Release (v.mu); TRY v.returnAction (event) FINALLY Thread.Acquire (v.mu) END END UnlockedReturnAction; PROCEDUREInsert4spaces (v: T; <* UNUSED *> READONLY event: VBT.KeyRec) = BEGIN LOCK v.mu DO v.insert (" ") END END Insert4spaces; PROCEDUREUnlockedTabAction (v: T; READONLY event: VBT.KeyRec) = BEGIN Thread.Release (v.mu); TRY v.tabAction (event) FINALLY Thread.Acquire (v.mu) END END UnlockedTabAction;
<* EXPORTED *> PROCEDURE************************* VBT methods **************************Normalize (v: T; to: INTEGER := -1) = BEGIN LOCK v.mu DO v.normalize (to) END END Normalize; PROCEDURELockedNormalize (v: T; to: INTEGER) = <* LL = v.mu *> CONST name = "Normalize"; VAR point: CARDINAL; BEGIN TRY IF to < 0 THEN point := v.index () ELSE point := MIN (to, v.length ()) END; IF NOT VText.InRegion (v.vtext, 0, point) THEN VText.SetStart (v.vtext, 0, point, v.linesShown DIV 2) END; VBT.Mark (v) EXCEPT | VTDef.Error (ec) => v.vterror (name, ec) | Rd.EndOfFile => v.rdeoferror (name) | Rd.Failure (ref) => v.rdfailure (name, ref) | Thread.Alerted => END END LockedNormalize; PROCEDUREUnlockedFocus (v: T; gaining: BOOLEAN; time: VBT.TimeStamp) = BEGIN Thread.Release (v.mu); TRY v.focus (gaining, time) FINALLY Thread.Acquire (v.mu) END END UnlockedFocus; PROCEDUREIgnoreFocus (<* UNUSED *> v: T; <* UNUSED *> gaining: BOOLEAN; <* UNUSED *> time : VBT.TimeStamp) = BEGIN END IgnoreFocus; PROCEDUREUnlockedModified (v: T) = BEGIN Thread.Release (v.mu); TRY v.modified () FINALLY Thread.Acquire (v.mu) END END UnlockedModified; PROCEDUREIgnoreModification (<* UNUSED *> v: T) = BEGIN END IgnoreModification; PROCEDUREFindSource (v : T; time: VBT.TimeStamp; loc := TextPortClass.Loc.Next; ignoreCase := TRUE ) = BEGIN TRY TextPortClass.FindAndSelect ( v, v.m.read (VBT.Source, time), time, loc, ignoreCase) EXCEPT | VBT.Error (ec) => v.vbterror ("findSource", ec) END END FindSource; PROCEDURENotFoundProc (<* UNUSED *> v: T) = BEGIN (* SmallIO.PutChar (SmallIO.stderr, '\007') *) END NotFoundProc;
In this section, we lock v.mu and relay the method-calls to the Model, which handles selections, the mouse, etc.
VAR miscwr := TextWr.New (); debugMisc := FALSE; PROCEDURE************************ Module Initialization ***********************Misc (v: T; READONLY cd: VBT.MiscRec) = BEGIN LOCK v.mu DO IF debugMisc THEN VBTutils.WriteMiscRec (miscwr, cd); v.error (TextWr.ToText (miscwr)) END; v.m.misc (cd) END END Misc; PROCEDURERead (v: T; s: VBT.Selection; typecode: CARDINAL): VBT.Value RAISES {VBT.Error} = <* LL.sup <= VBT.mu *> BEGIN IF typecode # TYPECODE (TEXT) THEN RAISE VBT.Error (VBT.ErrorCode.WrongType) ELSE LOCK v.mu DO RETURN VBT.FromRef (v.m.read (s, 0)) END END END Read; PROCEDUREWrite (v : T; s : VBT.Selection; value : VBT.Value; typecode: CARDINAL ) RAISES {VBT.Error} = <* LL.sup <= VBT.mu *> BEGIN LOCK v.mu DO IF typecode # TYPECODE (TEXT) THEN RAISE VBT.Error (VBT.ErrorCode.WrongType) ELSIF v.readOnly THEN RAISE VBT.Error (VBT.ErrorCode.Unwritable) ELSE TYPECASE value.toRef () OF | NULL => RAISE VBT.Error (VBT.ErrorCode.WrongType) | TEXT (t) => v.m.write (s, 0, t) ELSE RAISE VBT.Error (VBT.ErrorCode.WrongType) END END END END Write; PROCEDUREMouse (v: T; READONLY cd: VBT.MouseRec) = BEGIN LOCK v.mu DO (* IF v.getKFocus (cd.time) THEN v.m.mouse (cd) END *) v.m.mouse (cd) END END Mouse; PROCEDUREPosition (v: T; READONLY cd: VBT.PositionRec) = BEGIN LOCK v.mu DO IF NOT v.m.dragging THEN (* skip *) ELSIF cd.cp.gone THEN VBT.SetCage (v, VBT.GoneCage) ELSE v.m.position (cd) END END END Position; PROCEDUREvbterror (v: T; msg: TEXT; ec: VBT.ErrorCode) = BEGIN v.ULerror (msg & ": " & TextPortClass.VBTErrorCodeTexts [ec]) END vbterror; PROCEDUREvterror (v: T; msg: TEXT; ec: VTDef.ErrorCode) = BEGIN v.ULerror (msg & ": " & VTDef.ErrorCodeTexts [ec]) END vterror; PROCEDURErdfailure (v: T; msg: TEXT; ref: REFANY) = BEGIN v.ULerror (msg & ": " & RdUtils.FailureText (ref)) END rdfailure; PROCEDURErdeoferror (v: T; msg: TEXT) = BEGIN v.ULerror (msg & ": End of file") END rdeoferror; PROCEDUREUnlockedError (v: T; msg: TEXT) = BEGIN Thread.Release (v.mu); TRY v.error (msg) FINALLY Thread.Acquire (v.mu) END END UnlockedError; VAR errMu := NEW(MUTEX); PROCEDUREError (<* UNUSED *> v: T; msg: TEXT) = <* FATAL Wr.Failure, Thread.Alerted *> BEGIN IF debug THEN LOCK errMu DO Wr.PutText(Stdio.stderr, msg); Wr.PutChar(Stdio.stderr, '\n') END END END Error;
BEGIN VAR s: TEXT; BEGIN s := Env.Get ("TEXTPORTMODEL"); IF s # NIL THEN IF Text.Equal (s, "ivy") THEN DefaultModel := Model.Ivy ELSIF Text.Equal (s, "xterm") THEN DefaultModel := Model.Xterm ELSIF Text.Equal (s, "mac") THEN DefaultModel := Model.Mac ELSE DefaultModel := Model.Emacs END END; debug := Env.Get ("TEXTPORTDEBUG") # NIL; s := Env.Get ("KEYBOARD_MODE"); UseDiacritical := s # NIL AND Text.Equal (s, "French") END END TextPort.