PageRenderTime 92ms CodeModel.GetById 40ms app.highlight 25ms RepoModel.GetById 2ms app.codeStats 4ms

/components/synedit/syneditpointclasses.pas

http://github.com/graemeg/lazarus
Pascal | 3487 lines | 2900 code | 399 blank | 188 comment | 379 complexity | c58c656596b082f0b7a7d16f58d7d30c MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1{-------------------------------------------------------------------------------
   2The contents of this file are subject to the Mozilla Public License
   3Version 1.1 (the "License"); you may not use this file except in compliance
   4with the License. You may obtain a copy of the License at
   5http://www.mozilla.org/MPL/
   6
   7Software distributed under the License is distributed on an "AS IS" basis,
   8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
   9the specific language governing rights and limitations under the License.
  10
  11Alternatively, the contents of this file may be used under the terms of the
  12GNU General Public License Version 2 or later (the "GPL"), in which case
  13the provisions of the GPL are applicable instead of those above.
  14If you wish to allow use of your version of this file only under the terms
  15of the GPL and not to allow others to use your version of this file
  16under the MPL, indicate your decision by deleting the provisions above and
  17replace them with the notice and other provisions required by the GPL.
  18If you do not delete the provisions above, a recipient may use your version
  19of this file under either the MPL or the GPL.
  20
  21-------------------------------------------------------------------------------}
  22
  23(* Naming Conventions:
  24  Byte = Logical: Refers to the location any TextToken has in the String.
  25         In Utf8String some TextToken can have more than one byte
  26  Char = Physical: Refers to the (x-)location on the screen matrix.
  27         Some TextToken (like tab) can spawn multiply char locations
  28*)
  29
  30unit SynEditPointClasses;
  31
  32{$I synedit.inc}
  33
  34{off $DEFINE SynCaretDebug}
  35
  36interface
  37
  38uses
  39  Classes, SysUtils, Controls, LCLProc, LCLType, LCLIntf, ExtCtrls, Graphics, Forms,
  40  {$IFDEF SYN_MBCSSUPPORT}
  41  Imm,
  42  {$ENDIF}
  43  LazSynEditText, SynEditTypes, SynEditMiscProcs;//, SynEditTextBuffer;
  44
  45type
  46
  47  TInvalidateLines = procedure(FirstLine, LastLine: integer) of Object;
  48  TLinesCountChanged = procedure(FirstLine, Count: integer) of Object;
  49  TMaxLeftCharFunc = function: Integer of object;
  50
  51  { TSynEditPointBase }
  52
  53  TSynEditPointBase = class
  54  private
  55    function GetLocked: Boolean;
  56  protected
  57    FLines: TSynEditStrings;
  58    FOnChangeList: TMethodList;
  59    FLockCount: Integer;
  60    procedure SetLines(const AValue: TSynEditStrings); virtual;
  61    procedure DoLock; virtual;
  62    Procedure DoUnlock; virtual;
  63  public
  64    constructor Create;
  65    constructor Create(Lines: TSynEditStrings);
  66    destructor Destroy; override;
  67    procedure AddChangeHandler(AHandler: TNotifyEvent);
  68    procedure RemoveChangeHandler(AHandler: TNotifyEvent);
  69    procedure Lock;
  70    Procedure Unlock;
  71    property  Lines: TSynEditStrings read FLines write SetLines;
  72    property Locked: Boolean read GetLocked;
  73  end;
  74
  75  TSynEditBaseCaret = class;
  76  TSynEditCaret = class;
  77
  78  TSynBlockPersistMode = (
  79    sbpDefault,
  80    sbpWeak,     // selstart/end are treated as outside the block
  81    sbpStrong    // selstart/end are treated as inside the block
  82  );
  83
  84  TSynBeforeSetSelTextEvent = procedure(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar) of object;
  85
  86  { TSynBeforeSetSelTextList }
  87
  88  TSynBeforeSetSelTextList = Class(TMethodList)
  89  public
  90    procedure CallBeforeSetSelTextHandlers(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar);
  91  end;
  92
  93  { TSynEditSelection }
  94
  95  TSynEditSelection = class(TSynEditPointBase)
  96  private
  97    FOnBeforeSetSelText: TSynBeforeSetSelTextList;
  98    FAutoExtend: Boolean;
  99    FCaret: TSynEditCaret;
 100    FHide: Boolean;
 101    FInternalCaret: TSynEditBaseCaret;
 102    FInvalidateLinesMethod: TInvalidateLines;
 103    FEnabled: Boolean;
 104    FHookedLines: Boolean;
 105    FIsSettingText: Boolean;
 106    FForceSingleLineSelected: Boolean;
 107    FActiveSelectionMode: TSynSelectionMode;
 108    FSelectionMode:       TSynSelectionMode;
 109    FStartLinePos: Integer; // 1 based
 110    FStartBytePos: Integer; // 1 based
 111    FAltStartLinePos, FAltStartBytePos: Integer; // 1 based // Alternate, for min selection
 112    FEndLinePos: Integer; // 1 based
 113    FEndBytePos: Integer; // 1 based
 114    FPersistent: Boolean;
 115    FPersistentLock, FWeakPersistentIdx, FStrongPersistentIdx: Integer;
 116    FIgnoreNextCaretMove: Boolean;
 117    (* On any modification, remember the position of the caret.
 118       If it gets moved from there to either end of the block, this should be ignored
 119       This happens, if Block and caret are adjusted directly
 120    *)
 121    FLastCarePos: TPoint;
 122    FStickyAutoExtend: Boolean;
 123    function  AdjustBytePosToCharacterStart(Line: integer; BytePos: integer): integer;
 124    function  GetFirstLineBytePos: TPoint;
 125    function  GetLastLineBytePos: TPoint;
 126    function GetLastLineHasSelection: Boolean;
 127    procedure SetAutoExtend(AValue: Boolean);
 128    procedure SetCaret(const AValue: TSynEditCaret);
 129    procedure SetEnabled(const Value : Boolean);
 130    procedure SetActiveSelectionMode(const Value: TSynSelectionMode);
 131    procedure SetForceSingleLineSelected(AValue: Boolean);
 132    procedure SetHide(const AValue: Boolean);
 133    procedure SetPersistent(const AValue: Boolean);
 134    procedure SetSelectionMode      (const AValue: TSynSelectionMode);
 135    function  GetStartLineBytePos: TPoint;
 136    procedure ConstrainStartLineBytePos(var Value: TPoint);
 137    procedure SetStartLineBytePos(Value: TPoint);
 138    procedure AdjustStartLineBytePos(Value: TPoint);
 139    function  GetEndLineBytePos: TPoint;
 140    procedure SetEndLineBytePos(Value: TPoint);
 141    function  GetSelText: string;
 142    procedure SetSelText(const Value: string);
 143    procedure DoCaretChanged(Sender: TObject);
 144    procedure AdjustAfterTrimming; // TODO: Move into TrimView?
 145  protected
 146    procedure DoLock; override;
 147    procedure DoUnlock; override;
 148    Procedure LineChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
 149    procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
 150                            aLineBrkCnt: Integer; aText: String);
 151  public
 152    constructor Create(ALines: TSynEditStrings; aActOnLineChanges: Boolean);
 153    destructor Destroy; override;
 154    procedure AssignFrom(Src: TSynEditSelection);
 155    procedure SetSelTextPrimitive(PasteMode: TSynSelectionMode; Value: PChar; AReplace: Boolean = False);
 156    function  SelAvail: Boolean;
 157    function  SelCanContinue(ACaret: TSynEditCaret): Boolean;
 158    function  IsBackwardSel: Boolean; // SelStart < SelEnd ?
 159    procedure BeginMinimumSelection; // current selection will be minimum while follow caret (autoExtend) // until next setSelStart or end of follow
 160    procedure SortSelectionPoints;
 161    procedure IgnoreNextCaretMove;
 162    // Mode can NOT be changed in nested calls
 163    procedure IncPersistentLock(AMode: TSynBlockPersistMode = sbpDefault); // Weak: Do not extend (but rather move) block, if at start/end
 164    procedure DecPersistentLock;
 165    procedure Clear;
 166    procedure AddBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
 167    procedure RemoveBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
 168    property  Enabled: Boolean read FEnabled write SetEnabled;
 169    property  ForceSingleLineSelected: Boolean read FForceSingleLineSelected write SetForceSingleLineSelected;
 170    property  ActiveSelectionMode: TSynSelectionMode
 171                read FActiveSelectionMode write SetActiveSelectionMode;
 172    property  SelectionMode: TSynSelectionMode
 173                read FSelectionMode write SetSelectionMode;
 174    property  SelText: String read GetSelText write SetSelText;
 175    // Start and End positions are in the order they where defined
 176    // This may mean Startpos is behind EndPos in the text
 177    property  StartLineBytePos: TPoint
 178                read GetStartLineBytePos write SetStartLineBytePos;
 179    property  StartLineBytePosAdjusted: TPoint
 180                 write AdjustStartLineBytePos;
 181    property  EndLineBytePos: TPoint
 182                read GetEndLineBytePos write SetEndLineBytePos;
 183    property  StartLinePos: Integer read FStartLinePos;
 184    property  EndLinePos: Integer read FEndLinePos;
 185    property  StartBytePos: Integer read FStartBytePos;
 186    property  EndBytePos: Integer read FEndBytePos;
 187    // First and Last Pos are ordered according to the text flow (LTR)
 188    property  FirstLineBytePos: TPoint read GetFirstLineBytePos;
 189    property  LastLineBytePos: TPoint read GetLastLineBytePos;
 190    property  LastLineHasSelection: Boolean read GetLastLineHasSelection;
 191    property  InvalidateLinesMethod : TInvalidateLines write FInvalidateLinesMethod;
 192    property  Caret: TSynEditCaret read FCaret write SetCaret;
 193    property  Persistent: Boolean read FPersistent write SetPersistent;
 194    // automatically Start/Extend selection if caret moves
 195    // (depends if caret was at block border or not)
 196    property  AutoExtend: Boolean read FAutoExtend write SetAutoExtend;
 197    property  StickyAutoExtend: Boolean read FStickyAutoExtend write FStickyAutoExtend;
 198    property  Hide: Boolean read FHide write SetHide;
 199  end;
 200
 201  { TSynEditCaret }
 202
 203  TSynEditCaretFlag = (
 204      scCharPosValid, scBytePosValid
 205    );
 206  TSynEditCaretFlags = set of TSynEditCaretFlag;
 207
 208  TSynEditCaretUpdateFlag = (
 209      scuForceSet,                // Change even if equal to old
 210      scuChangedX, scuChangedY,   //
 211      scuNoInvalidate             // Keep the Char/Byte ValidFlags
 212    );
 213  TSynEditCaretUpdateFlags = set of TSynEditCaretUpdateFlag;
 214
 215
 216  { TSynEditBaseCaret
 217    No Checks at all.
 218    Caller MUST ensure at least not to set x to invalid pos (middle of char) (incl update x, after SetLine)
 219  }
 220
 221  TSynEditBaseCaret = class(TSynEditPointBase)
 222  private
 223    FFlags: TSynEditCaretFlags;
 224    FLinePos: Integer;     // 1 based
 225    FCharPos: Integer;     // 1 based
 226    FBytePos, FBytePosOffset: Integer;     // 1 based
 227
 228    function  GetBytePos: Integer;
 229    function  GetBytePosOffset: Integer;
 230    function  GetCharPos: Integer;
 231    function GetFullLogicalPos: TLogCaretPoint;
 232    function  GetLineBytePos: TPoint;
 233    function  GetLineCharPos: TPoint;
 234    procedure SetBytePos(AValue: Integer);
 235    procedure SetBytePosOffset(AValue: Integer);
 236    procedure SetCharPos(AValue: Integer);
 237    procedure SetFullLogicalPos(AValue: TLogCaretPoint);
 238    procedure SetLineBytePos(AValue: TPoint);
 239    procedure SetLineCharPos(AValue: TPoint);
 240    procedure SetLinePos(AValue: Integer);
 241
 242    function  GetLineText: string;
 243    procedure SetLineText(AValue: string);
 244  protected
 245    procedure ValidateBytePos;
 246    procedure ValidateCharPos;
 247
 248    procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
 249                                     UpdFlags: TSynEditCaretUpdateFlags); virtual;
 250    procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
 251                                     UpdFlags: TSynEditCaretUpdateFlags); virtual;
 252  public
 253    constructor Create;
 254    procedure AssignFrom(Src: TSynEditBaseCaret);
 255    procedure Invalidate; // force to 1,1
 256    procedure InvalidateBytePos; // 1,1 IF no validCharPos
 257    procedure InvalidateCharPos;
 258
 259    function IsAtLineChar(aPoint: TPoint): Boolean;
 260    function IsAtLineByte(aPoint: TPoint; aByteOffset: Integer = -1): Boolean;
 261    function IsAtPos(aCaret: TSynEditCaret): Boolean;
 262
 263    property LinePos: Integer read FLinePos write SetLinePos;
 264    property CharPos: Integer read GetCharPos write SetCharPos;
 265    property LineCharPos: TPoint read GetLineCharPos write SetLineCharPos;
 266    property BytePos: Integer read GetBytePos write SetBytePos;
 267    property BytePosOffset: Integer read GetBytePosOffset write SetBytePosOffset;
 268    property LineBytePos: TPoint read GetLineBytePos write SetLineBytePos;
 269    property FullLogicalPos: TLogCaretPoint read GetFullLogicalPos write SetFullLogicalPos;
 270
 271    property LineText: string read GetLineText write SetLineText;
 272  end;
 273
 274  { TSynEditCaret }
 275
 276  TSynEditCaret = class(TSynEditBaseCaret)
 277  private
 278    FLinesEditedRegistered: Boolean;
 279    FAllowPastEOL: Boolean;
 280    FAutoMoveOnEdit: Integer;
 281    FForcePastEOL: Integer;
 282    FForceAdjustToNextChar: Integer;
 283    FKeepCaretX: Boolean;
 284    FLastCharPos: Integer; // used by KeepCaretX
 285
 286    FOldLinePos: Integer; // 1 based
 287    FOldCharPos: Integer; // 1 based
 288
 289    FAdjustToNextChar: Boolean;
 290    FMaxLeftChar: TMaxLeftCharFunc;
 291    FChangeOnTouch: Boolean;
 292    FSkipTabs: Boolean;
 293    FTouched: Boolean;
 294
 295    procedure AdjustToChar;
 296    function GetMaxLeftPastEOL: Integer;
 297
 298    function  GetOldLineCharPos: TPoint;
 299    function  GetOldLineBytePos: TPoint;
 300    function  GetOldFullLogicalPos: TLogCaretPoint;
 301
 302    procedure SetAllowPastEOL(const AValue: Boolean);
 303    procedure SetSkipTabs(const AValue: Boolean);
 304    procedure SetKeepCaretX(const AValue: Boolean);
 305
 306    procedure RegisterLinesEditedHandler;
 307  protected
 308    procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
 309                                     UpdFlags: TSynEditCaretUpdateFlags); override;
 310    procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
 311                                     UpdFlags: TSynEditCaretUpdateFlags); override;
 312
 313    procedure DoLock; override;
 314    Procedure DoUnlock; override;
 315    procedure SetLines(const AValue: TSynEditStrings); override;
 316    procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
 317                            aLineBrkCnt: Integer; aText: String);
 318  public
 319    constructor Create;
 320    destructor Destroy; override;
 321    procedure AssignFrom(Src: TSynEditBaseCaret);
 322
 323    procedure IncForcePastEOL;
 324    procedure DecForcePastEOL;
 325    procedure IncForceAdjustToNextChar;
 326    procedure DecForceAdjustToNextChar;
 327    procedure IncAutoMoveOnEdit;
 328    procedure DecAutoMoveOnEdit;
 329    procedure ChangeOnTouch;
 330    procedure Touch(aChangeOnTouch: Boolean = False);
 331
 332    function WasAtLineChar(aPoint: TPoint): Boolean;
 333    function WasAtLineByte(aPoint: TPoint): Boolean;
 334    function MoveHoriz(ACount: Integer): Boolean; // Logical // False, if past EOL (not mowed)/BOl
 335
 336    property OldLinePos: Integer read FOldLinePos;
 337    property OldCharPos: Integer read FOldCharPos;
 338    property OldLineCharPos: TPoint read GetOldLineCharPos;
 339    property OldLineBytePos: TPoint read GetOldLineBytePos;
 340    property OldFullLogicalPos: TLogCaretPoint read GetOldFullLogicalPos;
 341
 342    property AdjustToNextChar: Boolean read FAdjustToNextChar write FAdjustToNextChar; deprecated;
 343    property SkipTabs: Boolean read FSkipTabs write SetSkipTabs;
 344    property AllowPastEOL: Boolean read FAllowPastEOL write SetAllowPastEOL;
 345    property KeepCaretX: Boolean read FKeepCaretX write SetKeepCaretX;
 346    property KeepCaretXPos: Integer read FLastCharPos write FLastCharPos;
 347    property MaxLeftChar: TMaxLeftCharFunc read FMaxLeftChar write FMaxLeftChar;
 348  end;
 349
 350  TSynCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock, ctCostum);
 351  TSynCaretLockFlags = set of (sclfUpdateDisplay, sclfUpdateDisplayType);
 352
 353  { TSynEditScreenCaretTimer
 354    Allow sync between carets which use an internal painter
 355  }
 356
 357  TSynEditScreenCaretTimer = class
 358  private
 359    FDisplayCycle: Boolean;
 360    FTimer: TTimer;
 361    FTimerList: TMethodList;
 362    FAfterPaintList: TMethodList;
 363    FLocCount: Integer;
 364    FLocFlags: set of (lfTimer, lfRestart);
 365    procedure DoTimer(Sender: TObject);
 366    procedure DoAfterPaint(Data: PtrInt);
 367  public
 368    constructor Create;
 369    destructor Destroy; override;
 370    procedure AddAfterPaintHandler(AHandler: TNotifyEvent); // called once
 371    procedure AddHandler(AHandler: TNotifyEvent);
 372    procedure RemoveHandler(AHandler: TNotifyEvent);
 373    procedure RemoveHandler(AHandlerOwner: TObject);
 374    procedure IncLock;
 375    procedure DecLock;
 376    procedure AfterPaintEvent;
 377
 378    procedure RestartCycle;
 379    property DisplayCycle: Boolean read FDisplayCycle;
 380  end;
 381
 382  TSynEditScreenCaret = class;
 383
 384  { TSynEditScreenCaretPainter }
 385
 386  TSynEditScreenCaretPainter = class
 387  private
 388    FLeft, FTop, FHeight, FWidth: Integer;
 389    FCreated, FShowing: Boolean;
 390    FInPaint, FInScroll: Boolean;
 391    FPaintClip: TRect;
 392    FScrollX, FScrollY: Integer;
 393    FScrollRect, FScrollClip: TRect;
 394
 395    function GetHandle: HWND;
 396    function GetHandleAllocated: Boolean;
 397  protected
 398    FHandleOwner: TWinControl;
 399    FOwner: TSynEditScreenCaret;
 400    FNeedPositionConfirmed: boolean;
 401    procedure Init; virtual;
 402    property Handle: HWND read GetHandle;
 403    property HandleAllocated: Boolean read GetHandleAllocated;
 404
 405    procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); virtual;
 406    procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); virtual;
 407    procedure BeginPaint(rcClip: TRect); virtual;
 408    procedure FinishPaint(rcClip: TRect); virtual;
 409  public
 410    constructor Create(AHandleOwner: TWinControl; AOwner: TSynEditScreenCaret);
 411    function CreateCaret(w, h: Integer): Boolean; virtual;
 412    function DestroyCaret: Boolean; virtual;
 413    function HideCaret: Boolean; virtual;
 414    function ShowCaret: Boolean; virtual;
 415    function SetCaretPosEx(x, y: Integer): Boolean; virtual;
 416
 417    property Left: Integer read FLeft;
 418    property Top: Integer read FTop;
 419    property Width: Integer read FWidth;
 420    property Height: Integer read FHeight;
 421    property Created: Boolean read FCreated;
 422    property Showing: Boolean read FShowing;
 423    property InPaint: Boolean read FInPaint;
 424    property InScroll: Boolean read FInScroll;
 425    property NeedPositionConfirmed: boolean read FNeedPositionConfirmed;
 426  end;
 427
 428  TSynEditScreenCaretPainterClass = class of TSynEditScreenCaretPainter;
 429
 430  { TSynEditScreenCaretPainterSystem }
 431
 432  TSynEditScreenCaretPainterSystem = class(TSynEditScreenCaretPainter)
 433  protected
 434    //procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
 435    procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
 436    procedure BeginPaint(rcClip: TRect); override;
 437    //procedure FinishPaint(rcClip: TRect); override; // unhide, currently done by editor
 438  public
 439    function CreateCaret(w, h: Integer): Boolean; override;
 440    function DestroyCaret: Boolean; override;
 441    function HideCaret: Boolean; override;
 442    function ShowCaret: Boolean; override;
 443    function SetCaretPosEx(x, y: Integer): Boolean; override;
 444  end;
 445
 446  { TSynEditScreenCaretPainterInternal }
 447
 448  TSynEditScreenCaretPainterInternal = class(TSynEditScreenCaretPainter)
 449  private type
 450    TIsInRectState = (irInside, irPartInside, irOutside);
 451    TPainterState = (psAfterPaintAdded, psCleanOld, psRemoveTimer);
 452    TPainterStates = set of TPainterState;
 453  private
 454    FColor: TColor;
 455    FForcePaintEvents: Boolean;
 456    FIsDrawn: Boolean;
 457    FSavePen: TPen;
 458    FOldX, FOldY, FOldW, FOldH: Integer;
 459    FState: TPainterStates;
 460    FCanPaint: Boolean;
 461
 462    procedure DoTimer(Sender: TObject);
 463    procedure DoPaint(ACanvas: TCanvas; X, Y, H, W: Integer);
 464    procedure Paint;
 465    procedure Invalidate;
 466    procedure AddAfterPaint(AStates: TPainterStates = []);
 467    procedure DoAfterPaint(Sender: TObject);
 468    procedure ExecAfterPaint;
 469    function CurrentCanvas: TCanvas;
 470    procedure SetColor(AValue: TColor);
 471    function IsInRect(ARect: TRect): TIsInRectState;
 472    function IsInRect(ARect: TRect; X, Y, W, H: Integer): TIsInRectState;
 473  protected
 474    procedure Init; override;
 475
 476    procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
 477    procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
 478    procedure BeginPaint(rcClip: TRect); override;
 479    procedure FinishPaint(rcClip: TRect); override;
 480  public
 481    destructor Destroy; override;
 482    function CreateCaret(w, h: Integer): Boolean; override;
 483    function DestroyCaret: Boolean; override;
 484    function HideCaret: Boolean; override;
 485    function ShowCaret: Boolean; override;
 486    function SetCaretPosEx(x, y: Integer): Boolean; override;
 487    property Color: TColor read FColor write SetColor;
 488    property ForcePaintEvents: Boolean read FForcePaintEvents write FForcePaintEvents;
 489  end;
 490
 491  // relative dimensions in percent from 0 to 1024 (=100%)
 492  TSynCustomCaretSizeFlag = (ccsRelativeLeft, ccsRelativeTop, ccsRelativeWidth, ccsRelativeHeight);
 493  TSynCustomCaretSizeFlags = set of TSynCustomCaretSizeFlag;
 494
 495  { TSynEditScreenCaret }
 496
 497  TSynEditScreenCaret = class
 498  private
 499    FCharHeight: Integer;
 500    FCharWidth: Integer;
 501    FClipRight: Integer;
 502    FClipBottom: Integer;
 503    FClipLeft: Integer;
 504    FClipTop: Integer;
 505    FDisplayPos: TPoint;
 506    FDisplayType: TSynCaretType;
 507    FExtraLinePixel, FExtraLineChars: Integer;
 508    FOnExtraLineCharsChanged: TNotifyEvent;
 509    FVisible: Boolean;
 510    FHandleOwner: TWinControl;
 511    FCaretPainter: TSynEditScreenCaretPainter;
 512    FPaintTimer: TSynEditScreenCaretTimer;
 513    FPaintTimerOwned: Boolean;
 514    function GetHandle: HWND;
 515    function GetHandleAllocated: Boolean;
 516    procedure SetCharHeight(const AValue: Integer);
 517    procedure SetCharWidth(const AValue: Integer);
 518    procedure SetClipRight(const AValue: Integer);
 519    procedure SetDisplayPos(const AValue: TPoint);
 520    procedure SetDisplayType(const AType: TSynCaretType);
 521    procedure SetVisible(const AValue: Boolean);
 522  private
 523    FClipExtraPixel: Integer;
 524    {$IFDeF SynCaretDebug}
 525    FDebugShowCount: Integer;
 526    {$ENDIF}
 527    FPixelWidth, FPixelHeight: Integer;
 528    FOffsetX, FOffsetY: Integer;
 529    FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer;
 530    FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer;
 531    FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags;
 532    FLockCount: Integer;
 533    FLockFlags: TSynCaretLockFlags;
 534    function GetHasPaintTimer: Boolean;
 535    function GetPaintTimer: TSynEditScreenCaretTimer;
 536    procedure SetClipBottom(const AValue: Integer);
 537    procedure SetClipExtraPixel(AValue: Integer);
 538    procedure SetClipLeft(const AValue: Integer);
 539    procedure SetClipRect(const AValue: TRect);
 540    procedure SetClipTop(const AValue: Integer);
 541    procedure CalcExtraLineChars;
 542    procedure SetPaintTimer(AValue: TSynEditScreenCaretTimer);
 543    procedure UpdateDisplayType;
 544    procedure UpdateDisplay;
 545    procedure ShowCaret;
 546    procedure HideCaret;
 547    property HandleAllocated: Boolean read GetHandleAllocated;
 548  protected
 549    property Handle: HWND read GetHandle;
 550  public
 551    constructor Create(AHandleOwner: TWinControl);
 552    constructor Create(AHandleOwner: TWinControl; APainterClass: TSynEditScreenCaretPainterClass);
 553    procedure ChangePainter(APainterClass: TSynEditScreenCaretPainterClass);
 554    destructor Destroy; override;
 555
 556    procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect);
 557    procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean);
 558    procedure BeginPaint(rcClip: TRect);
 559    procedure FinishPaint(rcClip: TRect);
 560    procedure Lock;
 561    procedure UnLock;
 562    procedure AfterPaintEvent;  // next async
 563
 564    procedure  Hide; // Keep visible = true
 565    procedure  DestroyCaret(SkipHide: boolean = False);
 566    procedure ResetCaretTypeSizes;
 567    procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer;
 568                               AFlags: TSynCustomCaretSizeFlags = []);
 569    property HandleOwner: TWinControl read FHandleOwner;
 570    property PaintTimer: TSynEditScreenCaretTimer read GetPaintTimer write SetPaintTimer;
 571    property HasPaintTimer: Boolean read GetHasPaintTimer;
 572    property Painter: TSynEditScreenCaretPainter read FCaretPainter;
 573    property CharWidth:   Integer read FCharWidth write SetCharWidth;
 574    property CharHeight:  Integer read FCharHeight write SetCharHeight;
 575    property ClipLeft:    Integer read FClipLeft write SetClipLeft;
 576    property ClipRight:   Integer read FClipRight write SetClipRight;           // First pixel outside the allowed area
 577    property ClipTop:     Integer read FClipTop write SetClipTop;
 578    property ClipRect:    TRect write SetClipRect;
 579    property ClipBottom:  Integer read FClipBottom write SetClipBottom;
 580    property ClipExtraPixel: Integer read FClipExtraPixel write SetClipExtraPixel; // Amount of pixels, after  the last full char (half visible char width)
 581    property Visible:     Boolean read FVisible write SetVisible;
 582    property DisplayType: TSynCaretType read FDisplayType write SetDisplayType;
 583    property DisplayPos:  TPoint  read FDisplayPos write SetDisplayPos;
 584    property ExtraLineChars: Integer read FExtraLineChars; // Extend the longest line by x chars
 585    property OnExtraLineCharsChanged: TNotifyEvent
 586             read FOnExtraLineCharsChanged write FOnExtraLineCharsChanged;
 587  end;
 588
 589implementation
 590
 591{ TSynBeforeSetSelTextList }
 592
 593procedure TSynBeforeSetSelTextList.CallBeforeSetSelTextHandlers(Sender: TObject;
 594  AMode: TSynSelectionMode; ANewText: PChar);
 595var
 596  i: Integer;
 597begin
 598  i:=Count;
 599  while NextDownIndex(i) do
 600    TSynBeforeSetSelTextEvent(Items[i])(Sender, AMode, ANewText);
 601end;
 602
 603{ TSynEditBaseCaret }
 604
 605function TSynEditBaseCaret.GetBytePos: Integer;
 606begin
 607  ValidateBytePos;
 608  Result := FBytePos;
 609end;
 610
 611function TSynEditBaseCaret.GetBytePosOffset: Integer;
 612begin
 613  ValidateBytePos;
 614  Result := FBytePosOffset;
 615end;
 616
 617function TSynEditBaseCaret.GetCharPos: Integer;
 618begin
 619  ValidateCharPos;
 620  Result := FCharPos;
 621end;
 622
 623function TSynEditBaseCaret.GetFullLogicalPos: TLogCaretPoint;
 624begin
 625  ValidateBytePos;
 626  Result.Y := FLinePos;
 627  Result.X := FBytePos;
 628  Result.Offs := FBytePosOffset;
 629end;
 630
 631function TSynEditBaseCaret.GetLineBytePos: TPoint;
 632begin
 633  ValidateBytePos;
 634  Result := Point(FBytePos, FLinePos);
 635end;
 636
 637function TSynEditBaseCaret.GetLineCharPos: TPoint;
 638begin
 639  ValidateCharPos;
 640  Result := Point(FCharPos, FLinePos);
 641end;
 642
 643procedure TSynEditBaseCaret.SetBytePos(AValue: Integer);
 644begin
 645  InternalSetLineByterPos(FLinePos, AValue, 0, [scuChangedX]);
 646end;
 647
 648procedure TSynEditBaseCaret.SetBytePosOffset(AValue: Integer);
 649begin
 650  ValidateBytePos;
 651  InternalSetLineByterPos(FLinePos, FBytePos, AValue, [scuChangedX]);
 652end;
 653
 654procedure TSynEditBaseCaret.SetCharPos(AValue: Integer);
 655begin
 656  InternalSetLineCharPos(FLinePos, AValue, [scuChangedX]);
 657end;
 658
 659procedure TSynEditBaseCaret.SetFullLogicalPos(AValue: TLogCaretPoint);
 660begin
 661  InternalSetLineByterPos(AValue.y, AValue.x, AValue.Offs, [scuChangedX, scuChangedY]);
 662end;
 663
 664procedure TSynEditBaseCaret.SetLineBytePos(AValue: TPoint);
 665begin
 666  InternalSetLineByterPos(AValue.y, AValue.x, 0, [scuChangedX, scuChangedY]);
 667end;
 668
 669procedure TSynEditBaseCaret.SetLineCharPos(AValue: TPoint);
 670begin
 671  InternalSetLineCharPos(AValue.y, AValue.X, [scuChangedX, scuChangedY]);
 672end;
 673
 674procedure TSynEditBaseCaret.SetLinePos(AValue: Integer);
 675begin
 676  // TODO: may temporary lead to invalid x bytepos. Must be adjusted *before* calculating char
 677  //if scBytePosValid in FFlags then
 678  //  InternalSetLineByterPos(AValue, FBytePos, FBytePosOffset, [scuChangedY])
 679  //else
 680    ValidateCharPos;
 681    InternalSetLineCharPos(AValue, FCharPos, [scuChangedY]);
 682end;
 683
 684function TSynEditBaseCaret.GetLineText: string;
 685begin
 686  if (LinePos >= 1) and (LinePos <= FLines.Count) then
 687    Result := FLines[LinePos - 1]
 688  else
 689    Result := '';
 690end;
 691
 692procedure TSynEditBaseCaret.SetLineText(AValue: string);
 693begin
 694  if (LinePos >= 1) and (LinePos <= Max(1, FLines.Count)) then
 695    FLines[LinePos - 1] := AValue;
 696end;
 697
 698procedure TSynEditBaseCaret.ValidateBytePos;
 699begin
 700  if scBytePosValid in FFlags then
 701    exit;
 702  assert(scCharPosValid in FFlags, 'ValidateBytePos: no charpos set');
 703  Include(FFlags, scBytePosValid);
 704  FBytePos := FLines.LogPhysConvertor.PhysicalToLogical(FLinePos-1, FCharPos, FBytePosOffset);
 705end;
 706
 707procedure TSynEditBaseCaret.ValidateCharPos;
 708begin
 709  if scCharPosValid in FFlags then
 710    exit;
 711  assert(scBytePosValid in FFlags, 'ValidateCharPos: no bytepos set');
 712  Include(FFlags, scCharPosValid);
 713  FCharPos := FLines.LogPhysConvertor.LogicalToPhysical(FLinePos-1, FBytePos, FBytePosOffset);
 714end;
 715
 716procedure TSynEditBaseCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
 717  UpdFlags: TSynEditCaretUpdateFlags);
 718begin
 719  if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
 720     (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
 721  then
 722    exit;
 723
 724  if not (scuNoInvalidate in UpdFlags) then
 725    Exclude(FFlags, scBytePosValid);
 726  Include(FFlags, scCharPosValid);
 727
 728  if NewLine < 1 then begin
 729    NewLine := 1;
 730    Exclude(FFlags, scBytePosValid);
 731  end;
 732
 733  if NewCharPos < 1 then begin
 734    NewCharPos := 1;
 735    Exclude(FFlags, scBytePosValid);
 736  end;
 737
 738  FCharPos := NewCharPos;
 739  FLinePos := NewLine;
 740end;
 741
 742procedure TSynEditBaseCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
 743  UpdFlags: TSynEditCaretUpdateFlags);
 744begin
 745  if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
 746     (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
 747  then
 748    exit;
 749
 750  if not (scuNoInvalidate in UpdFlags) then
 751    Exclude(FFlags, scCharPosValid);
 752  Include(FFlags, scBytePosValid);
 753
 754  if NewLine < 1 then begin
 755    NewLine := 1;
 756    Exclude(FFlags, scCharPosValid);
 757  end;
 758
 759  if NewBytePos < 1 then begin
 760    NewBytePos := 1;
 761    Exclude(FFlags, scCharPosValid);
 762  end;
 763
 764  FBytePos       := NewBytePos;
 765  FBytePosOffset := NewByteOffs;
 766  FLinePos       := NewLine;
 767end;
 768
 769constructor TSynEditBaseCaret.Create;
 770begin
 771  inherited Create;
 772  fLinePos       := 1;
 773  fCharPos       := 1;
 774  FBytePos       := 1;
 775  FBytePosOffset := 0;
 776  FFlags := [scCharPosValid, scBytePosValid];
 777end;
 778
 779procedure TSynEditBaseCaret.AssignFrom(Src: TSynEditBaseCaret);
 780begin
 781  FLinePos       := Src.FLinePos;
 782  FCharPos       := Src.FCharPos;
 783  FBytePos       := Src.FBytePos;
 784  FBytePosOffset := Src.FBytePosOffset;
 785  FFlags         := Src.FFlags;
 786  SetLines(Src.FLines);
 787end;
 788
 789procedure TSynEditBaseCaret.Invalidate;
 790begin
 791  FLinePos := 1;
 792  FCharPos := 1;
 793  FBytePos := 1;
 794  FFlags := [];
 795end;
 796
 797procedure TSynEditBaseCaret.InvalidateBytePos;
 798begin
 799  if not (scCharPosValid in FFlags) then
 800    Invalidate
 801  else
 802    Exclude(FFlags, scBytePosValid);
 803end;
 804
 805procedure TSynEditBaseCaret.InvalidateCharPos;
 806begin
 807  if not (scBytePosValid in FFlags) then
 808    Invalidate
 809  else
 810    Exclude(FFlags, scCharPosValid);
 811end;
 812
 813function TSynEditBaseCaret.IsAtLineChar(aPoint: TPoint): Boolean;
 814begin
 815  ValidateCharPos;
 816  Result := (FLinePos = aPoint.y) and (FCharPos = aPoint.x);
 817end;
 818
 819function TSynEditBaseCaret.IsAtLineByte(aPoint: TPoint; aByteOffset: Integer): Boolean;
 820begin
 821  ValidateBytePos;
 822  Result := (FLinePos = aPoint.y) and (BytePos = aPoint.x) and
 823            ( (aByteOffset < 0) or (FBytePosOffset = aByteOffset) );
 824end;
 825
 826function TSynEditBaseCaret.IsAtPos(aCaret: TSynEditCaret): Boolean;
 827begin
 828  if (scBytePosValid in FFlags) or (scBytePosValid in aCaret.FFlags) then
 829    Result := IsAtLineByte(aCaret.LineBytePos, aCaret.BytePosOffset)
 830  else
 831    Result := IsAtLineChar(aCaret.LineCharPos);
 832end;
 833
 834{ TSynEditPointBase }
 835
 836function TSynEditPointBase.GetLocked: Boolean;
 837begin
 838  Result := FLockCount > 0;
 839end;
 840
 841procedure TSynEditPointBase.SetLines(const AValue: TSynEditStrings);
 842begin
 843  FLines := AValue;
 844end;
 845
 846procedure TSynEditPointBase.DoLock;
 847begin
 848end;
 849
 850procedure TSynEditPointBase.DoUnlock;
 851begin
 852end;
 853
 854constructor TSynEditPointBase.Create;
 855begin
 856  FOnChangeList := TMethodList.Create;
 857end;
 858
 859constructor TSynEditPointBase.Create(Lines : TSynEditStrings);
 860begin
 861  Create;
 862  FLines := Lines;
 863end;
 864
 865destructor TSynEditPointBase.Destroy;
 866begin
 867  FreeAndNil(FOnChangeList);
 868  inherited Destroy;
 869end;
 870
 871procedure TSynEditPointBase.AddChangeHandler(AHandler : TNotifyEvent);
 872begin
 873  FOnChangeList.Add(TMethod(AHandler));
 874end;
 875
 876procedure TSynEditPointBase.RemoveChangeHandler(AHandler : TNotifyEvent);
 877begin
 878  FOnChangeList.Remove(TMethod(AHandler));
 879end;
 880
 881procedure TSynEditPointBase.Lock;
 882begin
 883  if FLockCount = 0 then
 884    DoLock;
 885  inc(FLockCount);
 886end;
 887
 888procedure TSynEditPointBase.Unlock;
 889begin
 890  dec(FLockCount);
 891  if FLockCount = 0 then
 892    DoUnLock;
 893end;
 894
 895{ TSynEditCaret }
 896
 897constructor TSynEditCaret.Create;
 898begin
 899  inherited Create;
 900  FMaxLeftChar := nil;
 901  FAllowPastEOL := True;
 902  FForcePastEOL := 0;
 903  FAutoMoveOnEdit := 0;
 904  if FLines <> nil then
 905    FLines.AddEditHandler(@DoLinesEdited);
 906end;
 907
 908destructor TSynEditCaret.Destroy;
 909begin
 910  if FLines <> nil then
 911    FLines.RemoveEditHandler(@DoLinesEdited);
 912  inherited Destroy;
 913end;
 914
 915procedure TSynEditCaret.AssignFrom(Src: TSynEditBaseCaret);
 916begin
 917  FOldCharPos := FCharPos;
 918  FOldLinePos := FLinePos;
 919
 920  inherited AssignFrom(Src);
 921
 922  if Src is TSynEditCaret then begin
 923    FMaxLeftChar   := TSynEditCaret(Src).FMaxLeftChar;
 924    FAllowPastEOL  := TSynEditCaret(Src).FAllowPastEOL;
 925    FKeepCaretX    := TSynEditCaret(Src).FKeepCaretX;
 926    FLastCharPos   := TSynEditCaret(Src).FLastCharPos;
 927  end
 928  else begin
 929    AdjustToChar;
 930    FLastCharPos   := FCharPos;
 931  end;
 932end;
 933
 934procedure TSynEditCaret.DoLock;
 935begin
 936  FTouched := False;
 937  ValidateCharPos;
 938  //ValidateBytePos;
 939  FOldCharPos := FCharPos;
 940  FOldLinePos := FLinePos;
 941end;
 942
 943procedure TSynEditCaret.DoUnlock;
 944begin
 945  if not FChangeOnTouch then
 946    FTouched := False;
 947  FChangeOnTouch := False;
 948  ValidateCharPos;
 949  //ValidateBytePos;
 950  if (FOldCharPos <> FCharPos) or (FOldLinePos <> FLinePos) or FTouched then
 951    fOnChangeList.CallNotifyEvents(self);
 952  // All notifications called, reset oldpos
 953  FTouched := False;
 954  FOldCharPos := FCharPos;
 955  FOldLinePos := FLinePos;
 956end;
 957
 958procedure TSynEditCaret.SetLines(const AValue: TSynEditStrings);
 959begin
 960  if FLines = AValue then exit;
 961  // Do not check flag. It will be cleared in Assign
 962  if (FLines <> nil) then
 963    FLines.RemoveEditHandler(@DoLinesEdited);
 964  FLinesEditedRegistered := False;
 965  inherited SetLines(AValue);
 966  if FAutoMoveOnEdit > 0 then
 967    RegisterLinesEditedHandler;
 968end;
 969
 970procedure TSynEditCaret.RegisterLinesEditedHandler;
 971begin
 972  if FLinesEditedRegistered or (FLines = nil) then
 973    exit;
 974  FLinesEditedRegistered := True;
 975  FLines.AddEditHandler(@DoLinesEdited);
 976end;
 977
 978procedure TSynEditCaret.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
 979  aLineBrkCnt: Integer; aText: String);
 980  // Todo: refactor / this is a copy from selection
 981  function AdjustPoint(aPoint: Tpoint): TPoint; inline;
 982  begin
 983    Result := aPoint;
 984    if aLineBrkCnt < 0 then begin
 985      (* Lines Deleted *)
 986      if aPoint.y > aLinePos then begin
 987        Result.y := Max(aLinePos, Result.y + aLineBrkCnt);
 988        if Result.y = aLinePos then
 989          Result.x := Result.x + aBytePos - 1;
 990      end;
 991    end
 992    else
 993    if aLineBrkCnt > 0 then begin
 994      (* Lines Inserted *)
 995      if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then begin
 996        Result.x := Result.x - aBytePos + 1;
 997        Result.y := Result.y + aLineBrkCnt;
 998      end;
 999      if aPoint.y > aLinePos then begin
