1 MODULE Documents;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Documents.odc *)
4 (* DO NOT EDIT *)
6 IMPORT
7 Kernel, Files, Ports, Dates, Printers,
8 Stores, Sequencers, Models, Views, Controllers, Properties,
9 Dialog, Printing, Containers;
11 CONST
12 (** Document.SetPage/PollPage decorate **)
13 plain* = FALSE; decorate* = TRUE;
15 (** Controller.opts **)
16 pageWidth* = 16; pageHeight* = 17; winWidth* = 18; winHeight* = 19;
18 point = Ports.point;
19 mm = Ports.mm;
21 defB = 8 * point; (* defB also used by HostWindows in DefBorders *)
23 scrollUnit = 16 * point;
24 abort = 1;
26 resizingKey = "#System:Resizing";
27 pageSetupKey = "#System:PageSetup";
29 docTag = 6F4F4443H; docVersion = 0;
31 minVersion = 0; maxModelVersion = 0; maxCtrlVersion = 0;
32 maxDocVersion = 0; maxStdDocVersion = 0;
35 TYPE
36 Document* = POINTER TO ABSTRACT RECORD (Containers.View) END;
38 Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
40 Directory* = POINTER TO ABSTRACT RECORD END;
43 Model = POINTER TO RECORD (Containers.Model)
44 doc: StdDocument;
45 view: Views.View;
46 l, t, r, b: INTEGER (* possibly r, b >= Views.infinite *)
47 (* l, t: constant (= defB) *)
48 (* r-l, b-t: invalid in some cases, use PollRect *)
49 END;
51 Controller = POINTER TO RECORD (Containers.Controller)
52 doc: StdDocument
53 END;
55 StdDocument = POINTER TO RECORD (Document)
56 model: Model;
57 original: StdDocument; (* original # NIL => d IS copy of original *)
58 pw, ph, pl, pt, pr, pb: INTEGER; (* invalid if original # NIL, use PollPage *)
59 decorate: BOOLEAN;
60 x, y: INTEGER (* scroll state *)
61 END;
63 StdContext = POINTER TO RECORD (Context)
64 model: Model
65 END;
67 StdDirectory = POINTER TO RECORD (Directory) END;
69 SetRectOp = POINTER TO RECORD (Stores.Operation)
70 model: Model;
71 w, h: INTEGER
72 END;
73 SetPageOp = POINTER TO RECORD (Stores.Operation)
74 d: StdDocument;
75 pw, ph, pl, pt, pr, pb: INTEGER;
76 decorate: BOOLEAN
77 END;
78 ReplaceViewOp = POINTER TO RECORD (Stores.Operation)
79 model: Model;
80 new: Views.View
81 END;
83 PrinterContext = POINTER TO RECORD (Models.Context)
84 param: Printing.Par;
85 date: Dates.Date;
86 time: Dates.Time;
87 pr: Printers.Printer;
88 l, t, r, b: INTEGER; (* frame *)
89 pw, ph: INTEGER (* paper *)
90 END;
92 UpdateMsg = RECORD (Views.Message)
93 doc: StdDocument
94 END;
97 PContext = POINTER TO RECORD (Models.Context)
98 view: Views.View;
99 w, h: INTEGER (* content size *)
100 END;
101 Pager = POINTER TO RECORD (Views.View)
102 con: PContext;
103 w, h: INTEGER; (* page size *)
104 x, y: INTEGER (* origin *)
105 END;
107 PrintingHook = POINTER TO RECORD (Printing.Hook) END;
109 TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
111 VAR
112 dir-, stdDir-: Directory;
113 cleaner: TrapCleaner;
114 current: INTEGER;
117 (** Cleaner **)
119 PROCEDURE (c: TrapCleaner) Cleanup;
120 BEGIN
121 Printing.par := NIL; current := -1
122 END Cleanup;
125 (** Document **)
127 PROCEDURE (d: Document) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
128 VAR thisVersion: INTEGER;
129 BEGIN
130 IF rd.cancelled THEN RETURN END;
131 rd.ReadVersion(minVersion, maxDocVersion, thisVersion)
132 END Internalize2;
134 PROCEDURE (d: Document) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
135 BEGIN
136 wr.WriteVersion(maxDocVersion)
137 END Externalize2;
139 PROCEDURE (d: Document) GetNewFrame* (VAR frame: Views.Frame);
140 VAR f: Views.RootFrame;
141 BEGIN
142 NEW(f); frame := f
143 END GetNewFrame;
145 PROCEDURE (d: Document) GetBackground* (VAR color: Ports.Color);
146 BEGIN
147 color := Ports.background
148 END GetBackground;
150 PROCEDURE (d: Document) DocCopyOf* (v: Views.View): Document, NEW, ABSTRACT;
151 PROCEDURE (d: Document) SetView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
152 PROCEDURE (d: Document) ThisView* (): Views.View, NEW, ABSTRACT;
153 PROCEDURE (d: Document) OriginalView* (): Views.View, NEW, ABSTRACT;
155 PROCEDURE (d: Document) SetRect* (l, t, r, b: INTEGER), NEW, ABSTRACT;
156 PROCEDURE (d: Document) PollRect* (VAR l, t, r, b: INTEGER), NEW, ABSTRACT;
157 PROCEDURE (d: Document) SetPage* (w, h, l, t, r, b: INTEGER; decorate: BOOLEAN), NEW, ABSTRACT;
158 PROCEDURE (d: Document) PollPage* (VAR w, h, l, t, r, b: INTEGER;
159 VAR decorate: BOOLEAN), NEW, ABSTRACT;
162 (** Context **)
164 PROCEDURE (c: Context) ThisDoc* (): Document, NEW, ABSTRACT;
167 (** Directory **)
169 PROCEDURE (d: Directory) New* (view: Views.View; w, h: INTEGER): Document, NEW, ABSTRACT;
172 (* operations *)
174 PROCEDURE (op: SetRectOp) Do;
175 VAR m: Model; w, h: INTEGER; upd: UpdateMsg;
176 BEGIN
177 m := op.model;
178 w := m.r - m.l; h := m.b - m.t;
179 m.r := m.l + op.w; m.b := m.t + op.h;
180 op.w := w; op.h := h;
181 IF m.doc.context # NIL THEN
182 upd.doc := m.doc;
183 Views.Domaincast(m.doc.Domain(), upd)
184 END
185 END Do;
187 PROCEDURE (op: SetPageOp) Do;
188 VAR d: StdDocument; pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN; upd: UpdateMsg;
189 BEGIN
190 d := op.d;
191 pw := d.pw; ph := d.ph; pl := d.pl; pt := d.pt; pr := d.pr; pb := d.pb;
192 decorate := d.decorate;
193 d.pw := op.pw; d.ph := op.ph; d.pl := op.pl; d.pt := op.pt; d.pr := op.pr; d.pb := op.pb;
194 d.decorate := op.decorate;
195 op.pw := pw; op.ph := d.ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
196 op.decorate := decorate;
197 IF d.context # NIL THEN
198 upd.doc := d;
199 Views.Domaincast(d.Domain(), upd)
200 END
201 END Do;
203 PROCEDURE (op: ReplaceViewOp) Do;
204 VAR new: Views.View; upd: UpdateMsg;
205 BEGIN
206 new := op.new; op.new := op.model.view; op.model.view := new;
207 upd.doc := op.model.doc;
208 IF upd.doc.context # NIL THEN
209 Views.Domaincast(upd.doc.Domain(), upd)
210 END
211 END Do;
214 (* printing support for StdDocument *)
216 PROCEDURE CheckOrientation (d: Document; prt: Printers.Printer);
217 VAR w, h, l, t, r, b: INTEGER; decorate: BOOLEAN;
218 BEGIN
219 d.PollPage(w, h, l, t, r, b, decorate);
220 prt.SetOrientation(w > h)
221 END CheckOrientation;
223 PROCEDURE NewPrinterContext (d: Document; prt: Printers.Printer; p: Printing.Par): PrinterContext;
224 VAR c: PrinterContext;
225 pw, ph, x0, y0, x1, y1, l, t, r, b: INTEGER; decorate: BOOLEAN;
226 BEGIN
227 prt.GetRect(x0, y0, x1, y1);
228 d.PollPage(pw, ph, l, t, r, b, decorate);
229 INC(l, x0); INC(t, y0); INC(r, x0); INC(b, y0);
230 NEW(c); (* c.Domain() := d.Domain(); (* dom *)*) c.param := p; Dates.GetDate(c.date); Dates.GetTime(c.time);
231 c.pr := prt;
232 c.l := l; c.t := t; c.r := r; c.b := b;
233 c.pw := pw + 2 * x0; c.ph := ph + 2 * y0; (* paper reduced to printer range *)
234 RETURN c
235 END NewPrinterContext;
237 PROCEDURE Decorate (c: PrinterContext; f: Views.Frame);
238 VAR p: Printing.Par; x0, x1, y, asc, dsc, w: INTEGER; alt: BOOLEAN;
239 BEGIN
240 p := c.param;
241 alt := p.page.alternate & ~ODD(p.page.first + Printing.Current() (* p.page.current *));
242 IF alt THEN x0 := c.pw - c.r; x1 := c.pw - c.l
243 ELSE x0 := c.l; x1 := c.r
244 END;
245 IF (alt & (p.header.left # "")) OR (~alt & (p.header.right # "")) THEN
246 p.header.font.GetBounds(asc, dsc, w);
247 y := c.t - p.header.gap - dsc;
248 Printing.PrintBanner(f, p.page, p.header, c.date, c.time, x0, x1, y)
249 END;
250 IF (alt & (p.footer.left # "")) OR (~alt & (p.footer.right # "")) THEN
251 p.footer.font.GetBounds(asc, dsc, w);
252 y := c.b + p.footer.gap + asc;
253 Printing.PrintBanner(f, p.page, p.footer, c.date, c.time, x0, x1, y)
254 END
255 END Decorate;
258 (* support for StdDocument paging *)
260 PROCEDURE HasFocus (v: Views.View; f: Views.Frame): BOOLEAN;
261 VAR focus: Views.View; dummy: Controllers.PollFocusMsg;
262 BEGIN
263 focus := NIL; dummy.focus := NIL;
264 v.HandleCtrlMsg(f, dummy, focus);
265 RETURN focus # NIL
266 END HasFocus;
268 PROCEDURE ScrollDoc(v: StdDocument; x, y: INTEGER);
269 BEGIN
270 IF (x # v.x) OR (y # v.y) THEN
271 Views.Scroll(v, x - v.x, y - v.y);
272 v.x := x; v.y := y
273 END
274 END ScrollDoc;
276 PROCEDURE PollSection (v: StdDocument; f: Views.Frame; VAR msg: Controllers.PollSectionMsg);
277 VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
278 BEGIN
279 mv := v.model.view;
280 g := Views.ThisFrame(f, mv);
281 c := v.ThisController();
282 IF c.Singleton() # NIL THEN g := NIL END;
283 IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
284 IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
285 v.PollRect(l, t, r, b);
286 IF msg.vertical THEN
287 ps := f.b - f.t; vs := b + t; p := -v.y
288 ELSE
289 ps := f.r - f.l; vs := r + l; p := -v.x
290 END;
291 IF ps > vs THEN ps := vs END;
292 ws := vs - ps;
293 IF p > ws THEN
294 p := ws;
295 IF msg.vertical THEN ScrollDoc(v, v.x, -p)
296 ELSE ScrollDoc(v, -p, v.y)
297 END
298 END;
299 msg.wholeSize := vs;
300 msg.partSize := ps;
301 msg.partPos := p;
302 msg.valid := ws > Ports.point
303 END;
304 msg.done := TRUE
305 END PollSection;
307 PROCEDURE Scroll (v: StdDocument; f: Views.Frame; VAR msg: Controllers.ScrollMsg);
308 VAR mv: Views.View; g: Views.Frame; vs, ps, ws, p, l, t, r, b: INTEGER; c: Containers.Controller;
309 BEGIN
310 mv := v.model.view;
311 g := Views.ThisFrame(f, mv);
312 c := v.ThisController();
313 IF c.Singleton() # NIL THEN g := NIL END;
314 IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END;
315 IF (g = NIL) OR ~msg.done & (~msg.focus OR ~HasFocus(mv, g)) THEN
316 v.PollRect(l, t, r, b);
317 IF msg.vertical THEN
318 ps := f.b - f.t; vs := b + t; p := -v.y
319 ELSE
320 ps := f.r - f.l; vs := r + l; p := -v.x
321 END;
322 ws := vs - ps;
323 CASE msg.op OF
324 Controllers.decLine: p := MAX(0, p - scrollUnit)
325 | Controllers.incLine: p := MIN(ws, p + scrollUnit)
326 | Controllers.decPage: p := MAX(0, p - ps + scrollUnit)
327 | Controllers.incPage: p := MIN(ws, p + ps - scrollUnit)
328 | Controllers.gotoPos: p := MAX(0, MIN(ws, msg.pos))
329 ELSE
330 END;
331 IF msg.vertical THEN ScrollDoc(v, v.x, -p)
332 ELSE ScrollDoc(v, -p, v.y)
333 END
334 END;
335 msg.done := TRUE
336 END Scroll;
338 PROCEDURE MakeVisible* (d: Document; f: Views.Frame; l, t, r, b: INTEGER);
339 VAR x, y, w, h, dw, dh, ml, mt, mr, mb: INTEGER;
340 BEGIN
341 WITH d: StdDocument DO
342 d.context.GetSize(w, h);
343 x := -d.x; y := -d.y;
344 d.PollRect(ml, mt, mr, mb);
345 dw := mr + ml - w; dh := mb + mt - h;
346 IF dw > 0 THEN
347 IF r > x + w - 2 * ml THEN x := r - w + 2 * ml END;
348 IF l < x THEN x := l END;
349 IF x < 0 THEN x := 0 ELSIF x > dw THEN x := dw END
350 END;
351 IF dh > 0 THEN
352 IF b > y + h - 2 * mt THEN y := b - h + 2 * mt END;
353 IF t < y THEN y := t END;
354 IF y < 0 THEN y := 0 ELSIF y > dh THEN y := dh END
355 END;
356 ScrollDoc(d, -x, -y)
357 END
358 END MakeVisible;
360 PROCEDURE Page (d: StdDocument; f: Views.Frame;
361 VAR msg: Controllers.PageMsg);
362 VAR g: Views.Frame;
363 BEGIN
364 g := Views.ThisFrame(f, d.model.view);
365 IF g # NIL THEN Views.ForwardCtrlMsg(g, msg) END
366 END Page;
369 (* Model *)
371 PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
372 VAR c: StdContext; thisVersion: INTEGER; l, t, r, b: INTEGER;
373 BEGIN
374 m.Internalize^(rd);
375 IF rd.cancelled THEN RETURN END;
376 rd.ReadVersion(minVersion, maxModelVersion, thisVersion);
377 IF rd.cancelled THEN RETURN END;
378 Views.ReadView(rd, m.view);
379 rd.ReadInt(l); rd.ReadInt(t); rd.ReadInt(r); rd.ReadInt(b);
380 m.l := defB; m.t := defB; m.r := defB + r - l; m.b := defB + b - t;
381 NEW(c); c.model := m; m.view.InitContext(c)
382 END Internalize;
384 PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
385 BEGIN
386 ASSERT(m.doc.original = NIL, 100);
387 m.Externalize^(wr);
388 wr.WriteVersion(maxModelVersion);
389 Views.WriteView(wr, m.view);
390 wr.WriteInt(m.l); wr.WriteInt(m.t); wr.WriteInt(m.r); wr.WriteInt(m.b)
391 END Externalize;
393 PROCEDURE (m: Model) CopyFrom (source: Stores.Store);
394 VAR c: StdContext;
395 BEGIN
396 WITH source: Model DO
397 m.view := Stores.CopyOf(source.view)(Views.View);
398 m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
399 NEW(c); c.model := m; m.view.InitContext(c)
400 END
401 END CopyFrom;
403 PROCEDURE (m: Model) InitFrom (source: Containers.Model);
404 VAR c: StdContext;
405 BEGIN
406 WITH source: Model DO
407 m.view := Stores.CopyOf(source.view)(Views.View);
408 m.l := source.l; m.t := source.t; m.r := source.r; m.b := source.b;
409 NEW(c); c.model := m; m.view.InitContext(c)
410 END
411 END InitFrom;
413 PROCEDURE (m: Model) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
414 BEGIN
415 minW := 5 * mm; minH := 5 * mm;
416 maxW := MAX(INTEGER) DIV 2; maxH := MAX(INTEGER) DIV 2
417 END GetEmbeddingLimits;
419 PROCEDURE (m: Model) ReplaceView (old, new: Views.View);
420 VAR con: Models.Context; op: ReplaceViewOp;
421 BEGIN
422 ASSERT(old # NIL, 20); con := old.context;
423 ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = m, 22);
424 ASSERT(new # NIL, 23);
425 ASSERT((new.context = NIL) OR (new.context = con), 24);
426 IF new # old THEN
427 IF new.context = NIL THEN new.InitContext(con) END;
428 Stores.Join(m, new);
429 NEW(op); op.model := m; op.new := new;
430 Models.Do(m, "#System:ReplaceView", op)
431 END
432 END ReplaceView;
435 (* StdDocument *)
437 PROCEDURE (d: StdDocument) Internalize2 (VAR rd: Stores.Reader);
438 VAR thisVersion: INTEGER; c: Containers.Controller;
439 BEGIN
440 d.Internalize2^(rd);
441 IF rd.cancelled THEN RETURN END;
442 rd.ReadVersion(minVersion, maxStdDocVersion, thisVersion);
443 IF rd.cancelled THEN RETURN END;
444 rd.ReadInt(d.pw); rd.ReadInt(d.ph);
445 rd.ReadInt(d.pl); rd.ReadInt(d.pt); rd.ReadInt(d.pr); rd.ReadInt(d.pb);
446 rd.ReadBool(d.decorate);
447 (* change infinite height to "fit to window" *)
448 c := d.ThisController();
449 IF (c # NIL) & (d.model.b >= 29000 * Ports.mm) & (c.opts * {winHeight, pageHeight} = {}) THEN
450 c.SetOpts(c.opts + {winHeight})
451 END;
452 c.SetOpts(c.opts - {Containers.noSelection});
453 d.x := 0; d.y := 0;
454 Stores.InitDomain(d)
455 END Internalize2;
457 PROCEDURE (d: StdDocument) Externalize2 (VAR wr: Stores.Writer);
458 BEGIN
459 ASSERT(d.original = NIL, 100);
460 d.Externalize2^(wr);
461 wr.WriteVersion(maxStdDocVersion);
462 wr.WriteInt(d.pw); wr.WriteInt(d.ph);
463 wr.WriteInt(d.pl); wr.WriteInt(d.pt); wr.WriteInt(d.pr); wr.WriteInt(d.pb);
464 wr.WriteBool(d.decorate)
465 END Externalize2;
467 PROCEDURE (d: StdDocument) CopyFromModelView2 (source: Views.View; model: Models.Model);
468 BEGIN
469 WITH source: StdDocument DO
470 d.pw := source.pw; d.ph := source.ph;
471 d.pl := source.pl; d.pt := source.pt; d.pr := source.pr; d.pb := source.pb;
472 d.decorate := source.decorate
473 END
474 END CopyFromModelView2;
476 PROCEDURE (d: StdDocument) AcceptableModel (m: Containers.Model): BOOLEAN;
477 BEGIN
478 RETURN m IS Model
479 END AcceptableModel;
481 PROCEDURE (d: StdDocument) InitModel2 (m: Containers.Model);
482 BEGIN
483 ASSERT((d.model = NIL) OR (d.model = m), 20);
484 ASSERT(m IS Model, 23);
485 WITH m: Model DO d.model := m; m.doc := d END
486 END InitModel2;
488 PROCEDURE (d: StdDocument) PollRect (VAR l, t, r, b: INTEGER);
489 VAR c: Containers.Controller; doc: StdDocument; ww, wh, pw, ph: INTEGER;
490 BEGIN
491 IF d.original = NIL THEN doc := d ELSE doc := d.original END;
492 l := d.model.l; t := d.model.t;
493 pw := doc.pr - doc.pl; ph := doc.pb - doc.pt;
494 IF d.context = NIL THEN ww := 0; wh := 0
495 ELSIF d.context IS PrinterContext THEN ww := pw; wh := ph
496 ELSE d.context.GetSize(ww, wh); DEC(ww, 2 * l); DEC(wh, 2 * t)
497 END;
498 c := d.ThisController();
499 IF pageWidth IN c.opts THEN r := l + pw
500 ELSIF winWidth IN c.opts THEN
501 IF ww > 0 THEN r := l + ww ELSE r := d.model.r END
502 ELSE r := l + doc.model.r - doc.model.l
503 END;
504 IF pageHeight IN c.opts THEN b := t + ph
505 ELSIF winHeight IN c.opts THEN
506 IF wh > 0 THEN b := t + wh ELSE b := d.model.b END
507 ELSE b := t + doc.model.b - doc.model.t
508 END;
509 ASSERT(r > l, 60); ASSERT(b > t, 61)
510 END PollRect;
512 PROCEDURE (d: StdDocument) PollPage (VAR w, h, l, t, r, b: INTEGER; VAR decorate: BOOLEAN);
513 VAR doc: StdDocument;
514 BEGIN
515 IF d.original = NIL THEN doc := d ELSE doc := d.original END;
516 w := doc.pw; h := doc.ph;
517 l := doc.pl; t := doc.pt; r := doc.pr; b := doc.pb;
518 decorate := doc.decorate
519 END PollPage;
521 PROCEDURE (d: StdDocument) DocCopyOf (v: Views.View): Document;
522 VAR c0, c1: Containers.Controller; u: Views.View; new: Document; w, h: INTEGER;
523 BEGIN
524 ASSERT(v # NIL, 20);
525 ASSERT(~(v IS Document), 21);
526 ASSERT(d.Domain() = v.Domain(), 22);
527 ASSERT(d.Domain() # NIL, 23);
528 Views.BeginModification(3, v);
529 u := Views.CopyOf(v, Views.shallow);
530 v.context.GetSize(w, h);
531 new := dir.New(u, w, h);
532 WITH new: StdDocument DO
533 IF d.original # NIL THEN new.original := d.original ELSE new.original := d END
534 END;
535 c0 := d.ThisController();
536 c1 := new.ThisController();
537 c1.SetOpts(c0.opts);
538 Views.EndModification(3, v);
539 RETURN new
540 END DocCopyOf;
542 PROCEDURE (d: StdDocument) Restore (f: Views.Frame; l, t, r, b: INTEGER);
543 VAR c: Containers.Controller; m: Model; con: Models.Context; s: Views.View;
544 BEGIN
545 m := d.model; con := d.context;
546 WITH con: PrinterContext DO
547 IF con.param.page.alternate & ~ODD(con.param.page.first + Printing.Current()) THEN
548 Views.InstallFrame(f, m.view, con.pw - con.r, con.t, 0, FALSE)
549 ELSE
550 Views.InstallFrame(f, m.view, con.l, con.t, 0, FALSE)
551 END
552 ELSE
553 c := d.ThisController(); s := c.Singleton();
554 Views.InstallFrame(f, m.view, m.l + d.x, m.t + d.y, 0, s = NIL)
555 END
556 END Restore;
558 PROCEDURE (d: StdDocument) GetRect (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER);
559 VAR l0, t0, r0, b0: INTEGER;
560 BEGIN
561 d.PollRect(l0, t0, r0, b0);
562 l := l0 + d.x; t := t0 + d.y; r := r0 + d.x; b := b0 + d.y
563 END GetRect;
565 PROCEDURE (d: StdDocument) SetView (view: Views.View; w, h: INTEGER);
566 CONST
567 wA4 = 210 * mm; hA4 = 296 * mm; (* A4 default paper size *)
568 lm = 20 * mm; tm = 20 * mm; rm = 20 * mm; bm = 20 * mm;
569 VAR m: Model; c: StdContext; prt: Printers.Printer;
570 ctrl: Containers.Controller; opts: SET; rp: Properties.ResizePref;
571 u, minW, maxW, minH, maxH, defW, defH, dw, dh, pw, ph,
572 pageW, pageH, paperW, paperH, leftM, topM, rightM, botM: INTEGER;
573 l, t, r, b: INTEGER; port: Ports.Port;
574 BEGIN
575 ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
576 ASSERT(d.original = NIL, 100);
577 m := d.model;
578 NEW(c); c.model := m; view.InitContext(c);
579 IF d.context # NIL THEN Stores.Join(d, view) END;
580 IF Printers.dir # NIL THEN prt := Printers.dir.Current() ELSE prt := NIL END;
581 IF prt # NIL THEN
582 prt.SetOrientation(FALSE);
583 port := prt.ThisPort(); prt.GetRect(l, t, r, b);
584 port.GetSize(pw, ph); u := port.unit;
585 paperW := r - l; paperH := b - t;
586 pageW := paperW - lm - rm; pageH := paperH - tm - bm;
587 leftM := lm; topM := tm; rightM := rm; botM := bm;
588 IF pageW > pw * u THEN pageW := pw * u END;
589 IF pageH > ph * u THEN pageH := ph * u END;
590 IF leftM + l < 0 THEN dw := -(leftM + l)
591 ELSIF paperW - rightM + l > pw * u THEN dw := pw * u - (paperW - rightM + l)
592 ELSE dw := 0
593 END;
594 IF topM + t < 0 THEN dh := -(topM + t)
595 ELSIF paperH - botM + t > ph * u THEN dh := ph * u - (paperH - botM + t)
596 ELSE dh := 0
597 END;
598 INC(leftM, dw); INC(topM, dh); INC(rightM, dw); INC(botM, dh)
599 ELSE
600 paperW := wA4; paperH := hA4;
601 pageW := paperW - lm - rm; pageH := paperH - tm - bm;
602 leftM := lm; topM := tm; rightM := rm; botM := bm
603 END;
604 m.GetEmbeddingLimits(minW, maxW, minH, maxH);
605 defW := MAX(minW, pageW - m.l - defB);
606 defH := MAX(minH, pageH - m.t - defB);
607 Properties.PreferredSize(view, minW, maxW, minH, maxH, defW, defH, w, h);
608 opts := {}; rp.fixed := FALSE;
609 rp.horFitToPage := FALSE;
610 rp.verFitToPage := FALSE;
611 rp.horFitToWin := FALSE;
612 rp.verFitToWin := FALSE;
613 Views.HandlePropMsg(view, rp);
614 IF rp.horFitToPage THEN INCL(opts, pageWidth)
615 ELSIF rp.horFitToWin THEN INCL(opts, winWidth)
616 END;
617 IF rp.verFitToPage THEN INCL(opts, pageHeight)
618 ELSIF rp.verFitToWin THEN INCL(opts, winHeight)
619 END;
620 Views.BeginModification(Views.notUndoable, d);
621 m.view := view; d.x := 0; d.y := 0;
622 ctrl := d.ThisController();
623 ctrl.SetOpts(ctrl.opts - {pageWidth..winHeight});
624 d.SetPage(paperW, paperH, leftM, topM, paperW - rightM, paperH - botM, plain);
625 ASSERT(w > 0, 100); ASSERT(h > 0, 101);
626 d.SetRect(m.l, m.t, m.l + w, m.t + h);
627 ctrl.SetOpts(ctrl.opts + opts);
628 Views.EndModification(Views.notUndoable, d);
629 Stores.Join(d, view);
630 Views.Update(d, Views.rebuildFrames)
631 END SetView;
633 PROCEDURE (d: StdDocument) ThisView (): Views.View;
634 BEGIN
635 RETURN d.model.view
636 END ThisView;
638 PROCEDURE (d: StdDocument) OriginalView (): Views.View;
639 BEGIN
640 IF d.original = NIL THEN RETURN d.model.view
641 ELSE RETURN d.original.model.view
642 END
643 END OriginalView;
645 PROCEDURE (d: StdDocument) SetRect (l, t, r, b: INTEGER);
646 VAR m: Model; op: SetRectOp; c: Containers.Controller; w, h: INTEGER;
647 BEGIN
648 ASSERT(l < r, 22); ASSERT(t < b, 25);
649 m := d.model;
650 IF (m.l # l) OR (m.t # t) THEN
651 m.r := l + m.r - m.l; m.l := l;
652 m.b := t + m.b - m.t; m.t := t;
653 Views.Update(d, Views.rebuildFrames)
654 END;
655 IF d.original # NIL THEN m := d.original.model END;
656 c := d.ThisController(); w := r - l; h := b - t;
657 IF (pageWidth IN c.opts) OR (winWidth IN c.opts) THEN w := m.r - m.l END;
658 IF (pageHeight IN c.opts) OR (winHeight IN c.opts) THEN h := m.b - m.t END;
659 IF (w # m.r - m.l) OR (h # m.b - m.t) THEN
660 NEW(op); op.model := m; op.w:= w; op.h := h;
661 Views.Do(d, resizingKey, op)
662 END
663 END SetRect;
665 PROCEDURE (d: StdDocument) SetPage (pw, ph, pl, pt, pr, pb: INTEGER; decorate: BOOLEAN);
666 VAR op: SetPageOp; doc: StdDocument;
667 BEGIN
668 IF d.original = NIL THEN doc := d ELSE doc := d.original END;
669 IF (doc.pw # pw) OR (doc.ph # ph) OR (doc.decorate # decorate)
670 OR (doc.pl # pl) OR (doc.pt # pt) OR (doc.pr # pr) OR (doc.pb # pb) THEN
671 ASSERT(0 <= pw, 20);
672 ASSERT(0 <= ph, 22);
673 ASSERT(0 <= pl, 24); ASSERT(pl < pr, 25); ASSERT(pr <= pw, 26);
674 ASSERT(0 <= pt, 27); ASSERT(pt < pb, 28); ASSERT(pb <= ph, 29);
675 NEW(op);
676 op.d := doc;
677 op.pw := pw; op.ph := ph; op.pl := pl; op.pt := pt; op.pr := pr; op.pb := pb;
678 op.decorate := decorate;
679 Views.Do(doc, pageSetupKey, op)
680 END
681 END SetPage;
683 PROCEDURE (v: StdDocument) HandleViewMsg2 (f: Views.Frame; VAR msg: Views.Message);
684 BEGIN
685 WITH msg: UpdateMsg DO
686 IF (msg.doc = v) OR (msg.doc = v.original) THEN
687 Views.Update(v, Views.rebuildFrames)
688 END
689 ELSE
690 END
691 END HandleViewMsg2;
693 PROCEDURE (d: StdDocument) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message;
694 VAR focus: Views.View);
695 BEGIN
696 WITH f: Views.RootFrame DO
697 WITH msg: Controllers.PollSectionMsg DO
698 PollSection(d, f, msg); focus := NIL
699 | msg: Controllers.ScrollMsg DO
700 Scroll(d, f, msg); focus := NIL
701 | msg: Controllers.PageMsg DO
702 Page(d, f, msg); focus := NIL
703 ELSE
704 END
705 END
706 END HandleCtrlMsg2;
709 (* Controller *)
711 PROCEDURE (c: Controller) Internalize2 (VAR rd: Stores.Reader);
712 VAR v: INTEGER;
713 BEGIN
714 rd.ReadVersion(minVersion, maxCtrlVersion, v)
715 END Internalize2;
717 PROCEDURE (c: Controller) Externalize2 (VAR wr: Stores.Writer);
718 BEGIN
719 wr.WriteVersion(maxCtrlVersion)
720 END Externalize2;
722 PROCEDURE (c: Controller) InitView2 (v: Views.View);
723 BEGIN
724 IF v # NIL THEN c.doc := v(StdDocument) ELSE c.doc := NIL END
725 END InitView2;
727 PROCEDURE (c: Controller) GetContextType (OUT type: Stores.TypeName);
728 END GetContextType;
730 PROCEDURE (c: Controller) GetValidOps (OUT valid: SET);
731 BEGIN
732 IF c.Singleton() # NIL THEN
733 valid := {Controllers.copy}
734 END
735 END GetValidOps;
737 PROCEDURE (c: Controller) NativeModel (m: Models.Model): BOOLEAN;
738 BEGIN
739 RETURN m IS Model
740 END NativeModel;
742 PROCEDURE (c: Controller) NativeView (v: Views.View): BOOLEAN;
743 BEGIN
744 RETURN v IS StdDocument
745 END NativeView;
747 PROCEDURE (c: Controller) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
748 BEGIN
749 RETURN Ports.arrowCursor
750 END NativeCursorAt;
752 PROCEDURE (c: Controller) PollNativeProp (selection: BOOLEAN; VAR p: Properties.Property;
753 VAR truncated: BOOLEAN);
754 END PollNativeProp;
756 PROCEDURE (c: Controller) SetNativeProp (selection: BOOLEAN; p, old: Properties.Property);
757 END SetNativeProp;
759 PROCEDURE (c: Controller) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
760 BEGIN
761 IF selection THEN v := c.Singleton() ELSE v := c.doc.model.view END
762 END GetFirstView;
764 PROCEDURE (c: Controller) GetNextView (selection: BOOLEAN; VAR v: Views.View);
765 BEGIN
766 v := NIL
767 END GetNextView;
769 PROCEDURE (c: Controller) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
770 BEGIN
771 v := NIL
772 END GetPrevView;
774 PROCEDURE (c: Controller) TrackMarks (f: Views.Frame; x, y: INTEGER;
775 units, extend, add: BOOLEAN);
776 BEGIN
777 c.Neutralize
778 END TrackMarks;
780 PROCEDURE (c: Controller) RestoreMarks2 (f: Views.Frame; l, t, r, b: INTEGER);
781 BEGIN
782 IF c.doc.context IS PrinterContext THEN Decorate(c.doc.context(PrinterContext), f) END
783 END RestoreMarks2;
785 PROCEDURE (c: Controller) Resize (view: Views.View; l, t, r, b: INTEGER);
786 VAR d: StdDocument; l0, t0: INTEGER;
787 BEGIN
788 d := c.doc;
789 ASSERT(view = d.model.view, 20);
790 l0 := d.model.l; t0 := d.model.t;
791 d.SetRect(l0, t0, l0 + r - l, t0 + b - t)
792 END Resize;
794 PROCEDURE (c: Controller) DeleteSelection;
795 END DeleteSelection;
797 PROCEDURE (c: Controller) MoveLocalSelection (f, dest: Views.Frame; x, y: INTEGER;
798 dx, dy: INTEGER);
799 VAR m: Model; l, t, r, b: INTEGER;
800 BEGIN
801 IF f = dest THEN
802 m := c.doc.model; DEC(dx, x); DEC(dy, y);
803 l := m.l + dx; t := m.t + dy;
804 r := m.r + dx; b := m.b + dy;
805 c.Resize(m.view, l, t, r, b);
806 IF c.Singleton() = NIL THEN c.SetSingleton(m.view) END
807 END
808 END MoveLocalSelection;
810 PROCEDURE (c: Controller) SelectionCopy (): Model;
811 BEGIN
812 RETURN NIL
813 END SelectionCopy;
815 PROCEDURE (c: Controller) NativePaste (m: Models.Model; f: Views.Frame);
816 VAR m0: Model;
817 BEGIN
818 WITH m: Model DO
819 m0 := c.doc.model;
820 m0.ReplaceView(m0.view, m.view);
821 c.doc.SetRect(m.l, m.t, m.r, m.b)
822 END
823 END NativePaste;
825 PROCEDURE (c: Controller) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
826 VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
827 BEGIN
828 m := c.doc.model;
829 m.GetEmbeddingLimits(minW, maxW, minH, maxH);
830 defW := m.r - m.l; defH := m.b - m.t;
831 Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
832 m.ReplaceView(m.view, v);
833 c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
834 END PasteView;
836 PROCEDURE (c: Controller) Drop (src, dst: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
837 v: Views.View; isSingle: BOOLEAN);
838 VAR m: Model; minW, maxW, minH, maxH, defW, defH: INTEGER;
839 BEGIN
840 m := c.doc.model;
841 m.GetEmbeddingLimits(minW, maxW, minH, maxH);
842 defW := m.r - m.l; defH := m.b - m.t;
843 Properties.PreferredSize(v, minW, maxW, minH, maxH, defW, defH, w, h);
844 m.ReplaceView(m.view, v);
845 c.doc.SetRect(m.l, m.t, m.l + w, m.t + h)
846 END Drop;
848 (* selection *)
850 PROCEDURE (c: Controller) Selectable (): BOOLEAN;
851 BEGIN
852 RETURN TRUE
853 END Selectable;
855 PROCEDURE (c: Controller) SelectAll (select: BOOLEAN);
856 BEGIN
857 IF ~select & (c.Singleton() # NIL) THEN
858 c.SetSingleton(NIL)
859 ELSIF select & (c.Singleton() = NIL) THEN
860 c.SetSingleton(c.doc.model.view)
861 END
862 END SelectAll;
864 PROCEDURE (c: Controller) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
865 BEGIN
866 RETURN c.Singleton() # NIL
867 END InSelection;
869 (* caret *)
871 PROCEDURE (c: Controller) HasCaret (): BOOLEAN;
872 BEGIN
873 RETURN FALSE
874 END HasCaret;
876 PROCEDURE (c: Controller) MarkCaret (f: Views.Frame; show: BOOLEAN);
877 END MarkCaret;
879 PROCEDURE (c: Controller) CanDrop (f: Views.Frame; x, y: INTEGER): BOOLEAN;
880 BEGIN
881 RETURN FALSE
882 END CanDrop;
884 (* handlers *)
886 PROCEDURE (c: Controller) HandleCtrlMsg (f: Views.Frame;
887 VAR msg: Controllers.Message; VAR focus: Views.View);
888 VAR l, t, r, b: INTEGER;
889 BEGIN
890 IF ~(Containers.noFocus IN c.opts) THEN
891 WITH msg: Controllers.TickMsg DO
892 IF c.Singleton() = NIL THEN c.SetFocus(c.doc.model.view) END
893 | msg: Controllers.CursorMessage DO
894 IF c.Singleton() = NIL THEN (* delegate to focus, even if not directly hit *)
895 focus := c.ThisFocus();
896 c.doc.GetRect(f, focus, l, t, r, b); (* except for resize in lower right corner *)
897 IF (c.opts * {pageWidth..winHeight} # {})
898 OR (msg.x < r) OR (msg.y < b) THEN RETURN END
899 END
900 ELSE
901 END
902 END;
903 c.HandleCtrlMsg^(f, msg, focus)
904 END HandleCtrlMsg;
907 PROCEDURE (c: Controller) PasteChar (ch: CHAR);
908 END PasteChar;
910 PROCEDURE (c: Controller) ControlChar (f: Views.Frame; ch: CHAR);
911 END ControlChar;
913 PROCEDURE (c: Controller) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
914 END ArrowChar;
916 PROCEDURE (c: Controller) CopyLocalSelection (src, dst: Views.Frame; sx, sy, dx, dy: INTEGER);
917 END CopyLocalSelection;
920 (* StdContext *)
922 PROCEDURE (c: StdContext) ThisModel (): Models.Model;
923 BEGIN
924 RETURN c.model
925 END ThisModel;
927 PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
928 VAR m: Model; dc: Models.Context; l, t, r, b: INTEGER;
929 BEGIN
930 m := c.model;
931 m.doc.PollRect(l, t, r, b); w := r - l; h := b - t;
932 dc := m.doc.context;
933 IF dc # NIL THEN
934 WITH dc: PrinterContext DO
935 w := MIN(w, dc.r - dc.l); h := MIN(h, dc.b - dc.t)
936 ELSE
937 END
938 END;
939 ASSERT(w > 0, 60); ASSERT(h > 0, 61)
940 END GetSize;
942 PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
943 VAR m: Model; d: StdDocument; minW, maxW, minH, maxH, defW, defH: INTEGER;
944 BEGIN
945 m := c.model; d := m.doc; ASSERT(d # NIL, 20);
946 m.GetEmbeddingLimits(minW, maxW, minH, maxH);
947 defW := m.r - m.l; defH := m.b - m.t;
948 Properties.PreferredSize(m.view, minW, maxW, minH, maxH, defW, defH, w, h);
949 d.SetRect(m.l, m.t, m.l + w, m.t + h)
950 END SetSize;
952 PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
953 BEGIN
954 RETURN TRUE
955 END Normalize;
957 PROCEDURE (c: StdContext) ThisDoc (): Document;
958 BEGIN
959 RETURN c.model.doc
960 END ThisDoc;
962 PROCEDURE (c: StdContext) MakeVisible (l, t, r, b: INTEGER);
963 BEGIN
964 MakeVisible(c.model.doc, NIL, l, t, r, b)
965 END MakeVisible;
968 (* PrinterContext *)
970 PROCEDURE (c: PrinterContext) GetSize (OUT w, h: INTEGER);
971 VAR p: Ports.Port;
972 BEGIN
973 p := c.pr.ThisPort();
974 p.GetSize(w, h);
975 w := w * p.unit;
976 h := h * p.unit
977 END GetSize;
979 PROCEDURE (c: PrinterContext) Normalize (): BOOLEAN;
980 BEGIN
981 RETURN TRUE
982 END Normalize;
984 PROCEDURE (c: PrinterContext) SetSize (w, h: INTEGER);
985 END SetSize;
987 PROCEDURE (c: PrinterContext) ThisModel (): Models.Model;
988 BEGIN
989 RETURN NIL
990 END ThisModel;
993 (* StdDirectory *)
995 PROCEDURE (d: StdDirectory) New (view: Views.View; w, h: INTEGER): Document;
996 VAR doc: StdDocument; m: Model; c: Controller;
997 BEGIN
998 ASSERT(view # NIL, 20); ASSERT(~(view IS Document), 21);
999 NEW(m);
1000 NEW(doc); doc.InitModel(m);
1001 NEW(c); doc.SetController(c);
1002 doc.SetRect(defB, defB, defB + 1, defB + 1); (* set top-left point *)
1003 doc.SetView(view, w, h); (* joins store graphs of doc and view *)
1004 Stores.InitDomain(doc); (* domains of new documents are bound *)
1005 RETURN doc
1006 END New;
1009 (** PContext **)
1011 PROCEDURE (c: PContext) GetSize (OUT w, h: INTEGER);
1012 BEGIN
1013 w := c.w; h := c.h
1014 END GetSize;
1016 PROCEDURE (c: PContext) Normalize (): BOOLEAN;
1017 BEGIN
1018 RETURN TRUE
1019 END Normalize;
1021 PROCEDURE (c: PContext) SetSize (w, h: INTEGER);
1022 END SetSize;
1024 PROCEDURE (c: PContext) ThisModel (): Models.Model;
1025 BEGIN
1026 RETURN NIL
1027 END ThisModel;
1030 (** Pager **)
1033 PROCEDURE (p: Pager) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1034 BEGIN
1035 Views.InstallFrame(f, p.con.view, -p.x, -p.y, 0, FALSE)
1036 END Restore;
1038 PROCEDURE (p: Pager) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage; VAR focus: Views.View);
1039 VAR v: Views.View; g: Views.Frame;
1040 BEGIN
1041 WITH msg: Controllers.PageMsg DO
1042 v := p.con.view; g := Views.ThisFrame(f, v);
1043 IF g = NIL THEN
1044 Views.InstallFrame(f, v, 0, 0, 0, FALSE);
1045 g := Views.ThisFrame(f, v)
1046 END;
1047 IF g # NIL THEN
1048 Views.ForwardCtrlMsg(g, msg);
1049 IF ~msg.done THEN
1050 IF p.con.w > p.w THEN (* needs horizontal paging *)
1051 IF msg.op = Controllers.gotoPageX THEN p.x := msg.pageX * p.w; msg.done := TRUE
1052 ELSIF msg.op = Controllers.nextPageX THEN p.x := p.x + p.w; msg.done := TRUE
1053 END;
1054 IF p.x >= p.con.w THEN msg.eox := TRUE; p.x := 0 END
1055 END;
1056 IF p.con.h > p.h THEN (* needs vertical paging *)
1057 IF msg.op = Controllers.gotoPageY THEN p.y := msg.pageY * p.h; msg.done := TRUE
1058 ELSIF msg.op = Controllers.nextPageY THEN p.y := p.y + p.h; msg.done := TRUE
1059 END;
1060 IF p.y >= p.con.h THEN msg.eoy := TRUE; p.y := 0 END
1061 END
1062 END
1063 END
1064 ELSE focus := p.con.view
1065 END
1066 END HandleCtrlMsg;
1068 PROCEDURE NewPager (v: Views.View; w, h, pw, ph: INTEGER): Pager;
1069 VAR p: Pager; c: PContext;
1070 BEGIN
1071 NEW(c); c.view := v; c.w := w; c.h := h; v.InitContext(c);
1072 NEW(p); p.con := c; p.w := pw; p.h := ph; p.x := 0; p.y := 0;
1073 Stores.Join(v, p);
1074 RETURN p
1075 END NewPager;
1077 PROCEDURE PrinterDoc (d: Document; c: PrinterContext): Document;
1078 VAR v, u, p: Views.View; w, h, l, t, r, b, pw, ph: INTEGER; pd: Document;
1079 ct: Containers.Controller; dec: BOOLEAN; seq: ANYPTR;
1080 BEGIN
1081 v := d.ThisView();
1083 IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
1084 IF seq#NIL THEN seq(Sequencers.Sequencer).BeginModification(Sequencers.invisible, d) END
1085 END;
1086 u := Views.CopyOf(v, Views.shallow);
1087 IF d.Domain() # NIL THEN seq:=d.Domain().GetSequencer();
1088 IF seq#NIL THEN seq(Sequencers.Sequencer).EndModification(Sequencers.invisible, d) END
1089 END;
1091 d.PollPage(w, h, l, t, r, b, dec); pw := r - l; ph := b - t; (* page size *)
1092 v.context.GetSize(w, h);
1093 ct := d.ThisController();
1094 IF winWidth IN ct.opts THEN w := pw END; (* fit to win -> fit to page *)
1095 IF winHeight IN ct.opts THEN h := ph END;
1096 p := NewPager(u, w, h, pw, ph);
1097 ASSERT(Stores.Joined(p, d), 100);
1098 pd := dir.New(p, pw, ph);
1099 pd.InitContext(c);
1100 RETURN pd
1101 END PrinterDoc;
1104 (** miscellaneous **)
1106 PROCEDURE Print* (d: Document; p: Printers.Printer; par: Printing.Par);
1107 VAR dom: Stores.Domain; d1: Document; f: Views.RootFrame; g: Views.Frame;
1108 c: PrinterContext; from, to, this, copies, w, h, u, k: INTEGER; page: Controllers.PageMsg;
1109 title: Views.Title; port: Ports.Port;
1110 BEGIN
1111 ASSERT(d # NIL, 20); ASSERT(p # NIL, 21);
1112 ASSERT(par # NIL, 22);
1113 ASSERT(par.page.from >= 0, 23); ASSERT(par.page.from <= par.page.to, 24);
1114 ASSERT(par.copies > 0, 25);
1115 IF (par.header.right # "") OR (par.page.alternate & (par.header.left # "")) THEN
1116 ASSERT(par.header.font # NIL, 26)
1117 END;
1118 IF (par.footer.right # "") OR (par.page.alternate & (par.footer.left # "")) THEN
1119 ASSERT(par.footer.font # NIL, 27)
1120 END;
1121 IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
1122 from := par.page.from; to := par.page.to;
1123 copies := par.copies;
1124 CheckOrientation(d, p);
1125 p.OpenJob(copies, title);
1126 IF p.res = 0 THEN
1127 dom := d.Domain();
1128 ASSERT(dom # NIL, 100);
1129 c := NewPrinterContext(d, p, par);
1130 d1 := PrinterDoc(d, c);
1131 CheckOrientation(d, p); (* New in PrinterDoc resets printer orientation *)
1132 d1.GetNewFrame(g); f := g(Views.RootFrame); f.ConnectTo(p.ThisPort());
1133 Views.SetRoot(f, d1, FALSE, {}); Views.AdaptRoot(f);
1134 current := 0; (*par.page.current := 0; *)
1135 d1.Restore(f, 0, 0, 0, 0); (* install frame for doc's view *)
1136 Kernel.PushTrapCleaner(cleaner);
1137 port := p.ThisPort();
1138 Printing.par := par;
1139 page.op := Controllers.gotoPageX; page.pageX := 0;
1140 page.done := FALSE; page.eox := FALSE;
1141 Views.ForwardCtrlMsg(f, page);
1142 IF page.done THEN this := 0 ELSE this := from END;
1143 page.op := Controllers.gotoPageY; page.pageY := this;
1144 page.done := FALSE; page.eoy := FALSE;
1145 Views.ForwardCtrlMsg(f, page);
1146 IF ~page.done & (from > 0) OR page.eox OR page.eoy THEN to := -1 END;
1147 WHILE this <= to DO
1148 IF this >= from THEN
1149 current := this; (*par.page.current := this;*)
1150 port.GetSize(w, h); u := port.unit;
1151 FOR k := copies TO par.copies DO
1152 p.OpenPage;
1153 IF p.res = 0 THEN
1154 Views.RemoveFrames(f, 0, 0, w * u, h * u);
1155 Views.RestoreRoot(f, 0, 0, w * u, h * u)
1156 END;
1157 p.ClosePage
1158 END
1159 END;
1160 IF p.res # abort THEN INC(this) ELSE to := -1 END;
1161 IF this <= to THEN
1162 page.op := Controllers.nextPageX;
1163 page.done := FALSE; page.eox := FALSE;
1164 Views.ForwardCtrlMsg(f, page);
1165 IF ~page.done OR page.eox THEN
1166 IF page.done THEN
1167 page.op := Controllers.gotoPageX; page.pageX := 0;
1168 page.done := FALSE; page.eox := FALSE;
1169 Views.ForwardCtrlMsg(f, page)
1170 END;
1171 page.op := Controllers.nextPageY;
1172 page.done := FALSE; page.eoy := FALSE;
1173 Views.ForwardCtrlMsg(f, page);
1174 IF ~page.done OR page.eoy THEN to := -1 END
1175 END
1176 END
1177 END;
1178 Printing.par := NIL;
1179 Kernel.PopTrapCleaner(cleaner)
1180 ELSE Dialog.ShowMsg("#System:FailedToOpenPrintJob")
1181 END;
1182 p.CloseJob
1183 END Print;
1185 PROCEDURE (hook: PrintingHook) Current(): INTEGER;
1186 BEGIN
1187 RETURN current
1188 END Current;
1190 PROCEDURE (hook: PrintingHook) Print (v: Views.View; par: Printing.Par);
1191 VAR dom: Stores.Domain; d: Document; f: Views.RootFrame; c: PrinterContext;
1192 w, h, u: INTEGER; p: Printers.Printer; g: Views.Frame; title: Views.Title;
1193 k, copies: INTEGER; port: Ports.Port;
1194 BEGIN
1195 ASSERT(v # NIL, 20);
1196 p := Printers.dir.Current();
1197 ASSERT(p # NIL, 21);
1198 IF v IS Document THEN Print(v(Document), p, par); RETURN END;
1199 IF (v.context # NIL) & (v.context IS Context) THEN
1200 Print(v.context(Context).ThisDoc(), p, par); RETURN
1201 END;
1202 p.SetOrientation(FALSE);
1203 IF par.page.title = "" THEN title := "(" + Dialog.appName + ")" ELSE title := par.page.title END;
1204 copies := par.copies;
1205 p.OpenJob(copies, title);
1206 IF p.res = 0 THEN
1207 Printing.par := par;
1208 Stores.InitDomain(v);
1209 dom := v.Domain();
1210 v := Views.CopyOf(v, Views.shallow) ;
1211 d := dir.New(v, Views.undefined, Views.undefined);
1212 c := NewPrinterContext(d, (* dom, *) p, par);
1213 d.InitContext(c); (* Stores.InitDomain(d, c.Domain()); (* nicht mehr noetig *) *)
1214 d.GetNewFrame(g); f := g(Views.RootFrame);
1215 port := p.ThisPort(); f.ConnectTo(port);
1216 Views.SetRoot(f, d, FALSE, {}); Views.AdaptRoot(f);
1217 port.GetSize(w, h); u := port.unit;
1218 FOR k := copies TO par.copies DO
1219 p.OpenPage;
1220 IF p.res = 0 THEN
1221 Views.RemoveFrames(f, 0, 0, w * u, h * u); Views.RestoreRoot(f, 0, 0, w * u, h * u)
1222 END;
1223 p.ClosePage
1224 END
1225 END;
1226 Printing.par := NIL;
1227 p.CloseJob
1228 END Print;
1231 PROCEDURE ImportDocument* (f: Files.File; OUT s: Stores.Store);
1232 VAR r: Stores.Reader; tag, version: INTEGER;
1233 BEGIN
1234 ASSERT(f # NIL, 20);
1235 r.ConnectTo(f);
1236 r.ReadInt(tag);
1237 IF tag = docTag THEN
1238 r.ReadInt(version);
1239 ASSERT(version = docVersion, 100);
1240 r.ReadStore(s);
1241 IF s IS Document THEN s := s(Document).ThisView()
1242 ELSE s := NIL
1243 END
1244 END
1245 END ImportDocument;
1247 PROCEDURE ExportDocument* (s: Stores.Store; f: Files.File);
1248 VAR w: Stores.Writer; v: Views.View;
1249 BEGIN
1250 ASSERT(s # NIL, 20);
1251 ASSERT(s IS Views.View, 21);
1252 ASSERT(f # NIL, 22);
1253 v := s(Views.View);
1254 IF (v.context # NIL) & (v.context IS Context) THEN
1255 v := v.context(Context).ThisDoc()
1256 END;
1257 IF ~(v IS Document) THEN
1258 IF v.context # NIL THEN
1259 v := Views.CopyOf(v, Views.shallow)
1260 END;
1261 v := dir.New(v, Views.undefined, Views.undefined)
1262 END;
1263 w.ConnectTo(f);
1264 w.WriteInt(docTag); w.WriteInt(docVersion);
1265 w.WriteStore(v)
1266 END ExportDocument;
1269 PROCEDURE SetDir* (d: Directory);
1270 BEGIN
1271 ASSERT(d # NIL, 20);
1272 dir := d;
1273 IF stdDir = NIL THEN stdDir := d END
1274 END SetDir;
1276 PROCEDURE Init;
1277 VAR d: StdDirectory; h: PrintingHook;
1278 BEGIN
1279 NEW(d); SetDir(d);
1280 NEW(h); Printing.SetHook(h);
1281 NEW(cleaner)
1282 END Init;
1284 BEGIN
1285 Init
1286 END Documents.