home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / def.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  18KB  |  446 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 22 Jan 96
  5. Syntax10i.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. MODULE Def;    (** CAS 
  8.     IMPORT
  9.         Oberon, Viewers, Fonts, Texts, MenuViewers, TextFrames;
  10.     CONST
  11.         Menu = "^Edit.Menu.Text";
  12.         TAB = 9X;  CR = 0DX;  MaxMod = 32;
  13.         module = 0;  import = 1;  const = 2;  type = 3;  class = 4;  var = 5;  procedure = 6;  begin = 7;  end = 8;
  14.         period = 9;  array = 10;  record = 11;  of = 12;  pointer = 13;  to = 14;  asterisk = 15;  comma = 16;  colon = 17;
  15.         equal = 18;  lparen = 19;  rparen = 20;  semicolon = 21;  arrow = 22;  slash = 23;  minus = 24;  ident = 25;
  16.         endident = 29;  endmod = 30;  eot = 31;  none = 99;
  17.         B: Texts.Buffer;
  18.         TMod: Texts.Text;
  19.         plainFont: Fonts.Font;
  20.         W, WL: Texts.Writer;
  21.         R: Texts.Reader;
  22.         wpos, pos, cpos: LONGINT;
  23.         mods: INTEGER;    (*no of "exported" modules*)
  24.         mod: ARRAY MaxMod OF RECORD
  25.             exp, break: BOOLEAN;
  26.             beg, end: LONGINT;
  27.             name: ARRAY 32 OF CHAR
  28.         END ;
  29.         sym, tag, line, level, nlines: INTEGER;
  30.         newline, plain: BOOLEAN;
  31.         ch: CHAR;
  32.         id: ARRAY 64 OF CHAR;
  33.         comment: RECORD
  34.             exp, break, split: BOOLEAN;
  35.             wpos, pos0, pos1: LONGINT
  36.         END ;
  37.     PROCEDURE AppendDef(VAR s: ARRAY OF CHAR);
  38.         VAR i: INTEGER;
  39.     BEGIN i := 0;
  40.         WHILE s[i] # 0X DO INC(i) END ;
  41.         s[i] := "."; s[i+1] := "D"; s[i+2] := "e"; s[i+3] := "f"; s[i+4] := 0X
  42.     END AppendDef;
  43.     PROCEDURE DefSuffix(VAR s: ARRAY OF CHAR);
  44.         VAR i: INTEGER;
  45.     BEGIN i := 0;
  46.         WHILE s[i] # 0X DO
  47.             IF (s[i] = ".") & (s[i+1] = "M") & (s[i+2] = "o") & (s[i+3] = "d") & (s[i+4] = 0X) THEN
  48.                 s[i] := 0X; AppendDef(s)
  49.             END ;
  50.             INC(i)
  51.         END
  52.     END DefSuffix;
  53.     PROCEDURE Mark(err: INTEGER);
  54.     BEGIN Texts.WriteString(WL, "  pos   "); Texts.WriteInt(WL, pos, 0);
  55.         IF err = 0 THEN Texts.WriteString(WL, "  not a module")
  56.         ELSIF err = 2 THEN Texts.WriteString(WL, "  end of module missing")
  57.         END ;
  58.         Texts.WriteLn(WL); Texts.Append(Oberon.Log, WL.buf)
  59.     END Mark;
  60.     PROCEDURE Pos(): LONGINT;
  61.     BEGIN RETURN Texts.Pos(R)-1
  62.     END Pos;
  63.     PROCEDURE PickAttr(attr: LONGINT);
  64.         VAR R: Texts.Reader; ch: CHAR;
  65.     BEGIN Texts.OpenReader(R, TMod, attr); Texts.Read(R, ch);
  66.         Texts.SetFont(W, R.fnt); Texts.SetColor(W, R.col); Texts.SetOffset(W, R.voff)
  67.     END PickAttr;
  68.     PROCEDURE Wr(attr: LONGINT; ch: CHAR);
  69.     BEGIN PickAttr(attr); Texts.Write(W, ch)
  70.     END Wr;
  71.     PROCEDURE WrS(attr: LONGINT; s: ARRAY OF CHAR);
  72.     BEGIN PickAttr(attr); Texts.WriteString(W, s)
  73.     END WrS;
  74.     PROCEDURE WrLn;
  75.     BEGIN Texts.WriteLn(W)
  76.     END WrLn;
  77.     PROCEDURE Indent(n: INTEGER);
  78.     BEGIN WrLn; Texts.SetFont(W, plainFont);
  79.         WHILE n > 0 DO Texts.Write(W, TAB); DEC(n) END
  80.     END Indent;
  81.     PROCEDURE Break(break: BOOLEAN; n: INTEGER);
  82.     BEGIN
  83.         IF break THEN Indent(n) ELSE Texts.SetFont(W, plainFont); Texts.Write(W, " ") END
  84.     END Break;
  85.     PROCEDURE Append(SB, DB: Texts.Buffer);
  86.     BEGIN Texts.Copy(SB, DB); Texts.OpenBuf(SB)
  87.     END Append;
  88.     PROCEDURE InsertBuf(B: Texts.Buffer; text: Texts.Text; VAR pos: LONGINT);
  89.         VAR len: LONGINT;
  90.     BEGIN len := B.len; Texts.Insert(text, pos, B); INC(pos, len)
  91.     END InsertBuf;
  92.     PROCEDURE Insert(beg, end: LONGINT; text: Texts.Text; VAR pos: LONGINT);
  93.         VAR buf: Texts.Buffer;
  94.     BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.Save(TMod, beg, end, buf);
  95.         InsertBuf(W.buf, text, pos); InsertBuf(buf, text, pos)
  96.     END Insert;
  97.     PROCEDURE Disp(beg, end: LONGINT);
  98.     BEGIN Append(W.buf, B); Texts.Save(TMod, beg, end, B)
  99.     END Disp;
  100.     (* scanner *)
  101.     PROCEDURE Ch;
  102.     BEGIN
  103.         IF ch = CR THEN INC(line) END ;
  104.         Texts.Read(R, ch)
  105.     END Ch;
  106.     PROCEDURE Comment;
  107.         VAR ch0: CHAR;    lev, cnt: INTEGER;    pos1: LONGINT;
  108.     BEGIN ch0 := ch; lev := 1; cnt := 0;
  109.         IF ch = "*" THEN Ch;
  110.             IF ch = ")" THEN Ch; RETURN END
  111.         END ;
  112.         REPEAT
  113.             IF ch = "*" THEN Ch; INC(cnt);
  114.                 IF ch = ")" THEN Ch; DEC(lev) END
  115.             ELSIF ch = "(" THEN Ch; cnt := 0;
  116.                 IF ch = "*" THEN Ch; INC(lev) END
  117.             ELSE Ch; cnt := 0
  118.             END
  119.         UNTIL (lev = 0) OR R.eot;
  120.         IF ch0 = "*" THEN comment.exp := TRUE;    (*exported comment*)
  121.             comment.break := nlines >= 2; comment.wpos := wpos; comment.pos0 := pos;
  122.             pos1 := Pos(); comment.pos1 := pos1; comment.split := (cnt > 1) & (pos+5 < pos1)
  123.         ELSE comment.exp := FALSE
  124.         END
  125.     END Comment;
  126.     PROCEDURE FlushComment;
  127.     BEGIN
  128.         IF comment.exp THEN
  129.             IF comment.break THEN WrLn END ;
  130.             Disp(comment.wpos, comment.pos0); Disp(comment.pos0, comment.pos0 + 1);
  131.             IF comment.split THEN Disp(comment.pos0 + 2, comment.pos1 - 2); Disp(comment.pos1 - 1, comment.pos1)
  132.             ELSE Disp(comment.pos0 + 2, comment.pos1)
  133.             END ;
  134.             comment.exp := FALSE
  135.         END
  136.     END FlushComment;
  137.     PROCEDURE Ident;
  138.         VAR i: INTEGER;
  139.     BEGIN sym := ident; i := 0;
  140.         REPEAT id[i] := ch; Ch; INC(i) UNTIL (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z");
  141.         id[i] := 0X
  142.     END Ident;
  143.     PROCEDURE Sym;
  144.         VAR ch0: CHAR; ln: INTEGER;
  145.     BEGIN
  146.         IF sym = eot THEN RETURN END ;
  147.         sym := none; ln := line;
  148.         WHILE ~R.eot & (sym = none) DO
  149.             wpos := Pos();
  150.             WHILE ~R.eot & (ch <= " ") DO
  151.                 IF ch = 0DX THEN wpos := Pos() END ;
  152.                 Ch
  153.             END ;
  154.             pos := Pos(); nlines := line - ln; newline := nlines # 0;
  155.             IF (ch >= "a") & (ch <= "z") THEN ch0 := CAP(ch) ELSE ch0 := ch END ;
  156.             IF (ch0 >= "A") & (ch0 <= "Z") THEN Ident ELSE Ch END ;
  157.             CASE ch0 OF
  158.                 0X.."!", "#".."'", "+", "0".."9", "<", ">".."@":
  159.             |  22X: REPEAT Ch UNTIL (ch = 22X) OR (ch < " ") OR R.eot; Ch
  160.             |  "(": IF ch = "*" THEN Ch; Comment; FlushComment ELSE sym := lparen END
  161.             |  ")": sym := rparen
  162.             |  "*": sym := asterisk
  163.             |  ",": sym := comma
  164.             |  "-": sym := minus
  165.             |  ".": IF ch # "." THEN sym := period END
  166.             |  "/": sym := slash
  167.             |  ":": sym := colon
  168.             |  ";": sym := semicolon
  169.             |  "=": sym := equal
  170.             |  "D", "F".."H", "J".."L", "N", "Q", "S", "U", "W".."Z":
  171.             |  "A": IF id = "ARRAY" THEN sym := array END
  172.             |  "B": IF id = "BEGIN" THEN sym := begin END
  173.             |  "C": IF id = "CONST" THEN sym := const ELSIF id = "CLASS" THEN sym := class END
  174.             |  "E": IF id = "END" THEN sym := end END
  175.             |  "I": IF id = "IMPORT" THEN sym := import END
  176.             |  "M": IF id = "MODULE" THEN sym := module END
  177.             |  "O": IF id = "OF" THEN sym := of END
  178.             |  "P": IF id = "PROCEDURE" THEN sym := procedure ELSIF id = "POINTER" THEN sym := pointer END
  179.             |  "R": IF id = "RECORD" THEN sym := record END
  180.             |  "T": IF id = "TYPE" THEN sym := type ELSIF id = "TO" THEN sym := to END
  181.             |  "V": IF id = "VAR" THEN sym := var END
  182.             |  "[", "\", "]":
  183.             |  "^": sym := arrow
  184.             |  "|": sym := semicolon    (*nearly - but does the job*)
  185.             |  "_".."{", "}"..0FFX:
  186.             END
  187.         END ;
  188.         IF R.eot THEN sym := eot END
  189.     END Sym;
  190.     PROCEDURE Seek(syms: SET; exporting: BOOLEAN);
  191.         VAR first, emod: BOOLEAN;    m: INTEGER;
  192.     BEGIN
  193.         IF sym # endmod THEN syms := syms + {endmod, eot}; emod := ~(end IN syms);
  194.             REPEAT first := sym # period;
  195.                 IF exporting & first & (sym = ident) THEN m := 0;
  196.                     WHILE m < mods DO
  197.                         IF id = mod[m].name THEN mod[m].exp := TRUE END ;
  198.                         INC(m)
  199.                     END ;
  200.                     first := FALSE;
  201.                     IF ident IN syms THEN RETURN END ;
  202.                     Sym
  203.                 ELSIF emod & (sym = end) THEN cpos := pos; Sym;
  204.                     IF sym = ident THEN Sym;
  205.                         IF (sym = period) OR (sym = eot) THEN sym := endmod
  206.                         ELSIF sym = semicolon THEN sym := endident
  207.                         END
  208.                     END
  209.                 ELSE Sym
  210.                 END
  211.             UNTIL sym IN syms
  212.         END
  213.     END Seek;
  214.     (* projector *)
  215.     PROCEDURE ShowType(show: BOOLEAN; newlev: INTEGER);
  216.         VAR exp, first, break, skip, limited: BOOLEAN;    pos1, pos2: LONGINT;    oldlev: INTEGER;
  217.     BEGIN Seek({ident, record, array, pointer, procedure}, show); oldlev := level; level := newlev;
  218.         IF sym = record THEN pos1 := pos; pos2 := Pos(); Seek({lparen, ident, end}, show); exp := FALSE;
  219.             IF sym = lparen THEN Seek({rparen}, show); pos2 := Pos(); Seek({ident, end}, show) END ;
  220.             IF show THEN Disp(pos1, pos2) END ;
  221.             WHILE sym = ident DO first := TRUE; skip := FALSE;
  222.                 REPEAT pos1 := pos; pos2 := Pos(); break := newline; Seek({asterisk, minus, comma, colon}, show);
  223.                     IF sym IN {asterisk, minus} THEN limited := sym = minus; Seek({comma, colon}, show);
  224.                         IF show THEN
  225.                             IF first THEN
  226.                                 IF exp THEN Wr(pos, ";") END ;
  227.                                 Break(break OR skip, level+1); skip := FALSE
  228.                             ELSE WrS(pos, ", ")
  229.                             END ;
  230.                             IF limited THEN Disp(pos1, pos) ELSE Disp(pos1, pos2) END ;
  231.                             exp := TRUE; first := FALSE
  232.                         END
  233.                     ELSE skip := TRUE
  234.                     END ;
  235.                     IF sym = comma THEN Seek({ident}, show) END
  236.                 UNTIL sym IN {colon, eot};
  237.                 IF sym = colon THEN
  238.                     IF exp & ~first THEN WrS(pos, ": ") END ;
  239.                     ShowType(exp & ~first, level+1)
  240.                 END ;
  241.                 IF sym # end THEN Seek({ident, end}, show) END
  242.             END ;
  243.             IF show & (sym = end) THEN
  244.                 IF ~exp THEN Wr(Pos(), " ") ELSE Indent(level) END ;
  245.                 Disp(pos, Pos())
  246.             END
  247.         ELSIF sym = array THEN pos1 := pos; Seek({of}, show);
  248.             IF show THEN Disp(pos1, Pos()); Wr(Pos(), " ") END ;
  249.             ShowType(show, level)
  250.         ELSIF sym = pointer THEN pos1 := pos; Seek({to}, show);
  251.             IF show THEN Disp(pos1, Pos()); Wr(Pos(), " ") END ;
  252.             ShowType(show, level)
  253.         ELSIF sym = procedure THEN pos1 := pos; pos2 := Pos(); Seek({lparen, semicolon, end}, show);
  254.             IF sym = lparen THEN Seek({rparen}, show); Seek({semicolon, end}, show); pos2 := pos END ;
  255.             IF show THEN Disp(pos1, pos2) END
  256.         ELSE (*simple type*) pos1 := pos; pos2 := Pos(); Seek({period, semicolon, end}, show);
  257.             WHILE sym = period DO Seek({ident}, FALSE); pos2 := Pos(); Seek({period, semicolon, end}, FALSE) END ;
  258.             IF show THEN Disp(pos1, pos2) END
  259.         END ;
  260.         level := oldlev
  261.     END ShowType;
  262.     PROCEDURE Import(VAR ins, beg, end: LONGINT);
  263.     BEGIN Append(W.buf, B); ins := B.len; beg := pos; end := Pos(); level := 1;
  264.         REPEAT Seek({ident, const, type, class, var, procedure}, FALSE);
  265.             IF sym = ident THEN mod[mods].beg := pos; COPY(id, mod[mods].name);
  266.                 mod[mods].break := newline; Seek({semicolon, comma, asterisk}, FALSE);
  267.                 mod[mods].end := pos; mod[mods].exp := FALSE;
  268.                 IF sym = asterisk THEN Seek({semicolon, comma}, FALSE) END ;
  269.                 INC(mods)
  270.             END
  271.         UNTIL sym IN {const, type, class, var, procedure, endmod, eot};
  272.         level := 0
  273.     END Import;
  274.     PROCEDURE GenImports(text: Texts.Text; ins, beg, end: LONGINT);
  275.         VAR m: INTEGER;    exp: BOOLEAN;
  276.     BEGIN m := 0; exp := FALSE; pos := ins;
  277.         WHILE m < mods DO
  278.             IF mod[m].exp THEN
  279.                 IF exp THEN Wr(mod[m].end, ",")
  280.                 ELSE Indent(1); Insert(beg, end, text, pos);
  281.                     IF ~mod[m].break THEN Break(mod[0].break, 2) END
  282.                 END ;
  283.                 exp := TRUE; Break(mod[m].break, 2); Insert(mod[m].beg, mod[m].end, text, pos)
  284.             END ;
  285.             INC(m)
  286.         END ;
  287.         IF exp THEN Wr(pos, ";"); InsertBuf(W.buf, text, pos) END
  288.     END GenImports;
  289.     PROCEDURE^ Constructor;
  290.     PROCEDURE Const;
  291.         VAR pos0, pos1, pos2: LONGINT;    break, exp: BOOLEAN;
  292.     BEGIN pos0 := pos; pos1 := Pos(); exp := FALSE;
  293.         Seek({ident, const, type, class, var, procedure}, FALSE);
  294.         INC(level);
  295.         WHILE sym = ident DO pos2 := pos; break := newline; Seek({equal, asterisk}, FALSE);
  296.             IF sym = asterisk THEN
  297.                 IF ~exp & (tag # const) THEN WrLn; Indent(level); Disp(pos0, pos1) END ;
  298.                 Break(break, level + 1); Disp(pos2, pos); pos2 := Pos();
  299.                 Seek({semicolon}, TRUE); Disp(pos2, Pos()); exp := TRUE; tag := const
  300.             ELSE Seek({semicolon}, TRUE)
  301.             END ;
  302.             Seek({ident, const, type, class, var, procedure, begin, endident}, FALSE)
  303.         END ;
  304.         DEC(level)
  305.     END Const;
  306.     PROCEDURE Type;
  307.         VAR pos0, pos1, pos2: LONGINT;    first, break, exp: BOOLEAN;
  308.     BEGIN pos0 := pos; pos1 := Pos(); exp := FALSE;
  309.         Seek({ident, const, type, class, var, procedure}, FALSE);
  310.         INC(level);
  311.         WHILE sym = ident DO first := TRUE; pos2 := pos; break := newline; Seek({equal, asterisk}, FALSE);
  312.             IF sym = asterisk THEN
  313.                 IF ~exp & (tag # type) THEN WrLn; Indent(level); Disp(pos0, pos1) END ;
  314.                 Break(break, level + 1); Disp(pos2, pos); pos2 := Pos();
  315.                 Seek({equal}, FALSE); Disp(pos2, Pos());
  316.                 Wr(Pos(), " "); ShowType(TRUE, level + 1); first := FALSE; exp := TRUE; tag := type
  317.             ELSIF sym = equal THEN ShowType(FALSE, level + 1)
  318.             END ;
  319.             IF ~first THEN Wr(Pos(), ";") END ;
  320.             Seek({ident, const, type, class, var, procedure, begin, endident}, FALSE)
  321.         END ;
  322.         DEC(level)
  323.     END Type;
  324.     PROCEDURE Var(instance: BOOLEAN);
  325.         VAR pos0, pos1, pos2: LONGINT;    first, skip, break, exp, limited: BOOLEAN;
  326.     BEGIN pos0 := pos; pos1 := Pos(); exp := FALSE;
  327.         Seek({ident, const, type, class, var, procedure, endident}, FALSE);
  328.         INC(level);
  329.         WHILE sym = ident DO first := TRUE; break := newline OR instance; skip := FALSE;
  330.             WHILE sym = ident DO pos2 := pos; Seek({colon, comma, asterisk, minus}, FALSE);
  331.                 IF sym IN {asterisk, minus} THEN limited := sym = minus;
  332.                     IF ~exp & (tag # var) & ~instance THEN WrLn; Indent(level); Disp(pos0, pos1) END ;
  333.                     IF first THEN Break(break OR skip, level + 1) ELSE WrS(Pos(), ", ") END ;
  334.                     IF limited THEN Disp(pos2, Pos()) ELSE Disp(pos2, pos) END ;
  335.                     Seek({colon, comma}, FALSE); first := FALSE; exp := TRUE; skip := FALSE; tag := var
  336.                 ELSE skip := TRUE
  337.                 END ;
  338.                 IF sym = comma THEN Seek({ident}, FALSE); break := newline
  339.                 ELSIF sym = colon THEN
  340.                     IF ~first THEN WrS(Pos(), ": ") END ;
  341.                     ShowType(~first, level + 1)
  342.                 END
  343.             END ;
  344.             IF ~first THEN Wr(Pos(), ";") END ;
  345.             Seek({ident, const, type, class, var, procedure, begin, endident}, FALSE)
  346.         END ;
  347.         DEC(level)
  348.     END Var;
  349.     PROCEDURE Procedure;
  350.         VAR pos0, pos1: LONGINT;    savetag: INTEGER;
  351.     BEGIN pos0 := pos; Seek({arrow, asterisk, slash, ident, lparen}, FALSE);
  352.         IF sym IN {asterisk, slash} THEN Seek({ident, lparen}, FALSE) END ;
  353.         IF sym = lparen THEN Seek({rparen}, FALSE); Seek({ident}, FALSE) END ;
  354.         IF sym = ident THEN pos1 := Pos(); Seek({lparen, semicolon, asterisk}, FALSE);
  355.             IF sym = asterisk THEN
  356.                 IF tag # procedure THEN WrLn END ;
  357.                 INC(level); Indent(level); Disp(pos0, pos1); pos0 := Pos(); Seek({lparen, semicolon}, FALSE);
  358.                 IF sym = lparen THEN Seek({rparen}, TRUE); Seek({semicolon}, TRUE) END ;
  359.                 Disp(pos0, Pos()); tag := procedure; DEC(level)
  360.             ELSIF sym = lparen THEN Seek({rparen}, FALSE)
  361.             END
  362.         ELSE Seek({lparen, semicolon}, FALSE);
  363.             IF sym = lparen THEN Seek({rparen}, FALSE) END
  364.         END ;
  365.         Seek({const, type, class, var, procedure, endident}, FALSE); savetag := tag;
  366.         WHILE sym IN {const, type, class, var, procedure} DO Constructor END ;
  367.         Seek({const, type, class, var, procedure, endident}, FALSE); tag := savetag
  368.     END Procedure;
  369.     PROCEDURE Class;
  370.         VAR pos0: LONGINT; forward: BOOLEAN;
  371.     BEGIN pos0 := pos; Seek({arrow, asterisk, semicolon}, FALSE); forward := sym = arrow;
  372.         IF forward THEN Seek({asterisk, semicolon}, FALSE) END ;
  373.         IF sym = asterisk THEN WrLn; Indent(level + 1); Disp(pos0, pos);
  374.             Seek({lparen, semicolon}, FALSE);
  375.             IF sym = lparen THEN pos0 := pos; Seek({rparen}, TRUE); Disp(pos0, Pos()); Seek({semicolon}, FALSE) END ;
  376.             tag := procedure;
  377.             Disp(pos, Pos()); REPEAT Var(TRUE) UNTIL sym # ident;
  378.             IF forward & (sym # endident) THEN Seek({endident}, FALSE)
  379.             ELSE INC(level);
  380.                 WHILE sym = procedure DO Procedure END ;
  381.                 DEC(level)
  382.             END ;
  383.             Indent(level + 1); Disp(cpos, Pos()); tag := class
  384.         ELSE (*sym = semicolon*)
  385.             REPEAT Var(TRUE) UNTIL sym # ident;
  386.             IF forward & (sym # endident) THEN Seek({endident}, FALSE)
  387.             ELSE
  388.                 WHILE sym = procedure DO Procedure END
  389.             END
  390.         END ;
  391.         Seek({const, type, class, var, procedure, endident}, FALSE)
  392.     END Class;
  393.     PROCEDURE Constructor;
  394.     BEGIN
  395.         CASE sym OF
  396.             const: Const | type: Type | class: Class | var: Var(FALSE) | procedure: Procedure
  397.         END ;
  398.         IF sym = begin THEN Seek({const, type, class, var, procedure, endident}, FALSE) END
  399.     END Constructor;
  400.     PROCEDURE Show*;    (** ( "*" | "^" | name ) [ "/P" ]   --P option enforces plain text style **)
  401.         VAR S: Texts.Scanner;    V: Viewers.Viewer;    text: Texts.Text;    name: ARRAY 32 OF CHAR;
  402.             selbeg, selend, time: LONGINT;    x, y: INTEGER;
  403.             defpos, modbeg, modend, impins, impbeg, impend: LONGINT;
  404.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  405.         IF (S.class = Texts.Char) & (S.c = "*") & (S.line = 0) THEN V := Oberon.MarkedViewer();
  406.             IF (V # NIL) & (V.dsc # NIL) & (V.dsc.next # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
  407.                 TMod := V.dsc.next(TextFrames.Frame).text; S.s[0] := "*"; S.s[1] := 0X
  408.             ELSE RETURN
  409.             END
  410.         ELSIF (S.class = Texts.Name) & (S.line = 0) THEN TMod := TextFrames.Text(S.s)
  411.         ELSE Oberon.GetSelection(text, selbeg, selend, time);
  412.             IF time > 0 THEN Texts.OpenScanner(S, text, selbeg); Texts.Scan(S);
  413.                 IF (S.class # Texts.Name) OR (S.line > 0) THEN RETURN END
  414.             ELSE RETURN
  415.             END ;
  416.             TMod := TextFrames.Text(S.s)
  417.         END ;
  418.         COPY(S.s, name); DefSuffix(name); Texts.Scan(S);
  419.         plain := FALSE; IF (S.class = Texts.Char) & (S.c = "/") THEN plain := CAP(S.nextCh) = "P" END ;
  420.         Texts.OpenBuf(W.buf); Texts.OpenBuf(WL.buf); Texts.OpenBuf(B);
  421.         Texts.OpenReader(R, TMod, 0); ch := 0X; Ch; sym := none; line := 0; level := 0; Sym;
  422.         IF sym = module THEN defpos := pos; WrS(defpos, "DEFINITION "); Seek({ident}, FALSE);
  423.             IF name[0] = "*" THEN COPY(id, name); AppendDef(name) END ;
  424.             modbeg := pos; modend := Pos(); Seek({semicolon}, FALSE);
  425.             Disp(modbeg, modend); Disp(pos, Pos()); Seek({import, const, type, class, var, procedure}, FALSE);
  426.             mods := 0; tag := none;
  427.             IF sym = import THEN Import(impins, impbeg, impend) END ;
  428.             WHILE sym IN {const, type, class, var, procedure} DO Constructor END ;
  429.             IF sym # endmod THEN Seek({}, FALSE) END ;
  430.             IF sym = endmod THEN WrLn; Disp(cpos, Pos());
  431.                 WHILE sym # eot DO Sym END ;
  432.                 text := TextFrames.Text(""); WrLn; Append(W.buf, B); Texts.Append(text, B);
  433.                 GenImports(text, impins, impbeg, impend);
  434.                 IF plain THEN Texts.ChangeLooks(text, 0, text.len, {0}, plainFont, 0, 0) END ;
  435.                 Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  436.                 V := MenuViewers.New(TextFrames.NewMenu(name, Menu), TextFrames.NewText(text, 0),
  437.                     TextFrames.menuH, x, y)
  438.             ELSE Mark(2)
  439.             END ;
  440.             TMod := NIL
  441.         ELSE Mark(0)
  442.         END
  443.     END Show;
  444. BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WL); NEW(B); plainFont := Fonts.This("Syntax10.Scn.Fnt")
  445. END Def.
  446.