Trurl-based/Text/Mod/Controllers.txt

   1 MODULE TextControllers;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Controllers.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT
   7                 Services, Stores, Ports, Models, Views, Dialog, Controllers, Properties, Containers,
   8                 TextModels, TextRulers, TextSetters, TextViews;
   9
  10         CONST
  11                 noAutoScroll* = 16; noAutoIndent* = 17;
  12
  13                 (** Controller.SetCaret pos; Controller.SetSelection beg, end **)
  14                 none* = -1;
  15
  16                 (* Track mode *)
  17                 chars = 0; words = 1; lines = 2;        (* plus "none", defined above *)
  18
  19                 enter = 3X; rdel = 7X; ldel = 8X;
  20                 aL = 1CX; aR = 1DX; aU = 1EX; aD = 1FX;
  21                 pL = 10X; pR = 11X; pU = 12X; pD = 13X;
  22                 dL = 14X; dR = 15X; dU = 16X; dD = 17X;
  23
  24                 viewcode = TextModels.viewcode;
  25                 tab = TextModels.tab; line = TextModels.line; para = TextModels.para;
  26
  27                 point = Ports.point; mm = Ports.mm; inch16 = Ports.inch DIV 16;
  28
  29                 boundCaret = TRUE;
  30                 lenCutoff = 2000;       (* max run length inspected to fetch properties *)
  31
  32                 attrChangeKey = "#Text:AttributeChange";
  33                 resizingKey = "#System:Resizing";
  34                 insertingKey = "#System:Inserting";
  35                 deletingKey = "#System:Deleting";
  36                 movingKey = "#System:Moving";
  37                 copyingKey = "#System:Copying";
  38                 linkingKey = "#System:Linking";
  39                 replacingKey = "#System:Replacing";
  40
  41                 minVersion = 0; maxVersion = 0; maxStdVersion = 0;
  42
  43
  44         TYPE
  45                 Controller* = POINTER TO ABSTRACT RECORD (Containers.Controller)
  46                         view-: TextViews.View;
  47                         text-: TextModels.Model (** view # NIL => text = view.ThisText() **)
  48                 END;
  49
  50                 Directory* = POINTER TO ABSTRACT RECORD (Containers.Directory) END;
  51
  52
  53                 FilterPref* = RECORD (Properties.Preference)
  54                         controller*: Controller;        (** IN, set to text controller asking for filter **)
  55                         frame*: Views.Frame;    (** IN, set to frame of controlled text view **)
  56                         x*, y*: INTEGER;        (** IN, set to coordinates of cursor in frame space **)
  57                         filter*: BOOLEAN        (** preset to FALSE **)
  58                 END;
  59
  60                 FilterPollCursorMsg* = RECORD (Controllers.Message)
  61                         controller*: Controller;        (** IN, set to text controller asking for filter **)
  62                         x*, y*: INTEGER;
  63                         cursor*: INTEGER;       (** as for Controllers.PollCursorMsg **)
  64                         done*: BOOLEAN  (** OUT; initialized to FALSE **)
  65                 END;
  66
  67                 FilterTrackMsg* = RECORD (Controllers.Message)
  68                         controller*: Controller;        (** IN, set to text controller asking for filter **)
  69                         x*, y*: INTEGER;
  70                         modifiers*: SET;        (** as for Controllers.TrackMsg **)
  71                         done*: BOOLEAN  (** OUT; initialized to FALSE **)
  72                 END;
  73
  74
  75                 StdCtrl = POINTER TO RECORD (Controller)
  76                         (* general state *)
  77                         cachedRd: TextModels.Reader;
  78                         cachedWr: TextModels.Writer;
  79                         insAttr: TextModels.Attributes;  (* preset attrs for next typed char *)
  80                         autoBeg, autoEnd: INTEGER;      (* lazy auto-scrolling;
  81                                                                                                                                 invalid if (-1, .); initially (MAX(LONGINT), 0) *)
  82                         (* caret *)
  83                         carPos: INTEGER;        (* HasCaret()  iff  0 <= carPos <= text.Length() *)
  84                         carLast: INTEGER;       (* used to recover caret at meaningful position *)
  85                         carX, lastX: INTEGER;   (* arrow up/down anti-aliasing *)
  86                         carTick: LONGINT;       (* next tick to invert flashing caret mark *)
  87                         carVisible: BOOLEAN;    (* caret currently visible - used for flashing caret *)
  88                         (* selection *)
  89                         selBeg, selEnd: INTEGER;        (* HasSel()  iff  0 <= selBeg < selEnd <= text.Length() *)
  90                         aliasSelBeg, aliasSelEnd: INTEGER;      (* need lazy synchronization? *)
  91                         selPin0, selPin1: INTEGER;      (* anchor points of selection *)
  92                         (* most recent scroll-while-tracking step *)
  93                         lastStep: LONGINT
  94                 END;
  95
  96                 StdDirectory = POINTER TO RECORD (Directory) END;
  97
  98
  99                 (* messages *)
 100
 101                 ModelMessage* = ABSTRACT RECORD (Models.Message) END;
 102                         (** messages to control virtual model extensions, such as marks **)
 103
 104                 SetCaretMsg* = EXTENSIBLE RECORD (ModelMessage)
 105                         pos*: INTEGER
 106                 END;
 107
 108                 SetSelectionMsg* = EXTENSIBLE RECORD (ModelMessage)
 109                         beg*, end*: INTEGER
 110                 END;
 111
 112
 113                 ViewMessage = ABSTRACT RECORD (Views.Message) END;
 114
 115                 CaretMsg = RECORD (ViewMessage)
 116                         show: BOOLEAN
 117                 END;
 118
 119                 SelectionMsg = RECORD (ViewMessage)
 120                         beg, end: INTEGER;
 121                         show: BOOLEAN
 122                 END;
 123
 124
 125                 (* miscellaneous *)
 126
 127                 TrackState = RECORD
 128                         x, y: INTEGER;
 129                         toggle: BOOLEAN
 130                 END;
 131
 132
 133         VAR
 134                 dir-, stdDir-: Directory;
 135
 136
 137         PROCEDURE CachedReader (c: StdCtrl): TextModels.Reader;
 138                 VAR rd: TextModels.Reader;
 139         BEGIN
 140                 rd := c.text.NewReader(c.cachedRd); c.cachedRd := NIL; RETURN rd
 141         END CachedReader;
 142
 143         PROCEDURE CacheReader (c: StdCtrl; rd: TextModels.Reader);
 144         BEGIN
 145                 c.cachedRd := rd
 146         END CacheReader;
 147
 148
 149         PROCEDURE CachedWriter (c: StdCtrl; attr: TextModels.Attributes): TextModels.Writer;
 150                 VAR wr: TextModels.Writer;
 151         BEGIN
 152                 wr := c.text.NewWriter(c.cachedWr); wr.SetAttr(attr);
 153                 c.cachedRd := NIL; RETURN wr
 154         END CachedWriter;
 155
 156         PROCEDURE CacheWriter (c: StdCtrl; wr: TextModels.Writer);
 157         BEGIN
 158                 c.cachedWr := wr
 159         END CacheWriter;
 160
 161
 162         (** Controller **)
 163
 164         PROCEDURE (c: Controller) Internalize2- (VAR rd: Stores.Reader), EXTENSIBLE;
 165                 VAR v: INTEGER;
 166         BEGIN
 167                 (* c.Internalize^(rd); *)
 168                 rd.ReadVersion(minVersion, maxVersion, v)
 169         END Internalize2;
 170
 171         PROCEDURE (c: Controller) Externalize2- (VAR wr: Stores.Writer), EXTENSIBLE;
 172         BEGIN
 173                 (* c.Externalize^(wr); *)
 174                 wr.WriteVersion(maxVersion)
 175         END Externalize2;
 176
 177         PROCEDURE (c: Controller) InitView2* (v: Views.View), EXTENSIBLE;
 178         BEGIN
 179                 ASSERT((v = NIL) # (c.view = NIL), 21);
 180                 IF c.view = NIL THEN ASSERT(v IS TextViews.View, 22) END;
 181                 (* c.InitView^(v); *)
 182                 IF v # NIL THEN c.view := v(TextViews.View); c.text := c.view.ThisModel()
 183                 ELSE c.view := NIL; c.text := NIL
 184                 END
 185         END InitView2;
 186
 187         PROCEDURE (c: Controller) ThisView* (): TextViews.View, EXTENSIBLE;
 188         BEGIN
 189                 RETURN c.view
 190         END ThisView;
 191
 192
 193         (** caret **)
 194
 195         PROCEDURE (c: Controller) CaretPos* (): INTEGER, NEW, ABSTRACT;
 196         PROCEDURE (c: Controller) SetCaret* (pos: INTEGER), NEW, ABSTRACT;
 197         (** pre: pos = none  OR  0 <= pos <= c.text.Length() **)
 198         (** post: c.carPos = pos **)
 199
 200
 201         (** selection **)
 202
 203         PROCEDURE (c: Controller) GetSelection* (OUT beg, end: INTEGER), NEW, ABSTRACT;
 204         (** post: beg = end  OR  0 <= beg <= end <= c.text.Length() **)
 205
 206         PROCEDURE (c: Controller) SetSelection* (beg, end: INTEGER), NEW, ABSTRACT;
 207         (** pre: beg = end  OR  0 <= beg < end <= c.text.Length() **)
 208         (** post: c.selBeg = beg, c.selEnd = end **)
 209
 210
 211         (** Directory **)
 212
 213         PROCEDURE (d: Directory) NewController* (opts: SET): Controller, ABSTRACT;
 214
 215         PROCEDURE (d: Directory) New* (): Controller, EXTENSIBLE;
 216         BEGIN
 217                 RETURN d.NewController({})
 218         END New;
 219
 220
 221         (** miscellaneous **)
 222
 223         PROCEDURE SetDir* (d: Directory);
 224         BEGIN
 225                 ASSERT(d # NIL, 20); dir := d
 226         END SetDir;
 227
 228         PROCEDURE Install*;
 229         BEGIN
 230                 TextViews.SetCtrlDir(dir)
 231         END Install;
 232
 233
 234         PROCEDURE Focus* (): Controller;
 235                 VAR v: Views.View; c: Containers.Controller;
 236         BEGIN
 237                 v := Controllers.FocusView();
 238                 IF (v # NIL) & (v IS TextViews.View) THEN
 239                         c := v(TextViews.View).ThisController();
 240                         IF (c # NIL) & (c IS Controller) THEN RETURN c(Controller)
 241                         ELSE RETURN NIL
 242                         END
 243                 ELSE RETURN NIL
 244                 END
 245         END Focus;
 246
 247
 248         PROCEDURE SetCaret* (text: TextModels.Model; pos: INTEGER);
 249         (** pre: text # NIL,  pos = none  OR  0 <= pos <= text.Length() **)
 250                 VAR cm: SetCaretMsg;
 251         BEGIN
 252                 ASSERT(text # NIL, 20); ASSERT(none <= pos, 21); ASSERT(pos <= text.Length(), 22);
 253                 cm.pos := pos; Models.Broadcast(text, cm)
 254         END SetCaret;
 255
 256         PROCEDURE SetSelection* (text: TextModels.Model; beg, end: INTEGER);
 257         (** pre: text # NIL,  beg = end  OR  0 <= beg < end <= text.Length() **)
 258                 VAR sm: SetSelectionMsg;
 259         BEGIN
 260                 ASSERT(text # NIL, 20);
 261                 IF beg # end THEN
 262                         ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= text.Length(), 23)
 263                 END;
 264                 sm.beg := beg; sm.end := end; Models.Broadcast(text, sm)
 265         END SetSelection;
 266
 267
 268         (* support for cursor/selection/focus marking *)
 269
 270         PROCEDURE BlinkCaret (c: StdCtrl; f: Views.Frame; tick: INTEGER);
 271                 VAR vis: BOOLEAN;
 272         BEGIN
 273                 IF (c.carPos # none) & f.front & (tick >= c.carTick) THEN
 274                         IF c.carVisible THEN
 275                                 c.MarkCaret(f, Containers.hide); c.carVisible := FALSE
 276                         ELSE
 277                                 c.carVisible := TRUE; c.MarkCaret(f, Containers.show)
 278                         END;
 279                         c.carTick := tick + Dialog.caretPeriod
 280                 END
 281         END BlinkCaret;
 282
 283         PROCEDURE FlipCaret (c: StdCtrl; show: BOOLEAN);
 284                 VAR msg: CaretMsg;
 285         BEGIN
 286                 msg.show := show;
 287                 Views.Broadcast(c.view, msg)
 288         END FlipCaret;
 289
 290         PROCEDURE CheckCaret (c: StdCtrl);
 291                 VAR text: TextModels.Model; len, pos: INTEGER;
 292         BEGIN
 293                 IF ~(Containers.noCaret IN c.opts) THEN
 294                         IF (c.carPos = none) & ~(boundCaret & (c.selBeg # c.selEnd)) & (c.ThisFocus() = NIL) THEN
 295                                 text := c.text; len := text.Length(); pos := c.carLast;
 296                                 IF pos < 0 THEN pos := 0 ELSIF pos > len THEN pos := len END;
 297                                 (* c.carVisible := FALSE; c.carTick := 0;       (* force visible mark *) *)
 298                                 SetCaret(text, pos)
 299                         END
 300                 ELSE c.carPos := none
 301                 END
 302         END CheckCaret;
 303
 304
 305
 306         PROCEDURE HiliteRect (f: Views.Frame; l, t, r, b, s: INTEGER; show: BOOLEAN);
 307         BEGIN
 308                 IF s = Ports.fill THEN
 309                         f.MarkRect(l, t, r, b, Ports.fill, Ports.hilite, show)
 310                 ELSE
 311                         f.MarkRect(l, t, r - s, t + s, s, Ports.hilite, show);
 312                         f.MarkRect(l, t + s, l + s, b - s, s, Ports.hilite, show);
 313                         f.MarkRect(l + s, b - s, r, b, s, Ports.hilite, show);
 314                         f.MarkRect(r - s, t + s, r, b - s, s, Ports.hilite, show)
 315                 END
 316         END HiliteRect;
 317
 318         PROCEDURE MarkSelRange (c: StdCtrl; f: Views.Frame; b, e: TextViews.Location;
 319                 front, show: BOOLEAN
 320         );
 321                 VAR fw, ff, r, t: INTEGER;
 322         BEGIN
 323                 IF front THEN fw := 0; ff := Ports.fill ELSE fw := f.dot; ff := fw END;
 324                 IF b.start # e.start THEN
 325                         r := f.r; t := b.y + b.asc + b.dsc;
 326                         HiliteRect(f, b.x, b.y, r + fw, t + fw, ff, show);
 327                         IF t < e.y THEN HiliteRect(f, 0, t, r + fw, e.y + fw, ff, show) END;
 328                         b.x := f.l; b.y := e.y
 329                 END;
 330                 HiliteRect(f, b.x, b.y, e.x + fw, e.y + e.asc + e.dsc + fw, ff, show)
 331         END MarkSelRange;
 332
 333         PROCEDURE MarkSelection (c: StdCtrl; f: Views.Frame; beg, end: INTEGER; show: BOOLEAN);
 334                 VAR b, e: TextViews.Location; s: Views.View;
 335         BEGIN
 336                 IF (beg # end) & f.mark THEN
 337                         ASSERT(beg < end, 20);
 338                         s := c.Singleton();
 339                         IF s # NIL THEN
 340                                 IF beg + 1 = end THEN Containers.MarkSingleton(c, f, show) END
 341                         ELSE
 342                                 c.view.GetThisLocation(f, beg, b); c.view.GetThisLocation(f, end, e);
 343                                 IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
 344                                         MarkSelRange(c, f, b, e, f.front, show)
 345                                 END
 346                         END
 347                 END
 348         END MarkSelection;
 349
 350         PROCEDURE FlipSelection (c: StdCtrl; beg, end: INTEGER; show: BOOLEAN);
 351                 VAR msg: SelectionMsg;
 352         BEGIN
 353                 msg.beg := beg; msg.end := end; msg.show := show;
 354                 Views.Broadcast(c.view, msg)
 355         END FlipSelection;
 356
 357
 358         PROCEDURE InitMarks (c: StdCtrl);
 359         BEGIN
 360                 c.autoBeg := MAX(INTEGER); c.autoEnd := 0;
 361                 c.carPos := none; c.carVisible := FALSE; c.carLast := none; c.carTick := 0; c.carX := -1;
 362                 c.selBeg := none; c.selEnd := none;
 363                 c.lastStep := 0
 364         END InitMarks;
 365
 366         PROCEDURE AutoShowRange (c: StdCtrl; beg, end: INTEGER);
 367         BEGIN
 368                 IF (beg <= c.autoBeg) & (c.autoEnd <= end) THEN
 369                         c.autoBeg := beg; c.autoEnd := end      (* new range includes old range: expand *)
 370                 ELSE
 371                         c.autoBeg := -1 (* schizopheric scroll request -> don't scroll at all *)
 372                 END
 373         END AutoShowRange;
 374
 375         PROCEDURE UpdateMarks (c: StdCtrl; op: INTEGER; beg, end, delta: INTEGER);
 376         (* ensure that marks are valid after updates *)
 377         BEGIN
 378                 CASE op OF
 379                   TextModels.insert:
 380                         c.carLast := end; c.selBeg := end; c.selEnd := end; beg := end
 381                 | TextModels.delete:
 382                         c.carLast := beg; c.selBeg := beg; c.selEnd := beg; end := beg
 383                 | TextModels.replace:
 384                 ELSE
 385                         HALT(100)
 386                 END;
 387                 AutoShowRange(c, beg, end)
 388         END UpdateMarks;
 389
 390
 391         (* support for smart cut/copy/paste and attributing *)
 392
 393         PROCEDURE LegalChar (ch: CHAR): BOOLEAN;
 394         BEGIN
 395                 IF ch < 100X THEN
 396                         CASE ORD(ch) OF
 397                                 ORD(viewcode),
 398                                 ORD(tab), ORD(line), ORD(para),
 399                                 ORD(" ") .. 7EH, 80H .. 0FFH: RETURN TRUE
 400                         ELSE RETURN FALSE
 401                         END
 402                 ELSE RETURN TRUE
 403                 END
 404         END LegalChar;
 405
 406         PROCEDURE LeftTerminator (ch: CHAR): BOOLEAN;
 407         BEGIN
 408                 IF ch < 100X THEN
 409                         CASE ch OF
 410                                 viewcode, tab, line, para, '"', "'", "(", "[", "{": RETURN TRUE
 411                         ELSE RETURN FALSE
 412                         END
 413                 ELSE RETURN TRUE
 414                 END
 415         END LeftTerminator;
 416
 417         PROCEDURE RightTerminator (ch, ch1: CHAR): BOOLEAN;
 418         BEGIN
 419                 IF ch < 100X THEN
 420                         CASE ch OF
 421                           0X, viewcode, tab, line, para,
 422                           "!", '"', "'", "(", ")", ",", ";", "?", "[", "]", "{", "}": RETURN TRUE
 423                         | ".", ":":
 424                                 CASE ch1 OF
 425                                   0X, viewcode, tab, line, para, " ": RETURN TRUE
 426                                 ELSE RETURN FALSE
 427                                 END
 428                         ELSE RETURN FALSE
 429                         END
 430                 ELSE RETURN TRUE
 431                 END
 432         END RightTerminator;
 433
 434         PROCEDURE ReadLeft (rd: TextModels.Reader; pos: INTEGER; OUT ch: CHAR);
 435         BEGIN
 436                 IF pos > 0 THEN rd.SetPos(pos - 1); rd.ReadChar(ch)
 437                 ELSE rd.SetPos(pos); ch := " "
 438                 END
 439         END ReadLeft;
 440
 441         PROCEDURE SmartRange (c: StdCtrl; VAR beg, end: INTEGER);
 442         (* if possible and whole words are covered,
 443         extend [beg, end) to encompass either a leading or a trailing blank *)
 444                 VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR; rightTerm: BOOLEAN;
 445         BEGIN
 446 (*
 447 disable intelligent delete/cut/move for now
 448                 rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
 449                 IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN
 450                         (* range covers beg of word *)
 451                         we := beg; be := beg;
 452                         WHILE (ch # 0X) & (be <= end) DO
 453                                 ch1 := ch; rd.ReadChar(ch); INC(be);
 454                                 IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN we := be END
 455                         END;
 456                         rightTerm := RightTerminator(ch1, ch);
 457                         IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN
 458                                 (* range covers end of word *)
 459                                 IF (we < be) & (ch1 = " ") THEN
 460                                         INC(end)        (* include trailing blank *)
 461                                 ELSIF (beg > 0) & rightTerm & (ch0 = " ") THEN
 462                                         DEC(beg)        (* include leading blank *)
 463                                 END
 464                         END
 465                 END;
 466                 CacheReader(c, rd)
 467 *)
 468         END SmartRange;
 469
 470         PROCEDURE OnlyWords (c: StdCtrl; beg, end: INTEGER): BOOLEAN;
 471                 VAR rd: TextModels.Reader; we, be: INTEGER; ch, ch0, ch1: CHAR;
 472                         rightTerm, words: BOOLEAN;
 473         BEGIN
 474                 words := FALSE;
 475                 rd := CachedReader(c); ReadLeft(rd, beg, ch0); rd.ReadChar(ch);
 476                 IF ((ch0 <= " ") OR LeftTerminator(ch0)) & (ch # " ") THEN      (* range covers beg of word *)
 477                         we := beg; be := beg;
 478                         WHILE (ch # 0X) & (be <= end) DO
 479                                 ch1 := ch; rd.ReadChar(ch); INC(be);
 480                                 IF (ch1 # " ") & ((be <= end) OR ~RightTerminator(ch1, ch)) THEN
 481                                         we := be
 482                                 END
 483                         END;
 484                         rightTerm := RightTerminator(ch1, ch);
 485                         IF (beg < we) & (we = end) & ((we < be) OR rightTerm) THEN      (* range covers end of word *)
 486                                 words := TRUE
 487                         END
 488                 END;
 489                 CacheReader(c, rd);
 490                 RETURN words
 491         END OnlyWords;
 492
 493         PROCEDURE GetTargetField (t: TextModels.Model; pos: INTEGER;
 494                 VAR touchL, touchM, touchR: BOOLEAN
 495         );
 496                 VAR rd: TextModels.Reader; ch0, ch1: CHAR; leftTerm, rightTerm: BOOLEAN;
 497         BEGIN
 498                 rd := t.NewReader(NIL); ReadLeft(rd, pos, ch0); rd.ReadChar(ch1);
 499                 leftTerm := (ch0 <= " ") OR LeftTerminator(ch0);
 500                 rightTerm := (ch1 <= " ") OR RightTerminator(ch1, 0X);
 501                 touchL := ~leftTerm & rightTerm;
 502                 touchM := ~leftTerm & ~rightTerm;
 503                 touchR := leftTerm & ~rightTerm
 504         END GetTargetField;
 505
 506         PROCEDURE LeftExtend (t: TextModels.Model; attr: TextModels.Attributes);
 507                 VAR wr: TextModels.Writer;
 508         BEGIN
 509                 wr := t.NewWriter(NIL); wr.SetAttr(attr); wr.SetPos(0); wr.WriteChar(" ")
 510         END LeftExtend;
 511
 512         PROCEDURE RightExtend (t: TextModels.Model; attr: TextModels.Attributes);
 513                 VAR wr: TextModels.Writer;
 514         BEGIN
 515                 wr := t.NewWriter(NIL); wr.SetPos(t.Length()); wr.SetAttr(attr); wr.WriteChar(" ")
 516         END RightExtend;
 517
 518         PROCEDURE MergeAdjust (target, inset: TextModels.Model; pos: INTEGER; OUT start: INTEGER);
 519                 VAR rd: TextModels.Reader; a: TextModels.Attributes; ch, ch1: CHAR;
 520                         touchL, touchM, touchR: BOOLEAN;
 521         BEGIN
 522                 start := pos;
 523 (*
 524 disable intelligent paste for now
 525                 GetTargetField(target, pos, touchL, touchM, touchR);
 526                 IF touchL THEN
 527                         rd := inset.NewReader(NIL); rd.SetPos(0);
 528                         rd.ReadChar(ch); a := rd.attr; rd.ReadChar(ch1);
 529                         IF (ch > " ") & ~RightTerminator(ch, ch1) THEN LeftExtend(inset, a); INC(start) END
 530                 END;
 531                 IF touchR & (inset.Length() > 0) THEN
 532                         rd := inset.NewReader(rd); rd.SetPos(inset.Length() - 1); rd.ReadChar(ch);
 533                         IF (ch > " ") & ~LeftTerminator(ch) THEN RightExtend(inset, rd.attr) END
 534                 END
 535 *)
 536         END MergeAdjust;
 537
 538
 539         PROCEDURE InsertionAttr (c: StdCtrl): TextModels.Attributes;
 540                 VAR rd: TextModels.Reader; r: TextRulers.Ruler; a: TextModels.Attributes; ch: CHAR;
 541         BEGIN
 542                 a := c.insAttr;
 543                 IF a = NIL THEN
 544                         rd := CachedReader(c); a := NIL;
 545                         IF c.carPos # none THEN
 546                                 ReadLeft(rd, c.carPos, ch); a := rd.attr;
 547                                 IF ((ch <= " ") OR (ch = TextModels.nbspace)) & (c.carPos < c.text.Length()) THEN
 548                                         rd.ReadChar(ch);
 549                                         IF ch > " " THEN a := rd.attr END
 550                                 END
 551                         ELSIF boundCaret & (c.selBeg # c.selEnd) THEN
 552                                 rd.SetPos(c.selBeg); rd.ReadChar(ch); a := rd.attr;
 553                                 c.insAttr := a
 554                         END;
 555                         IF a = NIL THEN c.view.PollDefaults(r, a) END;
 556                         CacheReader(c, rd)
 557                 END;
 558                 RETURN a
 559         END InsertionAttr;
 560
 561
 562         PROCEDURE GetTargetRange (c: StdCtrl; OUT beg, end: INTEGER);
 563         BEGIN
 564                 IF boundCaret & (c.selBeg # c.selEnd) THEN
 565                         beg := c.selBeg; end := c.selEnd
 566                 ELSE
 567                         beg := c.carPos; end := beg
 568                 END
 569         END GetTargetRange;
 570
 571
 572         PROCEDURE DoEdit (name: Stores.OpName;
 573                 c: StdCtrl; beg, end: INTEGER;
 574                 attr: TextModels.Attributes; ch: CHAR; view: Views.View; w, h: INTEGER;
 575                 buf: TextModels.Model; bufbeg, bufend: INTEGER; (* buf # NIL & bufend < 0: bufend = buf.Length() *)
 576                 pos: INTEGER
 577         );
 578                 VAR script: Stores.Operation; wr: TextModels.Writer; cluster: BOOLEAN;
 579         BEGIN
 580                 IF (beg < end)  (* something to delete *)
 581                 OR (attr # NIL) (* something new to write *)
 582                 OR (buf # NIL)  (* something new to insert *)
 583                 THEN
 584                         cluster := (beg < end) OR (attr = NIL) OR (view # NIL);
 585                         (* don't script when typing a single character -> TextModels will bunch if possible *)
 586                         (* ~cluster => name is reverted to #System.Inserting by TextModels *)
 587                         IF cluster THEN Models.BeginScript(c.text, name, script) END;
 588                         IF beg < end THEN
 589                                 c.text.Delete(beg, end);
 590                                 IF pos > beg THEN DEC(pos, end - beg) END
 591                         END;
 592                         IF attr # NIL THEN
 593                                 ASSERT(buf = NIL, 20);
 594                                 wr := CachedWriter(c, attr); wr.SetPos(pos);
 595                                 IF view # NIL THEN wr.WriteView(view, w, h) ELSE wr.WriteChar(ch) END;
 596                                 CacheWriter(c, wr)
 597                         ELSIF buf # NIL THEN
 598                                 IF bufend < 0 THEN bufend := buf.Length() END;
 599                                 c.text.Insert(pos, buf, bufbeg, bufend)
 600                         END;
 601                         IF cluster THEN Models.EndScript(c.text, script) END;
 602                         CheckCaret(c)
 603                 END
 604         END DoEdit;
 605
 606
 607         (* editing *)
 608
 609         PROCEDURE ThisPos (v: TextViews.View; f: Views.Frame; x, y: INTEGER): INTEGER;
 610                 VAR loc: TextViews.Location; pos: INTEGER;
 611         BEGIN
 612                 pos := v.ThisPos(f, x, y); v.GetThisLocation(f, pos, loc);
 613                 IF (loc.view # NIL) & (x > (loc.l + loc.r) DIV 2) THEN INC(pos) END;
 614                 RETURN pos
 615         END ThisPos;
 616
 617         PROCEDURE ShowPos (c: StdCtrl; beg, end: INTEGER);
 618         BEGIN
 619                 IF ~(noAutoScroll IN c.opts) THEN
 620                         c.view.ShowRange(beg, end, TextViews.focusOnly)
 621                 END
 622         END ShowPos;
 623
 624
 625         PROCEDURE Indentation (c: StdCtrl; pos: INTEGER): TextModels.Model;
 626         (* pre: c.carPos # none *)
 627                 VAR st: TextSetters.Setter; buf: TextModels.Model; rd: TextModels.Reader;
 628                         wr: TextModels.Writer; ch: CHAR; spos: INTEGER;
 629         BEGIN
 630                 buf := NIL;
 631                 rd := CachedReader(c);
 632                 st := c.view.ThisSetter(); spos := st.ThisSequence(pos); rd.SetPos(spos); rd.ReadChar(ch);
 633                 IF (ch = tab) & (spos < pos) THEN
 634                         buf := TextModels.CloneOf(c.text); wr := buf.NewWriter(NIL); wr.SetPos(buf.Length());
 635                         wr.SetAttr(InsertionAttr(c));
 636                         wr.WriteChar(line);
 637                         REPEAT wr.WriteChar(tab); rd.ReadChar(ch) UNTIL (ch # tab) OR (rd.Pos() > pos)
 638                 END;
 639                 CacheReader(c, rd);
 640                 RETURN buf
 641         END Indentation;
 642
 643         PROCEDURE InsertChar (c: StdCtrl; ch: CHAR);
 644                 VAR buf: TextModels.Model; attr: TextModels.Attributes;
 645                         beg, end: INTEGER; legal: BOOLEAN; name: Stores.OpName;
 646         BEGIN
 647                 attr := NIL; buf := NIL;
 648                 IF ch < 100X THEN legal := LegalChar(ch) ELSE legal := TRUE END;        (* should check Unicode *)
 649                 IF (ch = ldel) OR (ch = rdel) THEN name := deletingKey ELSE name := replacingKey END;
 650                 IF boundCaret & (c.selBeg # c.selEnd) & (legal OR (ch = ldel) OR (ch = rdel) OR (ch = enter)) THEN
 651                         beg := c.selBeg; end := c.selEnd;
 652                         IF (ch = ldel) OR (ch = rdel) THEN SmartRange(c, beg, end); ch := 0X END
 653                 ELSE
 654                         beg := c.carPos; end := beg
 655                 END;
 656                 IF (c.carPos # none) OR boundCaret & (c.selBeg # c.selEnd) THEN
 657                         IF (ch = line) OR (ch = enter) THEN
 658                                 IF noAutoIndent IN c.opts THEN buf := NIL ELSE buf := Indentation(c, beg) END;
 659                                 IF buf = NIL THEN ch := line; legal := TRUE ELSE ch := 0X; legal := FALSE END
 660                         END;
 661                         IF legal THEN
 662                                 attr := InsertionAttr(c)
 663                         ELSIF (ch = ldel) & (c.carPos > 0) THEN
 664                                 beg := c.carPos - 1; end := c.carPos
 665                         ELSIF (ch = rdel) & (c.carPos < c.text.Length()) THEN
 666                                 beg := c.carPos; end := c.carPos + 1
 667                         END
 668                 END;
 669                 DoEdit(name, c, beg, end, attr, ch, NIL, 0, 0, buf, 0, -1, beg)
 670         END InsertChar;
 671
 672         PROCEDURE InsertText (c: StdCtrl; beg, end: INTEGER; text: TextModels.Model; OUT start: INTEGER);
 673                 VAR buf: TextModels.Model;
 674         BEGIN
 675                 buf := TextModels.CloneOf(text); buf.InsertCopy(0, text, 0, text.Length());
 676                 IF beg = end THEN MergeAdjust(c.text, buf, beg, start) ELSE start := beg END;
 677                 DoEdit(insertingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, 0, -1, beg)
 678         END InsertText;
 679
 680         PROCEDURE InsertView (c: StdCtrl; beg, end: INTEGER; v: Views.View; w, h: INTEGER);
 681         BEGIN
 682                 DoEdit(insertingKey, c, beg, end, InsertionAttr(c), 0X, v, w, h, NIL, 0, 0, beg)
 683         END InsertView;
 684
 685
 686         PROCEDURE InSubFrame (f, f1: Views.Frame; x, y: INTEGER): BOOLEAN;
 687         BEGIN
 688                 INC(x, f.gx - f1.gx); INC(y, f.gy - f1.gy);
 689                 RETURN (f1.l <= x) & (x < f1.r) & (f1.t <= y) & (y < f1.b)
 690         END InSubFrame;
 691
 692         PROCEDURE InFrame (f: Views.Frame; x, y: INTEGER): BOOLEAN;
 693         BEGIN
 694                 RETURN (f.l <= x) & (x < f.r) & (f.t <= y) & (y < f.b)
 695         END InFrame;
 696
 697
 698         (* filtered tracking *)
 699
 700         PROCEDURE IsFilter (v: Views.View; c: StdCtrl; f: Views.Frame; x, y: INTEGER): BOOLEAN;
 701                 VAR pref: FilterPref;
 702         BEGIN
 703                 pref.controller := c; pref.frame := f; pref.x := x; pref.y := y;
 704                 pref.filter := FALSE;
 705                 Views.HandlePropMsg(v, pref);
 706                 RETURN pref.filter
 707         END IsFilter;
 708
 709         PROCEDURE FindFilter (c: StdCtrl; f: Views.Frame; x, y: INTEGER; OUT filter: Views.View);
 710                 CONST catchRange = 1000;
 711                 VAR rd: TextModels.Reader; pos, beg, end: INTEGER; isF: BOOLEAN;
 712         BEGIN
 713                 c.view.GetRange(f, beg, end); DEC(beg, catchRange);
 714                 pos := c.view.ThisPos(f, x, y);
 715                 IF pos < c.text.Length() THEN INC(pos) END;     (* let filter handle itself *)
 716                 rd := CachedReader(c); rd.SetPos(pos);
 717                 REPEAT
 718                         rd.ReadPrevView(filter);
 719                         isF := (filter # NIL) & IsFilter(filter, c, f, x, y);
 720                 UNTIL isF OR rd.eot OR (rd.Pos() < beg);
 721                 IF ~isF THEN filter := NIL END;
 722                 CacheReader(c, rd)
 723         END FindFilter;
 724
 725         PROCEDURE FilteredPollCursor (c: StdCtrl; f: Views.Frame;
 726                 VAR msg: Controllers.PollCursorMsg; VAR done: BOOLEAN
 727         );
 728                 VAR filter, focus: Views.View; x, y: INTEGER; modifiers: SET; isDown: BOOLEAN; fmsg: FilterPollCursorMsg;
 729         BEGIN
 730                 FindFilter(c, f, msg.x, msg.y, filter);
 731                 IF filter # NIL THEN
 732                         (* f.Input(x, y, modifiers, isDown); *)
 733                         fmsg.x := msg.x; fmsg.y := msg.y; fmsg.cursor := msg.cursor;
 734                         fmsg.controller := c; fmsg.done := FALSE;
 735                         (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
 736                         focus := NIL;
 737                         filter.HandleCtrlMsg(f, fmsg, focus);
 738                         IF fmsg.done THEN msg.cursor := fmsg.cursor END;
 739                         done := fmsg.done
 740                 END
 741         END FilteredPollCursor;
 742
 743         PROCEDURE FilteredTrack (c: StdCtrl; f: Views.Frame;
 744                 VAR msg: Controllers.TrackMsg; VAR done: BOOLEAN
 745         );
 746                 VAR filter, focus: Views.View; fmsg: FilterTrackMsg;
 747         BEGIN
 748                 FindFilter(c, f, msg.x, msg.y, filter);
 749                 IF filter # NIL THEN
 750                         fmsg.x := msg.x; fmsg.y := msg.y; fmsg.modifiers := msg.modifiers;
 751                         fmsg.controller := c; fmsg.done := FALSE;
 752                         (*Views.ForwardCtrlMsg(f, fmsg) - does not work f.view # filter !!*)
 753                         focus := NIL; filter.HandleCtrlMsg(f, fmsg, focus);
 754                         done := fmsg.done
 755                 END
 756         END FilteredTrack;
 757
 758
 759         (* StdCtrl *)
 760
 761         PROCEDURE (c: StdCtrl) Internalize2 (VAR rd: Stores.Reader);
 762                 VAR thisVersion: INTEGER;
 763         BEGIN
 764                 c.Internalize2^(rd);
 765                 IF rd.cancelled THEN RETURN END;
 766                 rd.ReadVersion(minVersion, maxStdVersion, thisVersion);
 767                 IF rd.cancelled THEN RETURN END;
 768                 InitMarks(c)
 769         END Internalize2;
 770
 771         PROCEDURE (c: StdCtrl) Externalize2 (VAR wr: Stores.Writer);
 772         BEGIN
 773                 c.Externalize2^(wr);
 774                 wr.WriteVersion(maxStdVersion)
 775         END Externalize2;
 776
 777         PROCEDURE (c: StdCtrl) CopyFrom (source: Stores.Store);
 778         BEGIN
 779                 c.CopyFrom^(source); InitMarks(c)
 780         END CopyFrom;
 781
 782         PROCEDURE (c: StdCtrl) Neutralize2;
 783         BEGIN
 784                 (* c.Neutralize^; *)
 785                 c.SetCaret(none)
 786         END Neutralize2;
 787
 788         PROCEDURE (c: StdCtrl) GetContextType (OUT type: Stores.TypeName);
 789         BEGIN
 790                 type := "TextViews.View"
 791         END GetContextType;
 792
 793         PROCEDURE (c: StdCtrl) GetValidOps (OUT valid: SET);
 794         BEGIN
 795                 valid := {};
 796                 IF (c.carPos # none) OR (boundCaret & (c.selBeg # c.selEnd)) THEN
 797                         valid := valid + {Controllers.pasteChar, Controllers.paste}
 798                 END;
 799                 IF c.selBeg # c.selEnd THEN
 800                         valid := valid + {Controllers.cut, Controllers.copy}
 801                 END
 802         END GetValidOps;
 803
 804         PROCEDURE (c: StdCtrl) NativeModel (m: Models.Model): BOOLEAN;
 805         BEGIN
 806                 ASSERT(m # NIL, 20);
 807                 RETURN m IS TextModels.Model
 808         END NativeModel;
 809
 810         PROCEDURE (c: StdCtrl) NativeView (v: Views.View): BOOLEAN;
 811         BEGIN
 812                 ASSERT(v # NIL, 20);
 813                 RETURN v IS TextViews.View
 814         END NativeView;
 815
 816         PROCEDURE (c: StdCtrl) NativeCursorAt (f: Views.Frame; x, y: INTEGER): INTEGER;
 817         BEGIN
 818                 RETURN Ports.textCursor
 819         END NativeCursorAt;
 820
 821         PROCEDURE (c: StdCtrl) PollNativeProp (selection: BOOLEAN;
 822                 VAR p: Properties.Property; VAR truncated: BOOLEAN
 823         );
 824                 VAR beg, end: INTEGER;
 825         BEGIN
 826                 IF selection & (c.selBeg = c.selEnd) THEN
 827                         p := InsertionAttr(c).Prop(); truncated := FALSE
 828                 ELSE
 829                         IF selection THEN beg := c.selBeg; end := c.selEnd
 830                         ELSE beg := 0; end := c.text.Length()
 831                         END;
 832 (*
 833                         truncated := (end - beg > lenCutoff);
 834                         IF truncated THEN end := beg + lenCutoff END;
 835 *)
 836                         p := c.text.Prop(beg, end)
 837                 END
 838         END PollNativeProp;
 839
 840         PROCEDURE (c: StdCtrl) SetNativeProp (selection: BOOLEAN; old, p: Properties.Property);
 841                 VAR t: TextModels.Model; beg, end: INTEGER;
 842         BEGIN
 843                 t := c.text;
 844                 IF selection THEN beg := c.selBeg; end := c.selEnd ELSE beg := 0; end := t.Length() END;
 845                 IF beg < end THEN
 846                         t.Modify(beg, end, old, p);
 847                         IF selection THEN c.SetSelection(beg, end) END
 848                 ELSIF selection THEN
 849                         c.insAttr := TextModels.ModifiedAttr(InsertionAttr(c), p)
 850                 END
 851         END SetNativeProp;
 852
 853         PROCEDURE (c: StdCtrl) MakeViewVisible (v: Views.View);
 854                 VAR pos: INTEGER;
 855         BEGIN
 856                 ASSERT(v # NIL, 20);
 857                 ASSERT(v.context # NIL, 21);
 858                 ASSERT(v.context.ThisModel() = c.text, 22);
 859                 pos := v.context(TextModels.Context).Pos();
 860                 ShowPos(c, pos, pos + 1)
 861         END MakeViewVisible;
 862
 863         PROCEDURE (c: StdCtrl) GetFirstView (selection: BOOLEAN; OUT v: Views.View);
 864                 VAR rd: TextModels.Reader; beg, end: INTEGER;
 865         BEGIN
 866                 IF selection THEN beg := c.selBeg; end := c.selEnd
 867                 ELSE beg := 0; end := c.text.Length()
 868                 END;
 869                 IF beg < end THEN
 870                         rd := CachedReader(c); rd.SetPos(beg); rd.ReadView(v);
 871                         IF rd.Pos() > end THEN v := NIL END;
 872                         CacheReader(c, rd)
 873                 ELSE v := NIL
 874                 END
 875         END GetFirstView;
 876
 877         PROCEDURE (c: StdCtrl) GetNextView (selection: BOOLEAN; VAR v: Views.View);
 878                 VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
 879         BEGIN
 880                 ASSERT(v # NIL, 20); con := v.context;
 881                 ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
 882                 IF selection THEN beg := c.selBeg; end := c.selEnd
 883                 ELSE beg := 0; end := c.text.Length()
 884                 END;
 885                 pos := con(TextModels.Context).Pos();
 886                 IF (beg <= pos) & (pos < end) THEN
 887                         rd := CachedReader(c); rd.SetPos(pos + 1); rd.ReadView(v);
 888                         IF rd.Pos() > end THEN v := NIL END;
 889                         CacheReader(c, rd)
 890                 ELSE v := NIL
 891                 END
 892         END GetNextView;
 893
 894         PROCEDURE (c: StdCtrl) GetPrevView (selection: BOOLEAN; VAR v: Views.View);
 895                 VAR con: Models.Context; rd: TextModels.Reader; beg, end, pos: INTEGER;
 896         BEGIN
 897                 ASSERT(v # NIL, 20); con := v.context;
 898                 ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
 899                 IF selection THEN beg := c.selBeg; end := c.selEnd
 900                 ELSE beg := 0; end := c.text.Length()
 901                 END;
 902                 pos := con(TextModels.Context).Pos();
 903                 IF (beg < pos) & (pos <= end) THEN
 904                         rd := CachedReader(c); rd.SetPos(pos); rd.ReadPrevView(v);
 905                         IF rd.Pos() < beg THEN v := NIL END;
 906                         CacheReader(c, rd)
 907                 ELSE v := NIL
 908                 END
 909         END GetPrevView;
 910
 911         PROCEDURE (c: StdCtrl) GetSelectionBounds (f: Views.Frame; OUT x, y, w, h: INTEGER);
 912                 VAR b, e: TextViews.Location;
 913         BEGIN
 914                 c.GetSelectionBounds^(f, x, y, w, h);
 915                 IF w = Views.undefined THEN
 916                         c.view.GetThisLocation(f, c.selBeg, b);
 917                         c.view.GetThisLocation(f, c.selEnd, e);
 918                         IF b.start = e.start THEN x := b.x; w := e.x - b.x;
 919                         ELSE x := f.l; w := f.r - f.l;
 920                         END;
 921                         y := b.y; h := e.y + e.asc + e.dsc - b.y
 922                 END
 923         END GetSelectionBounds;
 924
 925         PROCEDURE (c: StdCtrl) MarkPickTarget (source, f: Views.Frame;
 926                 sx, sy, x, y: INTEGER; show: BOOLEAN
 927         );
 928                 VAR b, e: TextViews.Location; pos: INTEGER;
 929         BEGIN
 930                 pos := c.view.ThisPos(f, x, y);
 931                 IF pos < c.text.Length() THEN
 932                         c.view.GetThisLocation(f, pos, b);
 933                         c.view.GetThisLocation(f, pos + 1, e);
 934                         IF (b.pos < e.pos) OR (b.pos = e.pos) & (b.x < e.x) THEN
 935                                 MarkSelRange(c, f, b, e, TRUE, show)
 936                         END
 937                 END
 938         END MarkPickTarget;
 939
 940         PROCEDURE (c: StdCtrl) MarkDropTarget (source, f: Views.Frame;
 941                 sx, sy, dx, dy, w, h, rx, ry: INTEGER; type: Stores.TypeName; isSingle, show: BOOLEAN
 942         );
 943                 VAR loc: TextViews.Location; pos: INTEGER;
 944         BEGIN
 945                 pos := c.view.ThisPos(f, dx, dy);
 946                 IF (source # NIL) & ((source.view = f.view) OR (source.view.ThisModel() = f.view.ThisModel()))
 947                 & (c.selBeg < pos) & (pos < c.selEnd) THEN
 948                         pos := c.selBeg
 949                 END;
 950                 c.view.GetThisLocation(f, pos, loc);
 951                 f.MarkRect(loc.x, loc.y, loc.x + f.unit, loc.y + loc.asc + loc.dsc, Ports.fill, Ports.invert, show);
 952                 IF (isSingle OR ~Services.Extends(type, "TextViews.View")) & (w > 0) & (h > 0) THEN
 953                         DEC(dx, rx); DEC(dy, ry);
 954                         f.MarkRect(dx, dy, dx + w, dy + h, 0, Ports.dim25, show)
 955                 END
 956         END MarkDropTarget;
 957
 958
 959         PROCEDURE GetThisLine (c: StdCtrl; pos: INTEGER; OUT beg, end: INTEGER);
 960                 VAR st: TextSetters.Setter;
 961         BEGIN
 962                 st := c.view.ThisSetter();
 963                 beg := st.ThisLine(pos); end := st.NextLine(beg);
 964                 IF end = beg THEN end := c.text.Length() END;
 965         END GetThisLine;
 966
 967         PROCEDURE GetThisChunk (c: StdCtrl; f: Views.Frame;
 968                 VAR s: TrackState; OUT beg, end: INTEGER; OUT mode: INTEGER
 969         );
 970                 VAR v: TextViews.View; b, e: TextViews.Location;
 971                         st: TextSetters.Setter; ruler: TextRulers.Ruler; ra: TextRulers.Attributes;
 972                         pos, r: INTEGER;
 973         BEGIN
 974                 v := c.view; st := v.ThisSetter(); pos := ThisPos(v, f, s.x, s.y);
 975                 ruler := TextViews.ThisRuler(v, pos); ra := ruler.style.attr;
 976                 r := ra.right; IF ~(TextRulers.rightFixed IN ra.opts) OR (r > f.r) THEN r := f.r END;
 977                 st.GetWord(pos, beg, end);
 978                 v.GetThisLocation(f, beg, b); v.GetThisLocation(f, end, e);
 979                 IF (s.x < f.l) OR (s.x >= r) THEN       (* outside of line box: whole line *)
 980                         GetThisLine(c, pos, beg, end);
 981                         mode := lines
 982                 ELSIF (s.y < b.y) OR (s.y < b.y + b.asc + b.dsc) & (s.x < b.x)
 983                 OR (s.y >= e.y) & (s.x >= e.x) OR (s.y >= e.y + e.asc + e.dsc) THEN
 984                         (* outside of word: single char *)
 985                         beg := ThisPos(v, f, s.x, s.y); v.GetThisLocation(f, beg, b);
 986                         IF (b.x > s.x) & (beg > 0) THEN DEC(beg) END;
 987                         IF beg < c.text.Length() THEN end := beg + 1 ELSE end := beg END;
 988                         mode := words
 989                 ELSE    (* whole word *)
 990                         mode := words
 991                 END
 992         END GetThisChunk;
 993
 994         PROCEDURE SetSel (c: StdCtrl; beg, end: INTEGER);
 995         (* pre: ~(Containers.noSelection IN c.opts) *)
 996         BEGIN
 997                 IF beg >= end THEN c.SetCaret(beg) ELSE c.SetSelection(beg, end) END
 998         END SetSel;
 999
1000         PROCEDURE PrepareToTrack (c: StdCtrl; f: Views.Frame;
1001                 VAR s: TrackState; mode: INTEGER;
1002                 VAR pin0, pin1, pos: INTEGER
1003         );
1004                 VAR loc: TextViews.Location; beg, end: INTEGER; m: INTEGER;
1005         BEGIN
1006                 pos := ThisPos(c.view, f, s.x, s.y);
1007                 IF mode IN {chars, words, lines} THEN
1008                         GetThisChunk(c, f, s, pin0, pin1, m)
1009                 ELSE pin0 := pos; pin1 := pos
1010                 END;
1011                 IF s.toggle & ((c.selBeg # c.selEnd) OR boundCaret & (c.carPos # none))
1012                 & ~(Containers.noSelection IN c.opts) THEN      (* modify existing selection *)
1013                         IF c.selBeg # c.selEnd THEN
1014                                 beg := c.selBeg; end := c.selEnd
1015                         ELSE
1016                                 beg := c.carPos; end := beg; c.selPin0 := beg; c.selPin1 := beg
1017                         END;
1018                         IF pin1 > c.selPin0 THEN
1019                                 end := pin1; pin0 := beg
1020                         ELSIF pin0 < c.selPin1 THEN
1021                                 beg := pin0; pin0 := end
1022                         END;
1023                         SetSel(c, beg, end);
1024                         pin1 := pin0
1025                 ELSIF mode IN {chars, words, lines} THEN
1026                         SetSel(c, pin0, pin1);
1027                         pos := pin1
1028                 ELSE
1029                         SetCaret(c.text, pos)
1030                 END;
1031                 c.lastStep := Services.Ticks()
1032         END PrepareToTrack;
1033
1034         PROCEDURE ScrollDelay (d: INTEGER): INTEGER;
1035                 VAR second, delay: INTEGER;
1036         BEGIN
1037                 second := Services.resolution;
1038                 IF d < 2 * mm THEN delay := second DIV 2
1039                 ELSIF d < 4 * mm THEN delay := second DIV 3
1040                 ELSIF d < 6 * mm THEN delay := second DIV 5
1041                 ELSIF d < 8 * mm THEN delay := second DIV 10
1042                 ELSE delay := second DIV 20
1043                 END;
1044                 RETURN delay
1045         END ScrollDelay;
1046
1047         PROCEDURE ScrollWhileTracking (c: StdCtrl; f: Views.Frame; VAR x0, y0, x, y: INTEGER);
1048         (* currently, there are no provisions to scroll while tracking inside an embedded view *)
1049                 VAR now: LONGINT; (* normalize: BOOLEAN; *) scr: Controllers.ScrollMsg;
1050         BEGIN
1051                 (* normalize := c.view.context.Normalize(); *)
1052                 now := Services.Ticks();
1053                 IF x < f.l THEN x0 := x; x := f.l ELSIF x > f.r THEN x0 := x; x := f.r END;
1054                 IF (y < f.t) (* & normalize*) THEN
1055                         IF c.lastStep + ScrollDelay(f.t - y) <= now THEN
1056                                 c.lastStep := now;
1057                                 scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.decLine;
1058                                 scr.done := FALSE;
1059                                 Controllers.ForwardVia(Controllers.frontPath, scr)
1060                         END
1061                 ELSIF (y > f.b) (* & normalize *) THEN
1062                         IF c.lastStep + ScrollDelay(y - f.b) <= now THEN
1063                                 c.lastStep := now;
1064                                 scr.focus := TRUE; scr.vertical := TRUE; scr.op := Controllers.incLine;
1065                                 scr.done := FALSE;
1066                                 Controllers.ForwardVia(Controllers.frontPath, scr)
1067                         END
1068                 ELSE
1069                         y0 := y
1070                 END
1071         END ScrollWhileTracking;
1072
1073         PROCEDURE (c: StdCtrl) TrackMarks (f: Views.Frame; x, y: INTEGER; units, extend, add: BOOLEAN);
1074                 VAR s: TrackState; pos, beg, end, pin0, pin1, p, p1: INTEGER;
1075                         modifiers: SET; mode, m: INTEGER; isDown, noSel: BOOLEAN;
1076         BEGIN
1077                 IF c.opts * Containers.mask # Containers.mask THEN      (* track caret or selection *)
1078                         s.x := x; s.y := y; s.toggle := extend;
1079                         noSel := Containers.noSelection IN c.opts;
1080                         IF units & ~noSel THEN  (* select units, i.e. words or lines *)
1081                                 GetThisChunk(c, f, s, beg, end, mode)
1082                         ELSE    (* set caret or selection *)
1083                                 mode := none
1084                         END;
1085                         PrepareToTrack(c, f, s, mode, pin0, pin1, p); x := s.x; y := s.y;
1086                         beg := pin0; end := pin1;
1087                         IF p < pin0 THEN beg := p ELSIF p > pin1 THEN end := p END;
1088                         p := -1;
1089                         f.Input(s.x, s.y, modifiers, isDown);
1090                         WHILE isDown DO
1091 (*
1092                         REPEAT
1093                                 f.Input(s.x, s.y, modifiers, isDown);
1094 *)
1095                                 IF (s.x # x) OR (s.y # y) THEN
1096                                         ScrollWhileTracking(c, f, x, y, s.x, s.y);
1097                                         p1 := ThisPos(c.view, f, s.x, s.y);
1098                                         IF p1 # p THEN
1099                                                 p := p1;
1100                                                 IF mode IN {words, lines} THEN
1101                                                         IF mode = words THEN
1102                                                                 GetThisChunk(c, f, s, beg, end, m)
1103                                                         ELSE
1104                                                                 GetThisLine(c, p, beg, end)
1105                                                         END;
1106                                                         IF p > pin0 THEN pos := end ELSE pos := beg END
1107                                                 ELSE pos := p
1108                                                 END;
1109                                                 beg := pin0; end := pin1;
1110                                                 IF noSel THEN
1111                                                         c.SetCaret(pos)
1112                                                 ELSE
1113                                                         IF pos < pin0 THEN beg := pos ELSIF pos > pin1 THEN end := pos END;
1114                                                         SetSel(c, beg, end);
1115                                                         IF c.selPin0 = c.selPin1 THEN
1116                                                                 IF pos < pin0 THEN c.selPin0 := pos; c.selPin1 := pin1
1117                                                                 ELSIF pos > pin1 THEN c.selPin0 := pin0; c.selPin1 := pos
1118                                                                 END
1119                                                         END
1120                                                 END
1121                                         END
1122                                 END;
1123                                 f.Input(s.x, s.y, modifiers, isDown)
1124                         END
1125 (*
1126                         UNTIL ~isDown
1127 *)
1128                 END
1129         END TrackMarks;
1130
1131         PROCEDURE (c: StdCtrl) Resize (v: Views.View; l, t, r, b: INTEGER);
1132                 VAR con: Models.Context;
1133         BEGIN
1134                 ASSERT(v # NIL, 20); con := v.context;
1135                 ASSERT(con # NIL, 21); ASSERT(con.ThisModel() = c.text, 22);
1136                 con.SetSize(r - l, b - t)
1137         END Resize;
1138
1139         PROCEDURE (c: StdCtrl) DeleteSelection;
1140                 VAR beg, end: INTEGER;
1141         BEGIN
1142                 beg := c.selBeg; end := c.selEnd;
1143                 IF beg # end THEN
1144                         SmartRange(c, beg, end);
1145                         DoEdit(deletingKey, c, beg, end, NIL, 0X, NIL, 0, 0, NIL, 0, 0, 0)
1146                 END
1147         END DeleteSelection;
1148
1149         PROCEDURE (c: StdCtrl) MoveLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
1150                 VAR buf: TextModels.Model; pos, beg0, end0, beg, end, start, len: INTEGER;
1151         BEGIN
1152                 pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
1153 (* smart move disabled for now --> use true move instead of copy
1154                 beg0 := c.selBeg; end0 := c.selEnd; beg := beg0; end := end0;
1155                 SmartRange(c, beg, end);
1156                 IF (beg < pos) & (pos < end) THEN pos := beg END;
1157                 buf := TextModels.CloneOf(c.text); buf.CopyFrom(0, c.text, beg0, end0);
1158                 IF OnlyWords(c, beg0, end0) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
1159                 len := end0 - beg0;
1160                 IF start >= end THEN DEC(start, end - beg) END;
1161                 IF pos # beg THEN
1162                         DoEdit(movingKey, c, beg, end, NIL, 0X, NIL, 0, 0, buf, pos);
1163                         SetSelection(c.text, start, start + len);
1164                         AutoShowRange(c, start, start + len)
1165                 END
1166 *)
1167                 beg := c.selBeg; end := c.selEnd;
1168                 IF (pos < beg) OR (pos > end) THEN
1169                         len := end - beg; start := pos;
1170                         IF start >= end THEN DEC(start, len) END;
1171                         DoEdit(movingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, c.text, beg, end, pos);
1172                         SetSelection(c.text, start, start + len);
1173                         AutoShowRange(c, start, start + len)
1174                 END
1175         END MoveLocalSelection;
1176
1177         PROCEDURE (c: StdCtrl) CopyLocalSelection (f, dest: Views.Frame; x, y, dx, dy: INTEGER);
1178                 VAR buf: TextModels.Model; pos, beg, end, start, len: INTEGER;
1179         BEGIN
1180                 pos := dest.view(TextViews.View).ThisPos(dest, dx, dy);
1181                 beg := c.selBeg; end := c.selEnd;
1182                 IF (beg < pos) & (pos < end) THEN pos := beg END;
1183                 buf := TextModels.CloneOf(c.text); buf.InsertCopy(0, c.text, beg, end);
1184                 IF OnlyWords(c, beg, end) THEN MergeAdjust(c.text, buf, pos, start) ELSE start := pos END;
1185                 len := end - beg;
1186                 DoEdit(copyingKey, c, 0, 0, NIL, 0X, NIL, 0, 0, buf, 0, -1, pos);
1187                 SetSelection(c.text, start, start + len);
1188                 AutoShowRange(c, start, start + len)
1189         END CopyLocalSelection;
1190
1191         PROCEDURE (c: StdCtrl) SelectionCopy (): Containers.Model;
1192                 VAR t: TextModels.Model;
1193         BEGIN
1194                 IF c.selBeg # c.selEnd THEN
1195                         t := TextModels.CloneOf(c.text); t.InsertCopy(0, c.text, c.selBeg, c.selEnd);
1196                 ELSE t := NIL
1197                 END;
1198                 RETURN t
1199         END SelectionCopy;
1200
1201         PROCEDURE (c: StdCtrl) NativePaste (m: Models.Model; f: Views.Frame);
1202                 VAR beg, end, start: INTEGER;
1203         BEGIN
1204                 WITH m: TextModels.Model DO
1205                         GetTargetRange(c, beg, end);
1206                         IF beg # none THEN InsertText(c, beg, end, m, start) END
1207                 END
1208         END NativePaste;
1209
1210         PROCEDURE (c: StdCtrl) ArrowChar (f: Views.Frame; ch: CHAR; units, select: BOOLEAN);
1211                 VAR st: TextSetters.Setter; v: TextViews.View; loc: TextViews.Location;
1212                         org, len,  p, pos,  b, e,  beg, end,  d, d0, edge,  x, dy: INTEGER;
1213                         change, rightEdge, rightDir: BOOLEAN;
1214                         scroll: Controllers.ScrollMsg;
1215         BEGIN
1216                 c.insAttr := NIL;
1217                 Models.StopBunching(c.text);
1218                 v := c.view; st := v.ThisSetter();
1219                 change := select OR (c.selBeg = c.selEnd);
1220                 IF c.selBeg # c.selEnd THEN beg := c.selBeg; end := c.selEnd
1221                 ELSE beg := c.carPos; end := beg; c.carLast := beg
1222                 END;
1223                 len := c.text.Length();
1224                 rightDir := (ch = aR) OR (ch = pR) OR (ch = dR) OR (ch = aD) OR (ch = pD) OR (ch = dD);
1225                 rightEdge :=    change & (c.carLast < end)
1226                                                         OR rightDir & (~change OR (beg = end) & (c.carLast = end));
1227                 IF rightEdge THEN edge := end ELSE edge := beg END;
1228                 ShowPos(c, edge, edge);
1229                 b := beg; e := end; d := edge; d0 := edge;
1230                 CASE ch OF
1231                 | aL:
1232                         IF units THEN
1233                                 p := d; e := d;
1234                                 WHILE (p > 0) & ((edge = d) OR (edge = e)) DO DEC(p); st.GetWord(p, edge, e) END;
1235                         ELSIF change THEN DEC(edge)
1236                         END
1237                 | pL, dL:
1238                         v.GetThisLocation(f, edge, loc); edge := loc.start
1239                 | aR:
1240                         IF units THEN
1241                                 p := d; e := edge;
1242                                 WHILE (p < len) & ((edge <= d) OR (edge = e)) DO INC(p); st.GetWord(p, edge, e) END
1243                         ELSIF change THEN INC(edge)
1244                         END
1245                 | pR, dR:
1246                         v.GetThisLocation(f, edge, loc); p := st.NextLine(loc.start);
1247                         IF p = loc.start THEN p := len ELSE DEC(p) END;
1248                         IF p > edge THEN edge := p END
1249                 | aU:
1250                         IF units THEN
1251                                 p := st.ThisSequence(edge);
1252                                 IF p < edge THEN edge := p ELSE edge := st.PreviousSequence(edge) END
1253                         ELSE
1254                                 v.PollOrigin(org, dy); v.GetThisLocation(f, edge, loc);
1255                                 IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
1256                                 c.carX := x;
1257                                 IF loc.start > 0 THEN
1258                                         edge := v.ThisPos(f, x, loc.y - 1);
1259                                         IF (edge >= loc.start) & (org > 0) THEN
1260                                                 v.SetOrigin(org - 1, 0);
1261                                                 v.GetThisLocation(f, edge, loc);
1262                                                 edge := v.ThisPos(f, x, loc.y - 1)
1263                                         END
1264                                 END
1265                         END
1266                 | pU:
1267                         v.PollOrigin(org, dy);
1268                         IF edge > org THEN edge := org
1269                         ELSIF org > 0 THEN
1270                                 scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.decPage;
1271                                 scroll.done := FALSE;
1272                                 Views.ForwardCtrlMsg(f, scroll);
1273                                 v.PollOrigin(edge, dy)
1274                         END
1275                 | dU:
1276                         edge := 0
1277                 | aD:
1278                         IF units THEN
1279                                 p := st.NextSequence(st.ThisSequence(edge));
1280                                 IF p > edge THEN edge := p ELSE edge := st.NextSequence(p) END
1281                         ELSE
1282                                 v.GetThisLocation(f, edge, loc);
1283                                 IF c.lastX >= 0 THEN x := c.lastX ELSE x := loc.x END;
1284                                 c.carX := x;
1285                                 edge := v.ThisPos(f, x, loc.y + loc.asc + loc.dsc + 1)
1286                         END
1287                 | pD:
1288                         v.GetRange(f, b, e);
1289                         IF e < len THEN
1290                                 scroll.focus := TRUE; scroll.vertical := TRUE; scroll.op := Controllers.incPage;
1291                                 scroll.done := FALSE;
1292                                 Views.ForwardCtrlMsg(f, scroll);
1293                                 v.GetRange(f, edge, e)
1294                         ELSE edge := len
1295                         END
1296                 | dD:
1297                         edge := len
1298                 END;
1299                 IF rightEdge THEN end := edge ELSE beg := edge END;
1300                 IF ~select THEN
1301                         IF rightDir THEN beg := edge ELSE end := edge END
1302                 END;
1303                 IF beg < 0 THEN beg := 0 ELSIF beg > len THEN beg := len END;
1304                 IF end < beg THEN end := beg ELSIF end > len THEN end := len END;
1305                 IF beg = end THEN
1306                         ShowPos(c, beg, end)
1307                 ELSE
1308                         IF rightEdge THEN ShowPos(c, end - 1, end) ELSE ShowPos(c, beg, beg + 1) END
1309                 END;
1310                 SetSel(c, beg, end)
1311         END ArrowChar;
1312
1313         PROCEDURE (c: StdCtrl) ControlChar (f: Views.Frame; ch: CHAR);
1314         BEGIN
1315                 InsertChar(c, ch)
1316         END ControlChar;
1317
1318         PROCEDURE (c: StdCtrl) PasteChar (ch: CHAR);
1319         BEGIN
1320                 InsertChar(c, ch)
1321         END PasteChar;
1322
1323         PROCEDURE (c: StdCtrl) PasteView (f: Views.Frame; v: Views.View; w, h: INTEGER);
1324                 VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
1325         BEGIN
1326                 GetTargetRange(c, beg, end);
1327                 IF beg # none THEN InsertView(c, beg, end, v, w, h) END
1328         END PasteView;
1329
1330         PROCEDURE (c: StdCtrl) Drop (src, f: Views.Frame; sx, sy, x, y, w, h, rx, ry: INTEGER;
1331                 v: Views.View; isSingle: BOOLEAN
1332         );
1333                 VAR t: TextModels.Model; pos, start, beg, end, len: INTEGER;
1334         BEGIN
1335                 pos := ThisPos(c.view, f, x, y);
1336                 WITH v: TextViews.View DO t := v.ThisModel() ELSE t := NIL END;
1337                 IF (t # NIL) & ~isSingle THEN
1338                         InsertText(c, pos, pos, t, start); len := t.Length()
1339                 ELSE
1340                         InsertView(c, pos, pos, v, w, h); start := pos; len := 1
1341                 END;
1342                 SetSelection(c.text, start, start + len);
1343                 AutoShowRange(c, start, start + len)
1344         END Drop;
1345
1346         PROCEDURE (c: StdCtrl) PickNativeProp (f: Views.Frame; x, y: INTEGER; VAR p: Properties.Property);
1347                 VAR rd: TextModels.Reader;
1348         BEGIN
1349                 rd := CachedReader(c); rd.SetPos(ThisPos(c.view, f, x, y)); rd.Read;
1350                 IF ~rd.eot THEN p := rd.attr.Prop() ELSE p := NIL END;
1351                 CacheReader(c, rd)
1352         END PickNativeProp;
1353
1354         PROCEDURE (c: StdCtrl) HandleModelMsg (VAR msg: Models.Message);
1355                 VAR done: BOOLEAN;
1356         BEGIN
1357                 c.HandleModelMsg^(msg);
1358                 IF msg.model = c.text THEN
1359                         WITH msg: Models.UpdateMsg DO
1360                                 WITH msg: TextModels.UpdateMsg DO
1361                                         CASE msg.op OF
1362                                           TextModels.insert, TextModels.delete, TextModels.replace:
1363                                                 UpdateMarks(c, msg.op, msg.beg, msg.end, msg.delta)
1364                                         ELSE    (* unknown text op happened *)
1365                                                 c.view.Neutralize
1366                                         END
1367                                 ELSE    (* unknown text update happened *)
1368                                         c.view.Neutralize
1369                                 END
1370                         | msg: ModelMessage DO
1371                                 WITH msg: SetCaretMsg DO
1372                                         c.SetCaret(msg.pos)
1373                                 | msg: SetSelectionMsg DO
1374                                         c.SetSelection(msg.beg, msg.end)
1375                                 ELSE
1376                                 END
1377                         ELSE
1378                         END
1379                 END
1380         END HandleModelMsg;
1381
1382         PROCEDURE (c: StdCtrl) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
1383         BEGIN
1384                 c.HandleViewMsg^(f, msg);
1385                 IF msg.view = c.view THEN
1386                         WITH msg: ViewMessage DO
1387                                 WITH msg: CaretMsg DO
1388                                         c.MarkCaret(f, msg.show)
1389                                 | msg: SelectionMsg DO
1390                                         MarkSelection(c, f, msg.beg, msg.end, msg.show)
1391                                 END
1392                         ELSE
1393                         END
1394                 END
1395         END HandleViewMsg;
1396
1397         PROCEDURE (c: StdCtrl) HandleCtrlMsg (f: Views.Frame;
1398                 VAR msg: Controllers.Message; VAR focus: Views.View
1399         );
1400                 VAR g: Views.Frame; beg, end: INTEGER; done: BOOLEAN;
1401         BEGIN
1402                 IF (msg IS Controllers.MarkMsg) OR (msg IS Controllers.TickMsg) THEN
1403                         beg := c.autoBeg; end := c.autoEnd;
1404                         c.autoBeg := MAX(INTEGER); c.autoEnd := 0
1405                 END;
1406                 WITH msg: Controllers.TickMsg DO
1407                         IF ~(noAutoScroll IN c.opts)
1408                                 & (0 <= beg) & (beg <= end) & (end <= c.text.Length())
1409                                 & c.view.context.Normalize()
1410                         THEN
1411                                 c.view.ShowRange(beg, end, TextViews.focusOnly)
1412                         END;
1413                         IF focus = NIL THEN
1414                                 CheckCaret(c); BlinkCaret(c, f, msg.tick);
1415                                 IF (c.selBeg # c.aliasSelBeg) OR (c.selEnd # c.aliasSelEnd) THEN
1416                                         (* lazy update of text-synchronous alias marks *)
1417                                         c.aliasSelBeg := c.selBeg; c.aliasSelEnd := c.selEnd;
1418                                         SetSelection(c.text, c.selBeg, c.selEnd)
1419                                 END
1420                         END
1421                 | msg: Controllers.MarkMsg DO
1422                         c.carX := -1;
1423                         IF msg.show THEN c.carVisible := TRUE; c.carTick := 0 END
1424                 | msg: Controllers.TrackMsg DO
1425                         c.insAttr := NIL; c.carX := -1; Models.StopBunching(c.text)
1426                 | msg: Controllers.EditMsg DO
1427                         c.lastX := c.carX; c.carX := -1;
1428                         IF focus = NIL THEN CheckCaret(c) END
1429                 | msg: Controllers.ReplaceViewMsg DO
1430                         c.carX := -1
1431                 | msg: Controllers.TransferMessage DO
1432                         c.carX := -1
1433                 | msg: Properties.EmitMsg DO
1434                         c.carX := -1
1435                 ELSE
1436                 END;
1437                 done := FALSE;
1438                 WITH msg: Controllers.CursorMessage DO
1439                         IF TRUE (* Containers.noCaret IN c.opts *) THEN (* mask or browser mode *)
1440                                 g := Views.FrameAt(f, msg.x, msg.y);
1441                                 IF (g = NIL) OR IsFilter(g.view, c, f, msg.x, msg.y) THEN
1442                                         WITH msg: Controllers.PollCursorMsg DO
1443                                                 FilteredPollCursor(c, f, msg, done)
1444                                         | msg: Controllers.TrackMsg DO
1445                                                 FilteredTrack(c, f, msg, done)
1446                                         ELSE
1447                                         END
1448                                 END
1449                         END
1450                 ELSE
1451                 END;
1452                 IF ~done THEN c.HandleCtrlMsg^(f, msg, focus) END
1453         END HandleCtrlMsg;
1454
1455
1456         (* caret *)
1457
1458         PROCEDURE (c: StdCtrl) HasCaret (): BOOLEAN;
1459         BEGIN
1460                 RETURN c.carPos # none
1461         END HasCaret;
1462
1463         PROCEDURE (c: StdCtrl) MarkCaret (f: Views.Frame; show: BOOLEAN);
1464                 CONST carW = 1; carMinH = 7;    (* in frame dots *)
1465                 VAR loc: TextViews.Location; pos, beg, end,  u, x, y, w, h: INTEGER; fm: INTEGER;
1466         BEGIN
1467                 pos := c.carPos;
1468                 IF (pos # none) & f.mark & (f.front & c.carVisible OR ~f.front) THEN
1469                         c.view.GetRange(f, beg, end);
1470                         IF (beg <= pos) & (pos <= end) THEN
1471                                 u := f.dot;
1472                                 c.view.GetThisLocation(f, pos, loc);
1473                                 IF f.front THEN fm := Ports.invert ELSE fm := Ports.dim50 END;
1474                                 x := loc.x; y := loc.y; h := loc.asc + loc.dsc;
1475                                 IF Dialog.thickCaret THEN w := 2 * carW * u ELSE w := carW * u END;
1476                                 IF x >= f.r - w THEN DEC(x, w) END;
1477                                 IF h < carMinH * u THEN h := carMinH * u END;   (* special caret in lines of (almost) zero height *)
1478                                 f.MarkRect(x, y, x + w, y + h, Ports.fill, fm, show)
1479                         END
1480                 END
1481         END MarkCaret;
1482
1483         PROCEDURE (c: StdCtrl) CaretPos (): INTEGER;
1484         BEGIN
1485                 RETURN c.carPos
1486         END CaretPos;
1487
1488         PROCEDURE (c: StdCtrl) SetCaret (pos: INTEGER);
1489         BEGIN
1490                 ASSERT(none <= pos, 20); ASSERT(pos <= c.text.Length(), 21);
1491                 c.insAttr := NIL;
1492                 IF pos # c.carPos THEN
1493                         IF (pos # none) & (c.carPos = none) THEN
1494                                 IF boundCaret THEN c.SetSelection(none, none) END;
1495                                 c.SetFocus(NIL)
1496                         END;
1497
1498                         IF Containers.noCaret IN c.opts THEN pos := none END;
1499                         IF c.carPos # none THEN
1500                                 c.carLast := c.carPos; FlipCaret(c, Containers.hide)
1501                         END;
1502                         c.carPos := pos;
1503                         IF pos # none THEN
1504                                 c.carVisible := TRUE; c.carTick := Services.Ticks() + Dialog.caretPeriod; FlipCaret(c, Containers.show)
1505                         END
1506                 END
1507         END SetCaret;
1508
1509
1510         (* selection *)
1511
1512         PROCEDURE (c: StdCtrl) HasSelection (): BOOLEAN;
1513         BEGIN
1514                 RETURN c.selBeg # c.selEnd
1515         END HasSelection;
1516
1517         PROCEDURE (c: StdCtrl) Selectable (): BOOLEAN;
1518         BEGIN
1519                 RETURN c.text.Length() > 0
1520         END Selectable;
1521
1522         PROCEDURE (c: StdCtrl) SetSingleton (s: Views.View);
1523                 VAR s0: Views.View;
1524         BEGIN
1525                 s0 := c.Singleton();
1526                 c.SetSingleton^(s);
1527                 s := c.Singleton();
1528                 IF s # s0 THEN
1529                         c.insAttr := NIL;
1530                         IF s # NIL THEN
1531                                 c.selBeg := s.context(TextModels.Context).Pos(); c.selEnd := c.selBeg + 1;
1532                                 c.selPin0 := c.selBeg; c.selPin1 := c.selEnd
1533                         ELSE c.selBeg := none; c.selEnd := none
1534                         END
1535                 END
1536         END SetSingleton;
1537
1538         PROCEDURE (c: StdCtrl) SelectAll (select: BOOLEAN);
1539         (** extended by subclass to include intrinsic selections **)
1540         BEGIN
1541                 IF select THEN c.SetSelection(0, c.text.Length()) ELSE c.SetSelection(none, none) END
1542         END SelectAll;
1543
1544         PROCEDURE (c: StdCtrl) InSelection (f: Views.Frame; x, y: INTEGER): BOOLEAN;
1545         (* pre: c.selBeg # c.selEnd *)
1546         (* post: (x, y) in c.selection *)
1547                 VAR b, e: TextViews.Location; y0, y1, y2, y3: INTEGER;
1548         BEGIN
1549                 c.view.GetThisLocation(f, c.selBeg, b); y0 := b.y; y1 := y0 + b.asc + b.dsc;
1550                 c.view.GetThisLocation(f, c.selEnd, e); y2 := e.y; y3 := y2 + e.asc + e.dsc;
1551                 RETURN ((y >= y0) & (x >= b.x) OR (y >= y1)) & ((y < y2) OR (y < y3) & (x < e.x))
1552         END InSelection;
1553
1554         PROCEDURE (c: StdCtrl) MarkSelection (f: Views.Frame; show: BOOLEAN);
1555         BEGIN
1556                 MarkSelection(c, f, c.selBeg, c.selEnd, show)
1557         END MarkSelection;
1558
1559         PROCEDURE (c: StdCtrl) GetSelection (OUT beg, end: INTEGER);
1560         BEGIN
1561                 beg := c.selBeg; end := c.selEnd
1562         END GetSelection;
1563
1564         PROCEDURE (c: StdCtrl) SetSelection (beg, end: INTEGER);
1565                 VAR t: TextModels.Model; rd: TextModels.Reader;
1566                         beg0, end0, p: INTEGER; singleton: BOOLEAN;
1567         BEGIN
1568                 t := c.text; ASSERT(t # NIL, 20);
1569                 IF Containers.noSelection IN c.opts THEN end := beg
1570                 ELSIF beg # end THEN
1571                         ASSERT(0 <= beg, 21); ASSERT(beg < end, 22); ASSERT(end <= t.Length(), 23)
1572                 END;
1573                 beg0 := c.selBeg; end0 := c.selEnd;
1574                 c.insAttr := NIL;
1575                 IF (beg # beg0) OR (end # end0) THEN
1576                         IF (beg # end) & (c.selBeg = c.selEnd) THEN
1577                                 IF boundCaret THEN
1578                                         IF c.carPos = end THEN p := c.carPos ELSE p := beg END;
1579                                         c.SetCaret(none); c.carLast := p
1580                                 END;
1581                                 c.SetFocus(NIL);
1582                                 c.selPin0 := beg; c.selPin1 := end
1583                         ELSIF boundCaret & (beg = end) THEN
1584                                 c.selPin1 := c.selPin0  (* clear selection anchors *)
1585                         END;
1586                         IF beg + 1 = end THEN
1587                                 rd := CachedReader(c);
1588                                 rd.SetPos(beg); rd.Read; singleton := rd.view # NIL;
1589                                 CacheReader(c, rd)
1590                         ELSE singleton := FALSE
1591                         END;
1592                         IF singleton THEN       (* native or singleton -> singleton *)
1593                                 IF rd.view # c.Singleton() THEN c.SetSingleton(rd.view) END
1594                         ELSIF c.Singleton() # NIL THEN  (* singleton -> native *)
1595                                 c.SetSingleton(NIL);
1596                                 c.selBeg := beg; c.selEnd := end;
1597                                 FlipSelection(c, beg, end, Containers.show)
1598                         ELSE    (* native -> native *)
1599                                 c.selBeg := beg; c.selEnd := end;
1600                                 IF (beg0 <= beg) & (end <= end0) THEN   (* reduce *)
1601                                         p := end0; end0 := beg; beg := end; end := p
1602                                 ELSIF (beg <= beg0) & (end0 <= end) THEN        (* extend *)
1603                                         p := end; end := beg0; beg0 := end0; end0 := p
1604                                 ELSIF (beg <= beg0) & (beg0 <= end) THEN        (* shift left *)
1605                                         p := end; end := beg0; beg0 := p
1606                                 ELSIF (end >= end0) & (beg <= end0) THEN        (* shift right *)
1607                                         p := end0; end0 := beg; beg := p
1608                                 END;
1609                                 IF beg0 < end0 THEN FlipSelection(c, beg0, end0, Containers.show) END;
1610                                 IF beg < end THEN FlipSelection(c, beg, end, Containers.show) END
1611                         END
1612                 END
1613         END SetSelection;
1614
1615
1616         (* StdDirectory *)
1617
1618         PROCEDURE (d: StdDirectory) NewController (opts: SET): Controller;
1619                 VAR c: StdCtrl;
1620         BEGIN
1621                 NEW(c); c.SetOpts(opts); InitMarks(c); RETURN c
1622         END NewController;
1623
1624
1625         PROCEDURE Init;
1626                 VAR d: StdDirectory;
1627         BEGIN
1628                 NEW(d); dir := d; stdDir := d
1629         END Init;
1630
1631 BEGIN
1632         Init
1633 END TextControllers.