Copyright (C) 1994, Digital Equipment Corp. MODULE; IMPORT DPS, DPSWindow, Fmt, Err; PROCEDURE DisplayList NewBox (e: E; box: DPS.Box) =
Could just offer NewBoxToParent. This is convenient for subclassers.
VAR p: T; BEGIN p := e.parent; IF p # NIL THEN p.NewBoxOfChild (e, box); ELSE e.box := box; (* New box of root. Needs repaint? *) END; END NewBox; PROCEDURENewBoxToParent (e: E; box: DPS.Box) = VAR p: T; BEGIN p := e.parent; IF p # NIL THEN p.NewBoxOfChild (e, box); ELSE e.box := box; (* New box of root. Needs repaint? *) END; END NewBoxToParent; PROCEDURENewBoxOfChild (<*UNUSED*> t: T; e: E; box: DPS.Box) = VAR dirt: DPS.Box; BEGIN dirt := DPS.BoxUnion (e.box, box); e.box := box; e.Dirty (dirt, NIL); END NewBoxOfChild; PROCEDURERepaint (t: T; box: DPS.Box; only: REFANY): TEXT = VAR him, ret: TEXT := ""; VAR ee: E; BEGIN TYPECASE only OF NULL => ee := t.First(); WHILE ee # NIL DO him := ee.Repaint (box, only); IF him # NIL THEN ret := ret & him; END; ee := ee.Next(); END; | E(eeonly) => (* ee := t.First(); WHILE ee # NIL DO him := ee.Repaint (box, NIL); IF him # NIL THEN ret := ret & him; END; ee := ee.Next(); END; *) (* ret := eeonly.Repaint (box, only); *) ee := t.First(); WHILE ee # NIL DO IF ee = eeonly THEN RETURN ee.Repaint (box, only); END; ee := ee.Next(); END; (* If 'only' not child, have to traverse tree so ancestors can warp. *) ee := t.First(); WHILE ee # NIL DO him := ee.Repaint (box, only); IF him # NIL THEN ret := ret & him; END; ee := ee.Next(); END; ELSE Err.Msg ("Bad -only- in DisplayList.Repaint"); END; RETURN ret; END Repaint; PROCEDUREDirtyToWindow (r: R; box: DPS.Box; only: T := NIL) = BEGIN r.window.Dirty (box, only); END DirtyToWindow; PROCEDUREDirtyToParent (e: E; box: DPS.Box; only: T := NIL) = VAR p: T; BEGIN p := e.parent; IF p # NIL THEN p.Dirty(box, only); END; END DirtyToParent; PROCEDUREPostScriptToParent (e: E; script: TEXT) = VAR p: T; BEGIN p := e.parent; IF p # NIL THEN p.ImmediatePostScript(script); END; END PostScriptToParent; PROCEDUREPostScriptToWindow (r: R; script: TEXT) = <*FATAL DPS.BadPostScript*> VAR w: DPSWindow.T; BEGIN w := r.window; IF w # NIL THEN w.Send(script); END; END PostScriptToWindow; PROCEDUREMouse (t: T; window: DPSWindow.T; event: DPS.MouseEvent): BOOLEAN = VAR e: E; BEGIN e := t.Last(); WHILE e # NIL DO IF e.Mouse (window, event) THEN RETURN TRUE; END; e := e.Previous(); END; (* Used to kill input focus if no-one accepted mouse. *) RETURN FALSE; END Mouse; PROCEDURECharR (r: R; window: DPSWindow.T; char: CHAR): BOOLEAN = VAR e: E; BEGIN e := r.childWithInputFocus; IF e # NIL THEN RETURN e.Char (window, char); END; Err.Msg ("Discarded Char: ", Fmt.Int(ORD(char))); RETURN FALSE; END CharR; PROCEDURECharT (r: T; window: DPSWindow.T; char: CHAR): BOOLEAN = VAR e: E; BEGIN e := r.childWithInputFocus; IF e # NIL THEN RETURN e.Char (window, char); END; Err.Msg ("Discarded Char: ", Fmt.Int(ORD(char))); RETURN FALSE; END CharT; PROCEDUREKey (t: T; window: DPSWindow.T; event: DPS.KeyEvent) = VAR got: CHAR; VAR e: E; BEGIN got := DPS.CharFromKey (event.key, event.modifiers); IF got = '\000' THEN RETURN; END; e := t.Last(); WHILE e # NIL DO IF e.Char (window, got) THEN RETURN; END; e := e.Previous(); END; Err.Msg ("Ignored Keystroke = ",Fmt.Int(event.key)," = ",Fmt.Int(ORD(got))); END Key; PROCEDUREGetInputFocus (t: T; e: E := NIL) = VAR c: E; VAR p: T; BEGIN IF e = NIL THEN (* Start of a call. *) KillAnyInputFocusDownFromHere (t); END; IF e # NIL THEN (* Recursive, internal call. *) c := t.childWithInputFocus; (* IF c = e THEN RETURN; END; IF c # NIL THEN c.LoseInputFocus (); END; *) IF (c#e) AND (c#NIL) THEN c.LoseInputFocus (); END; t.childWithInputFocus := e; END; p := t.parent; IF p # NIL THEN p.GetInputFocus(t); END; IF e = NIL THEN (* Debugging. *) ForceInputFocusToHere (t); END; END GetInputFocus; PROCEDUREForceInputFocusToHere (e: E) = VAR parent: E; BEGIN e.childWithInputFocus := NIL; WHILE e.parent # NIL DO parent := e.parent; parent.childWithInputFocus := e; e := e.parent; END; END ForceInputFocusToHere; PROCEDUREKillAnyInputFocusDownFromHere (e: E) = VAR child: E; BEGIN IF e # NIL THEN child := e.childWithInputFocus; e.LoseInputFocus(); e.childWithInputFocus := NIL; (* In case he doesn't. *) KillAnyInputFocusDownFromHere (child); END; END KillAnyInputFocusDownFromHere; PROCEDURELoseInputFocus (<*UNUSED*> t: T) = BEGIN END LoseInputFocus; PROCEDUREKillInputFocus (t: T) = VAR e, ee: E; BEGIN e := t.childWithInputFocus; WHILE e # NIL DO ee := e.childWithInputFocus; e.LoseInputFocus(); (* Is it OK to work downward? *) e := ee; END; END KillInputFocus; BEGIN END DisplayList.