MODULE TextViews; (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Views.odc *) (* DO NOT EDIT *) (* could use +, $ in DrawLine cache implementation *) IMPORT Services, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Printing, Containers, TextModels, TextRulers, TextSetters; CONST (** v.DisplayMarks hide *) show* = FALSE; hide* = TRUE; (** v.ShowRange focusOnly **) any* = FALSE; focusOnly* = TRUE; parasign = 0B6X; (* paragraph sign, to mark non-ruler paragraph breaks *) mm = Ports.mm; inch16 = Ports.inch DIV 16; point = Ports.point; maxScrollHeight = 16 * point; maxScrollSteps = 100; fuseScrollHeight = maxScrollHeight DIV 2; maxHeight = maxScrollHeight * maxScrollSteps; adjustMask = {TextRulers.leftAdjust, TextRulers.rightAdjust}; (* SetOp.mode *) setMarks = 0; setSetter = 1; setDefs = 2; scrollingKey = "#System:Scrolling"; viewSettingKey = "#System:ViewSetting"; minVersion = 0; maxVersion = 0; maxStdVersion = 0; TYPE View* = POINTER TO ABSTRACT RECORD (Containers.View) END; Directory* = POINTER TO ABSTRACT RECORD defAttr-: TextModels.Attributes END; Location* = RECORD (** start of line and position of location **) start*, pos*: INTEGER; (** coordinates of location **) x*, y*: INTEGER; (** line dimensions at location **) asc*, dsc*: INTEGER; (** if view at location: **) view*: Views.View; l*, t*, r*, b*: INTEGER END; PositionMsg* = RECORD (Models.Message) focusOnly*: BOOLEAN; beg*, end*: INTEGER END; PageMsg* = RECORD (Properties.Message) current*: INTEGER END; Line = POINTER TO RECORD next: Line; start, asc, h: INTEGER; attr: TextRulers.Attributes; (* attr = box.ruler.style.attr *) box: TextSetters.LineBox (* caching of box.rpos not consistent *) END; StdView = POINTER TO RECORD (View) (* model *) text: TextModels.Model; org: INTEGER; dy: INTEGER; (* 0 <= dy < Height(first line) *) defRuler: TextRulers.Ruler; defAttr: TextModels.Attributes; hideMarks: BOOLEAN; (* general state *) cachedRd: TextSetters.Reader; (* line grid cache *) trailer: Line; (* trailer # NIL => trailer.eot, trailer.next # trailer *) bot: INTEGER; (* max(f : f seen by Restore : f.b) *) (* setter *) setter, setter0: TextSetters.Setter (* setter # setter0 lazily detects setter change *) END; StdDirectory = POINTER TO RECORD (Directory) END; ScrollOp = POINTER TO RECORD (Stores.Operation) v: StdView; org, dy: INTEGER; bunchOrg, bunchDy: INTEGER; bunch: BOOLEAN; (* bunch => bunchOrg, bunchDy valid *) silent: BOOLEAN (* original caller of Do(op) already handled situation *) END; SetOp = POINTER TO RECORD (Stores.Operation) mode: INTEGER; view: StdView; hideMarks: BOOLEAN; setter: TextSetters.Setter; defRuler: TextRulers.Ruler; defAttr: TextModels.Attributes END; FindAnyFrameMsg = RECORD (Views.Message) (* find frame with smallest height (frame.b - frame.t) that displays view; NIL if none found *) frame: Views.Frame (* OUT, initially NIL *) END; FindFocusFrameMsg = RECORD (Controllers.Message) (* find outermost focus frame displaying view; NIL if none found *) view: Views.View; (* IN *) frame: Views.Frame (* OUT, initially NIL *) END; VAR ctrlDir-: Containers.Directory; dir-, stdDir-: Directory; (* forward used in GetStart, UpdateView, ShowRangeIn *) PROCEDURE ^ DoSetOrigin (v: StdView; org, dy: INTEGER; silent: BOOLEAN); (** View **) PROCEDURE (v: View) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE; (** pre: ~v.init **) (** post: v.init **) VAR thisVersion: INTEGER; BEGIN (*v.Internalize^(rd);*) IF rd.cancelled THEN RETURN END; rd.ReadVersion(minVersion, maxVersion, thisVersion) END Internalize2; PROCEDURE (v: View) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE; (** pre: v.init **) BEGIN (*v.Externalize^(wr);*) wr.WriteVersion(maxVersion) END Externalize2; PROCEDURE (v: View) ThisModel* (): TextModels.Model, EXTENSIBLE; VAR m: Containers.Model; BEGIN m := v.ThisModel^(); IF m # NIL THEN RETURN m(TextModels.Model) ELSE RETURN NIL END END ThisModel; PROCEDURE (v: View) DisplayMarks* (hide: BOOLEAN), NEW, ABSTRACT; PROCEDURE (v: View) HidesMarks* (): BOOLEAN, NEW, ABSTRACT; PROCEDURE (v: View) SetSetter* (setter: TextSetters.Setter), NEW, ABSTRACT; PROCEDURE (v: View) ThisSetter* (): TextSetters.Setter, NEW, ABSTRACT; PROCEDURE (v: View) SetOrigin* (org, dy: INTEGER), NEW, ABSTRACT; (** post: org = ThisLine(org) => v.org = org, v.dy = dy; else v.org = ThisLine(org), v.dy = 0 **) PROCEDURE (v: View) PollOrigin* (OUT org, dy: INTEGER), NEW, ABSTRACT; PROCEDURE (v: View) SetDefaults* (r: TextRulers.Ruler; a: TextModels.Attributes), NEW, ABSTRACT; (** pre: r.init, a.init **) PROCEDURE (v: View) PollDefaults* (OUT r: TextRulers.Ruler; OUT a: TextModels.Attributes), NEW, ABSTRACT; PROCEDURE (v: View) GetThisLocation* (f: Views.Frame; pos: INTEGER; OUT loc: Location), NEW, ABSTRACT; PROCEDURE (v: View) GetRect* (f: Views.Frame; view: Views.View; OUT l, t, r, b: INTEGER); VAR con: Models.Context; loc: Location; pos: INTEGER; BEGIN con := view.context; ASSERT(con # NIL, 20); ASSERT(con.ThisModel() = v.ThisModel(), 21); pos := con(TextModels.Context).Pos(); v.GetThisLocation(f, pos, loc); IF loc.view = view THEN l := loc.l; t := loc.t; r := loc.r; b := loc.b ELSE l := MAX(INTEGER); t := MAX(INTEGER); r := l; b := t END END GetRect; PROCEDURE (v: View) GetRange* (f: Views.Frame; OUT beg, end: INTEGER), NEW, ABSTRACT; (** post: beg = beg of first visible line, end = end of last visible line **) PROCEDURE (v: View) ThisPos* (f: Views.Frame; x, y: INTEGER): INTEGER, NEW, ABSTRACT; PROCEDURE (v: View) ShowRangeIn* (f: Views.Frame; beg, end: INTEGER), NEW, ABSTRACT; PROCEDURE (v: View) ShowRange* (beg, end: INTEGER; focusOnly: BOOLEAN), NEW, ABSTRACT; (** post: in all frames (resp. in front or otherwise target frame if focusOnly): if possible, first visible pos <= k <= last visible pos, with k = beg if beg = end and beg <= k < end otherwise **) (** Directory **) PROCEDURE (d: Directory) Set* (defAttr: TextModels.Attributes), NEW, EXTENSIBLE; BEGIN ASSERT(defAttr # NIL, 20); ASSERT(defAttr.init, 21); d.defAttr := defAttr END Set; PROCEDURE (d: Directory) New* (text: TextModels.Model): View, NEW, ABSTRACT; (** miscellaneous **) PROCEDURE SetCtrlDir* (d: Containers.Directory); BEGIN ASSERT(d # NIL, 20); ctrlDir := d END SetCtrlDir; PROCEDURE SetDir* (d: Directory); BEGIN ASSERT(d # NIL, 20); dir := d END SetDir; PROCEDURE Focus* (): View; VAR v: Views.View; BEGIN v := Controllers.FocusView(); IF (v # NIL) & (v IS View) THEN RETURN v(View) ELSE RETURN NIL END END Focus; PROCEDURE FocusText* (): TextModels.Model; VAR v: View; BEGIN v := Focus(); IF v # NIL THEN RETURN v.ThisModel() ELSE RETURN NIL END END FocusText; PROCEDURE Deposit*; BEGIN Views.Deposit(dir.New(NIL)) END Deposit; PROCEDURE ShowRange* (text: TextModels.Model; beg, end: INTEGER; focusOnly: BOOLEAN); (** post: in all front or target frames displaying a view displaying t: if possible, first visible pos <= k <= last visible pos, with k = beg if beg = end and beg <= k < end otherwise **) VAR pm: PositionMsg; BEGIN ASSERT(text # NIL, 20); pm.beg := beg; pm.end := end; pm.focusOnly := focusOnly; Models.Broadcast(text, pm) END ShowRange; PROCEDURE ThisRuler* (v: View; pos: INTEGER): TextRulers.Ruler; VAR r: TextRulers.Ruler; a: TextModels.Attributes; rpos: INTEGER; BEGIN v.PollDefaults(r, a); rpos := -1; TextRulers.GetValidRuler(v.ThisModel(), pos, -1, r, rpos); RETURN r END ThisRuler; (* auxiliary procedures *) PROCEDURE GetReader (v: StdView; start: INTEGER; IN box: TextSetters.LineBox ): TextSetters.Reader; VAR st: TextSetters.Setter; rd: TextSetters.Reader; BEGIN ASSERT(box.ruler # NIL, 100); st := v.ThisSetter(); rd := v.cachedRd; v.cachedRd := NIL; (* reader recycling *) rd := st.NewReader(rd); rd.Set(rd.r, v.text, box.left, start, box.ruler, box.rpos, st.vw, st.hideMarks); RETURN rd END GetReader; PROCEDURE CacheReader (v: StdView; rd: TextSetters.Reader); BEGIN ASSERT(v.cachedRd = NIL, 20); v.cachedRd := rd END CacheReader; (* line descriptors *) PROCEDURE SetLineAsc (st: TextSetters.Setter; t: Line; dsc: INTEGER); (* pre: dsc: descender of previous line (-1 if first line) *) BEGIN t.asc := t.box.asc + st.GridOffset(dsc, t.box); t.h := t.asc + t.box.dsc END SetLineAsc; PROCEDURE NewLine (st: TextSetters.Setter; start, dsc: INTEGER): Line; (* pre: start: start of line to measure; dsc: descender of previous line (-1 if first line) *) VAR t: Line; BEGIN NEW(t); st.GetLine(start, t.box); t.start := start; SetLineAsc(st, t, dsc); t.attr := t.box.ruler.style.attr; RETURN t END NewLine; PROCEDURE AddLine (st: TextSetters.Setter; VAR t: Line; VAR start, y: INTEGER); BEGIN t.next := NewLine(st, start, t.box.dsc); t := t.next; INC(start, t.box.len); INC(y, t.h) END AddLine; PROCEDURE InitLines (v: StdView); VAR asc, dsc, w: INTEGER; t0, t: Line; start, y: INTEGER; BEGIN v.defAttr.font.GetBounds(asc, dsc, w); NEW(t0); start := v.org; y := v.dy; t0.box.dsc := -1; (* dsc = -1: trailer.next is first line *) t := t0; AddLine(v.ThisSetter(), t, start, y); t.next := t0; (* at least one valid line desc *) t0.start := start; t0.asc := asc; t0.h := asc + dsc; (* trailer.(asc, h) for caret display following last line *) t0.attr := NIL; t0.box.eot := TRUE; t0.box.len := 0; t0.box.ruler := NIL; t0.box.left := -1; (* make trailer async to every other line *) v.trailer := t0; v.bot := 0 END InitLines; PROCEDURE ExtendLines (v: StdView; bot: INTEGER); VAR st: TextSetters.Setter; t0, t: Line; start, y: INTEGER; BEGIN IF bot >= v.bot THEN t0 := v.trailer; start := t0.start; y := v.dy; t := t0; WHILE t.next # t0 DO t := t.next; INC(y, t.h) END; IF (y < bot) & ~t.box.eot THEN st := v.ThisSetter(); REPEAT AddLine(st, t, start, y) UNTIL (y >= bot) OR t.box.eot; t.next := t0; t0.start := start END; v.bot := bot END END ExtendLines; PROCEDURE ReduceLines (v: StdView; bot: INTEGER); VAR t0, t: Line; y: INTEGER; BEGIN IF bot <= v.bot THEN t0 := v.trailer; y := v.dy; t := t0; WHILE (t.next # t0) & (y < bot) DO t := t.next; INC(y, t.h) END; t0.start := t.next.start; t.next := t0; v.bot := bot END END ReduceLines; PROCEDURE ValidateLines (v: StdView; bot: INTEGER); VAR st: TextSetters.Setter; w, h, len: INTEGER; BEGIN IF v.setter # NIL THEN v.context.GetSize(w, h); (* possibly adapt to changed width *) IF v.setter.vw # w THEN v.setter0 := NIL; v.trailer := NIL END END; len := v.text.Length(); IF (v.org > len) OR (v.trailer # NIL) & (v.trailer.start > len) THEN v.trailer := NIL END; IF v.trailer = NIL THEN IF v.org > len THEN v.org := len END; st := v.ThisSetter(); v.org := st.ThisLine(v.org); InitLines(v) END; ExtendLines(v, bot) END ValidateLines; PROCEDURE PrependLines (v: StdView); VAR st: TextSetters.Setter; t0, t1, t: Line; start, y: INTEGER; BEGIN t0 := v.trailer; start := v.org; y := v.dy; IF t0.start # start THEN st := v.ThisSetter(); t := t0; t1 := t0.next; WHILE (t1.start # start) & (y < v.bot) DO AddLine(st, t, start, y) END; IF y >= v.bot THEN t.next := t0; t0.start := start ELSE t.next := t1; IF t1 # v.trailer THEN SetLineAsc(st, t1, t.box.dsc) END END END END PrependLines; (* update frame after insert/delete/replace *) PROCEDURE ThisViewLine (v: StdView; y: INTEGER): Line; (* pre: 0 <= y < v.bot *) VAR t: Line; py: INTEGER; BEGIN t := v.trailer.next; py := v.dy; WHILE ~t.box.eot & (py + t.h < y) DO INC(py, t.h); t := t.next END; RETURN t END ThisViewLine; PROCEDURE LocateThisLine (v: StdView; start: INTEGER; OUT t: Line; OUT y: INTEGER); VAR t1: Line; BEGIN t := v.trailer.next; y := v.dy; t1 := v.trailer.next; WHILE t.start # start DO INC(y, t.h); t := t.next; ASSERT(t # t1, 100) END END LocateThisLine; PROCEDURE GetStart (st: TextSetters.Setter; v: StdView; beg: INTEGER; OUT start: INTEGER); (* find start of line containing beg after text change; tuned using valid line descs *) VAR s, t: Line; BEGIN s := v.trailer; t := s.next; WHILE (t # v.trailer) & (t.start + t.box.len < beg) DO s := t; t := s.next END; IF s # v.trailer THEN (* at least first line desc possibly still valid *) start := st.NextLine(s.start); (* NextLine can be much cheaper than ThisLine *) IF start # t.start THEN GetStart(st, v, s.start, start) ELSIF ~t.box.eot & (start + t.box.len = beg) & (st.NextLine(start) = beg) THEN start := beg END ELSE IF v.org <= v.text.Length() THEN start := st.ThisLine(v.org) ELSE start := st.ThisLine(v.text.Length()) END; IF start < v.org THEN DoSetOrigin(v, start, 0, TRUE) ELSIF start > v.org THEN start := v.org END END END GetStart; PROCEDURE GetStringStart (v: StdView; t: Line; pos: INTEGER; OUT p1, x: INTEGER); VAR rd: TextSetters.Reader; BEGIN p1 := t.start; x := t.box.left; IF t.box.views THEN rd := GetReader(v, p1, t.box); rd.Read; WHILE ~rd.eot & (rd.pos <= pos) DO rd.AdjustWidth(t.start, p1, t.box, rd.w); INC(rd.x, rd.w); IF rd.view # NIL THEN p1 := rd.pos; x := rd.x END; rd.Read END; CacheReader(v, rd) END END GetStringStart; PROCEDURE InSynch (t0, t1: Line): BOOLEAN; BEGIN RETURN (t0.start = t1.start) & (t0.asc = t1.asc) & (t0.attr = t1.attr) & (t0.box.left = t1.box.left) & (t0.box.asc = t1.box.asc) & (t0.box.dsc = t1.box.dsc) & (t0.box.rbox = t1.box.rbox) & (t0.box.bop = t1.box.bop) END InSynch; PROCEDURE RebuildView (v: StdView); BEGIN v.setter0 := NIL; IF v.trailer # NIL THEN v.trailer := NIL; v.bot := 0; Views.Update(v, Views.rebuildFrames) END END RebuildView; PROCEDURE UpdateIn (v: StdView; l, t, b: INTEGER); BEGIN Views.UpdateIn(v, l, t, MAX(INTEGER), b, Views.rebuildFrames) END UpdateIn; PROCEDURE UpdateFrames (v: StdView; t0, t1, u: Line; beg, y0, yu: INTEGER); VAR t, te: Line; b, x, b0, b1, top, bot: INTEGER; BEGIN IF ((beg < t0.next.start) OR t0.box.eot) & ~t0.box.adj & ((beg < t1.next.start) OR t1.box.eot) & ~t1.box.adj & InSynch(t0, t1) THEN GetStringStart(v, t1, beg, beg, x) ELSE beg := t1.start END; b := y0; t := t0; WHILE t # u DO INC(b, t.h); t := t.next END; IF b = yu THEN te := u ELSE (* t = u *) te := v.trailer; b0 := b; WHILE t # v.trailer DO INC(b0, t.h); t := t.next END; IF yu < b THEN ExtendLines(v, v.bot) ELSE ReduceLines(v, v.bot) END; b1 := y0; t := t1; WHILE t # v.trailer DO INC(b1, t.h); t := t.next END; IF b1 < b0 THEN UpdateIn(v, 0, b1, b0) END (* erase trailer *) END; IF t1.start < beg THEN (* conserve head of t1 *) UpdateIn(v, x, y0, y0 + t1.h); (* redraw tail of t1 *) top := y0 + t1.h ELSE top := y0 END; bot := y0; REPEAT INC(bot, t1.h); t1 := t1.next UNTIL t1 = te; IF top < bot THEN UpdateIn(v, 0, top, bot) END (* redraw affected lines *) END UpdateFrames; PROCEDURE UpdateView (v: StdView; beg, end, delta: INTEGER); VAR st: TextSetters.Setter; r: TextRulers.Ruler; rpos: INTEGER; s0, t0, t, tn, u: Line; start, y, y0: INTEGER; BEGIN IF v.trailer # NIL THEN v.setter0 := NIL; st := v.ThisSetter(); IF (beg <= v.trailer.start) & ((end >= v.org) OR (end - delta >= v.org)) THEN GetStart(st, v, beg, start); y0 := v.dy; s0 := v.trailer; WHILE s0.next.start < start DO s0 := s0.next; INC(y0, s0.h) END; t := s0.next; WHILE (t # v.trailer) & (t.start < end) DO t := t.next END; IF (t = v.trailer.next) & (t.start >= end) THEN REPEAT INC(t.start, delta); IF t.box.rpos >= end THEN INC(t.box.rpos, delta) END; t := t.next UNTIL t = v.trailer.next ELSE WHILE (t # v.trailer.next) & (t.start >= end) DO INC(t.start, delta); IF t.box.rpos >= end THEN INC(t.box.rpos, delta) END; t := t.next END END; tn := s0; y := y0; t0 := s0.next; u := t0; REPEAT t := tn; AddLine(st, tn, start, y); (* start = end(tn), y = bot(tn) *) WHILE (u # v.trailer) & (u.start < tn.start) DO u := u.next END UNTIL tn.box.eot OR (y > v.bot) OR (tn.start >= end) & (u.start = tn.start) & (u.box.len = tn.box.len) & (u.asc = tn.asc) & (u.attr = tn.attr) & (u.box.dsc = tn.box.dsc) & (u.box.rpos = tn.box.rpos); (* can be expensive ... *) IF tn.box.eot OR (y > v.bot) THEN t := tn; u := v.trailer; v.trailer.start := start ELSE DEC(y, tn.h) END; t.next := u; IF (s0 # v.trailer) & (s0.next # v.trailer) THEN s0.box.eot := FALSE END; ASSERT(v.trailer.start <= v.text.Length(), 100); UpdateFrames(v, t0, s0.next, u, beg, y0, y) ELSIF end <= v.org THEN INC(v.org, delta); (* IF end < v.org - delta - 500 THEN start := v.org ELSE start := st.ThisLine(v.org) END; (* this is not safe; even a change 500 characters away could force the view's origin to a new position in order to maintain the invariant that the origin always falls on a line start; however, ThisLine can be quite expensive -- can we rely on TextSetters cache ? *) *) start := st.ThisLine(v.org); r := v.defRuler; rpos := -1; TextRulers.GetValidRuler(v.text, start, -1, r, rpos); IF (v.org = start) & (v.trailer.next.attr = r.style.attr) THEN t := v.trailer; REPEAT t := t.next; INC(t.start, delta); IF t.box.rpos < start THEN t.box.rpos := rpos ELSE INC(t.box.rpos, delta) END UNTIL t = v.trailer ELSE DoSetOrigin(v, start, 0, TRUE); RebuildView(v) END END END END UpdateView; PROCEDURE StyleUpdate (v: StdView; oldAttr: TextRulers.Attributes); VAR t: Line; beg: INTEGER; first: BOOLEAN; BEGIN IF v.trailer # NIL THEN t := v.trailer.next; first := TRUE; WHILE t # v.trailer DO WHILE (t # v.trailer) & (t.attr # oldAttr) DO t := t.next END; IF t # v.trailer THEN IF first THEN v.Neutralize; first := FALSE END; beg := t.start; t := t.next; WHILE (t # v.trailer) & (t.attr = oldAttr) DO t := t.next END; UpdateView(v, beg, t.start, 0) END END END END StyleUpdate; (* line drawing *) PROCEDURE DrawLine (v: StdView; start: INTEGER; IN box: TextSetters.LineBox; f: Views.Frame; l, r, y, t: INTEGER; pageF: BOOLEAN ); (* pre: area cleared *) (* [l,r) for high-level clipping to tune update after small change *) CONST cacheLen = 128; VAR rd: TextSetters.Reader; ra: TextRulers.Attributes; v1: Views.View; c: Containers.Controller; py, end, skip: INTEGER; cache: RECORD (* initially: long = TRUE, len = 0 *) x, y: INTEGER; color: Ports.Color; font: Fonts.Font; len: INTEGER; buf: ARRAY cacheLen OF CHAR END; PROCEDURE FlushCaches; BEGIN IF cache.len > 0 THEN cache.buf[cache.len] := 0X; f.DrawString(cache.x, cache.y, cache.color, cache.buf, cache.font) END; cache.len := 0 END FlushCaches; PROCEDURE CacheString (x, y: INTEGER; c: INTEGER; IN s: ARRAY OF CHAR; f: Fonts.Font ); VAR i, j, len: INTEGER; BEGIN len := 0; WHILE s[len] # 0X DO INC(len) END; IF (cache.len + len >= cacheLen) OR (cache.y # y) OR (cache.color # c) OR (cache.font # f) THEN FlushCaches END; ASSERT(cache.len + len < cacheLen, 100); IF cache.len = 0 THEN cache.x := x; cache.y := y; cache.color := c; cache.font := f END; i := 0; j := cache.len; WHILE i < len DO cache.buf[j] := s[i]; INC(i); INC(j) END; cache.len := j END CacheString; (* PROCEDURE CacheString (x, y: INTEGER; c: INTEGER; IN s: ARRAY OF CHAR; f: Fonts.Font ); VAR i, j, len: INTEGER; BEGIN (* flush first, then promote *) len := 0; WHILE s[len] # 0X DO INC(len) END; IF (cache.len + len >= cacheLen) OR (cache.y # y) OR (cache.color # c) OR (cache.font # f) THEN FlushCaches END; IF (cache.len > 0) & cache.short THEN (* promote short chars to chars *) i := 0; WHILE i < cache.len DO cache.buf[i] := cache.sbuf[i]; INC(i) END END; cache.short := FALSE; ASSERT(cache.len + len < cacheLen, 100); IF cache.len = 0 THEN cache.x := x; cache.y := y; cache.color := c; cache.font := f END; i := 0; j := cache.len; WHILE i < len DO cache.buf[j] := s[i]; INC(i); INC(j) END; cache.len := j END CacheString; *) BEGIN IF box.len > 0 THEN cache.len := 0; end := start + box.len; skip := start + box.skipOff; rd := GetReader(v, start, box); rd.Read; WHILE ~rd.eot & (rd.pos <= end) & (rd.x < r) DO IF rd.pos > skip THEN rd.w := rd.endW END; rd.AdjustWidth(start, rd.pos, box, rd.w); IF rd.x + rd.w > l THEN v1 := rd.view; IF v1 # NIL THEN FlushCaches; IF ~((TextModels.hideable IN rd.textOpts) & v.hideMarks) THEN c := v.ThisController(); Views.InstallFrame(f, v1, rd.x, y - rd.attr.offset + rd.dsc - rd.h, 0, (c # NIL) & (v1 = c.ThisFocus()) ) END ELSIF (rd.h > 0) & (rd.w > 0) THEN IF box.rbox & ~v.hideMarks THEN rd.string[0] := parasign END; (* ¶ sign *) py := y - rd.attr.offset; IF rd.string[0] > " " THEN CacheString(rd.x, py, rd.attr.color, rd.string, rd.attr.font); IF ~v.hideMarks & (TextModels.hideable IN rd.textOpts) THEN f.DrawRect(rd.x, py - box.asc + f.dot, MIN(rd.x + rd.w, f.r), py + box.dsc - f.dot, 0, Ports.grey25) END ELSIF rd.string[0] # 0X THEN FlushCaches; IF ~v.hideMarks & (TextModels.hideable IN rd.textOpts) THEN f.DrawRect(rd.x, py - box.asc + f.dot, rd.x + rd.w, py + box.dsc - f.dot, 0, Ports.grey25) END ELSE FlushCaches END END END; INC(rd.x, rd.w); rd.Read END; FlushCaches; CacheReader(v, rd) END; IF v.hideMarks & ~pageF THEN ra := box.ruler.style.attr; IF TextRulers.pageBreak IN ra.opts THEN IF (box.rpos = start) & (ra.lead >= f.dot) THEN f.DrawLine(l, t, r - f.dot, t, 0, Ports.grey50) ELSIF (box.rpos = start - 1) & (ra.lead < f.dot) THEN f.DrawLine(l, t, r - f.dot, t, 0, Ports.grey50) END END END END DrawLine; PROCEDURE DrawDecorations (v: StdView; u: Line; f: Views.Frame; l, t, r, b: INTEGER); VAR a: TextRulers.Attributes; i, x: INTEGER; col: Ports.Color; st: TextSetters.Setter; srd: TextSetters.Reader; rd: TextModels.Reader; BEGIN IF t < b THEN i := 0; a := u.attr; srd := NIL; WHILE i < a.tabs.len DO IF TextRulers.barTab IN a.tabs.tab[i].type THEN x := a.tabs.tab[i].stop; IF (l <= x) & (x < r) THEN IF u.box.rpos = -1 THEN col := v.defAttr.color ELSIF srd = NIL THEN st := v.ThisSetter(); srd := v.cachedRd; v.cachedRd := NIL; srd := st.NewReader(srd); srd.Set(srd.r, v.text, 0, 0, v.defRuler, 0, st.vw, st.hideMarks); rd := srd.r; rd.SetPos(u.box.rpos); rd.Read; col := rd.attr.color END; f.DrawLine(x, t, x, b - f.dot, 0, col) END END; INC(i) END; IF srd # NIL THEN CacheReader(v, srd) END END END DrawDecorations; (* focus-message handling *) PROCEDURE PollSection (v: StdView; f: Views.Frame; VAR msg: Controllers.PollSectionMsg); CONST ms = maxScrollSteps; mh = maxScrollHeight; VAR t: Line; steps, step: INTEGER; BEGIN IF msg.vertical THEN ValidateLines(v, f.b); t := v.trailer.next; IF t.h > 0 THEN steps := -((-t.h) DIV mh); step := -(v.dy DIV mh) ELSE steps := 1; step := 0 END; msg.wholeSize := v.text.Length() * ms; msg.partPos := v.org * ms + t.box.len * ms * step DIV steps; msg.partSize := 0; msg.valid := (v.org > 0) OR (t.h > mh) OR (t.next # v.trailer); msg.done := TRUE END END PollSection; PROCEDURE Scroll (v: StdView; f: Views.Frame; VAR msg: Controllers.ScrollMsg); VAR st: TextSetters.Setter; box, box0: TextSetters.LineBox; t, t1, trailer: Line; org, len, dy, h, h1, sh, steps, step: INTEGER; poll: Controllers.PollSectionMsg; BEGIN IF msg.vertical THEN poll.vertical := TRUE; PollSection(v, f, poll) END; IF msg.vertical & poll.valid THEN org := v.org; dy := v.dy; st := v.ThisSetter(); trailer := v.trailer; CASE msg.op OF Controllers.decLine: IF dy <= -(maxScrollHeight + fuseScrollHeight) THEN INC(dy, maxScrollHeight) ELSIF dy < 0 THEN dy := 0 ELSIF org > 0 THEN org := st.PreviousLine(org); st.GetLine(org, box); h1 := box.asc + box.dsc + st.GridOffset(-1, box); IF h1 > maxScrollHeight + fuseScrollHeight THEN sh := h1 - h1 MOD maxScrollHeight; IF h1 - sh < fuseScrollHeight THEN DEC(sh, maxScrollHeight) END; dy := -sh ELSE dy := 0 END END | Controllers.incLine: t := trailer.next; IF t.h + dy > maxScrollHeight + fuseScrollHeight THEN DEC(dy, maxScrollHeight) ELSIF ~t.box.eot THEN org := t.next.start; dy := 0 END | Controllers.decPage: sh := f.b; DEC(sh, maxScrollHeight + sh MOD maxScrollHeight); IF dy <= -(sh + fuseScrollHeight) THEN INC(dy, sh) ELSE t := trailer.next; h := maxScrollHeight - dy; IF t.h < h THEN h := t.h END; box0 := t.box; h1:= h - st.GridOffset(-1, box0); WHILE (org > 0) & (h + fuseScrollHeight < f.b) DO org := st.PreviousLine(org); st.GetLine(org, box); h1 := box.asc + box.dsc; INC(h, h1 + st.GridOffset(box.dsc, box0)); box0 := box END; h1 := h1 + st.GridOffset(-1, box0); sh := h1 - (h - f.b); DEC(sh, sh MOD maxScrollHeight); IF h1 - sh >= fuseScrollHeight THEN dy := -sh ELSE dy := 0 END END; IF (org > v.org) OR (org = v.org) & (dy <= v.dy) THEN (* guarantee progress *) org := st.PreviousLine(org); st.GetLine(org, box); h1 := box.asc + box.dsc + st.GridOffset(-1, box); IF h1 > maxScrollHeight + fuseScrollHeight THEN dy := - (h1 DIV maxScrollHeight * maxScrollHeight) ELSE dy := 0 END END | Controllers.incPage: t := trailer.next; sh := f.b; DEC(sh, maxScrollHeight + sh MOD maxScrollHeight); IF t.h + dy > sh + fuseScrollHeight THEN DEC(dy, sh) ELSE t := ThisViewLine(v, f.b); LocateThisLine(v, t.start, t1, h); IF (h + t.h >= f.b) & (t.h <= maxScrollHeight) THEN org := st.PreviousLine(t.start) ELSE org := t.start END; IF h + t.h - f.b > maxScrollHeight THEN sh := f.b - h; DEC(sh, maxScrollHeight + sh MOD maxScrollHeight); IF sh >= fuseScrollHeight THEN dy := -sh ELSE dy := 0 END ELSE dy := 0 END END; IF (org < v.org) OR (org = v.org) & (dy >= v.dy) THEN (* guarantee progress *) IF t.h + dy > maxScrollHeight + fuseScrollHeight THEN DEC(dy, maxScrollHeight) ELSE org := t.next.start; dy := 0 END END | Controllers.gotoPos: org := st.ThisLine(msg.pos DIV maxScrollSteps); st.GetLine(org, box); sh := box.asc + box.dsc + st.GridOffset(-1, box); steps := -((-sh) DIV maxScrollHeight); IF (steps > 0) & (box.len > 0) THEN step := steps * (msg.pos - org * maxScrollSteps) DIV (maxScrollSteps * box.len); (* step := steps * (msg.pos MOD maxScrollSteps) DIV maxScrollSteps; *) dy := -(step * maxScrollHeight) ELSE dy := 0 END ELSE END; len := v.text.Length(); IF org > len THEN org := len; dy := 0 END; v.SetOrigin(org, dy); msg.done := TRUE END END Scroll; PROCEDURE NotifyViewsOnPage (v: StdView; beg, end, pageNo: INTEGER); VAR st: TextSetters.Setter; rd: TextSetters.Reader; r: TextModels.Reader; view: Views.View; current: INTEGER; page: PageMsg; BEGIN IF pageNo >= 0 THEN current := pageNo ELSIF Printing.par # NIL THEN current := Printing.Current() (* Printing.par.page.current *) + 1 ELSE current := -1 END; IF current >= 0 THEN st := v.ThisSetter(); rd := v.cachedRd; v.cachedRd := NIL; (* reader recycling *) rd := st.NewReader(rd); rd.Set(rd.r, v.text, 0, 0, v.defRuler, 0, st.vw, st.hideMarks); r := rd.r; r.SetPos(beg); r.ReadView(view); WHILE (r.Pos() <= end) & ~r.eot DO page.current := current; Views.HandlePropMsg(view, page); r.ReadView(view) END; CacheReader(v, rd) END END NotifyViewsOnPage; PROCEDURE Page (v: StdView; pageH: INTEGER; op, pageY: INTEGER; OUT done, eoy: BOOLEAN); VAR st: TextSetters.Setter; org, prev, page: INTEGER; BEGIN IF ~v.hideMarks & ((v.context = NIL) OR v.context.Normalize()) THEN v.DisplayMarks(hide) END; st := v.ThisSetter(); IF op = Controllers.nextPageY THEN done := TRUE; org := st.NextPage(pageH, v.org); eoy := (org = v.text.Length()); IF ~eoy THEN NotifyViewsOnPage(v, org, st.NextPage(pageH, org), -1) END ELSIF op = Controllers.gotoPageY THEN ASSERT(pageY >= 0, 20); done := TRUE; org := 0; eoy := FALSE; page := 0; WHILE (page < pageY) & ~eoy DO prev := org; org := st.NextPage(pageH, org); eoy := org = prev; IF ~eoy THEN NotifyViewsOnPage(v, prev, org, page) END; INC(page) END; IF ~eoy THEN NotifyViewsOnPage(v, org, st.NextPage(pageH, org), page) END ELSE done := FALSE END; IF done & ~eoy THEN v.org := org; v.dy := 0; v.trailer := NIL; v.bot := 0 END END Page; PROCEDURE ShowAdjusted (v: StdView; shift: INTEGER; rebuild: BOOLEAN); BEGIN IF shift # 0 THEN Views.Scroll(v, 0, shift) ELSIF rebuild THEN UpdateIn(v, 0, 0, MAX(INTEGER)) END; Views.RestoreDomain(v.Domain()) END ShowAdjusted; PROCEDURE AdjustLines (v: StdView; org, dy: INTEGER; OUT shift: INTEGER; OUT rebuild: BOOLEAN ); (* post: shift = 0 OR ~rebuild *) VAR d: Stores.Domain; c: Containers.Controller; t, t0, t1: Line; org0, dy0, y: INTEGER; BEGIN d := v.Domain(); t0 := v.trailer; org0 := v.org; rebuild := FALSE; shift := 0; IF (d # NIL) & ((org # org0) OR (dy # v.dy)) THEN Views.RestoreDomain(d); (* make sure that pixels are up-to-date before scrolling *) c := v.ThisController(); IF c # NIL THEN Containers.FadeMarks(c, Containers.hide) (* fade marks with overhang *) END END; IF (t0 # NIL) & (org = org0) & (dy # v.dy) THEN (* sub-line shift *) shift := dy - v.dy; ELSIF (t0 # NIL) & (org > org0) & (org < t0.start) THEN (* shift up *) LocateThisLine(v, org, t, y); t0.next := t; shift := dy - y ELSIF (t0 # NIL) & (org < org0) THEN (* shift down *) t1 := t0.next; dy0 := v.dy + t1.asc; v.org := org; v.dy := dy; IF t1.start = org0 THEN (* new lines need to be prepended *) PrependLines(v) (* may change t1.asc *) END; ASSERT(t0.next.start = org, 100); IF org0 < t0.start THEN (* former top still visible -> shift down *) LocateThisLine(v, org0, t, y); shift := y - (dy0 - t1.asc) ELSE (* rebuild all *) rebuild := TRUE END ELSIF (t0 = NIL) OR (org # org0) OR (dy # v.dy) THEN (* rebuild all *) rebuild := TRUE END; v.org := org; v.dy := dy; IF rebuild THEN (* rebuild all *) v.trailer := NIL; ValidateLines(v, v.bot) ELSIF shift < 0 THEN (* shift up *) INC(v.bot, shift); ExtendLines(v, v.bot - shift) ELSIF shift > 0 THEN (* shift down *) INC(v.bot, shift); ReduceLines(v, v.bot - shift) END END AdjustLines; PROCEDURE Limit (v: StdView; bot: INTEGER; allLines: BOOLEAN): INTEGER; CONST minH = 12 * point; VAR s, t: Line; pos, y: INTEGER; BEGIN s := v.trailer.next; t := s; y := v.dy; WHILE ~t.box.eot & (y + t.h <= bot) DO INC(y, t.h); s := t; t := t.next END; IF ~allLines & (bot - y < t.h) & (bot - y < minH) THEN t := s END; pos := t.start + t.box.len; (* IF t.box.eot THEN INC(pos) END; *) RETURN pos END Limit; (* ScrollOp *) PROCEDURE (op: ScrollOp) Do; VAR org0, dy0, org, dy, shift: INTEGER; rebuild: BOOLEAN; BEGIN IF op.bunch THEN org := op.bunchOrg; dy := op.bunchDy ELSE org := op.org; dy := op.dy END; org0 := op.v.org; dy0 := op.v.dy; IF op.silent THEN op.v.org := org; op.v.dy := dy; op.silent := FALSE ELSE AdjustLines(op.v, org, dy, shift, rebuild); ShowAdjusted(op.v, shift, rebuild) END; IF op.bunch THEN op.bunch := FALSE ELSE op.org := org0; op.dy := dy0 END END Do; PROCEDURE DoSetOrigin (v: StdView; org, dy: INTEGER; silent: BOOLEAN); (* pre: org = v.ThisSetter().ThisLine(org) *) VAR con: Models.Context; last: Stores.Operation; op: ScrollOp; shift: INTEGER; rebuild: BOOLEAN; BEGIN IF (org # v.org) OR (dy # v.dy) THEN con := v.context; IF con # NIL THEN IF (v.Domain() = NIL) OR con.Normalize() THEN IF silent THEN v.org := org; v.dy := dy ELSE AdjustLines(v, org, dy, shift, rebuild); ShowAdjusted(v, shift, rebuild) END ELSE last := Views.LastOp(v); IF (last # NIL) & (last IS ScrollOp) THEN op := last(ScrollOp); op.bunch := TRUE; op.bunchOrg := org; op.bunchDy := dy; op.silent := silent; Views.Bunch(v) ELSE NEW(op); op.v := v; op.org := org; op.dy := dy; op.bunch := FALSE; op.silent := silent; Views.Do(v, scrollingKey, op) END END ELSE v.org := org; v.dy := dy END END END DoSetOrigin; (* SetOp *) PROCEDURE (op: SetOp) Do; VAR v: StdView; m: BOOLEAN; a: TextModels.Attributes; r: TextRulers.Ruler; s: TextSetters.Setter; BEGIN v := op.view; CASE op.mode OF setMarks: m := v.hideMarks; v.hideMarks := op.hideMarks; op.hideMarks := m | setSetter: s := v.setter; IF s # NIL THEN s.ConnectTo(NIL, NIL, 0, FALSE) END; v.setter := op.setter; op.setter := s | setDefs: r := v.defRuler; a := v.defAttr; v.defRuler := op.defRuler; v.defAttr := op.defAttr; op.defRuler := r; op.defAttr := a; (* IF (v.defAttr.Domain() # NIL) & (v.defAttr.Domain() # v.Domain()) THEN v.defAttr := Stores.CopyOf(v.defAttr)(TextModels.Attributes) END; Stores.Join(v, v.defAttr); *) IF v.defAttr # NIL THEN (* could be for undo operations *) IF ~Stores.Joined(v, v.defAttr) THEN IF ~Stores.Unattached(v.defAttr) THEN v.defAttr := Stores.CopyOf(v.defAttr)(TextModels.Attributes) END; Stores.Join(v, v.defAttr) END; END; IF v.defRuler # NIL THEN Stores.Join(v, v.defRuler) END; END; RebuildView(v) END Do; PROCEDURE DoSet (op: SetOp; mode: INTEGER; v: StdView); BEGIN op.mode := mode; op.view := v; Views.Do(v, viewSettingKey, op) END DoSet; (* StdView *) PROCEDURE (v: StdView) Internalize2 (VAR rd: Stores.Reader); VAR st: Stores.Store; r: TextRulers.Ruler; a: TextModels.Attributes; org, dy: INTEGER; thisVersion: INTEGER; hideMarks: BOOLEAN; BEGIN v.Internalize2^(rd); IF rd.cancelled THEN RETURN END; rd.ReadVersion(minVersion, maxStdVersion, thisVersion); IF rd.cancelled THEN RETURN END; rd.ReadBool(hideMarks); rd.ReadStore(st); ASSERT(st # NIL, 100); IF ~(st IS TextRulers.Ruler) THEN rd.TurnIntoAlien(Stores.alienComponent); Stores.Report("#Text:AlienDefaultRuler", "", "", ""); RETURN END; r := st(TextRulers.Ruler); TextModels.ReadAttr(rd, a); rd.ReadInt(org); rd.ReadInt(dy); v.DisplayMarks(hideMarks); v.setter := TextSetters.dir.New(); v.setter0 := NIL; v.SetDefaults(r, a); v.SetOrigin(org, dy); v.trailer := NIL; v.bot := 0 END Internalize2; PROCEDURE (v: StdView) Externalize2 (VAR wr: Stores.Writer); VAR org, dy: INTEGER; hideMarks: BOOLEAN; a: Stores.Store; BEGIN v.Externalize2^(wr); IF (v.context = NIL) OR v.context.Normalize() THEN org := 0; dy := 0; hideMarks := TRUE ELSE org := v.org; dy := v.dy; hideMarks := v.hideMarks END; wr.WriteVersion(maxStdVersion); wr.WriteBool(hideMarks); a := Stores.CopyOf(v.defAttr); (*Stores.InitDomain(a, v.Domain());*) Stores.Join(v, a); (* bkwd-comp hack: avoid link => so that pre release 1.3 Internalize can still read texts *) wr.WriteStore(v.defRuler); wr.WriteStore(a); wr.WriteInt(org); wr.WriteInt(dy) END Externalize2; PROCEDURE (v: StdView) CopyFromModelView2 (source: Views.View; model: Models.Model); VAR s: TextSetters.Setter; r: TextRulers.Ruler; BEGIN (* v.CopyFromModelView^(source, model); *) WITH source: StdView DO s := Stores.CopyOf(source.setter)(TextSetters.Setter); v.setter := s; v.setter0 := NIL; r := TextRulers.CopyOf(source.defRuler, Views.deep); v.DisplayMarks(source.HidesMarks()); v.SetDefaults(r, source.defAttr); v.trailer := NIL; v.bot := 0; IF v.text = source.text THEN v.org := source.org; v.dy := source.dy END END END CopyFromModelView2; PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER); VAR st: TextSetters.Setter; u0, u: Line; y0, y, w, h: INTEGER; end: INTEGER; pageF: BOOLEAN; BEGIN ASSERT(v.context # NIL, 20); IF v.setter # NIL THEN v.context.GetSize(w, h) END; IF (v.setter = NIL) OR (v.setter.vw # w) THEN Views.RemoveFrames(f, l, t, r, b) END; ValidateLines(v, b); u := v.trailer.next; y := v.dy; pageF := Views.IsPrinterFrame(f) & v.context.Normalize(); IF pageF THEN (* on page-formatted frames do not display truncated lines at bottom *) st := v.ThisSetter(); end := st.NextPage(f.b - f.t, v.org) END; WHILE (u # v.trailer) & (y + u.h <= t) DO INC(y, u.h); u := u.next END; y0 := y; u0 := u; IF (u = v.trailer.next) & (y < b) THEN (* at least one line per page *) ASSERT((u.box.len > 0) OR u.box.eot OR (u.next = v.trailer), 100); DrawLine(v, u.start, u.box, f, l, r, y + u.asc, y + u.h - u.box.dsc - u.box.asc, pageF); INC(y, u.h); u := u.next END; WHILE (u # v.trailer) & (y < b) & (~pageF OR (u.start < end)) DO ASSERT((u.box.len > 0) OR u.box.eot OR (u.next = v.trailer), 101); IF u.box.ruler # u0.box.ruler THEN DrawDecorations(v, u0, f, l, y0, r, y); u0 := u; y0 := y END; DrawLine(v, u.start, u.box, f, l, r, y + u.asc, y + u.h - u.box.dsc - u.box.asc, pageF); INC(y, u.h); u := u.next END; IF y0 # y THEN DrawDecorations(v, u0, f, l, y0, r, y) END END Restore; PROCEDURE (v: StdView) DisplayMarks (hide: BOOLEAN); VAR op: SetOp; c: Containers.Controller; BEGIN IF v.hideMarks # hide THEN c := v.ThisController(); IF c # NIL THEN Containers.FadeMarks(c, Containers.hide) END; IF (v.context # NIL) & ~v.context.Normalize() THEN NEW(op); op.hideMarks := hide; DoSet(op, setMarks, v) ELSE v.hideMarks := hide; RebuildView(v) END END END DisplayMarks; PROCEDURE (v: StdView) HidesMarks (): BOOLEAN; BEGIN RETURN v.hideMarks END HidesMarks; PROCEDURE (v: StdView) SetSetter (setter: TextSetters.Setter); VAR op: SetOp; BEGIN ASSERT(setter # NIL, 20); IF v.setter # setter THEN IF v.setter # NIL THEN NEW(op); op.setter := setter; DoSet(op, setSetter, v) ELSE v.setter := setter END END END SetSetter; PROCEDURE (v: StdView) ThisSetter (): TextSetters.Setter; VAR st: TextSetters.Setter; w, h: INTEGER; BEGIN st := v.setter; ASSERT(st # NIL, 20); IF st # v.setter0 THEN IF v.context # NIL THEN v.context.GetSize(w, h) ELSE IF Dialog.metricSystem THEN w := 165*mm ELSE w := 104*inch16 END END; st.ConnectTo(v.text, v.defRuler, w, v.hideMarks); v.setter0 := st END; RETURN st END ThisSetter; PROCEDURE (d: StdView) AcceptableModel (m: Containers.Model): BOOLEAN; BEGIN RETURN m IS TextModels.Model END AcceptableModel; PROCEDURE (v: StdView) InitModel2 (m: Containers.Model); BEGIN ASSERT(m IS TextModels.Model, 23); v.text := m(TextModels.Model) END InitModel2; PROCEDURE (v: StdView) SetOrigin (org, dy: INTEGER); VAR st: TextSetters.Setter; start: INTEGER; BEGIN ASSERT(v.text # NIL, 20); st := v.ThisSetter(); start := st.ThisLine(org); IF start # org THEN org := start; dy := 0 END; DoSetOrigin(v, org, dy, FALSE) END SetOrigin; PROCEDURE (v: StdView) PollOrigin (OUT org, dy: INTEGER); BEGIN org := v.org; dy := v.dy END PollOrigin; PROCEDURE (v: StdView) SetDefaults (r: TextRulers.Ruler; a: TextModels.Attributes); VAR op: SetOp; BEGIN ASSERT(r # NIL, 20); ASSERT(r.style.attr.init, 21); ASSERT(a # NIL, 22); ASSERT(a.init, 23); IF (v.defRuler # r) OR (v.defAttr # a) THEN (* (*IF (v.context # NIL) & (r # v.defRuler) THEN*) IF (v.Domain() # NIL) & (r # v.defRuler) THEN Stores.InitDomain(r, v.Domain()) END; *) IF r # v.defRuler THEN Stores.Join(v, r) END; NEW(op); op.defRuler := r; op.defAttr := a; DoSet(op, setDefs, v) END END SetDefaults; PROCEDURE (v: StdView) PollDefaults (OUT r: TextRulers.Ruler; OUT a: TextModels.Attributes); BEGIN r := v.defRuler; a := v.defAttr END PollDefaults; (* PROCEDURE (v: StdView) PropagateDomain; VAR m: Models.Model; BEGIN ASSERT(v.setter # NIL, 20); ASSERT(v.text # NIL, 21); ASSERT(v.defRuler # NIL, 22); ASSERT(v.defAttr # NIL, 23); v.PropagateDomain^; m := v.ThisModel(); IF m # NIL THEN Stores.InitDomain(m, v.Domain()) END; Stores.InitDomain(v.defRuler, v.Domain()) END PropagateDomain; *) (* PROCEDURE (v: StdView) Flush, NEW; BEGIN v.trailer := NIL; v.bot := 0; v.setter0 := NIL END Flush; *) PROCEDURE (v: StdView) HandleModelMsg2 (VAR msg: Models.Message); BEGIN IF msg.model = v.text THEN WITH msg: Models.UpdateMsg DO WITH msg: TextModels.UpdateMsg DO IF msg.op IN {TextModels.insert, TextModels.delete, TextModels.replace} THEN UpdateView(v, msg.beg, msg.end, msg.delta) ELSE (* unknown text op happened *) RebuildView(v) END ELSE (* unknown text update happened *) RebuildView(v) END | msg: PositionMsg DO v.ShowRange(msg.beg, msg.end, msg.focusOnly) ELSE END ELSE (* domaincast received *) WITH msg: TextRulers.UpdateMsg DO StyleUpdate(v, msg.oldAttr) | msg: Models.UpdateMsg DO (* forced rebuild *) RebuildView(v) ELSE END END END HandleModelMsg2; PROCEDURE (v: StdView) HandleViewMsg2 (f: Views.Frame; VAR msg: Views.Message); BEGIN IF msg.view = v THEN WITH msg: FindAnyFrameMsg DO IF (msg.frame = NIL) OR (msg.frame.b - msg.frame.t > f.b - f.t) THEN msg.frame := f END ELSE END ELSE WITH msg: Views.UpdateCachesMsg DO (* display view in new frame *) IF Views.Era(v) # Models.Era(v.text) THEN (* view/setter caches outdated - possible if v previous to this notification had no frame open *) v.setter0 := NIL; v.trailer := NIL; v.bot := 0 END ELSE END END END HandleViewMsg2; PROCEDURE (v: StdView) HandleCtrlMsg2 (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View ); BEGIN WITH msg: Controllers.PollSectionMsg DO IF (focus = NIL) OR ~msg.focus THEN PollSection(v, f, msg); focus := NIL END | msg: FindFocusFrameMsg DO IF (msg.view = v) & (msg.frame = NIL) THEN msg.frame := f END | msg: Controllers.ScrollMsg DO IF (focus = NIL) OR ~msg.focus THEN Scroll(v, f, msg); focus := NIL END | msg: Controllers.PageMsg DO Page(v, f.b - f.t, msg.op, msg.pageY, msg.done, msg.eoy); focus := NIL ELSE END END HandleCtrlMsg2; PROCEDURE (v: StdView) HandlePropMsg2 (VAR p: Properties.Message); CONST minW = 5 * point; maxW = maxHeight; minH = 5 * point; maxH = maxHeight; VAR st: TextSetters.Setter; BEGIN WITH p: Properties.SizePref DO IF p.w = Views.undefined THEN p.w := v.defRuler.style.attr.right END; IF p.h = Views.undefined THEN p.h := MAX(INTEGER) END | p: Properties.BoundsPref DO st := v.ThisSetter(); st.GetBox(0, v.text.Length(), maxW, maxH, p.w, p.h); IF p.w < minW THEN p.w := minW END; IF p.h < minH THEN p.h := minH END | p: Properties.ResizePref DO p.fixed := FALSE; p.horFitToPage := ~(TextRulers.rightFixed IN v.defRuler.style.attr.opts); p.verFitToWin := TRUE | p: Properties.TypePref DO IF Services.Is(v, p.type) THEN p.view := v END | p: Containers.DropPref DO p.okToDrop := TRUE ELSE END END HandlePropMsg2; PROCEDURE (v: StdView) GetThisLocation (f: Views.Frame; pos: INTEGER; OUT loc: Location); (* pre: f must be displayed *) (* if position lies outside view, the next best location inside will be taken *) VAR rd: TextSetters.Reader; t: Line; p1, y, w, h: INTEGER; BEGIN ValidateLines(v, f.b); y := v.dy; IF pos < v.org THEN t := v.trailer.next; loc.start := t.start; loc.pos := t.start; loc.x := 0; loc.y := y; loc.asc := t.asc; loc.dsc := t.h - t.asc; loc.view := NIL; RETURN ELSIF pos < v.trailer.start THEN t := v.trailer.next; WHILE ~t.box.eot & ~((t.start <= pos) & (pos < t.next.start)) DO INC(y, t.h); t := t.next END ELSE (* pos >= v.trailer.start *) t := v.trailer.next; WHILE ~t.box.eot DO INC(y, t.h); t := t.next END; IF t = v.trailer THEN loc.start := t.start; loc.pos := t.start; loc.x := 0; loc.y := y; loc.asc := t.asc; loc.dsc := t.h - t.asc; loc.view := NIL; RETURN END END; p1 := t.start; rd := GetReader(v, p1, t.box); rd.Read; WHILE rd.pos < pos DO p1 := rd.pos; rd.AdjustWidth(t.start, p1, t.box, rd.w); INC(rd.x, rd.w); rd.Read END; IF LEN(rd.string$) > 1 THEN (* collated subsequence *) rd.x := f.CharPos(rd.x, pos - p1, rd.string, rd.attr.font); IF rd.pos = pos THEN rd.Read END ELSIF rd.pos = pos THEN rd.AdjustWidth(t.start, pos, t.box, rd.w); INC(rd.x, rd.w); rd.Read ELSE ASSERT(p1 = pos, 100) END; loc.view := rd.view; loc.start := t.start; loc.pos := pos; loc.x := rd.x; loc.y := y; loc.asc := t.asc; loc.dsc := t.h - t.asc; IF loc.view # NIL THEN v.context.GetSize(w, h); IF rd.x + rd.w > w THEN rd.w := w - rd.x END; loc.l := rd.x; loc.t := y - rd.attr.offset + t.asc + rd.dsc - rd.h; loc.r := loc.l + rd.w; loc.b := loc.t + rd.h END; CacheReader(v, rd) END GetThisLocation; PROCEDURE (v: StdView) GetRange (f: Views.Frame; OUT beg, end: INTEGER); VAR t: Line; BEGIN ValidateLines(v, f.b); t := ThisViewLine(v, f.t); beg := t.start; end := Limit(v, f.b, TRUE) END GetRange; PROCEDURE (v: StdView) ThisPos (f: Views.Frame; x, y: INTEGER): INTEGER; (* pre: f must be displayed *) (* post: f.org <= result <= v.text.Length() *) VAR rd: TextSetters.Reader; t: Line; p1, end, py: INTEGER; BEGIN ValidateLines(v, f.b); t := v.trailer.next; py := v.dy; WHILE ~t.box.eot & (py + t.h <= y) DO INC(py, t.h); t := t.next END; p1 := t.start; end := p1 + t.box.len; IF py + t.h > y THEN IF (end > p1) & (y >= v.dy) THEN IF t.box.eot THEN INC(end) END; rd := GetReader(v, p1, t.box); rd.Read; rd.AdjustWidth(t.start, rd.pos, t.box, rd.w); WHILE (rd.x + rd.SplitWidth(rd.w) < x) & (rd.pos < end) DO p1 := rd.pos; INC(rd.x, rd.w); rd.Read; rd.AdjustWidth(t.start, rd.pos, t.box, rd.w) END; IF LEN(rd.string$) > 1 THEN (* collated subsequence *) INC(p1, f.CharIndex(rd.x, x, rd.string, rd.attr.font)) END; CacheReader(v, rd) END ELSE p1 := end END; RETURN p1 END ThisPos; PROCEDURE (v: StdView) ShowRangeIn (f: Views.Frame; beg, end: INTEGER); CONST minH = 12 * point; VAR c: Models.Context; st: TextSetters.Setter; t, t1: Line; org0, last, len, org, dy, p, q: INTEGER; y, h, mh: INTEGER; box, box0: TextSetters.LineBox; loc, loc1: Location; focus: BOOLEAN; BEGIN focus := f = Controllers.FocusFrame(); c := v.context; st := v.ThisSetter(); ValidateLines(v, f.b); org0 := v.org; last := Limit(v, f.b, FALSE); len := v.text.Length(); IF last = len THEN p := st.ThisLine(last); LocateThisLine(v, p, t1, y); h := f.b - y END; IF (beg > last) OR (beg = last) & ((last < len) OR (len > 0) & (h < t1.h) & (h < minH)) OR (end < org0) OR (beg < end) & (end = org0) THEN org := -1; dy := 0; IF beg <= org0 THEN (* try to adjust by scrolling up *) p := st.PreviousLine(v.org); IF p <= beg THEN (* reveal one line at top *) org := p; st.GetLine(org, box); h := box.asc + box.dsc + st.GridOffset(-1, box); IF h > maxScrollHeight + fuseScrollHeight THEN dy := -(h - h MOD maxScrollHeight); IF h + dy < fuseScrollHeight THEN INC(dy, maxScrollHeight) END END END END; IF (org = -1) & (beg >= last) THEN (* try to adjust by scrolling down *) p := st.ThisLine(last); q := st.NextLine(p); st.GetLine(q, box); IF (beg < q + box.len) OR (p = q) THEN (* reveal one line at bottom *) LocateThisLine(v, p, t1, y); h := box.asc + box.dsc + st.GridOffset(t1.box.dsc, box); IF h > maxScrollHeight + fuseScrollHeight THEN h := maxScrollHeight END; mh := y + t1.h - f.b + h; t := v.trailer.next; h := v.dy; WHILE (t # v.trailer) & (h < mh) DO INC(h, t.h); t := t.next END; IF t.start > v.org THEN org := t.start END END END; IF org = -1 THEN (* adjust by moving into "nice" position *) mh := f.b DIV 3; org := st.ThisLine(beg); st.GetLine(org, box0); h := box0.asc + box0.dsc + st.GridOffset(-1, box0); p := org; WHILE (p > 0) & (h < mh) DO DEC(h, st.GridOffset(-1, box0)); org := p; p := st.PreviousLine(org); st.GetLine(p, box); INC(h, box.asc + box.dsc + st.GridOffset(box.dsc, box0)); box0 := box END; IF (org = len) & (len > 0) THEN org := st.PreviousLine(org) END END; DoSetOrigin(v, org, dy, FALSE) END; IF focus THEN f := Controllers.FocusFrame(); IF (f # NIL) & (f.view = v) THEN v.GetThisLocation(f, beg, loc); v.GetThisLocation(f, end, loc1); IF (loc.y = loc1.y) & (loc.x <= loc1.x) THEN c.MakeVisible(loc.x, loc.y, loc1.x, loc1.y) END ELSE HALT(100); (* this should not happen *) END END; (* IF c IS Documents.Context THEN v.GetThisLocation(f, beg, loc); v.GetThisLocation(f, end, loc1); IF (loc.y = loc1.y) & (loc.x <= loc1.x) THEN Documents.MakeVisible(c(Documents.Context).ThisDoc(), f, loc.x, loc.y, loc1.x, loc1.y) END END *) END ShowRangeIn; PROCEDURE (v: StdView) ShowRange (beg, end: INTEGER; focusOnly: BOOLEAN); VAR fmsg: FindFocusFrameMsg; amsg: FindAnyFrameMsg; f: Views.Frame; BEGIN IF focusOnly THEN fmsg.view := v; fmsg.frame := NIL; Controllers.Forward(fmsg); f := fmsg.frame ELSE amsg.frame := NIL; Views.Broadcast(v, amsg); f := amsg.frame END; IF f # NIL THEN v.ShowRangeIn(f, beg, end) END END ShowRange; (* StdDirectory *) PROCEDURE (d: StdDirectory) New (text: TextModels.Model): View; VAR v: StdView; c: Controllers.Controller; r: TextRulers.Ruler; BEGIN r := TextRulers.dir.New(NIL); IF text = NIL THEN text := TextModels.dir.New() END; (* IF text.Domain() # NIL THEN Stores.InitDomain(r, text.Domain()) END; *) Stores.Join(text, r); NEW(v); v.hideMarks := FALSE; v.bot := 0; v.org := 0; v.dy := 0; v.InitModel(text); v.SetDefaults(r, d.defAttr); v.SetSetter(TextSetters.dir.New()); v.DisplayMarks(hide); IF ctrlDir # NIL THEN v.SetController(ctrlDir.New()) END; (* Stores.InitDomain(v, text.Domain()); *) Stores.Join(v, text); RETURN v END New; PROCEDURE Init; VAR d: StdDirectory; a: TextModels.Attributes; res: INTEGER; BEGIN Dialog.Call("TextControllers.Install", "#Text:CntrlInstallFailed", res); NEW(a); a.InitFromProp(NIL); (* use defaults *) NEW(d); d.defAttr := a; stdDir := d; dir := d END Init; BEGIN Init END TextViews.