123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855 |
- MODULE Windows;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Windows.odc *)
- (* DO NOT EDIT *)
- IMPORT
- Kernel, Ports, Files, Services,
- Stores, Sequencers, Models, Views, Controllers, Properties,
- Dialog, Converters, Containers, Documents;
- CONST
- (** Window.flags **)
- isTool* = 0; isAux* = 1;
- noHScroll* = 2; noVScroll* = 3; noResize* = 4;
- allowDuplicates* = 5; neverDirty* = 6;
- (** Directory.Select lazy **)
- eager* = FALSE; lazy* = TRUE;
- notRecorded = 3;
- TYPE
- Window* = POINTER TO ABSTRACT RECORD
- port-: Ports.Port;
- frame-: Views.RootFrame;
- doc-: Documents.Document;
- seq-: Sequencers.Sequencer;
- link-: Window; (* ring of windows with same sequencer *)
- sub-: BOOLEAN;
- flags-: SET;
- loc-: Files.Locator;
- name-: Files.Name;
- conv-: Converters.Converter
- END;
- Directory* = POINTER TO ABSTRACT RECORD
- l*, t*, r*, b*: INTEGER;
- minimized*, maximized*: BOOLEAN
- END;
- OpElem = POINTER TO RECORD
- next: OpElem;
- st: Stores.Store;
- op: Stores.Operation;
- name: Stores.OpName;
- invisible, transparent: BOOLEAN
- END;
- Script = POINTER TO RECORD (Stores.Operation)
- up: Script;
- list: OpElem;
- level: INTEGER; (* nestLevel at creation time *)
- name: Stores.OpName
- END;
- StdSequencer = POINTER TO RECORD (Sequencers.Sequencer)
- home: Window;
- trapEra: INTEGER; (* last observed TrapCount value *)
- modLevel: INTEGER; (* dirty if modLevel > 0 *)
- entryLevel: INTEGER; (* active = (entryLevel > 0) *)
- nestLevel: INTEGER; (* nesting level of BeginScript/Modification *)
- modStack: ARRAY 64 OF RECORD store: Stores.Store; type: INTEGER END;
- lastSt: Stores.Store;
- lastOp: Stores.Operation;
- script: Script;
- undo, redo: OpElem; (* undo/redo stacks *)
- noUndo: BOOLEAN; (* script # NIL and BeginModification called *)
- invisibleLevel, transparentLevel, notRecordedLevel: INTEGER
- END;
-
- SequencerDirectory = POINTER TO RECORD (Sequencers.Directory) END;
- Forwarder = POINTER TO RECORD (Controllers.Forwarder) END;
-
- RootContext = POINTER TO RECORD (Models.Context)
- win: Window
- END;
-
- Reducer = POINTER TO RECORD (Kernel.Reducer) END;
- Hook = POINTER TO RECORD (Views.MsgHook) END;
-
- CheckAction = POINTER TO RECORD (Services.Action)
- wait: WaitAction
- END;
- WaitAction = POINTER TO RECORD (Services.Action)
- check: CheckAction
- END;
-
- LangNotifier = POINTER TO RECORD (Dialog.LangNotifier) END;
- VAR dir-, stdDir-: Directory;
- PROCEDURE ^ Reset (s: StdSequencer);
- PROCEDURE CharError;
- BEGIN
- Dialog.Beep
- END CharError;
-
-
- (** Window **)
- PROCEDURE (w: Window) Init* (port: Ports.Port), NEW;
- BEGIN
- ASSERT(w.port = NIL, 20); ASSERT(port # NIL, 21);
- w.port := port
- END Init;
- PROCEDURE (w: Window) SetTitle* (title: Views.Title), NEW, ABSTRACT;
- PROCEDURE (w: Window) GetTitle* (OUT title: Views.Title), NEW, ABSTRACT;
- PROCEDURE (w: Window) RefreshTitle* (), NEW, ABSTRACT;
- PROCEDURE (w: Window) SetSpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter), NEW, EXTENSIBLE;
- VAR u: Window;
- BEGIN
- u := w;
- REPEAT
- u := u.link;
- u.loc := loc; u.name := name$; u.conv := conv
- UNTIL u = w
- END SetSpec;
- PROCEDURE (w: Window) Restore* (l, t, r, b: INTEGER), NEW;
- VAR f: Views.Frame; u, pw, ph: INTEGER;
- BEGIN
- f := w.frame;
- IF f # NIL THEN
- w.port.GetSize(pw, ph); u := w.port.unit;
- IF r > pw THEN r := pw END;
- IF b > ph THEN b := ph END;
- l := l * u - f.gx; t := t * u - f.gy; r := r * u - f.gx; b := b * u - f.gy;
- (* only adds to the BlackBox region, but doesn't draw: *)
- Views.UpdateRoot(w.frame, l, t, r, b, Views.keepFrames)
- END
- END Restore;
- PROCEDURE (w: Window) Update*, NEW;
- BEGIN
- ASSERT(w.frame # NIL, 20);
- (* redraws the whole accumulated BlackBox region: *)
- Views.ValidateRoot(w.frame)
- END Update;
- PROCEDURE (w: Window) GetSize*(OUT width, height: INTEGER), NEW, EXTENSIBLE;
- BEGIN
- w.port.GetSize(width, height)
- END GetSize;
-
- PROCEDURE (w: Window) SetSize* (width, height: INTEGER), NEW, EXTENSIBLE;
- VAR c: Containers.Controller; w0, h0: INTEGER;
- BEGIN
- w.port.GetSize(w0, h0);
- w.port.SetSize(width, height);
- IF w.frame # NIL THEN Views.AdaptRoot(w.frame) END;
- c := w.doc.ThisController();
- IF c.opts * {Documents.winWidth, Documents.winHeight} # {} THEN
- w.Restore(0, 0, width, height)
- END
- END SetSize;
- PROCEDURE (w: Window) BroadcastModelMsg* (VAR msg: Models.Message), NEW, EXTENSIBLE;
- BEGIN
- IF w.frame # NIL THEN
- Views.BroadcastModelMsg(w.frame, msg)
- END
- END BroadcastModelMsg;
- PROCEDURE (w: Window) BroadcastViewMsg* (VAR msg: Views.Message), NEW, EXTENSIBLE;
- BEGIN
- IF w.frame # NIL THEN
- Views.BroadcastViewMsg(w.frame, msg)
- END
- END BroadcastViewMsg;
- PROCEDURE (w: Window) ForwardCtrlMsg* (VAR msg: Controllers.Message), NEW, EXTENSIBLE;
- BEGIN
- IF w.frame # NIL THEN
- WITH msg: Controllers.CursorMessage DO
- DEC(msg.x, w.frame.gx); DEC(msg.y, w.frame.gy)
- ELSE
- END;
- Views.ForwardCtrlMsg(w.frame, msg)
- END
- END ForwardCtrlMsg;
- PROCEDURE (w: Window) MouseDown* (x, y, time: INTEGER; modifiers: SET), NEW, ABSTRACT;
- PROCEDURE (w: Window) KeyDown* (ch: CHAR; modifiers: SET), NEW, EXTENSIBLE;
- VAR key: Controllers.EditMsg;
- BEGIN
- IF ch = 0X THEN
- CharError
- ELSE
- key.op := Controllers.pasteChar; key.char := ch;
- key.modifiers:= modifiers;
- w.ForwardCtrlMsg(key)
- END
- END KeyDown;
- PROCEDURE (w: Window) Close*, NEW, EXTENSIBLE;
- VAR u: Window; f: Views.Frame; s: Sequencers.Sequencer; msg: Sequencers.RemoveMsg;
- BEGIN
- u := w.link; WHILE u.link # w DO u := u.link END;
- u.link := w.link;
- f := w.frame; s := w.seq;
- IF ~w.sub THEN s.Notify(msg) END;
- WITH s: StdSequencer DO
- IF s.home = w THEN s.home := NIL END
- ELSE
- END;
- w.port.SetSize(0, 0); Views.AdaptRoot(w.frame);
- w.port := NIL; w.frame := NIL; w.doc := NIL; w.seq := NIL; w.link := NIL; w.loc := NIL;
- f.Close
- END Close;
- (** Directory **)
- PROCEDURE (d: Directory) NewSequencer* (): Sequencers.Sequencer, NEW;
- VAR s: StdSequencer;
- BEGIN
- NEW(s); Reset(s); RETURN s
- END NewSequencer;
- PROCEDURE (d: Directory) First* (): Window, NEW, ABSTRACT;
- PROCEDURE (d: Directory) Next* (w: Window): Window, NEW, ABSTRACT;
- PROCEDURE (d: Directory) New* (): Window, NEW, ABSTRACT;
-
- PROCEDURE (d: Directory) Open* (w: Window; doc: Documents.Document;
- flags: SET; name: Views.Title;
- loc: Files.Locator; fname: Files.Name;
- conv: Converters.Converter),
- NEW, EXTENSIBLE;
- VAR v: Views.View; c: RootContext; s: Sequencers.Sequencer; f: Views.Frame; any: ANYPTR;
- BEGIN
- ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21); ASSERT(doc.context = NIL, 22);
- v := doc.ThisView(); ASSERT(v # NIL, 23);
- ASSERT(w.doc = NIL, 24); ASSERT(w.port # NIL, 25);
- IF w.link = NIL THEN w.link := w END; (* create new window ring *)
- w.doc := doc; w.flags := flags;
- IF w.seq = NIL THEN
- ASSERT(doc.Domain() # NIL, 27);
- any := doc.Domain().GetSequencer();
- IF any # NIL THEN
- ASSERT(any IS Sequencers.Sequencer, 26);
- w.seq := any(Sequencers.Sequencer)
- ELSE
- w.seq := d.NewSequencer();
- doc.Domain().SetSequencer(w.seq)
- END
- END;
- s := w.seq;
- WITH s: StdSequencer DO
- IF s.home = NIL THEN s.home := w END
- ELSE
- END;
- NEW(c); c.win := w; doc.InitContext(c);
- doc.GetNewFrame(f); w.frame := f(Views.RootFrame);
- w.frame.ConnectTo(w.port);
- Views.SetRoot(w.frame, w.doc, FALSE, w.flags);
- w.SetSpec(loc, fname, conv)
- END Open;
- PROCEDURE (d: Directory) OpenSubWindow* (w: Window; doc: Documents.Document; flags: SET; name: Views.Title), NEW, EXTENSIBLE;
- VAR u: Window; title: Views.Title;
- BEGIN
- ASSERT(w # NIL, 20); ASSERT(doc # NIL, 21);
- u := d.First(); WHILE (u # NIL) & (u.seq # doc.Domain().GetSequencer()) DO u := d.Next(u) END;
- IF u # NIL THEN
- w.sub := TRUE;
- w.link := u.link; u.link := w;
- w.seq := u.seq; w.loc := u.loc; w.name := u.name; w.conv := u.conv;
- u.GetTitle(title);
- d.Open(w, doc, flags, title, u.loc, u.name, u.conv)
- ELSE
- d.Open(w, doc, flags, name, NIL, "", NIL)
- END
- END OpenSubWindow;
- PROCEDURE ^ RestoreSequencer(seq: Sequencers.Sequencer);
- PROCEDURE (d: Directory) Focus* (target: BOOLEAN): Window, NEW, ABSTRACT;
- PROCEDURE (d: Directory) GetThisWindow* (p: Ports.Port; px, py: INTEGER; OUT x, y: INTEGER; OUT w: Window), NEW, ABSTRACT;
- PROCEDURE (d: Directory) Select* (w: Window; lazy: BOOLEAN), NEW, ABSTRACT;
- PROCEDURE (d: Directory) Close* (w: Window), NEW, ABSTRACT;
- PROCEDURE (d: Directory) Update* (w: Window), NEW;
- VAR u: Window;
- BEGIN
- (* redraws the BlackBox region of a given window, or of all windows *)
- u := d.First();
- WHILE u # NIL DO
- ASSERT(u.frame # NIL, 101);
- IF (u = w) OR (w = NIL) THEN RestoreSequencer(u.seq) END;
- u := d.Next(u)
- END
- END Update;
-
- PROCEDURE (d: Directory) GetBounds* (OUT w, h: INTEGER), NEW, ABSTRACT;
- (* RootContext *)
- PROCEDURE (c: RootContext) GetSize (OUT w, h: INTEGER);
- BEGIN
- c.win.port.GetSize(w, h);
- w := w * c.win.port.unit; h := h * c.win.port.unit
- END GetSize;
- PROCEDURE (c: RootContext) SetSize (w, h: INTEGER);
- END SetSize;
-
- PROCEDURE (c: RootContext) Normalize (): BOOLEAN;
- BEGIN
- RETURN TRUE
- END Normalize;
-
- PROCEDURE (c: RootContext) ThisModel (): Models.Model;
- BEGIN
- RETURN NIL
- END ThisModel;
- (* sequencing utilities *)
- PROCEDURE Prepend (s: Script; st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
- VAR e: OpElem;
- BEGIN
- ASSERT(op # NIL, 20);
- NEW(e); e.st := st; e.op := op; e.name := name;
- e.next := s.list; s.list := e
- END Prepend;
- PROCEDURE Push (VAR list, e: OpElem);
- BEGIN
- e.next := list; list := e
- END Push;
- PROCEDURE Pop (VAR list, e: OpElem);
- BEGIN
- e := list; list := list.next
- END Pop;
- PROCEDURE Reduce (VAR list: OpElem; max: INTEGER);
- VAR e: OpElem;
- BEGIN
- e := list; WHILE (max > 1) & (e # NIL) DO DEC(max); e := e.next END;
- IF e # NIL THEN e.next := NIL END
- END Reduce;
-
- PROCEDURE (r: Reducer) Reduce (full: BOOLEAN);
- VAR e: OpElem; n: INTEGER; w: Window;
- BEGIN
- IF dir # NIL THEN
- w := dir.First();
- WHILE w # NIL DO
- IF w.seq IS StdSequencer THEN
- IF full THEN
- n := 1
- ELSE
- n := 0; e := w.seq(StdSequencer).undo;
- WHILE e # NIL DO INC(n); e := e.next END;
- IF n > 20 THEN n := n DIV 2 ELSE n := 10 END
- END;
- Reduce(w.seq(StdSequencer).undo, n)
- END;
- w := dir.Next(w)
- END
- END;
- Kernel.InstallReducer(r)
- END Reduce;
- PROCEDURE Reset (s: StdSequencer);
- BEGIN
- s.trapEra := Kernel.trapCount;
- IF (s.entryLevel # 0) OR (s.nestLevel # 0) THEN
- s.modLevel := 0;
- s.entryLevel := 0;
- s.nestLevel := 0;
- s.lastSt := NIL;
- s.lastOp := NIL;
- s.script := NIL;
- s.noUndo := FALSE;
- s.undo := NIL; s.redo := NIL;
- s.invisibleLevel := 0;
- s.transparentLevel := 0;
- s.notRecordedLevel := 0
- END
- END Reset;
- PROCEDURE Neutralize (st: Stores.Store);
- VAR neutralize: Models.NeutralizeMsg;
- BEGIN
- IF st # NIL THEN (* st = NIL for scripts *)
- WITH st: Models.Model DO
- Models.Broadcast(st, neutralize)
- | st: Views.View DO
- st.Neutralize
- ELSE
- END
- END
- END Neutralize;
- PROCEDURE Do (s: StdSequencer; st: Stores.Store; op: Stores.Operation);
- BEGIN
- INC(s.entryLevel); s.lastSt := NIL; s.lastOp := NIL;
- Neutralize(st); op.Do;
- DEC(s.entryLevel)
- END Do;
- PROCEDURE AffectsDoc (s: StdSequencer; st: Stores.Store): BOOLEAN;
- VAR v, w: Window;
- BEGIN
- w := s.home;
- IF (w = NIL) OR (st = w.doc) OR (st = w.doc.ThisView()) THEN
- RETURN TRUE
- ELSE
- v := w.link;
- WHILE (v # w) & (st # v.doc) & (st # v.doc.ThisView()) DO v := v.link END;
- RETURN v = w
- END
- END AffectsDoc;
- (* Script *)
- PROCEDURE (s: Script) Do;
- VAR e, f, g: OpElem;
- BEGIN
- e := s.list; f := NIL;
- REPEAT
- Neutralize(e.st); e.op.Do;
- g := e.next; e.next := f; f := e; e := g
- UNTIL e = NIL;
- s.list := f
- END Do;
- (* StdSequencer *)
- PROCEDURE (s: StdSequencer) Handle (VAR msg: ANYREC);
- (* send message to all windows attached to s *)
- VAR w: Window;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- WITH msg: Models.Message DO
- IF msg IS Models.UpdateMsg THEN
- Properties.IncEra;
- IF s.entryLevel = 0 THEN
- (* updates in dominated model bypassed the sequencer *)
- Reset(s); (* panic reset: clear sequencer *)
- INC(s.modLevel) (* but leave dirty *)
- END
- END;
- w := dir.First();
- WHILE w # NIL DO
- IF w.seq = s THEN w.BroadcastModelMsg(msg) END;
- w := dir.Next(w)
- END
- | msg: Views.Message DO
- w := dir.First();
- WHILE w # NIL DO
- IF w.seq = s THEN w.BroadcastViewMsg(msg) END;
- w := dir.Next(w)
- END
- ELSE
- END
- END Handle;
- PROCEDURE (s: StdSequencer) Dirty (): BOOLEAN;
- BEGIN
- RETURN s.modLevel > 0
- END Dirty;
- PROCEDURE (s: StdSequencer) SetDirty (dirty: BOOLEAN);
- BEGIN
- IF dirty THEN INC(s.modLevel) ELSE s.modLevel := 0 END
- END SetDirty;
- PROCEDURE (s: StdSequencer) LastOp (st: Stores.Store): Stores.Operation;
- BEGIN
- ASSERT(st # NIL, 20);
- IF s.lastSt = st THEN RETURN s.lastOp ELSE RETURN NIL END
- END LastOp;
- PROCEDURE (s: StdSequencer) BeginScript (IN name: Stores.OpName; VAR script: Stores.Operation);
- VAR sop: Script;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- INC(s.nestLevel);
- IF (s.nestLevel = 1) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN
- INC(s.modLevel)
- END;
- s.lastSt := NIL; s.lastOp := NIL;
- NEW(sop); sop.up := s.script; sop.list := NIL; sop.level := s.nestLevel; sop.name := name;
- s.script := sop;
- script := sop
- END BeginScript;
- PROCEDURE (s: StdSequencer) Do (st: Stores.Store; IN name: Stores.OpName; op: Stores.Operation);
- VAR e: OpElem;
- BEGIN
- ASSERT(st # NIL, 20); ASSERT(op # NIL, 21);
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- Do(s, st, op);
- IF s.noUndo THEN (* cannot undo: unbalanced BeginModification pending *)
- s.lastSt := NIL; s.lastOp := NIL
- ELSIF (s.entryLevel = 0) (* don't record when called from within op.Do *)
- & AffectsDoc(s, st) THEN (* don't record when Do affected child window only *)
- s.lastSt := st; s.lastOp := op;
- s.redo := NIL; (* clear redo stack *)
- IF s.script # NIL THEN
- Prepend(s.script, st, name, op)
- ELSE
- IF (s.invisibleLevel = 0) & (s.transparentLevel = 0) & (s.notRecordedLevel = 0) THEN INC(s.modLevel) END;
- NEW(e); e.st := st; e.op := op; e.name := name;
- e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
- IF (s.notRecordedLevel=0) THEN Push(s.undo, e) END
- END
- END
- END Do;
- PROCEDURE (s: StdSequencer) Bunch (st: Stores.Store);
- VAR lastOp: Stores.Operation;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- ASSERT(st # NIL, 20); ASSERT(st = s.lastSt, 21);
- lastOp := s.lastOp;
- Do(s, st, lastOp);
- IF s.noUndo THEN
- s.lastSt := NIL; s.lastOp := NIL
- ELSIF (s.entryLevel = 0) (* don't record when called from within op.Do *)
- & AffectsDoc(s, st) THEN (* don't record when Do affected child window only *)
- s.lastSt := st; s.lastOp := lastOp
- END
- END Bunch;
- PROCEDURE (s: StdSequencer) EndScript (script: Stores.Operation);
- VAR e: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- ASSERT(script # NIL, 20); ASSERT(s.script = script, 21);
- WITH script: Script DO
- ASSERT(s.nestLevel = script.level, 22);
- s.script := script.up;
- IF s.entryLevel = 0 THEN (* don't record when called from within op.Do *)
- IF script.list # NIL THEN
- IF s.script # NIL THEN
- Prepend(s.script, NIL, script.name, script)
- ELSE (* outermost scripting level *)
- s.redo := NIL; (* clear redo stack *)
- IF ~s.noUndo THEN
- NEW(e); e.st := NIL; e.op := script; e.name := script.name;
- e.invisible := s.invisibleLevel > 0; e.transparent := s.transparentLevel > 0;
- IF s.notRecordedLevel=0 THEN Push(s.undo, e) END
- END;
- s.lastSt := NIL; s.lastOp := NIL
- END
- ELSE
- IF (s.script = NIL) & (s.modLevel > 0) & (s.invisibleLevel = 0) & (s.transparentLevel = 0) THEN
- DEC(s.modLevel)
- END
- END
- END
- END;
- DEC(s.nestLevel);
- IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
- END EndScript;
- PROCEDURE (s: StdSequencer) StopBunching;
- BEGIN
- s.lastSt := NIL; s.lastOp := NIL
- END StopBunching;
- PROCEDURE (s: StdSequencer) BeginModification (type: INTEGER; st: Stores.Store);
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- IF s.nestLevel < LEN(s.modStack) THEN s.modStack[s.nestLevel].store := st; s.modStack[s.nestLevel].type := type END;
- INC(s.nestLevel);
- IF type = Sequencers.notUndoable THEN
- INC(s.modLevel); (* unbalanced! *)
- s.noUndo := TRUE; s.undo := NIL; s.redo := NIL;
- s.lastSt := NIL; s.lastOp := NIL;
- INC(s.entryLevel) (* virtual entry of modification "operation" *)
- ELSIF type = Sequencers.invisible THEN
- INC(s.invisibleLevel)
- ELSIF type = Sequencers.clean THEN
- INC(s.transparentLevel)
- ELSIF type = notRecorded THEN
- INC(s.notRecordedLevel)
- END
- END BeginModification;
- PROCEDURE (s: StdSequencer) EndModification (type: INTEGER; st: Stores.Store);
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- ASSERT(s.nestLevel > 0, 20);
- IF s.nestLevel <= LEN(s.modStack) THEN
- ASSERT((s.modStack[s.nestLevel - 1].store = st) & (s.modStack[s.nestLevel - 1].type = type), 21)
- END;
- DEC(s.nestLevel);
- IF type = Sequencers.notUndoable THEN
- DEC(s.entryLevel)
- ELSIF type = Sequencers.invisible THEN
- DEC(s.invisibleLevel)
- ELSIF type = Sequencers.clean THEN
- DEC(s.transparentLevel)
- ELSIF type = notRecorded THEN
- DEC(s.notRecordedLevel)
- END;
- IF s.nestLevel = 0 THEN ASSERT(s.script = NIL, 22); s.noUndo := FALSE END
- END EndModification;
- PROCEDURE (s: StdSequencer) CanUndo (): BOOLEAN;
- VAR op: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- op := s.undo;
- WHILE (op # NIL) & op.invisible DO op := op.next END;
- RETURN op # NIL
- END CanUndo;
- PROCEDURE (s: StdSequencer) CanRedo (): BOOLEAN;
- VAR op: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- op := s.redo;
- WHILE (op # NIL) & op.invisible DO op := op.next END;
- RETURN op # NIL
- END CanRedo;
- PROCEDURE (s: StdSequencer) GetUndoName (VAR name: Stores.OpName);
- VAR op: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- op := s.undo;
- WHILE (op # NIL) & op.invisible DO op := op.next END;
- IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
- END GetUndoName;
- PROCEDURE (s: StdSequencer) GetRedoName (VAR name: Stores.OpName);
- VAR op: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- op := s.redo;
- WHILE (op # NIL) & op.invisible DO op := op.next END;
- IF op # NIL THEN name := op.name$ ELSE name[0] := 0X END
- END GetRedoName;
- PROCEDURE (s: StdSequencer) Undo;
- VAR e: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- IF s.undo # NIL THEN
- REPEAT
- Pop(s.undo, e); Do(s, e.st, e.op); Push(s.redo, e)
- UNTIL ~e.invisible OR (s.undo = NIL);
- IF ~e.transparent THEN
- IF s.modLevel > 0 THEN DEC(s.modLevel) END
- END
- END
- END Undo;
- PROCEDURE (s: StdSequencer) Redo;
- VAR e: OpElem;
- BEGIN
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- IF s.redo # NIL THEN
- Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e);
- WHILE (s.redo # NIL) & s.redo.invisible DO
- Pop(s.redo, e); Do(s, e.st, e.op); Push(s.undo, e)
- END;
- IF ~e.transparent THEN
- INC(s.modLevel)
- END
- END
- END Redo;
- (* Forwarder *)
- PROCEDURE (f: Forwarder) Forward (target: BOOLEAN; VAR msg: Controllers.Message);
- VAR w: Window;
- BEGIN
- w := dir.Focus(target);
- IF w # NIL THEN w.ForwardCtrlMsg(msg) END
- END Forward;
- PROCEDURE (f: Forwarder) Transfer (VAR msg: Controllers.TransferMessage);
- VAR w: Window; h: Views.Frame; p: Ports.Port; sx, sy, tx, ty, pw, ph: INTEGER;
- BEGIN
- h := msg.source; p := h.rider.Base();
- (* (msg.x, msg.y) is point in local coordinates of source frame *)
- sx := (msg.x + h.gx) DIV h.unit;
- sy := (msg.y + h.gy) DIV h.unit;
- (* (sx, sy) is point in global coordinates of source port *)
- dir.GetThisWindow(p, sx, sy, tx, ty, w);
- IF w # NIL THEN
- (* (tx, ty) is point in global coordinates of target port *)
- w.port.GetSize(pw, ph);
- msg.x := tx * w.port.unit;
- msg.y := ty * w.port.unit;
- (* (msg.x, msg.y) is point in coordinates of target window *)
- w.ForwardCtrlMsg(msg)
- END
- END Transfer;
- (** miscellaneous **)
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20);
- IF stdDir = NIL THEN stdDir := d END;
- dir := d
- END SetDir;
- PROCEDURE SelectBySpec* (loc: Files.Locator; name: Files.Name; conv: Converters.Converter; VAR done: BOOLEAN);
- VAR w: Window;
- BEGIN
- Kernel.MakeFileName(name, "");
- w := dir.First();
- WHILE (w # NIL) & ((loc = NIL) OR (w.loc = NIL) OR (loc.res = 77) OR (w.loc.res = 77) OR
- (name = "") OR (w.name = "") OR
- ~Files.dir.SameFile(loc, name, w.loc, w.name) OR (w.conv # conv)) DO
- w := dir.Next(w)
- END;
- IF w # NIL THEN dir.Select(w, lazy); done := TRUE ELSE done := FALSE END
- END SelectBySpec;
- PROCEDURE SelectByTitle* (v: Views.View; flags: SET; title: Views.Title; VAR done: BOOLEAN);
- VAR w: Window; t: Views.Title; n1, n2: ARRAY 64 OF CHAR;
- BEGIN
- done := FALSE;
- IF v # NIL THEN
- IF v IS Documents.Document THEN v := v(Documents.Document).ThisView() END;
- Services.GetTypeName(v, n1)
- ELSE n1 := ""
- END;
- w := dir.First();
- WHILE w # NIL DO
- IF ((w.flags / flags) * {isAux, isTool} = {}) & ~(allowDuplicates IN w.flags) THEN
- w.GetTitle(t);
- IF t = title THEN
- Services.GetTypeName(w.doc.ThisView(), n2);
- IF (n1 = "") OR (n1 = n2) THEN dir.Select(w, lazy); done := TRUE; RETURN END
- END
- END;
- w := dir.Next(w)
- END
- END SelectByTitle;
- PROCEDURE (h: Hook) Omnicast (VAR msg: ANYREC);
- VAR w: Window;
- BEGIN
- w := dir.First();
- WHILE w # NIL DO
- IF ~w.sub THEN w.seq.Handle(msg) END;
- w := dir.Next(w)
- END
- END Omnicast;
- PROCEDURE RestoreSequencer (seq: Sequencers.Sequencer);
- VAR w: Window;
- BEGIN
- w := dir.First();
- WHILE w # NIL DO
- ASSERT(w.frame # NIL, 100);
- IF (seq = NIL) OR (w.seq = seq) THEN
- w.Update (* causes redrawing of BlackBox region *)
- END;
- w := dir.Next(w)
- END
- END RestoreSequencer;
- PROCEDURE (h: Hook) RestoreDomain (d: Stores.Domain);
- VAR seq: ANYPTR;
- BEGIN
- IF d = NIL THEN
- RestoreSequencer(NIL)
- ELSE
- seq := d.GetSequencer();
- IF seq # NIL THEN
- RestoreSequencer (seq(Sequencers.Sequencer))
- END
- END
- END RestoreDomain;
- (* SequencerDirectory *)
-
- PROCEDURE (d: SequencerDirectory) New (): Sequencers.Sequencer;
- BEGIN
- RETURN dir.NewSequencer()
- END New;
- (** CheckAction **)
-
- PROCEDURE (a: CheckAction) Do;
- VAR w: Window; s: StdSequencer;
- BEGIN
- Services.DoLater(a.wait, Services.resolution);
- w := dir.First();
- WHILE w # NIL DO
- s := w.seq(StdSequencer);
- IF s.trapEra # Kernel.trapCount THEN Reset(s) END;
- ASSERT(s.nestLevel = 0, 100);
- (* unbalanced calls of Views.BeginModification/EndModification or Views.BeginScript/EndScript *)
- w := dir.Next(w)
- END
- END Do;
-
- PROCEDURE (a: WaitAction) Do;
- BEGIN
- Services.DoLater(a.check, Services.immediately)
- END Do;
- PROCEDURE (n: LangNotifier) Notify;
- VAR w: Window; pw, ph: INTEGER;
- BEGIN
- w := dir.First();
- WHILE w # NIL DO
- w.port.GetSize(pw, ph);
- w.Restore(0, 0, pw, ph);
- w.RefreshTitle;
- w := dir.Next(w)
- END
- END Notify;
-
- PROCEDURE Init;
- VAR f: Forwarder; r: Reducer; sdir: SequencerDirectory;
- a: CheckAction; w: WaitAction; h: Hook; ln: LangNotifier;
- BEGIN
- NEW(sdir); Sequencers.SetDir(sdir);
- NEW(h); Views.SetMsgHook(h);
- NEW(f); Controllers.Register(f);
- NEW(r); Kernel.InstallReducer(r);
- NEW(a); NEW(w); a.wait := w; w.check := a; Services.DoLater(a, Services.immediately);
- NEW(ln); Dialog.RegisterLangNotifier(ln)
- END Init;
- BEGIN
- Init
- END Windows.
|