1000        Result.y := Result.y + aLineBrkCnt;
1001      end;
1002    end
1003    else
1004    if aCount <> 0 then begin
1005      (* Chars Insert/Deleted *)
1006      if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then
1007        Result.x := Max(aBytePos, Result.x + aCount);
1008    end;
1009  end;
1010
1011var
1012  p: TPoint;
1013begin
1014  if (FAutoMoveOnEdit > 0) and
1015     ( (aLineBrkCnt <> 0) or (aLinePos = FLinePos) )
1016  then begin
1017    IncForcePastEOL;
1018    ValidateBytePos;
1019    p :=  AdjustPoint(Point(FBytePos, FLinePos));
1020    InternalSetLineByterPos(p.y, p.x, FBytePosOffset, [scuChangedX, scuChangedY, scuForceSet]);
1021    DecForcePastEOL;
1022  end;
1023end;
1024
1025procedure TSynEditCaret.AdjustToChar;
1026var
1027  CharWidthsArr: TPhysicalCharWidths;
1028  CharWidths: PPhysicalCharWidth;
1029  i, LogLen: Integer;
1030  ScreenPos: Integer;
1031  LogPos: Integer;
1032  L: String;
1033begin
1034  ValidateCharPos;
1035  L := LineText;
1036  if FLines.LogPhysConvertor.CurrentLine = FLinePos then begin
1037    CharWidths := FLines.LogPhysConvertor.CurrentWidths;
1038    LogLen     := FLines.LogPhysConvertor.CurrentWidthsCount;
1039  end
1040  else begin
1041    CharWidthsArr := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
1042    LogLen        := Length(CharWidthsArr);
1043    if LogLen > 0 then
1044      CharWidths := @CharWidthsArr[0];
1045  end;
1046
1047  ScreenPos := 1;
1048  LogPos := 0;
1049
1050  while LogPos < LogLen do begin
1051    if ScreenPos = FCharPos then exit;
1052    if ScreenPos + (CharWidths[LogPos] and PCWMask) > FCharPos then begin
1053      if (L[LogPos+1] = #9) and (not FSkipTabs) then exit;
1054      i := FCharPos;
1055      if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
1056        FCharPos := ScreenPos + (CharWidths[LogPos] and PCWMask)
1057      else
1058        FCharPos := ScreenPos;
1059      if FCharPos <> i then
1060        Exclude(FFlags, scBytePosValid);
1061      exit;
1062    end;
1063    ScreenPos := ScreenPos + (CharWidths[LogPos] and PCWMask);
1064    inc(LogPos);
1065  end;
1066end;
1067
1068function TSynEditCaret.GetMaxLeftPastEOL: Integer;
1069begin
1070  if FMaxLeftChar <> nil then
1071    Result := FMaxLeftChar()
1072  else
1073    Result := MaxInt;
1074end;
1075
1076procedure TSynEditCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
1077  UpdFlags: TSynEditCaretUpdateFlags);
1078var
1079  LogEolPos, MaxPhysX, NewLogCharPos, Offs: Integer;
1080  L: String;
1081begin
1082  if not (scuChangedX in UpdFlags) and FKeepCaretX then
1083    NewCharPos := FLastCharPos;
1084
1085  Lock;
1086  FTouched := True;
1087  try
1088    if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
1089       (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
1090    then begin
1091      // Lines may have changed, so the other pos can be invalid
1092      if not (scuNoInvalidate in UpdFlags) then
1093        Exclude(FFlags, scBytePosValid);
1094      exit;
1095    end;
1096
1097    if NewLine > FLines.Count then begin
1098      NewLine := FLines.Count;
1099      Exclude(UpdFlags, scuNoInvalidate);
1100    end;
1101
1102    if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
1103      NewLine := 1;
1104      if (NewCharPos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
1105      then MaxPhysX := GetMaxLeftPastEOL
1106      else MaxPhysX := 1;
1107
1108      if NewCharPos > MaxPhysX then
1109        NewCharPos := MaxPhysX;
1110
1111      NewLogCharPos := NewCharPos;
1112      Offs := 0;
1113      Exclude(UpdFlags, scuNoInvalidate);
1114    end else begin
1115      if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
1116        NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToNextChar])
1117      else
1118        NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToCharBegin]);
1119      Offs := Lines.LogPhysConvertor.UnAdjustedPhysToLogColOffs;
1120      L := Lines[NewLine - 1];
1121
1122      if (Offs > 0) and (not FSkipTabs) and (L[NewLogCharPos] = #9) then begin
1123        // get the unadjusted result
1124        NewLogCharPos  := Lines.LogPhysConvertor.UnAdjustedPhysToLogResult
1125      end
1126      else begin
1127        // get adjusted Result
1128        NewCharPos := Lines.LogPhysConvertor.AdjustedPhysToLogOrigin;
1129        Offs := 0;
1130      end;
1131
1132      LogEolPos := length(L)+1;
1133      if NewLogCharPos > LogEolPos then begin
1134        if FAllowPastEOL or (FForcePastEOL > 0) then begin
1135          MaxPhysX := GetMaxLeftPastEOL;
1136          if NewCharPos > MaxPhysX then begin
1137            NewLogCharPos := NewLogCharPos - (NewCharPos - MaxPhysX);
1138            NewCharPos := MaxPhysX;
1139            Exclude(UpdFlags, scuNoInvalidate);
1140          end;
1141        end
1142        else begin
1143          NewCharPos := NewCharPos - (NewLogCharPos - LogEolPos);
1144          NewLogCharPos := LogEolPos;
1145          Exclude(UpdFlags, scuNoInvalidate);
1146        end;
1147      end;
1148
1149    end;
1150
1151    if NewCharPos < 1 then begin
1152      NewCharPos := 1;
1153      Exclude(UpdFlags, scuNoInvalidate);
1154    end;
1155
1156    inherited InternalSetLineCharPos(NewLine, NewCharPos, UpdFlags);
1157    inherited InternalSetLineByterPos(NewLine, NewLogCharPos, Offs, [scuNoInvalidate, scuChangedX]);
1158
1159    if (scuChangedX in UpdFlags) or (not FKeepCaretX) then
1160      FLastCharPos := FCharPos;
1161  finally
1162    Unlock;
1163  end;
1164end;
1165
1166procedure TSynEditCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
1167  UpdFlags: TSynEditCaretUpdateFlags);
1168var
1169  MaxPhysX, NewCharPos, LogEolPos: Integer;
1170  L: String;
1171begin
1172  if not (scuChangedX in UpdFlags) and FKeepCaretX then begin
1173    Exclude(UpdFlags, scuNoInvalidate);
1174    InternalSetLineCharPos(NewLine, FLastCharPos, UpdFlags);
1175    exit;
1176  end;
1177
1178  Lock;
1179  FTouched := True;
1180  try
1181    if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
1182       (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
1183    then begin
1184      // Lines may have changed, so the other pos can be invalid
1185      if not (scuNoInvalidate in UpdFlags) then
1186        Exclude(FFlags, scCharPosValid);
1187      exit;
1188    end;
1189
1190    if NewLine > FLines.Count then begin
1191      NewLine := FLines.Count;
1192      Exclude(UpdFlags, scuNoInvalidate);
1193    end;
1194
1195    if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
1196      L := '';
1197      NewLine := 1;
1198      LogEolPos := 1;
1199      if (NewBytePos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
1200      then MaxPhysX := GetMaxLeftPastEOL
1201      else MaxPhysX := 1;
1202      if NewBytePos > MaxPhysX then
1203        NewBytePos := MaxPhysX;
1204      NewByteOffs := 0;
1205      NewCharPos := NewBytePos;
1206      Exclude(UpdFlags, scuNoInvalidate);
1207    end else begin
1208      L := Lines[NewLine - 1];
1209      LogEolPos := length(L)+1;
1210
1211      if (NewBytePos > LogEolPos) then begin
1212        if not(FAllowPastEOL or (FForcePastEOL > 0)) then
1213          NewBytePos := LogEolPos;
1214        NewByteOffs := 0;
1215      end
1216      else
1217      if (NewByteOffs > 0) and ( (FSkipTabs) or (L[NewBytePos] <> #9) ) then
1218        NewByteOffs := 0;
1219
1220
1221      if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
1222        NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToNextChar])
1223      else
1224        NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToCharBegin]);
1225      NewBytePos := Lines.LogPhysConvertor.AdjustedLogToPhysOrigin;
1226
1227      if (NewBytePos > LogEolPos) then begin
1228        MaxPhysX := GetMaxLeftPastEOL;
1229        if NewCharPos > MaxPhysX then begin
1230          NewBytePos := NewBytePos - (NewCharPos - MaxPhysX);
1231          NewCharPos := MaxPhysX;
1232          Exclude(UpdFlags, scuNoInvalidate);
1233        end;
1234      end;
1235
1236    end;
1237
1238    if NewBytePos < 1 then begin
1239      NewBytePos := 1;
1240      Exclude(UpdFlags, scuNoInvalidate);
1241    end;
1242
1243    inherited InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs, UpdFlags);
1244    inherited InternalSetLineCharPos(NewLine, NewCharPos, [scuNoInvalidate, scuChangedX]);
1245
1246    if (scuChangedX in UpdFlags) and FKeepCaretX then
1247      FLastCharPos := FCharPos;
1248  finally
1249    Unlock;
1250  end;
1251end;
1252
1253function TSynEditCaret.GetOldLineCharPos: TPoint;
1254begin
1255  Result := Point(FOldCharPos, FOldLinePos);
1256end;
1257
1258function TSynEditCaret.GetOldLineBytePos: TPoint;
1259begin
1260  Result := FLines.PhysicalToLogicalPos(OldLineCharPos);
1261end;
1262
1263function TSynEditCaret.GetOldFullLogicalPos: TLogCaretPoint;
1264begin
1265  Result.Y := FOldLinePos;
1266  Result.X := FLines.LogPhysConvertor.PhysicalToLogical(ToIdx(FOldLinePos), FOldCharPos, Result.Offs);
1267end;
1268
1269procedure TSynEditCaret.SetAllowPastEOL(const AValue: Boolean);
1270begin
1271  if FAllowPastEOL = AValue then exit;
1272  FAllowPastEOL := AValue;
1273  if not FAllowPastEOL then begin
1274    // TODO: this would set x=LastX
1275    //if scBytePosValid in FFlags then
1276    //  InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
1277    //else
1278    ValidateCharPos;
1279    InternalSetLineCharPos(FLinePos, FCharPos, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
1280  end;
1281end;
1282
1283procedure TSynEditCaret.SetKeepCaretX(const AValue: Boolean);
1284begin
1285  if FKeepCaretX = AValue then exit;
1286  FKeepCaretX := AValue;
1287  if FKeepCaretX then begin
1288    ValidateCharPos;
1289    FLastCharPos := FCharPos;
1290  end;
1291end;
1292
1293procedure TSynEditCaret.SetSkipTabs(const AValue: Boolean);
1294begin
1295  if FSkipTabs = AValue then exit;
1296  FSkipTabs := AValue;
1297  if FSkipTabs then begin
1298    Lock;
1299    AdjustToChar;
1300    Unlock;
1301  end;
1302end;
1303
1304procedure TSynEditCaret.IncForcePastEOL;
1305begin
1306  inc(FForcePastEOL);
1307end;
1308
1309procedure TSynEditCaret.DecForcePastEOL;
1310begin
1311  dec(FForcePastEOL);
1312end;
1313
1314procedure TSynEditCaret.IncForceAdjustToNextChar;
1315begin
1316  Inc(FForceAdjustToNextChar);
1317end;
1318
1319procedure TSynEditCaret.DecForceAdjustToNextChar;
1320begin
1321  Dec(FForceAdjustToNextChar);
1322end;
1323
1324procedure TSynEditCaret.IncAutoMoveOnEdit;
1325begin
1326  if FAutoMoveOnEdit = 0 then begin
1327    RegisterLinesEditedHandler;
1328    ValidateBytePos;
1329  end;
1330  inc(FAutoMoveOnEdit);
1331end;
1332
1333procedure TSynEditCaret.DecAutoMoveOnEdit;
1334begin
1335  dec(FAutoMoveOnEdit);
1336end;
1337
1338procedure TSynEditCaret.ChangeOnTouch;
1339begin
1340  FChangeOnTouch := True;
1341  if not Locked then
1342    FTouched := False;
1343end;
1344
1345procedure TSynEditCaret.Touch(aChangeOnTouch: Boolean);
1346begin
1347  if aChangeOnTouch then
1348    ChangeOnTouch;
1349  FTouched := True;
1350end;
1351
1352
1353function TSynEditCaret.WasAtLineChar(aPoint: TPoint): Boolean;
1354begin
1355  Result := (FOldLinePos = aPoint.y) and (FOldCharPos = aPoint.x);
1356end;
1357
1358function TSynEditCaret.WasAtLineByte(aPoint: TPoint): Boolean;
1359begin
1360  Result := (FOldLinePos = aPoint.y) and
1361            (FLines.PhysicalToLogicalPos(Point(FOldCharPos, FOldLinePos)).X = aPoint.x);
1362end;
1363
1364function TSynEditCaret.MoveHoriz(ACount: Integer): Boolean;
1365var
1366  L: String;
1367  CharWidths: TPhysicalCharWidths;
1368  GotCharWidths: Boolean;
1369  MaxOffs: Integer;
1370  p: Integer;
1371  NC: Boolean;
1372  NF: Integer;
1373
1374  function GetMaxOffs(AlogPos: Integer): Integer;
1375  begin
1376    if not GotCharWidths then
1377      CharWidths := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
1378    GotCharWidths := True;
1379    Result := CharWidths[AlogPos-1];
1380  end;
1381
1382begin
1383  GotCharWidths := False;
1384  L := LineText;
1385  ValidateBytePos;
1386
1387  If ACount > 0 then begin
1388    if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
1389      MaxOffs := GetMaxOffs(FBytePos) - 1
1390    else
1391      MaxOffs := 0;
1392
1393    while ACount > 0 do begin
1394      if FBytePosOffset < MaxOffs then
1395        inc(FBytePosOffset)
1396      else begin
1397        if (FBytePos > length(L)) and not (FAllowPastEOL or (FForcePastEOL > 0)) then
1398          break;
1399        FBytePos := FLines.LogicPosAddChars(L, FBytePos, 1, True);
1400        FBytePosOffset := 0;
1401        if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
1402          MaxOffs := GetMaxOffs(FBytePos) - 1
1403        else
1404          MaxOffs := 0;
1405      end;
1406      dec(ACount);
1407    end;
1408    Result := ACount = 0;
1409
1410    p := FBytePos;
1411    IncForceAdjustToNextChar;
1412    InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
1413    DecForceAdjustToNextChar;
1414    if p > FBytePos then
1415      Result := False; // MaxLeftChar
1416  end
1417  else begin
1418    while ACount < 0 do begin
1419      if FBytePosOffset > 0 then
1420        dec(FBytePosOffset)
1421      else begin
1422        if FBytePos = 1 then
1423          break;
1424        FBytePos := FLines.LogicPosAddChars(L, FBytePos, -1, True);
1425        if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
1426          FBytePosOffset := GetMaxOffs(FBytePos) - 1
1427        else
1428          FBytePosOffset := 0;
1429      end;
1430      inc(ACount);
1431    end;
1432    Result := ACount = 0;
1433
1434    NC := FAdjustToNextChar;
1435    NF := FForceAdjustToNextChar;
1436    FAdjustToNextChar      := False;
1437    FForceAdjustToNextChar := 0;
1438    InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
1439    FAdjustToNextChar      := NC;
1440    FForceAdjustToNextChar := NF;
1441  end;
1442end;
1443
1444{ TSynEditSelection }
1445
1446constructor TSynEditSelection.Create(ALines : TSynEditStrings; aActOnLineChanges: Boolean);
1447begin
1448  Inherited Create(ALines);
1449  FOnBeforeSetSelText := TSynBeforeSetSelTextList.Create;
1450  FInternalCaret := TSynEditBaseCaret.Create;
1451  FInternalCaret.Lines := FLines;
1452
1453  FActiveSelectionMode := smNormal;
1454  FStartLinePos := 1;
1455  FStartBytePos := 1;
1456  FAltStartLinePos := -1;
1457  FAltStartBytePos := -1;
1458  FEndLinePos := 1;
1459  FEndBytePos := 1;
1460  FEnabled := True;
1461  FHookedLines := aActOnLineChanges;
1462  FIsSettingText := False;
1463  if FHookedLines then begin
1464    FLines.AddEditHandler(@DoLinesEdited);
1465    FLines.AddChangeHandler(senrLineChange, @LineChanged);
1466  end;
1467end;
1468
1469destructor TSynEditSelection.Destroy;
1470begin
1471  FreeAndNil(FOnBeforeSetSelText);
1472  FreeAndNil(FInternalCaret);
1473  if FHookedLines then begin
1474    FLines.RemoveEditHandler(@DoLinesEdited);
1475    FLines.RemoveChangeHandler(senrLineChange, @LineChanged);
1476  end;
1477  inherited Destroy;
1478end;
1479
1480procedure TSynEditSelection.AssignFrom(Src: TSynEditSelection);
1481begin
1482  //FEnabled             := src.FEnabled;
1483  FHide                := src.FHide;
1484  FActiveSelectionMode := src.FActiveSelectionMode;
1485  FSelectionMode       := src.FSelectionMode;
1486  FStartLinePos        := src.FStartLinePos; // 1 based
1487  FStartBytePos        := src.FStartBytePos; // 1 based
1488  FEndLinePos          := src.FEndLinePos; // 1 based
1489  FEndBytePos          := src.FEndBytePos; // 1 based
1490  FPersistent          := src.FPersistent;
1491end;
1492
1493procedure TSynEditSelection.AdjustAfterTrimming;
1494begin
1495  if FStartBytePos > Length(FLines[FStartLinePos-1]) + 1 then
1496    FStartBytePos := Length(FLines[FStartLinePos-1]) + 1;
1497  if FEndBytePos > Length(FLines[FEndLinePos-1]) + 1 then
1498    FEndBytePos := Length(FLines[FEndLinePos-1]) + 1;
1499  // Todo: Call ChangeNotification
1500end;
1501
1502procedure TSynEditSelection.DoLock;
1503begin
1504  inherited DoLock;
1505  FLastCarePos := Point(-1, -1);
1506end;
1507
1508procedure TSynEditSelection.DoUnlock;
1509begin
1510  inherited DoUnlock;
1511  FLastCarePos := Point(-1, -1);
1512end;
1513
1514function TSynEditSelection.GetSelText : string;
1515
1516  function CopyPadded(const S: string; Index, Count: integer): string;
1517  var
1518    SrcLen: Integer;
1519    DstLen: integer;
1520    P: PChar;
1521  begin
1522    SrcLen := Length(S);
1523    DstLen := Index + Count;
1524    if SrcLen >= DstLen then
1525      Result := Copy(S, Index, Count)
1526    else begin
1527      SetLength(Result, DstLen);
1528      P := PChar(Pointer(Result));
1529      StrPCopy(P, Copy(S, Index, Count));
1530      Inc(P, SrcLen);
1531      FillChar(P^, DstLen - Srclen, $20);
1532    end;
1533  end;
1534
1535  procedure CopyAndForward(const S: string; Index, Count: Integer; var P:
1536    PChar);
1537  var
1538    pSrc: PChar;
1539    SrcLen: Integer;
1540    DstLen: Integer;
1541  begin
1542    SrcLen := Length(S);
1543    if (Index <= SrcLen) and (Count > 0) then begin
1544      Dec(In…

Large files files are truncated, but you can click here to view the full file