home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / editkeys.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  25KB  |  628 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 20 Mar 96
  5. Syntax10i.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. MODULE EditKeys;    (* CAS/MH 27 Jan 93, SHML 
  8.  << *)
  9.     IMPORT
  10.         Files, Oberon, Input, Fonts, Display, Viewers, MenuViewers, Texts, TextFrames;
  11.     CONST
  12.         IdentLen = 32; DefaultFile = "EditKeys.Text"; DefaultMacro = "OTHERWISE"; InstallMacro = "INSTALL";
  13.         (*scanner symbols*)
  14.             cmdSym = 0; nameSym = 1; stretchSym = 2; lparen = 3; rparen = 4; bslash = 5; eof = 6;
  15.         (*built-in commands*)
  16.             (*w/ param*)
  17.             writeCmd = "0"; charCmd = "1"; fntCmd = "2"; voffCmd = "3"; callCmd = "4";
  18.             argCmd = "A"; execCmd = "B"; paramCmd = "C";
  19.             (*w/o param*)
  20.             keepCmd = "5"; pickCmd = "6"; caretCmd = "7"; indentCmd = "8"; freezeCmd = "9";
  21.         (*preset.set*)
  22.             fntPreset = 0; pickPreset = 1; voffPreset = 2; caretPreset = 3; freezePreset = 4;
  23.         Menu = "System.Close  System.Copy  System.Grow  Edit.Search  Edit.Replace  Edit.Parcs  Edit.Store ";
  24.         SysMenu = "System.Close  System.Copy  System.Grow  Edit.Store ";
  25.     TYPE
  26.         Ident = ARRAY IdentLen OF CHAR;
  27.         Definition = POINTER TO DefinitionDesc;
  28.         Sequence = POINTER TO SequenceDesc;
  29.         DefinitionDesc = RECORD
  30.             left, right: Definition;
  31.             in: BOOLEAN;
  32.             trig: Ident;
  33.             seq: Sequence
  34.         END;
  35.         SequenceDesc = RECORD
  36.             next: Sequence;
  37.             sym: INTEGER;
  38.             cmd: CHAR;
  39.             def: Definition;
  40.             stretch: Texts.Buffer
  41.         END;
  42.         defs, dmy: Definition;
  43.         ch, cmd, hotKey: CHAR;
  44.         sym, errs: INTEGER;
  45.         errpos: LONGINT;
  46.         name, trig: Ident;
  47.         stretch, buf, indent: Texts.Buffer;
  48.         T: Texts.Text;
  49.         R: Texts.Reader;
  50.         W, WB, WL: Texts.Writer;    (*out, compose, host editor*)
  51.         map: ARRAY 17 OF CHAR;
  52.         preset: RECORD
  53.             set: SET;
  54.             pos, caret: LONGINT;
  55.             frame: TextFrames.Frame;
  56.             def, fnt: Fonts.Font;
  57.             voff: SHORTINT
  58.         END;
  59.     PROCEDURE Flip (VAR src, dst: ARRAY OF CHAR);
  60.         VAR i, j: INTEGER;
  61.     BEGIN i := -1; j := 0;
  62.         REPEAT INC(i) UNTIL src[i] = 0X;
  63.         WHILE i > 0 DO DEC(i); dst[j] := src[i]; INC(j) END;
  64.         dst[j] := 0X
  65.     END Flip;
  66.     PROCEDURE WLog;
  67.     BEGIN Texts.Append(Oberon.Log, W.buf)
  68.     END WLog;
  69.     PROCEDURE Ch (ch: CHAR);
  70.     BEGIN Texts.Write(W, ch)
  71.     END Ch;
  72.     PROCEDURE Str (s: ARRAY OF CHAR);
  73.     BEGIN Texts.WriteString(W, s)
  74.     END Str;
  75.     PROCEDURE FlipStr (s: ARRAY OF CHAR);
  76.         VAR n: Ident;
  77.     BEGIN Flip(s, n); Str(n)
  78.     END FlipStr;
  79.     PROCEDURE Gap;
  80.     BEGIN Str("  ")
  81.     END Gap;
  82.     PROCEDURE Ln;
  83.     BEGIN Texts.WriteLn(W)
  84.     END Ln;
  85.     PROCEDURE Char (ch: CHAR);
  86.         VAR pat: Display.Pattern; i, n, dx, x, y, w, h: INTEGER;
  87.             d: ARRAY 3 OF CHAR;
  88.     BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat);
  89.         IF h > 0 THEN Ch(ch); Str(" (* ") END;
  90.         Ch("#"); i := 0; n := ORD(ch);
  91.         REPEAT d[i] := map[n MOD 10]; n := n DIV 10; INC(i) UNTIL n = 0;
  92.         WHILE i > 0 DO DEC(i); Ch(d[i]) END;
  93.         IF h = 0 THEN Str(" (* ") ELSE Str(", ") END;
  94.         Ch("0"); i := 0; n := ORD(ch);
  95.         REPEAT d[i] := map[n MOD 16]; n := n DIV 16; INC(i) UNTIL n = 0;
  96.         WHILE i > 0 DO DEC(i); Ch(d[i]) END;
  97.         Str("X *)")
  98.     END Char;
  99.     PROCEDURE Append (SB, DB: Texts.Buffer);
  100.     BEGIN Texts.Copy(SB, DB); Texts.OpenBuf(SB)
  101.     END Append;
  102.     (* table handler *)
  103.     PROCEDURE Find (VAR name, trig: Ident; insert: BOOLEAN): Definition;
  104.         VAR p, q, d, x: Definition; i: INTEGER;
  105.     BEGIN Flip(name, trig); p := defs; d := p.right; q := NIL; x := NIL;
  106.         WHILE d # NIL DO i := 0;
  107.             WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
  108.             IF trig[i] = d.trig[i] THEN x := d; d := NIL
  109.             ELSIF trig[i] = 0X THEN q := d; d := NIL
  110.             ELSIF trig[i] < d.trig[i] THEN p := d; d := d.left
  111.             ELSE p := d; d := d.right
  112.             END
  113.         END;
  114.         IF insert & (x # NIL) THEN Str(name); Str(" already defined"); Ln; WLog END;    (*<<*)
  115.         IF insert & (x = NIL) THEN NEW(x); x.right := q; x.in := FALSE; x.trig := trig;
  116.             IF trig < p.trig THEN p.left := x ELSE p.right := x END;
  117.             IF q # NIL THEN dmy.right := NIL; p := dmy;
  118.                 WHILE q.left # NIL DO
  119.                     WHILE (q.left # NIL) & (q.left.trig > trig) DO q := q.left END;
  120.                     WHILE (q.left # NIL) & (q.left.trig < trig) DO p.right := q.left; p := p.right; q.left := p.right; p.right := NIL END
  121.                 END;
  122.                 x.left := dmy.right
  123.             END
  124.         END;
  125.         RETURN x
  126.     END Find;
  127.     PROCEDURE ResetDefs;
  128.         VAR def: Definition; seq: Sequence;
  129.     BEGIN defs.right := NIL; defs.trig[0] := 0X; hotKey := "\";
  130.         name := DefaultMacro; def := Find(name, trig, TRUE);
  131.         NEW(def.seq); seq := def.seq;
  132.         seq.sym := cmdSym; seq.cmd := pickCmd;
  133.         NEW(seq.next); seq := seq.next;
  134.         Texts.OpenBuf(WB.buf); Texts.Write(WB, "\");
  135.         seq.sym := stretchSym; seq.stretch := WB.buf;
  136.         NEW(WB.buf); Texts.OpenBuf(WB.buf);
  137.         NEW(seq.next); seq := seq.next;
  138.         seq.sym := cmdSym; seq.cmd := writeCmd
  139.     END ResetDefs;
  140.     PROCEDURE Trigger (VAR trig: Ident): Definition;
  141.         VAR d, x: Definition; i: INTEGER;
  142.     BEGIN d := defs.right; x := NIL;
  143.         WHILE d # NIL DO i := 0;
  144.             WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
  145.             IF trig[i] = d.trig[i] THEN RETURN d END;
  146.             IF d.trig[i] = 0X THEN x := d END;
  147.             IF trig[i] < d.trig[i] THEN d := d.left ELSE d := d.right END
  148.         END;
  149.         RETURN x
  150.     END Trigger;
  151.     (* macro compiler *)
  152.     PROCEDURE Mark (err: ARRAY OF CHAR);
  153.     BEGIN INC(errs);
  154.         IF Texts.Pos(R) - errpos > 9 THEN
  155.             errpos := Texts.Pos(R); Ln; Str("  pos  "); Texts.WriteInt(W, errpos, 0); Gap; Str(err); WLog
  156.         END
  157.     END Mark;
  158.     PROCEDURE GetCh;
  159.     BEGIN Texts.Read(R, ch)
  160.     END GetCh;
  161.     PROCEDURE CharCode;
  162.         VAR c: INTEGER;
  163.     BEGIN c := 0;
  164.         WHILE ("0" <= ch) & (ch <= "9") DO c := c * 10 + SHORT(ORD(ch) - 30H); GetCh END;
  165.         name[0] := CHR(c); name[1] := 0X    (*unchecked*)
  166.     END CharCode;
  167.     PROCEDURE Name;
  168.         VAR i: INTEGER;
  169.     BEGIN i := 0;
  170.         REPEAT name[i] := ch; INC(i); GetCh
  171.         UNTIL (ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot OR (i = IdentLen-1);
  172.         IF ~((ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot) THEN Mark("name too long") END;
  173.         name[i] := 0X
  174.     END Name;
  175.     PROCEDURE Save (text: Texts.Text; beg, end: LONGINT; buf: Texts.Buffer);
  176.     BEGIN
  177.         IF end > beg THEN Texts.Save(text, beg, end, buf) END
  178.     END Save;
  179.     PROCEDURE Stretch;
  180.         VAR beg, end: LONGINT;
  181.     BEGIN beg := Texts.Pos(R); end := beg; GetCh;
  182.         WHILE ~R.eot & (ch # 22X) DO INC(end); GetCh END;
  183.         IF ch = 22X THEN GetCh;
  184.             IF end > beg THEN NEW(stretch); Texts.OpenBuf(stretch); Save(T, beg, end, stretch)
  185.             ELSE Mark("empty stretch")
  186.             END
  187.         ELSE Mark("Closing quote expected")
  188.         END
  189.     END Stretch;
  190.     PROCEDURE Comment;
  191.     BEGIN
  192.         LOOP
  193.             IF ch = "(" THEN GetCh;
  194.                 IF ch = "*" THEN GetCh; Comment END
  195.             ELSIF ch = "*" THEN GetCh;
  196.                 IF ch = ")" THEN GetCh; EXIT END
  197.             ELSE GetCh
  198.             END
  199.         END
  200.     END Comment;
  201.     PROCEDURE GetSym;
  202.     BEGIN sym := eof;
  203.         REPEAT
  204.             IF (0X <= ch) & (ch <= " ") THEN GetCh
  205.             ELSIF ch = 22X THEN sym := stretchSym; Stretch
  206.             ELSIF ch = "#" THEN sym := nameSym; GetCh; CharCode
  207.             ELSIF ch = "(" THEN GetCh; IF ch = "*" THEN GetCh; Comment ELSE sym := lparen END
  208.             ELSIF ch = ")" THEN sym := rparen; GetCh
  209.             ELSIF ch = "\" THEN sym := bslash; GetCh
  210.             ELSIF ch = "^" THEN sym := cmdSym; GetCh; cmd := ch; GetCh
  211.             ELSE sym := nameSym; Name
  212.             END
  213.         UNTIL (sym # eof) OR R.eot
  214.     END GetSym;
  215.     PROCEDURE ParseText;
  216.         VAR def: Definition; beg, seq: Sequence;
  217.     BEGIN GetSym;
  218.         IF sym = bslash THEN
  219.             GetSym; IF sym = nameSym THEN hotKey := name[0]; GetSym ELSE Mark("hot-key code expected") END
  220.         END;
  221.         WHILE sym = nameSym DO GetSym; def := Find(name, trig, TRUE);
  222.             IF sym = lparen THEN
  223.                 GetSym; NEW(beg); seq := beg; beg.next := NIL;
  224.                 WHILE sym IN {cmdSym, nameSym, stretchSym} DO
  225.                     NEW(seq.next); seq := seq.next; seq.sym := sym;
  226.                     IF sym = cmdSym THEN seq.cmd := cmd
  227.                     ELSIF sym = nameSym THEN seq.def := Find(name, trig, FALSE);
  228.                         IF seq.def = NIL THEN Mark("illegal forward reference") END
  229.                     ELSE (*sym = stretchSym*) seq.stretch := stretch
  230.                     END;
  231.                     GetSym
  232.                 END;
  233.                 def.seq := beg.next; IF sym = rparen THEN GetSym ELSE Mark(") expected") END
  234.             ELSE Mark("( expected")
  235.             END
  236.         END;
  237.         IF sym # eof THEN GetSym;
  238.             IF sym # eof THEN Mark("unexpected trailing char.s") END
  239.         END;
  240.         stretch := NIL
  241.     END ParseText;
  242.     PROCEDURE ReadText (name: ARRAY OF CHAR; beg: LONGINT);
  243.     BEGIN Texts.OpenReader(R, T, beg); GetCh;
  244.         IF ~R.eot THEN Str("  reading "); Str(name); WLog; errs := 0; errpos := -10; ParseText;
  245.             IF errs = 0 THEN Str(" done") ELSE ResetDefs END;
  246.             Ln; WLog
  247.         END
  248.     END ReadText;
  249.     (* macro processor *)
  250.     PROCEDURE Insert (frame: TextFrames.Frame; buf: Texts.Buffer);
  251.         VAR pos, len: LONGINT;
  252.     BEGIN pos := frame.carloc.pos; len := buf.len;
  253.         Texts.Insert(frame.text, pos, buf); TextFrames.SetCaret(frame, pos + len)
  254.     END Insert;
  255.     PROCEDURE Delete (frame: TextFrames.Frame; beg, end: LONGINT);
  256.     BEGIN Texts.Delete(frame.text, beg, end); TextFrames.SetCaret(frame, beg)
  257.     END Delete;
  258.     PROCEDURE Err (def: Definition; s: ARRAY OF CHAR);
  259.     BEGIN INC(errs); Gap; Str(s); Str(" in "); FlipStr(def.trig); Ln; WLog
  260.     END Err;
  261.     PROCEDURE PopArg (def: Definition; class: SHORTINT; VAR S: Texts.Scanner; VAR stack: Sequence);
  262.         VAR B: Texts.Buffer;
  263.     BEGIN
  264.         IF stack # NIL THEN T := TextFrames.Text("");
  265.             NEW(B); Texts.OpenBuf(B); Texts.Copy(stack.stretch, B);
  266.             Texts.Append(T, B); Texts.OpenScanner(S, T, 0); Texts.Scan(S); stack := stack.next;
  267.             IF (class >= 0) & (S.class # class) THEN Err(def, "illegal param type") END
  268.         ELSE Err(def, "missing param")
  269.         END
  270.     END PopArg;
  271.     PROCEDURE PushArg (buf: Texts.Buffer; VAR stack: Sequence);
  272.         VAR u: Sequence;
  273.     BEGIN NEW(u); u.next := stack; stack := u; u.stretch := buf
  274.     END PushArg;
  275.     PROCEDURE ThisArg (n: LONGINT; args: Sequence): Sequence;
  276.     BEGIN
  277.         WHILE (n > 0) & (args # NIL) DO DEC(n); args := args.next END;
  278.         RETURN args
  279.     END ThisArg;
  280.     PROCEDURE GetArguments (text: Texts.Text; pos: LONGINT; VAR pin: LONGINT; VAR args: Sequence);
  281.         VAR B: Texts.Buffer; R: Texts.Reader; ch: CHAR;
  282.     BEGIN pin := pos; DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
  283.         IF ch = ":" THEN pin := pos;
  284.             WHILE pos > 0 DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch); (*inv text[pos] = ch*)
  285.                 IF ch <= " " THEN
  286.                     NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
  287.                     pin := pos + 1; RETURN
  288.                 ELSIF ch = ":" THEN
  289.                     NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
  290.                     pin := pos
  291.                 ELSIF (ch = 22X) & (pos = pin - 1) THEN ch := 0X;
  292.                     WHILE (pos > 0) & (ch # 22X) DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch) END;
  293.                     IF ch = 22X THEN
  294.                         NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin - 1, B); PushArg(B, args);
  295.                         pin := pos;
  296.                         DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
  297.                         IF ch = ":" THEN pin := pos END;
  298.                         IF ch <= " " THEN RETURN END
  299.                     ELSE RETURN
  300.                     END
  301.                 END
  302.             END;
  303.             NEW(B); Texts.OpenBuf(B); Save(text, pos, pin, B); PushArg(B, args);
  304.             pin := pos
  305.         END
  306.     END GetArguments;
  307.     PROCEDURE Expand (def: Definition; VAR stack, args, params: Sequence);
  308.         VAR d: Definition; seq, u: Sequence; B: Texts.Buffer; S: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
  309.     BEGIN
  310.         IF ~def.in THEN def.in := TRUE; seq := def.seq;
  311.             WHILE (errs = 0) & (seq # NIL) DO
  312.                 IF seq.sym = cmdSym THEN
  313.                     IF seq.cmd = writeCmd THEN
  314.                         IF stack # NIL THEN Append(stack.stretch, buf); stack := stack.next
  315.                         ELSE Err(def, "missing param")
  316.                         END
  317.                     ELSIF seq.cmd = charCmd THEN PopArg(def, Texts.Int, S, stack);
  318.                         Texts.Write(WB, CHR(S.i)); Append(WB.buf, buf)
  319.                     ELSIF seq.cmd = fntCmd THEN PopArg(def, Texts.Name, S, stack);
  320.                         INCL(preset.set, fntPreset); preset.fnt := Fonts.This(S.s)
  321.                     ELSIF seq.cmd = voffCmd THEN PopArg(def, Texts.Int, S, stack);
  322.                         INCL(preset.set, voffPreset); preset.voff := SHORT(SHORT(S.i))
  323.                     ELSIF seq.cmd = callCmd THEN PopArg(def, Texts.Name, S, stack);
  324.                         IF errs = 0 THEN NEW(par); par.vwr := Oberon.FocusViewer; par.frame := par.vwr.dsc.next;
  325.                             IF params # NIL THEN
  326.                                 par.text := TextFrames.Text("");
  327.                                 WHILE params # NIL DO Texts.Insert(par.text, 0, params.stretch);
  328.                                     params := params.next
  329.                                 END;
  330.                                 NEW(B); Texts.OpenBuf(B);
  331.                                 Texts.Save(T, Texts.Pos(S) - 1, T.len, B); Texts.Append(par.text, B);
  332.                                 par.pos := 0
  333.                             ELSE par.text := T; par.pos := Texts.Pos(S)
  334.                             END;
  335.                             Oberon.Call(S.s, par, FALSE, res);
  336.                             IF res # 0 THEN Texts.WriteInt(W, res, 3); Err(def, "call error ") END
  337.                         END
  338.                     ELSIF seq.cmd = argCmd THEN PopArg(def, Texts.Int, S, stack);
  339.                         IF errs = 0 THEN u := ThisArg(S.i, args);
  340.                             IF u # NIL THEN NEW(B); Texts.OpenBuf(B); Texts.Copy(u.stretch, B); PushArg(B, stack)
  341.                             ELSE Err(def, "missing argument")
  342.                             END
  343.                         END
  344.                     ELSIF seq.cmd = execCmd THEN PopArg(def, Texts.Name, S, stack);
  345.                         IF errs = 0 THEN COPY(S.s, name); d := Find(name, trig, FALSE);
  346.                             IF d # NIL THEN Expand(d, stack, args, params)
  347.                             ELSE Err(def, "exec of undefined macro")
  348.                             END
  349.                         END
  350.                     ELSIF seq.cmd = paramCmd THEN
  351.                         IF stack # NIL THEN u := stack; stack := stack.next; u.next := params; params := u
  352.                         ELSE Err(def, "missing param")
  353.                         END
  354.                     ELSIF seq.cmd = keepCmd THEN INCL(preset.set, fntPreset); preset.fnt := preset.def
  355.                     ELSIF seq.cmd = pickCmd THEN INCL(preset.set, pickPreset)
  356.                     ELSIF seq.cmd = caretCmd THEN INCL(preset.set, caretPreset); preset.caret := buf.len
  357.                     ELSIF seq.cmd = indentCmd THEN
  358.                         IF indent.len > 0 THEN Texts.Copy(indent, buf) END
  359.                     ELSIF seq.cmd = freezeCmd THEN INCL(preset.set, freezePreset)
  360.                     ELSE Err(def, "illegal built-in")
  361.                     END
  362.                 ELSIF seq.sym = nameSym THEN Expand(seq.def, stack, args, params)
  363.                 ELSE (*seq.sym = stretchSym*)
  364.                     NEW(B); Texts.OpenBuf(B); Texts.Copy(seq.stretch, B); PushArg(B, stack)
  365.                 END;
  366.                 seq := seq.next
  367.             END;
  368.             def.in := FALSE
  369.         ELSE Err(def, "cyclic expansion")
  370.         END
  371.     END Expand;
  372.     PROCEDURE InitialExec (name: Ident);
  373.         VAR def: Definition; stack, args, params: Sequence; trig: Ident;
  374.     BEGIN def := Find(name, trig, FALSE);
  375.         IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL; errs := 0;
  376.             Expand(def, stack, args, params);
  377.             IF stack # NIL THEN Err(def, "superfluous param") END
  378.         END
  379.     END InitialExec;
  380.     PROCEDURE Process (frame: TextFrames.Frame; VAR del: LONGINT);
  381.         VAR def: Definition; org, pos, i, tlen, pin: LONGINT; stack, args, params: Sequence; default: BOOLEAN;
  382. dmy: Texts.Reader;
  383.     BEGIN errs := 0; del := 0; Texts.OpenBuf(buf); org := frame.carloc.pos;
  384.         pos := org - (IdentLen-1);
  385.         IF pos >= 0 THEN i := IdentLen-1 ELSE pos := 0; i := org END;
  386.         trig[i] := 0X; Texts.OpenReader(R, frame.text, pos);
  387.         WHILE i > 0 DO DEC(i); Texts.Read(R, trig[i]) END;
  388.         def := Trigger(trig);
  389.         IF def # NIL THEN default := FALSE; tlen := 0;
  390.             WHILE def.trig[tlen] # 0X DO INC(tlen) END
  391.         ELSE default := TRUE; name := DefaultMacro; def := Find(name, trig, FALSE); tlen := 0
  392.         END;
  393.         IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL;
  394.             GetArguments(frame.text, org - tlen, pin, args);
  395. Texts.OpenReader(dmy, frame.text, 0);
  396.             Expand(def, stack, args, params);
  397.             IF stack # NIL THEN Err(def, "superfluous param") END;
  398.             IF errs = 0 THEN
  399.                 IF ~default THEN del := org - pin END;
  400.                 preset.frame := frame; preset.pos := frame.carloc.pos - del;
  401.                 IF caretPreset IN preset.set THEN INC(preset.pos, preset.caret) ELSE INC(preset.pos, buf.len) END
  402.             END
  403.         END
  404.     END Process;
  405.     (* editor interface *)
  406.     PROCEDURE Key (frame: TextFrames.Frame; ch: CHAR; VAR handled: BOOLEAN);
  407.         CONST TAB = 9X; LF = 0AX; CR = 0DX;
  408.         VAR del, pos, beg: LONGINT; voff: SHORTINT; fnt: Fonts.Font; ch1: CHAR;
  409.     BEGIN handled := TRUE; pos := frame.carloc.pos;
  410.         IF frame.text.len > 0 THEN
  411.             IF pos < frame.text.len THEN Texts.OpenReader(R, frame.text, pos); Texts.Read(R, ch1) END;
  412.             IF (pos > 0) & ((pos = frame.text.len) OR (ch1 <= " ")) THEN
  413.                 Texts.OpenReader(R, frame.text, pos - 1); Texts.Read(R, ch1)
  414.             END;
  415.             preset.def := R.fnt; Texts.SetColor(WL, R.col);
  416.             IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(WL, Oberon.CurOff)
  417.             ELSE Texts.SetOffset(WL, R.voff)
  418.             END
  419.         ELSE preset.def :=  Oberon.CurFnt; Texts.SetColor(WL, Oberon.CurCol); Texts.SetOffset(WL, Oberon.CurOff)
  420.         END;
  421.         fnt := preset.def; voff := WL.voff;
  422.         IF (preset.frame = frame) & (preset.pos = pos) THEN
  423.             IF fntPreset IN preset.set THEN fnt := preset.fnt END;
  424.             IF voffPreset IN preset.set THEN voff := preset.voff END
  425.         END;
  426.         preset.set := {}; preset.frame := NIL;
  427.         IF WL.fnt # fnt THEN Texts.SetFont(WL, fnt) END;
  428.         IF WL.voff # voff THEN Texts.SetOffset(WL, voff) END;
  429.         IF ch = hotKey THEN beg := frame.carloc.org; Texts.OpenReader(R, frame.text, beg); Texts.Read(R, ch1);
  430.             WHILE (Texts.Pos(R) <= pos) & (ch1 <= " ") DO Texts.Read(R, ch1) END;
  431.             Texts.OpenBuf(indent); Save(frame.text, beg, Texts.Pos(R) - 1, indent);
  432.             Process(frame, del);
  433.             IF ~(freezePreset IN preset.set) & (errs = 0) THEN
  434.                 IF frame.hasCar & (frame.carloc.pos # pos) THEN preset.pos := frame.carloc.pos - del END;
  435.                 TextFrames.SetCaret(frame, pos);
  436.                 IF del > 0 THEN Delete(frame, pos - del, pos) END;
  437.                 IF pickPreset IN preset.set THEN T := TextFrames.Text("");
  438.                     Texts.Append(T, buf); Texts.ChangeLooks(T, 0, T.len, {0}, preset.def, 0, 0);
  439.                     Save(T, 0, T.len, buf)
  440.                 END;
  441.                 Insert(frame, buf)
  442.             ELSE TextFrames.RemoveCaret(frame); preset.pos := frame.carloc.pos
  443.             END;
  444.             IF (0 <= preset.pos) & (preset.pos <= frame.text.len) THEN
  445.                 TextFrames.SetCaret(frame, preset.pos)
  446.             END
  447.         (*ELSIF (ch >= " ") & (ch # DEL) & (ch < 95X) OR (ch = 9BX) OR (ch = 9FX) THEN Texts.Write(WL, ch)*)
  448.         ELSE handled := FALSE
  449.         END;
  450.         IF (WL.buf.len > 0) & frame.hasCar THEN Insert(frame, WL.buf) END
  451.     END Key;
  452.     PROCEDURE KeyHandle*(f: Display.Frame; VAR msg: Display.FrameMsg);    (*<<*)
  453.         CONST InvalMsg = -1;
  454.         VAR frame: TextFrames.Frame; handled: BOOLEAN;
  455.     BEGIN
  456.         IF msg IS Oberon.InputMsg THEN
  457.             WITH msg: Oberon.InputMsg DO
  458.                 frame := f(TextFrames.Frame);
  459.                 IF (msg.id = Oberon.consume) & frame.hasCar THEN
  460.                     Key(frame, msg.ch, handled);
  461.                     IF handled THEN msg.id := InvalMsg END
  462.                 ELSIF (msg.id = Oberon.track) & (msg.keys # {}) THEN preset.set := {}
  463.                 END
  464.             END
  465.         END
  466.     END KeyHandle;
  467.     PROCEDURE Handle* (F: Display.Frame; VAR msg: Display.FrameMsg);
  468.     BEGIN KeyHandle(F, msg); TextFrames.Handle(F, msg)
  469.     END Handle;
  470.     (* commands *)
  471.     PROCEDURE GetMainArg (VAR S: Texts.Scanner; VAR end: LONGINT);
  472.         (*after command or (^) at selection; end of selection or -1*)
  473.         VAR text: Texts.Text; beg, time: LONGINT;
  474.     BEGIN Texts.Scan(S); end := -1;
  475.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time);
  476.             IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  477.         END;
  478.         IF S.line # 0 THEN S.class := Texts.Inval END
  479.     END GetMainArg;
  480.     PROCEDURE ShowPos (F: TextFrames.Frame; pos: LONGINT);
  481.         VAR beg, end, delta: LONGINT;
  482.     BEGIN delta := 200;
  483.         LOOP beg := F.org; end := TextFrames.Pos(F, F.X + F.W, F.Y);
  484.             IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END;
  485.             TextFrames.Show(F, pos - delta); DEC(delta, 20)
  486.         END
  487.     END ShowPos;
  488.     PROCEDURE NewView (name: ARRAY OF CHAR; class: INTEGER;
  489.             T: Texts.Text; org: LONGINT; sys: BOOLEAN): TextFrames.Frame;
  490.         VAR V: MenuViewers.Viewer; F, M: TextFrames.Frame; buf: Texts.Buffer; i, x, y: INTEGER;
  491.     BEGIN
  492.         IF class = Texts.String THEN i := 0;
  493.             WHILE name[i] # 0X DO INC(i) END;
  494.             name[i] := 22X; INC(i); name[i] := 0X;
  495.             WHILE i >= 0 DO name[i+1] := name[i]; DEC(i) END;
  496.             name[0] := 22X
  497.         END;
  498.         F := TextFrames.NewText(T, org);
  499.         F.handle := Handle;
  500.         IF sys THEN Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  501.             V := MenuViewers.New(TextFrames.NewMenu(name, SysMenu), F, TextFrames.menuH, x, y)
  502.         ELSE Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  503.             IF Files.Old("Edit.Menu.Text") = NIL THEN M := TextFrames.NewMenu(name, Menu)
  504.             ELSE M := TextFrames.NewMenu(name, "");
  505.                 NEW(T); Texts.Open(T, "Edit.Menu.Text");
  506.                 NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(M.text, buf)
  507.             END;
  508.             V := MenuViewers.New(M, F, TextFrames.menuH, x, y)
  509.         END;
  510.         ShowPos(F, org);
  511.         RETURN F
  512.     END NewView;
  513.     PROCEDURE Open*;
  514.         VAR S: Texts.Scanner; F: TextFrames.Frame; end: LONGINT;
  515.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S, end);
  516.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  517.             F := NewView(S.s, S.class, TextFrames.Text(S.s), 0, FALSE)
  518.         END
  519.     END Open;
  520.     PROCEDURE SysOpen*;
  521.         VAR S: Texts.Scanner; F: TextFrames.Frame; end: LONGINT;
  522.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); GetMainArg(S, end);
  523.         IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
  524.             F := NewView(S.s, S.class, TextFrames.Text(S.s), 0, TRUE)
  525.         END
  526.     END SysOpen;
  527.     PROCEDURE Upgrade*;    (*<< ww *)
  528.         VAR v: Viewers.Viewer; f: Display.Frame; hT, h: Display.Handler;
  529.     BEGIN v := Oberon.MarkedViewer();
  530.         IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN f := v.dsc.next; hT := TextFrames.Handle; h := Handle;
  531.             IF f.handle = hT THEN f.handle := h
  532.             ELSIF f.handle # h THEN Str("EditKeys.Upgrade: Not a TextFrame."); Ln; WLog
  533.             END
  534.         END
  535.     END Upgrade;
  536.     PROCEDURE GetKeyHandler*;    (*<<*)
  537.         CONST Magic = -42;
  538.     BEGIN
  539.         IF Oberon.Par.pos = Magic THEN Oberon.Par.frame.handle := KeyHandle END
  540.     END GetKeyHandler;
  541.     PROCEDURE Reset*;
  542.     BEGIN ResetDefs
  543.     END Reset;
  544.     PROCEDURE Read*;
  545.         VAR S: Texts.Scanner; text: Texts.Text; beg, end, time: LONGINT;
  546.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  547.         IF (S.class = Texts.Char) & (S.c = "@") & (S.line = 0) THEN
  548.             Oberon.GetSelection(text, beg, end, time);
  549.             IF time > 0 THEN T := text; ReadText(" @ ", beg) END
  550.         ELSIF (S.class = Texts.Char) & (S.c = ":") & (S.nextCh = "=") & (S.line = 0) THEN Texts.Scan(S);
  551.             T := Oberon.Par.text; ReadText(" := ", Texts.Pos(S) - 1)
  552.         ELSE
  553.             IF (S.class = Texts.Char) & (S.c = "^") & (S.line = 0) THEN
  554.                 Oberon.GetSelection(text, beg, end, time);
  555.                 IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  556.             END;
  557.             WHILE S.class = Texts.Name DO T := TextFrames.Text(S.s); ReadText(S.s, 0); Texts.Scan(S) END
  558.         END;
  559.         T := NIL
  560.     END Read;
  561.     PROCEDURE Definitions*;
  562.         VAR S: Texts.Scanner; V: MenuViewers.Viewer; T, text: Texts.Text; tree: Definition;
  563.             beg, end, time: LONGINT; x, y: INTEGER;
  564.         PROCEDURE Sort(VAR d: Definition; VAR pat: ARRAY OF CHAR; VAR tree: Definition);
  565.             VAR i: INTEGER; t: Definition; n: Ident;
  566.             PROCEDURE Ins(VAR tree: Definition; t: Definition; VAR n: Ident);
  567.                 VAR m: Ident;
  568.             BEGIN
  569.                 IF tree = NIL THEN tree := t
  570.                 ELSE Flip(tree.trig, m);
  571.                     IF n < m THEN Ins(tree.left, t, n) ELSE Ins(tree.right, t, n) END
  572.                 END
  573.             END Ins;
  574.         BEGIN
  575.             IF d # NIL THEN Flip(d.trig, n); i := 0;
  576.                 WHILE (pat[i] # 0X) & (n[i] = pat[i]) DO INC(i) END;
  577.                 IF pat[i] = 0X THEN NEW(t); t^ := d^; t.left := NIL; t.right := NIL; Ins(tree, t, n) END;
  578.                 Sort(d.left, pat, tree); Sort(d.right, pat, tree)
  579.             END
  580.         END Sort;
  581.         PROCEDURE Write(tree: Definition);
  582.             PROCEDURE Seq(seq: Sequence);
  583.                 VAR b: Texts.Buffer;
  584.             BEGIN
  585.                 WHILE seq # NIL DO
  586.                     IF seq.sym = cmdSym THEN Ch("^"); Ch(seq.cmd)
  587.                     ELSIF seq.sym = nameSym THEN
  588.                         IF (name[1] = 0X) & ((name[0] < " ") OR (name[0] > 7EX)) THEN Char(name[0])
  589.                         ELSE FlipStr(seq.def.trig)
  590.                         END
  591.                     ELSE (*seq.sym = stretchSym*) Ch(22X); Append(W.buf, buf);
  592.                         NEW(b); Texts.OpenBuf(b); Texts.Copy(seq.stretch, b); Append(b, buf); Ch(22X)
  593.                     END;
  594.                     seq := seq.next; IF seq # NIL THEN Ch(" ") END
  595.                 END
  596.             END Seq;
  597.         BEGIN
  598.             IF tree # NIL THEN
  599.                 Write(tree.left); Gap; FlipStr(tree.trig); Gap; Ch("("); Seq(tree.seq); Ch(")"); Ln; Write(tree.right)
  600.             END
  601.         END Write;
  602.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  603.         IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN
  604.             Oberon.GetSelection(text, beg, end, time);
  605.             IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  606.         END;
  607.         IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN S.s[0] := 0X END;
  608.         Str("(hotkey is "); Char(hotKey); Ch(")"); Ln;
  609.         tree := NIL; Sort(defs.right, S.s, tree); Texts.OpenBuf(buf); Write(tree); Append(W.buf, buf);
  610.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); T := TextFrames.Text("");
  611.         Texts.Append(T, buf);
  612.         V := MenuViewers.New(TextFrames.NewMenu("EditKeys.Definitions", Menu),
  613.             TextFrames.NewText(T, 0), TextFrames.menuH, x, y)
  614.     END Definitions;
  615.     PROCEDURE GetKeyCode*;    (*<<*)
  616.     BEGIN Str("EditKeys.GetKeyCode  ('q' to quit)"); WLog;
  617.         REPEAT Input.Read(ch); Ln; Gap; Char(ch); WLog UNTIL ch = "q";
  618.         Ln; WLog
  619.     END GetKeyCode;
  620. BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WB); 
  621.     Texts.OpenWriter(WL);
  622.     NEW(defs); NEW(dmy); NEW(buf); NEW(indent);
  623.     map := "0123456789ABCDEF";
  624.     ResetDefs;
  625.     T := TextFrames.Text(DefaultFile); ReadText(DefaultFile, 0); T := NIL;
  626.     InitialExec(InstallMacro)
  627. END EditKeys.
  628.