DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / bbcp.git / blob


50bf0eacf1af722d919b8ec1cf1ccc5eee866b6c
[bbcp.git] / Trurl-based / Std / Mod / Stamps.txt
1 MODULE StdStamps;
2
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Stamps.odc *)
4 (* DO NOT EDIT *)
5
6 (*
7 StdStamps are used to keep track of document changes, in particular program texts.
8 StdStamps carry a sequence number and a fingerprint of the document with them.
9 Each time the document (and therefore its fingerprint) is changed and stored,
10 the sequence number is incremented. (When determining the fingerprint of the
11 document, whitespace is ignored, except in string literals.)
12
13 Each StdStamp also keeps track of the history of most recent changes.
14 For the last maxHistoryEntries sequence numbers, the date and time,
15 and an optional one-line comment is stored. To avoid too many entries in the history
16 while working on a module, the most recent history entry is overwritten upon the
17 generation of a new sequence number if the current date is the same as the date in
18 the history entry.
19
20 *)
21
22 IMPORT
23 SYSTEM, (* SYSTEM.ROT only, for fingerprint calculation *)
24 Strings, Dates, StdCmds,
25 Ports, Models, Stores, Containers, Properties, Views, Controllers, Fonts,
26 TextModels, TextSetters, TextMappers, TextViews, TextRulers;
27
28 CONST
29 setCommentKey = "#Std:Set Comment";
30 maxHistoryEntries = 25;
31 minVersion = 0; origStampVersion = 0; thisVersion = 2;
32
33 TYPE
34 History = ARRAY maxHistoryEntries OF RECORD
35 fprint, snr: INTEGER; (* fingerprint, sequence number *)
36 date: INTEGER; (* days since 1/1/1 *)
37 time: INTEGER; (* min + 64 * hour *)
38 comment: POINTER TO ARRAY OF CHAR; (* nil if no comment *)
39 END;
40
41 StdView = POINTER TO RECORD (Views.View)
42 (*--snr: LONGINT;*)
43 nentries: INTEGER; (* number of entries in history *)
44 history: History; (* newest entry in history[0] *)
45 cache: ARRAY 64 OF CHAR;
46 END;
47
48 SetCmtOp = POINTER TO RECORD (Stores.Operation)
49 stamp: StdView;
50 oldcomment: POINTER TO ARRAY OF CHAR;
51 END;
52
53 VAR
54 comment*: RECORD
55 s*: ARRAY 64 OF CHAR;
56 END;
57
58
59 PROCEDURE (op: SetCmtOp) Do;
60 VAR temp: POINTER TO ARRAY OF CHAR;
61 BEGIN
62 temp := op.stamp.history[0].comment;
63 op.stamp.history[0].comment := op.oldcomment;
64 op.oldcomment := temp;
65 END Do;
66
67 PROCEDURE Format (v: StdView);
68 VAR s: ARRAY 64 OF CHAR; d: Dates.Date; t: INTEGER;
69 BEGIN
70 t := v.history[0].time;
71 Dates.DayToDate(v.history[0].date, d);
72 Dates.DateToString(d, Dates.plainAbbreviated, s); v.cache := s$;
73 Strings.IntToStringForm(v.history[0].snr, Strings.decimal, 4, "0", FALSE, s);
74 v.cache := v.cache + " (" + s + ")"
75 END Format;
76
77
78 PROCEDURE FontContext (v: StdView): Fonts.Font;
79 VAR c: Models.Context;
80 BEGIN
81 c := v.context;
82 IF (c # NIL) & (c IS TextModels.Context) THEN
83 RETURN c(TextModels.Context).Attr().font;
84 ELSE
85 RETURN Fonts.dir.Default()
86 END;
87 END FontContext;
88
89 PROCEDURE CalcFP (t: TextModels.Model): INTEGER;
90 CONST sglQuote = "'"; dblQuote = '"';
91 VAR fp: INTEGER; rd: TextModels.Reader; ch, quoteChar: CHAR;
92 BEGIN
93 quoteChar := 0X; fp := 0;
94 rd := t.NewReader(NIL); rd.ReadChar(ch);
95 WHILE ~rd.eot DO
96 IF ch = quoteChar THEN quoteChar := 0X;
97 ELSIF (quoteChar = 0X) & ((ch = dblQuote) OR (ch = sglQuote)) THEN quoteChar := ch;
98 END;
99 IF (quoteChar = 0X) & (21X <= ch) & (ch # 8BX) & (ch # 8FX) & (ch # 0A0X) (* not in string literal *)
100 OR (quoteChar # 0X) & (20X <= ch) (* within string literal *)
101 THEN
102 fp := SYSTEM.ROT(fp, 1) + 13 * ORD(ch);
103 END;
104 rd.ReadChar(ch);
105 END;
106 RETURN fp;
107 END CalcFP;
108
109 PROCEDURE Update (v: StdView; forcenew: BOOLEAN);
110 VAR fp: INTEGER; i: INTEGER; ndays: INTEGER; d: Dates.Date; t: Dates.Time;
111 BEGIN
112 IF (v.context # NIL) & (v.context IS TextModels.Context) THEN
113 fp := CalcFP(v.context(TextModels.Context).ThisModel());
114 IF (fp # v.history[0].fprint) OR forcenew THEN
115 Dates.GetDate(d); Dates.GetTime(t);
116 ndays := Dates.Day(d);
117 IF (ndays # v.history[0].date) OR forcenew THEN
118 (* move down entries in history list *)
119 i := maxHistoryEntries-1;
120 WHILE i > 0 DO
121 v.history[i] := v.history[i-1];
122 DEC(i);
123 END;
124 v.history[0].comment := NIL;
125 END;
126 IF v.nentries < maxHistoryEntries THEN INC(v.nentries) END;
127 INC(v.history[0].snr);
128 v.history[0].fprint := fp;
129 v.history[0].date := ndays;
130 v.history[0].time := t.minute + t.hour*64;
131 Format(v);
132 Views.Update(v, Views.keepFrames);
133 END;
134 END;
135 END Update;
136
137 PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
138 VAR i, len: INTEGER;
139 BEGIN
140 Update(v, FALSE);
141 v.Externalize^(wr);
142 wr.WriteVersion(thisVersion);
143 (*--wr.WriteLInt(v.snr);*)
144 wr.WriteXInt(v.nentries);
145 FOR i := 0 TO v.nentries-1 DO
146 wr.WriteInt(v.history[i].fprint);
147 wr.WriteInt(v.history[i].snr);
148 wr.WriteInt(v.history[i].date);
149 wr.WriteXInt(v.history[i].time);
150 IF v.history[i].comment # NIL THEN
151 len := LEN(v.history[i].comment$);
152 wr.WriteXInt(len);
153 wr.WriteXString(v.history[i].comment^);
154 ELSE wr.WriteXInt(0);
155 END
156 END;
157 END Externalize;
158
159 PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
160 VAR version: INTEGER; format: BYTE; i, len: INTEGER;
161 d: Dates.Date; t: Dates.Time;
162 BEGIN
163 v.Internalize^(rd);
164 IF ~rd.cancelled THEN
165 rd.ReadVersion(minVersion, thisVersion, version);
166 IF ~rd.cancelled THEN
167 IF version = origStampVersion THEN (* deal with old StdStamp format *)
168 (* would like to calculate fingerprint, but hosting model not available at this time *)
169 v.history[0].fprint := 0;
170 v.history[0].snr := 1; v.nentries := 1;
171 rd.ReadXInt(d.year); rd.ReadXInt(d.month); rd.ReadXInt(d.day);
172 rd.ReadXInt(t.hour); rd.ReadXInt(t.minute); rd.ReadXInt(t.second);
173 rd.ReadByte(format); (* format not used anymore *)
174 v.history[0].date := Dates.Day(d);
175 v.history[0].time := t.minute + t.hour*64;
176 ELSE
177 IF version = 1 THEN rd.ReadInt(v.history[0].snr) END; (* red text: to be removed soon *)
178 rd.ReadXInt(v.nentries);
179 FOR i := 0 TO v.nentries-1 DO
180 rd.ReadInt(v.history[i].fprint);
181 IF version > 1 THEN rd.ReadInt(v.history[i].snr)
182 ELSIF (* (version = 1) & *) i > 0 THEN v.history[i].snr := v.history[i-1].snr - 1;
183 END; (* red text: to be removed soon *)
184 rd.ReadInt(v.history[i].date);
185 rd.ReadXInt(v.history[i].time);
186 rd.ReadXInt(len);
187 IF len > 0 THEN
188 NEW(v.history[i].comment, len + 1);
189 rd.ReadXString(v.history[i].comment^);
190 ELSE v.history[i].comment := NIL;
191 END
192 END;
193 END;
194 Format(v);
195 END
196 END
197 END Internalize;
198
199 PROCEDURE (v: StdView) CopyFromSimpleView (source: Views.View);
200 VAR i: INTEGER;
201 BEGIN
202 (* v.CopyFrom^(source); *)
203 WITH source: StdView DO
204 (*--v.snr := source.snr;*)
205 v.nentries := source.nentries;
206 v.history := source.history;
207 v.cache := source.cache;
208 FOR i := 0 TO v.nentries - 1 DO
209 IF source.history[i].comment # NIL THEN
210 NEW(v.history[i].comment, LEN(source.history[i].comment$) + 1);
211 v.history[i].comment^ := source.history[i].comment^$;
212 END
213 END
214 END
215 END CopyFromSimpleView;
216
217 PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
218 VAR a: TextModels.Attributes; color: Ports.Color; c: Models.Context; font: Fonts.Font;
219 asc, dsc, fw: INTEGER;
220 BEGIN
221 c := v.context;
222 IF (c # NIL) & (c IS TextModels.Context) THEN
223 a := v.context(TextModels.Context).Attr();
224 font := a.font;
225 color := a.color;
226 ELSE font := Fonts.dir.Default(); color := Ports.black;
227 END;
228 font.GetBounds(asc, dsc, fw);
229 f.DrawLine(f.l, asc + f.dot, f.r, asc + f.dot, 1, Ports.grey25 );
230 f.DrawString(0, asc, color, v.cache, font);
231 END Restore;
232
233 PROCEDURE SizePref (v: StdView; VAR p: Properties.SizePref);
234 VAR font: Fonts.Font; asc, dsc, w: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
235 BEGIN
236 font := FontContext(v);
237 font.GetBounds(asc, dsc, w);
238 d.day := 28; d.month := 1; d.year := 2222; p.w := 0;
239 WHILE d.month <= 12 DO
240 Dates.DateToString(d, Dates.plainAbbreviated, s);
241 s := s + " (0000)";
242 w := font.StringWidth(s);
243 IF w > p.w THEN p.w := w END;
244 INC(d.month)
245 END;
246 p.h := asc + dsc;
247 END SizePref;
248
249 PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
250 VAR font: Fonts.Font; asc, w: INTEGER;
251 BEGIN
252 WITH msg: Properties.Preference DO
253 WITH msg: Properties.SizePref DO
254 SizePref(v, msg)
255 | msg: Properties.ResizePref DO
256 msg.fixed := TRUE
257 | msg: Properties.FocusPref DO
258 msg.hotFocus := TRUE
259 | msg: TextSetters.Pref DO
260 font := FontContext(v);
261 font.GetBounds(asc, msg.dsc, w);
262 ELSE
263 END
264 ELSE
265 END
266 END HandlePropMsg;
267
268 PROCEDURE NewRuler (): TextRulers.Ruler;
269 CONST mm = Ports.mm;
270 VAR r: TextRulers.Ruler;
271 BEGIN
272 r := TextRulers.dir.New(NIL);
273 TextRulers.SetRight(r, 140 * mm);
274 TextRulers.AddTab(r, 15 * mm); TextRulers.AddTab(r, 35 * mm); TextRulers.AddTab(r, 75 * mm);
275 RETURN r
276 END NewRuler;
277
278 PROCEDURE ShowHistory (v: StdView);
279 VAR text: TextModels.Model; f: TextMappers.Formatter;
280 i: INTEGER; d: Dates.Date; s: ARRAY 64 OF CHAR;
281 tv: TextViews.View; attr: TextModels.Attributes;
282 BEGIN
283 text := TextModels.dir.New();
284 f.ConnectTo(text);
285 attr := f.rider.attr;
286 f.rider.SetAttr(TextModels.NewStyle(attr, {Fonts.italic}));
287 f.WriteString("seq nr."); f.WriteTab;
288 f.WriteString("fingerprint"); f.WriteTab;
289 f.WriteString("date and time"); f.WriteTab;
290 f.WriteString("comment"); f.WriteLn;
291 f.rider.SetAttr(attr); f.WriteLn;
292 (*--n := v.snr;*)
293 FOR i := 0 TO v.nentries-1 DO
294 f.WriteIntForm(v.history[i].snr, 10, 4, "0", FALSE);
295 (*--DEC(n);*)
296 f.WriteTab;
297 f.WriteIntForm(v.history[i].fprint, TextMappers.hexadecimal, 8, "0", FALSE);
298 f.WriteTab;
299 Dates.DayToDate(v.history[i].date, d);
300 Dates.DateToString(d, Dates.plainAbbreviated, s);
301 f.WriteString(s);
302 f.WriteString(" ");
303 f.WriteIntForm(v.history[i].time DIV 64, 10, 2, "0", FALSE);
304 f.WriteString(":");
305 f.WriteIntForm(v.history[i].time MOD 64, 10, 2, "0", FALSE);
306 IF v.history[i].comment # NIL THEN
307 f.WriteTab;
308 f.WriteString( v.history[i].comment^);
309 END;
310 f.WriteLn;
311 END;
312 tv := TextViews.dir.New(text);
313 tv.SetDefaults(NewRuler(), TextViews.dir.defAttr);
314 tv.ThisController().SetOpts({Containers.noFocus, Containers.noCaret});
315 Views.OpenAux(tv, "History");
316 END ShowHistory;
317
318 PROCEDURE Track (v: StdView; f: Views.Frame; x, y: INTEGER; buttons: SET);
319 VAR c: Models.Context; w, h: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
320 BEGIN
321 c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
322 REPEAT
323 IF in # in0 THEN
324 f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
325 END;
326 f.Input(x, y, m, isDown);
327 in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
328 UNTIL ~isDown;
329 IF in0 THEN
330 f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
331 IF Controllers.modify IN m THEN
332 IF v.history[0].comment # NIL THEN comment.s := v.history[0].comment^$;
333 ELSE comment.s := "";
334 END;
335 StdCmds.OpenToolDialog("Std/Rsrc/Stamps", "Comment");
336 ELSE ShowHistory(v);
337 END
338 END
339 END Track;
340
341 PROCEDURE (v: StdView) HandleCtrlMsg (
342 f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
343 BEGIN
344 WITH msg: Controllers.TrackMsg DO
345 Track(v, f, msg.x, msg.y, msg.modifiers)
346 | msg: Controllers.PollCursorMsg DO
347 msg.cursor := Ports.refCursor
348 ELSE
349 END
350 END HandleCtrlMsg;
351
352
353 (* ------------ programming interface: ---------------------- *)
354
355 PROCEDURE GetFirstInText* (t: TextModels.Model): Views.View;
356 VAR r: TextModels.Reader; v: Views.View;
357 BEGIN
358 IF t # NIL THEN
359 r := t.NewReader(NIL);
360 REPEAT r.ReadView(v) UNTIL (v = NIL) OR (v IS StdView);
361 RETURN v;
362 ELSE RETURN NIL;
363 END;
364 END GetFirstInText;
365
366 PROCEDURE IsStamp* (v: Views.View): BOOLEAN;
367 BEGIN
368 RETURN v IS StdView;
369 END IsStamp;
370
371 PROCEDURE GetInfo* (v: Views.View; VAR snr, historylen: INTEGER);
372 BEGIN
373 ASSERT(v IS StdView, 20);
374 WITH v: StdView DO
375 snr := v.history[0].snr; historylen := v.nentries;
376 END
377 END GetInfo;
378
379 PROCEDURE GetData* (v: Views.View; entryno: INTEGER;
380 VAR fprint: INTEGER; VAR date: Dates.Date; VAR time: Dates.Time);
381 BEGIN
382 ASSERT(v IS StdView, 20);
383 WITH v: StdView DO
384 IF entryno <= v.nentries THEN
385 fprint := v.history[entryno].fprint;
386 Dates.DayToDate(v.history[entryno].date, date);
387 time.minute := v.history[entryno].time MOD 64;
388 time.minute := v.history[entryno].time DIV 64;
389 time.second := 0;
390 END
391 END
392 END GetData;
393
394 (** Insert new history entry with comment in v. *)
395 PROCEDURE Stamp* (v: Views.View; comment: ARRAY OF CHAR);
396 BEGIN
397 ASSERT(v IS StdView, 20);
398 WITH v: StdView DO
399 Update(v, TRUE);
400 NEW(v.history[0].comment, LEN(comment$) + 1);
401 v.history[0].comment^ := comment$;
402 END
403 END Stamp;
404
405 PROCEDURE New* (): Views.View;
406 VAR v: StdView; d: Dates.Date; t: Dates.Time;
407 BEGIN
408 NEW(v); v.history[0].snr := 0; v.nentries := 0;
409 v.history[0].fprint := 0;
410 Dates.GetDate(d); Dates.GetTime(t);
411 v.history[0].date := Dates.Day(d);
412 v.history[0].time := t.minute + t.hour*64;
413 Format(v);
414 RETURN v;
415 END New;
416
417 PROCEDURE SetComment*;
418 VAR v: Views.View; op: SetCmtOp;
419 BEGIN
420 v := GetFirstInText(TextViews.FocusText());
421 IF v # NIL THEN
422 WITH v: StdView DO
423 NEW(op); op.stamp := v;
424 NEW(op.oldcomment, LEN(comment.s$) + 1);
425 op.oldcomment^ := comment.s$;
426 Views.Do(v, setCommentKey, op);
427 END
428 END
429 END SetComment;
430
431 PROCEDURE Deposit*;
432 BEGIN
433 Views.Deposit(New())
434 END Deposit;
435
436 END StdStamps.
[FORK] BlackBox Cross-Platform (Windows, GNU/Linux, OpenBSD, FreeBSD)
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024