dc1e43b459155264dce85cbe7ae7c606fb05e7c8
1 MODULE TextModels;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Models.odc *)
4 (* DO NOT EDIT *)
6 (* re-check alien attributes: project to base attributes? *)
7 (* support *lists* of attribute extensions? *)
8 (* support for enumeration of texts within embedded views
9 - generally: support for enumeration of X-views within a recursive scheme?
10 - however: Containers already provides a general iteration scheme
11 -> could add recursion support to Reader later
12 *)
14 IMPORT
15 Files, Services, Fonts, Ports, Stores, Models, Views, Properties, Containers;
17 (* text file format:
19 text = 0 CHAR
20 textoffset INTEGER (> 0)
21 { run }
22 -1 CHAR
23 { char }
25 run = attrno BYTE (0..32)
26 [ attr ] attr.Internalize
27 ( piece | lpiece | viewref )
29 piece = length INTEGER (> 0)
31 lpiece = -length INTEGER (< 0, length MOD 2 = 0)
33 viewref = 0 INTEGER
34 w INTEGER
35 h INTEGER
36 view view.Internalize
37 *)
39 CONST
40 (* unicode* = 1X; *)
41 viewcode* = 2X; (** code for embedded views **)
42 tab* = 9X; line* = 0DX; para* = 0EX; (** tabulator; line and paragraph separator **)
43 zwspace* = 8BX; nbspace* = 0A0X; digitspace* = 8FX;
44 hyphen* = 90X; nbhyphen* = 91X; softhyphen* = 0ADX;
46 (** Pref.opts, options of text-aware views **)
47 maskChar* = 0; hideable* = 1;
49 (** Prop.known/valid/readOnly **)
50 offset* = 0; code* = 1;
52 (** InfoMsg.op **)
53 store* = 0;
55 (** UpdateMsg.op **)
56 replace* = 0; insert* = 1; delete* = 2;
58 (* EditOp.mode *)
59 deleteRange = 0; moveBuf = 1; writeSChar = 2; writeChar = 3; writeView = 4;
61 dictSize = 32;
63 point = Ports.point;
64 defW = 64 * point; defH = 32 * point;
66 (* embedding limits - don't increase maxHeight w/o checking TextViews.StdView *)
67 minWidth = 5 * point; maxWidth = MAX(INTEGER) DIV 2;
68 minHeight = 5 * point; maxHeight = 1500 * point;
70 minVersion = 0; maxAttrVersion = 0; maxModelVersion = 0;
71 noLCharStdModelVersion = 0; maxStdModelVersion = 1;
73 cacheWidth = 8; cacheLen = 4096; cacheLine = 128;
75 TYPE
76 Model* = POINTER TO ABSTRACT RECORD (Containers.Model) END;
78 Attributes* = POINTER TO EXTENSIBLE RECORD (Stores.Store)
79 init-: BOOLEAN; (* immutable once init is set *)
80 color-: Ports.Color;
81 font-: Fonts.Font;
82 offset-: INTEGER
83 END;
85 AlienAttributes* = POINTER TO RECORD (Attributes)
86 store-: Stores.Alien
87 END;
89 Prop* = POINTER TO RECORD (Properties.Property)
90 offset*: INTEGER;
91 code*: CHAR
92 END;
95 Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
97 Pref* = RECORD (Properties.Preference)
98 opts*: SET; (** preset to {} **)
99 mask*: CHAR (** valid if maskChar IN opts **)
100 END;
103 Reader* = POINTER TO ABSTRACT RECORD
104 eot*: BOOLEAN;
105 attr*: Attributes;
106 char*: CHAR;
107 view*: Views.View;
108 w*, h*: INTEGER
109 END;
111 Writer* = POINTER TO ABSTRACT RECORD
112 attr-: Attributes
113 END;
116 InfoMsg* = RECORD (Models.Message)
117 op*: INTEGER
118 END;
120 UpdateMsg* = RECORD (Models.UpdateMsg)
121 op*: INTEGER;
122 beg*, end*, delta*: INTEGER (** range: [beg, end); length = length' + delta **)
123 END;
126 Directory* = POINTER TO ABSTRACT RECORD
127 attr-: Attributes
128 END;
131 Run = POINTER TO EXTENSIBLE RECORD
132 prev, next: Run;
133 len: INTEGER;
134 attr: Attributes
135 END;
137 LPiece = POINTER TO EXTENSIBLE RECORD (Run)
138 file: Files.File;
139 org: INTEGER
140 END;
142 Piece = POINTER TO RECORD (LPiece) END; (* u IS Piece => CHAR run *)
144 ViewRef = POINTER TO RECORD (Run) (* u IS ViewRef => View run *)
145 w, h: INTEGER;
146 view: Views.View (* embedded view *)
147 END;
150 PieceCache = RECORD
151 org: INTEGER;
152 prev: Run (* Org(prev.next) = org *)
153 END;
155 SpillFile = POINTER TO RECORD
156 file: Files.File; (* valid if file # NIL *)
157 len: INTEGER; (* len = file.Length() *)
158 writer: Files.Writer (* writer.Base() = file *)
159 END;
161 AttrDict = RECORD
162 len: BYTE;
163 attr: ARRAY dictSize OF Attributes
164 END;
166 StdModel = POINTER TO RECORD (Model)
167 len: INTEGER; (* len = sum(u : [trailer.next, trailer) : u.len) *)
168 id: INTEGER; (* unique (could use SYSTEM.ADR instead ...) *)
169 era: INTEGER; (* stable era >= k *)
170 trailer: Run; (* init => trailer # NIL *)
171 pc: PieceCache;
172 spill: SpillFile; (* spill file, created lazily, shared with clones *)
173 rd: Reader (* reader cache *)
174 END;
176 StdContext = POINTER TO RECORD (Context)
177 text: StdModel;
178 ref: ViewRef
179 END;
181 StdReader = POINTER TO RECORD (Reader)
182 base: StdModel; (* base = Base() *)
183 pos: INTEGER; (* pos = Pos() *)
184 era: INTEGER;
185 run: Run; (* era = base.era => Pos(run) + off = pos *)
186 off: INTEGER; (* era = base.era => 0 <= off < run.len *)
187 reader: Files.Reader (* file reader cache *)
188 END;
190 StdWriter = POINTER TO RECORD (Writer)
191 base: StdModel; (* base = Base() *)
192 (* hasSequencer := base.Domain() = NIL OR base.Domain().GetSequencer() = NIL *)
193 pos: INTEGER; (* pos = Pos() *)
194 era: INTEGER; (* relevant iff hasSequencer *)
195 run: Run (* hasSequencer & era = base.era => Pos(run) = pos *)
196 END;
198 StdDirectory = POINTER TO RECORD (Directory) END;
201 MoveOp = POINTER TO RECORD (Stores.Operation) (* MoveStretchFrom *)
202 (* move src.[beg, end) to dest.pos *)
203 src: StdModel;
204 beg, end: INTEGER;
205 dest: StdModel;
206 pos: INTEGER
207 END;
209 EditOp = POINTER TO RECORD (Stores.Operation) (* CopyStretchFrom, Delete, WriteXXX *)
210 mode: INTEGER;
211 canBunch: BOOLEAN;
212 text: StdModel;
213 beg, end: INTEGER; (* op = deleteRange: move text.[beg, end) to <first, last> *)
214 pos: INTEGER;
215 first, last: Run; (* op = moveBuf: move <first, last> to text.pos;
216 op = writeView: insert <first> at text.pos*)
217 len: INTEGER; (* op = moveBuf: length of <first, last>;
218 op = write[L]Char: length of spill file before writing new [long] char *)
219 attr: Attributes (* op = write[L]Char *)
220 END;
222 AttrList = POINTER TO RECORD
223 next: AttrList;
224 len: INTEGER;
225 attr: Attributes
226 END;
228 SetAttrOp = POINTER TO RECORD (Stores.Operation) (* SetAttr, Modify *)
229 text: StdModel;
230 beg: INTEGER;
231 list: AttrList
232 END;
234 ResizeViewOp = POINTER TO RECORD (Stores.Operation) (* ResizeView *)
235 text: StdModel;
236 pos: INTEGER;
237 ref: ViewRef;
238 w, h: INTEGER
239 END;
241 ReplaceViewOp = POINTER TO RECORD (Stores.Operation) (* ReplaceView *)
242 text: StdModel;
243 pos: INTEGER;
244 ref: ViewRef;
245 new: Views.View
246 END;
248 TextCache = RECORD
249 id: INTEGER; (* id of the text block served by this cache block *)
250 beg, end: INTEGER; (* [beg .. end) cached, 0 <= end - beg < cacheLen *)
251 buf: ARRAY cacheLen OF BYTE (* [beg MOD cacheLen .. end MOD cacheLen) *)
252 END;
253 Cache = ARRAY cacheWidth OF TextCache;
255 VAR
256 dir-, stdDir-: Directory;
258 stdProp: Properties.StdProp; (* temp for NewColor, ... NewWeight *)
259 prop: Prop; (* temp for NewOffset *)
260 nextId: INTEGER;
261 cache: Cache;
264 (** Model **)
266 PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
267 VAR thisVersion: INTEGER;
268 BEGIN
269 m.Internalize^(rd); IF rd.cancelled THEN RETURN END;
270 rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
271 END Internalize;
273 PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
274 BEGIN
275 m.Externalize^(wr);
276 wr.WriteVersion(maxModelVersion)
277 END Externalize;
280 PROCEDURE (m: Model) Length* (): INTEGER, NEW, ABSTRACT;
281 PROCEDURE (m: Model) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
282 PROCEDURE (m: Model) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
283 PROCEDURE (m: Model) InsertCopy* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
284 PROCEDURE (m: Model) Insert* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
285 PROCEDURE (m: Model) Delete* (beg, end: INTEGER), NEW, ABSTRACT;
286 PROCEDURE (m: Model) SetAttr* (beg, end: INTEGER; attr: Attributes), NEW, ABSTRACT;
287 PROCEDURE (m: Model) Prop* (beg, end: INTEGER): Properties.Property, NEW, ABSTRACT;
288 PROCEDURE (m: Model) Modify* (beg, end: INTEGER; old, p: Properties.Property), NEW, ABSTRACT;
289 PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), ABSTRACT;
291 PROCEDURE (m: Model) Append* (m0: Model), NEW, ABSTRACT;
292 (*
293 BEGIN
294 ASSERT(m # m0, 20);
295 m.Insert(m.Length(), m0, 0, m0.Length())
296 END Append;
297 *)
298 PROCEDURE (m: Model) Replace* (beg, end: INTEGER; m0: Model; beg0, end0: INTEGER),
299 NEW, ABSTRACT;
300 (*
301 VAR script: Stores.Operation; delta: INTEGER;
302 BEGIN
303 Models.BeginScript(m, "#System:Replacing", script);
304 m.Delete(beg, end);
305 IF beg0 >
306 m.Insert(beg, m0, beg0, end0);
307 Models.EndScript(m, script)
308 END Replace;
309 *)
311 (** Attributes **)
313 PROCEDURE (a: Attributes) CopyFrom- (source: Stores.Store), EXTENSIBLE;
314 (** pre: ~a.init, source.init **)
315 (** post: a.init **)
316 BEGIN
317 WITH source: Attributes DO
318 ASSERT(~a.init, 20); ASSERT(source.init, 21); a.init := TRUE;
319 a.color := source.color; a.font := source.font; a.offset := source.offset
320 END
321 END CopyFrom;
323 PROCEDURE (a: Attributes) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
324 (** pre: ~a.init **)
325 (** post: a.init **)
326 VAR thisVersion: INTEGER;
327 fprint: INTEGER; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
328 BEGIN
329 ASSERT(~a.init, 20); a.init := TRUE;
330 a.Internalize^(rd);
331 IF rd.cancelled THEN RETURN END;
332 rd.ReadVersion(minVersion, maxAttrVersion, thisVersion);
333 IF rd.cancelled THEN RETURN END;
334 rd.ReadInt(a.color);
335 rd.ReadInt(fprint);
336 rd.ReadXString(face); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight);
337 a.font := Fonts.dir.This(face, size, style, weight);
338 IF a.font.IsAlien() THEN Stores.Report("#System:AlienFont", face, "", "")
339 (*
340 ELSIF a.font.Fingerprint() # fprint THEN Stores.Report("#System:AlienFontVersion", face, "", "")
341 *)
342 END;
343 rd.ReadInt(a.offset)
344 END Internalize;
346 PROCEDURE (a: Attributes) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
347 (** pre: a.init **)
348 VAR f: Fonts.Font;
349 BEGIN
350 ASSERT(a.init, 20);
351 a.Externalize^(wr);
352 wr.WriteVersion(maxAttrVersion);
353 wr.WriteInt(a.color);
354 f := a.font;
355 (*
356 wr.WriteInt(f.Fingerprint());
357 *)
358 wr.WriteInt(0);
359 wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight);
360 wr.WriteInt(a.offset)
361 END Externalize;
363 PROCEDURE (a: Attributes) InitFromProp* (p: Properties.Property), NEW, EXTENSIBLE;
364 (** pre: ~a.init **)
365 (** post: a.init, x IN p.valid => x set in a, else x defaults in a **)
366 VAR def: Fonts.Font; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
367 BEGIN
368 ASSERT(~a.init, 20); a.init := TRUE;
369 def := Fonts.dir.Default();
370 face := def.typeface$; size := def.size; style := def.style; weight := def.weight;
371 a.color := Ports.defaultColor; a.offset := 0;
372 WHILE p # NIL DO
373 WITH p: Properties.StdProp DO
374 IF Properties.color IN p.valid THEN a.color := p.color.val END;
375 IF Properties.typeface IN p.valid THEN face := p.typeface END;
376 IF (Properties.size IN p.valid)
377 & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
378 size := p.size
379 END;
380 IF Properties.style IN p.valid THEN
381 style := style - p.style.mask + p.style.val * p.style.mask
382 END;
383 IF (Properties.weight IN p.valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
384 weight := p.weight
385 END
386 | p: Prop DO
387 IF offset IN p.valid THEN a.offset := p.offset END
388 ELSE
389 END;
390 p := p.next
391 END;
392 a.font := Fonts.dir.This(face, size, style, weight)
393 END InitFromProp;
395 PROCEDURE (a: Attributes) Equals* (b: Attributes): BOOLEAN, NEW, EXTENSIBLE;
396 (** pre: a.init, b.init **)
397 BEGIN
398 ASSERT(a.init, 20); ASSERT((b # NIL) & b.init, 21);
399 RETURN (a = b)
400 OR (Services.SameType(a, b))
401 & (a.color = b.color) & (a.font = b.font) & (a.offset = b.offset)
402 END Equals;
404 PROCEDURE (a: Attributes) Prop* (): Properties.Property, NEW, EXTENSIBLE;
405 (** pre: a.init **)
406 VAR p: Properties.Property; sp: Properties.StdProp; tp: Prop;
407 BEGIN
408 ASSERT(a.init, 20);
409 NEW(sp);
410 sp.known := {Properties.color .. Properties.weight}; sp.valid := sp.known;
411 sp.color.val := a.color;
412 sp.typeface := a.font.typeface$;
413 sp.size := a.font.size;
414 sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
415 sp.style.val := a.font.style * sp.style.mask;
416 sp.weight := a.font.weight;
417 NEW(tp);
418 tp.known := {offset}; tp.valid := tp.known;
419 tp.offset := a.offset;
420 Properties.Insert(p, tp); Properties.Insert(p, sp);
421 RETURN p
422 END Prop;
424 PROCEDURE (a: Attributes) ModifyFromProp- (p: Properties.Property), NEW, EXTENSIBLE;
425 (** pre: ~a.init **)
426 VAR face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
427 valid: SET;
428 BEGIN
429 face := a.font.typeface; size := a.font.size;
430 style := a.font.style; weight := a.font.weight;
431 WHILE p # NIL DO
432 valid := p.valid;
433 WITH p: Properties.StdProp DO
434 IF Properties.color IN valid THEN a.color := p.color.val END;
435 IF Properties.typeface IN valid THEN
436 face := p.typeface
437 END;
438 IF (Properties.size IN valid)
439 & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
440 size := p.size
441 ELSE EXCL(valid, Properties.size)
442 END;
443 IF Properties.style IN valid THEN
444 style := style - p.style.mask + p.style.val * p.style.mask
445 END;
446 IF (Properties.weight IN valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
447 weight := p.weight
448 ELSE EXCL(valid, Properties.weight)
449 END;
450 IF valid - {Properties.typeface .. Properties.weight} # valid THEN
451 a.font := Fonts.dir.This(face, size, style, weight)
452 END
453 | p: Prop DO
454 IF offset IN valid THEN a.offset := p.offset END
455 ELSE
456 END;
457 p := p.next
458 END
459 END ModifyFromProp;
462 PROCEDURE ReadAttr* (VAR rd: Stores.Reader; VAR a: Attributes);
463 VAR st: Stores.Store; alien: AlienAttributes;
464 BEGIN
465 rd.ReadStore(st); ASSERT(st # NIL, 20);
466 IF st IS Stores.Alien THEN
467 NEW(alien); alien.store := st(Stores.Alien); Stores.Join(alien, alien.store);
468 alien.InitFromProp(NIL); a := alien;
469 Stores.Report("#Text:AlienAttributes", "", "", "")
470 ELSE a := st(Attributes)
471 END
472 END ReadAttr;
474 PROCEDURE WriteAttr* (VAR wr: Stores.Writer; a: Attributes);
475 BEGIN
476 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
477 WITH a: AlienAttributes DO wr.WriteStore(a.store) ELSE wr.WriteStore(a) END
478 END WriteAttr;
480 PROCEDURE ModifiedAttr* (a: Attributes; p: Properties.Property): Attributes;
481 (** pre: a.init **)
482 (** post: x IN p.valid => x in new attr set to value in p, else set to value in a **)
483 VAR h: Attributes;
484 BEGIN
485 ASSERT(a.init, 20);
486 h := Stores.CopyOf(a)(Attributes); h.ModifyFromProp(p);
487 RETURN h
488 END ModifiedAttr;
491 (** AlienAttributes **)
493 PROCEDURE (a: AlienAttributes) Externalize- (VAR wr: Stores.Writer);
494 BEGIN
495 HALT(100)
496 END Externalize;
498 PROCEDURE (a: AlienAttributes) CopyFrom- (source: Stores.Store);
499 BEGIN
500 a.CopyFrom^(source);
501 a.store := Stores.CopyOf(source(AlienAttributes).store)(Stores.Alien);
502 Stores.Join(a, a.store)
503 END CopyFrom;
505 PROCEDURE (a: AlienAttributes) Prop* (): Properties.Property;
506 BEGIN
507 RETURN NIL
508 END Prop;
510 PROCEDURE (a: AlienAttributes) ModifyFromProp- (p: Properties.Property);
511 END ModifyFromProp;
514 (** Prop **)
516 PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
517 VAR valid: SET;
518 BEGIN
519 WITH q: Prop DO
520 valid := p.valid * q.valid; equal := TRUE;
521 IF p.offset # q.offset THEN EXCL(valid, offset) END;
522 IF p.code # q.code THEN EXCL(valid, code) END;
523 IF p.valid # valid THEN p.valid := valid; equal := FALSE END
524 END
525 END IntersectWith;
528 (** Context **)
530 PROCEDURE (c: Context) ThisModel* (): Model, ABSTRACT;
531 PROCEDURE (c: Context) Pos* (): INTEGER, NEW, ABSTRACT;
532 PROCEDURE (c: Context) Attr* (): Attributes, NEW, ABSTRACT;
535 (** Reader **)
537 PROCEDURE (rd: Reader) Base* (): Model, NEW, ABSTRACT;
538 PROCEDURE (rd: Reader) SetPos* (pos: INTEGER), NEW, ABSTRACT;
539 PROCEDURE (rd: Reader) Pos* (): INTEGER, NEW, ABSTRACT;
540 PROCEDURE (rd: Reader) Read*, NEW, ABSTRACT;
541 PROCEDURE (rd: Reader) ReadPrev*, NEW, ABSTRACT;
543 PROCEDURE (rd: Reader) ReadChar* (OUT ch: CHAR), NEW, ABSTRACT;
544 (*
545 BEGIN
546 rd.Read; ch := rd.char
547 END ReadChar;
548 *)
549 PROCEDURE (rd: Reader) ReadPrevChar* (OUT ch: CHAR), NEW, ABSTRACT;
550 (*
551 BEGIN
552 rd.ReadPrev; ch := rd.char
553 END ReadPrevChar;
554 *)
555 PROCEDURE (rd: Reader) ReadView* (OUT v: Views.View), NEW, ABSTRACT;
556 (*
557 BEGIN
558 REPEAT rd.Read UNTIL (rd.view # NIL) OR rd.eot;
559 v := rd.view
560 END ReadView;
561 *)
562 PROCEDURE (rd: Reader) ReadPrevView* (OUT v: Views.View), NEW, ABSTRACT;
563 (*
564 BEGIN
565 REPEAT rd.ReadPrev UNTIL (rd.view # NIL) OR rd.eot;
566 v := rd.view
567 END ReadPrevView;
568 *)
569 PROCEDURE (rd: Reader) ReadRun* (OUT attr: Attributes), NEW, ABSTRACT;
570 (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos() - 1) **)
571 (*
572 VAR a: Attributes;
573 BEGIN
574 a := rd.attr;
575 REPEAT rd.Read UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
576 IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
577 END ReadRun;
578 *)
579 PROCEDURE (rd: Reader) ReadPrevRun* (OUT attr: Attributes), NEW, ABSTRACT;
580 (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos()) **)
581 (*
582 VAR a: Attributes;
583 BEGIN
584 a := rd.attr;
585 REPEAT rd.ReadPrev UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
586 IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
587 END ReadPrevRun;
588 *)
590 (** Writer **)
592 PROCEDURE (wr: Writer) Base* (): Model, NEW, ABSTRACT;
593 PROCEDURE (wr: Writer) SetPos* (pos: INTEGER), NEW, ABSTRACT;
594 PROCEDURE (wr: Writer) Pos* (): INTEGER, NEW, ABSTRACT;
595 (* PROCEDURE (wr: Writer) WriteSChar* (ch: SHORTCHAR), NEW, ABSTRACT; *)
596 PROCEDURE (wr: Writer) WriteChar* (ch: CHAR), NEW, ABSTRACT;
597 PROCEDURE (wr: Writer) WriteView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
599 PROCEDURE (wr: Writer) SetAttr* (attr: Attributes), NEW(*, EXTENSIBLE*);
600 BEGIN
601 ASSERT(attr # NIL, 20); ASSERT(attr.init, 21); wr.attr := attr
602 END SetAttr;
605 (** Directory **)
607 PROCEDURE (d: Directory) New* (): Model, NEW, ABSTRACT;
609 PROCEDURE (d: Directory) NewFromString* (s: ARRAY OF CHAR): Model, NEW, EXTENSIBLE;
610 VAR m: Model; w: Writer; i: INTEGER;
611 BEGIN
612 m := d.New(); w := m.NewWriter(NIL);
613 i := 0; WHILE s[i] # 0X DO w.WriteChar(s[i]); INC(i) END;
614 RETURN m
615 END NewFromString;
617 PROCEDURE (d: Directory) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;
618 BEGIN
619 ASSERT(attr.init, 20); d.attr := attr
620 END SetAttr;
623 (* StdModel - foundation *)
625 PROCEDURE OpenSpill (s: SpillFile);
626 BEGIN
627 s.file := Files.dir.Temp(); s.len := 0;
628 s.writer := s.file.NewWriter(NIL)
629 END OpenSpill;
631 PROCEDURE Find (t: StdModel; VAR pos: INTEGER; VAR u: Run; VAR off: INTEGER);
632 (* post: 0 <= pos <= t.len, 0 <= off < u.len, Pos(u) + off = pos *)
633 (* Read/Write rely on Find to force pos into the legal range *)
634 VAR v: Run; m: INTEGER;
635 BEGIN
636 IF pos < 0 THEN pos := 0 END;
637 IF pos >= t.len THEN
638 u := t.trailer; off := 0; t.pc.prev := t.trailer; t.pc.org := 0
639 ELSE
640 v := t.pc.prev.next; m := pos - t.pc.org;
641 IF m >= 0 THEN
642 WHILE m >= v.len DO DEC(m, v.len); v := v.next END
643 ELSE
644 WHILE m < 0 DO v := v.prev; INC(m, v.len) END
645 END;
646 u := v; off := m; t.pc.prev := v.prev; t.pc.org := pos - m
647 END
648 END Find;
650 PROCEDURE Split (off: INTEGER; VAR u, un: Run);
651 (* pre: 0 <= off <= u.len *)
652 (* post: u.len = off, u.len + un.len = u'.len, Pos(u) + u.len = Pos(un) *)
653 VAR lp: LPiece; sp: Piece;
654 BEGIN
655 IF off = 0 THEN un := u; u := un.prev (* "split" at left edge of run *)
656 ELSIF off < u.len THEN (* u.len > 1 => u IS LPiece; true split *)
657 WITH u: Piece DO
658 NEW(sp); sp^ := u^; INC(sp.org, off);
659 un := sp
660 ELSE (* u IS LPiece) & ~(u IS Piece) *)
661 NEW(lp);
662 lp.prev := u.prev; lp.next := u.next; lp.len := u.len; lp.attr := u.attr;
663 lp.file := u(LPiece).file; lp.org := u(LPiece).org;
664 INC(lp.org, 2 * off);
665 un := lp
666 END;
667 DEC(un.len, off); DEC(u.len, un.len);
668 un.prev := u; un.next := u.next; un.next.prev := un; u.next := un
669 ELSIF off = u.len THEN un := u.next (* "split" at right edge of run *)
670 ELSE HALT(100)
671 END
672 END Split;
674 PROCEDURE Merge (t: StdModel; u: Run; VAR v: Run);
675 VAR p, q: LPiece;
676 BEGIN
677 WITH u: Piece DO
678 IF (v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
679 p := u; q := v(Piece);
680 IF (p.file = q.file) & (p.org + p.len = q.org) THEN
681 IF t.pc.prev = p THEN INC(t.pc.org, q.len)
682 ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
683 END;
684 INC(p.len, q.len); v := v.next
685 END
686 END
687 | u: LPiece DO (* ~(u IS Piece) *)
688 IF (v IS LPiece) & ~(v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
689 p := u(LPiece); q := v(LPiece);
690 IF (p.file = q.file) & (p.org + 2 * p.len = q.org) THEN
691 IF t.pc.prev = p THEN INC(t.pc.org, q.len)
692 ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
693 END;
694 INC(p.len, q.len); v := v.next
695 END
696 END
697 ELSE (* ignore: can't merge ViewRef runs *)
698 END
699 END Merge;
701 PROCEDURE Splice (un, v, w: Run); (* (u, un) -> (u, v ... w, un) *)
702 VAR u: Run;
703 BEGIN
704 IF v # w.next THEN (* non-empty stretch v ... w *)
705 u := un.prev;
706 u.next := v; v.prev := u; un.prev := w; w.next := un
707 END
708 END Splice;
710 PROCEDURE NewContext (r: ViewRef; text: StdModel): StdContext;
711 VAR c: StdContext;
712 BEGIN
713 NEW(c); c.text := text; c.ref := r;
714 Stores.Join(text, r.view);
715 RETURN c
716 END NewContext;
718 PROCEDURE CopyOfPiece (p: LPiece): LPiece;
719 VAR lp: LPiece; sp: Piece;
720 BEGIN
721 WITH p: Piece DO NEW(sp); sp^ := p^; RETURN sp
722 ELSE
723 NEW(lp);
724 lp.prev := p.prev; lp.next := p.next; lp.len := p.len; lp.attr := p.attr;
725 lp.file := p(LPiece).file; lp.org := p(LPiece).org;
726 RETURN lp
727 END
728 END CopyOfPiece;
730 PROCEDURE CopyOfViewRef (r: ViewRef; text: StdModel): ViewRef;
731 VAR v: ViewRef;
732 BEGIN
733 NEW(v); v^ := r^;
734 v.view := Views.CopyOf(r.view, Views.deep);
735 v.view.InitContext(NewContext(v, text));
736 RETURN v
737 END CopyOfViewRef;
739 PROCEDURE InvalCache (t: StdModel; pos: INTEGER);
740 VAR n: INTEGER;
741 BEGIN
742 n := t.id MOD cacheWidth;
743 IF cache[n].id = t.id THEN
744 IF pos <= cache[n].beg THEN cache[n].beg := 0; cache[n].end := 0
745 ELSIF pos < cache[n].end THEN cache[n].end := pos
746 END
747 END
748 END InvalCache;
750 PROCEDURE StdInit (t: StdModel);
751 VAR u: Run;
752 BEGIN
753 IF t.trailer = NIL THEN
754 NEW(u); u.len := MAX(INTEGER); u.attr := NIL; u.next := u; u.prev := u;
755 t.len := 0; t.id := nextId; INC(nextId); t.era := 0; t.trailer := u;
756 t.pc.prev := u; t.pc.org := 0;
757 IF t.spill = NIL THEN NEW(t.spill) END
758 END
759 END StdInit;
761 PROCEDURE CopyOf (src: StdModel; beg, end: INTEGER; dst: StdModel): StdModel;
762 VAR buf: StdModel; u, v, r, z, zn: Run; ud, vd: INTEGER;
763 BEGIN
764 ASSERT(beg < end, 20);
765 buf := Containers.CloneOf(dst)(StdModel);
766 ASSERT(buf.Domain() = NIL, 100);
767 Find(src, beg, u, ud); Find(src, end, v, vd);
768 z := buf.trailer; r := u;
769 WHILE r # v DO
770 WITH r: LPiece DO (* Piece or LPiece *)
771 zn := CopyOfPiece(r); DEC(zn.len, ud);
772 IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END
773 | r: ViewRef DO
774 zn := CopyOfViewRef(r, buf)
775 ELSE (* ignore *)
776 END;
777 z.next := zn; zn.prev := z; z := zn; r := r.next; ud := 0
778 END;
779 IF vd > 0 THEN (* v IS LPiece *)
780 zn := CopyOfPiece(v(LPiece)); zn.len := vd - ud;
781 IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END;
782 z.next := zn; zn.prev := z; z := zn
783 END;
784 z.next := buf.trailer; buf.trailer.prev := z;
785 buf.len := end - beg;
786 RETURN buf
787 END CopyOf;
789 PROCEDURE ProjectionOf (src: Model; beg, end: INTEGER; dst: StdModel): StdModel;
790 (* rider-conversion to eliminate covariance conflicts in binary operations *)
791 VAR buf: StdModel; rd: Reader; wr: Writer;
792 BEGIN
793 rd := src.NewReader(NIL); rd.SetPos(beg);
794 buf := Containers.CloneOf(dst)(StdModel); ASSERT(buf.Domain() = NIL, 100);
795 wr := buf.NewWriter(NIL);
796 WHILE beg < end DO
797 INC(beg);
798 rd.Read; wr.SetAttr(rd.attr);
799 IF rd.view # NIL THEN
800 wr.WriteView(Views.CopyOf(rd.view, Views.deep), rd.w, rd.h)
801 ELSE
802 wr.WriteChar(rd.char)
803 END
804 END;
805 RETURN buf
806 END ProjectionOf;
808 PROCEDURE Move (src: StdModel; beg, end: INTEGER; dest: StdModel; pos: INTEGER);
809 VAR pc: PieceCache; view: Views.View;
810 u, un, v, vn, w, wn: Run; ud, vd, wd: INTEGER;
811 (*initDom: BOOLEAN; newDom, dom: Stores.Domain;*)
812 upd: UpdateMsg; neut: Models.NeutralizeMsg;
813 BEGIN
814 Models.Broadcast(src, neut);
815 Find(src, beg, u, ud); Split(ud, u, un); pc := src.pc;
816 Find(src, end, v, vd); Split(vd, v, vn); src.pc := pc;
817 Merge(src, u, vn); u.next := vn; vn.prev := u;
818 DEC(src.len, end - beg);
819 InvalCache(src, beg);
820 INC(src.era);
821 upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := beg - end;
822 Models.Broadcast(src, upd);
823 IF src = dest THEN
824 IF pos > end THEN DEC(pos, end - beg) END
825 ELSE
826 (*newDom := dest.Domain(); initDom := (src.Domain() = NIL) & (newDom # NIL);*)
827 w := un;
828 WHILE w # vn DO
829 (*
830 IF initDom THEN
831 dom := w.attr.Domain();
832 IF (dom # NIL) & (dom # newDom) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
833 Stores.InitDomain(w.attr, newDom)
834 END;
835 *)
836 IF ~Stores.Joined(dest, w.attr) THEN
837 IF ~Stores.Unattached(w.attr) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
838 Stores.Join(dest, w.attr)
839 END;
840 WITH w: ViewRef DO
841 view := w.view;
842 (*IF initDom THEN Stores.InitDomain(view, newDom) END;*)
843 Stores.Join(dest, view);
844 view.context(StdContext).text := dest
845 ELSE
846 END;
847 w := w.next
848 END
849 END;
850 Find(dest, pos, w, wd); Split(wd, w, wn); Splice(wn, un, v);
851 v := wn.prev; Merge(dest, v, wn); v.next := wn; wn.prev := v;
852 wn := w.next; Merge(dest, w, wn); w.next := wn; wn.prev := w;
853 INC(dest.len, end - beg);
854 InvalCache(dest, pos);
855 INC(dest.era);
856 upd.op := insert; upd.beg := pos; upd.end := pos + end - beg; upd.delta := end - beg;
857 Models.Broadcast(dest, upd)
858 END Move;
861 (* StdModel - operations *)
863 PROCEDURE (op: MoveOp) Do;
864 VAR src, dest: StdModel; beg, end, pos: INTEGER; neut: Models.NeutralizeMsg;
865 BEGIN
866 src := op.src; beg := op.beg; end := op.end; dest := op.dest; pos := op.pos;
867 IF src = dest THEN
868 IF pos < beg THEN
869 op.pos := end; op.beg := pos; op.end := pos + end - beg
870 ELSE
871 op.pos := beg; op.beg := pos - (end - beg); op.end := pos
872 END
873 ELSE
874 Models.Broadcast(op.src, neut); (* destination is neutralized by sequencer *)
875 op.dest := src; op.src := dest;
876 op.pos := beg; op.beg := pos; op.end := pos + end - beg
877 END;
878 Move(src, beg, end, dest, pos)
879 END Do;
881 PROCEDURE DoMove (name: Stores.OpName;
882 src: StdModel; beg, end: INTEGER;
883 dest: StdModel; pos: INTEGER
884 );
885 VAR op: MoveOp;
886 BEGIN
887 IF (beg < end) & ((src # dest) OR ~((beg <= pos) & (pos <= end))) THEN
888 NEW(op);
889 op.src := src; op.beg := beg; op.end := end;
890 op.dest := dest; op.pos := pos;
891 Models.Do(dest, name, op)
892 END
893 END DoMove;
896 PROCEDURE (op: EditOp) Do;
897 VAR text: StdModel; (*newDom, dom: Stores.Domain;*) pc: PieceCache;
898 u, un, v, vn: Run; sp: Piece; lp: LPiece; r: ViewRef;
899 ud, vd, beg, end, pos, len: INTEGER; w, h: INTEGER;
900 upd: UpdateMsg;
901 BEGIN
902 text := op.text;
903 CASE op.mode OF
904 deleteRange:
905 beg := op.beg; end := op.end; len := end - beg;
906 Find(text, beg, u, ud); Split(ud, u, un); pc := text.pc;
907 Find(text, end, v, vd); Split(vd, v, vn); text.pc := pc;
908 Merge(text, u, vn); u.next := vn; vn.prev := u;
909 DEC(text.len, len);
910 InvalCache(text, beg);
911 INC(text.era);
912 op.mode := moveBuf; op.canBunch := FALSE;
913 op.pos := beg; op.first := un; op.last := v; op.len := len;
914 upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := -len;
915 Models.Broadcast(text, upd)
916 | moveBuf:
917 pos := op.pos;
918 Find(text, pos, u, ud); Split(ud, u, un); Splice(un, op.first, op.last);
919 INC(text.len, op.len);
920 InvalCache(text, pos);
921 INC(text.era);
922 op.mode := deleteRange;
923 op.beg := pos; op.end := pos + op.len;
924 upd.op := insert; upd.beg := pos; upd.end := pos + op.len; upd.delta := op.len;
925 Models.Broadcast(text, upd)
926 | writeSChar:
927 pos := op.pos;
928 InvalCache(text, pos);
929 Find(text, pos, u, ud); Split(ud, u, un);
930 IF (u.attr = op.attr) & (u IS Piece) & (u(Piece).file = text.spill.file)
931 & (u(Piece).org + u.len = op.len) THEN
932 INC(u.len);
933 IF text.pc.org >= pos THEN INC(text.pc.org) END
934 ELSE
935 (*
936 newDom := text.Domain();
937 IF newDom # NIL THEN
938 dom := op.attr.Domain();
939 IF (dom # NIL) & (dom # newDom) THEN
940 op.attr := Stores.CopyOf(op.attr)(Attributes)
941 END;
942 Stores.InitDomain(op.attr, newDom)
943 END;
944 *)
945 IF ~Stores.Joined(text, op.attr) THEN
946 IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
947 Stores.Join(text, op.attr)
948 END;
949 NEW(sp); u.next := sp; sp.prev := u; sp.next := un; un.prev := sp;
950 sp.len := 1; sp.attr := op.attr;
951 sp.file := text.spill.file; sp.org := op.len;
952 IF text.pc.org > pos THEN INC(text.pc.org) END
953 END;
954 INC(text.len); INC(text.era);
955 op.mode := deleteRange;
956 upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
957 Models.Broadcast(text, upd)
958 | writeChar:
959 pos := op.pos;
960 InvalCache(text, pos);
961 Find(text, pos, u, ud); Split(ud, u, un);
962 IF (u.attr = op.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = text.spill.file)
963 & (u(LPiece).org + 2 * u.len = op.len) THEN
964 INC(u.len);
965 IF text.pc.org >= pos THEN INC(text.pc.org) END
966 ELSE
967 (*
968 newDom := text.Domain();
969 IF newDom # NIL THEN
970 dom := op.attr.Domain();
971 IF (dom # NIL) & (dom # newDom) THEN
972 op.attr := Stores.CopyOf(op.attr)(Attributes)
973 END;
974 Stores.InitDomain(op.attr, newDom)
975 END;
976 *)
977 IF ~Stores.Joined(text, op.attr) THEN
978 IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
979 Stores.Join(text, op.attr)
980 END;
981 NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
982 lp.len := 1; lp.attr := op.attr;
983 lp.file := text.spill.file; lp.org := op.len;
984 IF text.pc.org > pos THEN INC(text.pc.org) END
985 END;
986 INC(text.len); INC(text.era);
987 op.mode := deleteRange;
988 upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
989 Models.Broadcast(text, upd)
990 | writeView:
991 pos := op.pos; r := op.first(ViewRef);
992 InvalCache(text, pos);
993 Find(text, pos, u, ud); Split(ud, u, un);
994 u.next := r; r.prev := u; r.next := un; un.prev := r;
995 INC(text.len); INC(text.era);
996 r.view.InitContext(NewContext(r, text));
997 (* Stores.InitDomain(r.view, text.Domain()); *)
998 Stores.Join(text, r.view);
999 w := r.w; h := r.h; r.w := defW; r.h := defH;
1000 Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
1001 w, h
1002 );
1003 r.w := w; r.h := h;
1004 op.mode := deleteRange;
1005 upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
1006 Models.Broadcast(text, upd)
1007 END
1008 END Do;
1010 PROCEDURE GetWriteOp (t: StdModel; pos: INTEGER; VAR op: EditOp; VAR bunch: BOOLEAN);
1011 VAR last: Stores.Operation;
1012 BEGIN
1013 last := Models.LastOp(t);
1014 IF (last # NIL) & (last IS EditOp) THEN
1015 op := last(EditOp);
1016 bunch := op.canBunch & (op.end = pos)
1017 ELSE bunch := FALSE
1018 END;
1019 IF bunch THEN
1020 INC(op.end)
1021 ELSE
1022 NEW(op); op.canBunch := TRUE;
1023 op.text := t; op.beg := pos; op.end := pos + 1
1024 END;
1025 op.pos := pos
1026 END GetWriteOp;
1029 PROCEDURE SetPreferredSize (t: StdModel; v: Views.View);
1030 VAR minW, maxW, minH, maxH, w, h: INTEGER;
1031 BEGIN
1032 t.GetEmbeddingLimits(minW, maxW, minH, maxH);
1033 v.context.GetSize(w, h);
1034 Properties.PreferredSize(v, minW, maxW, minH, maxH, w, h, w, h);
1035 v.context.SetSize(w, h)
1036 END SetPreferredSize;
1038 PROCEDURE (op: SetAttrOp) Do;
1039 VAR t: StdModel; attr: Attributes; z: AttrList; (*checkDom: BOOLEAN;*)
1040 pc: PieceCache; u, un, v, vn: Run; ud, vd, pos, next: INTEGER;
1041 upd: UpdateMsg;
1042 BEGIN
1043 t := op.text; z := op.list; pos := op.beg; (*checkDom := t.Domain() # NIL;*)
1044 WHILE z # NIL DO
1045 next := pos + z.len;
1046 IF z.attr # NIL THEN
1047 Find(t, pos, u, ud); Split(ud, u, un); pc := t.pc;
1048 Find(t, next, v, vd); Split(vd, v, vn); t.pc := pc;
1049 attr := un.attr;
1050 WHILE un # vn DO
1051 un.attr := z.attr;
1052 (*
1053 IF checkDom & (un.attr.Domain() # t.Domain()) THEN
1054 IF un.attr.Domain() # NIL THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
1055 Stores.InitDomain(un.attr, t.Domain())
1056 END;
1057 *)
1058 IF ~Stores.Joined(t, un.attr) THEN
1059 IF ~Stores.Unattached(un.attr) THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
1060 Stores.Join(t, un.attr)
1061 END;
1062 Merge(t, u, un);
1063 WITH un: ViewRef DO SetPreferredSize(t, un.view) ELSE END;
1064 IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
1065 END;
1066 Merge(t, u, un); u.next := un; un.prev := u;
1067 z.attr := attr
1068 END;
1069 pos := next; z := z.next
1070 END;
1071 INC(t.era);
1072 upd.op := replace; upd.beg := op.beg; upd.end := pos; upd.delta := 0;
1073 Models.Broadcast(t, upd)
1074 END Do;
1077 PROCEDURE (op: ResizeViewOp) Do;
1078 VAR r: ViewRef; w, h: INTEGER; upd: UpdateMsg;
1079 BEGIN
1080 r := op.ref;
1081 w := op.w; h := op.h; op.w := r.w; op.h := r.h; r.w := w; r.h := h;
1082 INC(op.text.era);
1083 upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
1084 Models.Broadcast(op.text, upd)
1085 END Do;
1088 PROCEDURE (op: ReplaceViewOp) Do;
1089 VAR new: Views.View; upd: UpdateMsg;
1090 BEGIN
1091 new := op.new; op.new := op.ref.view; op.ref.view := new;
1092 INC(op.text.era);
1093 upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
1094 Models.Broadcast(op.text, upd)
1095 END Do;
1098 (* StdModel *)
1100 PROCEDURE (t: StdModel) InitFrom (source: Containers.Model);
1101 BEGIN
1102 WITH source: StdModel DO
1103 ASSERT(source.trailer # NIL, 20);
1104 t.spill := source.spill; (* reduce no of temp files: share spill files among clones *)
1105 StdInit(t)
1106 END
1107 END InitFrom;
1109 PROCEDURE WriteCharacters (t: StdModel; VAR wr: Stores.Writer);
1110 VAR r: Files.Reader; u: Run; len: INTEGER;
1111 (*
1112 sp: Properties.StorePref;
1113 *)
1114 buf: ARRAY 1024 OF BYTE;
1115 BEGIN
1116 r := NIL;
1117 u := t.trailer.next;
1118 WHILE u # t.trailer DO
1119 WITH u: Piece DO
1120 r := u.file.NewReader(r); r.SetPos(u.org);
1121 len := u.len;
1122 WHILE len > LEN(buf) DO
1123 r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
1124 DEC(len, LEN(buf))
1125 END;
1126 r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
1127 | u: LPiece DO (* ~(u IS Piece) *)
1128 r := u.file.NewReader(r); r.SetPos(u.org);
1129 len := 2 * u.len;
1130 WHILE len > LEN(buf) DO
1131 r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
1132 DEC(len, LEN(buf))
1133 END;
1134 r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
1135 | u: ViewRef DO
1136 (*
1137 sp.view := u.view; Views.HandlePropMsg(u.view, sp);
1138 IF sp.view # NIL THEN wr.WriteSChar(viewcode) END
1139 *)
1140 IF Stores.ExternalizeProxy(u.view) # NIL THEN
1141 wr.WriteSChar(viewcode)
1142 END
1143 END;
1144 u := u.next
1145 END
1146 END WriteCharacters;
1148 PROCEDURE WriteAttributes (VAR wr: Stores.Writer; t: StdModel;
1149 a: Attributes; VAR dict: AttrDict
1150 );
1151 VAR k, len: BYTE;
1152 BEGIN
1153 len := dict.len; k := 0; WHILE (k # len) & ~a.Equals(dict.attr[k]) DO INC(k) END;
1154 wr.WriteByte(k);
1155 IF k = len THEN
1156 IF len < dictSize THEN dict.attr[len] := a; INC(dict.len) END;
1157 (* ASSERT(Stores.Joined(t, a)); but bkwd-comp: *)
1158 (* IF a.Domain() # d THEN always copy: bkwd-comp hack to avoid link *)
1159 a := Stores.CopyOf(a)(Attributes); (* Stores.InitDomain(a, d); *) Stores.Join(t, a);
1160 (* END; *)
1161 WriteAttr(wr, a)
1162 END
1163 END WriteAttributes;
1165 PROCEDURE (t: StdModel) Externalize (VAR wr: Stores.Writer);
1166 VAR (*dom: Stores.Domain;*) u, v, un: Run;
1167 attr: Attributes; dict: AttrDict;
1168 org, runlen, pos: INTEGER; lchars: BOOLEAN;
1169 inf: InfoMsg;
1170 BEGIN
1171 t.Externalize^(wr);
1172 StdInit(t); (*dom := t.Domain();*)
1173 wr.WriteVersion(0);
1174 wr.WriteInt(0); org := wr.Pos();
1175 u := t.trailer.next; v := t.trailer; dict.len := 0; lchars := FALSE;
1176 WHILE u # v DO
1177 attr := u.attr;
1178 WITH u: Piece DO
1179 runlen := u.len; un := u.next;
1180 WHILE (un IS Piece) & un.attr.Equals(attr) DO
1181 INC(runlen, un.len); un := un.next
1182 END;
1183 WriteAttributes(wr, t, attr, dict); wr.WriteInt(runlen)
1184 | u: LPiece DO (* ~(u IS Piece) *)
1185 runlen := 2 * u.len; un := u.next;
1186 WHILE (un IS LPiece) & ~(un IS Piece) & un.attr.Equals(attr) DO
1187 INC(runlen, 2 * un.len); un := un.next
1188 END;
1189 WriteAttributes(wr, t, attr, dict); wr.WriteInt(-runlen);
1190 lchars := TRUE
1191 | u: ViewRef DO
1192 IF Stores.ExternalizeProxy(u.view) # NIL THEN
1193 WriteAttributes(wr, t, attr, dict); wr.WriteInt(0);
1194 wr.WriteInt(u.w); wr.WriteInt(u.h); Views.WriteView(wr, u.view)
1195 END;
1196 un := u.next
1197 END;
1198 u := un
1199 END;
1200 wr.WriteByte(-1);
1201 pos := wr.Pos();
1202 wr.SetPos(org - 5);
1203 IF lchars THEN wr.WriteVersion(maxStdModelVersion)
1204 ELSE wr.WriteVersion(noLCharStdModelVersion) (* version 0 did not support LONGCHAR *)
1205 END;
1206 wr.WriteInt(pos - org);
1207 wr.SetPos(pos);
1208 WriteCharacters(t, wr);
1209 inf.op := store; Models.Broadcast(t, inf)
1210 END Externalize;
1212 PROCEDURE (t: StdModel) Internalize (VAR rd: Stores.Reader);
1213 VAR u, un: Run; sp: Piece; lp: LPiece; v: ViewRef;
1214 org, len: INTEGER; ano: BYTE; thisVersion: INTEGER;
1215 attr: Attributes; dict: AttrDict;
1216 BEGIN
1217 ASSERT(t.Domain() = NIL, 20); ASSERT(t.len = 0, 21);
1218 t.Internalize^(rd); IF rd.cancelled THEN RETURN END;
1219 rd.ReadVersion(minVersion, maxStdModelVersion, thisVersion);
1220 IF rd.cancelled THEN RETURN END;
1221 StdInit(t);
1222 dict.len := 0; u := t.trailer;
1223 rd.ReadInt(len); org := rd.Pos() + len;
1224 rd.ReadByte(ano);
1225 WHILE ano # -1 DO
1226 IF ano = dict.len THEN
1227 ReadAttr(rd, attr); Stores.Join(t, attr);
1228 IF dict.len < dictSize THEN dict.attr[dict.len] := attr; INC(dict.len) END
1229 ELSE
1230 attr := dict.attr[ano]
1231 END;
1232 rd.ReadInt(len);
1233 IF len > 0 THEN (* piece *)
1234 NEW(sp); sp.len := len; sp.attr := attr;
1235 sp.file := rd.rider.Base(); sp.org := org; un := sp;
1236 INC(org, len)
1237 ELSIF len < 0 THEN (* longchar piece *)
1238 len := -len; ASSERT(~ODD(len), 100);
1239 NEW(lp); lp.len := len DIV 2; lp.attr := attr;
1240 lp.file := rd.rider.Base(); lp.org := org; un := lp;
1241 INC(org, len)
1242 ELSE (* len = 0 => embedded view *)
1243 NEW(v); v.len := 1; v.attr := attr;
1244 rd.ReadInt(v.w); rd.ReadInt(v.h); Views.ReadView(rd, v.view);
1245 v.view.InitContext(NewContext(v, t));
1246 un := v; INC(org)
1247 END;
1248 INC(t.len, un.len); u.next := un; un.prev := u; u := un;
1249 rd.ReadByte(ano)
1250 END;
1251 rd.SetPos(org);
1252 u.next := t.trailer; t.trailer.prev := u
1253 END Internalize;
1255 (*
1256 PROCEDURE (t: StdModel) PropagateDomain;
1257 VAR u: Run; dom: Stores.Domain;
1258 BEGIN
1259 IF t.Domain() # NIL THEN
1260 u := t.trailer.next;
1261 WHILE u # t.trailer DO
1262 dom := u.attr.Domain();
1263 IF (dom # NIL) & (dom # t.Domain()) THEN u.attr := Stores.CopyOf(u.attr)(Attributes) END;
1264 Stores.InitDomain(u.attr, t.Domain());
1265 WITH u: ViewRef DO Stores.InitDomain(u.view, t.Domain()) ELSE END;
1266 u := u.next
1267 END
1268 END
1269 END PropagateDomain;
1270 *)
1272 PROCEDURE (t: StdModel) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
1273 BEGIN
1274 minW := minWidth; maxW := maxWidth; minH := minHeight; maxH := maxHeight
1275 END GetEmbeddingLimits;
1278 PROCEDURE (t: StdModel) Length (): INTEGER;
1279 BEGIN
1280 StdInit(t);
1281 RETURN t.len
1282 END Length;
1284 PROCEDURE (t: StdModel) NewReader (old: Reader): Reader;
1285 VAR rd: StdReader;
1286 BEGIN
1287 StdInit(t);
1288 IF (old # NIL) & (old IS StdReader) THEN rd := old(StdReader) ELSE NEW(rd) END;
1289 IF rd.base # t THEN
1290 rd.base := t; rd.era := -1; rd.SetPos(0)
1291 ELSIF rd.pos > t.len THEN
1292 rd.SetPos(t.len)
1293 END;
1294 rd.eot := FALSE;
1295 RETURN rd
1296 END NewReader;
1298 PROCEDURE (t: StdModel) NewWriter (old: Writer): Writer;
1299 VAR wr: StdWriter;
1300 BEGIN
1301 StdInit(t);
1302 IF (old # NIL) & (old IS StdWriter) THEN wr := old(StdWriter) ELSE NEW(wr) END;
1303 IF (wr.base # t) OR (wr.pos > t.len) THEN
1304 wr.base := t; wr.era := -1; wr.SetPos(t.len)
1305 END;
1306 wr.SetAttr(dir.attr);
1307 RETURN wr
1308 END NewWriter;
1310 PROCEDURE (t: StdModel) InsertCopy (pos: INTEGER; t0: Model; beg0, end0: INTEGER);
1311 VAR buf: StdModel;
1312 BEGIN
1313 StdInit(t);
1314 ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
1315 ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
1316 IF beg0 < end0 THEN
1317 WITH t0: StdModel DO buf := CopyOf(t0, beg0, end0, t)
1318 ELSE buf := ProjectionOf(t0, beg0, end0, t)
1319 END;
1320 (* IF t.Domain() # NIL THEN Stores.InitDomain(buf,t.Domain()) END; *)
1321 Stores.Join(t, buf);
1322 DoMove("#System:Copying", buf, 0, buf.len, t, pos)
1323 END
1324 END InsertCopy;
1326 PROCEDURE (t: StdModel) Insert (pos: INTEGER; t0: Model; beg, end: INTEGER);
1327 BEGIN
1328 StdInit(t);
1329 ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
1330 ASSERT(0 <= beg, 23); ASSERT(beg <= end, 24); ASSERT(end <= t0.Length(), 25);
1331 IF beg < end THEN
1332 IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
1333 DoMove("#System:Moving", t0(StdModel), beg, end, t, pos)
1334 ELSE (* moving across domains *)
1335 t.InsertCopy(pos, t0, beg, end); t0.Delete(beg, end)
1336 END
1337 END
1338 END Insert;
1340 PROCEDURE (t: StdModel) Append (t0: Model);
1341 VAR len0: INTEGER;
1342 BEGIN
1343 StdInit(t);
1344 ASSERT(t # t0, 20);
1345 len0 := t0.Length();
1346 IF len0 > 0 THEN
1347 IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
1348 DoMove("#Text:Appending", t0(StdModel), 0, len0, t, t.len)
1349 ELSE (* moving across domains *)
1350 t.InsertCopy(t.len, t0, 0, len0); t0.Delete(0, len0)
1351 END
1352 END
1353 END Append;
1355 PROCEDURE (t: StdModel) Delete (beg, end: INTEGER);
1356 VAR op: EditOp;
1357 BEGIN
1358 StdInit(t);
1359 ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
1360 IF beg < end THEN
1361 NEW(op); op.mode := deleteRange; op.canBunch := FALSE;
1362 op.text := t; op.beg := beg; op.end := end;
1363 Models.Do(t, "#System:Deleting", op)
1364 END
1365 END Delete;
1367 PROCEDURE (t: StdModel) SetAttr (beg, end: INTEGER; attr: Attributes);
1368 VAR op: SetAttrOp; zp, z: AttrList;
1369 u, v, w: Run; ud, vd: INTEGER; modified: BOOLEAN;
1370 BEGIN
1371 StdInit(t);
1372 ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
1373 IF beg < end THEN
1374 NEW(op); op.text := t; op.beg := beg;
1375 Find(t, beg, u, ud); Find(t, end, v, vd);
1376 IF vd > 0 THEN w := v.next ELSE w := v END;
1377 zp := NIL; modified := FALSE;
1378 WHILE u # w DO
1379 IF u = v THEN INC(ud, v.len - vd) END;
1380 NEW(z); z.len := u.len - ud; z.attr := attr;
1381 IF zp = NIL THEN op.list := z ELSE zp.next:= z END;
1382 zp := z;
1383 modified := modified OR ~u.attr.Equals(attr);
1384 u := u.next; ud := 0
1385 END;
1386 IF modified THEN Models.Do(t, "#Text:AttributeChange", op) END
1387 END
1388 END SetAttr;
1390 PROCEDURE (t: StdModel) Prop (beg, end: INTEGER): Properties.Property;
1391 VAR p, q: Properties.Property; tp: Prop;
1392 u, v, w: Run; ud, vd: INTEGER; equal: BOOLEAN;
1393 rd: Reader;
1394 BEGIN
1395 StdInit(t);
1396 ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
1397 IF beg < end THEN
1398 Find(t, beg, u, ud); Find(t, end, v, vd);
1399 IF vd > 0 THEN w := v.next ELSE w := v END;
1400 p := u.attr.Prop();
1401 u := u.next;
1402 WHILE u # w DO
1403 Properties.Intersect(p, u.attr.Prop(), equal);
1404 u := u.next
1405 END;
1406 IF beg + 1 = end THEN
1407 t.rd := t.NewReader(t.rd); rd := t.rd;
1408 rd.SetPos(beg); rd.Read;
1409 IF (rd.view = NIL) OR (rd.char # viewcode) THEN
1410 q := p; WHILE (q # NIL) & ~(q IS Prop) DO q := q.next END;
1411 IF q # NIL THEN
1412 tp := q(Prop)
1413 ELSE NEW(tp); Properties.Insert(p, tp)
1414 END;
1415 INCL(tp.valid, code); INCL(tp.known, code); INCL(tp.readOnly, code);
1416 tp.code := rd.char
1417 END
1418 END
1419 ELSE p := NIL
1420 END;
1421 RETURN p
1422 END Prop;
1424 PROCEDURE (t: StdModel) Modify (beg, end: INTEGER; old, p: Properties.Property);
1425 VAR op: SetAttrOp; zp, z: AttrList;
1426 u, v, w: Run; ud, vd: INTEGER; equal, modified: BOOLEAN;
1427 q: Properties.Property;
1428 BEGIN
1429 StdInit(t);
1430 ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
1431 IF (beg < end) & (p # NIL) THEN
1432 NEW(op); op.text := t; op.beg := beg;
1433 Find(t, beg, u, ud); Find(t, end, v, vd);
1434 IF vd > 0 THEN w := v.next ELSE w := v END;
1435 zp := NIL; modified := FALSE;
1436 WHILE u # w DO
1437 IF u = v THEN INC(ud, v.len - vd) END;
1438 IF old # NIL THEN
1439 q := u.attr.Prop();
1440 Properties.Intersect(q, old, equal); (* q := q * old *)
1441 Properties.Intersect(q, old, equal) (* equal := q = old *)
1442 END;
1443 NEW(z); z.len := u.len - ud;
1444 IF (old = NIL) OR equal THEN
1445 z.attr := ModifiedAttr(u.attr, p);
1446 modified := modified OR ~u.attr.Equals(z.attr)
1447 END;
1448 IF zp = NIL THEN op.list := z ELSE zp.next := z END;
1449 zp := z;
1450 u := u.next; ud := 0
1451 END;
1452 IF modified THEN Models.Do(t, "#System:Modifying", op) END
1453 END
1454 END Modify;
1456 PROCEDURE (t: StdModel) ReplaceView (old, new: Views.View);
1457 VAR c: StdContext; op: ReplaceViewOp;
1458 BEGIN
1459 StdInit(t);
1460 ASSERT(old.context # NIL, 20); ASSERT(old.context IS StdContext, 21);
1461 ASSERT(old.context(StdContext).text = t, 22);
1462 ASSERT((new.context = NIL) OR (new.context = old.context), 24);
1463 IF new # old THEN
1464 c := old.context(StdContext);
1465 IF new.context = NIL THEN new.InitContext(c) END;
1466 (* Stores.InitDomain(new, t.Domain()); *)
1467 Stores.Join(t, new);
1468 NEW(op); op.text := t; op.pos := c.Pos(); op.ref := c.ref; op.new := new;
1469 Models.Do(t, "#System:Replacing", op)
1470 END
1471 END ReplaceView;
1473 PROCEDURE (t: StdModel) CopyFrom- (source: Stores.Store);
1474 BEGIN
1475 StdInit(t);
1476 WITH source: StdModel DO t.InsertCopy(0, source, 0, source.len) END
1477 END CopyFrom;
1479 PROCEDURE (t: StdModel) Replace (beg, end: INTEGER; t0: Model; beg0, end0: INTEGER);
1480 VAR script: Stores.Operation;
1481 BEGIN
1482 StdInit(t);
1483 ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
1484 ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
1485 ASSERT(t # t0, 26);
1486 Models.BeginScript(t, "#System:Replacing", script);
1487 t.Delete(beg, end); t.Insert(beg, t0, beg0, end0);
1488 Models.EndScript(t, script)
1489 END Replace;
1492 (* StdContext *)
1494 PROCEDURE (c: StdContext) ThisModel (): Model;
1495 BEGIN
1496 RETURN c.text
1497 END ThisModel;
1499 PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
1500 BEGIN
1501 w := c.ref.w; h := c.ref.h
1502 END GetSize;
1504 PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
1505 VAR t: StdModel; r: ViewRef; op: ResizeViewOp;
1506 BEGIN
1507 t := c.text; r := c.ref;
1508 IF w = Views.undefined THEN w := r.w END;
1509 IF h = Views.undefined THEN h := r.h END;
1510 Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, r.w, r.h, w, h);
1511 IF (w # r.w) OR (h # r.h) THEN
1512 NEW(op); op.text := t; op.pos := c.Pos(); op.ref := r; op.w := w; op.h := h;
1513 Models.Do(t, "#System:Resizing", op)
1514 END
1515 END SetSize;
1517 PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
1518 BEGIN
1519 RETURN FALSE
1520 END Normalize;
1522 PROCEDURE (c: StdContext) Pos (): INTEGER;
1523 VAR t: StdModel; u, r, w: Run; pos: INTEGER;
1524 BEGIN
1525 t := c.text; r := c.ref;
1526 IF t.pc.prev.next # r THEN
1527 u := t.trailer.next; w := t.trailer; pos := 0;
1528 WHILE (u # r) & (u # w) DO INC(pos, u.len); u := u.next END;
1529 ASSERT(u = r, 20);
1530 t.pc.prev := r.prev; t.pc.org := pos
1531 END;
1532 RETURN t.pc.org
1533 END Pos;
1535 PROCEDURE (c: StdContext) Attr (): Attributes;
1536 BEGIN
1537 RETURN c.ref.attr
1538 END Attr;
1541 (* StdReader *)
1543 PROCEDURE RemapView (rd: StdReader);
1544 VAR p: Pref;
1545 BEGIN
1546 p.opts := {}; Views.HandlePropMsg(rd.view, p);
1547 IF maskChar IN p.opts THEN rd.char := p.mask ELSE rd.char := viewcode END
1548 END RemapView;
1550 PROCEDURE Reset (rd: StdReader);
1551 VAR t: StdModel;
1552 BEGIN
1553 t := rd.base;
1554 Find(t, rd.pos, rd.run, rd.off); rd.era := t.era
1555 END Reset;
1558 PROCEDURE (rd: StdReader) Base (): Model;
1559 BEGIN
1560 RETURN rd.base
1561 END Base;
1563 PROCEDURE (rd: StdReader) SetPos (pos: INTEGER);
1564 BEGIN
1565 ASSERT(pos >= 0, 20); ASSERT(rd.base # NIL, 21); ASSERT(pos <= rd.base.len, 22);
1566 rd.eot := FALSE; rd.attr := NIL; rd.char := 0X; rd.view := NIL;
1567 IF (rd.pos # pos) OR (rd.run = rd.base.trailer) THEN
1568 rd.pos := pos; rd.era := -1
1569 END
1570 END SetPos;
1572 PROCEDURE (rd: StdReader) Pos (): INTEGER;
1573 BEGIN
1574 RETURN rd.pos
1575 END Pos;
1577 PROCEDURE (rd: StdReader) Read;
1578 VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
1579 BEGIN
1580 t := rd.base;
1581 n := t.id MOD cacheWidth;
1582 IF rd.era # t.era THEN Reset(rd) END;
1583 u := rd.run;
1584 WITH u: Piece DO
1585 rd.attr := u.attr;
1586 pos := rd.pos MOD cacheLen;
1587 IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
1588 (* cache miss *)
1589 IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
1590 len := cacheLine;
1591 IF len > cacheLen - pos THEN len := cacheLen - pos END;
1592 IF len > u.len - rd.off THEN len := u.len - rd.off END;
1593 rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off);
1594 rd.reader.ReadBytes(cache[n].buf, pos, len);
1595 IF rd.pos = cache[n].end THEN
1596 cache[n].end := rd.pos + len;
1597 (*
1598 INC(cache[n].end, len);
1599 *)
1600 IF cache[n].end - cache[n].beg >= cacheLen THEN
1601 cache[n].beg := cache[n].end - (cacheLen - 1)
1602 END
1603 ELSE cache[n].beg := rd.pos; cache[n].end := rd.pos + len
1604 END
1605 END;
1606 rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL;
1607 INC(rd.pos); INC(rd.off);
1608 IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
1609 | u: LPiece DO (* ~(u IS Piece) *)
1610 rd.attr := u.attr;
1611 rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off * 2);
1612 rd.reader.ReadBytes(lc, 0, 2);
1613 rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
1614 IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
1615 cache[n].end := cache[n].end + 1;
1616 IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
1617 (*
1618 INC(cache[n].end);
1619 IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
1620 *)
1621 END;
1622 INC(rd.pos); INC(rd.off);
1623 IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
1624 | u: ViewRef DO
1625 rd.attr := u.attr;
1626 rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
1627 IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
1628 cache[n].end := cache[n].end + 1;
1629 IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
1630 (*
1631 INC(cache[n].end);
1632 IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
1633 *)
1634 END;
1635 INC(rd.pos); rd.run := u.next; rd.off := 0
1636 ELSE
1637 rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
1638 END
1639 END Read;
1641 PROCEDURE (rd: StdReader) ReadPrev;
1642 VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
1643 BEGIN
1644 t := rd.base;
1645 n := t.id MOD cacheWidth;
1646 IF rd.era # t.era THEN Reset(rd) END;
1647 IF rd.off > 0 THEN DEC(rd.off)
1648 ELSIF rd.pos > 0 THEN
1649 rd.run := rd.run.prev; rd.off := rd.run.len - 1
1650 ELSE rd.run := t.trailer
1651 END;
1652 u := rd.run;
1653 WITH u: Piece DO
1654 rd.attr := u.attr;
1655 DEC(rd.pos);
1656 pos := rd.pos MOD cacheLen;
1657 IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
1658 (* cache miss *)
1659 IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
1660 len := cacheLine;
1661 IF len > pos + 1 THEN len := pos + 1 END;
1662 IF len > rd.off + 1 THEN len := rd.off + 1 END;
1663 rd.reader := u.file.NewReader(rd.reader);
1664 rd.reader.SetPos(u.org + rd.off - (len - 1));
1665 rd.reader.ReadBytes(cache[n].buf, pos - (len - 1), len);
1666 IF rd.pos = cache[n].beg - 1 THEN
1667 cache[n].beg := cache[n] .beg - len;
1668 (*
1669 DEC(cache[n].beg, len);
1670 *)
1671 IF cache[n].end - cache[n].beg >= cacheLen THEN
1672 cache[n].end := cache[n].beg + (cacheLen - 1)
1673 END
1674 ELSE cache[n].beg := rd.pos - (len - 1); cache[n].end := rd.pos + 1
1675 END
1676 END;
1677 rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL
1678 | u: LPiece DO (* ~(u IS Piece) *)
1679 rd.attr := u.attr;
1680 rd.reader := u.file.NewReader(rd.reader);
1681 rd.reader.SetPos(u.org + 2 * rd.off);
1682 rd.reader.ReadBytes(lc, 0, 2);
1683 rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
1684 IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
1685 cache[n].beg := cache[n].beg - 1;
1686 IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
1687 (*
1688 DEC(cache[n].beg);
1689 IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
1690 *)
1691 END;
1692 DEC(rd.pos)
1693 | u: ViewRef DO
1694 rd.attr := u.attr;
1695 rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
1696 IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
1697 cache[n].beg := cache[n].beg - 1;
1698 IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
1699 (*
1700 DEC(cache[n].beg);
1701 IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
1702 *)
1703 END;
1704 DEC(rd.pos)
1705 ELSE
1706 rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
1707 END
1708 END ReadPrev;
1710 PROCEDURE (rd: StdReader) ReadChar (OUT ch: CHAR);
1711 BEGIN
1712 rd.Read; ch := rd.char
1713 END ReadChar;
1715 PROCEDURE (rd: StdReader) ReadPrevChar (OUT ch: CHAR);
1716 BEGIN
1717 rd.ReadPrev; ch := rd.char
1718 END ReadPrevChar;
1720 PROCEDURE (rd: StdReader) ReadView (OUT v: Views.View);
1721 VAR t: StdModel; u: Run;
1722 BEGIN
1723 t := rd.base;
1724 IF rd.era # t.era THEN Reset(rd) END;
1725 DEC(rd.pos, rd.off);
1726 u := rd.run;
1727 WHILE u IS LPiece DO INC(rd.pos, u.len); u := u.next END;
1728 WITH u: ViewRef DO
1729 INC(rd.pos); rd.run := u.next; rd.off := 0;
1730 rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
1731 ELSE (* u = t.trailer *)
1732 ASSERT(u = t.trailer, 100);
1733 rd.run := u; rd.off := 0;
1734 rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
1735 END;
1736 v := rd.view
1737 END ReadView;
1739 PROCEDURE (rd: StdReader) ReadPrevView (OUT v: Views.View);
1740 VAR t: StdModel; u: Run;
1741 BEGIN
1742 t := rd.base;
1743 IF rd.era # t.era THEN Reset(rd) END;
1744 DEC(rd.pos, rd.off);
1745 u := rd.run.prev;
1746 WHILE u IS LPiece DO DEC(rd.pos, u.len); u := u.prev END;
1747 rd.run := u; rd.off := 0;
1748 WITH u: ViewRef DO
1749 DEC(rd.pos);
1750 rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
1751 ELSE (* u = t.trailer *)
1752 ASSERT(u = t.trailer, 100);
1753 rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
1754 END;
1755 v := rd.view
1756 END ReadPrevView;
1758 PROCEDURE (rd: StdReader) ReadRun (OUT attr: Attributes);
1759 VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
1760 BEGIN
1761 t := rd.base;
1762 IF rd.era # t.era THEN Reset(rd) END;
1763 a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
1764 WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
1765 INC(pos, u.len); u := u.next
1766 END;
1767 rd.run := u; rd.pos := pos; rd.off := 0;
1768 rd.Read;
1769 attr := rd.attr
1770 END ReadRun;
1772 PROCEDURE (rd: StdReader) ReadPrevRun (OUT attr: Attributes);
1773 VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
1774 BEGIN
1775 t := rd.base;
1776 IF rd.era # t.era THEN Reset(rd) END;
1777 a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
1778 IF u # trailer THEN u := u.prev; DEC(pos, u.len) END;
1779 WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
1780 u := u.prev; DEC(pos, u.len)
1781 END;
1782 IF u # trailer THEN
1783 rd.run := u.next; rd.pos := pos + u.len; rd.off := 0
1784 ELSE
1785 rd.run := trailer; rd.pos := 0; rd.off := 0
1786 END;
1787 rd.ReadPrev;
1788 attr := rd.attr
1789 END ReadPrevRun;
1792 (* StdWriter *)
1794 PROCEDURE WriterReset (wr: StdWriter);
1795 VAR t: StdModel; u: Run; uo: INTEGER;
1796 BEGIN
1797 t := wr.base;
1798 Find(t, wr.pos, u, uo); Split(uo, u, wr.run); wr.era := t.era
1799 END WriterReset;
1801 PROCEDURE (wr: StdWriter) Base (): Model;
1802 BEGIN
1803 RETURN wr.base
1804 END Base;
1806 PROCEDURE (wr: StdWriter) SetPos (pos: INTEGER);
1807 BEGIN
1808 ASSERT(pos >= 0, 20); ASSERT(wr.base # NIL, 21); ASSERT(pos <= wr.base.len, 22);
1809 IF wr.pos # pos THEN
1810 wr.pos := pos; wr.era := -1
1811 END
1812 END SetPos;
1814 PROCEDURE (wr: StdWriter) Pos (): INTEGER;
1815 BEGIN
1816 RETURN wr.pos
1817 END Pos;
1819 PROCEDURE WriteSChar (wr: StdWriter; ch: SHORTCHAR);
1820 VAR t: StdModel; u, un: Run; p: Piece; pos, spillPos: INTEGER;
1821 op: EditOp; bunch: BOOLEAN;
1822 BEGIN
1823 t := wr.base; pos := wr.pos;
1824 IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
1825 t.spill.writer.WriteByte(SHORT(ORD(ch))); spillPos := t.spill.len; t.spill.len := spillPos + 1;
1826 IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
1827 (* optimized for speed - writing to unbound text *)
1828 InvalCache(t, pos);
1829 IF wr.era # t.era THEN WriterReset(wr) END;
1830 un := wr.run; u := un.prev;
1831 IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS Piece) & (u(Piece).file = t.spill.file)
1832 & (u(Piece).org + u.len = spillPos) THEN
1833 INC(u.len);
1834 IF t.pc.org >= pos THEN INC(t.pc.org) END
1835 ELSE
1836 NEW(p); u.next := p; p.prev := u; p.next := un; un.prev := p;
1837 p.len := 1; p.attr := wr.attr;
1838 p.file := t.spill.file; p.org := spillPos;
1839 IF t.pc.org > pos THEN INC(t.pc.org) END;
1840 IF ~Stores.Joined(t, p.attr) THEN
1841 IF ~Stores.Unattached(p.attr) THEN p.attr := Stores.CopyOf(p.attr)(Attributes) END;
1842 Stores.Join(t, p.attr)
1843 END
1844 END;
1845 INC(t.era); INC(t.len);
1846 INC(wr.era)
1847 ELSE
1848 GetWriteOp(t, pos, op, bunch);
1849 IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
1850 op.mode := writeSChar; (*op.attr := wr.attr;*) op.len := spillPos;
1851 IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
1852 END;
1853 wr.pos := pos + 1
1854 END WriteSChar;
1856 PROCEDURE (wr: StdWriter) WriteChar (ch: CHAR);
1857 VAR t: StdModel; u, un: Run; lp: LPiece; pos, spillPos: INTEGER;
1858 fw: Files.Writer; op: EditOp; bunch: BOOLEAN;
1859 BEGIN
1860 IF (ch >= 20X) & (ch < 7FX)
1861 OR (ch = tab) OR (ch = line) OR (ch = para)
1862 OR (ch = zwspace) OR (ch = digitspace)
1863 OR (ch = hyphen) OR (ch = nbhyphen) OR (ch >= 0A0X) & (ch < 100X) THEN
1864 WriteSChar(wr, SHORT(ch)) (* could inline! *)
1865 ELSIF ch = 200BX THEN wr.WriteChar(zwspace)
1866 ELSIF ch = 2010X THEN wr.WriteChar(hyphen)
1867 ELSIF ch = 2011X THEN wr.WriteChar(nbhyphen)
1868 ELSIF ch >= 100X THEN
1869 t := wr.base; pos := wr.pos;
1870 IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
1871 fw := t.spill.writer;
1872 fw.WriteByte(SHORT(SHORT(ORD(ch))));
1873 fw.WriteByte(SHORT(SHORT(ORD(ch) DIV 256 - 128)));
1874 spillPos := t.spill.len; t.spill.len := spillPos + 2;
1875 IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
1876 (* optimized for speed - writing to unbound text *)
1877 InvalCache(t, pos);
1878 IF wr.era # t.era THEN WriterReset(wr) END;
1879 un := wr.run; u := un.prev;
1880 IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = t.spill.file)
1881 & (u(LPiece).org + 2 * u.len = spillPos) THEN
1882 INC(u.len);
1883 IF t.pc.org >= pos THEN INC(t.pc.org) END
1884 ELSE
1885 NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
1886 lp.len := 1; lp.attr := wr.attr;
1887 lp.file := t.spill.file; lp.org := spillPos;
1888 IF t.pc.org > pos THEN INC(t.pc.org) END;
1889 IF ~Stores.Joined(t, lp.attr) THEN
1890 IF ~Stores.Unattached(lp.attr) THEN lp.attr := Stores.CopyOf(lp.attr)(Attributes) END;
1891 Stores.Join(t, lp.attr)
1892 END
1893 END;
1894 INC(t.era); INC(t.len);
1895 INC(wr.era)
1896 ELSE
1897 GetWriteOp(t, pos, op, bunch);
1898 IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
1899 op.mode := writeChar; (*op.attr := wr.attr;*) op.len := spillPos;
1900 IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
1901 END;
1902 wr.pos := pos + 1
1903 END
1904 END WriteChar;
1906 PROCEDURE (wr: StdWriter) WriteView (view: Views.View; w, h: INTEGER);
1907 VAR t: StdModel; u, un: Run; r: ViewRef; pos: INTEGER;
1908 op: EditOp; bunch: BOOLEAN;
1909 BEGIN
1910 ASSERT(view # NIL, 20); ASSERT(view.context = NIL, 21);
1911 t := wr.base; pos := wr.pos;
1912 Stores.Join(t, view);
1913 IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
1914 (* optimized for speed - writing to unbound text *)
1915 IF wr.era # t.era THEN WriterReset(wr) END;
1916 InvalCache(t, pos);
1917 NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := defW; r.h := defH;
1918 un := wr.run; u := un.prev; u.next := r; r.prev := u; r.next := un; un.prev := r;
1919 IF t.pc.org > pos THEN INC(t.pc.org) END;
1920 INC(t.era); INC(t.len);
1921 view.InitContext(NewContext(r, t));
1922 Properties.PreferredSize(view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
1923 w, h
1924 );
1925 r.w := w; r.h := h;
1926 INC(wr.era)
1927 ELSE
1928 NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := w; r.h := h;
1929 GetWriteOp(t, pos, op, bunch);
1930 op.mode := writeView; op.first := r;
1931 IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
1932 END;
1933 INC(wr.pos)
1934 END WriteView;
1937 (* StdDirectory *)
1939 PROCEDURE (d: StdDirectory) New (): Model;
1940 VAR t: StdModel;
1941 BEGIN
1942 NEW(t); StdInit(t); RETURN t
1943 END New;
1946 (** miscellaneous procedures **)
1947 (*
1948 PROCEDURE DumpRuns* (t: Model);
1949 VAR u: Run; n, i, beg, end: INTEGER; name: ARRAY 64 OF CHAR; r: Files.Reader; b: BYTE;
1950 BEGIN
1951 Sub.synch := FALSE;
1952 WITH t: StdModel DO
1953 u := t.trailer.next;
1954 REPEAT
1955 WITH u: Piece DO
1956 Sub.String("short");
1957 Sub.Int(u.len);
1958 Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
1959 Sub.Int(u.org); Sub.Char(" ");
1960 r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
1961 WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
1962 Sub.Ln
1963 | u: LPiece DO (* ~(u IS Piece) *)
1964 Sub.String("long");
1965 Sub.Int(-u.len);
1966 Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
1967 Sub.Int(u.org); Sub.Char(" ");
1968 r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
1969 WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
1970 Sub.Ln
1971 | u: ViewRef DO
1972 Sub.String("view");
1973 Services.GetTypeName(u.view, name);
1974 Sub.String(name); Sub.Int(u.w); Sub.Int(u.h); Sub.Ln
1975 ELSE
1976 Sub.Char("?"); Sub.Ln
1977 END;
1978 u := u.next
1979 UNTIL u = t.trailer;
1980 n := t.id MOD cacheWidth;
1981 IF cache[n].id = t.id THEN
1982 beg := cache[n].beg; end := cache[n].end;
1983 Sub.Int(beg); Sub.Int(end); Sub.Ln;
1984 Sub.Char("{");
1985 WHILE beg < end DO Sub.Char(CHR(cache[n].buf[beg MOD cacheLen])); INC(beg) END;
1986 Sub.Char("}"); Sub.Ln
1987 ELSE Sub.String("not cached"); Sub.Ln
1988 END
1989 END
1990 END DumpRuns;
1991 *)
1993 PROCEDURE NewColor* (a: Attributes; color: Ports.Color): Attributes;
1994 BEGIN
1995 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
1996 stdProp.valid := {Properties.color}; stdProp.color.val := color;
1997 RETURN ModifiedAttr(a, stdProp)
1998 END NewColor;
2000 PROCEDURE NewFont* (a: Attributes; font: Fonts.Font): Attributes;
2001 BEGIN
2002 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2003 stdProp.valid := {Properties.typeface .. Properties.weight};
2004 stdProp.typeface := font.typeface$;
2005 stdProp.size := font.size;
2006 stdProp.style.val := font.style;
2007 stdProp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
2008 stdProp.weight := font.weight;
2009 RETURN ModifiedAttr(a, stdProp)
2010 END NewFont;
2012 PROCEDURE NewOffset* (a: Attributes; offset: INTEGER): Attributes;
2013 BEGIN
2014 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2015 prop.valid := {0 (*global constant offset masked by param :-( *)}; prop.offset := offset;
2016 RETURN ModifiedAttr(a, prop)
2017 END NewOffset;
2019 PROCEDURE NewTypeface* (a: Attributes; typeface: Fonts.Typeface): Attributes;
2020 BEGIN
2021 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2022 stdProp.valid := {Properties.typeface}; stdProp.typeface := typeface;
2023 RETURN ModifiedAttr(a, stdProp)
2024 END NewTypeface;
2026 PROCEDURE NewSize* (a: Attributes; size: INTEGER): Attributes;
2027 BEGIN
2028 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2029 stdProp.valid := {Properties.size}; stdProp.size := size;
2030 RETURN ModifiedAttr(a, stdProp)
2031 END NewSize;
2033 PROCEDURE NewStyle* (a: Attributes; style: SET): Attributes;
2034 BEGIN
2035 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2036 stdProp.valid := {Properties.style}; stdProp.style.val := style; stdProp.style.mask := -{};
2037 RETURN ModifiedAttr(a, stdProp)
2038 END NewStyle;
2040 PROCEDURE NewWeight* (a: Attributes; weight: INTEGER): Attributes;
2041 BEGIN
2042 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
2043 stdProp.valid := {Properties.weight}; stdProp.weight := weight;
2044 RETURN ModifiedAttr(a, stdProp)
2045 END NewWeight;
2048 PROCEDURE WriteableChar* (ch: CHAR): BOOLEAN;
2049 (* must be identical to test in (StdWriter)WriteChar - inlined there for efficiency *)
2050 BEGIN
2051 RETURN
2052 (ch >= 20X) & (ch < 7FX) OR
2053 (ch = tab) OR (ch = line) OR (ch = para) OR
2054 (ch = zwspace) OR (ch = digitspace) OR
2055 (ch = hyphen) OR (ch = nbhyphen) OR
2056 (ch >= 0A0X) (* need to augment with test for valid Unicode *)
2057 END WriteableChar;
2060 PROCEDURE CloneOf* (source: Model): Model;
2061 BEGIN
2062 ASSERT(source # NIL, 20);
2063 RETURN Containers.CloneOf(source)(Model)
2064 END CloneOf;
2067 PROCEDURE SetDir* (d: Directory);
2068 BEGIN
2069 ASSERT(d # NIL, 20); ASSERT(d.attr # NIL, 21); ASSERT(d.attr.init, 22);
2070 dir := d
2071 END SetDir;
2074 PROCEDURE Init;
2075 VAR d: StdDirectory; a: Attributes;
2076 BEGIN
2077 NEW(a); a.InitFromProp(NIL);
2078 NEW(stdProp); stdProp.known := -{};
2079 NEW(prop); prop.known := -{};
2080 NEW(d); stdDir := d; dir := d; d.SetAttr(a)
2081 END Init;
2083 BEGIN
2084 Init
2085 END TextModels.