1unit SynPluginMultiCaret; 2 3{$mode objfpc}{$H+} 4 5{off $DEFINE SynMultiCaretAssert} 6{off $DEFINE SynMultiCaretDebug} 7 8{$IfDef SynMultiCaretAssert} 9 {$ASSERTIONS on} 10{$ENDIF} 11{ $INLINE off} 12interface 13 14uses 15 Classes, SysUtils, SynEdit, SynEditPointClasses, SynEditKeyCmds, SynEditTypes, 16 LazSynTextArea, SynEditMiscProcs, LazSynEditText, SynEditMiscClasses, SynEditMouseCmds, 17 SynEditStrConst, SynEditTextTrimmer, SynEditTextBase, 18 {$IfDef SynMultiCaretDebug} LazLoggerBase, {$ELSE} LazLoggerDummy, {$ENDIF} 19 LCLType, Controls, Graphics, Clipbrd; 20 21const 22 23 emcPluginMultiCaretToggleCaret = emcPluginFirstMultiCaret + 0; 24 emcPluginMultiCaretSelectionToCarets = emcPluginFirstMultiCaret + 1; 25 26 ecPluginMultiCaretSetCaret = ecPluginFirstMultiCaret + 0; 27 ecPluginMultiCaretUnsetCaret = ecPluginFirstMultiCaret + 1; 28 ecPluginMultiCaretToggleCaret = ecPluginFirstMultiCaret + 2; 29 ecPluginMultiCaretClearAll = ecPluginFirstMultiCaret + 3; 30 31 ecPluginMultiCaretModeCancelOnMove = ecPluginFirstMultiCaret + 4; 32 ecPluginMultiCaretModeMoveAll = ecPluginFirstMultiCaret + 5; 33 34 // last 35 ecPluginLastMultiCaret = ecPluginFirstMultiCaret + 5; 36 37const 38 EMPTY_LIST_LEN = 8; 39 40type 41 42 TSynMultiCaretCommandAction = ( 43 ccaDefaultAction, // build in default, if any 44 ccaNoneRepeatCommand, // Run Command (onc), clear carets IF any changes (text,selection,main-caret) 45 ccaRepeatCommand, // Repeat the command for each caret 46 ccaRepeatCommandPerLine, // Repeat the command for the first caret on each line 47 ccaClearCarets, // Always Clear all carets 48 ccaAdjustCarets // Run the command once (for main-caret), keep and adjust all carets 49 ); 50 TSynMultiCaretCommandFlag = ( // for extension 51 ccfDummy // do not use 52 ); 53 TSynMultiCaretCommandFlags = set of TSynMultiCaretCommandFlag; 54 55 TSynMultiCaretBeforeCommand = procedure(Sender: TObject; 56 ACommand: TSynEditorCommand; 57 var AnAction: TSynMultiCaretCommandAction; 58 var AFlags: TSynMultiCaretCommandFlags) of object; 59 60 TLogCaretPointArray = Array of TLogCaretPoint; 61 TSynPluginMultiCaretVisualList = class; 62 63 { TSynPluginMultiCaretVisual } 64 65 TSynPluginMultiCaretVisual = class(TSynEditScreenCaret) 66 private 67 FListIndex: Integer; 68 FUsedList: TSynPluginMultiCaretVisualList; 69 FUnUsedList: TSynPluginMultiCaretVisualList; 70 {$IfDef SynMultiCaretAssert} 71 FIsUsed: Boolean; 72 {$ENDIF} 73 public 74 constructor Create(AHandleOwner: TWinControl; 75 APainterClass: TSynEditScreenCaretPainterClass; 76 AnUsedList, AnUnUsedList: TSynPluginMultiCaretVisualList); 77 procedure MoveToUsed; 78 procedure MoveToUnUsed; 79 property ListIndex: Integer read FListIndex; 80 property UsedList: TSynPluginMultiCaretVisualList read FUsedList; 81 property UnUsedList: TSynPluginMultiCaretVisualList read FUnUsedList; 82 end; 83 84 { TSynPluginMultiCaretVisualList } 85 86 TSynPluginMultiCaretVisualList = class 87 private 88 FList: Array of TSynPluginMultiCaretVisual; 89 FCount: Integer; 90 function GetScreenCaret(Index: Integer): TSynPluginMultiCaretVisual; 91 public 92 destructor Destroy; override; 93 procedure Add(AScreenCaret: TSynPluginMultiCaretVisual); 94 procedure Remove(AScreenCaret: TSynPluginMultiCaretVisual); 95 procedure Clear; // free visuals 96 function Count: Integer; 97 property ScreenCaret[Index: Integer]: TSynPluginMultiCaretVisual read GetScreenCaret; default; 98 end; 99 100 TCaretFlag = (cfMainCaret, cfNoneVisual, cfAddDuplicate, cfIterationDone); 101 TCaretFlags = set of TCaretFlag; 102 103 { TSynPluginMultiCaretList } 104 105 TSynPluginMultiCaretList = class 106 private type 107 //TCaretFlag = (cfMainCaret, cfNoneVisual); 108 //TCaretFlags = set of TCaretFlag; 109 TCaretData = record 110 x, y, offs: Integer; // logical 111 KeepX: Integer; 112 Flags: TCaretFlags; 113 Visual: TSynPluginMultiCaretVisual; 114 end; 115 PCaretData = ^TCaretData; 116 private 117 FLowIndex, FHighIndex: Integer; 118 FMainCaretIndex: Integer; 119 FMergeLock: Integer; 120 FCarets: Array of TCaretData; 121 function FindEqOrNextCaretRawIdx(X, Y, Offs: Integer; LowIdx: integer = -1; HighIdx: integer = -1): Integer; 122 function GetCaret(Index: Integer): TPoint; inline; 123 function GetCaretFull(Index: Integer): TLogCaretPoint; inline; 124 function GetCaretKeepX(Index: Integer): Integer; inline; 125 function GetCaretOffs(Index: Integer): Integer; inline; 126 function GetCaretX(Index: Integer): Integer; inline; 127 function GetCaretY(Index: Integer): Integer; inline; 128 function GetFlags(Index: Integer): TCaretFlags; 129 function GetMainCaretIndex: Integer; 130 function GetVisual(Index: Integer): TSynPluginMultiCaretVisual; inline; 131 procedure SetCaret(Index: Integer; AValue: TPoint); inline; 132 procedure SetCaretFull(Index: Integer; AValue: TLogCaretPoint); inline; 133 procedure SetCaretKeepX(Index: Integer; AValue: Integer); inline; 134 procedure SetCaretOffs(Index: Integer; AValue: Integer); inline; 135 procedure SetCaretX(Index: Integer; AValue: Integer); inline; 136 procedure SetCaretY(Index: Integer; AValue: Integer); inline; 137 procedure SetVisual(Index: Integer; AValue: TSynPluginMultiCaretVisual); inline; 138 139 function InternalRemoveCaretEx(RawIndex: Integer; AlternativeRawIndex: Integer = -1): Integer; 140 function InternalRemoveCaret(RawIndex: Integer): integer; 141 procedure AdjustAfterChange(RawIndex: Integer); inline; 142 public 143 constructor Create; 144 function AddCaret(X, Y, Offs: Integer; flags: TCaretFlags = []; PhysX: Integer = -1): Integer; 145 procedure RemoveCaret(Index: Integer); 146 procedure Clear(AFreeVisual: Boolean = False; ACapacity: Integer = EMPTY_LIST_LEN); 147 function Count: Integer; 148 function Capacity: Integer; 149 procedure ImportFromSortedList(AMultiCaretList: TLogCaretPointArray); 150 function FindCaretIdx(X, Y, Offs: Integer): Integer; 151 function FindEqOrNextCaretIdx(X, Y, Offs: Integer; LowIdx: integer = -1; HighIdx: integer = -1): Integer; 152 procedure AdjustAllAfterEdit(aLinePos, aBytePos, aCount, aLineBrkCnt: Integer); 153 procedure FindAndRemoveMergedCarets; 154 procedure IncMergeLock; 155 procedure DecMergeLock; 156 157 property Caret[Index: Integer]: TPoint read GetCaret write SetCaret; 158 property CaretFull[Index: Integer]: TLogCaretPoint read GetCaretFull write SetCaretFull; 159 property CaretX[Index: Integer]: Integer read GetCaretX write SetCaretX; 160 property CaretOffs[Index: Integer]: Integer read GetCaretOffs write SetCaretOffs; 161 property CaretKeepX[Index: Integer]: Integer read GetCaretKeepX write SetCaretKeepX; 162 property CaretY[Index: Integer]: Integer read GetCaretY write SetCaretY; 163 property Visual[Index: Integer]: TSynPluginMultiCaretVisual read GetVisual write SetVisual; 164 property Flags[Index: Integer]: TCaretFlags read GetFlags; 165 property MainCaretIndex: Integer read GetMainCaretIndex; 166 167 private 168 FCurrenCaret, FBeforeNextCaret: PCaretData; 169 FIterationDoneCount: Integer; 170 FLowCaret, FHighCaret: PCaretData; // used in AdjustAfterChange 171 FIteratoreMode: (mciNone, mciUp, mciDown); 172 function GetCurrentCaretFlags: TCaretFlags; inline; 173 function GetCurrentCaretFull: TLogCaretPoint; inline; 174 function GetCurrentCaretKeepX: Integer; inline; 175 procedure SetCurrentCaretFull(AValue: TLogCaretPoint); inline; 176 procedure SetCurrentCaretKeepX(AValue: Integer); inline; 177 178 procedure AdjustAfterChange(ACaret: PCaretData); 179 public 180 // During iteration no calls to add/remove are allowed 181 procedure StartIteratorAtFirst; // valid after first call to IterateNextUp 182 function IterateNextUp: Boolean; inline; 183 procedure StartIteratorAtLast; 184 function IterateNextDown: Boolean; inline; 185 function CanPeekCaret(AIndexOffset: Integer): Boolean; inline; 186 function PeekCaretY(AIndexOffset: Integer): Integer; inline; 187 function PeekCaretFull(AIndexOffset: Integer): TLogCaretPoint; inline; 188 //procedure AbortIterator; 189 190 property CurrentCaretFull: TLogCaretPoint read GetCurrentCaretFull write SetCurrentCaretFull; 191 property CurrentCaretKeepX: Integer read GetCurrentCaretKeepX write SetCurrentCaretKeepX; 192 property CurrentCaretFlags: TCaretFlags read GetCurrentCaretFlags; 193 //property CurrentCaret: TPoint read GetCurrentCaret write SetCurrentCaret; 194 //property CurrentCaretX: Integer read GetCurrentCaretX write SetCurrentCaretX; 195 //property CurrentCaretOffs: Integer read GetCurrentCaretOffs write SetCurrentCaretOffs; 196 //property CurrentCaretY: Integer read GetCurrentCaretY write SetCurrentCaretY; 197 end; 198 199 { TSynPluginMultiCaretBase } 200 201 TSynPluginMultiCaretBase = class(TLazSynEditPlugin) 202 private 203 FCarets: TSynPluginMultiCaretList; 204 FColor: TColor; 205 FRestoreSingleCaretPainter: Boolean; 206 FSingleCaretClass: TSynEditScreenCaretPainterClass; 207 FUsedList: TSynPluginMultiCaretVisualList; 208 FUnUsedList: TSynPluginMultiCaretVisualList; 209 FInPaint: Boolean; 210 FPaintClip: TRect; 211 212 FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer; 213 FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer; 214 FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags; 215 216 FPaintLock: Integer; 217 FPaintLockFlags: set of 218 (plfUpdateCaretsPos, plfDeferUpdateCaretsPos, plfMergeCarets, 219 plfBoundsChanged, plfTextSizeChanged); 220 221 function GetTextArea: TLazSynTextArea; 222 procedure DoTextSizeChanged(Sender: TObject); 223 procedure DoBoundsChanged(Sender: TObject); 224 procedure MergeAndRemoveCarets(AForce: Boolean = False); 225 function IsCaretMergeRequested: Boolean; 226 procedure DoEditorPaintEvent(Sender: TObject; EventType: TSynPaintEvent; 227 const prcClip: TRect); 228 procedure DoEditorScrollEvent(Sender: TObject; EventType: TSynScrollEvent; dx, 229 dy: Integer; const prcScroll, prcClip: TRect); 230 procedure DoEditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges); 231 procedure DoAfterDecPaintLock(Sender: TObject); virtual; 232 procedure DoBeforeIncPaintLock(Sender: TObject); virtual; 233 procedure DoBufferChanged(Sender: TObject); virtual; 234 procedure SetColor(AValue: TColor); 235 property TextArea: TLazSynTextArea read GetTextArea; 236 function CreateVisual: TSynPluginMultiCaretVisual; virtual; 237 function GetVisual: TSynPluginMultiCaretVisual; 238 protected 239 procedure UpdateMainCaret; 240 function AddCaret(X, Y, Offs: Integer; flags: TCaretFlags = []; PhysX: Integer = -1): Integer; 241 procedure RemoveCaret(Index: Integer); 242 procedure UpdateCaretsPos; 243 procedure ClearCarets; 244 function CaretsCount: Integer; 245 procedure DoCleared; virtual; 246 247 procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount, 248 aLineBrkCnt: Integer; aText: String); virtual; 249 procedure DoEditorRemoving(AValue: TCustomSynEdit); override; 250 procedure DoEditorAdded(AValue: TCustomSynEdit); override; 251 252 property Carets: TSynPluginMultiCaretList read FCarets; 253 property PaintLock: Integer read FPaintLock; 254 public 255 constructor Create(AOwner: TComponent); override; 256 destructor Destroy; override; 257 258 procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer; AFlags: TSynCustomCaretSizeFlags); 259 property Color: TColor read FColor write SetColor; 260 property RestoreSingleCaretPainter: Boolean read FRestoreSingleCaretPainter write FRestoreSingleCaretPainter; 261 end; 262 263 { TSynPluginMultiCaretMouseActions } 264 265 TSynPluginMultiCaretMouseActions = class(TSynEditMouseActions) 266 public 267 procedure ResetDefaults; override; 268 end; 269 270 { TSynPluginMultiCaretKeyStrokes } 271 272 TSynPluginMultiCaretKeyStrokes = class(TSynEditKeyStrokes) 273 public 274 procedure ResetDefaults; override; 275 end; 276 277 TSynPluginMultiCaretMode = ( 278 mcmCancelOnCaretMove, 279 mcmMoveAllCarets, 280 // Only for ActiveMode 281 mcmNoCarets, 282 mcmAddingCarets // move main caret, keep others 283 ); 284 TSynPluginMultiCaretDefaultMode = mcmCancelOnCaretMove..mcmMoveAllCarets; 285 286 TSynPluginMultiCaretStateFlag = ( 287 sfProcessingCmd, sfProcessingMain, sfProcessingRepeat, 288 sfNoChangeIndicator, 289 sfExtendingColumnSel, sfSkipCaretsAtSelection, 290 sfCreateCaretAtCurrentPos, 291 sfSkipSelChanged, sfSkipCaretChanged, 292 sfSkipUndoCarets 293 ); 294 TSynPluginMultiCaretStateFlags = set of TSynPluginMultiCaretStateFlag; 295 296 TSynMultiCaretOption = ( 297 smcoDeleteSkipLineBreak // ecDeleteChar will not join lines 298 ); 299 TSynMultiCaretOptions = set of TSynMultiCaretOption; 300 301 { TSynEditUndoMultiCaret } 302 303 TSynEditUndoMultiCaret = class(TSynEditUndoItem) 304 private 305 FCaretUndoItem: TSynEditUndoItem; 306 FBeginBlock: Boolean; 307 FActiveMode: TSynPluginMultiCaretMode; 308 FMultiCaretList: TLogCaretPointArray; 309 protected 310 function IsEqualContent(AnItem: TSynEditUndoItem): Boolean; override; 311 function DebugString: String; override; 312 public 313 constructor Create(ACaretUndoItem: TSynEditUndoItem; ABeginBlock: Boolean); 314 destructor Destroy; override; 315 constructor AddCaretsFrom(AList: TSynPluginMultiCaretList); 316 function IsCaretInfo: Boolean; override; 317 function PerformUndo(Caller: TObject): Boolean; override; 318 property ActiveMode: TSynPluginMultiCaretMode read FActiveMode write FActiveMode; 319 end; 320 321 { TSynCustomPluginMultiCaret } 322 323 TSynCustomPluginMultiCaret = class(TSynPluginMultiCaretBase) 324 private 325 FActiveMode: TSynPluginMultiCaretMode; 326 FDefaultColumnSelectMode: TSynPluginMultiCaretDefaultMode; 327 FDefaultMode: TSynPluginMultiCaretDefaultMode; 328 FEnableWithColumnSelection: Boolean; 329 FKeyStrokes: TSynPluginMultiCaretKeyStrokes; 330 FOnBeforeCommand: TSynMultiCaretBeforeCommand; 331 FOptions: TSynMultiCaretOptions; 332 FStateFlags: TSynPluginMultiCaretStateFlags; 333 FMouseActions: TSynPluginMultiCaretMouseActions; 334 FSelY1, FSelY2, FSelX: Integer; 335 FColSelDoneY1, FColSelDoneY2, FColSelDonePhysX: Integer; 336 FSpaceTrimmerLocked: Boolean; 337 FForeignPaintLock, FNestedCommandProcessor: Integer; 338 339 function GetIsInMainExecution: Boolean; 340 function GetIsInRepeatExecution: Boolean; 341 procedure RemoveCaretsInSelection; 342 procedure SetActiveMode(AValue: TSynPluginMultiCaretMode); 343 procedure SetDefaultColumnSelectMode(AValue: TSynPluginMultiCaretDefaultMode); 344 procedure SetDefaultMode(AValue: TSynPluginMultiCaretDefaultMode); 345 procedure SetSkipCaretAtSel; 346 347 procedure UpdateCaretForUndo(var AnUndoItem: TSynEditUndoItem; AnIsBeginUndo: Boolean); 348 function HandleUndoRedoItem(Caller: TObject; Item: TSynEditUndoItem): Boolean; 349 350 procedure LockSpaceTrimmer; // Todo: per line lock / reverse: trimmer should ask / add event for trimmer via caretObj 351 procedure UnLockSpaceTrimmer; 352 protected 353 function LogPhysConvertor: TSynLogicalPhysicalConvertor; inline; 354 function PhysicalToLogical(AIndex, AColumn: Integer; out AColOffset: Integer; 355 ACharSide: TSynPhysCharSide= cspDefault; 356 AFlags: TSynLogPhysFlags = []): Integer; inline; 357 358 359 procedure DoEditorRemoving(AValue: TCustomSynEdit); override; 360 procedure DoEditorAdded(AValue: TCustomSynEdit); override; 361 procedure DoBufferChanged(Sender: TObject); override; 362 363 procedure DoAfterDecPaintLock(Sender: TObject); override; 364 procedure DoIncForeignPaintLock(Sender: TObject); 365 procedure DoDecForeignPaintLock(Sender: TObject); 366 367 procedure DoCleared; override; 368 procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount, 369 aLineBrkCnt: Integer; aText: String); override; 370 procedure DoCaretChanged(Sender: TObject); 371 procedure DoSelectionChanged(Sender: TObject); 372 procedure DoBeforeSetSelText(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar); 373 procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState; 374 var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean; 375 var Command: TSynEditorCommand; FinishComboOnly: Boolean; 376 var ComboKeyStrokes: TSynEditKeyStrokes); 377 procedure ProcessMySynCommand(Sender: TObject; AfterProcessing: boolean; 378 var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char; 379 Data: pointer; HandlerData: pointer); 380 procedure ProcessAllSynCommand(Sender: TObject; AfterProcessing: boolean; 381 var Handled: boolean; var Command: TSynEditorCommand; 382 var AChar: TUTF8Char; Data: pointer; HandlerData: pointer); 383 function MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo; 384 HandleActionProc: TSynEditMouseActionHandler): Boolean; 385 function DoHandleMouseAction(AnAction: TSynEditMouseAction; 386 var AnInfo: TSynEditMouseActionInfo): Boolean; 387 388 procedure AddStateFlags(AFlags: TSynPluginMultiCaretStateFlags; AnOnlyIfLocked: Boolean); 389 function CreateVisual: TSynPluginMultiCaretVisual; override; 390 property ViewedTextBuffer; 391 public 392 constructor Create(AOwner: TComponent); override; 393 destructor Destroy; override; 394 procedure AddCaretAtLogPos(X, Y, Offs: Integer); 395 property IsInMainExecution: Boolean read GetIsInMainExecution; 396 property IsInRepeatExecution: Boolean read GetIsInRepeatExecution; 397 property MouseActions: TSynPluginMultiCaretMouseActions read FMouseActions; 398 property KeyStrokes: TSynPluginMultiCaretKeyStrokes read FKeyStrokes; 399 property EnableWithColumnSelection: Boolean read FEnableWithColumnSelection write FEnableWithColumnSelection default True; 400 property ActiveMode: TSynPluginMultiCaretMode read FActiveMode write SetActiveMode; 401 property DefaultMode: TSynPluginMultiCaretDefaultMode read FDefaultMode write SetDefaultMode default mcmMoveAllCarets; 402 property DefaultColumnSelectMode: TSynPluginMultiCaretDefaultMode 403 read FDefaultColumnSelectMode write SetDefaultColumnSelectMode default mcmCancelOnCaretMove; 404 property Options: TSynMultiCaretOptions read FOptions write FOptions; 405 property OnBeforeCommand: TSynMultiCaretBeforeCommand read FOnBeforeCommand write FOnBeforeCommand; 406 end; 407 408 TSynPluginMultiCaret = class(TSynCustomPluginMultiCaret) 409 published 410 property MouseActions; 411 property KeyStrokes; 412 property EnableWithColumnSelection; 413 property DefaultMode; 414 property DefaultColumnSelectMode; 415 property OnBeforeCommand; 416 end; 417 418implementation 419 420{$IfDef SynMultiCaretDebug} 421var 422 SynMCaretDebug: PLazLoggerLogGroup; 423{$EndIf} 424 425const 426 SynMouseCommandNames: array [0..1] of TIdentMapEntry = ( 427 (Value: emcPluginMultiCaretToggleCaret; Name: 'emcPluginMultiCaretToggleCaret'), 428 (Value: emcPluginMultiCaretSelectionToCarets; Name: 'emcPluginMultiCaretSelectionToCarets') 429 ); 430 431const 432 EditorKeyCommandStrs: array[0..5] of TIdentMapEntry = ( 433 (Value: ecPluginMultiCaretSetCaret; Name: 'ecPluginMultiCaretSetCaret'), 434 (Value: ecPluginMultiCaretUnsetCaret; Name: 'ecPluginMultiCaretUnsetCaret'), 435 (Value: ecPluginMultiCaretToggleCaret; Name: 'ecPluginMultiCaretToggleCaret'), 436 (Value: ecPluginMultiCaretClearAll; Name: 'ecPluginMultiCaretClearAll'), 437 (Value: ecPluginMultiCaretModeCancelOnMove; Name: 'ecPluginMultiCaretModeCancelOnMove'), 438 (Value: ecPluginMultiCaretModeMoveAll; Name: 'ecPluginMultiCaretModeMoveAll') 439 ); 440 441function IdentToKeyCommand(const Ident: string; var Cmd: longint): boolean; 442begin 443 Result := IdentToInt(Ident, Cmd, EditorKeyCommandStrs); 444end; 445 446function KeyCommandToIdent(Cmd: longint; var Ident: string): boolean; 447begin 448 Result := (Cmd >= ecPluginFirstMultiCaret) and (Cmd <= ecPluginLastMultiCaret); 449 if not Result then exit; 450 Result := IntToIdent(Cmd, Ident, EditorKeyCommandStrs); 451end; 452 453procedure GetEditorCommandValues(Proc: TGetStrProc); 454var 455 i: integer; 456begin 457 for i := Low(EditorKeyCommandStrs) to High(EditorKeyCommandStrs) do 458 Proc(EditorKeyCommandStrs[I].Name); 459end; 460 461function SynMouseCmdToIdent(SynMouseCmd: Longint; var Ident: String): Boolean; 462begin 463 Ident := ''; 464 Result := IntToIdent(SynMouseCmd, Ident, SynMouseCommandNames); 465end; 466 467function IdentToSynMouseCmd(const Ident: string; var SynMouseCmd: Longint): Boolean; 468begin 469 SynMouseCmd := 0; 470 Result := IdentToInt(Ident, SynMouseCmd, SynMouseCommandNames); 471end; 472 473procedure GetEditorMouseCommandValues(Proc: TGetStrProc); 474var 475 i: Integer; 476begin 477 for i := Low(SynMouseCommandNames) to High(SynMouseCommandNames) do 478 Proc(SynMouseCommandNames[I].Name); 479end; 480 481function MouseCommandName(emc: TSynEditorMouseCommand): String; 482begin 483 case emc of 484 emcPluginMultiCaretToggleCaret: Result := SYNS_emcPluginMultiCaretToggleCaret; 485 emcPluginMultiCaretSelectionToCarets: Result := SYNS_emcPluginMultiCaretSelectionToCarets; 486 else 487 Result := ''; 488 end; 489end; 490 491function MouseCommandConfigName(emc: TSynEditorMouseCommand): String; 492begin 493 case emc of 494 emcPluginMultiCaretToggleCaret, 495 emcPluginMultiCaretSelectionToCarets: Result := ''; 496 else 497 Result := ''; 498 end; 499end; 500 501{ TSynPluginMultiCaretVisual } 502 503constructor TSynPluginMultiCaretVisual.Create(AHandleOwner: TWinControl; 504 APainterClass: TSynEditScreenCaretPainterClass; AnUsedList, 505 AnUnUsedList: TSynPluginMultiCaretVisualList); 506begin 507 FListIndex := -1; 508 FUsedList := AnUsedList; 509 FUnUsedList := AnUnUsedList; 510 inherited Create(AHandleOwner, APainterClass); 511end; 512 513procedure TSynPluginMultiCaretVisual.MoveToUsed; 514begin 515 {$IfDef SynMultiCaretAssert} 516 assert((FListIndex < 0) or (not FIsUsed), 'TSynPluginMultiCaretVisual.MoveToUsed: not yet on list'); 517 FIsUsed := True; 518 {$ENDIF} 519 if FListIndex >= 0 then 520 FUnUsedList.Remove(Self); 521 FUsedList.Add(Self); 522end; 523 524procedure TSynPluginMultiCaretVisual.MoveToUnUsed; 525begin 526 {$IfDef SynMultiCaretAssert} 527 assert((FListIndex < 0) or FIsUsed, 'TSynPluginMultiCaretVisual.MoveToUnUsed: not yet on list'); 528 FIsUsed := False; 529 {$ENDIF} 530 if FListIndex >= 0 then 531 FUsedList.Remove(Self); 532 FUnUsedList.Add(Self); 533 Visible := False; 534end; 535 536{ TSynPluginMultiCaretVisualList } 537 538function TSynPluginMultiCaretVisualList.GetScreenCaret(Index: Integer): TSynPluginMultiCaretVisual; 539begin 540 Result := FList[Index]; 541end; 542 543destructor TSynPluginMultiCaretVisualList.Destroy; 544begin 545 inherited Destroy; 546 Clear; 547end; 548 549procedure TSynPluginMultiCaretVisualList.Add(AScreenCaret: TSynPluginMultiCaretVisual); 550begin 551 if (AScreenCaret.ListIndex >= 0) and (AScreenCaret.ListIndex < FCount) and 552 (FList[AScreenCaret.ListIndex] = AScreenCaret) 553 then begin 554 assert(False, 'TSynPluginMultiCaretVisualList.Add: not on list'); 555 exit; 556 end; 557 558 {$IfDef SynMultiCaretDebug} 559 if FCount = Length(FList) then debugln(SynMCaretDebug, ['TSynPluginMultiCaretVisualList.Add ', FCount + max(16, FCount div 16)]); 560 {$EndIf} 561 if FCount = Length(FList) then 562 SetLength(FList, FCount + max(16, FCount div 16)); 563 564 FList[FCount] := AScreenCaret; 565 AScreenCaret.FListIndex := FCount; 566 inc(FCount); 567end; 568 569procedure TSynPluginMultiCaretVisualList.Remove(AScreenCaret: TSynPluginMultiCaretVisual); 570var 571 t: TSynPluginMultiCaretVisual; 572begin 573 if (AScreenCaret.ListIndex < 0) or (AScreenCaret.ListIndex >= FCount) or 574 (FList[AScreenCaret.ListIndex] <> AScreenCaret) 575 then begin 576 assert(False, 'TSynPluginMultiCaretVisualList.Remove: not on list'); 577 exit; 578 end; 579 if AScreenCaret.ListIndex < FCount then begin 580 t := FList[FCount - 1]; 581 FList[AScreenCaret.ListIndex] := t; 582 t.FListIndex := AScreenCaret.ListIndex; 583 end; 584 AScreenCaret.FListIndex := -1; 585 dec(FCount); 586end; 587 588procedure TSynPluginMultiCaretVisualList.Clear; 589var 590 i: Integer; 591begin 592 for i := 0 to FCount - 1 do 593 FList[i].Free; 594 FCount := 0; 595 SetLength(FList, EMPTY_LIST_LEN); 596end; 597 598function TSynPluginMultiCaretVisualList.Count: Integer; 599begin 600 Result := FCount; 601end; 602 603{ TSynPluginMultiCaretList } 604 605function TSynPluginMultiCaretList.FindEqOrNextCaretRawIdx(X, Y, Offs: Integer; 606 LowIdx: integer; HighIdx: integer): Integer; 607var 608 l, h: integer; 609 cp: ^TCaretData; 610begin 611 if LowIdx < 0 612 then l := FLowIndex 613 else l := LowIdx; 614 if HighIdx < 0 615 then h := FHighIndex 616 else h := HighIdx; 617 618 if h < l then begin 619 Result := h; 620 exit; 621 end; 622 623 Result := (l + h) div 2; 624 // FPC does not optimize the repeated array access 625 while (h > l) do begin 626 cp := @FCarets[Result]; 627 if (cp^.y > y) or 628 ( (cp^.y = y) and 629 ( (cp^.x > x) or 630 ((cp^.x = x) and (cp^.offs >= Offs)) 631 ) 632 ) 633 then 634 h := Result // FCarets[Result] >= (x,y,o) 635 else 636 l := Result + 1; // FCarets[Result] < (x,y,o) 637 Result := cardinal(l + h) div 2; 638 end; 639 cp := @FCarets[Result]; 640 if (cp^.y < y) or 641 ( (cp^.y = y) and 642 (cp^.x < x) or 643 ((cp^.x = x) and (cp^.offs < Offs)) 644 ) 645 then 646 inc(Result); 647end; 648 649function TSynPluginMultiCaretList.GetCaret(Index: Integer): TPoint; 650begin 651 Index := Index + FLowIndex; 652 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaret: (Index>=FLowIndex) and (Index <= FHighIndex)'); 653 Result.x := FCarets[Index].x; 654 Result.y := FCarets[Index].y; 655end; 656 657function TSynPluginMultiCaretList.GetCaretFull(Index: Integer): TLogCaretPoint; 658begin 659 Index := Index + FLowIndex; 660 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 661 Result.X := FCarets[Index].x; 662 Result.Y := FCarets[Index].y; 663 Result.Offs := FCarets[Index].offs; 664end; 665 666function TSynPluginMultiCaretList.GetCaretKeepX(Index: Integer): Integer; 667begin 668 Index := Index + FLowIndex; 669 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 670 Result := FCarets[Index].KeepX; 671end; 672 673function TSynPluginMultiCaretList.GetCaretOffs(Index: Integer): Integer; 674begin 675 Index := Index + FLowIndex; 676 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 677 Result := FCarets[Index].offs; 678end; 679 680function TSynPluginMultiCaretList.GetCaretX(Index: Integer): Integer; 681begin 682 Index := Index + FLowIndex; 683 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 684 Result := FCarets[Index].x; 685end; 686 687function TSynPluginMultiCaretList.GetCaretY(Index: Integer): Integer; 688begin 689 Index := Index + FLowIndex; 690 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretY: (Index>=FLowIndex) and (Index <= FHighIndex)'); 691 Result := FCarets[Index].y; 692end; 693 694function TSynPluginMultiCaretList.GetFlags(Index: Integer): TCaretFlags; 695begin 696 Index := Index + FLowIndex; 697 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetFlags: (Index>=FLowIndex) and (Index <= FHighIndex)'); 698 Result := FCarets[Index].Flags; 699end; 700 701function TSynPluginMultiCaretList.GetMainCaretIndex: Integer; 702begin 703 if FMainCaretIndex >= FLowIndex then 704 Result := FMainCaretIndex - FLowIndex 705 else 706 Result := -1; 707end; 708 709function TSynPluginMultiCaretList.GetVisual(Index: Integer): TSynPluginMultiCaretVisual; 710begin 711 Index := Index + FLowIndex; 712 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetVisual: (Index>=FLowIndex) and (Index <= FHighIndex)'); 713 Result := FCarets[Index].Visual; 714end; 715 716procedure TSynPluginMultiCaretList.SetCaret(Index: Integer; AValue: TPoint); 717begin 718 Index := Index + FLowIndex; 719 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaret: (Index>=FLowIndex) and (Index <= FHighIndex)'); 720 if (FCarets[Index].x = AValue.x) and (FCarets[Index].y = AValue.y) then exit; 721 FCarets[Index].x := AValue.x; 722 FCarets[Index].y := AValue.y; 723 AdjustAfterChange(Index); 724end; 725 726procedure TSynPluginMultiCaretList.SetCaretFull(Index: Integer; AValue: TLogCaretPoint); 727begin 728 Index := Index + FLowIndex; 729 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 730 if (FCarets[Index].x = AValue.x) and (FCarets[Index].y = AValue.y) and (FCarets[Index].offs = AValue.Offs) then 731 exit; 732 FCarets[Index].x := AValue.X; 733 FCarets[Index].y := AValue.Y; 734 FCarets[Index].offs := AValue.Offs; 735 AdjustAfterChange(Index); 736end; 737 738procedure TSynPluginMultiCaretList.SetCaretKeepX(Index: Integer; AValue: Integer); 739begin 740 Index := Index + FLowIndex; 741 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 742 //if FCarets[Index].KeepX = AValue then exit; 743 FCarets[Index].KeepX := AValue; 744end; 745 746procedure TSynPluginMultiCaretList.SetCaretOffs(Index: Integer; AValue: Integer); 747begin 748 Index := Index + FLowIndex; 749 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 750 if FCarets[Index].offs = AValue then exit; 751 FCarets[Index].offs := AValue; 752 AdjustAfterChange(Index); 753end; 754 755procedure TSynPluginMultiCaretList.SetCaretX(Index: Integer; AValue: Integer); 756begin 757 Index := Index + FLowIndex; 758 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)'); 759 if FCarets[Index].x = AValue then exit; 760 FCarets[Index].x := AValue; 761 AdjustAfterChange(Index); 762end; 763 764procedure TSynPluginMultiCaretList.SetCaretY(Index: Integer; AValue: Integer); 765begin 766 Index := Index + FLowIndex; 767 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretY: (Index>=FLowIndex) and (Index <= FHighIndex)'); 768 if FCarets[Index].y = AValue then exit; 769 FCarets[Index].y := AValue; 770 AdjustAfterChange(Index); 771end; 772 773procedure TSynPluginMultiCaretList.SetVisual(Index: Integer; AValue: TSynPluginMultiCaretVisual); 774begin 775 Index := Index + FLowIndex; 776 assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetVisual: (Index>=FLowIndex) and (Index <= FHighIndex)'); 777 if FCarets[Index].Visual <> nil then 778 FCarets[Index].Visual.MoveToUnUsed; 779 FCarets[Index].Visual := AValue; 780 if AValue <> nil then 781 AValue.MoveToUsed; 782end; 783 784function TSynPluginMultiCaretList.InternalRemoveCaretEx(RawIndex: Integer; 785 AlternativeRawIndex: Integer): Integer; 786begin 787 assert((RawIndex>=FLowIndex) and (RawIndex <= FHighIndex), 'TSynPluginMultiCaretList.InternalRemoveCaretEx: (Index>=FLowIndex) and (Index <= FHighIndex)'); 788 if (RawIndex = FMainCaretIndex) and (AlternativeRawIndex >= FLowIndex) then 789 Result := InternalRemoveCaret(AlternativeRawIndex) 790 else 791 Result := InternalRemoveCaret(RawIndex); 792end; 793 794function TSynPluginMultiCaretList.InternalRemoveCaret(RawIndex: Integer): integer; 795begin 796 assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone'); 797 assert((RawIndex>=FLowIndex) and (RawIndex <= FHighIndex), 'TSynPluginMultiCaretList.InternalRemoveCaret: (RawIndex>=FLowIndex) and (RawIndex <= FHighIndex)'); 798 Result := 0; // change to LowCaret .. RawIndex 799 800 if FCarets[RawIndex].Visual <> nil then 801 FCarets[RawIndex].Visual.MoveToUnUsed; 802 if RawIndex = FMainCaretIndex then 803 FMainCaretIndex := -1; 804 805 if RawIndex > (FHighIndex + FLowIndex) div 2 then begin 806 if (RawIndex < FHighIndex) then 807 Move(FCarets[RawIndex+1], FCarets[RawIndex], (FHighIndex - RawIndex) * SizeOf(FCarets[0])); 808 dec(FHighIndex); 809 if RawIndex < FMainCaretIndex then 810 dec(FMainCaretIndex); 811 end 812 else begin 813 if (RawIndex > FLowIndex) then 814 Move(FCarets[FLowIndex], FCarets[FLowIndex+1], (RawIndex - FLowIndex) * SizeOf(FCarets[0])); 815 inc(FLowIndex); 816 if RawIndex > FMainCaretIndex then 817 inc(FMainCaretIndex); 818 Result := 1; // FLowIndex was increasde by 1; 819 end; 820 821 //debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.InternalRemoveCaret ', RawIndex, ' , ', count]); 822end; 823 824procedure TSynPluginMultiCaretList.AdjustAfterChange(RawIndex: Integer); 825begin 826 assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone'); 827 FLowCaret := @FCarets[FLowIndex]; 828 FHighCaret := @FCarets[FHighIndex]; 829 AdjustAfterChange(@FCarets[RawIndex]); 830end; 831 832constructor TSynPluginMultiCaretList.Create; 833begin 834 FLowIndex := 0; 835 FHighIndex := -1; 836 FMainCaretIndex := -1; 837end; 838 839function TSynPluginMultiCaretList.AddCaret(X, Y, Offs: Integer; flags: TCaretFlags; 840 PhysX: Integer): Integer; 841var 842 NewCarets: Array of TCaretData; 843 Len, AddLen, i, Middle: Integer; 844begin 845 assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone'); 846 Result := FindEqOrNextCaretRawIdx(x, y, Offs); 847 if Result < FLowIndex then 848 Result := FLowIndex; 849 if (Result <= FHighIndex) and (FCarets[Result].x = x) and (FCarets[Result].y = y) and 850 (FCarets[Result].offs = Offs) and not(cfAddDuplicate in flags) 851 then begin 852 if cfMainCaret in flags then begin 853 FMainCaretIndex := Result; 854 FCarets[Result].Flags := flags + [cfMainCaret]; 855 end; 856 // TODO maybe update PhysX; 857 Result := Result - FLowIndex; 858 exit; 859 end; 860 861 Len := length(FCarets) - 1; 862 Middle := (FLowIndex + FHighIndex) div 2; 863 if (FLowIndex > 0) and ((Result < Middle) or (FHighIndex = len)) 864 then begin 865 // use space in front of list 866 if (Result > FHighIndex) and (FHighIndex = High(FCarets)) // moving all entries 867 then i := max(FLowIndex div 2 - 1, 0) // Make some room at the end of the list 868 else i := 0; 869 if Result > FLowIndex then 870 Move(FCarets[FLowIndex], FCarets[FLowIndex-1-i], (Result-FLowIndex) * SizeOf(FCarets[0])); 871 FLowIndex := FLowIndex - 1 - i; 872 FHighIndex := FHighIndex - i; 873 Result := Result - 1 - i; 874 if Result > FMainCaretIndex 875 then FMainCaretIndex := FMainCaretIndex - 1 - i 876 else FMainCaretIndex := FMainCaretIndex - i; 877 end 878 else 879 if FHighIndex < Len then begin 880 // use space at end of list 881 if (Result = FLowIndex) and (FLowIndex = 0) // moving all entries 882 then i := max((High(FCarets)-FHighIndex) div 2 - 1, 0) // Make some room at the start of the list 883 else i := 0; 884 if Result <= FHighIndex then 885 Move(FCarets[Result], FCarets[Result+1+i], (FHighIndex-Result+1) * SizeOf(FCarets[0])); 886 FHighIndex := FHighIndex + 1 + i; 887 FLowIndex := FLowIndex + i; 888 Result := Result + i; 889 if Result <= FMainCaretIndex 890 then FMainCaretIndex := FMainCaretIndex + 1 + i 891 else FMainCaretIndex := FMainCaretIndex + i; 892 end 893 else begin 894 // realloc all 895 AddLen := Max(32, Len div 8); 896 SetLength(NewCarets, Len + 2 * AddLen); 897 i := Result-FLowIndex; 898 if i > 0 then 899 Move(FCarets[FLowIndex], NewCarets[AddLen], (i) * SizeOf(FCarets[0])); 900 if Result <= FHighIndex then 901 Move(FCarets[Result], NewCarets[AddLen+i+1], (FHighIndex-Result+1) * SizeOf(FCarets[0])); 902 903 if Result <= FMainCaretIndex 904 then FMainCaretIndex := FMainCaretIndex - FLowIndex + AddLen + 1 905 else FMainCaretIndex := FMainCaretIndex - FLowIndex + AddLen; 906 907 FLowIndex := AddLen; 908 FHighIndex := AddLen + Len + 1; 909 Result := i + AddLen; 910 FCarets := NewCarets; 911 end; 912 913 FCarets[Result].x := x; 914 FCarets[Result].offs := Offs; 915 FCarets[Result].y := y; 916 FCarets[Result].KeepX := PhysX; 917 FCarets[Result].Visual := nil; 918 FCarets[Result].Flags := flags - [cfAddDuplicate]; 919 920 if cfMainCaret in flags then 921 FMainCaretIndex := Result; 922 923 Result := Result - FLowIndex; 924end; 925 926procedure TSynPluginMultiCaretList.RemoveCaret(Index: Integer); 927begin 928 assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.RemoveCaret: FIteratoreMode=mciNone'); 929 InternalRemoveCaret(Index+FLowIndex); 930end; 931 932procedure TSynPluginMultiCaretList.Clear(AFreeVisual: Boolean; ACapacity: Integer); 933var 934 i: Integer; 935begin 936 assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.Clear: FIteratoreMode=mciNone'); 937 if AFreeVisual then 938 begin 939 for i := FLowIndex to FHighIndex do 940 if FCarets[i].Visual <> nil then begin 941 FCarets[i].Visual.UsedList.Remove(FCarets[i].Visual); 942 FCarets[i].Visual.Free; 943 end 944 end 945 else 946 for i := FLowIndex to FHighIndex do 947 if FCarets[i].Visual <> nil then 948 FCarets[i].Visual.MoveToUnUsed; 949 SetLength(FCarets, ACapacity); 950 FLowIndex := Cardinal(ACapacity) div 2; 951 FHighIndex := FLowIndex - 1; 952 FMainCaretIndex := -1; 953end; 954 955function TSynPluginMultiCaretList.Count: Integer; 956begin 957 Result := FHighIndex - FLowIndex + 1; 958end; 959 960function TSynPluginMultiCaretList.Capacity: Integer; 961begin 962 Result := Length(FCarets); 963end; 964 965procedure TSynPluginMultiCaretList.ImportFromSortedList(AMultiCaretList: TLogCaretPointArray); 966var 967 i: Integer; 968 c: PCaretData; 969begin 970 Clear(False, Length(AMultiCaretList) + 32); 971 FLowIndex := 16; 972 FHighIndex := FLowIndex + High(AMultiCaretList); 973 c := @FCarets[FLowIndex]; 974 for i := 0 to High(AMultiCaretList) do begin 975 c^.x := AMultiCaretList[i].X; 976 c^.offs := AMultiCaretList[i].Offs; 977 c^.y := AMultiCaretList[i].Y; 978 c^.KeepX := -1; 979 c^.Visual := nil; 980 c^.Flags := []; 981 inc(c); 982 end; 983end; 984 985function TSynPluginMultiCaretList.FindCaretIdx(X, Y, Offs: Integer): Integer; 986begin 987 Result := FindEqOrNextCaretRawIdx(x, y, offs); 988 if Result < FLowIndex then 989 exit(-1); 990 if (Result > FHighIndex) or (FCarets[Result].x <> x) or (FCarets[Result].offs <> Offs) or 991 (FCarets[Result].y <> y) 992 then 993 Result := -1 994 else 995 Result := Result - FLowIndex; 996end; 997 998function TSynPluginMultiCaretList.FindEqOrNextCaretIdx(X, Y, Offs: Integer; LowIdx: integer; 999 HighIdx: integer): Integer; 1000begin 1001 if LowIdx >= 0 then inc(LowIdx, FLowIndex); 1002 if HighIdx >= 0 then inc(HighIdx, FLowIndex); 1003 Result := FindEqOrNextCaretRawIdx(x, y, offs, LowIdx, HighIdx); 1004 if (Result > FHighIndex) 1005 then 1006 Result := -1 1007 else 1008 Result := Result - FLowIndex; 1009end; 1010 1011procedure TSynPluginMultiCaretList.AdjustAllAfterEdit(aLinePos, aBytePos, aCount, 1012 aLineBrkCnt: Integer); 1013var 1014 i, j, lowest: Integer; 1015begin 1016 if Count = 0 then exit; 1017 lowest := FindEqOrNextCaretRawIdx(aBytePos, aLinePos, 0); 1018 if lowest < FLowIndex then lowest := FLowIndex; 1019 1020 if aLineBrkCnt = 0 then begin 1021 if aCount < 0 then begin 1022 i := lowest; 1023 while i <= FHighIndex do begin 1024 if (FCarets[i].y = aLinePos) and (FCarets[i].x >= aBytePos) then 1025 FCarets[i].x := Max(aBytePos, FCarets[i].x + aCount) 1026 else 1027 break; 1028 inc(i); 1029 end; 1030 end 1031 else begin // aCount >= 0 1032 for i := lowest to FHighIndex do begin 1033 if (FCarets[i].y = aLinePos) and (FCarets[i].x >= aBytePos) then 1034 FCarets[i].x := FCarets[i].x + aCount 1035 else 1036 break; 1037 end; 1038 end; 1039 end 1040 else // aLineBrkCnt = 0 1041 begin // aCount is always 0 (aBytePos:=max(1,aBytePos+aCount)) // aBytePos is the end of line 1042 if aLineBrkCnt < 0 then begin 1043 j := aLinePos+(-aLineBrkCnt); 1044 i := lowest; 1045 while i <= FHighIndex do begin 1046 if (FCarets[i].y < j) then 1047 FCarets[i].x := aBytePos; 1048 if (FCarets[i].y = j) then 1049 FCarets[i].x := FCarets[i].x - 1 + aBytePos 1050 else 1051 break; 1052 FCarets[i].y := aLinePos; 1053 inc(i); 1054 end; 1055 while i <= FHighIndex do begin 1056 FCarets[i].y := FCarets[i].y + aLineBrkCnt; 1057 inc(i); 1058 end; 1059 end 1060 else begin // aLineBrkCnt >= 0 1061 i := lowest; 1062 while i <= FHighIndex do begin 1063 if (FCarets[i].y = aLinePos) then 1064 FCarets[i].x := FCarets[i].x + 1 - aBytePos 1065 else 1066 break; 1067 FCarets[i].y := FCarets[i].y + aLineBrkCnt; 1068 inc(i); 1069 end; 1070 while i <= FHighIndex do begin 1071 FCarets[i].y := FCarets[i].y + aLineBrkCnt; 1072 inc(i); 1073 end; 1074 end; 1075 end; 1076end; 1077 1078procedure TSynPluginMultiCaretList.FindAndRemoveMergedCarets; 1079var 1080 i, i2: Integer; 1081 c: TCaretData; 1082begin 1083 i := FLowIndex + 1; 1084 while i <= FHighIndex do begin 1085 if (FCarets[i].y = FCarets[i-1].y) and (FCarets[i].x = FCarets[i-1].x) then begin 1086 i := i + InternalRemoveCaretEx(i, i-1); 1087 continue; 1088 end; 1089 if (FCarets[i].y < FCarets[i-1].y) or 1090 ((FCarets[i].y = FCarets[i-1].y) and (FCarets[i].x < FCarets[i-1].x)) 1091 then begin 1092 // should not happen 1093 {$IfDef SynMultiCaretDebug} 1094 debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.FindAndRemoveMergedCarets BUBBLE SORTING']); 1095 {$EndIf} 1096 i2 := i; 1097 c := FCarets[i2]; 1098 repeat 1099 FCarets[i2] := FCarets[i2-1]; 1100 dec(i2); 1101 until (i2 = FLowIndex) or (FCarets[i2].y > FCarets[i2-1].y) or 1102 ((FCarets[i2].y = FCarets[i2-1].y) and (FCarets[i2].x > FCarets[i2-1].x)); 1103 FCarets[i2] := c; 1104 if FMainCaretIndex = i then 1105 FMainCaretIndex := i2; 1106 if (FMainCaretIndex < i) and (FMainCaretIndex >= i2) then 1107 inc(FMainCaretIndex); 1108 end; 1109 inc(i); 1110 end; 1111end; 1112 1113procedure TSynPluginMultiCaretList.IncMergeLock; 1114begin 1115 inc(FMergeLock); 1116end; 1117 1118procedure TSynPluginMultiCaretList.DecMergeLock; 1119begin 1120 dec(FMergeLock); 1121end; 1122 1123function TSynPluginMultiCaretList.GetCurrentCaretFull: TLogCaretPoint; 1124begin 1125 Result.X := FCurrenCaret^.x; 1126 Result.Y := FCurrenCaret^.y; 1127 Result.Offs := FCurrenCaret^.offs; 1128end; 1129 1130function TSynPluginMultiCaretList.GetCurrentCaretFlags: TCaretFlags; 1131begin 1132 Result := FCurrenCaret^.Flags; 1133end; 1134 1135function TSynPluginMultiCaretList.GetCurrentCaretKeepX: Integer; 1136begin 1137 Result := FCurrenCaret^.KeepX; 1138end; 1139 1140procedure TSynPluginMultiCaretList.SetCurrentCaretFull(AValue: TLogCaretPoint); 1141begin 1142 FCurrenCaret^.x := AValue.X; 1143 FCurrenCaret^.y := AValue.Y; 1144 FCurrenCaret^.offs := AValue.Offs; 1145 AdjustAfterChange(FCurrenCaret); 1146end; 1147 1148procedure TSynPluginMultiCaretList.SetCurrentCaretKeepX(AValue: Integer); 1149begin 1150 FCurrenCaret^.KeepX := AValue; 1151end; 1152 1153procedure TSynPluginMultiCaretList.AdjustAfterChange(ACaret: PCaretData); 1154 function ToRawIndex(C: PCaretData): Integer; 1155 begin 1156 Result := (C - PCaretData(@FCarets[0])); // div SizeOf(FCarets[0]); 1157 end; 1158var 1159 NewCaretPos, HelpCaretPos: PCaretData; 1160 NewCaretIdx, y, x, o: Integer; 1161 v: TCaretData; 1162begin 1163 assert((ACaret>=FLowCaret) and (ACaret <= FHighCaret) and (ACaret <> nil), 'TSynPluginMultiCaretList.AdjustAfterChange: (ACaret>=FLowCaret) and (ACaret <= FHighCaret)'); 1164 // if iterating then this must only be called with fcurrentcaret 1165 assert((FIteratoreMode=mciNone) or ((ACaret = FCurrenCaret)), 'TSynPluginMultiCaretList.AdjustAfterChange: (FIteratoreMode=mciNone) or (ACaret = FCurrenCaret)'); 1166 1167 y := ACaret^.y; 1168 1169 if (ACaret > FLowCaret) then begin 1170 NewCaretPos := ACaret - 1; 1171 // Compare with previous Caret in list 1172 if (y <= NewCaretPos^.y) then begin 1173 x := ACaret^.x; 1174 if (y < NewCaretPos^.y) or (x <= NewCaretPos^.x) then begin 1175 o := ACaret^.offs; 1176 if (x < NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o <= NewCaretPos^.offs) ) 1177 then begin 1178 // ACaret is <= previous Caret in list 1179 // TODO: If equal, only check for merge 1180 HelpCaretPos := NewCaretPos - 1; 1181 if (HelpCaretPos >= FLowCaret) and 1182 ( (y < HelpCaretPos^.y) or 1183 ( (y = HelpCaretPos^.y) and 1184 ( (x < HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o <= HelpCaretPos^.offs) ) ) 1185 ) ) 1186 then begin 1187 // ACaret is < pre-previous Caret in list 1188 NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, FLowIndex, ToRawIndex(HelpCaretPos)); 1189 Assert((NewCaretIdx >= FLowIndex) and (NewCaretIdx <= FHighIndex), 'caret idx in range'); 1190 NewCaretPos := @FCarets[NewCaretIdx]; 1191 end; 1192 1193 if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin 1194 if FMergeLock = 0 then begin 1195 InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos)); 1196 exit; 1197 end; 1198 end; 1199 v := ACaret^; 1200 {$IfDef SynMultiCaretDebug} 1201 debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]); 1202 {$EndIf} 1203 Move(NewCaretPos^, (NewCaretPos+1)^, Pointer(ACaret)-Pointer(NewCaretPos)); 1204 NewCaretPos^ := v; 1205 1206 assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil Caret changed twice in same iteration'); 1207 FCurrenCaret := NewCaretPos; // move down 1208 case FIteratoreMode of 1209 mciUp: FBeforeNextCaret := ACaret; // continue at ACaret+1; 1210 mciDown: begin 1211 FBeforeNextCaret := ACaret + 1; // continue at ACaret; 1212 Include(FCurrenCaret^.Flags, cfIterationDone); 1213 inc(FIterationDoneCount); 1214 end; 1215 end; 1216 1217 exit; 1218 end 1219 end; 1220 end; 1221 end; 1222 1223 if (ACaret < FHighCaret) then begin 1224 NewCaretPos := ACaret + 1; 1225 // Compare with next Caret in list 1226 if (y >= NewCaretPos^.y) then begin 1227 x := ACaret^.x; 1228 if (y > NewCaretPos^.y) or (x >= NewCaretPos^.x) then begin 1229 o := ACaret^.offs; 1230 if (x > NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o >= NewCaretPos^.offs) ) 1231 then begin 1232 // ACaret is >= next Caret in list 1233 HelpCaretPos := NewCaretPos + 1; 1234 if (HelpCaretPos <= FHighCaret) and 1235 ( (y > HelpCaretPos^.y) or 1236 ( (y = HelpCaretPos^.y) and 1237 ( (x > HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o >= HelpCaretPos^.offs) ) ) 1238 ) ) 1239 then begin 1240 // ACaret is > post-next Caret in list 1241 NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, ToRawIndex(HelpCaretPos), FHighIndex); 1242 Assert((NewCaretIdx >= FLowIndex + 1) and (NewCaretIdx <= FHighIndex + 1), 'caret idx in range'); 1243 {$PUSH}{$R-} 1244 NewCaretPos := @FCarets[NewCaretIdx]; 1245 {$POP} 1246 if (NewCaretIdx <= FHighIndex) then begin 1247 if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin 1248 if FMergeLock = 0 then begin 1249 InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos)); 1250 exit; 1251 end; 1252 end; 1253 end; 1254 dec(NewCaretPos); 1255 end 1256 1257 else 1258 if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin 1259 if FMergeLock = 0 then begin 1260 InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos)); 1261 exit; 1262 end; 1263 end; 1264 1265 v := ACaret^; 1266 {$IfDef SynMultiCaretDebug} 1267 debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]); 1268 {$EndIf} 1269 Move((ACaret+1)^, ACaret^, Pointer(NewCaretPos)-Pointer(ACaret)); 1270 NewCaretPos^ := v; 1271 1272 assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil Caret changed twice in same iteration'); 1273 FCurrenCaret := NewCaretPos; // move down 1274 case FIteratoreMode of 1275 mciDown: FBeforeNextCaret := ACaret; // continue at ACaret-1; 1276 mciUp: begin 1277 FBeforeNextCaret := ACaret - 1; // continue at ACaret; 1278 Include(FCurrenCaret^.Flags, cfIterationDone); 1279 inc(FIterationDoneCount); 1280 end; 1281 end; 1282 end; 1283 end; 1284 end; 1285 end; 1286 1287end; 1288 1289procedure TSynPluginMultiCaretList.StartIteratorAtFirst; 1290begin 1291 FBeforeNextCaret := nil; 1292 if Length(FCarets) = 0 then begin 1293 FLowCaret := nil; 1294 FHighCaret := nil; 1295 FCurrenCaret := nil; 1296 exit; 1297 end; 1298 FLowCaret := @FCarets[FLowIndex]; 1299 FHighCaret := @FCarets[FHighIndex]; 1300 FCurrenCaret := FLowCaret - 1; 1301 FIteratoreMode := mciUp; 1302end; 1303 1304function TSynPluginMultiCaretList.IterateNextUp: Boolean; 1305begin 1306 if FBeforeNextCaret <> nil then begin 1307 FCurrenCaret := FBeforeNextCaret; 1308 FBeforeNextCaret := nil; 1309 end; 1310 repeat 1311 Result := FCurrenCaret < FHighCaret; 1312 if not Result then begin 1313 FIteratoreMode := mciNone; 1314 assert(FIterationDoneCount = 0, 'TSynPluginMultiCaretList.IterateNextUp: FIterationDoneCount = 0'); 1315 exit; 1316 end; 1317 inc(FCurrenCaret); 1318 if not(cfIterationDone in FCurrenCaret^.Flags) then 1319 break; 1320 Exclude(FCurrenCaret^.Flags, cfIterationDone); 1321 dec(FIterationDoneCount); 1322 until False; 1323end; 1324 1325procedure TSynPluginMultiCaretList.StartIteratorAtLast; 1326begin 1327 FBeforeNextCaret := nil; 1328 if Length(FCarets) = 0 then begin 1329 FLowCaret := nil; 1330 FHighCaret := nil; 1331 FCurrenCaret := nil; 1332 exit; 1333 end; 1334 FLowCaret := @FCarets[FLowIndex]; 1335 FHighCaret := @FCarets[FHighIndex]; 1336 FCurrenCaret := FHighCaret + 1; 1337 FIteratoreMode := mciDown; 1338end; 1339 1340function TSynPluginMultiCaretList.IterateNextDown: Boolean; 1341begin 1342 if FBeforeNextCaret <> nil then begin 1343 FCurrenCaret := FBeforeNextCaret; 1344 FBeforeNextCaret := nil; 1345 end; 1346 repeat 1347 Result := FCurrenCaret > FLowCaret; 1348 if not Result then begin 1349 FIteratoreMode := mciNone; 1350 assert(FIterationDoneCount = 0, 'TSynPluginMultiCaretList.IterateNextDown: FIterationDoneCount = 0'); 1351 exit; 1352 end; 1353 dec(FCurrenCaret); 1354 if not(cfIterationDone in FCurrenCaret^.Flags) then 1355 break; 1356 Exclude(FCurrenCaret^.Flags, cfIterationDone); 1357 dec(FIterationDoneCount); 1358 until False; 1359end; 1360 1361function TSynPluginMultiCaretList.CanPeekCaret(AIndexOffset: Integer): Boolean; 1362begin 1363 if AIndexOffset < 0 then 1364 Result := FCurrenCaret + AIndexOffset >= FLowCaret 1365 else 1366 Result := FCurrenCaret + AIndexOffset <= FHighCaret; 1367end; 1368 1369function TSynPluginMultiCaretList.PeekCaretY(AIndexOffset: Integer): Integer; 1370begin 1371 Result := (FCurrenCaret+AIndexOffset)^.y; 1372end; 1373 1374function TSynPluginMultiCaretList.PeekCaretFull(AIndexOffset: Integer): TLogCaretPoint; 1375begin 1376 Result.X := (FCurrenCaret+AIndexOffset)^.x; 1377 Result.Y := (FCurrenCaret+AIndexOffset)^.y; 1378 Result.Offs := (FCurrenCaret+AIndexOffset)^.offs; 1379end; 1380 1381{ TSynPluginMultiCaretBase } 1382 1383procedure TSynPluginMultiCaretBase.DoBoundsChanged(Sender: TObject); 1384var 1385 i: Integer; 1386 ta: TLazSynTextArea; 1387begin 1388 if FPaintLock > 0 then begin 1389 include(FPaintLockFlags, plfBoundsChanged); 1390 exit; 1391 end; 1392 1393 ta := TextArea; 1394 for i := 0 to FUsedList.Count - 1 do 1395 FUsedList[i].ClipRect := ta.Bounds; 1396 UpdateCaretsPos; 1397end; 1398 1399procedure TSynPluginMultiCaretBase.MergeAndRemoveCarets(AForce: Boolean); 1400var 1401 i: Integer; 1402begin 1403 if (FPaintLock > 0) and (not AForce) then begin 1404 include(FPaintLockFlags, plfMergeCarets); 1405 exit; 1406 end; 1407 1408 Carets.FindAndRemoveMergedCarets; 1409 i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset); 1410 if i >= 0 then 1411 RemoveCaret(i); 1412end; 1413 1414function TSynPluginMultiCaretBase.IsCaretMergeRequested: Boolean; 1415begin 1416 Result := plfMergeCarets in FPaintLockFlags; 1417end; 1418 1419procedure TSynPluginMultiCaretBase.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, 1420 aCount, aLineBrkCnt: Integer; aText: String); 1421begin 1422 Carets.AdjustAllAfterEdit(aLinePos, aBytePos, aCount, aLineBrkCnt); 1423 MergeAndRemoveCarets; 1424end; 1425 1426procedure TSynPluginMultiCaretBase.SetColor(AValue: TColor); 1427var 1428 i: Integer; 1429begin 1430 if FColor = AValue then Exit; 1431 FColor := AValue; 1432 for i := 0 to FUsedList.Count - 1 do 1433 TSynEditScreenCaretPainterInternal(FUsedList[i].Painter).Color := FColor; 1434end; 1435 1436function TSynPluginMultiCaretBase.CreateVisual: TSynPluginMultiCaretVisual; 1437begin 1438 Result := TSynPluginMultiCaretVisual.Create(Editor, 1439 TSynEditScreenCaretPainterInternal, 1440 FUsedList, FUnUsedList); 1441 Result.PaintTimer:= ScreenCaret.PaintTimer; 1442end; 1443 1444function TSynPluginMultiCaretBase.GetVisual: TSynPluginMultiCaretVisual; 1445var 1446 ta: TLazSynTextArea; 1447 i: TSynCaretType; 1448begin 1449 if FUnUsedList.Count > 0 then 1450 Result := FUnUsedList[FUnUsedList.Count-1] 1451 else 1452 Result := CreateVisual; 1453 1454 ta := TextArea; 1455 Result.ClipRect := ta.Bounds; 1456 Result.CharHeight := ta.LineHeight - Max(0, ta.ExtraLineSpacing); 1457 Result.CharWidth := ta.CharWidth; 1458 if Editor.InsertMode then 1459 Result.DisplayType := Editor.InsertCaret 1460 else 1461 Result.DisplayType := Editor.OverwriteCaret; 1462 for i := low(TSynCaretType) to high(TSynCaretType) do 1463 Result.SetCaretTypeSize(i, FCustomPixelWidth[i], FCustomPixelHeight[i], FCustomOffsetX[i], FCustomOffsetY[i], FCustomFlags[i]); 1464 TSynEditScreenCaretPainterInternal(Result.Painter).Color := FColor; 1465end; 1466 1467procedure TSynPluginMultiCaretBase.UpdateMainCaret; 1468begin 1469 if not FRestoreSingleCaretPainter then begin 1470 // always set internal painter 1471 if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterInternal then 1472 ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal); 1473 exit; 1474 end; 1475 1476 if Carets = nil then exit; 1477 1478 if Carets.Count = 0 then begin 1479 if (FSingleCaretClass <> nil) and 1480 (ScreenCaret.Painter.ClassType = TSynEditScreenCaretPainterInternal) and 1481 (ScreenCaret.Painter.ClassType <> FSingleCaretClass) 1482 then 1483 ScreenCaret.ChangePainter(FSingleCaretClass); 1484 FSingleCaretClass := nil; 1485 end 1486 else begin 1487 // store current class 1488 if FSingleCaretClass = nil then 1489 FSingleCaretClass := TSynEditScreenCaretPainterClass(ScreenCaret.Painter.ClassType); 1490 if ScreenCaret.Painter.ClassType <> TSynEditScreenCaretPainterInternal then 1491 ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal); 1492 end; 1493end; 1494 1495procedure TSynPluginMultiCaretBase.DoTextSizeChanged(Sender: TObject); 1496var 1497 i: Integer; 1498 ta: TLazSynTextArea; 1499begin 1500 if FPaintLock > 0 then begin 1501 include(FPaintLockFlags, plfTextSizeChanged); 1502 exit; 1503 end; 1504 1505 ta := TextArea; 1506 for i := 0 to FUsedList.Count - 1 do begin 1507 FUsedList[i].CharHeight := ta.LineHeight - Max(0, ta.ExtraLineSpacing); 1508 FUsedList[i].CharWidth := ta.CharWidth; 1509 end; 1510 UpdateCaretsPos; 1511end; 1512 1513procedure TSynPluginMultiCaretBase.DoEditorPaintEvent(Sender: TObject; 1514 EventType: TSynPaintEvent; const prcClip: TRect); 1515var 1516 i: Integer; 1517begin 1518 if EventType = peAfterPaint then 1519 UpdateCaretsPos; 1520 1521 case EventType of 1522 peBeforePaint: 1523 begin 1524 FInPaint := True; 1525 FPaintClip := prcClip; 1526 for i := 0 to FUsedList.Count - 1 do 1527 FUsedList[i].BeginPaint(prcClip); 1528 for i := 0 to FUnUsedList.Count - 1 do 1529 FUnUsedList[i].BeginPaint(prcClip); 1530 end; 1531 peAfterPaint: 1532 begin 1533 FInPaint := False; 1534 for i := 0 to FUsedList.Count - 1 do 1535 FUsedList[i].FinishPaint(prcClip); 1536 for i := 0 to FUnUsedList.Count - 1 do 1537 FUnUsedList[i].FinishPaint(prcClip); 1538 end; 1539 end; 1540end; 1541 1542procedure TSynPluginMultiCaretBase.DoEditorScrollEvent(Sender: TObject; 1543 EventType: TSynScrollEvent; dx, dy: Integer; const prcScroll, prcClip: TRect); 1544var 1545 i: Integer; 1546begin 1547 case EventType of 1548 peBeforeScroll: 1549 for i := 0 to FUsedList.Count - 1 do 1550 FUsedList[i].BeginScroll(dx, dy, prcScroll, prcClip); 1551 peAfterScroll: 1552 for i := 0 to FUsedList.Count - 1 do 1553 FUsedList[i].FinishScroll(dx, dy, prcScroll, prcClip, True); 1554 peAfterScrollFailed: 1555 for i := 0 to FUsedList.Count - 1 do 1556 FUsedList[i].FinishScroll(dx, dy, prcScroll, prcClip, False); 1557 end; 1558 1559 if EventType = peAfterScroll then 1560 UpdateCaretsPos; 1561end; 1562 1563procedure TSynPluginMultiCaretBase.DoEditorStatusChanged(Sender: TObject; 1564 Changes: TSynStatusChanges); 1565var 1566 i: Integer; 1567 v: Boolean; 1568begin 1569 if scFocus in Changes then begin 1570 v := (Editor.Focused or (eoPersistentCaret in Editor.Options)) and not (eoNoCaret in Editor.Options); 1571 for i := 0 to FUsedList.Count - 1 do 1572 FUsedList[i].Visible := v; 1573 end; 1574 if scInsertMode in Changes then 1575 for i := 0 to FUsedList.Count - 1 do 1576 if Editor.InsertMode 1577 then FUsedList[i].DisplayType := Editor.InsertCaret 1578 else FUsedList[i].DisplayType := Editor.OverwriteCaret; 1579 if scOptions in Changes then begin 1580 for i := 0 to FUsedList.Count - 1 do begin 1581 if Editor.InsertMode 1582 then FUsedList[i].DisplayType := Editor.InsertCaret 1583 else FUsedList[i].DisplayType := Editor.OverwriteCaret; 1584 UpdateCaretsPos; 1585 end; 1586 end; 1587end; 1588 1589procedure TSynPluginMultiCaretBase.DoAfterDecPaintLock(Sender: TObject); 1590begin 1591 if FPaintLock > 0 then 1592 Dec(FPaintLock); 1593 if FPaintLock > 0 then 1594 exit; 1595 1596 Include(FPaintLockFlags, plfDeferUpdateCaretsPos); 1597 if plfBoundsChanged in FPaintLockFlags then 1598 DoBoundsChanged(nil); 1599 if plfTextSizeChanged in FPaintLockFlags then 1600 DoTextSizeChanged(nil); 1601 if plfMergeCarets in FPaintLockFlags then 1602 MergeAndRemoveCarets; 1603 Exclude(FPaintLockFlags, plfDeferUpdateCaretsPos); 1604 if plfUpdateCaretsPos in FPaintLockFlags then 1605 UpdateCaretsPos; 1606 FPaintLockFlags := []; 1607 1608 ScreenCaret.UnLock; // unlock timer 1609end; 1610 1611procedure TSynPluginMultiCaretBase.DoBeforeIncPaintLock(Sender: TObject); 1612begin 1613 inc(FPaintLock); 1614 1615 if FPaintLock = 1 then 1616 ScreenCaret.Lock; // lock timer 1617end; 1618 1619function TSynPluginMultiCaretBase.GetTextArea: TLazSynTextArea; 1620begin 1621 Result := TLazSynSurfaceManager(PaintArea).TextArea; 1622end; 1623 1624function TSynPluginMultiCaretBase.AddCaret(X, Y, Offs: Integer; flags: TCaretFlags; 1625 PhysX: Integer): Integer; 1626var 1627 y1, y2: Integer; 1628begin 1629 Result := Carets.AddCaret(x,y, Offs, flags, PhysX); 1630 UpdateMainCaret; 1631 1632 if cfNoneVisual in flags then 1633 exit; 1634 1635 if FPaintLock > 0 then begin 1636 UpdateCaretsPos; 1637 exit; 1638 end; 1639 1640 if (eoNoCaret in Editor.Options) then begin 1641 Carets.Visual[Result] := nil; 1642 exit; 1643 end; 1644 1645 y1 := Editor.RowToScreenRow(y); 1646 if (y1 < 0) or (y1 > Editor.LinesInWindow + 1) then 1647 y := -1; // not visible 1648 if y > 1 then 1649 y2 := Editor.RowToScreenRow(y-1) 1650 else 1651 y2 := -1; 1652 1653 if (y > 0) and (y1 <> y2) or (y=1) then begin 1654 if Carets.Visual[Result] = nil then 1655 Carets.Visual[Result] := GetVisual; 1656 x := ViewedTextBuffer.LogPhysConvertor.LogicalToPhysical(ToIdx(y), x, Offs); // TODO: check if offs was adjusted? But should not happen for NEW caret 1657 Carets.Visual[Result].DisplayPos := TextArea.RowColumnToPixels(Point(x, y1)); 1658 Carets.Visual[Result].Visible := (eoPersistentCaret in Editor.Options) or Editor.Focused; 1659 end 1660 else 1661 Carets.Visual[Result] := nil; 1662end; 1663 1664procedure TSynPluginMultiCaretBase.RemoveCaret(Index: Integer); 1665begin 1666 Carets.RemoveCaret(Index); 1667 UpdateMainCaret; 1668end; 1669 1670procedure TSynPluginMultiCaretBase.UpdateCaretsPos; 1671var 1672 i, x, y, o, w: Integer; 1673 y1, y2: Integer; 1674 vis: Boolean; 1675begin 1676 if plfDeferUpdateCaretsPos in FPaintLockFlags then exit; 1677 if FPaintLock > 0 then begin 1678 include(FPaintLockFlags, plfUpdateCaretsPos); 1679 exit; 1680 end; 1681 if (eoNoCaret in Editor.Options) then begin 1682 for i := 0 to CaretsCount - 1 do 1683 Carets.Visual[i] := nil; 1684 exit; 1685 end; 1686 1687 vis := (eoPersistentCaret in Editor.Options) or Editor.Focused; 1688 1689 w := Editor.LinesInWindow + 1; 1690 for i := 0 to CaretsCount - 1 do begin 1691 if cfNoneVisual in Carets.Flags[i] then continue; 1692 1693 x := Carets.CaretX[i]; 1694 y := Carets.CaretY[i]; 1695 o := Carets.CaretOffs[i]; 1696 y1 := Editor.RowToScreenRow(y); 1697 if (y1 < 0) or (y1 > w) then begin 1698 Carets.Visual[i] := nil; 1699 continue; 1700 end; 1701 1702 if y > 1 then 1703 y2 := Editor.RowToScreenRow(y-1); 1704 1705 if (y1 <> y2) or (y=1) then begin 1706 if Carets.Visual[i] = nil then 1707 Carets.Visual[i] := GetVisual; 1708 x := ViewedTextBuffer.LogPhysConvertor.LogicalToPhysical(ToIdx(y), x, o); 1709 Carets.Visual[i].Lock; 1710 Carets.Visual[i].DisplayPos := TextArea.RowColumnToPixels(Point(x, y1)); 1711 Carets.Visual[i].Visible := vis; 1712 Carets.Visual[i].UnLock; 1713//todo: remove if duplicate 1714 // check if offs was adjusted 1715 //if o <> Carets.CaretOffs[i] then 1716 // Carets.CaretOffs[i] := o; 1717 end 1718 else 1719 Carets.Visual[i] := nil; 1720 end; 1721end; 1722 1723procedure TSynPluginMultiCaretBase.ClearCarets; 1724begin 1725 Carets.Clear(True); 1726 UpdateMainCaret; 1727 FUsedList.Clear; 1728 FUnUsedList.Clear; 1729 DoCleared; 1730end; 1731 1732function TSynPluginMultiCaretBase.CaretsCount: Integer; 1733begin 1734 Result := Carets.Count; 1735end; 1736 1737procedure TSynPluginMultiCaretBase.DoCleared; 1738begin 1739 // 1740end; 1741 1742procedure TSynPluginMultiCaretBase.DoBufferChanged(Sender: TObject); 1743begin 1744 TSynEditStrings(Sender).RemoveNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock); 1745 TSynEditStrings(Sender).RemoveNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock); 1746 TSynEditStrings(Sender).RemoveEditHandler(@DoLinesEdited); 1747 ViewedTextBuffer.AddEditHandler(@DoLinesEdited); 1748 ViewedTextBuffer.AddNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock); 1749 ViewedTextBuffer.AddNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock); 1750end; 1751 1752procedure TSynPluginMultiCaretBase.DoEditorRemoving(AValue: TCustomSynEdit); 1753begin 1754 inherited DoEditorRemoving(AValue); 1755 if Editor <> nil then begin 1756 ClearCarets; 1757 TextArea.RemoveBoundsChangeHandler(@DoBoundsChanged); 1758 TextArea.RemoveTextSizeChangeHandler(@DoTextSizeChanged); 1759 Editor.UnRegisterStatusChangedHandler(@DoEditorStatusChanged); 1760 Editor.UnRegisterScrollEventHandler(@DoEditorScrollEvent); 1761 Editor.UnRegisterPaintEventHandler(@DoEditorPaintEvent); 1762 ViewedTextBuffer.RemoveNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock); 1763 ViewedTextBuffer.RemoveNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock); 1764 ViewedTextBuffer.RemoveEditHandler(@DoLinesEdited); 1765 ViewedTextBuffer.RemoveNotifyHandler(senrTextBufferChanged, @DoBufferChanged); 1766 end; 1767end; 1768 1769procedure TSynPluginMultiCaretBase.DoEditorAdded(AValue: TCustomSynEdit); 1770begin 1771 if Editor <> nil then begin 1772 ViewedTextBuffer.AddNotifyHandler(senrTextBufferChanged, @DoBufferChanged); 1773 ViewedTextBuffer.AddEditHandler(@DoLinesEdited); 1774 ViewedTextBuffer.AddNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock); 1775 ViewedTextBuffer.AddNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock); 1776 Editor.RegisterPaintEventHandler(@DoEditorPaintEvent, [peBeforePaint, peAfterPaint]); 1777 Editor.RegisterScrollEventHandler(@DoEditorScrollEvent, [peBeforeScroll, peAfterScroll, peAfterScrollFailed]); 1778 Editor.RegisterStatusChangedHandler(@DoEditorStatusChanged, [scInsertMode, scFocus, scOptions]); 1779 TextArea.AddTextSizeChangeHandler(@DoTextSizeChanged); 1780 TextArea.AddBoundsChangeHandler(@DoBoundsChanged); 1781 1782 FSingleCaretClass := TSynEditScreenCaretPainterClass(ScreenCaret.Painter.ClassType); 1783 UpdateMainCaret; 1784 end; 1785 inherited DoEditorAdded(AValue); 1786end; 1787 1788constructor TSynPluginMultiCaretBase.Create(AOwner: TComponent); 1789begin 1790 FRestoreSingleCaretPainter := True; 1791 inherited Create(AOwner); 1792 FColor := clBlack; 1793 FCarets := TSynPluginMultiCaretList.Create; 1794 FUsedList := TSynPluginMultiCaretVisualList.Create; 1795 FUnUsedList := TSynPluginMultiCaretVisualList.Create; 1796end; 1797 1798destructor TSynPluginMultiCaretBase.Destroy; 1799begin 1800 inherited Destroy; 1801 FreeAndNil(FCarets); 1802 FreeAndNil(FUsedList); 1803 FreeAndNil(FUnUsedList); 1804end; 1805 1806procedure TSynPluginMultiCaretBase.SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, 1807 AXOffs, AYOffs: Integer; AFlags: TSynCustomCaretSizeFlags); 1808var 1809 i: Integer; 1810begin 1811 FCustomPixelWidth[AType] := AWidth; 1812 FCustomPixelHeight[AType] := AHeight; 1813 FCustomOffsetX[AType] := AXOffs; 1814 FCustomOffsetY[AType] := AYOffs; 1815 FCustomFlags[AType] := AFlags; 1816 1817 for i := 0 to FUsedList.Count - 1 do 1818 FUsedList[i].SetCaretTypeSize(AType, AWidth, AHeight, AXOffs, AYOffs, AFlags) 1819end; 1820 1821{ TSynPluginMultiCaretMouseActions } 1822 1823procedure TSynPluginMultiCaretMouseActions.ResetDefaults; 1824begin 1825 Clear; 1826 AddCommand(emcPluginMultiCaretToggleCaret, False, mbXLeft, ccAny, cdDown, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]); 1827end; 1828 1829{ TSynPluginMultiCaretKeyStrokes } 1830 1831procedure TSynPluginMultiCaretKeyStrokes.ResetDefaults; 1832 procedure AddKey(const ACmd: TSynEditorCommand; const AKey: word; 1833 const AShift: TShiftState; const AShiftMask: TShiftState = []); 1834 begin 1835 with Add do 1836 begin 1837 Key := AKey; 1838 Shift := AShift; 1839 ShiftMask := AShiftMask; 1840 Command := ACmd; 1841 end; 1842 end; 1843begin 1844 inherited ResetDefaults; 1845 AddKey(ecPluginMultiCaretToggleCaret, VK_SPACE, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]); 1846 AddKey(ecPluginMultiCaretClearAll, VK_ESCAPE, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]); 1847end; 1848 1849{ TSynEditUndoMultiCaret } 1850 1851function TSynEditUndoMultiCaret.IsEqualContent(AnItem: TSynEditUndoItem): Boolean; 1852begin 1853 Result := (FCaretUndoItem = nil) or 1854 FCaretUndoItem.IsEqual(TSynEditUndoMultiCaret(AnItem).FCaretUndoItem); 1855 Result := Result and 1856 (FActiveMode = TSynEditUndoMultiCaret(AnItem).FActiveMode) and 1857 (Length(FMultiCaretList) = Length(TSynEditUndoMultiCaret(AnItem).FMultiCaretList)); 1858 if Result then 1859 Result := 0 = CompareByte(FMultiCaretList[0], TSynEditUndoMultiCaret(AnItem).FMultiCaretList[0], 1860 Length(FMultiCaretList)*SizeOf(FMultiCaretList[0])); 1861end; 1862 1863function TSynEditUndoMultiCaret.DebugString: String; 1864begin 1865 Result := 'TSynEditUndoMultiCaret '+IntToStr(Length(FMultiCaretList)); 1866 //if FCaretUndoItem <> nil then 1867 // Result := Result + ' / ' + FCaretUndoItem.DebugString; 1868end; 1869 1870constructor TSynEditUndoMultiCaret.Create(ACaretUndoItem: TSynEditUndoItem; 1871 ABeginBlock: Boolean); 1872begin 1873 FBeginBlock := ABeginBlock; 1874 FCaretUndoItem := ACaretUndoItem; 1875end; 1876 1877destructor TSynEditUndoMultiCaret.Destroy; 1878begin 1879 FCaretUndoItem.Free; 1880 inherited Destroy; 1881end; 1882 1883constructor TSynEditUndoMultiCaret.AddCaretsFrom(AList: TSynPluginMultiCaretList); 1884var 1885 i, j: Integer; 1886begin 1887 SetLength(FMultiCaretList, AList.Count); 1888 j := 0; 1889 for i := 0 to AList.Count-1 do 1890 if not (cfNoneVisual in AList.Flags[i]) then begin 1891 FMultiCaretList[j] := AList.CaretFull[i]; 1892 inc(j); 1893 end; 1894 SetLength(FMultiCaretList, j); 1895end; 1896 1897function TSynEditUndoMultiCaret.IsCaretInfo: Boolean; 1898begin 1899 Result := True; 1900end; 1901 1902function TSynEditUndoMultiCaret.PerformUndo(Caller: TObject): Boolean; 1903var 1904 C: TSynCustomPluginMultiCaret; 1905 AnRedoItem: TSynEditUndoMultiCaret; 1906 UList: TSynEditUndoList; 1907begin 1908 Result := Caller is TSynCustomPluginMultiCaret; 1909 if not Result then exit; 1910 C := TSynCustomPluginMultiCaret(Caller); 1911 Result := (FCaretUndoItem <> nil) and FCaretUndoItem.PerformUndo(C.Editor); 1912 if Result then begin 1913 if FBeginBlock then begin 1914 C.Carets.ImportFromSortedList(FMultiCaretList); 1915 C.ActiveMode := ActiveMode; 1916 C.UpdateCaretsPos; 1917 C.AddStateFlags([sfSkipSelChanged, sfSkipCaretChanged], True); 1918 end; 1919 // redo 1920 UList := C.ViewedTextBuffer.CurUndoList; 1921 if UList.CurrentGroup = nil then exit; // should never happen / just added the caret. 1922 AnRedoItem := TSynEditUndoMultiCaret.Create(UList.CurrentGroup.Pop, not FBeginBlock); 1923 AnRedoItem.FMultiCaretList := FMultiCaretList; 1924 AnRedoItem.ActiveMode := ActiveMode; 1925 UList.AddChange(AnRedoItem); 1926 end; 1927end; 1928 1929{ TSynCustomPluginMultiCaret } 1930 1931procedure TSynCustomPluginMultiCaret.TranslateKey(Sender: TObject; Code: word; 1932 SState: TShiftState; var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean; 1933 var Command: TSynEditorCommand; FinishComboOnly: Boolean; 1934 var ComboKeyStrokes: TSynEditKeyStrokes); 1935begin 1936 if Handled then 1937 exit; 1938 if not FinishComboOnly then 1939 FKeyStrokes.ResetKeyCombo; 1940 Command := FKeyStrokes.FindKeycodeEx(Code, SState, Data, IsStartOfCombo, FinishComboOnly, ComboKeyStrokes); 1941 if (Command = ecPluginMultiCaretClearAll) and (FCarets.Count = 0) then 1942 Command := ecNone; 1943 1944 Handled := (Command <> ecNone) or IsStartOfCombo; 1945 if IsStartOfCombo then 1946 ComboKeyStrokes := FKeyStrokes; 1947end; 1948 1949procedure TSynCustomPluginMultiCaret.RemoveCaretsInSelection; 1950var 1951 i, x, y: Integer; 1952 bb, be: TPoint; 1953 sm: TSynSelectionMode; 1954begin 1955 bb := SelectionObj.FirstLineBytePos; 1956 be := SelectionObj.LastLineBytePos; 1957 sm := SelectionObj.ActiveSelectionMode; 1958 if sm = smLine then begin 1959 bb.x := 0; 1960 be.x := MaxInt; 1961 end; 1962 if (sm = smColumn) and (bb.x > be.x) then begin 1963 if bb.x = be.x then 1964 exit; 1965 i := bb.x; 1966 bb.x := be.x; 1967 be.x := i; 1968 end; 1969 1970 i := CaretsCount; 1971 while i > 0 do begin 1972 dec(i); 1973 x := Carets.Caret[i].x; 1974 y := Carets.Caret[i].y; 1975 if (y < bb.y) or 1976 (y > be.y) or 1977 ( ((y = bb.y) or (sm = smColumn)) and (x <= bb.x) ) or 1978 ( ((y = be.y) or (sm = smColumn)) and (x >= be.x) ) 1979 then 1980 Continue; 1981 RemoveCaret(i); 1982 end; 1983end; 1984 1985function TSynCustomPluginMultiCaret.GetIsInMainExecution: Boolean; 1986begin 1987 Result := sfProcessingMain in FStateFlags; 1988end; 1989 1990function TSynCustomPluginMultiCaret.GetIsInRepeatExecution: Boolean; 1991begin 1992 Result := sfProcessingRepeat in FStateFlags; 1993end; 1994 1995procedure TSynCustomPluginMultiCaret.SetActiveMode(AValue: TSynPluginMultiCaretMode); 1996begin 1997 if FActiveMode = AValue then Exit; 1998 FActiveMode := AValue; 1999 if FActiveMode = mcmNoCarets then begin 2000 ClearCarets; 2001 UnLockSpaceTrimmer; 2002 end 2003 else 2004 LockSpaceTrimmer; 2005end; 2006 2007procedure TSynCustomPluginMultiCaret.SetDefaultColumnSelectMode(AValue: TSynPluginMultiCaretDefaultMode); 2008begin 2009 if FDefaultColumnSelectMode = AValue then Exit; 2010 FDefaultColumnSelectMode := AValue; 2011end; 2012 2013procedure TSynCustomPluginMultiCaret.SetDefaultMode(AValue: TSynPluginMultiCaretDefaultMode); 2014begin 2015 if FDefaultMode = AValue then Exit; 2016 FDefaultMode := AValue; 2017end; 2018 2019procedure TSynCustomPluginMultiCaret.SetSkipCaretAtSel; 2020begin 2021 Include(FStateFlags, sfSkipCaretsAtSelection); 2022 FSelY1 := SelectionObj.FirstLineBytePos.y; 2023 FSelY2 := SelectionObj.LastLineBytePos.y; 2024 FSelX := SelectionObj.FirstLineBytePos.x; 2025end; 2026 2027procedure TSynCustomPluginMultiCaret.UpdateCaretForUndo(var AnUndoItem: TSynEditUndoItem; 2028 AnIsBeginUndo: Boolean); 2029begin 2030 if (FStateFlags * [sfProcessingCmd, sfSkipUndoCarets] = [sfProcessingCmd]) and // active edit 2031 (CaretsCount > 0) 2032 then begin 2033 AnUndoItem := TSynEditUndoMultiCaret.Create(AnUndoItem, AnIsBeginUndo); 2034 TSynEditUndoMultiCaret(AnUndoItem).AddCaretsFrom(Carets); 2035 TSynEditUndoMultiCaret(AnUndoItem).ActiveMode := ActiveMode; 2036 end; 2037end; 2038 2039function TSynCustomPluginMultiCaret.HandleUndoRedoItem(Caller: TObject; 2040 Item: TSynEditUndoItem): Boolean; 2041begin 2042 Result := Caller = Editor; 2043 if not Result then exit; 2044 Result := Item.PerformUndo(Self); 2045end; 2046 2047procedure TSynCustomPluginMultiCaret.LockSpaceTrimmer; 2048var 2049 b: TSynEditStrings; 2050begin 2051 if FSpaceTrimmerLocked then exit; 2052 FSpaceTrimmerLocked := True; 2053 b := ViewedTextBuffer; 2054 while b <> nil do begin 2055 if b is TSynEditStringTrimmingList then TSynEditStringTrimmingList(b).Lock; 2056 if b is TSynEditStringsLinked then 2057 b := TSynEditStringsLinked(b).NextLines 2058 else 2059 b := nil; 2060 end; 2061end; 2062 2063procedure TSynCustomPluginMultiCaret.UnLockSpaceTrimmer; 2064var 2065 b: TSynEditStrings; 2066begin 2067 if not FSpaceTrimmerLocked then exit; 2068 FSpaceTrimmerLocked := False; 2069 b := ViewedTextBuffer; 2070 while b <> nil do begin 2071 if b is TSynEditStringTrimmingList then TSynEditStringTrimmingList(b).UnLock; 2072 if b is TSynEditStringsLinked then 2073 b := TSynEditStringsLinked(b).NextLines 2074 else 2075 b := nil; 2076 end; 2077end; 2078 2079function TSynCustomPluginMultiCaret.LogPhysConvertor: TSynLogicalPhysicalConvertor; 2080begin 2081 Result := ViewedTextBuffer.LogPhysConvertor; 2082end; 2083 2084function TSynCustomPluginMultiCaret.PhysicalToLogical(AIndex, AColumn: Integer; out 2085 AColOffset: Integer; ACharSide: TSynPhysCharSide; AFlags: TSynLogPhysFlags): Integer; 2086var 2087 s: String; 2088begin 2089 Result := LogPhysConvertor.PhysicalToLogical(AIndex, AColumn, AColOffset, ACharSide, AFlags); 2090 if (AColOffset > 0) then begin 2091 if (eoCaretSkipTab in Editor.Options2) then 2092 AColOffset := 0 2093 else 2094 begin 2095 s := ViewedTextBuffer[AIndex]; 2096 if (Result > Length(s)) or (s[Result] <> #9) then 2097 AColOffset := 0; 2098 end; 2099 end; 2100end; 2101 2102procedure TSynCustomPluginMultiCaret.DoEditorRemoving(AValue: TCustomSynEdit); 2103begin 2104 if Editor <> nil then begin 2105 ViewedTextBuffer.RemoveNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock); 2106 ViewedTextBuffer.RemoveNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock); 2107 ViewedTextBuffer.UndoList.UnregisterUpdateCaretUndo(@UpdateCaretForUndo); 2108 CaretObj.RemoveChangeHandler(@DoCaretChanged); 2109 SelectionObj.RemoveChangeHandler(@DoSelectionChanged); 2110 Editor.UnregisterCommandHandler(@ProcessAllSynCommand); 2111 Editor.UnregisterCommandHandler(@ProcessMySynCommand); 2112 Editor.UnRegisterKeyTranslationHandler(@TranslateKey); 2113 Editor.UnregisterMouseActionSearchHandler(@MaybeHandleMouseAction); 2114 Editor.UnregisterMouseActionExecHandler(@DoHandleMouseAction); 2115 Editor.UnRegisterUndoRedoItemHandler(@HandleUndoRedoItem); 2116 end; 2117 inherited DoEditorRemoving(AValue); 2118end; 2119 2120procedure TSynCustomPluginMultiCaret.DoEditorAdded(AValue: TCustomSynEdit); 2121begin 2122 inherited DoEditorAdded(AValue); 2123 if Editor <> nil then begin 2124 Editor.RegisterUndoRedoItemHandler(@HandleUndoRedoItem); 2125 Editor.RegisterMouseActionSearchHandler(@MaybeHandleMouseAction); 2126 Editor.RegisterMouseActionExecHandler(@DoHandleMouseAction); 2127 Editor.RegisterCommandHandler(@ProcessAllSynCommand, nil, [hcfInit, hcfFinish]); 2128 Editor.RegisterCommandHandler(@ProcessMySynCommand, nil, [hcfPreExec]); 2129 Editor.RegisterKeyTranslationHandler(@TranslateKey); 2130 SelectionObj.AddChangeHandler(@DoSelectionChanged); 2131 CaretObj.AddChangeHandler(@DoCaretChanged); 2132 ViewedTextBuffer.UndoList.RegisterUpdateCaretUndo(@UpdateCaretForUndo); 2133 ViewedTextBuffer.AddNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock); 2134 ViewedTextBuffer.AddNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock); 2135 end; 2136end; 2137 2138procedure TSynCustomPluginMultiCaret.DoBufferChanged(Sender: TObject); 2139begin 2140 inherited DoBufferChanged(Sender); 2141 TSynEditStrings(Sender).RemoveNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock); 2142 TSynEditStrings(Sender).RemoveNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock); 2143 TSynEditStrings(Sender).UndoList.UnregisterUpdateCaretUndo(@UpdateCaretForUndo); 2144 ViewedTextBuffer.UndoList.RegisterUpdateCaretUndo(@UpdateCaretForUndo); 2145 ViewedTextBuffer.AddNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock); 2146 ViewedTextBuffer.AddNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock); 2147end; 2148 2149procedure TSynCustomPluginMultiCaret.DoAfterDecPaintLock(Sender: TObject); 2150begin 2151 if FPaintLock > 1 then begin 2152 inherited DoAfterDecPaintLock(Sender); 2153 exit; 2154 end; 2155 2156 UpdateCaretsPos; 2157 inherited DoAfterDecPaintLock(Sender); 2158 FStateFlags := FStateFlags - [sfExtendingColumnSel, sfSkipSelChanged, sfSkipCaretChanged]; 2159end; 2160 2161procedure TSynCustomPluginMultiCaret.DoIncForeignPaintLock(Sender: TObject); 2162begin 2163 if Sender = Editor then exit; 2164 inc(FForeignPaintLock); 2165end; 2166 2167procedure TSynCustomPluginMultiCaret.DoDecForeignPaintLock(Sender: TObject); 2168begin 2169 if Sender = Editor then exit; 2170 dec(FForeignPaintLock); 2171end; 2172 2173procedure TSynCustomPluginMultiCaret.DoCleared; 2174begin 2175 inherited DoCleared; 2176 ActiveMode := mcmNoCarets; 2177 Exclude(FStateFlags, sfCreateCaretAtCurrentPos); 2178 FColSelDoneY1 := -1; 2179 FColSelDoneY2 := -2; 2180 FColSelDonePhysX := -1; 2181end; 2182 2183procedure TSynCustomPluginMultiCaret.DoLinesEdited(Sender: TSynEditStrings; aLinePos, 2184 aBytePos, aCount, aLineBrkCnt: Integer; aText: String); 2185begin 2186 if (FStateFlags * [sfProcessingCmd] = []) and 2187 (FForeignPaintLock = 0) 2188 then 2189 ClearCarets; 2190 2191 2192 inherited DoLinesEdited(Sender, aLinePos, aBytePos, aCount, aLineBrkCnt, aText); 2193 FStateFlags := FStateFlags - [sfCreateCaretAtCurrentPos, sfSkipCaretsAtSelection, sfNoChangeIndicator]; 2194end; 2195 2196procedure TSynCustomPluginMultiCaret.DoCaretChanged(Sender: TObject); 2197var 2198 p: TLogCaretPoint; 2199begin 2200 Exclude(FStateFlags, sfNoChangeIndicator); 2201 if (sfCreateCaretAtCurrentPos in FStateFlags) then begin 2202 p := CaretObj.OldFullLogicalPos; 2203 AddCaret(p.x, p.y, p.Offs); 2204 exclude(FStateFlags, sfCreateCaretAtCurrentPos); 2205 exit; 2206 end; 2207 if (FStateFlags * [sfProcessingCmd, sfExtendingColumnSel, sfSkipCaretChanged] <> []) or 2208 (ActiveMode = mcmAddingCarets) or 2209 (FForeignPaintLock > 0) 2210 then 2211 exit; 2212 2213 ClearCarets; 2214end; 2215 2216procedure TSynCustomPluginMultiCaret.DoSelectionChanged(Sender: TObject); 2217 procedure AddCarets(StartY, EndY, PhysX: Integer); 2218 var 2219 i, XLog, Offs: Integer; 2220 CurCar: TLogCaretPoint; 2221 begin 2222 i:= -1; 2223 CurCar.Y := -1; 2224 while StartY <= EndY do begin 2225 XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs); 2226 if StartY >= CurCar.Y then begin 2227 i := Carets.FindEqOrNextCaretIdx(XLog, StartY, Offs, i+1); 2228 if i >= 0 then 2229 CurCar := Carets.CaretFull[i]; 2230 end; 2231 if (CurCar.x <> XLog) or (CurCar.Offs <> Offs) or (CurCar.y <> StartY) then 2232 AddCaret(XLog, StartY, Offs, [], PhysX); // TODO: pass "i-1" as KnowIndexOfCaretBefore (limit bin search) 2233 inc(StartY); 2234 end; 2235 end; 2236 procedure RemoveCarets(StartY, EndY, PhysX: Integer); 2237 var 2238 i, XLog, Offs: Integer; 2239 begin 2240 XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs); 2241 i := Carets.FindEqOrNextCaretIdx(XLog, StartY, Offs); 2242 if i >= 0 then begin 2243 while Carets.CaretY[i] <= EndY do begin 2244 if (Carets.CaretX[i] = XLog) and (Carets.CaretOffs[i] = Offs) then 2245 RemoveCaret(i) 2246 else 2247 inc(i); 2248 if i >= CaretsCount then 2249 break; 2250 if StartY <> Carets.CaretY[i] then begin 2251 StartY := Carets.CaretY[i]; 2252 XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs); 2253 end; 2254 end; 2255 end; 2256 end; 2257var 2258 i: Integer; 2259 XPhys, XLog, Offs: Integer; 2260 SelFirstY, SelLastY, CurY: Integer; 2261 CurCaret: TLogCaretPoint; 2262begin 2263 Exclude(FStateFlags, sfNoChangeIndicator); 2264 if (FStateFlags * [sfProcessingCmd, sfSkipSelChanged] <> []) or 2265 (FForeignPaintLock > 0) 2266 then exit; 2267 SelFirstY := Editor.BlockBegin.y; 2268 SelLastY := Editor.BlockEnd.y; 2269 If not ((SelFirstY <> SelLastY) and (Editor.SelectionMode = smColumn) and EnableWithColumnSelection) then begin 2270 ClearCarets; 2271 exit; 2272 end; 2273 2274 2275 Include(FStateFlags, sfExtendingColumnSel); 2276 if SelFirstY = CaretObj.LinePos then inc(SelFirstY); 2277 if SelLastY = CaretObj.LinePos then dec(SelLastY); 2278 2279 if (FColSelDoneY2 >= FColSelDoneY1) then begin 2280 // Delete carets at top, that are no longer in selection 2281 if SelFirstY > FColSelDoneY1 then begin 2282 RemoveCarets(FColSelDoneY1, SelFirstY - 1, FColSelDonePhysX); 2283 FColSelDoneY1 := SelFirstY; 2284 end; 2285 // Delete carets at bottom, that are no longer in selection 2286 if SelLastY < FColSelDoneY2 then begin 2287 RemoveCarets(SelLastY + 1, FColSelDoneY2, FColSelDonePhysX); 2288 FColSelDoneY2 := SelLastY; 2289 end; 2290 end; 2291 2292 XPhys := Editor.CaretX; 2293 if (FColSelDoneY2 >= FColSelDoneY1) and (XPhys <> FColSelDonePhysX) then begin 2294 // Move carets X 2295 CurY := FColSelDoneY1; 2296 XLog := PhysicalToLogical(ToIdx(CurY), FColSelDonePhysX, Offs); 2297 i := Carets.FindEqOrNextCaretIdx(XLog, CurY, Offs); 2298 if i >= 0 then begin 2299 while True do begin 2300 CurCaret := Carets.CaretFull[i]; 2301 if CurCaret.Y > FColSelDoneY2 then 2302 break; 2303 if (CurCaret.X = XLog) and (CurCaret.Offs = Offs) then begin 2304 CurCaret.X := PhysicalToLogical(ToIdx(CurCaret.Y), XPhys, CurCaret.Offs); 2305 Carets.CaretFull[i] := CurCaret; 2306 Carets.CaretKeepX[i] := XPhys; 2307 end; 2308 inc(i); 2309 if i >= CaretsCount then 2310 break; 2311 if CurY <> Carets.CaretY[i] then begin 2312 CurY := Carets.CaretY[i]; 2313 XLog := PhysicalToLogical(ToIdx(CurY), FColSelDonePhysX, Offs); 2314 end; 2315 end; 2316 end; 2317 FColSelDonePhysX := XPhys; 2318 end; 2319 2320 if (FColSelDoneY2 < FColSelDoneY1) then begin 2321 // New Selection 2322 AddCarets(SelFirstY, SelLastY, XPhys); 2323 FColSelDoneY1 := SelFirstY; 2324 FColSelDoneY2 := SelLastY; 2325 FColSelDonePhysX := XPhys; 2326 end 2327 else 2328 begin 2329 // Extend 2330 if SelFirstY < FColSelDoneY1 then begin 2331 AddCarets(SelFirstY, FColSelDoneY1 - 1, FColSelDonePhysX); 2332 FColSelDoneY1 := SelFirstY; 2333 end; 2334 if SelLastY > FColSelDoneY2 then begin 2335 AddCarets(FColSelDoneY2 + 1, SelLastY, FColSelDonePhysX); 2336 FColSelDoneY2 := SelLastY; 2337 end; 2338 end; 2339 2340 i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset); 2341 if i >= 0 then 2342 RemoveCaret(i); 2343 2344 if ActiveMode = mcmNoCarets then 2345 ActiveMode := DefaultColumnSelectMode; 2346end; 2347 2348procedure TSynCustomPluginMultiCaret.DoBeforeSetSelText(Sender: TObject; AMode: TSynSelectionMode; 2349 ANewText: PChar); 2350var 2351 skip: Boolean; 2352begin 2353 SelectionObj.RemoveBeforeSetSelTextHandler(@DoBeforeSetSelText); 2354 2355 // only here if selectionexists and is smColumn; 2356 skip := //Editor.SelAvail and (SelectionObj.ActiveSelectionMode = smColumn) and 2357 not(eoPersistentBlock in Editor.Options2); 2358 if skip then 2359 SetSkipCaretAtSel; 2360 2361 RemoveCaretsInSelection; 2362 SelectionObj.SelText := ''; 2363 2364 if Carets.MainCaretIndex >= 0 then begin 2365 Editor.LogicalCaretXY := Carets.Caret[Carets.MainCaretIndex]; 2366 FSelX := Carets.Caret[Carets.MainCaretIndex].x; 2367 end 2368 else 2369 assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found'); 2370 2371 if skip then 2372 Include(FStateFlags, sfSkipCaretsAtSelection); // restore the flag 2373end; 2374 2375procedure TSynCustomPluginMultiCaret.ProcessMySynCommand(Sender: TObject; 2376 AfterProcessing: boolean; var Handled: boolean; var Command: TSynEditorCommand; 2377 var AChar: TUTF8Char; Data: pointer; HandlerData: pointer); 2378var 2379 i: Integer; 2380begin 2381 // hcfPreExec 2382 if Handled then exit; 2383 2384 Handled := True; 2385 case Command of 2386 ecPluginMultiCaretSetCaret: begin 2387 if Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset) < 0 then 2388 include(FStateFlags, sfCreateCaretAtCurrentPos); 2389 ActiveMode := mcmAddingCarets; 2390 end; 2391 ecPluginMultiCaretUnsetCaret: begin 2392 exclude(FStateFlags, sfCreateCaretAtCurrentPos); 2393 i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset); 2394 if i >= 0 then 2395 RemoveCaret(i); 2396 ActiveMode := mcmAddingCarets; 2397 end; 2398 ecPluginMultiCaretToggleCaret: begin 2399 i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset); 2400 if (i >= 0) or (sfCreateCaretAtCurrentPos in FStateFlags) then begin 2401 exclude(FStateFlags, sfCreateCaretAtCurrentPos); 2402 if i >= 0 then 2403 RemoveCaret(i); 2404 end 2405 else begin 2406 include(FStateFlags, sfCreateCaretAtCurrentPos); 2407 end; 2408 ActiveMode := mcmAddingCarets; 2409 end; 2410 ecPluginMultiCaretClearAll: begin 2411 Handled := FCarets.Count > 0; 2412 ClearCarets; 2413 if not SelectionObj.SelAvail then 2414 SelectionObj.Clear; // clear invisibel selection 2415 end; 2416 2417 ecPluginMultiCaretModeCancelOnMove: ActiveMode := mcmCancelOnCaretMove; 2418 ecPluginMultiCaretModeMoveAll: ActiveMode := mcmMoveAllCarets; 2419 else 2420 Handled := False; 2421 end; 2422end; 2423 2424procedure TSynCustomPluginMultiCaret.ProcessAllSynCommand(Sender: TObject; AfterProcessing: boolean; 2425 var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer; 2426 HandlerData: pointer); 2427 2428 procedure ExecCommandRepeated(AOnePerLine: Boolean = False; AForceAll: Boolean = False); 2429 var 2430 i, y: Integer; 2431 p: TLogCaretPoint; 2432 skip, noChange, SelAvail, IsUser: Boolean; 2433 MainY: Integer; 2434 begin 2435 Handled := True; 2436 Editor.BeginUpdate(True); 2437 FCarets.IncMergeLock; 2438 try 2439 AddCaret(Editor.LogicalCaretXY.x, Editor.CaretY, CaretObj.BytePosOffset, 2440 [cfMainCaret, cfNoneVisual {, cfAddDuplicate}], CaretObj.KeepCaretXPos); 2441 2442 // Execute Command at current caret pos 2443 Include(FStateFlags, sfProcessingMain); 2444 Include(FStateFlags, sfNoChangeIndicator); 2445 if Editor.SelAvail and (SelectionObj.ActiveSelectionMode = smColumn) then 2446 SelectionObj.AddBeforeSetSelTextHandler(@DoBeforeSetSelText); 2447 Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]); 2448 SelectionObj.RemoveBeforeSetSelTextHandler(@DoBeforeSetSelText); 2449 Exclude(FStateFlags, sfProcessingMain); 2450 noChange := sfNoChangeIndicator in FStateFlags; 2451 Exclude(FStateFlags, sfNoChangeIndicator); 2452 2453 if noChange and not AForceAll then begin 2454 if Carets.MainCaretIndex >= 0 then 2455 RemoveCaret(Carets.MainCaretIndex) 2456 else 2457 assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found'); 2458 exit; 2459 end; 2460 2461 // Repeat command 2462 Include(FStateFlags, sfProcessingRepeat); 2463 CaretObj.IncForcePastEOL; 2464 skip := sfSkipCaretsAtSelection in FStateFlags; 2465 MainY := CaretObj.LinePos; 2466 SelAvail := Editor.SelAvail; 2467 IsUser := Command >= ecUserFirst; 2468 2469 y := FSelY2; 2470 Carets.StartIteratorAtLast; 2471 while Carets.IterateNextDown do begin 2472 if cfMainCaret in Carets.CurrentCaretFlags then 2473 continue; 2474 p := Carets.CurrentCaretFull; 2475 if y > p.y then y := p.y; 2476 if (skip) and (y >= FSelY1) and 2477 (y = p.y) and (FSelX = p.x) 2478 then begin 2479 dec(y); 2480 continue; 2481 end; 2482 if AOnePerLine and 2483 ( (p.y = MainY) or 2484 ( Carets.CanPeekCaret(-1) and (Carets.PeekCaretY(-1) = p.y) ) ) 2485 then 2486 continue; 2487 2488 CaretObj.FullLogicalPos := p; 2489 if IsUser and not SelAvail then 2490 SelectionObj.StartLineBytePos := Point(p.x, p.y); 2491 i := Carets.CurrentCaretKeepX; 2492 if i > 0 then 2493 CaretObj.KeepCaretXPos := i; 2494 Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]); 2495 Carets.CurrentCaretFull := CaretObj.FullLogicalPos; 2496 Carets.CurrentCaretKeepX := -1; 2497 end; 2498 2499 CaretObj.DecForcePastEOL; 2500 Exclude(FStateFlags, sfProcessingRepeat); 2501 2502 if Carets.MainCaretIndex >= 0 then begin 2503 CaretObj.FullLogicalPos := Carets.CaretFull[Carets.MainCaretIndex]; 2504 //CaretObj.KeepCaretXPos := Carets.CaretKeepX[Carets.MainCaretIndex]; 2505 RemoveCaret(Carets.MainCaretIndex); 2506 end 2507 else 2508 assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found'); 2509 finally 2510 Exclude(FStateFlags, sfSkipCaretsAtSelection); 2511 FCarets.DecMergeLock; 2512 MergeAndRemoveCarets; 2513 Editor.EndUpdate; 2514 end; 2515 end; 2516 2517 procedure ExecCaretMoveRepeated; 2518 var 2519 k, xk: Integer; 2520 c: TLogCaretPoint; 2521 begin 2522 Handled := True; 2523 Editor.BeginUpdate(True); 2524 FCarets.IncMergeLock; 2525 try 2526 // Execute Command at current caret pos 2527 Include(FStateFlags, sfProcessingMain); 2528 Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]); 2529 c := CaretObj.FullLogicalPos; 2530 xk := CaretObj.KeepCaretXPos; 2531 Exclude(FStateFlags, sfProcessingMain); 2532 2533 // Repeat command 2534 Include(FStateFlags, sfProcessingRepeat); 2535 case Command of 2536 ecLeft, ecUp, ecWordLeft, ecLineStart, ecPageUp, ecPageLeft, 2537 ecPageTop, ecLineTextStart, ecWordEndLeft, ecHalfWordLeft, ecSmartWordLeft: 2538 begin 2539 Carets.StartIteratorAtFirst; 2540 while Carets.IterateNextUp do begin 2541 CaretObj.FullLogicalPos := Carets.CurrentCaretFull; 2542 k := Carets.CurrentCaretKeepX; 2543 if k > 0 then 2544 CaretObj.KeepCaretXPos := k; 2545 Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]); 2546 Carets.CurrentCaretFull := CaretObj.FullLogicalPos; 2547 Carets.CurrentCaretKeepX := CaretObj.KeepCaretXPos; 2548 end; 2549 end; 2550 ecEditorTop, ecEditorBottom: ClearCarets; 2551 else 2552 begin 2553 Carets.StartIteratorAtLast; 2554 while Carets.IterateNextDown do begin 2555 CaretObj.FullLogicalPos := Carets.CurrentCaretFull; 2556 k := Carets.CurrentCaretKeepX; 2557 if k > 0 then 2558 CaretObj.KeepCaretXPos := k; 2559 Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]); 2560 Carets.CurrentCaretFull := CaretObj.FullLogicalPos; 2561 Carets.CurrentCaretKeepX := CaretObj.KeepCaretXPos; 2562 end; 2563 end; 2564 end; 2565 Exclude(FStateFlags, sfProcessingRepeat); 2566 2567 finally 2568 FCarets.DecMergeLock; 2569 CaretObj.FullLogicalPos := c; 2570 CaretObj.KeepCaretXPos := xk; 2571 MergeAndRemoveCarets; 2572 Editor.EndUpdate; 2573 end; 2574 end; 2575 2576 procedure StartEditing; 2577 begin 2578 Include(FStateFlags, sfProcessingCmd); 2579 if (ActiveMode = mcmAddingCarets) and (not Editor.ReadOnly) then 2580 ActiveMode := DefaultMode; 2581 end; 2582 2583var 2584 ClipHelper: TSynClipboardStream; 2585 Action: TSynMultiCaretCommandAction; 2586 Flags: TSynMultiCaretCommandFlags; 2587begin 2588 // hcfFinish 2589 if AfterProcessing then begin 2590 if (FNestedCommandProcessor > 0) then begin 2591 dec(FNestedCommandProcessor); 2592 exit; 2593 end; 2594 2595 FStateFlags := FStateFlags - [sfProcessingCmd, sfSkipUndoCarets, sfExtendingColumnSel]; 2596 if (CaretsCount = 0) then 2597 exit; 2598 2599 if IsCaretMergeRequested then 2600 MergeAndRemoveCarets(True); // is case of several commands in one paintlock 2601 UpdateCaretsPos; 2602 2603 exit; 2604 end; 2605 2606 2607 // hcfInit 2608 (* use Editor.CommandProcessor(... SkipInit=[hcfInit, hcfFinish]) 2609 command is already initialized / prevent macro recorder from recording again. 2610 *) 2611 2612 if (sfProcessingCmd in FStateFlags) then 2613 inc(FNestedCommandProcessor); 2614 if (sfProcessingCmd in FStateFlags) or (CaretsCount = 0) then 2615 exit; 2616 if Handled then 2617 exit; 2618 2619 2620 Action := ccaDefaultAction; 2621 case Command of 2622 ecCopy, ecCut: Action := ccaNoneRepeatCommand; 2623 ecGotoMarker0..ecGotoMarker9: Action := ccaClearCarets; 2624 ecSelectAll: Action := ccaClearCarets; 2625 ecDeleteChar: if smcoDeleteSkipLineBreak in Options then 2626 Command := ecDeleteCharNoCrLf; 2627 else 2628 if Command >= ecUserFirst then 2629 Action := ccaNoneRepeatCommand; 2630 end; 2631 Flags := []; 2632 if FOnBeforeCommand <> nil then 2633 FOnBeforeCommand(Self, Command, Action, Flags); 2634 2635 case Action of 2636 //ccaDefaultAction: ; 2637 ccaNoneRepeatCommand: begin 2638 exit; 2639 end; 2640 ccaRepeatCommand: begin 2641 StartEditing; 2642 ExecCommandRepeated; 2643 exit; 2644 end; 2645 ccaRepeatCommandPerLine: begin 2646 StartEditing; 2647 ExecCommandRepeated(True); 2648 exit; 2649 end; 2650 ccaClearCarets: begin 2651 ClearCarets; 2652 exit; 2653 end; 2654 ccaAdjustCarets: begin 2655 Include(FStateFlags, sfProcessingCmd); 2656 exit; 2657 end; 2658 end; 2659 2660 case Command of 2661 // TODO: delete and smColumn -- only delete once 2662 ecDeleteLastChar..ecDeleteLine, ecDeleteCharNoCrLf, 2663 ecLineBreak..ecChar: 2664 begin 2665 StartEditing; 2666 if Editor.ReadOnly then exit; 2667 ExecCommandRepeated(False, Command = ecDeleteCharNoCrLf); 2668 end; 2669 ecPaste: 2670 begin 2671 StartEditing; 2672 if Editor.ReadOnly then exit; 2673 2674 if (SelectionObj.ActiveSelectionMode = smColumn) and 2675 (SelectionObj.StartLinePos <> SelectionObj.EndLinePos) 2676 then begin 2677 ClipHelper := TSynClipboardStream.Create; 2678 try 2679 ClipHelper.ReadFromClipboard(Clipboard); 2680 if ClipHelper.SelectionMode = smColumn then begin 2681 Exclude(FStateFlags, sfProcessingCmd); 2682 exit; 2683 end; 2684 finally 2685 ClipHelper.Free; 2686 end; 2687 end; 2688 2689 ExecCommandRepeated; 2690 end; 2691 ecTab..ecShiftTab: 2692 begin 2693 StartEditing; 2694 if Editor.ReadOnly then exit; 2695 if (eoTabIndent in Editor.Options) and Editor.SelAvail then begin 2696 if (SelectionObj.ActiveSelectionMode = smColumn) then begin 2697 // no indent for column mode, when multicaret 2698 Editor.BeginUpdate(True); 2699 try 2700 AddCaret(Editor.LogicalCaretXY.x, Editor.CaretY, CaretObj.BytePosOffset, [cfMainCaret, cfNoneVisual, cfAddDuplicate]); 2701 Editor.SelText := ''; 2702 if Carets.MainCaretIndex >= 0 then begin 2703 Editor.LogicalCaretXY := Carets.Caret[Carets.MainCaretIndex]; 2704 RemoveCaret(Carets.MainCaretIndex); 2705 end 2706 else 2707 assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found'); 2708 ExecCommandRepeated; 2709 finally 2710 Editor.EndUpdate; 2711 end; 2712 end 2713 else // exec once and adjust 2714 exit; 2715 end 2716 else 2717 ExecCommandRepeated; 2718 end; 2719 ecSelColCmdRangeStart..ecSelColCmdRangeEnd: 2720 begin 2721 Include(FStateFlags, sfSkipUndoCarets); 2722 Include(FStateFlags, sfExtendingColumnSel); 2723 end; 2724 ecLeft..ecSmartWordRight: begin 2725 Include(FStateFlags, sfSkipUndoCarets); 2726 if ActiveMode = mcmMoveAllCarets then begin 2727 Include(FStateFlags, sfProcessingCmd); 2728 ExecCaretMoveRepeated; 2729 end 2730 else 2731 if ActiveMode = mcmAddingCarets then 2732 Include(FStateFlags, sfProcessingCmd) 2733 else 2734 ClearCarets; 2735 end; 2736 ecUndo, ecRedo: 2737 begin 2738 // handle now / prevent carets from being cleared 2739 Include(FStateFlags, sfProcessingCmd); 2740 Include(FStateFlags, sfSkipUndoCarets); 2741 Carets.Clear(False, Carets.Capacity); // will be restored at end of undo 2742 Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]); 2743 Handled := True; 2744 end; 2745 ecPluginFirstMultiCaret..ecPluginLastMultiCaret: ; // ignore and handle in hcfPreExec 2746 else 2747 begin 2748 StartEditing; 2749 if Editor.ReadOnly then exit; 2750 ExecCommandRepeated; 2751 end; 2752 end; 2753 2754 //Exclude(FStateFlags, sfSkipCaretsAtSelection); 2755end; 2756 2757function TSynCustomPluginMultiCaret.MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo; 2758 HandleActionProc: TSynEditMouseActionHandler): Boolean; 2759begin 2760 Result := HandleActionProc(FMouseActions, AnInfo); 2761end; 2762 2763function TSynCustomPluginMultiCaret.DoHandleMouseAction(AnAction: TSynEditMouseAction; 2764 var AnInfo: TSynEditMouseActionInfo): Boolean; 2765var 2766 i, j: Integer; 2767begin 2768 Result := False; 2769 2770 case AnAction.Command of 2771 emcPluginMultiCaretToggleCaret: 2772 begin 2773 Result := True; 2774 i := Carets.FindCaretIdx(AnInfo.NewCaret.BytePos, AnInfo.NewCaret.LinePos, AnInfo.NewCaret.BytePosOffset); 2775 if i >= 0 then 2776 RemoveCaret(i) 2777 else 2778 if (AnInfo.NewCaret.BytePos <> CaretObj.BytePos) or (AnInfo.NewCaret.LinePos <> CaretObj.LinePos) then begin 2779 AddCaret(AnInfo.NewCaret.BytePos, AnInfo.NewCaret.LinePos, AnInfo.NewCaret.BytePosOffset); 2780 end; 2781 if CaretsCount > 0 then 2782 ActiveMode := DefaultMode 2783 else 2784 ActiveMode := mcmNoCarets; 2785 exclude(FStateFlags, sfCreateCaretAtCurrentPos); 2786 end; 2787 emcPluginMultiCaretSelectionToCarets: 2788 begin 2789 Result := True; 2790 j := SelectionObj.LastLineBytePos.y; 2791 i := SelectionObj.FirstLineBytePos.y; 2792 SelectionObj.Clear; 2793 CaretObj.LineBytePos := Point(Length(ViewedTextBuffer[ToIdx(j)])+1, j); 2794 while i < j do begin 2795 AddCaret(Length(ViewedTextBuffer[ToIdx(i)])+1, i, 0); 2796 inc(i); 2797 end; 2798 if CaretsCount > 0 then 2799 ActiveMode := DefaultMode; 2800 if FPaintLock > 0 then 2801 FStateFlags := FStateFlags + [sfSkipSelChanged, sfSkipCaretChanged]; 2802 end; 2803 end; 2804end; 2805 2806procedure TSynCustomPluginMultiCaret.AddStateFlags(AFlags: TSynPluginMultiCaretStateFlags; 2807 AnOnlyIfLocked: Boolean); 2808begin 2809 if (not AnOnlyIfLocked) or (FPaintLock > 0) then 2810 FStateFlags := FStateFlags + AFlags; 2811end; 2812 2813function TSynCustomPluginMultiCaret.CreateVisual: TSynPluginMultiCaretVisual; 2814begin 2815 Result := inherited CreateVisual; 2816 if FInPaint then 2817 Result.BeginPaint(FPaintClip); 2818end; 2819 2820constructor TSynCustomPluginMultiCaret.Create(AOwner: TComponent); 2821begin 2822 FMouseActions := TSynPluginMultiCaretMouseActions.Create(Self); 2823 FMouseActions.ResetDefaults; 2824 FKeyStrokes := TSynPluginMultiCaretKeyStrokes.Create(Self); 2825 FKeyStrokes.ResetDefaults; 2826 FEnableWithColumnSelection := True; 2827 FActiveMode := mcmNoCarets; 2828 FDefaultMode := mcmMoveAllCarets; 2829 FDefaultColumnSelectMode := mcmCancelOnCaretMove; 2830 inherited Create(AOwner); 2831end; 2832 2833destructor TSynCustomPluginMultiCaret.Destroy; 2834begin 2835 inherited Destroy; 2836 FreeAndNil(FMouseActions); 2837 FreeAndNil(FKeyStrokes); 2838end; 2839 2840procedure TSynCustomPluginMultiCaret.AddCaretAtLogPos(X, Y, Offs: Integer); 2841begin 2842 AddCaret(x, y, Offs); 2843 if ActiveMode = mcmNoCarets then 2844 ActiveMode := FDefaultMode; 2845end; 2846 2847initialization 2848 RegisterMouseCmdIdentProcs(@IdentToSynMouseCmd, @SynMouseCmdToIdent); 2849 RegisterExtraGetEditorMouseCommandValues(@GetEditorMouseCommandValues); 2850 RegisterMouseCmdNameAndOptProcs(@MouseCommandName, @MouseCommandConfigName); 2851 2852 RegisterKeyCmdIdentProcs(@IdentToKeyCommand, @KeyCommandToIdent); 2853 RegisterExtraGetEditorCommandValues(@GetEditorCommandValues); 2854 2855{$IfDef SynMultiCaretDebug} 2856 SynMCaretDebug := DebugLogger.FindOrRegisterLogGroup('SynMultiCaretDebug' {$IFDEF SynMultiCaretDebug} , True {$ENDIF} ); 2857{$ENDIF} 2858end. 2859 2860