home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon / system / xe.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-05-17  |  50.1 KB  |  1,090 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 17 May 95
  6. Syntax12i.Scn.Fnt
  7. FoldElems
  8. LineElems
  9. Alloc
  10. Syntax10b.Scn.Fnt
  11. Syntax10i.Scn.Fnt
  12. (* code for all Oberons without the object model (all except HP, DEC, SGI) *)
  13. MODULE XE;    (** SHML (ludwig@inf.ethz.ch) 10 Dec 90; 
  14.     (* eXtended Edit: Supports various enhancements over usual TextFrames.Handle for programmer's purposes *)
  15.     (* Declarations *)
  16.     IMPORT Modules, Display, Input, Files, Fonts, Texts, Viewers, Oberon, TextFrames, MenuViewers, FoldElems;
  17.     CONST
  18.         GetHandlerKey* = -210566;    (** secret number to get XE.Handle  **)
  19.         DefErrFile = "OberonErrors.Text"; ErrFont = "Syntax8.Scn.Fnt";
  20.         ML = 2; MM = 1; MR = 0;
  21.         WordBoundary = 0; NameBoundary = 1; FileNameBoundary = 2;    (* type for WordBounds checking *)
  22.         CtrlB = 2X; CtrlD = 4X; CtrlE = 5X; CtrlF = 6X; BS = 08X; LF = 0AX; CtrlK = 0BX; CR = 0DX; CtrlN = 0EX;
  23.         CtrlP = 10X; CtrlT = 14X; CtrlW = 17X; CtrlX = 18X; CtrlZ = 1AX;
  24.         UpArrow = 0C1X; DnArrow = 0C2X;
  25.         MaxPat = 32;
  26.         OptionChar1 = "/"; OptionChar2 = "\";    (* character used by host Oberon System for introducing options *)
  27.         Version = "XE  (SHML  23 Mar 95)";
  28.         XEMenu = "XE.Menu.Text"; EditMenu = "Edit.Menu.Text"; SystemMenu = "System.Menu.Text";
  29.         ConfigurationName = "XE.Configuration.Text";
  30.         KeyHandler = "EditKeys.GetKeyHandler";
  31.         DefComp = "Compiler.Compile";    (* default compiler command *)
  32.         DefOpenCmd = "Doc.Open"; DefOpenCmd1 = "XE.Open";    (* commands used by OpenCall *)
  33.         Empty0 = "Empty.Mod"; Empty1 = "Empty.Tool"; Empty3 = "Empty.c";    (* default empty files for Defaults *)
  34.         Ext00 = "Mod"; Ext01 = "Text"; Ext1 = "Tool"; Ext30 = "c"; Ext31 = "h";    (* default file extensions for Defaults *)
  35.         AsciiFont = "Courier10.Scn.Fnt";    (* used by OpenAscii for displaying ascii texts *)
  36.     TYPE
  37.         LongName = ARRAY 128 OF CHAR;
  38.         Name = ARRAY 32 OF CHAR;
  39.         Elem = POINTER TO ElemDesc;
  40.         ElemDesc = RECORD (Texts.ElemDesc)
  41.             err: INTEGER;
  42.             pos: LONGINT;
  43.             wide: BOOLEAN;
  44.             num: ARRAY 8 OF CHAR;
  45.             msg: LongName
  46.         END;
  47.         Element = POINTER TO ElementDesc;
  48.         ElementDesc = RECORD
  49.             compiler, ext: Name; errFile: LongName;
  50.             next: Element
  51.         END;
  52.         wr: Texts.Writer;
  53.         errT: Texts.Text; errFnt: Fonts.Font;
  54.         keyHandle: Display.Handler;
  55.         compiler, defComp, openCmd: Name;
  56.         empty: ARRAY 4 OF Name;
  57.         ext: ARRAY 4, 2 OF Name;
  58.         first: BOOLEAN; delay: LONGINT;
  59.         root: Element;
  60.         find: RECORD
  61.             len: SHORTINT;
  62.             buf: ARRAY MaxPat OF CHAR;
  63.             shiftTab: ARRAY 256 OF SHORTINT
  64.         END;
  65.     (* Support *)
  66.     PROCEDURE Str(s: ARRAY OF CHAR);    BEGIN Texts.WriteString(wr, s) END Str;
  67.     PROCEDURE Ch(ch: CHAR);    BEGIN Texts.Write(wr, ch) END Ch;
  68.     PROCEDURE Ln;    BEGIN Texts.WriteLn(wr); Texts.Append(Oberon.Log, wr.buf) END Ln;
  69.     PROCEDURE Extension(name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR);    (* get extension of name *)
  70.         VAR i, j: INTEGER;
  71.     BEGIN
  72.         i := -1;
  73.         REPEAT INC(i) UNTIL name[i] = 0X;
  74.         REPEAT DEC(i) UNTIL (name[i] = ".") OR (i = 0);
  75.         IF i = 0 THEN ext[0] := 0X
  76.         ELSE
  77.             j := -1;
  78.             REPEAT INC(i); INC(j); ext[j] := name[i] UNTIL name[i] = 0X
  79.         END
  80.     END Extension;
  81.     PROCEDURE Append(src: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);    (* append src to dest if no "." in src *)
  82.         VAR i, off: INTEGER;
  83.     BEGIN
  84.         off := -1;
  85.         REPEAT INC(off) UNTIL (dest[off] = 0X) OR (dest[off] = ".");
  86.         IF dest[off] # "." THEN
  87.             i := -1;
  88.             REPEAT INC(i); dest[i+off] := src[i] UNTIL src[i] = 0X END
  89.     END Append;
  90.     PROCEDURE SearchPair(ext: ARRAY OF CHAR; VAR prev: Element): Element;    
  91.         VAR l: Element;
  92.     BEGIN
  93.         l := root; prev := NIL;
  94.         WHILE (l # NIL) & (l.ext # ext) DO prev := l; l := l.next END;
  95.         RETURN l
  96.     END SearchPair;
  97.     PROCEDURE ScanFirst(VAR s: Texts.Scanner);    (* Scan first parameter *)
  98.         VAR sel: Texts.Text; beg, end, time: LONGINT;
  99.     BEGIN
  100.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  101.         IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN
  102.             Oberon.GetSelection(sel, beg, end, time);
  103.             IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
  104.         END
  105.     END ScanFirst;
  106.     PROCEDURE InstallKeyHandler;    
  107.         VAR save, par: Oberon.ParList; res: INTEGER;
  108.     BEGIN
  109.         save := Oberon.Par;
  110.         NEW(par); NEW(par.frame); par.frame.X := 0; par.frame.Y := 0; par.pos := -42;    (* magic *)
  111.         Oberon.Call(KeyHandler, par, FALSE, res);
  112.         IF res = 0 THEN keyHandle := Oberon.Par.frame.handle
  113.         ELSE keyHandle := NIL
  114.         END;
  115.         Oberon.Par := save; Modules.res := 0    (* bug in Modules? *)
  116.     END InstallKeyHandler;
  117.     PROCEDURE OpenText(VAR t: Texts.Text; VAR name: ARRAY OF CHAR;
  118.             s: Texts.Scanner; default, ext1, ext2: ARRAY OF CHAR);    
  119.         VAR extName: LongName; i, len: INTEGER;
  120.         PROCEDURE Extend(VAR str: ARRAY OF CHAR; with: ARRAY OF CHAR);    (* extend str with with *)
  121.             VAR ls, le: INTEGER;
  122.         BEGIN
  123.             ls := -1;
  124.             REPEAT INC(ls) UNTIL str[ls] = 0X;
  125.             le := -1;
  126.             REPEAT INC(le) UNTIL with[le] = 0X;
  127.             IF ls <= LEN(str)-(le+1) THEN
  128.                 INC(ls, le+1);
  129.                 REPEAT str[ls] := with[le]; DEC(ls); DEC(le) UNTIL le = -1;
  130.                 str[ls] := "."
  131.             END
  132.         END Extend;
  133.         PROCEDURE Try(): BOOLEAN;    (* try opening name with ext1 or ext2 appended to it *)
  134.         BEGIN
  135.             COPY(name, extName); Extend(extName, ext1); t := TextFrames.Text(extName);
  136.             IF t.len = 0 THEN COPY(name, extName); Extend(extName, ext2); t := TextFrames.Text(extName) END;
  137.             RETURN t.len > 0
  138.         END Try;
  139.     BEGIN
  140.         IF first THEN first := FALSE; Str(Version); Ln; InstallKeyHandler END;    (* write a startup message to the Log (once) *)
  141.         find.len := 0;
  142.         IF s.class = Texts.String THEN
  143.             t := TextFrames.Text(s.s);
  144.             name[0] := '"'; i := 0;
  145.             REPEAT INC(i); name[i] := s.s[i-1] UNTIL name[i] = 0X;
  146.             name[i] := '"'; name[i+1] := 0X
  147.         ELSIF s.class # Texts.Name THEN t := TextFrames.Text(default); COPY(default, name)
  148.         ELSE
  149.             COPY(s.s, name); t := TextFrames.Text(name);    (* use original name *)
  150.             IF t.len = 0 THEN    (* name doesn't exist *)
  151.                 IF Try() THEN COPY(extName, name)    (* use extended name *)
  152.                 ELSE
  153.                     len := s.len;
  154.                     REPEAT DEC(len) UNTIL (name[len] = ".") OR (len = 0);
  155.                     IF len # 0 THEN    (* name[len] = "." *)
  156.                         i := -1;    (* copy appended name to pattern for Edit.Show *)
  157.                         REPEAT INC(i); find.buf[i] := name[i+len+1] UNTIL find.buf[i] = 0X;
  158.                         find.len := SHORT(i);
  159.                         name[len] := 0X;    (* delete extension, try with trimmed name *)
  160.                         IF Try() THEN COPY(extName, name)    (* use extended name *)
  161.                         ELSE COPY(s.s, name)    (* use original name with empty text *)
  162.                         END
  163.                     END
  164.                 END
  165.             END
  166.         END
  167.     END OpenText;
  168.     PROCEDURE Show(f: TextFrames.Frame; pos: LONGINT);    
  169.         VAR end, delta: LONGINT;
  170.     BEGIN
  171.         delta := 200; end := TextFrames.Pos(f, f.X+f.W, f.Y);
  172.         WHILE ((f.org > pos) OR (pos >= end)) & (f.org # end) DO
  173.             TextFrames.Show(f, pos-delta); DEC(delta, 20);
  174.             end := TextFrames.Pos(f, f.X+f.W, f.Y)
  175.         END
  176.     END Show;
  177.     PROCEDURE GetOptions(VAR s: Texts.Scanner; VAR options: ARRAY OF CHAR);    
  178.         VAR pos: LONGINT; i: INTEGER; ch: CHAR; r: Texts.Reader;
  179.     BEGIN
  180.         IF (s.class # Texts.Char) OR (s.c # OptionChar1) & (s.c # OptionChar2) THEN options[0] := 0X
  181.         ELSE
  182.             pos := Texts.Pos(s);
  183.             options[0] := s.c; ch := s.nextCh; i := 1; r := s;
  184.             WHILE ((ch >= "0") & (ch <= "9") OR (ch >= "a") & (ch <= "z")) & (i < LEN(options)-1) DO
  185.                 options[i] := ch; INC(i); Texts.Read(r, ch)
  186.             END;
  187.             options[i] := 0X; pos := pos+(i-1);
  188.             WHILE Texts.Pos(s) < pos DO Texts.Scan(s) END; Texts.Scan(s)
  189.         END
  190.     END GetOptions;
  191.     PROCEDURE MenuFrame(name, menu: ARRAY OF CHAR; line: INTEGER): TextFrames.Frame;    
  192.         (* open XEMenu/EditMenu/SystemMenu and if existant get lineth textline (counting starts with 0) as menuline; (line >= 0, 100) *)
  193.         VAR
  194.             mf: TextFrames.Frame; buf: Texts.Buffer; t: Texts.Text;
  195.             r: Texts.Reader; start, end: LONGINT; ch: CHAR; menuFile: LongName;
  196.     BEGIN
  197.         ASSERT(line >= 0, 100);
  198.         IF Files.Old(XEMenu) # NIL THEN menuFile := XEMenu
  199.         ELSIF (line = 1) & (Files.Old(SystemMenu) # NIL) THEN menuFile := SystemMenu
  200.         ELSIF Files.Old(EditMenu) # NIL THEN menuFile := EditMenu
  201.         ELSE RETURN TextFrames.NewMenu(name, menu)
  202.         END;
  203.         NEW(t); Texts.Open(t, menuFile);
  204.         Texts.OpenReader(r, t, 0);
  205.         REPEAT    (* skip line lines *)
  206.             start := Texts.Pos(r);
  207.             REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = 0DX);
  208.             DEC(line)
  209.         UNTIL line = -1;
  210.         IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END;
  211.         IF start = end THEN RETURN TextFrames.NewMenu(name, menu)
  212.         ELSE
  213.             NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, start, end, buf);
  214.             mf := TextFrames.NewMenu(name, ""); Texts.Append(mf.text, buf);
  215.             RETURN mf
  216.         END
  217.     END MenuFrame;
  218.     PROCEDURE NoNotify(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
  219.     END NoNotify;
  220.     PROCEDURE BackRead(VAR r: Texts.Reader; t: Texts.Text; VAR ch: CHAR);    
  221.         VAR p: LONGINT;
  222.     BEGIN
  223.         p := Texts.Pos(r);
  224.         IF p > 0 THEN Texts.OpenReader(r, t, p-1); Texts.Read(r, ch); Texts.OpenReader(r, t, p-1)
  225.         ELSE ch := 0X
  226.         END
  227.     END BackRead;
  228.     PROCEDURE InWordSet(ch: CHAR): BOOLEAN;    
  229.     BEGIN
  230.         RETURN (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "Z")
  231.             OR ("a" <= ch) & (ch <= "z") OR (80X <= ch) & (ch <= 95X))
  232.     END InWordSet;
  233.     PROCEDURE InNameSet(ch: CHAR): BOOLEAN;    
  234.     BEGIN RETURN (ch = ".") OR InWordSet(ch)
  235.     END InNameSet;
  236.     PROCEDURE InFileNameSet(ch: CHAR): BOOLEAN;    
  237.     BEGIN
  238. RETURN InNameSet(ch) OR (ch = "/") OR (ch = "_")    (* Unix/Amiga Oberon *)
  239.     END InFileNameSet;
  240.     PROCEDURE PrepareFind;    (* prepare find.shiftTab according to current pattern *)
  241.         VAR i: INTEGER; m: SHORTINT;
  242.     BEGIN
  243.         m := find.len+1;
  244.         FOR i := 0 TO LEN(find.shiftTab)-1 DO find.shiftTab[i] := m END;    (* init all chars with length of pattern+1 *)
  245.         DEC(m);
  246.         FOR i := 0 TO find.len-1 DO
  247.             find.shiftTab[ORD(find.buf[i])] := m;
  248.             DEC(m)
  249.         END
  250.     END PrepareFind;
  251.     PROCEDURE Find(t: Texts.Text; beg: LONGINT; VAR end: LONGINT);    (*<< Quicksearch algorithm, D.M. Sunday *)
  252.         VAR r: Texts.Reader; i: INTEGER; found: BOOLEAN; ch: CHAR;
  253.     BEGIN
  254.         found := FALSE;
  255.         REPEAT
  256.             Texts.OpenReader(r, t, beg); Texts.Read(r, ch); i := 0;
  257.             WHILE ~r.eot & (i < find.len) & (ch = find.buf[i]) DO Texts.Read(r, ch); INC(i) END;
  258.             IF ~r.eot & (i < find.len) THEN
  259.                 Texts.OpenReader(r, t, beg+find.len); Texts.Read(r, ch);
  260.                 beg := beg+find.shiftTab[ORD(ch)]
  261.             ELSE found := TRUE
  262.             END
  263.         UNTIL found;
  264.         IF i = find.len THEN end := beg+find.len ELSE end := -1 END
  265.     END Find;
  266.     PROCEDURE SearchIdent(f: TextFrames.Frame; t: Texts.Text);    
  267.         VAR pos, dec, start: LONGINT; r: Texts.Reader; ch: CHAR;
  268.     BEGIN
  269.         IF find.len > 0 THEN    (* simulate Edit.Show *)
  270.             dec := 1;
  271.             find.buf[find.len] := "*"; INC(find.len); find.buf[find.len] := 0X;    (* search for name* *)
  272.             PrepareFind; Find(t, 0, pos);
  273.             IF pos = -1 THEN    (* not found *)
  274.                 find.buf[find.len-1] := "-"; PrepareFind; Find(t, 0, pos);    (* search for name- *)
  275.                 IF pos = -1 THEN    (* not found *)
  276.                     DEC(find.len); find.buf[find.len] := 0X; start := 0; dec := 0;    (* search for name *)
  277.                     PrepareFind;
  278.                     REPEAT
  279.                         Find(t, start, pos);
  280.                         IF pos > 0 THEN    (* something found, check if it's an identifier. If not, search again *)
  281.                             Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  282.                             IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "Z") OR ("a" <= ch) & (ch <= "z") THEN
  283.                                 start := pos
  284.                             ELSE start := -1
  285.                             END
  286.                         ELSE start := -1
  287.                         END
  288.                     UNTIL start = -1;
  289.                     (*DEC(find.len); find.buf[find.len] := 0X; Find(t, 0, pos); dec := 0*)
  290.                 END
  291.             END;
  292.             IF pos > 0 THEN
  293.                 pos := pos-find.len;
  294.                 TextFrames.Show(f, pos); TextFrames.SetSelection(f, pos, pos+find.len-dec);
  295.                 Oberon.PassFocus(Viewers.This(f.X, f.Y)); TextFrames.SetCaret(f, pos+find.len-dec)
  296.             END
  297.         END
  298.     END SearchIdent;
  299.     PROCEDURE WordBounds(t: Texts.Text; VAR beg, end: LONGINT; type: INTEGER);    
  300.         VAR r: Texts.Reader; ch: CHAR; word, name, fileName: BOOLEAN;
  301.     BEGIN
  302.         word := type = WordBoundary;
  303.         name := type = NameBoundary;
  304.         fileName := type = FileNameBoundary;
  305.         Texts.OpenReader(r, t, beg);
  306.         REPEAT Texts.Read(r, ch)
  307.         UNTIL r.eot OR word & ~InWordSet(ch) OR name & ~InNameSet(ch) OR fileName & ~InFileNameSet(ch);
  308.         IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END;
  309.         Texts.OpenReader(r, t, beg);
  310.         REPEAT BackRead(r, t, ch)
  311.         UNTIL word & ~InWordSet(ch) OR name & ~InNameSet(ch) OR fileName & ~InFileNameSet(ch);
  312.         IF ch = 0X THEN beg := 0 ELSE beg := Texts.Pos(r)+1 END
  313.     END WordBounds;
  314.     PROCEDURE EndOfLine(f: TextFrames.Frame; VAR loc: TextFrames.Location; org: LONGINT; VAR end: LONGINT);
  315.     BEGIN
  316.         WHILE (end < f.text.len) & (loc.org <= org) DO INC(end, 30); TextFrames.LocatePos(f, end, loc) END;
  317.         IF (end >= f.text.len) & (loc.org <= org) THEN end := f.text.len
  318.         ELSE WHILE loc.org > org DO end := loc.org; TextFrames.LocatePos(f, end-1, loc) END
  319.         END
  320.     END EndOfLine;
  321.     PROCEDURE TrackSelection(f: TextFrames.Frame; VAR x, y: INTEGER; VAR keysum: SET);    
  322.         VAR
  323.             keys: SET;
  324.             beg, end, begW, endW, begN, endN, pos: LONGINT; loc, loc1: TextFrames.Location;
  325.             v: Viewers.Viewer; upper: TextFrames.Frame;
  326.             r: Texts.Reader; ch: CHAR;
  327.     BEGIN
  328.         v := Viewers.This(f.X, f.Y); v := v.next(Viewers.Viewer);
  329.         IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  330.             upper := v.dsc.next(TextFrames.Frame);
  331.             IF upper.hasSel & (upper.text = f.text) THEN
  332.                 TextFrames.LocateLine(upper, upper.bot, loc);
  333.                 IF (upper.selbeg.pos < loc.org) & (upper.org < upper.selend.pos)
  334.                         & (upper.selbeg.pos <= TextFrames.Pos(f, x, y)) THEN
  335.                     TextFrames.SetSelection(f, upper.selbeg.pos, TextFrames.Pos(f, x, y)+1)
  336.                 ELSE TextFrames.RemoveSelection(upper); upper := NIL
  337.                 END
  338.             ELSE upper := NIL
  339.             END
  340.         ELSE upper := NIL
  341.         END;
  342.         IF upper = NIL THEN
  343.             pos := TextFrames.Pos(f, x, y);
  344.             IF f.hasSel & (Oberon.Time() < f.time+delay) THEN
  345.                 beg := f.selbeg.pos; end := f.selend.pos;
  346.                 IF (beg+1 = end) & (pos = beg) THEN    (* one char selected, mouse on same character *)
  347.                     TextFrames.LocatePos(f, beg, loc); TextFrames.LocatePos(f, end, loc1);
  348.                     Texts.OpenReader(r, f.text, beg); Texts.Read(r, ch);
  349.                     IF (end = f.text.len) OR (loc.org # loc1.org) OR ~InNameSet(ch) THEN    (* extend to whole line *)
  350.                         EndOfLine(f, loc1, loc.org, end);
  351.                         TextFrames.SetSelection(f, loc.org, end)
  352.                     ELSE    (* (end # f.text.len) & (loc.org = loc1.org) & InNameSet(ch) *)
  353.                         begW := pos; endW := pos+1;
  354.                         IF ch = "." THEN WordBounds(f.text, begW, endW, NameBoundary)
  355.                         ELSE WordBounds(f.text, begW, endW, WordBoundary)
  356.                         END;
  357.                         begN := pos; endN := pos+1; WordBounds(f.text, begN, endN, NameBoundary);
  358.                         IF (begW = beg) & (endW = end) THEN
  359.                             IF (begN = beg) & (endN = end) THEN
  360.                                 (* single char InNameSet -> select line *)
  361.                                 EndOfLine(f, loc1, loc.org, end);
  362.                                 TextFrames.SetSelection(f, loc.org, end)
  363.                             ELSE TextFrames.SetSelection(f, begN, endN)    (* name *)
  364.                             END
  365.                         ELSE TextFrames.SetSelection(f, begW, endW)    (* word *)
  366.                         END
  367.                     END
  368.                 ELSIF (beg <= pos) & (pos < end) THEN    (* mouse within selection *)
  369.                     TextFrames.LocatePos(f, beg, loc); TextFrames.LocatePos(f, end-1, loc1);
  370.                     IF loc.org = loc1.org THEN    (* selection is at most one line *)
  371.                         begW := pos; endW := pos+1; WordBounds(f.text, begW, endW, WordBoundary);
  372.                         begN := pos; endN := pos+1; WordBounds(f.text, begN, endN, NameBoundary);
  373.                         IF (begW = beg) & (endW = end) & ((begN < beg) OR (end < endN)) THEN
  374.                             (* word selected -> extend to name *)
  375.                             TextFrames.SetSelection(f, begN, endN)
  376.                         ELSE    (* name selected -> extend to line *)
  377.                             endN := loc1.pos; EndOfLine(f, loc1, loc.org, endN);
  378.                             IF (loc.org # beg) OR (endN # end) THEN TextFrames.SetSelection(f, loc.org, endN)
  379.                             ELSE TextFrames.SetSelection(f, pos, pos+1)    (*  select single char *)
  380.                             END
  381.                         END
  382.                     ELSE TextFrames.SetSelection(f, pos, pos+1)    (* not same line -> select single char *)
  383.                     END
  384.                 ELSE TextFrames.SetSelection(f, pos, pos+1)    (* not within selection -> select single char *)
  385.                 END
  386.             ELSE TextFrames.SetSelection(f, pos, pos+1)    (* no selection or time out -> select single char *)
  387.             END;    (* f.hasSel & ... *)
  388.             end := f.selend.pos
  389.         ELSE end := upper.selbeg.pos
  390.         END;    (* upper = NIL *)
  391.         REPEAT
  392.             Input.Mouse(keys, x, y); keysum := keysum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  393.             pos := TextFrames.Pos(f, x, y)+1;
  394.             IF f.hasSel THEN
  395.                 IF pos >= end THEN TextFrames.SetSelection(f, f.selbeg.pos, pos);
  396.                     IF upper # NIL THEN
  397.                         TextFrames.SetSelection(upper, upper.selbeg.pos, pos); upper.selend.pos := f.selend.pos
  398.                     END
  399.                 END
  400.             ELSE TextFrames.SetSelection(f, TextFrames.Pos(f, x, y), TextFrames.Pos(f, x, y)+1)
  401.             END
  402.         UNTIL keys = {};
  403.         IF upper # NIL THEN f.selbeg.pos := upper.selbeg.pos END
  404.     END TrackSelection;
  405.     PROCEDURE CaretVisible(f: TextFrames.Frame; pos: LONGINT): BOOLEAN;    
  406.     BEGIN RETURN f.hasCar & (f.carloc.y >= f.bot) & (f.carloc.pos = pos)
  407.     END CaretVisible;
  408.     PROCEDURE MoveTextStretch(from: Texts.Text; to: TextFrames.Frame; beg, end, pos: LONGINT);    
  409.         VAR len: LONGINT;
  410.     BEGIN
  411.         (* only if other text or target pos not within selection *)
  412.         IF ((from # to.text) OR (pos < beg) OR (end < pos)) THEN
  413.             len := end-beg;
  414.             IF (from = to.text) & (end < pos) THEN DEC(pos, len) END;    (* dec caret pos by length of sel *)
  415.             Texts.Save(from, beg, end, wr.buf); Texts.Delete(from, beg, end); Texts.Insert(to.text, pos, wr.buf);
  416.             TextFrames.SetCaret(to, pos+len);
  417.             IF CaretVisible(to, pos+len) THEN TextFrames.SetSelection(to, pos, pos+len) END
  418.         END
  419.     END MoveTextStretch;
  420.     PROCEDURE MoveSelection(f: TextFrames.Frame; x, y: INTEGER; keySum: SET; VAR done: BOOLEAN);    
  421.         VAR keys: SET; v: Viewers.Viewer; target: TextFrames.Frame; time: LONGINT; oldX, oldY: INTEGER;
  422.     BEGIN
  423.         time := Oberon.Time(); oldX := x; oldY := y;
  424.         REPEAT Input.Mouse(keys, x, y); keySum := keySum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  425.         UNTIL (keys = {}) OR (keySum # {MM})
  426.             OR (ABS(oldX-x) < 3) & (ABS(oldY-y) < 3) & (Oberon.Time() > time+delay DIV 2);
  427.         IF (keys # {}) & (keySum = {MM, ML}) THEN
  428.             v := Viewers.This(x, y);
  429.             IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  430.                 target := v.dsc.next(TextFrames.Frame);
  431.                 Oberon.PassFocus(v); TextFrames.TrackCaret(target, x, y, keySum);
  432.                 IF keySum = {MM, ML} THEN
  433.                     MoveTextStretch(f.text, target, f.selbeg.pos, f.selend.pos, target.carloc.pos)
  434.                 END
  435.             END;
  436.             done := TRUE
  437.         ELSE done := FALSE
  438.         END
  439.     END MoveSelection;
  440.     PROCEDURE OpenCall(f: TextFrames.Frame; x, y: INTEGER; pos: LONGINT);    
  441.         VAR s: Texts.Scanner; par: Oberon.ParList; loc: TextFrames.Location; beg, end, newPos: LONGINT; res: INTEGER;
  442.     BEGIN
  443.         TextFrames.LocateChar(f, x, y, loc); newPos := loc.pos;
  444.         REPEAT beg := newPos; WordBounds(f.text, beg, end, FileNameBoundary); DEC(newPos)
  445.         UNTIL (beg < end) OR (newPos < pos);
  446.         IF beg < end THEN
  447.             Texts.OpenScanner(s, f.text, beg); Texts.Scan(s);
  448.             IF (s.line = 0) & (s.class = Texts.Name) THEN
  449.                 NEW(par); par.frame := f; par.text := f.text; par.pos := beg;
  450.                 Oberon.Call(openCmd, par, FALSE, res);
  451.                 IF res # 0 THEN Oberon.Call(DefOpenCmd1, par, FALSE, res) END
  452.             END
  453.         END
  454.     END OpenCall;
  455.     PROCEDURE HandleCall(f: TextFrames.Frame; pos: LONGINT; new: BOOLEAN);    
  456.         VAR s: Texts.Scanner; par: Oberon.ParList; res, i, j: INTEGER;
  457.     BEGIN
  458.         Texts.OpenScanner(s, f.text, pos); Texts.Scan(s);
  459.         IF (s.class = Texts.Name) & (s.line = 0) THEN
  460.             i := -1;
  461.             REPEAT INC(i) UNTIL (i = s.len) OR (s.s[i] = ".");
  462.             j := i;
  463.             REPEAT INC(j) UNTIL (j >= s.len) OR (s.s[j] = ".");
  464.             IF (j >= s.len) & (s.s[i] = ".") THEN
  465.                 NEW(par); par.frame := f; par.text := f.text; par.pos := pos+s.len;
  466.                 Oberon.Call(s.s, par, new, res);
  467. (* delete this fold, if you have the object model (HP, DEC, SGI) *)
  468.                 IF res > 0 THEN    (* not-object model error messages *)
  469.                     IF res = 1 THEN Str(Modules.importing); Str(" not found")
  470.                     ELSIF res = 2 THEN Str(Modules.importing); Str(" not an obj-file")
  471.                     ELSIF res = 3 THEN Str(Modules.importing); Str(" imports "); Str(Modules.imported); Str(" with bad key")
  472.                     ELSIF res = 4 THEN Str(Modules.importing); Str(" corrupted obj file")
  473.                     ELSIF res = 5 THEN Str(s.s); Str(" command not found")
  474.                     ELSIF res = 6 THEN Str(Modules.importing); Str(" has too many imports")
  475.                     ELSIF res = 7 THEN Str(Modules.importing); Str(" not enough space")
  476.                     END;
  477.                     Ln
  478.                 ELSIF res < 0 THEN
  479.                     INC(i);
  480.                     WHILE i # s.len DO Ch(s.s[i]); INC(i) END;
  481.                     Str(" not found"); Ln
  482.                 END
  483.             END
  484.         END
  485.     END HandleCall;
  486.     (* Error Element *)
  487.     PROCEDURE ElemWidth(e: Elem): INTEGER;    
  488.         VAR pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER; str: LongName;
  489.     BEGIN
  490.         i := 0; px := 0;
  491.         IF e.wide THEN COPY(e.msg, str) ELSE COPY(e.num, str) END;
  492.         WHILE str[i] # 0X DO
  493.             Display.GetChar(errFnt.raster, str[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
  494.         END;
  495.         RETURN px+6
  496.     END ElemWidth;
  497.     PROCEDURE UpdateErr(e: Elem);    
  498.         VAR t: Texts.Text;
  499.     BEGIN    (* precondition: e.pos is correct *)
  500.         t := Texts.ElemBase(e); t.notify(t, Texts.replace, e.pos, e.pos+1)
  501.     END UpdateErr;
  502.     PROCEDURE ShowErrMsg(e: Elem; col: SHORTINT; x0, y0, dw: INTEGER);    
  503.         VAR
  504.             pat: Display.Pattern; i, px, rm, dx, x, y, w, h: INTEGER;
  505.             ch: CHAR; str: LongName;
  506.     BEGIN
  507.         IF e.wide THEN COPY(e.msg, str) ELSE COPY(e.num, str) END;
  508.         i := 0; px := x0+3; rm := x0+dw-3; INC(y0, 2);
  509.         LOOP
  510.             ch := str[i]; INC(i);
  511.             IF ch = 0X THEN EXIT END;
  512.             Display.GetChar(errFnt.raster, ch, dx, x, y, w, h, pat);
  513.             IF px+dx > rm THEN EXIT END;
  514.             Display.CopyPattern(col, pat, px+x, y0+y, Display.invert); INC(px, dx)
  515.         END
  516.     END ShowErrMsg;
  517.     PROCEDURE DeleteErrElems(t: Texts.Text);    
  518.         VAR r: Texts.Reader; pos: LONGINT;
  519.     BEGIN
  520.         Texts.OpenReader(r, t, 0); Texts.ReadElem(r);
  521.         WHILE r.elem # NIL DO
  522.             IF r.elem IS Elem THEN pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos) END;
  523.             Texts.ReadElem(r)
  524.         END
  525.     END DeleteErrElems;
  526.     PROCEDURE ElemHandle(e: Texts.Elem; VAR msg: Texts.ElemMsg);    
  527.         VAR copy: Elem; w, h: INTEGER; keys, keySum: SET;
  528.         PROCEDURE Expand(el: Elem);    
  529.             VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
  530.         BEGIN
  531.             IF el.msg[0] = 0X THEN
  532.                 Texts.OpenScanner(s, errT, 0);
  533.                 REPEAT
  534.                     s.line := 0;
  535.                     REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0)
  536.                 UNTIL s.eot OR (s.class = Texts.Int) & (s.i = el.err);
  537.                 IF ~s.eot THEN
  538.                     Texts.Read(s, ch); n := 0;
  539.                     WHILE ~s.eot & (ch # CR) & (n+1 < LEN(el.msg)) DO el.msg[n] := ch; INC(n); Texts.Read(s, ch) END;
  540.                     el.msg[n] := 0X
  541.                 END
  542.             END;
  543.             el.wide := TRUE;
  544.             el.W := LONG(ElemWidth(el))*TextFrames.Unit
  545.         END Expand;
  546.     BEGIN
  547.         WITH e: Elem DO
  548.             WITH msg: TextFrames.DisplayMsg DO
  549.                 IF ~msg.prepare THEN
  550.                     w := SHORT(e.W DIV TextFrames.Unit); h := SHORT(e.H DIV TextFrames.Unit);
  551.                     Display.ReplConst(Display.white, msg.X0+1, msg.Y0+2, w-2, h, Display.replace);
  552.                     ShowErrMsg(e, msg.col, msg.X0, msg.Y0+2, w)
  553.                 END
  554.             | msg: TextFrames.TrackMsg DO    (* a mouse click hit the element *)
  555.                 IF msg.keys = {MM} THEN
  556.                     w := SHORT(e.W DIV TextFrames.Unit); h := SHORT(e.H DIV TextFrames.Unit);
  557.                     Oberon.RemoveMarks(msg.X0, msg.Y0, w, h);
  558.                     Display.ReplConst(Display.white, msg.X0+2, msg.Y0+3, w-4, h-2, Display.invert);
  559.                     keySum := msg.keys;
  560.                     REPEAT
  561.                         Input.Mouse(keys, msg.X, msg.Y); keySum := keySum+keys;
  562.                         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y)
  563.                     UNTIL keys = {};
  564.                     Display.ReplConst(Display.white, msg.X0+2, msg.Y0+3, w-4, h-2, Display.invert);
  565.                     e.pos := msg.pos;
  566.                     IF keySum = {MM} THEN    (* expand/reduce element *)
  567.                         IF ~e.wide THEN Expand(e)
  568.                         ELSE e.wide := FALSE; e.W := LONG(ElemWidth(e))*TextFrames.Unit
  569.                         END;
  570.                         UpdateErr(e)
  571.                     END;
  572.                     msg.keys := {}
  573.                 END
  574.             | msg: Texts.CopyMsg  DO    (* copy element *)
  575.                 NEW(copy); Texts.CopyElem(e, copy); copy.err := e.err; copy.pos := e.pos; copy.wide := e.wide;
  576.                 copy.num := e.num; copy.msg := e.msg; msg.e := copy
  577.             ELSE
  578.             END
  579.         END
  580.     END ElemHandle;
  581.     PROCEDURE InsertErrAt(t: Texts.Text; pos: LONGINT; err: INTEGER);    
  582.         VAR e: Elem; h: ARRAY 8 OF CHAR; j, k: INTEGER;
  583.     BEGIN
  584.         NEW(e); e.H := 3*TextFrames.mm; e.handle := ElemHandle;
  585.         e.err := err; e.msg := ""; e.wide := FALSE;
  586.         k := 0;
  587.         REPEAT h[k] := CHR(err MOD 10 + ORD("0")); err := err DIV 10; INC(k) UNTIL err = 0;
  588.         j := 0;
  589.         REPEAT DEC(k); e.num[j] := h[k]; INC(j) UNTIL k = 0;
  590.         e.num[j] := 0X;
  591.         e.W := LONG(ElemWidth(e))*TextFrames.Unit;
  592.         Texts.WriteElem(wr, e); Texts.Insert(t, pos, wr.buf)
  593.     END InsertErrAt;
  594.     PROCEDURE MarkErrors(f: TextFrames.Frame; t: Texts.Text; beg: LONGINT);    
  595.         VAR s: Texts.Scanner; pos, delta: LONGINT; err: INTEGER; log: Texts.Text; error: BOOLEAN;
  596.     BEGIN
  597.         DeleteErrElems(f.text);
  598.         log := Oberon.Log; pos := log.len;
  599.         Texts.OpenScanner(s, log, beg);
  600.         REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Name) & (s.s = "pos");
  601.         IF (s.class = Texts.Name) & (s.s = "pos") THEN
  602.             delta := 0;
  603.             LOOP
  604.                 s.line := 0;
  605.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0) OR (s.class = Texts.Int);
  606.                 IF s.eot OR (s.line # 0) THEN EXIT END;
  607.                 pos := s.i;
  608.                 Texts.Scan(s); error := (s.s = "err") OR (s.s = "pc");
  609.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0) OR (s.class = Texts.Int);
  610.                 IF s.eot OR (s.line # 0) THEN EXIT END;
  611.                 err := SHORT(s.i);
  612.                 (* display errors, but warnings only if it's the Analyzer *)
  613.                 IF error OR (compiler = "Analyzer.Analyze") THEN InsertErrAt(t, pos+delta, err); INC(delta) END;
  614.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0)
  615.             END
  616.         END
  617.     END MarkErrors;
  618.     PROCEDURE ErrCheck(e: Texts.Elem): BOOLEAN;    
  619.     BEGIN RETURN e IS Elem
  620.     END ErrCheck;
  621.     (** Handler **)
  622.     PROCEDURE Handle*(f: Display.Frame; VAR msg: Display.FrameMsg);    
  623.         VAR
  624.             tf, ff: TextFrames.Frame;
  625.             t, sel: Texts.Text; loc: TextFrames.Location; copyOver: Oberon.CopyOverMsg;
  626.             r: Texts.Reader; handled, done: BOOLEAN; ch: CHAR; x, y: INTEGER;
  627.             pos, beg, end, len, time: LONGINT; keySum: SET;
  628.             loc2:TextFrames.Location;
  629.         PROCEDURE PartialFolds(text: Texts.Text; b, e: LONGINT): BOOLEAN;
  630.             CONST leftMode = {FoldElems.colLeft, FoldElems.expLeft, FoldElems.tempLeft, FoldElems.findLeft};
  631.             VAR level: INTEGER;
  632.         BEGIN
  633.             level := 0; Texts.OpenReader(r, text, b); Texts.ReadElem(r);
  634.             WHILE (r.elem # NIL) & (Texts.Pos(r) <= e) DO
  635.                 IF r.elem IS FoldElems.Elem THEN
  636.                     IF r.elem(FoldElems.Elem).mode IN leftMode THEN INC(level) ELSE DEC(level) END
  637.                 END;
  638.                 Texts.ReadElem(r)
  639.             END;
  640.             RETURN level # 0
  641.         END PartialFolds;
  642.         PROCEDURE ThisSubFrame(x, y: INTEGER): Display.Frame;
  643.             VAR sf: Display.Frame;
  644.         BEGIN
  645.             sf := f.dsc;
  646.             WHILE (sf # NIL) & ((x < sf.X) OR (x >= sf.X+sf.W) OR (y < sf.Y) OR (y >= sf.Y+sf.H)) DO sf := sf.next END;
  647.             RETURN sf
  648.         END ThisSubFrame;
  649.     BEGIN
  650.         tf := f(TextFrames.Frame);
  651.         IF keyHandle # NIL THEN keyHandle(tf, msg) END;
  652.         t := tf.text; handled := TRUE;
  653.         WITH msg: Oberon.InputMsg DO
  654.             IF (msg.id = Oberon.track) & (msg.X >= tf.X+tf.barW) & (ThisSubFrame(msg.X, msg.Y) = NIL) THEN
  655.                 IF ML IN msg.keys THEN
  656.                     Oberon.PassFocus(Viewers.This(tf.X, tf.Y)); TextFrames.TrackCaret(tf, x, y, keySum);
  657.                     IF (keySum = {ML, MM}) & tf.hasCar THEN
  658.                         Oberon.GetSelection(sel, beg, end, time);
  659.                         IF time >= 0 THEN
  660.                             Texts.Save(sel, beg, end, wr.buf); len := end-beg; pos := tf.carloc.pos;
  661.                             Texts.Insert(tf.text, pos, wr.buf); TextFrames.SetCaret(tf, pos+len);
  662.                             IF CaretVisible(tf, pos+len) THEN TextFrames.SetSelection(tf, pos, pos+len) END
  663.                         END
  664.                     ELSIF (keySum = {ML, MR}) & tf.hasCar & (tf.carloc.pos < tf.text.len) THEN
  665.                         Oberon.GetSelection(sel, beg, end, time);
  666.                         IF time >= 0 THEN
  667.                             Texts.OpenReader(r, tf.text, tf.carloc.pos); Texts.Read(r, ch);
  668.                             Texts.ChangeLooks(sel, beg, end, {0, 1, 2}, r.fnt, r.col, r.voff)
  669.                         END
  670.                     END
  671.                 ELSIF MM IN msg.keys THEN
  672.                     x := msg.X; y := msg.Y; pos := TextFrames.Pos(tf, x, y);
  673.                     IF tf.hasSel & (tf.selbeg.pos <= pos) & (pos < tf.selend.pos) THEN MoveSelection(tf, x, y, msg.keys, done)
  674.                     ELSE done := FALSE
  675.                     END;
  676.                     IF ~done THEN
  677.                         Texts.OpenReader(r, t, pos); Texts.ReadElem(r);
  678.                         IF (r.elem = NIL) OR (Texts.Pos(r) # pos+1) THEN    (* no elem at this position *)
  679.                             TextFrames.TrackWord(tf, x, y, pos, keySum); keySum := keySum+msg.keys;
  680.                             IF (keySum = {MM}) OR (keySum = {MM, ML}) THEN HandleCall(tf, pos, keySum = {MM, ML})
  681.                             ELSIF keySum = {MM, MR} THEN OpenCall(tf, x, y, pos)
  682.                             END
  683.                         ELSE handled := FALSE
  684.                         END
  685.                     END
  686.                 ELSIF MR IN msg.keys THEN
  687.                     TrackSelection(tf, msg.X, msg.Y, msg.keys);
  688.                     IF (msg.keys = {MM, MR}) & tf.hasSel & ~PartialFolds(tf.text, tf.selbeg.pos, tf.selend.pos) THEN
  689.                         copyOver.text := tf.text; copyOver.beg := tf.selbeg.pos; copyOver.end := tf.selend.pos;
  690.                         len := copyOver.end-copyOver.beg;
  691.                         IF (Oberon.FocusViewer IS MenuViewers.Viewer) & (Oberon.FocusViewer.dsc.next # NIL)
  692.                                 & (Oberon.FocusViewer(MenuViewers.Viewer).dsc.next IS TextFrames.Frame) THEN
  693.                             ff := Oberon.FocusViewer.dsc.next(TextFrames.Frame); pos := ff.carloc.pos
  694.                         ELSE ff := NIL
  695.                         END;
  696.                         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyOver);
  697.                         IF (ff # NIL) & CaretVisible(ff, pos+len) THEN TextFrames.SetSelection(ff, pos, pos+len) END
  698.                     ELSIF (msg.keys = {ML, MR}) & tf.hasSel & ~PartialFolds(tf.text, tf.selbeg.pos, tf.selend.pos) THEN
  699.                         Oberon.PassFocus(Viewers.This(tf.X, tf.Y));
  700.                         Texts.Delete(tf.text, tf.selbeg.pos, tf.selend.pos); TextFrames.SetCaret(tf, tf.selbeg.pos)
  701.                     END
  702.                 ELSE handled := FALSE
  703.                 END
  704.             ELSIF (msg.id = Oberon.consume) & tf.hasCar THEN
  705.                 loc := tf.carloc; pos := loc.pos;
  706.                 CASE msg.ch OF
  707.                 | CR: msg.ch := LF; handled := FALSE    (* switch CR <-> LF *)
  708.                 | LF: msg.ch := CR; handled := FALSE
  709.                 | BS, CtrlD: IF pos < t.len THEN Texts.Delete(t, pos, pos+1); TextFrames.SetCaret(tf, pos) END
  710.                 | (*DnArrow, *) CtrlN: msg.ch := DnArrow; handled := FALSE
  711.                 (*    TextFrames.LocatePos(tf,t.len,loc2);
  712.                     LOOP
  713.                         y:=loc.y+1;
  714.                         REPEAT
  715.                             DEC(y); pos := TextFrames.Pos(tf, loc.x+1, y);
  716.                         UNTIL (pos # loc.pos) OR (pos >= t.len) OR (y <= tf.Y+tf.bot);
  717.                         IF pos#loc.pos THEN    (* position found. *)
  718.                             TextFrames.SetCaret(tf, pos);                    
  719.                             EXIT;                
  720.                         ELSIF (pos>=t.len) OR (y<=loc2.y) THEN    (* last line, no chance of finding one. *)
  721.                             EXIT;
  722.                         END;
  723.                         y:=tf.Y+tf.H;
  724.                         REPEAT
  725.                             DEC(y); TextFrames.LocateLine(tf,y,loc);
  726.                         UNTIL loc.org#tf.org;
  727.                         TextFrames.Show(tf,loc.org);
  728.                         TextFrames.LocatePos(tf,tf.carloc.pos,loc);
  729.                     END;
  730.                 *)
  731.                 | (*UpArrow,*) CtrlP: msg.ch := UpArrow; handled := FALSE
  732.                 (*    IF loc.org = tf.org THEN    (* top of frame *)
  733.                         IF tf.org > 0 THEN
  734.                             pos := tf.org-1; TextFrames.Show(tf, pos);
  735.                             TextFrames.SetCaret(tf, TextFrames.Pos(tf, loc.x+1, tf.Y+tf.H))
  736.                         END
  737.                     ELSE    (* not at top *)
  738.                         y := loc.y+loc.dy;
  739.                         REPEAT pos := TextFrames.Pos(tf, loc.x+1, y); INC(y)
  740.                         UNTIL (pos # loc.pos) OR (y >= tf.Y+tf.H);
  741.                         TextFrames.SetCaret(tf, pos)
  742.                     END
  743.                     *)
  744.                 | CtrlT:
  745.                     IF pos > 1 THEN    (* exchange this with previous char *)
  746.                         Texts.Save(t, pos-2, pos-1, wr.buf);
  747.                         Texts.Delete(t, pos-2, pos-1); Texts.Insert(t, pos-1, wr.buf);
  748.                         TextFrames.SetCaret(tf, pos)
  749.                     END
  750.                 | CtrlF:
  751.                     IF pos < t.len THEN    (* move one word forward *)
  752.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  753.                         WHILE ~r.eot & (ch <= " ") & (ch # Texts.ElemChar) DO Texts.Read(r, ch) END;
  754.                         IF r.eot THEN pos := t.len
  755.                         ELSE
  756.                             IF ~InWordSet(ch) THEN pos := Texts.Pos(r)
  757.                             ELSE
  758.                                 REPEAT Texts.Read(r, ch) UNTIL r.eot OR ~InWordSet(ch);
  759.                                 IF r.eot THEN pos := t.len ELSE pos := Texts.Pos(r)-1 END;
  760.                                 TextFrames.LocatePos(tf, pos, loc);
  761.                                 IF loc.y <= tf.Y THEN TextFrames.Show(tf, pos) END;    (* at bottom of f *)
  762.                             END
  763.                         END;
  764.                         TextFrames.SetCaret(tf, pos)
  765.                     END
  766.                 | CtrlB:
  767.                     IF pos > 0 THEN    (* move one word backward *)
  768.                         Texts.OpenReader(r, t, pos);
  769.                         REPEAT BackRead(r, t, ch) UNTIL (Texts.Pos(r) = 0) OR (ch > " ") OR (ch = Texts.ElemChar);
  770.                         IF Texts.Pos(r) = 0 THEN pos := 0
  771.                         ELSE
  772.                             IF ~InWordSet(ch) THEN pos := Texts.Pos(r)
  773.                             ELSE
  774.                                 REPEAT BackRead(r, t, ch) UNTIL (Texts.Pos(r) = 0) OR ~InWordSet(ch);
  775.                                 IF Texts.Pos(r) = 0 THEN pos := 0 ELSE pos := Texts.Pos(r)+1 END
  776.                             END
  777.                         END;
  778.                         IF pos < tf.org THEN TextFrames.Show(tf, pos) END;
  779.                         TextFrames.SetCaret(tf, pos)
  780.                     END
  781.                 | CtrlE:
  782.                     IF pos < t.len THEN    (* move to end of (next) line *)
  783.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  784.                         IF ~r.eot & (ch = CR) THEN Texts.Read(r, ch) END;
  785.                         WHILE ~r.eot & (ch # CR) DO Texts.Read(r, ch) END;
  786.                         IF r.eot THEN TextFrames.SetCaret(tf, t.len) ELSE TextFrames.SetCaret(tf, Texts.Pos(r)-1) END
  787.                     END
  788.                 | CtrlW:
  789.                     IF pos > 0 THEN    (* move to beginning of (previous) line *)
  790.                         IF pos = loc.org THEN TextFrames.LocatePos(tf, pos-1, loc) END;
  791.                         TextFrames.SetCaret(tf, loc.org)
  792.                     END
  793.                 | CtrlK:    (* delete to end of line *)
  794.                     Texts.OpenReader(r, t, pos);
  795.                     REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = CR);
  796.                     IF Texts.Pos(r) = pos+1 THEN Texts.Delete(t, pos, pos+1) ELSE Texts.Delete(t, pos, Texts.Pos(r)-1) END;
  797.                     TextFrames.SetCaret(tf, pos)
  798.                 | CtrlX:    (* move selection to caret position *)
  799.                     Oberon.GetSelection(sel, beg, end, time);
  800.                     IF time >= 0 THEN MoveTextStretch(sel, tf, beg, end, pos) END
  801.                 | CtrlZ:
  802.                     IF pos < t.len  THEN    (* delete forward to non-char *)
  803.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  804.                         WHILE ~r.eot & (ch <= " ") & (ch # Texts.ElemChar) DO Texts.Read(r, ch) END;
  805.                         IF r.eot THEN end := t.len
  806.                         ELSE
  807.                             IF ~InWordSet(ch) THEN end := Texts.Pos(r)
  808.                             ELSE
  809.                                 REPEAT Texts.Read(r, ch) UNTIL r.eot OR ~InWordSet(ch);
  810.                                 IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END
  811.                             END
  812.                         END;
  813.                         Texts.Delete(t, pos, end); TextFrames.SetCaret(tf, pos)
  814.                     END
  815.                 ELSE handled := FALSE
  816.                 END    (* CASE msg.ch ... *)
  817.             ELSE handled := FALSE
  818.             END    (* IF msg.id = ... *)
  819.         | msg: Oberon.CopyOverMsg DO    (* allow copy over only if text has no partial folds in it *)
  820.             IF ~tf.hasCar OR ~PartialFolds(msg.text, msg.beg, msg.end) THEN handled := FALSE END
  821.         ELSE handled := FALSE
  822.         END;        (* WITH msg: ... *)
  823.         IF ~handled THEN TextFrames.Handle(tf, msg) END
  824.     END Handle;
  825.     (** Commands **)
  826.     PROCEDURE Open*;    (** (name | "^")    Open a user viewer containing a text **)
  827.         CONST menu = "System.Close System.Copy System.Grow XE.Search Edit.Replace All Edit.Parcs XE.Comp XE.Err Edit.Store ";
  828.         VAR
  829.             v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner;
  830.             name: LongName; x, y: INTEGER;
  831.     BEGIN
  832.         ScanFirst(s); OpenText(t, name, s, empty[0], ext[0, 0], ext[0, 1]);
  833.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  834.         v := MenuViewers.New(MenuFrame(name, menu, 0), TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  835.         v.dsc.handle := Handle; v.dsc.next.handle := Handle;
  836.         SearchIdent(v.dsc.next(TextFrames.Frame), t)
  837.     END Open;
  838.     PROCEDURE SysOpen*;    (** [defY] (name | "^")    Open a system viewer at defY **)
  839.         CONST menu = "System.Close  System.Grow  Edit.Parcs  Edit.Store ";
  840.         VAR
  841.             v: Viewers.Viewer; t: Texts.Text;
  842.             s: Texts.Scanner; name: LongName; x, defY, y: INTEGER;
  843.             default: BOOLEAN;
  844.     BEGIN
  845.         ScanFirst(s);
  846.         IF s.class = Texts.Int THEN    (* read desired Y-coordinate *)
  847.             defY := SHORT(s.i); default := TRUE; Oberon.Par.pos := Texts.Pos(s)-1; ScanFirst(s)
  848.         ELSE default := FALSE
  849.         END;
  850.         OpenText(t, name, s, empty[1], ext[1, 0], ext[1, 1]);
  851.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  852.         IF default THEN y := defY END;
  853.         v := MenuViewers.New(MenuFrame(name, menu, 1), TextFrames.NewText(t, 0), TextFrames.menuH,x,y);
  854.         v.dsc.handle := Handle; v.dsc.next.handle := Handle
  855.     END SysOpen;
  856.     PROCEDURE OpenWide*;    (** (name | "^")    Open a user viewer containing a text spanning whole display **)
  857.         CONST menu = "System.Close System.Copy System.Grow XE.Search Edit.Replace All Edit.Parcs XE.Comp XE.Err Edit.Store | Log.Open | XE.SysOpen Strip ";
  858.         VAR
  859.             v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner;
  860.             name: LongName; x, y: INTEGER;
  861.     BEGIN
  862.         ScanFirst(s); OpenText(t, name, s, empty[2], ext[2, 0], ext[2, 1]);
  863.         Oberon.OpenTrack(Oberon.UserTrack(Oberon.Mouse.X), Oberon.DisplayWidth(Oberon.Mouse.X));
  864.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  865.         v := MenuViewers.New(MenuFrame(name, menu, 2), TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  866.         v.dsc.handle := Handle; v.dsc.next.handle := Handle;
  867.         SearchIdent(v.dsc.next(TextFrames.Frame), t)
  868.     END OpenWide;
  869.     PROCEDURE OpenAscii*;    (** (name | "^")    Open a user viewer containing a text using a fixed spaced font **)
  870.         CONST menu = "System.Close System.Copy System.Grow XE.Search Edit.Replace All XE.Comp EditTools.LocateLine ^ EdiT.StoreAscii ";
  871.         VAR
  872.             v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner;
  873.             name: LongName; x, y: INTEGER;
  874.     BEGIN
  875.         ScanFirst(s); OpenText(t, name, s, empty[3], ext[3, 0], ext[3, 1]);
  876.         Texts.ChangeLooks(t, 0, t.len, {0}, Fonts.This(AsciiFont), 0, 0);
  877.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  878.         v := MenuViewers.New(MenuFrame(name, menu, 3), TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  879.         v.dsc.handle := Handle; v.dsc.next.handle := Handle;
  880.         SearchIdent(v.dsc.next(TextFrames.Frame), t)
  881.     END OpenAscii;
  882.     PROCEDURE Search*;    (** Search selection (in folds if viewer is marked) **)
  883.         VAR res: INTEGER;
  884.     BEGIN
  885.         IF Oberon.Pointer.on & (Oberon.Par.vwr = Oberon.MarkedViewer()) THEN
  886.             Oberon.Call("FoldElems.Search", Oberon.Par, FALSE, res)
  887.         ELSE Oberon.Call("Edit.Search", Oberon.Par, FALSE, res)
  888.         END
  889.     END Search;
  890.     PROCEDURE Err*;    (** Show next error after caret **)
  891.         VAR f: TextFrames.Frame; v: Viewers.Viewer; pos: LONGINT; e: Texts.Elem;
  892.     BEGIN
  893.         IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN    (* called from menu frame *)
  894.             IF (Oberon.Par.frame.next # NIL) & (Oberon.Par.frame.next IS TextFrames.Frame) THEN
  895.                 f := Oberon.Par.frame.next(TextFrames.Frame)
  896.             ELSE f := NIL
  897.             END
  898.         ELSE
  899.             v := Oberon.MarkedViewer();
  900.             IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN f := v.dsc.next(TextFrames.Frame)
  901.             ELSE f := NIL
  902.             END
  903.         END;
  904.         IF f # NIL THEN
  905.             IF f.hasCar THEN pos := f.carloc.pos ELSE pos := 0 END;
  906.             FoldElems.FindElem(f.text, pos, ErrCheck, e, pos);
  907.             IF e # NIL THEN
  908.                 (*TextFrames.*)Show(f, pos); e(Elem).pos := pos; UpdateErr(e(Elem));
  909.                 Oberon.PassFocus(Viewers.This(f.X, f.Y)); TextFrames.SetCaret(f, pos+1)
  910.             ELSIF f.hasCar THEN TextFrames.RemoveCaret(f)
  911.             END
  912.         END
  913.     END Err;
  914.     PROCEDURE Comp*;    (** [options] | "*" | "^" | {fileName [options]}    Compile viewer in main frame with options
  915.         or marked viewer or list of filenames with options **)
  916.         VAR
  917.             f: TextFrames.Frame; menuT: Texts.Text; s: Texts.Scanner; v: Viewers.Viewer;
  918.             len: LONGINT; options: Name; fileName: LongName;
  919.         PROCEDURE Compile(frame: TextFrames.Frame; text: Texts.Text; name: ARRAY OF CHAR);
  920.             VAR
  921.                 vwr: MenuViewers.Viewer; oldNotify: Texts.Notifier; logLen: LONGINT; x, y, h: INTEGER;
  922.                 this, prev: Element; ext: Name; errorFile: LongName; res: INTEGER;
  923.         BEGIN
  924.             IF text # NIL THEN
  925.                 COPY(DefErrFile, errorFile);
  926.                 IF (compiler = "") & (name # "") OR (frame = NIL) THEN    (* no compile command yet, check extension *)
  927.                     COPY(defComp, compiler);
  928.                     Extension(name, ext); this := SearchPair(ext, prev);
  929.                     IF this # NIL THEN COPY(this.compiler, compiler); COPY(this.errFile, errorFile) END
  930.                 END;
  931.                 errT := TextFrames.Text(errorFile);
  932.                 oldNotify := text.notify; text.notify := NoNotify;
  933.                 FoldElems.ExpandAll(text, 0, TRUE);
  934.                 IF frame = NIL THEN    (* create temporary viewer *)
  935.                     x := Display.Width-1; y := Display.Bottom; h := Viewers.minH; Viewers.minH := 1;
  936.                     vwr := MenuViewers.New(TextFrames.NewMenu("", ""),
  937.                         TextFrames.NewText(text, 0), TextFrames.menuH, x, y
  938.                     );
  939.                     Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
  940.                     Viewers.minH := h
  941.                 ELSE DeleteErrElems(text)
  942.                 END;
  943.                 (* create new parameter text for compiler *)
  944.                 Oberon.Par.text := TextFrames.Text(""); Oberon.Par.pos := 0;
  945.                 Ch("*"); Str(options); Texts.Append(Oberon.Par.text, wr.buf);
  946.                 Str(compiler); Ch(" "); Str(options); Texts.Append(Oberon.Log, wr.buf);
  947.                 Append(".Compile", compiler);    (* extend compiler command, if necessary *)
  948.                 logLen := Oberon.Log.len;
  949.                 Oberon.Call(compiler, Oberon.Par, FALSE, res);
  950.                 IF (res = 0) & (frame # NIL) THEN MarkErrors(frame, text, logLen) END;
  951.                 FoldElems.CollapseAll(text, {FoldElems.tempLeft});
  952.                 IF frame = NIL THEN Viewers.Close(vwr)
  953.                 ELSE text.notify := oldNotify; text.notify(text, Texts.replace, 0, text.len)
  954.                 END
  955.             END
  956.         END Compile;
  957.     BEGIN
  958.         menuT := NIL;
  959.         IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN    (* called from menu frame *)
  960.             IF (Oberon.Par.frame.next # NIL) & (Oberon.Par.frame.next IS TextFrames.Frame) THEN
  961.                 f := Oberon.Par.frame.next(TextFrames.Frame);
  962.                 menuT := Oberon.Par.frame(TextFrames.Frame).text    (* menu text *)
  963.             END
  964.         ELSE    (* allow XE.Comp * ... *)
  965.             ScanFirst(s);
  966.             IF (s.class = Texts.Char) & (s.c = "*") & (s.line = 0) THEN
  967.                 Oberon.Par.pos := Texts.Pos(s);
  968.                 v := Oberon.MarkedViewer();
  969.                 IF (v IS MenuViewers.Viewer) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  970.                     f := v.dsc.next(TextFrames.Frame);
  971.                     menuT := v.dsc(TextFrames.Frame).text    (* menu text *)
  972.                 END
  973.             END
  974.         END;
  975.         IF menuT # NIL THEN
  976.             compiler := ""; fileName := "";
  977.             IF menuT # Oberon.Par.text THEN    (* called from an element *)
  978.                 ScanFirst(s);
  979.                 IF (s.class = Texts.Name) & (s.line = 0) THEN    (* get compiler override name *)
  980.                     COPY(s.s, compiler); Texts.Scan(s)
  981.                 END;
  982.                 GetOptions(s, options);
  983.             END;
  984.             IF compiler = "" THEN
  985.                 Texts.OpenScanner(s, menuT, 0); Texts.Scan(s);
  986.                 IF s.class = Texts.Name THEN COPY(s.s, fileName) END
  987.             END;
  988.             len := menuT.len;
  989.             Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y); Oberon.FadeCursor(Oberon.Pointer);
  990.             Compile(f, f.text, fileName);
  991.             IF len # menuT.len THEN    (* text was stored and got an UpdateMsg -> ! char in menu text *)
  992.                 Texts.Delete(menuT, menuT.len-1, menuT.len)
  993.             END;
  994.             Err    (* show first error, if any *)
  995.         ELSE    (* compile file list: {fileName [options] } ~ *)
  996.             ScanFirst(s);
  997.             WHILE s.class = Texts.Name DO
  998.                 COPY(s.s, fileName); Texts.Scan(s); GetOptions(s, options);
  999.                 Compile(NIL, TextFrames.Text(fileName), fileName)
  1000.             END
  1001.         END
  1002.     END Comp;
  1003.     PROCEDURE List*;    (** List compiler, extension, errorfile set **)
  1004.         VAR this: Element;
  1005.         PROCEDURE WriteExt(cmd: ARRAY OF CHAR; i: INTEGER);
  1006.         BEGIN Str(cmd); Str(" - "); Str(empty[i]); Str("  *."); Str(ext[i, 0]); Str("  *."); Str(ext[i, 1]); Ln
  1007.         END WriteExt;
  1008.     BEGIN
  1009.         Str("XE.List"); Ln;
  1010.         Str("OpenCmd - "); Str(openCmd); Ln;
  1011.         WriteExt("Open", 0); WriteExt("SysOpen", 1); WriteExt("OpenWide", 2); WriteExt("OpenAscii", 3);
  1012.         Str("Compiler"); Ln;
  1013.         IF defComp # "" THEN Str(defComp); Str(" - * - "); Str(DefErrFile); Ln END;
  1014.         this := root;
  1015.         WHILE this # NIL DO
  1016.             Str(this.compiler ); Str(" - *."); Str(this.ext); Str(" - "); Str(this.errFile); Ln;
  1017.             this := this.next
  1018.         END
  1019.     END List;
  1020.     PROCEDURE Defaults*;    (** Clear compiler, extension, errorfile set and load default assignments from configuration file **)
  1021.         VAR t: Texts.Text; s: Texts.Scanner; new, this, prev: Element;
  1022.         PROCEDURE ScanExt(cmd: ARRAY OF CHAR; i: INTEGER);
  1023.         BEGIN
  1024.             IF (s.class = Texts.Name) & (s.s = cmd) THEN
  1025.                 Texts.Scan(s);
  1026.                 IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
  1027.                     COPY(s.s, empty[i]); Texts.Scan(s);
  1028.                 END;
  1029.                 IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
  1030.                     COPY(s.s, ext[i, 0]); Texts.Scan(s);
  1031.                 END;
  1032.                 IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
  1033.                     COPY(s.s, ext[i, 1]); Texts.Scan(s)
  1034.                 END
  1035.             END
  1036.         END ScanExt;
  1037.     BEGIN
  1038.         root := NIL;
  1039.         defComp := DefComp; openCmd := DefOpenCmd;
  1040.         empty[0] := Empty0; ext[0, 0] := Ext00; ext[0, 1] := Ext01;
  1041.         empty[1] := Empty1; ext[1, 0] := Ext1; ext[1, 1] := Ext1;
  1042.         empty[2] := Empty0; ext[2, 0] := Ext00; ext[2, 1] := Ext01;
  1043.         empty[3] := Empty3; ext[3, 0] := Ext30; ext[3, 1] := Ext31;
  1044.         t := TextFrames.Text(ConfigurationName);
  1045.         IF t.len # 0 THEN
  1046.             Texts.OpenScanner(s, t, 0); Texts.Scan(s);
  1047.             IF (s.class = Texts.Name) & (s.s = "OpenCmd") THEN
  1048.                 Texts.Scan(s);
  1049.                 IF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
  1050.                     COPY(s.s, openCmd); Texts.Scan(s)
  1051.                 END
  1052.             END;
  1053.             ScanExt("Open", 0); ScanExt("SysOpen", 1); ScanExt("OpenWide", 2); ScanExt("OpenAscii", 3);
  1054.             IF (s.class = Texts.Name) & (s.s = "Compiler") THEN
  1055.                 Texts.Scan(s);
  1056.                 WHILE ~s.eot & (s.class = Texts.Name) DO
  1057.                     NEW(new); COPY(s.s, new.compiler); Texts.Scan(s);
  1058.                     IF (s.class = Texts.Char) & (s.c = "*") THEN defComp := new.compiler
  1059.                     ELSIF s.class = Texts.Name THEN
  1060.                         COPY(s.s, new.ext); Texts.Scan(s);
  1061.                         IF s.class = Texts.Name THEN
  1062.                             COPY(s.s, new.errFile); errT := TextFrames.Text(new.errFile);
  1063.                             IF errT.len = 0 THEN errT := TextFrames.Text(DefErrFile); COPY(DefErrFile, new.errFile) END
  1064.                         ELSE errT := TextFrames.Text(DefErrFile); COPY(DefErrFile, new.errFile)
  1065.                         END;
  1066.                         this := SearchPair(new.ext, prev);    (* check for duplicates *)
  1067.                         IF this = NIL THEN new.next := root; root := new    (* new entry *)
  1068.                         ELSIF this.compiler # new.compiler THEN    (* new entry for existing extension -> remove this *)
  1069.                             IF this = root THEN new.next := root.next; root := new
  1070.                             ELSE new.next := this.next; prev.next := new
  1071.                             END
  1072.                         END
  1073.                     END;
  1074.                     Texts.Scan(s)
  1075.                 END
  1076.             END
  1077.         END
  1078.     END Defaults;
  1079.     PROCEDURE GetHandler*;    (** install XE.Handle in Oberon.Par.frame.handle, if Oberon.Par.pos = GetHandlerKey **)
  1080.     BEGIN
  1081.         IF (Oberon.Par # NIL) & (Oberon.Par.pos = GetHandlerKey) & (Oberon.Par.frame # NIL) THEN
  1082.             Oberon.Par.frame.handle := Handle
  1083.         END
  1084.     END GetHandler;
  1085. BEGIN
  1086.     Texts.OpenWriter(wr); errFnt := Fonts.This(ErrFont); first := TRUE;
  1087.     Defaults;
  1088. delay := Input.TimeUnit DIV 2    (* 0.5 seconds: other Oberons *)
  1089. END XE.
  1090.