Oberon/A2/Oberon.TextFrames.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)

MODULE TextFrames IN Oberon;	(** portable *) (* JG / pjm *)

  IMPORT Input, Modules, Objects, Display, Viewers, Fonts, Texts, Oberon, MenuViewers;

  CONST CR = 0DX;
    replace = Display.replace; paint = Display.paint; invert = Display.invert;
    extend = Display.extend; reduce = Display.reduce;

	StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";
	LogMenu = "System.Clear Edit.Locate Edit.Search Edit.Store";
	OpenCmd = "ET.Open";

	Modern = FALSE;	(* enable "modern" look *)
	SmallDisplay = TRUE;	(* enable PDR's support for narrow displays *)
	MoveArea = TRUE;	(* show "move" icon at top left, and use clipping for caret *)

  TYPE
  	Line = POINTER TO LineDesc;

  	LineDesc = RECORD
    	len: SIGNED32;
        wid: SIGNED16;
        eot: BOOLEAN;
        next: Line
  	END;

  	Location* = RECORD
        org*, pos*: SIGNED32;
        dx*, x*, y*: SIGNED16;
        lin: Line
  	END;

  	Frame* = POINTER TO FrameDesc;

  	FrameDesc* = RECORD
        (Display.FrameDesc)
        text*: Texts.Text;
        org*: SIGNED32;
        col*: SIGNED16;
        lsp*: SIGNED16;
        left*, right*, top*, bot*: SIGNED16;
        markH*: SIGNED16;
        time*: SIGNED32;
        mark*, car*, sel*: SIGNED16;
        carloc*: Location;
        selbeg*, selend*: Location;
        trailer: Line
  	END;

  	(*mark < 0: arrow mark
        mark = 0: no mark
        mark > 0: position mark*)

  VAR
    menuH*, barW*, left*, right*, top*, bot*, lsp*: SIGNED16; (*standard sizes*)
    MarkColor, BarColor, MenuBG, TextBG, FullColor, mode: SIGNED16;
    asr, dsr, selH, markW, eolW: SIGNED16;
    ch: CHAR;
    W, KW: Texts.Writer; (*keyboard writer*)
    box: Fonts.Char;
    BoxPat: ARRAY 12 OF SET;
    hintPos: SIGNED32;
    saved: Oberon.CaretMsg;

  PROCEDURE Min (i, j: SIGNED16): SIGNED16;
  BEGIN IF i >= j THEN RETURN j ELSE RETURN i END
  END Min;

  PROCEDURE Max (i, j: SIGNED32): SIGNED32;
  BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
  END Max;

  (*------------------display support------------------------*)

  PROCEDURE ReplConst (col: SIGNED16; F: Frame; X, Y, W, H: SIGNED16; mode: SIGNED16);
  BEGIN
    IF X + W <= F.X + F.W THEN Display.ReplConst(col, X, Y, W, H, mode)
      ELSIF X < F.X + F.W THEN Display.ReplConst(col, X, Y, F.X + F.W - X, H, mode)
    END
  END ReplConst;

  PROCEDURE UpdateMark (F: Frame);
    VAR oldH: SIGNED16;
  BEGIN
    oldH := F.markH; F.markH := SHORT(F.org * F.H DIV (F.text.len + 1));
    IF (F.mark > 0) & (F.left >= barW) & (F.markH # oldH) THEN
      Display.ReplConst(F.col, F.X, F.Y + F.H - 1 - oldH, markW, 1, replace);
      Display.ReplConst(MarkColor, F.X, F.Y + F.H - 1 - F.markH, markW, 1, replace)
    END
  END UpdateMark;

  PROCEDURE Width (VAR R: Texts.Reader; len: SIGNED32): SIGNED16;
    VAR  pos: SIGNED32; ox: SIGNED16; obj: Objects.Object;
  BEGIN pos := 0; ox := 0;
    WHILE pos # len DO
      R.lib.GetObj(R.lib, ORD(ch), obj);
      IF ~(obj IS Fonts.Char) THEN obj := box END;
      ox := ox + obj(Fonts.Char).dx; INC(pos); Texts.Read(R, ch)
    END;
    RETURN ox
  END Width;

  PROCEDURE DisplayLine (F: Frame; L: Line;
    VAR R: Texts.Reader; X, Y: SIGNED16; len: SIGNED32);
    VAR NX: SIGNED16; obj: Objects.Object;
  BEGIN NX := F.X + F.W;
    WHILE (ch # CR) & (R.lib # NIL) DO
      IF R.lib IS Fonts.Font THEN R.lib.GetObj(R.lib, ORD(ch), obj)
        ELSE obj := box
      END;
      WITH obj: Fonts.Char DO
        IF X + obj.x + obj.w <= NX THEN
          Display.CopyPattern(R.col, obj.pat, X + obj.x, Y + obj.y, mode);
          X := X + obj.dx
        ELSE
          X := NX
        END;
      END;
      INC(len); Texts.Read(R, ch)
    END;
    L.len := len + 1; L.wid := X + eolW - (F.X + F.left);
    L.eot := R.eot; Texts.Read(R, ch)
  END DisplayLine;

  PROCEDURE Validate (T: Texts.Text; VAR org: SIGNED32);
    VAR R: Texts.Reader; pos: SIGNED32;
  BEGIN
    IF org > T.len THEN org := T.len
    ELSIF org > 0 THEN Texts.OpenReader(R, T, org - 1); Texts.Read(R, ch);
      IF ch # CR THEN
        pos := Max(org - 100, 0); Texts.OpenReader(R, T, pos);
        REPEAT Texts.Read(R, ch); INC(pos) UNTIL (pos = org) OR (ch = CR);
        org := pos
      END
    ELSE org := 0
    END
  END Validate;

  PROCEDURE Mark* (F: Frame; mark: SIGNED16);
  BEGIN
    IF (mark >= 0) & (F.mark < 0) & (F.H >= 16) THEN
      Display.CopyPattern(F.col, Display.downArrow, F.X, F.Y, paint)
    ELSIF (mark <= 0) & (F.mark > 0) & (F.H > 0) & (F.left >= barW) THEN
      Display.ReplConst(F.col, F.X, F.Y + F.H - 1 - F.markH, markW, 1, replace)
    END;
    IF (mark > 0) & (F.H > 0) & (F.left >= barW) & (F.mark <= 0) THEN
      Display.ReplConst(MarkColor, F.X, F.Y + F.H - 1 - F.markH, markW, 1, replace)
    ELSIF (mark < 0) & (F.H >= 16) & (F.mark >= 0) THEN
      Display.CopyPattern(MarkColor, Display.downArrow, F.X, F.Y, paint)
    END;
    F.mark := mark
  END Mark;

  PROCEDURE DrawIcon(F: Frame);
  BEGIN
    Display.ReplConst(MarkColor, F.X+3, F.Y+F.H-9, 6, 6, replace);
    IF Oberon.New THEN
      Display.ReplConst(F.col, F.X+5, F.Y+F.H-7, 2, 2, replace)
    END
  END DrawIcon;

  PROCEDURE Restore* (F: Frame);
    VAR R: Texts.Reader; L: Line; curY, botY: SIGNED16;
  BEGIN (*F.mark = 0*)
    Display.ReplConst(F.col, F.X, F.Y, F.W, F.H, replace);
    IF F.left >= barW THEN
      Display.ReplConst(BarColor, F.X + barW - 1, F.Y, 1, F.H, replace)
    ELSIF MoveArea THEN
      DrawIcon(F)
    END;
    Validate(F.text, F.org);
    botY := F.Y + F.bot + dsr;
    Texts.OpenReader(R, F.text, F.org); Texts.Read(R, ch);
    L := F.trailer; curY := F.Y + F.H - F.top - asr;
    WHILE ~L.eot & (curY >= botY) DO
      NEW(L.next); L := L.next;
      DisplayLine(F, L, R, F.X + F.left, curY, 0);
      curY := curY - lsp
    END;
    L.next := F.trailer;
    F.markH := SHORT(F.org * F.H DIV (F.text.len + 1))
  END Restore;

  PROCEDURE Suspend* (F: Frame);
  BEGIN (*F.mark = 0*)
    F.trailer.next := F.trailer
  END Suspend;

  PROCEDURE Extend* (F: Frame; newY: SIGNED16);
    VAR R: Texts.Reader; L: Line;
    org: SIGNED32; curY, botY: SIGNED16;
  BEGIN (*F.mark = 0*)
    Display.ReplConst(F.col, F.X, newY, F.W, F.Y - newY, replace);
    IF F.left >= barW THEN
      Display.ReplConst(BarColor, F.X + barW - 1, newY, 1, F.Y - newY, replace)
    ELSIF MoveArea THEN
      DrawIcon(F)
    END;
    F.H := F.H + F.Y - newY; F.Y := newY;
    IF F.trailer.next = F.trailer THEN Validate(F.text, F.org) END;
    L := F.trailer; org := F.org; curY := F.Y + F.H - F.top - asr;
    WHILE L.next # F.trailer DO
      L := L.next; org := org + L.len; curY := curY - lsp
    END;
    botY := F.Y + F.bot + dsr;
    Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
    WHILE ~L.eot & (curY >= botY) DO
      NEW(L.next); L := L.next;
      DisplayLine(F, L, R, F.X + F.left, curY, 0);
      curY := curY - lsp
    END;
    L.next := F.trailer;
    F.markH := SHORT(F.org * F.H DIV (F.text.len + 1))
  END Extend;

  PROCEDURE Reduce* (F: Frame; newY: SIGNED16);
    VAR L: Line; curY, botY: SIGNED16;
  BEGIN (*F.mark = 0*)
    F.H := F.H + F.Y - newY; F.Y := newY;
    botY := F.Y + F.bot + dsr;
    L := F.trailer; curY := F.Y + F.H - F.top - asr;
    WHILE (L.next # F.trailer) & (curY >= botY) DO
      L := L.next; curY := curY - lsp
    END;
    L.next := F.trailer;
    IF curY + asr > F.Y THEN
      Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, curY + asr - F.Y, replace)
    END;
    F.markH := SHORT(F.org * F.H DIV (F.text.len + 1));
    Mark(F, 1)
  END Reduce;

  PROCEDURE Show* (F: Frame; pos: SIGNED32);
    VAR R: Texts.Reader; L: Line;
      org: SIGNED32; curY, botY, Y0: SIGNED16;
  BEGIN
    IF F.trailer.next # F.trailer THEN Validate(F.text, pos);
      IF pos < F.org THEN Mark(F, 0);
        Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, F.H, replace);
        botY := F.Y; F.Y := F.Y + F.H; F.H := 0;
        F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
        Mark(F, 1)
      ELSIF pos > F.org THEN
        org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
        WHILE (L.next # F.trailer) & (org # pos) DO
          org := org + L.len; L := L.next; curY := curY - lsp;
        END;
        IF org = pos THEN
          F.org := org; F.trailer.next := L; Y0 := curY;
          WHILE L.next # F.trailer DO
            org := org + L.len; L := L.next; curY := curY - lsp
          END;
          Display.CopyBlock
            (F.X + F.left, curY - dsr, F.W - F.left, Y0 + asr - (curY - dsr),
            F.X + F.left, curY - dsr + F.Y + F.H - F.top - asr - Y0, replace);
          curY := curY + F.Y + F.H - F.top - asr - Y0;
          Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, curY - dsr - F.Y, replace);
          botY := F.Y + F.bot + dsr;
          org := org + L.len; curY := curY - lsp;
          Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
          WHILE ~L.eot & (curY >= botY) DO
            NEW(L.next); L := L.next;
            DisplayLine(F, L, R, F.X + F.left, curY, 0);
            curY := curY - lsp
          END;
          L.next := F.trailer;
          UpdateMark(F)
        ELSE Mark(F, 0);
          Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, F.H, replace);
          botY := F.Y; F.Y := F.Y + F.H; F.H := 0;
          F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
          Mark(F, 1)
        END
      END
    END
  END Show;

  PROCEDURE LocateLine (F: Frame; y: SIGNED16; VAR loc: Location);
    VAR L: Line; org: SIGNED32; cury: SIGNED16;
  BEGIN
    org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
    WHILE (L.next # F.trailer) & (cury > y + dsr) DO
      org := org + L.len; L := L.next; cury := cury - lsp
    END;
    loc.org := org; loc.lin := L; loc.y := cury
  END LocateLine;

  PROCEDURE LocateString (F: Frame; x, y: SIGNED16; VAR loc: Location);
    VAR R: Texts.Reader;
      bpos, pos, lim: SIGNED32;
      bx, ex, ox: SIGNED16;
      obj: Objects.Object;
      continue (* outer loop *): BOOLEAN;
  BEGIN
    LocateLine(F, y, loc);
    lim := loc.org + loc.lin.len - 1;
    bpos := loc.org; bx := F.left;
    pos := loc.org; ox := F.left;
    Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, ch);
    continue := TRUE;
    (* LOOP *) WHILE continue DO
      (* LOOP *) (*scan string*)
      WHILE (pos # lim) & (" " < ch) DO
        R.lib.GetObj(R.lib, ORD(ch), obj);
        IF ~(obj IS Fonts.Char) THEN obj := box END;
        INC(pos); ox := ox + obj(Fonts.Char).dx; Texts.Read(R, ch)
      END;
      ex := ox;
      (* LOOP *) (*scan gap*)
      WHILE (pos # lim) & (ch <= " ") DO
        R.lib.GetObj(R.lib, ORD(ch), obj);
        IF ~(obj IS Fonts.Char) THEN obj := box END;
        INC(pos); ox := ox + obj(Fonts.Char).dx; Texts.Read(R, ch)
      END;
      IF (pos = lim) OR (ox > x) THEN
        (* EXIT *) continue := FALSE
      ELSE
        R.lib.GetObj(R.lib, ORD(ch), obj);
        IF ~(obj IS Fonts.Char) THEN obj := box END;
        bpos := pos; bx := ox;
        INC(pos); ox := ox + obj(Fonts.Char).dx; Texts.Read(R, ch)
      END
    END;
    loc.pos := bpos; loc.dx := ex - bx; loc.x := bx
  END LocateString;

  PROCEDURE LocateChar (F: Frame; x, y: SIGNED16; VAR loc: Location);
    VAR R: Texts.Reader;
      pos, lim: SIGNED32;
      ox, dx: SIGNED16;
      obj: Objects.Object;
      continue (* one loop *): BOOLEAN;
  BEGIN
    LocateLine(F, y, loc);
    lim := loc.org + loc.lin.len - 1;
    pos := loc.org; ox := F.left;
    Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, ch);
    continue :=  TRUE;
    (* LOOP *) WHILE continue DO
      IF pos = lim THEN
        dx := eolW; (* EXIT *) continue := FALSE
      ELSE
        R.lib.GetObj(R.lib, ORD(ch), obj);
        IF ~(obj IS Fonts.Char) THEN obj := box END;
        dx := obj(Fonts.Char).dx;
        IF ox + dx > x THEN
          (* EXIT *) continue := FALSE
        ELSE
          INC(pos); ox := ox + dx; Texts.Read(R, ch)
        END
      END
    END (* LOOP *);
    loc.pos := pos; loc.dx := dx; loc.x := ox
  END LocateChar;

  PROCEDURE LocatePos (F: Frame; pos: SIGNED32; VAR loc: Location);
    VAR R: Texts.Reader; L: Line; org: SIGNED32; cury: SIGNED16;
  BEGIN
    org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
    WHILE (L.next # F.trailer) & (pos >= org + L.len) DO
      org := org + L.len; L := L.next; cury := cury - lsp
    END;
    IF pos < org THEN pos := org
      ELSIF pos >= org + L.len THEN pos := org + L.len - 1
    END;
    Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
    loc.org := org; loc.pos := pos; loc.lin := L;
    loc.x := F.left + Width(R, pos - org); loc.y := cury
  END LocatePos;

  PROCEDURE Pos* (F: Frame; X, Y: SIGNED16): SIGNED32;
    VAR loc: Location;
  BEGIN LocateChar(F, X - F.X, Y - F.Y, loc);
    RETURN loc.pos
  END Pos;

  PROCEDURE FlipCaret (F: Frame);
  VAR ox, oy, ow, oh: SIGNED16;
  BEGIN
    IF MoveArea THEN
      Display.GetClip(ox, oy, ow, oh);
      Display.SetClip(F.X, F.Y, F.W, F.H);
      Display.CopyPattern(FullColor, Display.hook, F.X + F.carloc.x, F.Y + F.carloc.y - 10, invert);
      Display.SetClip(ox, oy, ow, oh)
    ELSE
      IF (F.carloc.y >= 10) & (F.carloc.x + 12 < F.W) THEN
        Display.CopyPattern(FullColor, Display.hook, F.X + F.carloc.x, F.Y + F.carloc.y - 10, invert)
      END
    END
  END FlipCaret;

  PROCEDURE SetCaret* (F: Frame; pos: SIGNED32);
  BEGIN
    IF F.car # 0 THEN FlipCaret(F); F.car := 0 END;
    LocatePos(F, pos, F.carloc);
    IF F.carloc.pos = pos THEN FlipCaret(F); F.car := 1
    ELSE
      RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
      Show(F, pos - 100); LocatePos(F, pos, F.carloc);
      IF F.carloc.pos = pos THEN FlipCaret(F); F.car := 1 END
    END
  END SetCaret;

  PROCEDURE TrackCaret* (F: Frame; X, Y: SIGNED16; VAR keysum: SET);
    VAR loc: Location; keys: SET;
  BEGIN
    IF F.trailer.next # F.trailer THEN
      LocateChar(F, X - F.X, Y - F.Y, F.carloc);
      FlipCaret(F);
      keysum := {};
      REPEAT
        Input.Mouse(keys, X, Y);
        keysum := keysum + keys;
        Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
        LocateChar(F, X - F.X, Y - F.Y, loc);
        IF loc.pos # F.carloc.pos THEN FlipCaret(F); F.carloc := loc; FlipCaret(F) END
      UNTIL keys = {};
      F.car := 1
    END
  END TrackCaret;

  PROCEDURE RemoveCaret* (F: Frame);
  BEGIN IF F.car # 0 THEN FlipCaret(F); F.car := 0 END
  END RemoveCaret;

  PROCEDURE FlipSelection (F: Frame; VAR beg, end: Location);
    VAR L: Line; Y: SIGNED16;
    continue (* one loop *): BOOLEAN;
  BEGIN
    L := beg.lin; Y := F.Y + beg.y - 2;
    IF L = end.lin THEN
      ReplConst(FullColor, F, F.X + beg.x, Y, end.x - beg.x, selH, invert)
    ELSE
      ReplConst(FullColor, F, F.X + beg.x, Y, F.left + L.wid - beg.x, selH, invert);
      continue :=  TRUE;
      (* LOOP *) WHILE continue DO
        L := L.next; Y := Y - lsp;
        IF L = end.lin THEN
          (* EXIT *) continue := FALSE
        ELSE
          ReplConst(FullColor, F, F.X + F.left, Y, L.wid, selH, invert)
        END
      END;
      ReplConst(FullColor, F, F.X + F.left, Y, end.x - F.left, selH, invert)
    END
  END FlipSelection;

  PROCEDURE SetSelection* (F: Frame; beg, end: SIGNED32);
  BEGIN
    IF end <= beg THEN end := beg + 1 END;
    IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
    LocatePos(F, beg, F.selbeg);
    IF F.selbeg.pos # beg THEN Show(F, beg); LocatePos(F, beg, F.selbeg) END;
    LocatePos(F, end, F.selend);
    FlipSelection(F, F.selbeg, F.selend); F.time := Input.Time(); F.sel := 1
  END SetSelection;

  PROCEDURE TrackSelection* (F: Frame; X, Y: SIGNED16; VAR keysum: SET);
    VAR loc: Location; modKeys, keys: SET; M: Oberon.SelectMsg;
  BEGIN
      IF F.trailer.next # F.trailer THEN
    	IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
    	LocateChar(F, X - F.X, Y - F.Y, loc);
    	IF (F.sel # 0) & (loc.pos = F.selbeg.pos) & (F.selend.pos = F.selbeg.pos + 1) THEN
      	LocateChar(F, F.left, Y - F.Y, F.selbeg)
    	ELSE F.selbeg := loc
    	END;
    	F.sel := 0;
    	INC(loc.pos); loc.x := loc.x + loc.dx; F.selend := loc;
    	FlipSelection(F, F.selbeg, F.selend);
        keysum := {};
    	REPEAT
          Input.Mouse(keys, X, Y);
      	keysum := keysum + keys;
      	Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
    	  LocateChar(F, X - F.X, Y - F.Y, loc);
      	IF loc.pos < F.selbeg.pos THEN loc := F.selbeg END;
      	INC(loc.pos); loc.x := loc.x + loc.dx;
      	IF loc.pos < F.selend.pos THEN FlipSelection(F, loc, F.selend); F.selend := loc
        	ELSIF loc.pos > F.selend.pos THEN FlipSelection(F, F.selend, loc); F.selend := loc
      	END
  	  UNTIL keys = {};
       (* ps - 3.4.98 *)
        Input.KeyState(modKeys);
        IF Input.SHIFT IN modKeys THEN
          M.id := Oberon.get; M.F := NIL; M.sel := NIL; M.text := NIL; M.time := -1; Display.Broadcast(M);
          IF (M.time # -1) & (M.text = F.text) & (M.sel IS Frame) THEN
            IF M.beg > F.selbeg.pos THEN M.beg := F.selbeg.pos END;
            IF M.end < F.selend.pos THEN M.end := F.selend.pos END;
            FlipSelection(F, F.selbeg, F.selend);
            LocatePos(F, M.beg, F.selbeg); LocatePos(F, M.end, F.selend);
            FlipSelection(F, F.selbeg, F.selend);
            M.F := M.sel; M.id := Oberon.set; Display.Broadcast(M)
          END
        END;
        F.time := Input.Time(); F.sel := 1
      END
  END TrackSelection;

  PROCEDURE RemoveSelection* (F: Frame);
  BEGIN IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend); F.sel := 0 END
  END RemoveSelection;

  PROCEDURE TrackLine* (F: Frame; X, Y: SIGNED16; VAR org: SIGNED32; VAR keysum: SET);
    VAR old, new: Location; keys: SET;
  BEGIN
        IF F.trailer.next # F.trailer THEN
    	  LocateLine(F, Y - F.Y, old);
    	  ReplConst(FullColor, F, F.X + F.left, F.Y + old.y - dsr, old.lin.wid, 2, invert);
          keysum := {};
      	REPEAT
      	  Input.Mouse(keys, X, Y);
      	  keysum := keysum + keys;
            Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
        	LocateLine(F, Y - F.Y, new);
        	IF new.org # old.org THEN
        	  ReplConst(FullColor, F, F.X + F.left, F.Y + old.y - dsr, old.lin.wid, 2, invert);
       	   ReplConst(FullColor, F, F.X + F.left, F.Y + new.y - dsr, new.lin.wid, 2, invert);
        	  old := new
      	  END
    	  UNTIL keys = {};
    	  ReplConst(FullColor, F, F.X + F.left, F.Y + new.y - dsr, new.lin.wid, 2, invert);
    	  org := new.org
        ELSE org := -1
        END
  END TrackLine;

  PROCEDURE TrackWord* (F: Frame; X, Y: SIGNED16; VAR pos: SIGNED32; VAR keysum: SET);
    VAR old, new: Location; keys: SET;
  BEGIN
    IF F.trailer.next # F.trailer THEN
	  LocateString(F, X - F.X, Y - F.Y, old);
  	ReplConst(FullColor, F, F.X + old.x, F.Y + old.y - dsr, old.dx, 2, invert);
      keysum := {};
      REPEAT
    	Input.Mouse(keys, X, Y);
		keysum := keysum + keys;
    	Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
    	LocateString(F, X - F.X, Y - F.Y, new);
    	IF new.pos # old.pos THEN
      	ReplConst(FullColor, F, F.X + old.x, F.Y + old.y - dsr, old.dx, 2, invert);
      	ReplConst(FullColor, F, F.X + new.x, F.Y + new.y - dsr, new.dx, 2, invert);
      	old := new
    	END
  	UNTIL keys = {};
  	ReplConst(FullColor, F, F.X + new.x, F.Y + new.y - dsr, new.dx, 2, invert);
  	pos := new.pos; hintPos := new.org
    ELSE pos := -1
    END
  END TrackWord;

  (*------------------message handling------------------------*)

  PROCEDURE RemoveMarks (F: Frame);
  BEGIN RemoveCaret(F); RemoveSelection(F)
  END RemoveMarks;

  PROCEDURE GetAttr* (F: Frame; VAR s: ARRAY OF CHAR);
    VAR S: Texts.Scanner;
  BEGIN Texts.OpenScanner(S, F.text, 0); Texts.Scan(S); COPY(S.s, s)
  END GetAttr;

  PROCEDURE CallCmd (cmd: ARRAY OF CHAR; F: Frame; pos: SIGNED32; new: BOOLEAN);
    VAR res: SIGNED16; par: Oberon.ParList;
  BEGIN
    NEW(par); par.vwr := Viewers.This(F.X, F.Y);
    par.frame := F; par.text := F.text; par.pos := pos;
    Oberon.Call(cmd, par, new, res);
    IF res > 0 THEN
      Texts.WriteString(W, "Call error: ");
      Texts.WriteString(W, Modules.resMsg);
      Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
    END
  END CallCmd;

  PROCEDURE Call* (F: Frame; pos: SIGNED32; new: BOOLEAN);
    VAR S: Texts.Scanner; i, h: SIGNED16; hint: ARRAY 32 OF CHAR;
  BEGIN
    IF SmallDisplay THEN
      Texts.OpenScanner(S, F.text, pos); Texts.Scan(S); h := 0;
      IF ((S.class = Texts.Char) & (S.c = ".") OR (S.class = Texts.Name) & (S.s[0] = ".")) THEN
        (*find hint*)
        Texts.OpenScanner(S, F.text, hintPos);
        REPEAT
          Texts.Scan(S);
          IF S.class = Texts.Name THEN
            i := 0; WHILE (i < S.len) & (S.s[i] # ".") DO INC(i) END;
            IF (0 < i) & (i < S.len) THEN
              h := 0; REPEAT hint[h] := S.s[h]; INC(h) UNTIL h > i
            END
          END
        UNTIL Texts.Pos(S) > pos;
        IF (S.class = Texts.Char) & (S.c = ".") THEN Texts.Scan(S) END
      END;
      IF S.class = Texts.Name THEN
        IF h > 1 THEN  (*use hint*)
          i := S.len; IF S.s[0] = "." THEN DEC(h) END;
          REPEAT S.s[i+h] := S.s[i]; DEC(i) UNTIL (i = -1) OR (S.s[i+1] = ".");
          REPEAT DEC(h); S.s[h] := hint[h] UNTIL h = 0
        END;
        CallCmd(S.s, F, pos + S.len, new)
      END
    ELSE
      Texts.OpenScanner(S, F.text, pos); Texts.Scan(S);
      IF (S.line = 0) & (S.class = Texts.Name) THEN CallCmd(S.s, F, pos + S.len, new) END
    END
  END Call;

  PROCEDURE Write* (F: Frame; ch: CHAR; lib: Objects.Library; col, voff: SIGNED8);
  BEGIN (*F.car # 0*)
    IF ch = 7FX THEN
      IF F.carloc.pos > F.org THEN
        Texts.Delete(F.text, F.carloc.pos - 1, F.carloc.pos);
        SetCaret(F, F.carloc.pos - 1)
      END
    ELSIF ch = 0C3X THEN (* right *)
      IF F.carloc.pos < F.text.len THEN
        RemoveCaret(F); SetCaret(F, F.carloc.pos + 1)
      END
    ELSIF ch = 0C4X THEN (* left *)
      IF F.carloc.pos > 0 THEN
        RemoveCaret(F); SetCaret(F, F.carloc.pos - 1)
      END
    ELSIF (ch >= 0C1X) & (ch <= 0C4X) THEN
    ELSIF (ch >= 0A0X) & (ch <= 0A9X) THEN
    ELSIF (ch >= 0F0X) & (ch <= 0FFX) THEN
    ELSE
      KW.lib := lib; KW.col := col; KW.voff := voff; Texts.Write(KW, ch);
      Texts.Insert(F.text, F.carloc.pos, KW.buf);
      SetCaret(F, F.carloc.pos + 1)
    END
  END Write;

  PROCEDURE Defocus* (F: Frame);
  BEGIN RemoveCaret(F)
  END Defocus;

  PROCEDURE Neutralize* (F: Frame);
  BEGIN RemoveMarks(F)
  END Neutralize;

  PROCEDURE Modify* (F: Frame; id, dY, Y, H: SIGNED16);
  BEGIN
    Mark(F, 0); RemoveMarks(F);
    IF id = extend THEN
      IF dY > 0 THEN
        Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, F.Y + dY, replace); F.Y := F.Y + dY
      END;
      Extend(F, Y)
    ELSIF id = reduce THEN
      Reduce(F, Y + dY);
      IF dY > 0 THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y, replace); F.Y := Y END;
    END;
    IF F.H > 0 THEN Mark(F, 1) END
  END Modify;

  PROCEDURE Open* (
        F: Frame; H: Objects.Handler; T: Texts.Text; org: SIGNED32;
        col, left, right, top, bot, lsp: SIGNED16);
    VAR L: Line;
  BEGIN NEW(L);
    L.len := 0; L.wid := 0; L.eot := FALSE; L.next := L;
    F.handle := H; F.text := T; F.org := org; F.trailer := L;
    F.left := left; F.right := right; F.top := top; F.bot := bot;
    F.lsp := lsp; F.col := col; F.mark := 0; F.car := 0; F.sel := 0
  END Open;

  PROCEDURE Copy* (F: Frame; VAR F1: Frame);
  BEGIN NEW(F1);
    Open(F1, F.handle, F.text, F.org, F.col, F.left, F.right, F.top, F.bot, F.lsp)
  END Copy;

  PROCEDURE CopyOver* (F: Frame; text: Texts.Text; beg, end: SIGNED32);
    VAR  buf: Texts.Buffer;
  BEGIN
    IF F.car > 0 THEN
      NEW(buf); Texts.OpenBuf(buf);
      Texts.Save(text, beg, end, buf);
      Texts.Insert(F.text, F.carloc.pos, buf);
      SetCaret(F, F.carloc.pos + (end - beg))
    END
  END CopyOver;

  PROCEDURE GetSelection* (F: Frame; VAR M: Oberon.SelectMsg);
  BEGIN
    IF F.sel > 0 THEN
      IF (F.time - M.time > 0) OR (M.time = -1) THEN M.sel := F; M.time := F.time;
        M.text := F.text; M.beg := F.selbeg.pos; M.end := F.selend.pos;
        IF M.end > M.text.len THEN M.end := M.text.len END
(*
       ELSIF (F.text = M.text) & (F.selbeg.pos < M.beg) & (M.sel IS Frame) THEN
        IF (M.beg <= M.sel(Frame).org) & (F.selend.pos >= Pos(F, F.X+F.W, F.Y)) THEN
        	M.beg := F.selbeg.pos
        END
*)
     ELSIF F.text = M.text THEN	(* extend selection over frame boundaries *)
        (* 7.4.98 - ps *)
        IF (F.selbeg.pos < M.beg) & (F.selend.pos >= Pos(F, F.X+F.W, F.Y)) THEN M.beg := F.selbeg.pos END;
        IF (F.selend.pos > M.end) & (F.selbeg.pos = F.org) THEN M.end := F.selend.pos END;
        IF M.end > F.text.len THEN M.end :=  F.text.len END
      END
    END
  END GetSelection;

  PROCEDURE GetCaret* (F: Frame; VAR M: Oberon.CaretMsg);
  BEGIN IF F.car > 0 THEN M.text := F.text; M.pos := F.carloc.pos; M.car := F; M.res := 0 END
  END GetCaret;

  PROCEDURE LineLen (VAR R: Texts.Reader): SIGNED32;
    VAR len: SIGNED32;
  BEGIN len := 0;
    WHILE (ch # CR) & (R.lib # NIL) DO INC(len); Texts.Read(R, ch) END;
    Texts.Read(R, ch);
    RETURN len + 1
  END LineLen;

  PROCEDURE Update* (F: Frame; beg, end, len: SIGNED32);
    VAR R: Texts.Reader; L, LB, LR, LS: Line; done: BOOLEAN;
      org, orgB, orgS, off, Llen: SIGNED32;
      botY, Y, YB, YL, YR, YS, wid, H: SIGNED16;
  BEGIN
    IF end < F.org THEN F.org := F.org - (end - beg) + len;
    ELSE
      IF beg < F.org THEN
        F.trailer.next.len := F.trailer.next.len + (F.org - beg);
        F.org := beg
      END;
      botY := F.Y + F.bot + dsr;
      org := F.org; Y := F.Y + F.H - F.top - asr; L := F.trailer.next;
      WHILE (L # F.trailer) & (org + L.len <= beg) DO
        org := org + L.len; Y := Y - lsp; L := L.next
      END;
      IF L # F.trailer THEN done := FALSE;
        RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
        orgB := org; YB := Y; LB := L;
        WHILE (L # F.trailer) & (org + L.len <= end) DO
          org := org + L.len; Y := Y - lsp; L := L.next
        END;
        IF L # F.trailer THEN
          org := org + L.len; Y := Y - lsp; L := L.next;
          IF L # F.trailer THEN
            YR := Y; LR := L; org := orgB; Y := YB;
            Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
            Llen := LineLen(R);
            WHILE (org + Llen <= beg + len) & (botY + lsp <= Y) DO
              org := org + Llen; Y := Y - lsp; Llen := LineLen(R)
            END;
            org := org + Llen; Y := Y - lsp;
            IF botY <= Y THEN (* update with reusing lines *)
              YL := Y; L := LR;
              WHILE (L.next # F.trailer) & (botY + lsp <= Y) DO
                org := org + L.len; Y := Y - lsp; L := L.next
              END;
              orgS := org; YS := Y; LS := L;
              Display.CopyBlock (
                F.X + F.left, YS - dsr + (YR - YL), F.W - F.left, YL + lsp - YS, F.X + F.left, YS - dsr, replace);
              org := orgB; Y := YB; L := LB;
              Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
              off := beg - org; wid := Width(R, off);
              ReplConst (F.col, F, F.X + F.left + wid, Y - dsr, L.wid - wid, lsp, 0);
              DisplayLine(F, L, R, F.X + F.left + wid, Y, off);
              WHILE org + L.len <= beg + len DO
                org := org + L.len; Y := Y - lsp; NEW(L.next); L := L.next;
                Display.ReplConst(F.col, F.X + F.left, Y - dsr, F.W - F.left, lsp, replace);
                DisplayLine(F, L, R, F.X + F.left, Y, 0)
              END;
              L.next := LR;
              org := orgS; Y := YS; L := LS; org := org + L.len; Y := Y - lsp;
              Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
              WHILE ~L.eot & (botY <= Y) DO
                NEW(L.next); L := L.next;
                Display.ReplConst(F.col, F.X + F.left, Y - dsr, F.W - F.left, lsp, replace);
                DisplayLine(F, L, R, F.X + F.left, Y, 0);
                org := org + L.len; Y := Y - lsp
              END;
              L.next := F.trailer;
              IF YR < YL THEN H := Min(YL- YR, Y + lsp - dsr - F.Y);
                Display.ReplConst(F.col, F.X + F.left, Y + lsp - dsr - H, F.W - F.left, H, replace)
              END;
              done := TRUE
            END
          END
        END;
        IF ~done THEN (* update without reusing lines *)
          YR := Y; org := orgB; Y := YB; L := LB;
          Texts.OpenReader(R, F.text, org); Texts.Read(R, ch);
          off := beg - org; wid := Width(R, off);
          ReplConst (F.col, F, F.X + F.left + wid, Y - dsr, L.wid - wid, lsp, 0);
          DisplayLine(F, L, R, F.X + F.left + wid, Y, off);
          WHILE ~L.eot & (botY + lsp <= Y) DO
            org := org + L.len; Y := Y - lsp; NEW(L.next); L := L.next;
            Display.ReplConst(F.col, F.X + F.left, Y - dsr, F.W - F.left, lsp, replace);
            DisplayLine(F, L, R, F.X + F.left, Y, 0)
          END;
          org := org + L.len; Y := Y - lsp;
          IF (Y < botY) & (org <= beg + len) & (beg + len < org + 500) THEN (*autoscroll*)
            REPEAT
              Display.CopyBlock
              (F.X + F.left, Y + lsp - dsr, F.W - F.left, F.Y + F.H - F.top - asr - Y - lsp,
                  F.X + F.left, Y + lsp - dsr + lsp,
              replace);
              F.org := F.org + F.trailer.next.len;
              L.next := F.trailer.next; F.trailer.next := F.trailer.next.next;
              L := L.next;
              Display.ReplConst(F.col, F.X + F.left, Y + lsp - dsr, F.W - F.left, lsp, replace);
              DisplayLine(F, L, R, F.X + F.left, Y + lsp, 0);
              org := org + L.len
            UNTIL org > beg + len
          END;
          L.next := F.trailer;
          IF YR < Y THEN
            Display.ReplConst (F.col, F.X + F.left, YR + lsp - dsr, F.W - F.left, Y - YR, replace)
          END
        END
      END
    END;
    UpdateMark(F)
  END Update;

  PROCEDURE Recall (F: Frame);
    VAR buf: Texts.Buffer; pos: SIGNED32;
  BEGIN
    IF F.car > 0 THEN
	  NEW(buf); Texts.OpenBuf(buf);
      Texts.Recall(buf); pos := F.carloc.pos + buf.len;
	  Texts.Insert(F.text, F.carloc.pos, buf);
      SetCaret(F, pos)
    END
  END Recall;

  PROCEDURE SaveCaret;
  BEGIN
    saved.car := NIL; saved.text := NIL;
    saved.id := Oberon.get; Display.Broadcast(saved)
  END SaveCaret;

  PROCEDURE RestoreCaret;
  BEGIN
    IF (saved.car # NIL) & (saved.text # NIL) THEN
      saved.id := Oberon.set; Display.Broadcast(saved)
    END
  END RestoreCaret;

  PROCEDURE Edit* (F: Frame; X, Y: SIGNED16; Keys: SET);
    VAR
      M: Oberon.ConsumeMsg;
      R: Texts.Reader;
      text: Texts.Text; buf: Texts.Buffer;
      time, pos, beg, end: SIGNED32;
      keysum: SET;
      ch: CHAR;
  BEGIN
    Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
    IF X < F.X + Min(F.left, barW) THEN
      IF (0 IN Keys) OR (1 IN Keys) THEN keysum := Keys;
        REPEAT
          Input.Mouse(Keys, X, Y);
          keysum := keysum + Keys;
          Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
        UNTIL Keys = {};
        IF ~(2 IN keysum) THEN
          RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
          IF (0 IN keysum) OR (F.Y + F.H < Y) THEN
            IF 1 IN keysum THEN pos := 0
            ELSE pos := Max(F.org - LONG(F.H * 25) DIV lsp, 0)
            END
          ELSE
            pos := (F.Y + F.H - Y) * (F.text.len) DIV F.H
          END;
          RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
          Show(F, pos)
        ELSIF ~(0 IN keysum) THEN
          RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
          Show(F, F.text.len)
        END
      ELSIF 2 IN Keys THEN
        TrackLine(F, X, Y, pos, keysum);
        IF (pos >= 0) & ~(0 IN keysum) THEN
          RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
          Show(F, pos)
        END
      END
    ELSE
      IF 0 IN Keys THEN
        TrackSelection(F, X, Y, keysum);
        IF F.sel # 0 THEN
          IF (2 IN keysum) & ~(1 IN keysum) THEN (*delete text*)
            Oberon.GetSelection(text, beg, end, time);
            Texts.Delete(text, beg, end);
            Oberon.Defocus; SetCaret(F, beg)
          ELSIF (1 IN keysum) & ~(2 IN keysum) THEN (*copy to focus*)
            Oberon.GetSelection(text, beg, end, time);
            M.F := NIL; M.text := text; M.beg := beg; M.end := end;
            Display.Broadcast(M)
    	  END
        END
      ELSIF 1 IN Keys THEN
        TrackWord(F, X, Y, pos, keysum);
        IF 0 IN keysum THEN
          IF (pos >= 0) & ~(2 IN keysum) THEN CallCmd(OpenCmd, F, pos, FALSE) END
        ELSE
          IF pos >= 0 THEN Call(F, pos, 2 IN keysum) END
        END
      ELSIF 2 IN Keys THEN
        IF Oberon.New & (F.car # 0) & (Pos(F, X, Y) = F.carloc.pos) THEN (*click on caret*)
          Oberon.Defocus; RestoreCaret; TrackWord(F, X, Y, pos, keysum);
          IF 0 IN keysum THEN
            IF (pos >= 0) & ~(1 IN keysum) THEN CallCmd(OpenCmd, F, pos, FALSE) END
          ELSE
            IF pos >= 0 THEN Call(F, pos, FALSE) END
          END
        ELSE
          IF Oberon.New THEN SaveCaret END;
          Oberon.Defocus; TrackCaret(F, X, Y, keysum);
          IF F.car # 0 THEN
            IF (1 IN keysum) & ~(0 IN keysum) THEN (*copy from selection*)
              Oberon.GetSelection(text, beg, end, time);
              IF time # -1 THEN
                 NEW(buf); Texts.OpenBuf(buf);
                 Texts.Save(text, beg, end, buf);
                 Texts.Insert(F.text, F.carloc.pos, buf);
                 SetCaret(F, F.carloc.pos + (end - beg))
               ELSE (*copy from delete buffer*)
                 NEW(buf); Texts.OpenBuf(buf);
                 Texts.Recall(buf);
                 end := F.carloc.pos + buf.len;
                 Texts.Insert(F.text, F.carloc.pos, buf);
                 SetCaret(F, end)
               END
            ELSIF (0 IN keysum) & ~(1 IN keysum) THEN (*copy font*)
              Oberon.GetSelection(text, beg, end, time);
              IF time # -1 THEN
                Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch);
                IF (R.lib # NIL) & (R.lib IS Fonts.Font) THEN
                  Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.lib, R.col, R.voff)
                END
              END
            END
          END
        END
      END
    END
  END Edit;

  PROCEDURE  Handle* (F: Objects.Object; VAR M: Objects.ObjMsg);
  	VAR F1: Frame;
  BEGIN
    WITH F: Frame DO
  	IF M IS Texts.UpdateMsg THEN
  	  WITH M: Texts.UpdateMsg DO
          IF F.text = M.text THEN Update(F, M.beg, M.end, M.len) END
  	  END
      ELSIF M IS Oberon.InputMsg THEN
         WITH M: Oberon.InputMsg DO
          IF M.id = Oberon.track THEN Edit(F, M.X, M.Y, M.keys)
          ELSIF M.id = Oberon.consume THEN
  	      IF F.car # 0 THEN Write(F, M.ch, M.fnt, M.col, M.voff) END
          END
         END
      ELSIF M IS Oberon.ControlMsg THEN
        WITH M: Oberon.ControlMsg DO
  	    IF M.id = Oberon.defocus THEN Defocus(F)
  	    ELSIF M.id = Oberon.neutralize THEN Neutralize(F)
          END
        END
      ELSIF M IS Oberon.CaretMsg THEN
        WITH M: Oberon.CaretMsg DO
          IF M.id = Oberon.get THEN GetCaret(F, M)
          ELSIF (M.car = F) & (M.text = F.text) THEN
            IF M.id = Oberon.set THEN SetCaret(F, M.pos)
              ELSIF M.id = Oberon.reset THEN RemoveCaret(F)
            END
          END
        END
      ELSIF M IS Oberon.SelectMsg THEN
        WITH M: Oberon.SelectMsg DO
          IF M.id = Oberon.get THEN GetSelection(F, M)
          ELSIF (M.sel = F) & (M.text = F.text) THEN
            IF M.id = Oberon.set THEN SetSelection(F, M.beg, M.end)
              ELSIF M.id = Oberon.reset THEN RemoveSelection(F)
            END
          END
        END
      ELSIF M IS Oberon.ConsumeMsg THEN
        WITH M: Oberon.ConsumeMsg DO
          CopyOver(F, M.text, M.beg, M.end)
        END
      ELSIF M IS Oberon.RecallMsg THEN
        WITH M: Oberon.RecallMsg DO Recall(F) END
      ELSIF M IS Display.ModifyMsg THEN
        WITH M: Display.ModifyMsg DO
          IF M.F = F THEN Modify(F, M.id, M.dY, M.Y, M.H) END
        END
      ELSIF M IS Display.LocateMsg THEN
        WITH M: Display.LocateMsg DO
          IF (F.X <= M.X) & (M.X < F.X + F.W) & (F.Y <= M.Y) & (M.Y < F.Y + F.H) THEN
            M.loc := F; M.res := 0
          END
        END
      ELSIF M IS Objects.AttrMsg THEN
        WITH M: Objects.AttrMsg DO GetAttr(F, M.s); M.class := Objects.String; M.res := 0 END
      ELSIF M IS Objects.CopyMsg THEN
        WITH M: Objects.CopyMsg DO Copy(F, F1); M.obj := F1 END
      ELSIF M IS Objects.LinkMsg THEN
        WITH M: Objects.LinkMsg DO M.obj := F.text; M.res := 0 END
  	END
    END
  END Handle;

  (*creation*)

  PROCEDURE Menu (name, commands: ARRAY OF CHAR): Texts.Text;
    VAR T: Texts.Text; mb, me, m, s, d, i: SIGNED16; ch: CHAR;
    continueOuter, continueInner: BOOLEAN;
  BEGIN
    IF SmallDisplay & (Display.Width < 1024) THEN (*adjust commands*)
      mb := 0; me := 0; s := 0; d := 0;
      continueOuter := TRUE;
      (* outer LOOP *) WHILE continueOuter DO

        (*position to beginning of word*)
        continueInner := TRUE;
        (* LOOP 0 *) WHILE continueInner DO
          IF s >= LEN(commands) THEN
            (* EXIT *) continueInner := FALSE
          ELSE
            ch := commands[s]; INC(s);
            IF ch = 0X THEN
              (* EXIT *) continueInner := FALSE
            ELSE
              commands[d] := ch; INC(d);
              IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN (* EXIT *) continueInner := FALSE END
            END
          END
        END (* LOOP 0 *);

        IF (s >= LEN(commands)) OR (ch = 0X) THEN
          (* EXIT *) continueInner := FALSE
        ELSE

          (*scan first part of word, checking against last module name*)
          m := mb; i := 0;
          continueInner := TRUE;
          (* LOOP 1 *) WHILE continueInner DO
            INC(i); IF (m < me) & (commands[m] = ch) THEN INC(m) END;
            IF s >= LEN(commands) THEN
              (* EXIT *) continueInner := FALSE
            ELSE
              ch := commands[s]; INC(s);
              IF ch = 0X THEN
                (* EXIT *) continueInner := FALSE
              ELSE
                commands[d] := ch; INC(d);
                IF (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR (CAP(ch) > "Z") THEN
                  (* EXIT *) continueInner := FALSE
                END
              END
            END
          END (* LOOP 1 *);
  
          (*check for match*)
          IF (s < LEN(commands)) & (ch = ".") THEN
            IF m = mb + i THEN (*matches previous module name - compress*)
              DEC(d, i); commands[d-1] := "."
            ELSE (*set new module name*)
              mb := d - (i+1); me := d-1
            END;
            
            (*and do last part of word*)
            continueInner := TRUE;
            (* LOOP 2 *) WHILE continueInner DO
              IF s >= LEN(commands) THEN
                (* EXIT *) continueInner := FALSE
              ELSE
                ch := commands[s]; INC(s);
                IF ch = 0X THEN
                  (* EXIT *) continueInner := FALSE
                ELSE
                  commands[d] := ch; INC(d);
                  IF (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR (CAP(ch) > "Z") THEN
                    (* EXIT *) continueInner := FALSE
                  END
                END
              END
            END (* LOOP 2 *)
            
          END;
          IF (s >= LEN(commands)) OR (ch = 0X) THEN (* EXIT *) continueOuter := FALSE END
        END
      END (* outer LOOP *);
      IF d < LEN(commands) THEN commands[d] := 0X END
    END;

    NEW(T); Texts.Open(T, "");
    Texts.WriteString(W, name); Texts.WriteString(W, " | "); Texts.WriteString(W, commands);
    Texts.Append(T, W.buf);
    RETURN T
 END Menu;

  PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text;
    VAR T: Texts.Text;
  BEGIN NEW(T); Texts.Open(T, name); RETURN T
  END Text;

  PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame;
    VAR F: Frame; l: SIGNED16;
  BEGIN NEW(F);
    IF MoveArea THEN l := barW-1 ELSE l := left DIV 4 END;
    IF Modern THEN Open(F, Handle, Menu(name, commands), 0, MenuBG, l, 0, 3, 1, lsp)
    ELSE Open(F, Handle, Menu(name, commands), 0, MenuBG, l, 0, 1, 0, lsp)
    END;
    RETURN F
  END NewMenu;

  PROCEDURE NewText* (text: Texts.Text; pos: SIGNED32): Frame;
    VAR F: Frame;
  BEGIN NEW(F);
    Open(F, Handle, text, pos, TextBG, left, right, top, bot, lsp);
    RETURN F
  END NewText;

PROCEDURE ShowText(title: ARRAY OF CHAR; T: Texts.Text; W, H: SIGNED16);
	VAR X, Y: SIGNED16; V: Viewers.Viewer; menu: ARRAY 100 OF CHAR;
BEGIN
	X := 0; WHILE (title[X] # 0X) & (title[X] # "|") DO INC(X) END;
	IF title[X] = "|" THEN
		title[X] := 0X;  INC(X);  Y := 0;
		WHILE title[X] # 0X DO menu[Y] := title[X];  INC(X);  INC(Y) END;
		menu[Y] := 0X
	ELSE
		menu := ""
	END;
	IF T = Oberon.Log THEN
		Oberon.AllocateSystemViewer(0, X, Y);
		IF menu = "" THEN menu := LogMenu END;
		V := MenuViewers.New(NewMenu(title, menu), NewText(T, Max(T.len-200, 0)), menuH, X, Y)
	ELSE
		IF W > LONG(Display.Width * 3) DIV 8 THEN Oberon.AllocateUserViewer(0, X, Y)
		ELSE Oberon.AllocateSystemViewer(0, X, Y)
		END;
		IF menu = "" THEN menu := StandardMenu END;
		V := MenuViewers.New(NewMenu(title, menu), NewText(T, 0), menuH, X, Y)
	END
END ShowText;

(** Replace the default system editor with a textframe. *)
PROCEDURE ReplaceSystemEditor*;
BEGIN
	Oberon.OpenText := ShowText
END ReplaceSystemEditor;

BEGIN
  IF Oberon.OpenText = NIL THEN
    Oberon.OpenText := ShowText
  END;
  IF Display.Depth(0) # 1 THEN
    MarkColor := 12; MenuBG := 13; TextBG := 14;
    IF Modern THEN BarColor := 12; FullColor := Display.FG - TextBG
    ELSE BarColor := 13; FullColor := Display.FG
    END;
    mode := paint
  ELSE
    MarkColor := Display.FG; BarColor := Display.FG; MenuBG := Display.FG; TextBG:= Display.BG;
    FullColor := Display.FG;  mode := invert
  END;
  IF Modern THEN menuH := Fonts.Default.height + 8
  ELSE menuH := Fonts.Default.height + 2
  END;
  barW := Fonts.Default.height + 2;
  left := barW + Fonts.Default.height DIV 2;
  right := Fonts.Default.height DIV 2;
  IF Modern THEN top := Fonts.Default.height DIV 2 * 2 DIV 3
  ELSE top := Fonts.Default.height DIV 2
  END;
  bot := Fonts.Default.height DIV 2;
  asr := Fonts.Default.maxY;
  dsr := -Fonts.Default.minY;
  lsp := Fonts.Default.height;
  selH := Fonts.Default.height;
  markW := Fonts.Default.height DIV 3 * 2;
  eolW := Fonts.Default.height DIV 2;
  Texts.OpenWriter(W); Texts.OpenWriter(KW);
  BoxPat[0] := {0..11};
  BoxPat[1] := {0, 11}; BoxPat[2] := {0, 11}; BoxPat[3] := {0, 11}; BoxPat[4] := {0, 11};
  BoxPat[5] := {0, 11}; BoxPat[6] := {0, 11}; BoxPat[7] := {0, 11}; BoxPat[8] := {0, 11};
  BoxPat[9] := {0, 11}; BoxPat[10] := {0, 11}; BoxPat[11] := {0.. 11};
  NEW(box);
  box.dx := 12; box.x := 0; box.y := -3; box.w := 12; box.h := 12;
  box.pat := Display.NewPattern(12, 12, BoxPat)
END TextFrames.