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