1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633 |
- MODULE TextControllers;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Controllers.odc *)
- (* DO NOT EDIT *)
- IMPORT
- Services, Stores, Ports, Models, Views, Dialog, Controllers, Properties, Containers,
- TextModels, TextRulers, TextSetters, TextViews;
- CONST
- noAutoScroll* = 16; noAutoIndent* = 17;
- (** Controller.SetCaret pos; Controller.SetSelection beg, end **)
- none* = -1;
- (* Track mode *)
- chars = 0; words = 1; lines = 2; (* plus "none", defined above *)
- enter = 3X; rdel = 7X; ldel = 8X;
- aL = 1CX; aR = 1DX; aU = 1EX; aD = 1FX;
- pL = 10X; pR = 11X; pU = 12X; pD = 13X;
- dL = 14X; dR = 15X; dU = 16X; dD = 17X;
- viewcode = TextModels.viewcode;
- tab = TextModels.tab; line = TextModels.line; para = TextModels.para;
- point = Ports.point; mm = Ports.mm; inch16 = Ports.inch DIV 16;
- boundCaret = TRUE;
- lenCutoff = 2000; (* max run length inspected to fetch properties *)
- attrChangeKey = "#Text:AttributeChange";
- resizingKey = "#System:Resizing";
- insertingKey = "#System:Inserting";
- deletingKey = "#System:Deleting";
- movingKey = "#System:Moving";
- copyingKey = "#System:Copying";
- linkingKey = "#System:Linking";
- replacingKey = "#System:Replacing";
- minVersion = 0; maxVersion = 0; maxStdVersion = 0;
- TYPE
- Controller* = POINTER TO ABSTRACT RECORD (Containers.Controller)
- view-: TextViews.View;
- text-: TextModels.Model (** view # NIL => text = view.ThisText() **)
- END;
- Directory* = POINTER TO ABSTRACT RECORD (Containers.Directory) END;
- FilterPref* = RECORD (Properties.Preference)
- controller*: Controller; (** IN, set to text controller asking for filter **)
- frame*: Views.Frame; (** IN, set to frame of controlled text view **)
- x*, y*: INTEGER; (** IN, set to coordinates of cursor in frame space **)
- filter*: BOOLEAN (** preset to FALSE **)
- END;
- FilterPollCursorMsg* = RECORD (Controllers.Message)
- controller*: Controller; (** IN, set to text controller asking for filter **)
- x*, y*: INTEGER;
- cursor*: INTEGER; (** as for Controllers.PollCursorMsg **)
- done*: BOOLEAN (** OUT; initialized to FALSE **)
- END;
- FilterTrackMsg* = RECORD (Controllers.Message)
- controller*: Controller; (** IN, set to text controller asking for filter **)
- x*, y*: INTEGER;
- modifiers*: SET; (** as for Controllers.TrackMsg **)
- done*: BOOLEAN (** OUT; initialized to FALSE **)
- END;
- StdCtrl = POINTER TO RECORD (Controller)
- (* general state *)
- cachedRd: TextModels.Reader;
- cachedWr: TextModels.Writer;
- insAttr: TextModels.Attributes; (* preset attrs for next typed char *)
- autoBeg, autoEnd: INTEGER; (* lazy auto-scrolling;
- invalid if (-1, .); initially (MAX(LONGINT), 0) *)
- (* caret *)
- carPos: INTEGER; (* HasCaret() iff 0 <= carPos <= text.Length() *)
- carLast: INTEGER; (* used to recover caret at meaningful position *)
- carX, lastX: INTEGER; (* arrow up/down anti-aliasing *)
- carTick: LONGINT; (* next tick to invert flashing caret mark *)
- carVisible: BOOLEAN; (* caret currently visible - used for flashing caret *)
- (* selection *)
- selBeg, selEnd: INTEGER; (* HasSel() iff 0 <= selBeg < selEnd <= text.Length() *)
- aliasSelBeg, aliasSelEnd: INTEGER; (* need lazy synchronization? *)
- selPin0, selPin1: INTEGER; (* anchor points of selection *)
- (* most recent scroll-while-tracking step *)
- lastStep: LONGINT
- END;
- StdDirectory = POINTER TO RECORD (Directory) END;
- (* messages *)
- ModelMessage* = ABSTRACT RECORD (Models.Message) END;
- (** messages to control virtual model extensions, such as marks **)
- SetCaretMsg* = EXTENSIBLE RECORD (ModelMessage)
- pos*: INTEGER
- END;
- SetSelectionMsg* = EXTENSIBLE RECORD (ModelMessage)
- beg*, end*: INTEGER
- END;
- ViewMessage = ABSTRACT RECORD (Views.Message) END;
- CaretMsg = RECORD (ViewMessage)
- show: BOOLEAN
- END;
- SelectionMsg = RECORD (ViewMessage)
- beg, end: INTEGER;
- show: BOOLEAN
- END;
- (* miscellaneous *)
- TrackState = RECORD
- x, y: INTEGER;
- toggle: BOOLEAN
- END;
- VAR
- dir-, stdDir-: Directory;
- PROCEDURE CachedReader (c: StdCtrl): TextModels.Reader;
- VAR rd: TextModels.Reader;
- BEGIN
- rd := c.text.NewReader(c.cachedRd); c.cachedRd := NIL; RETURN rd
- END CachedReader;
- PROCEDURE CacheReader (c: StdCtrl; rd: TextModels.Reader);
- BEGIN
- c.cachedRd := rd
- END CacheReader;
- PROCEDURE CachedWriter (c: StdCtrl; attr: TextModels.Attributes): TextModels.Writer;
- VAR wr: TextModels.Writer;
- BEGIN
- wr := c.text.NewWriter(c.cachedWr); wr.SetAttr(attr);
- c.cachedRd := NIL; RETURN wr
- END CachedWriter;
- PROCEDURE CacheWriter (c: StdCtrl; wr: TextModels.Writer);
- BEGIN
- c.cachedWr := wr
- END CacheWriter;
- (** Controller **)
- PROCEDURE (c: Controller) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
- VAR v: INTEGER;
- BEGIN
- (* c.Internalize^(rd); *)
- rd.ReadVersion(minVersion, maxVersion, v)
- END Internalize2;
- PROCEDURE (c: Controller) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
- BEGIN
- (* c.Externalize^(wr); *)
- wr.WriteVersion(maxVersion)
- END Externalize2;
- PROCEDURE (c: Controller) InitView2* (v: Views.View), EXTENSIBLE;
- BEGIN
- ASSERT((v = NIL) # (c.view = NIL), 21);
- IF c.view = NIL THEN ASSERT(v IS TextViews.View, 22) END;
- (* c.InitView^(v); *)
- IF v # NIL THEN c.view := v(TextViews.View); c.text := c.view.ThisModel()
- ELSE c.view := NIL; c.text := NIL
- END
- END InitView2;
- PROCEDURE (c: Controller) ThisView* (): TextViews.View, EXTENSIBLE;
- BEGIN
- RETURN c.view
- END ThisView;
- (** caret **)
- PROCEDURE (c: Controller) CaretPos* (): INTEGER, NEW, ABSTRACT;
- PROCEDURE (c: Controller) SetCaret* (pos: INTEGER), NEW, ABSTRACT;
- (** pre: pos = none OR 0 <= pos <= c.text.Length() **)
- (** post: c.carPos = pos **)
- (** selection **)
- PROCEDURE (c: Controller) GetSelection* (OUT beg, end: INTEGER), NEW, ABSTRACT;
- (** post: beg = end OR 0 <= beg <= end <= c.text.Length() **)
- PROCEDURE (c: Controller) SetSelection* (beg, end: INTEGER), NEW, ABSTRACT;
- (** pre: beg = end OR 0 <= beg < end <= c.text.Length() **)
- (** post: c.selBeg = beg, c.selEnd = end **)
- (** Directory **)
- PROCEDURE (d: Directory) NewController* (opts: SET): Controller, ABSTRACT;
- PROCEDURE (d: Directory) New* (): Controller, EXTENSIBLE;
- BEGIN
- RETURN d.NewController({})
- END New;
- (** miscellaneous **)
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20); dir := d
- END SetDir;
- PROCEDURE Install*;
- BEGIN
- TextViews.SetCtrlDir(dir)
- END Install;
- PROCEDURE Focus* (): Controller;
- VAR v: Views.View; c: Containers.Controller;
- BEGIN
- v := Controllers.FocusView();
- IF (v # NIL) & (v IS TextViews.View) THEN
- c := v(TextViews.View).ThisController();
- IF (c # NIL) & (c IS Controller) THEN RETURN c(Controller)
- ELSE RETURN NIL
- END
- ELSE RETURN NIL
- END
- END Focus;
- PROCEDURE SetCaret* (text: TextModels.Model; pos: INTEGER);
- (** pre: text # NIL, pos = none OR 0 <= pos <= text.Length() **)
- VAR cm: SetCaretMsg;
- BEGIN
- ASSERT(text # NIL, 20); ASSERT(none <= pos, 21); ASSERT(pos <= text.Length(), 22);
- cm.pos := pos; Models.Broadcast(text, cm)
- END SetCaret;
- PROCEDURE SetSelection* (text: TextModels.Model; beg, end: INTEGER);
- (** pre: text # NIL, beg = end OR 0 <= beg < end <= text.Length() **)
- VAR sm: SetSelectionMsg;
- BEGIN
- ASSERT(text # NIL, 20);
- IF beg # end THEN
- ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= text.Length(), 23)
- END;
- sm.beg := beg; sm.end := end; Models.Broadcast(text, sm)
- END SetSelection;
- (* support for cursor/selection/focus marking *)
- PROCEDURE BlinkCaret (c: StdCtrl; f: Views.Frame; tick: INTEGER);
- VAR vis: BOOLEAN;
- BEGIN
- IF (c.carPos # none) & f.front & (tick >= c.carTick) THEN
- IF c.carVisible THEN
- c.MarkCaret(f, Containers.hide); c.carVisible := FALSE
- ELSE
- c.carVisible := TRUE; c.MarkCaret(f, Containers.show)
- END;
- c.carTick := tick + Dialog.caretPeriod
- END
- END BlinkCaret;
- PROCEDURE FlipCaret (c: StdCtrl; show: BOOLEAN);
- VAR msg: CaretMsg;
- BEGIN
- msg.show := show;
- Views.Broadcast(c.view, msg)
- END FlipCaret;
- PROCEDURE CheckCaret (c: StdCtrl);
- VAR text: TextModels.Model; len, pos: INTEGER;
- BEGIN
- IF ~(Containers.noCaret IN c.opts) THEN
- IF (c.carPos = none) & ~(boundCaret & (c.selBeg # c.selEnd)) & (c.ThisFocus() = NIL) THEN
- text := c.text; len := text.Length(); pos := c.carLast;
- IF pos < 0 THEN pos := 0 ELSIF pos > len THEN pos := len END;
- (* c.carVisible := FALSE; c.carTick := 0; (* force visible mark *) *)
- SetCaret(text, pos)
- END
- ELSE c.carPos := none
- END
- END CheckCaret;
- PROCEDURE HiliteRect (f: Views.Frame; l, t, r, b, s: INTEGER; show: BOOLEAN);
- BEGIN
- IF s = Ports.fill THEN
- f.MarkRect(l, t, r, b, Ports.fill, Ports.hilite, show)
- ELSE
- f.MarkRect(l, t, r - s, t + s, s, Ports.hilite, show);
- f.MarkRect(l, t + s, l + s, b - s, s, Ports.hilite, show);
- f.MarkRect(l + s, b - s, r, b, s, Ports.hilite, show);
- f.MarkRect(r - s, t + s, r, b - s, s, Ports.hilite, show)
- END
- END HiliteRect;
- PROCEDURE MarkSelRange (c: StdCtrl; f: Views.Frame; b, e: TextViews.Location;
- front, show: BOOLEAN
- );
- VAR fw, ff, r, t: INTEGER;
- BEGIN
- IF front THEN fw := 0; ff := Ports.fill ELSE fw := f.dot; ff := fw END;
- IF b.start # e.start THEN
- r := f.r; t := b.y + b.asc + b.dsc;
- HiliteRect(f, b.x, b.y, r + fw, t + fw, ff, show);
- IF t < e.y THEN HiliteRect(f, 0, t, r + fw, e.y + fw, ff, show) END;
- b.x := f.l; b.y := e.y
- END;
- HiliteRect(f, b.x, b.y, e.x + fw, e.y + e.asc + e.dsc + fw, ff, show)
- END MarkSelRange;
- PROCEDURE MarkSelection (c: StdCtrl; f: Views.Frame; beg, end: INTEGER; show: BOOLEAN);
- VAR b, e: TextViews.Location; s: Views.View;
- BEGIN
- IF (beg # end) & f.mark THEN
- ASSERT(beg < end, 20);
- s := c.Singleton();
- IF s # NIL THEN
- IF beg + 1 = end THEN Containers.MarkSingleton(c, f, show) END
- ELSE
- c.view.GetThisLocation(f, beg, b); c.view.GetThisLocation(f, end, e);
- IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
- MarkSelRange(c, f, b, e, f.front, show)
- END
- END
- END
- END MarkSelection;
- PROCEDURE FlipSelection (c: StdCtrl; beg, end: INTEGER; show: BOOLEAN);
- VAR msg: SelectionMsg;
- BEGIN
- msg.beg := beg; msg.end := end; msg.show := show;
- Views.Broadcast(c.view, msg)
- END FlipSelection;
- PROCEDURE InitMarks (c: StdCtrl);
- BEGIN
- c.autoBeg := MAX(INTEGER); c.autoEnd := 0;
- c.carPos := none; c.carVisible := FALSE; c.carLast := none; c.carTick := 0; c.carX := -1;
- c.selBeg := none; c.selEnd := none;
- c.lastStep := 0
- END InitMarks;
- PROCEDURE AutoShowRange (c: StdCtrl; beg, end: INTEGER);
- BEGIN
- IF (beg <= c.autoBeg) & (c.autoEnd <= end) THEN
- c.autoBeg := beg; c.autoEnd := end (* new range includes old range: expand *)
- ELSE
- c.autoBeg := -1 (* schizopheric scroll request -> don't scroll at all *)
- END
- END AutoShowRange;
- PROCEDURE UpdateMarks (c: StdCtrl; op: INTEGER; beg, end, delta: INTEGER);
- (* ensure that marks are valid after updates *)
- BEGIN
- CASE op OF
- TextModels.insert:
- c.carLast := end; c.selBeg := end; c.selEnd := end; beg := end
- | TextModels.delete:
- c.carLast := beg; c.selBeg := beg; c.selEnd := beg; end := beg
- | TextModels.replace:
- ELSE
- HALT(100)
- END;
- AutoShowRange(c, beg, end)
- END UpdateMarks;
- (* support for smart cut/copy/paste and attributing *)
- PROCEDURE LegalChar (ch: CHAR): BOOLEAN;
- BEGIN
- IF ch < 100X THEN
- CASE ORD(ch) OF
- ORD(viewcode),
- ORD(tab), ORD(line), ORD(para),
- ORD(" ") .. 7EH, 80H .. 0FFH: RETURN TRUE
- ELSE RETURN FALSE
- END
- ELSE RETURN TRUE
- END
- END LegalChar;
- PROCEDURE LeftTerminator (ch: CHAR): BOOLEAN;
- BEGIN
- IF ch < 100X THEN
- CASE ch OF
- viewcode, tab, line, para, '"', "'", "(", "[", "{": RETURN TRUE
- ELSE RETURN FALSE
- END
- ELSE RETURN TRUE
- END
- END LeftTerminator;
- PROCEDURE RightTerminator (ch, ch1: CHAR): BOOLEAN;
- BEGIN
- IF ch < 100X THEN
- CASE ch OF
- 0X, viewcode, tab, line, para,
- "!", '"', "'", "(", ")", ",", ";", "?", "[", "]", "{", "}": RETURN TRUE
- | ".", ":":
- CASE ch1 OF
- 0X, viewcode, tab, line, para, " ": RETURN TRUE
- ELSE RETURN FALSE
- END
- ELSE RETURN FALSE
- END
- ELSE RETURN TRUE
- END
- END RightTerminator;
- PROCEDURE ReadLeft (rd: TextModels.Reader; pos: INTEGER; OUT ch: CHAR);
- BEGIN
- IF pos > 0 THEN rd.SetPos(pos - 1); rd.ReadChar(ch)
- ELSE rd.SetPos(pos); ch := " "
- END
- END ReadLeft;
- PROCEDURE SmartRange (c: StdCtrl; VAR beg, end: INTEGER);
- (* if possible and whole words are covered,
- extend [beg, end) to encompass either a leading or a trailing blank *)
- VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR; rightTerm: BOOLEAN;
- BEGIN
- (*
- disable intelligent delete/cut/move for now
- rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
- IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN
- (* range covers beg of word *)
- we := beg; be := beg;
- WHILE (ch # 0X) & (be <= end) DO
- ch1 := ch; rd.ReadChar(ch); INC(be);
- IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN we := be END
- END;
- rightTerm := RightTerminator(ch1, ch);
- IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN
- (* range covers end of word *)
- IF (we < be) & (ch1 = " ") THEN
- INC(end) (* include trailing blank *)
- ELSIF (beg > 0) & rightTerm & (ch0 = " ") THEN
- DEC(beg) (* include leading blank *)
- END
- END
- END;
- CacheReader(c, rd)
- *)
- END SmartRange;
- PROCEDURE OnlyWords (c: StdCtrl; beg, end: INTEGER): BOOLEAN;
- VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR;
- rightTerm, words: BOOLEAN;
- BEGIN
- words := FALSE;
- rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
- IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN (* range covers beg of word *)
- we := beg; be := beg;
- WHILE (ch # 0X) & (be <= end) DO
- ch1 := ch; rd.ReadChar(ch); INC(be);
- IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN
- we := be
- END
- END;
- rightTerm := RightTerminator(ch1, ch);
- IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN (* range covers end of word *)
- words := TRUE
- END
- END;
- CacheReader(c, rd);
- RETURN words
- END OnlyWords;
- PROCEDURE GetTargetField (t: TextModels.Model; pos: INTEGER;
- VAR touchL, touchM, touchR: BOOLEAN
- );
- VAR rd: TextModels.Reader; ch0, ch1: CHAR; leftTerm, rightTerm: BOOLEAN;
- BEGIN
- rd := t.NewReader(NIL); ReadLeft(rd, pos, ch0); rd.ReadChar(ch1);
- leftTerm := (ch0 <= " ") OR LeftTerminator(ch0);
- rightTerm := (ch1 <= " ") OR RightTerminator(ch1, 0X);
- touchL := ~leftTerm & rightTerm;
- touchM := ~leftTerm & ~rightTerm;
- touchR := leftTerm & ~rightTerm
- END GetTargetField;
- PROCEDURE LeftExtend (t: TextModels.Model; attr: TextModels.Attributes);
- VAR wr: TextModels.Writer;
- BEGIN
- wr := t.NewWriter(NIL); wr.SetAttr(attr); wr.SetPos(0); wr.WriteChar(" ")
- END LeftExtend;
- PROCEDURE RightExtend (t: TextModels.Model; attr: TextModels.Attributes);
- VAR wr: TextModels.Writer;
- BEGIN
- wr := t.NewWriter(NIL); wr.SetPos(t.Length()); wr.SetAttr(attr); wr.WriteChar(" ")
- END RightExtend;
- PROCEDURE MergeAdjust (target, inset: TextModels.Model; pos: INTEGER; OUT start: INTEGER);
- VAR rd: TextModels.Reader; a: TextModels.Attributes; ch, ch1: CHAR;
- touchL, touchM, touchR: BOOLEAN;
- BEGIN
- start := pos;
- (*
- disable intelligent paste for now
- GetTargetField(target, pos, touchL, touchM, touchR);
- IF touchL THEN
- rd := inset.NewReader(NIL); rd.SetPos(0);
- rd.ReadChar(ch); a := rd.attr; rd.ReadChar(ch1);
- IF (ch > " ") & ~RightTerminator(ch, ch1) THEN LeftExtend(inset, a); INC(start) END
- END;
- IF touchR & (inset.Length() > 0) THEN
- rd := inset.NewReader(rd); rd.SetPos(inset.Length() - 1); rd.ReadChar(ch);
- IF (ch > " ") & ~LeftTerminator(ch) THEN RightExtend(inset, rd.attr) END
- END
- *)
- END MergeAdjust;
- PROCEDURE InsertionAttr (c: StdCtrl): TextModels.Attributes;
- VAR rd: TextModels.Reader; r: TextRulers.Ruler; a: TextModels.Attributes; ch: CHAR;
- BEGIN
- a := c.insAttr;
- IF a = NIL THEN
- rd := CachedReader(c); a := NIL;
- IF c.carPos # none THEN
- ReadLeft(rd, c.carPos, ch); a := rd.attr;
- IF ((ch <= " ") OR (ch = TextModels.nbspace)) & (c.carPos < c.text.Length()) THEN
- rd.ReadChar(ch);
- IF ch > " " THEN a := rd.attr END
- END
- ELSIF boundCaret & (c.selBeg # c.selEnd) THEN
- rd.SetPos(c.selBeg); rd.ReadChar(ch); a := rd.attr;
- c.insAttr := a
- END;
- IF a = NIL THEN c.view.PollDefaults(r, a) END;
- CacheReader(c, rd)
- END;
- RETURN a
- END InsertionAttr;
- PROCEDURE GetTargetRange (c: StdCtrl; OUT beg, end: INTEGER);
- BEGIN
- IF boundCaret & (c.selBeg # c.selEnd) THEN
- beg := c.selBeg; end := c.selEnd
- ELSE
- beg := c.carPos; end := beg
- END
- END GetTargetRange;
- PROCEDURE DoEdit (name: Stores.OpName;
- c: StdCtrl; beg, end: INTEGER;
- attr: TextModels.Attributes; ch: CHAR; view: Views.View; w, h: INTEGER;
- buf: TextModels.Model; bufbeg, bufend: INTEGER; (* buf # NIL & bufend < 0: bufend = buf.Length() *)
- pos: INTEGER
- );
- VAR script: Stores.Operation; wr: TextModels.Writer; cluster: BOOLEAN;
- BEGIN
- IF (beg < end) (* something to delete *)
- OR (attr # NIL) (* something new to write *)
- OR (buf # NIL) (* something new to insert *)
- THEN
- cluster := (beg < end) OR (attr = NIL) OR (view # NIL);
- (* don't script when typing a single character -> TextModels will bunch if possible *)
- (* ~cluster => name is reverted to #System.Inserting by TextModels *)
- IF cluster THEN Models.BeginScript(c.text, name, script) END;
- IF beg < end THEN
- c.text.Delete(beg, end);
- IF pos > beg THEN DEC(pos, end - beg) END
- END;
- IF attr # NIL THEN
- ASSERT(buf = NIL, 20);
- wr := CachedWriter(c, attr); wr.SetPos(pos);
- IF view # NIL THEN wr.WriteView(view, w, h) ELSE wr.WriteChar(ch) END;
- CacheWriter(c, wr)
- ELSIF buf # NIL THEN
- IF bufend < 0 THEN bufend := buf.Length() END;
- c.text.Insert(pos, buf, bufbeg, bufend)
- END;
- IF cluster THEN Models.EndScript(c.text, script) END;
- CheckCaret(c)
- END
- END DoEdit;
- (* editing *)
- PROCEDURE ThisPos (v: TextViews.View; f: Views.Frame; x, y: INTEGER): INTEGER;
- VAR loc: TextViews.Location; pos: INTEGER;
- BEGIN
- pos := v.ThisPos(f, x, y); v.GetThisLocation(f, pos, loc);
- IF (loc.view # NIL) & (x > (loc.l + loc.r) DIV 2) THEN INC(pos) END;
- RETURN pos
- END ThisPos;
- PROCEDURE ShowPos (c: StdCtrl; beg, end: INTEGER);
- BEGIN
- IF ~(noAutoScroll IN c.opts) THEN
- c.view.ShowRange(beg, end, TextViews.focusOnly)
- END
- END ShowPos;
- PROCEDURE Indentation (c: StdCtrl; pos: INTEGER): TextModels.Model;
- (* pre: c.carPos # none *)
- VAR st: TextSetters.Setter; buf: TextModels.Model; rd: TextModels.Reader;
- wr: TextModels.Writer; ch: CHAR; spos: INTEGER;
- BEGIN
- buf := NIL;
- rd := CachedReader(c);
- st := c.view.ThisSetter(); spos := st.ThisSequence(pos); rd.SetPos(spos); rd.ReadChar(ch);
- IF (ch = tab) & (spos < pos) THEN
- buf := TextModels.CloneOf(c.text); wr := buf.NewWriter(NIL); wr.SetPos(buf.Length());
- wr.SetAttr(InsertionAttr(c));
- wr.WriteChar(line);
- REPEAT wr.WriteChar(tab); rd.ReadChar(ch) UNTIL (ch # tab) OR (rd.Pos() > pos)
- END;
- CacheReader(c, rd);
- RETURN buf
- END Indentation;
- PROCEDURE InsertChar (c: StdCtrl; ch: CHAR);
- VAR buf: TextModels.Model; attr: TextModels.Attributes;
- beg, end: INTEGER; legal: BOOLEAN; name: Stores.OpName;
- BEGIN
- attr := NIL; buf := NIL;
- IF ch < 100X THEN legal := LegalChar(ch) ELSE legal := TRUE END; (* should check Unicode *)
- IF (ch = ldel) OR (ch = rdel) THEN name := deletingKey ELSE name := replacingKey END;
- IF boundCaret & (c.selBeg # c.selEnd) & (legal OR (ch = ldel) OR (ch = rdel) OR (ch = enter)) THEN
- beg := c.selBeg; end := c.selEnd;
- IF (ch = ldel) OR (ch = rdel) THEN SmartRange(c, beg, end); ch := 0X END
- ELSE
- beg := c.carPos; end := beg
- END;
- IF (c.carPos # none) OR boundCaret & (c.selBeg # c.selEnd) THEN
- IF (ch = line) OR (ch = enter) THEN
- IF noAutoIndent IN c.opts THEN buf := NIL ELSE buf := Indentation(c, beg) END;
- IF buf = NIL THEN ch := line; legal := TRUE ELSE ch := 0X; legal := FALSE END
- END;
- IF legal THEN
- attr := InsertionAttr(c)
- ELSIF (ch = ldel) & (c.carPos > 0) THEN
- beg := c.carPos - 1; end := c.carPos
- ELSIF (ch = rdel) & (c.carPos < c.text.Length()) THEN
- beg := c.carPos; end := c.carPos + 1
- END
- END;
- DoEdit(name, c, beg, end, attr, ch, NIL, 0, 0, buf, 0, -1, beg)
- END InsertChar;
- PROCEDURE InsertText (c: StdCtrl; beg, end: INTEGER; text: TextModels.Model; OUT start: INTEGER);
- VAR buf: TextModels.Model;
- BEGIN
- buf := TextModels.CloneOf(text); buf.InsertCopy(0, text, 0, text.Length());
- IF beg = end THEN MergeAdjust(c.text, buf, beg, start) ELSE start := beg END;
- DoEdit(insertingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, 0, -1, beg)
- END InsertText;
- PROCEDURE InsertView (c: StdCtrl; beg, end: INTEGER; v: Views.View; w, h: INTEGER);
- BEGIN
- DoEdit(insertingKey, c, beg, end, InsertionAttr(c), 0X, v, w, h, NIL, 0, 0, beg)
- END InsertView;
- PROCEDURE InSubFrame (f, f1: Views.Frame; x, y: INTEGER): BOOLEAN;
- BEGIN
- INC(x, f.gx - f1.gx); INC(y, f.gy - f1.gy);
- RETURN (f1.l <= x) & (x < f1.r) & (f1.t <= y) & (y < f1.b)
- END InSubFrame;
- PROCEDURE InFrame (f: Views.Frame; x, y: INTEGER): BOOLEAN;
- BEGIN
- RETURN (f.l <= x) & (x < f.r) & (f.t <= y) & (y < f.b)
- END InFrame;
- (* filtered tracking *)
- PROCEDURE IsFilter (v: Views.View; c: StdCtrl; f: Views.Frame; x, y: INTEGER): BOOLEAN;
- VAR pref: FilterPref;
- BEGIN
- pref.controller := c; pref.frame := f; pref.x := x; pref.y := y;
- pref.filter := FALSE;
- Views.HandlePropMsg(v, pref);
- RETURN pref.filter
- END IsFilter;
- PROCEDURE FindFilter (c: StdCtrl; f: Views.Frame; x, y: INTEGER; OUT filter: Views.View);
- CONST catchRange = 1000;
- VAR rd: TextModels.Reader; pos, beg, end: INTEGER; isF: BOOLEAN;
- BEGIN
- c.view.GetRange(f, beg, end); DEC(beg, catchRange);
- pos := c.view.ThisPos(f, x, y);
- IF pos < c.text.Length() THEN INC(pos) END; (* let filter handle itself *)
- rd := CachedReader(c); rd.SetPos(pos);
- REPEAT
- rd.ReadPrevView(filter);
- isF := (filter # NIL) & IsFilter(filter, c, f, x, y);
- UNTIL isF OR rd.eot OR (rd.Pos() < beg);
- IF ~isF THEN filter := NIL END;
- CacheReader(c, rd)
- END FindFilter;
- PROCEDURE FilteredPollCursor (c: StdCtrl; f: Views.Frame;
- VAR msg: Controllers.PollCursorMsg; VAR done: BOOLEAN
- );
- VAR filter, focus: Views.View; x, y: INTEGER; modifiers: SET; isDown: BOOLEAN; fmsg: FilterPollCursorMsg;
- BEGIN
- FindFilter(c, f, msg.x, msg.y, filter);
- IF filter # NIL THEN
- (* f.Input(x, y, modifiers, isDown); *)
- fmsg.x := msg.x; fmsg.y := msg.y; fmsg.cursor := msg.cursor;
- fmsg.controller := c; fmsg.done := FALSE;
- (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
- focus := NIL;
- filter.HandleCtrlMsg(f, fmsg, focus);
- IF fmsg.done THEN msg.cursor := fmsg.cursor END;
- done := fmsg.done
- END
- END FilteredPollCursor;
- PROCEDURE FilteredTrack (c: StdCtrl; f: Views.Frame;
- VAR msg: Controllers.TrackMsg; VAR done: BOOLEAN
- );
- VAR filter, focus: Views.View; fmsg: FilterTrackMsg;
- BEGIN
- FindFilter(c, f, msg.x, msg.y, filter);
- IF filter # NIL THEN
- fmsg.x := msg.x; fmsg.y := msg.y; fmsg.modifiers := msg.modifiers;
- fmsg.controller := c; fmsg.done := FALSE;
- (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
- focus := NIL; filter.HandleCtrlMsg(f, fmsg, focus);
- done := fmsg.done
- END
- END FilteredTrack;
- (* StdCtrl *)
- PROCEDURE (c: StdCtrl) Internalize2 (VAR rd: Stores.Reader);
- VAR thisVersion: INTEGER;
- BEGIN
- c.Internalize2^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxStdVersion, thisVersion);
- IF rd.cancelled THEN RETURN END;
- InitMarks(c)
- END Internalize2;
- PROCEDURE (c: StdCtrl) Externalize2 (VAR wr: Stores.Writer);
- BEGIN
- c.Externalize2^(wr);
- wr.WriteVersion(maxStdVersion)
- END Externalize2;
- PROCEDURE (c: StdCtrl) CopyFrom (source: Stores.Store);
- BEGIN
- c.CopyFrom^(source); InitMarks(c)
- END CopyFrom;
- PROCEDURE (c: StdCtrl) Neutralize2;
- BEGIN
- (* c.Neutralize^; *)
- c.SetCaret(none)
- END Neutralize2;
- PROCEDURE (c: StdCtrl) GetContextType (OUT type: Stores.TypeName);
- BEGIN
- type := "TextViews.View"
- END GetContextType;
- PROCEDURE (c: StdCtrl) GetValidOps (OUT valid: SET);
- BEGIN
- valid := {};
- IF (c.carPos # none) OR (boundCaret & (c.selBeg # c.selEnd)) THEN
- valid := valid + {Controllers.pasteChar, Controllers.paste}
- END;
- IF c.selBeg # c.selEnd THEN
- valid := valid + {Controllers.cut, Controllers.copy}
- END
- END GetValidOps;
- PROCEDURE (c: StdCtrl) NativeModel (m: Models.Model): BOOLEAN;
- BEGIN
- ASSERT(m # NIL, 20);
- RETURN m IS TextModels.Model
- END NativeModel;
- PROCEDURE (c: StdCtrl) NativeView (v: Views.View): BOOLEAN;
- BEGIN
- ASSERT(v # NIL, 20);
- RETURN v IS TextViews.View
- END NativeView;
- PROCEDURE (c: StdCtrl) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
- BEGIN
- RETURN Ports.textCursor
- END NativeCursorAt;
- PROCEDURE (c: StdCtrl) PollNativeProp (selection: BOOLEAN;
- VAR p: Properties.Property; VAR truncated: BOOLEAN
- );
- VAR beg, end: INTEGER;
- BEGIN
- IF selection & (c.selBeg = c.selEnd) THEN
- p := InsertionAttr(c).Prop(); truncated := FALSE
- ELSE
- IF selection THEN beg := c.selBeg; end := c.selEnd
- ELSE beg := 0; end := c.text.Length()
- END;
- (*
- truncated := (end - beg > lenCutoff);
- IF truncated THEN end := beg + lenCutoff END;
- *)
- p := c.text.Prop(beg, end)
- END
- END PollNativeProp;
- PROCEDURE (c: StdCtrl) SetNativeProp (selection: BOOLEAN; old, p: Properties.Property);
- VAR t: TextModels.Model; beg, end: INTEGER;
- BEGIN
- t := c.text;
- IF selection THEN beg := c.selBeg; end := c.selEnd ELSE beg := 0; end := t.Length() END;
- IF beg < end THEN
- t.Modify(beg, end, old, p);
- IF selection THEN c.SetSelection(beg, end) END
- ELSIF selection THEN
- c.insAttr := TextModels.ModifiedAttr(InsertionAttr(c), p)
- END
- END SetNativeProp;
- PROCEDURE (c: StdCtrl) MakeViewVisible (v: Views.View);
- VAR pos: INTEGER;
- BEGIN
- ASSERT(v # NIL, 20);
- ASSERT(v.context # NIL, 21);
- ASSERT(v.context.ThisModel() = c.text, 22);
- pos := v.context(TextModels.Context).Pos();
- ShowPos(c, pos, pos + 1)
- END MakeViewVisible;
- PROCEDURE (c: StdCtrl) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
- VAR rd: TextModels.Reader; beg, end: INTEGER;
- BEGIN
- IF selection THEN beg := c.selBeg; end := c.selEnd
- ELSE beg := 0; end := c.text.Length()
- END;
- IF beg < end THEN
- rd := CachedReader(c); rd.SetPos(beg); rd.ReadView(v);
- IF rd.Pos() > end THEN v := NIL END;
- CacheReader(c, rd)
- ELSE v := NIL
- END
- END GetFirstView;
- PROCEDURE (c: StdCtrl) GetNextView (selection: BOOLEAN; VAR v: Views.View);
- VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
- BEGIN
- ASSERT(v # NIL, 20); con := v.context;
- ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
- IF selection THEN beg := c.selBeg; end := c.selEnd
- ELSE beg := 0; end := c.text.Length()
- END;
- pos := con(TextModels.Context).Pos();
- IF (beg <= pos) & (pos < end) THEN
- rd := CachedReader(c); rd.SetPos(pos + 1); rd.ReadView(v);
- IF rd.Pos() > end THEN v := NIL END;
- CacheReader(c, rd)
- ELSE v := NIL
- END
- END GetNextView;
- PROCEDURE (c: StdCtrl) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
- VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
- BEGIN
- ASSERT(v # NIL, 20); con := v.context;
- ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
- IF selection THEN beg := c.selBeg; end := c.selEnd
- ELSE beg := 0; end := c.text.Length()
- END;
- pos := con(TextModels.Context).Pos();
- IF (beg < pos) & (pos <= end) THEN
- rd := CachedReader(c); rd.SetPos(pos); rd.ReadPrevView(v);
- IF rd.Pos() < beg THEN v := NIL END;
- CacheReader(c, rd)
- ELSE v := NIL
- END
- END GetPrevView;
- PROCEDURE (c: StdCtrl) GetSelectionBounds (f: Views.Frame; OUT x, y, w, h: INTEGER);
- VAR b, e: TextViews.Location;
- BEGIN
- c.GetSelectionBounds^(f, x, y, w, h);
- IF w = Views.undefined THEN
- c.view.GetThisLocation(f, c.selBeg, b);
- c.view.GetThisLocation(f, c.selEnd, e);
- IF b.start = e.start THEN x := b.x; w := e.x - b.x;
- ELSE x := f.l; w := f.r - f.l;
- END;
- y := b.y; h := e.y + e.asc + e.dsc - b.y
- END
- END GetSelectionBounds;
- PROCEDURE (c: StdCtrl) MarkPickTarget (source, f: Views.Frame;
- sx, sy, x, y: INTEGER; show: BOOLEAN
- );
- VAR b, e: TextViews.Location; pos: INTEGER;
- BEGIN
- pos := c.view.ThisPos(f, x, y);
- IF pos < c.text.Length() THEN
- c.view.GetThisLocation(f, pos, b);
- c.view.GetThisLocation(f, pos + 1, e);
- IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
- MarkSelRange(c, f, b, e, TRUE, show)
- END
- END
- END MarkPickTarget;
- PROCEDURE (c: StdCtrl) MarkDropTarget (source, f: Views.Frame;
- sx, sy, dx, dy, w, h, rx, ry: INTEGER; type: Stores.TypeName; isSingle, show: BOOLEAN
- );
- VAR loc: TextViews.Location; pos: INTEGER;
- BEGIN
- pos := c.view.ThisPos(f, dx, dy);
- IF (source # NIL) & ((source.view = f.view) OR (source.view.ThisModel() = f.view.ThisModel()))
- & (c.selBeg < pos) & (pos < c.selEnd) THEN
- pos := c.selBeg
- END;
- c.view.GetThisLocation(f, pos, loc);
- f.MarkRect(loc.x, loc.y, loc.x + f.unit, loc.y + loc.asc + loc.dsc, Ports.fill, Ports.invert, show);
- IF (isSingle OR ~Services.Extends(type, "TextViews.View")) & (w > 0) & (h > 0) THEN
- DEC(dx, rx); DEC(dy, ry);
- f.MarkRect(dx, dy, dx + w, dy + h, 0, Ports.dim25, show)
- END
- END MarkDropTarget;
- PROCEDURE GetThisLine (c: StdCtrl; pos: INTEGER; OUT beg, end: INTEGER);
- VAR st: TextSetters.Setter;
- BEGIN
- st := c.view.ThisSetter();
- beg := st.ThisLine(pos); end := st.NextLine(beg);
- IF end = beg THEN end := c.text.Length() END;
- END GetThisLine;
- PROCEDURE GetThisChunk (c: StdCtrl; f: Views.Frame;
- VAR s: TrackState; OUT beg, end: INTEGER; OUT mode: INTEGER
- );
- VAR v: TextViews.View; b, e: TextViews.Location;
- st: TextSetters.Setter; ruler: TextRulers.Ruler; ra: TextRulers.Attributes;
- pos, r: INTEGER;
- BEGIN
- v := c.view; st := v.ThisSetter(); pos := ThisPos(v, f, s.x, s.y);
- ruler := TextViews.ThisRuler(v, pos); ra := ruler.style.attr;
- r := ra.right; IF ~(TextRulers.rightFixed IN ra.opts) OR (r > f.r) THEN r := f.r END;
- st.GetWord(pos, beg, end);
- v.GetThisLocation(f, beg, b); v.GetThisLocation(f, end, e);
- IF (s.x < f.l) OR (s.x >= r) THEN (* outside of line box: whole line *)
- GetThisLine(c, pos, beg, end);
- mode := lines
- ELSIF (s.y < b.y) OR (s.y < b.y + b.asc + b.dsc) & (s.x < b.x)
- OR (s.y >= e.y) & (s.x >= e.x) OR (s.y >= e.y + e.asc + e.dsc) THEN
- (* outside of word: single char *)
- beg := ThisPos(v, f, s.x, s.y); v.GetThisLocation(f, beg, b);
- IF (b.x > s.x) & (beg > 0) THEN DEC(beg) END;
- IF beg < c.text.Length() THEN end := beg + 1 ELSE end := beg END;
- mode := words
- ELSE (* whole word *)
- mode := words
- END
- END GetThisChunk;
- PROCEDURE SetSel (c: StdCtrl; beg, end: INTEGER);
- (* pre: ~(Containers.noSelection IN c.opts) *)
- BEGIN
- IF beg >= end THEN c.SetCaret(beg) ELSE c.SetSelection(beg, end) END
- END SetSel;
- PROCEDURE PrepareToTrack (c: StdCtrl; f: Views.Frame;
- VAR s: TrackState; mode: INTEGER;
- VAR pin0, pin1, pos: INTEGER
- );
- VAR loc: TextViews.Location; beg, end: INTEGER; m: INTEGER;
- BEGIN
- pos := ThisPos(c.view, f, s.x, s.y);
- IF mode IN {chars, words, lines} THEN
- GetThisChunk(c, f, s, pin0, pin1, m)
- ELSE pin0 := pos; pin1 := pos
- END;
- IF s.toggle & ((c.selBeg # c.selEnd) OR boundCaret & (c.carPos # none))
- & ~(Containers.noSelection IN c.opts) THEN (* modify existing selection *)
- IF c.selBeg # c.selEnd THEN
- beg := c.selBeg; end := c.selEnd
- ELSE
- beg := c.carPos; end := beg; c.selPin0 := beg; c.selPin1 := beg
- END;
- IF pin1 > c.selPin0 THEN
- end := pin1; pin0 := beg
- ELSIF pin0 < c.selPin1 THEN
- beg := pin0; pin0 := end
- END;
- SetSel(c, beg, end);
- pin1 := pin0
- ELSIF mode IN {chars, words, lines} THEN
- SetSel(c, pin0, pin1);
- pos := pin1
- ELSE
- SetCaret(c.text, pos)
- END;
- c.lastStep := Services.Ticks()
- END PrepareToTrack;
- PROCEDURE ScrollDelay (d: INTEGER): INTEGER;
- VAR second, delay: INTEGER;
- BEGIN
- second := Services.resolution;
- IF d < 2 * mm THEN delay := second DIV 2
- ELSIF d < 4 * mm THEN delay := second DIV 3
- ELSIF d < 6 * mm THEN delay := second DIV 5
- ELSIF d < 8 * mm THEN delay := second DIV 10
- ELSE delay := second DIV 20
- END;
- RETURN delay
- END ScrollDelay;
- PROCEDURE ScrollWhileTracking (c: StdCtrl; f: Views.Frame; VAR x0, y0, x, y: INTEGER);
- (* currently, there are no provisions to scroll while tracking inside an embedded view *)
- VAR now: LONGINT; (* normalize: BOOLEAN; *) scr: Controllers.ScrollMsg;
- BEGIN
- (* normalize := c.view.context.Normalize(); *)
- now := Services.Ticks();
- IF x < f.l THEN x0 := x; x := f.l ELSIF x > f.r THEN x0 := x; x := f.r END;
- IF (y < f.t) (* & normalize*) THEN
- IF c.lastStep + ScrollDelay(f.t - y) <= now THEN
- c.lastStep := now;
- scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.decLine;
- scr.done := FALSE;
- Controllers.ForwardVia(Controllers.frontPath, scr)
- END
- ELSIF (y > f.b) (* & normalize *) THEN
- IF c.lastStep + ScrollDelay(y - f.b) <= now THEN
- c.lastStep := now;
- scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.incLine;
- scr.done := FALSE;
- Controllers.ForwardVia(Controllers.frontPath, scr)
- END
- ELSE
- y0 := y
- END
- END ScrollWhileTracking;
- PROCEDURE (c: StdCtrl) TrackMarks (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN);
- VAR s: TrackState; pos, beg, end, pin0, pin1, p, p1: INTEGER;
- modifiers: SET; mode, m: INTEGER; isDown, noSel: BOOLEAN;
- BEGIN
- IF c.opts * Containers.mask # Containers.mask THEN (* track caret or selection *)
- s.x := x; s.y := y; s.toggle := extend;
- noSel := Containers.noSelection IN c.opts;
- IF units & ~noSel THEN (* select units, i.e. words or lines *)
- GetThisChunk(c, f, s, beg, end, mode)
- ELSE (* set caret or selection *)
- mode := none
- END;
- PrepareToTrack(c, f, s, mode, pin0, pin1, p); x := s.x; y := s.y;
- beg := pin0; end := pin1;
- IF p < pin0 THEN beg := p ELSIF p > pin1 THEN end := p END;
- p := -1;
- f.Input(s.x, s.y, modifiers, isDown);
- WHILE isDown DO
- (*
- REPEAT
- f.Input(s.x, s.y, modifiers, isDown);
- *)
- IF (s.x # x) OR (s.y # y) THEN
- ScrollWhileTracking(c, f, x, y, s.x, s.y);
- p1 := ThisPos(c.view, f, s.x, s.y);
- IF p1 # p THEN
- p := p1;
- IF mode IN {words, lines} THEN
- IF mode = words THEN
- GetThisChunk(c, f, s, beg, end, m)
- ELSE
- GetThisLine(c, p, beg, end)
- END;
- IF p > pin0 THEN pos := end ELSE pos := beg END
- ELSE pos := p
- END;
- beg := pin0; end := pin1;
- IF noSel THEN
- c.SetCaret(pos)
- ELSE
- IF pos < pin0 THEN beg := pos ELSIF pos > pin1 THEN end := pos END;
- SetSel(c, beg, end);
- IF c.selPin0 = c.selPin1 THEN
- IF pos < pin0 THEN c.selPin0 := pos; c.selPin1 := pin1
- ELSIF pos > pin1 THEN c.selPin0 := pin0; c.selPin1 := pos
- END
- END
- END
- END
- END;
- f.Input(s.x, s.y, modifiers, isDown)
- END
- (*
- UNTIL ~isDown
- *)
- END
- END TrackMarks;
- PROCEDURE (c: StdCtrl) Resize (v: Views.View; l, t, r, b: INTEGER);
- VAR con: Models.Context;
- BEGIN
- ASSERT(v # NIL, 20); con := v.context;
- ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
- con.SetSize(r - l, b - t)
- END Resize;
- PROCEDURE (c: StdCtrl) DeleteSelection;
- VAR beg, end: INTEGER;
- BEGIN
- beg := c.selBeg; end := c.selEnd;
- IF beg # end THEN
- SmartRange(c, beg, end);
- DoEdit(deletingKey, c, beg, end, NIL, 0X, NIL, 0, 0, NIL, 0, 0, 0)
- END
- END DeleteSelection;
- PROCEDURE (c: StdCtrl) MoveLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
- VAR buf: TextModels.Model; pos, beg0, end0, beg, end, start, len: INTEGER;
- BEGIN
- pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
- (* smart move disabled for now --> use true move instead of copy
- beg0 := c.selBeg; end0 := c.selEnd; beg := beg0; end := end0;
- SmartRange(c, beg, end);
- IF (beg < pos) & (pos < end) THEN pos := beg END;
- buf := TextModels.CloneOf(c.text); buf.CopyFrom(0, c.text, beg0, end0);
- IF OnlyWords(c, beg0, end0) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
- len := end0 - beg0;
- IF start >= end THEN DEC(start, end - beg) END;
- IF pos # beg THEN
- DoEdit(movingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, pos);
- SetSelection(c.text, start, start + len);
- AutoShowRange(c, start, start + len)
- END
- *)
- beg := c.selBeg; end := c.selEnd;
- IF (pos < beg) OR (pos > end) THEN
- len := end - beg; start := pos;
- IF start >= end THEN DEC(start, len) END;
- DoEdit(movingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, c.text, beg, end, pos);
- SetSelection(c.text, start, start + len);
- AutoShowRange(c, start, start + len)
- END
- END MoveLocalSelection;
- PROCEDURE (c: StdCtrl) CopyLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
- VAR buf: TextModels.Model; pos, beg, end, start, len: INTEGER;
- BEGIN
- pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
- beg := c.selBeg; end := c.selEnd;
- IF (beg < pos) & (pos < end) THEN pos := beg END;
- buf := TextModels.CloneOf(c.text); buf.InsertCopy(0, c.text, beg, end);
- IF OnlyWords(c, beg, end) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
- len := end - beg;
- DoEdit(copyingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, buf, 0, -1, pos);
- SetSelection(c.text, start, start + len);
- AutoShowRange(c, start, start + len)
- END CopyLocalSelection;
- PROCEDURE (c: StdCtrl) SelectionCopy (): Containers.Model;
- VAR t: TextModels.Model;
- BEGIN
- IF c.selBeg # c.selEnd THEN
- t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, c.selBeg, c.selEnd);
- ELSE t := NIL
- END;
- RETURN t
- END SelectionCopy;
- PROCEDURE (c: StdCtrl) NativePaste (m: Models.Model; f: Views.Frame);
- VAR beg, end, start: INTEGER;
- BEGIN
- WITH m: TextModels.Model DO
- GetTargetRange(c, beg, end);
- IF beg # none THEN InsertText(c, beg, end, m, start) END
- END
- END NativePaste;
- PROCEDURE (c: StdCtrl) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
- VAR st: TextSetters.Setter; v: TextViews.View; loc: TextViews.Location;
- org, len, p, pos, b, e, beg, end, d, d0, edge, x, dy: INTEGER;
- change, rightEdge, rightDir: BOOLEAN;
- scroll: Controllers.ScrollMsg;
- BEGIN
- c.insAttr := NIL;
- Models.StopBunching(c.text);
- v := c.view; st := v.ThisSetter();
- change := select OR (c.selBeg = c.selEnd);
- IF c.selBeg # c.selEnd THEN beg := c.selBeg; end := c.selEnd
- ELSE beg := c.carPos; end := beg; c.carLast := beg
- END;
- len := c.text.Length();
- rightDir := (ch = aR) OR (ch = pR) OR (ch = dR) OR (ch = aD) OR (ch = pD) OR (ch = dD);
- rightEdge := change & (c.carLast < end)
- OR rightDir & (~change OR (beg = end) & (c.carLast = end));
- IF rightEdge THEN edge := end ELSE edge := beg END;
- ShowPos(c, edge, edge);
- b := beg; e := end; d := edge; d0 := edge;
- CASE ch OF
- | aL:
- IF units THEN
- p := d; e := d;
- WHILE (p > 0) & ((edge = d) OR (edge = e)) DO DEC(p); st.GetWord(p, edge, e) END;
- ELSIF change THEN DEC(edge)
- END
- | pL, dL:
- v.GetThisLocation(f, edge, loc); edge := loc.start
- | aR:
- IF units THEN
- p := d; e := edge;
- WHILE (p < len) & ((edge <= d) OR (edge = e)) DO INC(p); st.GetWord(p, edge, e) END
- ELSIF change THEN INC(edge)
- END
- | pR, dR:
- v.GetThisLocation(f, edge, loc); p := st.NextLine(loc.start);
- IF p = loc.start THEN p := len ELSE DEC(p) END;
- IF p > edge THEN edge := p END
- | aU:
- IF units THEN
- p := st.ThisSequence(edge);
- IF p < edge THEN edge := p ELSE edge := st.PreviousSequence(edge) END
- ELSE
- v.PollOrigin(org, dy); v.GetThisLocation(f, edge, loc);
- IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
- c.carX := x;
- IF loc.start > 0 THEN
- edge := v.ThisPos(f, x, loc.y - 1);
- IF (edge >= loc.start) & (org > 0) THEN
- v.SetOrigin(org - 1, 0);
- v.GetThisLocation(f, edge, loc);
- edge := v.ThisPos(f, x, loc.y - 1)
- END
- END
- END
- | pU:
- v.PollOrigin(org, dy);
- IF edge > org THEN edge := org
- ELSIF org > 0 THEN
- scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.decPage;
- scroll.done := FALSE;
- Views.ForwardCtrlMsg(f, scroll);
- v.PollOrigin(edge, dy)
- END
- | dU:
- edge := 0
- | aD:
- IF units THEN
- p := st.NextSequence(st.ThisSequence(edge));
- IF p > edge THEN edge := p ELSE edge := st.NextSequence(p) END
- ELSE
- v.GetThisLocation(f, edge, loc);
- IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
- c.carX := x;
- edge := v.ThisPos(f, x, loc.y + loc.asc + loc.dsc + 1)
- END
- | pD:
- v.GetRange(f, b, e);
- IF e < len THEN
- scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.incPage;
- scroll.done := FALSE;
- Views.ForwardCtrlMsg(f, scroll);
- v.GetRange(f, edge, e)
- ELSE edge := len
- END
- | dD:
- edge := len
- END;
- IF rightEdge THEN end := edge ELSE beg := edge END;
- IF ~select THEN
- IF rightDir THEN beg := edge ELSE end := edge END
- END;
- IF beg < 0 THEN beg := 0 ELSIF beg > len THEN beg := len END;
- IF end < beg THEN end := beg ELSIF end > len THEN end := len END;
- IF beg = end THEN
- ShowPos(c, beg, end)
- ELSE
- IF rightEdge THEN ShowPos(c, end - 1, end) ELSE ShowPos(c, beg, beg + 1) END
- END;
- SetSel(c, beg, end)
- END ArrowChar;
- PROCEDURE (c: StdCtrl) ControlChar (f: Views.Frame; ch: CHAR);
- BEGIN
- InsertChar(c, ch)
- END ControlChar;
- PROCEDURE (c: StdCtrl) PasteChar (ch: CHAR);
- BEGIN
- InsertChar(c, ch)
- END PasteChar;
- PROCEDURE (c: StdCtrl) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
- VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
- BEGIN
- GetTargetRange(c, beg, end);
- IF beg # none THEN InsertView(c, beg, end, v, w, h) END
- END PasteView;
- PROCEDURE (c: StdCtrl) Drop (src, f: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
- v: Views.View; isSingle: BOOLEAN
- );
- VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
- BEGIN
- pos := ThisPos(c.view, f, x, y);
- WITH v: TextViews.View DO t := v.ThisModel() ELSE t := NIL END;
- IF (t # NIL) & ~isSingle THEN
- InsertText(c, pos, pos, t, start); len := t.Length()
- ELSE
- InsertView(c, pos, pos, v, w, h); start := pos; len := 1
- END;
- SetSelection(c.text, start, start + len);
- AutoShowRange(c, start, start + len)
- END Drop;
- PROCEDURE (c: StdCtrl) PickNativeProp (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property);
- VAR rd: TextModels.Reader;
- BEGIN
- rd := CachedReader(c); rd.SetPos(ThisPos(c.view, f, x, y)); rd.Read;
- IF ~rd.eot THEN p := rd.attr.Prop() ELSE p := NIL END;
- CacheReader(c, rd)
- END PickNativeProp;
- PROCEDURE (c: StdCtrl) HandleModelMsg (VAR msg: Models.Message);
- VAR done: BOOLEAN;
- BEGIN
- c.HandleModelMsg^(msg);
- IF msg.model = c.text THEN
- WITH msg: Models.UpdateMsg DO
- WITH msg: TextModels.UpdateMsg DO
- CASE msg.op OF
- TextModels.insert, TextModels.delete, TextModels.replace:
- UpdateMarks(c, msg.op, msg.beg, msg.end, msg.delta)
- ELSE (* unknown text op happened *)
- c.view.Neutralize
- END
- ELSE (* unknown text update happened *)
- c.view.Neutralize
- END
- | msg: ModelMessage DO
- WITH msg: SetCaretMsg DO
- c.SetCaret(msg.pos)
- | msg: SetSelectionMsg DO
- c.SetSelection(msg.beg, msg.end)
- ELSE
- END
- ELSE
- END
- END
- END HandleModelMsg;
- PROCEDURE (c: StdCtrl) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
- BEGIN
- c.HandleViewMsg^(f, msg);
- IF msg.view = c.view THEN
- WITH msg: ViewMessage DO
- WITH msg: CaretMsg DO
- c.MarkCaret(f, msg.show)
- | msg: SelectionMsg DO
- MarkSelection(c, f, msg.beg, msg.end, msg.show)
- END
- ELSE
- END
- END
- END HandleViewMsg;
- PROCEDURE (c: StdCtrl) HandleCtrlMsg (f: Views.Frame;
- VAR msg: Controllers.Message; VAR focus: Views.View
- );
- VAR g: Views.Frame; beg, end: INTEGER; done: BOOLEAN;
- BEGIN
- IF (msg IS Controllers.MarkMsg) OR (msg IS Controllers.TickMsg) THEN
- beg := c.autoBeg; end := c.autoEnd;
- c.autoBeg := MAX(INTEGER); c.autoEnd := 0
- END;
- WITH msg: Controllers.TickMsg DO
- IF ~(noAutoScroll IN c.opts)
- & (0 <= beg) & (beg <= end) & (end <= c.text.Length())
- & c.view.context.Normalize()
- THEN
- c.view.ShowRange(beg, end, TextViews.focusOnly)
- END;
- IF focus = NIL THEN
- CheckCaret(c); BlinkCaret(c, f, msg.tick);
- IF (c.selBeg # c.aliasSelBeg) OR (c.selEnd # c.aliasSelEnd) THEN
- (* lazy update of text-synchronous alias marks *)
- c.aliasSelBeg := c.selBeg; c.aliasSelEnd := c.selEnd;
- SetSelection(c.text, c.selBeg, c.selEnd)
- END
- END
- | msg: Controllers.MarkMsg DO
- c.carX := -1;
- IF msg.show THEN c.carVisible := TRUE; c.carTick := 0 END
- | msg: Controllers.TrackMsg DO
- c.insAttr := NIL; c.carX := -1; Models.StopBunching(c.text)
- | msg: Controllers.EditMsg DO
- c.lastX := c.carX; c.carX := -1;
- IF focus = NIL THEN CheckCaret(c) END
- | msg: Controllers.ReplaceViewMsg DO
- c.carX := -1
- | msg: Controllers.TransferMessage DO
- c.carX := -1
- | msg: Properties.EmitMsg DO
- c.carX := -1
- ELSE
- END;
- done := FALSE;
- WITH msg: Controllers.CursorMessage DO
- IF TRUE (* Containers.noCaret IN c.opts *) THEN (* mask or browser mode *)
- g := Views.FrameAt(f, msg.x, msg.y);
- IF (g = NIL) OR IsFilter(g.view, c, f, msg.x, msg.y) THEN
- WITH msg: Controllers.PollCursorMsg DO
- FilteredPollCursor(c, f, msg, done)
- | msg: Controllers.TrackMsg DO
- FilteredTrack(c, f, msg, done)
- ELSE
- END
- END
- END
- ELSE
- END;
- IF ~done THEN c.HandleCtrlMsg^(f, msg, focus) END
- END HandleCtrlMsg;
- (* caret *)
- PROCEDURE (c: StdCtrl) HasCaret (): BOOLEAN;
- BEGIN
- RETURN c.carPos # none
- END HasCaret;
- PROCEDURE (c: StdCtrl) MarkCaret (f: Views.Frame; show: BOOLEAN);
- CONST carW = 1; carMinH = 7; (* in frame dots *)
- VAR loc: TextViews.Location; pos, beg, end, u, x, y, w, h: INTEGER; fm: INTEGER;
- BEGIN
- pos := c.carPos;
- IF (pos # none) & f.mark & (f.front & c.carVisible OR ~f.front) THEN
- c.view.GetRange(f, beg, end);
- IF (beg <= pos) & (pos <= end) THEN
- u := f.dot;
- c.view.GetThisLocation(f, pos, loc);
- IF f.front THEN fm := Ports.invert ELSE fm := Ports.dim50 END;
- x := loc.x; y := loc.y; h := loc.asc + loc.dsc;
- IF Dialog.thickCaret THEN w := 2 * carW * u ELSE w := carW * u END;
- IF x >= f.r - w THEN DEC(x, w) END;
- IF h < carMinH * u THEN h := carMinH * u END; (* special caret in lines of (almost) zero height *)
- f.MarkRect(x, y, x + w, y + h, Ports.fill, fm, show)
- END
- END
- END MarkCaret;
- PROCEDURE (c: StdCtrl) CaretPos (): INTEGER;
- BEGIN
- RETURN c.carPos
- END CaretPos;
- PROCEDURE (c: StdCtrl) SetCaret (pos: INTEGER);
- BEGIN
- ASSERT(none <= pos, 20); ASSERT(pos <= c.text.Length(), 21);
- c.insAttr := NIL;
- IF pos # c.carPos THEN
- IF (pos # none) & (c.carPos = none) THEN
- IF boundCaret THEN c.SetSelection(none, none) END;
- c.SetFocus(NIL)
- END;
- IF Containers.noCaret IN c.opts THEN pos := none END;
- IF c.carPos # none THEN
- c.carLast := c.carPos; FlipCaret(c, Containers.hide)
- END;
- c.carPos := pos;
- IF pos # none THEN
- c.carVisible := TRUE; c.carTick := Services.Ticks() + Dialog.caretPeriod; FlipCaret(c, Containers.show)
- END
- END
- END SetCaret;
- (* selection *)
- PROCEDURE (c: StdCtrl) HasSelection (): BOOLEAN;
- BEGIN
- RETURN c.selBeg # c.selEnd
- END HasSelection;
- PROCEDURE (c: StdCtrl) Selectable (): BOOLEAN;
- BEGIN
- RETURN c.text.Length() > 0
- END Selectable;
- PROCEDURE (c: StdCtrl) SetSingleton (s: Views.View);
- VAR s0: Views.View;
- BEGIN
- s0 := c.Singleton();
- c.SetSingleton^(s);
- s := c.Singleton();
- IF s # s0 THEN
- c.insAttr := NIL;
- IF s # NIL THEN
- c.selBeg := s.context(TextModels.Context).Pos(); c.selEnd := c.selBeg + 1;
- c.selPin0 := c.selBeg; c.selPin1 := c.selEnd
- ELSE c.selBeg := none; c.selEnd := none
- END
- END
- END SetSingleton;
- PROCEDURE (c: StdCtrl) SelectAll (select: BOOLEAN);
- (** extended by subclass to include intrinsic selections **)
- BEGIN
- IF select THEN c.SetSelection(0, c.text.Length()) ELSE c.SetSelection(none, none) END
- END SelectAll;
- PROCEDURE (c: StdCtrl) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
- (* pre: c.selBeg # c.selEnd *)
- (* post: (x, y) in c.selection *)
- VAR b, e: TextViews.Location; y0, y1, y2, y3: INTEGER;
- BEGIN
- c.view.GetThisLocation(f, c.selBeg, b); y0 := b.y; y1 := y0 + b.asc + b.dsc;
- c.view.GetThisLocation(f, c.selEnd, e); y2 := e.y; y3 := y2 + e.asc + e.dsc;
- RETURN ((y >= y0) & (x >= b.x) OR (y >= y1)) & ((y < y2) OR (y < y3) & (x < e.x))
- END InSelection;
- PROCEDURE (c: StdCtrl) MarkSelection (f: Views.Frame; show: BOOLEAN);
- BEGIN
- MarkSelection(c, f, c.selBeg, c.selEnd, show)
- END MarkSelection;
- PROCEDURE (c: StdCtrl) GetSelection (OUT beg, end: INTEGER);
- BEGIN
- beg := c.selBeg; end := c.selEnd
- END GetSelection;
- PROCEDURE (c: StdCtrl) SetSelection (beg, end: INTEGER);
- VAR t: TextModels.Model; rd: TextModels.Reader;
- beg0, end0, p: INTEGER; singleton: BOOLEAN;
- BEGIN
- t := c.text; ASSERT(t # NIL, 20);
- IF Containers.noSelection IN c.opts THEN end := beg
- ELSIF beg # end THEN
- ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= t.Length(), 23)
- END;
- beg0 := c.selBeg; end0 := c.selEnd;
- c.insAttr := NIL;
- IF (beg # beg0) OR (end # end0) THEN
- IF (beg # end) & (c.selBeg = c.selEnd) THEN
- IF boundCaret THEN
- IF c.carPos = end THEN p := c.carPos ELSE p := beg END;
- c.SetCaret(none); c.carLast := p
- END;
- c.SetFocus(NIL);
- c.selPin0 := beg; c.selPin1 := end
- ELSIF boundCaret & (beg = end) THEN
- c.selPin1 := c.selPin0 (* clear selection anchors *)
- END;
- IF beg + 1 = end THEN
- rd := CachedReader(c);
- rd.SetPos(beg); rd.Read; singleton := rd.view # NIL;
- CacheReader(c, rd)
- ELSE singleton := FALSE
- END;
- IF singleton THEN (* native or singleton -> singleton *)
- IF rd.view # c.Singleton() THEN c.SetSingleton(rd.view) END
- ELSIF c.Singleton() # NIL THEN (* singleton -> native *)
- c.SetSingleton(NIL);
- c.selBeg := beg; c.selEnd := end;
- FlipSelection(c, beg, end, Containers.show)
- ELSE (* native -> native *)
- c.selBeg := beg; c.selEnd := end;
- IF (beg0 <= beg) & (end <= end0) THEN (* reduce *)
- p := end0; end0 := beg; beg := end; end := p
- ELSIF (beg <= beg0) & (end0 <= end) THEN (* extend *)
- p := end; end := beg0; beg0 := end0; end0 := p
- ELSIF (beg <= beg0) & (beg0 <= end) THEN (* shift left *)
- p := end; end := beg0; beg0 := p
- ELSIF (end >= end0) & (beg <= end0) THEN (* shift right *)
- p := end0; end0 := beg; beg := p
- END;
- IF beg0 < end0 THEN FlipSelection(c, beg0, end0, Containers.show) END;
- IF beg < end THEN FlipSelection(c, beg, end, Containers.show) END
- END
- END
- END SetSelection;
- (* StdDirectory *)
- PROCEDURE (d: StdDirectory) NewController (opts: SET): Controller;
- VAR c: StdCtrl;
- BEGIN
- NEW(c); c.SetOpts(opts); InitMarks(c); RETURN c
- END NewController;
- PROCEDURE Init;
- VAR d: StdDirectory;
- BEGIN
- NEW(d); dir := d; stdDir := d
- END Init;
- BEGIN
- Init
- END TextControllers.
|