DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / bbcp.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
* -> old; Trurl-based -> new
[bbcp.git] / new / System / Mod / Windows.txt
1 MODULE Windows;
2
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Windows.odc *)
4 (* DO NOT EDIT *)
5
6 IMPORT
7 Kernel, Ports, Files, Services,
8 Stores, Sequencers, Models, Views, Controllers, Properties,
9 Dialog, Converters, Containers, Documents;
10
11 CONST
12 (** Window.flags **)
13 isTool* = 0; isAux* = 1;
14 noHScroll* = 2; noVScroll* = 3; noResize* = 4;
15 allowDuplicates* = 5; neverDirty* = 6;
16
17 (** Directory.Select lazy **)
18 eager* = FALSE; lazy* = TRUE;
19
20 notRecorded = 3;
21
22 TYPE
23 Window* = POINTER TO ABSTRACT RECORD
24 port-: Ports.Port;
25 frame-: Views.RootFrame;
26 doc-: Documents.Document;
27 seq-: Sequencers.Sequencer;
28 link-: Window; (* ring of windows with same sequencer *)
29 sub-: BOOLEAN;
30 flags-: SET;
31 loc-: Files.Locator;
32 name-: Files.Name;
33 conv-: Converters.Converter
34 END;
35
36 Directory* = POINTER TO ABSTRACT RECORD
37 l*, t*, r*, b*: INTEGER;
38 minimized*, maximized*: BOOLEAN
39 END;
40
41
42 OpElem = POINTER TO RECORD
43 next: OpElem;
44 st: Stores.Store;
45 op: Stores.Operation;
46 name: Stores.OpName;
47 invisible, transparent: BOOLEAN
48 END;
49
50 Script = POINTER TO RECORD (Stores.Operation)
51 up: Script;
52 list: OpElem;
53 level: INTEGER; (* nestLevel at creation time *)
54 name: Stores.OpName
55 END;
56
57 StdSequencer = POINTER TO RECORD (Sequencers.Sequencer)
58 home: Window;
59 trapEra: INTEGER; (* last observed TrapCount value *)
60 modLevel: INTEGER; (* dirty if modLevel > 0 *)
61 entryLevel: INTEGER; (* active = (entryLevel > 0) *)
62 nestLevel: INTEGER; (* nesting level of BeginScript/Modification *)
63 modStack: ARRAY 64 OF RECORD store: Stores.Store; type: INTEGER END;
64 lastSt: Stores.Store;
65 lastOp: Stores.Operation;
66 script: Script;
67 undo, redo: OpElem; (* undo/redo stacks *)
68 noUndo: BOOLEAN; (* script # NIL and BeginModification called *)
69 invisibleLevel, transparentLevel, notRecordedLevel: INTEGER
70 END;
71
72 SequencerDirectory = POINTER TO RECORD (Sequencers.Directory) END;
73
74 Forwarder = POINTER TO RECORD (Controllers.Forwarder) END;
75
76 RootContext = POINTER TO RECORD (Models.Context)
77 win: Window
78 END;
79
80 Reducer = POINTER TO RECORD (Kernel.Reducer) END;
81
82 Hook = POINTER TO RECORD (Views.MsgHook) END;
83
84 CheckAction = POINTER TO RECORD (Services.Action)
85 wait: WaitAction
86 END;
87
88 WaitAction = POINTER TO RECORD (Services.Action)
89 check: CheckAction
90 END;
91
92 LangNotifier = POINTER TO RECORD (Dialog.LangNotifier) END;
93
94 VAR dir-, stdDir-: Directory;
95
96 PROCEDURE ^ Reset (s: StdSequencer);
97
98
99 PROCEDURE CharError;
100 BEGIN
101 Dialog.Beep
102 END CharError;
103
104
105
106 (** Window **)
107
108 PROCEDURE (w: Window) Init* (port: Ports.Port), NEW;
109 BEGIN
110 ASSERT(w.port = NIL, 20); ASSERT(port # NIL, 21);
111 w.port := port
112 END Init;
113
114 PROCEDURE (w: Window) SetTitle* (title: Views.Title), NEW, ABSTRACT;
115 PROCEDURE (w: Window) GetTitle* (OUT title: Views.Title), NEW, ABSTRACT;
116 PROCEDURE (w: Window) RefreshTitle* (), NEW, ABSTRACT;
117
118 PROCEDURE (w: Window) SetSpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter), NEW, EXTENSIBLE;
119 VAR u: Window;
120 BEGIN
121 u := w;
122 REPEAT
123 u := u.link;
124 u.loc := loc; u.name := name$; u.conv := conv
125 UNTIL u = w
126 END SetSpec;
127
128 PROCEDURE (w: Window) Restore* (l, t, r, b: INTEGER), NEW;
129 VAR f: Views.Frame; u, pw, ph: INTEGER;
130 BEGIN
131 f := w.frame;
132 IF f # NIL THEN
133 w.port.GetSize(pw, ph); u := w.port.unit;
134 IF r > pw THEN r := pw END;
135 IF b > ph THEN b := ph END;
136 l := l * u - f.gx; t := t * u - f.gy; r := r * u - f.gx; b := b * u - f.gy;
137 (* only adds to the BlackBox region, but doesn't draw: *)
138 Views.UpdateRoot(w.frame, l, t, r, b, Views.keepFrames)
139 END
140 END Restore;
141
142 PROCEDURE (w: Window) Update*, NEW;
143 BEGIN
144 ASSERT(w.frame # NIL, 20);
145 (* redraws the whole accumulated BlackBox region: *)
146 Views.ValidateRoot(w.frame)
147 END Update;
148
149 PROCEDURE (w: Window) GetSize*(OUT width, height: INTEGER), NEW, EXTENSIBLE;
150 BEGIN
151 w.port.GetSize(width, height)
152 END GetSize;
153
154 PROCEDURE (w: Window) SetSize* (width, height: INTEGER), NEW, EXTENSIBLE;
155 VAR c: Containers.Controller; w0, h0: INTEGER;
156 BEGIN
157 w.port.GetSize(w0, h0);
158 w.port.SetSize(width, height);
159 IF w.frame # NIL THEN Views.AdaptRoot(w.frame) END;
160 c := w.doc.ThisController();
161 IF c.opts * {Documents.winWidth, Documents.winHeight} # {} THEN
162 w.Restore(0, 0, width, height)
163 END
164 END SetSize;
165
166 PROCEDURE (w: Window) BroadcastModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
167 BEGIN
168 IF w.frame # NIL THEN
169 Views.BroadcastModelMsg(w.frame, msg)
170 END
171 END BroadcastModelMsg;
172
173 PROCEDURE (w: Window) BroadcastViewMsg* (VAR msg: Views.Message), NEW, EXTENSIBLE;
174 BEGIN
175 IF w.frame # NIL THEN
176 Views.BroadcastViewMsg(w.frame, msg)
177 END
178 END BroadcastViewMsg;
179
180 PROCEDURE (w: Window) ForwardCtrlMsg* (VAR msg: Controllers.Message), NEW, EXTENSIBLE;
181 BEGIN
182 IF w.frame # NIL THEN
183 WITH msg: Controllers.CursorMessage DO
184 DEC(msg.x, w.frame.gx); DEC(msg.y, w.frame.gy)
185 ELSE
186 END;
187 Views.ForwardCtrlMsg(w.frame, msg)
188 END
189 END ForwardCtrlMsg;
190
191 PROCEDURE (w: Window) MouseDown* (x, y, time: INTEGER; modifiers: SET), NEW, ABSTRACT;
192
193 PROCEDURE (w: Window) KeyDown* (ch: CHAR; modifiers: SET), NEW, EXTENSIBLE;
194 VAR key: Controllers.EditMsg;
195 BEGIN
196 IF ch = 0X THEN
197 CharError
198 ELSE
199 key.op := Controllers.pasteChar; key.char := ch;
200 key.modifiers:= modifiers;
201 w.ForwardCtrlMsg(key)
202 END
203 END KeyDown;
204
205 PROCEDURE (w: Window) Close*, NEW, EXTENSIBLE;
206 VAR u: Window; f: Views.Frame; s: Sequencers.Sequencer; msg: Sequencers.RemoveMsg;
207 BEGIN
208 u := w.link; WHILE u.link # w DO u := u.link END;
209 u.link := w.link;
210 f := w.frame; s := w.seq;
211 IF ~w.sub THEN s.Notify(msg) END;
212 WITH s: StdSequencer DO
213 IF s.home = w THEN s.home := NIL END
214 ELSE
215 END;
216 w.port.SetSize(0, 0); Views.AdaptRoot(w.frame);
217 w.port := NIL; w.frame := NIL; w.doc := NIL; w.seq := NIL; w.link := NIL; w.loc := NIL;
218 f.Close
219 END Close;
220
221
222 (** Directory **)
223
224 PROCEDURE (d: Directory) NewSequencer* (): Sequencers.Sequencer, NEW;
225 VAR s: StdSequencer;
226 BEGIN
227 NEW(s); Reset(s); RETURN s
228 END NewSequencer;
229
230
231 PROCEDURE (d: Directory) First* (): Window, NEW, ABSTRACT;
232 PROCEDURE (d: Directory) Next* (w: Window): Window, NEW, ABSTRACT;
233
234 PROCEDURE (d: Directory) New* (): Window, NEW, ABSTRACT;
235
236 PROCEDURE (d: Directory) Open* (w: Window; doc: Documents.Document;
237 flags: SET; name: Views.Title;
238 loc: Files.Locator; fname: Files.Name;
239 conv: Converters.Converter),
240 NEW, EXTENSIBLE;
241 VAR v: Views.View; c: RootContext; s: Sequencers.Sequencer; f: Views.Frame; any: ANYPTR;
242 BEGIN
243 ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21); ASSERT(doc.context = NIL, 22);
244 v := doc.ThisView(); ASSERT(v # NIL, 23);
245 ASSERT(w.doc = NIL, 24); ASSERT(w.port # NIL, 25);
246 IF w.link = NIL THEN w.link := w END; (* create new window ring *)
247 w.doc := doc; w.flags := flags;
248 IF w.seq = NIL THEN
249 ASSERT(doc.Domain() # NIL, 27);
250 any := doc.Domain().GetSequencer();
251 IF any # NIL THEN
252 ASSERT(any IS Sequencers.Sequencer, 26);
253 w.seq := any(Sequencers.Sequencer)
254 ELSE
255 w.seq := d.NewSequencer();
256 doc.Domain().SetSequencer(w.seq)
257 END
258 END;
259 s := w.seq;
260 WITH s: StdSequencer DO
261 IF s.home = NIL THEN s.home := w END
262 ELSE
263 END;
264 NEW(c); c.win := w; doc.InitContext(c);
265 doc.GetNewFrame(f); w.frame := f(Views.RootFrame);
266 w.frame.ConnectTo(w.port);
267 Views.SetRoot(w.frame, w.doc, FALSE, w.flags);
268 w.SetSpec(loc, fname, conv)
269 END Open;
270
271 PROCEDURE (d: Directory) OpenSubWindow* (w: Window; doc: Documents.Document; flags: SET; name: Views.Title), NEW, EXTENSIBLE;
272 VAR u: Window; title: Views.Title;
273 BEGIN
274 ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21);
275 u := d.First(); WHILE (u # NIL) & (u.seq # doc.Domain().GetSequencer()) DO u := d.Next(u) END;
276 IF u # NIL THEN
277 w.sub := TRUE;
278 w.link := u.link; u.link := w;
279 w.seq := u.seq; w.loc := u.loc; w.name := u.name; w.conv := u.conv;
280 u.GetTitle(title);
281 d.Open(w, doc, flags, title, u.loc, u.name, u.conv)
282 ELSE
283 d.Open(w, doc, flags, name, NIL, "", NIL)
284 END
285 END OpenSubWindow;
286
287 PROCEDURE ^ RestoreSequencer(seq: Sequencers.Sequencer);
288
289 PROCEDURE (d: Directory) Focus* (target: BOOLEAN): Window, NEW, ABSTRACT;
290 PROCEDURE (d: Directory) GetThisWindow* (p: Ports.Port; px, py: INTEGER; OUT x, y: INTEGER; OUT w: Window), NEW, ABSTRACT;
291 PROCEDURE (d: Directory) Select* (w: Window; lazy: BOOLEAN), NEW, ABSTRACT;
292 PROCEDURE (d: Directory) Close* (w: Window), NEW, ABSTRACT;
293
294 PROCEDURE (d: Directory) Update* (w: Window), NEW;
295 VAR u: Window;
296 BEGIN
297 (* redraws the BlackBox region of a given window, or of all windows *)
298 u := d.First();
299 WHILE u # NIL DO
300 ASSERT(u.frame # NIL, 101);
301 IF (u = w) OR (w = NIL) THEN RestoreSequencer(u.seq) END;
302 u := d.Next(u)
303 END
304 END Update;
305
306 PROCEDURE (d: Directory) GetBounds* (OUT w, h: INTEGER), NEW, ABSTRACT;
307
308
309 (* RootContext *)
310
311 PROCEDURE (c: RootContext) GetSize (OUT w, h: INTEGER);
312 BEGIN
313 c.win.port.GetSize(w, h);
314 w := w * c.win.port.unit; h := h * c.win.port.unit
315 END GetSize;
316
317 PROCEDURE (c: RootContext) SetSize (w, h: INTEGER);
318 END SetSize;
319
320 PROCEDURE (c: RootContext) Normalize (): BOOLEAN;
321 BEGIN
322 RETURN TRUE
323 END Normalize;
324
325 PROCEDURE (c: RootContext) ThisModel (): Models.Model;
326 BEGIN
327 RETURN NIL
328 END ThisModel;
329
330
331 (* sequencing utilities *)
332
333 PROCEDURE Prepend (s: Script; st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
334 VAR e: OpElem;
335 BEGIN
336 ASSERT(op # NIL, 20);
337 NEW(e); e.st := st; e.op := op; e.name := name;
338 e.next := s.list; s.list := e
339 END Prepend;
340
341 PROCEDURE Push (VAR list, e: OpElem);
342 BEGIN
343 e.next := list; list := e
344 END Push;
345
346 PROCEDURE Pop (VAR list, e: OpElem);
347 BEGIN
348 e := list; list := list.next
349 END Pop;
350
351 PROCEDURE Reduce (VAR list: OpElem; max: INTEGER);
352 VAR e: OpElem;
353 BEGIN
354 e := list; WHILE (max > 1) & (e # NIL) DO DEC(max); e := e.next END;
355 IF e # NIL THEN e.next := NIL END
356 END Reduce;
357
358 PROCEDURE (r: Reducer) Reduce (full: BOOLEAN);
359 VAR e: OpElem; n: INTEGER; w: Window;
360 BEGIN
361 IF dir # NIL THEN
362 w := dir.First();
363 WHILE w # NIL DO
364 IF w.seq IS StdSequencer THEN
365 IF full THEN
366 n := 1
367 ELSE
368 n := 0; e := w.seq(StdSequencer).undo;
369 WHILE e # NIL DO INC(n); e := e.next END;
370 IF n > 20 THEN n := n DIV 2 ELSE n := 10 END
371 END;
372 Reduce(w.seq(StdSequencer).undo, n)
373 END;
374 w := dir.Next(w)
375 END
376 END;
377 Kernel.InstallReducer(r)
378 END Reduce;
379
380 PROCEDURE Reset (s: StdSequencer);
381 BEGIN
382 s.trapEra := Kernel.trapCount;
383 IF (s.entryLevel # 0) OR (s.nestLevel # 0) THEN
384 s.modLevel := 0;
385 s.entryLevel := 0;
386 s.nestLevel := 0;
387 s.lastSt := NIL;
388 s.lastOp := NIL;
389 s.script := NIL;
390 s.noUndo := FALSE;
391 s.undo := NIL; s.redo := NIL;
392 s.invisibleLevel := 0;
393 s.transparentLevel := 0;
394 s.notRecordedLevel := 0
395 END
396 END Reset;
397
398 PROCEDURE Neutralize (st: Stores.Store);
399 VAR neutralize: Models.NeutralizeMsg;
400 BEGIN
401 IF st # NIL THEN (* st = NIL for scripts *)
402 WITH st: Models.Model DO
403 Models.Broadcast(st, neutralize)
404 | st: Views.View DO
405 st.Neutralize
406 ELSE
407 END
408 END
409 END Neutralize;
410
411 PROCEDURE Do (s: StdSequencer; st: Stores.Store; op: Stores.Operation);
412 BEGIN
413 INC(s.entryLevel); s.lastSt := NIL; s.lastOp := NIL;
414 Neutralize(st); op.Do;
415 DEC(s.entryLevel)
416 END Do;
417
418 PROCEDURE AffectsDoc (s: StdSequencer; st: Stores.Store): BOOLEAN;
419 VAR v, w: Window;
420 BEGIN
421 w := s.home;
422 IF (w = NIL) OR (st = w.doc) OR (st = w.doc.ThisView()) THEN
423 RETURN TRUE
424 ELSE
425 v := w.link;
426 WHILE (v # w) & (st # v.doc) & (st # v.doc.ThisView()) DO v := v.link END;
427 RETURN v = w
428 END
429 END AffectsDoc;
430
431
432 (* Script *)
433
434 PROCEDURE (s: Script) Do;
435 VAR e, f, g: OpElem;
436 BEGIN
437 e := s.list; f := NIL;
438 REPEAT
439 Neutralize(e.st); e.op.Do;
440 g := e.next; e.next := f; f := e; e := g
441 UNTIL e = NIL;
442 s.list := f
443 END Do;
444
445
446 (* StdSequencer *)
447
448 PROCEDURE (s: StdSequencer) Handle (VAR msg: ANYREC);
449 (* send message to all windows attached to s *)
450 VAR w: Window;
451 BEGIN
452 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
453 WITH msg: Models.Message DO
454 IF msg IS Models.UpdateMsg THEN
455 Properties.IncEra;
456 IF s.entryLevel = 0 THEN
457 (* updates in dominated model bypassed the sequencer *)
458 Reset(s); (* panic reset: clear sequencer *)
459 INC(s.modLevel) (* but leave dirty *)
460 END
461 END;
462 w := dir.First();
463 WHILE w # NIL DO
464 IF w.seq = s THEN w.BroadcastModelMsg(msg) END;
465 w := dir.Next(w)
466 END
467 | msg: Views.Message DO
468 w := dir.First();
469 WHILE w # NIL DO
470 IF w.seq = s THEN w.BroadcastViewMsg(msg) END;
471 w := dir.Next(w)
472 END
473 ELSE
474 END
475 END Handle;
476
477
478 PROCEDURE (s: StdSequencer) Dirty (): BOOLEAN;
479 BEGIN
480 RETURN s.modLevel > 0
481 END Dirty;
482
483 PROCEDURE (s: StdSequencer) SetDirty (dirty: BOOLEAN);
484 BEGIN
485 IF dirty THEN INC(s.modLevel) ELSE s.modLevel := 0 END
486 END SetDirty;
487
488 PROCEDURE (s: StdSequencer) LastOp (st: Stores.Store): Stores.Operation;
489 BEGIN
490 ASSERT(st # NIL, 20);
491 IF s.lastSt = st THEN RETURN s.lastOp ELSE RETURN NIL END
492 END LastOp;
493
494
495 PROCEDURE (s: StdSequencer) BeginScript (IN name: Stores.OpName; VAR script: Stores.Operation);
496 VAR sop: Script;
497 BEGIN
498 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
499 INC(s.nestLevel);
500 IF (s.nestLevel = 1) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN
501 INC(s.modLevel)
502 END;
503 s.lastSt := NIL; s.lastOp := NIL;
504 NEW(sop); sop.up := s.script; sop.list := NIL; sop.level := s.nestLevel; sop.name := name;
505 s.script := sop;
506 script := sop
507 END BeginScript;
508
509 PROCEDURE (s: StdSequencer) Do (st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
510 VAR e: OpElem;
511 BEGIN
512 ASSERT(st # NIL, 20); ASSERT(op # NIL, 21);
513 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
514 Do(s, st, op);
515 IF s.noUndo THEN (* cannot undo: unbalanced BeginModification pending *)
516 s.lastSt := NIL; s.lastOp := NIL
517 ELSIF (s.entryLevel = 0) (* don't record when called from within op.Do *)
518 & AffectsDoc(s, st) THEN (* don't record when Do affected child window only *)
519 s.lastSt := st; s.lastOp := op;
520 s.redo := NIL; (* clear redo stack *)
521 IF s.script # NIL THEN
522 Prepend(s.script, st, name, op)
523 ELSE
524 IF (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN INC(s.modLevel) END;
525 NEW(e); e.st := st; e.op := op; e.name := name;
526 e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
527 IF (s.notRecordedLevel=0) THEN Push(s.undo, e) END
528 END
529 END
530 END Do;
531
532 PROCEDURE (s: StdSequencer) Bunch (st: Stores.Store);
533 VAR lastOp: Stores.Operation;
534 BEGIN
535 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
536 ASSERT(st # NIL, 20); ASSERT(st = s.lastSt, 21);
537 lastOp := s.lastOp;
538 Do(s, st, lastOp);
539 IF s.noUndo THEN
540 s.lastSt := NIL; s.lastOp := NIL
541 ELSIF (s.entryLevel = 0) (* don't record when called from within op.Do *)
542 & AffectsDoc(s, st) THEN (* don't record when Do affected child window only *)
543 s.lastSt := st; s.lastOp := lastOp
544 END
545 END Bunch;
546
547 PROCEDURE (s: StdSequencer) EndScript (script: Stores.Operation);
548 VAR e: OpElem;
549 BEGIN
550 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
551 ASSERT(script # NIL, 20); ASSERT(s.script = script, 21);
552 WITH script: Script DO
553 ASSERT(s.nestLevel = script.level, 22);
554 s.script := script.up;
555 IF s.entryLevel = 0 THEN (* don't record when called from within op.Do *)
556 IF script.list # NIL THEN
557 IF s.script # NIL THEN
558 Prepend(s.script, NIL, script.name, script)
559 ELSE (* outermost scripting level *)
560 s.redo := NIL; (* clear redo stack *)
561 IF ~s.noUndo THEN
562 NEW(e); e.st := NIL; e.op := script; e.name := script.name;
563 e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
564 IF s.notRecordedLevel=0 THEN Push(s.undo, e) END
565 END;
566 s.lastSt := NIL; s.lastOp := NIL
567 END
568 ELSE
569 IF (s.script = NIL) & (s.modLevel > 0) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) THEN
570 DEC(s.modLevel)
571 END
572 END
573 END
574 END;
575 DEC(s.nestLevel);
576 IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
577 END EndScript;
578
579 PROCEDURE (s: StdSequencer) StopBunching;
580 BEGIN
581 s.lastSt := NIL; s.lastOp := NIL
582 END StopBunching;
583
584 PROCEDURE (s: StdSequencer) BeginModification (type: INTEGER; st: Stores.Store);
585 BEGIN
586 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
587 IF s.nestLevel < LEN(s.modStack) THEN s.modStack[s.nestLevel].store := st; s.modStack[s.nestLevel].type := type END;
588 INC(s.nestLevel);
589 IF type = Sequencers.notUndoable THEN
590 INC(s.modLevel); (* unbalanced! *)
591 s.noUndo := TRUE; s.undo := NIL; s.redo := NIL;
592 s.lastSt := NIL; s.lastOp := NIL;
593 INC(s.entryLevel) (* virtual entry of modification "operation" *)
594 ELSIF type = Sequencers.invisible THEN
595 INC(s.invisibleLevel)
596 ELSIF type = Sequencers.clean THEN
597 INC(s.transparentLevel)
598 ELSIF type = notRecorded THEN
599 INC(s.notRecordedLevel)
600 END
601 END BeginModification;
602
603 PROCEDURE (s: StdSequencer) EndModification (type: INTEGER; st: Stores.Store);
604 BEGIN
605 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
606 ASSERT(s.nestLevel > 0, 20);
607 IF s.nestLevel <= LEN(s.modStack) THEN
608 ASSERT((s.modStack[s.nestLevel - 1].store = st) & (s.modStack[s.nestLevel - 1].type = type), 21)
609 END;
610 DEC(s.nestLevel);
611 IF type = Sequencers.notUndoable THEN
612 DEC(s.entryLevel)
613 ELSIF type = Sequencers.invisible THEN
614 DEC(s.invisibleLevel)
615 ELSIF type = Sequencers.clean THEN
616 DEC(s.transparentLevel)
617 ELSIF type = notRecorded THEN
618 DEC(s.notRecordedLevel)
619 END;
620 IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
621 END EndModification;
622
623 PROCEDURE (s: StdSequencer) CanUndo (): BOOLEAN;
624 VAR op: OpElem;
625 BEGIN
626 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
627 op := s.undo;
628 WHILE (op # NIL) & op.invisible DO op := op.next END;
629 RETURN op # NIL
630 END CanUndo;
631
632 PROCEDURE (s: StdSequencer) CanRedo (): BOOLEAN;
633 VAR op: OpElem;
634 BEGIN
635 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
636 op := s.redo;
637 WHILE (op # NIL) & op.invisible DO op := op.next END;
638 RETURN op # NIL
639 END CanRedo;
640
641 PROCEDURE (s: StdSequencer) GetUndoName (VAR name: Stores.OpName);
642 VAR op: OpElem;
643 BEGIN
644 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
645 op := s.undo;
646 WHILE (op # NIL) & op.invisible DO op := op.next END;
647 IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
648 END GetUndoName;
649
650 PROCEDURE (s: StdSequencer) GetRedoName (VAR name: Stores.OpName);
651 VAR op: OpElem;
652 BEGIN
653 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
654 op := s.redo;
655 WHILE (op # NIL) & op.invisible DO op := op.next END;
656 IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
657 END GetRedoName;
658
659 PROCEDURE (s: StdSequencer) Undo;
660 VAR e: OpElem;
661 BEGIN
662 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
663 IF s.undo # NIL THEN
664 REPEAT
665 Pop(s.undo, e); Do(s, e.st, e.op); Push(s.redo, e)
666 UNTIL ~e.invisible OR (s.undo = NIL);
667 IF ~e.transparent THEN
668 IF s.modLevel > 0 THEN DEC(s.modLevel) END
669 END
670 END
671 END Undo;
672
673 PROCEDURE (s: StdSequencer) Redo;
674 VAR e: OpElem;
675 BEGIN
676 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
677 IF s.redo # NIL THEN
678 Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e);
679 WHILE (s.redo # NIL) & s.redo.invisible DO
680 Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e)
681 END;
682 IF ~e.transparent THEN
683 INC(s.modLevel)
684 END
685 END
686 END Redo;
687
688
689 (* Forwarder *)
690
691 PROCEDURE (f: Forwarder) Forward (target: BOOLEAN; VAR msg: Controllers.Message);
692 VAR w: Window;
693 BEGIN
694 w := dir.Focus(target);
695 IF w # NIL THEN w.ForwardCtrlMsg(msg) END
696 END Forward;
697
698 PROCEDURE (f: Forwarder) Transfer (VAR msg: Controllers.TransferMessage);
699 VAR w: Window; h: Views.Frame; p: Ports.Port; sx, sy, tx, ty, pw, ph: INTEGER;
700 BEGIN
701 h := msg.source; p := h.rider.Base();
702 (* (msg.x, msg.y) is point in local coordinates of source frame *)
703 sx := (msg.x + h.gx) DIV h.unit;
704 sy := (msg.y + h.gy) DIV h.unit;
705 (* (sx, sy) is point in global coordinates of source port *)
706 dir.GetThisWindow(p, sx, sy, tx, ty, w);
707 IF w # NIL THEN
708 (* (tx, ty) is point in global coordinates of target port *)
709 w.port.GetSize(pw, ph);
710 msg.x := tx * w.port.unit;
711 msg.y := ty * w.port.unit;
712 (* (msg.x, msg.y) is point in coordinates of target window *)
713 w.ForwardCtrlMsg(msg)
714 END
715 END Transfer;
716
717
718 (** miscellaneous **)
719
720 PROCEDURE SetDir* (d: Directory);
721 BEGIN
722 ASSERT(d # NIL, 20);
723 IF stdDir = NIL THEN stdDir := d END;
724 dir := d
725 END SetDir;
726
727 PROCEDURE SelectBySpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter; VAR done: BOOLEAN);
728 VAR w: Window;
729 BEGIN
730 Kernel.MakeFileName(name, "");
731 w := dir.First();
732 WHILE (w # NIL) & ((loc = NIL) OR (w.loc = NIL) OR (loc.res = 77) OR (w.loc.res = 77) OR
733 (name = "") OR (w.name = "") OR
734 ~Files.dir.SameFile(loc, name, w.loc, w.name) OR (w.conv # conv)) DO
735 w := dir.Next(w)
736 END;
737 IF w # NIL THEN dir.Select(w, lazy); done := TRUE ELSE done := FALSE END
738 END SelectBySpec;
739
740 PROCEDURE SelectByTitle* (v: Views.View; flags: SET; title: Views.Title; VAR done: BOOLEAN);
741 VAR w: Window; t: Views.Title; n1, n2: ARRAY 64 OF CHAR;
742 BEGIN
743 done := FALSE;
744 IF v # NIL THEN
745 IF v IS Documents.Document THEN v := v(Documents.Document).ThisView() END;
746 Services.GetTypeName(v, n1)
747 ELSE n1 := ""
748 END;
749 w := dir.First();
750 WHILE w # NIL DO
751 IF ((w.flags / flags) * {isAux, isTool} = {}) & ~(allowDuplicates IN w.flags) THEN
752 w.GetTitle(t);
753 IF t = title THEN
754 Services.GetTypeName(w.doc.ThisView(), n2);
755 IF (n1 = "") OR (n1 = n2) THEN dir.Select(w, lazy); done := TRUE; RETURN END
756 END
757 END;
758 w := dir.Next(w)
759 END
760 END SelectByTitle;
761
762
763 PROCEDURE (h: Hook) Omnicast (VAR msg: ANYREC);
764 VAR w: Window;
765 BEGIN
766 w := dir.First();
767 WHILE w # NIL DO
768 IF ~w.sub THEN w.seq.Handle(msg) END;
769 w := dir.Next(w)
770 END
771 END Omnicast;
772
773 PROCEDURE RestoreSequencer (seq: Sequencers.Sequencer);
774 VAR w: Window;
775 BEGIN
776 w := dir.First();
777 WHILE w # NIL DO
778 ASSERT(w.frame # NIL, 100);
779 IF (seq = NIL) OR (w.seq = seq) THEN
780 w.Update (* causes redrawing of BlackBox region *)
781 END;
782 w := dir.Next(w)
783 END
784 END RestoreSequencer;
785
786 PROCEDURE (h: Hook) RestoreDomain (d: Stores.Domain);
787 VAR seq: ANYPTR;
788 BEGIN
789 IF d = NIL THEN
790 RestoreSequencer(NIL)
791 ELSE
792 seq := d.GetSequencer();
793 IF seq # NIL THEN
794 RestoreSequencer (seq(Sequencers.Sequencer))
795 END
796 END
797 END RestoreDomain;
798
799
800 (* SequencerDirectory *)
801
802 PROCEDURE (d: SequencerDirectory) New (): Sequencers.Sequencer;
803 BEGIN
804 RETURN dir.NewSequencer()
805 END New;
806
807 (** CheckAction **)
808
809 PROCEDURE (a: CheckAction) Do;
810 VAR w: Window; s: StdSequencer;
811 BEGIN
812 Services.DoLater(a.wait, Services.resolution);
813 w := dir.First();
814 WHILE w # NIL DO
815 s := w.seq(StdSequencer);
816 IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
817 ASSERT(s.nestLevel = 0, 100);
818 (* unbalanced calls of Views.BeginModification/EndModification or Views.BeginScript/EndScript *)
819 w := dir.Next(w)
820 END
821 END Do;
822
823 PROCEDURE (a: WaitAction) Do;
824 BEGIN
825 Services.DoLater(a.check, Services.immediately)
826 END Do;
827
828
829 PROCEDURE (n: LangNotifier) Notify;
830 VAR w: Window; pw, ph: INTEGER;
831 BEGIN
832 w := dir.First();
833 WHILE w # NIL DO
834 w.port.GetSize(pw, ph);
835 w.Restore(0, 0, pw, ph);
836 w.RefreshTitle;
837 w := dir.Next(w)
838 END
839 END Notify;
840
841 PROCEDURE Init;
842 VAR f: Forwarder; r: Reducer; sdir: SequencerDirectory;
843 a: CheckAction; w: WaitAction; h: Hook; ln: LangNotifier;
844 BEGIN
845 NEW(sdir); Sequencers.SetDir(sdir);
846 NEW(h); Views.SetMsgHook(h);
847 NEW(f); Controllers.Register(f);
848 NEW(r); Kernel.InstallReducer(r);
849 NEW(a); NEW(w); a.wait := w; w.check := a; Services.DoLater(a, Services.immediately);
850 NEW(ln); Dialog.RegisterLangNotifier(ln)
851 END Init;
852
853 BEGIN
854 Init
855 END Windows.
[FORK] BlackBox Cross-Platform (Windows, GNU/Linux, OpenBSD, FreeBSD)
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024