2
This file is part of the Free Pascal Integrated Development Environment
3
Copyright (c) 1998 by Berczi Gabor
5
Code editor template objects
7
See the file COPYING.FPC, included in this distribution,
8
for details about the copyright.
10
This program is distributed in the hope that it will be useful,
11
but WITHOUT ANY WARRANTY; without even the implied warranty of
12
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
**********************************************************************}
16
{$ifdef TP}{$L-}{$endif}
22
Dos,Objects,Drivers,Views,Dialogs,Menus,
27
cmFileNameChanged = 51234;
29
cmClearLineHighlights = 51236;
30
cmSaveCancelled = 51237;
34
cmLastCursorPos = 51241;
35
cmIndentBlock = 51242;
36
cmUnIndentBlock = 51243;
41
cmResetDebuggerRow = 51248;
43
cmExpandCodeTemplate = 51250;
46
cmWindowStart = 51253;
48
cmFindMatchingDelimiter= 51255;
49
cmFindMatchingDelimiterBack=51256;
50
cmActivateMenu = 51257;
51
cmWordLowerCase = 51258;
52
cmWordUpperCase = 51259;
53
cmOpenAtCursor = 51260;
54
cmBrowseAtCursor = 51261;
55
cmInsertOptions = 51262;
59
cmCollapseFold = 51266;
61
cmDelToEndOfWord = 51268;
63
EditorTextBufSize = {$ifdef FPC}32768{$else} 4096{$endif};
65
MaxLineCount = {$ifdef FPC}2000000{$else}16380{$endif};
68
CodeTemplateCursorChar = '|'; { char to signal cursor pos in templates }
70
efBackupFiles = $00000001;
71
efInsertMode = $00000002;
72
efAutoIndent = $00000004;
73
efUseTabCharacters = $00000008;
74
efBackSpaceUnindents = $00000010;
75
efPersistentBlocks = $00000020;
76
efSyntaxHighlight = $00000040;
77
efBlockInsCursor = $00000080;
78
efVerticalBlocks = $00000100;
79
efHighlightColumn = $00000200;
80
efHighlightRow = $00000400;
81
efAutoBrackets = $00000800;
82
efExpandAllTabs = $00001000;
83
efKeepTrailingSpaces = $00002000;
84
efCodeComplete = $00004000;
86
efNoIndent = $00010000;
87
efKeepLineAttr = $00020000;
88
efStoreContent = $80000000;
93
attrAll = attrAsm+attrComment;
105
edReplacePrompt = 10;
111
edFileOnDiskChanged = 16;
112
edChangedOnloading = 17;
114
edReloadDiskmodifiedFile = 19;
115
edReloadDiskAndIDEModifiedFile = 20;
117
ffmOptions = $0007; ffsOptions = 0;
118
ffmDirection = $0008; ffsDirection = 3;
119
ffmScope = $0010; ffsScope = 4;
120
ffmOrigin = $0020; ffsOrigin = 5;
122
ffReplaceAll = $0080;
125
ffCaseSensitive = $0001;
126
ffWholeWordsOnly = $0002;
127
ffPromptOnReplace = $0004;
133
ffSelectedText = $0010;
135
ffFromCursor = $0000;
136
ffEntireScope = $0020;
140
ffmUseRegExpFind = $0004;
141
ffmOptionsFind = $0003;
142
ffsUseRegExpFind = 8 - 2;
143
ffmUseRegExpReplace = $0008;
144
ffsUseRegExpReplace = 8 - 3;
148
coWhiteSpaceColor = 1;
150
coReservedWordColor = 3;
151
coIdentifierColor = 4;
154
coAssemblerColor = 7;
156
coDirectiveColor = 9;
157
coHexNumberColor = 10;
159
coAsmReservedColor = 12;
162
coLastColor = coBreakColor;
164
lfBreakpoint = $0001;
165
lfHighlightRow = $0002;
166
lfDebuggerRow = $0004;
167
lfSpecialRow = $0008;
174
eaSelectionChanged = 6;
185
eaUnindentBlock = 17;
186
eaOverwriteText = 18;
191
LastAction = eaDummy;
193
ActionString : array [0..LastAction-1] of string[13] =
194
('','Move','InsLine','InsText','DelLine','DelText',
195
'SelChange','Cut','Paste','PasteWin','DelChar','Clear',
196
'CopyBlock','MoveBlock','DelBlock',
197
'ReadBlock','IndentBlock','UnindentBlock','Overwrite',
198
'UpperCase','LowerCase','ToggleCase');
201
CEditor = #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50;
208
Tcentre = (do_not_centre,do_centre);
210
PCustomCodeEditor = ^TCustomCodeEditor;
211
PEditorLineInfo = ^TEditorLineInfo;
212
PFoldCollection = ^TFoldCollection;
215
TFold = object(TObject)
216
constructor Init(AEditor: PCustomCodeEditor; AParentFold: PFold; ACollapsed: boolean);
217
procedure AddReference(P: PObject);
218
procedure RemoveReference(P: PObject);
219
procedure AddLineReference(Line: PEditorLineInfo);
220
procedure RemoveLineReference(Line: PEditorLineInfo);
221
procedure AddChildReference(Fold: PFold);
222
procedure RemoveChildReference(Fold: PFold);
223
function CanDispose: boolean;
224
function IsCollapsed: boolean;
225
function IsParent(AFold: PFold): boolean;
226
function GetLineCount: sw_integer;
227
procedure Collapse(ACollapse: boolean);
229
function GetLevel: sw_integer;
230
destructor Done; virtual;
234
ReferenceCount: sw_integer;
235
Editor: PCustomCodeEditor;
236
LineCount_: sw_integer;
237
Childs: PFoldCollection;
240
TFoldCollection = object(TCollection)
241
function At(Index: sw_Integer): PFold;
244
TEditorLineInfo = object(TObject)
245
Editor: PCustomCodeEditor;
248
EndsWithAsm : boolean;
250
EndsInSingleLineComment,
251
EndsWithComment : boolean;
253
EndsWithDirective : boolean;
254
BeginCommentType,EndCommentType : byte;
256
constructor Init(AEditor: PCustomCodeEditor);
257
destructor Done; virtual;
258
function GetFormat: string;
259
procedure SetFormat(const AFormat: string);
260
procedure SetFold(AFold: PFold);
261
{ Syntax information is now generated separately for each editor instance.
262
This is not neccessary for a one-language IDE, but this unit contains
263
a _generic_ editor object, which should be (and is) as flexible as
265
The overhead caused by generating the same syntax info for ex.
266
twice isn't so much... - Gabor }
269
PEditorLineInfoCollection = ^TEditorLineInfoCollection;
270
TEditorLineInfoCollection = object(TCollection)
271
function At(Index: sw_Integer): PEditorLineInfo;
274
PCustomLine = ^TCustomLine;
275
TCustomLine = object(TObject)
276
constructor Init(const AText: string; AFlags: longint);
277
{a}function GetText: string; virtual;
278
{a}procedure SetText(const AText: string); virtual;
279
{a}function GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo; virtual;
280
{a}function GetFlags: longint; virtual;
281
{a}procedure SetFlags(AFlags: longint); virtual;
282
function IsFlagSet(AFlag: longint): boolean; {$ifdef USEINLINE}inline;{$endif}
283
procedure SetFlagState(AFlag: longint; ASet: boolean);
284
destructor Done; virtual;
285
public { internal use only! }
286
{a}procedure AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor); virtual;
287
{a}procedure RemoveEditorInfo(AEditor: PCustomCodeEditor); virtual;
290
PLineCollection = ^TLineCollection;
291
TLineCollection = object(TCollection)
292
function At(Index: sw_Integer): PCustomLine;
295
PEditorAction = ^TEditorAction;
296
TEditorAction = object(TObject)
300
ActionCount : longint;
304
TimeStamp : longint; { this is needed to keep track of line number &
305
position changes (for ex. for symbol browser)
306
the line&pos references (eg. symbol info) should
307
also contain such a timestamp. this will enable
308
to determine which changes have been made since
309
storage of the information and thus calculate
310
the (probably) changed line & position information,
311
so, we can still jump to the right position in the
312
editor even when it is heavily modified - Gabor }
313
constructor init(act:byte; StartP,EndP:TPoint;Txt:String;AFlags : longint);
314
constructor init_group(act:byte);
315
function is_grouped_action : boolean;
316
destructor done; virtual;
319
PEditorActionCollection = ^TEditorActionCollection;
320
TEditorActionCollection = object(TCollection)
321
CurrentGroupedAction : PEditorAction;
322
GroupLevel : longint;
323
function At(Idx : sw_integer) : PEditorAction;
327
(ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
328
ssDirectivePrefix,ssDirectiveSuffix,ssAsmPrefix,ssAsmSuffix);
330
TEditorBookMark = record
335
TCompleteState = (csInactive,csOffering,csDenied);
337
PEditorBinding = ^TEditorBinding;
339
PEditorBindingCollection = ^TEditorBindingCollection;
340
TEditorBindingCollection = object(TCollection)
341
function At(Index: sw_Integer): PEditorBinding;
344
TEditorBinding = object(TObject)
345
Editor : PCustomCodeEditor;
346
constructor Init(AEditor: PCustomCodeEditor);
347
destructor Done; virtual;
350
PCustomCodeEditorCore = ^TCustomCodeEditorCore;
351
TCustomCodeEditorCore = object(TObject)
352
{$ifdef TP}public{$else}protected{$endif}
353
Bindings : PEditorBindingCollection;
354
LockFlag : sw_integer;
355
ChangedLine : sw_integer;
356
ContentsChangedCalled : boolean;
357
LimitsChangedCalled : boolean;
358
ModifiedChangedCalled : boolean;
359
TabSizeChangedCalled : boolean;
360
StoreUndoChangedCalled : boolean;
361
{$ifdef TEST_PARTIAL_SYNTAX}
362
LastSyntaxedLine : sw_integer;
363
SyntaxComplete : boolean;
364
{$endif TEST_PARTIAL_SYNTAX}
367
procedure BindEditor(AEditor: PCustomCodeEditor);
368
procedure UnBindEditor(AEditor: PCustomCodeEditor);
369
function IsEditorBound(AEditor: PCustomCodeEditor): boolean;
370
function GetBindingCount: sw_integer;
371
function GetBindingIndex(AEditor: PCustomCodeEditor): sw_integer;
372
function SearchBinding(AEditor: PCustomCodeEditor): PEditorBinding;
373
function CanDispose: boolean;
374
destructor Done; virtual;
376
{a}function GetModified: boolean; virtual;
377
function GetChangedLine: sw_integer;
378
{a}procedure SetModified(AModified: boolean); virtual;
379
{a}function GetStoreUndo: boolean; virtual;
380
{a}procedure SetStoreUndo(AStore: boolean); virtual;
381
{a}function GetSyntaxCompleted: boolean; virtual;
382
{a}procedure SetSyntaxCompleted(SC: boolean); virtual;
383
{a}function GetTabSize: integer; virtual;
384
{a}procedure SetTabSize(ATabSize: integer); virtual;
385
{a}function GetIndentSize: integer; virtual;
386
{a}procedure SetIndentSize(AIndentSize: integer); virtual;
387
function IsClipboard: Boolean;
390
procedure BindingsChanged;
391
procedure ContentsChanged;
392
procedure LimitsChanged;
393
procedure ModifiedChanged;
394
procedure TabSizeChanged;
395
procedure StoreUndoChanged;
396
{a}procedure DoContentsChanged; virtual;
397
{a}procedure DoLimitsChanged; virtual;
398
{a}procedure DoModifiedChanged; virtual;
399
{a}procedure DoTabSizeChanged; virtual;
400
{a}procedure DoStoreUndoChanged; virtual;
401
{a}procedure DoSyntaxStateChanged; virtual;
402
function GetLastVisibleLine : sw_integer;
405
function LoadFromStream(Editor: PCustomCodeEditor; Stream: PFastBufStream): boolean; virtual;
406
function SaveToStream(Editor: PCustomCodeEditor; Stream: PStream): boolean; virtual;
407
function SaveAreaToStream(Editor: PCustomCodeEditor; Stream: PStream; StartP,EndP: TPoint): boolean; virtual;
408
{$ifdef TP}public{$else}protected{$endif}
409
{ Text & info storage abstraction }
410
{a}procedure ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean); virtual;
411
{a}procedure IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:string); virtual;
412
{a}function IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): string; virtual;
413
{a}procedure ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: string); virtual;
415
{ Text & info storage abstraction }
416
function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
417
function LinePosToCharIdx(Line,X: sw_integer): sw_integer;
418
{a}function GetLineCount: sw_integer; virtual;
419
{a}function GetLine(LineNo: sw_integer): PCustomLine; virtual;
420
{a}function GetLineText(LineNo: sw_integer): string; virtual;
421
{a}procedure SetDisplayText(I: sw_integer;const S: string); virtual;
422
{a}function GetDisplayText(I: sw_integer): string; virtual;
423
{a}procedure SetLineText(I: sw_integer;const S: string); virtual;
424
procedure GetDisplayTextFormat(Editor: PCustomCodeEditor; I: sw_integer;var DT,DF:string); virtual;
425
function GetLineFormat(Editor: PCustomCodeEditor; I: sw_integer): string; virtual;
426
procedure SetLineFormat(Editor: PCustomCodeEditor; I: sw_integer;const S: string); virtual;
427
{a}procedure DeleteAllLines; virtual;
428
{a}procedure DeleteLine(I: sw_integer); virtual;
429
{a}function InsertLine(LineNo: sw_integer; const S: string): PCustomLine; virtual;
430
{a}procedure AddLine(const S: string); virtual;
431
{a}procedure GetContent(ALines: PUnsortedStringCollection); virtual;
432
{a}procedure SetContent(ALines: PUnsortedStringCollection); virtual;
434
procedure Lock(AEditor: PCustomCodeEditor);
435
procedure UnLock(AEditor: PCustomCodeEditor);
436
function Locked: boolean;
439
function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
440
function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; virtual;
441
function DoUpdateAttrs(Editor: PCustomCodeEditor; FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
442
function DoUpdateAttrsRange(Editor: PCustomCodeEditor; FromLine, ToLine: sw_integer;
443
Attrs: byte): sw_integer; virtual;
445
{ Undo info storage }
446
{a}procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;AFlags : longint); virtual;
447
{a}procedure AddGroupedAction(AAction : byte); virtual;
448
{a}procedure CloseGroupedAction(AAction : byte); virtual;
449
{a}function GetUndoActionCount: sw_integer; virtual;
450
{a}function GetRedoActionCount: sw_integer; virtual;
451
procedure UpdateUndoRedo(cm : word; action : byte);virtual;
454
TCaseAction = (caToLowerCase,caToUpperCase,caToggleCase);
456
TCustomCodeEditor = object(TScroller)
463
AlwaysShowScrollBars: boolean;
465
{ constructor Load(var S: TStream);
466
procedure Store(var S: TStream);}
467
procedure ConvertEvent(var Event: TEvent); virtual;
468
procedure HandleEvent(var Event: TEvent); virtual;
469
procedure SetState(AState: Word; Enable: Boolean); virtual;
470
procedure LocalMenu(P: TPoint); virtual;
471
function GetLocalMenu: PMenu; virtual;
472
function GetCommandTarget: PView; virtual;
473
function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
474
function GetPalette: PPalette; virtual;
476
procedure Draw; virtual;
477
procedure DrawCursor; virtual;
478
{ this is the only way I found to avoid
479
having the cursor being updated if lock is on PM }
480
procedure ResetCursor; virtual;
481
procedure DrawIndicator; virtual;
483
{a}function GetFlags: longint; virtual;
484
{a}procedure SetFlags(AFlags: longint); virtual;
485
{a}function GetModified: boolean; virtual;
486
{a}procedure SetModified(AModified: boolean); virtual;
487
{a}function GetStoreUndo: boolean; virtual;
488
{a}procedure SetStoreUndo(AStore: boolean); virtual;
489
{a}function GetSyntaxCompleted: boolean; virtual;
490
{a}procedure SetSyntaxCompleted(SC: boolean); virtual;
491
{a}function GetLastSyntaxedLine: sw_integer; virtual;
492
{a}procedure SetLastSyntaxedLine(ALine: sw_integer); virtual;
493
function IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
494
function GetReservedColCount: sw_integer; virtual;
495
{a}function GetTabSize: integer; virtual;
496
{a}procedure SetTabSize(ATabSize: integer); virtual;
497
{a}function GetIndentSize: integer; virtual;
498
{a}procedure SetIndentSize(AIndentSize: integer); virtual;
499
{a}function IsReadOnly: boolean; virtual;
500
{a}function IsClipboard: Boolean; virtual;
501
{a}function GetInsertMode: boolean; virtual;
502
{a}procedure SetInsertMode(InsertMode: boolean); virtual;
503
procedure SetCurPtr(X,Y: sw_integer); virtual;
504
procedure GetSelectionArea(var StartP,EndP: TPoint); virtual;
505
procedure SetSelection(A, B: TPoint); virtual;
506
procedure SetHighlight(A, B: TPoint); virtual;
507
procedure ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction); virtual;
508
procedure SetLineFlagState(LineNo: sw_integer; Flags: longint; ASet: boolean);
509
procedure SetLineFlagExclusive(Flags: longint; LineNo: sw_integer);
510
procedure Update; virtual;
511
procedure ScrollTo(X, Y: sw_Integer);
512
procedure TrackCursor(centre:Tcentre); virtual;
513
procedure Lock; virtual;
514
procedure UnLock; virtual;
516
{ Text & info storage abstraction }
517
{a}function GetLineCount: sw_integer; virtual;
518
{a}function GetLine(LineNo: sw_integer): PCustomLine; virtual;
519
{a}function CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer; virtual;
520
{a}function LinePosToCharIdx(Line,X: sw_integer): sw_integer; virtual;
521
{a}function GetLineText(I: sw_integer): string; virtual;
522
{a}procedure SetDisplayText(I: sw_integer;const S: string); virtual;
523
{a}function GetDisplayText(I: sw_integer): string; virtual;
524
{a}procedure SetLineText(I: sw_integer;const S: string); virtual;
525
{a}procedure GetDisplayTextFormat(I: sw_integer;var DT,DF:string); virtual;
526
{a}function GetLineFormat(I: sw_integer): string; virtual;
527
{a}procedure SetLineFormat(I: sw_integer;const S: string); virtual;
528
{a}procedure DeleteAllLines; virtual;
529
{a}procedure DeleteLine(I: sw_integer); virtual;
530
{a}function InsertLine(LineNo: sw_integer; const S: string): PCustomLine; virtual;
531
{a}procedure AddLine(const S: string); virtual;
532
{a}function GetErrorMessage: string; virtual;
533
{a}procedure SetErrorMessage(const S: string); virtual;
534
{a}procedure AdjustSelection(DeltaX, DeltaY: sw_integer);
535
{a}procedure AdjustSelectionBefore(DeltaX, DeltaY: sw_integer);
536
{a}procedure AdjustSelectionPos(OldCurPosX, OldCurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
537
{a}procedure GetContent(ALines: PUnsortedStringCollection); virtual;
538
{a}procedure SetContent(ALines: PUnsortedStringCollection); virtual;
539
{a}function LoadFromStream(Stream: PFastBufStream): boolean; virtual;
540
{a}function SaveToStream(Stream: PStream): boolean; virtual;
541
{a}function SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;virtual;
542
function LoadFromFile(const AFileName: string): boolean; virtual;
543
function SaveToFile(const AFileName: string): boolean; virtual;
545
{a}function InsertFrom(Editor: PCustomCodeEditor): Boolean; virtual;
546
{a}function InsertText(const S: string): Boolean; virtual;
548
procedure FlagsChanged(OldFlags: longint); virtual;
549
{a}procedure BindingsChanged; virtual;
550
procedure ContentsChanged; virtual;
551
procedure LimitsChanged; virtual;
552
procedure ModifiedChanged; virtual;
553
procedure PositionChanged; virtual;
554
procedure TabSizeChanged; virtual;
555
procedure SyntaxStateChanged; virtual;
556
procedure StoreUndoChanged; virtual;
557
procedure SelectionChanged; virtual;
558
procedure HighlightChanged; virtual;
559
{a}procedure DoLimitsChanged; virtual;
561
{ Syntax highlight support }
562
{a}function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
563
{a}function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
564
{a}function IsReservedWord(const S: string): boolean; virtual;
565
{a}function IsAsmReservedWord(const S: string): boolean; virtual;
567
{ CodeTemplate support }
568
{a}function TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
569
function SelectCodeTemplate(var ShortCut: string): boolean; virtual;
570
{ CodeComplete support }
571
{a}function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
572
{a}function GetCodeCompleteWord: string; virtual;
573
{a}procedure SetCodeCompleteWord(const S: string); virtual;
574
{a}function GetCodeCompleteFrag: string; virtual;
575
{a}procedure SetCodeCompleteFrag(const S: string); virtual;
576
function GetCompleteState: TCompleteState; virtual;
577
procedure SetCompleteState(AState: TCompleteState); virtual;
578
procedure ClearCodeCompleteWord; virtual;
580
function GetMaxFoldLevel: sw_integer; virtual;
581
function GetFoldStringWidth: sw_integer; virtual;
582
procedure GetFoldStrings(EditorLine: sw_integer; var Prefix, Suffix: openstring); virtual;
583
{a}function GetFoldCount: sw_integer; virtual;
584
{a}function GetFold(Index: sw_integer): PFold; virtual;
585
{a}procedure RegisterFold(AFold: PFold); virtual;
586
{a}procedure UnRegisterFold(AFold: PFold); virtual;
587
function ViewToEditorLine(ViewLine: sw_integer): sw_integer;
588
function EditorToViewLine(EditorLine: sw_integer): sw_integer;
589
procedure ViewToEditorPoint(P: TPoint; var NP: TPoint);
590
procedure EditorToViewPoint(P: TPoint; var NP: TPoint);
592
function CreateFold(StartY,EndY: sw_integer; Collapsed: boolean): boolean; virtual;
593
procedure FoldChanged(Fold: PFold); virtual;
594
procedure RemoveAllFolds; virtual;
597
{a}function UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer; virtual;
598
{a}function UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer; virtual;
600
{ Undo info storage }
601
{a}procedure AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;AFlags : longint); virtual;
602
{a}procedure AddGroupedAction(AAction : byte); virtual;
603
{a}procedure CloseGroupedAction(AAction : byte); virtual;
604
{a}function GetUndoActionCount: sw_integer; virtual;
605
{a}function GetRedoActionCount: sw_integer; virtual;
606
{$ifdef TP}public{$else}protected{$endif}
609
Bookmarks : array[0..9] of TEditorBookmark;
611
DrawCursorCalled: boolean;
613
procedure DrawLines(FirstLine: sw_integer);
614
function Overwrite: boolean;
615
function IsModal: boolean;
617
procedure CodeCompleteCheck;
618
procedure CodeCompleteApply;
619
procedure CodeCompleteCancel;
620
procedure UpdateUndoRedo(cm : word; action : byte);
621
procedure HideHighlight;
622
function ShouldExtend: boolean;
623
function ValidBlock: boolean;
624
function GetLineFold(EditorLine: sw_integer): PFold;
625
function IsLineVisible(EditorLine: sw_integer): boolean; virtual;
626
function NextVisibleLine(StartLine: sw_integer; Down: boolean): sw_integer;
627
procedure PushInfo(Const st : string);virtual;
628
procedure PopInfo;virtual;
630
{ Editor primitives }
631
procedure SelectAll(Enable: boolean); virtual;
634
SearchRunCount: integer;
635
InASCIIMode: boolean;
636
procedure Indent; virtual;
637
procedure CharLeft; virtual;
638
procedure CharRight; virtual;
639
procedure WordLeft; virtual;
640
procedure WordRight; virtual;
641
procedure LineStart; virtual;
642
procedure LineEnd; virtual;
643
procedure LineUp; virtual;
644
procedure LineDown; virtual;
645
procedure PageUp; virtual;
646
procedure PageDown; virtual;
647
procedure TextStart; virtual;
648
procedure TextEnd; virtual;
649
procedure WindowStart; virtual;
650
procedure WindowEnd; virtual;
651
procedure JumpSelStart; virtual;
652
procedure JumpSelEnd; virtual;
653
procedure JumpMark(MarkIdx: integer); virtual;
654
procedure DefineMark(MarkIdx: integer); virtual;
655
procedure JumpToLastCursorPos; virtual;
656
procedure FindMatchingDelimiter(ScanForward: boolean); virtual;
657
procedure CreateFoldFromBlock; virtual;
658
procedure ToggleFold; virtual;
659
procedure CollapseFold; virtual;
660
procedure ExpandFold; virtual;
661
procedure UpperCase; virtual;
662
procedure LowerCase; virtual;
663
procedure WordLowerCase; virtual;
664
procedure WordUpperCase; virtual;
665
procedure InsertOptions; virtual;
666
procedure ToggleCase; virtual;
667
function InsertNewLine: Sw_integer; virtual;
668
procedure BreakLine; virtual;
669
procedure BackSpace; virtual;
670
procedure DelChar; virtual;
671
procedure DelWord; virtual;
672
procedure DelToEndOfWord; virtual;
673
procedure DelStart; virtual;
674
procedure DelEnd; virtual;
675
procedure DelLine; virtual;
676
procedure InsMode; virtual;
677
procedure StartSelect; virtual;
678
procedure EndSelect; virtual;
679
procedure DelSelect; virtual;
680
procedure HideSelect; virtual;
681
procedure CopyBlock; virtual;
682
procedure MoveBlock; virtual;
683
procedure IndentBlock; virtual;
684
procedure UnindentBlock; virtual;
685
procedure SelectWord; virtual;
686
procedure SelectLine; virtual;
687
procedure WriteBlock; virtual;
688
procedure ReadBlock; virtual;
689
procedure PrintBlock; virtual;
690
procedure ExpandCodeTemplate; virtual;
691
procedure AddChar(C: char); virtual;
692
{$ifdef WinClipSupported}
693
function ClipCopyWin: Boolean; virtual;
694
function ClipPasteWin: Boolean; virtual;
695
{$endif WinClipSupported}
696
function ClipCopy: Boolean; virtual;
697
procedure ClipCut; virtual;
698
procedure ClipPaste; virtual;
699
function GetCurrentWord : string;
700
function GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
701
procedure Undo; virtual;
702
procedure Redo; virtual;
703
procedure Find; virtual;
704
procedure Replace; virtual;
705
procedure DoSearchReplace; virtual;
706
procedure GotoLine; virtual;
709
TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
711
TEditorInputLine = object(TInputLine)
712
Procedure HandleEvent(var Event : TEvent);virtual;
714
PEditorInputLine = ^TEditorInputLine;
718
{ used for ShiftDel and ShiftIns to avoid
719
GetShiftState to be considered for extending
721
DontConsiderShiftState: boolean = false;
723
CodeCompleteMinLen : byte = 4; { minimum length of text to try to complete }
725
ToClipCmds : TCommandSet = ([cmCut,cmCopy,cmCopyWin,
726
{ cmUnselect should because like cut, copy, copywin:
727
if there is a selection, it is active, else it isn't }
729
FromClipCmds : TCommandSet = ([cmPaste]);
730
NulClipCmds : TCommandSet = ([cmClear]);
731
UndoCmd : TCommandSet = ([cmUndo]);
732
RedoCmd : TCommandSet = ([cmRedo]);
734
function ExtractTabs(S: string; TabSize: Sw_integer): string;
736
function StdEditorDialog(Dialog: Integer; Info: Pointer): word;
739
DefaultSaveExt : string[12] = '.pas';
740
FileDir : DirStr = '';
742
EditorDialog : TCodeEditorDialog = {$ifdef fpc}@{$endif}StdEditorDialog;
743
Clipboard : PCustomCodeEditor = nil;
744
FindStr : String[FindStrSize] = '';
745
ReplaceStr : String[FindStrSize] = '';
746
FindReplaceEditor : PCustomCodeEditor = nil;
747
FindFlags : word = ffPromptOnReplace;
748
{$ifndef NO_UNTYPEDSET}
749
{$define USE_UNTYPEDSET}
750
{$endif ndef NO_UNTYPEDSET}
751
WhiteSpaceChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = [#0,#32,#255];
752
TabChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = [#9];
753
HashChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['#'];
754
AlphaChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['A'..'Z','a'..'z','_'];
755
NumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['0'..'9'];
756
HexNumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['0'..'9','A'..'F','a'..'f'];
757
RealNumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['E','e','.'{,'+','-'}];
759
procedure RegisterWEditor;
764
Strings,Video,MsgBox,App,StdDlg,Validate,
765
{$ifdef WinClipSupported}
767
{$endif WinClipSupported}
774
RecordWord = sw_word;
776
TFindDialogRec = packed record
777
Find : String[FindStrSize];
778
Options : RecordWord{longint};
779
{ checkboxes need 32 bits PM }
780
{ reverted to word in dialogs.TCluster for TP compatibility (PM) }
781
{ anyhow its complete nonsense : you can only have 16 fields
782
but use a longint to store it !! }
783
Direction: RecordWord;{ and tcluster has word size }
788
TReplaceDialogRec = packed record
789
Find : String[FindStrSize];
790
Replace : String[FindStrSize];
791
Options : RecordWord{longint};
792
Direction: RecordWord;
797
TGotoLineDialogRec = packed record
803
kbShift = kbLeftShift+kbRightShift;
807
FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
808
Ord(^A), cmWordLeft, Ord(^B), cmJumpLine, Ord(^C), cmPageDown,
809
Ord(^D), cmCharRight, Ord(^E), cmLineUp,
810
Ord(^F), cmWordRight, Ord(^G), cmDelChar,
811
Ord(^H), cmBackSpace, Ord(^J), cmExpandCodeTemplate,
812
Ord(^K), $FF02, Ord(^L), cmSearchAgain,
813
Ord(^M), cmNewLine, Ord(^N), cmBreakLine,
815
Ord(^P), cmASCIIChar, Ord(^Q), $FF01,
816
Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
817
Ord(^T), cmDelToEndOfWord, Ord(^U), cmUndo,
818
Ord(^V), cmInsMode, Ord(^X), cmLineDown,
819
Ord(^Y), cmDelLine, kbLeft, cmCharLeft,
820
kbRight, cmCharRight, kbCtrlLeft, cmWordLeft,
821
kbCtrlRight, cmWordRight, kbHome, cmLineStart,
822
kbCtrlHome, cmWindowStart, kbCtrlEnd, cmWindowEnd,
823
kbEnd, cmLineEnd, kbUp, cmLineUp,
824
kbDown, cmLineDown, kbPgUp, cmPageUp,
825
kbPgDn, cmPageDown, kbCtrlPgUp, cmTextStart,
826
kbCtrlPgDn, cmTextEnd, kbIns, cmInsMode,
827
kbDel, cmDelChar, kbShiftIns, cmPaste,
828
kbShiftDel, cmCut, kbCtrlIns, cmCopy,
830
kbCtrlGrayMul, cmToggleFold, kbCtrlGrayMinus, cmCollapseFold, kbCtrlGrayPlus, cmExpandFold);
832
QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
833
Ord('A'), cmReplace, Ord('C'), cmTextEnd,
834
Ord('D'), cmLineEnd, Ord('F'), cmFind,
835
Ord('H'), cmDelStart, Ord('R'), cmTextStart,
836
Ord('S'), cmLineStart, Ord('Y'), cmDelEnd,
837
Ord('G'), cmJumpLine, Ord('A'), cmReplace,
838
Ord('B'), cmSelStart, Ord('K'), cmSelEnd,
839
Ord('P'), cmLastCursorPos,
840
Ord('E'), cmWindowStart, Ord('T'), cmWindowStart,
841
Ord('U'), cmWindowEnd, Ord('X'), cmWindowEnd,
842
Ord('['), cmFindMatchingDelimiter, Ord(']'), cmFindMatchingDelimiterBack,
843
Ord('0'), cmJumpMark0, Ord('1'), cmJumpMark1, Ord('2'), cmJumpMark2,
844
Ord('3'), cmJumpMark3, Ord('4'), cmJumpMark4, Ord('5'), cmJumpMark5,
845
Ord('6'), cmJumpMark6, Ord('7'), cmJumpMark7, Ord('8'), cmJumpMark8,
846
Ord('9'), cmJumpMark9);
848
BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
849
Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
850
Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
851
Ord('Y'), cmDelSelect, Ord('V'), cmMoveBlock,
852
Ord('I'), cmIndentBlock, Ord('U'), cmUnindentBlock,
853
Ord('T'), cmSelectWord, Ord('L'), cmSelectLine,
854
Ord('W'), cmWriteBlock, Ord('R'), cmReadBlock,
855
Ord('P'), cmPrintBlock,
856
Ord('N'), cmUpperCase, Ord('O'), cmLowerCase,
857
Ord('D'), cmActivateMenu,
858
Ord('E'), cmWordLowerCase, Ord('F'), cmWordUpperCase,
859
Ord('S'), cmSave, Ord('A'), cmCreateFold,
860
Ord('0'), cmSetMark0, Ord('1'), cmSetMark1, Ord('2'), cmSetMark2,
861
Ord('3'), cmSetMark3, Ord('4'), cmSetMark4, Ord('5'), cmSetMark5,
862
Ord('6'), cmSetMark6, Ord('7'), cmSetMark7, Ord('8'), cmSetMark8,
863
Ord('9'), cmSetMark9);
865
MiscKeys: array[0..MiscKeyCount * 2] of Word = (MiscKeyCount,
866
Ord('A'), cmOpenAtCursor, Ord('B'), cmBrowseAtCursor,
867
Ord('G'), cmJumpLine, Ord('O'), cmInsertOptions,
868
Ord('U'), cmToggleCase, Ord('L'), cmSelectLine);
869
KeyMap: array[0..3] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys, @MiscKeys);
871
function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
883
if (lo(p^)=lo(keycode)) and
884
((hi(p^)=0) or (hi(p^)=hi(keycode))) then
896
function IsWordSeparator(C: char): boolean;
898
IsWordSeparator:=C in
899
[' ',#0,#255,':','=','''','"',
900
'.',',','/',';','$','#',
901
'(',')','<','>','^','*',
902
'+','-','?','&','[',']',
903
'{','}','@','~','%','\',
907
{function IsSpace(C: char): boolean;
909
IsSpace:=C in[' ',#0,#255];
912
function LTrim(S: string): string;
914
while (length(S)>0) and (S[1] in [#0,TAB,#32]) do
919
{ TAB are not same as spaces if UseTabs is set PM }
920
function RTrim(S: string;cut_tabs : boolean): string;
922
while (length(S)>0) and
923
((S[length(S)] in [#0,#32]) or
924
((S[Length(S)]=TAB) and cut_tabs)) do
925
Delete(S,length(S),1);
929
function Trim(S: string): string;
931
Trim:=RTrim(LTrim(S),true);
934
function EatIO: integer;
939
function ExistsFile(const FileName: string): boolean;
943
if FileName='' then Exists:=false else
956
function StrToInt(const S: string): longint;
960
Val(S,L,C); if C<>0 then L:=-1;
964
function RExpand(const S: string; MinLen: byte): string;
966
if length(S)<MinLen then
967
RExpand:=S+CharStr(' ',MinLen-length(S))
973
function upper(const s : string) : string;
977
for i:=1 to length(s) do
978
if s[i] in ['a'..'z'] then
979
upper[i]:=char(byte(s[i])-32)
985
type TPosOfs = {$ifdef TP}longint{$endif}{$ifdef FPC}int64{$endif};
987
function PosToOfs(const X,Y: sw_integer): TPosOfs;
989
PosToOfs:=TPosOfs(y) shl (sizeof(sw_integer)*8) or x;
992
function PosToOfsP(const P: TPoint): TPosOfs;
994
PosToOfsP:=PosToOfs(P.X,P.Y);
997
function PointOfs(P: TPoint): TPosOfs;
999
PointOfs:={longint(P.Y)*MaxLineLength+P.X}PosToOfsP(P);
1003
function ExtractTabs(S: string; TabSize: Sw_integer): string;
1008
while p<length(s) do
1013
PAdd:=TabSize-((p-1) mod TabSize);
1014
s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,High(s));
1021
{function CompressUsingTabs(S: string; TabSize: byte): string;
1025
TabS:=CharStr(' ',TabSize);
1029
S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,High(S));
1031
CompressUsingTabs:=S;
1035
{*****************************************************************************
1036
Forward/Backward Scanning
1037
*****************************************************************************}
1041
MaxBufLength = $7f00;
1044
MaxBufLength = $7fffff00;
1049
Btable = Array[0..255] of Byte;
1050
Procedure BMFMakeTable(const s:string; Var t : Btable);
1054
FillChar(t,sizeof(t),length(s));
1055
For x := length(s) downto 1 do
1056
if (t[ord(s[x])] = length(s)) then
1057
t[ord(s[x])] := length(s) - x;
1061
function BMFScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
1063
buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
1072
BMFScan := NotFoundValue;
1075
s2[0]:=chr(len); { sets the length to that of the search String }
1078
While (not found) and (numb<size) do
1081
if buffer[numb] = ord(str[len]) then
1084
if buffer[numb-pred(len)] = ord(str[1]) then
1086
move(buffer[numb-pred(len)],s2[1],len);
1096
inc(numb,Bt[buffer[numb]]);
1099
BMFScan := NotFoundValue
1101
BMFScan := numb - pred(len);
1105
function BMFIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
1107
buffer : Array[0..MaxBufLength-1] of Char Absolute block;
1116
if (len=0) or (len>size) then
1118
BMFIScan := NotFoundValue;
1123
While (not found) and (numb<size) do
1127
if c in ['a'..'z'] then
1129
if (c=str[len]) then
1132
p:=@buffer[numb-pred(len)];
1136
if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
1150
inc(numb,Bt[ord(c)]);
1153
BMFIScan := NotFoundValue
1155
BMFIScan := numb - pred(len);
1159
Procedure BMBMakeTable(const s:string; Var t : Btable);
1163
FillChar(t,sizeof(t),length(s));
1164
For x := 1 to length(s)do
1165
if (t[ord(s[x])] = length(s)) then
1166
t[ord(s[x])] := x-1;
1170
function BMBScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
1172
buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
1181
BMBScan := NotFoundValue;
1184
s2[0]:=chr(len); { sets the length to that of the search String }
1187
While (not found) and (numb>=0) do
1190
if buffer[numb] = ord(str[1]) then
1193
if buffer[numb+pred(len)] = ord(str[len]) then
1195
move(buffer[numb],s2[1],len);
1205
dec(numb,Bt[buffer[numb]]);
1208
BMBScan := NotFoundValue
1214
function BMBIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
1216
buffer : Array[0..MaxBufLength-1] of Char Absolute block;
1225
if (len=0) or (len>size) then
1227
BMBIScan := NotFoundValue;
1232
While (not found) and (numb>=0) do
1236
if c in ['a'..'z'] then
1245
if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
1259
dec(numb,Bt[ord(c)]);
1262
BMBIScan := NotFoundValue
1268
{*****************************************************************************
1269
PLine,TLineCollection
1270
*****************************************************************************}
1272
constructor TCustomLine.Init(const AText: string; AFlags: longint);
1278
function TCustomLine.GetText: string;
1280
Abstract;GetText:='';
1283
procedure TCustomLine.SetText(const AText: string);
1288
function TCustomLine.GetEditorInfo(Editor: PCustomCodeEditor): PEditorLineInfo;
1294
function TCustomLine.GetFlags: longint;
1300
procedure TCustomLine.SetFlags(AFlags: longint);
1305
function TCustomLine.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
1307
IsFlagSet:=(GetFlags and AFlag)=AFlag;
1310
procedure TCustomLine.SetFlagState(AFlag: longint; ASet: boolean);
1317
N:=N and (not AFlag);
1322
procedure TCustomLine.AddEditorInfo(Index: sw_integer; AEditor: PCustomCodeEditor);
1327
procedure TCustomLine.RemoveEditorInfo(AEditor: PCustomCodeEditor);
1332
destructor TCustomLine.Done;
1337
function TLineCollection.At(Index: sw_Integer): PCustomLine;
1339
At:=inherited At(Index);
1342
constructor TFold.Init(AEditor: PCustomCodeEditor; AParentFold: PFold; ACollapsed: boolean);
1345
New(Childs, Init(10,10));
1347
ParentFold:=AParentFold;
1348
if Assigned(ParentFold) then
1349
ParentFold^.AddChildReference(@Self);
1350
Collapsed_:=ACollapsed;
1351
if Assigned(AEditor) then
1352
Editor^.RegisterFold(@Self);
1355
procedure TFold.AddReference(P: PObject);
1357
Inc(ReferenceCount);
1360
procedure TFold.RemoveReference(P: PObject);
1362
Dec(ReferenceCount);
1367
procedure TFold.AddLineReference(Line: PEditorLineInfo);
1373
procedure TFold.RemoveLineReference(Line: PEditorLineInfo);
1376
RemoveReference(Line);
1379
procedure TFold.AddChildReference(Fold: PFold);
1381
Childs^.Insert(Fold);
1385
procedure TFold.RemoveChildReference(Fold: PFold);
1387
Childs^.Delete(Fold);
1388
RemoveReference(Fold);
1391
function TFold.CanDispose: boolean;
1393
CanDispose:=ReferenceCount<=0;
1396
function TFold.IsCollapsed: boolean;
1400
if Assigned(ParentFold) then C:=C or ParentFold^.IsCollapsed;
1404
function TFold.IsParent(AFold: PFold): boolean;
1407
P:=(ParentFold=AFold);
1408
if Assigned(ParentFold) then P:=P or ParentFold^.IsParent(AFold);
1412
function TFold.GetLineCount: sw_integer;
1413
var Count: sw_integer;
1414
procedure AddIt(P: PFold); {$ifndef FPC}far;{$endif}
1416
Inc(Count,P^.GetLineCount);
1420
if assigned(Childs) then Childs^.ForEach(@AddIt);
1421
GetLineCount:=Count;
1424
procedure TFold.Collapse(ACollapse: boolean);
1426
if ACollapse<>Collapsed_ then
1428
Collapsed_:=ACollapse;
1429
if (not Collapsed_) and Assigned(ParentFold) then
1430
ParentFold^.Collapse(false);
1435
procedure TFold.Changed;
1437
if Assigned(Editor) then
1438
Editor^.FoldChanged(@Self);
1441
function TFold.GetLevel: sw_integer;
1442
var Level: sw_integer;
1445
if Assigned(ParentFold) then
1446
Inc(Level,1+ParentFold^.GetLevel);
1450
destructor TFold.Done;
1452
if Assigned(ParentFold) then
1453
ParentFold^.RemoveChildReference(@Self);
1454
if Assigned(Editor) then
1455
Editor^.UnRegisterFold(@Self);
1456
Childs^.DeleteAll; Dispose(Childs, Done);
1460
function TFoldCollection.At(Index: sw_Integer): PFold;
1462
At:=inherited At(Index);
1465
constructor TEditorLineInfo.Init(AEditor: PCustomCodeEditor);
1471
function TEditorLineInfo.GetFormat: string;
1473
GetFormat:=GetStr(Format);
1476
procedure TEditorLineInfo.SetFormat(const AFormat: string);
1478
SetStr(Format,AFormat);
1481
procedure TEditorLineInfo.SetFold(AFold: PFold);
1483
if Assigned(Fold) then
1484
Fold^.RemoveLineReference(@Self);
1486
if Assigned(Fold) then
1487
Fold^.AddLineReference(@Self);
1490
destructor TEditorLineInfo.Done;
1499
function TEditorLineInfoCollection.At(Index: sw_Integer): PEditorLineInfo;
1501
At:=inherited At(Index);
1504
function TEditorBindingCollection.At(Index: sw_Integer): PEditorBinding;
1506
At:=inherited At(Index);
1509
constructor TEditorBinding.Init(AEditor: PCustomCodeEditor);
1515
destructor TEditorBinding.Done;
1520
constructor TCustomCodeEditorCore.Init;
1523
New(Bindings, Init(10,10));
1526
procedure TCustomCodeEditorCore.BindEditor(AEditor: PCustomCodeEditor);
1527
var B: PEditorBinding;
1528
Count,I,Idx: sw_integer;
1531
assert(Aeditor<>nil);
1532
New(B, Init(AEditor));
1533
Bindings^.Insert(B);
1534
Idx:=Bindings^.IndexOf(B);
1535
Count:=GetLineCount;
1536
for I:=0 to Count-1 do
1540
L^.AddEditorInfo(Idx,AEditor);
1546
procedure TCustomCodeEditorCore.UnBindEditor(AEditor: PCustomCodeEditor);
1547
var B: PEditorBinding;
1548
Count,I: sw_integer;
1551
assert(Aeditor<>nil);
1552
B:=SearchBinding(AEditor);
1555
Count:=GetLineCount;
1556
for I:=0 to Count-1 do
1560
L^.RemoveEditorInfo(AEditor);
1568
function TCustomCodeEditorCore.IsEditorBound(AEditor: PCustomCodeEditor): boolean;
1570
IsEditorBound:=SearchBinding(AEditor)<>nil;
1573
function TCustomCodeEditorCore.GetBindingCount: sw_integer;
1575
GetBindingCount:=Bindings^.Count;
1578
function TCustomCodeEditorCore.GetBindingIndex(AEditor: PCustomCodeEditor): sw_integer;
1579
var B: PEditorBinding;
1581
B:=SearchBinding(AEditor);
1582
GetBindingIndex:=Bindings^.IndexOf(B);
1585
function TCustomCodeEditorCore.SearchBinding(AEditor: PCustomCodeEditor): PEditorBinding;
1586
function SearchEditor(P: PEditorBinding): boolean; {$ifndef FPC}far;{$endif}
1588
SearchEditor:=P^.Editor=AEditor;
1591
SearchBinding:=Bindings^.FirstThat(@SearchEditor);
1594
function TCustomCodeEditorCore.CanDispose: boolean;
1596
CanDispose:=Assigned(Bindings) and (Bindings^.Count=0);
1599
function TCustomCodeEditorCore.GetModified: boolean;
1604
function TCustomCodeEditorCore.GetChangedLine: sw_integer;
1606
GetChangedLine:=ChangedLine;
1609
procedure TCustomCodeEditorCore.SetModified(AModified: boolean);
1614
function TCustomCodeEditorCore.GetStoreUndo: boolean;
1617
GetStoreUndo:=false;
1620
procedure TCustomCodeEditorCore.SetStoreUndo(AStore: boolean);
1625
function TCustomCodeEditorCore.GetSyntaxCompleted: boolean;
1628
GetSyntaxCompleted:=true;
1631
procedure TCustomCodeEditorCore.SetSyntaxCompleted(SC : boolean);
1637
function TCustomCodeEditorCore.IsClipboard: Boolean;
1638
function IsClip(P: PEditorBinding): boolean; {$ifndef FPC}far;{$endif}
1640
IsClip:=(P^.Editor=Clipboard);
1643
IsClipBoard:=Bindings^.FirstThat(@IsClip)<>nil;
1646
function TCustomCodeEditorCore.GetTabSize: integer;
1652
procedure TCustomCodeEditorCore.SetTabSize(ATabSize: integer);
1657
function TCustomCodeEditorCore.GetIndentSize: integer;
1663
procedure TCustomCodeEditorCore.SetIndentSize(AIndentSize: integer);
1668
procedure TCustomCodeEditorCore.LimitsChanged;
1671
LimitsChangedCalled:=true
1676
procedure TCustomCodeEditorCore.ContentsChanged;
1679
ContentsChangedCalled:=true
1684
procedure TCustomCodeEditorCore.ModifiedChanged;
1687
ModifiedChangedCalled:=true
1692
procedure TCustomCodeEditorCore.TabSizeChanged;
1695
TabSizeChangedCalled:=true
1700
procedure TCustomCodeEditorCore.StoreUndoChanged;
1703
StoreUndoChangedCalled:=true
1709
procedure TCustomCodeEditorCore.BindingsChanged;
1710
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1712
P^.Editor^.BindingsChanged;
1715
Bindings^.ForEach(@CallIt);
1718
procedure TCustomCodeEditorCore.DoLimitsChanged;
1719
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1721
P^.Editor^.DoLimitsChanged;
1724
Bindings^.ForEach(@CallIt);
1727
procedure TCustomCodeEditorCore.DoContentsChanged;
1728
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1730
P^.Editor^.ContentsChanged;
1733
Bindings^.ForEach(@CallIt);
1736
procedure TCustomCodeEditorCore.DoModifiedChanged;
1737
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1739
P^.Editor^.ModifiedChanged;
1742
Bindings^.ForEach(@CallIt);
1745
procedure TCustomCodeEditorCore.DoTabSizeChanged;
1746
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1748
P^.Editor^.TabSizeChanged;
1751
Bindings^.ForEach(@CallIt);
1754
procedure TCustomCodeEditorCore.UpdateUndoRedo(cm : word; action : byte);
1755
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1757
if (P^.Editor^.State and sfActive)<>0 then
1759
P^.Editor^.UpdateUndoRedo(cm,action);
1762
P^.Editor^.SetCmdState(UndoCmd,true);
1763
P^.Editor^.SetCmdState(RedoCmd,false);
1764
Message(Application,evBroadcast,cmCommandSetChanged,nil);
1769
Bindings^.ForEach(@CallIt);
1773
procedure TCustomCodeEditorCore.DoStoreUndoChanged;
1774
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1776
P^.Editor^.StoreUndoChanged;
1779
Bindings^.ForEach(@CallIt);
1781
procedure TCustomCodeEditorCore.DoSyntaxStateChanged;
1782
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1784
P^.Editor^.SyntaxStateChanged;
1787
Bindings^.ForEach(@CallIt);
1790
function TCustomCodeEditorCore.GetLastVisibleLine : sw_integer;
1793
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
1795
if y < P^.Editor^.Delta.Y+P^.Editor^.Size.Y then
1796
y:=P^.Editor^.Delta.Y+P^.Editor^.Size.Y;
1800
Bindings^.ForEach(@CallIt);
1801
GetLastVisibleLine:=y;
1804
function TCustomCodeEditorCore.SaveToStream(Editor: PCustomCodeEditor; Stream: PStream): boolean;
1808
B.Y:=GetLineCount-1;
1809
if GetLineCount>0 then
1810
B.X:=length(GetDisplayText(B.Y))
1813
SaveToStream:=SaveAreaToStream(Editor,Stream,A,B);
1816
procedure TCustomCodeEditorCore.ISetLineFlagState(Binding: PEditorBinding; LineNo: sw_integer; Flag: longint; ASet: boolean);
1821
procedure TCustomCodeEditorCore.IGetDisplayTextFormat(Binding: PEditorBinding; LineNo: sw_integer;var DT,DF:string);
1826
function TCustomCodeEditorCore.IGetLineFormat(Binding: PEditorBinding; LineNo: sw_integer): string;
1832
procedure TCustomCodeEditorCore.ISetLineFormat(Binding: PEditorBinding; LineNo: sw_integer;const S: string);
1837
function TCustomCodeEditorCore.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
1839
TabSize,CP,RX,NextInc: sw_integer;
1841
S:=GetLineText(Line);
1842
(* this would fasten the code
1843
but UseTabCharacters is set for Editor not for EditorCore
1844
objects,which is dangerous anyway and should be changed ... PM
1845
if not IsFlagSet(efUseTabCharacters) then
1847
if CharIdx<=Length(S) then
1848
CharIdxToLinePos:=CharIdx-1
1850
CharIdxToLinePos:=Length(S)-1;
1854
TabSize:=GetTabSize;
1857
while {(CP<=length(S)) and }(CP<=CharIdx) do
1861
if (CP<=length(S)) and (S[CP]=TAB) then
1862
NextInc:=TabSize-(RX mod TabSize) -1
1868
CharIdxToLinePos:=RX-1;
1871
function TCustomCodeEditorCore.LinePosToCharIdx(Line,X: sw_integer): sw_integer;
1873
TabSize,CP,RX: sw_integer;
1875
TabSize:=GetTabSize;
1876
S:=GetLineText(Line);
1878
if not IsFlagSet(efUseTabCharacters) then
1882
else if (Line<Length(S)) then
1883
LinePosToCharIdx:=Line+1
1885
LinePosToCharIdx:=Length(S);
1893
while (RX<=X) and (CP<=length(S)) do
1896
if (CP<=length(S)) and
1898
Inc(RX,TabSize-(RX mod TabSize))
1903
LinePosToCharIdx:=CP;
1906
function TCustomCodeEditorCore.GetLineCount: sw_integer;
1912
function TCustomCodeEditorCore.GetLine(LineNo: sw_integer): PCustomLine;
1918
function TCustomCodeEditorCore.GetLineText(LineNo: sw_integer): string;
1924
procedure TCustomCodeEditorCore.SetDisplayText(I: sw_integer;const S: string);
1929
function TCustomCodeEditorCore.GetDisplayText(I: sw_integer): string;
1935
procedure TCustomCodeEditorCore.SetLineText(I: sw_integer;const S: string);
1940
procedure TCustomCodeEditorCore.GetDisplayTextFormat(Editor: PCustomCodeEditor; I: sw_integer;var DT,DF:string);
1942
IGetDisplayTextFormat(SearchBinding(Editor),I,DT,DF);
1945
function TCustomCodeEditorCore.GetLineFormat(Editor: PCustomCodeEditor; I: sw_integer): string;
1947
GetLineFormat:=IGetLineFormat(SearchBinding(Editor),I);
1950
procedure TCustomCodeEditorCore.SetLineFormat(Editor: PCustomCodeEditor; I: sw_integer; const S: string);
1952
ISetLineFormat(SearchBinding(Editor),I,S);
1955
procedure TCustomCodeEditorCore.DeleteAllLines;
1960
procedure TCustomCodeEditorCore.DeleteLine(I: sw_integer);
1965
function TCustomCodeEditorCore.InsertLine(LineNo: sw_integer; const S: string): PCustomLine;
1968
InsertLine:=nil; { eliminate compiler warning }
1971
procedure TCustomCodeEditorCore.AddLine(const S: string);
1976
procedure TCustomCodeEditorCore.GetContent(ALines: PUnsortedStringCollection);
1981
procedure TCustomCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
1986
function TCustomCodeEditorCore.Locked: boolean;
1991
procedure TCustomCodeEditorCore.Lock(AEditor: PCustomCodeEditor);
1996
procedure TCustomCodeEditorCore.UnLock(AEditor: PCustomCodeEditor);
2000
Bug('negative lockflag',nil)
2004
if (LockFlag>0) then
2007
if LimitsChangedCalled then
2010
LimitsChangedCalled:=false;
2013
if ModifiedChangedCalled then
2016
ModifiedChangedCalled:=false;
2019
if TabSizeChangedCalled then
2022
TabSizeChangedCalled:=false;
2025
if StoreUndoChangedCalled then
2028
StoreUndoChangedCalled:=false;
2031
if ContentsChangedCalled then
2034
ContentsChangedCalled:=false;
2039
function TCustomCodeEditorCore.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
2040
var MinLine: sw_integer;
2041
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
2044
I:=DoUpdateAttrs(P^.Editor,FromLine,Attrs);
2045
if (I<MinLine) or (MinLine=-1) then MinLine:=I;
2049
Bindings^.ForEach(@CallIt);
2050
UpdateAttrs:=MinLine;
2053
function TCustomCodeEditorCore.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
2054
var MinLine: sw_integer;
2055
procedure CallIt(P: PEditorBinding); {$ifndef FPC}far;{$endif}
2058
I:=DoUpdateAttrsRange(P^.Editor,FromLine,ToLine,Attrs);
2059
if (I<MinLine) or (MinLine=-1) then MinLine:=I;
2063
Bindings^.ForEach(@CallIt);
2064
UpdateAttrsRange:=MinLine;
2067
function TCustomCodeEditorCore.DoUpdateAttrs(Editor: PCustomCodeEditor; FromLine: sw_integer; Attrs: byte): sw_integer;
2069
TCharClass = (ccWhiteSpace,ccTab,ccAlpha,
2070
ccNumber,ccHexNumber,ccRealNumber,
2073
SymbolIndex: Sw_integer;
2074
CurrentCommentType : Byte;
2075
FirstCC,LastCC: TCharClass;
2076
InAsm,InComment,InSingleLineComment,InDirective,InString: boolean;
2077
X,ClassStart: Sw_integer;
2078
SymbolConcat: string;
2079
LineText,Format: string;
2081
function MatchSymbol(const What, S: string): boolean;
2085
if length(What)>=length(S) then
2086
if copy(What,1+length(What)-length(S),length(S))=S then
2091
var MatchedSymbol: boolean;
2092
MatchingSymbol: string;
2093
type TPartialType = (pmNone,pmLeft,pmRight,pmAny);
2095
function MatchesAnySpecSymbol(SClass: TSpecSymbolClass; PartialMatch: TPartialType): boolean;
2098
Match,Found: boolean;
2101
if SymbolConcat<>'' then
2102
for I:=1 to Editor^.GetSpecSymbolCount(SClass) do
2105
S:=Editor^.GetSpecSymbol(SClass,I-1);
2106
if (length(SymbolConcat)<length(S^)) or
2107
((PartialMatch=pmNone) and (length(S^)<>length(SymbolConcat)))
2112
case PartialMatch of
2113
pmNone : Match:=SymbolConcat=S^;
2115
Match:=copy(SymbolConcat,length(SymbolConcat)-length(S^)+1,length(S^))=S^;
2116
else Match:=MatchSymbol(SymbolConcat,S^);
2121
MatchingSymbol:=S^; Found:=true; Break;
2124
MatchedSymbol:=MatchedSymbol or Found;
2125
MatchesAnySpecSymbol:=Found;
2128
function MatchesAsmSpecSymbol(Const OrigWhat: string; SClass: TSpecSymbolClass): boolean;
2132
Match,Found: boolean;
2135
What:=UpcaseStr(OrigWhat);
2137
for I:=1 to Editor^.GetSpecSymbolCount(SClass) do
2140
S:=Editor^.GetSpecSymbol(SClass,I-1);
2141
if (length(S^)<>length(What)) then
2145
{if CaseInsensitive then
2146
S:=UpcaseStr(S); asm symbols need to be uppercased PM }
2147
{case PartialMatch of
2151
Match:=copy(What,length(What)-length(S)+1,length(S))=S;
2152
else Match:=MatchSymbol(What,S);
2162
// MatchedSymbol:=MatchedSymbol or Found;
2163
MatchesAsmSpecSymbol:=Found;
2166
function IsCommentPrefix: boolean;
2168
IsCommentPrefix:=MatchesAnySpecSymbol(ssCommentPrefix,pmLeft);
2171
function IsSingleLineCommentPrefix: boolean;
2173
IsSingleLineCommentPrefix:=MatchesAnySpecSymbol(ssCommentSingleLinePrefix,pmLeft);
2176
function IsCommentSuffix: boolean;
2178
IsCommentSuffix:=(MatchesAnySpecSymbol(ssCommentSuffix,pmRight))
2179
and (CurrentCommentType=SymbolIndex);
2182
function IsStringPrefix: boolean;
2184
IsStringPrefix:=MatchesAnySpecSymbol(ssStringPrefix,pmLeft);
2187
function IsStringSuffix: boolean;
2189
IsStringSuffix:=MatchesAnySpecSymbol(ssStringSuffix,pmRight);
2192
function IsDirectivePrefix: boolean;
2194
IsDirectivePrefix:=MatchesAnySpecSymbol(ssDirectivePrefix,pmLeft);
2197
function IsDirectiveSuffix: boolean;
2199
IsDirectiveSuffix:=MatchesAnySpecSymbol(ssDirectiveSuffix,pmRight);
2202
function IsAsmPrefix(const WordS: string): boolean;
2204
StoredMatchedSymbol : boolean;}
2206
{StoredMatchedSymbol:=MatchedSymbol;}
2207
IsAsmPrefix:=MatchesAsmSpecSymbol(WordS,ssAsmPrefix);
2208
{MatchedSymbol:=StoredMatchedSymbol;}
2211
function IsAsmSuffix(const WordS: string): boolean;
2213
StoredMatchedSymbol : boolean;}
2215
{StoredMatchedSymbol:=MatchedSymbol;}
2216
IsAsmSuffix:=MatchesAsmSpecSymbol(WordS,ssAsmSuffix);
2217
{MatchedSymbol:=StoredMatchedSymbol;}
2220
function GetCharClass(C: char): TCharClass;
2224
WhiteSpaceChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = [#0,#32,#255];
2225
TabChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = [#9];
2226
HashChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['#'];
2227
AlphaChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['A'..'Z','a'..'z','_'];
2228
NumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['0'..'9'];
2229
HexNumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['0'..'9','A'..'F','a'..'f'];
2230
RealNumberChars {$ifdef USE_UNTYPEDSET}: set of char {$endif} = ['E','e','.'{,'+','-'}];
2232
if C in {$ifdef USE_UNTYPEDSET}[#0,#32,#255]{$else}WhiteSpaceChars{$endif} then
2234
else if C in {$ifdef USE_UNTYPEDSET}[#9]{$else}TabChars{$endif} then
2236
else if C in {$ifdef USE_UNTYPEDSET}['#']{$else}HashChars{$endif} then
2238
else if (LastCC=ccHexNumber) and (C in {$ifdef USE_UNTYPEDSET}['0'..'9','A'..'F','a'..'f']{$else}HexNumberChars{$endif}) then
2240
else if C in {$ifdef USE_UNTYPEDSET}['0'..'9']{$else}NumberChars{$endif} then
2242
else if (LastCC=ccNumber) and (C in {$ifdef USE_UNTYPEDSET}['E','e','.']{$else}RealNumberChars{$endif}) then
2246
if (X>=length(LineText)) or
2247
(LineText[X+1]='.') then
2254
if (X>=length(LineText)) or
2255
(LineText[X+1]in ['+','-','0'..'9']) then
2261
else if C in {$ifdef USE_UNTYPEDSET}['A'..'Z','a'..'z','_']{$else}AlphaChars{$endif} then CC:=ccAlpha else
2266
procedure FormatWord(SClass: TCharClass; StartX:Sw_integer;EndX: Sw_integer);
2272
WordS:=copy(LineText,StartX,EndX-StartX+1);
2273
if (InAsm=true) and (InComment=false) and (InString=false) and
2274
(InDirective=false) and (SClass=ccAlpha) and IsAsmSuffix(WordS) then InAsm:=false;
2275
if InDirective then C:=coDirectiveColor else
2276
if InComment then C:=coCommentColor else
2277
if InString then C:=coStringColor else
2280
if (SClass=ccAlpha) and Editor^.IsAsmReservedWord(WordS) then
2281
C:=coReservedWordColor
2283
C:=coAssemblerColor;
2288
C:=coWhiteSpaceColor;
2292
C:=coHexNumberColor;
2302
if Editor^.IsReservedWord(WordS) then
2303
C:=coReservedWordColor
2305
C:=coIdentifierColor;
2308
if EndX+1>=StartX then
2309
FillChar(Format[StartX],EndX+1-StartX,C);
2310
if (InString=false) and (InAsm=false) and (InComment=false) and
2311
(InDirective=false) and (SClass=ccAlpha) and IsAsmPrefix(WordS) then
2315
procedure ProcessChar(C: char);
2318
EndComment: pstring;
2320
CC:=GetCharClass(C);
2321
if ClassStart=X then
2323
if ( (CC<>LastCC) and
2325
((FirstCC=ccNumber) and (CC<>ccRealNumber) {and (CC<>ccNumber)}) or
2326
(((CC<>ccAlpha) or (LastCC<>ccNumber) ) and
2327
( (CC<>ccNumber) or (LastCC<>ccAlpha) ) and
2328
( (CC<>ccNumber) or (LastCC<>ccHash) ) and
2329
( (CC<>ccRealNumber) or (LastCC<>ccNumber))
2332
(X>length(LineText)) or (CC=ccSymbol) then
2334
MatchedSymbol:=false;
2336
if (CC=ccSymbol) then
2338
if length(SymbolConcat)>=High(SymbolConcat) then
2339
Delete(SymbolConcat,1,1);
2340
SymbolConcat:=SymbolConcat+C;
2341
if InComment and IsCommentSuffix then
2343
if InString and IsStringSuffix then
2345
if InDirective and IsDirectiveSuffix then
2348
if CC=ccRealNumber then
2350
if (C='$') and (MatchedSymbol=false) and (IsDirectivePrefix=false) then
2352
if CC<>ccSymbol then SymbolConcat:='';
2353
FormatWord(LastCC,ClassStart,EX);
2355
if ClassStart=X then
2360
if (LastCC<>ccAlpha) then;
2362
if (InComment=true) and (CurrentCommentType=1) and
2363
(InDirective=false) and IsDirectivePrefix then
2367
Dec(ClassStart,length(MatchingSymbol)-1);
2369
else if (InComment=false) and
2370
(InDirective=true) and IsDirectiveSuffix then
2372
else if (InComment=false) and
2373
(InString=false) and (InDirective=false) and IsCommentPrefix then
2376
CurrentCommentType:=SymbolIndex;
2377
InSingleLineComment:=IsSingleLineCommentPrefix;
2379
Dec(ClassStart,length(MatchingSymbol)-1);
2380
{ Remove (* from SymbolConcat to avoid problem with (*) PM }
2381
{ fixes part of bug 1617 }
2382
{ but removed proper directive prefix detection ... }
2383
EndComment:=Editor^.GetSpecSymbol(ssCommentSuffix,SymbolIndex);
2384
if MatchingSymbol[length(MatchingSymbol)]=EndComment^[1] then
2385
Delete(SymbolConcat,1,length(MatchingSymbol));
2387
else if InComment and IsCommentSuffix then
2392
else if (InComment=false) and (InString=false) and IsStringPrefix then
2395
Dec(ClassStart,length(MatchingSymbol)-1);
2397
else if (InComment=false) and (InString=true) and IsStringSuffix then
2400
if MatchedSymbol and (InComment=false) then
2406
var CurLineNr: Sw_integer;
2407
Line,NextLine,PrevLine{,OldLine}: PCustomLine;
2408
PrevLI,LI,nextLI: PEditorLineInfo;
2410
if (not Editor^.IsFlagSet(efSyntaxHighlight)) or (FromLine>=GetLineCount) then
2412
SetLineFormat(Editor,FromLine,'');
2413
DoUpdateAttrs:=GetLineCount;
2414
{$ifdef TEST_PARTIAL_SYNTAX}
2415
LastSyntaxedLine:=GetLineCount;
2416
if not SyntaxComplete then
2418
SyntaxComplete:=true;
2419
DoSyntaxStateChanged;
2421
(* { no Idle necessary }
2422
EventMask:=EventMask and not evIdle;*)
2423
{$endif TEST_PARTIAL_SYNTAX}
2424
Editor^.SyntaxStateChanged;
2427
{$ifdef TEST_PARTIAL_SYNTAX}
2428
If Editor^.IsFlagSet(efSyntaxHighlight) and (LastSyntaxedLine<FromLine)
2429
and (FromLine<GetLineCount) then
2430
CurLineNr:=LastSyntaxedLine
2432
{$endif TEST_PARTIAL_SYNTAX}
2433
CurLineNr:=FromLine;
2435
PrevLine:=GetLine(CurLineNr-1)
2439
Line:=GetLine(CurLineNr);
2440
if Assigned(PrevLine) then PrevLI:=PrevLine^.GetEditorInfo(Editor) else PrevLI:=nil;
2441
if Assigned(Line) then LI:=Line^.GetEditorInfo(Editor) else LI:=nil;
2442
InSingleLineComment:=false;
2445
InAsm:=PrevLI^.EndsWithAsm;
2446
InComment:=PrevLI^.EndsWithComment and not PrevLI^.EndsInSingleLineComment;
2447
CurrentCommentType:=PrevLI^.EndCommentType;
2448
InDirective:=PrevLI^.EndsWithDirective;
2454
CurrentCommentType:=0;
2458
if (not Editor^.IsFlagSet(efKeepLineAttr)) then
2460
LI^.BeginsWithAsm:=InAsm;
2461
LI^.BeginsWithComment:=InComment;
2462
LI^.BeginsWithDirective:=InDirective;
2463
LI^.BeginCommentType:=CurrentCommentType;
2467
InAsm:=LI^.BeginsWithAsm;
2468
InComment:=LI^.BeginsWithComment;
2469
InDirective:=LI^.BeginsWithDirective;
2470
CurrentCommentType:=LI^.BeginCommentType;
2472
LineText:=GetLineText(CurLineNr);
2473
Format:=CharStr(chr(coTextColor),length(LineText));
2474
LastCC:=ccWhiteSpace;
2478
if LineText<>'' then
2480
for X:=1 to length(LineText) do
2481
ProcessChar(LineText[X]);
2485
SetLineFormat(Editor,CurLineNr,Format);
2486
LI^.EndsWithAsm:=InAsm;
2487
LI^.EndsWithComment:=InComment;
2488
LI^.EndsInSingleLineComment:=InSingleLineComment;
2489
LI^.EndCommentType:=CurrentCommentType;
2490
LI^.EndsWithDirective:=InDirective;
2492
if CurLineNr>=GetLineCount then
2494
NextLine:=GetLine(CurLineNr);
2495
if Assigned(NextLine) then NextLI:=NextLine^.GetEditorInfo(Editor) else NextLI:=nil;
2496
if ((Attrs and attrForceFull)=0) then
2497
if (* Why should we go
2498
(InAsm=false) and (NextLI^.BeginsWithAsm=false) and
2499
(InComment=false) and (NextLI^.BeginsWithComment=false) and
2500
(InDirective=false) and (NextLI^.BeginsWithDirective=false) and
2501
{ OldLine = Line so this is nonsense}
2502
(PrevLI^.EndsWithComment=LI^.EndsWithComment) and
2503
(PrevLI^.EndsWithAsm=LI^.EndsWithAsm) and
2504
(PrevLI^.EndsWithDirective=LI^.EndsWithDirective) and *)
2505
{$ifdef TEST_PARTIAL_SYNTAX}
2506
(CurLineNr>FromLine) and
2507
{$endif TEST_PARTIAL_SYNTAX}
2508
(NextLI^.BeginsWithAsm=LI^.EndsWithAsm) and
2509
(NextLI^.BeginsWithComment=LI^.EndsWithComment) and
2510
(NextLI^.BeginsWithDirective=LI^.EndsWithDirective) and
2511
(NextLI^.BeginCommentType=LI^.EndCommentType) and
2512
(NextLI^.Format<>nil) then
2514
{$ifdef TEST_PARTIAL_SYNTAX}
2515
if (CurLineNr<GetLineCount) and
2516
(CurLineNr>FromLine) and
2517
((Attrs and attrForceFull)=0) and
2518
(CurLineNr>GetLastVisibleLine) then
2520
If SyntaxComplete then
2522
SyntaxComplete:=false;
2523
DoSyntaxStateChanged;
2525
LastSyntaxedLine:=CurLineNr-1;
2528
{$endif TEST_PARTIAL_SYNTAX}
2531
DoUpdateAttrs:=CurLineNr;
2532
{$ifdef TEST_PARTIAL_SYNTAX}
2533
If LastSyntaxedLine<CurLineNr-1 then
2534
LastSyntaxedLine:=CurLineNr-1;
2535
if CurLineNr=GetLineCount then
2537
SyntaxComplete:=true;
2538
DoSyntaxStateChanged;
2540
{$endif TEST_PARTIAL_SYNTAX}
2543
function TCustomCodeEditorCore.DoUpdateAttrsRange(Editor: PCustomCodeEditor; FromLine, ToLine: sw_integer;
2544
Attrs: byte): sw_integer;
2545
var Line: Sw_integer;
2550
Line:=DoUpdateAttrs(Editor,Line,Attrs);
2551
until (Line>=GetLineCount) or (Line>ToLine);
2552
DoUpdateAttrsRange:=Line;
2556
procedure TCustomCodeEditorCore.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;AFlags : longint);
2561
procedure TCustomCodeEditorCore.AddGroupedAction(AAction : byte);
2566
procedure TCustomCodeEditorCore.CloseGroupedAction(AAction : byte);
2571
function TCustomCodeEditorCore.GetUndoActionCount: sw_integer;
2574
GetUndoActionCount:=0;
2577
function TCustomCodeEditorCore.GetRedoActionCount: sw_integer;
2580
GetRedoActionCount:=0;
2583
destructor TCustomCodeEditorCore.Done;
2586
if Bindings^.Count>0 then
2587
ErrorBox('Internal error: there are still '+IntToStr(Bindings^.Count)+' editors '+
2588
'registered at TCodeEditorCode.Done!!!',nil);
2590
if Assigned(Bindings) then Dispose(Bindings, Done); Bindings:=nil;
2594
procedure TCustomCodeEditor.Lock;
2600
procedure TCustomCodeEditor.UnLock;
2604
Bug('negative lockflag',nil)
2609
if (ELockFlag>0) then
2615
If DrawCursorCalled then
2618
DrawCursorCalled:=false;
2622
procedure TCustomCodeEditor.DrawIndicator;
2627
procedure TCustomCodeEditor.AdjustSelectionPos(OldCurPosX, OldCurPosY: sw_integer; DeltaX, DeltaY: sw_integer);
2630
if ValidBlock=false then Exit;
2632
CP.X:=OldCurPosX; CP.Y:=OldCurPosY;
2633
if (PosToOfsP(SelStart)<=PosToOfsP(CP)) and (PosToOfsP(CP)<PosToOfsP(SelEnd)) then
2635
{ OldCurPos is IN selection }
2636
if (CP.Y=SelEnd.Y) then
2638
if ((SelStart.Y<>SelEnd.Y) or (SelStart.X<=CP.X)) and
2639
(CP.X<=SelEnd.X) then
2640
Inc(SelEnd.X,DeltaX);
2642
else if (CP.Y=SelEnd.Y+DeltaY) then
2643
Inc(SelEnd.X,DeltaX);
2644
Inc(SelEnd.Y,DeltaY);
2648
if (PosToOfsP(CP)<=PosToOfsP(SelStart)) then
2650
{ OldCurPos is BEFORE selection }
2651
if (CP.Y=SelStart.Y) and (CP.Y=SelEnd.Y) and (DeltaY<0) then
2653
SelStart:=CurPos; SelEnd:=CurPos;
2656
if (CP.Y=SelStart.Y) then
2658
if CP.X<SelStart.X then
2659
Inc(SelStart.X,DeltaX);
2663
Inc(SelStart.Y,DeltaY);
2664
Inc(SelEnd.Y,DeltaY);
2666
if SelEnd.Y=CurPos.Y then Inc(SelEnd.X,DeltaX);
2671
{ OldCurPos is AFTER selection }
2672
{ actually we don't have to do anything here }
2676
function TCustomCodeEditor.GetFlags: longint;
2682
procedure TCustomCodeEditor.SetFlags(AFlags: longint);
2687
function TCustomCodeEditor.GetModified: boolean;
2693
procedure TCustomCodeEditor.SetModified(AModified: boolean);
2698
function TCustomCodeEditor.GetStoreUndo: boolean;
2701
GetStoreUndo:=false;
2704
procedure TCustomCodeEditor.SetStoreUndo(AStore: boolean);
2709
function TCustomCodeEditor.GetSyntaxCompleted: boolean;
2712
GetSyntaxCompleted:=true;
2715
procedure TCustomCodeEditor.SetSyntaxCompleted(SC : boolean);
2720
function TCustomCodeEditor.GetLastSyntaxedLine: sw_integer;
2723
GetLastSyntaxedLine:=0;
2726
procedure TCustomCodeEditor.SetLastSyntaxedLine(ALine: sw_integer);
2731
function TCustomCodeEditor.IsFlagSet(AFlag: longint): boolean;{$ifdef USEINLINE}inline;{$endif}
2733
IsFlagSet:=(GetFlags and AFlag)=AFlag;
2736
function TCustomCodeEditor.GetTabSize: integer;
2742
procedure TCustomCodeEditor.SetTabSize(ATabSize: integer);
2747
function TCustomCodeEditor.GetIndentSize: integer;
2753
procedure TCustomCodeEditor.SetIndentSize(AIndentSize: integer);
2758
function TCustomCodeEditor.IsReadOnly: boolean;
2764
function TCustomCodeEditor.IsClipboard: Boolean;
2770
function TCustomCodeEditor.GetLineCount: sw_integer;
2776
function TCustomCodeEditor.GetLine(LineNo: sw_integer): PCustomLine;
2782
function TCustomCodeEditor.CharIdxToLinePos(Line,CharIdx: sw_integer): sw_integer;
2785
CharIdxToLinePos:=0;
2788
function TCustomCodeEditor.LinePosToCharIdx(Line,X: sw_integer): sw_integer;
2791
LinePosToCharIdx:=0;
2794
function TCustomCodeEditor.GetLineText(I: sw_integer): string;
2800
procedure TCustomCodeEditor.SetDisplayText(I: sw_integer;const S: string);
2805
function TCustomCodeEditor.GetDisplayText(I: sw_integer): string;
2811
procedure TCustomCodeEditor.SetLineText(I: sw_integer;const S: string);
2816
procedure TCustomCodeEditor.GetDisplayTextFormat(I: sw_integer;var DT,DF:string);
2821
function TCustomCodeEditor.GetLineFormat(I: sw_integer): string;
2827
procedure TCustomCodeEditor.SetLineFormat(I: sw_integer;const S: string);
2832
procedure TCustomCodeEditor.DeleteAllLines;
2837
procedure TCustomCodeEditor.DeleteLine(I: sw_integer);
2842
function TCustomCodeEditor.InsertLine(LineNo: sw_integer; const S: string): PCustomLine;
2845
InsertLine:=nil; { eliminate compiler warning }
2848
procedure TCustomCodeEditor.AddLine(const S: string);
2853
function TCustomCodeEditor.GetErrorMessage: string;
2856
GetErrorMessage:='';
2859
procedure TCustomCodeEditor.SetErrorMessage(const S: string);
2864
procedure TCustomCodeEditor.GetContent(ALines: PUnsortedStringCollection);
2869
procedure TCustomCodeEditor.SetContent(ALines: PUnsortedStringCollection);
2874
function TCustomCodeEditor.LoadFromStream(Stream: PFastBufStream): boolean;
2877
LoadFromStream:=false;
2880
function TCustomCodeEditor.SaveToStream(Stream: PStream): boolean;
2884
B.Y:=GetLineCount-1;
2885
if GetLineCount>0 then
2886
B.X:=length(GetDisplayText(B.Y))
2889
SaveToStream:=SaveAreaToStream(Stream,A,B);
2892
function TCustomCodeEditor.SaveAreaToStream(Stream: PStream; StartP,EndP: TPoint): boolean;
2895
SaveAreaToStream:=false;
2898
function TCustomCodeEditor.LoadFromFile(const AFileName: string): boolean;
2899
var S: PFastBufStream;
2902
New(S, Init(AFileName,stOpenRead,EditorTextBufSize));
2904
{$ifdef TEST_PARTIAL_SYNTAX}
2905
SetSyntaxCompleted(false);
2907
EventMask:=EventMask or evIdle;
2908
{$endif TEST_PARTIAL_SYNTAX}
2909
if OK then OK:=LoadFromStream(S);
2910
if Assigned(S) then Dispose(S, Done);
2914
function TCustomCodeEditor.SaveToFile(const AFileName: string): boolean;
2918
New(S, Init(AFileName,stCreate,EditorTextBufSize));
2919
OK:=Assigned(S) and (S^.Status=stOK);
2920
if OK then OK:=SaveToStream(S);
2921
if Assigned(S) then Dispose(S, Done);
2926
function TCustomCodeEditor.InsertFrom(Editor: PCustomCodeEditor): Boolean;
2928
CP,RX,RSX,LineDelta,LineCount: Sw_integer;
2929
StartPos,DestPos,BPos,EPos: TPoint;
2930
LineStartX,LineEndX: Sw_integer;
2931
TabSize,CharIdxStart,CharIdxEnd: Sw_integer;
2932
S,DS,BeforeS,OrigS,AfterS: string;
2933
VerticalBlock: boolean;
2936
if Editor^.IsFlagSet(efVerticalBlocks) then
2943
{ every data in the clipboard gets a new line }
2944
if (Clipboard=@Self) and (CurPos.X>0) then
2947
OK:=(Editor^.SelStart.X<>Editor^.SelEnd.X) or (Editor^.SelStart.Y<>Editor^.SelEnd.Y);
2950
StartPos:=CurPos; DestPos:=CurPos;
2952
VerticalBlock:=Editor^.IsFlagSet(efVerticalBlocks);
2953
LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
2954
OK:=GetLineCount<MaxLineCount;
2955
OrigS:=GetLineText(DestPos.Y);
2956
BeforeS:=Copy(OrigS,1,LinePosToCharIdx(DestPos.Y,DestPos.X-1));
2957
{ we might need to add some spaces here,
2959
TabSize:=GetTabSize;
2961
while (CP<=length(BeforeS)) do
2963
if (BeforeS[CP]=TAB) then
2964
Inc(RX,TabSize-(RX mod TabSize))
2969
BeforeS:=BeforeS+CharStr(' ',DestPos.X-RX);
2970
AfterS:=Copy(OrigS,LinePosToCharIdx(DestPos.Y,DestPos.X),High(OrigS));
2972
while OK and (LineDelta<LineCount) do
2974
if (LineDelta>0) and (VerticalBlock=false) then
2976
InsertLine(DestPos.Y,'');
2977
EPOS.X:=0;EPos.Y:=DestPos.Y;
2978
AddAction(eaInsertLine,BPos,EPos,'',GetFlags);
2984
if (LineDelta=0) or VerticalBlock then
2985
LineStartX:=Editor^.SelStart.X
2989
if (LineDelta=LineCount-1) or VerticalBlock then
2990
LineEndX:=Editor^.SelEnd.X-1
2994
CharIdxStart:=Editor^.LinePosToCharIdx(Editor^.SelStart.Y+LineDelta,LineStartX);
2995
CharIdxEnd:=Editor^.LinePosToCharIdx(Editor^.SelStart.Y+LineDelta,LineEndX);
2996
if LineEndX<LineStartX then
2998
else if VerticalBlock then
2999
S:=RExpand(copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),CharIdxStart,CharIdxEnd-CharIdxStart+1),
3000
Min(CharIdxEnd-CharIdxStart+1,High(S)))
3002
S:=copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),CharIdxStart,CharIdxEnd-CharIdxStart+1);
3003
if VerticalBlock=false then
3008
while (CP<=length(DS)) do
3010
if (DS[CP]=TAB) then
3011
Inc(RX,TabSize-(RX mod TabSize))
3014
if CP=length(BeforeS) then
3019
if LineDelta=LineCount-1 then
3021
SetLineText(DestPos.Y,DS+AfterS);
3022
BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
3023
EPOS.X:=DestPos.X+RX-RSX;EPos.Y:=DestPos.Y;
3024
AddAction(eaInsertText,BPos,EPos,S,GetFlags);
3028
SetLineText(DestPos.Y,DS);
3029
BPos.X:=DestPos.X;BPos.Y:=DestPos.Y;
3030
EPOS.X:=DestPos.X+RX-RSX;EPos.Y:=DestPos.Y;
3031
AddAction(eaInsertText,BPos,EPos,S,GetFlags);
3034
if LineDelta=LineCount-1 then
3037
SEnd.X:=DestPos.X+RX-RSX;
3045
else { if VerticalBlock=false then .. else }
3047
{ this is not yet implemented !! PM }
3048
S:=RExpand(S,LineEndX-LineStartX+1);
3051
OK:=GetLineCount<MaxLineCount;
3053
if not OK then EditorDialog(edTooManyLines,nil);
3054
{ mainly to force eaMove insertion }
3055
if not IsClipboard then
3056
SetCurPtr(EPos.X,EPos.Y);
3057
SetCurPtr(StartPos.X,StartPos.Y);
3058
UpdateAttrs(StartPos.Y,attrAll);
3061
SetSelection(CurPos,SEnd);
3064
Inc(DestPos.X,length(S));
3065
SetCurPtr(DestPos.X,DestPos.Y);
3073
function TCustomCodeEditor.InsertText(const S: string): Boolean;
3080
HoldUndo:=GetStoreUndo;
3081
SetStoreUndo(false);
3082
for I:=1 to length(S) do
3085
SetStoreUndo(HoldUndo);
3086
AddAction(eaInsertText,OldPos,CurPos,S,GetFlags);
3090
procedure TCustomCodeEditor.ModifiedChanged;
3095
procedure TCustomCodeEditor.PositionChanged;
3100
procedure TCustomCodeEditor.TabSizeChanged;
3105
procedure TCustomCodeEditor.SyntaxStateChanged;
3110
procedure TCustomCodeEditor.StoreUndoChanged;
3115
function TCustomCodeEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
3118
GetSpecSymbolCount:=0;
3121
function TCustomCodeEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
3127
function TCustomCodeEditor.IsReservedWord(const S: string): boolean;
3130
IsReservedWord:=false;
3133
function TCustomCodeEditor.IsAsmReservedWord(const S: string): boolean;
3136
IsAsmReservedWord:=false;
3139
function TCustomCodeEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
3142
TranslateCodeTemplate:=false;
3145
function TCustomCodeEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
3149
CompleteCodeWord:=false;
3152
function TCustomCodeEditor.GetCodeCompleteWord: string;
3155
GetCodeCompleteWord:='';
3158
function TCustomCodeEditor.CreateFold(StartY,EndY: sw_integer; Collapsed: boolean): boolean;
3159
var F,ParentF: PFold;
3161
EI: PEditorLineInfo;
3167
for Y:=StartY to EndY do
3171
EI:=L^.GetEditorInfo(@Self)
3180
OK:=OK and (EI^.Fold=ParentF);
3186
New(F, Init(@Self,ParentF,Collapsed));
3187
for Y:=StartY to EndY do
3188
GetLine(Y)^.GetEditorInfo(@Self)^.SetFold(F);
3195
procedure TCustomCodeEditor.FoldChanged(Fold: PFold);
3199
for I:=0 to GetFoldCount-1 do
3202
if F^.ParentFold=Fold then
3205
if Fold^.IsCollapsed then
3207
F:=GetLineFold(CurPos.Y); I:=CurPos.Y;
3210
while GetLineFold(I-1)=Fold do
3213
SetCurPtr(CurPos.X,I);
3219
procedure TCustomCodeEditor.RemoveAllFolds;
3224
for I:=0 to GetLineCount-1 do
3227
if not assigned(L) then exit;
3229
with GetEditorInfo(@Self)^ do
3235
{ to be called if CurPos has already been changed }
3237
procedure TCustomCodeEditor.AdjustSelection(DeltaX, DeltaY: sw_integer);
3239
AdjustSelectionPos(CurPos.X-DeltaX,CurPos.Y-DeltaY,DeltaX,DeltaY);
3242
{ to be called if CurPos has not yet been changed }
3244
procedure TCustomCodeEditor.AdjustSelectionBefore(DeltaX, DeltaY: sw_integer);
3246
AdjustSelectionPos(CurPos.X,CurPos.Y,DeltaX,DeltaY);
3249
procedure TCustomCodeEditor.TrackCursor(centre:Tcentre);
3253
EditorToViewPoint(D,D); EditorToViewPoint(CurPos,CP);
3254
if CP.Y<Delta.Y then D.Y:=CP.Y else
3255
if CP.Y>Delta.Y+Size.Y-1 then D.Y:=CP.Y-Size.Y+1;
3256
if CP.X<Delta.X then D.X:=CP.X else
3257
if CP.X>Delta.X+Size.X-1 then D.X:=CP.X-Size.X+1;
3258
if {((Delta.X<>D.X) or (Delta.Y<>D.Y)) and }centre=do_centre then
3260
{ loose centering for debugger PM }
3261
while (CP.Y-D.Y)<(Size.Y div 3) do Dec(D.Y);
3262
while (CP.Y-D.Y)>2*(Size.Y div 3) do Inc(D.Y);
3264
ViewToEditorPoint(D,D);
3265
if (Delta.X<>D.X) or (Delta.Y<>D.Y) then
3270
procedure TCustomCodeEditor.ScrollTo(X, Y: sw_Integer);
3272
inherited ScrollTo(X,Y);
3273
if (HScrollBar=nil) or (VScrollBar=nil) then
3274
begin Delta.X:=X; Delta.Y:=Y; end;
3278
function TCustomCodeEditor.IsModal: boolean;
3281
IsM:=GetState(sfModal);
3282
if Assigned(Owner) then
3283
IsM:=IsM or Owner^.GetState(sfModal);
3287
procedure TCustomCodeEditor.FlagsChanged(OldFlags: longint);
3291
if ((OldFlags xor GetFlags) and efCodeComplete)<>0 then
3292
ClearCodeCompleteWord;
3293
SetInsertMode(IsFlagSet(efInsertMode));
3294
if ((OldFlags xor GetFlags) and efFolds)<>0 then
3295
if not IsFlagSet(efFolds) then
3297
if IsFlagSet(efSyntaxHighlight) then
3298
UpdateAttrs(0,attrAll) else
3299
for I:=0 to GetLineCount-1 do
3300
SetLineFormat(I,'');
3305
procedure TCustomCodeEditor.LimitsChanged;
3310
procedure TCustomCodeEditor.DoLimitsChanged;
3312
SetLimit(MaxLineLength+1,EditorToViewLine(GetLineCount));
3315
procedure TCustomCodeEditor.BindingsChanged;
3320
procedure TCustomCodeEditor.ContentsChanged;
3325
procedure TCustomCodeEditor.ConvertEvent(var Event: TEvent);
3329
if Event.What = evKeyDown then
3331
if (Event.KeyShift and kbShift <> 0) and
3332
(Event.ScanCode >= $47) and (Event.ScanCode <= $51) then
3333
Event.CharCode := #0;
3334
Key := Event.KeyCode;
3335
if KeyState <> 0 then
3337
if (Lo(Key) >= $01) and (Lo(Key) <= $1A) then Inc(Key, $40);
3338
if (Lo(Key) >= $61) and (Lo(Key) <= $7A) then Dec(Key, $20);
3340
Key := ScanKeyMap(KeyMap[KeyState], Key);
3341
if (KeyState<>0) and (Key=0) then
3342
ClearEvent(Event); { eat second key if unrecognized after ^Q or ^K }
3345
if Hi(Key) = $FF then
3347
KeyState := Lo(Key);
3352
Event.What := evCommand;
3353
Event.Command := Key;
3358
procedure TCustomCodeEditor.SetLineFlagState(LineNo: sw_integer; Flags: longint; ASet: boolean);
3361
{ Avoid crashes if file was shorten for instance }
3362
if LineNo>=GetLineCount then
3368
SetFlags(GetFlags or Flags)
3370
SetFlags(GetFlags and not Flags);
3373
procedure TCustomCodeEditor.SetLineFlagExclusive(Flags: longint; LineNo: sw_integer);
3374
var I,Count: sw_integer;
3378
Count:=GetLineCount;
3379
for I:=0 to Count-1 do
3382
if not assigned(L) then break;
3384
L^.SetFlags(L^.GetFlags or Flags)
3386
L^.SetFlags(L^.GetFlags and (not Flags));
3391
procedure TCustomCodeEditor.HandleEvent(var Event: TEvent);
3392
var DontClear : boolean;
3394
procedure CheckScrollBar(P: PScrollBar; var D: Sw_Integer);
3396
if (Event.InfoPtr = P) and (P^.Value <> D) then
3403
procedure GetMousePos(var P: TPoint);
3405
MakeLocal(Event.Where,P);
3406
Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
3407
Dec(P.X,GetReservedColCount);
3408
if P.X<0 then P.X:=0;
3409
if P.Y<0 then P.Y:=0;
3411
type TCCAction = (ccCheck,ccClear,ccDontCare);
3416
CCAction: TCCAction;
3421
if (E.What and (evMouse or evKeyboard))<>0 then
3423
if (InASCIIMode=false) or (Event.What<>evKeyDown) then
3424
if (Event.What<>evKeyDown) or (Event.KeyCode<>kbEnter) or (IsReadOnly=false) then
3425
if (Event.What<>evKeyDown) or
3426
((Event.KeyCode<>kbEnter) and (Event.KeyCode<>kbEsc)) or
3427
(GetCompleteState<>csOffering) then
3428
ConvertEvent(Event);
3431
if MouseInView(Event.Where) then
3432
if (Event.Buttons=mbRightButton) then
3434
MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
3438
if Event.Buttons=mbLeftButton then
3445
if PointOfs(P)<PointOfs(StartP)
3446
then SetSelection(P,StartP)
3447
else SetSelection(StartP,P);
3450
until not MouseEvent(Event, evMouseMove+evMouseAuto);
3455
{ Scancode is almost never zero PM }
3456
{ this is supposed to enable entering of ASCII chars below 32,
3457
which are normally interpreted as control chars. So, when you enter
3458
Alt+24 (on the numeric pad) then this will normally move the cursor
3459
one line down, but if you do it in ASCII mode (also after Ctrl+B)
3460
then this will insert the ASCII #24 char (upper arrow) in the
3461
source code. - Gabor }
3462
if InASCIIMode {and (Event.CharCode<>0)} then
3464
AddChar(Event.CharCode);
3465
if (GetCompleteState<>csDenied) or (Event.CharCode=#32) then
3473
case Event.KeyCode of
3475
Message(@Self,evCommand,cmLocalMenu,@Self);
3478
DontClear:=true else
3479
if GetCompleteState=csOffering then
3482
Message(@Self,evCommand,cmNewLine,nil);
3484
if GetCompleteState=csOffering then
3485
CodeCompleteCancel else
3489
case Event.CharCode of
3491
if (Event.CharCode=#9) and IsModal then
3496
AddChar(Event.CharCode);
3498
if (GetCompleteState<>csDenied) or (Event.CharCode=#32) then
3505
end; { case Event.CharCode .. }
3506
end; { case Event.KeyCode .. }
3507
if not DontClear then
3515
case Event.Command of
3516
cmASCIIChar : InASCIIMode:=not InASCIIMode;
3517
cmAddChar : AddChar(chr(longint(Event.InfoPtr)));
3518
cmCharLeft : CharLeft;
3519
cmCharRight : CharRight;
3520
cmWordLeft : WordLeft;
3521
cmWordRight : WordRight;
3522
cmLineStart : LineStart;
3523
cmLineEnd : LineEnd;
3525
cmLineDown : LineDown;
3527
cmPageDown : PageDown;
3528
cmTextStart : TextStart;
3529
cmTextEnd : TextEnd;
3530
cmWindowStart : WindowStart;
3531
cmWindowEnd : WindowEnd;
3534
TrackCursor(do_not_centre);
3536
cmBreakLine : BreakLine;
3537
cmBackSpace : BackSpace;
3538
cmDelChar : DelChar;
3539
cmDelWord : DelWord;
3540
cmDelToEndOfWord : DelToEndOfWord;
3541
cmDelStart : DelStart;
3543
cmDelLine : DelLine;
3544
cmInsMode : InsMode;
3545
cmStartSelect : StartSelect;
3546
cmHideSelect : HideSelect;
3548
cmEndSelect : EndSelect;
3549
cmDelSelect : DelSelect;
3550
cmCopyBlock : CopyBlock;
3551
cmMoveBlock : MoveBlock;
3552
cmIndentBlock : IndentBlock;
3553
cmUnindentBlock : UnindentBlock;
3554
cmSelStart : JumpSelStart;
3555
cmSelEnd : JumpSelEnd;
3556
cmLastCursorPos : JumpToLastCursorPos;
3557
cmFindMatchingDelimiter : FindMatchingDelimiter(true);
3558
cmFindMatchingDelimiterBack : FindMatchingDelimiter(false);
3559
cmUpperCase : UpperCase;
3560
cmLowerCase : LowerCase;
3561
cmWordLowerCase : WordLowerCase;
3562
cmWordUpperCase : WordUpperCase;
3563
cmInsertOptions : InsertOptions;
3564
cmToggleCase : ToggleCase;
3565
cmCreateFold : CreateFoldFromBlock;
3566
cmToggleFold : ToggleFold;
3567
cmExpandFold : ExpandFold;
3568
cmCollapseFold : CollapseFold;
3569
cmJumpMark0..cmJumpMark9 : JumpMark(Event.Command-cmJumpMark0);
3570
cmSetMark0..cmSetMark9 : DefineMark(Event.Command-cmSetMark0);
3571
cmSelectWord : SelectWord;
3572
cmSelectLine : SelectLine;
3573
cmWriteBlock : WriteBlock;
3574
cmReadBlock : ReadBlock;
3575
cmPrintBlock : PrintBlock;
3578
cmReplace : Replace;
3579
cmSearchAgain : DoSearchReplace;
3580
cmJumpLine : GotoLine;
3584
cmPaste : ClipPaste;
3586
cmSelectAll : SelectAll(true);
3587
cmUnselect : SelectAll(false);
3588
{$ifdef WinClipSupported}
3589
cmCopyWin : ClipCopyWin;
3590
cmPasteWin : ClipPasteWin;
3591
{$endif WinClipSupported}
3594
cmClear : DelSelect;
3595
cmExpandCodeTemplate: ExpandCodeTemplate;
3598
P:=CurPos; Inc(P.X); Inc(P.Y);
3602
Message(Application,evCommand,cmMenu,nil);
3606
CCAction:=ccDontCare;
3609
if DontClear=false then
3612
{$ifdef TEST_PARTIAL_SYNTAX}
3615
CCAction:=ccDontCare;
3616
{ Complete syntax by 20 lines increment }
3617
{ could already be quite lengthy on slow systems }
3618
if not GetSyntaxCompleted then
3619
UpdateAttrsRange(GetLastSyntaxedLine,GetLastSyntaxedLine+20,AttrAll);
3621
{$endif TEST_PARTIAL_SYNTAX}
3624
CCAction:=ccDontCare;
3625
case Event.Command of
3628
cmClearLineHighlights :
3629
SetLineFlagExclusive(lfHighlightRow,-1);
3630
cmResetDebuggerRow :
3631
SetLineFlagExclusive(lfDebuggerRow,-1);
3633
if (Event.InfoPtr = HScrollBar) or
3634
(Event.InfoPtr = VScrollBar) then
3636
CheckScrollBar(HScrollBar, Delta.X);
3637
CheckScrollBar(VScrollBar, Delta.Y);
3641
else CCAction:=ccDontCare;
3643
inherited HandleEvent(Event);
3646
ccCheck : CodeCompleteCheck;
3647
ccClear : ClearCodeCompleteWord;
3651
procedure TCustomCodeEditor.UpdateUndoRedo(cm : word; action : byte);
3652
var UndoMenu : PMenuItem;
3654
UndoMenu:=PAdvancedMenuBar(MenuBar)^.GetMenuItem(cm);
3655
if assigned(UndoMenu) then
3657
If assigned(UndoMenu^.Param) then
3658
DisposeStr(UndoMenu^.Param);
3659
if action<lastaction then
3660
UndoMenu^.Param:=NewStr(ActionString[action]);
3665
procedure TCustomCodeEditor.Update;
3674
function TCustomCodeEditor.GetLocalMenu: PMenu;
3679
function TCustomCodeEditor.GetCommandTarget: PView;
3681
GetCommandTarget:=@Self;
3684
function TCustomCodeEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
3687
New(MV, Init(Bounds, M));
3688
CreateLocalMenuView:=MV;
3691
procedure TCustomCodeEditor.LocalMenu(P: TPoint);
3699
if LastLocalCmd<>0 then
3700
M^.Default:=SearchMenuItem(M,LastLocalCmd);
3701
Desktop^.GetExtent(R);
3702
MakeGlobal(P,R.A); {Desktop^.MakeLocal(R.A,R.A);}
3703
MV:=CreateLocalMenuView(R,M);
3704
Re:=Application^.ExecView(MV);
3705
if M^.Default=nil then LastLocalCmd:=0
3706
else LastLocalCmd:=M^.Default^.Command;
3709
Message(GetCommandTarget,evCommand,Re,@Self);
3712
function TCustomCodeEditor.GetReservedColCount: sw_integer;
3713
var LSX: sw_integer;
3715
if IsFlagSet(efFolds) then LSX:=GetFoldStringWidth else LSX:=0;
3716
GetReservedColCount:=LSX;
3719
procedure TCustomCodeEditor.Draw;
3720
function GetEIFold(EI: PEditorLineInfo): PFold;
3722
if Assigned(EI) then GetEIFold:=EI^.Fold else GetEIFold:=nil;
3727
ErrorMessageColor : word;
3729
X,Y,AX,AY,MaxX,LSX: sw_integer;
3731
LineCount: sw_integer;
3733
LineText,Format: string;
3736
FreeFormat: array[0..MaxLineLength] of boolean;
3738
ColorTab: array[coFirstColor..coLastColor] of word;
3740
ErrorMsg: string[MaxViewWidth];
3741
function CombineColors(Orig,Modifier: byte): byte;
3744
if (Modifier and $0f)=0 then
3745
Color:=(Orig and $0f) or (Modifier and $f0)
3747
Color:=(Orig and $f0) or (Modifier and $0f);
3748
{ do not allow invisible }
3749
{ use white as foreground in this case }
3750
if (Color and $f) = ((Color div $10) and $7) then
3751
Color:=(Color and $F0) or $F;
3752
CombineColors:=Color;
3755
FoldPrefix,FoldSuffix: string;
3756
{ SkipLine: boolean;}
3757
{ FoldStartLine: sw_integer;}
3766
ErrorMsg:=copy(GetErrorMessage,1,MaxViewWidth);
3767
if ErrorMsg='' then ErrorLine:=-1 else
3768
if (CurPos.Y-Delta.Y)<(Size.Y div 2) then ErrorLine:=Size.Y-1
3770
LineCount:=GetLineCount;
3771
ColorTab[coTextColor]:=GetColor(1);
3772
ColorTab[coWhiteSpaceColor]:=GetColor(2);
3773
ColorTab[coCommentColor]:=GetColor(3);
3774
ColorTab[coReservedWordColor]:=GetColor(4);
3775
ColorTab[coIdentifierColor]:=GetColor(5);
3776
ColorTab[coStringColor]:=GetColor(6);
3777
ColorTab[coNumberColor]:=GetColor(7);
3778
ColorTab[coAssemblerColor]:=GetColor(8);
3779
ColorTab[coSymbolColor]:=GetColor(9);
3780
ColorTab[coDirectiveColor]:=GetColor(13);
3781
ColorTab[coHexNumberColor]:=GetColor(14);
3782
ColorTab[coTabColor]:=GetColor(15);
3783
{ break same as error }
3784
ColorTab[coBreakColor]:=GetColor(16);
3785
ColorTab[coAsmReservedColor]:=GetColor(17);
3786
SelectColor:=GetColor(10);
3787
HighlightColColor:=GetColor(11);
3788
HighlightRowColor:=GetColor(12);
3789
ErrorMessageColor:=GetColor(16);
3790
{$ifdef TEST_PARTIAL_SYNTAX}
3791
If (not GetSyntaxCompleted) and (GetLastSyntaxedLine<Delta.Y+Size.Y) then
3792
UpdateAttrsRange(GetLastSyntaxedLine,Delta.Y+Size.Y,AttrAll);
3793
{$endif TEST_PARTIAL_SYNTAX}
3794
LSX:=GetReservedColCount;
3796
for Y:=0 to Size.Y-1 do
3800
MoveChar(B,' ',ErrorMessageColor,Size.X);
3801
MoveStr(B,ErrorMsg,ErrorMessageColor);
3802
WriteLine(0,Y,Size.X,1,B);
3806
AY:=ViewToEditorLine(Delta.Y+Y);
3807
if (0<=AY) and (AY<LineCount) then
3810
if assigned(Line) then
3812
IsBreak:=Line^.IsFlagSet(lfBreakpoint);
3826
Color:=ColorTab[coTextColor];
3827
FillChar(FreeFormat,SizeOf(FreeFormat),1);
3828
MoveChar(B,' ',Color,Size.X);
3829
GetDisplayTextFormat(AY,LineText,Format);
3831
{ if FlagSet(efSyntaxHighlight) then MaxX:=length(LineText)+1
3832
else }MaxX:=Size.X+Delta.X;
3833
for X:=1 to Min(MaxX,High(LineText)) do
3836
if X<=length(LineText) then C:=LineText[X] else C:=' ';
3838
PX.X:=AX-Delta.X; PX.Y:=AY;
3839
if (Highlight.A.X<>Highlight.B.X) or (Highlight.A.Y<>Highlight.B.Y) then
3840
{ there's a highlight }
3842
if (PointOfs(Highlight.A)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(Highlight.B)) then
3845
FreeFormat[X]:=false;
3851
if IsFlagSet(efVerticalBlocks) then
3853
if (SelStart.X<=AX) and (AX<=SelEnd.X) and
3854
(SelStart.Y<=AY) and (AY<=SelEnd.Y) then
3856
Color:=SelectColor; FreeFormat[X]:=false;
3860
if PointOfs(SelStart)<>PointOfs(SelEnd) then
3861
if (PointOfs(SelStart)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(SelEnd)) then
3863
Color:=SelectColor; FreeFormat[X]:=false;
3865
end; { no highlight }
3866
if FreeFormat[X] then
3867
if X<=length(Format) then
3868
{Color:=ColorTab[ord(Format[X])] else Color:=ColorTab[coTextColor];
3869
this give BoundsCheckError with -Cr quite often PM }
3870
Color:=ColorTab[ord(Format[X]) mod (coLastColor + 1)] else Color:=ColorTab[coTextColor];
3872
if IsFlagSet(efHighlightRow) and
3873
(PX.Y=CurPos.Y) then
3875
Color:=CombineColors(Color,HighlightRowColor);
3876
FreeFormat[X]:=false;
3878
if IsFlagSet(efHighlightColumn) and (PX.X=CurPos.X) then
3880
Color:=CombineColors(Color,HighlightColColor);
3881
FreeFormat[X]:=false;
3884
if Assigned(Line) and Line^.IsFlagSet(lfHighlightRow) then
3886
Color:=CombineColors(Color,HighlightRowColor);
3887
FreeFormat[X]:=false;
3891
Color:=ColorTab[coBreakColor];
3892
FreeFormat[X]:=false;
3894
if Assigned(Line) and Line^.isFlagSet(lfDebuggerRow) then
3896
Color:=CombineColors(Color,HighlightRowColor);
3897
FreeFormat[X]:=false;
3900
if (0<=LSX+X-1-Delta.X) and (LSX+X-1-Delta.X<MaxViewWidth) then
3901
MoveChar(B[LSX+X-1-Delta.X],C,Color,1);
3902
end; { for X:=1 to ... }
3903
if IsFlagSet(efFolds) then
3905
GetFoldStrings(AY,FoldPrefix,FoldSuffix);
3906
MoveStr(B[0],FoldPrefix,ColorTab[coTextColor]);
3907
if FoldSuffix<>'' then
3908
MoveStr(B[Size.X-1-length(FoldSuffix)],FoldSuffix,ColorTab[coTextColor]);
3910
WriteLine(0,Y,Size.X,1,B);
3911
end; { if not SkipLine ... }
3912
end; { not errorline }
3913
end; { while (Y<Size.Y) ... }
3917
procedure TCustomCodeEditor.DrawCursor;
3920
DrawCursorCalled:=true
3923
SetCursor(GetReservedColCount+CurPos.X-Delta.X,EditorToViewLine(CurPos.Y)-Delta.Y);
3924
SetState(sfCursorIns,Overwrite);
3928
procedure TCustomCodeEditor.ResetCursor;
3932
DrawCursorCalled:=true;
3936
inherited ResetCursor;
3939
function TCustomCodeEditor.Overwrite: boolean;
3941
Overwrite:=not IsFlagSet(efInsertMode);
3944
procedure TCustomCodeEditor.SetCodeCompleteWord(const S: string);
3947
SetCompleteState(csOffering)
3949
SetCompleteState(csInactive);
3952
procedure TCustomCodeEditor.ClearCodeCompleteWord;
3954
SetCodeCompleteWord('');
3955
SetCompleteState(csInactive);
3958
function TCustomCodeEditor.GetCompleteState: TCompleteState;
3961
GetCompleteState:=csInactive;
3964
procedure TCustomCodeEditor.SetCompleteState(AState: TCompleteState);
3969
function TCustomCodeEditor.UpdateAttrs(FromLine: sw_integer; Attrs: byte): sw_integer;
3975
function TCustomCodeEditor.UpdateAttrsRange(FromLine, ToLine: sw_integer; Attrs: byte): sw_integer;
3978
UpdateAttrsRange:=-1;
3981
procedure TCustomCodeEditor.AddAction(AAction: byte; AStartPos, AEndPos: TPoint; AText: string;AFlags : longint);
3986
procedure TCustomCodeEditor.AddGroupedAction(AAction : byte);
3991
procedure TCustomCodeEditor.CloseGroupedAction(AAction : byte);
3996
function TCustomCodeEditor.GetUndoActionCount: sw_integer;
3999
GetUndoActionCount:=0;
4002
function TCustomCodeEditor.GetRedoActionCount: sw_integer;
4005
GetRedoActionCount:=0;
4008
function TCustomCodeEditor.GetMaxFoldLevel: sw_integer;
4009
var Max,L,I: sw_integer;
4012
for I:=0 to GetFoldCount-1 do
4014
L:=GetFold(I)^.GetLevel;
4015
if L>Max then Max:=L;
4017
GetMaxFoldLevel:=Max;
4020
function TCustomCodeEditor.GetFoldStringWidth: sw_integer;
4022
GetFoldStringWidth:=GetMaxFoldLevel;
4025
procedure TCustomCodeEditor.GetFoldStrings(EditorLine: sw_integer; var Prefix, Suffix: openstring);
4029
Prefix:=CharStr(' ',GetFoldStringWidth); Suffix:='';
4030
F:=GetLineFold(EditorLine);
4033
if F^.Collapsed_ then C:=#27 else C:=#26;
4034
Prefix[1+F^.GetLevel]:=C;
4035
if F^.Collapsed_ then
4036
Suffix:='('+IntToStr(F^.GetLineCount)+')';
4040
function TCustomCodeEditor.GetFoldCount: sw_integer;
4045
function TCustomCodeEditor.GetFold(Index: sw_integer): PFold;
4050
procedure TCustomCodeEditor.RegisterFold(AFold: PFold);
4055
procedure TCustomCodeEditor.UnRegisterFold(AFold: PFold);
4060
procedure TCustomCodeEditor.Indent;
4061
var S, PreS: string;
4064
S:=GetLineText(CurPos.Y);
4066
PreS:=RTrim(GetLineText(CurPos.Y-1),not IsFlagSet(efUseTabCharacters))
4069
if CurPos.X>=length(PreS) then
4074
while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>' ') do
4077
SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,High(S)));
4078
SetCurPtr(CurPos.X+Shift,CurPos.Y);
4079
UpdateAttrs(CurPos.Y,attrAll);
4080
DrawLines(CurPos.Y);
4084
procedure TCustomCodeEditor.CharLeft;
4086
if CurPos.X=0 then Exit;
4088
SetCurPtr(CurPos.X-1,CurPos.Y);
4091
procedure TCustomCodeEditor.CharRight;
4093
if CurPos.X>=MaxLineLength then
4095
SetCurPtr(CurPos.X+1,CurPos.Y);
4098
procedure TCustomCodeEditor.WordLeft;
4099
var X, Y: sw_integer;
4101
GotIt,FoundNonSeparator: boolean;
4106
FoundNonSeparator:=false;
4111
X:=length(GetDisplayText(Y));
4113
X:=CurPos.X; Dec(X);
4118
X:=length(GetDisplayText(Y));
4123
X:=length(GetDisplayText(Y))-1;
4124
Line:=GetDisplayText(Y);
4125
while (X>=0) and (GotIt=false) do
4127
if FoundNonSeparator then
4129
if IsWordSeparator(Line[X+1]) then
4137
if not IsWordSeparator(Line[X+1]) then
4138
FoundNonSeparator:=true;
4140
if (X=0) and (IsWordSeparator(Line[1])=false) then
4152
X:=length(GetDisplayText(Y));
4156
if Y<0 then Y:=0; if X<0 then X:=0;
4160
procedure TCustomCodeEditor.WordRight;
4161
var X, Y: sw_integer;
4165
X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
4166
while (Y<GetLineCount) do
4170
X:=CurPos.X; Inc(X);
4171
if (X>length(GetDisplayText(Y))-1) then
4172
begin Inc(Y); X:=0; end;
4174
Line:=GetDisplayText(Y);
4175
while (X<=length(Line)+1) and (GotIt=false) and (Line<>'') do
4177
if X=length(Line)+1 then begin GotIt:=true; Dec(X); Break end;
4178
if IsWordSeparator(Line[X]) then
4180
while (Y<GetLineCount) and
4181
(X<=length(Line)) and (IsWordSeparator(Line[X])) do
4184
if X>=length(Line) then
4185
begin GotIt:=true; Dec(X); Break; end;
4187
if (GotIt=false) and (X<length(Line)) then
4196
if GotIt then Break;
4199
if (Y<GetLineCount) then
4201
Line:=GetDisplayText(Y);
4202
if (Line<>'') and (IsWordSeparator(Line[1])=false) then Break;
4205
if Y=GetLineCount then Y:=GetLineCount-1;
4209
procedure TCustomCodeEditor.LineStart;
4211
SetCurPtr(0,CurPos.Y);
4214
procedure TCustomCodeEditor.LineEnd;
4219
if CurPos.Y<GetLineCount then
4221
s:=GetDisplayText(CurPos.Y);
4223
while (i>0) and (s[i]=' ') do
4225
SetCurPtr(i,CurPos.Y);
4228
SetCurPtr(0,CurPos.Y);
4231
function TCustomCodeEditor.NextVisibleLine(StartLine: sw_integer; Down: boolean): sw_integer;
4232
var Count,NL: sw_integer;
4236
Count:=GetLineCount;
4238
while (NL<Count-1) and not IsLineVisible(NL) do
4246
while (NL>0) and not IsLineVisible(NL) do
4249
if not IsLineVisible(NL) then
4251
NextVisibleLine:=NL;
4254
procedure TCustomCodeEditor.LineUp;
4257
NL:=NextVisibleLine(CurPos.Y-1,false);
4259
SetCurPtr(CurPos.X,NL);
4262
procedure TCustomCodeEditor.LineDown;
4265
NL:=NextVisibleLine(CurPos.Y+1,true);
4267
SetCurPtr(CurPos.X,NL);
4270
procedure TCustomCodeEditor.PageUp;
4273
ScrollTo(Delta.X,Max(Delta.Y-Size.Y,0));
4274
NL:=Max(CurPos.Y-(Size.Y),0);
4275
if not IsLineVisible(NL) then
4276
NL:=NextVisibleLine(NL,false);
4278
SetCurPtr(CurPos.X,Max(0,NL));
4281
procedure TCustomCodeEditor.PageDown;
4284
ScrollTo(Delta.X,Min(Delta.Y+Size.Y,GetLineCount-1));
4285
NL:=Min(CurPos.Y+(Size.Y{-1}),GetLineCount-1);
4286
if not IsLineVisible(NL) then
4287
NL:=NextVisibleLine(NL,true);
4289
SetCurPtr(CurPos.X,Min(GetLineCount-1,NL));
4292
procedure TCustomCodeEditor.TextStart;
4297
procedure TCustomCodeEditor.TextEnd;
4301
s:=GetDisplayText(GetLineCount-1);
4303
while (i>0) and (s[i]=' ') do
4305
SetCurPtr(i,GetLineCount-1);
4308
procedure TCustomCodeEditor.WindowStart;
4310
SetCurPtr(CurPos.X,Delta.Y);
4313
procedure TCustomCodeEditor.WindowEnd;
4315
SetCurPtr(CurPos.X,Delta.Y+Size.Y-1);
4318
procedure TCustomCodeEditor.JumpSelStart;
4321
SetCurPtr(SelStart.X,SelStart.Y);
4324
procedure TCustomCodeEditor.JumpSelEnd;
4327
SetCurPtr(SelEnd.X,SelEnd.Y);
4330
procedure TCustomCodeEditor.JumpMark(MarkIdx: integer);
4332
DontConsiderShiftState:=true;
4333
if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
4334
begin ErrorBox(FormatStrInt(msg_invalidmarkindex,MarkIdx),nil); Exit; end;
4336
with Bookmarks[MarkIdx] do
4338
InformationBox(FormatStrInt(msg_marknotset,MarkIdx),nil)
4340
SetCurPtr(Pos.X,Pos.Y);
4341
DontConsiderShiftState:=false;
4344
procedure TCustomCodeEditor.DefineMark(MarkIdx: integer);
4346
if (MarkIdx<Low(Bookmarks)) or (MarkIdx>High(Bookmarks)) then
4348
ErrorBox(FormatStrInt(msg_invalidmarkindex,MarkIdx),nil);
4351
with Bookmarks[MarkIdx] do
4358
procedure TCustomCodeEditor.JumpToLastCursorPos;
4363
procedure TCustomCodeEditor.UpperCase;
4364
var StartP,EndP: TPoint;
4366
if ValidBlock=false then Exit;
4367
GetSelectionArea(StartP,EndP);
4368
AddGroupedAction(eaUpperCase);
4369
ChangeCaseArea(StartP,EndP,caToUpperCase);
4370
CloseGroupedAction(eaUpperCase);
4373
procedure TCustomCodeEditor.LowerCase;
4374
var StartP,EndP: TPoint;
4376
if ValidBlock=false then Exit;
4377
GetSelectionArea(StartP,EndP);
4378
AddGroupedAction(eaLowerCase);
4379
ChangeCaseArea(StartP,EndP,caToLowerCase);
4380
CloseGroupedAction(eaLowerCase);
4383
procedure TCustomCodeEditor.ToggleCase;
4384
var StartP,EndP: TPoint;
4386
if ValidBlock=false then Exit;
4387
GetSelectionArea(StartP,EndP);
4388
AddGroupedAction(eaToggleCase);
4389
ChangeCaseArea(StartP,EndP,caToggleCase);
4390
CloseGroupedAction(eaToggleCase);
4393
procedure TCustomCodeEditor.WordLowerCase;
4394
var StartP,EndP: TPoint;
4396
if GetCurrentWordArea(StartP,EndP)=false then Exit;
4397
AddGroupedAction(eaLowerCase);
4398
ChangeCaseArea(StartP,EndP,caToLowerCase);
4399
CloseGroupedAction(eaLowerCase);
4402
procedure TCustomCodeEditor.WordUpperCase;
4403
var StartP,EndP: TPoint;
4405
if GetCurrentWordArea(StartP,EndP)=false then Exit;
4406
AddGroupedAction(eaUpperCase);
4407
ChangeCaseArea(StartP,EndP,caToUpperCase);
4408
CloseGroupedAction(eaUpperCase);
4411
procedure TCustomCodeEditor.CreateFoldFromBlock;
4412
var StartY,EndY: sw_integer;
4414
if not IsFlagSet(efFolds) then Exit;
4415
if not ValidBlock then Exit;
4416
StartY:=SelStart.Y; EndY:=SelEnd.Y;
4417
if SelEnd.X=0 then Dec(EndY);
4418
if CreateFold(StartY,EndY,false)=false then
4419
ErrorBox(msg_foldboundsarenotvalid,nil);
4422
procedure TCustomCodeEditor.ToggleFold;
4425
if not IsFlagSet(efFolds) then Exit;
4426
F:=GetLineFold(CurPos.Y);
4428
F^.Collapse(not F^.Collapsed_);
4431
procedure TCustomCodeEditor.ExpandFold;
4434
if not IsFlagSet(efFolds) then Exit;
4435
F:=GetLineFold(CurPos.Y);
4440
procedure TCustomCodeEditor.CollapseFold;
4443
if not IsFlagSet(efFolds) then Exit;
4444
F:=GetLineFold(CurPos.Y);
4449
procedure TCustomCodeEditor.ChangeCaseArea(StartP,EndP: TPoint; CaseAction: TCaseAction);
4450
var Y,X: sw_integer;
4458
HoldUndo:=GetStoreUndo;
4459
SetStoreUndo(false);
4460
for Y:=StartP.Y to EndP.Y do
4462
S:=GetDisplayText(Y);
4463
{ Pierre, please implement undo here! Gabor }
4464
X1:=0; X2:=length(S)-1;
4465
if Y=StartP.Y then X1:=StartP.X;
4466
if Y=EndP.Y then X2:=EndP.X;
4467
SetStoreUndo(HoldUndo);
4470
{ the only drawback is that we keep
4471
the original text even if Toggle where
4472
it is not really necessary PM }
4473
Addaction(eaOverwriteText,StartPos,StartPos,Copy(S,X1+1,X2-X1+1),GetFlags);
4474
SetStoreUndo(false);
4479
caToLowerCase : C:=LowCase(C);
4480
caToUpperCase : C:=UpCase(C);
4481
caToggleCase : if C in['a'..'z'] then
4488
SetDisplayText(Y,S);
4490
UpdateAttrsRange(StartP.Y,EndP.Y,attrAll);
4491
DrawLines(CurPos.Y);
4493
Addaction(eaMoveCursor,StartPos,CurPos,'',GetFlags);
4494
SetStoreUndo(HoldUndo);
4498
procedure TCustomCodeEditor.PushInfo(Const st : string);
4503
procedure TCustomCodeEditor.PopInfo;
4509
procedure TCustomCodeEditor.InsertOptions;
4515
function TCustomCodeEditor.GetLineFold(EditorLine: sw_integer): PFold;
4517
LI: PEditorLineInfo;
4521
if IsFlagSet(efFolds) then
4522
if (0<=EditorLine) and (EditorLine<GetLineCount) then
4524
L:=GetLine(EditorLine);
4526
LI:=L^.GetEditorInfo(@Self)
4529
if Assigned(LI) then
4535
function TCustomCodeEditor.IsLineVisible(EditorLine: sw_integer): boolean;
4538
FoldHeadline: boolean;
4541
if IsFlagSet(efFolds) then
4543
F:=GetLineFold(EditorLine);
4546
PrevF:=GetLineFold(EditorLine-1);
4547
FoldHeadline:=false;
4548
if (PrevF<>F) and ((PrevF=nil) or (not PrevF^.IsParent(F))) then
4550
if FoldHeadline then
4552
if Assigned(F^.ParentFold) and (F^.ParentFold^.IsCollapsed) then
4556
if F^.IsCollapsed then
4563
function TCustomCodeEditor.ViewToEditorLine(ViewLine: sw_integer): sw_integer;
4564
var I,Line,Count: sw_integer;
4566
if not IsFlagSet(efFolds) then
4570
Count:=GetLineCount;
4572
while (Line<ViewLine) and (I<Count) do
4574
if IsLineVisible(I) then
4578
if Line<>ViewLine then
4583
ViewToEditorLine:=Line;
4586
function TCustomCodeEditor.EditorToViewLine(EditorLine: sw_integer): sw_integer;
4587
var I,Line: sw_integer;
4589
if not IsFlagSet(efFolds) then
4594
for I:=0 to EditorLine do
4595
if IsLineVisible(I) then
4598
EditorToViewLine:=Line;
4601
procedure TCustomCodeEditor.ViewToEditorPoint(P: TPoint; var NP: TPoint);
4603
NP.X:=P.X-GetReservedColCount;
4604
NP.Y:=ViewToEditorLine(P.Y);
4607
procedure TCustomCodeEditor.EditorToViewPoint(P: TPoint; var NP: TPoint);
4609
NP.X:=P.X+GetReservedColCount;
4610
NP.Y:=EditorToViewLine(P.Y);
4613
procedure TCustomCodeEditor.FindMatchingDelimiter(ScanForward: boolean);
4614
const OpenSymbols : string[6] = '[{(<''"';
4615
CloseSymbols : string[6] = ']})>''"';
4616
var SymIdx: integer;
4617
LineText,LineAttr: string;
4620
LineCount: sw_integer;
4622
BracketLevel: integer;
4624
JumpPos.X:=-1; JumpPos.Y:=-1;
4625
LineText:=GetDisplayText(CurPos.Y);
4626
LineText:=copy(LineText,CurPos.X+1,1);
4627
if LineText='' then Exit;
4628
CurChar:=LineText[1];
4629
Y:=CurPos.Y; X:=CurPos.X; LineCount:=0;
4633
SymIdx:=Pos(CurChar,OpenSymbols);
4634
if SymIdx=0 then Exit;
4637
GetDisplayTextFormat(Y,LineText,LineAttr);
4638
if LineCount<>1 then X:=-1;
4641
if X<length(LineText) then
4642
if copy(LineAttr,X+1,1)<>chr(attrComment) then
4643
if (LineText[X+1]=CloseSymbols[SymIdx]) and (BracketLevel=1) then
4645
JumpPos.X:=X; JumpPos.Y:=Y;
4648
if LineText[X+1]=OpenSymbols[SymIdx] then
4651
if LineText[X+1]=CloseSymbols[SymIdx] then
4652
if BracketLevel>1 then
4654
until (X>=length(LineText)) or (JumpPos.X<>-1);
4656
until (Y>=GetLineCount) or (JumpPos.X<>-1);
4660
SymIdx:=Pos(CurChar,CloseSymbols);
4661
if SymIdx=0 then Exit;
4664
GetDisplayTextFormat(Y,LineText,LineAttr);
4665
if LineCount<>1 then X:=length(LineText);
4669
if copy(LineAttr,X+1,1)<>chr(attrComment) then
4670
if (LineText[X+1]=OpenSymbols[SymIdx]) and (BracketLevel=1) then
4672
JumpPos.X:=X; JumpPos.Y:=Y;
4675
if LineText[X+1]=CloseSymbols[SymIdx] then
4678
if LineText[X+1]=OpenSymbols[SymIdx] then
4679
if BracketLevel>1 then
4681
until (X<0) or (JumpPos.X<>-1);
4683
until (Y<0) or (JumpPos.X<>-1);
4685
if JumpPos.X<>-1 then
4687
SetCurPtr(JumpPos.X,JumpPos.Y);
4688
TrackCursor(do_centre);
4692
function TCustomCodeEditor.InsertNewLine: Sw_integer;
4693
var i,Ind: Sw_integer;
4694
S,IndentStr: string;
4695
procedure CalcIndent(LineOver: Sw_integer);
4697
if (LineOver<0) or (LineOver>GetLineCount) or ((GetFlags and efNoIndent)<>0) then
4701
IndentStr:=GetDisplayText(LineOver);
4703
until (LineOver<0) or (IndentStr<>'');
4705
while (Ind<length(IndentStr)) and (IndentStr[Ind+1]=' ') do
4708
IndentStr:=CharStr(' ',Ind);
4710
var {SelBack: sw_integer;}
4714
L,NewL: PCustomLine;
4715
EI,NewEI: PEditorLineInfo;
4717
if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
4720
HoldUndo:=GetStoreUndo;
4721
SetStoreUndo(false);
4722
if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
4723
if Overwrite=false then
4725
if CurPos.Y<GetLineCount then
4727
L:=GetLine(CurPos.Y);
4728
if not assigned(L) then
4731
EI:=L^.GetEditorInfo(@Self);
4736
CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
4737
if GetLineCount>0 then
4739
S:=GetLineText(CurPos.Y);
4740
{ SelBack:=length(S)-SelEnd.X;}
4741
SetLineText(CurPos.Y,RTrim(S,not IsFlagSet(efUseTabCharacters)));
4743
SetLineText(CurPos.Y,copy(S,1,CI-1));
4744
CalcIndent(CurPos.Y);
4745
S:=copy(S,CI,High(S));
4747
while (i<=length(s)) and (i<=length(IndentStr)) and (s[i]=' ') do
4750
Delete(IndentStr,1,i-1);
4751
NewL:=InsertLine(CurPos.Y+1,IndentStr+S);
4753
(* if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
4754
begin SelEnd.Y:=CurPos.Y+1; SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack; end;*)
4755
UpdateAttrs(CurPos.Y,attrAll);
4756
SetCurPtr(Ind,CurPos.Y+1);
4757
NewEI:=NewL^.GetEditorInfo(@Self);
4758
if Assigned(EI) and Assigned(NewEI) then
4760
NewEI^.SetFold(EI^.Fold);
4761
if Assigned(EI^.Fold) then
4762
if EI^.Fold^.IsCollapsed then
4763
EI^.Fold^.Collapse(false);
4765
SetStoreUndo(HoldUndo);
4766
{ obsolete IndentStr is taken care of by the Flags PM }
4767
Addaction(eaInsertLine,SCP,CurPos,CharStr(' ',i-1){IndentStr},GetFlags);
4768
SetStoreUndo(false);
4769
AdjustSelectionPos(SCP.X,SCP.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
4772
CalcIndent(CurPos.Y);
4773
if CurPos.Y=GetLineCount-1 then
4776
AdjustSelectionBefore(0,1);
4778
SetStoreUndo(HoldUndo);
4779
UpdateAttrs(CurPos.Y,attrAll);
4780
SetCurPtr(Ind,CurPos.Y+1);
4781
{ obsolete IndentStr is taken care of by the Flags PM }
4782
Addaction(eaInsertLine,SCP,CurPos,''{IndentStr},GetFlags);
4783
SetStoreUndo(false);
4787
UpdateAttrs(CurPos.Y,attrAll);
4788
SetStoreUndo(HoldUndo);
4789
SetCurPtr(Ind,CurPos.Y+1);
4790
AddAction(eaMoveCursor,SCP,CurPos,'',GetFlags);
4791
SetStoreUndo(false);
4794
DrawLines(CurPos.Y);
4795
SetStoreUndo(HoldUndo);
4800
procedure TCustomCodeEditor.BreakLine;
4802
NotImplemented; Exit;
4805
procedure TCustomCodeEditor.BackSpace;
4807
OI,CI,CP,Y,TX: Sw_integer;
4811
if IsReadOnly then Exit;
4814
HoldUndo:=GetStoreUndo;
4815
SetStoreUndo(false);
4820
CI:=Length(GetDisplayText(CurPos.Y-1));
4821
S:=GetLineText(CurPos.Y-1);
4822
SetLineText(CurPos.Y-1,S+GetLineText(CurPos.Y));
4823
SC1.X:=Length(S);SC1.Y:=CurPOS.Y-1;
4824
SetStoreUndo(HoldUndo);
4825
AddAction(eaDeleteLine,SCP,SC1,GetLineText(CurPos.Y),GetFlags);
4826
SetStoreUndo(false);
4827
DeleteLine(CurPos.Y);
4829
SetCurPtr(CI,CurPos.Y-1);
4830
AdjustSelectionPos(Ci,CurPos.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
4836
S:=GetLineText(CurPos.Y);
4837
CI:=LinePosToCharIdx(CurPos.Y,CP);
4838
if (s[ci]=TAB) and (CharIdxToLinePos(Curpos.y,ci)=cp) then
4839
CP:=CharIdxToLinePos(CurPos.Y,CI-1)+1;
4840
if IsFlagSet(efBackspaceUnindents) then
4842
S:=GetDisplayText(CurPos.Y);
4843
if Trim(copy(S,1,CP+1))='' then
4849
PreS:=GetDisplayText(Y);
4850
if Trim(copy(PreS,1,CP+1))<>'' then Break;
4852
if Y<0 then PreS:='';
4854
while (TX<length(PreS)) and (PreS[TX+1]=' ') do
4856
if TX<CP then CP:=TX;
4859
S:=GetLineText(CurPos.Y);
4860
OI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
4861
CI:=LinePosToCharIdx(CurPos.Y,CP);
4862
SetLineText(CurPos.Y,copy(S,1,CI-1)+copy(S,OI,High(S)));
4863
SetCurPtr(CP,CurPos.Y);
4864
SetStoreUndo(HoldUndo);
4865
Addaction(eaDeleteText,SCP,CurPos,Copy(S,CI,OI-CI),GetFlags);
4866
SetStoreUndo(false);
4867
AdjustSelectionPos(SCP.X-1,SCP.Y,CurPos.X-SCP.X,CurPos.Y-SCP.Y);
4869
UpdateAttrs(CurPos.Y,attrAll);
4870
DrawLines(CurPos.Y);
4871
SetStoreUndo(HoldUndo);
4876
procedure TCustomCodeEditor.DelChar;
4878
SDX,SDY,CI : sw_integer;
4882
if IsReadOnly then Exit;
4884
HoldUndo:=GetStoreUndo;
4885
SetStoreUndo(false);
4886
S:=GetLineText(CurPos.Y);
4887
CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
4888
if (CI>length(S)) or (S='') then
4890
if CurPos.Y<GetLineCount-1 then
4892
SetLineText(CurPos.Y,S+CharStr(' ',CurPOS.X-Length(S))+GetLineText(CurPos.Y+1));
4894
SetStoreUndo(HoldUndo);
4895
SCP.X:=0;SCP.Y:=CurPos.Y+1;
4896
AddGroupedAction(eaDelChar);
4897
AddAction(eaMoveCursor,CurPos,SCP,'',GetFlags);
4898
S:=GetLineText(CurPos.Y+1);
4899
AddAction(eaDeleteLine,SCP,CurPos,S,GetFlags);
4900
CloseGroupedAction(eaDelChar);
4901
SetStoreUndo(false);
4902
DeleteLine(CurPos.Y+1);
4905
SetCurPtr(CurPos.X,CurPos.Y);
4906
UpdateAttrs(CurPos.Y,attrAll);
4907
AdjustSelectionPos(CurPos.X,CurPos.Y,SDX,SDY);
4913
{ Problem if S[CurPos.X+1]=TAB !! PM }
4916
{ we want to remove the tab if we are at the first place
4917
of the tab, but the following test was true for the last position
4919
if CharIdxToLinePos(Curpos.y,ci)=Curpos.x then }
4920
if CharIdxToLinePos(Curpos.y,ci-1)=Curpos.x-1 then
4923
S:=Copy(S,1,CI-1)+CharStr(' ',GetTabSize-1)+Copy(S,CI+1,High(S));
4924
SetStoreUndo(HoldUndo);
4925
Addaction(eaDeleteText,CurPos,CurPos,#9,GetFlags);
4927
SetStoreUndo(false);
4931
SetStoreUndo(HoldUndo);
4932
Addaction(eaDeleteText,CurPos,CurPos,S[CI],GetFlags);
4933
SetStoreUndo(false);
4937
SetLineText(CurPos.Y,S);
4939
SetCurPtr(CurPos.X,CurPos.Y);
4940
UpdateAttrs(CurPos.Y,attrAll);
4941
AdjustSelectionPos(SCP.X,SCP.Y,SDX,SDY);
4943
DrawLines(CurPos.Y);
4944
SetStoreUndo(HoldUndo);
4949
procedure TCustomCodeEditor.DelWord;
4952
SelSize : sw_integer;
4954
if IsReadOnly then Exit;
4958
SetSelection(SelStart,SelStart);
4960
SelSize:=SelEnd.X-SelStart.X;
4962
SetSelection(SP,EP);
4963
AdjustSelectionPos(CurPos.X,CurPos.Y,-SelSize,0);
4969
procedure TCustomCodeEditor.DelToEndOfWord;
4973
SelSize : sw_integer;
4975
if IsReadOnly then Exit;
4979
SetSelection(SelStart,SelStart);
4981
S:=GetDisplayText(CurPos.Y);
4982
if ((SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y)) then
4984
if (Length(S) <= CurPos.X) then
4986
SetSelection(SP,EP);
4993
SelEnd.X:=CurPos.X+1;
4997
while (length(S)>= SelEnd.X+1) and
4998
((S[SelEnd.X+1]=' ') or (S[SelEnd.X+1]=TAB)) do
5000
SetSelection(CurPos,SelEnd);
5001
SelSize:=SelEnd.X-SelStart.X;
5003
SetSelection(SP,EP);
5004
AdjustSelectionPos(CurPos.X,CurPos.Y,-SelSize,0);
5010
procedure TCustomCodeEditor.DelStart;
5013
if IsReadOnly then Exit;
5015
S:=GetLineText(CurPos.Y);
5016
if (S<>'') and (CurPos.X<>0) then
5018
SetLineText(CurPos.Y,copy(S,LinePosToCharIdx(CurPos.Y,CurPos.X),High(S)));
5019
SetCurPtr(0,CurPos.Y);
5020
UpdateAttrs(CurPos.Y,attrAll);
5021
DrawLines(CurPos.Y);
5027
procedure TCustomCodeEditor.DelEnd;
5030
if IsReadOnly then Exit;
5032
S:=GetLineText(CurPos.Y);
5033
if (S<>'') and (CurPos.X<>length(S)) then
5035
SetLineText(CurPos.Y,copy(S,1,LinePosToCharIdx(CurPos.Y,CurPos.X)-1));
5036
SetCurPtr(CurPos.X,CurPos.Y);
5037
UpdateAttrs(CurPos.Y,attrAll);
5038
DrawLines(CurPos.Y);
5044
procedure TCustomCodeEditor.DelLine;
5050
if IsReadOnly then Exit;
5052
if GetLineCount>0 then
5055
S:=GetLineText(CurPos.Y);
5056
HoldUndo:=GetStoreUndo;
5057
SetStoreUndo(false);
5058
DeleteLine(CurPos.Y);
5060
AdjustSelectionBefore(0,-1);
5061
SetCurPtr(0,CurPos.Y);
5062
UpdateAttrs(Max(0,CurPos.Y-1),attrAll);
5063
DrawLines(CurPos.Y);
5064
SetStoreUndo(HoldUndo);
5065
AddAction(eaDeleteLine,SP,CurPos,S,GetFlags);
5071
procedure TCustomCodeEditor.InsMode;
5073
SetInsertMode(Overwrite);
5076
function TCustomCodeEditor.GetCurrentWordArea(var StartP,EndP: TPoint): boolean;
5077
const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
5080
StartPos,EndPos : byte;
5084
S:=GetLineText(P.Y);
5087
OK:=(S[StartPos] in WordChars);
5090
While (StartPos>0) and (S[StartPos-1] in WordChars) do
5092
While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
5094
StartP.X:=StartPos-1; StartP.Y:=CurPos.Y;
5095
EndP.X:=EndPos-1; EndP.Y:=CurPos.Y;
5097
GetCurrentWordArea:=OK;
5100
function TCustomCodeEditor.GetCurrentWord : string;
5102
StartP,EndP: TPoint;
5104
if GetCurrentWordArea(StartP,EndP)=false then
5108
S:=GetLineText(StartP.Y);
5109
S:=copy(S,StartP.X+1,EndP.X-StartP.X+1);
5114
procedure TCustomCodeEditor.StartSelect;
5117
if ValidBlock=false then
5119
{ SetSelection(SelStart,Limit);}
5120
P1:=CurPos; P1.X:=0; P2:=CurPos; {P2.X:=length(GetLineText(P2.Y))+1;}
5121
SetSelection(P1,P2);
5124
SetSelection(CurPos,SelEnd);
5125
if PointOfs(SelEnd)<PointOfs(SelStart) then
5126
SetSelection(SelStart,SelStart);
5131
procedure TCustomCodeEditor.EndSelect;
5136
{ P.X:=Min(SelEnd.X,length(GetLineText(SelEnd.Y)));}
5137
LS:=length(GetLineText(SelEnd.Y));
5138
if LS<P.X then P.X:=LS;
5140
SetSelection(SelStart,P);
5144
procedure TCustomCodeEditor.DelSelect;
5145
var LineDelta, LineCount, CurLine: Sw_integer;
5146
StartX,EndX,LastX: Sw_integer;
5150
if IsReadOnly or (ValidBlock=false) then Exit;
5153
AddGroupedAction(eaDelBlock);
5154
LineCount:=(SelEnd.Y-SelStart.Y)+1;
5155
LineDelta:=0; LastX:=CurPos.X;
5156
CurLine:=SelStart.Y;
5157
{ single line : easy }
5160
S:=GetDisplayText(CurLine);
5163
SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
5164
+copy(S,EndX+1,High(S)));
5165
if GetStoreUndo then
5169
AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,EndX-StartX),GetFlags);
5174
{ several lines : a bit less easy }
5177
S:=GetDisplayText(CurLine);
5180
SetDisplayText(CurLine,RExpand(copy(S,1,StartX),StartX)
5181
+copy(GetDisplayText(CurLine+LineCount-1),EndX+1,High(S)));
5182
if GetStoreUndo then
5186
AddAction(eaDeleteText,SPos,SPos,Copy(S,StartX+1,High(S)),GetFlags);
5187
S:=GetDisplayText(CurLine+LineCount-1);
5192
while (LineDelta<LineCount) do
5194
{ delete the complete line }
5195
DeleteLine(CurLine);
5198
if GetStoreUndo then
5200
AddAction(eaInsertText,SPos,SPos,Copy(S,EndX+1,High(S)),GetFlags);
5204
SetCurPtr(LastX,CurLine-1);
5205
UpdateAttrs(CurPos.Y,attrAll);
5206
DrawLines(CurPos.Y);
5208
CloseGroupedAction(eaDelBlock);
5212
procedure TCustomCodeEditor.HideSelect;
5214
SetSelection(CurPos,CurPos);
5218
procedure TCustomCodeEditor.CopyBlock;
5219
var Temp: PCodeEditor;
5222
if IsReadOnly or (ValidBlock=false) then Exit;
5226
AddGroupedAction(eaCopyBlock);
5227
New(Temp, Init(R, nil, nil, nil,nil));
5228
Temp^.InsertFrom(@Self);
5229
(* Temp^.SelectAll(true);
5230
{ this selects one line too much because
5231
we have a empty line at creation to avoid
5232
negative line problems so we need to decrease SelEnd.Y }
5233
Dec(Temp^.SelEnd.Y);*)
5237
Dispose(Temp, Done);
5238
CloseGroupedAction(eaCopyBlock);
5242
procedure TCustomCodeEditor.MoveBlock;
5243
var Temp: PCodeEditor;
5247
if IsReadOnly then Exit;
5248
if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
5250
AddGroupedAction(eaMoveBlock);
5252
New(Temp, Init(R, nil, nil, nil,nil));
5253
Temp^.InsertFrom(@Self);
5255
if CurPos.Y>SelStart.Y then
5256
Dec(OldPos.Y,Temp^.GetLineCount-1);
5258
SetCurPtr(OldPos.X,OldPos.Y);
5260
Dispose(Temp, Done);
5261
CloseGroupedAction(eaMoveBlock);
5265
procedure TCustomCodeEditor.IndentBlock;
5267
ey,i{,indlen} : Sw_integer;
5271
if IsReadOnly then Exit;
5272
if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
5274
AddGroupedAction(eaIndentBlock);
5279
{ If AutoIndent try to align first line to
5280
last line before selection }
5281
{ DISABLED created problems PM
5282
if IsFlagSet(efAutoIndent) and (SelStart.Y>0) then
5285
while (S='') and (i>=0) do
5287
S:=GetDisplayText(i);
5290
if (S='') or (S[1]<>' ') then
5295
while (i<=Length(S)) and (S[i]=' ') do
5298
S:=GetDisplayText(SelStart.Y);
5300
while (i<=Length(S)) and (S[i]=' ') do
5305
Ind:=CharStr(' ',indlen);
5310
Ind:=CharStr(' ',GetIndentSize);
5311
for i:=selstart.y to ey do
5314
SetLineText(i,Ind+S);
5316
AddAction(eaInsertText,Pos,Pos,Ind,GetFlags);
5318
SetCurPtr(CurPos.X,CurPos.Y);
5319
{ must be added manually here PM }
5320
AddAction(eaMoveCursor,Pos,CurPos,'',GetFlags);
5321
UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
5322
DrawLines(CurPos.Y);
5324
CloseGroupedAction(eaIndentBlock);
5328
procedure TCustomCodeEditor.UnindentBlock;
5330
ey,i,j,k,indlen : Sw_integer;
5334
if IsReadOnly then Exit;
5335
if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
5337
AddGroupedAction(eaUnindentBlock);
5341
{ If AutoIndent try to align first line to
5342
last line before selection }
5343
{ Disabled created problems
5344
if IsFlagSet(efAutoIndent) and (SelStart.Y>0) then
5346
S:=GetDisplayText(SelStart.Y);
5348
while (i<=Length(S)) and (S[i]=' ') do
5353
while (S='') and (i>=0) do
5355
if Trim(Copy(GetDisplayText(i),1,indlen))='' then
5358
S:=GetDisplayText(i);
5366
while (i<=Length(S)) and (S[i]=' ') do
5375
Indlen:=GetIndentSize;
5376
for i:=selstart.y to ey do
5380
for j:=1 to indlen do
5381
if (length(s)>1) and (S[1]=' ') then
5391
AddAction(eaDeleteText,Pos,Pos,CharStr(' ',k),GetFlags);
5394
SetCurPtr(CurPos.X,CurPos.Y);
5395
UpdateAttrsRange(SelStart.Y,SelEnd.Y,attrAll);
5396
DrawLines(CurPos.Y);
5398
CloseGroupedAction(eaUnindentBlock);
5402
procedure TCustomCodeEditor.SelectWord;
5403
const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
5405
StartPos,EndPos : byte;
5410
S:=GetDisplayText(A.Y);
5413
if not (S[StartPos] in WordChars) then
5417
While (StartPos>0) and (S[StartPos-1] in WordChars) do
5419
While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
5427
procedure TCustomCodeEditor.SelectLine;
5430
if CurPos.Y<GetLineCount then
5432
A.Y:=CurPos.Y; A.X:=0;
5433
B.Y:=CurPos.Y+1; B.X:=0;
5438
procedure TCustomCodeEditor.WriteBlock;
5439
var FileName: string;
5442
if ValidBlock=false then Exit;
5445
if EditorDialog(edWriteBlock, @FileName) <> cmCancel then
5447
FileName := FExpand(FileName);
5449
New(S, Init(FileName, stCreate, 4096));
5450
if (S=nil) or (S^.Status<>stOK) then
5451
EditorDialog(edCreateError,@FileName)
5453
if SaveAreaToStream(S,SelStart,SelEnd)=false then
5454
EditorDialog(edWriteError,@FileName);
5455
if Assigned(S) then Dispose(S, Done);
5459
procedure TCustomCodeEditor.ReadBlock;
5460
var FileName: string;
5465
if IsReadOnly then Exit;
5467
if EditorDialog(edReadBlock, @FileName) <> cmCancel then
5469
FileName := FExpand(FileName);
5471
New(S, Init(FileName, stOpenRead, 4096));
5472
if (S=nil) or (S^.Status<>stOK) then
5473
EditorDialog(edReadError,@FileName)
5477
New(E, Init(R,nil,nil,nil,nil));
5478
AddGroupedAction(eaReadBlock);
5479
if E^.LoadFromStream(S)=false then
5480
EditorDialog(edReadError,@FileName)
5486
CloseGroupedAction(eaReadBlock);
5489
if Assigned(S) then Dispose(S, Done);
5493
procedure TCustomCodeEditor.PrintBlock;
5495
NotImplemented; Exit;
5498
function TCustomCodeEditor.SelectCodeTemplate(var ShortCut: string): boolean;
5501
SelectCodeTemplate:=false;
5504
procedure TCustomCodeEditor.ExpandCodeTemplate;
5505
var Line,ShortCutInEditor,ShortCut: string;
5506
X,Y,I,LineIndent: sw_integer;
5507
CodeLines: PUnsortedStringCollection;
5512
The usage of editing primitives in this routine make it pretty slow, but
5513
its speed is still acceptable and they make the implementation of Undo
5514
much easier... - Gabor
5516
if IsReadOnly then Exit;
5521
Line:=GetDisplayText(CurPos.Y);
5522
X:=CurPos.X; ShortCut:='';
5523
if X<=length(Line) then
5524
while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
5526
ShortCut:=Line[X]+ShortCut;
5529
ShortCutInEditor:=ShortCut;
5531
New(CodeLines, Init(10,10));
5532
if (ShortCut='') or (not TranslateCodeTemplate(ShortCut,CodeLines)) then
5533
if SelectCodeTemplate(ShortCut) then
5534
TranslateCodeTemplate(ShortCut,CodeLines);
5536
if CodeLines^.Count>0 then
5539
SetCurPtr(X,CurPos.Y);
5540
if Copy(ShortCut,1,length(ShortCutInEditor))=ShortCutInEditor then
5542
for I:=1 to length(ShortCutInEditor) do
5546
{ restore correct position }
5547
SetCurPtr(X+Length(ShortCutInEditor),CurPos.Y);
5548
for Y:=0 to CodeLines^.Count-1 do
5550
Line:=GetStr(CodeLines^.At(Y));
5554
CanJump:=Trim(GetLineText(CurPos.Y))='';
5555
if CanJump=false then
5557
(* for X:=1 to LineIndent do { indent template lines to align }
5558
AddChar(' '); { them to the first line }*)
5559
InsertText(CharStr(' ',LineIndent));
5562
SetCurPtr(CurPos.X+LineIndent,CurPos.Y);
5564
I:=Pos(CodeTemplateCursorChar,Line);
5572
if Y<CodeLines^.Count-1 then
5574
InsertNewLine; { line break }
5575
if CanJump=false then
5577
while CurPos.X>0 do { unindent }
5579
SetCurPtr(CurPos.X-1,CurPos.Y);
5584
SetCurPtr(0,CurPos.Y);
5588
Dispose(CodeLines, Done);
5590
if (CP.X<>-1) and (CP.Y<>-1) then
5591
SetCurPtr(CP.X,CP.Y);
5596
procedure TCustomCodeEditor.AddChar(C: char);
5597
const OpenBrackets : string[10] = '[({';
5598
CloseBrackets : string[10] = '])}';
5599
var S,SC,TabS: string;
5601
CI,TabStart,LocTabSize : Sw_integer;
5605
if IsReadOnly then Exit;
5609
HoldUndo:=GetStoreUndo;
5610
SetStoreUndo(false);
5611
if (C<>TAB) or IsFlagSet(efUseTabCharacters) then
5615
LocTabSize:=GetTabSize - (CurPos.X mod GetTabSize);
5616
if (CurPos.Y<=1) or not IsFlagSet(efAutoIndent) then
5617
SC:=CharStr(' ',LocTabSize)
5620
S:=GetLineText(CurPos.Y-1);
5622
while (BI<=Length(S)) and (S[BI]=' ') do
5624
if (BI=CurPos.X+1) or (BI>Length(S)) then
5625
SC:=CharStr(' ',LocTabSize)
5627
SC:=CharStr(' ',BI-CurPos.X-1);
5630
S:=GetLineText(CurPos.Y);
5631
if CharIdxToLinePos(CurPos.Y,length(S))<CurPos.X then
5633
S:=S+CharStr(' ',CurPos.X-CharIdxToLinePos(CurPos.Y,length(S)){-1});
5634
SetLineText(CurPos.Y,S);
5636
CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
5642
if (CI>0) and (S[CI]=TAB) and not IsFlagSet(efUseTabCharacters) then
5647
TabStart:=CharIdxToLinePos(CurPos.Y,CI-1)+1;
5648
if SC=Tab then TabS:=Tab else
5649
TabS:=CharStr(' ',CurPos.X-TabStart);
5650
SetLineText(CurPos.Y,copy(S,1,CI-1)+TabS+SC+copy(S,CI+1,High(S)));
5651
SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(TabS)+length(SC)),CurPos.Y);
5655
if Overwrite and (CI<=length(S)) then
5657
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI+length(SC),High(S)));
5660
SetLineText(CurPos.Y,copy(S,1,CI-1)+SC+copy(S,CI,High(S)));
5661
SetCurPtr(CharIdxToLinePos(CurPos.Y,CI+length(SC)),CurPos.Y);
5663
{ must be before CloseBrackets !! }
5664
SetStoreUndo(HoldUndo);
5666
Addaction(eaOverwriteText,SP,CurPos,Copy(S,CI,length(SC)),GetFlags)
5668
Addaction(eaInsertText,SP,CurPos,SC,GetFlags);
5669
SetStoreUndo(false);
5670
if IsFlagSet(efAutoBrackets) then
5672
BI:=Pos(C,OpenBrackets);
5675
SetStoreUndo(HoldUndo);
5676
AddChar(CloseBrackets[BI]);
5677
SetStoreUndo(false);
5678
SetCurPtr(CurPos.X-1,CurPos.Y);
5681
UpdateAttrs(CurPos.Y,attrAll);
5682
if GetInsertMode then
5683
AdjustSelection(CurPos.X-SP.X,CurPos.Y-SP.Y);
5684
DrawLines(CurPos.Y);
5685
SetStoreUndo(HoldUndo);
5690
{$ifdef WinClipSupported}
5691
function TCustomCodeEditor.ClipPasteWin: Boolean;
5694
p,p10,p2,p13 : pchar;
5696
BPos,EPos,StorePos : TPoint;
5700
OK:=WinClipboardSupported;
5706
l:=GetTextWinClipboardSize;
5710
OK:=GetTextWinClipBoardData(p,l);
5714
PushInfo(msg_readingwinclipboard);
5715
AddGroupedAction(eaPasteWin);
5719
while assigned(p10) do
5728
{ we need to cut the line in two
5729
if not at end of line PM }
5731
SetCurPtr(StorePos.X,StorePos.Y);
5739
BPos.X:=0;BPos.Y:=i;
5740
EPOS.X:=Length(s);EPos.Y:=i;
5741
AddAction(eaInsertLine,BPos,EPos,GetDisplayText(i),GetFlags);
5748
p13:=strpos(p2,#13);
5749
p10:=strpos(p2,#10);
5751
if strlen(p2)>0 then
5758
SetCurPtr(StorePos.X,StorePos.Y);
5760
UpdateAttrs(StorePos.Y,attrAll);
5761
CloseGroupedAction(eaPasteWin);
5765
{ we must free the allocated memory }
5774
function TCustomCodeEditor.ClipCopyWin: Boolean;
5775
var OK,ShowInfo: boolean;
5778
i,str_begin,str_end,NumLines,PcLength : longint;
5780
NumLines:=SelEnd.Y-SelStart.Y;
5781
if (NumLines>0) or (SelEnd.X>SelStart.X) then
5786
ShowInfo:=SelEnd.Y-SelStart.Y>50;
5788
PushInfo(msg_copyingwinclipboard);
5789
{ First calculate needed size }
5790
{ for newlines first + 1 for terminal #0 }
5791
PcLength:=Length(EOL)*(NumLines-1)+1;
5793
{ overestimated but can not be that big PM }
5794
for i:=SelStart.Y to SelEnd.Y do
5795
PCLength:=PCLength+Length(GetLineText(i));
5799
str_begin:=LinePosToCharIdx(i,SelStart.X);
5800
if SelEnd.Y>SelStart.Y then
5803
str_end:=LinePosToCharIdx(i,SelEnd.X)-1;
5804
s:=copy(s,str_begin,str_end-str_begin+1);
5810
strpcopy(p2,EOL+GetLineText(i));
5814
if SelEnd.Y>SelStart.Y then
5816
s:=copy(GetLineText(i),1,LinePosToCharIdx(i,SelEnd.X)-1);
5819
OK:=WinClipboardSupported;
5822
OK:=SetTextWinClipBoardData(p,strlen(p));
5827
Freemem(p,PCLength);
5830
{$endif WinClipSupported}
5832
function TCustomCodeEditor.ClipCopy: Boolean;
5834
var ShowInfo,CanPaste: boolean;
5838
{AddGroupedAction(eaCopy);
5839
can we undo a copy ??
5840
maybe as an Undo Paste in Clipboard !! }
5843
if (clipboard<>nil) and (clipboard<>@self) then
5845
ShowInfo:=SelEnd.Y-SelStart.Y>50;
5847
PushInfo(msg_copyingclipboard);
5848
clipcopy:=Clipboard^.InsertFrom(@Self);
5851
{Enable paste command.}
5852
CanPaste:=((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
5853
(Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
5854
SetCmdState(FromClipCmds,CanPaste);
5859
procedure TCustomCodeEditor.ClipCut;
5861
ShowInfo,CanPaste : boolean;
5863
if IsReadOnly then Exit;
5865
AddGroupedAction(eaCut);
5866
DontConsiderShiftState:=true;
5867
if (clipboard<>nil) and (clipboard<>@self) then
5869
ShowInfo:=SelEnd.Y-SelStart.Y>50;
5871
PushInfo(msg_cutting);
5872
if Clipboard^.InsertFrom(@Self) then
5874
if not IsClipBoard then
5880
CanPaste:=((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
5881
(Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
5882
SetCmdState(FromClipCmds,CanPaste);
5884
CloseGroupedAction(eaCut);
5886
DontConsiderShiftState:=false;
5889
procedure TCustomCodeEditor.ClipPaste;
5893
if IsReadOnly then Exit;
5894
DontConsiderShiftState:=true;
5896
AddGroupedAction(eaPaste);
5897
if Clipboard<>nil then
5899
ShowInfo:=Clipboard^.SelEnd.Y-Clipboard^.SelStart.Y>50;
5901
PushInfo(msg_pastingclipboard);
5902
InsertFrom(Clipboard);
5907
CloseGroupedAction(eaPaste);
5909
DontConsiderShiftState:=false;
5912
procedure TCustomCodeEditor.Undo;
5914
NotImplemented; Exit;
5917
procedure TCustomCodeEditor.Redo;
5919
NotImplemented; Exit;
5922
procedure TCustomCodeEditor.GotoLine;
5924
GotoRec: TGotoLineDialogRec;
5929
Lines:=GetLineCount;
5930
{Linecount can be 0, but in that case there still is a cursor blinking in top
5931
of the window, which will become line 1 as soon as sometype hits a key.}
5934
if EditorDialog(edGotoLine, @GotoRec) <> cmCancel then
5937
SetCurPtr(0,StrToInt(LineNo)-1);
5938
TrackCursor(do_centre);
5944
procedure TCustomCodeEditor.Find;
5946
FindRec: TFindDialogRec;
5952
if GetCurrentWord<>'' then
5953
Find:=GetCurrentWord;
5954
{$ifdef TEST_REGEXP}
5955
Options := ((FindFlags and ffmOptionsFind) shr ffsOptions) or
5956
((FindFlags and ffUseRegExp) shr ffsUseRegExpFind);
5957
{$else not TEST_REGEXP}
5958
Options := (FindFlags and ffmOptions) shr ffsOptions;
5959
{$endif TEST_REGEXP}
5960
Direction := (FindFlags and ffmDirection) shr ffsDirection;
5961
Scope := (FindFlags and ffmScope) shr ffsScope;
5962
Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
5963
DoConf:= (FindFlags and ffPromptOnReplace)<>0;
5964
FindReplaceEditor:=@self;
5965
if EditorDialog(edFind, @FindRec) <> cmCancel then
5968
{$ifdef TEST_REGEXP}
5969
FindFlags := ((Options and ffmOptionsFind) shl ffsOptions) or (Direction shl ffsDirection) or
5970
((Options and ffmUseRegExpFind) shl ffsUseRegExpFind) or
5971
(Scope shl ffsScope) or (Origin shl ffsOrigin);
5972
{$else : not TEST_REGEXP}
5973
FindFlags := ((Options and ffmOptions) shl ffsOptions) or (Direction shl ffsDirection) or
5974
(Scope shl ffsScope) or (Origin shl ffsOrigin);
5975
{$endif TEST_REGEXP}
5976
FindFlags := FindFlags and not ffDoReplace;
5978
FindFlags := (FindFlags or ffPromptOnReplace);
5983
EditorDialog(edSearchFailed,nil);
5985
FindReplaceEditor:=nil;
5989
procedure TCustomCodeEditor.Replace;
5991
ReplaceRec: TReplaceDialogRec;
5994
if IsReadOnly then Exit;
5998
if GetCurrentWord<>'' then
5999
Find:=GetCurrentWord;
6000
Replace := ReplaceStr;
6001
{$ifdef TEST_REGEXP}
6002
Options := (FindFlags and ffmOptions) shr ffsOptions or
6003
(FindFlags and ffUseRegExp) shr ffsUseRegExpReplace;
6004
{$else not TEST_REGEXP}
6005
Options := (FindFlags and ffmOptions) shr ffsOptions;
6006
{$endif TEST_REGEXP}
6007
Direction := (FindFlags and ffmDirection) shr ffsDirection;
6008
Scope := (FindFlags and ffmScope) shr ffsScope;
6009
Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
6010
FindReplaceEditor:=@self;
6011
Re:=EditorDialog(edReplace, @ReplaceRec);
6012
FindReplaceEditor:=nil;
6013
if Re <> cmCancel then
6016
ReplaceStr := Replace;
6017
FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
6018
{$ifdef TEST_REGEXP}
6019
((Options and ffmUseRegExpReplace) shl ffsUseRegExpReplace) or
6020
{$endif TEST_REGEXP}
6021
(Scope shl ffsScope) or (Origin shl ffsOrigin);
6022
FindFlags := FindFlags or ffDoReplace;
6024
FindFlags := FindFlags or ffReplaceAll;
6029
EditorDialog(edSearchFailed,nil);
6034
procedure TCustomCodeEditor.DoSearchReplace;
6036
DX,DY,P,Y,X: sw_integer;
6038
Found,CanExit: boolean;
6039
SForward,DoReplace,DoReplaceAll: boolean;
6040
{$ifdef TEST_REGEXP}
6041
UseRegExp : boolean;
6042
RegExpEngine : TRegExprEngine;
6043
RegExpFlags : tregexprflags;
6044
regexpindex,regexplen : longint;
6045
findstrpchar : pchar;
6046
{$endif TEST_REGEXP}
6047
LeftOK,RightOK: boolean;
6048
FoundCount: sw_integer;
6050
AreaStart,AreaEnd: TPoint;
6051
CanReplace,Confirm: boolean;
6056
function ContainsText(const SubS:string;var S: string; Start: Sw_integer): Sw_integer;
6066
if Start>length(s) then
6068
else if FindFlags and ffCaseSensitive<>0 then
6069
P:=BMFScan(S[Start],length(s)+1-Start,FindStr,Bt)+1
6071
P:=BMFIScan(S[Start],length(s)+1-Start,IFindStr,Bt)+1;
6077
if start>length(s) then
6079
if FindFlags and ffCaseSensitive<>0 then
6080
P:=BMBScan(S[1],Start,FindStr,Bt)+1
6082
P:=BMBIScan(S[1],Start,IFindStr,Bt)+1;
6088
function InArea(X,Y: sw_integer): boolean;
6090
InArea:=((AreaStart.Y=Y) and (AreaStart.X<=X)) or
6091
((AreaStart.Y<Y) and (Y<AreaEnd.Y)) or
6092
((AreaEnd.Y=Y) and (X<=AreaEnd.X));
6094
var CurDY: sw_integer;
6099
{ Find will call DoFindReplace at end again
6100
so we need to exit directly now PM }
6103
Inc(SearchRunCount);
6105
SForward:=(FindFlags and ffmDirection)=ffForward;
6106
DoReplace:=(FindFlags and ffDoReplace)<>0;
6107
Confirm:=(FindFlags and ffPromptOnReplace)<>0;
6108
DoReplaceAll:=(FindFlags and ffReplaceAll)<>0;
6109
{$ifdef TEST_REGEXP}
6110
UseRegExp:=(FindFlags and ffUseRegExp)<>0;
6113
if FindFlags and ffCaseSensitive<>0 then
6114
RegExpFlags:=[ref_caseinsensitive]
6117
getmem(findstrpchar,length(findstr)+1);
6118
strpcopy(findstrpchar,findstr);
6119
RegExpEngine:=GenerateRegExprEngine(findstrpchar,RegExpFlags);
6120
strdispose(findstrpchar);
6122
{$endif TEST_REGEXP}
6123
Count:=GetLineCount;
6128
EditorDialog(edSearchFailed,nil);
6139
PushInfo('Looking for "'+FindStr+'"');
6140
if (FindFlags and ffmScope)=ffGlobal then
6144
AreaEnd.X:=length(GetDisplayText(Count-1));
6149
AreaStart:=SelStart;
6155
if SearchRunCount=1 then
6156
if (FindFlags and ffmOrigin)=ffEntireScope then
6168
if FindFlags and ffCaseSensitive<>0 then
6171
BMFMakeTable(FindStr,bt)
6173
BMBMakeTable(FindStr,bt);
6177
IFindStr:=upcase(FindStr);
6179
BMFMakeTable(IFindStr,bt)
6181
BMBMakeTable(IFindStr,bt);
6186
if not DoReplace or (not Confirm and (Owner<>nil)) then
6191
S:=GetDisplayText(Y);
6192
{$ifdef TEST_REGEXP}
6195
getmem(findstrpchar,length(Copy(S,X+1,high(S)))+1);
6196
strpcopy(findstrpchar,Copy(S,X+1,high(S)));
6197
{ If start of line is required do check other positions PM }
6198
if (FindStr[1]='^') and (X<>0) then
6201
Found:=RegExprPos(RegExpEngine,findstrpchar,regexpindex,regexplen);
6202
strdispose(findstrpchar);
6206
{$endif TEST_REGEXP}
6208
P:=ContainsText(FindStr,S,X+1);
6216
{$ifdef TEST_REGEXP}
6220
{$endif TEST_REGEXP}
6221
B.X:=A.X+length(FindStr);
6223
Found:=Found and InArea(A.X,A.Y);
6225
if Found and ((FindFlags and ffWholeWordsOnly)<>0) then
6227
LeftOK:=(A.X<=0) or (not( (S[A.X] in AlphaChars) or (S[A.X] in NumberChars) ));
6228
RightOK:=(B.X>=length(S)) or (not( (S[B.X+1] in AlphaChars) or (S[B.X+1] in NumberChars) ));
6229
Found:=LeftOK and RightOK;
6245
TrackCursor(do_centre);
6249
if not DoReplace then
6269
Re:=EditorDialog(edReplacePrompt,@CurPos);
6287
InsertText(ReplaceStr);
6313
if (DoReplaceAll=false) then
6318
if (CanExit=false) and (CurDY<>0) then
6325
CanExit:=(Y>=Count) or (Y<0);
6328
CanExit:=not InArea(X,Y);
6330
if (FoundCount=0) or (DoReplace) then
6331
SetHighlight(CurPos,CurPos);
6332
if (DoReplace=false) or ((Confirm=false) and (Owner<>nil)) then
6334
{if (DoReplace=false) or (Confirm=false) then
6336
if (FoundCount=0) then
6337
EditorDialog(edSearchFailed,nil);
6340
{$ifdef TEST_REGEXP}
6342
DestroyRegExprEngine(RegExpEngine);
6343
{$endif TEST_REGEXP}
6344
if (FindFlags and ffmScope)=ffSelectedText then
6345
{ restore selection PM }
6347
SetSelection(AreaStart,AreaEnd);
6351
function TCustomCodeEditor.GetInsertMode: boolean;
6353
GetInsertMode:=(GetFlags and efInsertMode)<>0;
6356
procedure TCustomCodeEditor.SetInsertMode(InsertMode: boolean);
6359
SetFlags(GetFlags or efInsertMode)
6361
SetFlags(GetFlags and (not efInsertMode));
6365
{ there is a problem with ShiftDel here
6366
because GetShitState tells to extend the
6367
selection which gives wrong results (PM) }
6369
function TCustomCodeEditor.ShouldExtend: boolean;
6370
var ShiftInEvent: boolean;
6372
ShiftInEvent:=false;
6373
if Assigned(CurEvent) then
6374
if CurEvent^.What=evKeyDown then
6375
ShiftInEvent:=((CurEvent^.KeyShift and kbShift)<>0);
6376
ShouldExtend:=ShiftInEvent and
6377
not DontConsiderShiftState;
6380
procedure TCustomCodeEditor.SetCurPtr(X,Y: sw_integer);
6381
var OldPos{,OldSEnd,OldSStart}: TPoint;
6386
X:=Max(0,Min(MaxLineLength+1,X));
6387
Y:=Max(0,Min(GetLineCount-1,Y));
6390
OldSStart:=SelStart;}
6393
TrackCursor(do_not_centre);
6394
if not IsLineVisible(CurPos.Y) then
6396
F:=GetLineFold(CurPos.Y);
6400
if not NoSelect and ShouldExtend then
6404
if PointOfs(OldPos)=PointOfs(SelStart) then
6406
SetSelection(CurPos,SelEnd);
6410
if Extended=false then
6411
if PointOfs(OldPos)=PointOfs(SelEnd) then
6413
if not ValidBlock then
6414
SetSelection(CurPos,CurPos);
6415
SetSelection(SelStart,CurPos); Extended:=true;
6418
if not Extended then
6419
if PointOfs(OldPos)<=PointOfs(CurPos) then
6421
SetSelection(OldPos,CurPos);
6426
SetSelection(CurPos,OldPos);
6431
else if not IsFlagSet(efPersistentBlocks) then
6436
{ if PointOfs(SelStart)=PointOfs(SelEnd) then
6437
SetSelection(CurPos,CurPos);}
6438
if (GetFlags and (efHighlightColumn+efHighlightRow))<>0 then
6440
if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and
6441
((Highlight.A.X<>HighLight.B.X) or (Highlight.A.Y<>HighLight.B.Y)) then
6443
if (OldPos.Y<>CurPos.Y) and (0<=OldPos.Y) and (OldPos.Y<GetLineCount) then
6444
SetLineText(OldPos.Y,RTrim(GetLineText(OldPos.Y),not IsFlagSet(efUseTabCharacters)));
6445
if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (GetErrorMessage<>'') then
6446
SetErrorMessage('');
6447
{ if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (HighlightRow<>-1) then
6448
SetHighlightRow(-1);}
6449
if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
6450
AddAction(eaMoveCursor,OldPos,CurPos,'',GetFlags);
6451
if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) then
6452
PositionChanged;{UpdateIndicator;}
6456
procedure TCustomCodeEditor.CheckSels;
6458
if (SelStart.Y>SelEnd.Y) or
6459
( (SelStart.Y=SelEnd.Y) and (SelStart.X>SelEnd.X) ) then
6460
SetSelection(SelEnd,SelStart);
6463
procedure TCustomCodeEditor.CodeCompleteApply;
6470
{ here should be some kind or "mark" or "break" inserted in the Undo
6471
information, so activating it "undoes" only the completition first and
6472
doesn't delete the complete word at once... - Gabor }
6474
FragLen:=Length(GetCodeCompleteFrag);
6475
S:=GetCodeCompleteWord;
6476
for I:=FragLen+1 to length(S) do
6480
SetCompleteState(csInactive);
6483
procedure TCustomCodeEditor.CodeCompleteCancel;
6485
SetCompleteState(csDenied);
6488
procedure TCustomCodeEditor.CodeCompleteCheck;
6491
CurWord,NewWord: string;
6493
SetCodeCompleteFrag('');
6494
if (not IsFlagSet(efCodeComplete)) or (IsReadOnly=true) then Exit;
6498
Line:=GetDisplayText(CurPos.Y);
6499
X:=CurPos.X; CurWord:='';
6500
if X<=length(Line) then
6501
while (X>0) and (Line[X] in (NumberChars+AlphaChars)) do
6503
CurWord:=Line[X]+CurWord;
6507
if (length(CurWord)>=CodeCompleteMinLen) and CompleteCodeWord(CurWord,NewWord) then
6509
SetCodeCompleteFrag(CurWord);
6510
SetCodeCompleteWord(NewWord);
6513
ClearCodeCompleteWord;
6518
function TCustomCodeEditor.GetCodeCompleteFrag: string;
6521
GetCodeCompleteFrag:='';
6524
procedure TCustomCodeEditor.SetCodeCompleteFrag(const S: string);
6529
procedure TCustomCodeEditor.DrawLines(FirstLine: sw_integer);
6531
if FirstLine>=(Delta.Y+Size.Y) then Exit; { falls outside of the screen }
6535
procedure TCustomCodeEditor.HideHighlight;
6537
SetHighlight(CurPos,CurPos);
6540
procedure TCustomCodeEditor.GetSelectionArea(var StartP,EndP: TPoint);
6542
StartP:=SelStart; EndP:=SelEnd;
6546
EndP.X:=length(GetDisplayText(EndP.Y))-1;
6552
function TCustomCodeEditor.ValidBlock: boolean;
6554
ValidBlock:=(SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y);
6557
procedure TCustomCodeEditor.SetSelection(A, B: TPoint);
6562
OS:=SelStart; OE:=SelEnd;
6563
SelStart:=A; SelEnd:=B;
6564
if (WV=false) and (ValidBlock=false) then { do nothing } else
6565
if (OS.X<>SelStart.X) or (OS.Y<>SelStart.Y) or
6566
(OE.X<>SelEnd.X) or (OE.Y<>SelEnd.Y) then
6570
procedure TCustomCodeEditor.SetHighlight(A, B: TPoint);
6572
Highlight.A:=A; Highlight.B:=B;
6576
{procedure TCustomCodeEditor.SetHighlightRow(Row: sw_integer);
6582
{procedure TCodeEditor.SetDebuggerRow(Row: sw_integer);
6588
procedure TCustomCodeEditor.SelectAll(Enable: boolean);
6591
if (Enable=false) or (GetLineCount=0) then
6592
begin A:=CurPos; B:=CurPos end
6596
{ B.Y:=GetLineCount-1;
6597
B.X:=length(GetLineText(B.Y));}
6598
B.Y:=GetLineCount; B.X:=0;
6604
procedure TCustomCodeEditor.SelectionChanged;
6605
var Enable,CanPaste: boolean;
6607
if GetLineCount=0 then
6609
SelStart.X:=0; SelStart.Y:=0; SelEnd:=SelStart;
6612
if SelEnd.Y>GetLineCount-1 then
6613
if (SelEnd.Y<>GetLineCount) or (SelEnd.X<>0) then
6615
SelEnd.Y:=GetLineCount-1;
6616
SelEnd.X:=length(GetDisplayText(SelEnd.Y));
6619
{ we change the CurCommandSet, but only if we are top view }
6620
if ((State and sfFocused)<>0) then
6622
Enable:=((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) and (Clipboard<>nil);
6623
SetCmdState(ToClipCmds,Enable and (Clipboard<>@Self));
6624
SetCmdState(NulClipCmds,Enable);
6625
CanPaste:=(Clipboard<>nil) and ((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
6626
(Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
6627
SetCmdState(FromClipCmds,CanPaste and (Clipboard<>@Self));
6628
SetCmdState(UndoCmd,(GetUndoActionCount>0));
6629
SetCmdState(RedoCmd,(GetRedoActionCount>0));
6630
Message(Application,evBroadcast,cmCommandSetChanged,nil);
6635
procedure TCustomCodeEditor.HighlightChanged;
6640
procedure TCustomCodeEditor.SetState(AState: Word; Enable: Boolean);
6641
procedure ShowSBar(SBar: PScrollBar);
6643
if Assigned(SBar) and (SBar^.GetState(sfVisible)=false) then
6647
inherited SetState(AState,Enable);
6649
if AlwaysShowScrollBars then
6651
ShowSBar(HScrollBar);
6652
ShowSBar(VScrollBar);
6655
if (AState and (sfActive+sfSelected+sfFocused))<>0 then
6658
if ((State and sfFocused)=0) and (GetCompleteState=csOffering) then
6659
ClearCodeCompleteWord;
6663
function TCustomCodeEditor.GetPalette: PPalette;
6664
const P: string[length(CEditor)] = CEditor;
6669
function TCustomCodeEditorCore.LoadFromStream(Editor: PCustomCodeEditor; Stream: PFastBufStream): boolean;
6671
AllLinesComplete,LineComplete,hasCR,OK: boolean;
6675
AllLinesComplete:=true;
6676
OK:=(Stream^.Status=stOK);
6677
if eofstream(Stream) then
6681
while OK and (eofstream(Stream)=false) and (GetLineCount<MaxLineCount) do
6683
if not UseOldBufStreamMethod then
6684
Stream^.Readline(S,LineComplete,hasCR)
6686
ReadlnFromStream(Stream,S,LineComplete,hasCR);
6687
AllLinesComplete:=AllLinesComplete and LineComplete;
6688
OK:=OK and (Stream^.Status=stOK);
6689
if OK then AddLine(S);
6690
if not LineComplete and (ChangedLine=-1) then
6691
ChangedLine:=GetLineCount;
6693
{ Do not remove the final newline if it exists PM }
6698
if not AllLinesComplete then
6700
if (GetLineCount=MaxLineCount) and not eofstream(stream) then
6701
EditorDialog(edTooManyLines,nil);
6705
function TCustomCodeEditorCore.SaveAreaToStream(Editor: PCustomCodeEditor; Stream: PStream; StartP,EndP: TPoint): boolean;
6714
EndP.X:=length(GetDisplayText(EndP.Y));
6721
OK:=(Stream^.Status=stOK); Line:=StartP.Y;
6722
while OK and (Line<=EndP.Y) and (Line<GetLineCount) do
6724
S:=GetLineText(Line);
6725
{ Remove all traling spaces PM }
6726
if not Editor^.IsFlagSet(efKeepTrailingSpaces) then
6727
While (Length(S)>0) and (S[Length(S)]=' ') do
6729
{ if FlagSet(efUseTabCharacters) then
6730
S:=CompressUsingTabs(S,TabSize);
6732
if Line=EndP.Y then S:=copy(S,1,LinePosToCharIdx(Line,EndP.X));
6733
if Line=StartP.Y then S:=copy(S,LinePosToCharIdx(Line,StartP.X),High(S));
6734
Stream^.Write(S[1],length(S));
6736
Stream^.Write(EOL[1],length(EOL));
6738
OK:=OK and (Stream^.Status=stOK);
6740
SaveAreaToStream:=OK;
6744
constructor TEditorAction.init(act:byte; StartP,EndP:TPoint;Txt:String;AFlags : longint);
6756
constructor TEditorAction.init_group(act:byte);
6764
function TEditorAction.Is_grouped_action : boolean;
6766
Is_grouped_action:=IsGrouped;
6769
destructor TEditorAction.done;
6776
function TEditorActionCollection.At(Idx : sw_integer) : PEditorAction;
6778
At:=PEditorAction(Inherited At(Idx));
6781
procedure TEditorInputLine.HandleEvent(var Event : TEvent);
6786
If (Event.What=evKeyDown) then
6788
if (Event.KeyCode=kbRight) and
6789
(CurPos = Length(Data^)) and
6790
Assigned(FindReplaceEditor) then
6792
s:=FindReplaceEditor^.GetDisplayText(FindReplaceEditor^.CurPos.Y);
6793
s:=Copy(s,FindReplaceEditor^.CurPos.X + 1 -length(Data^),high(s));
6797
s:=Data^+s[i+length(Data^)];
6798
If not assigned(validator) or
6799
Validator^.IsValidInput(s,False) then
6801
Event.CharCode:=s[length(s)];
6803
Inherited HandleEvent(Event);
6808
else if (Event.KeyCode=kbShiftIns) and
6809
Assigned(Clipboard) and (Clipboard^.ValidBlock) then
6810
{ paste from clipboard }
6812
i:=Clipboard^.SelStart.Y;
6813
s:=Clipboard^.GetDisplayText(i);
6814
i:=Clipboard^.SelStart.X;
6816
s:=copy(s,i+1,high(s));
6817
if (Clipboard^.SelStart.Y=Clipboard^.SelEnd.Y) then
6819
i:=Clipboard^.SelEnd.X-i;
6822
for i:=1 to length(s) do
6825
If not assigned(validator) or
6826
Validator^.IsValidInput(s2,False) then
6828
Event.What:=evKeyDown;
6829
Event.CharCode:=s[i];
6831
Inherited HandleEvent(Event);
6836
else if (Event.KeyCode=kbCtrlIns) and
6837
Assigned(Clipboard) then
6838
{ Copy to clipboard }
6841
s:=copy(s,selstart+1,selend-selstart);
6842
Clipboard^.SelStart:=Clipboard^.CurPos;
6843
Clipboard^.InsertText(s);
6844
Clipboard^.SelEnd:=Clipboard^.CurPos;
6847
else if (Event.KeyCode=kbShiftDel) and
6848
Assigned(Clipboard) then
6849
{ Cut to clipboard }
6852
s:=copy(s,selstart+1,selend-selstart);
6853
Clipboard^.SelStart:=Clipboard^.CurPos;
6854
Clipboard^.InsertText(s);
6855
Clipboard^.SelEnd:=Clipboard^.CurPos;
6857
{ now remove the selected part }
6858
Event.keyCode:=kbDel;
6859
inherited HandleEvent(Event);
6863
Inherited HandleEvent(Event);
6866
Inherited HandleEvent(Event);
6869
function CreateFindDialog: PDialog;
6872
IL1: PEditorInputLine;
6875
RB1,RB2,RB3: PRadioButtons;
6877
R.Assign(0,0,56,15);
6878
New(D, Init(R, dialog_find));
6881
Options:=Options or ofCentered;
6882
GetExtent(R); R.Grow(-3,-2);
6883
R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
6884
R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
6885
New(IL1, Init(R2, FindStrSize));
6886
IL1^.Data^:=FindStr;
6888
Insert(New(PLabel, Init(R1, label_find_texttofind, IL1)));
6889
R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
6890
Control := New(PHistory, Init(R1, IL1, TextFindId));
6893
R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
6894
R2.Copy(R1); R2.Move(0,1);
6895
R2.B.Y:=R2.A.Y+{$ifdef TEST_REGEXP}3{$else}2{$endif};
6897
NewSItem(label_find_casesensitive,
6898
NewSItem(label_find_wholewordsonly,
6899
{$ifdef TEST_REGEXP}
6900
NewSItem(label_find_useregexp,
6901
{$endif TEST_REGEXP}
6902
nil)))){$ifdef TEST_REGEXP}){$endif TEST_REGEXP};
6904
Insert(New(PLabel, Init(R1, label_find_options, CB1)));
6906
R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
6907
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
6909
NewSItem(label_find_forward,
6910
NewSItem(label_find_backward,
6913
Insert(New(PLabel, Init(R1, label_find_direction, RB1)));
6915
R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
6916
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
6918
NewSItem(label_find_global,
6919
NewSItem(label_find_selectedtext,
6922
Insert(New(PLabel, Init(R1, label_find_scope, RB2)));
6924
R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
6925
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
6927
NewSItem(label_find_fromcursor,
6928
NewSItem(label_find_entirescope,
6931
Insert(New(PLabel, Init(R1, label_find_origin, RB3)));
6933
GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
6934
Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
6936
Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
6939
CreateFindDialog := D;
6942
function CreateReplaceDialog: PDialog;
6946
IL1: PEditorInputLine;
6947
IL2: PEditorInputLine;
6949
RB1,RB2,RB3: PRadioButtons;
6951
R.Assign(0,0,56,18);
6952
New(D, Init(R, dialog_replace));
6955
Options:=Options or ofCentered;
6956
GetExtent(R); R.Grow(-3,-2);
6957
R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
6958
R2.Copy(R); R2.B.X:=R2.B.X-3;R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
6959
New(IL1, Init(R2, FindStrSize));
6960
IL1^.Data^:=FindStr;
6962
Insert(New(PLabel, Init(R1, label_replace_texttofind, IL1)));
6963
R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
6964
Control := New(PHistory, Init(R1, IL1, TextFindId));
6967
R1.Copy(R); R1.Move(0,2); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
6968
R2.Copy(R); R2.Move(0,2);R2.B.X:=R2.B.X-3;
6969
R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
6970
New(IL2, Init(R2, FindStrSize));
6971
IL2^.Data^:=ReplaceStr;
6973
Insert(New(PLabel, Init(R1, label_replace_newtext, IL2)));
6974
R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
6975
Control := New(PHistory, Init(R1, IL2, TextReplaceId));
6978
R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
6979
R2.Copy(R1); R2.Move(0,1);
6980
R2.B.Y:=R2.A.Y+{$ifdef TEST_REGEXP}4{$else}3{$endif};
6982
NewSItem(label_replace_casesensitive,
6983
NewSItem(label_replace_wholewordsonly,
6984
NewSItem(label_replace_promptonreplace,
6985
{$ifdef TEST_REGEXP}
6986
NewSItem(label_find_useregexp,
6987
{$endif TEST_REGEXP}
6988
nil))))){$ifdef TEST_REGEXP}){$endif TEST_REGEXP};
6990
Insert(New(PLabel, Init(R1, label_replace_options, CB1)));
6992
R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
6993
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
6995
NewSItem(label_replace_forward,
6996
NewSItem(label_replace_backward,
6999
Insert(New(PLabel, Init(R1, label_replace_direction, RB1)));
7001
R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
7002
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
7004
NewSItem(label_replace_global,
7005
NewSItem(label_replace_selectedtext,
7008
Insert(New(PLabel, Init(R1, label_replace_scope, RB2)));
7010
R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
7011
R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
7013
NewSItem(label_replace_fromcursor,
7014
NewSItem(label_replace_entirescope,
7017
Insert(New(PLabel, Init(R1, label_replace_origin, RB3)));
7019
GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10; R.Move(-10,0);
7020
Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
7021
R.Move(11,0); R.B.X:=R.A.X+14;
7022
Insert(New(PButton, Init(R, btn_replace_changeall, cmYes, bfNormal)));
7023
R.Move(15,0); R.B.X:=R.A.X+10;
7024
Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
7027
CreateReplaceDialog := D;
7030
function CreateGotoLineDialog(Info: pointer): PDialog;
7034
IL: PEditorInputLine;
7037
New(D, Init(R, dialog_gotoline));
7040
Options:=Options or ofCentered;
7041
GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
7042
R1.Copy(R); R1.B.X:=27; R2.Copy(R);
7043
R2.B.X:=R2.B.X-3;R2.A.X:=27;
7044
New(IL, Init(R2,5));
7045
with TGotoLineDialogRec(Info^) do
7046
IL^.SetValidator(New(PRangeValidator, Init(1, Lines)));
7048
Insert(New(PLabel, Init(R1, label_gotoline_linenumber, IL)));
7049
R1.Assign(R2.B.X, R2.A.Y, R2.B.X+3, R2.B.Y);
7050
Control := New(PHistory, Init(R1, IL, GotoId));
7053
GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
7054
Insert(New(PButton, Init(R, btn_OK, cmOK, bfDefault)));
7056
Insert(New(PButton, Init(R, btn_Cancel, cmCancel, bfNormal)));
7059
CreateGotoLineDialog:=D;
7062
function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
7069
StoreDir,StoreDir2 : DirStr;
7070
Title,DefExt: string;
7075
StdEditorDialog := AdvMessageBox(msg_notenoughmemoryforthisoperation,
7076
nil, mfInsertInApp+ mfError + mfOkButton);
7078
StdEditorDialog := AdvMessageBox(msg_errorreadingfile,
7079
@Info, mfInsertInApp+ mfError + mfOkButton);
7081
StdEditorDialog := AdvMessageBox(msg_errorwritingfile,
7082
@Info, mfInsertInApp+ mfError + mfOkButton);
7084
StdEditorDialog := AdvMessageBox(msg_errorsavingfile,
7085
@Info, mfInsertInApp+ mfError + mfOkButton);
7087
StdEditorDialog := AdvMessageBox(msg_errorcreatingfile,
7088
@Info, mfInsertInApp+ mfError + mfOkButton);
7090
StdEditorDialog := AdvMessageBox(msg_filehasbeenmodifiedsave,
7091
@Info, mfInsertInApp+ mfInformation + mfYesNoCancel);
7093
StdEditorDialog := AdvMessageBox(msg_saveuntitledfile,
7094
nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
7096
StdEditorDialog := AdvMessageBox(msg_filehadtoolonglines,
7097
Info, mfInsertInApp+ mfOKButton + mfInformation);
7098
edFileOnDiskChanged:
7099
StdEditorDialog := AdvMessageBox(msg_filewasmodified,
7100
@info, mfInsertInApp+ mfInformation + mfYesNoCancel);
7101
edReloadDiskmodifiedFile:
7102
StdEditorDialog := AdvMessageBox(msg_reloaddiskmodifiedfile,
7103
@info, mfInsertInApp+ mfInformation + mfYesNoCancel);
7104
edReloadDiskAndIDEModifiedFile:
7105
StdEditorDialog := AdvMessageBox(msg_reloaddiskandidemodifiedfile,
7106
@info, mfInsertInApp+ mfInformation + mfYesNoCancel);
7107
edSaveAs,edWriteBlock,edReadBlock:
7109
Name:=PString(Info)^;
7112
if (Length(FileDir)>1) and (FileDir[2]=':') then
7114
{ does not assume that lowercase are greater then uppercase ! }
7115
if (FileDir[1]>='a') and (FileDir[1]<='z') then
7116
DriveNumber:=Ord(FileDir[1])-ord('a')+1
7118
DriveNumber:=Ord(FileDir[1])-ord('A')+1;
7119
GetDir(DriveNumber,StoreDir2);
7121
ChDir(Copy(FileDir,1,2));
7128
ChDir(TrimEndSlash(FileDir));
7135
Title:=dialog_savefileas;
7136
DefExt:='*'+DefaultSaveExt;
7140
Title:=dialog_writeblocktofile;
7145
Title:=dialog_readblockfromfile;
7148
else begin Title:='???'; DefExt:=''; end;
7150
Re:=Application^.ExecuteDialog(New(PFileDialog, Init(DefExt,
7151
Title, label_name, fdOkButton, FileId)), @Name);
7155
if ExtOf(Name)='' then
7156
Name:=Name+DefaultSaveExt;
7157
AskOW:=(Name<>PString(Info)^);
7161
if ExtOf(Name)='' then
7162
Name:=Name+DefaultSaveExt;
7165
edReadBlock : AskOW:=false;
7168
if (Re<>cmCancel) and AskOW then
7170
FileDir:=DirOf(FExpand(Name));
7171
if ExistsFile(Name) then
7172
if EditorDialog(edReplaceFile,@Name)<>cmYes then
7175
if DriveNumber<>0 then
7178
if (Length(StoreDir)>1) and (StoreDir[2]=':') then
7179
ChDir(Copy(StoreDir,1,2));
7181
if StoreDir<>'' then
7182
ChDir(TrimEndSlash(StoreDir));
7184
if Re<>cmCancel then
7185
PString(Info)^:=Name;
7186
StdEditorDialog := Re;
7190
Application^.ExecuteDialog(CreateGotoLineDialog(Info), Info);
7193
Application^.ExecuteDialog(CreateFindDialog, Info);
7195
StdEditorDialog := AdvMessageBox(msg_searchstringnotfound,
7196
nil, mfInsertInApp+ mfError + mfOkButton);
7199
Application^.ExecuteDialog(CreateReplaceDialog, Info);
7202
{ Avoid placing the dialog on the same line as the cursor }
7203
R.Assign(0, 1, 40, 8);
7204
R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
7205
Desktop^.MakeGlobal(R.B, T);
7207
if PPoint(Info)^.Y <= T.Y then
7208
R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
7209
StdEditorDialog := AdvMessageBoxRect(R, msg_replacethisoccourence,
7210
nil, mfInsertInApp+ mfYesNoCancel + mfInformation);
7214
AdvMessageBox(msg_fileexistsoverwrite,@Info,mfInsertInApp+mfConfirmation+
7215
mfYesButton+mfNoButton);
7219
procedure RegisterWEditor;
added
removed
fpcsrc/ide/weditor.pas
