home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / versionelems.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  9KB  |  258 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 22 Apr 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. FoldElems
  8. MODULE VersionElems;    (* HM 14 Sep 95 / 
  9. IMPORT Display, Viewers, Files, Input, Texts, TextFrames, TextPrinter, Oberon, PopupElems, In, Out;
  10. CONST
  11.     maxVersions = 8;
  12.     pixel = LONG(10000);
  13.     ML = 2; MM = 1; MR = 0;
  14.     Beg* = POINTER TO BegDesc;
  15.     BegDesc* = RECORD (PopupElems.ElemDesc)
  16.         cur: ARRAY 32 OF CHAR;    (*current version*)
  17.         vers: ARRAY maxVersions, 32 OF CHAR;    (*version names*)
  18.         buf: ARRAY maxVersions OF Texts.Buffer    (*version texts*)
  19.     END ;
  20.     End* = POINTER TO EndDesc;
  21.     EndDesc* = RECORD (Texts.ElemDesc) END ;
  22.     begIcon, endIcon: Display.Pattern;    (* x = 0, y = 3, w = 6, h = 9 *)
  23.     scratch: Texts.Text;
  24.     w: Texts.Writer;
  25. PROCEDURE (e: Beg) IndexOf (version: ARRAY OF CHAR): INTEGER;    
  26.     VAR i: INTEGER;
  27. BEGIN
  28.     i := 0;
  29.     WHILE (i < maxVersions) & (e.vers[i] # "") DO
  30.         IF e.vers[i] = version THEN RETURN i END;
  31.         INC(i)
  32.     END;
  33.     RETURN -1
  34. END IndexOf;
  35. PROCEDURE (e: Beg) CheckMenu;    
  36.     VAR s: Texts.Scanner; vers: ARRAY maxVersions, 32 OF CHAR; buf: ARRAY maxVersions OF Texts.Buffer; i, j: INTEGER;
  37. BEGIN
  38.     Texts.OpenScanner(s, e.menu, 0); i := 0;
  39.     REPEAT
  40.         Texts.Scan(s);
  41.         IF (i < maxVersions) & (s.class = Texts.Name) THEN
  42.             COPY(s.s, vers[i]);
  43.             j := e.IndexOf(s.s);
  44.             IF j >= 0 THEN buf[i] := e.buf[j] ELSE NEW(buf[i]); Texts.OpenBuf(buf[i]) END;
  45.             INC(i)
  46.         END
  47.     UNTIL s.eot;
  48.     FOR j := 0 TO i-1 DO COPY(vers[j], e.vers[j]); e.buf[j] := buf[j] END;
  49.     IF i < maxVersions THEN e.vers[i] := "" END
  50. END CheckMenu;
  51. PROCEDURE (e: Beg) TwinPos (): LONGINT;    
  52.     VAR r: Texts.Reader; level: INTEGER;
  53. BEGIN
  54.     Texts.OpenReader(r, Texts.ElemBase(e), Texts.ElemPos(e)+1);
  55.     level := 1;
  56.     LOOP
  57.         Texts.ReadElem(r);
  58.         IF r.eot THEN RETURN -1
  59.         ELSIF r.elem IS Beg THEN INC(level)
  60.         ELSIF r.elem IS End THEN DEC(level);
  61.             IF level = 0 THEN RETURN Texts.Pos(r) - 1 END
  62.         END
  63. END TwinPos;
  64. PROCEDURE (e: Beg) SwitchTo (version: ARRAY OF CHAR);    
  65.     VAR t: Texts.Text; beg, end: LONGINT; i, j: INTEGER;
  66. BEGIN
  67.     e.CheckMenu;
  68.     IF version # e.cur THEN
  69.         i := e.IndexOf(version); j := e.IndexOf(e.cur);
  70.         IF i >= 0 THEN
  71.             t := Texts.ElemBase(e); beg := Texts.ElemPos(e) + 1; end := e.TwinPos();
  72.             IF end >= 0 THEN 
  73.                 Texts.Delete(t, beg, end);
  74.                 Texts.Insert(t, beg, e.buf[i]);
  75.                 IF j >= 0 THEN Texts.Recall(e.buf[j]) END;
  76.                 COPY(version, e.cur)
  77.             END
  78.         ELSE Out.String("-- no version "); Out.String(version); Out.F(" at pos #$", Texts.ElemPos(e))
  79.         END
  80. END SwitchTo;
  81. PROCEDURE InitIcons;    
  82.     VAR line: ARRAY 10 OF SET;
  83. BEGIN
  84.     line[1] := {4};
  85.     line[2] := {3};
  86.     line[3] := {2};
  87.     line[4] := {1};
  88.     line[5] := {0};
  89.     line[6] := {1};
  90.     line[7] := {2};
  91.     line[8] := {3};
  92.     line[9] := {4};
  93.     begIcon := Display.NewPattern(line, 6, 9);
  94.     line[1] := {1};
  95.     line[2] := {2};
  96.     line[3] := {3};
  97.     line[4] := {4};
  98.     line[5] := {5};
  99.     line[6] := {4};
  100.     line[7] := {3};
  101.     line[8] := {2};
  102.     line[9] := {1};
  103.     endIcon := Display.NewPattern(line, 6, 9);
  104. END InitIcons;
  105. PROCEDURE NoNotify (t: Texts.Text; op: INTEGER; beg, end: LONGINT);    
  106. END NoNotify;
  107. PROCEDURE SwitchAll (t: Texts.Text; version: ARRAY OF CHAR);    
  108.     VAR r: Texts.Reader; pos: LONGINT; e: Beg;
  109. BEGIN
  110.     Texts.OpenReader(r, t, 0);
  111.     LOOP
  112.         Texts.ReadElem(r);
  113.         IF r.eot THEN EXIT END;
  114.         IF r.elem IS Beg THEN
  115.             pos := Texts.Pos(r) + 1; e := r.elem(Beg); e.SwitchTo(version); Texts.OpenReader(r, t, pos)
  116.         END
  117. END SwitchAll;
  118. PROCEDURE ShowPos (f: TextFrames.Frame; pos: LONGINT);    
  119.     VAR beg, end, delta: LONGINT;
  120. BEGIN delta := 200;
  121.     LOOP beg := f.org; end := TextFrames.Pos(f, f.X + f.W, f.Y);
  122.         IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END;
  123.         TextFrames.Show(f, pos - delta); delta := delta DIV 2
  124.     END;
  125.     TextFrames.SetCaret(f, pos)
  126. END ShowPos;
  127. PROCEDURE HandleBeg* (e: Texts.Elem; VAR m: Texts.ElemMsg);    
  128.     VAR e1: Beg; i: INTEGER; str: ARRAY 32 OF CHAR; s: Texts.Scanner;
  129. BEGIN
  130.     WITH e: Beg DO
  131.         WITH m: TextFrames.DisplayMsg DO
  132.             e.W := 6*pixel; e.H := 9*pixel;
  133.             IF ~m.prepare THEN
  134.                 Display.CopyPattern(Display.white, begIcon, m.X0, m.Y0+3, Display.paint)
  135.             END
  136.         | m: TextPrinter.PrintMsg DO
  137.             IF m.prepare THEN e.W := 1 ELSE e.W := 7*pixel END
  138.         | m: Texts.CopyMsg DO
  139.             IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(Beg) END ;
  140.             COPY(e.cur, e1.cur); i := 0;
  141.             WHILE (i < maxVersions) & (e.vers[i] # "") DO
  142.                 COPY(e.vers[i], e1.vers[i]);
  143.                 NEW(e1.buf[i]); Texts.OpenBuf(e1.buf[i]); Texts.Copy(e.buf[i], e1.buf[i]);
  144.                 INC(i)
  145.             END ;
  146.             PopupElems.Handle(e, m)
  147.         | m: Texts.IdentifyMsg DO
  148.             m.mod := "VersionElems"; m.proc := "AllocBeg"
  149.         | m: Texts.FileMsg DO
  150.             PopupElems.Handle(e, m);
  151.             IF m.id = Texts.load THEN
  152.                 Files.ReadString(m.r, e.cur);
  153.                 Files.ReadString(m.r, str); i := 0;
  154.                 WHILE str # "" DO
  155.                     COPY(str, e.vers[i]);
  156.                     Texts.Load(m.r, scratch); Texts.Delete(scratch, 0, scratch.len);
  157.                     NEW(e.buf[i]); Texts.Recall(e.buf[i]);
  158.                     INC(i); Files.ReadString(m.r, str)
  159.                 END
  160.             ELSE (*Texts.store*)
  161.                 Files.WriteString(m.r, e.cur); i := 0;
  162.                 WHILE (i < maxVersions) & (e.vers[i] # "") DO
  163.                     Files.WriteString(m.r, e.vers[i]);
  164.                     Texts.Append(scratch, e.buf[i]); Texts.Store(m.r, scratch);
  165.                     Texts.Delete(scratch, 0, scratch.len); Texts.Recall(e.buf[i]);
  166.                     INC(i)
  167.                 END ;
  168.                 Files.WriteString(m.r, "")
  169.             END
  170.         | m: PopupElems.ExecMsg DO
  171.             Texts.OpenScanner(s, e.menu, m.pos); Texts.Scan(s);
  172.             IF s.class = Texts.Name THEN SwitchAll(Texts.ElemBase(e), s.s) END
  173.         ELSE PopupElems.Handle(e, m)
  174.         END
  175. END HandleBeg;
  176. PROCEDURE HandleEnd* (e: Texts.Elem; VAR m: Texts.ElemMsg);    
  177.     VAR e1: End; keys: SET; x, y: INTEGER;
  178. BEGIN
  179.     WITH e: End DO
  180.         WITH m: TextFrames.DisplayMsg DO
  181.             e.W := 6 * TextFrames.Unit; e.H := 9 * TextFrames.Unit;
  182.             IF ~m.prepare THEN
  183.                 Display.CopyPattern(Display.white, endIcon, m.X0, m.Y0+3, Display.paint)
  184.             END
  185.         | m: TextPrinter.PrintMsg DO
  186.             IF m.prepare THEN e.W := 1 ELSE e.W := 7*pixel END
  187.         | m: Texts.CopyMsg DO
  188.             IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(End) END ;
  189.             Texts.CopyElem(e, e1)
  190.         | m: Texts.IdentifyMsg DO
  191.             m.mod := "VersionElems"; m.proc := "AllocEnd"
  192.         | m: TextFrames.TrackMsg DO
  193.             IF m.keys = {MM} THEN
  194.                 REPEAT
  195.                     Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  196.                 UNTIL keys = {}
  197.             END
  198.         ELSE
  199.         END
  200. END HandleEnd;
  201. PROCEDURE AllocBeg*;    
  202.     VAR e: Beg;
  203. BEGIN
  204.     NEW(e); e.handle := HandleBeg; Texts.new := e
  205. END AllocBeg;
  206. PROCEDURE AllocEnd*;    
  207.     VAR e: End;
  208. BEGIN
  209.     NEW(e); e.handle := HandleEnd; Texts.new := e
  210. END AllocEnd;
  211. PROCEDURE Insert*;    
  212.     VAR a: Beg; b: End; t: Texts.Text; beg, end, time: LONGINT; s: Texts.Scanner;
  213. BEGIN
  214.     Oberon.GetSelection(t, beg, end, time);
  215.     IF time >= 0 THEN
  216.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  217.         IF s.class = Texts.Name THEN
  218.             NEW(a);
  219.             a.W := 7*pixel; a.H := 11*pixel; a.handle := HandleBeg; COPY(s.s, a.cur);
  220.             a.menu := TextFrames.Text("");
  221.             Texts.WriteString(w, s.s); Texts.Append(a.menu, w.buf); PopupElems.MeasureMenu(a);
  222.             Texts.WriteElem(w, a); Texts.Insert(t, beg, w.buf);
  223.             NEW(b);
  224.             b.W := 7*pixel; b.H := 11*pixel; b.handle := HandleEnd;
  225.             Texts.WriteElem(w, b); Texts.Insert(t, end+1, w.buf)
  226.         ELSE Out.String("-- version name must be an Oberon name$")
  227.         END
  228.     ELSE Out.String("-- no selection$")
  229. END Insert;
  230. PROCEDURE SetVersion*;    
  231.     VAR version: ARRAY 32 OF CHAR; v: Viewers.Viewer; t: Texts.Text;
  232. BEGIN
  233.     In.Open; In.Name(version);
  234.     IF In.Done THEN
  235.         v := Oberon.MarkedViewer();
  236.         IF (v # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  237.             t := v.dsc.next(TextFrames.Frame).text;
  238.             SwitchAll(t, version)
  239.         END
  240.     ELSE Out.String("-- version name must be an Oberon name$")
  241. END SetVersion;
  242. PROCEDURE Find*;    
  243.     VAR v: Viewers.Viewer; f: TextFrames.Frame; r: Texts.Reader; pos: LONGINT;
  244. BEGIN
  245.     v := Oberon.FocusViewer;
  246.     IF (v # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  247.         f := v.dsc.next(TextFrames.Frame);
  248.         IF f.hasCar THEN pos := f.carloc.pos ELSE pos := 0 END;
  249.         Texts.OpenReader(r, f.text, pos);
  250.         REPEAT Texts.ReadElem(r) UNTIL r.eot OR (r.elem IS Beg);
  251.         IF ~r.eot THEN ShowPos(f, Texts.Pos(r)) ELSE TextFrames.RemoveCaret(f) END
  252. END Find;
  253. BEGIN
  254.     InitIcons;
  255.     Texts.OpenWriter(w);
  256.     NEW(scratch); Texts.Open(scratch, ""); scratch.notify := NoNotify
  257. END VersionElems.
  258.