home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / system / xe.mod (.txt) < prev    next >
Oberon Text  |  1995-05-17  |  51KB  |  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