MODULE StdStamps;

   project   = "BlackBox"
   organization   = ""
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""



   StdStamps are used to keep track of document changes, in particular program texts.
   StdStamps carry a sequence number and a fingerprint of the document with them.
   Each time the document (and therefore its fingerprint) is changed and stored,
   the sequence number is incremented. (When determining the fingerprint of the
   document, whitespace is ignored, except in string literals.)
   Each StdStamp also keeps track of the history of most recent changes.
   For the last maxHistoryEntries sequence numbers, the date and time,
   and an optional one-line comment is stored. To avoid too many entries in the history
   while working on a module, the most recent history entry is overwritten upon the
   generation of a new sequence number if the current date is the same as the date in
   the history entry.


      SYSTEM, (* SYSTEM.ROT only, for fingerprint calculation *)
      Strings, Dates, StdCmds,
      Ports, Models, Stores, Containers, Properties, Views, Controllers, Fonts,
      TextModels, TextSetters, TextMappers, TextViews, TextRulers;

      setCommentKey = "#Std:Set Comment";
      maxHistoryEntries = 25;
      minVersion = 0; origStampVersion = 0; thisVersion = 2;
      History = ARRAY maxHistoryEntries OF RECORD
         fprint, snr: INTEGER;   (* fingerprint, sequence number *)
         date: INTEGER;         (* days since 1/1/1 *)
         time: INTEGER;         (* min + 64 * hour *)
         comment: POINTER TO ARRAY OF CHAR;   (* nil if no comment*)
      StdView = POINTER TO RECORD (Views.View)
         (*--snr: LONGINT;*)         
         nentries: INTEGER;   (* number of entries in history *)
         history: History;         (* newest entry in history[0] *)
         cache: ARRAY 64 OF CHAR;
      SetCmtOp = POINTER TO RECORD (Stores.Operation)

         stamp: StdView;
         oldcomment: POINTER TO ARRAY OF CHAR;

      comment*: RECORD
         s*: ARRAY 64 OF CHAR;
   PROCEDURE (op: SetCmtOp) Do;

      temp := op.stamp.history[0].comment;
      op.stamp.history[0].comment := op.oldcomment;
      op.oldcomment := temp;
   END Do;
   PROCEDURE Format (v: StdView);

      VAR s: ARRAY 64 OF CHAR; d: Dates.Date; t: INTEGER;
      t := v.history[0].time;
      Dates.DayToDate(v.history[0].date, d);
      Dates.DateToString(d, Dates.plainAbbreviated, s); v.cache := s$;
      Strings.IntToStringForm(v.history[0].snr, Strings.decimal, 4, "0", FALSE, s);
      v.cache := v.cache + " (" + s + ")"
   END Format;
   PROCEDURE FontContext (v: StdView): Fonts.Font;

      VAR c: Models.Context;
      c := v.context;
      IF (c # NIL) & (c IS TextModels.Context) THEN
         RETURN c(TextModels.Context).Attr().font;
         RETURN Fonts.dir.Default()
   END FontContext;
   PROCEDURE CalcFP (t: TextModels.Model): INTEGER;

      CONST sglQuote = "'"; dblQuote = '"';
      VAR fp: INTEGER;rd: TextModels.Reader; ch, quoteChar: CHAR;
      quoteChar := 0X; fp := 0;
      rd := t.NewReader(NIL); rd.ReadChar(ch);
      WHILE ~rd.eot DO
         IF ch = quoteChar THEN quoteChar := 0X;
         ELSIF (quoteChar = 0X) & ((ch = dblQuote) OR (ch = sglQuote)) THEN quoteChar := ch;
         IF (quoteChar = 0X) & (21X <= ch) & (ch # 8BX) & (ch # 8FX) & (ch # 0A0X) (* not in string literal *)
            OR (quoteChar # 0X) & (20X <= ch) (* within string literal *)
            fp := SYSTEM.ROT(fp, 1) + 13 * ORD(ch);
      RETURN fp;
   END CalcFP;
   PROCEDURE Update (v: StdView; forcenew: BOOLEAN);

      VAR fp: INTEGER; i: INTEGER; ndays: INTEGER; d: Dates.Date; t: Dates.Time;
      IF (v.context # NIL) & (v.context IS TextModels.Context) THEN
         fp := CalcFP(v.context(TextModels.Context).ThisModel());
         IF (fp # v.history[0].fprint) OR forcenew THEN
            Dates.GetDate(d); Dates.GetTime(t);
            ndays := Dates.Day(d);
            IF (ndays # v.history[0].date) OR forcenew THEN
               (* move down entries in history list *)
               i := maxHistoryEntries-1;
               WHILE i > 0 DO
                  v.history[i] := v.history[i-1];
               v.history[0].comment := NIL;
            IF v.nentries < maxHistoryEntries THEN INC(v.nentries) END;
            v.history[0].fprint := fp;
            v.history[0].date := ndays;
            v.history[0].time := t.minute + t.hour*64;
            Views.Update(v, Views.keepFrames);
   END Update;
   PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);

      VAR i, len: INTEGER;
      Update(v, FALSE);
      FOR i := 0 TO v.nentries-1 DO
         IF v.history[i].comment # NIL THEN
            len := LEN(v.history[i].comment$);
         ELSE wr.WriteXInt(0);
   END Externalize;
   PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);

      VAR version: INTEGER; format: BYTE; i, len: INTEGER;
         d: Dates.Date; t: Dates.Time;
      IF ~rd.cancelled THEN
         rd.ReadVersion(minVersion, thisVersion, version);
         IF ~rd.cancelled THEN
            IF version = origStampVersion THEN (* deal with old StdStamp format *)
               (* would like to calculate fingerprint, but hosting model not available at this time *)
               v.history[0].fprint := 0;
               v.history[0].snr := 1; v.nentries := 1;
               rd.ReadXInt(d.year); rd.ReadXInt(d.month); rd.ReadXInt(;
               rd.ReadXInt(t.hour); rd.ReadXInt(t.minute); rd.ReadXInt(t.second);
               rd.ReadByte(format); (* format not used anymore *)
               v.history[0].date := Dates.Day(d);
               v.history[0].time := t.minute + t.hour*64;
               IF version = 1 THEN rd.ReadInt(v.history[0].snr) END; (* red text: to be removed soon *)
               FOR i := 0 TO v.nentries-1 DO
                  IF version > 1 THEN rd.ReadInt(v.history[i].snr)
                  ELSIF (* (version = 1) & *) i > 0 THEN v.history[i].snr := v.history[i-1].snr - 1;
                  END; (* red text: to be removed soon *)
                  IF len > 0 THEN
                     NEW(v.history[i].comment, len + 1);
                  ELSE v.history[i].comment := NIL;
   END Internalize;
   PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);

      VAR i: INTEGER;
      (* v.CopyFrom^(source); *)
      WITH source: StdView DO
         (*--v.snr := source.snr;*)
         v.nentries := source.nentries;
         v.history := source.history;
         v.cache := source.cache;
         FOR i := 0 TO v.nentries - 1 DO
            IF source.history[i].comment # NIL THEN
               NEW(v.history[i].comment, LEN(source.history[i].comment$) + 1);
               v.history[i].comment^ := source.history[i].comment^$;
   END CopyFromSimpleView;
   PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
         asc, dsc, fw: INTEGER;
      c := v.context;
      IF (c # NIL) & (c IS TextModels.Context) THEN
         a := v.context(TextModels.Context).Attr();
         font := a.font;
         color := a.color;
      ELSE font := Fonts.dir.Default(); color :=;
      font.GetBounds(asc, dsc, fw);
      f.DrawLine(f.l, asc +, f.r, asc +, 1, Ports.grey25 );
      f.DrawString(0, asc, color, v.cache, font);
   END Restore;
   PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);

      VAR font: Fonts.Font; asc, dsc, w: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
      font := FontContext(v);
      font.GetBounds(asc, dsc, w); := 28; d.month := 1; d.year := 2222; p.w := 0;
      WHILE d.month <= 12 DO
         Dates.DateToString(d, Dates.plainAbbreviated, s);
         s := s + " (0000)";
         w := font.StringWidth(s);
         IF w > p.w THEN p.w := w END;
      p.h := asc + dsc;
   END SizePref;
   PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);

      VAR font: Fonts.Font; asc, w: INTEGER;
      WITH msg: Properties.Preference DO
         WITH msg: Properties.SizePref DO
            SizePref(v, msg)
         | msg: Properties.ResizePref DO
            msg.fixed := TRUE
         | msg: Properties.FocusPref DO
            msg.hotFocus := TRUE
         | msg: TextSetters.Pref DO
            font := FontContext(v);
            font.GetBounds(asc, msg.dsc, w);
   END HandlePropMsg;
   PROCEDURE NewRuler (): TextRulers.Ruler;

      CONST mm =;
      VAR r: TextRulers.Ruler;
      r := TextRulers.dir.New(NIL);
      TextRulers.SetRight(r, 140 * mm);
      TextRulers.AddTab(r, 15 * mm); TextRulers.AddTab(r, 35 * mm); TextRulers.AddTab(r, 75 * mm);
      RETURN r
   END NewRuler;
   PROCEDURE ShowHistory (v: StdView);

      VAR text: TextModels.Model; f: TextMappers.Formatter;
         i: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
         tv: TextViews.View; attr: TextModels.Attributes;
      text := TextModels.dir.New();
      attr := f.rider.attr;
      f.rider.SetAttr(TextModels.NewStyle(attr, {Fonts.italic}));
      f.WriteString("seq nr."); f.WriteTab;
      f.WriteString("fingerprint"); f.WriteTab;
      f.WriteString("date and time"); f.WriteTab;
      f.WriteString("comment"); f.WriteLn;
      f.rider.SetAttr(attr); f.WriteLn;
      (*--n := v.snr;*)
      FOR i := 0 TO v.nentries-1 DO
         f.WriteIntForm(v.history[i].snr, 10, 4, "0", FALSE);
         f.WriteIntForm(v.history[i].fprint, TextMappers.hexadecimal, 8, "0", FALSE);
         Dates.DayToDate(v.history[i].date, d);
         Dates.DateToString(d, Dates.plainAbbreviated, s);
         f.WriteIntForm(v.history[i].time DIV 64, 10, 2, "0", FALSE);
         f.WriteIntForm(v.history[i].time MOD 64, 10, 2, "0", FALSE);
         IF v.history[i].comment # NIL THEN
            f.WriteString( v.history[i].comment^);
      tv := TextViews.dir.New(text);
      tv.SetDefaults(NewRuler(), TextViews.dir.defAttr);
      tv.ThisController().SetOpts({Containers.noFocus, Containers.noCaret});
      Views.OpenAux(tv, "History");
   END ShowHistory;
   PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);

      VAR c: Models.Context; w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
      c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
         IF in # in0 THEN
            f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert,; in0 := in
         f.Input(x, y, m, isDown);
         in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
      UNTIL ~isDown;
      IF in0 THEN
         f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
         IF Controllers.modify IN m THEN
            IF v.history[0].comment # NIL THEN comment.s := v.history[0].comment^$;
            ELSE comment.s := "";
            StdCmds.OpenToolDialog("Std/Rsrc/Stamps", "Comment");
         ELSE ShowHistory(v);
   END Track;
   PROCEDURE (v: StdView) HandleCtrlMsg (

            f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
      WITH msg: Controllers.TrackMsg DO
         Track(v, f, msg.x, msg.y, msg.modifiers)
      | msg: Controllers.PollCursorMsg DO
         msg.cursor := Ports.refCursor
   END HandleCtrlMsg;
   (* ------------ programming interface: ---------------------- *)

   PROCEDURE GetFirstInText* (t: TextModels.Model): Views.View;

      VAR r: TextModels.Reader; v: Views.View;
      IF t # NIL THEN
         r := t.NewReader(NIL);
         REPEAT r.ReadView(v) UNTIL (v = NIL) OR (v IS StdView);
         RETURN v;
   END GetFirstInText;
   PROCEDURE IsStamp* (v: Views.View): BOOLEAN;

      RETURN v IS StdView;
   END IsStamp;
   PROCEDURE GetInfo* (v: Views.View; VAR snr, historylen: INTEGER);

      ASSERT(v IS StdView, 20);
      WITH v: StdView DO
         snr := v.history[0].snr; historylen := v.nentries;
   END GetInfo;
   PROCEDURE GetData* (v: Views.View; entryno: INTEGER;

            VAR fprint: INTEGER; VAR date: Dates.Date; VAR time: Dates.Time);
      ASSERT(v IS StdView, 20);
      WITH v: StdView DO
         IF entryno <= v.nentries THEN
            fprint := v.history[entryno].fprint;
            Dates.DayToDate(v.history[entryno].date, date);
            time.minute := v.history[entryno].time MOD 64;
            time.minute := v.history[entryno].time DIV 64;
            time.second := 0;
   END GetData;
   (** Insert new history entry with comment in v. *)

   PROCEDURE Stamp* (v: Views.View; comment: ARRAY OF CHAR);
      ASSERT(v IS StdView, 20);
      WITH v: StdView DO
         Update(v, TRUE);
         NEW(v.history[0].comment, LEN(comment$) + 1);
         v.history[0].comment^ := comment$;
   END Stamp;
   PROCEDURE New* (): Views.View;

      VAR v: StdView; d: Dates.Date; t: Dates.Time;
      NEW(v); v.history[0].snr := 0; v.nentries := 0;
      v.history[0].fprint := 0;
      Dates.GetDate(d); Dates.GetTime(t);
      v.history[0].date := Dates.Day(d);
      v.history[0].time := t.minute + t.hour*64;
      RETURN v;
   END New;
   PROCEDURE SetComment*;

      VAR v: Views.View; op: SetCmtOp;
      v := GetFirstInText(TextViews.FocusText());
      IF v # NIL THEN
         WITH v: StdView DO
            NEW(op); op.stamp := v;
            NEW(op.oldcomment, LEN(comment.s$) + 1);
            op.oldcomment^ := comment.s$;
            Views.Do(v, setCommentKey, op);
   END SetComment;
   PROCEDURE Deposit*;

   END Deposit;
END StdStamps.