ð#Oberon10.Scn.FntM/M/MODULE ArchiveElems; (* MH 16.6.1994 *) IMPORT Display, Input, Fonts, Files, Texts, Oberon, TextFrames, TextPrinter, Viewers, MenuViewers; CONST Color = TRUE; ElemBackg = 11; Menu = "System.Close System.Copy System.Close ArchiveElems.Update "; CR = 0DX; MM = 1; DUnit = TextFrames.Unit; PUnit = TextPrinter.Unit; ArchTag = 0EEX; TYPE Elem* = POINTER TO ElemDesc; ElemDesc = RECORD (Texts.ElemDesc) label: ARRAY 128 OF CHAR; isMail: BOOLEAN; text: Texts.Text; base: Files.File; pos, len: LONGINT; END ; Viewer = POINTER TO ViewerDesc; ViewerDesc = RECORD(MenuViewers.ViewerDesc) elem: Elem END ; PROCEDURE Append (VAR s: ARRAY OF CHAR; suff: ARRAY OF CHAR); VAR i, j, max: LONGINT; BEGIN i := 0; j := 0; max := LEN(s)-1; WHILE s[i] # 0X DO INC(i) END ; WHILE (i < max) & (suff[j] # 0X) DO s[i] := suff[j]; INC(i); INC(j) END ; s[i] := 0X; END Append; PROCEDURE TextCopy (of: Texts.Text; beg, end: LONGINT): Texts.Text; VAR buf: Texts.Buffer; t: Texts.Text; BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.Save(of, beg, end, buf); t := TextFrames.Text(""); Texts.Append(t, buf); RETURN t END TextCopy; PROCEDURE LoadText (e: Elem); VAR r: Files.Rider; BEGIN Files.Set(r, e.base, e.pos); e.text := TextFrames.Text(""); Texts.Load(r, e.text); END LoadText; PROCEDURE OpenViewer (e: Elem); VAR V: Viewer; menu: TextFrames.Frame; body: TextFrames.Frame; x, y: INTEGER; restore: Viewers.ViewerMsg; BEGIN IF e.text = NIL THEN LoadText(e) END ; Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y); IF e.isMail THEN menu := TextFrames.NewMenu("", Menu) ELSE menu := TextFrames.NewMenu(e.label, Menu) END ; body := TextFrames.NewText(TextCopy(e.text, 0, e.text.len), 0); NEW(V); V.handle := MenuViewers.Handle; V.dsc := menu; V.dsc.next := body; V.menuH := TextFrames.menuH; V.elem := e; Viewers.Open(V, x, y); restore.id := Viewers.restore; V.handle(V, restore) END OpenViewer; PROCEDURE UnmarkMenu (V: Viewers.Viewer); VAR R: Texts.Reader; T: Texts.Text; ch: CHAR; BEGIN T := V.dsc(TextFrames.Frame).text; Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch); IF ch = "!" THEN Texts.Delete(T, T.len - 1, T.len) END END UnmarkMenu; PROCEDURE Changed (e: Elem); VAR R: Texts.Reader; T: Texts.Text; BEGIN T := Texts.ElemBase(e); IF T # NIL THEN Texts.OpenReader(R, T, 0); REPEAT Texts.ReadElem(R) UNTIL R.elem = e; T.notify(T, Texts.replace, Texts.Pos(R)-1, Texts.Pos(R)) END END Changed; PROCEDURE ParseMail (mail: Texts.Text; VAR sender, subject: ARRAY OF CHAR); CONST LineLen = 128; VAR line: ARRAY LineLen OF CHAR; R: Texts.Reader; senderFound, subjectFound: BOOLEAN; PROCEDURE ReadLine; VAR ch: CHAR; i: INTEGER; BEGIN i := 0; REPEAT Texts.Read(R, ch); IF i < LineLen-1 THEN line[i] := ch; INC(i) END ; UNTIL R.eot OR (ch = CR); IF ch = CR THEN DEC(i) END ; line[i] := 0X; END ReadLine; PROCEDURE matches (s: ARRAY OF CHAR): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE s[i] # 0X DO IF CAP(s[i]) # CAP(line[i]) THEN RETURN FALSE END ; INC(i); END ; RETURN TRUE; END matches; PROCEDURE extractSender; VAR i,j: INTEGER; ch: CHAR; BEGIN i := 0; ch := line[0]; WHILE ch # 0X DO IF (ch = "(") OR (ch = 22X) THEN INC(i); ch := line[i]; j := 0; WHILE (ch # ")") & (ch # 22X) & (ch # 0X) DO sender[j] := ch; INC(i); INC(j); ch := line[i] END ; sender[j] := 0X; RETURN ELSIF ch = "<" THEN IF (i > 10) & (line[i-1] = " ") THEN j := 0; i := 5; (* pos after "FROM:" *) WHILE line[i] <= " " DO INC(i) END ; WHILE line[i] # "<" DO sender[j] := line[i]; INC(i); INC(j) END ; WHILE sender[i-1] <= " " DO DEC(i) END ; sender[i] := 0X; RETURN ELSE INC(i); ch := line[i]; j := 0; WHILE (ch # ">") & (ch # 0X) DO sender[j] := ch; INC(i); INC(j); ch := line[i] END ; sender[j] := 0X; RETURN END END ; INC(i); ch := line[i] END ; (* if we got until here, just strip the "From:" from the line *) j := 0; i := 5; (* first char after ":" *); WHILE (line[i] # 0X) & (line[i] <= " ") DO INC(i) END ; IF ch = "<" THEN INC(i) END ; WHILE (line[i] # 0X) & (line[i] # ">") DO sender[j] := line[i]; INC(i); INC(j) END ; sender[j] := 0X; END extractSender; PROCEDURE extractSubject; VAR i,j: INTEGER; ch: CHAR; BEGIN i := 0; j := 0; WHILE line[i] # ":" DO INC(i) END ; INC(i); WHILE (line[i] # 0X) & (line[i] <= " ") DO INC(i) END ; WHILE line[i] # 0X DO subject[j] := line[i]; INC(j); INC(i) END ; subject[j] := 0X END extractSubject; BEGIN sender[0] := 0X; subject[0] := 0X; Texts.OpenReader(R, mail, 0); senderFound := FALSE; subjectFound := FALSE; REPEAT ReadLine; IF matches("FROM:") & ~senderFound THEN senderFound := TRUE; extractSender; ELSIF (matches("RE:") OR matches("SUBJECT:")) & ~subjectFound THEN subjectFound := TRUE; extractSubject; END ; UNTIL (senderFound & subjectFound) OR R.eot; END ParseMail; PROCEDURE Copy (source, dest: Elem); BEGIN Texts.CopyElem(source, dest); IF source.text # NIL THEN dest.text := TextCopy(source.text, 0, source.text.len) ELSE dest.text := NIL END ; dest.label := source.label; dest.isMail := source.isMail; dest.base := source.base; dest.pos := source.pos; dest.len := source.len; END Copy; PROCEDURE Open (e: Elem; T: Texts.Text; label: ARRAY OF CHAR); VAR sender, subject: ARRAY 64 OF CHAR; BEGIN ParseMail(T, sender, subject); e.text := T; IF (sender # "") OR (subject # "") THEN e.isMail := TRUE; IF sender # "" THEN COPY(sender, e.label); Append(e.label, ": "); Append(e.label, subject) ELSE COPY(subject, e.label); END ; ELSE e.isMail := FALSE; COPY(label, e.label) END ; END Open; PROCEDURE Load (e: Elem; VAR r: Files.Rider); VAR tag, version: CHAR; BEGIN Files.Read(r, tag); ASSERT(tag = ArchTag); Files.Read(r, version); e.text := NIL; e.base := Files.Base(r); Files.ReadString(r, e.label); Files.ReadBool(r, e.isMail); Files.ReadLInt(r, e.len); e.pos := Files.Pos(r); Files.Set(r, e.base, e.pos + e.len); END Load; PROCEDURE Store (e: Elem; VAR r: Files.Rider); CONST N = 1024; VAR p: Files.Rider; n, len: LONGINT; buf: ARRAY N OF CHAR; BEGIN Files.Write(r, ArchTag); Files.Write(r, 1X); Files.WriteString(r, e.label); Files.WriteBool(r, e.isMail); IF e.text # NIL THEN p := r; Files.WriteLInt(r, 0); (* placeholder for length of text block *) len := Files.Pos(r); Texts.Store(r, e.text); len := Files.Pos(r) - len; Files.WriteLInt(p, len); ELSE Files.Set(p, e.base, e.pos); len := e.len; Files.WriteLInt(r, len); WHILE len > 0 DO n := len; IF n > N THEN n := N END ; Files.ReadBytes(p, buf, n); Files.WriteBytes(r, buf, n); DEC(len, n); END END END Store; PROCEDURE StringWidth (fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT; VAR pat: Display.Pattern; width, i, dx, x, y, w, h: INTEGER; ch: CHAR; BEGIN width := 0; i := 0; ch := s[i]; WHILE ch # 0X DO Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat); INC(width, dx); INC(i); ch := s[i] END ; RETURN LONG(width) * DUnit END StringWidth; PROCEDURE DrawString (s: ARRAY OF CHAR; x0, y0: INTEGER; fnt: Fonts.Font; col: INTEGER); VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER; ch: CHAR; BEGIN i := 0; ch := s[i]; WHILE ch # 0X DO Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat); Display.CopyPattern(col, pat, x0+x, y0+y, Display.replace); INC(i); ch := s[i]; INC(x0, dx) END END DrawString; PROCEDURE Prepare (e: Elem; fnt: Fonts.Font; VAR dy: INTEGER); BEGIN e.W := StringWidth(fnt, e.label) + 2*DUnit; e.H := LONG(fnt.height + 2) * TextFrames.Unit; dy := fnt.minY - 1; END Prepare; PROCEDURE Draw (e: Elem; x0, y0: INTEGER; pos: LONGINT; fnt: Fonts.Font; bgcol, col: INTEGER; highlighted: BOOLEAN); VAR w, h: INTEGER; beg: LONGINT; p: TextFrames.Parc; BEGIN w := SHORT(e.W DIV DUnit); h := SHORT(e.H DIV DUnit); TextFrames.ParcBefore(Texts.ElemBase(e), pos, p, beg); y0 := y0 + SHORT(p.dsr DIV DUnit); (* y is base line *) Oberon.RemoveMarks(x0, y0+fnt.minY-1, w, h); IF Color THEN Display.ReplConst(ElemBackg, x0, y0+fnt.minY-1, w, h, Display.replace) ELSE Display.ReplConst(bgcol, x0, y0+fnt.minY-1, w, h, Display.replace); Display.ReplPattern(Display.white, Display.grey1, x0, y0-2, w, 1, Display.replace) END ; DrawString(e.label, x0, y0, fnt, col); IF highlighted THEN IF Color THEN Display.ReplPattern(Display.black, Display.grey1, x0, y0+fnt.minY-1, w, h, Display.paint) ELSE Display.ReplConst(Display.white, x0, y0+fnt.minY-1, w, h, Display.invert) END END END Draw; PROCEDURE Track (e: Elem; VAR M: TextFrames.TrackMsg); VAR w, h: INTEGER; keysum, keys: SET; inside, wasinside: BOOLEAN; x, y, y0: INTEGER; beg: LONGINT; p: TextFrames.Parc; C: Oberon.ControlMsg; BEGIN w := SHORT(e.W DIV DUnit); h := SHORT(e.H DIV DUnit); keys := M.keys; keysum := {}; TextFrames.ParcBefore(Texts.ElemBase(e), M.pos, p, beg); y0 := M.Y0 + SHORT(p.dsr DIV DUnit) + M.fnt.minY; inside := (M.X0 <= M.X) & (M.X <= M.X0+w) & (y0 <= M.Y) & (M.Y <= y0+h); IF inside THEN wasinside := FALSE; C.id := Oberon.neutralize; M.frame.handle(M.frame, C); WHILE keys # {} DO Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y); inside := (M.X0 <= x) & (x <= M.X0+w) & (y0 <= y) & (y <= y0+h); keysum := keysum + keys; IF inside & ~wasinside THEN wasinside := TRUE; Draw(e, M.X0, M.Y0, M.pos, M.fnt, M.frame(TextFrames.Frame).col, M.col, TRUE); ELSIF wasinside & ~inside THEN wasinside := FALSE; Draw(e, M.X0, M.Y0, M.pos, M.fnt, M.frame(TextFrames.Frame).col, M.col, FALSE); END END ; Draw(e, M.X0, M.Y0, M.pos, M.fnt, M.frame(TextFrames.Frame).col, M.col, FALSE); IF inside & (keysum = {MM}) THEN OpenViewer(e) END ; END END Track; PROCEDURE Handle* (e: Texts.Elem; VAR M: Texts.ElemMsg); VAR copy: Elem; BEGIN WITH e: Elem DO WITH M: TextFrames.DisplayMsg DO IF M.prepare THEN Prepare(e, M.fnt, M.Y0) ELSE Draw(e, M.X0, M.Y0, M.pos, M.fnt, M.frame(TextFrames.Frame).col, M.col, FALSE) END | M: TextPrinter.PrintMsg DO | M: Texts.IdentifyMsg DO M.mod := "ArchiveElems"; M.proc := "Alloc" | M: Texts.FileMsg DO IF M.id = Texts.load THEN Load(e, M.r) ELSIF M.id = Texts.store THEN Store(e, M.r) END | M: Texts.CopyMsg DO NEW(copy); Copy(e, copy); M(Texts.CopyMsg).e := copy | M: TextFrames.TrackMsg DO Track(e, M) ELSE (*ignore*) END END END Handle; PROCEDURE Alloc*; VAR e: Elem; BEGIN NEW(e); e.handle := Handle; Texts.new := e; END Alloc; PROCEDURE Update*; VAR V: Viewer; F: TextFrames.Frame; label: ARRAY 128 OF CHAR; S: Texts.Scanner; BEGIN IF Oberon.Par.vwr IS Viewer THEN V := Oberon.Par.vwr(Viewer); F := V.dsc.next(TextFrames.Frame); label := "Unknown"; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0); Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, label) END ; Open(V.elem, TextCopy(F.text, 0, F.text.len), label); Changed(V.elem); UnmarkMenu(V) END END Update; PROCEDURE Iconize*; VAR beg, end, time: LONGINT; e: Elem; v: Viewers.Viewer; text: Texts.Text; S: Texts.Scanner; name: ARRAY 64 OF CHAR; M: TextFrames.InsertElemMsg; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.line = 0) & (S.class = Texts.Char) & (S.c = "@") THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN NEW(e); e.handle := Handle; Open(e, TextCopy(text, beg, end), "Unknown"); M.e := e; Oberon.FocusViewer.handle(Oberon.FocusViewer, M); END ELSIF (S.line = 0) & (S.class = Texts.Char) & (S.c = "*") THEN v := Oberon.MarkedViewer(); IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN name := "Unknown"; IF v.dsc IS TextFrames.Frame THEN Texts.OpenScanner(S, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(S); IF S.class IN {Texts.Name, Texts.String} THEN COPY(S.s, name) END END ; text := v.dsc.next(TextFrames.Frame).text; NEW(e); e.handle := Handle; Open(e, TextCopy(text, 0, text.len), name); M.e := e; Oberon.FocusViewer.handle(Oberon.FocusViewer, M); END END END Iconize; END ArchiveElems. ArchiveElems.Iconize * ArchiveElems.Iconize @