then
+ Result := Value.AsString;
+ end;
+end;
+
+procedure SetClipboardText(const Text: string);
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, ClipService) then
+ ClipService.SetClipboard(Text);
+end;
+
+end.
diff --git a/Source/Highlighters/SynHighlighterADSP21xx.pas b/Source/Highlighters/SynHighlighterADSP21xx.pas
index 1023cddb..a3ec9080 100644
--- a/Source/Highlighters/SynHighlighterADSP21xx.pas
+++ b/Source/Highlighters/SynHighlighterADSP21xx.pas
@@ -12,7 +12,7 @@
The Original Code is based on the wbADSP21xxSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Wynand Breytenbach.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -43,10 +43,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
@@ -295,8 +295,10 @@ TSynADSP21xxSyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function UseUserSettings(settingIndex: Integer): Boolean; override;
procedure EnumUserSettings(settings: TStrings); override;
+ {$ENDIF}
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
write fCommentAttri;
@@ -320,8 +322,12 @@ TSynADSP21xxSyn = class(TSynCustomHighlighter)
implementation
uses
- Windows,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst;
const
@@ -2489,6 +2495,7 @@ procedure TSynADSP21xxSyn.ResetRange;
fRange:= rsUnknown;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure TSynADSP21xxSyn.EnumUserSettings(settings: TStrings);
begin
{ returns the user settings that exist in the registry }
@@ -2595,6 +2602,7 @@ function TSynADSP21xxSyn.UseUserSettings(settingIndex: Integer): Boolean;
end;
finally StrLst.Free; end;
end;
+{$ENDIF}
function TSynADSP21xxSyn.IsFilterStored: Boolean;
begin
diff --git a/Source/Highlighters/SynHighlighterAWK.pas b/Source/Highlighters/SynHighlighterAWK.pas
index 1664c2f6..f100ab7a 100644
--- a/Source/Highlighters/SynHighlighterAWK.pas
+++ b/Source/Highlighters/SynHighlighterAWK.pas
@@ -43,10 +43,10 @@ interface
{$I SynEdit.inc}
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterAsm.pas b/Source/Highlighters/SynHighlighterAsm.pas
index a17475cd..c569b047 100644
--- a/Source/Highlighters/SynHighlighterAsm.pas
+++ b/Source/Highlighters/SynHighlighterAsm.pas
@@ -49,7 +49,7 @@ interface
System.Classes,
System.Generics.Defaults,
System.Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter;
diff --git a/Source/Highlighters/SynHighlighterBaan.pas b/Source/Highlighters/SynHighlighterBaan.pas
index dbc9aed4..b4b81d59 100644
--- a/Source/Highlighters/SynHighlighterBaan.pas
+++ b/Source/Highlighters/SynHighlighterBaan.pas
@@ -12,7 +12,7 @@
The Original Code is based on the mwBaanSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is "riceball".
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -44,10 +44,16 @@
interface
uses
- Windows, Messages, Controls, Graphics, Registry,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows, Winapi.Messages,
+ {$ENDIF}
+ System.UITypes,
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
+ Registry,
+ {$ENDIF}
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils, Classes;
type
diff --git a/Source/Highlighters/SynHighlighterBat.pas b/Source/Highlighters/SynHighlighterBat.pas
index 1af4e2d0..769653db 100644
--- a/Source/Highlighters/SynHighlighterBat.pas
+++ b/Source/Highlighters/SynHighlighterBat.pas
@@ -44,10 +44,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterCAC.pas b/Source/Highlighters/SynHighlighterCAC.pas
index 99555220..a6d00101 100644
--- a/Source/Highlighters/SynHighlighterCAC.pas
+++ b/Source/Highlighters/SynHighlighterCAC.pas
@@ -44,10 +44,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterCPM.pas b/Source/Highlighters/SynHighlighterCPM.pas
index 5e751aa8..49db08f6 100644
--- a/Source/Highlighters/SynHighlighterCPM.pas
+++ b/Source/Highlighters/SynHighlighterCPM.pas
@@ -34,10 +34,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterCS.pas b/Source/Highlighters/SynHighlighterCS.pas
index 79e8bd66..bd9d1df0 100644
--- a/Source/Highlighters/SynHighlighterCS.pas
+++ b/Source/Highlighters/SynHighlighterCS.pas
@@ -13,7 +13,7 @@
which in turn is based on the dcjCppSyn.pas file from the mwEdit component
suite by Martin Waldenburg and other developers, the Initial Author of this file
is Michael Trier.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -48,11 +48,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynEditMiscClasses,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes,
SynEditCodeFolding;
@@ -226,8 +225,10 @@ TSynCSSyn = class(TSynCustomCodeFoldingHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function UseUserSettings(settingIndex: Integer): Boolean; override;
procedure EnumUserSettings(settings: TStrings); override;
+ {$ENDIF}
property ExtTokenID: TxtkTokenKind read GetExtTokenID;
procedure ScanForFoldRanges(FoldRanges: TSynFoldRanges;
LinesToScan: TStrings; FromLine: Integer; ToLine: Integer); override;
@@ -256,8 +257,12 @@ TSynCSSyn = class(TSynCustomCodeFoldingHighlighter)
implementation
uses
- Windows,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst,
SynEditMiscProcs;
@@ -1864,6 +1869,7 @@ procedure TSynCSSyn.SetRange(Value: Pointer);
fRange := TRangeState(Value);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure TSynCSSyn.EnumUserSettings(settings: TStrings);
begin
{ returns the user settings that exist in the registry }
@@ -2006,6 +2012,7 @@ function TSynCSSyn.UseUserSettings(settingIndex: Integer): Boolean;
begin
Result := ReadCPPBSettings(settingIndex);
end; { TSynCSSyn.UseUserSettings }
+{$ENDIF}
function TSynCSSyn.GetSampleSource: string;
begin
diff --git a/Source/Highlighters/SynHighlighterCache.pas b/Source/Highlighters/SynHighlighterCache.pas
index 19454dbb..192947b0 100644
--- a/Source/Highlighters/SynHighlighterCache.pas
+++ b/Source/Highlighters/SynHighlighterCache.pas
@@ -44,10 +44,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterCobol.pas b/Source/Highlighters/SynHighlighterCobol.pas
index 95a6f084..8201300d 100644
--- a/Source/Highlighters/SynHighlighterCobol.pas
+++ b/Source/Highlighters/SynHighlighterCobol.pas
@@ -41,7 +41,7 @@ interface
System.Classes,
System.Generics.Defaults,
System.Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
System.RegularExpressions,
diff --git a/Source/Highlighters/SynHighlighterCpp.pas b/Source/Highlighters/SynHighlighterCpp.pas
index 2ed7d7b7..73bb4c4a 100644
--- a/Source/Highlighters/SynHighlighterCpp.pas
+++ b/Source/Highlighters/SynHighlighterCpp.pas
@@ -12,7 +12,7 @@
The Original Code is based on the dcjCppSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Michael Trier.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -44,11 +44,11 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
SysUtils,
- SynUnicode,
+ SynUnicodeShared,
Classes,
SynEditCodeFolding;
@@ -165,8 +165,10 @@ TSynCppSyn = class(TSynCustomCodeFoldingHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function UseUserSettings(settingIndex: Integer): Boolean; override;
procedure EnumUserSettings(settings: TStrings); override;
+ {$ENDIF}
property ExtTokenID: TxtkTokenKind read GetExtTokenID;
property NewPreprocesorStyle: Boolean read FNewPreprocesorStyle write SetNewPreprocesorStyle;
//++ CodeFolding
@@ -194,8 +196,12 @@ TSynCppSyn = class(TSynCustomCodeFoldingHighlighter)
implementation
uses
- Windows,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst,
SynEditMiscProcs;
@@ -1476,6 +1482,7 @@ procedure TSynCppSyn.SetRange(Value: Pointer);
fRange := TRangeState(Value);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure TSynCppSyn.EnumUserSettings(settings: TStrings);
begin
{ returns the user settings that exist in the registry }
@@ -1642,6 +1649,7 @@ function TSynCppSyn.UseUserSettings(settingIndex: Integer): Boolean;
begin
Result := ReadCPPBSettings(settingIndex);
end; { TSynCppSyn.UseUserSettings }
+{$ENDIF}
function TSynCppSyn.IsFilterStored: Boolean;
begin
diff --git a/Source/Highlighters/SynHighlighterCss.pas b/Source/Highlighters/SynHighlighterCss.pas
index 82690867..903973a6 100644
--- a/Source/Highlighters/SynHighlighterCss.pas
+++ b/Source/Highlighters/SynHighlighterCss.pas
@@ -16,7 +16,7 @@
this in turn was based on the hkHTMLSyn.pas file from the mwEdit component suite
by Martin Waldenburg and other developers, the Initial Author of this file is
Hideo Koiso.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -62,9 +62,10 @@ interface
System.Classes,
System.Generics.Defaults,
System.Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
- SynEditHighlighter;
+ SynEditHighlighter,
+ SynEditCodeFolding;
type
TtkTokenKind = (tkComment, tkAtRule, tkProperty, tkSelector, tkSelectorAttrib,
@@ -74,7 +75,7 @@ interface
TRangeState = (rsComment, rsSelector, rsDeclaration, rsUnknown, rsProperty,
rsValue, rsAttrib, rsParameter);
- TSynCssSyn = class(TSynCustomHighlighter)
+ TSynCssSyn = class(TSynCustomCodeFoldingHighlighter)
private
fRange: TRangeState;
fCommentRange: TRangeState;
@@ -145,6 +146,8 @@ TSynCssSyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ procedure ScanForFoldRanges(FoldRanges: TSynFoldRanges;
+ LinesToScan: TStrings; FromLine: Integer; ToLine: Integer); override;
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
write fCommentAttri;
@@ -1066,10 +1069,26 @@ procedure TSynCssSyn.ResetRange;
function TSynCssSyn.GetSampleSource: string;
begin
- Result := '/* Syntax Highlighting */'#13#10 +
- 'body { font-family: Tahoma, Verdana, Arial, Helvetica, sans-serif; font-size: 8pt }'#13#10 +
- 'H1 { font-size: 18pt; color: #000099; made-up-property: 1 }';
-end; { GetSampleSource }
+ Result :=
+ '/* Main Stylesheet */'#13#10 +
+ 'body {'#13#10 +
+ ' font-family: Arial, sans-serif;'#13#10 +
+ ' font-size: 14px;'#13#10 +
+ ' color: #333;'#13#10 +
+ '}'#13#10 +
+ 'h1 {'#13#10 +
+ ' font-size: 24px;'#13#10 +
+ ' color: #000099;'#13#10 +
+ '}'#13#10 +
+ '@media screen and (max-width: 768px) {'#13#10 +
+ ' body {'#13#10 +
+ ' font-size: 12px;'#13#10 +
+ ' }'#13#10 +
+ ' h1 {'#13#10 +
+ ' font-size: 18px;'#13#10 +
+ ' }'#13#10 +
+ '}';
+end;
class function TSynCssSyn.GetLanguageName: string;
begin
@@ -1096,6 +1115,105 @@ class function TSynCssSyn.GetFriendlyLanguageName: string;
Result := SYNS_FriendlyLangCSS;
end;
+// =============================================================================
+// Code Folding Support
+// =============================================================================
+
+procedure CountCssBraces(const S: string; out Opens, Closes: Integer;
+ var InComment: Boolean);
+{ Scan a single line for CSS brace pairs.
+ - Braces inside /* ... */ comments are ignored.
+ - Braces inside quoted strings ("..." or '...') are ignored.
+ - InComment persists across lines for multi-line comments. }
+var
+ I, Len: Integer;
+ InString: WideChar;
+begin
+ Opens := 0;
+ Closes := 0;
+ I := 1;
+ Len := Length(S);
+ InString := #0;
+
+ while I <= Len do
+ begin
+ if InComment then
+ begin
+ if (S[I] = '*') and (I < Len) and (S[I + 1] = '/') then
+ begin
+ InComment := False;
+ Inc(I, 2);
+ end
+ else
+ Inc(I);
+ end
+ else if InString <> #0 then
+ begin
+ if (S[I] = '\') and (I < Len) then
+ Inc(I, 2) // skip escaped character
+ else if S[I] = InString then
+ begin
+ InString := #0;
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end
+ else if (S[I] = '/') and (I < Len) and (S[I + 1] = '*') then
+ begin
+ InComment := True;
+ Inc(I, 2);
+ end
+ else if (S[I] = '"') or (S[I] = '''') then
+ begin
+ InString := S[I];
+ Inc(I);
+ end
+ else if S[I] = '{' then
+ begin
+ Inc(Opens);
+ Inc(I);
+ end
+ else if S[I] = '}' then
+ begin
+ Inc(Closes);
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end;
+end;
+
+procedure TSynCssSyn.ScanForFoldRanges(FoldRanges: TSynFoldRanges;
+ LinesToScan: TStrings; FromLine, ToLine: Integer);
+var
+ Line: Integer;
+ CurLine: string;
+ Opens, Closes: Integer;
+ InComment: Boolean;
+begin
+ InComment := False;
+
+ for Line := FromLine to ToLine do
+ begin
+ CurLine := LinesToScan[Line];
+ if Trim(CurLine) = '' then
+ begin
+ FoldRanges.NoFoldInfo(Line + 1);
+ Continue;
+ end;
+
+ CountCssBraces(CurLine, Opens, Closes, InComment);
+
+ if Opens > Closes then
+ FoldRanges.StartFoldRange(Line + 1, 1)
+ else if Closes > Opens then
+ FoldRanges.StopFoldRange(Line + 1, 1)
+ else
+ FoldRanges.NoFoldInfo(Line + 1);
+ end;
+end;
+
initialization
RegisterPlaceableHighlighter(TSynCssSyn);
end.
diff --git a/Source/Highlighters/SynHighlighterDOT.pas b/Source/Highlighters/SynHighlighterDOT.pas
index f1491f36..065345eb 100644
--- a/Source/Highlighters/SynHighlighterDOT.pas
+++ b/Source/Highlighters/SynHighlighterDOT.pas
@@ -12,7 +12,7 @@
The original code is: SynHighlighterDOT.pas, released 2002-11-30.
Description: DOT Syntax Parser/Highlighter
The initial author of this file is nissl (nissl@tiscali.it, nissl@mammuth.it)
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
Copyright (c) 2002, all rights reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -44,12 +44,13 @@
interface
uses
- Windows,
- Controls,
- Graphics,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterDWS.pas b/Source/Highlighters/SynHighlighterDWS.pas
index 56a2e54d..ff3eb950 100644
--- a/Source/Highlighters/SynHighlighterDWS.pas
+++ b/Source/Highlighters/SynHighlighterDWS.pas
@@ -41,8 +41,10 @@
interface
uses
+ {$IFDEF MSWINDOWS}
Winapi.Windows,
- Vcl.Graphics,
+ {$ENDIF}
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
System.SysUtils,
diff --git a/Source/Highlighters/SynHighlighterDelphi.pas b/Source/Highlighters/SynHighlighterDelphi.pas
index 7dc55f6a..3c9771a4 100644
--- a/Source/Highlighters/SynHighlighterDelphi.pas
+++ b/Source/Highlighters/SynHighlighterDelphi.pas
@@ -10,7 +10,7 @@
interface
uses
- SysUtils, Classes, Graphics, SynEditTypes, SynEditHighlighter,
+ SysUtils, Classes, System.UITypes, SynEditTypes, SynEditHighlighter,
SynEditCodeFolding, SynEditStrConst, System.Math, System.RegularExpressions;
type
@@ -43,7 +43,9 @@ TSynDelphiSyn = class(TSynCustomCodeFoldingHighlighter)
fRE_BlockBegin: TRegEx;
fRE_BlockEnd: TRegEx;
fRE_Code: TRegEx;
+ fRE_Interface: TRegEx;
fRE_Implementation: TRegEx;
+ fRE_Begin: TRegEx;
// Parsers
procedure AddressOpProc;
@@ -143,10 +145,12 @@ implementation
begin
// These are now initialized ONCE for the entire application lifetime
// and are scoped specifically to TSynDelphiSyn.
- FRE_BlockBegin := TRegEx.Create('\b(begin|record|class|case|try)\b', [roIgnoreCase]);
+ FRE_BlockBegin := TRegEx.Create('\b(begin|record|class(?!\s+(var|function|procedure|constructor|destructor|operator)\b)|case|try)\b', [roIgnoreCase]);
FRE_BlockEnd := TRegEx.Create('\bend\b', [roIgnoreCase]);
FRE_Code := TRegEx.Create('^\s*(function|procedure|constructor|destructor)\b', [roIgnoreCase]);
+ FRE_Interface := TRegEx.Create('^interface\b', [roIgnoreCase]);
FRE_Implementation := TRegEx.Create('^implementation\b', [roIgnoreCase]);
+ FRE_Begin := TRegEx.Create('\bbegin\b', [roIgnoreCase]);
end;
constructor TSynDelphiSyn.Create(AOwner: TComponent);
@@ -684,10 +688,11 @@ procedure TSynDelphiSyn.ScanForFoldRanges(FoldRanges: TSynFoldRanges;
var
CurLine: string;
Line: Integer;
+ PendingProcLine: Integer;
+ HasImplementation: Boolean;
function IsStartKeyword(const S: string): Boolean;
begin
- // Simple check for folding start blocks
Result := fRE_BlockBegin.IsMatch(S);
end;
@@ -697,6 +702,8 @@ procedure TSynDelphiSyn.ScanForFoldRanges(FoldRanges: TSynFoldRanges;
end;
begin
+ PendingProcLine := -1;
+ HasImplementation := False;
for Line := FromLine to ToLine do
begin
CurLine := Trim(LinesToScan[Line]);
@@ -711,19 +718,45 @@ procedure TSynDelphiSyn.ScanForFoldRanges(FoldRanges: TSynFoldRanges;
FoldRanges.StartFoldRange(Line + 1, FoldRegionType)
else if CurLine.ToUpper.StartsWith('{$ENDREGION') then
FoldRanges.StopFoldRange(Line + 1, FoldRegionType)
- // Implementation section
+ // Interface section
+ else if fRE_Interface.IsMatch(CurLine) then
+ FoldRanges.StartFoldRange(Line + 1, 18)
+ // Implementation section (closes interface fold, opens implementation)
else if fRE_Implementation.IsMatch(CurLine) then
- FoldRanges.StartFoldRange(Line + 1, 18) // FT_Implementation
- // Procedure/Function headers
+ begin
+ FoldRanges.StopStartFoldRange(Line + 1, 18);
+ HasImplementation := True;
+ end
+ // Procedure/Function headers - defer fold until begin is found
else if fRE_Code.IsMatch(CurLine) then
- FoldRanges.StartFoldRange(Line + 1, 16) // FT_CodeDeclaration
- // Standard Blocks (begin..end)
+ PendingProcLine := Line + 1
+ // Standard Blocks
else
begin
if IsStartKeyword(CurLine) then
- FoldRanges.StartFoldRange(Line + 1, 1)
+ begin
+ if (PendingProcLine >= 0) and fRE_Begin.IsMatch(CurLine) then
+ begin
+ // begin after procedure/function: fold from the header line
+ FoldRanges.StartFoldRange(PendingProcLine, 1);
+ PendingProcLine := -1;
+ end
+ else
+ begin
+ // record/class/case/try or standalone begin
+ FoldRanges.StartFoldRange(Line + 1, 1);
+ PendingProcLine := -1;
+ end;
+ end
else if IsEndKeyword(CurLine) then
- FoldRanges.StopFoldRange(Line + 1, 1);
+ begin
+ // end. closes implementation section; end; closes block
+ if HasImplementation and CurLine.ToUpper.StartsWith('END.') then
+ FoldRanges.StopFoldRange(Line + 1, 18)
+ else
+ FoldRanges.StopFoldRange(Line + 1, 1);
+ PendingProcLine := -1;
+ end;
end;
end;
end;
diff --git a/Source/Highlighters/SynHighlighterDfm.pas b/Source/Highlighters/SynHighlighterDfm.pas
index 6a710c2c..9c5371bd 100644
--- a/Source/Highlighters/SynHighlighterDfm.pas
+++ b/Source/Highlighters/SynHighlighterDfm.pas
@@ -44,10 +44,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterDml.pas b/Source/Highlighters/SynHighlighterDml.pas
index d140f067..4eec9ca3 100644
--- a/Source/Highlighters/SynHighlighterDml.pas
+++ b/Source/Highlighters/SynHighlighterDml.pas
@@ -46,10 +46,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterEiffel.pas b/Source/Highlighters/SynHighlighterEiffel.pas
index 44c74936..d5fc5de0 100644
--- a/Source/Highlighters/SynHighlighterEiffel.pas
+++ b/Source/Highlighters/SynHighlighterEiffel.pas
@@ -43,10 +43,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterFortran.pas b/Source/Highlighters/SynHighlighterFortran.pas
index bb7ef113..bb056e75 100644
--- a/Source/Highlighters/SynHighlighterFortran.pas
+++ b/Source/Highlighters/SynHighlighterFortran.pas
@@ -44,10 +44,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterFoxpro.pas b/Source/Highlighters/SynHighlighterFoxpro.pas
index 12aa985b..c0a796c8 100644
--- a/Source/Highlighters/SynHighlighterFoxpro.pas
+++ b/Source/Highlighters/SynHighlighterFoxpro.pas
@@ -50,7 +50,7 @@ interface
System.Classes,
System.Generics.Defaults,
System.Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
System.RegularExpressions,
diff --git a/Source/Highlighters/SynHighlighterGWS.pas b/Source/Highlighters/SynHighlighterGWS.pas
index c7a26be2..7c7fb866 100644
--- a/Source/Highlighters/SynHighlighterGWS.pas
+++ b/Source/Highlighters/SynHighlighterGWS.pas
@@ -38,10 +38,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
diff --git a/Source/Highlighters/SynHighlighterGalaxy.pas b/Source/Highlighters/SynHighlighterGalaxy.pas
index 6cb8cab5..9d2c1973 100644
--- a/Source/Highlighters/SynHighlighterGalaxy.pas
+++ b/Source/Highlighters/SynHighlighterGalaxy.pas
@@ -12,7 +12,7 @@
The Original Code is based on the mkGalaxySyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Martijn van der Kooij.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -45,10 +45,13 @@
interface
uses
- Windows,
- Graphics,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ System.UITypes,
+ SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils, Classes;
type
@@ -99,8 +102,10 @@ TSynGalaxySyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function SaveToRegistry(RootKey: HKEY; Key: string): Boolean; override;
function LoadFromRegistry(RootKey: HKEY; Key: string): Boolean; override;
+ {$ENDIF}
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
write fCommentAttri;
@@ -117,7 +122,9 @@ TSynGalaxySyn = class(TSynCustomHighlighter)
implementation
uses
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst;
function TSynGalaxySyn.IsIdentChar(AChar: WideChar): Boolean;
@@ -386,6 +393,7 @@ class function TSynGalaxySyn.GetLanguageName: string;
Result := SYNS_LangGalaxy;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function TSynGalaxySyn.LoadFromRegistry(RootKey: HKEY; Key: string): Boolean;
var
r: TRegistry;
@@ -423,6 +431,7 @@ function TSynGalaxySyn.SaveToRegistry(RootKey: HKEY; Key: string): Boolean;
r.Free;
end;
end;
+{$ENDIF}
class function TSynGalaxySyn.GetFriendlyLanguageName: string;
begin
diff --git a/Source/Highlighters/SynHighlighterGeneral.pas b/Source/Highlighters/SynHighlighterGeneral.pas
index f4460127..10d19508 100644
--- a/Source/Highlighters/SynHighlighterGeneral.pas
+++ b/Source/Highlighters/SynHighlighterGeneral.pas
@@ -13,7 +13,7 @@
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Martin Waldenburg.
Portions written by Martin Waldenburg are copyright 1999 Martin Waldenburg.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -44,11 +44,13 @@
interface
uses
- Windows,
- Graphics,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
@@ -137,8 +139,10 @@ TSynGeneralSyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure ResetRange; override;
procedure SetRange(Value: Pointer); override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function SaveToRegistry(RootKey: HKEY; Key: string): Boolean; override;
function LoadFromRegistry(RootKey: HKEY; Key: string): Boolean; override;
+ {$ENDIF}
property OnGetTokenAttribute: TGetTokenAttributeEvent read fOnGetTokenAttribute write fOnGetTokenAttribute;
property StringMultiLine: Boolean read FStringMultiLine write FStringMultiLine;
published
@@ -170,7 +174,9 @@ TSynGeneralSyn = class(TSynCustomHighlighter)
implementation
uses
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst;
function TSynGeneralSyn.IsIdentChar(AChar: WideChar): Boolean;
@@ -717,6 +723,7 @@ class function TSynGeneralSyn.GetLanguageName: string;
Result := SYNS_LangGeneral;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function TSynGeneralSyn.LoadFromRegistry(RootKey: HKEY; Key: string): Boolean;
var
Reg: TRegistry;
@@ -749,6 +756,7 @@ function TSynGeneralSyn.SaveToRegistry(RootKey: HKEY; Key: string): Boolean;
Result := False;
finally Reg.Free; end;
end;
+{$ENDIF}
function TSynGeneralSyn.GetStringDelim: TStringDelim;
begin
diff --git a/Source/Highlighters/SynHighlighterHC11.pas b/Source/Highlighters/SynHighlighterHC11.pas
index 71784166..ee5c875e 100644
--- a/Source/Highlighters/SynHighlighterHC11.pas
+++ b/Source/Highlighters/SynHighlighterHC11.pas
@@ -49,7 +49,7 @@ interface
System.Classes,
System.Generics.Defaults,
System.Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter;
diff --git a/Source/Highlighters/SynHighlighterHP48.pas b/Source/Highlighters/SynHighlighterHP48.pas
index 37397f50..42d8821b 100644
--- a/Source/Highlighters/SynHighlighterHP48.pas
+++ b/Source/Highlighters/SynHighlighterHP48.pas
@@ -12,7 +12,7 @@
The Original Code is based on the cbHPSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Cyrille de Brebisson.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -43,11 +43,15 @@
interface
uses
- Windows,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
- Graphics,
+ {$ENDIF}
+ System.UITypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
@@ -170,8 +174,10 @@ TSynHP48Syn = class(TSynCustomHighLighter)
function GetRange: Pointer; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function SaveToRegistry(RootKey: HKEY; Key: string): Boolean; override;
function LoadFromRegistry(RootKey: HKEY; Key: string): Boolean; override;
+ {$ENDIF}
procedure Assign(Source: TPersistent); override;
property AsmKeyWords: TSpeedStringList read FAsmKeyWords;
property SAsmFoField: TSpeedStringList read FSAsmNoField;
@@ -797,6 +803,7 @@ procedure TSynHP48Syn.EndOfToken;
Inc(Run);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function TSynHP48Syn.LoadFromRegistry(RootKey: HKEY; Key: string): Boolean;
var
r: TRegistry;
@@ -835,6 +842,7 @@ function TSynHP48Syn.SaveToRegistry(RootKey: HKEY; Key: string): Boolean;
finally r.Free;
end;
end;
+{$ENDIF}
procedure TSynHP48Syn.Assign(Source: TPersistent);
var
diff --git a/Source/Highlighters/SynHighlighterHaskell.pas b/Source/Highlighters/SynHighlighterHaskell.pas
index 032764ed..4aee5f78 100644
--- a/Source/Highlighters/SynHighlighterHaskell.pas
+++ b/Source/Highlighters/SynHighlighterHaskell.pas
@@ -13,7 +13,7 @@
which in turn was based on the dcjCppSyn.pas file from the mwEdit component
suite by Martin Waldenburg and other developers, the Initial Author of this file
is Michael Trier.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -49,10 +49,10 @@
interface
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SysUtils,
Classes;
@@ -153,7 +153,9 @@ TSynHaskellSyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure EnumUserSettings(settings: TStrings); override;
+ {$ENDIF}
property ExtTokenID: TxtkTokenKind read GetExtTokenID;
published
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
@@ -174,8 +176,12 @@ TSynHaskellSyn = class(TSynCustomHighlighter)
implementation
uses
- Windows,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Registry,
+ {$ENDIF}
SynEditStrConst;
const
@@ -891,6 +897,7 @@ procedure TSynHaskellSyn.SetRange(Value: Pointer);
fRange := TRangeState(Value);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure TSynHaskellSyn.EnumUserSettings(settings: TStrings);
begin
{ returns the user settings that exist in the registry }
@@ -911,6 +918,7 @@ procedure TSynHaskellSyn.EnumUserSettings(settings: TStrings);
end;
end;
end;
+{$ENDIF}
function TSynHaskellSyn.IsFilterStored: Boolean;
begin
diff --git a/Source/Highlighters/SynHighlighterHtml.pas b/Source/Highlighters/SynHighlighterHtml.pas
index 4d79464c..0224f5a6 100644
--- a/Source/Highlighters/SynHighlighterHtml.pas
+++ b/Source/Highlighters/SynHighlighterHtml.pas
@@ -12,7 +12,7 @@
The Original Code is based on the hkHTMLSyn.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Hideo Koiso.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
HTML5 tags added by CodehunterWorks
All Rights Reserved.
@@ -49,10 +49,11 @@ interface
{$I SynEdit.inc}
uses
- Graphics,
+ System.UITypes,
SynEditTypes,
SynEditHighlighter,
- SynUnicode,
+ SynEditCodeFolding,
+ SynUnicodeShared,
SysUtils,
Classes;
@@ -85,7 +86,7 @@ interface
('Ψ'), { ? } { greek capital psi }
('Ω'), { O } { greek capital omega }
('α'), { a } { greek small alpha }
- ('β'), { } { greek small beta }
+ ('β'), { � } { greek small beta }
('γ'), { ? } { greek small gamma }
('δ'), { d } { greek small delta }
('ε'), { e } { greek small epsilon }
@@ -95,7 +96,7 @@ interface
('ι'), { ? } { greek small iota }
('κ'), { ? } { greek small kappa }
('λ'), { ? } { greek small lambda }
- ('μ'), { } { greek small mu }
+ ('μ'), { � } { greek small mu }
('ν'), { ? } { greek small nu }
('ξ'), { ? } { greek small xi }
('ο'), { ? } { greek small omicron }
@@ -112,8 +113,8 @@ interface
('ϑ'), { ? } { greek small theta symbol }
('ϒ'), { ? } { greek upsilon with hook symbol }
('ϖ'), { ? } { greek pi symbol }
- ('•'), { } { bullet }
- ('…'), { } { horizontal ellipsis }
+ ('•'), { � } { bullet }
+ ('…'), { � } { horizontal ellipsis }
('′'), { ' } { prime }
('″'), { " } { double prime }
('‾'), { ? } { overline, = spacing overscore }
@@ -121,7 +122,7 @@ interface
('℘'), { P } { script capital P }
('ℑ'), { I } { imaginary part }
('ℜ'), { R } { real part }
- ('™'), { } { trademark sign }
+ ('™'), { � } { trademark sign }
('ℵ'), { ? } { first transfinite cardinal }
('←'), { ? } { leftwards arrow }
('↑'), { ? } { upwards arrow }
@@ -137,7 +138,7 @@ interface
('∀'), { ? } { for all }
('∂'), { ? } { partial differential }
('∃'), { ? } { there exists }
- ('∅'), { } { empty set }
+ ('∅'), { � } { empty set }
('∇'), { ? } { backward difference }
('∈'), { ? } { element of }
('∉'), { ? } { not an element of }
@@ -158,7 +159,7 @@ interface
('∴'), { ? } { therefore }
('∼'), { ~ } { similar to = tilde operator }
('≅'), { ? } { approximately equal to }
- ('≈'), { } { almost euqal to }
+ ('≈'), { � } { almost euqal to }
('≠'), { ? } { not equal to }
('≡'), { = } { identical to }
('≤'), { = } { less-than or equal to }
@@ -171,7 +172,7 @@ interface
('⊕'), { ? } { circled plus }
('⊗'), { ? } { circled times }
('⊥'), { ? } { orthogonal to = perpendicular }
- ('⋅'), { } { dot operator }
+ ('⋅'), { � } { dot operator }
('⌈'), { ? } { left ceiling }
('⌉'), { ? } { right ceiling }
('⌊'), { ? } { left floor }
@@ -183,23 +184,23 @@ interface
('♣'), { ? } { black club suit }
('♥'), { ? } { black heart suit }
('♦'), { ? } { black diamond suit }
- ('‘'), { } { left single quote }
- ('’'), { } { right single quote }
- ('‚'), { } { single low-9 quote }
- ('“'), { } { left double quote }
- ('”'), { } { right double quote }
- ('„'), { } { double low-9 quote }
- ('†'), { } { dagger }
- ('‡'), { } { double dagger }
- ('‰'), { } { per mill sign }
- ('‹'), { } { single left-pointing angle quote }
- ('›'), { } { single right-pointing angle quote }
+ ('‘'), { � } { left single quote }
+ ('’'), { � } { right single quote }
+ ('‚'), { � } { single low-9 quote }
+ ('“'), { � } { left double quote }
+ ('”'), { � } { right double quote }
+ ('„'), { � } { double low-9 quote }
+ ('†'), { � } { dagger }
+ ('‡'), { � } { double dagger }
+ ('‰'), { � } { per mill sign }
+ ('‹'), { � } { single left-pointing angle quote }
+ ('›'), { � } { single right-pointing angle quote }
('"'), { " " } { double quotation mark }
('&'), { & & } { ampersand }
('<'), { < < } { less-than sign }
('>'), { > } { greater-than sign }
- ('–'), { – } { en dash }
- ('—'), { — } { em dash }
+ ('–'), { – � } { en dash }
+ ('—'), { — � } { em dash }
(' '), { } { nonbreaking space }
(' '), { } { thin space }
(' '), { } { en space }
@@ -207,108 +208,108 @@ interface
('¡'), { ¡ ! } { inverted exclamation }
('¢'), { ¢ c } { cent sign }
('£'), { £ L } { pound sterling }
- ('¤'), { ¤ } { general currency sign }
+ ('¤'), { ¤ � } { general currency sign }
('¥'), { ¥ Y } { yen sign }
- ('¦'), { ¦ } { broken vertical bar }
- ('&brkbar;'), { ¦ } { broken vertical bar }
- ('§'), { § } { section sign }
- ('¨'), { ¨ } { umlaut }
- ('¨'), { ¨ } { umlaut }
- ('©'), { © } { copyright }
+ ('¦'), { ¦ � } { broken vertical bar }
+ ('&brkbar;'), { ¦ � } { broken vertical bar }
+ ('§'), { § � } { section sign }
+ ('¨'), { ¨ � } { umlaut }
+ ('¨'), { ¨ � } { umlaut }
+ ('©'), { © � } { copyright }
('ª'), { ª a } { feminine ordinal }
- ('«'), { « } { left angle quote }
- ('¬'), { ¬ } { not sign }
- (''), { } { soft hyphen }
- ('®'), { ® } { registered trademark }
- ('¯'), { ¯ } { macron accent }
- ('&hibar;'), { ¯ } { macron accent }
- ('°'), { ° } { degree sign }
- ('±'), { ± } { plus or minus }
+ ('«'), { « � } { left angle quote }
+ ('¬'), { ¬ � } { not sign }
+ (''), { � } { soft hyphen }
+ ('®'), { ® � } { registered trademark }
+ ('¯'), { ¯ � } { macron accent }
+ ('&hibar;'), { ¯ � } { macron accent }
+ ('°'), { ° � } { degree sign }
+ ('±'), { ± � } { plus or minus }
('²'), { ² 2 } { superscript two }
('³'), { ³ 3 } { superscript three }
- ('´'), { ´ } { acute accent }
- ('µ'), { µ } { micro sign }
- ('¶'), { ¶ } { paragraph sign }
- ('·'), { · } { middle dot }
- ('¸'), { ¸ } { cedilla }
+ ('´'), { ´ � } { acute accent }
+ ('µ'), { µ � } { micro sign }
+ ('¶'), { ¶ � } { paragraph sign }
+ ('·'), { · � } { middle dot }
+ ('¸'), { ¸ � } { cedilla }
('¹'), { ¹ 1 } { superscript one }
('º'), { º o } { masculine ordinal }
- ('»'), { » } { right angle quote }
+ ('»'), { » � } { right angle quote }
('¼'), { ¼ 1 } { one-fourth }
('½'), { ½ 1 } { one-half }
('¾'), { ¾ 3 } { three-fourths }
('¿'), { ¿ ? } { inverted question mark }
('À'), { À A } { uppercase A, grave accent }
- ('Á'), { Á } { uppercase A, acute accent }
- ('Â'), { Â } { uppercase A, circumflex accent }
+ ('Á'), { Á � } { uppercase A, acute accent }
+ ('Â'), { Â � } { uppercase A, circumflex accent }
('Ã'), { Ã A } { uppercase A, tilde }
- ('Ä'), { Ä } { uppercase A, umlaut }
+ ('Ä'), { Ä � } { uppercase A, umlaut }
('Å'), { Å A } { uppercase A, ring }
('Æ'), { Æ A } { uppercase AE }
- ('Ç'), { Ç } { uppercase C, cedilla }
+ ('Ç'), { Ç � } { uppercase C, cedilla }
('È'), { È E } { uppercase E, grave accent }
- ('É'), { É } { uppercase E, acute accent }
+ ('É'), { É � } { uppercase E, acute accent }
('Ê'), { Ê E } { uppercase E, circumflex accent }
- ('Ë'), { Ë } { uppercase E, umlaut }
+ ('Ë'), { Ë � } { uppercase E, umlaut }
('Ì'), { Ì I } { uppercase I, grave accent }
- ('Í'), { Í } { uppercase I, acute accent }
- ('Î'), { Î } { uppercase I, circumflex accent }
+ ('Í'), { Í � } { uppercase I, acute accent }
+ ('Î'), { Î � } { uppercase I, circumflex accent }
('Ï'), { Ï I } { uppercase I, umlaut }
('Ð'), { Ð ? } { uppercase Eth, Icelandic }
('Ñ'), { Ñ N } { uppercase N, tilde }
('Ò'), { Ò O } { uppercase O, grave accent }
- ('Ó'), { Ó } { uppercase O, acute accent }
- ('Ô'), { Ô } { uppercase O, circumflex accent }
+ ('Ó'), { Ó � } { uppercase O, acute accent }
+ ('Ô'), { Ô � } { uppercase O, circumflex accent }
('Õ'), { Õ O } { uppercase O, tilde }
- ('Ö'), { Ö } { uppercase O, umlaut }
- ('×'), { × } { multiplication sign }
+ ('Ö'), { Ö � } { uppercase O, umlaut }
+ ('×'), { × � } { multiplication sign }
('Ø'), { Ø O } { uppercase O, slash }
('Ù'), { Ù U } { uppercase U, grave accent }
- ('Ú'), { Ú } { uppercase U, acute accent }
+ ('Ú'), { Ú � } { uppercase U, acute accent }
('Û'), { Û U } { uppercase U, circumflex accent }
- ('Ü'), { Ü } { uppercase U, umlaut }
- ('Ý'), { Ý } { uppercase Y, acute accent }
+ ('Ü'), { Ü � } { uppercase U, umlaut }
+ ('Ý'), { Ý � } { uppercase Y, acute accent }
('Þ'), { Þ ? } { uppercase THORN, Icelandic }
- ('ß'), { ß } { lowercase sharps, German }
- ('à'), { à } { lowercase a, grave accent }
- ('á'), { á } { lowercase a, acute accent }
- ('â'), { â } { lowercase a, circumflex accent }
- ('ã'), { ã } { lowercase a, tilde }
- ('ä'), { ä } { lowercase a, umlaut }
- ('å'), { å } { lowercase a, ring }
+ ('ß'), { ß � } { lowercase sharps, German }
+ ('à'), { à � } { lowercase a, grave accent }
+ ('á'), { á � } { lowercase a, acute accent }
+ ('â'), { â � } { lowercase a, circumflex accent }
+ ('ã'), { ã � } { lowercase a, tilde }
+ ('ä'), { ä � } { lowercase a, umlaut }
+ ('å'), { å � } { lowercase a, ring }
('æ'), { æ a } { lowercase ae }
- ('ç'), { ç } { lowercase c, cedilla }
+ ('ç'), { ç � } { lowercase c, cedilla }
('è'), { è e } { lowercase e, grave accent }
- ('é'), { é } { lowercase e, acute accent }
- ('ê'), { ê } { lowercase e, circumflex accent }
- ('ë'), { ë } { lowercase e, umlaut }
+ ('é'), { é � } { lowercase e, acute accent }
+ ('ê'), { ê � } { lowercase e, circumflex accent }
+ ('ë'), { ë � } { lowercase e, umlaut }
('ì'), { ì i } { lowercase i, grave accent }
- ('í'), { í } { lowercase i, acute accent }
- ('î'), { î } { lowercase i, circumflex accent }
+ ('í'), { í � } { lowercase i, acute accent }
+ ('î'), { î � } { lowercase i, circumflex accent }
('ï'), { ï i } { lowercase i, umlaut }
('ð'), { ð ? } { lowercase eth, Icelandic }
- ('ñ'), { ñ } { lowercase n, tilde }
+ ('ñ'), { ñ � } { lowercase n, tilde }
('ò'), { ò o } { lowercase o, grave accent }
- ('ó'), { ó } { lowercase o, acute accent }
- ('ô'), { ô } { lowercase o, circumflex accent }
+ ('ó'), { ó � } { lowercase o, acute accent }
+ ('ô'), { ô � } { lowercase o, circumflex accent }
('õ'), { õ o } { lowercase o, tilde }
- ('ö'), { ö } { lowercase o, umlaut }
- ('÷'), { ÷ } { division sign }
+ ('ö'), { ö � } { lowercase o, umlaut }
+ ('÷'), { ÷ � } { division sign }
('ø'), { ø o } { lowercase o, slash }
('ù'), { ù u } { lowercase u, grave accent }
- ('ú'), { ú } { lowercase u, acute accent }
+ ('ú'), { ú � } { lowercase u, acute accent }
('û'), { û u } { lowercase u, circumflex accent }
- ('ü'), { ü } { lowercase u, umlaut }
- ('ý'), { ý } { lowercase y, acute accent }
+ ('ü'), { ü � } { lowercase u, umlaut }
+ ('ý'), { ý � } { lowercase y, acute accent }
('þ'), { þ ? } { lowercase thorn, Icelandic }
('ÿ'), { ÿ y } { lowercase y, umlaut }
- ('€'), { } { euro sign }
- ('Œ'), { } { capital ligature OE }
- ('œ'), { } { small ligature oe }
- ('š'), { } { small S with caron }
- ('Š'), { } { capital S with caron }
- ('ƒ'), { } { function }
- ('ˆ') { } { circumflex accent }
+ ('€'), { � } { euro sign }
+ ('Œ'), { � } { capital ligature OE }
+ ('œ'), { � } { small ligature oe }
+ ('š'), { � } { small S with caron }
+ ('Š'), { � } { capital S with caron }
+ ('ƒ'), { � } { function }
+ ('ˆ') { � } { circumflex accent }
);
@@ -322,7 +323,7 @@ interface
PIdentFuncTableFunc = ^TIdentFuncTableFunc;
TIdentFuncTableFunc = function (Index: Integer): TtkTokenKind of object;
- TSynHTMLSyn = class(TSynCustomHighlighter)
+ TSynHTMLSyn = class(TSynCustomCodeFoldingHighlighter)
private
fAndCode: Integer;
fRange: TRangeState;
@@ -375,6 +376,8 @@ TSynHTMLSyn = class(TSynCustomHighlighter)
procedure Next; override;
procedure SetRange(Value: Pointer); override;
procedure ResetRange; override;
+ procedure ScanForFoldRanges(FoldRanges: TSynFoldRanges;
+ LinesToScan: TStrings; FromLine: Integer; ToLine: Integer); override;
published
property AndAttri: TSynHighlighterAttributes read fAndAttri write fAndAttri;
property CommentAttri: TSynHighlighterAttributes read fCommentAttri
@@ -1213,6 +1216,140 @@ class function TSynHTMLSyn.GetFriendlyLanguageName: string;
Result := SYNS_FriendlyLangHTML;
end;
+// =============================================================================
+// Code Folding Support
+// =============================================================================
+
+function IsVoidElement(const TagName: string): Boolean;
+const
+ VoidElements: array[0..13] of string = (
+ 'area', 'base', 'br', 'col', 'embed', 'hr', 'img', 'input',
+ 'link', 'meta', 'param', 'source', 'track', 'wbr');
+var
+ LowerName: string;
+ I: Integer;
+begin
+ LowerName := TagName.ToLower;
+ for I := Low(VoidElements) to High(VoidElements) do
+ if LowerName = VoidElements[I] then
+ Exit(True);
+ Result := False;
+end;
+
+procedure CountHtmlTags(const S: string; out Opens, Closes: Integer);
+{ Scan a single line for HTML opening and closing tags.
+ - Void elements (br, hr, img, input, etc.) are excluded from opens.
+ - Self-closing tags (
) are excluded from opens.
+ - Comments () and DOCTYPE are ignored.
+ - Handles quoted attribute values (won't be confused by > inside quotes). }
+var
+ I, Len: Integer;
+ InTag, IsClosing, SelfClose: Boolean;
+ TagName: string;
+ InQuote: WideChar;
+begin
+ Opens := 0;
+ Closes := 0;
+ I := 1;
+ Len := Length(S);
+ InTag := False;
+ IsClosing := False;
+ InQuote := #0;
+
+ while I <= Len do
+ begin
+ if InQuote <> #0 then
+ begin
+ if S[I] = InQuote then
+ InQuote := #0;
+ Inc(I);
+ end
+ else if InTag then
+ begin
+ if S[I] = '>' then
+ begin
+ SelfClose := (I > 1) and (S[I - 1] = '/');
+ if IsClosing then
+ Inc(Closes)
+ else if not SelfClose and not IsVoidElement(TagName) then
+ Inc(Opens);
+ InTag := False;
+ Inc(I);
+ end
+ else if (S[I] = '"') or (S[I] = '''') then
+ begin
+ InQuote := S[I];
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end
+ else if (S[I] = '<') then
+ begin
+ IsClosing := False;
+ TagName := '';
+ Inc(I);
+ // Skip comments '#13#10+
- ''#13#10+
- ' '#13#10+
- '';
+ Result :=
+ ''#13#10 +
+ ''#13#10 +
+ ''#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ ' '#13#10 +
+ '';
end;
class function TSynXMLSyn.GetFriendlyLanguageName: string;
@@ -851,6 +873,165 @@ class function TSynXMLSyn.GetFriendlyLanguageName: string;
Result := SYNS_FriendlyLangXML;
end;
+// =============================================================================
+// Code Folding Support
+// =============================================================================
+
+procedure CountXmlTags(const S: string; out Opens, Closes: Integer;
+ var InTag: Boolean; var IsClosing: Boolean; var InQuote: WideChar;
+ out ContinuedOpen: Boolean);
+{ Scan a single line for XML opening and closing tags.
+ State variables (InTag, IsClosing, InQuote) persist across calls so that
+ tags spanning multiple lines are handled correctly.
+ - Self-closing tags () are excluded.
+ - Processing instructions (), CDATA (),
+ comments (), and DOCTYPE () are ignored.
+ - Handles quoted attribute values (won't be confused by > inside quotes).
+ ContinuedOpen is True when a tag continued from a previous line resolves
+ as an opening tag (already counted in Opens). }
+var
+ I, Len: Integer;
+ SelfClose: Boolean;
+ FirstTag: Boolean;
+begin
+ Opens := 0;
+ Closes := 0;
+ ContinuedOpen := False;
+ I := 1;
+ Len := Length(S);
+ FirstTag := InTag; // True if continuing a tag from a previous line
+
+ while I <= Len do
+ begin
+ if InQuote <> #0 then
+ begin
+ if S[I] = InQuote then
+ InQuote := #0;
+ Inc(I);
+ end
+ else if InTag then
+ begin
+ if S[I] = '>' then
+ begin
+ SelfClose := (I > 1) and (S[I - 1] = '/');
+ if IsClosing then
+ begin
+ Inc(Closes);
+ end
+ else if not SelfClose then
+ begin
+ Inc(Opens);
+ if FirstTag then
+ ContinuedOpen := True;
+ end;
+ InTag := False;
+ FirstTag := False;
+ Inc(I);
+ end
+ else if (S[I] = '"') or (S[I] = '''') then
+ begin
+ InQuote := S[I];
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end
+ else if (S[I] = '<') then
+ begin
+ IsClosing := False;
+ FirstTag := False;
+ Inc(I);
+ // Skip processing instructions
+ if (I <= Len) and (S[I] = '?') then
+ begin
+ while (I < Len) and not ((S[I] = '?') and (S[I + 1] = '>')) do
+ Inc(I);
+ Inc(I, 2); // skip ?>
+ Continue;
+ end;
+ // Skip comments ';
+ FragEnd = '';
+begin
+ Result := nil;
+ if not Assigned(AHighlighter) or (AText = '') then
+ Exit;
+
+ Lines := AText.Split([#13#10, #10, #13]);
+
+ HTML := TStringBuilder.Create;
+ try
+ // Open the styled container
+ HTML.Append('');
+
+ for I := 0 to Length(Lines) - 1 do
+ begin
+ if I > 0 then
+ HTML.Append(CrLf);
+
+ AHighlighter.SetLine(Lines[I], I);
+ while not AHighlighter.GetEol do
+ begin
+ Token := AHighlighter.GetToken;
+ Attr := AHighlighter.GetTokenAttribute;
+
+ if (Attr = nil) or ((Attr.Foreground = 0) and (Attr.Style = [])) then
+ HTML.Append(HtmlEncode(Token))
+ else
+ begin
+ SpanStyle := '';
+ if Attr.Foreground <> 0 then
+ SpanStyle := SpanStyle + 'color: ' +
+ ColorToHtmlHex(TAlphaColor(Attr.Foreground)) + '; ';
+ SpanStyle := SpanStyle + FontStylesToCSS(Attr.Style);
+ SpanStyle := SpanStyle.Trim;
+
+ if SpanStyle <> '' then
+ begin
+ HTML.Append('');
+ HTML.Append(HtmlEncode(Token));
+ HTML.Append('');
+ end
+ else
+ HTML.Append(HtmlEncode(Token));
+ end;
+
+ AHighlighter.Next;
+ end;
+ end;
+
+ HTML.Append('');
+
+ // Build the CF_HTML envelope
+ UTF8Fragment := TEncoding.UTF8.GetBytes(HTML.ToString);
+
+ // Calculate CF_HTML offsets
+ // Header has fixed-length placeholders (%.10d = 10 digits)
+ var HeaderLen := Length(TEncoding.UTF8.GetBytes(
+ Format(HeaderTemplate, [0, 0, 0, 0])));
+ var HTMLStartBytes := TEncoding.UTF8.GetBytes(HTMLStart + FragStart);
+ var HTMLEndBytes := TEncoding.UTF8.GetBytes(FragEnd + HTMLEnd);
+ var StartHTMLOfs := HeaderLen;
+
+ FragmentStart := StartHTMLOfs + Length(TEncoding.UTF8.GetBytes(HTMLStart))
+ + Length(TEncoding.UTF8.GetBytes(FragStart));
+ FragmentEnd := FragmentStart + Length(UTF8Fragment);
+ var EndHTMLOfs := FragmentEnd + Length(TEncoding.UTF8.GetBytes(FragEnd))
+ + Length(TEncoding.UTF8.GetBytes(HTMLEnd));
+
+ Header := Format(HeaderTemplate, [StartHTMLOfs, EndHTMLOfs,
+ FragmentStart, FragmentEnd]);
+
+ // Assemble final bytes
+ var HeaderBytes := TEncoding.UTF8.GetBytes(Header);
+ SetLength(Result, Length(HeaderBytes) + Length(HTMLStartBytes)
+ + Length(UTF8Fragment) + Length(HTMLEndBytes) + 1); // +1 for null
+
+ var Pos := 0;
+ Move(HeaderBytes[0], Result[Pos], Length(HeaderBytes));
+ Inc(Pos, Length(HeaderBytes));
+ Move(HTMLStartBytes[0], Result[Pos], Length(HTMLStartBytes));
+ Inc(Pos, Length(HTMLStartBytes));
+ Move(UTF8Fragment[0], Result[Pos], Length(UTF8Fragment));
+ Inc(Pos, Length(UTF8Fragment));
+ Move(HTMLEndBytes[0], Result[Pos], Length(HTMLEndBytes));
+ Inc(Pos, Length(HTMLEndBytes));
+ Result[Pos] := 0; // null terminator
+ finally
+ HTML.Free;
+ end;
+end;
+
+//=== DRAG SOURCE ==============================================================
+
+function TSynDragSource.QueryContinueDrag(fEscapePressed: BOOL;
+ grfKeyState: Longint): HResult;
+begin
+ if fEscapePressed then
+ Result := DRAGDROP_S_CANCEL
+ else if (grfKeyState and MK_LBUTTON) = 0 then
+ Result := DRAGDROP_S_DROP
+ else
+ Result := S_OK;
+end;
+
+function TSynDragSource.GiveFeedback(dwEffect: Longint): HResult;
+begin
+ Result := DRAGDROP_S_USEDEFAULTCURSORS;
+end;
+
+//=== ENUM FORMATETC ===========================================================
+
+constructor TSynEnumFormatEtc.Create(FormatList: TArray;
+ Index: Integer);
+begin
+ inherited Create;
+ FList := FormatList;
+ FIndex := Index;
+end;
+
+function TSynEnumFormatEtc.GetFormatEtc(ClipFormat: TClipFormat): TFormatEtc;
+begin
+ with Result do
+ begin
+ cfFormat := ClipFormat;
+ dwAspect := DVASPECT_CONTENT;
+ ptd := nil;
+ tymed := TYMED_HGLOBAL;
+ lindex := -1;
+ end;
+end;
+
+function TSynEnumFormatEtc.Next(celt: Longint; out elt;
+ pceltFetched: PLongint): HResult;
+var
+ I: Integer;
+ FormatEtc: PFormatEtc;
+begin
+ I := 0;
+ FormatEtc := PFormatEtc(@Elt);
+ while (I < Celt) and (FIndex < Length(FList)) do
+ begin
+ FormatEtc^ := GetFormatEtc(FList[FIndex]);
+ Inc(FormatEtc);
+ Inc(FIndex);
+ Inc(I);
+ end;
+
+ if pCeltFetched <> nil then
+ pCeltFetched^ := I;
+
+ if I = Celt then
+ Result := S_OK
+ else
+ Result := S_FALSE;
+end;
+
+function TSynEnumFormatEtc.Skip(celt: Longint): HResult;
+begin
+ Result := S_OK;
+ if Celt <= Length(FList) - FIndex then
+ FIndex := FIndex + Celt
+ else
+ begin
+ FIndex := Length(FList);
+ Result := S_FALSE;
+ end;
+end;
+
+function TSynEnumFormatEtc.Reset: HResult;
+begin
+ FIndex := 0;
+ Result := S_OK;
+end;
+
+function TSynEnumFormatEtc.Clone(out Enum: IEnumFormatEtc): HResult;
+begin
+ Result := S_OK;
+ Enum := TSynEnumFormatEtc.Create(FList, FIndex);
+end;
+
+//=== INITIALIZATION ===========================================================
+
+const
+ CF_HTML = 'HTML Format';
+
+initialization
+ OleInitialize(nil);
+ SynEditClipboardFormat := RegisterClipboardFormat('Internal SynEdit clipboard format');
+ HTMLClipboardFormat := RegisterClipboardFormat(CF_HTML);
+
+finalization
+ OleFlushClipboard;
+ OleUninitialize;
+
+{$ENDIF}
+
+end.
diff --git a/Source/SynEditHighlighter.pas b/Source/SynEditHighlighter.pas
index 2dc79e97..81c3eae0 100644
--- a/Source/SynEditHighlighter.pas
+++ b/Source/SynEditHighlighter.pas
@@ -26,16 +26,18 @@
interface
uses
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
Winapi.Windows,
+ Vcl.Graphics,
+ System.Win.Registry,
+ {$ENDIF}
System.SysUtils,
System.Classes,
- System.Win.Registry,
System.IniFiles,
Generics.Collections,
- Vcl.Graphics,
+ System.UITypes,
SynEditTypes,
- SynEditMiscClasses,
- SynUnicode;
+ SynUnicodeShared;
type
TSynHighlighterAttributes = class(TPersistent)
@@ -63,10 +65,12 @@ TSynHighlighterAttributes = class(TPersistent)
procedure AssignColorAndStyle(Source: TSynHighlighterAttributes);
constructor Create(AName: string; AFriendlyName: string);
procedure InternalSaveDefaultValues;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function LoadFromBorlandRegistry(RootKey: HKEY; AttrKey, AttrName: string;
OldStyle: Boolean): Boolean; virtual;
function LoadFromRegistry(Reg: TRegistry): Boolean;
function SaveToRegistry(Reg: TRegistry): Boolean;
+ {$ENDIF}
function LoadFromFile(Ini: TCustomIniFile): Boolean;
function SaveToFile(Ini: TCustomIniFile): Boolean;
public
@@ -176,10 +180,12 @@ TSynCustomHighlighter = class(TComponent)
procedure SetLine(const Value: string; LineNumber: Integer); virtual;
procedure SetRange(Value: Pointer); virtual;
procedure ResetRange; virtual;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function UseUserSettings(settingIndex: Integer): Boolean; virtual;
procedure EnumUserSettings(Settings: TStrings); virtual;
function LoadFromRegistry(RootKey: HKEY; Key: string): Boolean; virtual;
function SaveToRegistry(RootKey: HKEY; Key: string): Boolean; virtual;
+ {$ENDIF}
function LoadFromIniFile(AIni: TCustomIniFile): Boolean;
function SaveToIniFile(AIni: TCustomIniFile): Boolean;
function LoadFromFile(AFileName: string): Boolean;
@@ -382,6 +388,7 @@ procedure TSynHighlighterAttributes.InternalSaveDefaultValues;
fStyleDefault := fStyle;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function TSynHighlighterAttributes.LoadFromBorlandRegistry(RootKey: HKEY;
AttrKey, AttrName: string; OldStyle: Boolean): Boolean;
// How the highlighting information is stored:
@@ -569,6 +576,7 @@ function TSynHighlighterAttributes.LoadFromBorlandRegistry(RootKey: HKEY;
else
Result := LoadNewStyle(RootKey, AttrKey, AttrName);
end; { TSynHighlighterAttributes.LoadFromBorlandRegistry }
+{$ENDIF}
procedure TSynHighlighterAttributes.SetBackground(Value: TColor);
begin
@@ -607,6 +615,7 @@ procedure TSynHighlighterAttributes.SetStyle(Value: TFontStyles);
end;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function TSynHighlighterAttributes.LoadFromRegistry(Reg: TRegistry): Boolean;
var
Key: string;
@@ -643,6 +652,7 @@ function TSynHighlighterAttributes.SaveToRegistry(Reg: TRegistry): Boolean;
else
Result := False;
end;
+{$ENDIF}
function TSynHighlighterAttributes.LoadFromFile(Ini: TCustomIniFile): Boolean;
var
@@ -791,6 +801,7 @@ procedure TSynCustomHighlighter.Assign(Source: TPersistent);
inherited Assign(Source);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
procedure TSynCustomHighlighter.EnumUserSettings(Settings: TStrings);
begin
Settings.Clear;
@@ -844,6 +855,7 @@ function TSynCustomHighlighter.SaveToRegistry(RootKey: HKEY;
r.Free;
end;
end;
+{$ENDIF}
function TSynCustomHighlighter.LoadFromFile(AFileName: string): Boolean;
var
diff --git a/Source/SynEditKeyCmds.pas b/Source/SynEditKeyCmds.pas
index 170188f8..2a6f9bae 100644
--- a/Source/SynEditKeyCmds.pas
+++ b/Source/SynEditKeyCmds.pas
@@ -39,9 +39,9 @@ interface
uses
System.SysUtils,
System.Classes,
+ System.UITypes,
System.Generics.Collections,
- Vcl.Menus,
- SynUnicode,
+ SynUnicodeShared,
SynEditTypes;
const
@@ -318,10 +318,73 @@ function IndexToEditorCommand(const AIndex: Integer): Integer;
implementation
uses
+ {$IFDEF MSWINDOWS}
Winapi.Windows,
- SynEditKeyConst,
+ {$ENDIF}
+ SynEditKeyConstShared,
SynEditStrConst;
+{$IFNDEF MSWINDOWS}
+const
+ VK_OEM_PLUS = $BB;
+ VK_OEM_MINUS = $BD;
+ VK_OEM_2 = $BF;
+ VK_OEM_6 = $DD;
+{$ENDIF}
+
+{ Local shortcut conversion functions - portable replacements for Vcl.Menus }
+function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
+begin
+ Result := Key;
+ if ssShift in Shift then Inc(Result, scShift);
+ if ssCtrl in Shift then Inc(Result, scCtrl);
+ if ssAlt in Shift then Inc(Result, scAlt);
+end;
+
+procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
+begin
+ Key := ShortCut and not (scShift + scCtrl + scAlt);
+ Shift := [];
+ if ShortCut and scShift <> 0 then Include(Shift, ssShift);
+ if ShortCut and scCtrl <> 0 then Include(Shift, ssCtrl);
+ if ShortCut and scAlt <> 0 then Include(Shift, ssAlt);
+end;
+
+function ShortCutToText(ShortCut: TShortCut): string;
+var
+ Key: Word;
+ Shift: TShiftState;
+begin
+ ShortCutToKey(ShortCut, Key, Shift);
+ Result := '';
+ if ssCtrl in Shift then Result := Result + 'Ctrl+';
+ if ssShift in Shift then Result := Result + 'Shift+';
+ if ssAlt in Shift then Result := Result + 'Alt+';
+ case Key of
+ $08: Result := Result + 'BkSp';
+ $09: Result := Result + 'Tab';
+ $0D: Result := Result + 'Enter';
+ $1B: Result := Result + 'Esc';
+ $20: Result := Result + 'Space';
+ $21: Result := Result + 'PgUp';
+ $22: Result := Result + 'PgDn';
+ $23: Result := Result + 'End';
+ $24: Result := Result + 'Home';
+ $25: Result := Result + 'Left';
+ $26: Result := Result + 'Up';
+ $27: Result := Result + 'Right';
+ $28: Result := Result + 'Down';
+ $2D: Result := Result + 'Ins';
+ $2E: Result := Result + 'Del';
+ $30..$39: Result := Result + Char(Key);
+ $41..$5A: Result := Result + Char(Key);
+ $60..$69: Result := Result + 'Num' + Char(Key - $60 + Ord('0'));
+ $70..$87: Result := Result + 'F' + IntToStr(Key - $6F);
+ else
+ Result := Result + '#' + IntToStr(Key);
+ end;
+end;
+
{ Command mapping routines }
const
@@ -536,7 +599,7 @@ function TSynEditKeyStroke.GetDisplayName: string;
function TSynEditKeyStroke.GetShortCut: TShortCut;
begin
- Result := Vcl.Menus.ShortCut(Key, Shift);
+ Result := SynEditKeyCmds.ShortCut(Key, Shift);
end;
procedure TSynEditKeyStroke.SetCommand(const Value: TSynEditorCommand);
@@ -579,7 +642,7 @@ procedure TSynEditKeyStroke.SetShortCut(const Value: TShortCut);
end;
end;
- Vcl.Menus.ShortCutToKey(Value, NewKey, NewShift);
+ ShortCutToKey(Value, NewKey, NewShift);
if (NewKey <> Key) or (NewShift <> Shift) then
begin
@@ -622,7 +685,7 @@ procedure TSynEditKeyStroke.SetShortCut2(const Value: TShortCut);
end;
end;
- Vcl.Menus.ShortCutToKey(Value, NewKey, NewShift);
+ ShortCutToKey(Value, NewKey, NewShift);
if (NewKey <> Key2) or (NewShift <> Shift2) then
begin
Key2 := NewKey;
@@ -632,7 +695,7 @@ procedure TSynEditKeyStroke.SetShortCut2(const Value: TShortCut);
function TSynEditKeyStroke.GetShortCut2: TShortCut;
begin
- Result := Vcl.Menus.ShortCut(Key2, Shift2);
+ Result := SynEditKeyCmds.ShortCut(Key2, Shift2);
end;
procedure TSynEditKeyStroke.LoadFromStream(AStream: TStream);
diff --git a/Source/SynEditKeyConst.pas b/Source/SynEditKeyConst.pas
deleted file mode 100644
index 3226087a..00000000
--- a/Source/SynEditKeyConst.pas
+++ /dev/null
@@ -1,112 +0,0 @@
-{-------------------------------------------------------------------------------
-The contents of this file are subject to the Mozilla Public License
-Version 1.1 (the "License"); you may not use this file except in compliance
-with the License. You may obtain a copy of the License at
-http://www.mozilla.org/MPL/
-
-Software distributed under the License is distributed on an "AS IS" basis,
-WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
-the specific language governing rights and limitations under the License.
-
-The Original Code is: SynEditKeyCmds.pas, released 2000-04-07.
-The Original Code is based on the mwKeyCmds.pas file from the
-mwEdit component suite by Martin Waldenburg and other developers, the Initial
-Author of this file is Brad Stowers.
-All Rights Reserved.
-
-Contributors to the SynEdit and mwEdit projects are listed in the
-Contributors.txt file.
-
-Alternatively, the contents of this file may be used under the terms of the
-GNU General Public License Version 2 or later (the "GPL"), in which case
-the provisions of the GPL are applicable instead of those above.
-If you wish to allow use of your version of this file only under the terms
-of the GPL and not to allow others to use your version of this file
-under the MPL, indicate your decision by deleting the provisions above and
-replace them with the notice and other provisions required by the GPL.
-If you do not delete the provisions above, a recipient may use your version
-of this file under either the MPL or the GPL.
--------------------------------------------------------------------------------}
-
-unit SynEditKeyConst;
-
-{ This unit provides a translation of DELPHI and CLX key constants to
- more readable SynEdit constants }
-
-{$I SynEdit.inc}
-
-interface
-
-uses
- Windows;
-
-const
-
- SYNEDIT_RETURN = VK_RETURN;
- SYNEDIT_ESCAPE = VK_ESCAPE;
- SYNEDIT_SPACE = VK_SPACE;
- SYNEDIT_PRIOR = VK_PRIOR;
- SYNEDIT_NEXT = VK_NEXT;
- SYNEDIT_END = VK_END;
- SYNEDIT_HOME = VK_HOME;
- SYNEDIT_UP = VK_UP;
- SYNEDIT_DOWN = VK_DOWN;
- SYNEDIT_BACK = VK_BACK;
- SYNEDIT_LEFT = VK_LEFT;
- SYNEDIT_RIGHT = VK_RIGHT;
- SYNEDIT_MENU = VK_MENU;
- SYNEDIT_CONTROL = VK_CONTROL;
- SYNEDIT_SHIFT = VK_SHIFT;
- SYNEDIT_F1 = VK_F1;
- SYNEDIT_F2 = VK_F2;
- SYNEDIT_F3 = VK_F3;
- SYNEDIT_F4 = VK_F4;
- SYNEDIT_F5 = VK_F5;
- SYNEDIT_F6 = VK_F6;
- SYNEDIT_F7 = VK_F7;
- SYNEDIT_F8 = VK_F8;
- SYNEDIT_F9 = VK_F9;
- SYNEDIT_F10 = VK_F10;
- SYNEDIT_F11 = VK_F11;
- SYNEDIT_F12 = VK_F12;
- SYNEDIT_F13 = VK_F13;
- SYNEDIT_F14 = VK_F14;
- SYNEDIT_F15 = VK_F15;
- SYNEDIT_F16 = VK_F16;
- SYNEDIT_F17 = VK_F17;
- SYNEDIT_F18 = VK_F18;
- SYNEDIT_F19 = VK_F19;
- SYNEDIT_F20 = VK_F20;
- SYNEDIT_F21 = VK_F21;
- SYNEDIT_F22 = VK_F22;
- SYNEDIT_F23 = VK_F23;
- SYNEDIT_F24 = VK_F24;
- SYNEDIT_PRINT = VK_PRINT;
- SYNEDIT_INSERT = VK_INSERT;
- SYNEDIT_DELETE = VK_DELETE;
- SYNEDIT_NUMPAD0 = VK_NUMPAD0;
- SYNEDIT_NUMPAD1 = VK_NUMPAD1;
- SYNEDIT_NUMPAD2 = VK_NUMPAD2;
- SYNEDIT_NUMPAD3 = VK_NUMPAD3;
- SYNEDIT_NUMPAD4 = VK_NUMPAD4;
- SYNEDIT_NUMPAD5 = VK_NUMPAD5;
- SYNEDIT_NUMPAD6 = VK_NUMPAD6;
- SYNEDIT_NUMPAD7 = VK_NUMPAD7;
- SYNEDIT_NUMPAD8 = VK_NUMPAD8;
- SYNEDIT_NUMPAD9 = VK_NUMPAD9;
- SYNEDIT_MULTIPLY = VK_MULTIPLY;
- SYNEDIT_ADD = VK_ADD;
- SYNEDIT_SEPARATOR = VK_SEPARATOR;
- SYNEDIT_SUBTRACT = VK_SUBTRACT;
- SYNEDIT_DECIMAL = VK_DECIMAL;
- SYNEDIT_DIVIDE = VK_DIVIDE;
- SYNEDIT_NUMLOCK = VK_NUMLOCK;
- SYNEDIT_SCROLL = VK_SCROLL;
- SYNEDIT_TAB = VK_TAB;
- SYNEDIT_CLEAR = VK_CLEAR;
- SYNEDIT_PAUSE = VK_PAUSE;
- SYNEDIT_CAPITAL = VK_CAPITAL;
-
-implementation
-
-end.
diff --git a/Source/SynEditKeyConstShared.pas b/Source/SynEditKeyConstShared.pas
new file mode 100644
index 00000000..0b835814
--- /dev/null
+++ b/Source/SynEditKeyConstShared.pas
@@ -0,0 +1,114 @@
+{-------------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: SynEditKeyCmds.pas, released 2000-04-07.
+The Original Code is based on the mwKeyCmds.pas file from the
+mwEdit component suite by Martin Waldenburg and other developers, the Initial
+Author of this file is Brad Stowers.
+All Rights Reserved.
+
+Contributors to the SynEdit and mwEdit projects are listed in the
+Contributors.txt file.
+
+Alternatively, the contents of this file may be used under the terms of the
+GNU General Public License Version 2 or later (the "GPL"), in which case
+the provisions of the GPL are applicable instead of those above.
+If you wish to allow use of your version of this file only under the terms
+of the GPL and not to allow others to use your version of this file
+under the MPL, indicate your decision by deleting the provisions above and
+replace them with the notice and other provisions required by the GPL.
+If you do not delete the provisions above, a recipient may use your version
+of this file under either the MPL or the GPL.
+-------------------------------------------------------------------------------}
+
+unit SynEditKeyConstShared;
+
+{ Platform-independent key constants for SynEdit.
+ Values match standard virtual key codes.
+
+ Named with the 'Shared' suffix because Delphi's scope resolution rules
+ make a bare 'SynEditKeyConst' shadow the prefixed 'Vcl.SynEditKeyConst'
+ and 'FMX.SynEditKeyConst' units. The suffix ensures that shared code
+ references this unit unambiguously, while VCL/FMX code can still use
+ the prefixed wrappers. }
+
+{$I SynEdit.inc}
+
+interface
+
+const
+ SYNEDIT_RETURN = $0D;
+ SYNEDIT_ESCAPE = $1B;
+ SYNEDIT_SPACE = $20;
+ SYNEDIT_PRIOR = $21;
+ SYNEDIT_NEXT = $22;
+ SYNEDIT_END = $23;
+ SYNEDIT_HOME = $24;
+ SYNEDIT_UP = $26;
+ SYNEDIT_DOWN = $28;
+ SYNEDIT_BACK = $08;
+ SYNEDIT_LEFT = $25;
+ SYNEDIT_RIGHT = $27;
+ SYNEDIT_MENU = $12;
+ SYNEDIT_CONTROL = $11;
+ SYNEDIT_SHIFT = $10;
+ SYNEDIT_F1 = $70;
+ SYNEDIT_F2 = $71;
+ SYNEDIT_F3 = $72;
+ SYNEDIT_F4 = $73;
+ SYNEDIT_F5 = $74;
+ SYNEDIT_F6 = $75;
+ SYNEDIT_F7 = $76;
+ SYNEDIT_F8 = $77;
+ SYNEDIT_F9 = $78;
+ SYNEDIT_F10 = $79;
+ SYNEDIT_F11 = $7A;
+ SYNEDIT_F12 = $7B;
+ SYNEDIT_F13 = $7C;
+ SYNEDIT_F14 = $7D;
+ SYNEDIT_F15 = $7E;
+ SYNEDIT_F16 = $7F;
+ SYNEDIT_F17 = $80;
+ SYNEDIT_F18 = $81;
+ SYNEDIT_F19 = $82;
+ SYNEDIT_F20 = $83;
+ SYNEDIT_F21 = $84;
+ SYNEDIT_F22 = $85;
+ SYNEDIT_F23 = $86;
+ SYNEDIT_F24 = $87;
+ SYNEDIT_PRINT = $2A;
+ SYNEDIT_INSERT = $2D;
+ SYNEDIT_DELETE = $2E;
+ SYNEDIT_NUMPAD0 = $60;
+ SYNEDIT_NUMPAD1 = $61;
+ SYNEDIT_NUMPAD2 = $62;
+ SYNEDIT_NUMPAD3 = $63;
+ SYNEDIT_NUMPAD4 = $64;
+ SYNEDIT_NUMPAD5 = $65;
+ SYNEDIT_NUMPAD6 = $66;
+ SYNEDIT_NUMPAD7 = $67;
+ SYNEDIT_NUMPAD8 = $68;
+ SYNEDIT_NUMPAD9 = $69;
+ SYNEDIT_MULTIPLY = $6A;
+ SYNEDIT_ADD = $6B;
+ SYNEDIT_SEPARATOR = $6C;
+ SYNEDIT_SUBTRACT = $6D;
+ SYNEDIT_DECIMAL = $6E;
+ SYNEDIT_DIVIDE = $6F;
+ SYNEDIT_NUMLOCK = $90;
+ SYNEDIT_SCROLL = $91;
+ SYNEDIT_TAB = $09;
+ SYNEDIT_CLEAR = $0C;
+ SYNEDIT_PAUSE = $13;
+ SYNEDIT_CAPITAL = $14;
+
+implementation
+
+end.
diff --git a/Source/SynEditMiscProcs.pas b/Source/SynEditMiscProcs.pas
index 4cba33a4..d075030c 100644
--- a/Source/SynEditMiscProcs.pas
+++ b/Source/SynEditMiscProcs.pas
@@ -36,14 +36,19 @@
interface
uses
+ {$IFDEF MSWINDOWS}
Winapi.Windows,
+ {$ENDIF}
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
+ Vcl.Graphics,
+ {$ENDIF}
+ System.UITypes,
System.Math,
System.Classes,
System.RegularExpressions,
- Vcl.Graphics,
SynEditTypes,
SynEditHighlighter,
- SynUnicode;
+ SynUnicodeShared;
const
MaxIntArraySize = MaxInt div 16;
@@ -119,28 +124,32 @@ function CalcFCS(const ABuf; ABufSize: Cardinal): Word;
function DeleteTypePrefixAndSynSuffix(s: string): string;
function CeilOfIntDiv(Dividend, Divisor: Cardinal): Integer;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
// In Windows Vista or later use the Consolas font
function DefaultFontName: string;
function GetCorrectFontWeight(Font: TFont): Integer;
+{$ENDIF}
// Calculates the difference between two lines
// Returns the starting point of the difference and the lengths of the change
procedure LineDiff(const Line, OldLine: string; out StartPos, OldLen, NewLen:
Integer);
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
// Tests whether a color is dark
function IsColorDark(AColor: TColor): Boolean;
+// Converts TColor to an HTML color string
+function ColorToHTML(Color: TColor): string;
+{$ENDIF}
+
// Substitutes control characters with Unicode control pictures
procedure SubstituteControlChars(var Input: string);
// Returns a compiled regular expression
function CompiledRegEx(const Pattern: string; Options: TRegExOptions = []): TRegEx;
-// Converts TColor to an HTML color string
-function ColorToHTML(Color: TColor): string;
-
// Bracket functions (Brackets have the form '()[]{}')
function IsBracket(Chr: Char; const Brackets: string): Boolean;
function IsOpeningBracket(Chr: Char; const Brackets: string): Boolean;
@@ -157,13 +166,15 @@ function GrowCollection(OldCapacity, NewCount: Integer): Integer;
implementation
uses
- System.UITypes,
System.SysUtils,
System.RegularExpressionsCore,
- SynHighlighterMulti,
- Winapi.D2D1,
- Vcl.Forms,
- SynDWrite;
+ SynHighlighterMulti
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
+ ,Winapi.D2D1
+ ,Vcl.Forms
+ ,SynDWrite
+ {$ENDIF}
+ ;
function MinMax(x, mi, ma: Integer): Integer;
begin
@@ -750,6 +761,7 @@ function CeilOfIntDiv(Dividend, Divisor: Cardinal): Integer;
Result := Integer(Res);
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function DefaultFontName: string;
begin
if CheckWin32Version(6) then
@@ -794,6 +806,7 @@ function GetCorrectFontWeight(Font: TFont): Integer;
ReleaseDC(0, DC);
end;
end;
+{$ENDIF}
{$IF CompilerVersion <= 32}
function GrowCollection(OldCapacity, NewCount: Integer): Integer;
@@ -834,6 +847,7 @@ procedure LineDiff(const Line, OldLine: string; out StartPos, OldLen, NewLen: In
end;
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function IsColorDark(AColor: TColor): Boolean;
var
ACol: Longint;
@@ -842,6 +856,7 @@ function IsColorDark(AColor: TColor): Boolean;
Result := ((2.99 * GetRValue(ACol) + 5.87 * GetGValue(ACol) +
1.14 * GetBValue(ACol)) < $400);
end;
+{$ENDIF}
procedure SubstituteControlChars(var Input: string);
const
@@ -871,6 +886,7 @@ function CompiledRegEx(const Pattern: string; Options: TRegExOptions): TRegEx;
{$ENDIF}
end;
+{$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
function ColorToHTML(Color: TColor): string;
var
R: TColorRef;
@@ -878,6 +894,7 @@ function ColorToHTML(Color: TColor): string;
R := ColorToRGB(Color);
Result := Format('#%.2x%.2x%.2x', [GetRValue(R), GetGValue(R), GetBValue(R)]);
end;
+{$ENDIF}
function IsBracket(Chr: Char; const Brackets: string): Boolean;
begin
diff --git a/Source/SynEditRegexSearch.pas b/Source/SynEditRegexSearch.pas
index c0630631..5a764fb1 100644
--- a/Source/SynEditRegexSearch.pas
+++ b/Source/SynEditRegexSearch.pas
@@ -10,8 +10,8 @@
The Original Code is: SynEditRegexSearch.pas, released 2002-07-26.
-Original Code by Eduardo Mauro, Gerald Nunn and Flvio Etrusco.
-Unicode translation by Mal Hrz.
+Original Code by Eduardo Mauro, Gerald Nunn and Fl�vio Etrusco.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit project are listed in the Contributors.txt file.
@@ -42,8 +42,7 @@ interface
SynEditTypes,
RegularExpressions,
RegularExpressionsCore,
- SynEditMiscClasses,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
@@ -75,8 +74,7 @@ implementation
uses
RegularExpressionsAPI,
- System.SysUtils,
- Consts;
+ System.SysUtils;
{$IF (CompilerVersion <= 35) and not Declared(RTLVersion112)}
type
diff --git a/Source/SynEditSearch.pas b/Source/SynEditSearch.pas
index 234dff44..7d942e4b 100644
--- a/Source/SynEditSearch.pas
+++ b/Source/SynEditSearch.pas
@@ -39,8 +39,7 @@ interface
uses
SynEditTypes,
- SynEditMiscClasses,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
@@ -96,8 +95,7 @@ TSynEditSearch = class(TSynEditSearchCustom)
implementation
uses
- Windows,
- SysUtils;
+ System.SysUtils;
constructor TSynEditSearch.Create(aOwner: TComponent);
begin
@@ -258,7 +256,7 @@ procedure TSynEditSearch.SetPattern(const Value: string);
if CaseSensitive then
Pat := CasedPat
else
- Pat := SysUtils.AnsiLowerCase(CasedPat);
+ Pat := System.SysUtils.AnsiLowerCase(CasedPat);
fShiftInitialized := False;
end;
fCount := 0;
@@ -272,7 +270,7 @@ procedure TSynEditSearch.SetCaseSensitive(const Value: Boolean);
if fCaseSensitive then
Pat := CasedPat
else
- Pat := SysUtils.AnsiLowerCase(CasedPat);
+ Pat := System.SysUtils.AnsiLowerCase(CasedPat);
fShiftInitialized := False;
end;
end;
@@ -303,7 +301,7 @@ function TSynEditSearch.FindAll(const NewText: string; StartChar: Integer = 1;
if CaseSensitive then
FTextToSearch := NewText
else
- FTextToSearch := SysUtils.AnsiLowerCase(NewText);
+ FTextToSearch := System.SysUtils.AnsiLowerCase(NewText);
FLineStart := PWideChar(FTextToSearch);
if Backwards then
diff --git a/Source/SynEditSelections.pas b/Source/SynEditSelections.pas
new file mode 100644
index 00000000..04d9e698
--- /dev/null
+++ b/Source/SynEditSelections.pas
@@ -0,0 +1,689 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Shared multi-selection / multi-caret base class.
+Platform-independent logic extracted from Vcl.SynEditMiscClasses.TSynSelections.
+VCL and FMX subclass TSynSelectionsBase with thin editor-specific overrides.
+-------------------------------------------------------------------------------}
+
+unit SynEditSelections;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.SysUtils,
+ System.Classes,
+ System.Math,
+ System.Generics.Collections,
+ System.Generics.Defaults,
+ SynEditTypes,
+ SynEditMiscProcs;
+
+type
+ TSynSelStorage = record
+ Selections: TArray;
+ BaseIndex, ActiveIndex: Integer;
+ procedure Clear;
+ end;
+
+ TSynSelectionsBase = class
+ public
+ type
+ TKeepSelection = (ksKeepBase, ksKeepActive);
+ private
+ function GetCount: Integer;
+ function GetActiveSelection: TSynSelection;
+ function GetBaseSelection: TSynSelection;
+ procedure SetActiveSelection(const Value: TSynSelection);
+ procedure SetBaseSelection(const Value: TSynSelection);
+ function GetSelection(Index: Integer): TSynSelection;
+ procedure SetActiveSelIndex(const Index: Integer);
+ function GetIsEmpty: Boolean;
+ protected
+ FOwner: TObject;
+ FSelections: TList;
+ FBaseSelIndex: Integer;
+ FActiveSelIndex: Integer;
+ // === Abstract methods — editor coupling points ===
+ procedure CaretsChanged; virtual; abstract;
+ procedure DoInvalidateSelection(const Sel: TSynSelection); virtual; abstract;
+ procedure DoRestoreSelection(const Sel: TSynSelection;
+ EnsureVisible: Boolean); virtual; abstract;
+ function GetLineText(ALine: Integer): string; virtual; abstract;
+ // Word-wrap / column selection support
+ function GetWordWrap: Boolean; virtual; abstract;
+ function GetScrollPastEOL: Boolean; virtual; abstract;
+ function GetRowLength(ARow: Integer): Integer; virtual; abstract;
+ function BufferToDisplayPos(const P: TBufferCoord): TDisplayCoord; virtual; abstract;
+ function DisplayToBufferPos(const P: TDisplayCoord): TBufferCoord; virtual; abstract;
+ function SelectionToDisplayRow(var Sel: TSynSelection): Integer; virtual; abstract;
+ public
+ constructor Create(Owner: TObject);
+ destructor Destroy; override;
+ // Selection management
+ procedure Clear(KeepSelection: TKeepSelection = ksKeepActive);
+ function AddCaret(const ACaret: TBufferCoord;
+ IsBase: Boolean = False): Boolean;
+ procedure DeleteSelection(Index: Integer);
+ function FindCaret(const ACaret: TBufferCoord): Integer;
+ function FindSelection(const BC: TBufferCoord;
+ var Index: Integer): Boolean;
+ procedure MouseSelection(const Sel: TSynSelection);
+ procedure ColumnSelection(Anchor, ACaret: TBufferCoord;
+ LastPosX: Integer = 0);
+ procedure Merge;
+ function PartSelectionsForRow(
+ const RowStart, RowEnd: TBufferCoord): TSynSelectionArray;
+ function RowHasCaret(ARow, ALine: Integer): Boolean;
+ // Invalidation
+ procedure InvalidateSelection(Index: Integer);
+ procedure InvalidateAll;
+ // Column selection anchor
+ function ColumnSelectionStart: TBufferCoord;
+ // Store/Restore
+ procedure Store(out SelStorage: TSynSelStorage);
+ procedure Restore(const [Ref] SelStorage: TSynSelStorage); overload;
+ procedure Restore(const [Ref] Sel: TSynSelection;
+ EnsureVisible: Boolean = True); overload;
+ // Multi-caret command execution
+ procedure ForEachSelection(const Callback: TProc);
+ // Line-change adjustment
+ procedure LinesInserted(FirstLine, aCount: Integer);
+ procedure LinesDeleted(FirstLine, aCount: Integer);
+ procedure LinePut(aIndex: Integer; const OldLine: string);
+ // Properties
+ property BaseSelectionIndex: Integer read FBaseSelIndex;
+ property ActiveSelection: TSynSelection read GetActiveSelection
+ write SetActiveSelection;
+ property BaseSelection: TSynSelection read GetBaseSelection
+ write SetBaseSelection;
+ property Count: Integer read GetCount;
+ property ActiveSelIndex: Integer read FActiveSelIndex
+ write SetActiveSelIndex;
+ property IsEmpty: Boolean read GetIsEmpty;
+ property Selection[Index: Integer]: TSynSelection
+ read GetSelection; default;
+ end;
+
+implementation
+
+{ TSynSelStorage }
+
+procedure TSynSelStorage.Clear;
+begin
+ Selections := [];
+end;
+
+{ TSynSelectionsBase }
+
+constructor TSynSelectionsBase.Create(Owner: TObject);
+begin
+ inherited Create;
+ FOwner := Owner;
+ FSelections := TList.Create(TComparer.Construct(
+ function(const L, R: TSynSelection): Integer
+ begin
+ if L.Normalized.Start < R.Normalized.Start then
+ Result := -1
+ else if L.Normalized.Start = R.Normalized.Start then
+ Result := 0
+ else
+ Result := 1;
+ end));
+end;
+
+destructor TSynSelectionsBase.Destroy;
+begin
+ FSelections.Free;
+ inherited;
+end;
+
+function TSynSelectionsBase.AddCaret(const ACaret: TBufferCoord;
+ IsBase: Boolean): Boolean;
+var
+ Sel: TSynSelection;
+ Index: Integer;
+begin
+ Result := False;
+ if FindSelection(ACaret, Index) then
+ begin
+ DeleteSelection(Index);
+ Restore(FSelections[FActiveSelIndex], False);
+ end
+ else if (Index > 0) and (FSelections[Index - 1].Caret = ACaret) then
+ begin
+ DeleteSelection(Index - 1);
+ Restore(FSelections[FActiveSelIndex], False);
+ end
+ else
+ begin
+ Sel := TSynSelection.Create(ACaret, ACaret, ACaret);
+ FSelections.Insert(Index, Sel);
+ FActiveSelIndex := Index;
+ if IsBase then
+ FBaseSelIndex := Index
+ else if FBaseSelIndex >= Index then
+ Inc(FBaseSelIndex);
+ Result := True;
+ end;
+end;
+
+procedure TSynSelectionsBase.Clear(KeepSelection: TKeepSelection);
+var
+ Index: Integer;
+begin
+ if FSelections.Count = 1 then Exit;
+
+ if (KeepSelection = ksKeepBase) and (FActiveSelIndex <> FBaseSelIndex) then
+ Restore(BaseSelection);
+
+ for Index := FSelections.Count - 1 downto 0 do
+ if not (((KeepSelection = ksKeepBase) and (Index = FBaseSelIndex)) or
+ ((KeepSelection = ksKeepActive) and (Index = FActiveSelIndex)))
+ then
+ DeleteSelection(Index);
+
+ Assert(FSelections.Count = 1);
+ FBaseSelIndex := 0;
+ FActiveSelIndex := 0;
+ CaretsChanged;
+end;
+
+function TSynSelectionsBase.ColumnSelectionStart: TBufferCoord;
+begin
+ if FSelections[FBaseSelIndex].IsEmpty then
+ Result := FSelections[FBaseSelIndex].Caret
+ else
+ Result := FSelections[FBaseSelIndex].Start;
+end;
+
+procedure TSynSelectionsBase.ForEachSelection(
+ const Callback: TProc);
+var
+ OldActiveSelIndex, I: Integer;
+begin
+ OldActiveSelIndex := FActiveSelIndex;
+
+ for I := 0 to FSelections.Count - 1 do
+ begin
+ ActiveSelIndex := I;
+ if FSelections[I].IsValid then
+ Callback(FSelections[I]);
+ end;
+
+ // Restore Active Selection (bounds-safe)
+ if OldActiveSelIndex < FSelections.Count then
+ ActiveSelIndex := OldActiveSelIndex
+ else
+ ActiveSelIndex := FSelections.Count - 1;
+
+ // Merge overlapping selections
+ Merge;
+end;
+
+procedure TSynSelectionsBase.ColumnSelection(Anchor, ACaret: TBufferCoord;
+ LastPosX: Integer);
+
+ procedure SetLineSelection(Index, Line, FromChar, ToChar: Integer;
+ ScrollPastEOL: Boolean);
+ var
+ LineString: string;
+ Len: Integer;
+ begin
+ LineString := GetLineText(Line);
+ Len := LineString.Length;
+ if not ScrollPastEOL then
+ ToChar := EnsureRange(ToChar, 1, Len + 1);
+ FromChar := EnsureRange(FromChar, 1, Len + 1);
+ FSelections.List[Index].Caret := BufferCoord(ToChar, Line);
+ FSelections.List[Index].Start := BufferCoord(FromChar, Line);
+ FSelections.List[Index].Stop := BufferCoord(Min(ToChar, Len + 1), Line);
+ FSelections.List[Index].LastPosX := LastPosX;
+ InvalidateSelection(Index);
+ end;
+
+ procedure SetRowSelection(Index, Row, FromChar, ToChar: Integer;
+ ScrollPastEOL: Boolean);
+ var
+ Len: Integer;
+ begin
+ Len := GetRowLength(Row);
+ if not ScrollPastEOL then
+ ToChar := EnsureRange(ToChar, 1, Len + 1);
+ FromChar := EnsureRange(FromChar, 1, Len + 1);
+ FSelections.List[Index].Caret :=
+ DisplayToBufferPos(DisplayCoord(ToChar, Row));
+ FSelections.List[Index].Start :=
+ DisplayToBufferPos(DisplayCoord(FromChar, Row));
+ FSelections.List[Index].Stop :=
+ DisplayToBufferPos(DisplayCoord(Min(ToChar, Len + 1), Row));
+ FSelections.List[Index].LastPosX := LastPosX;
+ InvalidateSelection(Index);
+ end;
+
+var
+ DC: TDisplayCoord;
+ FromChar, ToChar: Integer;
+ FromRow, ToRow: Integer;
+ Line, Row: Integer;
+ Index: Integer;
+ Increment: Integer;
+ ScrollPastEOL: Boolean;
+begin
+ Clear;
+ InvalidateSelection(0);
+
+ ScrollPastEOL := GetScrollPastEOL;
+
+ if GetWordWrap then
+ begin
+ DC := BufferToDisplayPos(Anchor);
+ FromChar := DC.Column;
+ FromRow := DC.Row;
+ DC := BufferToDisplayPos(ACaret);
+ ToChar := DC.Column;
+ ToRow := DC.Row;
+
+ SetRowSelection(0, FromRow, FromChar, ToChar, ScrollPastEOL);
+
+ Increment := Sign(ToRow - FromRow);
+
+ Row := FromRow;
+ while Row <> ToRow do
+ begin
+ Row := Row + Increment;
+ if Increment > 0 then
+ Index := FSelections.Add(TSynSelection.Invalid)
+ else
+ begin
+ FSelections.Insert(0, TSynSelection.Invalid);
+ Index := 0;
+ end;
+ SetRowSelection(Index, Row, FromChar, ToChar, ScrollPastEOL);
+ end;
+ end
+ else
+ begin
+ FromChar := Anchor.Char;
+ ToChar := ACaret.Char;
+ SetLineSelection(0, Anchor.Line, FromChar, ToChar, ScrollPastEOL);
+
+ Increment := Sign(ACaret.Line - Anchor.Line);
+
+ Line := Anchor.Line;
+ while Line <> ACaret.Line do
+ begin
+ Line := Line + Increment;
+ if Increment > 0 then
+ Index := FSelections.Add(TSynSelection.Invalid)
+ else
+ begin
+ FSelections.Insert(0, TSynSelection.Invalid);
+ Index := 0;
+ end;
+ SetLineSelection(Index, Line, FromChar, ToChar, ScrollPastEOL);
+ end;
+ end;
+
+ if Increment >= 0 then
+ begin
+ FBaseSelIndex := 0;
+ FActiveSelIndex := FSelections.Count - 1;
+ end
+ else
+ begin
+ FBaseSelIndex := FSelections.Count - 1;
+ FActiveSelIndex := 0;
+ end;
+
+ Restore(ActiveSelection, False);
+ CaretsChanged;
+end;
+
+procedure TSynSelectionsBase.DeleteSelection(Index: Integer);
+var
+ Sel: TSynSelection;
+begin
+ if FSelections.Count <= 1 then Exit;
+
+ Sel := FSelections[Index];
+ DoInvalidateSelection(Sel);
+ FSelections.Delete(Index);
+
+ if Index = FActiveSelIndex then
+ begin
+ if Index >= FSelections.Count then
+ FActiveSelIndex := FSelections.Count - 1;
+ end
+ else if FActiveSelIndex > Index then
+ Dec(FActiveSelIndex);
+
+ if FBaseSelIndex = Index then
+ FBaseSelIndex := FSelections.Count - 1
+ else if FBaseSelIndex > Index then
+ Dec(FBaseSelIndex);
+
+ CaretsChanged;
+end;
+
+function TSynSelectionsBase.FindCaret(const ACaret: TBufferCoord): Integer;
+var
+ Index: Integer;
+begin
+ if FSelections.Count = 0 then Exit(-1);
+
+ if FindSelection(ACaret, Index) then
+ begin
+ if FSelections[Index].Caret = ACaret then
+ Result := Index
+ else
+ Result := -1;
+ end
+ else if (Index > 0) and (FSelections[Index - 1].Caret = ACaret) then
+ Result := Index - 1
+ else
+ Result := -1;
+end;
+
+function TSynSelectionsBase.FindSelection(const BC: TBufferCoord;
+ var Index: Integer): Boolean;
+begin
+ if FSelections.BinarySearch(TSynSelection.Create(BC, BC, BC), Index) then
+ Exit(True);
+
+ if Index = 0 then
+ Exit(False);
+
+ Result := FSelections[Index - 1].Contains(BC);
+ if Result then
+ Dec(Index);
+end;
+
+function TSynSelectionsBase.GetActiveSelection: TSynSelection;
+begin
+ Result := FSelections[FActiveSelIndex];
+end;
+
+function TSynSelectionsBase.GetBaseSelection: TSynSelection;
+begin
+ Result := FSelections[FBaseSelIndex];
+end;
+
+function TSynSelectionsBase.GetCount: Integer;
+begin
+ Result := FSelections.Count;
+end;
+
+function TSynSelectionsBase.GetIsEmpty: Boolean;
+var
+ Index: Integer;
+begin
+ Result := True;
+ for Index := 0 to FSelections.Count - 1 do
+ if not FSelections.List[Index].IsEmpty then
+ Exit(False);
+end;
+
+function TSynSelectionsBase.GetSelection(Index: Integer): TSynSelection;
+begin
+ Result := FSelections[Index];
+end;
+
+procedure TSynSelectionsBase.InvalidateAll;
+var
+ Index: Integer;
+begin
+ for Index := 0 to FSelections.Count - 1 do
+ InvalidateSelection(Index);
+end;
+
+procedure TSynSelectionsBase.InvalidateSelection(Index: Integer);
+begin
+ DoInvalidateSelection(FSelections[Index]);
+end;
+
+procedure TSynSelectionsBase.LinePut(aIndex: Integer; const OldLine: string);
+var
+ I: Integer;
+ Line: string;
+ OldLen, NewLen: Integer;
+ StartPos: Integer;
+ Delta: Integer;
+begin
+ if FSelections.Count <= 1 then Exit;
+
+ Line := GetLineText(aIndex + 1);
+ LineDiff(Line, OldLine, StartPos, OldLen, NewLen);
+ Delta := NewLen - OldLen;
+
+ for I := FActiveSelIndex + 1 to Count - 1 do
+ begin
+ with FSelections.List[I] do
+ begin
+ if (Start.Line > aIndex + 1) and (Stop.Line > aIndex + 1) then
+ Exit;
+
+ if Caret.Line = aIndex + 1 then Inc(Caret.Char, Delta);
+ if Start.Line = aIndex + 1 then Inc(Start.Char, Delta);
+ if Stop.Line = aIndex + 1 then Inc(Stop.Char, Delta);
+ end;
+ end;
+end;
+
+procedure TSynSelectionsBase.LinesDeleted(FirstLine, aCount: Integer);
+var
+ I: Integer;
+ MinBC: TBufferCoord;
+begin
+ if FSelections.Count <= 1 then Exit;
+
+ for I := FActiveSelIndex + 1 to Count - 1 do
+ with FSelections.List[I] do
+ begin
+ if Caret.Line >= FirstLine + 1 then Dec(Caret.Line, aCount);
+ if Start.Line >= FirstLine + 1 then Dec(Start.Line, aCount);
+ if Stop.Line >= FirstLine + 1 then Dec(Stop.Line, aCount);
+
+ if (Start.Line < FirstLine + 1) and (Stop.Line < FirstLine + 1) then
+ begin
+ FSelections.List[I] := TSynSelection.Invalid;
+ Continue;
+ end;
+
+ MinBC := BufferCoord(FirstLine + 1, 1);
+ Caret := TBufferCoord.Max(Caret, MinBC);
+ Start := TBufferCoord.Max(Start, MinBC);
+ Stop := TBufferCoord.Max(Stop, MinBC);
+ end;
+end;
+
+procedure TSynSelectionsBase.LinesInserted(FirstLine, aCount: Integer);
+var
+ I: Integer;
+begin
+ if FSelections.Count <= 1 then Exit;
+
+ for I := FActiveSelIndex + 1 to Count - 1 do
+ with FSelections.List[I] do
+ begin
+ if Caret.Line >= FirstLine + 1 then Inc(Caret.Line, aCount);
+ if Start.Line >= FirstLine + 1 then Inc(Start.Line, aCount);
+ if Stop.Line >= FirstLine + 1 then Inc(Stop.Line, aCount);
+ end;
+end;
+
+procedure TSynSelectionsBase.Merge;
+
+ function DoMerge(const Sel, NextSel: TSynSelection): TSynSelection;
+ var
+ Caret, Start, Stop: TBufferCoord;
+ begin
+ Start := TBufferCoord.Min(
+ TBufferCoord.Min(Sel.Start, Sel.Stop),
+ TBufferCoord.Min(NextSel.Start, NextSel.Stop));
+ Stop := TBufferCoord.Max(
+ TBufferCoord.Max(Sel.Start, Sel.Stop),
+ TBufferCoord.Max(NextSel.Start, NextSel.Stop));
+
+ if NextSel.Caret = TBufferCoord.Min(NextSel.Start, NextSel.Stop) then
+ Caret := Start
+ else
+ Caret := Stop;
+
+ Result := TSynSelection.Create(Caret, Start, Stop);
+ Result.LastPosX := Sel.LastPosX;
+ Result.CaretAtEOL := Sel.CaretAtEOL;
+ end;
+
+var
+ Sel, NextSel: TSynSelection;
+ I: Integer;
+ BC: TBufferCoord;
+begin
+ if FSelections.Count = 1 then Exit;
+
+ // Remove Invalid
+ for I := Count - 1 downto 0 do
+ if not FSelections.List[I].IsValid then
+ DeleteSelection(I);
+
+ NextSel := FSelections.List[Count - 1];
+ for I := Count - 2 downto 0 do
+ begin
+ Sel := FSelections.List[I];
+
+ if (Sel = NextSel) or Sel.Intersects(NextSel) then
+ begin
+ Sel := DoMerge(Sel, NextSel);
+ FSelections.List[I] := Sel;
+ DeleteSelection(I + 1);
+ end;
+ NextSel := Sel;
+ end;
+
+ // Process the case of one invalid selection
+ if (FSelections.Count = 1) and not FSelections.List[0].IsValid then
+ begin
+ BC := BufferCoord(1, 1);
+ FSelections.List[0] := TSynSelection.Create(BC, BC, BC);
+ end;
+
+ // Activate the current selection
+ Restore(ActiveSelection, False);
+end;
+
+procedure TSynSelectionsBase.MouseSelection(const Sel: TSynSelection);
+begin
+ if FSelections.Count <= 1 then Exit;
+
+ for var Index := FSelections.Count - 1 downto 0 do
+ begin
+ if Index = FActiveSelIndex then
+ Continue;
+ if Sel.Intersects(FSelections.List[Index]) then
+ DeleteSelection(Index);
+ end;
+end;
+
+function TSynSelectionsBase.PartSelectionsForRow(
+ const RowStart, RowEnd: TBufferCoord): TSynSelectionArray;
+var
+ Sel: TSynSelection;
+begin
+ Result := [];
+ for var Index := 0 to FSelections.Count - 1 do
+ begin
+ Sel := FSelections.List[Index].Normalized;
+ if Sel.Stop < RowStart then
+ Continue
+ else if Sel.Start > RowEnd then
+ Exit
+ else if not Sel.IsEmpty then
+ Result := Result + [Sel];
+ end;
+end;
+
+procedure TSynSelectionsBase.Restore(const [Ref] SelStorage: TSynSelStorage);
+begin
+ InvalidateAll;
+ FSelections.Clear;
+ FSelections.AddRange(SelStorage.Selections);
+ FActiveSelIndex := SelStorage.ActiveIndex;
+ FBaseSelIndex := SelStorage.BaseIndex;
+ InvalidateAll;
+ Restore(ActiveSelection);
+ CaretsChanged;
+end;
+
+procedure TSynSelectionsBase.Restore(const [Ref] Sel: TSynSelection;
+ EnsureVisible: Boolean);
+begin
+ DoRestoreSelection(Sel, EnsureVisible);
+end;
+
+function TSynSelectionsBase.RowHasCaret(ARow, ALine: Integer): Boolean;
+
+ function IsCaretOnRow(Sel: TSynSelection): Boolean;
+ begin
+ if GetWordWrap then
+ Result := SelectionToDisplayRow(Sel) = ARow
+ else
+ Result := Sel.Caret.Line = ALine;
+ end;
+
+var
+ Sel: TSynSelection;
+ Index: Integer;
+begin
+ FindSelection(BufferCoord(1, ALine), Index);
+
+ Result := False;
+ while Index < FSelections.Count do
+ begin
+ Sel := FSelections[Index].Normalized;
+ if Sel.Start.Line > ALine then Break;
+ Result := IsCaretOnRow(Sel);
+ if Result then Break;
+ Inc(Index);
+ end;
+end;
+
+procedure TSynSelectionsBase.SetActiveSelection(const Value: TSynSelection);
+begin
+ FSelections[FActiveSelIndex] := Value;
+end;
+
+procedure TSynSelectionsBase.SetActiveSelIndex(const Index: Integer);
+var
+ Sel: TSynSelection;
+begin
+ Assert(InRange(Index, 0, Count - 1));
+ if Index <> FActiveSelIndex then
+ begin
+ FActiveSelIndex := Index;
+ Sel := ActiveSelection;
+ if Sel.IsValid then
+ Restore(ActiveSelection, False);
+ end;
+end;
+
+procedure TSynSelectionsBase.SetBaseSelection(const Value: TSynSelection);
+begin
+ FSelections[FBaseSelIndex] := Value;
+end;
+
+procedure TSynSelectionsBase.Store(out SelStorage: TSynSelStorage);
+begin
+ SelStorage.Selections := FSelections.ToArray;
+ SelStorage.BaseIndex := FBaseSelIndex;
+ SelStorage.ActiveIndex := FActiveSelIndex;
+end;
+
+end.
diff --git a/Source/SynEditTextBuffer.pas b/Source/SynEditTextBuffer.pas
index e136e896..6dda0ffb 100644
--- a/Source/SynEditTextBuffer.pas
+++ b/Source/SynEditTextBuffer.pas
@@ -12,7 +12,7 @@
The Original Code is based on parts of mwCustomEdit.pas by Martin Waldenburg,
part of the mwEdit component suite.
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
- Unicode translation by Mal Hrz.
+ Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -42,7 +42,7 @@ interface
System.SysUtils,
SynEditTypes,
SynEditMiscProcs,
- SynUnicode;
+ SynUnicodeShared;
type
TSynEditRange = Pointer;
@@ -196,7 +196,7 @@ procedure ListIndexOutOfBounds(Index: Integer);
raise ESynEditStringList.CreateFmt(SListIndexOutOfBounds, [Index]);
end;
-constructor TSynEditStringList.Create;
+constructor TSynEditStringList.Create(TextWidthFunc: TTextWidthFunc);
begin
inherited Create;
FFileFormat := sffDos;
@@ -384,7 +384,10 @@ function TSynEditStringList.GetTextWidth(Index: Integer): Integer;
begin
if sfTextWidthUnknown in FList^[Index].FFlags then
begin
- Result := FTextWidthFunc(FList^[Index].FString);
+ if Assigned(FTextWidthFunc) then
+ Result := FTextWidthFunc(FList^[Index].FString)
+ else
+ Result := Length(FList^[Index].FString);
FList^[Index].FTextWidth := Result;
Exclude(FList^[Index].FFlags, sfTextWidthUnknown);
end
@@ -411,7 +414,10 @@ function TSynEditStringList.GetMaxWidth: Integer;
PRec := @FList^[I];
if sfTextWidthUnknown in PRec^.FFlags then
begin
- PRec^.FTextWidth := FTextWidthFunc(PRec^.FString);
+ if Assigned(FTextWidthFunc) then
+ PRec^.FTextWidth := FTextWidthFunc(PRec^.FString)
+ else
+ PRec^.FTextWidth := Length(PRec^.FString);
Exclude(PRec^.FFlags, sfTextWidthUnknown);
end;
repeat
@@ -627,6 +633,7 @@ procedure TSynEditStringList.SaveToStream(Stream: TStream; Encoding: TEncoding);
S := GetTextStr;
Cancel := False;
+ {$IFDEF MSWINDOWS}
if (Encoding = TEncoding.ANSI) and Assigned(FOnInfoLoss) and not IsAnsiOnly(S)
then
begin
@@ -636,6 +643,7 @@ procedure TSynEditStringList.SaveToStream(Stream: TStream; Encoding: TEncoding);
if Encoding <> TEncoding.ANSI then
SetEncoding(Encoding);
end;
+ {$ENDIF}
Buffer := Encoding.GetBytes(S);
if WriteBOM then
@@ -669,7 +677,10 @@ procedure TSynEditStringList.Put(Index: Integer; const S: string);
// Optimization: We calculate text width here, thus
// in most cases avoiding to recalc FMaxWidth the hard way
OldWidth := FTextWidth;
- FTextWidth := FTextWidthFunc(FString);
+ if Assigned(FTextWidthFunc) then
+ FTextWidth := FTextWidthFunc(FString)
+ else
+ FTextWidth := Length(FString);
Exclude(FFlags, sfTextWidthUnknown);
if (FMaxWidth = OldWidth) and (OldWidth > FTextWidth) then
FMaxWidth := -1
diff --git a/Source/SynEditTypes.pas b/Source/SynEditTypes.pas
index 63078e50..567afdb5 100644
--- a/Source/SynEditTypes.pas
+++ b/Source/SynEditTypes.pas
@@ -12,7 +12,7 @@
The Original Code is based on parts of mwCustomEdit.pas by Martin Waldenburg,
part of the mwEdit component suite.
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -41,18 +41,55 @@
interface
uses
- Winapi.Windows,
- Winapi.Messages,
System.Types,
System.Math,
- Vcl.Controls,
System.SysUtils,
- System.Classes;
+ System.Classes,
+ System.UITypes;
const
DefaultBrackets = '()[]{}';
+ { Color constants - aliases for TColors.* to allow shared code to use the
+ traditional cl* names without depending on Vcl.Graphics }
+ clBlack = TColors.Black;
+ clMaroon = TColors.Maroon;
+ clGreen = TColors.Green;
+ clOlive = TColors.Olive;
+ clNavy = TColors.Navy;
+ clPurple = TColors.Purple;
+ clTeal = TColors.Teal;
+ clGray = TColors.Gray;
+ clSilver = TColors.Silver;
+ clRed = TColors.Red;
+ clLime = TColors.Lime;
+ clYellow = TColors.Yellow;
+ clBlue = TColors.Blue;
+ clFuchsia = TColors.Fuchsia;
+ clAqua = TColors.Aqua;
+ clLtGray = TColors.LtGray;
+ clDkGray = TColors.DkGray;
+ clWhite = TColors.White;
+ clSkyBlue = TColors.LegacySkyBlue;
+ clNone = TColors.SysNone;
+ clWindow = TColors.SysWindow;
+ clWindowText = TColors.SysWindowText;
+ clGrayText = TColors.SysGrayText;
+ clHighlight = TColors.SysHighlight;
+ clHighlightText = TColors.SysHighlightText;
+
+ { Font style constants - re-exported from System.UITypes where they are
+ scoped enums, so shared code can use unqualified fsBold etc. }
+ fsBold = System.UITypes.TFontStyle.fsBold;
+ fsItalic = System.UITypes.TFontStyle.fsItalic;
+ fsUnderline = System.UITypes.TFontStyle.fsUnderline;
+ fsStrikeOut = System.UITypes.TFontStyle.fsStrikeOut;
+
type
+ { Re-export font types so shared code doesn't need Vcl.Graphics }
+ TFontStyle = System.UITypes.TFontStyle;
+ TFontStyles = System.UITypes.TFontStyles;
+
TSynAlignment = TAlignment;
var
@@ -189,15 +226,6 @@ TSynSelection = record
TSynSelectionArray = TArray;
- (* Helper methods for TControl - for backwward compatibility *)
- {$IF CompilerVersion <= 32}
- TControlHelper = class helper for TControl
- public
- function CurrentPPI: Integer;
- function FCurrentPPI: Integer;
- end;
- {$ENDIF}
-
function DisplayCoord(AColumn, ARow: Integer): TDisplayCoord;
function BufferCoord(AChar, ALine: Integer): TBufferCoord;
@@ -212,18 +240,6 @@ TCaretShape = record
end;
-{ ************************* For ScrollBars ********************************}
-
- ISynEditScrollBars = interface
- function UpdateScrollBars: Boolean;
- function GetIsScrolling: Boolean;
- procedure WMHScroll(var AMsg: TWMScroll);
- procedure WMVScroll(var AMsg: TWMScroll);
- procedure DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint);
- property IsScrolling: Boolean read GetIsScrolling;
- end;
-
{ ************************* For Word Wrap ********************************}
// aIndex parameters of Line notifications are 0-based.
@@ -261,6 +277,44 @@ TCaretShape = record
// for undo/redo of adding a character past EOL and repositioning the caret
);
+{ ******************** Multicast event chains ****************************}
+
+ ESynMethodChain = class(Exception);
+ TSynExceptionEvent = procedure(Sender: TObject; E: Exception;
+ var DoContinue: Boolean) of object;
+
+ TSynMethodChain = class(TObject)
+ private
+ FNotifyProcs: TList;
+ FExceptionHandler: TSynExceptionEvent;
+ protected
+ procedure DoFire(const AEvent: TMethod); virtual; abstract;
+ function DoHandleException(E: Exception): Boolean; virtual;
+ property ExceptionHandler: TSynExceptionEvent read FExceptionHandler
+ write FExceptionHandler;
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+ procedure Add(AEvent: TMethod);
+ procedure Remove(AEvent: TMethod);
+ procedure Fire;
+ end;
+
+ TSynNotifyEventChain = class(TSynMethodChain)
+ private
+ FSender: TObject;
+ protected
+ procedure DoFire(const AEvent: TMethod); override;
+ public
+ constructor CreateEx(ASender: TObject);
+ procedure Add(AEvent: TNotifyEvent);
+ procedure Remove(AEvent: TNotifyEvent);
+ property ExceptionHandler;
+ property Sender: TObject read FSender write FSender;
+ end;
+
+{ ************************* For Undo Redo ********************************}
+
TSynEditUndoItem = class(TObject)
public
ChangeStartPos: TBufferCoord;
@@ -291,8 +345,8 @@ TSynEditUndoItem = class(TObject)
store/restore editor caret and selection
We need to pass the Editor so that they works with chained SynEdits
}
- procedure BeginBlock(Editor: TControl);
- procedure EndBlock(Editor: TControl);
+ procedure BeginBlock(Editor: TObject);
+ procedure EndBlock(Editor: TObject);
{ Lock disables undo/redo - useful if you are about to do a large number of
changes and planning to clear undo afterwards }
procedure Lock;
@@ -302,8 +356,8 @@ TSynEditUndoItem = class(TObject)
cannot be grouped with the current one }
procedure AddGroupBreak;
{Note: Undo/Redo are not reentrant}
- procedure Undo(Editor: TControl);
- procedure Redo(Editor: TControl);
+ procedure Undo(Editor: TObject);
+ procedure Redo(Editor: TObject);
{TrackChanges stuff}
procedure BufferSaved(Lines: TStrings);
procedure ClearTrackChanges(Lines: TStrings);
@@ -326,13 +380,259 @@ TSynEditUndoItem = class(TObject)
property InsideUndoRedo: Boolean read GetInsideUndoRedo;
end;
+{ ************************** Selected Color *********************************}
+
+ TSynSelectedColor = class(TPersistent)
+ private
+ FBG: TColor;
+ FFG: TColor;
+ FOnChange: TNotifyEvent;
+ FOpacity: Byte;
+ FFillWholeLines: Boolean;
+ procedure SetBG(Value: TColor);
+ procedure SetFG(Value: TColor);
+ procedure SetOpacity(Value: Byte);
+ procedure SetFillWholeLines(const Value: Boolean);
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property Background: TColor read FBG write SetBG default clHighLight;
+ property Foreground: TColor read FFG write SetFG default clHighLightText;
+ property Opacity: Byte read FOpacity write SetOpacity default 115;
+ property FillWholeLines: Boolean read FFillWholeLines write SetFillWholeLines
+ default True;
+ end;
+
+{ *************************** Search Engine ********************************}
+
+ TSynIsWordBreakFunction = function(C: WideChar): Boolean of object;
+
+ TSynEditSearchCustom = class(TComponent)
+ protected
+ FIsWordBreakFunction: TSynIsWordBreakFunction;
+ function GetPattern: string; virtual; abstract;
+ procedure SetPattern(const Value: string); virtual; abstract;
+ function GetLength(Index: Integer): Integer; virtual; abstract;
+ function GetResult(Index: Integer): Integer; virtual; abstract;
+ function GetResultCount: Integer; virtual; abstract;
+ procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
+ public
+ function FindAll(const NewText: string; StartChar: Integer = 1;
+ EndChar: Integer = 0): Integer; virtual; abstract;
+ function PreprocessReplaceExpression(const AReplace: string): string; virtual;
+ function Replace(const aOccurrence, aReplacement: string): string;
+ virtual; abstract;
+ property Pattern: string read GetPattern write SetPattern;
+ property ResultCount: Integer read GetResultCount;
+ property Results[Index: Integer]: Integer read GetResult;
+ property Lengths[Index: Integer]: Integer read GetLength;
+ property Options: TSynSearchOptions write SetOptions;
+ property IsWordBreakFunction: TSynIsWordBreakFunction write FIsWordBreakFunction;
+ end;
+
implementation
Uses
-{$IF CompilerVersion <= 32}
- Vcl.Forms,
-{$ENDIF}
SynEditStrConst,
- SynUnicode;
+ SynUnicodeShared;
+
+{$REGION 'TSynSelectedColor'}
+
+constructor TSynSelectedColor.Create;
+begin
+ inherited Create;
+ FBG := clHighLight;
+ FFG := clHighLightText;
+ FFillWholeLines := True;
+ FOpacity := 115;
+end;
+
+procedure TSynSelectedColor.Assign(Source: TPersistent);
+begin
+ if Source is TSynSelectedColor then
+ begin
+ var Src := TSynSelectedColor(Source);
+ FBG := Src.FBG;
+ FFG := Src.FFG;
+ FOpacity := Src.Opacity;
+ FFillWholeLines := Src.FillWholeLines;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TSynSelectedColor.SetBG(Value: TColor);
+begin
+ if FBG <> Value then
+ begin
+ FBG := Value;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ end;
+end;
+
+procedure TSynSelectedColor.SetFG(Value: TColor);
+begin
+ if FFG <> Value then
+ begin
+ FFG := Value;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ end;
+end;
+
+procedure TSynSelectedColor.SetOpacity(Value: Byte);
+begin
+ if FOpacity <> Value then
+ begin
+ FOpacity := Value;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ end;
+end;
+
+procedure TSynSelectedColor.SetFillWholeLines(const Value: Boolean);
+begin
+ if FFillWholeLines <> Value then
+ begin
+ FFillWholeLines := Value;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+ end;
+end;
+
+{$ENDREGION}
+
+{ TSynEditSearchCustom }
+
+function TSynEditSearchCustom.PreprocessReplaceExpression(const AReplace
+ : string): string;
+begin
+ Result := AReplace;
+end;
+
+{$REGION 'TSynMethodChain'}
+
+procedure TSynMethodChain.Add(AEvent: TMethod);
+begin
+ if not Assigned(@AEvent) then
+ raise ESynMethodChain.CreateFmt
+ ('%s.Entry: the parameter `AEvent'' must be specified.', [ClassName]);
+
+ with FNotifyProcs, AEvent do
+ begin
+ Add(Code);
+ Add(Data);
+ end
+end;
+
+constructor TSynMethodChain.Create;
+begin
+ inherited;
+ FNotifyProcs := TList.Create;
+end;
+
+destructor TSynMethodChain.Destroy;
+begin
+ FNotifyProcs.Free;
+ inherited;
+end;
+
+function TSynMethodChain.DoHandleException(E: Exception): Boolean;
+begin
+ if not Assigned(FExceptionHandler) then
+ raise E
+ else
+ try
+ Result := True;
+ FExceptionHandler(Self, E, Result);
+ except
+ raise ESynMethodChain.CreateFmt
+ ('%s.DoHandleException: MUST NOT occur any kind of exception in ' +
+ 'ExceptionHandler', [ClassName]);
+ end;
+end;
+
+procedure TSynMethodChain.Fire;
+var
+ AMethod: TMethod;
+ I: Integer;
+begin
+ I := 0;
+ with FNotifyProcs, AMethod do
+ while I < Count do
+ try
+ repeat
+ Code := Items[I];
+ Inc(I);
+ Data := Items[I];
+ Inc(I);
+
+ DoFire(AMethod)
+ until I >= Count;
+ except
+ on E: Exception do
+ if not DoHandleException(E) then
+ I := MaxInt;
+ end;
+end;
+
+procedure TSynMethodChain.Remove(AEvent: TMethod);
+var
+ I: Integer;
+begin
+ if not Assigned(@AEvent) then
+ raise ESynMethodChain.CreateFmt
+ ('%s.Remove: the parameter `AEvent'' must be specified.', [ClassName]);
+
+ with FNotifyProcs, AEvent do
+ begin
+ I := Count - 1;
+ while I > 0 do
+ if Items[I] <> Data then
+ Dec(I, 2)
+ else
+ begin
+ Dec(I);
+ if Items[I] = Code then
+ begin
+ Delete(I);
+ Delete(I);
+ end;
+ Dec(I);
+ end;
+ end;
+end;
+
+{$ENDREGION}
+
+{$REGION 'TSynNotifyEventChain'}
+
+procedure TSynNotifyEventChain.Add(AEvent: TNotifyEvent);
+begin
+ inherited Add(TMethod(AEvent));
+end;
+
+constructor TSynNotifyEventChain.CreateEx(ASender: TObject);
+begin
+ inherited Create;
+ FSender := ASender;
+end;
+
+procedure TSynNotifyEventChain.DoFire(const AEvent: TMethod);
+begin
+ TNotifyEvent(AEvent)(FSender);
+end;
+
+procedure TSynNotifyEventChain.Remove(AEvent: TNotifyEvent);
+begin
+ inherited Remove(TMethod(AEvent));
+end;
+
+{$ENDREGION}
function DisplayCoord(AColumn, ARow: Integer): TDisplayCoord;
begin
@@ -486,22 +786,6 @@ class function TDisplayCoord.Min(a, b: TDisplayCoord): TDisplayCoord;
Result := (a.Row <> b.Row) or (a.Column <> b.Column);
end;
-{$IF CompilerVersion <= 32}
-{ TControlHelper }
-
-function TControlHelper.CurrentPPI: Integer;
-begin
- Result := Screen.PixelsPerInch;
-end;
-
-function TControlHelper.FCurrentPPI: Integer;
-begin
- Result := Screen.PixelsPerInch;
-end;
-{$ENDIF}
-
-
-
{ TSynSelection }
function TSynSelection.Contains(const BC: TBufferCoord): Boolean;
diff --git a/Source/SynEditUndo.pas b/Source/SynEditUndo.pas
deleted file mode 100644
index e0ad496f..00000000
--- a/Source/SynEditUndo.pas
+++ /dev/null
@@ -1,955 +0,0 @@
-{ -------------------------------------------------------------------------------
- The contents of this file are subject to the Mozilla Public License
- Version 1.1 (the "License"); you may not use this file except in compliance
- with the License. You may obtain a copy of the License at
- http://www.mozilla.org/MPL/
-
- Software distributed under the License is distributed on an "AS IS" basis,
- WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
- the specific language governing rights and limitations under the License.
-
- Contributors to the SynEdit and mwEdit projects are listed in the
- Contributors.txt file.
-
- Alternatively, the contents of this file may be used under the terms of the
- GNU General Public License Version 2 or later (the "GPL"), in which case
- the provisions of the GPL are applicable instead of those above.
- If you wish to allow use of your version of this file only under the terms
- of the GPL and not to allow others to use your version of this file
- under the MPL, indicate your decision by deleting the provisions above and
- replace them with the notice and other provisions required by the GPL.
- If you do not delete the provisions above, a recipient may use your version
- of this file under either the MPL or the GPL.
-
- Known Issues:
- ------------------------------------------------------------------------------- }
-
-unit SynEditUndo;
-
-{$I SynEdit.inc}
-
-interface
-
-uses
- SynEdit,
- SynEditTypes,
- SynEditKeyCmds;
-
-{ Factory Method}
-
-function CreateSynEditUndo(Editor: TCustomSynEdit): ISynEditUndo;
-
-implementation
-
-uses
- System.Classes,
- System.SysUtils,
- System.Math,
- System.Generics.Collections,
- Vcl.Controls,
- SynEditMiscProcs,
- SynEditMiscClasses,
- SynEditTextBuffer;
-
-type
-
- TSynUndoItem = class abstract(TObject)
- ChangeNumber: Integer; // Undo items with the same change number are grouped
- FCaret: TBufferCoord;
- GroupBreak: Boolean; // Singnals not to group items together
- public
- procedure Undo(Editor: TCustomSynEdit); virtual; abstract;
- procedure Redo(Editor: TCustomSynEdit); virtual; abstract;
- end;
-
- TSynLinePutUndoItem = class(TSynUndoItem)
- private
- FIndex: Integer;
- FStartPos: Integer;
- FOldValue: string;
- FNewValue: string;
- FChangeFlags: TSynLineChangeFlags;
- FCommandProcessed: TSynEditorCommand;
- public
- function GroupWith(Item:TSynLinePutUndoItem): Boolean;
- procedure Undo(Editor: TCustomSynEdit); override;
- procedure Redo(Editor: TCustomSynEdit); override;
- constructor Create(Editor: TCustomSynEdit; Index: Integer; OldLine: string;
- Command: TSynEditorCommand);
- end;
-
- TSynLinesInsertedUndoItem = class(TSynUndoItem)
- private
- FIndex: Integer;
- FLines: TArray;
- FChangeFlags: TArray;
- public
- procedure Undo(Editor: TCustomSynEdit); override;
- procedure Redo(Editor: TCustomSynEdit); override;
- constructor Create(Editor: TCustomSynEdit; Index, Count: Integer);
- end;
-
- TSynLinesDeletedUndoItem = class(TSynUndoItem)
- private
- FIndex: Integer;
- FLines: TArray;
- FChangeFlags: TArray;
- public
- procedure Undo(Editor: TCustomSynEdit); override;
- procedure Redo(Editor: TCustomSynEdit); override;
- constructor Create(Editor: TCustomSynEdit; Index: Integer; DeletedLines:
- TArray; DeletedChangeFlags: TArray);
- end;
-
- TSynCaretAndSelectionUndoItem = class(TSynUndoItem)
- private
- FBlockBegin: TBufferCoord;
- FBlockEnd: TBufferCoord;
- SelStorage: TSynSelStorage;
- public
- procedure Undo(Editor: TCustomSynEdit); override;
- procedure Redo(Editor: TCustomSynEdit); override;
- constructor Create(Editor: TCustomSynEdit);
- end;
-
- TSynEditUndo = class;
-
- TSynUndoPlugin = class(TSynEditPlugin)
- private
- FSynEditUndo: TSynEditUndo;
- FDeletedLines: TArray;
- FDeletedChangeFlags: TArray;
- protected
- procedure LinesInserted(FirstLine, Count: Integer); override;
- procedure LinesBeforeDeleted(FirstLine, Count: Integer); override;
- procedure LinesDeleted(FirstLine, Count: Integer); override;
- procedure LinePut(aIndex: Integer; const OldLine: string); override;
- public
- constructor Create(SynEditUndo: TSynEditUndo; Editor: TCustomSynEdit);
- end;
-
- TSynEditUndoList = class(TObjectStack)
- protected
- FOwner: TSynEditUndo;
- FFullUndoImposible: Boolean;
- procedure EnsureMaxEntries;
- public
- constructor Create(Owner: TSynEditUndo);
- procedure Push(const Value: TSynUndoItem);
- end;
-
- TSynEditUndo = class(TInterfacedObject, ISynEditUndo)
- private
- FPlugin: TSynUndoPlugin;
- FGroupUndo: Boolean;
- FBlockCount: Integer;
- FLockCount: Integer;
- FBlockChangeNumber: Integer;
- FNextChangeNumber: Integer;
- FInitialChangeNumber: Integer;
- FMaxUndoActions: Integer;
- FBlockStartModified: Boolean;
- FUndoList: TSynEditUndoList;
- FRedoList: TSynEditUndoList;
- FOnModifiedChanged: TNotifyEvent;
- FInsideUndoRedo: Boolean;
- FCommandProcessed: TSynEditorCommand;
- FBlockSelRestoreItem: TSynUndoItem;
- function GetModified: Boolean;
- function GetCanUndo: Boolean;
- function GetCanRedo: Boolean;
- function GetFullUndoImposible: Boolean;
- function GetOnModifiedChanged: TNotifyEvent;
- function GetInsideUndoRedo: Boolean;
- procedure SetModified(const Value: Boolean);
- procedure SetCommandProcessed(const Command: TSynEditorCommand);
- procedure SetMaxUndoActions(const Value: Integer);
- procedure SetOnModifiedChanged(const Value: TNotifyEvent);
- procedure SetGroupUndo(const Value: Boolean);
- function GetMaxUndoActions: Integer;
- procedure BeginBlock(Editor: TControl);
- procedure EndBlock(Editor: TControl);
- procedure Lock;
- procedure Unlock;
- function IsLocked: Boolean;
- procedure Clear;
- procedure Undo(Editor: TControl);
- procedure Redo(Editor: TControl);
- procedure BufferSaved(Lines: TStrings);
- procedure ClearTrackChanges(Lines: TStrings);
-
- function NextChangeNumber: Integer;
- procedure AddGroupBreak;
- procedure AddUndoItem(Item: TSynUndoItem);
- public
- constructor Create(Editor: TCustomSynEdit);
- destructor Destroy; override;
- end;
-
-{ TSynEditUndoList }
-
-constructor TSynEditUndoList.Create(Owner: TSynEditUndo);
-begin
- inherited Create(True);
- FOwner := Owner;
-end;
-
-procedure TSynEditUndoList.EnsureMaxEntries;
-var
- KeepCount: Integer;
- ItemArray: TArray;
- I: Integer;
-begin
- if FOwner.FMaxUndoActions <= 0 then Exit;
-
- if Count > FOwner.FMaxUndoActions then
- begin
- FFullUndoImposible := True;
- KeepCount := (FOwner.FMaxUndoActions div 4) * 3;
- ItemArray := ToArray;
- for I := 1 to KeepCount do
- Extract;
- Clear; // Destroys remaining items
- for I := Length(ItemArray) - KeepCount to Length(ItemArray) - 1 do
- Push(ItemArray[I]);
- end;
-end;
-
-procedure TSynEditUndoList.Push(const Value: TSynUndoItem);
-begin
- inherited Push(Value);
- EnsureMaxEntries;
-end;
-
-{ TSynEditUndo }
-
-procedure TSynEditUndo.AddUndoItem(Item: TSynUndoItem);
-var
- OldModified: Boolean;
-begin
- Assert(not FInsideUndoRedo);
- OldModified := GetModified;
- if FBlockChangeNumber <> 0 then
- Item.ChangeNumber := FBlockChangeNumber
- else
- Item.ChangeNumber := NextChangeNumber;
- FUndoList.Push(Item);
- FRedoList.Clear;
- // Do not sent unnecessary notifications
- if (FBlockCount = 0) and (OldModified xor GetModified) and
- Assigned(FOnModifiedChanged)
- then
- FOnModifiedChanged(Self);
-end;
-
-procedure TSynEditUndo.AddGroupBreak;
-begin
- if (FUndoList.Count > 0) and (FBlockCount = 0) then
- FUndoList.Peek.GroupBreak := True;
-end;
-
-procedure TSynEditUndo.BeginBlock(Editor: TControl);
-begin
- if IsLocked then Exit;
-
- Inc(FBlockCount);
- if FBlockCount = 1 then // it was 0
- begin
- FBlockStartModified := GetModified;
- // All undo items added until the matching EndBlock is called
- // will get the same change number and will be grouped together
- FBlockChangeNumber := NextChangeNumber;
-
- // So that position is restored after Redo
- FBlockSelRestoreItem := TSynCaretAndSelectionUndoItem.Create(Editor as TCustomSynEdit);
- FBlockSelRestoreItem.ChangeNumber := FBlockChangeNumber;
- FUndoList.Push(FBlockSelRestoreItem);
- end;
-end;
-
-procedure TSynEditUndo.BufferSaved(Lines: TStrings);
-
- procedure PutItemSaved(Item: TSynLinePutUndoItem);
- begin
- if Item.FChangeFlags = [sfAsSaved] then
- Item.FChangeFlags := [sfModified];
- end;
-
- procedure InsertedItemSaved(Item: TSynLinesInsertedUndoItem);
- var
- I: Integer;
- begin
- for I := 0 to Length(Item.FChangeFlags) - 1 do
- Item.FChangeFlags[I] := [sfModified];
- end;
-
- procedure DeletedItemSaved(Item: TSynLinesDeletedUndoItem);
- var
- I: Integer;
- begin
- for I := 0 to Length(Item.FChangeFlags) - 1 do
- Item.FChangeFlags[I] := [sfModified];
- end;
-
-var
- SynLines: TSynEditStringList;
- Index: Integer;
- Flags: TSynLineChangeFlags;
- Item: TSynUndoItem;
-begin
- SynLines := Lines as TSynEditStringList;
- // First change the flags of TSynEditStringList
- for Index := 0 to SynLines.Count - 1 do
- begin
- Flags := SynLines.ChangeFlags[Index];
- if Flags = [sfSaved] then
- // original line saved and then restored
- SynLines.ChangeFlags[Index] := []
- else if sfModified in Flags then
- SynLines.ChangeFlags[Index] := Flags - [sfModified] + [sfSaved, sfAsSaved];
- end;
- // Then modify the Undo/Redo lists
- for Item in FUndoList do
- if Item is TSynLinePutUndoItem then
- PutItemSaved(TSynLinePutUndoItem(Item))
- else if Item is TSynLinesInsertedUndoItem then
- InsertedItemSaved(TSynLinesInsertedUndoItem(Item))
- else if Item is TSynLinesDeletedUndoItem then
- DeletedItemSaved(TSynLinesDeletedUndoItem(Item));
-
- for Item in FRedoList do
- if Item is TSynLinePutUndoItem then
- PutItemSaved(TSynLinePutUndoItem(Item))
- else if Item is TSynLinesInsertedUndoItem then
- InsertedItemSaved(TSynLinesInsertedUndoItem(Item))
- else if Item is TSynLinesDeletedUndoItem then
- DeletedItemSaved(TSynLinesDeletedUndoItem(Item));
-end;
-
-procedure TSynEditUndo.Clear;
-begin
- FUndoList.Clear;
- FRedoList.Clear;
-end;
-
-procedure TSynEditUndo.ClearTrackChanges(Lines: TStrings);
- procedure InsertedItemClear(Item: TSynLinesInsertedUndoItem);
- var
- I: Integer;
- begin
- for I := 0 to Length(Item.FChangeFlags) - 1 do
- Item.FChangeFlags[I] := [sfModified];
- end;
-
- procedure DeletedItemClear(Item: TSynLinesDeletedUndoItem);
- var
- I: Integer;
- begin
- for I := 0 to Length(Item.FChangeFlags) - 1 do
- Item.FChangeFlags[I] := [sfModified];
- end;
-var
- SynLines: TSynEditStringList;
- Index: Integer;
- Item: TSynUndoItem;
-begin
- SynLines := Lines as TSynEditStringList;
- // First change the flags of TSynEditStringList
- for Index := 0 to SynLines.Count - 1 do
- SynLines.ChangeFlags[Index] := [];
- // Then modify the Undo/Redo lists
- for Item in FUndoList do
- if Item is TSynLinesInsertedUndoItem then
- InsertedItemClear(TSynLinesInsertedUndoItem(Item))
- else if Item is TSynLinesDeletedUndoItem then
- DeletedItemClear(TSynLinesDeletedUndoItem(Item));
-
- for Item in FRedoList do
- if Item is TSynLinesInsertedUndoItem then
- InsertedItemClear(TSynLinesInsertedUndoItem(Item))
- else if Item is TSynLinesDeletedUndoItem then
- DeletedItemClear(TSynLinesDeletedUndoItem(Item));
-end;
-
-constructor TSynEditUndo.Create(Editor: TCustomSynEdit);
-begin
- inherited Create;
- FGroupUndo := True;
- FMaxUndoActions := 0;
- FNextChangeNumber := 1;
- FUndoList := TSynEditUndoList.Create(Self);
- FRedoList := TSynEditUndoList.Create(Self);
- FPlugin := TSynUndoPlugin.Create(Self, Editor);
-end;
-
-destructor TSynEditUndo.Destroy;
-begin
- FUndoList.Free;
- FRedoList.Free;
- inherited;
-end;
-
-procedure TSynEditUndo.EndBlock(Editor: TControl);
-var
- Item: TSynCaretAndSelectionUndoItem;
-begin
- if IsLocked then Exit;
-
- Assert(FBlockCount > 0);
- if FBlockCount > 0 then
- begin
- Dec(FBlockCount);
- if FBlockCount = 0 then
- begin
- if (FUndoList.Count > 0) and (FUndoList.Peek = FBlockSelRestoreItem) then
- // No undo items added from BlockBegin to BlockEnd
- FUndoList.Pop
- else
- begin
- // So that position is restored after Redo
- Item := TSynCaretAndSelectionUndoItem.Create(Editor as TCustomSynEdit);
- Item.ChangeNumber := FBlockChangeNumber;
- FUndoList.Push(Item);
- end;
-
- FBlockChangeNumber := 0;
- AddGroupBreak;
- if FBlockStartModified xor GetModified and Assigned(FOnModifiedChanged) then
- FOnModifiedChanged(Self);
- end;
- end;
-end;
-
-function TSynEditUndo.GetCanUndo: Boolean;
-begin
- Result := FUndoList.Count > 0;
-end;
-
-function TSynEditUndo.GetFullUndoImposible: Boolean;
-begin
- Result := FUndoList.FFullUndoImposible;
-end;
-
-function TSynEditUndo.GetInsideUndoRedo: Boolean;
-begin
- Result := FInsideUndoRedo;
-end;
-
-function TSynEditUndo.GetMaxUndoActions: Integer;
-begin
- Result := FMaxUndoActions;
-end;
-
-function TSynEditUndo.GetModified: Boolean;
-begin
- if FUndoList.Count = 0 then
- Result := FInitialChangeNumber <> 0
- else
- Result := FUndoList.Peek.ChangeNumber <> FInitialChangeNumber;
-end;
-
-function TSynEditUndo.GetOnModifiedChanged: TNotifyEvent;
-begin
- Result := FOnModifiedChanged;
-end;
-
-function TSynEditUndo.IsLocked: Boolean;
-begin
- Result := FLockCount > 0;
-end;
-
-function TSynEditUndo.GetCanRedo: Boolean;
-begin
- Result := FRedoList.Count > 0;
-end;
-
-procedure TSynEditUndo.Lock;
-begin
- Inc(FLockCount);
-end;
-
-function TSynEditUndo.NextChangeNumber: Integer;
-begin
- Result := FNextChangeNumber;
- Inc(FNextChangeNumber);
-end;
-
-procedure TSynEditUndo.Redo(Editor: TControl);
-var
- Item, LastItem: TSynUndoItem;
- OldChangeNumber: Integer;
- OldModified: Boolean;
- FKeepGoing: Boolean;
- LastItemHasGroupBreak: Boolean;
-begin
- Assert((FBlockCount = 0) and (FBlockChangeNumber = 0));
-
- if FRedoList.Count > 0 then
- begin
- Item := FRedoList.Peek;
- OldModified := GetModified;
- OldChangeNumber := Item.ChangeNumber;
-
- repeat
- Item := FRedoList.Extract;
- LastItemHasGroupBreak := Item.GroupBreak;
- LastItem := Item;
- FInsideUndoRedo := True;
- try
- Item.Redo(Editor as TCustomSynEdit);
- finally
- FInsideUndoRedo := False;
- end;
- // Move it to the UndoList
- FUndoList.Push(Item);
-
- if FRedoList.Count = 0 then
- Break
- else
- Item := FRedoList.Peek;
-
- if Item.ChangeNumber = OldChangeNumber then
- FKeepGoing := True
- else
- FKeepGoing :=
- FGroupUndo and
- { Last Item had a group break - Stop redoing }
- not LastItemHasGroupBreak and
- { Group together same undo actions }
- (LastItem is TSynLinePutUndoItem) and
- (Item is TSynLinePutUndoItem) and
- TSynLinePutUndoItem(LastItem).GroupWith(TSynLinePutUndoItem(Item));
- until not(FKeepGoing);
-
- if not (Item is TSynCaretAndSelectionUndoItem) then
- begin
- (Editor as TCustomSynEdit).Selections.Clear;
- (Editor as TCustomSynEdit).CaretXY := Item.FCaret; // removes selection
- end;
- if (OldModified xor GetModified) and Assigned(FOnModifiedChanged) then
- FOnModifiedChanged(Self);
- end;
-end;
-
-procedure TSynEditUndo.SetCommandProcessed(const Command: TSynEditorCommand);
-begin
- FCommandProcessed := Command;
-end;
-
-procedure TSynEditUndo.SetGroupUndo(const Value: Boolean);
-begin
- FGroupUndo := Value;
-end;
-
-procedure TSynEditUndo.SetMaxUndoActions(const Value: Integer);
-begin
- if Value <> FMaxUndoActions then
- begin
- FMaxUndoActions := Value;
- FUndoList.EnsureMaxEntries;
- FRedoList.EnsureMaxEntries;
- end;
-end;
-
-procedure TSynEditUndo.SetModified(const Value: Boolean);
-begin
- if not Value then
- begin
- if FUndoList.Count = 0 then
- FInitialChangeNumber := 0
- else
- FInitialChangeNumber := FUndoList.Peek.ChangeNumber;
- end
- else if FUndoList.Count = 0 then
- begin
- if FInitialChangeNumber = 0 then
- FInitialChangeNumber := -1;
- end
- else if FUndoList.Peek.ChangeNumber = FInitialChangeNumber then
- FInitialChangeNumber := -1
-end;
-
-procedure TSynEditUndo.SetOnModifiedChanged(const Value: TNotifyEvent);
-begin
- FOnModifiedChanged := Value;
-end;
-
-procedure TSynEditUndo.Undo(Editor: TControl);
-var
- Item, LastItem: TSynUndoItem;
- OldChangeNumber: Integer;
- OldModified: Boolean;
- FKeepGoing: Boolean;
-begin
- Assert((FBlockCount = 0) and (FBlockChangeNumber = 0));
-
- if FUndoList.Count > 0 then
- begin
- Item := FUndoList.Peek;
- OldModified := GetModified;
- OldChangeNumber := Item.ChangeNumber;
-
- repeat
- Item := FUndoList.Extract;
- LastItem := Item;
- FInsideUndoRedo := True;
- try
- Item.Undo(Editor as TCustomSynEdit);
- finally
- FInsideUndoRedo := False;
- end;
- // Move it to the RedoList
- FRedoList.Push(Item);
-
- if FUndoList.Count = 0 then
- Break
- else
- Item := FUndoList.Peek;
-
- if Item.ChangeNumber = OldChangeNumber then
- FKeepGoing := True
- else
- FKeepGoing :=
- FGroupUndo and
- { Last Item had a group break - Stop redoing }
- not Item.GroupBreak and
- { Group together same undo actions }
- (LastItem is TSynLinePutUndoItem) and
- (Item is TSynLinePutUndoItem) and
- TSynLinePutUndoItem(Item).GroupWith(TSynLinePutUndoItem(LastItem));
- until not(FKeepGoing);
-
- if not (LastItem is TSynCaretAndSelectionUndoItem) then
- begin
- (Editor as TCustomSynEdit).Selections.Clear;
- (Editor as TCustomSynEdit).SetCaretAndSelection(LastItem.FCaret, LastItem.FCaret,
- LastItem.FCaret);
- end;
- if (OldModified xor GetModified) and Assigned(FOnModifiedChanged) then
- FOnModifiedChanged(Self);
- end;
-end;
-
-procedure TSynEditUndo.Unlock;
-begin
- if FLockCount > 0 then
- Dec(FLockCount);
-end;
-
-{ Factory Method}
-
-function CreateSynEditUndo(Editor: TCustomSynEdit): ISynEditUndo;
-begin
- Result := TSynEditUndo.Create(Editor);
-end;
-
-{ TSynCaretAndSelectionUndoItem }
-
-constructor TSynCaretAndSelectionUndoItem.Create(Editor: TCustomSynEdit);
-begin
- inherited Create;
- if Editor.Selections.Count = 1 then
- begin
- FCaret := Editor.CaretXY;
- FBlockBegin := Editor.BlockBegin;
- FBlockEnd := Editor.BlockEnd;
- end
- else
- begin
- Editor.Selections.Store(SelStorage);
- end;
-end;
-
-procedure TSynCaretAndSelectionUndoItem.Redo(Editor: TCustomSynEdit);
-begin
- // Same as Undo
- Undo(Editor);
-end;
-
-procedure TSynCaretAndSelectionUndoItem.Undo(Editor: TCustomSynEdit);
-begin
- if Length(SelStorage.Selections) > 0 then
- Editor.Selections.Restore(SelStorage)
- else
- begin
- Editor.Selections.Clear;
- Editor.SetCaretAndSelection(FCaret, FBlockBegin, FBlockEnd);
- end;
-end;
-
-{ TSynLinesDeletedUndoItem }
-
-constructor TSynLinesDeletedUndoItem.Create(Editor: TCustomSynEdit; Index:
- Integer; DeletedLines: TArray; DeletedChangeFlags:
- TArray);
-begin
- inherited Create;
- FIndex := Index;
- FLines := DeletedLines;
- FChangeFlags := DeletedChangeFlags;
-end;
-
-procedure TSynLinesDeletedUndoItem.Redo(Editor: TCustomSynEdit);
-var
- I: Integer;
-begin
- // Save change flags
- SetLength(FChangeFlags, Length(FLines));
- for I := 0 to Length(FLines) - 1 do
- FChangeFlags[I] := TSynEditStringList(Editor.Lines).ChangeFlags[FIndex + I];
-
- TSynEditStringList(Editor.Lines).DeleteLines(FIndex, Length(FLines));
- FCaret := BufferCoord(1, FIndex + 1);
-end;
-
-procedure TSynLinesDeletedUndoItem.Undo(Editor: TCustomSynEdit);
-var
- I: Integer;
-begin
- TSynEditStringList(Editor.Lines).InsertStrings(FIndex, FLines);
-
- // Restore change flags
- for I := 0 to Length(FLines) - 1 do
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex + I] := FChangeFlags[I];
-
- FCaret := BufferCoord(1,
- Min(Editor.Lines.Count, FIndex + Length(FLines) + 1));
-end;
-
-{ TSynLinesInsertedUndoItem }
-
-constructor TSynLinesInsertedUndoItem.Create(Editor: TCustomSynEdit; Index,
- Count: Integer);
-var
- I: Integer;
-begin
- inherited Create;
- FIndex := Index;
- SetLength(FLines, Count);
- for I := 0 to Count - 1 do
- begin
- FLines[I] := Editor.Lines[Index + I];
- // Mark the lines modified
- TSynEditStringList(Editor.Lines).ChangeFlags[Index + I] := [sfModified];
- end;
-end;
-
-procedure TSynLinesInsertedUndoItem.Redo(Editor: TCustomSynEdit);
-var
- I: Integer;
-begin
- TSynEditStringList(Editor.Lines).InsertStrings(FIndex, FLines);
-
- // Restore change flags
- for I := 0 to Length(FLines) - 1 do
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex + I] := FChangeFlags[I];
-
- FCaret := BufferCoord(1,
- Min(Editor.Lines.Count, FIndex + Length(FLines) + 1));
-end;
-
-procedure TSynLinesInsertedUndoItem.Undo(Editor: TCustomSynEdit);
-var
- I: Integer;
-begin
- // Save change flags
- SetLength(FChangeFlags, Length(FLines));
- for I := 0 to Length(FLines) - 1 do
- FChangeFlags[I] := TSynEditStringList(Editor.Lines).ChangeFlags[FIndex + I];
-
- TSynEditStringList(Editor.Lines).DeleteLines(FIndex, Length(FLines));
- FCaret := BufferCoord(1, FIndex + 1);
-end;
-
-{ TSynLinePutUndoItem }
-
-function TSynLinePutUndoItem.GroupWith(Item: TSynLinePutUndoItem): Boolean;
-begin
- if (FNewValue.Length = Item.FNewValue.Length) and
- (FOldValue.Length = Item.FOldValue.Length) and
- (FOldValue.Length <= 1) and (FNewValue.Length <= 1) and
- (Abs(FStartPos - Item.FStartPos) <= 1)
- then
- Result := True
- else
- Result := False;
-end;
-
-constructor TSynLinePutUndoItem.Create(Editor: TCustomSynEdit; Index: Integer;
- OldLine: string; Command: TSynEditorCommand);
-var
- Len1, Len2: Integer;
- Line: string;
-begin
- FCommandProcessed := Command;
-
- FIndex := Index;
- Line := Editor.Lines[Index];
-
- LineDiff(Line, OldLine, FStartPos, Len1, Len2);
-
- FOldValue := Copy(OldLine, FStartPos, Len1);
- FNewValue := Copy(Line, FStartPos, Len2);
-
- FChangeFlags := TSynEditStringList(Editor.Lines).ChangeFlags[Index] -
- [sfSaved];
- TSynEditStringList(Editor.Lines).ChangeFlags[Index] :=
- TSynEditStringList(Editor.Lines).ChangeFlags[Index] +
- [sfModified] - [sfAsSaved];
-end;
-
-procedure TSynLinePutUndoItem.Redo(Editor: TCustomSynEdit);
-var
- Line: string;
- Char: Integer;
- TempCF: TSynLineChangeFlags;
-begin
- Line := Editor.Lines[FIndex];
- // Delete New
- Delete(Line, FStartPos, FOldValue.Length);
- Insert(FNewValue, Line, FStartPos);
- Editor.Lines[FIndex] := Line;
- // Swap change flags
- TempCF := FChangeFlags;
- FChangeFlags := TSynEditStringList(Editor.Lines).ChangeFlags[FIndex] -
- [sfSaved];
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex] :=
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex]
- - [sfModified, sfAsSaved] + TempCF;
- // Guess Caret position
- case FCommandProcessed of
- ecChar:
- if (FOldValue.Length = 1) and (FNewValue.Length = 1) then
- Char := FStartPos // Typing in Insert Mode
- else
- Char := FStartPos + FNewValue.Length;
- ecDeleteChar,
- ecDeleteWord,
- ecDeleteEOL: Char := FStartPos;
- else
- Char := FStartPos + FNewValue.Length;
- end;
- FCaret := BufferCoord(Char, FIndex + 1);
-end;
-
-procedure TSynLinePutUndoItem.Undo(Editor: TCustomSynEdit);
-var
- Line: string;
- Char: Integer;
- TempCF: TSynLineChangeFlags;
-begin
- Line := Editor.Lines[FIndex];
- // Delete New
- Delete(Line, FStartPos, FNewValue.Length);
- Insert(FOldValue, Line, FStartPos);
- Editor.Lines[FIndex] := Line;
- // Swap change flags
- TempCF := FChangeFlags;
- FChangeFlags := TSynEditStringList(Editor.Lines).ChangeFlags[FIndex] -
- [sfSaved];
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex] :=
- TSynEditStringList(Editor.Lines).ChangeFlags[FIndex]
- - [sfModified, sfAsSaved] + TempCF;
- // Guess Caret position
- case FCommandProcessed of
- ecChar:
- if (FOldValue.Length = 1) and (FNewValue.Length = 1) then
- Char := FStartPos // Typing in Overwrite Mode
- else
- Char := FStartPos + FOldValue.Length;
- ecDeleteChar,
- ecDeleteWord,
- ecDeleteEOL: Char := FStartPos;
- else
- Char := FStartPos + FOldValue.Length;
- end;
- FCaret := BufferCoord(Char, FIndex + 1);
-end;
-
-{ TSynUndoPlugin }
-
-constructor TSynUndoPlugin.Create(SynEditUndo: TSynEditUndo;
- Editor: TCustomSynEdit);
-begin
- FSynEditUndo := SynEditUndo;
- inherited Create(Editor,
- [phLinePut, phLinesInserted, phLinesBeforeDeleted, phLinesDeleted]);
-end;
-
-procedure TSynUndoPlugin.LinePut(aIndex: Integer; const OldLine: string);
-var
- Line: string;
- Item: TSynLinePutUndoItem;
-begin
- if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
- then
- Exit;
-
- Line := Editor.Lines[aIndex];
- if Line <> OldLine then
- begin
- Item := TSynLinePutUndoItem.Create(Editor, aIndex, OldLine,
- FSynEditUndo.FCommandProcessed);
- FSynEditUndo.AddUndoItem(Item);
- end;
-end;
-
-procedure TSynUndoPlugin.LinesBeforeDeleted(FirstLine, Count: Integer);
-var
- I: Integer;
-begin
- if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
- then
- Exit;
-
- // Save deleted lines and change flags
- SetLength(FDeletedLines, Count);
- SetLength(FDeletedChangeFlags, Count);
- for I := 0 to Count -1 do
- begin
- FDeletedLines[I] := Editor.Lines[FirstLine + I];
- FDeletedChangeFlags[I] :=
- TSynEditStringList(Editor.Lines).ChangeFlags[FirstLine + I];
- end;
-end;
-
-procedure TSynUndoPlugin.LinesDeleted(FirstLine, Count: Integer);
-var
- Item: TSynLinesDeletedUndoItem;
-begin
- if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
- then
- Exit;
-
- if Count > 0 then
- begin
- Item := TSynLinesDeletedUndoItem.Create(Editor, FirstLine,
- FDeletedLines, FDeletedChangeFlags);
- FSynEditUndo.AddUndoItem(Item);
- end;
-end;
-
-procedure TSynUndoPlugin.LinesInserted(FirstLine, Count: Integer);
-var
- Item: TSynLinesInsertedUndoItem;
-begin
- if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
- then
- Exit;
-
- // Consider a file with one empty line as empty
- // Otherwise when you type in a new file and undo it, CanUndo will still
- // return True because the initial insertion will be on the Undo list
- if (FSynEditUndo.FUndoList.Count = 0) and
- (Editor.Lines.Count = 1) and (Editor.Lines[0] = '')
- then
- Exit;
-
- if Count > 0 then
- begin
- Item := TSynLinesInsertedUndoItem.Create(Editor, FirstLine, Count);
- FSynEditUndo.AddUndoItem(Item);
- end;
-end;
-
-end.
diff --git a/Source/SynEditUndoShared.pas b/Source/SynEditUndoShared.pas
new file mode 100644
index 00000000..3ed63d14
--- /dev/null
+++ b/Source/SynEditUndoShared.pas
@@ -0,0 +1,751 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Shared undo/redo base classes.
+Platform-specific subclasses in Vcl.SynEditUndo.pas and FMX.SynEditUndo.pas
+provide editor-type-aware overrides.
+
+The "Shared" suffix avoids namespace shadowing with Vcl.SynEditUndo.
+-------------------------------------------------------------------------------}
+
+unit SynEditUndoShared;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ System.Math,
+ System.Generics.Collections,
+ SynEditTypes,
+ SynEditKeyCmds,
+ SynEditMiscProcs,
+ SynEditTextBuffer;
+
+type
+ TSynEditUndoBase = class;
+
+ TSynUndoItem = class abstract(TObject)
+ ChangeNumber: Integer;
+ FCaret: TBufferCoord;
+ GroupBreak: Boolean;
+ public
+ procedure Undo(Editor: TObject); virtual; abstract;
+ procedure Redo(Editor: TObject); virtual; abstract;
+ end;
+
+ { Line-change undo items operate on TStrings (TSynEditStringList).
+ The Lines reference is captured at construction and reused in Undo/Redo. }
+
+ TSynLinePutUndoItem = class(TSynUndoItem)
+ private
+ FLines: TStrings;
+ FIndex: Integer;
+ FStartPos: Integer;
+ FOldValue: string;
+ FNewValue: string;
+ FChangeFlags: TSynLineChangeFlags;
+ FCommandProcessed: TSynEditorCommand;
+ public
+ function GroupWith(Item: TSynLinePutUndoItem): Boolean;
+ procedure Undo(Editor: TObject); override;
+ procedure Redo(Editor: TObject); override;
+ constructor Create(Lines: TStrings; Index: Integer;
+ const OldLine: string; Command: TSynEditorCommand);
+ end;
+
+ TSynLinesInsertedUndoItem = class(TSynUndoItem)
+ private
+ FLines: TStrings;
+ FIndex: Integer;
+ FSavedLines: TArray;
+ FChangeFlags: TArray;
+ public
+ procedure Undo(Editor: TObject); override;
+ procedure Redo(Editor: TObject); override;
+ constructor Create(Lines: TStrings; Index, Count: Integer);
+ end;
+
+ TSynLinesDeletedUndoItem = class(TSynUndoItem)
+ private
+ FLines: TStrings;
+ FIndex: Integer;
+ FSavedLines: TArray;
+ FChangeFlags: TArray;
+ public
+ procedure Undo(Editor: TObject); override;
+ procedure Redo(Editor: TObject); override;
+ constructor Create(Lines: TStrings; Index: Integer;
+ const DeletedLines: TArray;
+ const DeletedChangeFlags: TArray);
+ end;
+
+ TSynEditUndoList = class(TObjectStack)
+ protected
+ FOwner: TSynEditUndoBase;
+ FFullUndoImposible: Boolean;
+ procedure EnsureMaxEntries;
+ public
+ constructor Create(AOwner: TSynEditUndoBase);
+ procedure Push(const Value: TSynUndoItem);
+ end;
+
+ TSynEditUndoBase = class(TInterfacedObject, ISynEditUndo)
+ protected
+ FGroupUndo: Boolean;
+ FBlockCount: Integer;
+ FLockCount: Integer;
+ FBlockChangeNumber: Integer;
+ FNextChangeNumber: Integer;
+ FInitialChangeNumber: Integer;
+ FMaxUndoActions: Integer;
+ FBlockStartModified: Boolean;
+ FUndoList: TSynEditUndoList;
+ FRedoList: TSynEditUndoList;
+ FOnModifiedChanged: TNotifyEvent;
+ FInsideUndoRedo: Boolean;
+ FCommandProcessed: TSynEditorCommand;
+ FBlockSelRestoreItem: TSynUndoItem;
+ // Saved lines for LinesBeforeDeleted/LinesDeleted pair
+ FDeletedLines: TArray;
+ FDeletedChangeFlags: TArray;
+ // === Abstract methods — subclass hooks ===
+ function CreateCaretUndoItem(Editor: TObject): TSynUndoItem; virtual; abstract;
+ procedure RestoreCaretAndSelection(Editor: TObject;
+ Item: TSynUndoItem); virtual; abstract;
+ private
+ function GetModified: Boolean;
+ function GetCanUndo: Boolean;
+ function GetCanRedo: Boolean;
+ function GetFullUndoImposible: Boolean;
+ function GetOnModifiedChanged: TNotifyEvent;
+ function GetInsideUndoRedo: Boolean;
+ procedure SetModified(const Value: Boolean);
+ procedure SetCommandProcessed(const Command: TSynEditorCommand);
+ procedure SetMaxUndoActions(const Value: Integer);
+ procedure SetOnModifiedChanged(const Value: TNotifyEvent);
+ procedure SetGroupUndo(const Value: Boolean);
+ function GetMaxUndoActions: Integer;
+ procedure Lock;
+ procedure Unlock;
+ procedure Clear;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function IsLocked: Boolean;
+ function NextChangeNumber: Integer;
+ procedure AddGroupBreak;
+ procedure AddUndoItem(Item: TSynUndoItem);
+ procedure BeginBlock(Editor: TObject);
+ procedure EndBlock(Editor: TObject);
+ procedure Undo(Editor: TObject);
+ procedure Redo(Editor: TObject);
+ procedure BufferSaved(Lines: TStrings);
+ procedure ClearTrackChanges(Lines: TStrings);
+ end;
+
+implementation
+
+{$REGION 'TSynEditUndoList'}
+
+constructor TSynEditUndoList.Create(AOwner: TSynEditUndoBase);
+begin
+ inherited Create(True);
+ FOwner := AOwner;
+end;
+
+procedure TSynEditUndoList.EnsureMaxEntries;
+var
+ KeepCount: Integer;
+ ItemArray: TArray;
+ I: Integer;
+begin
+ if FOwner.FMaxUndoActions <= 0 then Exit;
+
+ if Count > FOwner.FMaxUndoActions then
+ begin
+ FFullUndoImposible := True;
+ KeepCount := (FOwner.FMaxUndoActions div 4) * 3;
+ ItemArray := ToArray;
+ for I := 1 to KeepCount do
+ Extract;
+ Clear;
+ for I := Length(ItemArray) - KeepCount to Length(ItemArray) - 1 do
+ Push(ItemArray[I]);
+ end;
+end;
+
+procedure TSynEditUndoList.Push(const Value: TSynUndoItem);
+begin
+ inherited Push(Value);
+ EnsureMaxEntries;
+end;
+
+{$ENDREGION}
+
+{$REGION 'TSynEditUndoBase'}
+
+constructor TSynEditUndoBase.Create;
+begin
+ inherited Create;
+ FGroupUndo := True;
+ FMaxUndoActions := 0;
+ FNextChangeNumber := 1;
+ FUndoList := TSynEditUndoList.Create(Self);
+ FRedoList := TSynEditUndoList.Create(Self);
+end;
+
+destructor TSynEditUndoBase.Destroy;
+begin
+ FUndoList.Free;
+ FRedoList.Free;
+ inherited;
+end;
+
+procedure TSynEditUndoBase.AddUndoItem(Item: TSynUndoItem);
+var
+ OldModified: Boolean;
+begin
+ Assert(not FInsideUndoRedo);
+ OldModified := GetModified;
+ if FBlockChangeNumber <> 0 then
+ Item.ChangeNumber := FBlockChangeNumber
+ else
+ Item.ChangeNumber := NextChangeNumber;
+ FUndoList.Push(Item);
+ FRedoList.Clear;
+ if (FBlockCount = 0) and (OldModified xor GetModified) and
+ Assigned(FOnModifiedChanged)
+ then
+ FOnModifiedChanged(Self);
+end;
+
+procedure TSynEditUndoBase.AddGroupBreak;
+begin
+ if (FUndoList.Count > 0) and (FBlockCount = 0) then
+ FUndoList.Peek.GroupBreak := True;
+end;
+
+procedure TSynEditUndoBase.BeginBlock(Editor: TObject);
+begin
+ if IsLocked then Exit;
+ Inc(FBlockCount);
+ if FBlockCount = 1 then
+ begin
+ FBlockStartModified := GetModified;
+ FBlockChangeNumber := NextChangeNumber;
+ FBlockSelRestoreItem := CreateCaretUndoItem(Editor);
+ FBlockSelRestoreItem.ChangeNumber := FBlockChangeNumber;
+ FUndoList.Push(FBlockSelRestoreItem);
+ end;
+end;
+
+procedure TSynEditUndoBase.EndBlock(Editor: TObject);
+var
+ Item: TSynUndoItem;
+begin
+ if IsLocked then Exit;
+ Assert(FBlockCount > 0);
+ if FBlockCount > 0 then
+ begin
+ Dec(FBlockCount);
+ if FBlockCount = 0 then
+ begin
+ if (FUndoList.Count > 0) and (FUndoList.Peek = FBlockSelRestoreItem) then
+ FUndoList.Pop
+ else
+ begin
+ Item := CreateCaretUndoItem(Editor);
+ Item.ChangeNumber := FBlockChangeNumber;
+ FUndoList.Push(Item);
+ end;
+ FBlockChangeNumber := 0;
+ AddGroupBreak;
+ if (FBlockStartModified xor GetModified) and Assigned(FOnModifiedChanged) then
+ FOnModifiedChanged(Self);
+ end;
+ end;
+end;
+
+procedure TSynEditUndoBase.Clear;
+begin
+ FUndoList.Clear;
+ FRedoList.Clear;
+end;
+
+function TSynEditUndoBase.GetCanUndo: Boolean;
+begin
+ Result := FUndoList.Count > 0;
+end;
+
+function TSynEditUndoBase.GetCanRedo: Boolean;
+begin
+ Result := FRedoList.Count > 0;
+end;
+
+function TSynEditUndoBase.GetFullUndoImposible: Boolean;
+begin
+ Result := FUndoList.FFullUndoImposible;
+end;
+
+function TSynEditUndoBase.GetInsideUndoRedo: Boolean;
+begin
+ Result := FInsideUndoRedo;
+end;
+
+function TSynEditUndoBase.GetMaxUndoActions: Integer;
+begin
+ Result := FMaxUndoActions;
+end;
+
+function TSynEditUndoBase.GetModified: Boolean;
+begin
+ if FUndoList.Count = 0 then
+ Result := FInitialChangeNumber <> 0
+ else
+ Result := FUndoList.Peek.ChangeNumber <> FInitialChangeNumber;
+end;
+
+function TSynEditUndoBase.GetOnModifiedChanged: TNotifyEvent;
+begin
+ Result := FOnModifiedChanged;
+end;
+
+function TSynEditUndoBase.IsLocked: Boolean;
+begin
+ Result := FLockCount > 0;
+end;
+
+procedure TSynEditUndoBase.Lock;
+begin
+ Inc(FLockCount);
+end;
+
+function TSynEditUndoBase.NextChangeNumber: Integer;
+begin
+ Result := FNextChangeNumber;
+ Inc(FNextChangeNumber);
+end;
+
+procedure TSynEditUndoBase.SetCommandProcessed(const Command: TSynEditorCommand);
+begin
+ FCommandProcessed := Command;
+end;
+
+procedure TSynEditUndoBase.SetGroupUndo(const Value: Boolean);
+begin
+ FGroupUndo := Value;
+end;
+
+procedure TSynEditUndoBase.SetMaxUndoActions(const Value: Integer);
+begin
+ if Value <> FMaxUndoActions then
+ begin
+ FMaxUndoActions := Value;
+ FUndoList.EnsureMaxEntries;
+ FRedoList.EnsureMaxEntries;
+ end;
+end;
+
+procedure TSynEditUndoBase.SetModified(const Value: Boolean);
+begin
+ if not Value then
+ begin
+ if FUndoList.Count = 0 then
+ FInitialChangeNumber := 0
+ else
+ FInitialChangeNumber := FUndoList.Peek.ChangeNumber;
+ end
+ else if FUndoList.Count = 0 then
+ begin
+ if FInitialChangeNumber = 0 then
+ FInitialChangeNumber := -1;
+ end
+ else if FUndoList.Peek.ChangeNumber = FInitialChangeNumber then
+ FInitialChangeNumber := -1;
+end;
+
+procedure TSynEditUndoBase.SetOnModifiedChanged(const Value: TNotifyEvent);
+begin
+ FOnModifiedChanged := Value;
+end;
+
+procedure TSynEditUndoBase.Undo(Editor: TObject);
+var
+ Item, LastItem: TSynUndoItem;
+ OldChangeNumber: Integer;
+ OldModified: Boolean;
+ FKeepGoing: Boolean;
+begin
+ Assert((FBlockCount = 0) and (FBlockChangeNumber = 0));
+
+ if FUndoList.Count > 0 then
+ begin
+ Item := FUndoList.Peek;
+ OldModified := GetModified;
+ OldChangeNumber := Item.ChangeNumber;
+
+ repeat
+ Item := FUndoList.Extract;
+ LastItem := Item;
+ FInsideUndoRedo := True;
+ try
+ Item.Undo(Editor);
+ finally
+ FInsideUndoRedo := False;
+ end;
+ FRedoList.Push(Item);
+
+ if FUndoList.Count = 0 then
+ Break
+ else
+ Item := FUndoList.Peek;
+
+ if Item.ChangeNumber = OldChangeNumber then
+ FKeepGoing := True
+ else
+ FKeepGoing :=
+ FGroupUndo and
+ not Item.GroupBreak and
+ (LastItem is TSynLinePutUndoItem) and
+ (Item is TSynLinePutUndoItem) and
+ TSynLinePutUndoItem(Item).GroupWith(TSynLinePutUndoItem(LastItem));
+ until not FKeepGoing;
+
+ RestoreCaretAndSelection(Editor, LastItem);
+
+ if (OldModified xor GetModified) and Assigned(FOnModifiedChanged) then
+ FOnModifiedChanged(Self);
+ end;
+end;
+
+procedure TSynEditUndoBase.Redo(Editor: TObject);
+var
+ Item, LastItem: TSynUndoItem;
+ OldChangeNumber: Integer;
+ OldModified: Boolean;
+ FKeepGoing: Boolean;
+ LastItemHasGroupBreak: Boolean;
+begin
+ Assert((FBlockCount = 0) and (FBlockChangeNumber = 0));
+
+ if FRedoList.Count > 0 then
+ begin
+ Item := FRedoList.Peek;
+ OldModified := GetModified;
+ OldChangeNumber := Item.ChangeNumber;
+
+ repeat
+ Item := FRedoList.Extract;
+ LastItemHasGroupBreak := Item.GroupBreak;
+ LastItem := Item;
+ FInsideUndoRedo := True;
+ try
+ Item.Redo(Editor);
+ finally
+ FInsideUndoRedo := False;
+ end;
+ FUndoList.Push(Item);
+
+ if FRedoList.Count = 0 then
+ Break
+ else
+ Item := FRedoList.Peek;
+
+ if Item.ChangeNumber = OldChangeNumber then
+ FKeepGoing := True
+ else
+ FKeepGoing :=
+ FGroupUndo and
+ not LastItemHasGroupBreak and
+ (LastItem is TSynLinePutUndoItem) and
+ (Item is TSynLinePutUndoItem) and
+ TSynLinePutUndoItem(LastItem).GroupWith(TSynLinePutUndoItem(Item));
+ until not FKeepGoing;
+
+ RestoreCaretAndSelection(Editor, LastItem);
+
+ if (OldModified xor GetModified) and Assigned(FOnModifiedChanged) then
+ FOnModifiedChanged(Self);
+ end;
+end;
+
+procedure TSynEditUndoBase.Unlock;
+begin
+ if FLockCount > 0 then
+ Dec(FLockCount);
+end;
+
+procedure TSynEditUndoBase.BufferSaved(Lines: TStrings);
+var
+ SynLines: TSynEditStringList;
+ Index: Integer;
+ Flags: TSynLineChangeFlags;
+ Item: TSynUndoItem;
+
+ procedure PutItemSaved(Item: TSynLinePutUndoItem);
+ begin
+ if Item.FChangeFlags = [sfAsSaved] then
+ Item.FChangeFlags := [sfModified];
+ end;
+
+ procedure InsertedItemSaved(Item: TSynLinesInsertedUndoItem);
+ var I: Integer;
+ begin
+ for I := 0 to Length(Item.FChangeFlags) - 1 do
+ Item.FChangeFlags[I] := [sfModified];
+ end;
+
+ procedure DeletedItemSaved(Item: TSynLinesDeletedUndoItem);
+ var I: Integer;
+ begin
+ for I := 0 to Length(Item.FChangeFlags) - 1 do
+ Item.FChangeFlags[I] := [sfModified];
+ end;
+
+begin
+ SynLines := Lines as TSynEditStringList;
+ for Index := 0 to SynLines.Count - 1 do
+ begin
+ Flags := SynLines.ChangeFlags[Index];
+ if Flags = [sfSaved] then
+ SynLines.ChangeFlags[Index] := []
+ else if sfModified in Flags then
+ SynLines.ChangeFlags[Index] := Flags - [sfModified] + [sfSaved, sfAsSaved];
+ end;
+ for Item in FUndoList do
+ if Item is TSynLinePutUndoItem then
+ PutItemSaved(TSynLinePutUndoItem(Item))
+ else if Item is TSynLinesInsertedUndoItem then
+ InsertedItemSaved(TSynLinesInsertedUndoItem(Item))
+ else if Item is TSynLinesDeletedUndoItem then
+ DeletedItemSaved(TSynLinesDeletedUndoItem(Item));
+ for Item in FRedoList do
+ if Item is TSynLinePutUndoItem then
+ PutItemSaved(TSynLinePutUndoItem(Item))
+ else if Item is TSynLinesInsertedUndoItem then
+ InsertedItemSaved(TSynLinesInsertedUndoItem(Item))
+ else if Item is TSynLinesDeletedUndoItem then
+ DeletedItemSaved(TSynLinesDeletedUndoItem(Item));
+end;
+
+procedure TSynEditUndoBase.ClearTrackChanges(Lines: TStrings);
+var
+ SynLines: TSynEditStringList;
+ Index: Integer;
+ Item: TSynUndoItem;
+
+ procedure InsertedItemClear(Item: TSynLinesInsertedUndoItem);
+ var I: Integer;
+ begin
+ for I := 0 to Length(Item.FChangeFlags) - 1 do
+ Item.FChangeFlags[I] := [sfModified];
+ end;
+
+ procedure DeletedItemClear(Item: TSynLinesDeletedUndoItem);
+ var I: Integer;
+ begin
+ for I := 0 to Length(Item.FChangeFlags) - 1 do
+ Item.FChangeFlags[I] := [sfModified];
+ end;
+
+begin
+ SynLines := Lines as TSynEditStringList;
+ for Index := 0 to SynLines.Count - 1 do
+ SynLines.ChangeFlags[Index] := [];
+ for Item in FUndoList do
+ if Item is TSynLinesInsertedUndoItem then
+ InsertedItemClear(TSynLinesInsertedUndoItem(Item))
+ else if Item is TSynLinesDeletedUndoItem then
+ DeletedItemClear(TSynLinesDeletedUndoItem(Item));
+ for Item in FRedoList do
+ if Item is TSynLinesInsertedUndoItem then
+ InsertedItemClear(TSynLinesInsertedUndoItem(Item))
+ else if Item is TSynLinesDeletedUndoItem then
+ DeletedItemClear(TSynLinesDeletedUndoItem(Item));
+end;
+
+{$ENDREGION}
+
+{$REGION 'TSynLinePutUndoItem'}
+
+constructor TSynLinePutUndoItem.Create(Lines: TStrings; Index: Integer;
+ const OldLine: string; Command: TSynEditorCommand);
+var
+ Len1, Len2: Integer;
+ Line: string;
+begin
+ FLines := Lines;
+ FCommandProcessed := Command;
+ FIndex := Index;
+ Line := Lines[Index];
+
+ LineDiff(Line, OldLine, FStartPos, Len1, Len2);
+
+ FOldValue := Copy(OldLine, FStartPos, Len1);
+ FNewValue := Copy(Line, FStartPos, Len2);
+
+ FChangeFlags := TSynEditStringList(Lines).ChangeFlags[Index] -
+ [sfSaved];
+ TSynEditStringList(Lines).ChangeFlags[Index] :=
+ TSynEditStringList(Lines).ChangeFlags[Index] +
+ [sfModified] - [sfAsSaved];
+end;
+
+function TSynLinePutUndoItem.GroupWith(Item: TSynLinePutUndoItem): Boolean;
+begin
+ Result := (FNewValue.Length = Item.FNewValue.Length) and
+ (FOldValue.Length = Item.FOldValue.Length) and
+ (FOldValue.Length <= 1) and (FNewValue.Length <= 1) and
+ (Abs(FStartPos - Item.FStartPos) <= 1);
+end;
+
+procedure TSynLinePutUndoItem.Undo(Editor: TObject);
+var
+ Line: string;
+ Char: Integer;
+ TempCF: TSynLineChangeFlags;
+begin
+ Line := FLines[FIndex];
+ Delete(Line, FStartPos, FNewValue.Length);
+ Insert(FOldValue, Line, FStartPos);
+ FLines[FIndex] := Line;
+ TempCF := FChangeFlags;
+ FChangeFlags := TSynEditStringList(FLines).ChangeFlags[FIndex] -
+ [sfSaved];
+ TSynEditStringList(FLines).ChangeFlags[FIndex] :=
+ TSynEditStringList(FLines).ChangeFlags[FIndex]
+ - [sfModified, sfAsSaved] + TempCF;
+ case FCommandProcessed of
+ ecChar:
+ if (FOldValue.Length = 1) and (FNewValue.Length = 1) then
+ Char := FStartPos
+ else
+ Char := FStartPos + FOldValue.Length;
+ ecDeleteChar, ecDeleteWord, ecDeleteEOL:
+ Char := FStartPos;
+ else
+ Char := FStartPos + FOldValue.Length;
+ end;
+ FCaret := BufferCoord(Char, FIndex + 1);
+end;
+
+procedure TSynLinePutUndoItem.Redo(Editor: TObject);
+var
+ Line: string;
+ Char: Integer;
+ TempCF: TSynLineChangeFlags;
+begin
+ Line := FLines[FIndex];
+ Delete(Line, FStartPos, FOldValue.Length);
+ Insert(FNewValue, Line, FStartPos);
+ FLines[FIndex] := Line;
+ TempCF := FChangeFlags;
+ FChangeFlags := TSynEditStringList(FLines).ChangeFlags[FIndex] -
+ [sfSaved];
+ TSynEditStringList(FLines).ChangeFlags[FIndex] :=
+ TSynEditStringList(FLines).ChangeFlags[FIndex]
+ - [sfModified, sfAsSaved] + TempCF;
+ case FCommandProcessed of
+ ecChar:
+ if (FOldValue.Length = 1) and (FNewValue.Length = 1) then
+ Char := FStartPos
+ else
+ Char := FStartPos + FNewValue.Length;
+ ecDeleteChar, ecDeleteWord, ecDeleteEOL:
+ Char := FStartPos;
+ else
+ Char := FStartPos + FNewValue.Length;
+ end;
+ FCaret := BufferCoord(Char, FIndex + 1);
+end;
+
+{$ENDREGION}
+
+{$REGION 'TSynLinesInsertedUndoItem'}
+
+constructor TSynLinesInsertedUndoItem.Create(Lines: TStrings;
+ Index, Count: Integer);
+var
+ I: Integer;
+begin
+ inherited Create;
+ FLines := Lines;
+ FIndex := Index;
+ SetLength(FSavedLines, Count);
+ for I := 0 to Count - 1 do
+ begin
+ FSavedLines[I] := Lines[Index + I];
+ TSynEditStringList(Lines).ChangeFlags[Index + I] := [sfModified];
+ end;
+end;
+
+procedure TSynLinesInsertedUndoItem.Undo(Editor: TObject);
+var
+ I: Integer;
+begin
+ SetLength(FChangeFlags, Length(FSavedLines));
+ for I := 0 to Length(FSavedLines) - 1 do
+ FChangeFlags[I] := TSynEditStringList(FLines).ChangeFlags[FIndex + I];
+ TSynEditStringList(FLines).DeleteLines(FIndex, Length(FSavedLines));
+ FCaret := BufferCoord(1, FIndex + 1);
+end;
+
+procedure TSynLinesInsertedUndoItem.Redo(Editor: TObject);
+var
+ I: Integer;
+begin
+ TSynEditStringList(FLines).InsertStrings(FIndex, FSavedLines);
+ for I := 0 to Length(FSavedLines) - 1 do
+ TSynEditStringList(FLines).ChangeFlags[FIndex + I] := FChangeFlags[I];
+ FCaret := BufferCoord(1,
+ Min(FLines.Count, FIndex + Length(FSavedLines) + 1));
+end;
+
+{$ENDREGION}
+
+{$REGION 'TSynLinesDeletedUndoItem'}
+
+constructor TSynLinesDeletedUndoItem.Create(Lines: TStrings;
+ Index: Integer; const DeletedLines: TArray;
+ const DeletedChangeFlags: TArray);
+begin
+ inherited Create;
+ FLines := Lines;
+ FIndex := Index;
+ FSavedLines := DeletedLines;
+ FChangeFlags := DeletedChangeFlags;
+end;
+
+procedure TSynLinesDeletedUndoItem.Undo(Editor: TObject);
+var
+ I: Integer;
+begin
+ TSynEditStringList(FLines).InsertStrings(FIndex, FSavedLines);
+ for I := 0 to Length(FSavedLines) - 1 do
+ TSynEditStringList(FLines).ChangeFlags[FIndex + I] := FChangeFlags[I];
+ FCaret := BufferCoord(1,
+ Min(FLines.Count, FIndex + Length(FSavedLines) + 1));
+end;
+
+procedure TSynLinesDeletedUndoItem.Redo(Editor: TObject);
+var
+ I: Integer;
+begin
+ SetLength(FChangeFlags, Length(FSavedLines));
+ for I := 0 to Length(FSavedLines) - 1 do
+ FChangeFlags[I] := TSynEditStringList(FLines).ChangeFlags[FIndex + I];
+ TSynEditStringList(FLines).DeleteLines(FIndex, Length(FSavedLines));
+ FCaret := BufferCoord(1, FIndex + 1);
+end;
+
+{$ENDREGION}
+
+end.
diff --git a/Source/SynEditWildcardSearch.pas b/Source/SynEditWildcardSearch.pas
index 28d7c2f4..13d09c40 100644
--- a/Source/SynEditWildcardSearch.pas
+++ b/Source/SynEditWildcardSearch.pas
@@ -11,7 +11,7 @@
The Original Code is: SynEditWildcardSearch.pas, released 2003-06-21.
The original author of this file is Michael Elsdoerfer.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit project are listed in the Contributors.txt file.
@@ -37,7 +37,6 @@
interface
uses
- SynEdit,
SynEditTypes,
SynEditRegexSearch,
Classes;
@@ -65,9 +64,6 @@ TSynEditWildcardSearch = class(TSynEditRegexSearch)
implementation
-uses
- Consts;
-
{ TSynEditWildcardSearch }
constructor TSynEditWildcardSearch.Create(AOwner: TComponent);
diff --git a/Source/SynMacroRecorderShared.pas b/Source/SynMacroRecorderShared.pas
new file mode 100644
index 00000000..b38c52ea
--- /dev/null
+++ b/Source/SynMacroRecorderShared.pas
@@ -0,0 +1,461 @@
+{-------------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: SynMacroRecorder.pas, released 2001-10-17.
+
+Author of this file is Fl�vio Etrusco.
+Portions created by Fl�vio Etrusco are Copyright 2001 Fl�vio Etrusco.
+Unicode translation by Ma�l H�rz.
+All Rights Reserved.
+
+Contributors to the SynEdit project are listed in the Contributors.txt file.
+
+Alternatively, the contents of this file may be used under the terms of the
+GNU General Public License Version 2 or later (the "GPL"), in which case
+the provisions of the GPL are applicable instead of those above.
+If you wish to allow use of your version of this file only under the terms
+of the GPL and not to allow others to use your version of this file
+under the MPL, indicate your decision by deleting the provisions above and
+replace them with the notice and other provisions required by the GPL.
+If you do not delete the provisions above, a recipient may use your version
+of this file under either the MPL or the GPL.
+
+SynMacroRecorderShared: Cross-platform shared macro event types and factory.
+No VCL/FMX imports.
+-------------------------------------------------------------------------------}
+
+unit SynMacroRecorderShared;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+resourcestring
+ sCannotRecord = 'Cannot record macro; already recording or playing';
+ sCannotPlay = 'Cannot playback macro; already playing or recording';
+ sCannotPause = 'Can only pause when recording';
+ sCannotResume = 'Can only resume when paused';
+
+type
+ TSynMacroState = (msStopped, msRecording, msPlaying, msPaused);
+ TSynMacroCommand = (mcRecord, mcPlayback);
+
+ TSynMacroPlaybackProc = procedure(Command: TSynEditorCommand;
+ AChar: WideChar; Data: Pointer) of object;
+
+ TSynMacroEvent = class(TObject)
+ protected
+ fRepeatCount: Byte;
+ function GetAsString: string; virtual; abstract;
+ public
+ procedure InitEventParameters(aStr: string); virtual; abstract;
+ constructor Create; virtual;
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); virtual; abstract;
+ { the CommandID must not be read inside LoadFromStream/SaveToStream. It's
+ read by the MacroRecorder component to decide which MacroEvent class to
+ instantiate }
+ procedure LoadFromStream(aStream: TStream); virtual; abstract;
+ procedure SaveToStream(aStream: TStream); virtual; abstract;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc);
+ virtual; abstract;
+ property AsString: string read GetAsString;
+ property RepeatCount: Byte read fRepeatCount write fRepeatCount;
+ end;
+
+ TSynBasicEvent = class(TSynMacroEvent)
+ protected
+ fCommand: TSynEditorCommand;
+ function GetAsString: string; override;
+ public
+ procedure InitEventParameters(aStr: string); override;
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); override;
+ procedure LoadFromStream(aStream: TStream); override;
+ procedure SaveToStream(aStream: TStream); override;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc); override;
+ property Command: TSynEditorCommand read fCommand write fCommand;
+ end;
+
+ TSynCharEvent = class(TSynMacroEvent)
+ protected
+ fKey: WideChar;
+ function GetAsString: string; override;
+ public
+ procedure InitEventParameters(aStr: string); override;
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); override;
+ procedure LoadFromStream(aStream: TStream); override;
+ procedure SaveToStream(aStream: TStream); override;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc); override;
+ property Key: WideChar read fKey write fKey;
+ end;
+
+ TSynStringEvent = class(TSynMacroEvent)
+ protected
+ fString: string;
+ function GetAsString: string; override;
+ public
+ procedure InitEventParameters(aStr: string); override;
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); override;
+ procedure LoadFromStream(aStream: TStream); override;
+ procedure SaveToStream(aStream: TStream); override;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc); override;
+ property Value: string read fString write fString;
+ end;
+
+ TSynPositionEvent = class(TSynBasicEvent)
+ protected
+ fPosition: TBufferCoord;
+ function GetAsString: string; override;
+ public
+ procedure InitEventParameters(aStr: string); override;
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); override;
+ procedure LoadFromStream(aStream: TStream); override;
+ procedure SaveToStream(aStream: TStream); override;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc); override;
+ property Position: TBufferCoord read fPosition write fPosition;
+ end;
+
+ TSynDataEvent = class(TSynBasicEvent)
+ protected
+ fData: Pointer;
+ public
+ procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer); override;
+ procedure LoadFromStream(aStream: TStream); override;
+ procedure SaveToStream(aStream: TStream); override;
+ procedure PlaybackTo(const APlaybackProc: TSynMacroPlaybackProc); override;
+ end;
+
+function CreateMacroEvent(aCmd: TSynEditorCommand): TSynMacroEvent;
+
+implementation
+
+uses
+ SynEditMiscProcs,
+ SynUnicodeShared;
+
+{ TSynMacroEvent }
+
+constructor TSynMacroEvent.Create;
+begin
+ inherited Create;
+ fRepeatCount := 1;
+end;
+
+{ TSynBasicEvent }
+
+function TSynBasicEvent.GetAsString: string;
+var
+ Ident: string;
+begin
+ EditorCommandToIdent(Command, Ident);
+ Result := Ident;
+ if RepeatCount > 1 then
+ Result := Result + ' ' + IntToStr(RepeatCount);
+end;
+
+procedure TSynBasicEvent.InitEventParameters(aStr: string);
+begin
+ RepeatCount := StrToIntDef(Trim(aStr), 1);
+end;
+
+procedure TSynBasicEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer);
+begin
+ Command := aCmd;
+{$IFDEF SYN_DEVELOPMENT_CHECKS}
+ if (aChar <> #0) or (aData <> nil) then
+ raise Exception.Create('TSynBasicEvent cannot handle Char <> #0 or Data <> nil');
+{$ENDIF}
+end;
+
+procedure TSynBasicEvent.LoadFromStream(aStream: TStream);
+begin
+ aStream.Read(fRepeatCount, SizeOf(fRepeatCount));
+end;
+
+procedure TSynBasicEvent.PlaybackTo(
+ const APlaybackProc: TSynMacroPlaybackProc);
+var
+ i: Integer;
+begin
+ for i := 1 to RepeatCount do
+ APlaybackProc(Command, #0, nil);
+end;
+
+procedure TSynBasicEvent.SaveToStream(aStream: TStream);
+begin
+ aStream.Write(Command, SizeOf(TSynEditorCommand));
+ aStream.Write(RepeatCount, SizeOf(RepeatCount));
+end;
+
+{ TSynCharEvent }
+
+function TSynCharEvent.GetAsString: string;
+var
+ Ident: string;
+begin
+ EditorCommandToIdent(ecChar, Ident);
+ Result := Ident + ' ' + Key;
+ if RepeatCount > 1 then
+ Result := Result + ' ' + IntToStr(RepeatCount);
+end;
+
+procedure TSynCharEvent.InitEventParameters(aStr: string);
+begin
+ if Length(aStr) >= 1 then
+ Key := aStr[1]
+ else
+ Key := ' ';
+ Delete(aStr, 1, 1);
+ RepeatCount := StrToIntDef(Trim(aStr), 1);
+end;
+
+procedure TSynCharEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer);
+begin
+ Key := aChar;
+ Assert(aData = nil);
+end;
+
+procedure TSynCharEvent.LoadFromStream(aStream: TStream);
+begin
+ aStream.Read(fKey, SizeOf(Key));
+ aStream.Read(fRepeatCount, SizeOf(fRepeatCount));
+end;
+
+procedure TSynCharEvent.PlaybackTo(
+ const APlaybackProc: TSynMacroPlaybackProc);
+var
+ i: Integer;
+begin
+ for i := 1 to RepeatCount do
+ APlaybackProc(ecChar, Key, nil);
+end;
+
+procedure TSynCharEvent.SaveToStream(aStream: TStream);
+const
+ iCharCommand: TSynEditorCommand = ecChar;
+begin
+ aStream.Write(iCharCommand, SizeOf(TSynEditorCommand));
+ aStream.Write(Key, SizeOf(Key));
+ aStream.Write(RepeatCount, SizeOf(RepeatCount));
+end;
+
+{ TSynStringEvent }
+
+function TSynStringEvent.GetAsString: string;
+var
+ Ident: string;
+begin
+ EditorCommandToIdent(ecString, Ident);
+ Result := Ident + ' ' + AnsiQuotedStr(Value, #39);
+ if RepeatCount > 1 then
+ Result := Result + ' ' + IntToStr(RepeatCount);
+end;
+
+procedure TSynStringEvent.InitEventParameters(aStr: string);
+var
+ o, c: Integer;
+ valStr: string;
+begin
+ o := Pos('''', aStr);
+ c := LastDelimiter('''', aStr);
+ valStr := Copy(aStr, o + 1, c - o - 1);
+ Value := StringReplace(valStr, '''''', '''', [rfReplaceAll]);
+ Delete(aStr, 1, c);
+ RepeatCount := StrToIntDef(Trim(aStr), 1);
+end;
+
+procedure TSynStringEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer);
+begin
+ Value := string(aData);
+end;
+
+procedure TSynStringEvent.LoadFromStream(aStream: TStream);
+var
+ l: Integer;
+ Buff: PWideChar;
+begin
+ aStream.Read(l, SizeOf(l));
+ GetMem(Buff, l * SizeOf(WideChar));
+ try
+ FillChar(Buff^, l * SizeOf(WideChar), 0);
+ aStream.Read(Buff^, l * SizeOf(WideChar));
+ fString := Buff;
+ finally
+ FreeMem(Buff);
+ end;
+ aStream.Read(fRepeatCount, SizeOf(fRepeatCount));
+end;
+
+procedure TSynStringEvent.PlaybackTo(
+ const APlaybackProc: TSynMacroPlaybackProc);
+var
+ i, j: Integer;
+begin
+ for j := 1 to RepeatCount do
+ begin
+ // SynEdit doesn't actually support the ecString command so we convert
+ // it into ecChar commands
+ for i := 1 to Length(Value) do
+ APlaybackProc(ecChar, Value[i], nil);
+ end;
+end;
+
+procedure TSynStringEvent.SaveToStream(aStream: TStream);
+const
+ StrCommand: TSynEditorCommand = ecString;
+var
+ l: Integer;
+ Buff: PWideChar;
+begin
+ aStream.Write(StrCommand, SizeOf(StrCommand));
+ l := Length(Value) + 1;
+ aStream.Write(l, SizeOf(l));
+ GetMem(Buff, l * SizeOf(WideChar));
+ try
+ FillChar(Buff^, l * SizeOf(WideChar), 0);
+ Move(PWideChar(Value)^, Buff^, (l - 1) * SizeOf(WideChar));
+ aStream.Write(Buff^, l * SizeOf(WideChar));
+ finally
+ FreeMem(Buff);
+ end;
+ aStream.Write(RepeatCount, SizeOf(RepeatCount));
+end;
+
+{ TSynPositionEvent }
+
+function TSynPositionEvent.GetAsString: string;
+begin
+ Result := inherited GetAsString;
+ Result := Result + Format(' (%d, %d)', [Position.Char, Position.Line]);
+ if RepeatCount > 1 then
+ Result := Result + ' ' + IntToStr(RepeatCount);
+end;
+
+procedure TSynPositionEvent.InitEventParameters(aStr: string);
+var
+ i, o, c, x, y: Integer;
+ valStr: string;
+begin
+ inherited;
+ aStr := Trim(aStr);
+ i := Pos(',', aStr);
+ o := Pos('(', aStr);
+ c := Pos(')', aStr);
+ if (not ((i = 0) or (o = 0) or (c = 0))) and
+ ((i > o) and (i < c)) then
+ begin
+ valStr := Copy(aStr, o + 1, i - o - 1);
+ x := StrToIntDef(valStr, 1);
+ Delete(aStr, 1, i);
+ aStr := Trim(aStr);
+ c := Pos(')', aStr);
+ valStr := Copy(aStr, 1, c - 1);
+ y := StrToIntDef(valStr, 1);
+ Position := BufferCoord(x, y);
+ Delete(aStr, 1, c);
+ aStr := Trim(aStr);
+ RepeatCount := StrToIntDef(aStr, 1);
+ end;
+end;
+
+procedure TSynPositionEvent.Initialize(aCmd: TSynEditorCommand;
+ aChar: WideChar; aData: Pointer);
+begin
+ inherited;
+ if aData <> nil then
+ Position := TBufferCoord(aData^)
+ else
+ Position := BufferCoord(0, 0);
+end;
+
+procedure TSynPositionEvent.LoadFromStream(aStream: TStream);
+begin
+ aStream.Read(fPosition, SizeOf(Position));
+end;
+
+procedure TSynPositionEvent.PlaybackTo(
+ const APlaybackProc: TSynMacroPlaybackProc);
+begin
+ if (Position.Char <> 0) or (Position.Line <> 0) then
+ APlaybackProc(Command, #0, @fPosition)
+ else
+ APlaybackProc(Command, #0, nil);
+end;
+
+procedure TSynPositionEvent.SaveToStream(aStream: TStream);
+begin
+ inherited;
+ aStream.Write(Position, SizeOf(Position));
+end;
+
+{ TSynDataEvent }
+
+procedure TSynDataEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
+ aData: Pointer);
+begin
+ fCommand := aCmd;
+ Assert(aChar = #0);
+ fData := aData;
+end;
+
+procedure TSynDataEvent.LoadFromStream(aStream: TStream);
+begin
+ aStream.Read(fData, SizeOf(fData));
+end;
+
+procedure TSynDataEvent.PlaybackTo(
+ const APlaybackProc: TSynMacroPlaybackProc);
+begin
+ APlaybackProc(Command, #0, fData);
+end;
+
+procedure TSynDataEvent.SaveToStream(aStream: TStream);
+begin
+ inherited;
+ aStream.Write(fData, SizeOf(fData));
+end;
+
+{ Factory }
+
+function CreateMacroEvent(aCmd: TSynEditorCommand): TSynMacroEvent;
+begin
+ case aCmd of
+ ecGotoXY, ecSelGotoXY, ecSetMarker0..ecSetMarker9:
+ begin
+ Result := TSynPositionEvent.Create;
+ TSynPositionEvent(Result).Command := aCmd;
+ end;
+ ecChar:
+ Result := TSynCharEvent.Create;
+ ecString:
+ Result := TSynStringEvent.Create;
+ else
+ begin
+ Result := TSynBasicEvent.Create;
+ TSynBasicEvent(Result).Command := aCmd;
+ end;
+ end;
+end;
+
+end.
diff --git a/Source/SynSpellCheckHunspellProvider.pas b/Source/SynSpellCheckHunspellProvider.pas
new file mode 100644
index 00000000..dc07110c
--- /dev/null
+++ b/Source/SynSpellCheckHunspellProvider.pas
@@ -0,0 +1,829 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+-------------------------------------------------------------------------------}
+
+{ Pure-Delphi Hunspell dictionary provider implementing ISynSpellCheckProvider.
+ Framework-neutral — works with both VCL and FMX. }
+
+unit SynSpellCheckHunspellProvider;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.SysUtils,
+ System.Classes,
+ System.Generics.Collections,
+ SynSpellCheckTypes;
+
+{$REGION 'Hunspell Types'}
+
+type
+ TSynFlagType = (ftShort, ftLong, ftNum, ftUTF8);
+
+ TSynAffixRule = record
+ Flag: string;
+ CrossProduct: Boolean;
+ Strip: string;
+ Add: string;
+ Condition: string;
+ end;
+
+ TSynRepEntry = record
+ Pattern: string;
+ Replacement: string;
+ end;
+
+{$ENDREGION 'Hunspell Types'}
+
+{$REGION 'Hunspell Provider'}
+
+ TSynHunspellProvider = class(TInterfacedObject, ISynSpellCheckProvider)
+ private
+ FLanguage: string;
+ FDictionaryPath: string;
+ FLoaded: Boolean;
+ FWordList: TDictionary;
+ FWordFlags: TDictionary;
+ FPrefixRules: TList;
+ FSuffixRules: TList;
+ FRepTable: TList;
+ FTryChars: string;
+ FFlagType: TSynFlagType;
+ procedure LoadDictionary;
+ procedure ParseAffFile(const AFileName: string);
+ function MatchCondition(const AWord, ACondition: string;
+ AFromEnd: Boolean): Boolean;
+ function CheckSuffix(const AWord: string): Boolean;
+ function CheckPrefix(const AWord: string): Boolean;
+ function CheckCrossProduct(const AWord: string): Boolean;
+ function LookupWord(const AWord: string): Boolean;
+ function WordHasFlag(const AWord, AFlag: string): Boolean;
+ public
+ constructor Create; overload;
+ constructor Create(const ADictionaryPath: string;
+ const ALanguage: string = ''); overload;
+ destructor Destroy; override;
+ { ISynSpellCheckProvider }
+ function CheckWord(const AWord: string): Boolean;
+ function Suggest(const AWord: string): TArray;
+ function IsAvailable: Boolean;
+ function GetLanguage: string;
+ procedure SetLanguage(const Value: string);
+ { Additional }
+ property DictionaryPath: string read FDictionaryPath write FDictionaryPath;
+ end;
+
+{$ENDREGION 'Hunspell Provider'}
+
+{$REGION 'Hunspell Native Provider'}
+
+ { Stub for future native Hunspell DLL binding.
+ All methods are no-ops; IsAvailable returns False. }
+ TSynHunspellNativeProvider = class(TInterfacedObject, ISynSpellCheckProvider)
+ // External functions to bind (hunspell.dll / libhunspell.so / libhunspell.dylib):
+ // function Hunspell_create(affpath, dpath: PAnsiChar): Pointer; cdecl;
+ // procedure Hunspell_destroy(handle: Pointer); cdecl;
+ // function Hunspell_spell(handle: Pointer; word: PAnsiChar): Integer; cdecl;
+ // function Hunspell_suggest(handle: Pointer; out slst: PPAnsiChar;
+ // word: PAnsiChar): Integer; cdecl;
+ // procedure Hunspell_free_list(handle: Pointer; slst: PPAnsiChar;
+ // count: Integer); cdecl;
+ private
+ FHandle: Pointer;
+ FLanguage: string;
+ FDictionaryPath: string;
+ FLoaded: Boolean;
+ public
+ constructor Create(const ADictionaryPath: string;
+ const ALanguage: string = '');
+ destructor Destroy; override;
+ function CheckWord(const AWord: string): Boolean;
+ function Suggest(const AWord: string): TArray;
+ function IsAvailable: Boolean;
+ function GetLanguage: string;
+ procedure SetLanguage(const Value: string);
+ property DictionaryPath: string read FDictionaryPath;
+ end;
+
+{$ENDREGION 'Hunspell Native Provider'}
+
+implementation
+
+uses
+ System.IOUtils,
+ System.Character;
+
+{ ============================================================================ }
+{ TSynHunspellProvider }
+{ ============================================================================ }
+
+constructor TSynHunspellProvider.Create;
+begin
+ inherited Create;
+ FLanguage := '';
+ FDictionaryPath := '';
+ FLoaded := False;
+ FFlagType := ftShort;
+ FWordList := TDictionary.Create;
+ FWordFlags := TDictionary.Create;
+ FPrefixRules := TList.Create;
+ FSuffixRules := TList.Create;
+ FRepTable := TList.Create;
+end;
+
+constructor TSynHunspellProvider.Create(const ADictionaryPath: string;
+ const ALanguage: string);
+begin
+ inherited Create;
+ FDictionaryPath := ADictionaryPath;
+ FLanguage := ALanguage;
+ FLoaded := False;
+ FFlagType := ftShort;
+ FWordList := TDictionary.Create;
+ FWordFlags := TDictionary.Create;
+ FPrefixRules := TList.Create;
+ FSuffixRules := TList.Create;
+ FRepTable := TList.Create;
+end;
+
+destructor TSynHunspellProvider.Destroy;
+begin
+ FRepTable.Free;
+ FSuffixRules.Free;
+ FPrefixRules.Free;
+ FWordFlags.Free;
+ FWordList.Free;
+ inherited;
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ .aff file parser }
+{ ---------------------------------------------------------------------------- }
+
+procedure TSynHunspellProvider.ParseAffFile(const AFileName: string);
+var
+ Lines: TStringList;
+ I: Integer;
+ Line, Cmd, HeaderKey: string;
+ Parts: TArray;
+ Rule: TSynAffixRule;
+ Rep: TSynRepEntry;
+ SeenHeaders: TDictionary;
+ CrossProducts: TDictionary;
+ CrossProd: Boolean;
+ SlashPos: Integer;
+begin
+ FPrefixRules.Clear;
+ FSuffixRules.Clear;
+ FRepTable.Clear;
+ FTryChars := '';
+ FFlagType := ftShort;
+
+ if not TFile.Exists(AFileName) then
+ Exit;
+
+ Lines := TStringList.Create;
+ SeenHeaders := TDictionary.Create;
+ CrossProducts := TDictionary.Create;
+ try
+ Lines.LoadFromFile(AFileName, TEncoding.UTF8);
+ for I := 0 to Lines.Count - 1 do
+ begin
+ Line := Trim(Lines[I]);
+ if (Line = '') or (Line[1] = '#') then
+ Continue;
+
+ Parts := Line.Split([' ', #9], TStringSplitOptions.ExcludeEmpty);
+ if Length(Parts) < 2 then
+ Continue;
+
+ Cmd := Parts[0];
+
+ if Cmd = 'SET' then
+ begin
+ // Encoding directive — we load as UTF-8 by default
+ end
+ else if Cmd = 'FLAG' then
+ begin
+ if SameText(Parts[1], 'long') then
+ FFlagType := ftLong
+ else if SameText(Parts[1], 'num') then
+ FFlagType := ftNum
+ else if SameText(Parts[1], 'UTF-8') then
+ FFlagType := ftUTF8;
+ end
+ else if Cmd = 'TRY' then
+ begin
+ FTryChars := Parts[1];
+ end
+ else if Cmd = 'REP' then
+ begin
+ // REP pattern replacement (or REP count — skip count lines)
+ if Length(Parts) >= 3 then
+ begin
+ Rep.Pattern := Parts[1];
+ Rep.Replacement := Parts[2];
+ FRepTable.Add(Rep);
+ end;
+ end
+ else if (Cmd = 'PFX') or (Cmd = 'SFX') then
+ begin
+ if Length(Parts) < 4 then
+ Continue;
+
+ HeaderKey := Cmd + ':' + Parts[1];
+
+ if not SeenHeaders.ContainsKey(HeaderKey) then
+ begin
+ // Header line: CMD FLAG Y/N COUNT
+ SeenHeaders.Add(HeaderKey, True);
+ CrossProducts.AddOrSetValue(HeaderKey, Parts[2] = 'Y');
+ end
+ else
+ begin
+ // Rule line: CMD FLAG STRIP ADD [CONDITION]
+ Rule.Flag := Parts[1];
+ CrossProd := False;
+ CrossProducts.TryGetValue(HeaderKey, CrossProd);
+ Rule.CrossProduct := CrossProd;
+
+ if Parts[2] = '0' then
+ Rule.Strip := ''
+ else
+ Rule.Strip := Parts[2];
+
+ Rule.Add := Parts[3];
+ // Strip continuation flags after '/'
+ SlashPos := Pos('/', Rule.Add);
+ if SlashPos > 0 then
+ Rule.Add := Copy(Rule.Add, 1, SlashPos - 1);
+ if Rule.Add = '0' then
+ Rule.Add := '';
+
+ if Length(Parts) >= 5 then
+ Rule.Condition := Parts[4]
+ else
+ Rule.Condition := '.';
+
+ if Cmd = 'PFX' then
+ FPrefixRules.Add(Rule)
+ else
+ FSuffixRules.Add(Rule);
+ end;
+ end;
+ // Skip: COMPOUNDFLAG, COMPOUNDMIN, COMPOUNDRULE, KEY, MAP, PHONE, etc.
+ end;
+ finally
+ CrossProducts.Free;
+ SeenHeaders.Free;
+ Lines.Free;
+ end;
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ .dic file loader (preserves affix flags) }
+{ ---------------------------------------------------------------------------- }
+
+procedure TSynHunspellProvider.LoadDictionary;
+var
+ DicFile, AffFile: string;
+ Lines: TStringList;
+ I: Integer;
+ Entry, Word, Flags: string;
+ SlashPos, TabPos, SpPos: Integer;
+begin
+ FWordList.Clear;
+ FWordFlags.Clear;
+ FPrefixRules.Clear;
+ FSuffixRules.Clear;
+ FRepTable.Clear;
+ FLoaded := False;
+
+ if FDictionaryPath = '' then
+ Exit;
+
+ if FLanguage <> '' then
+ begin
+ DicFile := TPath.Combine(FDictionaryPath, FLanguage + '.dic');
+ AffFile := TPath.Combine(FDictionaryPath, FLanguage + '.aff');
+ end
+ else
+ begin
+ DicFile := FDictionaryPath;
+ AffFile := ChangeFileExt(FDictionaryPath, '.aff');
+ end;
+
+ if not TFile.Exists(DicFile) then
+ Exit;
+
+ // Parse .aff first (sets FFlagType, rules, TRY, REP, etc.)
+ ParseAffFile(AffFile);
+
+ Lines := TStringList.Create;
+ try
+ Lines.LoadFromFile(DicFile, TEncoding.UTF8);
+ // Hunspell .dic format: first line is word count, then one word per line.
+ // Words may have flags after a slash, e.g. "word/ABC"
+ for I := 1 to Lines.Count - 1 do
+ begin
+ Entry := Trim(Lines[I]);
+ if Entry = '' then
+ Continue;
+
+ SlashPos := Pos('/', Entry);
+ if SlashPos > 0 then
+ begin
+ Word := Copy(Entry, 1, SlashPos - 1);
+ Flags := Copy(Entry, SlashPos + 1, MaxInt);
+ // Strip morphological data after tab or space
+ TabPos := Pos(#9, Flags);
+ if TabPos > 0 then
+ Flags := Copy(Flags, 1, TabPos - 1);
+ SpPos := Pos(' ', Flags);
+ if SpPos > 0 then
+ Flags := Copy(Flags, 1, SpPos - 1);
+ end
+ else
+ begin
+ Word := Entry;
+ // Strip morphological data
+ TabPos := Pos(#9, Word);
+ if TabPos > 0 then
+ Word := Copy(Word, 1, TabPos - 1);
+ Flags := '';
+ end;
+
+ FWordList.AddOrSetValue(LowerCase(Word), True);
+ if Flags <> '' then
+ FWordFlags.AddOrSetValue(LowerCase(Word), Flags);
+ end;
+ FLoaded := True;
+ finally
+ Lines.Free;
+ end;
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ Condition matching for affix rules }
+{ Hunspell conditions: [abc] = char class, [^abc] = negated, . = any char, }
+{ literal chars. Anchored to word end (SFX) or start (PFX). }
+{ ---------------------------------------------------------------------------- }
+
+function TSynHunspellProvider.MatchCondition(const AWord, ACondition: string;
+ AFromEnd: Boolean): Boolean;
+var
+ CondLen, WordLen, I, J, StartPos: Integer;
+ Negated, Matched: Boolean;
+ C: Char;
+begin
+ if (ACondition = '') or (ACondition = '.') then
+ Exit(True);
+
+ // Count character positions in the condition pattern
+ CondLen := 0;
+ I := 1;
+ while I <= Length(ACondition) do
+ begin
+ Inc(CondLen);
+ if ACondition[I] = '[' then
+ begin
+ while (I <= Length(ACondition)) and (ACondition[I] <> ']') do
+ Inc(I);
+ end;
+ Inc(I);
+ end;
+
+ WordLen := Length(AWord);
+ if WordLen < CondLen then
+ Exit(False);
+
+ // Determine start position in the word
+ if AFromEnd then
+ StartPos := WordLen - CondLen + 1
+ else
+ StartPos := 1;
+
+ // Match each condition element against the word
+ I := 1;
+ J := StartPos;
+ while (I <= Length(ACondition)) and (J >= 1) and (J <= WordLen) do
+ begin
+ if ACondition[I] = '[' then
+ begin
+ Inc(I); // skip '['
+ Negated := False;
+ if (I <= Length(ACondition)) and (ACondition[I] = '^') then
+ begin
+ Negated := True;
+ Inc(I);
+ end;
+ Matched := False;
+ C := AWord[J];
+ while (I <= Length(ACondition)) and (ACondition[I] <> ']') do
+ begin
+ if ACondition[I] = C then
+ Matched := True;
+ Inc(I);
+ end;
+ if I <= Length(ACondition) then
+ Inc(I); // skip ']'
+ if Negated then
+ Matched := not Matched;
+ if not Matched then
+ Exit(False);
+ Inc(J);
+ end
+ else if ACondition[I] = '.' then
+ begin
+ Inc(I);
+ Inc(J);
+ end
+ else
+ begin
+ if AWord[J] <> ACondition[I] then
+ Exit(False);
+ Inc(I);
+ Inc(J);
+ end;
+ end;
+
+ Result := (I > Length(ACondition));
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ Word lookup helpers }
+{ ---------------------------------------------------------------------------- }
+
+function TSynHunspellProvider.LookupWord(const AWord: string): Boolean;
+begin
+ Result := FWordList.ContainsKey(LowerCase(AWord));
+end;
+
+function TSynHunspellProvider.WordHasFlag(const AWord, AFlag: string): Boolean;
+var
+ Flags: string;
+ FlagPos: Integer;
+ FlagParts: TArray;
+ FP: string;
+begin
+ if not FWordFlags.TryGetValue(LowerCase(AWord), Flags) then
+ Exit(False);
+
+ case FFlagType of
+ ftShort, ftUTF8:
+ Result := Pos(AFlag, Flags) > 0;
+ ftLong:
+ begin
+ FlagPos := 1;
+ Result := False;
+ while FlagPos + 1 <= Length(Flags) do
+ begin
+ if Copy(Flags, FlagPos, 2) = AFlag then
+ Exit(True);
+ Inc(FlagPos, 2);
+ end;
+ end;
+ ftNum:
+ begin
+ FlagParts := Flags.Split([',']);
+ Result := False;
+ for FP in FlagParts do
+ if Trim(FP) = AFlag then
+ Exit(True);
+ end;
+ else
+ Result := False;
+ end;
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ Affix rule checking }
+{ ---------------------------------------------------------------------------- }
+
+function TSynHunspellProvider.CheckSuffix(const AWord: string): Boolean;
+var
+ Rule: TSynAffixRule;
+ Stem, WordLower: string;
+begin
+ WordLower := LowerCase(AWord);
+ for Rule in FSuffixRules do
+ begin
+ if Rule.Add = '' then
+ begin
+ // Rule adds nothing — word itself is the stem with Strip re-added
+ Stem := WordLower + Rule.Strip;
+ if MatchCondition(Stem, Rule.Condition, True) and
+ WordHasFlag(Stem, Rule.Flag) then
+ Exit(True);
+ end
+ else if (Length(WordLower) > Length(Rule.Add)) and
+ WordLower.EndsWith(Rule.Add) then
+ begin
+ // Strip the added suffix and re-add the stripped part
+ Stem := Copy(WordLower, 1, Length(WordLower) - Length(Rule.Add))
+ + Rule.Strip;
+ if (Stem <> '') and MatchCondition(Stem, Rule.Condition, True) and
+ WordHasFlag(Stem, Rule.Flag) then
+ Exit(True);
+ end;
+ end;
+ Result := False;
+end;
+
+function TSynHunspellProvider.CheckPrefix(const AWord: string): Boolean;
+var
+ Rule: TSynAffixRule;
+ Stem, WordLower: string;
+begin
+ WordLower := LowerCase(AWord);
+ for Rule in FPrefixRules do
+ begin
+ if Rule.Add = '' then
+ begin
+ Stem := Rule.Strip + WordLower;
+ if MatchCondition(Stem, Rule.Condition, False) and
+ WordHasFlag(Stem, Rule.Flag) then
+ Exit(True);
+ end
+ else if (Length(WordLower) > Length(Rule.Add)) and
+ WordLower.StartsWith(Rule.Add) then
+ begin
+ Stem := Rule.Strip + Copy(WordLower, Length(Rule.Add) + 1, MaxInt);
+ if (Stem <> '') and MatchCondition(Stem, Rule.Condition, False) and
+ WordHasFlag(Stem, Rule.Flag) then
+ Exit(True);
+ end;
+ end;
+ Result := False;
+end;
+
+function TSynHunspellProvider.CheckCrossProduct(const AWord: string): Boolean;
+var
+ PfxRule, SfxRule: TSynAffixRule;
+ AfterPrefix, Stem, WordLower: string;
+begin
+ WordLower := LowerCase(AWord);
+
+ for PfxRule in FPrefixRules do
+ begin
+ if not PfxRule.CrossProduct then
+ Continue;
+
+ // Strip prefix
+ if PfxRule.Add = '' then
+ AfterPrefix := PfxRule.Strip + WordLower
+ else if WordLower.StartsWith(PfxRule.Add) then
+ AfterPrefix := PfxRule.Strip +
+ Copy(WordLower, Length(PfxRule.Add) + 1, MaxInt)
+ else
+ Continue;
+
+ if AfterPrefix = '' then
+ Continue;
+ if not MatchCondition(AfterPrefix, PfxRule.Condition, False) then
+ Continue;
+
+ // Now try each suffix rule on the result
+ for SfxRule in FSuffixRules do
+ begin
+ if not SfxRule.CrossProduct then
+ Continue;
+
+ if SfxRule.Add = '' then
+ begin
+ Stem := AfterPrefix + SfxRule.Strip;
+ if MatchCondition(Stem, SfxRule.Condition, True) and
+ WordHasFlag(Stem, PfxRule.Flag) and
+ WordHasFlag(Stem, SfxRule.Flag) then
+ Exit(True);
+ end
+ else if AfterPrefix.EndsWith(SfxRule.Add) then
+ begin
+ Stem := Copy(AfterPrefix, 1,
+ Length(AfterPrefix) - Length(SfxRule.Add)) + SfxRule.Strip;
+ if (Stem <> '') and
+ MatchCondition(Stem, SfxRule.Condition, True) and
+ WordHasFlag(Stem, PfxRule.Flag) and
+ WordHasFlag(Stem, SfxRule.Flag) then
+ Exit(True);
+ end;
+ end;
+ end;
+ Result := False;
+end;
+
+{ ---------------------------------------------------------------------------- }
+{ ISynSpellCheckProvider }
+{ ---------------------------------------------------------------------------- }
+
+function TSynHunspellProvider.CheckWord(const AWord: string): Boolean;
+begin
+ if not FLoaded and (FDictionaryPath <> '') then
+ LoadDictionary;
+
+ // If not loaded or empty dictionary, accept all words
+ if not FLoaded or (FWordList.Count = 0) then
+ Exit(True);
+
+ // Stage 1: Direct lookup
+ if LookupWord(AWord) then
+ Exit(True);
+
+ // Stage 2: Suffix stripping
+ if CheckSuffix(AWord) then
+ Exit(True);
+
+ // Stage 3: Prefix stripping
+ if CheckPrefix(AWord) then
+ Exit(True);
+
+ // Stage 4: Cross-product (prefix + suffix)
+ if CheckCrossProduct(AWord) then
+ Exit(True);
+
+ Result := False;
+end;
+
+function TSynHunspellProvider.Suggest(const AWord: string): TArray;
+const
+ MaxSuggestions = 10;
+
+ function IsValidWord(Provider: TSynHunspellProvider;
+ const S: string): Boolean;
+ begin
+ Result := Provider.CheckWord(S);
+ end;
+
+var
+ Suggestions: TList;
+ WordLower, S: string;
+ Rep: TSynRepEntry;
+ I, J, FoundPos: Integer;
+ C: Char;
+begin
+ if not FLoaded and (FDictionaryPath <> '') then
+ LoadDictionary;
+
+ Suggestions := TList.Create;
+ try
+ WordLower := LowerCase(AWord);
+
+ // Stage 1: REP table replacements
+ for Rep in FRepTable do
+ begin
+ if Suggestions.Count >= MaxSuggestions then
+ Break;
+ FoundPos := Pos(Rep.Pattern, WordLower);
+ while (FoundPos > 0) and (Suggestions.Count < MaxSuggestions) do
+ begin
+ S := Copy(WordLower, 1, FoundPos - 1) + Rep.Replacement +
+ Copy(WordLower, FoundPos + Length(Rep.Pattern), MaxInt);
+ if (S <> '') and not Suggestions.Contains(S) and
+ IsValidWord(Self, S) then
+ Suggestions.Add(S);
+ FoundPos := Pos(Rep.Pattern, WordLower, FoundPos + 1);
+ end;
+ end;
+
+ // Stage 2: Single-char edits using TRY characters
+ if (Suggestions.Count < MaxSuggestions) and (FTryChars <> '') then
+ begin
+ // Deletions
+ for I := 1 to Length(WordLower) do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ S := Copy(WordLower, 1, I - 1) + Copy(WordLower, I + 1, MaxInt);
+ if (S <> '') and not Suggestions.Contains(S) and
+ IsValidWord(Self, S) then
+ Suggestions.Add(S);
+ end;
+
+ // Transpositions
+ for I := 1 to Length(WordLower) - 1 do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ S := WordLower;
+ C := S[I];
+ S[I] := S[I + 1];
+ S[I + 1] := C;
+ if not Suggestions.Contains(S) and IsValidWord(Self, S) then
+ Suggestions.Add(S);
+ end;
+
+ // Substitutions
+ for I := 1 to Length(WordLower) do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ for J := 1 to Length(FTryChars) do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ if FTryChars[J] = WordLower[I] then
+ Continue;
+ S := WordLower;
+ S[I] := FTryChars[J];
+ if not Suggestions.Contains(S) and IsValidWord(Self, S) then
+ Suggestions.Add(S);
+ end;
+ end;
+
+ // Insertions
+ for I := 1 to Length(WordLower) + 1 do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ for J := 1 to Length(FTryChars) do
+ begin
+ if Suggestions.Count >= MaxSuggestions then Break;
+ S := Copy(WordLower, 1, I - 1) + FTryChars[J] +
+ Copy(WordLower, I, MaxInt);
+ if not Suggestions.Contains(S) and IsValidWord(Self, S) then
+ Suggestions.Add(S);
+ end;
+ end;
+ end;
+
+ Result := Suggestions.ToArray;
+ finally
+ Suggestions.Free;
+ end;
+end;
+
+function TSynHunspellProvider.IsAvailable: Boolean;
+begin
+ if not FLoaded and (FDictionaryPath <> '') then
+ LoadDictionary;
+ Result := FLoaded;
+end;
+
+function TSynHunspellProvider.GetLanguage: string;
+begin
+ Result := FLanguage;
+end;
+
+procedure TSynHunspellProvider.SetLanguage(const Value: string);
+begin
+ if FLanguage <> Value then
+ begin
+ FLanguage := Value;
+ FLoaded := False;
+ FWordList.Clear;
+ FWordFlags.Clear;
+ FPrefixRules.Clear;
+ FSuffixRules.Clear;
+ FRepTable.Clear;
+ end;
+end;
+
+{ ============================================================================ }
+{ TSynHunspellNativeProvider (stub) }
+{ ============================================================================ }
+
+constructor TSynHunspellNativeProvider.Create(const ADictionaryPath: string;
+ const ALanguage: string);
+begin
+ inherited Create;
+ FDictionaryPath := ADictionaryPath;
+ FLanguage := ALanguage;
+ FHandle := nil;
+ FLoaded := False;
+end;
+
+destructor TSynHunspellNativeProvider.Destroy;
+begin
+ FHandle := nil;
+ inherited;
+end;
+
+function TSynHunspellNativeProvider.CheckWord(const AWord: string): Boolean;
+begin
+ Result := True; // No-op: accept all words when native DLL not loaded
+end;
+
+function TSynHunspellNativeProvider.Suggest(
+ const AWord: string): TArray;
+begin
+ SetLength(Result, 0);
+end;
+
+function TSynHunspellNativeProvider.IsAvailable: Boolean;
+begin
+ Result := False; // Native DLL not yet implemented
+end;
+
+function TSynHunspellNativeProvider.GetLanguage: string;
+begin
+ Result := FLanguage;
+end;
+
+procedure TSynHunspellNativeProvider.SetLanguage(const Value: string);
+begin
+ FLanguage := Value;
+end;
+
+end.
diff --git a/Source/SynSpellCheckTypes.pas b/Source/SynSpellCheckTypes.pas
new file mode 100644
index 00000000..4a0da801
--- /dev/null
+++ b/Source/SynSpellCheckTypes.pas
@@ -0,0 +1,127 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+-------------------------------------------------------------------------------}
+
+{ Framework-neutral spell check types, interfaces, and word extraction helpers.
+ Shared by both VCL and FMX spell check implementations. }
+
+unit SynSpellCheckTypes;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.SysUtils,
+ System.Classes,
+ System.Generics.Collections;
+
+{$REGION 'Spell Check Token Types'}
+
+type
+ TSynSpellCheckToken = (sctComment, sctString, sctIdentifier);
+ TSynSpellCheckTokens = set of TSynSpellCheckToken;
+
+{$ENDREGION 'Spell Check Token Types'}
+
+{$REGION 'Spell Error Record'}
+
+ TSynSpellError = record
+ Line: Integer; // 1-based line
+ StartChar: Integer; // 1-based char
+ EndChar: Integer; // 1-based char (exclusive)
+ Word: string;
+ end;
+
+{$ENDREGION 'Spell Error Record'}
+
+{$REGION 'Provider Interface'}
+
+ ISynSpellCheckProvider = interface
+ ['{A1F5B2C3-D4E6-4789-AB01-23456789ABCD}']
+ function CheckWord(const AWord: string): Boolean;
+ function Suggest(const AWord: string): TArray;
+ function IsAvailable: Boolean;
+ function GetLanguage: string;
+ procedure SetLanguage(const Value: string);
+ end;
+
+{$ENDREGION 'Provider Interface'}
+
+{$REGION 'Word Extraction Helpers'}
+
+type
+ TWordInfo = record
+ Word: string;
+ StartChar: Integer; // 1-based
+ EndChar: Integer; // 1-based, exclusive
+ end;
+
+function IsSpellWordBreakChar(C: WideChar): Boolean; inline;
+function ExtractWords(const ALine: string): TArray;
+function ContainsLetter(const S: string): Boolean;
+
+{$ENDREGION 'Word Extraction Helpers'}
+
+implementation
+
+uses
+ System.Character;
+
+function IsSpellWordBreakChar(C: WideChar): Boolean;
+begin
+ case C of
+ 'A'..'Z', 'a'..'z', '0'..'9', '_', '''': Result := False;
+ else
+ Result := True;
+ end;
+end;
+
+function ExtractWords(const ALine: string): TArray;
+var
+ I, Len, WordStart: Integer;
+ List: TList;
+ Info: TWordInfo;
+begin
+ Len := Length(ALine);
+ List := TList.Create;
+ try
+ I := 1;
+ while I <= Len do
+ begin
+ // Skip non-word characters
+ while (I <= Len) and IsSpellWordBreakChar(ALine[I]) do
+ Inc(I);
+ if I > Len then Break;
+ // Start of a word
+ WordStart := I;
+ while (I <= Len) and not IsSpellWordBreakChar(ALine[I]) do
+ Inc(I);
+ Info.StartChar := WordStart;
+ Info.EndChar := I;
+ Info.Word := Copy(ALine, WordStart, I - WordStart);
+ if Info.Word.Length > 0 then
+ List.Add(Info);
+ end;
+ Result := List.ToArray;
+ finally
+ List.Free;
+ end;
+end;
+
+function ContainsLetter(const S: string): Boolean;
+var
+ I: Integer;
+begin
+ for I := 1 to Length(S) do
+ if S[I].IsLetter then
+ Exit(True);
+ Result := False;
+end;
+
+end.
diff --git a/Source/SynSpellCheckWinAPI.pas b/Source/SynSpellCheckWinAPI.pas
new file mode 100644
index 00000000..ec315dc8
--- /dev/null
+++ b/Source/SynSpellCheckWinAPI.pas
@@ -0,0 +1,172 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+-------------------------------------------------------------------------------}
+
+{ Windows Spell Checking API COM interface declarations.
+ Shared by both VCL and FMX spell check implementations.
+ Requires Windows 8+ at runtime. }
+
+unit SynSpellCheckWinAPI;
+
+{$I SynEdit.inc}
+
+{$IFDEF MSWINDOWS}
+
+interface
+
+uses
+ Winapi.Windows,
+ Winapi.ActiveX;
+
+// *********************************************************************//
+// GUIDS declared in the TypeLibrary. Following prefixes are used:
+// Type Libraries : LIBID_xxxx
+// CoClasses : CLASS_xxxx
+// DISPInterfaces : DIID_xxxx
+// Non-DISP interfaces: IID_xxxx
+// *********************************************************************//
+const
+ IID_ISpellCheckerFactory: TGUID = '{8E018A9D-2415-4677-BF08-794EA61F94BB}';
+ IID_IUserDictionariesRegistrar: TGUID = '{AA176B85-0E12-4844-8E1A-EEF1DA77F586}';
+ IID_ISpellChecker: TGUID = '{B6FD0B71-E2BC-4653-8D05-F197E412770B}';
+ IID_IEnumSpellingError: TGUID = '{803E3BD4-2828-4410-8290-418D1D73C762}';
+ IID_ISpellingError: TGUID = '{B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}';
+ IID_ISpellCheckerChangedEventHandler: TGUID = '{0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}';
+ IID_IOptionDescription: TGUID = '{432E5F85-35CF-4606-A801-6F70277E1D7A}';
+ CLASS_SpellCheckerFactory: TGUID = '{7AB36653-1796-484B-BDFA-E74F1DB7C1DC}';
+
+// Constants for enum CORRECTIVE_ACTION
+type
+ CORRECTIVE_ACTION = TOleEnum;
+ TCorrectiveAction = (secaNone, secaSuggestions, secaReplace, secaDelete);
+
+const
+ CORRECTIVE_ACTION_NONE = $00000000;
+ CORRECTIVE_ACTION_GET_SUGGESTIONS = $00000001;
+ CORRECTIVE_ACTION_REPLACE = $00000002;
+ CORRECTIVE_ACTION_DELETE = $00000003;
+
+type
+
+// *********************************************************************//
+// Forward declaration of types defined in TypeLibrary
+// *********************************************************************//
+ ISpellCheckerFactory = interface;
+ IUserDictionariesRegistrar = interface;
+ ISpellChecker = interface;
+ IEnumSpellingError = interface;
+ ISpellingError = interface;
+ ISpellCheckerChangedEventHandler = interface;
+ IOptionDescription = interface;
+
+// *********************************************************************//
+// Declaration of CoClasses defined in Type Library
+// (NOTE: Here we map each CoClass to its Default Interface)
+// *********************************************************************//
+ SpellCheckerFactory = ISpellCheckerFactory;
+
+// *********************************************************************//
+// Interface: ISpellCheckerFactory
+// GUID: {8E018A9D-2415-4677-BF08-794EA61F94BB}
+// *********************************************************************//
+ ISpellCheckerFactory = interface(IUnknown)
+ ['{8E018A9D-2415-4677-BF08-794EA61F94BB}']
+ function Get_SupportedLanguages(out value: IEnumString): HResult; stdcall;
+ function IsSupported(languageTag: PWideChar; out value: Integer): HResult; stdcall;
+ function CreateSpellChecker(languageTag: PWideChar; out value: ISpellChecker): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: IUserDictionariesRegistrar
+// GUID: {AA176B85-0E12-4844-8E1A-EEF1DA77F586}
+// *********************************************************************//
+ IUserDictionariesRegistrar = interface(IUnknown)
+ ['{AA176B85-0E12-4844-8E1A-EEF1DA77F586}']
+ function RegisterUserDictionary(dictionaryPath: PWideChar; languageTag: PWideChar): HResult; stdcall;
+ function UnregisterUserDictionary(dictionaryPath: PWideChar; languageTag: PWideChar): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: ISpellChecker
+// GUID: {B6FD0B71-E2BC-4653-8D05-F197E412770B}
+// *********************************************************************//
+ ISpellChecker = interface(IUnknown)
+ ['{B6FD0B71-E2BC-4653-8D05-F197E412770B}']
+ function Get_languageTag(out value: PWideChar): HResult; stdcall;
+ function Check(text: PWideChar; out value: IEnumSpellingError): HResult; stdcall;
+ function Suggest(word: PWideChar; out value: IEnumString): HResult; stdcall;
+ function Add(word: PWideChar): HResult; stdcall;
+ function Ignore(word: PWideChar): HResult; stdcall;
+ function AutoCorrect(from: PWideChar; to_: PWideChar): HResult; stdcall;
+ function GetOptionValue(optionId: PWideChar; out value: Byte): HResult; stdcall;
+ function Get_OptionIds(out value: IEnumString): HResult; stdcall;
+ function Get_Id(out value: PWideChar): HResult; stdcall;
+ function Get_LocalizedName(out value: PWideChar): HResult; stdcall;
+ function add_SpellCheckerChanged(const handler: ISpellCheckerChangedEventHandler;
+ out eventCookie: LongWord): HResult; stdcall;
+ function remove_SpellCheckerChanged(eventCookie: LongWord): HResult; stdcall;
+ function GetOptionDescription(optionId: PWideChar; out value: IOptionDescription): HResult; stdcall;
+ function ComprehensiveCheck(text: PWideChar; out value: IEnumSpellingError): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: ISpellChecker2
+// GUID: {E7ED1C71-87F7-4378-A840-C9200DACEE47}
+// *********************************************************************//
+ ISpellChecker2 = interface(ISpellChecker)
+ ['{E7ED1C71-87F7-4378-A840-C9200DACEE47}']
+ function Remove(word: PWideChar): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: IEnumSpellingError
+// GUID: {803E3BD4-2828-4410-8290-418D1D73C762}
+// *********************************************************************//
+ IEnumSpellingError = interface(IUnknown)
+ ['{803E3BD4-2828-4410-8290-418D1D73C762}']
+ function Next(out value: ISpellingError): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: ISpellingError
+// GUID: {B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}
+// *********************************************************************//
+ ISpellingError = interface(IUnknown)
+ ['{B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}']
+ function Get_StartIndex(out value: LongWord): HResult; stdcall;
+ function Get_Length(out value: LongWord): HResult; stdcall;
+ function Get_CorrectiveAction(out value: CORRECTIVE_ACTION): HResult; stdcall;
+ function Get_Replacement(out value: PWideChar): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: ISpellCheckerChangedEventHandler
+// GUID: {0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}
+// *********************************************************************//
+ ISpellCheckerChangedEventHandler = interface(IUnknown)
+ ['{0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}']
+ function Invoke(const sender: ISpellChecker): HResult; stdcall;
+ end;
+
+// *********************************************************************//
+// Interface: IOptionDescription
+// GUID: {432E5F85-35CF-4606-A801-6F70277E1D7A}
+// *********************************************************************//
+ IOptionDescription = interface(IUnknown)
+ ['{432E5F85-35CF-4606-A801-6F70277E1D7A}']
+ function Get_Id(out value: PWideChar): HResult; stdcall;
+ function Get_Heading(out value: PWideChar): HResult; stdcall;
+ function Get_Description(out value: PWideChar): HResult; stdcall;
+ function Get_Labels(out value: IEnumString): HResult; stdcall;
+ end;
+
+{$ENDIF MSWINDOWS}
+
+implementation
+
+end.
diff --git a/Source/SynSpellCheckWindowsProvider.pas b/Source/SynSpellCheckWindowsProvider.pas
new file mode 100644
index 00000000..b6ae2b38
--- /dev/null
+++ b/Source/SynSpellCheckWindowsProvider.pas
@@ -0,0 +1,231 @@
+{-------------------------------------------------------------------------------
+TurboPack SynEdit
+
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+-------------------------------------------------------------------------------}
+
+{ Windows Spell Checking API provider implementing ISynSpellCheckProvider.
+ Framework-neutral — works with both VCL and FMX.
+ Requires Windows 8+ at runtime. }
+
+unit SynSpellCheckWindowsProvider;
+
+{$I SynEdit.inc}
+
+{$IFDEF MSWINDOWS}
+
+interface
+
+uses
+ Winapi.Windows,
+ Winapi.ActiveX,
+ System.SysUtils,
+ System.Classes,
+ System.Generics.Collections,
+ SynSpellCheckTypes,
+ SynSpellCheckWinAPI;
+
+type
+ TSynWindowsSpellProvider = class(TInterfacedObject, ISynSpellCheckProvider)
+ private
+ FLanguage: string;
+ FFactory: ISpellCheckerFactory;
+ FSpellChecker: ISpellChecker;
+ FAvailable: Boolean;
+ procedure CreateFactory;
+ procedure CreateSpellChecker;
+ public
+ constructor Create; overload;
+ constructor Create(const ALanguage: string); overload;
+ destructor Destroy; override;
+ { ISynSpellCheckProvider }
+ function CheckWord(const AWord: string): Boolean;
+ function Suggest(const AWord: string): TArray;
+ function IsAvailable: Boolean;
+ function GetLanguage: string;
+ procedure SetLanguage(const Value: string);
+ { Additional }
+ class function SupportedLanguages: TArray;
+ end;
+
+implementation
+
+uses
+ System.Win.ComObj;
+
+{ ============================================================================ }
+{ TSynWindowsSpellProvider }
+{ ============================================================================ }
+
+constructor TSynWindowsSpellProvider.Create;
+begin
+ inherited Create;
+ FLanguage := 'en-US';
+ FAvailable := False;
+ CreateFactory;
+ if Assigned(FFactory) then
+ CreateSpellChecker;
+end;
+
+constructor TSynWindowsSpellProvider.Create(const ALanguage: string);
+begin
+ inherited Create;
+ FLanguage := ALanguage;
+ FAvailable := False;
+ CreateFactory;
+ if Assigned(FFactory) then
+ CreateSpellChecker;
+end;
+
+destructor TSynWindowsSpellProvider.Destroy;
+begin
+ FSpellChecker := nil;
+ FFactory := nil;
+ inherited;
+end;
+
+procedure TSynWindowsSpellProvider.CreateFactory;
+var
+ HR: HResult;
+ Unk: IUnknown;
+begin
+ FFactory := nil;
+ // Windows 8+ required for spell checking API
+ if not TOSVersion.Check(6, 2) then
+ Exit;
+
+ HR := CoCreateInstance(CLASS_SpellCheckerFactory, nil, CLSCTX_INPROC_SERVER,
+ IID_ISpellCheckerFactory, Unk);
+ if Succeeded(HR) and Assigned(Unk) then
+ FFactory := Unk as ISpellCheckerFactory;
+end;
+
+procedure TSynWindowsSpellProvider.CreateSpellChecker;
+var
+ HR: HResult;
+ Supported: Integer;
+begin
+ FSpellChecker := nil;
+ FAvailable := False;
+
+ if not Assigned(FFactory) then
+ Exit;
+
+ HR := FFactory.IsSupported(PChar(FLanguage), Supported);
+ if Failed(HR) or (Supported = 0) then
+ Exit;
+
+ HR := FFactory.CreateSpellChecker(PChar(FLanguage), FSpellChecker);
+ FAvailable := Succeeded(HR) and Assigned(FSpellChecker);
+end;
+
+function TSynWindowsSpellProvider.CheckWord(const AWord: string): Boolean;
+var
+ SpellingErrors: IEnumSpellingError;
+ SpellingError: ISpellingError;
+ HR: HResult;
+begin
+ Result := True;
+ if not FAvailable or not Assigned(FSpellChecker) then
+ Exit;
+
+ HR := FSpellChecker.Check(PChar(AWord), SpellingErrors);
+ if Failed(HR) or not Assigned(SpellingErrors) then
+ Exit;
+
+ // If Next returns S_OK, there is at least one error => word is misspelled
+ Result := SpellingErrors.Next(SpellingError) <> S_OK;
+end;
+
+function TSynWindowsSpellProvider.Suggest(const AWord: string): TArray;
+var
+ Suggestions: IEnumString;
+ HR: HResult;
+ Fetched: LongInt;
+ Str: PWideChar;
+ List: TList;
+begin
+ SetLength(Result, 0);
+ if not FAvailable or not Assigned(FSpellChecker) then
+ Exit;
+
+ HR := FSpellChecker.Suggest(PChar(AWord), Suggestions);
+ if Failed(HR) or not Assigned(Suggestions) then
+ Exit;
+
+ List := TList.Create;
+ try
+ while Suggestions.Next(1, Str, @Fetched) = S_OK do
+ begin
+ List.Add(string(Str));
+ CoTaskMemFree(Str);
+ end;
+ Result := List.ToArray;
+ finally
+ List.Free;
+ end;
+end;
+
+function TSynWindowsSpellProvider.IsAvailable: Boolean;
+begin
+ Result := FAvailable;
+end;
+
+function TSynWindowsSpellProvider.GetLanguage: string;
+begin
+ Result := FLanguage;
+end;
+
+procedure TSynWindowsSpellProvider.SetLanguage(const Value: string);
+begin
+ if FLanguage <> Value then
+ begin
+ FLanguage := Value;
+ if Assigned(FFactory) then
+ CreateSpellChecker;
+ end;
+end;
+
+class function TSynWindowsSpellProvider.SupportedLanguages: TArray;
+var
+ Factory: ISpellCheckerFactory;
+ Languages: IEnumString;
+ Lang: PWideChar;
+ Fetched: LongInt;
+ HR: HResult;
+ Unk: IUnknown;
+ List: TList;
+begin
+ SetLength(Result, 0);
+ if not TOSVersion.Check(6, 2) then
+ Exit;
+
+ HR := CoCreateInstance(CLASS_SpellCheckerFactory, nil, CLSCTX_INPROC_SERVER,
+ IID_ISpellCheckerFactory, Unk);
+ if Failed(HR) or not Assigned(Unk) then
+ Exit;
+
+ Factory := Unk as ISpellCheckerFactory;
+ HR := Factory.Get_SupportedLanguages(Languages);
+ if Failed(HR) or not Assigned(Languages) then
+ Exit;
+
+ List := TList.Create;
+ try
+ while Languages.Next(1, Lang, @Fetched) = S_OK do
+ begin
+ List.Add(string(Lang));
+ CoTaskMemFree(Lang);
+ end;
+ Result := List.ToArray;
+ finally
+ List.Free;
+ end;
+end;
+
+{$ENDIF MSWINDOWS}
+
+end.
diff --git a/Source/SynUnicode.pas b/Source/SynUnicodeShared.pas
similarity index 91%
rename from Source/SynUnicode.pas
rename to Source/SynUnicodeShared.pas
index 0d1a3270..7e4d114b 100644
--- a/Source/SynUnicode.pas
+++ b/Source/SynUnicodeShared.pas
@@ -26,23 +26,29 @@
------------------------------------------------------------------------------}
-unit SynUnicode;
+unit SynUnicodeShared;
+
+{ Platform-independent Unicode and encoding utilities for SynEdit.
+
+ Named with the 'Shared' suffix because a bare 'SynUnicode' unit
+ shadows 'Vcl.SynUnicode' and 'FMX.SynUnicode' under Delphi's scope
+ resolution rules (exact name match wins over dotted-prefix match).
+ The suffix lets shared code reference this unit unambiguously, while
+ Vcl.SynUnicode / FMX.SynUnicode re-export its public API together
+ with their own platform-specific clipboard functions. }
{$I SynEdit.inc}
interface
uses
- Windows,
- Messages,
- Controls,
- Forms,
- Graphics,
- Clipbrd,
- Types,
- Classes,
- SysUtils,
- TypInfo,
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ System.Types,
+ System.Classes,
+ System.SysUtils,
+ System.TypInfo,
SynEditTypes;
const
@@ -84,30 +90,39 @@ procedure StrSwapByteOrder(Str: PWideChar);
TSynEncoding = (seUTF8, seUTF16LE, seUTF16BE, seAnsi);
TSynEncodings = set of TSynEncoding;
+{$IFDEF MSWINDOWS}
function IsAnsiOnly(const WS: string): Boolean;
+{$ENDIF}
function IsUTF8(Stream: TStream; out WithBOM: Boolean; BytesToCheck: Integer = $4000): Boolean; overload;
function IsUTF8(const FileName: string; out WithBOM: Boolean; BytesToCheck: Integer = $4000): Boolean; overload;
function IsUTF8(const Bytes: TBytes; Start: Integer = 0; BytesToCheck: Integer = $4000): Boolean; overload;
function GetEncoding(const FileName: string; out WithBOM: Boolean): TEncoding; overload;
function GetEncoding(Stream: TStream; out WithBOM: Boolean): TEncoding; overload;
+{$IFDEF MSWINDOWS}
+{$IFNDEF SYN_SHARED}
function ClipboardProvidesText: Boolean;
function GetClipboardText: string;
procedure SetClipboardText(const Text: string);
+{$ENDIF ~SYN_SHARED}
{ misc functions }
function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
var
UserLocaleName: array [0..LOCALE_NAME_MAX_LENGTH - 1] of Char;
+{$ENDIF}
implementation
uses
- SynEditTextBuffer,
- Math,
- SysConst,
- RTLConsts;
+ {$IF Defined(MSWINDOWS) and not Defined(SYN_SHARED)}
+ Vcl.Clipbrd,
+ {$ENDIF}
+ System.Math,
+ System.SysConst,
+ System.RTLConsts,
+ SynEditTextBuffer;
// exchanges in each character of the given string the low order and high order
// byte to go from LSB to MSB and vice versa.
@@ -119,11 +134,12 @@ procedure StrSwapByteOrder(Str: PWideChar);
P := PWord(Str);
while P^ <> 0 do
begin
- P^ := MakeWord(HiByte(P^), LoByte(P^));
+ P^ := Swap(P^);
Inc(P);
end;
end;
+{$IFDEF MSWINDOWS}
function IsAnsiOnly(const WS: string): Boolean;
var
UsedDefaultChar: BOOL;
@@ -132,6 +148,7 @@ function IsAnsiOnly(const WS: string): Boolean;
nil, @UsedDefaultChar);
Result := not UsedDefaultChar;
end;
+{$ENDIF}
function IsUTF8(const FileName: string; out WithBOM: Boolean; BytesToCheck: Integer): Boolean;
var
@@ -354,6 +371,8 @@ function GetEncoding(Stream: TStream; out WithBOM: Boolean): TEncoding;
end;
end;
+{$IFDEF MSWINDOWS}
+{$IFNDEF SYN_SHARED}
function ClipboardProvidesText: Boolean;
begin
Result := IsClipboardFormatAvailable(CF_UNICODETEXT);
@@ -368,6 +387,7 @@ procedure SetClipboardText(const Text: string);
begin
Clipboard.AsText := Text;
end;
+{$ENDIF ~SYN_SHARED}
function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
var
@@ -377,10 +397,13 @@ function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
@UsedDefaultChar);
Result := not UsedDefaultChar;
end;
+{$ENDIF}
+{$IFDEF MSWINDOWS}
initialization
Assert(TOSVersion.Check(6), 'Unsupported Windows version. Windows Vista or higher required');
if LCIDToLocaleName(GetUserDefaultLCID, UserLocaleName, LOCALE_NAME_MAX_LENGTH, 0) = 0 then
RaiseLastOSError;
+{$ENDIF}
end.
diff --git a/Source/DesignTimeEditors/SynDelphiIDEImporter.pas b/Source/VCL/DesignTimeEditors/SynDelphiIDEImporter.pas
similarity index 100%
rename from Source/DesignTimeEditors/SynDelphiIDEImporter.pas
rename to Source/VCL/DesignTimeEditors/SynDelphiIDEImporter.pas
diff --git a/Source/SynAccessibility.pas b/Source/VCL/Vcl.SynAccessibility.pas
similarity index 99%
rename from Source/SynAccessibility.pas
rename to Source/VCL/Vcl.SynAccessibility.pas
index 12ae95ed..2feb2f26 100644
--- a/Source/SynAccessibility.pas
+++ b/Source/VCL/Vcl.SynAccessibility.pas
@@ -1,4 +1,4 @@
-unit SynAccessibility;
+unit Vcl.SynAccessibility;
{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
@@ -373,7 +373,7 @@ implementation
System.Variants,
Vcl.Controls,
SynEditTypes,
- SynUnicode;
+ SynUnicodeShared;
resourcestring
rsLocalizedControlType = 'editor';
diff --git a/Source/SynAutoCorrect.pas b/Source/VCL/Vcl.SynAutoCorrect.pas
similarity index 99%
rename from Source/SynAutoCorrect.pas
rename to Source/VCL/Vcl.SynAutoCorrect.pas
index 67e0e2aa..4394b4d2 100644
--- a/Source/SynAutoCorrect.pas
+++ b/Source/VCL/Vcl.SynAutoCorrect.pas
@@ -85,7 +85,7 @@
* New demo.
}
-unit SynAutoCorrect;
+unit Vcl.SynAutoCorrect;
{$I SynEdit.inc}
@@ -104,7 +104,7 @@ interface
SynEditKeyCmds,
SynEdit,
SynEditMiscClasses,
- SynUnicode,
+ SynUnicodeShared,
Classes,
SysUtils,
IniFiles;
diff --git a/Source/SynAutoCorrectEditor.dfm b/Source/VCL/Vcl.SynAutoCorrectEditor.dfm
similarity index 100%
rename from Source/SynAutoCorrectEditor.dfm
rename to Source/VCL/Vcl.SynAutoCorrectEditor.dfm
diff --git a/Source/SynAutoCorrectEditor.pas b/Source/VCL/Vcl.SynAutoCorrectEditor.pas
similarity index 98%
rename from Source/SynAutoCorrectEditor.pas
rename to Source/VCL/Vcl.SynAutoCorrectEditor.pas
index 8e2c9d91..b220f4ff 100644
--- a/Source/SynAutoCorrectEditor.pas
+++ b/Source/VCL/Vcl.SynAutoCorrectEditor.pas
@@ -28,7 +28,7 @@
-------------------------------------------------------------------------------}
-unit SynAutoCorrectEditor;
+unit Vcl.SynAutoCorrectEditor;
interface
@@ -36,7 +36,7 @@ interface
uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls,
- Buttons, Registry, SynAutoCorrect, SynUnicode, SysUtils, Classes;
+ Buttons, Registry, SynAutoCorrect, SynUnicodeShared, SysUtils, Classes;
type
TfrmAutoCorrectEditor = class(TForm)
diff --git a/Source/SynCompletionProposal.pas b/Source/VCL/Vcl.SynCompletionProposal.pas
similarity index 99%
rename from Source/SynCompletionProposal.pas
rename to Source/VCL/Vcl.SynCompletionProposal.pas
index d1d54804..5d744128 100644
--- a/Source/SynCompletionProposal.pas
+++ b/Source/VCL/Vcl.SynCompletionProposal.pas
@@ -30,7 +30,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynCompletionProposal;
+unit Vcl.SynCompletionProposal;
{$I SynEdit.inc}
@@ -51,7 +51,7 @@ interface
SynEditTypes,
SynEditKeyCmds,
SynEdit,
- SynUnicode;
+ SynUnicodeShared;
type
SynCompletionType = (ctCode, ctHint, ctParams);
@@ -558,7 +558,7 @@ implementation
System.UITypes,
SynEditTextBuffer,
SynEditMiscProcs,
- SynEditKeyConst;
+ SynEditKeyConstShared;
const
TextHeightString = 'CompletionProposal';
diff --git a/Source/SynDBEdit.pas b/Source/VCL/Vcl.SynDBEdit.pas
similarity index 99%
rename from Source/SynDBEdit.pas
rename to Source/VCL/Vcl.SynDBEdit.pas
index 78b4b0d6..bb86a145 100644
--- a/Source/SynDBEdit.pas
+++ b/Source/VCL/Vcl.SynDBEdit.pas
@@ -29,7 +29,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynDBEdit;
+unit Vcl.SynDBEdit;
{$I SynEdit.inc}
diff --git a/Source/SynDWrite.pas b/Source/VCL/Vcl.SynDWrite.pas
similarity index 99%
rename from Source/SynDWrite.pas
rename to Source/VCL/Vcl.SynDWrite.pas
index d332df91..3188ec2b 100644
--- a/Source/SynDWrite.pas
+++ b/Source/VCL/Vcl.SynDWrite.pas
@@ -1,4 +1,4 @@
-unit SynDWrite;
+unit Vcl.SynDWrite;
{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
@@ -1551,9 +1551,10 @@ implementation
System.Math,
System.Win.ComObj,
Vcl.Forms,
- SynUnicode,
+ SynUnicodeShared,
SynEditTypes,
- SynEditMiscProcs;
+ SynEditMiscProcs,
+ SynEditMiscClasses;
resourcestring
SYNS_FontFamilyNotFound = 'Font family name not found';
diff --git a/Source/SynEdit.pas b/Source/VCL/Vcl.SynEdit.pas
similarity index 98%
rename from Source/SynEdit.pas
rename to Source/VCL/Vcl.SynEdit.pas
index 6e9d2140..a1eb22e9 100644
--- a/Source/SynEdit.pas
+++ b/Source/VCL/Vcl.SynEdit.pas
@@ -30,7 +30,7 @@
//todo: Remove checks for WordWrap. Must abstract the behaviour with the plugins instead.
//todo: Move WordWrap glyph to the WordWrap plugin.
-unit SynEdit;
+unit Vcl.SynEdit;
{$I SynEdit.inc}
@@ -57,10 +57,12 @@ interface
Vcl.Dialogs,
Vcl.Themes,
System.UITypes,
- SynUnicode,
+ SynUnicodeShared,
SynEditTypes,
- SynEditKeyConst,
+ Vcl.SynEditScrollTypes,
+ SynEditKeyConstShared,
SynEditMiscProcs,
+ SynEditSelections,
SynEditMiscClasses,
SynEditTextBuffer,
SynDWrite,
@@ -537,6 +539,11 @@ TCustomSynEdit = class(TCustomControl)
State: TShiftState; MousePt: TPoint; var Effect: LongInt;
var Result: HResult); virtual;
procedure OleDragLeave(Sender: TObject; var Result: HResult); virtual;
+ /// Core drop logic extracted for testability.
+ /// OleDrop delegates here after extracting text from the IDataObject.
+ /// Returns True if the drop was performed, False if rejected.
+ function DropTextAtPos(const DropText: string; DropPos: TBufferCoord;
+ IsInternal, IsMove: Boolean): Boolean;
//-- Ole Drag & Drop
function GetReadOnly: Boolean; virtual;
procedure HighlighterAttrChanged(Sender: TObject);
@@ -1119,6 +1126,7 @@ implementation
Vcl.Consts,
Vcl.Clipbrd,
Vcl.IMouse,
+ Vcl.SynUnicode,
SynAccessibility,
SynEditScrollBars,
SynEditUndo,
@@ -1126,6 +1134,8 @@ implementation
SynEditStrConst,
SynEditDataObject,
SynEditDragDrop,
+ SynEditDragDropShared,
+ SynEditDragDropWin,
SynEditSearch;
{ TCustomSynEdit }
@@ -1248,14 +1258,8 @@ function TCustomSynEdit.PixelsToRowColumn(aX, aY: Integer): TDisplayCoord;
end;
function TCustomSynEdit.ColumnSelectionStart: TBufferCoord;
- // With eoScrollPastEol in an empty selection (Selection.Start = Selection.Stop)
- // Selection.Caret may be different to both, if it is past eol.
- // In that case prefer the Caret.
begin
- if Selections.BaseSelection.IsEmpty then
- Result := Selections.BaseSelection.Caret
- else
- Result := Selections.BaseSelection.Start;
+ Result := FSelections.ColumnSelectionStart;
end;
function TCustomSynEdit.ColumnToPixels(const S: string; Col: Integer): Integer;
@@ -4248,94 +4252,89 @@ procedure TCustomSynEdit.OleDrop(Sender: TObject; DataObject: IDataObject;
var Result: HResult);
var
vNewCaret: TBufferCoord;
- DoDrop, DropAfter, DropMove: Boolean;
- vBB, vBE: TBufferCoord;
DragDropText: string;
- ChangeScrollPastEOL: Boolean;
FormatEtc: TFormatEtc;
Medium: TStgMedium;
Pt: TPoint;
begin
Pt := ScreenToClient(MousePt);
- DropMove := Effect = DROPEFFECT_MOVE;
+
+ ComputeCaret(Pt.X, Pt.Y);
+ vNewCaret := CaretXY;
+
+ // Extract text from IDataObject
+ DragDropText := '';
+ with FormatEtc do begin
+ cfFormat := CF_UNICODETEXT;
+ dwAspect := DVASPECT_CONTENT;
+ ptd := nil;
+ tymed := TYMED_HGLOBAL;
+ lindex := -1;
+ end;
+ if DataObject.GetData(FormatEtc, Medium) = S_OK then begin
+ if Medium.hGlobal <> 0 then begin
+ DragDropText := PChar(GlobalLock(Medium.hGlobal));
+ GlobalUnLock(Medium.hGlobal);
+ end;
+ ReleaseStgMedium(Medium);
+ end;
+
+ if not DropTextAtPos(DragDropText, vNewCaret,
+ sfOleDragSource in fStateFlags, Effect = DROPEFFECT_MOVE) then
+ // Drop rejected (empty text, read-only, or drop inside selection)
+ Effect := DROPEFFECT_NONE
+ else if (sfOleDragSource in fStateFlags) and (Effect = DROPEFFECT_MOVE) then
+ // Internal move: signal OLE source not to delete (we already did)
+ Effect := DROPEFFECT_NONE;
+end;
+
+function TCustomSynEdit.DropTextAtPos(const DropText: string;
+ DropPos: TBufferCoord; IsInternal, IsMove: Boolean): Boolean;
+var
+ vBB, vBE: TBufferCoord;
+ DropInfo: TSynDropInfo;
+ ChangeScrollPastEOL: Boolean;
+begin
+ Result := False;
+ if (DropText = '') or ReadOnly then
+ Exit;
BeginUpdate;
try
- ComputeCaret(Pt.X, Pt.Y);
- vNewCaret := CaretXY;
- if not (sfOleDragSource in fStateFlags) then
- begin
- DoDrop := True;
- DropAfter := False;
- end
- else
- begin
- // Internal dragging
- vBB := BlockBegin;
- vBE := BlockEnd;
- DropAfter := (vNewCaret.Line > vBE.Line)
- or ((vNewCaret.Line = vBE.Line) and ((vNewCaret.Char > vBE.Char) or
- ((not DropMove) and (vNewCaret.Char = vBE.Char))));
- DoDrop := DropAfter or (vNewCaret.Line < vBB.Line)
- or ((vNewCaret.Line = vBB.Line) and ((vNewCaret.Char < vBB.Char) or
- ((not DropMove) and (vNewCaret.Char = vBB.Char))));
- end;
-
- if DoDrop then begin
- with FormatEtc do begin
- cfFormat := CF_UNICODETEXT;
- dwAspect := DVASPECT_CONTENT;
- ptd := nil;
- tymed := TYMED_HGLOBAL;
- lindex := -1;
- end;
- if DataObject.GetData(FormatEtc, Medium) = S_OK then begin
- if Medium.hGlobal <> 0 then begin
- DragDropText := PChar(GlobalLock(Medium.hGlobal));
- GlobalUnLock(Medium.hGlobal);
- DoDrop := DragDropText <> '';
- end else
- DoDrop := False;
- ReleaseStgMedium(Medium);
- end else
- DoDrop := False;
- end;
+ vBB := BlockBegin;
+ vBE := BlockEnd;
- if DoDrop then begin
- BeginUndoBlock;
+ DropInfo := TSynDragDropHelper.ComputeDropInfo(DropPos, vBB, vBE,
+ IsInternal, IsMove);
+
+ if not DropInfo.DoDrop then
+ Exit;
+
+ Result := True;
+ BeginUndoBlock;
+ try
+ // delete the selected text if necessary
+ if IsMove and IsInternal then
+ begin
+ SelText := '';
+ DropPos := TSynDragDropHelper.AdjustDropPos(
+ DropPos, vBB, vBE, DropInfo.DropAfter);
+ end;
+ // insert the selected text
+ ChangeScrollPastEOL := not (eoScrollPastEol in fScrollOptions);
try
- // delete the selected text if necessary
- if DropMove then
- begin
- if sfOleDragSource in fStateFlags then begin
- // Internal dragging
- Effect := DROPEFFECT_NONE; // do not clear selection after drop
- SelText := '';
- // adjust horizontal drop position
- if DropAfter and (vNewCaret.Line = vBE.Line) then
- Dec(vNewCaret.Char, vBE.Char - vBB.Char);
- // adjust vertical drop position
- if DropAfter and (vBE.Line > vBB.Line) then
- Dec(vNewCaret.Line, vBE.Line - vBB.Line);
- end;
- end;
- // insert the selected text
- ChangeScrollPastEOL := not (eoScrollPastEol in fScrollOptions);
- try
- if ChangeScrollPastEOL then
- Include(fScrollOptions, eoScrollPastEol);
- CaretXY := vNewCaret;
- SelText := DragDropText; // creates undo action
- finally
- if ChangeScrollPastEOL then
- Exclude(fScrollOptions, eoScrollPastEol);
- end;
- SetCaretAndSelection(CaretXY, vNewCaret, CaretXY);
+ if ChangeScrollPastEOL then
+ Include(fScrollOptions, eoScrollPastEol);
+ CaretXY := DropPos;
+ SelText := DropText;
finally
- EndUndoBlock;
+ if ChangeScrollPastEOL then
+ Exclude(fScrollOptions, eoScrollPastEol);
end;
- end else
- Effect := DROPEFFECT_NONE;
+ SetCaretAndSelection(CaretXY, DropPos, CaretXY);
+ finally
+ EndUndoBlock;
+ end;
finally
EndUpdate;
end;
@@ -7005,8 +7004,6 @@ procedure TCustomSynEdit.ExecuteCommand(Command: TSynEditorCommand; AChar: WideC
procedure TCustomSynEdit.ExecuteMultiCaretCommand(Command: TSynEditorCommand;
AChar: WideChar; Data: Pointer; CommandInfo: TSynCommandInfo);
var
- OldActiveSelIndex: Integer;
- I: Integer;
OldTopLine, OldLeftChar: Integer;
begin
DoOnPaintTransient(ttBefore);
@@ -7018,26 +7015,15 @@ procedure TCustomSynEdit.ExecuteMultiCaretCommand(Command: TSynEditorCommand;
BeginUndoBlock;
end;
- OldActiveSelIndex := Selections.ActiveSelIndex;
OldLeftChar := LeftChar;
OldTopLine := TopLine;
- for I := 0 to FSelections.Count -1 do
- begin
- // Make the current selection active
- Selections.ActiveSelIndex := I;
-
- if not FSelection.IsValid then Continue;
-
- ExecuteCommand(Command, AChar, Data);
- Selections.ActiveSelection := FSelection;
- end;
-
- // Restore Active Selection
- Selections.ActiveSelIndex := OldActiveSelIndex;
-
- // Merge Selections
- FSelections.Merge;
+ FSelections.ForEachSelection(
+ procedure(Sel: TSynSelection)
+ begin
+ ExecuteCommand(Command, AChar, Data);
+ Selections.ActiveSelection := FSelection;
+ end);
TopLine := OldTopLine;
LeftChar := OldLeftChar;
diff --git a/Source/SynEditActionsResource.dfm b/Source/VCL/Vcl.SynEditActionsResource.dfm
similarity index 100%
rename from Source/SynEditActionsResource.dfm
rename to Source/VCL/Vcl.SynEditActionsResource.dfm
diff --git a/Source/SynEditActionsResource.pas b/Source/VCL/Vcl.SynEditActionsResource.pas
similarity index 96%
rename from Source/SynEditActionsResource.pas
rename to Source/VCL/Vcl.SynEditActionsResource.pas
index db22379c..021d05e1 100644
--- a/Source/SynEditActionsResource.pas
+++ b/Source/VCL/Vcl.SynEditActionsResource.pas
@@ -1,4 +1,4 @@
-unit SynEditActionsResource;
+unit Vcl.SynEditActionsResource;
interface
diff --git a/Source/SynEditDataObject.pas b/Source/VCL/Vcl.SynEditDataObject.pas
similarity index 63%
rename from Source/SynEditDataObject.pas
rename to Source/VCL/Vcl.SynEditDataObject.pas
index d8d83e03..e88433c5 100644
--- a/Source/SynEditDataObject.pas
+++ b/Source/VCL/Vcl.SynEditDataObject.pas
@@ -1,4 +1,4 @@
-unit SynEditDataObject;
+unit Vcl.SynEditDataObject;
{
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
@@ -34,24 +34,12 @@ interface
Winapi.ActiveX,
System.SysUtils,
System.Classes,
- System.Generics.Collections;
+ System.Generics.Collections,
+ SynEditDragDropWin;
Type
-
- TSynEnumFormatEtc = class (TInterfacedObject, IEnumFORMATETC)
- private
- FList: TArray;
- FIndex: Integer;
- protected
- function GetFormatEtc(ClipFormat: TClipFormat): TFormatEtc;
- {IEnumFORMATETC}
- function Next (celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall;
- function Skip (celt: Longint): HResult; stdcall;
- function Reset: HResult; stdcall;
- function Clone (out Enum: IEnumFormatEtc): HResult; stdcall;
- public
- constructor Create (FormatList: TArray; Index: Integer = 0);
- end;
+ // Re-export shared type (API contract preserved)
+ TSynEnumFormatEtc = SynEditDragDropWin.TSynEnumFormatEtc;
TSynEditDataObject = class (TInterfacedObject, IDataObject)
private
@@ -75,89 +63,45 @@ TSynEditDataObject = class (TInterfacedObject, IDataObject)
destructor Destroy; override;
end;
-function MakeGlobal (const S: string): hGlobal; overload;
-function MakeGlobal (var P; Size: Integer): hGlobal; overload;
+// Re-export shared functions (API contract preserved)
+function MakeGlobal(const S: string): HGLOBAL; overload;
+function MakeGlobal(var P; Size: Integer): HGLOBAL; overload;
function HasFormat(DataObject: IDataObject; Format: TClipFormat): Boolean;
function GetInternalClipText: TArray;
+// Re-export shared constant (API contract preserved)
const
- IntClipFormatDelimiter = #$EEFF; // from private unicode area
+ IntClipFormatDelimiter = SynEditDragDropWin.IntClipFormatDelimiter;
-var
- SynEditClipboardFormat: UINT;
- HTMLClipboardFormat: UINT;
+// Note: SynEditClipboardFormat and HTMLClipboardFormat vars are accessible
+// directly via the SynEditDragDropWin unit (which is in the interface uses).
implementation
uses
- Vcl.Clipbrd,
SynEdit,
SynEditTypes,
SynExportHTML;
-function MakeGlobal (const S: string): hGlobal;
-var
- P: PChar;
- Size: Integer;
+// Re-export thin wrappers that delegate to shared unit
+function MakeGlobal(const S: string): HGLOBAL;
begin
- Size := ByteLength(S) + SizeOf(Char);
- Result := GlobalAlloc (GHND, Size);
- if Result = 0 then
- OutOfMemoryError;
- P := GlobalLock (Result);
- try
- Move(PChar(S)^, P^, Size)
- finally
- GlobalUnlock (Result)
- end
+ Result := SynEditDragDropWin.MakeGlobal(S);
end;
-function MakeGlobal (var P; Size: Integer): hGlobal;
-var
- D: pointer;
+function MakeGlobal(var P; Size: Integer): HGLOBAL;
begin
- Result := GlobalAlloc (GHND, Size);
- if Result = 0 then
- OutOfMemoryError;
- D := GlobalLock (Result);
- try
- Move (P, D^, Size)
- finally
- GlobalUnlock (Result)
- end
+ Result := SynEditDragDropWin.MakeGlobal(P, Size);
end;
-function HasFormat(DataObject: IDataObject; Format: TClipFormat):Boolean;
-var
- FormatEnumerator: IEnumFormatEtc;
- FormatEtc: TFormatEtc;
- Returned: Integer;
+function HasFormat(DataObject: IDataObject; Format: TClipFormat): Boolean;
begin
- Result := False;
- if (DataObject.EnumFormatEtc (DATADIR_GET, FormatEnumerator) = S_OK) then begin
- FormatEnumerator.Reset;
- while FormatEnumerator.Next (1, FormatEtc, @Returned) = S_OK do
- if FormatEtc.cfFormat = Format then
- Exit(True);
- end;
+ Result := SynEditDragDropWin.HasFormat(DataObject, Format);
end;
function GetInternalClipText: TArray;
-var
- Data: THandle;
- TempS: string;
begin
- Result := [];
- if not Clipboard.HasFormat(SynEditClipboardFormat) then Exit;
- Data := Clipboard.GetAsHandle(SynEditClipboardFormat);
-
- if Data <> 0 then
- try
- TempS := PChar(GlobalLock(Data));
- Result := TempS.Split([IntClipFormatDelimiter]);
- finally
- GlobalUnlock(Data);
- end;
+ Result := SynEditDragDropWin.GetInternalClipText;
end;
@@ -225,11 +169,11 @@ function TSynEditDataObject.GetData (const formatetcIn: TFormatEtc; out medium:
try
Medium.tymed := TYMED_HGLOBAL;
if FormatEtcIn.cfFormat = CF_UNICODETEXT then
- Medium.hGlobal := MakeGlobal(FText)
+ Medium.hGlobal := SynEditDragDropWin.MakeGlobal(FText)
else if FormatEtcIn.cfFormat = SynEditClipboardFormat then
- Medium.hGlobal := MakeGlobal(FInternalText)
+ Medium.hGlobal := SynEditDragDropWin.MakeGlobal(FInternalText)
else if (FormatEtcIn.cfFormat = HTMLClipboardFormat) then
- Medium.hGlobal := MakeGlobal(HtmlStream.Memory^, HtmlStream.Position);
+ Medium.hGlobal := SynEditDragDropWin.MakeGlobal(HtmlStream.Memory^, HtmlStream.Position);
except
Result := E_UNEXPECTED;
end
@@ -294,7 +238,7 @@ function TSynEditDataObject.EnumFormatEtc (dwDirection: Longint; out enumFormatE
try
if dwDirection = DATADIR_GET then
begin
- EnumFormatEtc := TSynEnumFormatEtc.Create(FFormatEtc.ToArray);
+ EnumFormatEtc := SynEditDragDropWin.TSynEnumFormatEtc.Create(FFormatEtc.ToArray);
Result := S_OK
end else
Result := E_NOTIMPL;
@@ -319,82 +263,4 @@ function TSynEditDataObject.EnumDAdvise (out enumAdvise: IEnumStatData): HResult
end;
-//=== BASE ENUM FORMATETC CLASS ================================================
-
-constructor TSynEnumFormatEtc.Create(FormatList: TArray;
- Index: Integer);
-begin
- inherited Create;
- FList := FormatList;
- FIndex := Index;
-end;
-
-function TSynEnumFormatEtc.GetFormatEtc(ClipFormat: TClipFormat): TFormatEtc;
-begin
- with Result do
- begin
- cfFormat := ClipFormat;
- dwAspect := DVASPECT_CONTENT;
- ptd := nil;
- tymed := TYMED_HGLOBAL;
- lindex := -1;
- end;
-end;
-
-function TSynEnumFormatEtc.Next (celt: Longint; out elt; pceltFetched: PLongint): HResult;
-var
- I: Integer;
- FormatEtc: PFormatEtc;
-begin
- I := 0;
- FormatEtc:= PFormatEtc(@Elt);
- while (I < Celt) and (FIndex < Length(FList)) do
- begin
- FormatEtc^ := GetFormatEtc(FList[FIndex]);
- Inc(FormatEtc);
- Inc (FIndex);
- Inc (I)
- end;
-
- if (pCeltFetched <> nil) then pCeltFetched^:= i;
-
- if (I = Celt) then
- Result:= S_OK
- else
- Result:= S_FALSE;
-end;
-
-function TSynEnumFormatEtc.Skip (celt: Longint): HResult;
-begin
- Result := S_OK;
- if Celt <= Length(FList) - FIndex then
- FIndex := FIndex + Celt
- else begin
- FIndex := Length(FList);
- Result := S_FALSE
- end
-end;
-
-function TSynEnumFormatEtc.Reset: HResult;
-begin
- FIndex := 0;
- Result := S_OK;
-end;
-
-function TSynEnumFormatEtc.Clone (out Enum: IEnumFormatEtc): HResult;
-begin
- Result := S_OK;
- Enum := TSynEnumFormatEtc.Create (FList, FIndex);
-end;
-
-
-const
- CF_HTML = 'HTML Format';
-initialization
- OleInitialize(nil);
- SynEditClipboardFormat := RegisterClipboardFormat ('Internal SynEdit clipboard format');
- HTMLClipboardFormat := RegisterClipboardFormat(CF_HTML);
-finalization
- OleFlushClipboard;
- OleUninitialize;
end.
diff --git a/Source/SynEditDragDrop.pas b/Source/VCL/Vcl.SynEditDragDrop.pas
similarity index 76%
rename from Source/SynEditDragDrop.pas
rename to Source/VCL/Vcl.SynEditDragDrop.pas
index 384ffa62..b386f220 100644
--- a/Source/SynEditDragDrop.pas
+++ b/Source/VCL/Vcl.SynEditDragDrop.pas
@@ -1,4 +1,4 @@
-unit SynEditDragDrop;
+unit Vcl.SynEditDragDrop;
{
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
@@ -29,18 +29,21 @@
interface
Uses
- Windows, ActiveX, SysUtils, Classes, Messages, Controls, Forms, ExtCtrls;
+ Windows, ActiveX, SysUtils, Classes, Messages, Controls, Forms, ExtCtrls,
+ SynEditDragDropWin;
-
-// Drop effects as Delphi style constants (originals in ActiveX)
+// Re-export shared drop effect constants (API contract preserved)
const
- deNone = DROPEFFECT_NONE;
- deMove = DROPEFFECT_MOVE;
- deCopy = DROPEFFECT_COPY;
- deLink = DROPEFFECT_LINK;
- deScroll = DROPEFFECT_SCROLL;
+ deNone = SynEditDragDropWin.deNone;
+ deMove = SynEditDragDropWin.deMove;
+ deCopy = SynEditDragDropWin.deCopy;
+ deLink = SynEditDragDropWin.deLink;
+ deScroll = SynEditDragDropWin.deScroll;
type
+ // Re-export shared type (API contract preserved)
+ TSynDragSource = SynEditDragDropWin.TSynDragSource;
+
TOnDragEvent = procedure(Sender: TObject; DataObject: IDataObject; State: TShiftState; MousePt: TPoint; var Effect: LongInt; var Result: HResult) of object;
TOnDragOverEvent = procedure(Sender: TObject; State: TShiftState; MousePt: TPoint; var Effect: LongInt; var Result: HResult) of object;
TOnDragLeaveEvent = procedure(Sender: TObject; var Result: HResult) of Object;
@@ -69,31 +72,8 @@ TSynDropTarget = class(TInterfacedObject, IDropTarget)
property OnDrop: TOnDragEvent read FOnDrop write FOnDrop;
end;
- // Implementation of the IDropSource interface
- TSynDragSource = class(TInterfacedObject, IDropSource)
- private
- // Called routinely by Windows to check that drag operations are to continue. See the
- // implementation below of QueryContinueDrag method for the default operation.
- function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; overload; stdcall;
- // Called routinely to modify the displayed cursor.
- function GiveFeedback(dwEffect: Longint): HResult; stdcall;
- end;
-
implementation
-//--- returns the normal response for a wanted effect:
-// no keys = "move"
-// control only = "copy"
-// control/shift = "link" - ignored in this case
-function StandardEffect(Keys: TShiftState): Integer;
-begin
- Result := deMove;
- if ssCtrl in Keys then
- begin
- Result := deCopy;
- end
-end;
-
{ TDropTarget }
function TSynDropTarget.DragEnter(const DataObj: IDataObject;
@@ -169,22 +149,5 @@ procedure TSynDropTarget.Drop(DataObject: IDataObject; State: TShiftState;
FOnDrop(Self, DataObject, State, Pt, Effect, Result)
end;
-//=== DRAG SOURCE CLASS ===================================================
-
-function TSynDragSource.QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult;
-begin
- if fEscapePressed then // cancel the drop
- Result := DRAGDROP_S_CANCEL
- else if(grfKeyState and MK_LBUTTON) = 0 then
- Result := DRAGDROP_S_DROP // drop has occurred
- else
- Result := S_OK;
-end;
-
-function TSynDragSource.GiveFeedback(dwEffect: Longint): HResult;
-begin
- Result := DRAGDROP_S_USEDEFAULTCURSORS;
-end;
-
end.
diff --git a/Source/SynEditExport.pas b/Source/VCL/Vcl.SynEditExport.pas
similarity index 99%
rename from Source/SynEditExport.pas
rename to Source/VCL/Vcl.SynEditExport.pas
index bec1a4a1..397e91ab 100644
--- a/Source/SynEditExport.pas
+++ b/Source/VCL/Vcl.SynEditExport.pas
@@ -15,7 +15,7 @@
Author of this file is Michael Hieke.
Portions created by Michael Hieke are Copyright 2000 Michael Hieke.
Portions created by James D. Jacobson are Copyright 1999 Martin Waldenburg.
-Unicode translation by Mal Hrz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit project are listed in the Contributors.txt file.
@@ -34,7 +34,7 @@
{ Base class for exporting a programming language source file or part of it to
a formatted output like HTML or RTF and copying this to the Windows clipboard
or saving it to a file. }
-unit SynEditExport;
+unit Vcl.SynEditExport;
{$I SynEdit.inc}
@@ -46,7 +46,7 @@ interface
Clipbrd,
SynEditHighlighter,
SynEditTypes,
- SynUnicode,
+ SynUnicodeShared,
Classes,
SysUtils;
@@ -202,6 +202,7 @@ implementation
uses
Math,
SynEditMiscProcs,
+ SynEditMiscClasses,
SynEditStrConst;
{ TSynCustomExporter }
diff --git a/Source/SynEditKbdHandler.pas b/Source/VCL/Vcl.SynEditKbdHandler.pas
similarity index 99%
rename from Source/SynEditKbdHandler.pas
rename to Source/VCL/Vcl.SynEditKbdHandler.pas
index 60e0135c..e05fac10 100644
--- a/Source/SynEditKbdHandler.pas
+++ b/Source/VCL/Vcl.SynEditKbdHandler.pas
@@ -29,7 +29,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditKbdHandler;
+unit Vcl.SynEditKbdHandler;
{$I SynEdit.inc}
diff --git a/Source/SynEditKeyCmdEditor.dfm b/Source/VCL/Vcl.SynEditKeyCmdEditor.dfm
similarity index 100%
rename from Source/SynEditKeyCmdEditor.dfm
rename to Source/VCL/Vcl.SynEditKeyCmdEditor.dfm
diff --git a/Source/SynEditKeyCmdEditor.pas b/Source/VCL/Vcl.SynEditKeyCmdEditor.pas
similarity index 99%
rename from Source/SynEditKeyCmdEditor.pas
rename to Source/VCL/Vcl.SynEditKeyCmdEditor.pas
index b9f10962..f5f615fc 100644
--- a/Source/SynEditKeyCmdEditor.pas
+++ b/Source/VCL/Vcl.SynEditKeyCmdEditor.pas
@@ -30,7 +30,7 @@
Known Issues:
-------------------------------------------------------------------------------}
-unit SynEditKeyCmdEditor;
+unit Vcl.SynEditKeyCmdEditor;
{$I SynEdit.inc}
diff --git a/Source/SynEditKeyCmdsEditor.dfm b/Source/VCL/Vcl.SynEditKeyCmdsEditor.dfm
similarity index 100%
rename from Source/SynEditKeyCmdsEditor.dfm
rename to Source/VCL/Vcl.SynEditKeyCmdsEditor.dfm
diff --git a/Source/SynEditKeyCmdsEditor.pas b/Source/VCL/Vcl.SynEditKeyCmdsEditor.pas
similarity index 99%
rename from Source/SynEditKeyCmdsEditor.pas
rename to Source/VCL/Vcl.SynEditKeyCmdsEditor.pas
index b83cd1c9..ce42fe6b 100644
--- a/Source/SynEditKeyCmdsEditor.pas
+++ b/Source/VCL/Vcl.SynEditKeyCmdsEditor.pas
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditKeyCmdsEditor;
+unit Vcl.SynEditKeyCmdsEditor;
{$I SynEdit.inc}
diff --git a/Source/VCL/Vcl.SynEditKeyConst.pas b/Source/VCL/Vcl.SynEditKeyConst.pas
new file mode 100644
index 00000000..977dfd6b
--- /dev/null
+++ b/Source/VCL/Vcl.SynEditKeyConst.pas
@@ -0,0 +1,114 @@
+{-------------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: SynEditKeyCmds.pas, released 2000-04-07.
+The Original Code is based on the mwKeyCmds.pas file from the
+mwEdit component suite by Martin Waldenburg and other developers, the Initial
+Author of this file is Brad Stowers.
+All Rights Reserved.
+
+Contributors to the SynEdit and mwEdit projects are listed in the
+Contributors.txt file.
+
+Alternatively, the contents of this file may be used under the terms of the
+GNU General Public License Version 2 or later (the "GPL"), in which case
+the provisions of the GPL are applicable instead of those above.
+If you wish to allow use of your version of this file only under the terms
+of the GPL and not to allow others to use your version of this file
+under the MPL, indicate your decision by deleting the provisions above and
+replace them with the notice and other provisions required by the GPL.
+If you do not delete the provisions above, a recipient may use your version
+of this file under either the MPL or the GPL.
+-------------------------------------------------------------------------------}
+
+unit Vcl.SynEditKeyConst;
+
+{ VCL key-constant facade. Re-exports every constant from
+ SynEditKeyConstShared so that VCL code using 'Vcl.SynEditKeyConst'
+ continues to compile unchanged. The actual definitions live in the
+ shared unit; this wrapper exists only to keep the Vcl.* namespace
+ populated for discoverability and IDE code-completion. }
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ SynEditKeyConstShared;
+
+const
+ SYNEDIT_RETURN = SynEditKeyConstShared.SYNEDIT_RETURN;
+ SYNEDIT_ESCAPE = SynEditKeyConstShared.SYNEDIT_ESCAPE;
+ SYNEDIT_SPACE = SynEditKeyConstShared.SYNEDIT_SPACE;
+ SYNEDIT_PRIOR = SynEditKeyConstShared.SYNEDIT_PRIOR;
+ SYNEDIT_NEXT = SynEditKeyConstShared.SYNEDIT_NEXT;
+ SYNEDIT_END = SynEditKeyConstShared.SYNEDIT_END;
+ SYNEDIT_HOME = SynEditKeyConstShared.SYNEDIT_HOME;
+ SYNEDIT_UP = SynEditKeyConstShared.SYNEDIT_UP;
+ SYNEDIT_DOWN = SynEditKeyConstShared.SYNEDIT_DOWN;
+ SYNEDIT_BACK = SynEditKeyConstShared.SYNEDIT_BACK;
+ SYNEDIT_LEFT = SynEditKeyConstShared.SYNEDIT_LEFT;
+ SYNEDIT_RIGHT = SynEditKeyConstShared.SYNEDIT_RIGHT;
+ SYNEDIT_MENU = SynEditKeyConstShared.SYNEDIT_MENU;
+ SYNEDIT_CONTROL = SynEditKeyConstShared.SYNEDIT_CONTROL;
+ SYNEDIT_SHIFT = SynEditKeyConstShared.SYNEDIT_SHIFT;
+ SYNEDIT_F1 = SynEditKeyConstShared.SYNEDIT_F1;
+ SYNEDIT_F2 = SynEditKeyConstShared.SYNEDIT_F2;
+ SYNEDIT_F3 = SynEditKeyConstShared.SYNEDIT_F3;
+ SYNEDIT_F4 = SynEditKeyConstShared.SYNEDIT_F4;
+ SYNEDIT_F5 = SynEditKeyConstShared.SYNEDIT_F5;
+ SYNEDIT_F6 = SynEditKeyConstShared.SYNEDIT_F6;
+ SYNEDIT_F7 = SynEditKeyConstShared.SYNEDIT_F7;
+ SYNEDIT_F8 = SynEditKeyConstShared.SYNEDIT_F8;
+ SYNEDIT_F9 = SynEditKeyConstShared.SYNEDIT_F9;
+ SYNEDIT_F10 = SynEditKeyConstShared.SYNEDIT_F10;
+ SYNEDIT_F11 = SynEditKeyConstShared.SYNEDIT_F11;
+ SYNEDIT_F12 = SynEditKeyConstShared.SYNEDIT_F12;
+ SYNEDIT_F13 = SynEditKeyConstShared.SYNEDIT_F13;
+ SYNEDIT_F14 = SynEditKeyConstShared.SYNEDIT_F14;
+ SYNEDIT_F15 = SynEditKeyConstShared.SYNEDIT_F15;
+ SYNEDIT_F16 = SynEditKeyConstShared.SYNEDIT_F16;
+ SYNEDIT_F17 = SynEditKeyConstShared.SYNEDIT_F17;
+ SYNEDIT_F18 = SynEditKeyConstShared.SYNEDIT_F18;
+ SYNEDIT_F19 = SynEditKeyConstShared.SYNEDIT_F19;
+ SYNEDIT_F20 = SynEditKeyConstShared.SYNEDIT_F20;
+ SYNEDIT_F21 = SynEditKeyConstShared.SYNEDIT_F21;
+ SYNEDIT_F22 = SynEditKeyConstShared.SYNEDIT_F22;
+ SYNEDIT_F23 = SynEditKeyConstShared.SYNEDIT_F23;
+ SYNEDIT_F24 = SynEditKeyConstShared.SYNEDIT_F24;
+ SYNEDIT_PRINT = SynEditKeyConstShared.SYNEDIT_PRINT;
+ SYNEDIT_INSERT = SynEditKeyConstShared.SYNEDIT_INSERT;
+ SYNEDIT_DELETE = SynEditKeyConstShared.SYNEDIT_DELETE;
+ SYNEDIT_NUMPAD0 = SynEditKeyConstShared.SYNEDIT_NUMPAD0;
+ SYNEDIT_NUMPAD1 = SynEditKeyConstShared.SYNEDIT_NUMPAD1;
+ SYNEDIT_NUMPAD2 = SynEditKeyConstShared.SYNEDIT_NUMPAD2;
+ SYNEDIT_NUMPAD3 = SynEditKeyConstShared.SYNEDIT_NUMPAD3;
+ SYNEDIT_NUMPAD4 = SynEditKeyConstShared.SYNEDIT_NUMPAD4;
+ SYNEDIT_NUMPAD5 = SynEditKeyConstShared.SYNEDIT_NUMPAD5;
+ SYNEDIT_NUMPAD6 = SynEditKeyConstShared.SYNEDIT_NUMPAD6;
+ SYNEDIT_NUMPAD7 = SynEditKeyConstShared.SYNEDIT_NUMPAD7;
+ SYNEDIT_NUMPAD8 = SynEditKeyConstShared.SYNEDIT_NUMPAD8;
+ SYNEDIT_NUMPAD9 = SynEditKeyConstShared.SYNEDIT_NUMPAD9;
+ SYNEDIT_MULTIPLY = SynEditKeyConstShared.SYNEDIT_MULTIPLY;
+ SYNEDIT_ADD = SynEditKeyConstShared.SYNEDIT_ADD;
+ SYNEDIT_SEPARATOR = SynEditKeyConstShared.SYNEDIT_SEPARATOR;
+ SYNEDIT_SUBTRACT = SynEditKeyConstShared.SYNEDIT_SUBTRACT;
+ SYNEDIT_DECIMAL = SynEditKeyConstShared.SYNEDIT_DECIMAL;
+ SYNEDIT_DIVIDE = SynEditKeyConstShared.SYNEDIT_DIVIDE;
+ SYNEDIT_NUMLOCK = SynEditKeyConstShared.SYNEDIT_NUMLOCK;
+ SYNEDIT_SCROLL = SynEditKeyConstShared.SYNEDIT_SCROLL;
+ SYNEDIT_TAB = SynEditKeyConstShared.SYNEDIT_TAB;
+ SYNEDIT_CLEAR = SynEditKeyConstShared.SYNEDIT_CLEAR;
+ SYNEDIT_PAUSE = SynEditKeyConstShared.SYNEDIT_PAUSE;
+ SYNEDIT_CAPITAL = SynEditKeyConstShared.SYNEDIT_CAPITAL;
+
+implementation
+
+end.
diff --git a/Source/SynEditMiscClasses.pas b/Source/VCL/Vcl.SynEditMiscClasses.pas
similarity index 80%
rename from Source/SynEditMiscClasses.pas
rename to Source/VCL/Vcl.SynEditMiscClasses.pas
index 633c30f0..13a05900 100644
--- a/Source/SynEditMiscClasses.pas
+++ b/Source/VCL/Vcl.SynEditMiscClasses.pas
@@ -12,7 +12,7 @@
The Original Code is based on the mwSupportClasses.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Michael Hieke.
- Unicode translation by Mal Hrz.
+ Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
@@ -29,7 +29,7 @@
of this file under either the MPL or the GPL.
------------------------------------------------------------------------------- }
-unit SynEditMiscClasses;
+unit Vcl.SynEditMiscClasses;
{$I SynEdit.inc}
@@ -57,34 +57,14 @@ interface
Vcl.StdActns,
SynDWrite,
SynEditTypes,
+ SynEditSelections,
SynEditKeyCmds,
- SynEditKeyConst,
- SynUnicode;
+ SynEditKeyConstShared,
+ SynUnicodeShared;
type
{$REGION 'Selected Color'}
- TSynSelectedColor = class(TPersistent)
- private
- FBG: TColor;
- FFG: TColor;
- FOnChange: TNotifyEvent;
- FOpacity: Byte;
- FFillWholeLines: Boolean;
- procedure SetBG(Value: TColor);
- procedure SetFG(Value: TColor);
- procedure SetOpacity(Value: Byte);
- procedure SetFillWholeLines(const Value: Boolean);
- public
- constructor Create;
- procedure Assign(Source: TPersistent); override;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- published
- property Background: TColor read FBG write SetBG default clHighLight;
- property Foreground: TColor read FFG write SetFG default clHighLightText;
- property Opacity: Byte read FOpacity write SetOpacity default 115;
- property FillWholeLines: Boolean read FFillWholeLines write SetFillWholeLines
- default True;
- end;
+ TSynSelectedColor = SynEditTypes.TSynSelectedColor;
{$ENDREGION 'Selected Color'}
{$REGION 'Indentation Guides'}
@@ -469,48 +449,6 @@ TSynGlyph = class(TPersistent)
{$ENDREGION 'TSynGlyph'}
- {$REGION 'Multicast events'}
-
- { TSynMethodChain }
-
- ESynMethodChain = class(Exception);
- TSynExceptionEvent = procedure(Sender: TObject; E: Exception;
- var DoContinue: Boolean) of object;
-
- TSynMethodChain = class(TObject)
- private
- FNotifyProcs: TList;
- FExceptionHandler: TSynExceptionEvent;
- protected
- procedure DoFire(const AEvent: TMethod); virtual; abstract;
- function DoHandleException(E: Exception): Boolean; virtual;
- property ExceptionHandler: TSynExceptionEvent read FExceptionHandler
- write FExceptionHandler;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- procedure Add(AEvent: TMethod);
- procedure Remove(AEvent: TMethod);
- procedure Fire;
- end;
-
- { TSynNotifyEventChain }
-
- TSynNotifyEventChain = class(TSynMethodChain)
- private
- FSender: TObject;
- protected
- procedure DoFire(const AEvent: TMethod); override;
- public
- constructor CreateEx(ASender: TObject);
- procedure Add(AEvent: TNotifyEvent);
- procedure Remove(AEvent: TNotifyEvent);
- property ExceptionHandler;
- property Sender: TObject read FSender write FSender;
- end;
-
- {$ENDREGION 'Multicast events'}
-
{$REGION 'TSynInternalImage'}
{ TSynInternalImage }
@@ -588,39 +526,6 @@ TSynHotKey = class(TCustomControl)
end;
{$ENDREGION 'TSynHotKey'}
- {$REGION 'TSynEditSearchCustom'}
-
- TSynIsWordBreakFunction = function(C: WideChar): Boolean of object;
-
- TSynEditSearchCustom = class(TComponent)
- protected
- FIsWordBreakFunction: TSynIsWordBreakFunction;
- function GetPattern: string; virtual; abstract;
- procedure SetPattern(const Value: string); virtual; abstract;
- function GetLength(Index: Integer): Integer; virtual; abstract;
- function GetResult(Index: Integer): Integer; virtual; abstract;
- function GetResultCount: Integer; virtual; abstract;
- procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
- public
- // This is the main public routine of search engines.
- // Given a NewText (typically a line) it calculates all matches from
- // StartChar to EndChar. The matches are stored left-to right.
- // EndChar = 0 is equivalent to EndChar = Length(NewText) + 1
- function FindAll(const NewText: string; StartChar: Integer = 1;
- EndChar: Integer = 0): Integer; virtual; abstract;
- function PreprocessReplaceExpression(const AReplace: string): string; virtual;
- function Replace(const aOccurrence, aReplacement: string): string;
- virtual; abstract;
- property Pattern: string read GetPattern write SetPattern;
- property ResultCount: Integer read GetResultCount;
- property Results[Index: Integer]: Integer read GetResult;
- property Lengths[Index: Integer]: Integer read GetLength;
- property Options: TSynSearchOptions write SetOptions;
- property IsWordBreakFunction: TSynIsWordBreakFunction write FIsWordBreakFunction;
- end;
-
- {$ENDREGION 'TSynEditSearchCustom'}
-
{$REGION 'Indicators'}
TSynIndicatorStyle = (sisTextDecoration, sisSquiggleMicrosoftWord,
@@ -733,67 +638,24 @@ TSynCarets = class
{$REGION 'TSynSelections'}
- TSynSelStorage = record
- Selections: TArray;
- BaseIndex, ActiveIndex :Integer;
- procedure Clear;
- end;
-
- // Keeps the selections and is responsible for showing the carets
- TSynSelections = class
- private
- FOwner: TPersistent;
- FSelections: TList;
- FBaseSelIndex: Integer;
- FActiveSelIndex: Integer;
- function GetCount: Integer;
- function GetActiveSelection: TSynSelection;
- function GetBaseSelection: TSynSelection;
- procedure SetActiveSelection(const Value: TSynSelection);
- procedure SetBaseSelection(const Value: TSynSelection);
- function GetSelection(Index: Integer): TSynSelection;
- procedure SetActiveSelIndex(const Index: Integer);
- procedure CaretsChanged;
- function GetIsEmpty: Boolean;
+ // TSynSelStorage and TSynSelectionsBase are now in shared SynEditSelections.pas
+ // TSynSelections inherits all logic from TSynSelectionsBase and provides
+ // thin VCL-specific overrides.
+ TSynSelections = class(TSynSelectionsBase)
+ protected
+ procedure CaretsChanged; override;
+ procedure DoInvalidateSelection(const Sel: TSynSelection); override;
+ procedure DoRestoreSelection(const Sel: TSynSelection;
+ EnsureVisible: Boolean); override;
+ function GetLineText(ALine: Integer): string; override;
+ function GetWordWrap: Boolean; override;
+ function GetScrollPastEOL: Boolean; override;
+ function GetRowLength(ARow: Integer): Integer; override;
+ function BufferToDisplayPos(const P: TBufferCoord): TDisplayCoord; override;
+ function DisplayToBufferPos(const P: TDisplayCoord): TBufferCoord; override;
+ function SelectionToDisplayRow(var Sel: TSynSelection): Integer; override;
public
- type
- TKeepSelection = (ksKeepBase, ksKeepActive);
constructor Create(Owner: TPersistent);
- destructor Destroy; override;
- procedure Clear(KeepSelection: TKeepSelection = ksKeepActive);
- function AddCaret(const ACaret: TBufferCoord; IsBase: Boolean = False): Boolean;
- procedure DeleteSelection(Index: Integer);
- function FindCaret(const ACaret: TBufferCoord): Integer;
- function FindSelection(const BC: TBufferCoord; var Index: Integer): Boolean;
- procedure MouseSelection(const Sel: TSynSelection);
- procedure ColumnSelection(Anchor, ACaret: TBufferCoord; LastPosX: Integer = 0);
- procedure Merge;
- function PartSelectionsForRow(const RowStart, RowEnd: TBufferCoord): TSynSelectionArray;
- function RowHasCaret(ARow, ALine: Integer): Boolean;
- // Invalidate
- procedure InvalidateSelection(Index: Integer);
- procedure InvalidateAll;
- //Storing and Restoring
- procedure Store(out SelStorage: TSynSelStorage);
- procedure Restore(const [Ref] SelStorage: TSynSelStorage); overload;
- procedure Restore(const [Ref] Sel: TSynSelection; EnsureVisible: Boolean = True); overload;
- // Adjust selections in response to editing events
- // Should only used by Synedit
- procedure LinesInserted(FirstLine, aCount: Integer);
- procedure LinesDeleted(FirstLine, aCount: Integer);
- procedure LinePut(aIndex: Integer; const OldLine: string);
- // properties
- property BaseSelectionIndex: Integer read FBaseSelIndex;
- // The last selection entered
- // Non-multicursor commands operate on the active selection
- property ActiveSelection: TSynSelection read GetActiveSelection write SetActiveSelection;
- // The selection that is kept when you clear multiple cursors
- // It the first one as in VS Code
- property BaseSelection: TSynSelection read GetBaseSelection write SetBaseSelection;
- property Count: Integer read GetCount;
- property ActiveSelIndex: Integer read FActiveSelIndex write SetActiveSelIndex;
- property IsEmpty: Boolean read GetIsEmpty;
- property Selection[Index: Integer]: TSynSelection read GetSelection; default;
end;
{$ENDREGION 'TSynSelections'}
@@ -939,6 +801,14 @@ TSynEditorOptionsContainer = class(TComponent)
{$ENDREGION 'TSynEditorOptionsContainer'}
+{$REGION 'VCL Utility Functions'}
+// VCL-specific utility functions (moved from SynEditMiscProcs)
+function DefaultFontName: string;
+function GetCorrectFontWeight(Font: TFont): Integer;
+function IsColorDark(AColor: TColor): Boolean;
+function ColorToHTML(Color: TColor): string;
+{$ENDREGION 'VCL Utility Functions'}
+
implementation
uses
@@ -951,73 +821,7 @@ implementation
SynEdit,
SynEditTextBuffer;
-{$REGION 'TSynSelectedColor'}
-
-constructor TSynSelectedColor.Create;
-begin
- inherited Create;
- FBG := clHighLight;
- FFG := clHighLightText;
- FFillWholeLines := True;
- Opacity := 115;
-end;
-
-procedure TSynSelectedColor.Assign(Source: TPersistent);
-begin
- if Source is TSynSelectedColor then
- begin
- var Src := TSynSelectedColor(Source);
- FBG := Src.FBG;
- FFG := Src.FFG;
- FOpacity := Src.Opacity;
- FFillWholeLines := Src.FillWholeLines;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end
- else
- inherited Assign(Source);
-end;
-
-procedure TSynSelectedColor.SetOpacity(Value: Byte);
-begin
- if (FOpacity <> Value) then
- begin
- FOpacity := Value;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
-procedure TSynSelectedColor.SetBG(Value: TColor);
-begin
- if (FBG <> Value) then
- begin
- FBG := Value;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
-procedure TSynSelectedColor.SetFG(Value: TColor);
-begin
- if (FFG <> Value) then
- begin
- FFG := Value;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
-procedure TSynSelectedColor.SetFillWholeLines(const Value: Boolean);
-begin
- if (FFillWholeLines <> Value) then
- begin
- FFillWholeLines := Value;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
+{$REGION 'TSynSelectedColor - now in SynEditTypes.pas'}
{$ENDREGION}
@@ -1642,126 +1446,6 @@ procedure TSynGlyph.SetVisible(Value: Boolean);
{$ENDREGION}
-{$REGION 'TSynMethodChain'}
-
-procedure TSynMethodChain.Add(AEvent: TMethod);
-begin
- if not Assigned(@AEvent) then
- raise ESynMethodChain.CreateFmt
- ('%s.Entry: the parameter `AEvent'' must be specified.', [ClassName]);
-
- with FNotifyProcs, AEvent do
- begin
- Add(Code);
- Add(Data);
- end
-end;
-
-constructor TSynMethodChain.Create;
-begin
- inherited;
- FNotifyProcs := TList.Create;
-end;
-
-destructor TSynMethodChain.Destroy;
-begin
- FNotifyProcs.Free;
- inherited;
-end;
-
-function TSynMethodChain.DoHandleException(E: Exception): Boolean;
-begin
- if not Assigned(FExceptionHandler) then
- raise E
- else
- try
- Result := True;
- FExceptionHandler(Self, E, Result);
- except
- raise ESynMethodChain.CreateFmt
- ('%s.DoHandleException: MUST NOT occur any kind of exception in ' +
- 'ExceptionHandler', [ClassName]);
- end;
-end;
-
-procedure TSynMethodChain.Fire;
-var
- AMethod: TMethod;
- I: Integer;
-begin
- I := 0;
- with FNotifyProcs, AMethod do
- while I < Count do
- try
- repeat
- Code := Items[I];
- Inc(I);
- Data := Items[I];
- Inc(I);
-
- DoFire(AMethod)
- until I >= Count;
- except
- on E: Exception do
- if not DoHandleException(E) then
- I := MaxInt;
- end;
-end;
-
-procedure TSynMethodChain.Remove(AEvent: TMethod);
-var
- I: Integer;
-begin
- if not Assigned(@AEvent) then
- raise ESynMethodChain.CreateFmt
- ('%s.Remove: the parameter `AEvent'' must be specified.', [ClassName]);
-
- with FNotifyProcs, AEvent do
- begin
- I := Count - 1;
- while I > 0 do
- if Items[I] <> Data then
- Dec(I, 2)
- else
- begin
- Dec(I);
- if Items[I] = Code then
- begin
- Delete(I);
- Delete(I);
- end;
- Dec(I);
- end;
- end;
-end;
-
-{$ENDREGION}
-
-
-{$REGION 'TSynNotifyEventChain'}
-
-procedure TSynNotifyEventChain.Add(AEvent: TNotifyEvent);
-begin
- inherited Add(TMethod(AEvent));
-end;
-
-constructor TSynNotifyEventChain.CreateEx(ASender: TObject);
-begin
- inherited Create;
- FSender := ASender;
-end;
-
-procedure TSynNotifyEventChain.DoFire(const AEvent: TMethod);
-begin
- TNotifyEvent(AEvent)(FSender);
-end;
-
-procedure TSynNotifyEventChain.Remove(AEvent: TNotifyEvent);
-begin
- inherited Remove(TMethod(AEvent));
-end;
-
-{$ENDREGION}
{$REGION 'TSynInternalImage'}
@@ -2044,14 +1728,6 @@ procedure TSynHotKey.WMSetFocus(var Msg: TWMSetFocus);
ShowCaret(Handle);
end;
-{ TSynEditSearchCustom }
-
-// possibility to preprocess search expression before is send to SynEdit.SearchReplace()
-function TSynEditSearchCustom.PreprocessReplaceExpression(const AReplace
- : string): string;
-begin
- Result := AReplace;
-end;
{$ENDREGION}
@@ -2086,12 +1762,23 @@ procedure TSynGutterBand.DoClick(Sender: TObject; Button: TMouseButton;
X, Y, Row, Line: Integer);
var
SynEdit: TCustomSynEdit;
- Index: Integer;
+ Index, I, BmkX, BmkY: Integer;
rcFold: TRect;
begin
- if Visible and (FKind = gbkFold) then
+ SynEdit := TCustomSynEdit(Editor);
+
+ if Visible and (FKind = gbkMarks) then
+ begin
+ // Click on marks band clears bookmark on that line
+ for I := 0 to 9 do
+ if SynEdit.GetBookmark(I, BmkX, BmkY) and (BmkY = Line) then
+ begin
+ SynEdit.ClearBookmark(I);
+ Break;
+ end;
+ end
+ else if Visible and (FKind = gbkFold) then
begin
- SynEdit := TCustomSynEdit(Editor);
if SynEdit.AllFoldRanges.FoldStartAtLine(Line, Index) then
begin
rcFold := FoldShapeRect(Row, Line);
@@ -3419,37 +3106,9 @@ procedure TSynBracketsHighlight.SetIndicatorSpecs(const MatchingBracketsSpec,
{$REGION 'TSynSelections'}
-function TSynSelections.AddCaret(const ACaret: TBufferCoord; IsBase: Boolean): Boolean;
-// If a selection has the same caret or contains the caret then remove it.
-// Otherwise add a new selection
-// Returns True if a new selection was added
-var
- Sel: TSynSelection;
- Index: Integer;
+constructor TSynSelections.Create(Owner: TPersistent);
begin
- Result := False;
- if FindSelection(ACaret, Index) then
- begin
- DeleteSelection(Index);
- Restore(FSelections[FActiveSelIndex], False);
- end
- else if (Index > 0) and (FSelections[Index - 1].Caret = ACaret) then
- begin
- DeleteSelection(Index - 1);
- Restore(FSelections[FActiveSelIndex], False);
- end
- else
- begin
- // ACaret is not included in any selection
- Sel := TSynSelection.Create(ACaret, ACaret, ACaret);
- FSelections.Insert(Index, Sel);
- FActiveSelIndex := Index;
- if IsBase then
- FBaseSelIndex := Index
- else if FBaseSelIndex >= Index then
- Inc(FBaseSelIndex);
- Result := True;
- end;
+ inherited Create(Owner);
end;
procedure TSynSelections.CaretsChanged;
@@ -3458,457 +3117,12 @@ procedure TSynSelections.CaretsChanged;
TCustomSynEdit(FOwner).StateFlags + [sfCaretChanged, sfScrollbarChanged];
end;
-procedure TSynSelections.Clear(KeepSelection: TKeepSelection);
-var
- Index: Integer;
-begin
- if FSelections.Count = 1 then Exit;
-
- if (KeepSelection = ksKeepBase) and (FActiveSelIndex <> FBaseSelIndex) then
- Restore(BaseSelection);
-
- for Index := FSelections.Count - 1 downto 0 do
- if not (((KeepSelection = ksKeepBase) and (Index = FBaseSelIndex)) or
- ((KeepSelection = ksKeepActive) and (Index = FActiveSelIndex)))
- then
- DeleteSelection(Index);
-
- Assert (FSelections.Count = 1);
- FBaseSelIndex := 0;
- FActiveSelIndex := 0;
- CaretsChanged;
-end;
-
-procedure TSynSelections.ColumnSelection(Anchor, ACaret: TBufferCoord;
- LastPosX: Integer);
-
- procedure SetLineSelection(Index, Line, FromChar, ToChar: Integer; ScrollPastEOL: Boolean);
- var
- LineString: string;
- Len: Integer;
- begin
- LineString := TCustomSynEdit(FOwner).Lines[Line - 1];
- Len := LineString.Length;
- if not ScrollPastEOL then
- ToChar := EnsureRange(ToChar, 1, Len + 1);
- FromChar := EnsureRange(FromChar, 1, Len + 1);
- FSelections.List[Index].Caret := BufferCoord(ToChar, Line);
- FSelections.List[Index].Start := BufferCoord(FromChar, Line);
- FSelections.List[Index].Stop := BufferCoord(Min(ToChar, Len + 1), Line);
- FSelections.List[Index].LastPosX := LastPosX;
- InvalidateSelection(Index);
- end;
-
- procedure SetRowSelection(Index, Row, FromChar, ToChar: Integer; ScrollPastEOL: Boolean);
- var
- Len: Integer;
- begin
- Len := TCustomSynEdit(FOwner).RowLength[Row];
- if not ScrollPastEOL then
- ToChar := EnsureRange(ToChar, 1, Len + 1);
- FromChar := EnsureRange(FromChar, 1, Len + 1);
- FSelections.List[Index].Caret :=
- TCustomSynEdit(FOwner).DisplayToBufferPos(DisplayCoord(ToChar, Row));
- FSelections.List[Index].Start :=
- TCustomSynEdit(FOwner).DisplayToBufferPos(DisplayCoord(FromChar, Row));
- FSelections.List[Index].Stop :=
- TCustomSynEdit(FOwner).DisplayToBufferPos(DisplayCoord(Min(ToChar, Len + 1), Row));
- FSelections.List[Index].LastPosX := LastPosX;
- InvalidateSelection(Index);
- end;
-
-var
- DC: TDisplayCoord;
- FromChar, ToChar: Integer;
- FromRow, ToRow: Integer;
- Line, Row: Integer;
- Index: Integer;
- Increment: Integer;
- ScrollPastEOL: Boolean;
-begin
- Clear;
- InvalidateSelection(0);
-
-
- ScrollPastEOL := eoScrollPastEol in TCustomSynEdit(FOwner).ScrollOptions;
-
- if TCustomSynEdit(FOwner).WordWrap then
- begin
- DC := TCustomSynEdit(FOwner).BufferToDisplayPos(Anchor);
- FromChar := DC.Column;
- FromRow := DC.Row;
- DC := TCustomSynEdit(FOwner).BufferToDisplayPos(ACaret);
- ToChar := DC.Column;
- ToRow := DC.Row;
-
- SetRowSelection(0, FromRow, FromChar, ToChar, ScrollPastEOL);
-
- Increment := Sign(ToRow - FromRow);
-
- Row := FromRow;
- while Row <> ToRow do
- begin
- Row := Row + Increment;
- if Increment > 0 then
- Index := FSelections.Add(TSynSelection.Invalid)
- else
- begin
- FSelections.Insert(0, TSynSelection.Invalid);
- Index := 0;
- end;
- SetRowSelection(Index, Row, FromChar, ToChar, ScrollPastEOL);
- end;
- end
- else
- begin
- FromChar := Anchor.Char;
- ToChar := ACaret.Char;
- SetLineSelection(0, Anchor.Line, FromChar, ToChar, ScrollPastEOL);
-
- Increment := Sign(ACaret.Line - Anchor.Line);
-
- Line := Anchor.Line;
- while Line <> ACaret.Line do
- begin
- Line := Line + Increment;
- if Increment > 0 then
- Index := FSelections.Add(TSynSelection.Invalid)
- else
- begin
- FSelections.Insert(0, TSynSelection.Invalid);
- Index := 0;
- end;
- SetLineSelection(Index, Line, FromChar, ToChar, ScrollPastEOL);
- end;
- end;
-
- if Increment >= 0 then
- begin
- FBaseSelIndex := 0;
- FActiveSelIndex := FSelections.Count - 1
- end
- else
- begin
- FBaseSelIndex := FSelections.Count -1;
- FActiveSelIndex := 0;
- end;
-
- Restore(ActiveSelection, False);
- CaretsChanged;
-end;
-
-constructor TSynSelections.Create(Owner: TPersistent);
+procedure TSynSelections.DoInvalidateSelection(const Sel: TSynSelection);
begin
- inherited Create;
- FOwner := Owner;
- FSelections := TList.Create(TComparer.Construct(
- function(const L, R: TSynSelection): Integer
- begin
- if L.Normalized.Start < R.Normalized.Start then
- Result := -1
- else if L.Normalized.Start = R.Normalized.Start then
- Result := 0
- else
- Result := 1;
- end));
-end;
-
-procedure TSynSelections.DeleteSelection(Index: Integer);
-var
- Sel: TSynSelection;
-begin
- // Leave at least one selection
- if FSelections.Count <= 1 then Exit;
-
- Sel := FSelections[Index];
TCustomSynEdit(FOwner).InvalidateSelection(Sel);
- FSelections.Delete(Index);
-
- if Index = FActiveSelIndex then
- begin
- if Index >= FSelections.Count then
- FActiveSelIndex := FSelections.Count - 1;
- end
- else if FActiveSelIndex > Index then
- Dec(FActiveSelIndex);
-
- if FBaseSelIndex = Index then
- // Base becomes the last one as in VS Code
- FBaseSelIndex := FSelections.Count - 1
- else if FBaseSelIndex > Index then
- Dec(FBaseSelIndex);
-
- CaretsChanged;
-end;
-
-destructor TSynSelections.Destroy;
-begin
- FSelections.Free;
- inherited;
-end;
-
-function TSynSelections.FindCaret(const ACaret: TBufferCoord): Integer;
-var
- Index: Integer;
-begin
- if FSelections.Count = 0 then Exit(-1);
-
- if FindSelection(ACaret, Index) then
- begin
- if FSelections[Index].Caret = ACaret then
- Result := Index
- else
- Result := -1;
- end
- else if (Index > 0) and (FSelections[Index - 1].Caret = ACaret) then
- Result := Index - 1
- else
- Result := -1;
-end;
-
-function TSynSelections.FindSelection(const BC: TBufferCoord; var Index: Integer): Boolean;
-begin
- if FSelections.BinarySearch(TSynSelection.Create(BC, BC, BC), Index) then
- Exit(True);
-
- if Index = 0 then
- // BC is before the start of the top selection
- Exit(False);
-
- Result := FSelections[Index - 1].Contains(BC);
- if Result then
- Dec(Index)
-end;
-
-function TSynSelections.GetActiveSelection: TSynSelection;
-begin
- Result := FSelections[FActiveSelIndex];
-end;
-
-function TSynSelections.GetBaseSelection: TSynSelection;
-begin
- Result := FSelections[FBaseSelIndex];
-end;
-
-function TSynSelections.GetCount: Integer;
-begin
- Result := FSelections.Count;
-end;
-
-function TSynSelections.GetIsEmpty: Boolean;
-var
- Index: Integer;
-begin
- Result := True;
- for Index := 0 to FSelections.Count - 1 do
- if not FSelections.List[Index].IsEmpty then
- Exit(False);
-end;
-
-function TSynSelections.GetSelection(Index: Integer): TSynSelection;
-begin
- Result := FSelections[Index];
-end;
-
-procedure TSynSelections.InvalidateAll;
-var
- Index: Integer;
-begin
- for Index := 0 to FSelections.Count - 1 do
- InvalidateSelection(Index);
-end;
-
-procedure TSynSelections.InvalidateSelection(Index: Integer);
-begin
- TCustomSynEdit(FOwner).InvalidateSelection(FSelections[Index]);
-end;
-
-procedure TSynSelections.LinePut(aIndex: Integer; const OldLine: string);
-var
- I: Integer;
- Line: string;
- OldLen, NewLen: Integer;
- StartPos: Integer;
- Delta: Integer;
-begin
- if FSelections.Count <= 1 then Exit;
-
- Line := TCustomSynEdit(FOwner).Lines[aIndex];
- LineDiff(Line, OldLine, StartPos, OldLen, NewLen);
- Delta := NewLen - OldLen;
-
- for I := FActiveSelIndex + 1 to Count - 1 do
- begin
- with FSelections.List[I] do
- begin
- if (Start.Line > aIndex + 1) and (Stop.Line > aIndex + 1) then
- Exit;
-
- if Caret.Line = aIndex + 1 then Inc(Caret.Char, Delta);
- if Start.Line = aIndex + 1 then Inc(Start.Char, Delta);
- if Stop.Line = aIndex + 1 then Inc(Stop.Char, Delta);
- end;
- end;
-end;
-
-procedure TSynSelections.LinesDeleted(FirstLine, aCount: Integer);
-var
- I: Integer;
- MinBC: TBufferCoord;
-begin
- if FSelections.Count <= 1 then Exit;
-
- for I := FActiveSelIndex + 1 to Count - 1 do
- with FSelections.List[I] do
- begin
- if Caret.Line >= FirstLine + 1 then Dec(Caret.Line, aCount);
- if Start.Line >= FirstLine + 1 then Dec(Start.Line, aCount);
- if Stop.Line >= FirstLine + 1 then Dec(Stop.Line, aCount);
-
- if (Start.Line < FirstLine + 1) and (Stop.Line < FirstLine + 1) then
- begin
- FSelections.List[I] := TSynSelection.Invalid;
- Continue;
- end;
-
- MinBC := BufferCoord(FirstLine + 1, 1);
- Caret := TBufferCoord.Max(Caret, MinBC);
- Start := TBufferCoord.Max(Start, MinBC);
- Stop := TBufferCoord.Max(Stop, MinBC);
- end;
end;
-procedure TSynSelections.LinesInserted(FirstLine, aCount: Integer);
-var
- I: Integer;
-begin
- if FSelections.Count <= 1 then Exit;
-
- for I := FActiveSelIndex + 1 to Count - 1 do
- with FSelections.List[I] do
- begin
- // FirstLine is 0-based
- if Caret.Line >= FirstLine + 1 then Inc(Caret.Line, aCount);
- if Start.Line >= FirstLine + 1 then Inc(Start.Line, aCount);
- if Stop.Line >= FirstLine + 1 then Inc(Stop.Line, aCount);
- end;
-end;
-
-procedure TSynSelections.Merge;
-// It is executed after the execution of a multi-selection command
-// It removes invalid selections and merges overllapping selections
-
- function DoMerge(const Sel, NextSel: TSynSelection): TSynSelection;
- var
- Caret, Start, Stop: TBufferCoord;
- begin
- Start := TBufferCoord.Min(
- TBufferCoord.Min(Sel.Start, Sel.Stop),
- TBufferCoord.Min(NextSel.Start, NextSel.Stop));
- Stop := TBufferCoord.Max(
- TBufferCoord.Max(Sel.Start, Sel.Stop),
- TBufferCoord.Max(NextSel.Start, NextSel.Stop));
-
- if NextSel.Caret = TBufferCoord.Min(NextSel.Start, NextSel.Stop) then
- Caret := Start
- else
- Caret := Stop;
-
- Result := TSynSelection.Create(Caret, Start, Stop);
- Result.LastPosX := Sel.LastPosX;
- Result.CaretAtEOL := Sel.CaretAtEOL
- end;
-
-var
- Sel, NextSel: TSynSelection;
- I: Integer;
- BC: TBufferCoord;
-begin
- if FSelections.Count = 1 then Exit;
-
- // Remove Invalid
- for I := Count - 1 downto 0 do
- if not FSelections.List[I].IsValid then
- DeleteSelection(I);
-
- // Selections should be sorted in increasing order of the normalized Start.
- // Merge is concequtive selections overlap.
-
- NextSel := FSelections.List[Count - 1]; // last selection
- for I := Count - 2 downto 0 do
- begin
- Sel := FSelections.List[I];
-
- if (Sel = NextSel) or Sel.Intersects(NextSel) then
- begin
- Sel := DoMerge(Sel, NextSel);
- FSelections.List[I] := Sel;
- DeleteSelection(I + 1);
- end;
- NextSel := Sel;
- end;
-
- // Process the case of one invalid selection
- if (FSelections.Count = 1) and not FSelections.List[0].IsValid then
- begin
- BC := BufferCoord(1, 1);
- FSelections.List[0] := TSynSelection.Create(BC, BC, BC);
- end;
-
- // Activate the current selection
- Restore(ActiveSelection, False);
-end;
-
-procedure TSynSelections.MouseSelection(const Sel: TSynSelection);
-// Mouse selection works differently than selection with the keyboard
-// All other selections overlapping with the active selection get removed
-// as in VS Code and Visual Studio.
-begin
- // Exit if there are no other selections
- if FSelections.Count <= 1 then Exit;
-
- for var Index := FSelections.Count - 1 downto 0 do
- begin
- // Sel will become the active selection
- if Index = FActiveSelIndex then
- Continue;
- if Sel.Intersects(fSelections.List[Index]) then
- DeleteSelection(Index);
- end;
-end;
-
-function TSynSelections.PartSelectionsForRow(
- const RowStart, RowEnd: TBufferCoord): TSynSelectionArray;
-// Provides a list of canditates for partial selection of a Row
-var
- Sel: TSynSelection;
-begin
- Result := [];
- for var Index := 0 to FSelections.Count - 1 do
- begin
- Sel := FSelections.List[Index].Normalized;
- if Sel.Stop < RowStart then
- Continue
- else if Sel.Start > RowEnd then
- Exit
- else if not Sel.IsEmpty then
- Result := Result + [Sel];
- end;
-end;
-
-procedure TSynSelections.Restore(const [Ref] SelStorage: TSynSelStorage);
-begin
- InvalidateAll;
- FSelections.Clear;
- FSelections.AddRange(SelStorage.Selections);
- FActiveSelIndex := SelStorage.ActiveIndex;
- FBaseSelIndex := SelStorage.BaseIndex;
- InvalidateAll;
- Restore(ActiveSelection);
- CaretsChanged;
-end;
-
-procedure TSynSelections.Restore(const [Ref] Sel: TSynSelection;
+procedure TSynSelections.DoRestoreSelection(const Sel: TSynSelection;
EnsureVisible: Boolean);
var
TrimTrailingActive: Boolean;
@@ -3923,64 +3137,39 @@ procedure TSynSelections.Restore(const [Ref] Sel: TSynSelection;
[eoTrimTrailingSpaces];
end;
-function TSynSelections.RowHasCaret(ARow, ALine: Integer): Boolean;
-// Used in painting the active line
-
- function IsCaretOnRow(Sel: TSynSelection): Boolean;
- begin
- if TCustomSynEdit(FOwner).WordWrap then
- Result := TCustomSynEdit(FOwner).SelectionToDisplayCoord(Sel).Row = ARow
- else
- Result := Sel.Caret.Line = ALine;
- end;
+function TSynSelections.GetLineText(ALine: Integer): string;
+begin
+ Result := TCustomSynEdit(FOwner).Lines[ALine - 1];
+end;
-var
- Sel: TSynSelection;
- Index: Integer;
+function TSynSelections.GetWordWrap: Boolean;
begin
- // Find first selection that may contain the caret
- FindSelection(BufferCoord(1, ALine), Index);
+ Result := TCustomSynEdit(FOwner).WordWrap;
+end;
- Result := False;
- while Index < FSelections.Count do
- begin
- Sel := FSelections[Index].Normalized;
- if Sel.Start.Line > ALine then Break;
- Result := IsCaretOnRow(Sel);
- if Result then Break;
- Inc(Index);
- end;
+function TSynSelections.GetScrollPastEOL: Boolean;
+begin
+ Result := eoScrollPastEol in TCustomSynEdit(FOwner).ScrollOptions;
end;
-procedure TSynSelections.SetActiveSelection(const Value: TSynSelection);
+function TSynSelections.GetRowLength(ARow: Integer): Integer;
begin
- FSelections[FActiveSelIndex] := Value;
+ Result := TCustomSynEdit(FOwner).RowLength[ARow];
end;
-procedure TSynSelections.SetActiveSelIndex(const Index: Integer);
-var
- Sel: TSynSelection;
+function TSynSelections.BufferToDisplayPos(const P: TBufferCoord): TDisplayCoord;
begin
- Assert(InRange(Index, 0, Count - 1));
- if Index <> FActiveSelIndex then
- begin
- FActiveSelIndex := Index;
- Sel := ActiveSelection;
- if Sel.IsValid then
- Restore(ActiveSelection, False);
- end;
+ Result := TCustomSynEdit(FOwner).BufferToDisplayPos(P);
end;
-procedure TSynSelections.SetBaseSelection(const Value: TSynSelection);
+function TSynSelections.DisplayToBufferPos(const P: TDisplayCoord): TBufferCoord;
begin
- FSelections[FBaseSelIndex] := Value;
+ Result := TCustomSynEdit(FOwner).DisplayToBufferPos(P);
end;
-procedure TSynSelections.Store(out SelStorage: TSynSelStorage);
+function TSynSelections.SelectionToDisplayRow(var Sel: TSynSelection): Integer;
begin
- SelStorage.Selections := FSelections.ToArray;
- SelStorage.BaseIndex := FBaseSelIndex;
- SelStorage.ActiveIndex := FActiveSelIndex;
+ Result := TCustomSynEdit(FOwner).SelectionToDisplayCoord(Sel).Row;
end;
{$ENDREGION 'TSynSelections'}
@@ -4042,13 +3231,6 @@ procedure TSynCarets.ShowCarets;
{$ENDREGION 'TSynCarets'}
-{ TSynSelStorage }
-
-procedure TSynSelStorage.Clear;
-begin
- Selections := [];
-end;
-
{$REGION 'Scrollbar Annotations'}
{ TSynScrollbarAnnItem }
@@ -4406,5 +3588,70 @@ procedure TSynEditorOptionsContainer.SetSynGutter(const Value: TSynGutter);
{$ENDREGION 'TSynEditorOptionsContainer'}
+{$REGION 'VCL Utility Functions'}
+
+function DefaultFontName: string;
+begin
+ if CheckWin32Version(6) then
+ begin
+ Result := 'Consolas';
+ if Screen.Fonts.IndexOf(Result) >= 0 then
+ Exit;
+ end;
+
+ Result := 'Lucida Console';
+ if Screen.Fonts.IndexOf(Result) >= 0 then
+ Exit;
+
+ Result := 'Courier New';
+ if Screen.Fonts.IndexOf(Result) < 0 then
+ Result := 'Courier';
+end;
+
+function WeightEnumFontsProc(EnumLogFontExDV: PEnumLogFontExDV;
+ EnumTextMetric: PEnumTextMetric;
+ FontType: DWORD; LParam: LPARAM): Integer; stdcall;
+begin;
+ PInteger(LPARAM)^ := EnumLogFontExDV.elfEnumLogfontEx.elfLogFont.lfWeight;
+ Result := 0;
+end;
+
+function GetCorrectFontWeight(Font: TFont): Integer;
+var
+ DC: HDC;
+ LogFont: TLogFont;
+begin
+ if TFontStyle.fsBold in Font.Style then
+ Result := FW_BOLD
+ else
+ begin
+ Result := FW_NORMAL;
+ DC := GetDC(0);
+ FillChar(LogFont, SizeOf(LogFont), 0);
+ LogFont.lfCharSet := DEFAULT_CHARSET;
+ StrPLCopy(LogFont.lfFaceName, Font.Name, Length(LogFont.lfFaceName) - 1);
+ EnumFontFamiliesEx(DC, LogFont, @WeightEnumFontsProc, LPARAM(@Result), 0);
+ ReleaseDC(0, DC);
+ end;
+end;
+
+function IsColorDark(AColor: TColor): Boolean;
+var
+ ACol: Longint;
+begin
+ ACol := ColorToRGB(AColor) and $00FFFFFF;
+ Result := ((2.99 * GetRValue(ACol) + 5.87 * GetGValue(ACol) +
+ 1.14 * GetBValue(ACol)) < $400);
+end;
+
+function ColorToHTML(Color: TColor): string;
+var
+ R: TColorRef;
+begin
+ R := ColorToRGB(Color);
+ Result := Format('#%.2x%.2x%.2x', [GetRValue(R), GetGValue(R), GetBValue(R)]);
+end;
+
+{$ENDREGION 'VCL Utility Functions'}
end.
diff --git a/Source/SynEditOptionsDialog.dfm b/Source/VCL/Vcl.SynEditOptionsDialog.dfm
similarity index 100%
rename from Source/SynEditOptionsDialog.dfm
rename to Source/VCL/Vcl.SynEditOptionsDialog.dfm
diff --git a/Source/SynEditOptionsDialog.pas b/Source/VCL/Vcl.SynEditOptionsDialog.pas
similarity index 99%
rename from Source/SynEditOptionsDialog.pas
rename to Source/VCL/Vcl.SynEditOptionsDialog.pas
index 020f6082..4ccd60cf 100644
--- a/Source/SynEditOptionsDialog.pas
+++ b/Source/VCL/Vcl.SynEditOptionsDialog.pas
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditOptionsDialog;
+unit Vcl.SynEditOptionsDialog;
{$I SynEdit.inc}
@@ -273,7 +273,7 @@ implementation
uses
System.Types,
- SynEditKeyConst,
+ SynEditKeyConstShared,
SynEditMiscProcs;
{ TSynEditOptionsDialog }
diff --git a/Source/SynEditPlugins.pas b/Source/VCL/Vcl.SynEditPlugins.pas
similarity index 99%
rename from Source/SynEditPlugins.pas
rename to Source/VCL/Vcl.SynEditPlugins.pas
index 3de3054a..2d3952eb 100644
--- a/Source/SynEditPlugins.pas
+++ b/Source/VCL/Vcl.SynEditPlugins.pas
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditPlugins;
+unit Vcl.SynEditPlugins;
{$I SynEdit.inc}
@@ -40,7 +40,7 @@ interface
SynEdit,
SynEditTypes,
SynEditKeyCmds,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
diff --git a/Source/SynEditPrint.pas b/Source/VCL/Vcl.SynEditPrint.pas
similarity index 99%
rename from Source/SynEditPrint.pas
rename to Source/VCL/Vcl.SynEditPrint.pas
index 5cfa742c..1d57c754 100644
--- a/Source/SynEditPrint.pas
+++ b/Source/VCL/Vcl.SynEditPrint.pas
@@ -74,7 +74,7 @@
PrintRange(StartPage,EndPage) : Prints the specified page-range (both inclusive)
-------------------------------------------------------------------------------}
-unit SynEditPrint;
+unit Vcl.SynEditPrint;
{$M+}
{$I SynEdit.inc}
@@ -98,7 +98,7 @@ interface
SynEditPrintMargins,
SynEditMiscProcs,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
SynDWrite;
type
@@ -219,7 +219,8 @@ implementation
uses
Winapi.MultiMon,
System.Math,
- System.UITypes;
+ System.UITypes,
+ SynEditMiscClasses;
resourcestring
SYNS_NoPrinter = 'No printer available';
diff --git a/Source/SynEditPrintHeaderFooter.pas b/Source/VCL/Vcl.SynEditPrintHeaderFooter.pas
similarity index 99%
rename from Source/SynEditPrintHeaderFooter.pas
rename to Source/VCL/Vcl.SynEditPrintHeaderFooter.pas
index 7ebf9679..37f38a06 100644
--- a/Source/SynEditPrintHeaderFooter.pas
+++ b/Source/VCL/Vcl.SynEditPrintHeaderFooter.pas
@@ -86,7 +86,7 @@
-------------------------------------------------------------------------------}
-unit SynEditPrintHeaderFooter;
+unit Vcl.SynEditPrintHeaderFooter;
{$M+}
{$I SynEdit.inc}
@@ -99,7 +99,7 @@ interface
Vcl.Graphics,
SynEditPrintTypes,
SynEditPrintMargins,
- SynUnicode,
+ SynUnicodeShared,
System.Classes,
System.SysUtils;
diff --git a/Source/SynEditPrintMargins.pas b/Source/VCL/Vcl.SynEditPrintMargins.pas
similarity index 99%
rename from Source/SynEditPrintMargins.pas
rename to Source/VCL/Vcl.SynEditPrintMargins.pas
index c8eb2b2e..7f35be10 100644
--- a/Source/SynEditPrintMargins.pas
+++ b/Source/VCL/Vcl.SynEditPrintMargins.pas
@@ -75,7 +75,7 @@
-------------------------------------------------------------------------------}
-unit SynEditPrintMargins;
+unit Vcl.SynEditPrintMargins;
{$M+}
{$I SynEdit.inc }
@@ -87,7 +87,7 @@ interface
Vcl.Graphics,
SynEditPrintTypes,
SynEditPrinterInfo,
- SynUnicode,
+ SynUnicodeShared,
SynDWrite,
System.Classes,
System.SysUtils;
diff --git a/Source/SynEditPrintMarginsDialog.dfm b/Source/VCL/Vcl.SynEditPrintMarginsDialog.dfm
similarity index 100%
rename from Source/SynEditPrintMarginsDialog.dfm
rename to Source/VCL/Vcl.SynEditPrintMarginsDialog.dfm
diff --git a/Source/SynEditPrintMarginsDialog.pas b/Source/VCL/Vcl.SynEditPrintMarginsDialog.pas
similarity index 99%
rename from Source/SynEditPrintMarginsDialog.pas
rename to Source/VCL/Vcl.SynEditPrintMarginsDialog.pas
index 5c1761df..21f04ed8 100644
--- a/Source/SynEditPrintMarginsDialog.pas
+++ b/Source/VCL/Vcl.SynEditPrintMarginsDialog.pas
@@ -34,7 +34,7 @@
a picture that can help with understanding the different values.
-------------------------------------------------------------------------------}
-unit SynEditPrintMarginsDialog;
+unit Vcl.SynEditPrintMarginsDialog;
{$I SynEdit.inc}
diff --git a/Source/SynEditPrintPreview.pas b/Source/VCL/Vcl.SynEditPrintPreview.pas
similarity index 99%
rename from Source/SynEditPrintPreview.pas
rename to Source/VCL/Vcl.SynEditPrintPreview.pas
index 603d2d06..07e39026 100644
--- a/Source/SynEditPrintPreview.pas
+++ b/Source/VCL/Vcl.SynEditPrintPreview.pas
@@ -39,7 +39,7 @@
before the preview is shown, and when the printer is changed)
-------------------------------------------------------------------------------}
-unit SynEditPrintPreview;
+unit Vcl.SynEditPrintPreview;
{$I SynEdit.inc}
diff --git a/Source/SynEditPrintTypes.pas b/Source/VCL/Vcl.SynEditPrintTypes.pas
similarity index 98%
rename from Source/SynEditPrintTypes.pas
rename to Source/VCL/Vcl.SynEditPrintTypes.pas
index 7eeea224..5577cd23 100644
--- a/Source/SynEditPrintTypes.pas
+++ b/Source/VCL/Vcl.SynEditPrintTypes.pas
@@ -38,12 +38,12 @@
-------------------------------------------------------------------------------}
-unit SynEditPrintTypes;
+unit Vcl.SynEditPrintTypes;
interface
uses
- SynUnicode, Classes, SysUtils;
+ SynUnicodeShared, Classes, SysUtils;
const
DefLeft = 25; //Default left margin [mm]
diff --git a/Source/SynEditPrinterInfo.pas b/Source/VCL/Vcl.SynEditPrinterInfo.pas
similarity index 99%
rename from Source/SynEditPrinterInfo.pas
rename to Source/VCL/Vcl.SynEditPrinterInfo.pas
index e036be9f..c41af1c4 100644
--- a/Source/SynEditPrinterInfo.pas
+++ b/Source/VCL/Vcl.SynEditPrinterInfo.pas
@@ -33,7 +33,7 @@
Class retrieving info about selected printer and paper size.
-------------------------------------------------------------------------------}
-unit SynEditPrinterInfo;
+unit Vcl.SynEditPrinterInfo;
{$I SynEdit.inc}
diff --git a/Source/SynEditPropertyReg.pas b/Source/VCL/Vcl.SynEditPropertyReg.pas
similarity index 99%
rename from Source/SynEditPropertyReg.pas
rename to Source/VCL/Vcl.SynEditPropertyReg.pas
index 7bf2fb25..25ae0991 100644
--- a/Source/SynEditPropertyReg.pas
+++ b/Source/VCL/Vcl.SynEditPropertyReg.pas
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditPropertyReg;
+unit Vcl.SynEditPropertyReg;
{$I SynEdit.inc}
diff --git a/Source/SynEditPythonBehaviour.pas b/Source/VCL/Vcl.SynEditPythonBehaviour.pas
similarity index 97%
rename from Source/SynEditPythonBehaviour.pas
rename to Source/VCL/Vcl.SynEditPythonBehaviour.pas
index bd165e54..8ed6dcae 100644
--- a/Source/SynEditPythonBehaviour.pas
+++ b/Source/VCL/Vcl.SynEditPythonBehaviour.pas
@@ -35,7 +35,7 @@
to a python source file. Python has a unusual way to mark blocks (like begin/end in pascal): it
uses indentation. So the rule is after a ":" and a line break, we have to indent once.
}
-unit SynEditPythonBehaviour;
+unit Vcl.SynEditPythonBehaviour;
{$I SynEdit.inc}
@@ -43,7 +43,7 @@ interface
uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, SynEdit, SynEditKeyCmds,
- SynUnicode, SysUtils, Classes, SynEditTypes;
+ SynUnicodeShared, SysUtils, Classes, SynEditTypes;
type
TSynEditPythonBehaviour = class(TComponent)
diff --git a/Source/VCL/Vcl.SynEditReg.dcr b/Source/VCL/Vcl.SynEditReg.dcr
new file mode 100644
index 00000000..7946bfcf
Binary files /dev/null and b/Source/VCL/Vcl.SynEditReg.dcr differ
diff --git a/Source/SynEditReg.pas b/Source/VCL/Vcl.SynEditReg.pas
similarity index 99%
rename from Source/SynEditReg.pas
rename to Source/VCL/Vcl.SynEditReg.pas
index e6e6a442..e396dd9d 100644
--- a/Source/SynEditReg.pas
+++ b/Source/VCL/Vcl.SynEditReg.pas
@@ -25,7 +25,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditReg;
+unit Vcl.SynEditReg;
{$I SynEdit.inc}
@@ -37,6 +37,7 @@ interface
// SynEdit components
SynEdit,
SynDBEdit,
+ SynEditTypes,
SynEditStrConst,
SynEditHighlighter,
SynEditMiscClasses,
diff --git a/Source/SynEditScrollBars.pas b/Source/VCL/Vcl.SynEditScrollBars.pas
similarity index 99%
rename from Source/SynEditScrollBars.pas
rename to Source/VCL/Vcl.SynEditScrollBars.pas
index 40627227..ec59efdc 100644
--- a/Source/SynEditScrollBars.pas
+++ b/Source/VCL/Vcl.SynEditScrollBars.pas
@@ -22,7 +22,7 @@
of this file under either the MPL or the GPL.
---------------------------------------------------------------------------- }
-unit SynEditScrollBars;
+unit Vcl.SynEditScrollBars;
{$I SynEdit.inc}
@@ -35,7 +35,8 @@ interface
System.UITypes,
Vcl.Controls,
Vcl.Forms,
- SynEditTypes;
+ SynEditTypes,
+ Vcl.SynEditScrollTypes;
{ Factory Method }
function CreateSynEditScrollBars(Editor: TCustomControl): ISynEditScrollBars;
@@ -67,7 +68,7 @@ implementation
SynEditMiscProcs,
SynEditMiscClasses,
SynEditStrConst,
- SynEditKeyConst;
+ SynEditKeyConstShared;
function GetBarScrollInfo(Handle: THandle; AKind: TScrollBarKind): TScrollInfo;
begin
diff --git a/Source/VCL/Vcl.SynEditScrollTypes.pas b/Source/VCL/Vcl.SynEditScrollTypes.pas
new file mode 100644
index 00000000..11252a67
--- /dev/null
+++ b/Source/VCL/Vcl.SynEditScrollTypes.pas
@@ -0,0 +1,68 @@
+{-------------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+http://www.mozilla.org/MPL/
+
+Software distributed under the License is distributed on an "AS IS" basis,
+WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+the specific language governing rights and limitations under the License.
+
+The Original Code is: SynEditTypes.pas, released 2000-04-07.
+The Original Code is based on parts of mwCustomEdit.pas by Martin Waldenburg,
+part of the mwEdit component suite.
+Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
+Unicode translation by Ma�l H�rz.
+All Rights Reserved.
+
+Contributors to the SynEdit and mwEdit projects are listed in the
+Contributors.txt file.
+
+Alternatively, the contents of this file may be used under the terms of the
+GNU General Public License Version 2 or later (the "GPL"), in which case
+the provisions of the GPL are applicable instead of those above.
+If you wish to allow use of your version of this file only under the terms
+of the GPL and not to allow others to use your version of this file
+under the MPL, indicate your decision by deleting the provisions above and
+replace them with the notice and other provisions required by the GPL.
+If you do not delete the provisions above, a recipient may use your version
+of this file under either the MPL or the GPL.
+
+VCL scrollbar interface, formerly Vcl.SynEditTypes.pas.
+
+Renamed to Vcl.SynEditScrollTypes to resolve a name collision: a bare
+'SynEditTypes' in a uses clause matches the shared SynEditTypes.pas
+(exact match) and shadows this Vcl-prefixed unit. Renaming the shared
+side would require updating 110+ files and re-aliasing enum types (which
+Delphi does not support), so the VCL/FMX side was renamed instead.
+The unit contains only ISynEditScrollBars, so 'ScrollTypes' is a more
+accurate name anyway.
+-------------------------------------------------------------------------------}
+
+unit Vcl.SynEditScrollTypes;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.Classes,
+ Winapi.Windows,
+ Winapi.Messages,
+ Vcl.Controls,
+ SynEditTypes;
+
+type
+ ISynEditScrollBars = interface
+ function UpdateScrollBars: Boolean;
+ function GetIsScrolling: Boolean;
+ procedure WMHScroll(var AMsg: TWMScroll);
+ procedure WMVScroll(var AMsg: TWMScroll);
+ procedure DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ MousePos: TPoint);
+ property IsScrolling: Boolean read GetIsScrolling;
+ end;
+
+implementation
+
+end.
diff --git a/Source/VCL/Vcl.SynEditUndo.pas b/Source/VCL/Vcl.SynEditUndo.pas
new file mode 100644
index 00000000..e1258bd7
--- /dev/null
+++ b/Source/VCL/Vcl.SynEditUndo.pas
@@ -0,0 +1,246 @@
+{ -------------------------------------------------------------------------------
+ The contents of this file are subject to the Mozilla Public License
+ Version 1.1 (the "License"); you may not use this file except in compliance
+ with the License. You may obtain a copy of the License at
+ http://www.mozilla.org/MPL/
+
+ Software distributed under the License is distributed on an "AS IS" basis,
+ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ the specific language governing rights and limitations under the License.
+
+ Contributors to the SynEdit and mwEdit projects are listed in the
+ Contributors.txt file.
+
+ Alternatively, the contents of this file may be used under the terms of the
+ GNU General Public License Version 2 or later (the "GPL"), in which case
+ the provisions of the GPL are applicable instead of those above.
+ If you wish to allow use of your version of this file only under the terms
+ of the GPL and not to allow others to use your version of this file
+ under the MPL, indicate your decision by deleting the provisions above and
+ replace them with the notice and other provisions required by the GPL.
+ If you do not delete the provisions above, a recipient may use your version
+ of this file under either the MPL or the GPL.
+
+ Known Issues:
+ ------------------------------------------------------------------------------- }
+
+unit Vcl.SynEditUndo;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ SynEdit,
+ SynEditTypes,
+ SynEditSelections,
+ SynEditKeyCmds;
+
+{ Factory Method}
+
+function CreateSynEditUndo(Editor: TCustomSynEdit): ISynEditUndo;
+
+implementation
+
+uses
+ System.Classes,
+ System.SysUtils,
+ System.Math,
+ System.Generics.Collections,
+ Vcl.Controls,
+ SynEditMiscProcs,
+ SynEditMiscClasses,
+ SynEditTextBuffer,
+ SynEditUndoShared;
+
+type
+ TSynEditUndo = class;
+
+ TSynCaretAndSelectionUndoItem = class(TSynUndoItem)
+ private
+ FBlockBegin: TBufferCoord;
+ FBlockEnd: TBufferCoord;
+ SelStorage: TSynSelStorage;
+ public
+ procedure Undo(Editor: TObject); override;
+ procedure Redo(Editor: TObject); override;
+ constructor Create(Editor: TCustomSynEdit);
+ end;
+
+ TSynUndoPlugin = class(TSynEditPlugin)
+ private
+ FSynEditUndo: TSynEditUndo;
+ FDeletedLines: TArray;
+ FDeletedChangeFlags: TArray;
+ protected
+ procedure LinesInserted(FirstLine, Count: Integer); override;
+ procedure LinesBeforeDeleted(FirstLine, Count: Integer); override;
+ procedure LinesDeleted(FirstLine, Count: Integer); override;
+ procedure LinePut(aIndex: Integer; const OldLine: string); override;
+ public
+ constructor Create(SynEditUndo: TSynEditUndo; Editor: TCustomSynEdit);
+ end;
+
+ TSynEditUndo = class(TSynEditUndoBase)
+ private
+ FPlugin: TSynUndoPlugin;
+ protected
+ function CreateCaretUndoItem(Editor: TObject): TSynUndoItem; override;
+ procedure RestoreCaretAndSelection(Editor: TObject;
+ Item: TSynUndoItem); override;
+ public
+ constructor Create(Editor: TCustomSynEdit);
+ end;
+
+{ TSynEditUndo }
+
+constructor TSynEditUndo.Create(Editor: TCustomSynEdit);
+begin
+ inherited Create;
+ FPlugin := TSynUndoPlugin.Create(Self, Editor);
+end;
+
+function TSynEditUndo.CreateCaretUndoItem(Editor: TObject): TSynUndoItem;
+begin
+ Result := TSynCaretAndSelectionUndoItem.Create(Editor as TCustomSynEdit);
+end;
+
+procedure TSynEditUndo.RestoreCaretAndSelection(Editor: TObject;
+ Item: TSynUndoItem);
+var
+ Ed: TCustomSynEdit;
+begin
+ if not (Item is TSynCaretAndSelectionUndoItem) then
+ begin
+ Ed := Editor as TCustomSynEdit;
+ Ed.Selections.Clear;
+ Ed.SetCaretAndSelection(Item.FCaret, Item.FCaret, Item.FCaret);
+ end;
+end;
+
+{ Factory Method}
+
+function CreateSynEditUndo(Editor: TCustomSynEdit): ISynEditUndo;
+begin
+ Result := TSynEditUndo.Create(Editor);
+end;
+
+{ TSynCaretAndSelectionUndoItem }
+
+constructor TSynCaretAndSelectionUndoItem.Create(Editor: TCustomSynEdit);
+begin
+ inherited Create;
+ if Editor.Selections.Count = 1 then
+ begin
+ FCaret := Editor.CaretXY;
+ FBlockBegin := Editor.BlockBegin;
+ FBlockEnd := Editor.BlockEnd;
+ end
+ else
+ begin
+ Editor.Selections.Store(SelStorage);
+ end;
+end;
+
+procedure TSynCaretAndSelectionUndoItem.Redo(Editor: TObject);
+begin
+ Undo(Editor);
+end;
+
+procedure TSynCaretAndSelectionUndoItem.Undo(Editor: TObject);
+var
+ Ed: TCustomSynEdit;
+begin
+ Ed := Editor as TCustomSynEdit;
+ if Length(SelStorage.Selections) > 0 then
+ Ed.Selections.Restore(SelStorage)
+ else
+ begin
+ Ed.Selections.Clear;
+ Ed.SetCaretAndSelection(FCaret, FBlockBegin, FBlockEnd);
+ end;
+end;
+
+{ TSynUndoPlugin }
+
+constructor TSynUndoPlugin.Create(SynEditUndo: TSynEditUndo;
+ Editor: TCustomSynEdit);
+begin
+ FSynEditUndo := SynEditUndo;
+ inherited Create(Editor,
+ [phLinePut, phLinesInserted, phLinesBeforeDeleted, phLinesDeleted]);
+end;
+
+procedure TSynUndoPlugin.LinePut(aIndex: Integer; const OldLine: string);
+var
+ Line: string;
+ Item: TSynLinePutUndoItem;
+begin
+ if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
+ then
+ Exit;
+
+ Line := Editor.Lines[aIndex];
+ if Line <> OldLine then
+ begin
+ Item := TSynLinePutUndoItem.Create(Editor.Lines, aIndex, OldLine,
+ FSynEditUndo.FCommandProcessed);
+ FSynEditUndo.AddUndoItem(Item);
+ end;
+end;
+
+procedure TSynUndoPlugin.LinesBeforeDeleted(FirstLine, Count: Integer);
+var
+ I: Integer;
+begin
+ if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
+ then
+ Exit;
+
+ SetLength(FDeletedLines, Count);
+ SetLength(FDeletedChangeFlags, Count);
+ for I := 0 to Count -1 do
+ begin
+ FDeletedLines[I] := Editor.Lines[FirstLine + I];
+ FDeletedChangeFlags[I] :=
+ TSynEditStringList(Editor.Lines).ChangeFlags[FirstLine + I];
+ end;
+end;
+
+procedure TSynUndoPlugin.LinesDeleted(FirstLine, Count: Integer);
+var
+ Item: TSynLinesDeletedUndoItem;
+begin
+ if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
+ then
+ Exit;
+
+ if Count > 0 then
+ begin
+ Item := TSynLinesDeletedUndoItem.Create(Editor.Lines, FirstLine,
+ FDeletedLines, FDeletedChangeFlags);
+ FSynEditUndo.AddUndoItem(Item);
+ end;
+end;
+
+procedure TSynUndoPlugin.LinesInserted(FirstLine, Count: Integer);
+var
+ Item: TSynLinesInsertedUndoItem;
+begin
+ if Editor.IsChained or FSynEditUndo.IsLocked or FSynEditUndo.FInsideUndoRedo
+ then
+ Exit;
+
+ if (FSynEditUndo.FUndoList.Count = 0) and
+ (Editor.Lines.Count = 1) and (Editor.Lines[0] = '')
+ then
+ Exit;
+
+ if Count > 0 then
+ begin
+ Item := TSynLinesInsertedUndoItem.Create(Editor.Lines, FirstLine, Count);
+ FSynEditUndo.AddUndoItem(Item);
+ end;
+end;
+
+end.
diff --git a/Source/SynEditWordWrap.pas b/Source/VCL/Vcl.SynEditWordWrap.pas
similarity index 99%
rename from Source/SynEditWordWrap.pas
rename to Source/VCL/Vcl.SynEditWordWrap.pas
index 004affc7..eeeff9e1 100644
--- a/Source/SynEditWordWrap.pas
+++ b/Source/VCL/Vcl.SynEditWordWrap.pas
@@ -26,7 +26,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynEditWordWrap;
+unit Vcl.SynEditWordWrap;
{$I SynEdit.inc}
@@ -92,7 +92,7 @@ implementation
System.RTLConsts,
System.Math,
System.Threading,
- SynUnicode,
+ SynUnicodeShared,
SynEditMiscProcs,
SynDWrite;
diff --git a/Source/SynExportHTML.pas b/Source/VCL/Vcl.SynExportHTML.pas
similarity index 98%
rename from Source/SynExportHTML.pas
rename to Source/VCL/Vcl.SynExportHTML.pas
index 92ba733b..15150469 100644
--- a/Source/SynExportHTML.pas
+++ b/Source/VCL/Vcl.SynExportHTML.pas
@@ -12,8 +12,8 @@
Author of this file is Michael Hieke.
Portions created by Michael Hieke are Copyright 2000 Michael Hieke.
Portions created by James D. Jacobson are Copyright 1999 Martin Waldenburg.
-Changes to emit XHTML 1.0 Strict complying code by Mal Hrz.
-Unicode translation by Mal Hrz.
+Changes to emit XHTML 1.0 Strict complying code by Ma�l H�rz.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit project are listed in the Contributors.txt file.
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynExportHTML;
+unit Vcl.SynExportHTML;
{$I SynEdit.inc}
@@ -39,7 +39,7 @@ interface
Graphics,
SynEditExport,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
System.Generics.Collections,
Classes;
@@ -109,6 +109,7 @@ implementation
uses
SynEditMiscProcs,
+ SynEditMiscClasses,
SynEditStrConst,
SynHighlighterMulti,
SysUtils;
diff --git a/Source/SynExportRTF.pas b/Source/VCL/Vcl.SynExportRTF.pas
similarity index 99%
rename from Source/SynExportRTF.pas
rename to Source/VCL/Vcl.SynExportRTF.pas
index 0efd38dd..e2495c70 100644
--- a/Source/SynExportRTF.pas
+++ b/Source/VCL/Vcl.SynExportRTF.pas
@@ -31,7 +31,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynExportRTF;
+unit Vcl.SynExportRTF;
{$I SynEdit.inc}
@@ -42,7 +42,7 @@ interface
Graphics,
RichEdit,
SynEditExport,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
diff --git a/Source/SynExportTeX.pas b/Source/VCL/Vcl.SynExportTeX.pas
similarity index 99%
rename from Source/SynExportTeX.pas
rename to Source/VCL/Vcl.SynExportTeX.pas
index f21cc546..6010054e 100644
--- a/Source/SynExportTeX.pas
+++ b/Source/VCL/Vcl.SynExportTeX.pas
@@ -36,7 +36,7 @@
We'll have to wait for LaTeX 3.)
-------------------------------------------------------------------------------}
-unit SynExportTeX;
+unit Vcl.SynExportTeX;
{$I SynEdit.inc}
@@ -47,7 +47,7 @@ interface
Graphics,
SynEditExport,
SynEditHighlighter,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
diff --git a/Source/SynMacroRecorder.pas b/Source/VCL/Vcl.SynMacroRecorder.pas
similarity index 58%
rename from Source/SynMacroRecorder.pas
rename to Source/VCL/Vcl.SynMacroRecorder.pas
index 41b32daf..bf03f343 100644
--- a/Source/SynMacroRecorder.pas
+++ b/Source/VCL/Vcl.SynMacroRecorder.pas
@@ -10,9 +10,9 @@
The Original Code is: SynMacroRecorder.pas, released 2001-10-17.
-Author of this file is Flvio Etrusco.
-Portions created by Flvio Etrusco are Copyright 2001 Flvio Etrusco.
-Unicode translation by Mal Hrz.
+Author of this file is Fl�vio Etrusco.
+Portions created by Fl�vio Etrusco are Copyright 2001 Fl�vio Etrusco.
+Unicode translation by Ma�l H�rz.
All Rights Reserved.
Contributors to the SynEdit project are listed in the Contributors.txt file.
@@ -28,7 +28,7 @@
of this file under either the MPL or the GPL.
-------------------------------------------------------------------------------}
-unit SynMacroRecorder;
+unit Vcl.SynMacroRecorder;
{$I SynEdit.inc}
@@ -45,106 +45,26 @@ interface
SynEditKeyCmds,
SynEditPlugins,
SynEditTypes,
- SynUnicode,
+ SynUnicodeShared,
+ SynMacroRecorderShared,
Classes;
-resourcestring
- sCannotRecord = 'Cannot record macro; already recording or playing';
- sCannotPlay = 'Cannot playback macro; already playing or recording';
- sCannotPause = 'Can only pause when recording';
- sCannotResume = 'Can only resume when paused';
-
type
- TSynMacroState = (msStopped, msRecording, msPlaying, msPaused);
- TSynMacroCommand = (mcRecord, mcPlayback);
-
- TSynMacroEvent = class(TObject)
- protected
- fRepeatCount: Byte;
- function GetAsString: string; virtual; abstract;
- procedure InitEventParameters(aStr: string); virtual; abstract;
- public
- constructor Create; virtual;
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- virtual; abstract;
- { the CommandID must not be read inside LoadFromStream/SaveToStream. It's read by the
- MacroRecorder component to decide which MacroEvent class to instanciate }
- procedure LoadFromStream(aStream: TStream); virtual; abstract;
- procedure SaveToStream(aStream: TStream); virtual; abstract;
- procedure Playback(aEditor: TCustomSynEdit); virtual; abstract;
- property AsString: string read GetAsString;
- property RepeatCount: Byte read fRepeatCount write fRepeatCount;
- end;
-
- TSynBasicEvent = class(TSynMacroEvent)
- protected
- fCommand: TSynEditorCommand;
- function GetAsString: string; override;
- procedure InitEventParameters(aStr: string); override;
- public
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- override;
- procedure LoadFromStream(aStream: TStream); override;
- procedure SaveToStream(aStream: TStream); override;
- procedure Playback(aEditor: TCustomSynEdit); override;
- public
- property Command: TSynEditorCommand read fCommand write fCommand;
- end;
-
- TSynCharEvent = class(TSynMacroEvent)
- protected
- fKey: WideChar;
- function GetAsString: string; override;
- procedure InitEventParameters(aStr: string); override;
- public
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- override;
- procedure LoadFromStream(aStream: TStream); override;
- procedure SaveToStream(aStream: TStream); override;
- procedure Playback(aEditor: TCustomSynEdit); override;
- public
- property Key: WideChar read fKey write fKey;
- end;
-
- TSynStringEvent = class(TSynMacroEvent)
- protected
- fString: string;
- function GetAsString: string; override;
- procedure InitEventParameters(aStr: string); override;
- public
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- override;
- procedure LoadFromStream(aStream: TStream); override;
- procedure SaveToStream(aStream: TStream); override;
- procedure Playback(aEditor: TCustomSynEdit); override;
- public
- property Value: string read fString write fString;
- end;
-
- TSynPositionEvent = class(TSynBasicEvent)
- protected
- fPosition: TBufferCoord;
- function GetAsString: string; override;
- procedure InitEventParameters(aStr: string); override;
- public
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- override;
- procedure LoadFromStream(aStream: TStream); override;
- procedure SaveToStream(aStream: TStream); override;
- procedure Playback(aEditor: TCustomSynEdit); override;
- public
- property Position: TBufferCoord read fPosition write fPosition;
- end;
-
- TSynDataEvent = class(TSynBasicEvent)
- protected
- fData: Pointer;
- public
- procedure Initialize(aCmd: TSynEditorCommand; aChar: WideChar; aData: Pointer);
- override;
- procedure LoadFromStream(aStream: TStream); override;
- procedure SaveToStream(aStream: TStream); override;
- procedure Playback(aEditor: TCustomSynEdit); override;
+ // Re-export shared types for backward compatibility
+ TSynMacroState = SynMacroRecorderShared.TSynMacroState;
+ TSynMacroCommand = SynMacroRecorderShared.TSynMacroCommand;
+ TSynMacroEvent = SynMacroRecorderShared.TSynMacroEvent;
+ TSynBasicEvent = SynMacroRecorderShared.TSynBasicEvent;
+ TSynCharEvent = SynMacroRecorderShared.TSynCharEvent;
+ TSynStringEvent = SynMacroRecorderShared.TSynStringEvent;
+ TSynPositionEvent = SynMacroRecorderShared.TSynPositionEvent;
+ TSynDataEvent = SynMacroRecorderShared.TSynDataEvent;
+ TSynMacroPlaybackProc = SynMacroRecorderShared.TSynMacroPlaybackProc;
+
+ // Backward compatibility: deprecated Playback(aEditor) via class helper
+ TSynMacroEventHelper = class helper for TSynMacroEvent
+ procedure Playback(aEditor: TCustomSynEdit);
+ deprecated 'Use PlaybackTo with editor.CommandProcessor';
end;
TCustomSynMacroRecorder = class;
@@ -247,30 +167,11 @@ implementation
RTLConsts,
SysUtils;
-{ TSynDataEvent }
+{ TSynMacroEventHelper }
-procedure TSynDataEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
- aData: Pointer);
+procedure TSynMacroEventHelper.Playback(aEditor: TCustomSynEdit);
begin
- fCommand := aCmd;
- Assert(aChar = #0);
- fData := aData;
-end;
-
-procedure TSynDataEvent.LoadFromStream(aStream: TStream);
-begin
- aStream.Read(fData, SizeOf(fData));
-end;
-
-procedure TSynDataEvent.Playback(aEditor: TCustomSynEdit);
-begin
- aEditor.CommandProcessor(Command, #0, fData);
-end;
-
-procedure TSynDataEvent.SaveToStream(aStream: TStream);
-begin
- inherited;
- aStream.Write(fData, SizeOf(fData));
+ PlaybackTo(aEditor.CommandProcessor);
end;
{ TCustomSynMacroRecorder }
@@ -454,7 +355,6 @@ procedure TCustomSynMacroRecorder.LoadFromStreamEx(aSrc: TStream;
end;
end;
-// TODO: Sender could be also something else then a TCustomSynedit(namely a TObject) but the code below assumes it is a TCustomSynedit even if Sender is of type TObject.
procedure TCustomSynMacroRecorder.OnCommand(Sender: TObject;
AfterProcessing: Boolean; var Handled: Boolean;
var Command: TSynEditorCommand; var aChar: WideChar; Data,
@@ -533,7 +433,7 @@ procedure TCustomSynMacroRecorder.PlaybackMacro(aEditor: TCustomSynEdit);
StateChanged;
for cEvent := 0 to EventCount -1 do
begin
- Events[cEvent].Playback(aEditor);
+ Events[cEvent].PlaybackTo(aEditor.CommandProcessor);
if State <> msPlaying then
Break;
end;
@@ -669,7 +569,6 @@ procedure TCustomSynMacroRecorder.SetAsString(const Value: string);
Stop;
Clear;
fEvents := TList.Create;
- // process file line by line and create events
S := TStringList.Create;
try
S.Text := Value;
@@ -679,7 +578,7 @@ procedure TCustomSynMacroRecorder.SetAsString(const Value: string);
p := Pos(' ', cmdStr);
if p = 0 then p := Length(cmdStr) + 1;
Cmd := ecNone;
- if IdentToEditorCommand(Copy(cmdStr, 1, p - 1), Cmd) then // D2 needs type-cast
+ if IdentToEditorCommand(Copy(cmdStr, 1, p - 1), Cmd) then
begin
Delete(cmdStr, 1, p);
iEvent := CreateMacroEvent(Cmd);
@@ -721,266 +620,4 @@ procedure TCustomSynMacroRecorder.SaveToFile(aFilename: string);
end;
end;
-{ TSynBasicEvent }
-
-function TSynBasicEvent.GetAsString: string;
-var
- Ident: string;
-begin
- EditorCommandToIdent(Command, Ident);
- Result := Ident;
- if RepeatCount > 1 then
- Result := Result + ' ' + IntToStr(RepeatCount);
-end;
-
-procedure TSynBasicEvent.InitEventParameters(aStr: string);
-begin
- // basic events have no parameters but can contain an optional repeat count
- RepeatCount := StrToIntDef(Trim(aStr), 1);
-end;
-
-procedure TSynBasicEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
- aData: Pointer);
-begin
- Command := aCmd;
-{$IFDEF SYN_DEVELOPMENT_CHECKS}
- if (aChar <> #0) or (aData <> nil) then
- raise Exception.Create('TSynBasicEvent cannot handle Char <> #0 or Data <> nil');
-{$ENDIF}
-end;
-
-procedure TSynBasicEvent.LoadFromStream(aStream: TStream);
-begin
- aStream.Read(fRepeatCount, SizeOf(fRepeatCount));
-end;
-
-procedure TSynBasicEvent.Playback(aEditor: TCustomSynEdit);
-var
- i : Integer;
-begin
- for i := 1 to RepeatCount do
- aEditor.CommandProcessor(Command, #0, nil);
-end;
-
-procedure TSynBasicEvent.SaveToStream(aStream: TStream);
-begin
- aStream.Write(Command, SizeOf(TSynEditorCommand));
- aStream.Write(RepeatCount, SizeOf(RepeatCount));
-end;
-
-{ TSynCharEvent }
-
-function TSynCharEvent.GetAsString: string;
-var
- Ident: string;
-begin
- EditorCommandToIdent(ecChar, Ident);
- Result := Ident + ' ' + Key;
- if RepeatCount > 1 then
- Result := Result + ' ' + IntToStr(RepeatCount);
-end;
-
-procedure TSynCharEvent.InitEventParameters(aStr: string);
-begin
- // aStr should be a Key value one character in length
- // with an optional repeat count whitespace separated
- if Length(aStr) >= 1 then
- Key := aStr[1]
- else
- Key := ' ';
- Delete(aStr, 1, 1); // if possible delete the first character
- RepeatCount := StrToIntDef(Trim(aStr), 1);
-end;
-
-procedure TSynCharEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
- aData: Pointer);
-begin
- Key := aChar;
- Assert(aData = nil);
-end;
-
-procedure TSynCharEvent.LoadFromStream(aStream: TStream);
-begin
- aStream.Read(fKey, SizeOf(Key));
- aStream.Read(fRepeatCount, SizeOf(fRepeatCount));
-end;
-
-procedure TSynCharEvent.Playback(aEditor: TCustomSynEdit);
-var
- i: Integer;
-begin
- for i := 1 to RepeatCount do
- aEditor.CommandProcessor(ecChar, Key, nil);
-end;
-
-procedure TSynCharEvent.SaveToStream(aStream: TStream);
-const
- iCharCommand: TSynEditorCommand = ecChar;
-begin
- aStream.Write(iCharCommand, SizeOf(TSynEditorCommand));
- aStream.Write(Key, SizeOf(Key));
- aStream.Write(RepeatCount, SizeOf(RepeatCount));
-end;
-
-{ TSynPositionEvent }
-
-function TSynPositionEvent.GetAsString: string;
-begin
- Result := inherited GetAsString;
- // add position data here
- Result := Result + Format(' (%d, %d)', [Position.Char, Position.Line]);
- if RepeatCount > 1 then
- Result := Result + ' ' + IntToStr(RepeatCount);
-end;
-
-procedure TSynPositionEvent.InitEventParameters(aStr: string);
-var
- i, o, c, x, y: Integer;
- valStr: string;
-begin
- inherited;
- // aStr should be (x, y) with optional repeat count whitespace separated
- aStr := Trim(aStr);
- i := Pos(',', aStr);
- o := Pos('(', aStr);
- c := Pos(')', aStr);
- if (not ((i = 0) or (o = 0) or (c = 0))) and
- ((i > o) and (i < c)) then
- begin
- valStr := Copy(aStr, o + 1, i - o - 1);
- x := StrToIntDef(valStr, 1);
- Delete(aStr, 1, i);
- aStr := Trim(aStr);
- c := Pos(')', aStr);
- valStr := Copy(aStr, 1, c - 1);
- y := StrToIntDef(valStr, 1);
- Position := BufferCoord(x, y);
- Delete(aStr, 1, c);
- aStr := Trim(aStr);
- RepeatCount := StrToIntDef(aStr, 1);
- end;
-end;
-
-procedure TSynPositionEvent.Initialize(aCmd: TSynEditorCommand;
- aChar: WideChar; aData: Pointer);
-begin
- inherited;
- if aData <> nil then
- Position := TBufferCoord(aData^)
- else
- Position := BufferCoord(0, 0);
-end;
-
-procedure TSynPositionEvent.LoadFromStream(aStream: TStream);
-begin
- aStream.Read(fPosition, SizeOf(Position));
-end;
-
-procedure TSynPositionEvent.Playback(aEditor: TCustomSynEdit);
-begin
- if (Position.Char <> 0) or (Position.Line <> 0) then
- aEditor.CommandProcessor(Command, #0, @Position)
- else
- aEditor.CommandProcessor(Command, #0, nil);
-end;
-
-procedure TSynPositionEvent.SaveToStream(aStream: TStream);
-begin
- inherited;
- aStream.Write(Position, SizeOf(Position));
-end;
-
-{ TSynStringEvent }
-
-function TSynStringEvent.GetAsString: string;
-var
- Ident: string;
-begin
- EditorCommandToIdent(ecString, Ident);
- Result := Ident + ' ' + AnsiQuotedStr(Value, #39);
- if RepeatCount > 1 then
- Result := Result + ' ' + IntToStr(RepeatCount);
-end;
-
-procedure TSynStringEvent.InitEventParameters(aStr: string);
-var
- o, c: Integer;
- valStr: string;
-begin
- // aStr = 'test' with optional whitespace separated repeat count
- o := Pos('''', aStr);
- c := LastDelimiter('''', aStr);
- valStr := Copy(aStr, o + 1, c - o - 1);
- Value := StringReplace(valStr, '''''', '''', [rfReplaceAll]);
- Delete(aStr, 1, c);
- RepeatCount := StrToIntDef(Trim(aStr), 1);
-end;
-
-procedure TSynStringEvent.Initialize(aCmd: TSynEditorCommand; aChar: WideChar;
- aData: Pointer);
-begin
- Value := string(aData);
-end;
-
-procedure TSynStringEvent.LoadFromStream(aStream: TStream);
-var
- l: Integer;
- Buff: PWideChar;
-begin
- aStream.Read(l, sizeof(l));
- GetMem(Buff, l * sizeof(WideChar));
- try
- FillMemory(Buff, l, 0);
- aStream.Read(Buff^, l * sizeof(WideChar));
- fString := Buff;
- finally
- FreeMem(Buff);
- end;
- aStream.Read(fRepeatCount, sizeof(fRepeatCount));
-end;
-
-procedure TSynStringEvent.Playback(aEditor: TCustomSynEdit);
-var
- i, j: Integer;
-begin
- for j := 1 to RepeatCount do
- begin
-// aEditor.CommandProcessor( ecString, #0, Pointer(Value) );
- // SynEdit doesn't actually support the ecString command so we convert
- // it into ecChar commands
- for i := 1 to Length(Value) do
- aEditor.CommandProcessor(ecChar, Value[i], nil);
- end;
-end;
-
-procedure TSynStringEvent.SaveToStream(aStream: TStream);
-const
- StrCommand: TSynEditorCommand = ecString;
-var
- l: Integer;
- Buff: PWideChar;
-begin
- aStream.Write(StrCommand, SizeOf(StrCommand));
- l := Length(Value) + 1;
- aStream.Write(l, sizeof(l));
- GetMem(Buff, l * sizeof(WideChar));
- try
- FillMemory(Buff, l, 0);
- StrCopy(Buff, PWideChar(Value));
- aStream.Write(Buff^, l * sizeof(WideChar));
- finally
- FreeMem(Buff);
- end;
- aStream.Write(RepeatCount, sizeof(RepeatCount));
-end;
-
-
-{ TSynMacroEvent }
-
-constructor TSynMacroEvent.Create;
-begin
- inherited Create;
- fRepeatCount := 1;
-end;
-
end.
diff --git a/Source/SynOmniSetupDialog.dfm b/Source/VCL/Vcl.SynOmniSetupDialog.dfm
similarity index 100%
rename from Source/SynOmniSetupDialog.dfm
rename to Source/VCL/Vcl.SynOmniSetupDialog.dfm
diff --git a/Source/SynOmniSetupDialog.pas b/Source/VCL/Vcl.SynOmniSetupDialog.pas
similarity index 99%
rename from Source/SynOmniSetupDialog.pas
rename to Source/VCL/Vcl.SynOmniSetupDialog.pas
index 927712d3..f1b04131 100644
--- a/Source/SynOmniSetupDialog.pas
+++ b/Source/VCL/Vcl.SynOmniSetupDialog.pas
@@ -1,4 +1,4 @@
-unit SynOmniSetupDialog;
+unit Vcl.SynOmniSetupDialog;
interface
diff --git a/Source/SynSpellCheck.pas b/Source/VCL/Vcl.SynSpellCheck.pas
similarity index 75%
rename from Source/SynSpellCheck.pas
rename to Source/VCL/Vcl.SynSpellCheck.pas
index a9be4a1f..aa618acd 100644
--- a/Source/SynSpellCheck.pas
+++ b/Source/VCL/Vcl.SynSpellCheck.pas
@@ -20,7 +20,7 @@
-------------------------------------------------------------------------------}
-unit SynSpellCheck;
+unit Vcl.SynSpellCheck;
{$I synedit.inc}
{$WARN SYMBOL_PLATFORM OFF}
@@ -36,165 +36,28 @@ interface
Vcl.Graphics,
Vcl.ActnList,
SynEdit,
- SynEditMiscClasses;
-
-{$REGION 'Spell Checking Interfaces'}
-
-// *********************************************************************//
-// GUIDS declared in the TypeLibrary. Following prefixes are used:
-// Type Libraries : LIBID_xxxx
-// CoClasses : CLASS_xxxx
-// DISPInterfaces : DIID_xxxx
-// Non-DISP interfaces: IID_xxxx
-// *********************************************************************//
-const
- IID_ISpellCheckerFactory: TGUID = '{8E018A9D-2415-4677-BF08-794EA61F94BB}';
- IID_IUserDictionariesRegistrar: TGUID = '{AA176B85-0E12-4844-8E1A-EEF1DA77F586}';
- IID_IEnumString: TGUID = '{00000101-0000-0000-C000-000000000046}';
- IID_ISpellChecker: TGUID = '{B6FD0B71-E2BC-4653-8D05-F197E412770B}';
- IID_IEnumSpellingError: TGUID = '{803E3BD4-2828-4410-8290-418D1D73C762}';
- IID_ISpellingError: TGUID = '{B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}';
- IID_ISpellCheckerChangedEventHandler: TGUID = '{0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}';
- IID_IOptionDescription: TGUID = '{432E5F85-35CF-4606-A801-6F70277E1D7A}';
- CLASS_SpellCheckerFactory: TGUID = '{7AB36653-1796-484B-BDFA-E74F1DB7C1DC}';
-
-// *********************************************************************//
-// Declaration of Enumerations defined in Type Library
-// *********************************************************************//
-// Constants for enum CORRECTIVE_ACTION
-type
- CORRECTIVE_ACTION = TOleEnum;
- TCorrectiveAction = (secaNone, secaSuggestions, secaReplace, secaDelete);
-const
- CORRECTIVE_ACTION_NONE = $00000000;
- CORRECTIVE_ACTION_GET_SUGGESTIONS = $00000001;
- CORRECTIVE_ACTION_REPLACE = $00000002;
- CORRECTIVE_ACTION_DELETE = $00000003;
-
-type
-
-// *********************************************************************//
-// Forward declaration of types defined in TypeLibrary
-// *********************************************************************//
- ISpellCheckerFactory = interface;
- IUserDictionariesRegistrar = interface;
- ISpellChecker = interface;
- IEnumSpellingError = interface;
- ISpellingError = interface;
- ISpellCheckerChangedEventHandler = interface;
- IOptionDescription = interface;
-
-// *********************************************************************//
-// Declaration of CoClasses defined in Type Library
-// (NOTE: Here we map each CoClass to its Default Interface)
-// *********************************************************************//
- SpellCheckerFactory = ISpellCheckerFactory;
-
-
-// *********************************************************************//
-// Interface: ISpellCheckerFactory
-// Flags: (0)
-// GUID: {8E018A9D-2415-4677-BF08-794EA61F94BB}
-// *********************************************************************//
- ISpellCheckerFactory = interface(IUnknown)
- ['{8E018A9D-2415-4677-BF08-794EA61F94BB}']
- function Get_SupportedLanguages(out value: IEnumString): HResult; stdcall;
- function IsSupported(languageTag: PWideChar; out value: Integer): HResult; stdcall;
- function CreateSpellChecker(languageTag: PWideChar; out value: ISpellChecker): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IUserDictionariesRegistrar
-// Flags: (0)
-// GUID: {AA176B85-0E12-4844-8E1A-EEF1DA77F586}
-// *********************************************************************//
- IUserDictionariesRegistrar = interface(IUnknown)
- ['{AA176B85-0E12-4844-8E1A-EEF1DA77F586}']
- function RegisterUserDictionary(dictionaryPath: PWideChar; languageTag: PWideChar): HResult; stdcall;
- function UnregisterUserDictionary(dictionaryPath: PWideChar; languageTag: PWideChar): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: ISpellChecker
-// Flags: (0)
-// GUID: {B6FD0B71-E2BC-4653-8D05-F197E412770B}
-// *********************************************************************//
- ISpellChecker = interface(IUnknown)
- ['{B6FD0B71-E2BC-4653-8D05-F197E412770B}']
- function Get_languageTag(out value: PWideChar): HResult; stdcall;
- function Check(text: PWideChar; out value: IEnumSpellingError): HResult; stdcall;
- function Suggest(word: PWideChar; out value: IEnumString): HResult; stdcall;
- function Add(word: PWideChar): HResult; stdcall;
- function Ignore(word: PWideChar): HResult; stdcall;
- function AutoCorrect(from: PWideChar; to_: PWideChar): HResult; stdcall;
- function GetOptionValue(optionId: PWideChar; out value: Byte): HResult; stdcall;
- function Get_OptionIds(out value: IEnumString): HResult; stdcall;
- function Get_Id(out value: PWideChar): HResult; stdcall;
- function Get_LocalizedName(out value: PWideChar): HResult; stdcall;
- function add_SpellCheckerChanged(const handler: ISpellCheckerChangedEventHandler;
- out eventCookie: LongWord): HResult; stdcall;
- function remove_SpellCheckerChanged(eventCookie: LongWord): HResult; stdcall;
- function GetOptionDescription(optionId: PWideChar; out value: IOptionDescription): HResult; stdcall;
- function ComprehensiveCheck(text: PWideChar; out value: IEnumSpellingError): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: ISpellChecker2
-// Flags: (0)
-// GUID: {E7ED1C71-87F7-4378-A840-C9200DACEE47}
-// *********************************************************************//
- ISpellChecker2 = interface(ISpellChecker)
- ['{E7ED1C71-87F7-4378-A840-C9200DACEE47}']
- function Remove(word: PWideChar): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IEnumSpellingError
-// Flags: (0)
-// GUID: {803E3BD4-2828-4410-8290-418D1D73C762}
-// *********************************************************************//
- IEnumSpellingError = interface(IUnknown)
- ['{803E3BD4-2828-4410-8290-418D1D73C762}']
- function Next(out value: ISpellingError): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: ISpellingError
-// Flags: (0)
-// GUID: {B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}
-// *********************************************************************//
- ISpellingError = interface(IUnknown)
- ['{B7C82D61-FBE8-4B47-9B27-6C0D2E0DE0A3}']
- function Get_StartIndex(out value: LongWord): HResult; stdcall;
- function Get_Length(out value: LongWord): HResult; stdcall;
- function Get_CorrectiveAction(out value: CORRECTIVE_ACTION): HResult; stdcall;
- function Get_Replacement(out value: PWideChar): HResult; stdcall;
- end;
+ SynEditMiscClasses,
+ SynSpellCheckTypes,
+ SynSpellCheckWinAPI;
-// *********************************************************************//
-// Interface: ISpellCheckerChangedEventHandler
-// Flags: (0)
-// GUID: {0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}
-// *********************************************************************//
- ISpellCheckerChangedEventHandler = interface(IUnknown)
- ['{0B83A5B0-792F-4EAB-9799-ACF52C5ED08A}']
- function Invoke(const sender: ISpellChecker): HResult; stdcall;
- end;
-
-// *********************************************************************//
-// Interface: IOptionDescription
-// Flags: (0)
-// GUID: {432E5F85-35CF-4606-A801-6F70277E1D7A}
-// *********************************************************************//
- IOptionDescription = interface(IUnknown)
- ['{432E5F85-35CF-4606-A801-6F70277E1D7A}']
- function Get_Id(out value: PWideChar): HResult; stdcall;
- function Get_Heading(out value: PWideChar): HResult; stdcall;
- function Get_Description(out value: PWideChar): HResult; stdcall;
- function Get_Labels(out value: IEnumString): HResult; stdcall;
- end;
+{$REGION 'Spell Checking Type Aliases'}
-{$ENDREGION 'Spell Checking Interfaces'}
+// Re-export COM types so that existing code using Vcl.SynSpellCheck.ISpellChecker
+// etc. continues to compile without changes.
+type
+ ISpellCheckerFactory = SynSpellCheckWinAPI.ISpellCheckerFactory;
+ IUserDictionariesRegistrar = SynSpellCheckWinAPI.IUserDictionariesRegistrar;
+ ISpellChecker = SynSpellCheckWinAPI.ISpellChecker;
+ ISpellChecker2 = SynSpellCheckWinAPI.ISpellChecker2;
+ IEnumSpellingError = SynSpellCheckWinAPI.IEnumSpellingError;
+ ISpellingError = SynSpellCheckWinAPI.ISpellingError;
+ ISpellCheckerChangedEventHandler = SynSpellCheckWinAPI.ISpellCheckerChangedEventHandler;
+ IOptionDescription = SynSpellCheckWinAPI.IOptionDescription;
+ CORRECTIVE_ACTION = SynSpellCheckWinAPI.CORRECTIVE_ACTION;
+ TCorrectiveAction = SynSpellCheckWinAPI.TCorrectiveAction;
+ SpellCheckerFactory = SynSpellCheckWinAPI.ISpellCheckerFactory;
+
+{$ENDREGION 'Spell Checking Type Aliases'}
TUnderlineStyle = (usCorelWordPerfect, usMicrosoftWord);
@@ -234,6 +97,7 @@ TWorkItem = record
private
FLanguageCode: string;
FSpellChecker: ISpellChecker;
+ FProvider: ISynSpellCheckProvider;
FEditor: TCustomSynEdit;
FEditors: TList;
FPlugins: TList;
@@ -251,6 +115,7 @@ TWorkItem = record
procedure SetPenColor(const Value: TColor);
procedure SetUnderlineStyle(const Value: TUnderlineStyle);
procedure SetAttributesChecked(const Value: TStrings);
+ procedure SetProvider(const Value: ISynSpellCheckProvider);
class var FSpellCheckFactory: ISpellCheckerFactory;
procedure SetCheckAsYouType(const Value: Boolean);
protected
@@ -277,6 +142,9 @@ TWorkItem = record
function ErrorAtPos(BC: TBufferCoord): ISpellingError;
// provides access to to the SpellChecker interface
function SpellChecker: ISpellChecker;
+ // Optional provider for plugin-based spell checking (e.g. Hunspell).
+ // When assigned, SpellCheckLine uses Provider.CheckWord instead of COM.
+ property Provider: ISynSpellCheckProvider read FProvider write SetProvider;
property LanguageCode: string read FLanguageCode write SetLanguageCode;
class function SupportedLanguages: TArray;
published
@@ -368,7 +236,7 @@ implementation
System.Math,
System.Win.ComObj,
SynEditTypes,
- SynUnicode,
+ SynUnicodeShared,
SynDWrite,
SynEditMiscProcs,
SynEditHighlighter,
@@ -638,6 +506,15 @@ procedure TSynSpellCheck.SetUnderlineStyle(const Value: TUnderlineStyle);
end;
end;
+procedure TSynSpellCheck.SetProvider(const Value: ISynSpellCheckProvider);
+begin
+ if FProvider <> Value then
+ begin
+ FProvider := Value;
+ Changed;
+ end;
+end;
+
function TSynSpellCheck.SpellChecker: ISpellChecker;
begin
if FDictionaryNA then Exit(nil);
@@ -697,14 +574,46 @@ function TSynSpellCheck.SpellCheckLine(Editor: TCustomSynEdit; Line:
end;
end;
+ procedure ProviderCheckToken(const Token: string; TokenPos: Integer = 0);
+ var
+ Words: TArray;
+ Info: TWordInfo;
+ WordStartChar, WordEndChar: Integer;
+ begin
+ Words := ExtractWords(Token);
+ for Info in Words do
+ begin
+ if not ContainsLetter(Info.Word) then
+ Continue;
+
+ WordStartChar := Info.StartChar + TokenPos;
+ WordEndChar := Info.EndChar + TokenPos;
+
+ if (WordStartChar < StartChar) then Continue;
+ if (WordEndChar > EndChar) then Continue;
+
+ if not FProvider.CheckWord(Info.Word) then
+ begin
+ if ErrorPos < 0 then
+ Editor.Indicators.Add(Line,
+ TSynIndicator.Create(SpellErrorIndicatorId,
+ WordStartChar, WordEndChar), False);
+ // Note: ErrorPos lookup not supported in provider mode (no ISpellingError)
+ end;
+ end;
+ end;
+
var
SLine, Token: string;
Attri: TSynHighlighterAttributes;
TokenPos: Integer;
WorkItem: TWorkItem;
+ UseProvider: Boolean;
begin
Result := nil;
- if not Assigned(SpellChecker()) then Exit;
+ UseProvider := Assigned(FProvider) and FProvider.IsAvailable;
+
+ if not UseProvider and not Assigned(SpellChecker()) then Exit;
SLine := Editor.Lines[Line - 1];
if SLine = '' then Exit;
@@ -737,14 +646,22 @@ function TSynSpellCheck.SpellCheckLine(Editor: TCustomSynEdit; Line:
for WorkItem in FWorkList do
begin
- SpellCheckToken(WorkItem.Token, WorkItem.TokenPos);
+ if UseProvider then
+ ProviderCheckToken(WorkItem.Token, WorkItem.TokenPos)
+ else
+ SpellCheckToken(WorkItem.Token, WorkItem.TokenPos);
// Check if ErrorPos >= 0 and we found the error
if Assigned(Result) then Exit;
end;
end
else
- SpellCheckToken(SLine);
+ begin
+ if UseProvider then
+ ProviderCheckToken(SLine)
+ else
+ SpellCheckToken(SLine);
+ end;
end;
class function TSynSpellCheck.SupportedLanguages: TArray;
@@ -792,7 +709,9 @@ procedure TSpellCheckPlugin.LinePut(aIndex: Integer; const OldLine: string);
begin
if Editor <> FSynSpellCheck.Editor then Exit; // Chained editors
- if Assigned(FSynSpellCheck.SpellChecker()) and FSynSpellCheck.CheckAsYouType then
+ if (Assigned(FSynSpellCheck.SpellChecker()) or
+ (Assigned(FSynSpellCheck.Provider) and FSynSpellCheck.Provider.IsAvailable))
+ and FSynSpellCheck.CheckAsYouType then
begin
Line := Editor.Lines[aIndex];
LineDiff(Line, OldLine, StartingPos, Len1, Len2);
@@ -807,7 +726,9 @@ procedure TSpellCheckPlugin.LinesInserted(FirstLine, Count: Integer);
begin
if Editor <> FSynSpellCheck.Editor then Exit;
- if Assigned(FSynSpellCheck.SpellChecker()) and FSynSpellCheck.CheckAsYouType then
+ if (Assigned(FSynSpellCheck.SpellChecker()) or
+ (Assigned(FSynSpellCheck.Provider) and FSynSpellCheck.Provider.IsAvailable))
+ and FSynSpellCheck.CheckAsYouType then
for Line := FirstLine + 1 to FirstLine + Count do
FSynSpellCheck.SpellCheckLine(Editor, Line);
end;
diff --git a/Source/SynURIOpener.pas b/Source/VCL/Vcl.SynURIOpener.pas
similarity index 99%
rename from Source/SynURIOpener.pas
rename to Source/VCL/Vcl.SynURIOpener.pas
index 73ecc53c..b7fdd895 100644
--- a/Source/SynURIOpener.pas
+++ b/Source/VCL/Vcl.SynURIOpener.pas
@@ -40,7 +40,7 @@
http://www.mh-net.de.vu
}
-unit SynURIOpener;
+unit Vcl.SynURIOpener;
{$I SynEdit.inc}
@@ -52,7 +52,7 @@ interface
SynEditTypes,
SynEdit,
SynHighlighterURI,
- SynUnicode,
+ SynUnicodeShared,
Classes;
type
@@ -101,7 +101,7 @@ implementation
ShellAPI,
Forms,
SynEditHighlighter,
- SynEditKeyConst,
+ SynEditKeyConstShared,
SysUtils;
type
diff --git a/Source/VCL/Vcl.SynUnicode.pas b/Source/VCL/Vcl.SynUnicode.pas
new file mode 100644
index 00000000..a769ed7d
--- /dev/null
+++ b/Source/VCL/Vcl.SynUnicode.pas
@@ -0,0 +1,121 @@
+{-------------------------------------------------------------------------------
+VCL Unicode facade for SynEdit.
+
+Re-exports the encoding types, constants, and helper functions from
+SynUnicodeShared and adds VCL-specific clipboard routines (Vcl.Clipbrd).
+This lets VCL consumer code 'uses Vcl.SynUnicode' as a single import
+without needing to know about the shared/VCL split.
+
+The shared unit was renamed to SynUnicodeShared because Delphi's scope
+resolution makes a bare 'SynUnicode' shadow this 'Vcl.SynUnicode' unit
+(exact name match wins), which broke the intended layering.
+-------------------------------------------------------------------------------}
+
+unit Vcl.SynUnicode;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ SynUnicodeShared;
+
+{ Re-exported constants from SynUnicodeShared }
+const
+ WideNull = SynUnicodeShared.WideNull;
+ WideTab = SynUnicodeShared.WideTab;
+ WideSpace = SynUnicodeShared.WideSpace;
+ WideLF = SynUnicodeShared.WideLF;
+ WideLineFeed = SynUnicodeShared.WideLineFeed;
+ WideVerticalTab = SynUnicodeShared.WideVerticalTab;
+ WideFormFeed = SynUnicodeShared.WideFormFeed;
+ WideCR = SynUnicodeShared.WideCR;
+ WideCarriageReturn = SynUnicodeShared.WideCarriageReturn;
+ WideCRLF = SynUnicodeShared.WideCRLF;
+ WideLineSeparator = SynUnicodeShared.WideLineSeparator;
+ WideParagraphSeparator = SynUnicodeShared.WideParagraphSeparator;
+
+{ Re-exported types from SynUnicodeShared }
+type
+ TSynEncoding = SynUnicodeShared.TSynEncoding;
+ TSynEncodings = SynUnicodeShared.TSynEncodings;
+
+{ Re-exported functions from SynUnicodeShared }
+procedure StrSwapByteOrder(Str: PWideChar); inline;
+function IsAnsiOnly(const WS: string): Boolean; inline;
+function IsUTF8(Stream: TStream; out WithBOM: Boolean; BytesToCheck: Integer = $4000): Boolean; overload; inline;
+function IsUTF8(const FileName: string; out WithBOM: Boolean; BytesToCheck: Integer = $4000): Boolean; overload; inline;
+function IsUTF8(const Bytes: TBytes; Start: Integer = 0; BytesToCheck: Integer = $4000): Boolean; overload; inline;
+function GetEncoding(const FileName: string; out WithBOM: Boolean): TEncoding; overload; inline;
+function GetEncoding(Stream: TStream; out WithBOM: Boolean): TEncoding; overload; inline;
+function IsWideCharMappableToAnsi(const WC: WideChar): Boolean; inline;
+
+{ VCL clipboard functions }
+function ClipboardProvidesText: Boolean;
+function GetClipboardText: string;
+procedure SetClipboardText(const Text: string);
+
+implementation
+
+uses
+ Winapi.Windows,
+ Vcl.Clipbrd;
+
+procedure StrSwapByteOrder(Str: PWideChar);
+begin
+ SynUnicodeShared.StrSwapByteOrder(Str);
+end;
+
+function IsAnsiOnly(const WS: string): Boolean;
+begin
+ Result := SynUnicodeShared.IsAnsiOnly(WS);
+end;
+
+function IsUTF8(Stream: TStream; out WithBOM: Boolean; BytesToCheck: Integer): Boolean;
+begin
+ Result := SynUnicodeShared.IsUTF8(Stream, WithBOM, BytesToCheck);
+end;
+
+function IsUTF8(const FileName: string; out WithBOM: Boolean; BytesToCheck: Integer): Boolean;
+begin
+ Result := SynUnicodeShared.IsUTF8(FileName, WithBOM, BytesToCheck);
+end;
+
+function IsUTF8(const Bytes: TBytes; Start: Integer; BytesToCheck: Integer): Boolean;
+begin
+ Result := SynUnicodeShared.IsUTF8(Bytes, Start, BytesToCheck);
+end;
+
+function GetEncoding(const FileName: string; out WithBOM: Boolean): TEncoding;
+begin
+ Result := SynUnicodeShared.GetEncoding(FileName, WithBOM);
+end;
+
+function GetEncoding(Stream: TStream; out WithBOM: Boolean): TEncoding;
+begin
+ Result := SynUnicodeShared.GetEncoding(Stream, WithBOM);
+end;
+
+function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
+begin
+ Result := SynUnicodeShared.IsWideCharMappableToAnsi(WC);
+end;
+
+function ClipboardProvidesText: Boolean;
+begin
+ Result := IsClipboardFormatAvailable(CF_UNICODETEXT);
+end;
+
+function GetClipboardText: string;
+begin
+ Result := Clipboard.AsText;
+end;
+
+procedure SetClipboardText(const Text: string);
+begin
+ Clipboard.AsText := Text;
+end;
+
+end.
diff --git a/Tests/FMX/FMXSynEditTests.dpr b/Tests/FMX/FMXSynEditTests.dpr
new file mode 100644
index 00000000..741cc350
--- /dev/null
+++ b/Tests/FMX/FMXSynEditTests.dpr
@@ -0,0 +1,71 @@
+program FMXSynEditTests;
+
+{$APPTYPE CONSOLE}
+{$STRONGLINKTYPES ON}
+
+uses
+ System.SysUtils,
+ FMX.Forms,
+ DUnitX.Loggers.Console,
+ DUnitX.Loggers.Xml.NUnit,
+ DUnitX.TestFramework,
+ TestFMXSynEditBuffer in 'TestFMXSynEditBuffer.pas',
+ TestFMXSynEditContent in 'TestFMXSynEditContent.pas',
+ TestFMXSynEditCaret in 'TestFMXSynEditCaret.pas',
+ TestFMXSynEditUndoRedo in 'TestFMXSynEditUndoRedo.pas',
+ TestFMXSynEditOptions in 'TestFMXSynEditOptions.pas',
+ TestFMXSynEditSearch in 'TestFMXSynEditSearch.pas',
+ TestFMXSynEditCodeFolding in 'TestFMXSynEditCodeFolding.pas',
+ TestFMXSynEditHighlighter in 'TestFMXSynEditHighlighter.pas',
+ TestFMXSynEditCommands in 'TestFMXSynEditCommands.pas',
+ TestFMXSynSpellCheck in 'TestFMXSynSpellCheck.pas',
+ TestFMXSynWindowsSpellCheck in 'TestFMXSynWindowsSpellCheck.pas',
+ TestFMXSynSpellCheckComponent in 'TestFMXSynSpellCheckComponent.pas',
+ TestFMXSynEditBugFixes in 'TestFMXSynEditBugFixes.pas',
+ TestFMXSynEditSelection in 'TestFMXSynEditSelection.pas',
+ TestFMXSynEditClipboard in 'TestFMXSynEditClipboard.pas',
+ TestFMXSynEditEditing in 'TestFMXSynEditEditing.pas',
+ TestFMXSynEditRenderer in 'TestFMXSynEditRenderer.pas',
+ TestFMXSynEditCompletionProposal in 'TestFMXSynEditCompletionProposal.pas',
+ TestSynHighlighterDelphiFolding in 'TestSynHighlighterDelphiFolding.pas',
+ TestSynHighlighterHTMLFolding in 'TestSynHighlighterHTMLFolding.pas',
+ TestSynHighlighterXMLFolding in 'TestSynHighlighterXMLFolding.pas',
+ TestSynHighlighterCSSFolding in 'TestSynHighlighterCSSFolding.pas',
+ TestFMXSynEditWordWrap in 'TestFMXSynEditWordWrap.pas',
+ TestFMXSynEditBookmarks in 'TestFMXSynEditBookmarks.pas',
+ TestFMXSynEditGutter in 'TestFMXSynEditGutter.pas',
+ TestFMXSynEditMultiCaret in 'TestFMXSynEditMultiCaret.pas',
+ TestFMXSynEditDragDrop in 'TestFMXSynEditDragDrop.pas',
+ TestFMXSynMacroRecorder in 'TestFMXSynMacroRecorder.pas';
+
+var
+ Runner: ITestRunner;
+ Results: IRunResults;
+ Logger: ITestLogger;
+ NUnitLogger: ITestLogger;
+begin
+ // FMX platform services must be initialized before creating TFMXSynEdit
+ Application.Initialize;
+ try
+ TDUnitX.CheckCommandLine;
+ Runner := TDUnitX.CreateRunner;
+ Logger := TDUnitXConsoleLogger.Create(True);
+ Runner.AddLogger(Logger);
+ NUnitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
+ Runner.AddLogger(NUnitLogger);
+ Runner.FailsOnNoAsserts := True;
+ Results := Runner.Execute;
+ if not Results.AllPassed then
+ System.ExitCode := 1;
+ {$IFNDEF CI}
+ if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
+ begin
+ System.Write('Done.. press key to quit.');
+ System.Readln;
+ end;
+ {$ENDIF}
+ except
+ on E: Exception do
+ System.Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/Tests/FMX/FMXSynEditTests.dproj b/Tests/FMX/FMXSynEditTests.dproj
new file mode 100644
index 00000000..d46fc820
--- /dev/null
+++ b/Tests/FMX/FMXSynEditTests.dproj
@@ -0,0 +1,129 @@
+
+
+ True
+ Console
+ Debug
+ DCC32
+ FMX
+ FMXSynEditTests.dpr
+ Win32
+ {8E7F6A5B-4C3D-2E1F-0A9B-8C7D6E5F4A3B}
+ FMXSynEditTests
+ 20.3
+ 3
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ FMXSynEditTests
+ ..\dcu\$(Platform)\$(Config)\
+ ..\bin\$(Platform)\$(Config)\
+ SYN_SHARED;$(DCC_Define)
+ FMX;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
+ ..\..\Source;..\..\Source\FMX;..\..\Source\Highlighters;$(DCC_UnitSearchPath)
+
+
+ Debug
+ System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ Debug
+ System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ 0
+ RELEASE;$(DCC_Define)
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+
+ Delphi.Personality.12
+ Application
+
+
+
+ FMXSynEditTests.dpr
+
+
+
+ True
+ True
+
+
+
+
diff --git a/Tests/FMX/TestFMXSynEditBookmarks.pas b/Tests/FMX/TestFMXSynEditBookmarks.pas
new file mode 100644
index 00000000..a2f0f006
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditBookmarks.pas
@@ -0,0 +1,252 @@
+unit TestFMXSynEditBookmarks;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditBookmarks = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestSetBookmark;
+ [Test]
+ procedure TestSetBookmarkUpdates;
+ [Test]
+ procedure TestClearBookmark;
+ [Test]
+ procedure TestGotoBookmark;
+ [Test]
+ procedure TestIsBookmarkSet;
+ [Test]
+ procedure TestGetBookmarkFalseWhenEmpty;
+ [Test]
+ procedure TestMultipleBookmarks;
+ [Test]
+ procedure TestToggleOnSameLine;
+ [Test]
+ procedure TestToggleDifferentLine;
+ [Test]
+ procedure TestAllTenBookmarks;
+ [Test]
+ procedure TestMarkListOwnership;
+ [Test]
+ procedure TestGotoBookmarkUnset;
+ [Test]
+ procedure TestBookmarkAfterClearAll;
+ [Test]
+ procedure TestMarksForLine;
+ [Test]
+ procedure TestBookmarkLineClamp;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Math,
+ SynEditTypes,
+ SynEditKeyCmds,
+ FMX.SynEditMiscClasses;
+
+const
+ SampleText =
+ 'Line one' + sLineBreak +
+ 'Line two' + sLineBreak +
+ 'Line three' + sLineBreak +
+ 'Line four' + sLineBreak +
+ 'Line five';
+
+procedure TTestFMXSynEditBookmarks.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := SampleText;
+end;
+
+procedure TTestFMXSynEditBookmarks.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditBookmarks.TestSetBookmark;
+var
+ X, Y: Integer;
+begin
+ FEditor.SetBookmark(0, 5, 2);
+ Assert.IsTrue(FEditor.GetBookmark(0, X, Y));
+ Assert.AreEqual(5, X);
+ Assert.AreEqual(2, Y);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestSetBookmarkUpdates;
+var
+ X, Y: Integer;
+begin
+ FEditor.SetBookmark(0, 1, 1);
+ FEditor.SetBookmark(0, 3, 4);
+ Assert.IsTrue(FEditor.GetBookmark(0, X, Y));
+ Assert.AreEqual(3, X);
+ Assert.AreEqual(4, Y);
+ // Mark list should still have only one entry
+ Assert.AreEqual(1, FEditor.Marks.Count);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestClearBookmark;
+begin
+ FEditor.SetBookmark(1, 1, 1);
+ Assert.IsTrue(FEditor.IsBookmarkSet(1));
+ FEditor.ClearBookmark(1);
+ Assert.IsFalse(FEditor.IsBookmarkSet(1));
+end;
+
+procedure TTestFMXSynEditBookmarks.TestGotoBookmark;
+begin
+ FEditor.SetBookmark(2, 5, 3);
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.GotoBookmark(2);
+ Assert.AreEqual(5, FEditor.CaretX);
+ Assert.AreEqual(3, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestIsBookmarkSet;
+begin
+ Assert.IsFalse(FEditor.IsBookmarkSet(0));
+ FEditor.SetBookmark(0, 1, 1);
+ Assert.IsTrue(FEditor.IsBookmarkSet(0));
+end;
+
+procedure TTestFMXSynEditBookmarks.TestGetBookmarkFalseWhenEmpty;
+var
+ X, Y: Integer;
+begin
+ Assert.IsFalse(FEditor.GetBookmark(5, X, Y));
+end;
+
+procedure TTestFMXSynEditBookmarks.TestMultipleBookmarks;
+var
+ X, Y: Integer;
+begin
+ FEditor.SetBookmark(0, 1, 1);
+ FEditor.SetBookmark(1, 2, 2);
+ FEditor.SetBookmark(2, 3, 3);
+ FEditor.SetBookmark(3, 4, 4);
+
+ Assert.IsTrue(FEditor.GetBookmark(0, X, Y));
+ Assert.AreEqual(1, Y);
+ Assert.IsTrue(FEditor.GetBookmark(1, X, Y));
+ Assert.AreEqual(2, Y);
+ Assert.IsTrue(FEditor.GetBookmark(2, X, Y));
+ Assert.AreEqual(3, Y);
+ Assert.IsTrue(FEditor.GetBookmark(3, X, Y));
+ Assert.AreEqual(4, Y);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestToggleOnSameLine;
+begin
+ // Set bookmark on line 2
+ FEditor.SetBookmark(0, 1, 2);
+ Assert.IsTrue(FEditor.IsBookmarkSet(0));
+
+ // Move caret to same line and execute ecSetMarker0 — should toggle off
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecSetMarker0, #0);
+ Assert.IsFalse(FEditor.IsBookmarkSet(0));
+end;
+
+procedure TTestFMXSynEditBookmarks.TestToggleDifferentLine;
+var
+ X, Y: Integer;
+begin
+ // Set bookmark on line 1
+ FEditor.SetBookmark(0, 1, 1);
+
+ // Move caret to line 3 and execute ecSetMarker0 — should move bookmark
+ FEditor.CaretXY := BufferCoord(4, 3);
+ FEditor.ExecuteCommand(ecSetMarker0, #0);
+ Assert.IsTrue(FEditor.IsBookmarkSet(0));
+ Assert.IsTrue(FEditor.GetBookmark(0, X, Y));
+ Assert.AreEqual(3, Y);
+ Assert.AreEqual(4, X);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestAllTenBookmarks;
+begin
+ for var I := 0 to 9 do
+ FEditor.SetBookmark(I, 1, Min(I + 1, FEditor.LineCount));
+
+ for var I := 0 to 9 do
+ Assert.IsTrue(FEditor.IsBookmarkSet(I),
+ Format('Bookmark %d should be set', [I]));
+
+ Assert.AreEqual(10, FEditor.Marks.Count);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestMarkListOwnership;
+begin
+ FEditor.SetBookmark(0, 1, 1);
+ FEditor.SetBookmark(3, 2, 2);
+ Assert.AreEqual(2, FEditor.Marks.Count);
+
+ FEditor.ClearBookmark(0);
+ Assert.AreEqual(1, FEditor.Marks.Count);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestGotoBookmarkUnset;
+begin
+ // Should be a no-op — caret stays at (1,1)
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.GotoBookmark(5);
+ Assert.AreEqual(1, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestBookmarkAfterClearAll;
+begin
+ FEditor.SetBookmark(0, 1, 1);
+ FEditor.SetBookmark(1, 2, 2);
+ FEditor.ClearAll;
+ Assert.IsFalse(FEditor.IsBookmarkSet(0));
+ Assert.IsFalse(FEditor.IsBookmarkSet(1));
+ Assert.AreEqual(0, FEditor.Marks.Count);
+end;
+
+procedure TTestFMXSynEditBookmarks.TestMarksForLine;
+var
+ LineMarks: TArray;
+begin
+ FEditor.SetBookmark(0, 1, 2);
+ FEditor.SetBookmark(3, 5, 2);
+ FEditor.SetBookmark(5, 1, 4);
+
+ LineMarks := FEditor.Marks.GetMarksForLine(2);
+ Assert.AreEqual(2, Length(LineMarks));
+
+ LineMarks := FEditor.Marks.GetMarksForLine(4);
+ Assert.AreEqual(1, Length(LineMarks));
+
+ LineMarks := FEditor.Marks.GetMarksForLine(1);
+ Assert.AreEqual(0, Length(LineMarks));
+end;
+
+procedure TTestFMXSynEditBookmarks.TestBookmarkLineClamp;
+var
+ X, Y: Integer;
+begin
+ // Set bookmark beyond line count — should clamp
+ FEditor.SetBookmark(0, 1, 999);
+ Assert.IsTrue(FEditor.GetBookmark(0, X, Y));
+ Assert.AreEqual(FEditor.LineCount, Y);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditBookmarks);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditBuffer.pas b/Tests/FMX/TestFMXSynEditBuffer.pas
new file mode 100644
index 00000000..626a3d63
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditBuffer.pas
@@ -0,0 +1,138 @@
+unit TestFMXSynEditBuffer;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditBuffer = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestLinesInitiallyEmpty;
+ [Test]
+ procedure TestAddSingle;
+ [Test]
+ procedure TestAddMultiple;
+ [Test]
+ procedure TestInsert;
+ [Test]
+ procedure TestDelete;
+ [Test]
+ procedure TestCount;
+ [Test]
+ procedure TestClear;
+ [Test]
+ procedure TestTextProperty;
+ [Test]
+ procedure TestIndexAccess;
+ [Test]
+ procedure TestLineCountMatchesLines;
+ end;
+
+implementation
+
+uses
+ System.SysUtils;
+
+procedure TTestFMXSynEditBuffer.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditBuffer.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditBuffer.TestLinesInitiallyEmpty;
+begin
+ Assert.AreEqual(0, FEditor.Lines.Count);
+end;
+
+procedure TTestFMXSynEditBuffer.TestAddSingle;
+begin
+ FEditor.Lines.Add('Hello');
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ Assert.AreEqual('Hello', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditBuffer.TestAddMultiple;
+begin
+ FEditor.Lines.Add('Line1');
+ FEditor.Lines.Add('Line2');
+ FEditor.Lines.Add('Line3');
+ Assert.AreEqual(3, FEditor.Lines.Count);
+end;
+
+procedure TTestFMXSynEditBuffer.TestInsert;
+begin
+ FEditor.Lines.Add('First');
+ FEditor.Lines.Add('Third');
+ FEditor.Lines.Insert(1, 'Second');
+ Assert.AreEqual(3, FEditor.Lines.Count);
+ Assert.AreEqual('Second', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXSynEditBuffer.TestDelete;
+begin
+ FEditor.Lines.Add('Keep');
+ FEditor.Lines.Add('Remove');
+ FEditor.Lines.Delete(1);
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ Assert.AreEqual('Keep', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditBuffer.TestCount;
+begin
+ Assert.AreEqual(0, FEditor.Lines.Count);
+ FEditor.Lines.Add('A');
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ FEditor.Lines.Add('B');
+ Assert.AreEqual(2, FEditor.Lines.Count);
+end;
+
+procedure TTestFMXSynEditBuffer.TestClear;
+begin
+ FEditor.Lines.Add('Something');
+ FEditor.Lines.Add('Else');
+ FEditor.Lines.Clear;
+ Assert.AreEqual(0, FEditor.Lines.Count);
+end;
+
+procedure TTestFMXSynEditBuffer.TestTextProperty;
+begin
+ FEditor.Lines.Text := 'Line1' + sLineBreak + 'Line2';
+ Assert.AreEqual(2, FEditor.Lines.Count);
+ Assert.AreEqual('Line1', FEditor.Lines[0]);
+ Assert.AreEqual('Line2', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXSynEditBuffer.TestIndexAccess;
+begin
+ FEditor.Lines.Add('Zero');
+ FEditor.Lines.Add('One');
+ FEditor.Lines.Add('Two');
+ Assert.AreEqual('Zero', FEditor.Lines[0]);
+ Assert.AreEqual('One', FEditor.Lines[1]);
+ Assert.AreEqual('Two', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXSynEditBuffer.TestLineCountMatchesLines;
+begin
+ FEditor.Text := 'A' + sLineBreak + 'B' + sLineBreak + 'C';
+ Assert.AreEqual(FEditor.Lines.Count, FEditor.LineCount);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditBuffer);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditBugFixes.pas b/Tests/FMX/TestFMXSynEditBugFixes.pas
new file mode 100644
index 00000000..5e5f23c7
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditBugFixes.pas
@@ -0,0 +1,963 @@
+unit TestFMXSynEditBugFixes;
+
+interface
+
+uses
+ System.Classes,
+ System.UITypes,
+ FMX.Types,
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ { Tests for blocking bugs identified in the FMX port review }
+
+ [TestFixture]
+ TTestPluginRegistration = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestPluginAutoRegisters;
+ [Test]
+ procedure TestPluginAutoUnregistersOnFree;
+ [Test]
+ procedure TestPluginHandlersSetViaConstructor;
+ [Test]
+ procedure TestPluginDefaultHandlersEmpty;
+ [Test]
+ procedure TestPluginAfterPaintDispatch;
+ end;
+
+ [TestFixture]
+ TTestModifiedProperty = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestModifiedInitiallyFalse;
+ [Test]
+ procedure TestModifiedTrueAfterEdit;
+ [Test]
+ procedure TestModifiedFalseAfterSaveReset;
+ [Test]
+ procedure TestModifiedDiffersFromCanUndo;
+ [Test]
+ procedure TestCanUndoTrueWhenModifiedFalse;
+ end;
+
+ [TestFixture]
+ TTestTextBufferNilWidthFunc = class
+ public
+ [Test]
+ procedure TestGetTextWidthWithNilFunc;
+ [Test]
+ procedure TestGetMaxWidthWithNilFunc;
+ [Test]
+ procedure TestPutWithNilFunc;
+ end;
+
+ [TestFixture]
+ TTestTabExpansion = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestMaxScrollWidthWithTabs;
+ [Test]
+ procedure TestMaxScrollWidthNoTabs;
+ [Test]
+ procedure TestMaxScrollWidthMixedLines;
+ [Test]
+ procedure TestExpandTabsAtColumnBoundary;
+ [Test]
+ procedure TestExpandTabsMidColumn;
+ end;
+
+ [TestFixture]
+ TTestAutoIndentTabs = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestAutoIndentPreservesLeadingTabs;
+ [Test]
+ procedure TestAutoIndentPreservesMixedWhitespace;
+ [Test]
+ procedure TestAutoIndentWithSpacesStillWorks;
+ [Test]
+ procedure TestNoAutoIndentWhenDisabled;
+ end;
+
+ [TestFixture]
+ TTestPixelToBufferCoord = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestClickLeftOfCharBoundary;
+ [Test]
+ procedure TestClickRightOfCharBoundary;
+ [Test]
+ procedure TestClickExactlyOnCharBoundary;
+ [Test]
+ procedure TestClickInGutterClampsToOne;
+ end;
+
+ [TestFixture]
+ TTestScrollBarSizing = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestLinesInWindowDeltaNoScrollBars;
+ [Test]
+ procedure TestCharsInWindowDeltaNoScrollBars;
+ [Test]
+ procedure TestScrollBarsHiddenInitially;
+ end;
+
+ { Tests for cross-platform fixes (issues 13-15) }
+ [TestFixture]
+ TTestCrossPlatformFixes = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ { Issue 13: Selection colors should not use Windows system colors }
+ [Test]
+ procedure TestSelectionBGNotSystemColor;
+ [Test]
+ procedure TestSelectionFGNotSystemColor;
+ [Test]
+ procedure TestSelectionBGIsExplicitARGB;
+ [Test]
+ procedure TestSelectionFGIsExplicitARGB;
+ { Issue 15: BlockBegin/BlockEnd should be writable }
+ [Test]
+ procedure TestBlockBeginWritable;
+ [Test]
+ procedure TestBlockEndWritable;
+ [Test]
+ procedure TestBlockBeginResetsBlockEnd;
+ [Test]
+ procedure TestBlockBeginClampsToMin;
+ [Test]
+ procedure TestSetSelectionViaProperties;
+ end;
+
+ [TestFixture]
+ TTestKeyboardHandlerChain = class
+ private
+ FEditor: TFMXSynEdit;
+ FHandlerCalled: Boolean;
+ FHandlerKey: Word;
+ FUserHandlerCalled: Boolean;
+ procedure KeyDownHandler(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure ConsumingKeyDownHandler(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure UserOnKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestAddKeyDownHandlerIsCalled;
+ [Test]
+ procedure TestRemoveKeyDownHandler;
+ [Test]
+ procedure TestMultipleHandlersBothCalled;
+ [Test]
+ procedure TestConsumingHandlerStopsChain;
+ [Test]
+ procedure TestOnKeyDownPreservedWithHandler;
+ end;
+
+implementation
+
+uses
+ System.Types,
+ System.SysUtils,
+ System.Math,
+ FMX.Graphics,
+ SynEditTypes,
+ SynEditKeyCmds,
+ SynEditTextBuffer,
+ FMX.SynEditMiscClasses;
+
+type
+ // Helper to access protected KeyDown for testing
+ TTestFMXSynEdit = class(TFMXSynEdit)
+ public
+ procedure DoKeyDown(var Key: Word; var KeyChar: WideChar;
+ Shift: TShiftState);
+ end;
+
+procedure TTestFMXSynEdit.DoKeyDown(var Key: Word; var KeyChar: WideChar;
+ Shift: TShiftState);
+begin
+ KeyDown(Key, KeyChar, Shift);
+end;
+
+{ ---- Bug 1: Plugin auto-registration ---- }
+
+type
+ { Access class to reach protected DoPluginAfterPaint for testing }
+ TFMXSynEditAccess = class(TCustomFMXSynEdit);
+
+ TTestPlugin = class(TSynFMXEditPlugin)
+ public
+ AfterPaintCalled: Boolean;
+ procedure AfterPaint(Canvas: TCanvas; const AClip: TRectF;
+ FirstLine, LastLine: Integer); override;
+ end;
+
+procedure TTestPlugin.AfterPaint(Canvas: TCanvas; const AClip: TRectF;
+ FirstLine, LastLine: Integer);
+begin
+ AfterPaintCalled := True;
+end;
+
+procedure TTestPluginRegistration.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestPluginRegistration.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestPluginRegistration.TestPluginAutoRegisters;
+var
+ Plugin: TTestPlugin;
+begin
+ // Creating a plugin with an owner should auto-register it
+ Plugin := TTestPlugin.Create(FEditor, [phAfterPaint]);
+ try
+ // Verify it was registered: unregister should succeed without error
+ FEditor.UnregisterPlugin(Plugin);
+ // Re-register manually to confirm the API works
+ FEditor.RegisterPlugin(Plugin);
+ Assert.IsTrue(Plugin.Owner = FEditor,
+ 'Plugin should be owned by the editor after registration');
+ finally
+ // Destructor will auto-unregister
+ Plugin.Free;
+ end;
+end;
+
+procedure TTestPluginRegistration.TestPluginAutoUnregistersOnFree;
+var
+ Plugin: TTestPlugin;
+begin
+ Plugin := TTestPlugin.Create(FEditor, [phAfterPaint]);
+ // Free should auto-unregister - should not AV or leave dangling pointer
+ Plugin.Free;
+ // Editor should still be usable after plugin is freed
+ FEditor.Text := 'test';
+ Assert.AreEqual('test', FEditor.Lines[0]);
+end;
+
+procedure TTestPluginRegistration.TestPluginHandlersSetViaConstructor;
+var
+ Plugin: TTestPlugin;
+begin
+ Plugin := TTestPlugin.Create(FEditor, [phAfterPaint, phLinesInserted]);
+ try
+ Assert.IsTrue(phAfterPaint in Plugin.Handlers);
+ Assert.IsTrue(phLinesInserted in Plugin.Handlers);
+ Assert.IsFalse(phLinesDeleted in Plugin.Handlers);
+ finally
+ Plugin.Free;
+ end;
+end;
+
+procedure TTestPluginRegistration.TestPluginDefaultHandlersEmpty;
+var
+ Plugin: TTestPlugin;
+begin
+ Plugin := TTestPlugin.Create(FEditor);
+ try
+ Assert.IsTrue(Plugin.Handlers = [],
+ 'Default handlers should be empty set');
+ finally
+ Plugin.Free;
+ end;
+end;
+
+procedure TTestPluginRegistration.TestPluginAfterPaintDispatch;
+var
+ Plugin: TTestPlugin;
+ Helper: TFMXSynEditAccess;
+begin
+ // Tests that DoPluginAfterPaint actually dispatches to registered plugins
+ Plugin := TTestPlugin.Create(FEditor, [phAfterPaint]);
+ try
+ Assert.IsFalse(Plugin.AfterPaintCalled,
+ 'AfterPaint should not be called before dispatch');
+ // DoPluginAfterPaint is protected; use a cast to access it
+ Helper := TFMXSynEditAccess(FEditor);
+ Helper.DoPluginAfterPaint(nil, TRectF.Empty, 1, 1);
+ Assert.IsTrue(Plugin.AfterPaintCalled,
+ 'AfterPaint should be called after DoPluginAfterPaint dispatch');
+ finally
+ Plugin.Free;
+ end;
+end;
+
+{ ---- Bug 2: Modified property ---- }
+
+procedure TTestModifiedProperty.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestModifiedProperty.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestModifiedProperty.TestModifiedInitiallyFalse;
+begin
+ Assert.IsFalse(FEditor.Modified,
+ 'New editor should not be modified');
+end;
+
+procedure TTestModifiedProperty.TestModifiedTrueAfterEdit;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FEditor.Modified,
+ 'Editor should be modified after typing');
+end;
+
+procedure TTestModifiedProperty.TestModifiedFalseAfterSaveReset;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FEditor.Modified);
+ // Simulate save by resetting Modified via the undo interface
+ FEditor.UndoRedo.Modified := False;
+ Assert.IsFalse(FEditor.Modified,
+ 'Modified should be False after save reset');
+end;
+
+procedure TTestModifiedProperty.TestModifiedDiffersFromCanUndo;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FEditor.Modified);
+ Assert.IsTrue(FEditor.CanUndo);
+ // Reset Modified (simulating save) - CanUndo should remain True
+ FEditor.UndoRedo.Modified := False;
+ Assert.IsFalse(FEditor.Modified,
+ 'Modified should be False after reset');
+ Assert.IsTrue(FEditor.CanUndo,
+ 'CanUndo should still be True - undo stack was not cleared');
+end;
+
+procedure TTestModifiedProperty.TestCanUndoTrueWhenModifiedFalse;
+begin
+ // This is the key test: the old bug had Modified = CanUndo
+ FEditor.Text := 'AB';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ // Simulate save
+ FEditor.UndoRedo.Modified := False;
+ // After save: Modified=False, CanUndo=True (they must differ)
+ Assert.IsFalse(FEditor.Modified, 'Modified should be False after save');
+ Assert.IsTrue(FEditor.CanUndo, 'CanUndo should be True (undo stack exists)');
+ Assert.AreNotEqual(FEditor.Modified, FEditor.CanUndo,
+ 'Modified and CanUndo should differ after save');
+end;
+
+{ ---- Bug 4: TSynEditStringList nil FTextWidthFunc ---- }
+
+procedure TTestTextBufferNilWidthFunc.TestGetTextWidthWithNilFunc;
+var
+ Lines: TSynEditStringList;
+begin
+ Lines := TSynEditStringList.Create(nil);
+ try
+ Lines.Add('Hello World');
+ // GetTextWidth should not crash - should fall back to Length
+ Assert.AreEqual(11, Lines.TextWidth[0],
+ 'TextWidth with nil func should return string length');
+ finally
+ Lines.Free;
+ end;
+end;
+
+procedure TTestTextBufferNilWidthFunc.TestGetMaxWidthWithNilFunc;
+var
+ Lines: TSynEditStringList;
+begin
+ Lines := TSynEditStringList.Create(nil);
+ try
+ Lines.Add('Short');
+ Lines.Add('A longer line');
+ // MaxWidth should not crash - should use Length fallback
+ Assert.AreEqual(13, Lines.MaxWidth,
+ 'MaxWidth with nil func should use string length');
+ finally
+ Lines.Free;
+ end;
+end;
+
+procedure TTestTextBufferNilWidthFunc.TestPutWithNilFunc;
+var
+ Lines: TSynEditStringList;
+begin
+ Lines := TSynEditStringList.Create(nil);
+ try
+ Lines.Add('Original');
+ // Force a width calculation to initialize MaxWidth
+ Lines.MaxWidth;
+ // Put triggers width recalculation via FTextWidthFunc
+ Lines[0] := 'Replacement text';
+ // Should not crash, and TextWidth should reflect new length
+ Assert.AreEqual(16, Lines.TextWidth[0],
+ 'TextWidth after Put with nil func should return new length');
+ finally
+ Lines.Free;
+ end;
+end;
+
+{ ---- Bugs 5 & 6: Tab expansion ---- }
+
+procedure TTestTabExpansion.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.TabWidth := 8;
+ // Disable eoTabsToSpaces so literal tabs stay in buffer
+ FEditor.Options := FEditor.Options - [eoTabsToSpaces];
+end;
+
+procedure TTestTabExpansion.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestTabExpansion.TestMaxScrollWidthWithTabs;
+begin
+ // Tab at column 0 expands to 8 spaces, "AB" is 2 chars = 10 visual columns
+ FEditor.Text := #9'AB';
+ // MaxScrollWidth should use expanded length (10), not raw length (3)
+ Assert.AreEqual(11, FEditor.MaxScrollWidth,
+ 'MaxScrollWidth should be 11 for tab(8)+AB(2)+1');
+end;
+
+procedure TTestTabExpansion.TestMaxScrollWidthNoTabs;
+begin
+ FEditor.Text := 'ABCDEFGHIJ'; // 10 chars, no tabs
+ Assert.AreEqual(11, FEditor.MaxScrollWidth,
+ 'MaxScrollWidth should be 11 for 10-char line+1');
+end;
+
+procedure TTestTabExpansion.TestMaxScrollWidthMixedLines;
+begin
+ // Line 1: 5 chars. Line 2: tab(8) + 5 = 13 visual.
+ FEditor.Text := 'Hello' + sLineBreak + #9'World';
+ Assert.AreEqual(14, FEditor.MaxScrollWidth,
+ 'MaxScrollWidth should be 14 for tab(8)+World(5)+1');
+end;
+
+procedure TTestTabExpansion.TestExpandTabsAtColumnBoundary;
+begin
+ // "12345678\tX" - tab at column 8 should expand to 8 spaces (next tab stop)
+ // Total: 8 + 8 + 1 = 17 visual columns
+ FEditor.Text := '12345678'#9'X';
+ Assert.AreEqual(18, FEditor.MaxScrollWidth,
+ 'MaxScrollWidth should be 18 for 8chars+tab(8)+X(1)+1');
+end;
+
+procedure TTestTabExpansion.TestExpandTabsMidColumn;
+begin
+ // "123\tX" - tab at column 3, expands to 5 spaces (to reach column 8)
+ // Total: 3 + 5 + 1 = 9 visual columns (but "123" occupies cols 0-2,
+ // tab fills cols 3-7, X at col 8 = 9 visual columns)
+ FEditor.Text := '123'#9'X';
+ Assert.AreEqual(10, FEditor.MaxScrollWidth,
+ 'MaxScrollWidth should be 10 for 123(3)+tab(5)+X(1)+1');
+end;
+
+{ ---- Bug 7: Keyboard handler chain ---- }
+
+procedure TTestKeyboardHandlerChain.Setup;
+begin
+ FEditor := TTestFMXSynEdit.Create(nil);
+ FHandlerCalled := False;
+ FHandlerKey := 0;
+ FUserHandlerCalled := False;
+end;
+
+procedure TTestKeyboardHandlerChain.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestKeyboardHandlerChain.KeyDownHandler(Sender: TObject;
+ var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ FHandlerCalled := True;
+ FHandlerKey := Key;
+end;
+
+procedure TTestKeyboardHandlerChain.ConsumingKeyDownHandler(Sender: TObject;
+ var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ FHandlerCalled := True;
+ FHandlerKey := Key;
+ // Consume the key
+ Key := 0;
+ KeyChar := #0;
+end;
+
+procedure TTestKeyboardHandlerChain.UserOnKeyDown(Sender: TObject;
+ var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ FUserHandlerCalled := True;
+end;
+
+procedure TTestKeyboardHandlerChain.TestAddKeyDownHandlerIsCalled;
+var
+ Key: Word;
+ KeyChar: WideChar;
+begin
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ try
+ // Simulate a key press through KeyDown
+ Key := vkReturn;
+ KeyChar := #0;
+ TTestFMXSynEdit(FEditor).DoKeyDown(Key, KeyChar, []);
+ Assert.IsTrue(FHandlerCalled,
+ 'KeyDown handler should have been called');
+ Assert.AreEqual(Word(vkReturn), FHandlerKey,
+ 'Handler should receive the correct key');
+ finally
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ end;
+end;
+
+procedure TTestKeyboardHandlerChain.TestRemoveKeyDownHandler;
+var
+ Key: Word;
+ KeyChar: WideChar;
+begin
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ Key := vkReturn;
+ KeyChar := #0;
+ TTestFMXSynEdit(FEditor).DoKeyDown(Key, KeyChar, []);
+ Assert.IsFalse(FHandlerCalled,
+ 'Removed handler should not be called');
+end;
+
+procedure TTestKeyboardHandlerChain.TestMultipleHandlersBothCalled;
+var
+ Key: Word;
+ KeyChar: WideChar;
+begin
+ // Register the same non-consuming handler twice to verify both fire
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ try
+ FHandlerCalled := False;
+ Key := vkReturn;
+ KeyChar := #0;
+ TTestFMXSynEdit(FEditor).DoKeyDown(Key, KeyChar, []);
+ Assert.IsTrue(FHandlerCalled,
+ 'Handler should be called when multiple handlers registered');
+ finally
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ end;
+end;
+
+procedure TTestKeyboardHandlerChain.TestConsumingHandlerStopsChain;
+var
+ Key: Word;
+ KeyChar: WideChar;
+begin
+ // Add a non-consuming handler first (it runs last since chain is LIFO)
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ // Add a consuming handler second (it runs first in LIFO order)
+ FEditor.AddKeyDownHandler(ConsumingKeyDownHandler);
+ try
+ FHandlerCalled := False;
+ Key := vkReturn;
+ KeyChar := #0;
+ TTestFMXSynEdit(FEditor).DoKeyDown(Key, KeyChar, []);
+ // The consuming handler should have been called
+ Assert.IsTrue(FHandlerCalled,
+ 'Consuming handler should have been called');
+ // Key should be consumed (set to 0)
+ Assert.AreEqual(Word(0), Key,
+ 'Key should be consumed by handler');
+ finally
+ FEditor.RemoveKeyDownHandler(ConsumingKeyDownHandler);
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ end;
+end;
+
+procedure TTestKeyboardHandlerChain.TestOnKeyDownPreservedWithHandler;
+var
+ Key: Word;
+ KeyChar: WideChar;
+begin
+ // This is the key test: assigning OnKeyDown and adding a handler
+ // should NOT destroy the OnKeyDown handler
+ FEditor.OnKeyDown := UserOnKeyDown;
+ FEditor.AddKeyDownHandler(KeyDownHandler);
+ try
+ Assert.IsTrue(Assigned(FEditor.OnKeyDown),
+ 'OnKeyDown should still be assigned after AddKeyDownHandler');
+
+ // Simulate a key press
+ Key := vkReturn;
+ KeyChar := #0;
+ TTestFMXSynEdit(FEditor).DoKeyDown(Key, KeyChar, []);
+
+ Assert.IsTrue(FHandlerCalled,
+ 'Chain handler should have been called');
+ // The OnKeyDown fires via inherited KeyDown, which is called first
+ Assert.IsTrue(FUserHandlerCalled,
+ 'User OnKeyDown handler should still be called');
+ finally
+ FEditor.RemoveKeyDownHandler(KeyDownHandler);
+ end;
+
+ // After removing chain handler, OnKeyDown should still be intact
+ Assert.IsTrue(Assigned(FEditor.OnKeyDown),
+ 'OnKeyDown should still be assigned after RemoveKeyDownHandler');
+end;
+
+{ ---- Auto-indent with tabs ---- }
+
+procedure TTestAutoIndentTabs.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ Assert.IsTrue(eoAutoIndent in FEditor.Options, 'eoAutoIndent should be on by default');
+ // Disable eoTabsToSpaces so literal tabs stay in the buffer
+ FEditor.Options := FEditor.Options - [eoTabsToSpaces];
+end;
+
+procedure TTestAutoIndentTabs.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestAutoIndentTabs.TestAutoIndentPreservesLeadingTabs;
+begin
+ FEditor.Text := #9'indented';
+ FEditor.CaretXY := BufferCoord(10, 1); // end of line
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(2, FEditor.LineCount);
+ Assert.AreEqual(#9, Copy(FEditor.Lines[1], 1, 1),
+ 'New line should start with a tab from auto-indent');
+end;
+
+procedure TTestAutoIndentTabs.TestAutoIndentPreservesMixedWhitespace;
+begin
+ FEditor.Text := #9' mixed';
+ FEditor.CaretXY := BufferCoord(9, 1); // end of line
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(2, FEditor.LineCount);
+ Assert.AreEqual(#9' ', Copy(FEditor.Lines[1], 1, 3),
+ 'New line should preserve tab+spaces from auto-indent');
+end;
+
+procedure TTestAutoIndentTabs.TestAutoIndentWithSpacesStillWorks;
+begin
+ FEditor.Text := ' spaced';
+ FEditor.CaretXY := BufferCoord(11, 1);
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(2, FEditor.LineCount);
+ Assert.AreEqual(' ', Copy(FEditor.Lines[1], 1, 4),
+ 'Auto-indent should still work with spaces');
+end;
+
+procedure TTestAutoIndentTabs.TestNoAutoIndentWhenDisabled;
+begin
+ FEditor.Options := FEditor.Options - [eoAutoIndent];
+ FEditor.Text := #9'indented';
+ FEditor.CaretXY := BufferCoord(10, 1);
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(2, FEditor.LineCount);
+ Assert.AreEqual('', FEditor.Lines[1],
+ 'No auto-indent should produce empty new line');
+end;
+
+{ ---- PixelToBufferCoord ---- }
+
+procedure TTestPixelToBufferCoord.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'ABCDEFGHIJ';
+ FEditor.Width := 500;
+ FEditor.Height := 300;
+end;
+
+procedure TTestPixelToBufferCoord.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestPixelToBufferCoord.TestClickLeftOfCharBoundary;
+var
+ BC: TBufferCoord;
+ Char3Px: TPointF;
+begin
+ // Get exact pixel position of char 3
+ Char3Px := FEditor.BufferCoordToPixel(BufferCoord(3, 1));
+ // Click slightly left of char 3 start — should map to char 2, not char 3
+ BC := FEditor.PixelToBufferCoord(Char3Px.X - 1, Char3Px.Y);
+ Assert.AreEqual(2, BC.Char,
+ 'Clicking 1px left of char 3 should map to char 2 (Trunc behavior)');
+end;
+
+procedure TTestPixelToBufferCoord.TestClickRightOfCharBoundary;
+var
+ BC: TBufferCoord;
+ Char3Px: TPointF;
+begin
+ // Click just past the start of char 3
+ Char3Px := FEditor.BufferCoordToPixel(BufferCoord(3, 1));
+ BC := FEditor.PixelToBufferCoord(Char3Px.X + 1, Char3Px.Y);
+ Assert.AreEqual(3, BC.Char,
+ 'Clicking 1px right of char 3 start should map to char 3');
+end;
+
+procedure TTestPixelToBufferCoord.TestClickExactlyOnCharBoundary;
+var
+ BC: TBufferCoord;
+ Char3Px: TPointF;
+begin
+ // Click exactly on the start of char 3
+ Char3Px := FEditor.BufferCoordToPixel(BufferCoord(3, 1));
+ BC := FEditor.PixelToBufferCoord(Char3Px.X, Char3Px.Y);
+ Assert.AreEqual(3, BC.Char,
+ 'Clicking exactly on char 3 start should map to char 3');
+end;
+
+procedure TTestPixelToBufferCoord.TestClickInGutterClampsToOne;
+var
+ BC: TBufferCoord;
+begin
+ // Click at X = 0 (gutter area) — should clamp to char 1
+ BC := FEditor.PixelToBufferCoord(0, 0);
+ Assert.AreEqual(1, BC.Char,
+ 'Clicking in gutter should clamp to char 1');
+end;
+
+{ ---- Scrollbar conditional sizing ---- }
+
+procedure TTestScrollBarSizing.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Width := 400;
+ FEditor.Height := 300;
+end;
+
+procedure TTestScrollBarSizing.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestScrollBarSizing.TestLinesInWindowDeltaNoScrollBars;
+var
+ Lines300, Lines400: Integer;
+ ExpectedDelta: Integer;
+begin
+ // Short content — no scrollbars should appear
+ FEditor.Text := 'Short';
+ FEditor.Height := 300;
+ Lines300 := FEditor.LinesInWindow;
+ FEditor.Height := 400;
+ Lines400 := FEditor.LinesInWindow;
+ // Increasing height by 100 should gain exactly Trunc(100/LineHeight) lines
+ ExpectedDelta := Integer(Trunc(100 / FEditor.LineHeight));
+ Assert.AreEqual(ExpectedDelta, Lines400 - Lines300,
+ 'LinesInWindow delta should match full height delta when no scrollbar');
+end;
+
+procedure TTestScrollBarSizing.TestCharsInWindowDeltaNoScrollBars;
+var
+ CharsNarrow, CharsWide: Integer;
+begin
+ // Short content — no vertical scrollbar should appear
+ FEditor.Text := 'Short';
+ FEditor.Width := 300;
+ CharsNarrow := FEditor.CharsInWindow;
+ FEditor.Width := 500;
+ CharsWide := FEditor.CharsInWindow;
+ // Adding 200px should gain roughly 200/CharWidth chars (within 1 of rounding)
+ Assert.IsTrue(Abs((CharsWide - CharsNarrow) * FEditor.CharWidth - 200) < FEditor.CharWidth,
+ 'CharsInWindow delta should reflect full width change when no scrollbar');
+end;
+
+procedure TTestScrollBarSizing.TestScrollBarsHiddenInitially;
+var
+ LinesShort, LinesManyShort: Integer;
+begin
+ // Verify that adding more short lines (that don't need a horizontal
+ // scrollbar) doesn't reduce LinesInWindow. If the vertical scrollbar
+ // were incorrectly shown for short content, LinesInWindow would shrink.
+ FEditor.Text := 'Short';
+ FEditor.Height := 300;
+ LinesShort := FEditor.LinesInWindow;
+
+ // 5 short lines — still fits in window, no scrollbar needed
+ FEditor.Text := 'A' + sLineBreak + 'B' + sLineBreak + 'C' +
+ sLineBreak + 'D' + sLineBreak + 'E';
+ LinesManyShort := FEditor.LinesInWindow;
+
+ Assert.AreEqual(LinesShort, LinesManyShort,
+ 'LinesInWindow should not change when adding lines that still fit');
+end;
+
+{ ---- Cross-platform fixes (issues 13-15) ---- }
+
+procedure TTestCrossPlatformFixes.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'hello world' + sLineBreak + 'second line';
+end;
+
+procedure TTestCrossPlatformFixes.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestCrossPlatformFixes.TestSelectionBGNotSystemColor;
+begin
+ // Issue 13: Default selection background should NOT be a system color
+ // (system colors have the SystemColor flag bit set and rely on platform
+ // APIs to resolve, which may fail on non-Windows FMX targets)
+ Assert.AreNotEqual(TColor(TColors.SysHighlight),
+ FEditor.SelectedColor.Background,
+ 'Default selection BG should not be clHighlight system color');
+end;
+
+procedure TTestCrossPlatformFixes.TestSelectionFGNotSystemColor;
+begin
+ Assert.AreNotEqual(TColor(TColors.SysHighlightText),
+ FEditor.SelectedColor.Foreground,
+ 'Default selection FG should not be clHighlightText system color');
+end;
+
+procedure TTestCrossPlatformFixes.TestSelectionBGIsExplicitARGB;
+begin
+ // TColor uses BGR format where system colors have negative values (high bit
+ // set). Explicit colors are non-negative (>= 0). Verify the default is
+ // not a system color so TColorToAlphaColor can convert it on any platform.
+ Assert.IsTrue(Integer(FEditor.SelectedColor.Background) >= 0,
+ 'Selection BG should be a non-negative TColor (not a system color)');
+end;
+
+procedure TTestCrossPlatformFixes.TestSelectionFGIsExplicitARGB;
+begin
+ Assert.IsTrue(Integer(FEditor.SelectedColor.Foreground) >= 0,
+ 'Selection FG should be a non-negative TColor (not a system color)');
+end;
+
+procedure TTestCrossPlatformFixes.TestBlockBeginWritable;
+var
+ BB: TBufferCoord;
+begin
+ // Issue 15: BlockBegin should be writable
+ BB := BufferCoord(3, 1);
+ FEditor.BlockBegin := BB;
+ Assert.AreEqual(3, FEditor.BlockBegin.Char);
+ Assert.AreEqual(1, FEditor.BlockBegin.Line);
+end;
+
+procedure TTestCrossPlatformFixes.TestBlockEndWritable;
+var
+ BE: TBufferCoord;
+begin
+ FEditor.BlockBegin := BufferCoord(1, 1);
+ BE := BufferCoord(6, 1);
+ FEditor.BlockEnd := BE;
+ Assert.AreEqual(6, FEditor.BlockEnd.Char);
+ Assert.AreEqual(1, FEditor.BlockEnd.Line);
+end;
+
+procedure TTestCrossPlatformFixes.TestBlockBeginResetsBlockEnd;
+begin
+ // Setting BlockBegin should also reset BlockEnd to the same value
+ // (matching VCL behavior — starting a new selection)
+ FEditor.BlockBegin := BufferCoord(1, 1);
+ FEditor.BlockEnd := BufferCoord(6, 1);
+ // Now set a new BlockBegin — BlockEnd should be reset
+ FEditor.BlockBegin := BufferCoord(3, 2);
+ Assert.AreEqual(FEditor.BlockBegin.Char, FEditor.BlockEnd.Char,
+ 'BlockEnd.Char should equal BlockBegin.Char after SetBlockBegin');
+ Assert.AreEqual(FEditor.BlockBegin.Line, FEditor.BlockEnd.Line,
+ 'BlockEnd.Line should equal BlockBegin.Line after SetBlockBegin');
+end;
+
+procedure TTestCrossPlatformFixes.TestBlockBeginClampsToMin;
+begin
+ // Setting BlockBegin with invalid coordinates should clamp to 1
+ FEditor.BlockBegin := BufferCoord(-5, 0);
+ Assert.IsTrue(FEditor.BlockBegin.Char >= 1, 'BlockBegin.Char should be >= 1');
+ Assert.IsTrue(FEditor.BlockBegin.Line >= 1, 'BlockBegin.Line should be >= 1');
+end;
+
+procedure TTestCrossPlatformFixes.TestSetSelectionViaProperties;
+begin
+ // Test setting selection entirely via BlockBegin/BlockEnd properties
+ FEditor.BlockBegin := BufferCoord(1, 1);
+ FEditor.BlockEnd := BufferCoord(6, 1);
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be available');
+ Assert.AreEqual('hello', FEditor.SelText,
+ 'Selected text should be "hello"');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestPluginRegistration);
+ TDUnitX.RegisterTestFixture(TTestModifiedProperty);
+ TDUnitX.RegisterTestFixture(TTestTextBufferNilWidthFunc);
+ TDUnitX.RegisterTestFixture(TTestTabExpansion);
+ TDUnitX.RegisterTestFixture(TTestAutoIndentTabs);
+ TDUnitX.RegisterTestFixture(TTestPixelToBufferCoord);
+ TDUnitX.RegisterTestFixture(TTestScrollBarSizing);
+ TDUnitX.RegisterTestFixture(TTestKeyboardHandlerChain);
+ TDUnitX.RegisterTestFixture(TTestCrossPlatformFixes);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditCaret.pas b/Tests/FMX/TestFMXSynEditCaret.pas
new file mode 100644
index 00000000..d3053bbf
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditCaret.pas
@@ -0,0 +1,150 @@
+unit TestFMXSynEditCaret;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditCaret = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestInitialPosition;
+ [Test]
+ procedure TestSetCaretXY;
+ [Test]
+ procedure TestCaretClampedToMin1;
+ [Test]
+ procedure TestSelectAll;
+ [Test]
+ procedure TestSelAvailAfterSelectAll;
+ [Test]
+ procedure TestSelTextAfterSelectAll;
+ [Test]
+ procedure TestSetCaretAndSelection;
+ [Test]
+ procedure TestBlockBeginBlockEnd;
+ [Test]
+ procedure TestClearSelection;
+ [Test]
+ procedure TestGetTextRange;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes;
+
+procedure TTestFMXSynEditCaret.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditCaret.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditCaret.TestInitialPosition;
+begin
+ Assert.AreEqual(1, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCaret.TestSetCaretXY;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.CaretXY := BufferCoord(6, 1);
+ Assert.AreEqual(6, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCaret.TestCaretClampedToMin1;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretX := 0;
+ Assert.IsTrue(FEditor.CaretX >= 1);
+ FEditor.CaretY := 0;
+ Assert.IsTrue(FEditor.CaretY >= 1);
+end;
+
+procedure TTestFMXSynEditCaret.TestSelectAll;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SelectAll;
+ Assert.IsTrue(FEditor.SelAvail);
+end;
+
+procedure TTestFMXSynEditCaret.TestSelAvailAfterSelectAll;
+begin
+ FEditor.Text := 'Line1' + sLineBreak + 'Line2';
+ FEditor.SelectAll;
+ Assert.IsTrue(FEditor.SelAvail);
+end;
+
+procedure TTestFMXSynEditCaret.TestSelTextAfterSelectAll;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.SelectAll;
+ Assert.AreEqual('Hello', FEditor.SelText);
+end;
+
+procedure TTestFMXSynEditCaret.TestSetCaretAndSelection;
+var
+ BC1, BC2, BCCaret: TBufferCoord;
+begin
+ FEditor.Text := 'Hello World';
+ BC1 := BufferCoord(1, 1);
+ BC2 := BufferCoord(6, 1);
+ BCCaret := BufferCoord(6, 1);
+ FEditor.SetCaretAndSelection(BCCaret, BC1, BC2);
+ Assert.AreEqual(6, FEditor.CaretX);
+ Assert.IsTrue(FEditor.SelAvail);
+ Assert.AreEqual('Hello', FEditor.SelText);
+end;
+
+procedure TTestFMXSynEditCaret.TestBlockBeginBlockEnd;
+var
+ BC1, BC2, BCCaret: TBufferCoord;
+begin
+ FEditor.Text := 'ABCDEF';
+ BC1 := BufferCoord(2, 1);
+ BC2 := BufferCoord(5, 1);
+ BCCaret := BufferCoord(5, 1);
+ FEditor.SetCaretAndSelection(BCCaret, BC1, BC2);
+ Assert.AreEqual(2, FEditor.BlockBegin.Char);
+ Assert.AreEqual(5, FEditor.BlockEnd.Char);
+end;
+
+procedure TTestFMXSynEditCaret.TestClearSelection;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SelectAll;
+ Assert.IsTrue(FEditor.SelAvail);
+ FEditor.ClearSelection;
+ Assert.IsFalse(FEditor.SelAvail);
+end;
+
+procedure TTestFMXSynEditCaret.TestGetTextRange;
+var
+ BC1, BC2: TBufferCoord;
+begin
+ FEditor.Text := 'ABCDEFGH';
+ BC1 := BufferCoord(3, 1);
+ BC2 := BufferCoord(6, 1);
+ Assert.AreEqual('CDE', FEditor.GetTextRange(BC1, BC2));
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditCaret);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditClipboard.pas b/Tests/FMX/TestFMXSynEditClipboard.pas
new file mode 100644
index 00000000..40e82019
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditClipboard.pas
@@ -0,0 +1,203 @@
+unit TestFMXSynEditClipboard;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditClipboard = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestCopySetsClipboard;
+ [Test]
+ procedure TestCopyWithNoSelection;
+ [Test]
+ procedure TestCutRemovesTextAndSetsClipboard;
+ [Test]
+ procedure TestCutInReadOnly;
+ [Test]
+ procedure TestPasteInsertsText;
+ [Test]
+ procedure TestPasteReplacesSelection;
+ [Test]
+ procedure TestPasteMultiLine;
+ [Test]
+ procedure TestPasteInReadOnly;
+ [Test]
+ procedure TestCutIsUndoable;
+ [Test]
+ procedure TestPasteIsUndoable;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds,
+ FMX.SynUnicode;
+
+procedure TTestFMXSynEditClipboard.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Hello World' + sLineBreak +
+ 'Second line';
+end;
+
+procedure TTestFMXSynEditClipboard.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditClipboard.TestCopySetsClipboard;
+begin
+ // Select "Hello" and copy
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual('Hello', FEditor.SelText);
+ FEditor.CopyToClipboard;
+ Assert.AreEqual('Hello', GetClipboardText,
+ 'Clipboard should contain selected text');
+ // Text should be unchanged
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Copy should not modify text');
+end;
+
+procedure TTestFMXSynEditClipboard.TestCopyWithNoSelection;
+var
+ OrigClipboard: string;
+begin
+ // Set clipboard to known value
+ SetClipboardText('before');
+ OrigClipboard := GetClipboardText;
+ // No selection — copy should be a no-op
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.CopyToClipboard;
+ Assert.AreEqual(OrigClipboard, GetClipboardText,
+ 'Clipboard should not change when nothing is selected');
+end;
+
+procedure TTestFMXSynEditClipboard.TestCutRemovesTextAndSetsClipboard;
+begin
+ // Select "Hello" and cut
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.CutToClipboard;
+ Assert.AreEqual('Hello', GetClipboardText,
+ 'Clipboard should contain cut text');
+ Assert.AreEqual(' World', FEditor.Lines[0],
+ 'Cut text should be removed from editor');
+end;
+
+procedure TTestFMXSynEditClipboard.TestCutInReadOnly;
+begin
+ FEditor.ReadOnly := True;
+ // Select "Hello"
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ SetClipboardText('before');
+ FEditor.CutToClipboard;
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Cut should not modify text in read-only mode');
+ Assert.AreEqual('before', GetClipboardText,
+ 'Clipboard should not change in read-only mode');
+end;
+
+procedure TTestFMXSynEditClipboard.TestPasteInsertsText;
+begin
+ SetClipboardText('ABC');
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.PasteFromClipboard;
+ Assert.AreEqual('ABCHello World', FEditor.Lines[0],
+ 'Paste should insert clipboard text at caret');
+end;
+
+procedure TTestFMXSynEditClipboard.TestPasteReplacesSelection;
+begin
+ SetClipboardText('Goodbye');
+ // Select "Hello"
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.PasteFromClipboard;
+ Assert.AreEqual('Goodbye World', FEditor.Lines[0],
+ 'Paste should replace selected text');
+end;
+
+procedure TTestFMXSynEditClipboard.TestPasteMultiLine;
+begin
+ SetClipboardText('ABC' + sLineBreak + 'DEF');
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.PasteFromClipboard;
+ Assert.AreEqual('ABC', FEditor.Lines[0],
+ 'First pasted line');
+ Assert.AreEqual('DEFHello World', FEditor.Lines[1],
+ 'Second pasted line should be joined with original');
+end;
+
+procedure TTestFMXSynEditClipboard.TestPasteInReadOnly;
+begin
+ FEditor.ReadOnly := True;
+ SetClipboardText('ABC');
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.PasteFromClipboard;
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Paste should not modify text in read-only mode');
+end;
+
+procedure TTestFMXSynEditClipboard.TestCutIsUndoable;
+begin
+ // Select "Hello" and cut
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.CutToClipboard;
+ Assert.AreEqual(' World', FEditor.Lines[0]);
+ // Undo should restore
+ FEditor.Undo;
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Undo should restore text after cut');
+end;
+
+procedure TTestFMXSynEditClipboard.TestPasteIsUndoable;
+begin
+ SetClipboardText('ABC');
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.PasteFromClipboard;
+ Assert.AreEqual('ABCHello World', FEditor.Lines[0]);
+ FEditor.Undo;
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Undo should restore text after paste');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditClipboard);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditCodeFolding.pas b/Tests/FMX/TestFMXSynEditCodeFolding.pas
new file mode 100644
index 00000000..8b3aed83
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditCodeFolding.pas
@@ -0,0 +1,166 @@
+unit TestFMXSynEditCodeFolding;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit,
+ SynHighlighterJSON;
+
+type
+ [TestFixture]
+ TTestFMXSynEditCodeFolding = class
+ private
+ FEditor: TFMXSynEdit;
+ FHighlighter: TSynJSONSyn;
+ procedure SetupFoldableContent;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestFoldRangesDetected;
+ [Test]
+ procedure TestCollapseAll;
+ [Test]
+ procedure TestUncollapseAll;
+ [Test]
+ procedure TestUseCodeFoldingRequiresHighlighter;
+ [Test]
+ procedure TestCollapseLevel;
+ [Test]
+ procedure TestUncollapseLevel;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditCodeFolding;
+
+const
+ // JSON with nested braces and brackets for fold testing
+ SampleJSON =
+ '{' + sLineBreak +
+ ' "name": "test",' + sLineBreak +
+ ' "items": [' + sLineBreak +
+ ' 1,' + sLineBreak +
+ ' 2,' + sLineBreak +
+ ' 3' + sLineBreak +
+ ' ]' + sLineBreak +
+ '}';
+
+procedure TTestFMXSynEditCodeFolding.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FHighlighter := TSynJSONSyn.Create(nil);
+end;
+
+procedure TTestFMXSynEditCodeFolding.TearDown;
+begin
+ FEditor.Free;
+ FHighlighter.Free;
+end;
+
+procedure TTestFMXSynEditCodeFolding.SetupFoldableContent;
+begin
+ FEditor.Highlighter := FHighlighter;
+ FEditor.Text := SampleJSON;
+ // UseCodeFolding must be set AFTER Text so that SetUseCodeFolding
+ // triggers FullFoldScan with text and highlighter both in place
+ FEditor.UseCodeFolding := True;
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestFoldRangesDetected;
+begin
+ SetupFoldableContent;
+ // JSON sample has 2 fold regions: outer {} and inner []
+ Assert.AreEqual(2, FEditor.AllFoldRanges.Count,
+ 'Should detect 2 fold ranges (braces and brackets) in JSON');
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestCollapseAll;
+var
+ I: Integer;
+ CollapsedCount: Integer;
+begin
+ SetupFoldableContent;
+ FEditor.CollapseAll;
+ CollapsedCount := 0;
+ for I := 0 to FEditor.AllFoldRanges.Count - 1 do
+ if FEditor.AllFoldRanges[I].Collapsed then
+ Inc(CollapsedCount);
+ Assert.AreEqual(FEditor.AllFoldRanges.Count, CollapsedCount,
+ 'All fold ranges should be collapsed after CollapseAll');
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestUncollapseAll;
+var
+ I: Integer;
+ AnyCollapsed: Boolean;
+begin
+ SetupFoldableContent;
+ FEditor.CollapseAll;
+ FEditor.UncollapseAll;
+ AnyCollapsed := False;
+ for I := 0 to FEditor.AllFoldRanges.Count - 1 do
+ if FEditor.AllFoldRanges[I].Collapsed then
+ begin
+ AnyCollapsed := True;
+ Break;
+ end;
+ Assert.IsFalse(AnyCollapsed, 'No fold ranges should be collapsed after UncollapseAll');
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestUseCodeFoldingRequiresHighlighter;
+begin
+ // Without a highlighter, UseCodeFolding should not produce fold ranges
+ FEditor.UseCodeFolding := True;
+ FEditor.Text := SampleJSON;
+ Assert.AreEqual(0, FEditor.AllFoldRanges.Count,
+ 'No fold ranges without a highlighter');
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestCollapseLevel;
+var
+ I: Integer;
+ CollapsedCount: Integer;
+begin
+ SetupFoldableContent;
+ // Level 1 = outermost folds
+ FEditor.CollapseLevel(1);
+ CollapsedCount := 0;
+ for I := 0 to FEditor.AllFoldRanges.Count - 1 do
+ if FEditor.AllFoldRanges[I].Collapsed then
+ Inc(CollapsedCount);
+ Assert.IsTrue(CollapsedCount >= 1,
+ 'CollapseLevel(1) should collapse at least one fold range');
+ // Verify not all ranges collapsed (inner range is level 2)
+ Assert.IsTrue(CollapsedCount < FEditor.AllFoldRanges.Count,
+ 'CollapseLevel(1) should not collapse nested (level 2) ranges');
+end;
+
+procedure TTestFMXSynEditCodeFolding.TestUncollapseLevel;
+var
+ I: Integer;
+ AnyCollapsed: Boolean;
+begin
+ SetupFoldableContent;
+ FEditor.CollapseLevel(1);
+ FEditor.UncollapseLevel(1);
+ AnyCollapsed := False;
+ for I := 0 to FEditor.AllFoldRanges.Count - 1 do
+ if FEditor.AllFoldRanges[I].Collapsed then
+ begin
+ AnyCollapsed := True;
+ Break;
+ end;
+ Assert.IsFalse(AnyCollapsed,
+ 'UncollapseLevel(1) should uncollapse top-level folds');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditCodeFolding);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditCommands.pas b/Tests/FMX/TestFMXSynEditCommands.pas
new file mode 100644
index 00000000..4589a5cd
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditCommands.pas
@@ -0,0 +1,197 @@
+unit TestFMXSynEditCommands;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditCommands = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestEcCharInserts;
+ [Test]
+ procedure TestEcDeleteChar;
+ [Test]
+ procedure TestEcDeleteLastChar;
+ [Test]
+ procedure TestEcLineBreak;
+ [Test]
+ procedure TestEcLineBreakAutoIndent;
+ [Test]
+ procedure TestEcTabInsertsSpaces;
+ [Test]
+ procedure TestEcTabInsertsTabChar;
+ [Test]
+ procedure TestEcShiftTabRemovesIndent;
+ [Test]
+ procedure TestEcLeft;
+ [Test]
+ procedure TestEcRight;
+ [Test]
+ procedure TestEcUp;
+ [Test]
+ procedure TestEcDown;
+ [Test]
+ procedure TestEcLineStart;
+ [Test]
+ procedure TestEcLineEnd;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditCommands.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Line one' + sLineBreak +
+ 'Line two' + sLineBreak +
+ 'Line three';
+end;
+
+procedure TTestFMXSynEditCommands.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditCommands.TestEcCharInserts;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('XLine one', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcDeleteChar;
+begin
+ // Delete first character of line 1
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.AreEqual('ine one', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcDeleteLastChar;
+begin
+ // Backspace at position 2 on line 1 should delete the 'L'
+ FEditor.CaretXY := BufferCoord(2, 1);
+ FEditor.ExecuteCommand(ecDeleteLastChar, #0);
+ Assert.AreEqual('ine one', FEditor.Lines[0]);
+ Assert.AreEqual(1, FEditor.CaretX);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcLineBreak;
+var
+ OrigLineCount: Integer;
+begin
+ OrigLineCount := FEditor.LineCount;
+ FEditor.CaretXY := BufferCoord(5, 1);
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(OrigLineCount + 1, FEditor.LineCount);
+ Assert.AreEqual('Line', FEditor.Lines[0]);
+ Assert.AreEqual(' one', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcLineBreakAutoIndent;
+begin
+ Assert.IsTrue(eoAutoIndent in FEditor.Options);
+ // Set line with leading spaces
+ FEditor.Text := ' indented';
+ FEditor.CaretXY := BufferCoord(11, 1); // end of 'indented' (2 spaces + 8 chars = pos 11)
+ FEditor.ExecuteCommand(ecLineBreak, #0);
+ Assert.AreEqual(2, FEditor.LineCount);
+ // New line should have auto-indentation
+ Assert.IsTrue(FEditor.Lines[1].StartsWith(' '),
+ 'Auto-indent should preserve leading whitespace');
+end;
+
+procedure TTestFMXSynEditCommands.TestEcTabInsertsSpaces;
+begin
+ // Default options include eoTabsToSpaces
+ Assert.IsTrue(eoTabsToSpaces in FEditor.Options);
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecTab, #0);
+ // Tab at position 1 with default TabWidth inserts spaces to next tab stop
+ Assert.AreEqual(' Hello', FEditor.Lines[0],
+ 'Tab should insert spaces before text');
+end;
+
+procedure TTestFMXSynEditCommands.TestEcTabInsertsTabChar;
+begin
+ FEditor.Options := FEditor.Options - [eoTabsToSpaces];
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecTab, #0);
+ Assert.AreEqual(#9'Hello', FEditor.Lines[0],
+ 'Without eoTabsToSpaces, tab should insert tab character');
+end;
+
+procedure TTestFMXSynEditCommands.TestEcShiftTabRemovesIndent;
+begin
+ FEditor.Text := ' Indented';
+ FEditor.CaretXY := BufferCoord(5, 1);
+ FEditor.ExecuteCommand(ecShiftTab, #0);
+ Assert.AreEqual('Indented', FEditor.Lines[0],
+ 'Shift-Tab should remove indentation');
+end;
+
+procedure TTestFMXSynEditCommands.TestEcLeft;
+begin
+ FEditor.CaretXY := BufferCoord(5, 1);
+ FEditor.ExecuteCommand(ecLeft, #0);
+ Assert.AreEqual(4, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcRight;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecRight, #0);
+ Assert.AreEqual(2, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcUp;
+begin
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecUp, #0);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcDown;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecDown, #0);
+ Assert.AreEqual(2, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcLineStart;
+begin
+ FEditor.CaretXY := BufferCoord(5, 1);
+ FEditor.ExecuteCommand(ecLineStart, #0);
+ Assert.AreEqual(1, FEditor.CaretX);
+end;
+
+procedure TTestFMXSynEditCommands.TestEcLineEnd;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecLineEnd, #0);
+ // 'Line one' = 8 chars, caret should be at 9 (past last char)
+ Assert.AreEqual(9, FEditor.CaretX);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditCommands);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditCompletionProposal.pas b/Tests/FMX/TestFMXSynEditCompletionProposal.pas
new file mode 100644
index 00000000..c4fe4c97
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditCompletionProposal.pas
@@ -0,0 +1,222 @@
+unit TestFMXSynEditCompletionProposal;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynCompletionProposal;
+
+type
+ [TestFixture]
+ TTestFMXCompletionProposalForm = class
+ private
+ FForm: TSynFMXCompletionProposalForm;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestAddItemIncreasesCount;
+ [Test]
+ procedure TestClearListEmptiesAll;
+ [Test]
+ procedure TestFilterByPrefixCaseInsensitive;
+ [Test]
+ procedure TestFilterByPrefixCaseSensitive;
+ [Test]
+ procedure TestEmptyStringShowsAll;
+ [Test]
+ procedure TestNoMatchShowsEmpty;
+ [Test]
+ procedure TestUseInsertListFiltering;
+ [Test]
+ procedure TestPositionClampedToValidRange;
+ [Test]
+ procedure TestMoveLineDown;
+ [Test]
+ procedure TestMoveLineUp;
+ [Test]
+ procedure TestMoveLineTopBoundary;
+ [Test]
+ procedure TestMoveLineBottomBoundary;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes;
+
+procedure TTestFMXCompletionProposalForm.Setup;
+begin
+ FForm := TSynFMXCompletionProposalForm.Create(nil);
+ // MatchText = True by default, CaseSensitive = False by default
+end;
+
+procedure TTestFMXCompletionProposalForm.TearDown;
+begin
+ FForm.Free;
+end;
+
+procedure TTestFMXCompletionProposalForm.TestAddItemIncreasesCount;
+begin
+ Assert.AreEqual(0, FForm.ItemList.Count, 'Should start empty');
+ FForm.AddItem('Display1', 'Insert1');
+ Assert.AreEqual(1, FForm.ItemList.Count, 'ItemList should have 1 item');
+ Assert.AreEqual(1, FForm.InsertList.Count, 'InsertList should have 1 item');
+ FForm.AddItem('Display2', 'Insert2');
+ Assert.AreEqual(2, FForm.ItemList.Count, 'ItemList should have 2 items');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestClearListEmptiesAll;
+begin
+ FForm.AddItem('A', 'a');
+ FForm.AddItem('B', 'b');
+ FForm.ClearList;
+ Assert.AreEqual(0, FForm.ItemList.Count, 'ItemList should be empty');
+ Assert.AreEqual(0, FForm.InsertList.Count, 'InsertList should be empty');
+ Assert.AreEqual(0, FForm.AssignedList.Count, 'AssignedList should be empty');
+ Assert.AreEqual(0, FForm.FilteredInsertList.Count,
+ 'FilteredInsertList should be empty');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestFilterByPrefixCaseInsensitive;
+begin
+ FForm.CaseSensitive := False;
+ FForm.MatchText := True;
+ FForm.AddItem('ArrayList', 'ArrayList');
+ FForm.AddItem('ArrayBuffer', 'ArrayBuffer');
+ FForm.AddItem('Boolean', 'Boolean');
+ // Filter with lowercase prefix
+ FForm.CurrentString := 'arr';
+ Assert.AreEqual(2, FForm.AssignedList.Count,
+ 'Case-insensitive filter should match 2 "Array" items');
+ Assert.AreEqual(0, FForm.Position, 'Position should be 0');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestFilterByPrefixCaseSensitive;
+begin
+ FForm.CaseSensitive := True;
+ FForm.MatchText := True;
+ FForm.AddItem('ArrayList', 'ArrayList');
+ FForm.AddItem('ArrayBuffer', 'ArrayBuffer');
+ FForm.AddItem('Boolean', 'Boolean');
+ // Filter with lowercase — should NOT match uppercase items
+ FForm.CurrentString := 'arr';
+ Assert.AreEqual(0, FForm.AssignedList.Count,
+ 'Case-sensitive filter with "arr" should not match "Array" items');
+ // Filter with correct case
+ FForm.CurrentString := 'Array';
+ Assert.AreEqual(2, FForm.AssignedList.Count,
+ 'Case-sensitive filter with "Array" should match 2 items');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestEmptyStringShowsAll;
+begin
+ FForm.MatchText := True;
+ FForm.AddItem('Alpha', 'Alpha');
+ FForm.AddItem('Beta', 'Beta');
+ FForm.AddItem('Gamma', 'Gamma');
+ FForm.CurrentString := '';
+ Assert.AreEqual(3, FForm.AssignedList.Count,
+ 'Empty filter string should show all items');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestNoMatchShowsEmpty;
+begin
+ FForm.MatchText := True;
+ FForm.AddItem('Alpha', 'Alpha');
+ FForm.AddItem('Beta', 'Beta');
+ FForm.CurrentString := 'xyz';
+ Assert.AreEqual(0, FForm.AssignedList.Count,
+ 'Non-matching filter should show empty list');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestUseInsertListFiltering;
+begin
+ FForm.CaseSensitive := False;
+ FForm.MatchText := True;
+ FForm.UseInsertList := True;
+ // Display text differs from insert text
+ FForm.AddItem('Array List (java.util)', 'ArrayList');
+ FForm.AddItem('Boolean Value', 'BooleanValue');
+ // Filter by insert list prefix
+ FForm.CurrentString := 'Array';
+ Assert.AreEqual(1, FForm.AssignedList.Count,
+ 'Should filter using InsertList, matching "ArrayList"');
+ Assert.AreEqual('Array List (java.util)', FForm.AssignedList[0],
+ 'Display text should be shown in AssignedList');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestPositionClampedToValidRange;
+begin
+ FForm.MatchText := False;
+ FForm.AddItem('A', 'A');
+ FForm.AddItem('B', 'B');
+ FForm.AddItem('C', 'C');
+ FForm.CurrentString := '';
+ // Try to set beyond range
+ FForm.Position := 100;
+ Assert.AreEqual(2, FForm.Position,
+ 'Position should be clamped to last item index');
+ // Try negative
+ FForm.Position := -5;
+ Assert.AreEqual(0, FForm.Position,
+ 'Position should be clamped to 0');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestMoveLineDown;
+begin
+ FForm.MatchText := False;
+ FForm.AddItem('A', 'A');
+ FForm.AddItem('B', 'B');
+ FForm.AddItem('C', 'C');
+ FForm.CurrentString := '';
+ FForm.Position := 0;
+ FForm.MoveLine(1);
+ Assert.AreEqual(1, FForm.Position,
+ 'MoveLine(1) should move to next item');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestMoveLineUp;
+begin
+ FForm.MatchText := False;
+ FForm.AddItem('A', 'A');
+ FForm.AddItem('B', 'B');
+ FForm.AddItem('C', 'C');
+ FForm.CurrentString := '';
+ FForm.Position := 2;
+ FForm.MoveLine(-1);
+ Assert.AreEqual(1, FForm.Position,
+ 'MoveLine(-1) should move to previous item');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestMoveLineTopBoundary;
+begin
+ FForm.MatchText := False;
+ FForm.AddItem('A', 'A');
+ FForm.AddItem('B', 'B');
+ FForm.CurrentString := '';
+ FForm.Position := 0;
+ FForm.MoveLine(-1);
+ Assert.AreEqual(0, FForm.Position,
+ 'MoveLine up at top should stay at 0');
+end;
+
+procedure TTestFMXCompletionProposalForm.TestMoveLineBottomBoundary;
+begin
+ FForm.MatchText := False;
+ FForm.AddItem('A', 'A');
+ FForm.AddItem('B', 'B');
+ FForm.CurrentString := '';
+ FForm.Position := 1;
+ FForm.MoveLine(1);
+ Assert.AreEqual(1, FForm.Position,
+ 'MoveLine down at bottom should stay at last index');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXCompletionProposalForm);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditContent.pas b/Tests/FMX/TestFMXSynEditContent.pas
new file mode 100644
index 00000000..665e0e06
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditContent.pas
@@ -0,0 +1,136 @@
+unit TestFMXSynEditContent;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditContent = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestGetTextEmpty;
+ [Test]
+ procedure TestSetTextSingleLine;
+ [Test]
+ procedure TestSetTextMultiLine;
+ [Test]
+ procedure TestSetTextClearsPrevious;
+ [Test]
+ procedure TestClearAll;
+ [Test]
+ procedure TestClearAllResetsCaret;
+ [Test]
+ procedure TestLoadSaveStreamRoundTrip;
+ [Test]
+ procedure TestSetTextResetsSelection;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ SynEditTypes;
+
+procedure TTestFMXSynEditContent.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditContent.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditContent.TestGetTextEmpty;
+begin
+ Assert.AreEqual('', FEditor.Text);
+end;
+
+procedure TTestFMXSynEditContent.TestSetTextSingleLine;
+begin
+ FEditor.Text := 'Hello';
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ Assert.AreEqual('Hello', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditContent.TestSetTextMultiLine;
+begin
+ FEditor.Text := 'Line1' + sLineBreak + 'Line2' + sLineBreak + 'Line3';
+ Assert.AreEqual(3, FEditor.Lines.Count);
+ Assert.AreEqual('Line1', FEditor.Lines[0]);
+ Assert.AreEqual('Line2', FEditor.Lines[1]);
+ Assert.AreEqual('Line3', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXSynEditContent.TestSetTextClearsPrevious;
+begin
+ FEditor.Text := 'Old content';
+ FEditor.Text := 'New content';
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ Assert.AreEqual('New content', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditContent.TestClearAll;
+begin
+ FEditor.Text := 'Something' + sLineBreak + 'Here';
+ FEditor.ClearAll;
+ Assert.AreEqual(0, FEditor.Lines.Count);
+end;
+
+procedure TTestFMXSynEditContent.TestClearAllResetsCaret;
+begin
+ FEditor.Text := 'Line1' + sLineBreak + 'Line2';
+ FEditor.CaretXY := BufferCoord(3, 2);
+ FEditor.ClearAll;
+ Assert.AreEqual(1, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditContent.TestLoadSaveStreamRoundTrip;
+var
+ Stream: TMemoryStream;
+ OrigText: string;
+begin
+ OrigText := 'Alpha' + sLineBreak + 'Beta' + sLineBreak + 'Gamma';
+ FEditor.Text := OrigText;
+
+ Stream := TMemoryStream.Create;
+ try
+ FEditor.SaveToStream(Stream);
+ FEditor.ClearAll;
+ Assert.AreEqual(0, FEditor.Lines.Count);
+
+ Stream.Position := 0;
+ FEditor.LoadFromStream(Stream);
+ Assert.AreEqual(3, FEditor.Lines.Count);
+ Assert.AreEqual('Alpha', FEditor.Lines[0]);
+ Assert.AreEqual('Beta', FEditor.Lines[1]);
+ Assert.AreEqual('Gamma', FEditor.Lines[2]);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditContent.TestSetTextResetsSelection;
+begin
+ FEditor.Text := 'Select me';
+ FEditor.SelectAll;
+ Assert.IsTrue(FEditor.SelAvail);
+ FEditor.Text := 'New text';
+ Assert.IsFalse(FEditor.SelAvail);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditContent);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditDragDrop.pas b/Tests/FMX/TestFMXSynEditDragDrop.pas
new file mode 100644
index 00000000..5b2df8db
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditDragDrop.pas
@@ -0,0 +1,497 @@
+unit TestFMXSynEditDragDrop;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynEditTypes,
+ SynEditDragDropShared,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TSynDragDropHelperTests = class
+ public
+ [Test]
+ procedure TestIsDropCopy_NoCtrl;
+ [Test]
+ procedure TestIsDropCopy_Ctrl;
+ [Test]
+ procedure TestComputeDropInfo_External_AlwaysDrops;
+ [Test]
+ procedure TestComputeDropInfo_Internal_RejectsDropInSelection;
+ [Test]
+ procedure TestComputeDropInfo_Internal_AcceptsDropBefore;
+ [Test]
+ procedure TestComputeDropInfo_Internal_AcceptsDropAfter;
+ [Test]
+ procedure TestComputeDropInfo_Internal_CopyAllowsDropAtBoundary;
+ [Test]
+ procedure TestAdjustDropPos_SameLine;
+ [Test]
+ procedure TestAdjustDropPos_MultiLine;
+ [Test]
+ procedure TestAdjustDropPos_BeforeSelection;
+ end;
+
+ /// Test subclass to access the protected DropTextAtPos method
+ TTestableEditor = class(TFMXSynEdit)
+ public
+ procedure TestDropTextAtPos(const DropText: string; DropPos: TBufferCoord;
+ IsInternal, IsMove: Boolean);
+ end;
+
+ [TestFixture]
+ TTestFMXDragDropIntegration = class
+ private
+ FEditor: TTestableEditor;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ // External drop tests
+ [Test]
+ procedure TestExternalDrop_SingleLine;
+ [Test]
+ procedure TestExternalDrop_MultiLine;
+ [Test]
+ procedure TestExternalDrop_PastEndOfLine;
+ [Test]
+ procedure TestExternalDrop_AtEndOfDocument;
+ [Test]
+ procedure TestExternalDrop_ReadOnlyRejects;
+ [Test]
+ procedure TestExternalDrop_EmptyTextRejects;
+ // Internal move tests
+ [Test]
+ procedure TestInternalMove_SameLine_Forward;
+ [Test]
+ procedure TestInternalMove_SameLine_Backward;
+ [Test]
+ procedure TestInternalMove_DifferentLine;
+ [Test]
+ procedure TestInternalMove_MultiLineSelection;
+ [Test]
+ procedure TestInternalMove_SourceTextDeleted;
+ [Test]
+ procedure TestInternalMove_RejectsDropInSelection;
+ // Internal copy tests
+ [Test]
+ procedure TestInternalCopy_DuplicatesText;
+ [Test]
+ procedure TestInternalCopy_SourceTextPreserved;
+ // Selection state tests
+ [Test]
+ procedure TestDrop_SelectsInsertedText;
+ [Test]
+ procedure TestDrop_LineCountIncreasesForMultiLine;
+ // Undo tests
+ [Test]
+ procedure TestInternalMove_UndoRestoresOriginal;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes;
+
+{ TTestableEditor }
+
+procedure TTestableEditor.TestDropTextAtPos(const DropText: string;
+ DropPos: TBufferCoord; IsInternal, IsMove: Boolean);
+begin
+ DropTextAtPos(DropText, DropPos, IsInternal, IsMove);
+end;
+
+{ TSynDragDropHelperTests }
+
+procedure TSynDragDropHelperTests.TestIsDropCopy_NoCtrl;
+begin
+ Assert.IsFalse(TSynDragDropHelper.IsDropCopy([]));
+ Assert.IsFalse(TSynDragDropHelper.IsDropCopy([ssShift]));
+ Assert.IsFalse(TSynDragDropHelper.IsDropCopy([ssAlt]));
+end;
+
+procedure TSynDragDropHelperTests.TestIsDropCopy_Ctrl;
+begin
+ Assert.IsTrue(TSynDragDropHelper.IsDropCopy([ssCtrl]));
+ Assert.IsTrue(TSynDragDropHelper.IsDropCopy([ssCtrl, ssShift]));
+end;
+
+procedure TSynDragDropHelperTests.TestComputeDropInfo_External_AlwaysDrops;
+var
+ Info: TSynDropInfo;
+begin
+ // External drop at any position should always be allowed
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(5, 3), // DropPos
+ BufferCoord(1, 1), // SelStart
+ BufferCoord(10, 1), // SelEnd
+ False, // IsInternal
+ True); // IsMove
+ Assert.IsTrue(Info.DoDrop);
+ Assert.IsFalse(Info.DropAfter);
+end;
+
+procedure TSynDragDropHelperTests.TestComputeDropInfo_Internal_RejectsDropInSelection;
+var
+ Info: TSynDropInfo;
+begin
+ // Selection is from (3,2) to (8,2); drop at (5,2) — inside selection
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(5, 2), // DropPos - inside selection
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ True, // IsInternal
+ True); // IsMove
+ Assert.IsFalse(Info.DoDrop);
+end;
+
+procedure TSynDragDropHelperTests.TestComputeDropInfo_Internal_AcceptsDropBefore;
+var
+ Info: TSynDropInfo;
+begin
+ // Selection is from (3,2) to (8,2); drop at (1,2) — before selection
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(1, 2), // DropPos - before selection
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ True, // IsInternal
+ True); // IsMove
+ Assert.IsTrue(Info.DoDrop);
+ Assert.IsFalse(Info.DropAfter);
+end;
+
+procedure TSynDragDropHelperTests.TestComputeDropInfo_Internal_AcceptsDropAfter;
+var
+ Info: TSynDropInfo;
+begin
+ // Selection is from (3,2) to (8,2); drop at (12,2) — after selection
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(12, 2), // DropPos - after selection
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ True, // IsInternal
+ True); // IsMove
+ Assert.IsTrue(Info.DoDrop);
+ Assert.IsTrue(Info.DropAfter);
+end;
+
+procedure TSynDragDropHelperTests.TestComputeDropInfo_Internal_CopyAllowsDropAtBoundary;
+var
+ Info: TSynDropInfo;
+begin
+ // Copy at selection end boundary should be allowed (not move)
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(8, 2), // DropPos - at selection end
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ True, // IsInternal
+ False); // IsMove = False (copy)
+ Assert.IsTrue(Info.DoDrop);
+ Assert.IsTrue(Info.DropAfter);
+
+ // Copy at selection start boundary should also be allowed
+ Info := TSynDragDropHelper.ComputeDropInfo(
+ BufferCoord(3, 2), // DropPos - at selection start
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ True, // IsInternal
+ False); // IsMove = False (copy)
+ Assert.IsTrue(Info.DoDrop);
+ Assert.IsFalse(Info.DropAfter);
+end;
+
+procedure TSynDragDropHelperTests.TestAdjustDropPos_SameLine;
+var
+ Result: TBufferCoord;
+begin
+ // Selection was "World" (chars 7-12) on line 1, drop at char 20 on same line
+ // After deletion, drop position shifts left by selection width (5 chars)
+ Result := TSynDragDropHelper.AdjustDropPos(
+ BufferCoord(20, 1), // DropPos
+ BufferCoord(7, 1), // SelStart
+ BufferCoord(12, 1), // SelEnd
+ True); // DropAfter
+ Assert.AreEqual(15, Result.Char);
+ Assert.AreEqual(1, Result.Line);
+end;
+
+procedure TSynDragDropHelperTests.TestAdjustDropPos_MultiLine;
+var
+ Result: TBufferCoord;
+begin
+ // Selection from (3,2) to (5,4), drop at (10,6)
+ // After deletion, 2 lines removed, drop line shifts up
+ Result := TSynDragDropHelper.AdjustDropPos(
+ BufferCoord(10, 6), // DropPos
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(5, 4), // SelEnd
+ True); // DropAfter
+ Assert.AreEqual(10, Result.Char); // Different line, no char adjustment
+ Assert.AreEqual(4, Result.Line); // 6 - (4-2) = 4
+end;
+
+procedure TSynDragDropHelperTests.TestAdjustDropPos_BeforeSelection;
+var
+ Result: TBufferCoord;
+begin
+ // Drop before selection — no adjustment needed
+ Result := TSynDragDropHelper.AdjustDropPos(
+ BufferCoord(1, 1), // DropPos - before selection
+ BufferCoord(3, 2), // SelStart
+ BufferCoord(8, 2), // SelEnd
+ False); // DropAfter = False
+ Assert.AreEqual(1, Result.Char);
+ Assert.AreEqual(1, Result.Line);
+end;
+
+{ TTestFMXDragDropIntegration }
+
+procedure TTestFMXDragDropIntegration.Setup;
+begin
+ FEditor := TTestableEditor.Create(nil);
+end;
+
+procedure TTestFMXDragDropIntegration.TearDown;
+begin
+ FEditor.Free;
+end;
+
+// --- External drop tests ---
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_SingleLine;
+begin
+ FEditor.Text := 'Hello World';
+ // Drop "XYZ" at position 6 (between "Hello" and " World")
+ FEditor.TestDropTextAtPos('XYZ', BufferCoord(6, 1), False, True);
+ Assert.AreEqual('HelloXYZ World', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_MultiLine;
+begin
+ FEditor.Text := 'Hello World';
+ // Drop multi-line text at position 6
+ FEditor.TestDropTextAtPos('AAA' + sLineBreak + 'BBB',
+ BufferCoord(6, 1), False, True);
+ Assert.AreEqual(2, FEditor.Lines.Count, 'Line count should increase');
+ Assert.AreEqual('HelloAAA', FEditor.Lines[0]);
+ Assert.AreEqual('BBB World', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_PastEndOfLine;
+begin
+ FEditor.Text := 'Short';
+ // Drop text at char 15, well past end of "Short" (5 chars)
+ FEditor.TestDropTextAtPos('XYZ', BufferCoord(15, 1), False, True);
+ // Should pad with spaces: "Short" + 9 spaces + "XYZ"
+ Assert.AreEqual('Short XYZ', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_AtEndOfDocument;
+begin
+ FEditor.Text := 'Line1' + sLineBreak + 'Line2';
+ // Drop multi-line text at end of last line
+ FEditor.TestDropTextAtPos('AAA' + sLineBreak + 'BBB' + sLineBreak + 'CCC',
+ BufferCoord(6, 2), False, True);
+ Assert.AreEqual(4, FEditor.Lines.Count, 'Should expand buffer for multi-line drop');
+ Assert.AreEqual('Line1', FEditor.Lines[0]);
+ Assert.AreEqual('Line2AAA', FEditor.Lines[1]);
+ Assert.AreEqual('BBB', FEditor.Lines[2]);
+ Assert.AreEqual('CCC', FEditor.Lines[3]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_ReadOnlyRejects;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.ReadOnly := True;
+ FEditor.TestDropTextAtPos('XYZ', BufferCoord(1, 1), False, True);
+ Assert.AreEqual('Hello', FEditor.Lines[0], 'Read-only editor should reject drop');
+end;
+
+procedure TTestFMXDragDropIntegration.TestExternalDrop_EmptyTextRejects;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.TestDropTextAtPos('', BufferCoord(1, 1), False, True);
+ Assert.AreEqual('Hello', FEditor.Lines[0], 'Empty text drop should be rejected');
+end;
+
+// --- Internal move tests ---
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_SameLine_Forward;
+begin
+ // "Hello World Goodbye" — select "World" (7-12), move to char 19
+ FEditor.Text := 'Hello World Goodbye';
+ FEditor.SetCaretAndSelection(BufferCoord(12, 1),
+ BufferCoord(7, 1), BufferCoord(12, 1));
+ FEditor.TestDropTextAtPos('World', BufferCoord(20, 1), True, True);
+ // "World" removed from pos 7, then inserted after "Goodbye"
+ // After deletion: "Hello Goodbye" (14 chars)
+ // AdjustDropPos: 20 - (12-7) = 15
+ // Insert at 15: "Hello Goodbye World" wait, that's wrong...
+ // Actually "Hello Goodbye" has a double space. Let me re-think.
+ // Original: "Hello World Goodbye" (H=1..o=5, space=6, W=7..d=11, space=12, G=13..e=19)
+ // Select chars 7-12 = "World " (includes trailing space)
+ // Wait, selection is (7,1)-(12,1). Delete(SLine, 7, 12-7) = Delete(SLine, 7, 5) removes 5 chars = "World"
+ // Result: "Hello Goodbye" (note double space)
+ // AdjustDropPos: char 20, same line as sel end (line 1), Dec(Char, 12-7=5) -> char 15
+ // Insert "World" at char 15 of "Hello Goodbye" (14 chars, so 15 = past end)
+ // With space padding: "Hello Goodbye" + " " + "World" wait, char 15 is 1 past end of 14 chars
+ // Actually Length("Hello Goodbye") = 14, char 15 = position just after 'e', no padding needed
+ // Result: "Hello GoodbyeWorld"
+ // Hmm, that's not ideal but it's the correct behavior for these coordinates.
+ // Let me use a cleaner example.
+ Assert.AreEqual('Hello GoodbyeWorld', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_SameLine_Backward;
+begin
+ // "Hello World" — select "World" (7-12), move to char 1
+ FEditor.Text := 'Hello World';
+ FEditor.SetCaretAndSelection(BufferCoord(12, 1),
+ BufferCoord(7, 1), BufferCoord(12, 1));
+ FEditor.TestDropTextAtPos('World', BufferCoord(1, 1), True, True);
+ // Drop is before selection, so no adjustment
+ // Delete "World" (7-12): "Hello " (note trailing space, only 6 chars remain... wait)
+ // Original: "Hello World" = H(1)e(2)l(3)l(4)o(5) (6)W(7)o(8)r(9)l(10)d(11)
+ // Delete(SLine, 7, 5): removes chars 7-11 = "World" -> "Hello " (6 chars)
+ // Insert "World" at char 1: "WorldHello "
+ Assert.AreEqual('WorldHello ', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_DifferentLine;
+begin
+ // Two lines: select "World" on line 1, move to start of line 2
+ FEditor.Text := 'Hello World' + sLineBreak + 'Goodbye';
+ FEditor.SetCaretAndSelection(BufferCoord(12, 1),
+ BufferCoord(7, 1), BufferCoord(12, 1));
+ FEditor.TestDropTextAtPos('World', BufferCoord(1, 2), True, True);
+ // Delete "World" from line 1: "Hello " remains
+ // Drop is on different line (after sel), AdjustDropPos: line stays 2, char stays 1
+ // (sel is single line, no line adjustment needed)
+ // Insert "World" at start of line 2
+ Assert.AreEqual('Hello ', FEditor.Lines[0]);
+ Assert.AreEqual('WorldGoodbye', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_MultiLineSelection;
+begin
+ // Three lines, select from middle of line 1 to middle of line 2
+ FEditor.Text := 'AAABBB' + sLineBreak + 'CCCDDD' + sLineBreak + 'EEEFFF';
+ // Select "BBB\r\nCCC" = from (4,1) to (4,2)
+ FEditor.SetCaretAndSelection(BufferCoord(4, 2),
+ BufferCoord(4, 1), BufferCoord(4, 2));
+ // Move to start of line 3
+ FEditor.TestDropTextAtPos('BBB' + sLineBreak + 'CCC',
+ BufferCoord(1, 3), True, True);
+ // Delete (4,1)-(4,2): line 1 becomes "AAA" + "DDD" = "AAADDD", line 2 deleted
+ // Now 2 lines: "AAADDD", "EEEFFF"
+ // AdjustDropPos: drop was line 3, after sel end line 2. Dec(Line, 2-1=1) -> line 2
+ // Insert "BBB\r\nCCC" at (1, 2) of "EEEFFF"
+ // Line 2 becomes "BBB", new line 3 = "CCCEEEFFF"
+ Assert.AreEqual(3, FEditor.Lines.Count);
+ Assert.AreEqual('AAADDD', FEditor.Lines[0]);
+ Assert.AreEqual('BBB', FEditor.Lines[1]);
+ Assert.AreEqual('CCCEEEFFF', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_SourceTextDeleted;
+begin
+ // Verify the source text is removed after an internal move
+ FEditor.Text := 'ABCDEFGH';
+ // Select "CDE" (3-6)
+ FEditor.SetCaretAndSelection(BufferCoord(6, 1),
+ BufferCoord(3, 1), BufferCoord(6, 1));
+ FEditor.TestDropTextAtPos('CDE', BufferCoord(9, 1), True, True);
+ // After delete "CDE": "ABFGH" (5 chars)
+ // AdjustDropPos: 9 - (6-3) = 6
+ // Insert at 6: "ABFGHCDE" wait, 6 is past "ABFGH" (5 chars) by 1
+ // char 6 = just past end, no padding needed
+ // "ABFGH" + insert at 6 = "ABFGHCDE"
+ Assert.AreEqual('ABFGHCDE', FEditor.Lines[0]);
+ // Original "CDE" is gone from its original position
+ Assert.AreEqual(0, Pos('CDEFGH', FEditor.Lines[0]),
+ 'Original text should be removed');
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_RejectsDropInSelection;
+begin
+ // Drop inside selection should be rejected
+ FEditor.Text := 'Hello World';
+ FEditor.SetCaretAndSelection(BufferCoord(8, 1),
+ BufferCoord(3, 1), BufferCoord(8, 1));
+ FEditor.TestDropTextAtPos('llo W', BufferCoord(5, 1), True, True);
+ // Drop at char 5 is inside selection (3-8), should be rejected
+ Assert.AreEqual('Hello World', FEditor.Lines[0],
+ 'Drop inside selection should be rejected');
+end;
+
+// --- Internal copy tests ---
+
+procedure TTestFMXDragDropIntegration.TestInternalCopy_DuplicatesText;
+begin
+ FEditor.Text := 'Hello World';
+ // Select "World" (7-12)
+ FEditor.SetCaretAndSelection(BufferCoord(12, 1),
+ BufferCoord(7, 1), BufferCoord(12, 1));
+ // Copy (not move) to char 1
+ FEditor.TestDropTextAtPos('World', BufferCoord(1, 1), True, False);
+ Assert.AreEqual('WorldHello World', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXDragDropIntegration.TestInternalCopy_SourceTextPreserved;
+begin
+ FEditor.Text := 'ABCDEF';
+ // Select "BCD" (2-5)
+ FEditor.SetCaretAndSelection(BufferCoord(5, 1),
+ BufferCoord(2, 1), BufferCoord(5, 1));
+ // Copy to end of line
+ FEditor.TestDropTextAtPos('BCD', BufferCoord(7, 1), True, False);
+ // Source preserved, copy appended
+ Assert.AreEqual('ABCDEFBCD', FEditor.Lines[0]);
+end;
+
+// --- Selection state tests ---
+
+procedure TTestFMXDragDropIntegration.TestDrop_SelectsInsertedText;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.TestDropTextAtPos('XYZ', BufferCoord(1, 1), False, True);
+ // After drop, selection should cover the inserted text
+ Assert.IsTrue(FEditor.SelAvail, 'Inserted text should be selected');
+ Assert.AreEqual('XYZ', FEditor.SelText, 'Selection should match dropped text');
+end;
+
+procedure TTestFMXDragDropIntegration.TestDrop_LineCountIncreasesForMultiLine;
+begin
+ FEditor.Text := 'OneLine';
+ Assert.AreEqual(1, FEditor.Lines.Count);
+ FEditor.TestDropTextAtPos('A' + sLineBreak + 'B' + sLineBreak + 'C',
+ BufferCoord(8, 1), False, True);
+ Assert.AreEqual(3, FEditor.Lines.Count,
+ 'Multi-line drop should increase line count');
+end;
+
+// --- Undo tests ---
+
+procedure TTestFMXDragDropIntegration.TestInternalMove_UndoRestoresOriginal;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SetCaretAndSelection(BufferCoord(12, 1),
+ BufferCoord(7, 1), BufferCoord(12, 1));
+ FEditor.TestDropTextAtPos('World', BufferCoord(1, 1), True, True);
+ // After move: "WorldHello "
+ Assert.AreEqual('WorldHello ', FEditor.Lines[0]);
+ // Undo should restore original
+ FEditor.Undo;
+ Assert.AreEqual('Hello World', FEditor.Text,
+ 'Undo should restore original text');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TSynDragDropHelperTests);
+ TDUnitX.RegisterTestFixture(TTestFMXDragDropIntegration);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditEditing.pas b/Tests/FMX/TestFMXSynEditEditing.pas
new file mode 100644
index 00000000..5f825d13
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditEditing.pas
@@ -0,0 +1,216 @@
+unit TestFMXSynEditEditing;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditEditing = class
+ private
+ FEditor: TFMXSynEdit;
+ FChangeCount: Integer;
+ procedure OnChangeHandler(Sender: TObject);
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestDeleteAtEndOfLineJoinsLines;
+ [Test]
+ procedure TestBackspaceAtStartOfLineJoinsLines;
+ [Test]
+ procedure TestJoinedLineContentPreserved;
+ [Test]
+ procedure TestOverwriteModeReplacesChar;
+ [Test]
+ procedure TestInsertModeInsertsChar;
+ [Test]
+ procedure TestEcToggleMode;
+ [Test]
+ procedure TestOnChangeFiresOnEdit;
+ [Test]
+ procedure TestOnChangeFiresOnDelete;
+ [Test]
+ procedure TestOnChangeFiresDuringBeginUpdate;
+ [Test]
+ procedure TestBackspaceAtDocStartIsNoOp;
+ [Test]
+ procedure TestDeleteAtDocEndIsNoOp;
+ [Test]
+ procedure TestDeleteCharMiddleOfLine;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditEditing.OnChangeHandler(Sender: TObject);
+begin
+ Inc(FChangeCount);
+end;
+
+procedure TTestFMXSynEditEditing.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Line one' + sLineBreak +
+ 'Line two' + sLineBreak +
+ 'Line three';
+ FChangeCount := 0;
+end;
+
+procedure TTestFMXSynEditEditing.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditEditing.TestDeleteAtEndOfLineJoinsLines;
+var
+ OrigCount: Integer;
+begin
+ OrigCount := FEditor.LineCount;
+ // Position at end of line 1 ('Line one' = 8 chars, caret at 9)
+ FEditor.CaretXY := BufferCoord(9, 1);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.AreEqual(OrigCount - 1, FEditor.LineCount,
+ 'Delete at end-of-line should join with next line');
+ Assert.AreEqual('Line oneLine two', FEditor.Lines[0],
+ 'Lines should be concatenated');
+end;
+
+procedure TTestFMXSynEditEditing.TestBackspaceAtStartOfLineJoinsLines;
+var
+ OrigCount: Integer;
+begin
+ OrigCount := FEditor.LineCount;
+ // Position at start of line 2
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecDeleteLastChar, #0);
+ Assert.AreEqual(OrigCount - 1, FEditor.LineCount,
+ 'Backspace at start-of-line should join with previous line');
+ Assert.AreEqual('Line oneLine two', FEditor.Lines[0],
+ 'Lines should be concatenated');
+end;
+
+procedure TTestFMXSynEditEditing.TestJoinedLineContentPreserved;
+begin
+ // Join line 2 into line 1 via backspace
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecDeleteLastChar, #0);
+ // Line 3 (now line 2) should be unchanged
+ Assert.AreEqual('Line three', FEditor.Lines[1],
+ 'Remaining lines should be preserved');
+end;
+
+procedure TTestFMXSynEditEditing.TestOverwriteModeReplacesChar;
+begin
+ FEditor.InsertMode := False;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('Xine one', FEditor.Lines[0],
+ 'Overwrite mode should replace the character at caret');
+ Assert.AreEqual(2, FEditor.CaretX,
+ 'Caret should advance after overwrite');
+end;
+
+procedure TTestFMXSynEditEditing.TestInsertModeInsertsChar;
+begin
+ FEditor.InsertMode := True;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('XLine one', FEditor.Lines[0],
+ 'Insert mode should insert without replacing');
+end;
+
+procedure TTestFMXSynEditEditing.TestEcToggleMode;
+begin
+ Assert.IsTrue(FEditor.InsertMode, 'Default should be insert mode');
+ FEditor.ExecuteCommand(ecToggleMode, #0);
+ Assert.IsFalse(FEditor.InsertMode, 'Should toggle to overwrite mode');
+ FEditor.ExecuteCommand(ecToggleMode, #0);
+ Assert.IsTrue(FEditor.InsertMode, 'Should toggle back to insert mode');
+end;
+
+procedure TTestFMXSynEditEditing.TestOnChangeFiresOnEdit;
+begin
+ FEditor.OnChange := OnChangeHandler;
+ FChangeCount := 0;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FChangeCount > 0,
+ 'OnChange should fire when text is edited');
+end;
+
+procedure TTestFMXSynEditEditing.TestOnChangeFiresOnDelete;
+begin
+ FEditor.OnChange := OnChangeHandler;
+ FChangeCount := 0;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.IsTrue(FChangeCount > 0,
+ 'OnChange should fire when text is deleted');
+end;
+
+procedure TTestFMXSynEditEditing.TestOnChangeFiresDuringBeginUpdate;
+begin
+ // The current implementation fires OnChange even during BeginUpdate
+ // (only Repaint is suppressed). Verify this behavior.
+ FEditor.OnChange := OnChangeHandler;
+ FChangeCount := 0;
+ FEditor.BeginUpdate;
+ try
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ finally
+ FEditor.EndUpdate;
+ end;
+ Assert.IsTrue(FChangeCount > 0,
+ 'OnChange should fire even during BeginUpdate');
+end;
+
+procedure TTestFMXSynEditEditing.TestBackspaceAtDocStartIsNoOp;
+var
+ OrigText: string;
+begin
+ OrigText := FEditor.Text;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecDeleteLastChar, #0);
+ Assert.AreEqual(OrigText, FEditor.Text,
+ 'Backspace at (1,1) should not modify text');
+ Assert.AreEqual(1, FEditor.CaretX);
+ Assert.AreEqual(1, FEditor.CaretY);
+end;
+
+procedure TTestFMXSynEditEditing.TestDeleteAtDocEndIsNoOp;
+var
+ OrigText: string;
+ LastLine: Integer;
+begin
+ OrigText := FEditor.Text;
+ LastLine := FEditor.LineCount;
+ // Position at end of last line
+ FEditor.CaretXY := BufferCoord(Length(FEditor.Lines[LastLine - 1]) + 1, LastLine);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.AreEqual(OrigText, FEditor.Text,
+ 'Delete at end of document should not modify text');
+end;
+
+procedure TTestFMXSynEditEditing.TestDeleteCharMiddleOfLine;
+begin
+ FEditor.CaretXY := BufferCoord(5, 1);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.AreEqual('Lineone', FEditor.Lines[0],
+ 'Delete should remove character at caret position');
+ Assert.AreEqual(5, FEditor.CaretX, 'Caret should not move');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditEditing);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditGutter.pas b/Tests/FMX/TestFMXSynEditGutter.pas
new file mode 100644
index 00000000..47db6732
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditGutter.pas
@@ -0,0 +1,246 @@
+unit TestFMXSynEditGutter;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditGutter = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestDefaultBandCount;
+ [Test]
+ procedure TestDefaultBandOrder;
+ [Test]
+ procedure TestDefaultBandVisibility;
+ [Test]
+ procedure TestGutterWidthPositive;
+ [Test]
+ procedure TestGutterWidthWithFolding;
+ [Test]
+ procedure TestGutterWidthWithoutFolding;
+ [Test]
+ procedure TestLineNumberWidthAutoSizes;
+ [Test]
+ procedure TestBandByKind;
+ [Test]
+ procedure TestBandByKindNil;
+ [Test]
+ procedure TestBandAtX;
+ [Test]
+ procedure TestBandAtXPastGutter;
+ [Test]
+ procedure TestHideBandReducesWidth;
+ [Test]
+ procedure TestGutterInvisibleZeroWidth;
+ [Test]
+ procedure TestCustomBand;
+ [Test]
+ procedure TestFoldBandVisibilitySync;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Math,
+ SynEditTypes,
+ FMX.SynEditMiscClasses,
+ SynHighlighterPas;
+
+const
+ SampleText =
+ 'program Test;' + sLineBreak +
+ 'begin' + sLineBreak +
+ ' WriteLn;' + sLineBreak +
+ 'end.';
+
+procedure TTestFMXSynEditGutter.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := SampleText;
+end;
+
+procedure TTestFMXSynEditGutter.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditGutter.TestDefaultBandCount;
+begin
+ Assert.AreEqual(4, FEditor.Gutter.Bands.Count);
+end;
+
+procedure TTestFMXSynEditGutter.TestDefaultBandOrder;
+begin
+ Assert.AreEqual(Ord(gbkLineNumbers), Ord(FEditor.Gutter.Bands[0].Kind));
+ Assert.AreEqual(Ord(gbkMarks), Ord(FEditor.Gutter.Bands[1].Kind));
+ Assert.AreEqual(Ord(gbkFold), Ord(FEditor.Gutter.Bands[2].Kind));
+ Assert.AreEqual(Ord(gbkMargin), Ord(FEditor.Gutter.Bands[3].Kind));
+end;
+
+procedure TTestFMXSynEditGutter.TestDefaultBandVisibility;
+begin
+ Assert.IsTrue(FEditor.Gutter.Bands[0].Visible, 'LineNumbers visible');
+ Assert.IsTrue(FEditor.Gutter.Bands[1].Visible, 'Marks visible');
+ Assert.IsFalse(FEditor.Gutter.Bands[2].Visible, 'Fold hidden');
+ Assert.IsTrue(FEditor.Gutter.Bands[3].Visible, 'Margin visible');
+end;
+
+procedure TTestFMXSynEditGutter.TestGutterWidthPositive;
+begin
+ Assert.IsTrue(FEditor.GutterWidth > 0, 'GutterWidth should be > 0');
+end;
+
+procedure TTestFMXSynEditGutter.TestGutterWidthWithFolding;
+var
+ WidthBefore, WidthAfter: Single;
+ HL: TSynPasSyn;
+begin
+ WidthBefore := FEditor.GutterWidth;
+ HL := TSynPasSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL;
+ FEditor.UseCodeFolding := True;
+ WidthAfter := FEditor.GutterWidth;
+ Assert.IsTrue(WidthAfter > WidthBefore, 'Width should increase with folding');
+ finally
+ FEditor.UseCodeFolding := False;
+ FEditor.Highlighter := nil;
+ HL.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditGutter.TestGutterWidthWithoutFolding;
+var
+ FoldBand: TSynFMXGutterBand;
+begin
+ FoldBand := FEditor.Gutter.Bands.BandByKind(gbkFold);
+ Assert.IsNotNull(FoldBand);
+ Assert.IsFalse(FoldBand.Visible, 'Fold band should be hidden');
+ Assert.IsTrue(FoldBand.RealWidth = 0, 'Fold band width should be 0');
+end;
+
+procedure TTestFMXSynEditGutter.TestLineNumberWidthAutoSizes;
+var
+ WidthSmall, WidthLarge: Single;
+ I: Integer;
+ Band: TSynFMXGutterBand;
+begin
+ Band := FEditor.Gutter.Bands.BandByKind(gbkLineNumbers);
+ WidthSmall := Band.RealWidth;
+ // Add lines to get past 4 digits
+ FEditor.BeginUpdate;
+ try
+ for I := 1 to 10000 do
+ FEditor.Lines.Add('Line ' + IntToStr(I));
+ finally
+ FEditor.EndUpdate;
+ end;
+ WidthLarge := Band.RealWidth;
+ Assert.IsTrue(WidthLarge > WidthSmall,
+ 'Line number band should widen with more lines');
+end;
+
+procedure TTestFMXSynEditGutter.TestBandByKind;
+var
+ Band: TSynFMXGutterBand;
+begin
+ Band := FEditor.Gutter.Bands.BandByKind(gbkMarks);
+ Assert.IsNotNull(Band);
+ Assert.AreEqual(Ord(gbkMarks), Ord(Band.Kind));
+end;
+
+procedure TTestFMXSynEditGutter.TestBandByKindNil;
+begin
+ // Remove the custom band kind - gbkCustom is not in defaults
+ Assert.IsNull(FEditor.Gutter.Bands.BandByKind(gbkCustom));
+end;
+
+procedure TTestFMXSynEditGutter.TestBandAtX;
+var
+ Band: TSynFMXGutterBand;
+begin
+ // X=0 should be in the first band (LineNumbers)
+ Band := FEditor.Gutter.BandAtX(0);
+ Assert.IsNotNull(Band);
+ Assert.AreEqual(Ord(gbkLineNumbers), Ord(Band.Kind));
+end;
+
+procedure TTestFMXSynEditGutter.TestBandAtXPastGutter;
+var
+ Band: TSynFMXGutterBand;
+begin
+ Band := FEditor.Gutter.BandAtX(FEditor.GutterWidth + 100);
+ Assert.IsNull(Band, 'Should return nil past gutter edge');
+end;
+
+procedure TTestFMXSynEditGutter.TestHideBandReducesWidth;
+var
+ WidthBefore, WidthAfter: Single;
+begin
+ WidthBefore := FEditor.GutterWidth;
+ FEditor.Gutter.Bands.BandByKind(gbkMarks).Visible := False;
+ WidthAfter := FEditor.GutterWidth;
+ Assert.IsTrue(WidthAfter < WidthBefore,
+ 'Hiding marks band should reduce gutter width');
+ // Restore
+ FEditor.Gutter.Bands.BandByKind(gbkMarks).Visible := True;
+end;
+
+procedure TTestFMXSynEditGutter.TestGutterInvisibleZeroWidth;
+begin
+ FEditor.Gutter.Visible := False;
+ Assert.AreEqual(Single(0), FEditor.GutterWidth,
+ 'Gutter width should be 0 when invisible');
+ FEditor.Gutter.Visible := True;
+end;
+
+procedure TTestFMXSynEditGutter.TestCustomBand;
+var
+ WidthBefore, WidthAfter: Single;
+begin
+ WidthBefore := FEditor.GutterWidth;
+ FEditor.Gutter.Bands.Add(gbkCustom, 20, True);
+ // Trigger width recalc
+ FEditor.Gutter.Changed;
+ WidthAfter := FEditor.GutterWidth;
+ Assert.AreEqual(5, FEditor.Gutter.Bands.Count, 'Should have 5 bands');
+ Assert.IsTrue(WidthAfter > WidthBefore,
+ 'Custom band should increase gutter width');
+end;
+
+procedure TTestFMXSynEditGutter.TestFoldBandVisibilitySync;
+var
+ FoldBand: TSynFMXGutterBand;
+ HL: TSynPasSyn;
+begin
+ FoldBand := FEditor.Gutter.Bands.BandByKind(gbkFold);
+ Assert.IsFalse(FoldBand.Visible, 'Fold band initially hidden');
+
+ HL := TSynPasSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL;
+ FEditor.UseCodeFolding := True;
+ Assert.IsTrue(FoldBand.Visible, 'Fold band visible when folding enabled');
+ FEditor.UseCodeFolding := False;
+ Assert.IsFalse(FoldBand.Visible, 'Fold band hidden when folding disabled');
+ finally
+ FEditor.Highlighter := nil;
+ HL.Free;
+ end;
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditGutter);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditHighlighter.pas b/Tests/FMX/TestFMXSynEditHighlighter.pas
new file mode 100644
index 00000000..43d287a1
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditHighlighter.pas
@@ -0,0 +1,119 @@
+unit TestFMXSynEditHighlighter;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditHighlighter = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestHighlighterNilByDefault;
+ [Test]
+ procedure TestAssignHighlighter;
+ [Test]
+ procedure TestHighlighterClearToNil;
+ [Test]
+ procedure TestHighlighterFreeNotification;
+ [Test]
+ procedure TestMultipleHighlighterSwitch;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynHighlighterDelphi,
+ SynHighlighterJSON;
+
+procedure TTestFMXSynEditHighlighter.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditHighlighter.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditHighlighter.TestHighlighterNilByDefault;
+begin
+ Assert.IsNull(FEditor.Highlighter);
+end;
+
+procedure TTestFMXSynEditHighlighter.TestAssignHighlighter;
+var
+ HL: TSynDelphiSyn;
+begin
+ HL := TSynDelphiSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL;
+ Assert.AreSame(HL, FEditor.Highlighter);
+ finally
+ FEditor.Highlighter := nil;
+ HL.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditHighlighter.TestHighlighterClearToNil;
+var
+ HL: TSynDelphiSyn;
+begin
+ HL := TSynDelphiSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL;
+ Assert.IsNotNull(FEditor.Highlighter);
+ FEditor.Highlighter := nil;
+ Assert.IsNull(FEditor.Highlighter);
+ finally
+ HL.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditHighlighter.TestHighlighterFreeNotification;
+var
+ HL: TSynDelphiSyn;
+begin
+ HL := TSynDelphiSyn.Create(nil);
+ FEditor.Highlighter := HL;
+ Assert.IsNotNull(FEditor.Highlighter);
+ // Freeing the highlighter should trigger FreeNotification
+ HL.Free;
+ Assert.IsNull(FEditor.Highlighter,
+ 'Highlighter property should be nil after highlighter is freed');
+end;
+
+procedure TTestFMXSynEditHighlighter.TestMultipleHighlighterSwitch;
+var
+ HL1: TSynDelphiSyn;
+ HL2: TSynJSONSyn;
+begin
+ HL1 := TSynDelphiSyn.Create(nil);
+ HL2 := TSynJSONSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL1;
+ Assert.AreSame(HL1, FEditor.Highlighter);
+ FEditor.Highlighter := HL2;
+ Assert.AreSame(HL2, FEditor.Highlighter);
+ FEditor.Highlighter := nil;
+ Assert.IsNull(FEditor.Highlighter);
+ finally
+ FEditor.Highlighter := nil;
+ HL2.Free;
+ HL1.Free;
+ end;
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditHighlighter);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditMultiCaret.pas b/Tests/FMX/TestFMXSynEditMultiCaret.pas
new file mode 100644
index 00000000..b779e4a9
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditMultiCaret.pas
@@ -0,0 +1,296 @@
+unit TestFMXSynEditMultiCaret;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditMultiCaret = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestSingleCaretBackwardCompat;
+ [Test]
+ procedure TestSelectionsDefaultCount;
+ [Test]
+ procedure TestAddCaret;
+ [Test]
+ procedure TestAddCaretToggle;
+ [Test]
+ procedure TestColumnSelectionDown;
+ [Test]
+ procedure TestColumnSelectionUp;
+ [Test]
+ procedure TestMultiCaretCharInsert;
+ [Test]
+ procedure TestMultiCaretDeleteChar;
+ [Test]
+ procedure TestMultiCaretBackspace;
+ [Test]
+ procedure TestCancelSelections;
+ [Test]
+ procedure TestCancelSingleSelection;
+ [Test]
+ procedure TestMergeOverlapping;
+ [Test]
+ procedure TestSelectAllMatchingText;
+ [Test]
+ procedure TestCaretsAtLineEnds;
+ [Test]
+ procedure TestMultiCaretUndo;
+ [Test]
+ procedure TestMultiCaretRedo;
+ [Test]
+ procedure TestPartSelectionsForRow;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditSelections,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditMultiCaret.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Hello World' + sLineBreak +
+ 'Second line' + sLineBreak +
+ 'Third line' + sLineBreak +
+ 'Hello Again' + sLineBreak +
+ 'Fifth line';
+end;
+
+procedure TTestFMXSynEditMultiCaret.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestSingleCaretBackwardCompat;
+begin
+ FEditor.CaretXY := BufferCoord(3, 2);
+ Assert.AreEqual(3, FEditor.CaretX);
+ Assert.AreEqual(2, FEditor.CaretY);
+ FEditor.BlockBegin := BufferCoord(1, 2);
+ FEditor.BlockEnd := BufferCoord(7, 2);
+ Assert.AreEqual('Second', FEditor.SelText);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestSelectionsDefaultCount;
+begin
+ Assert.AreEqual(1, FEditor.Selections.Count,
+ 'Should start with 1 selection');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestAddCaret;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ Assert.AreEqual(2, FEditor.Selections.Count,
+ 'Should have 2 selections after AddCaret');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestAddCaretToggle;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ Assert.AreEqual(2, FEditor.Selections.Count);
+ // Adding caret at same position removes it
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ Assert.AreEqual(1, FEditor.Selections.Count,
+ 'AddCaret at same position should toggle (remove)');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestColumnSelectionDown;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.CommandProcessor(ecSelColumnDown, #0);
+ Assert.AreEqual(2, FEditor.Selections.Count,
+ 'Column down from line 1 should create 2 selections');
+ FEditor.CommandProcessor(ecSelColumnDown, #0);
+ Assert.AreEqual(3, FEditor.Selections.Count,
+ 'Column down again should create 3 selections');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestColumnSelectionUp;
+begin
+ FEditor.CaretXY := BufferCoord(1, 3);
+ FEditor.CommandProcessor(ecSelColumnUp, #0);
+ Assert.AreEqual(2, FEditor.Selections.Count,
+ 'Column up from line 3 should create 2 selections');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMultiCaretCharInsert;
+begin
+ // Place carets at start of lines 1, 2, 3
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ FEditor.Selections.AddCaret(BufferCoord(1, 3));
+ Assert.AreEqual(3, FEditor.Selections.Count);
+
+ // Insert 'X' at all carets
+ FEditor.CommandProcessor(ecChar, 'X');
+
+ Assert.AreEqual('XHello World', FEditor.Lines[0]);
+ Assert.AreEqual('XSecond line', FEditor.Lines[1]);
+ Assert.AreEqual('XThird line', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMultiCaretDeleteChar;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ FEditor.Selections.AddCaret(BufferCoord(1, 3));
+
+ FEditor.CommandProcessor(ecDeleteChar, #0);
+
+ Assert.AreEqual('ello World', FEditor.Lines[0]);
+ Assert.AreEqual('econd line', FEditor.Lines[1]);
+ Assert.AreEqual('hird line', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMultiCaretBackspace;
+begin
+ FEditor.CaretXY := BufferCoord(2, 1);
+ FEditor.Selections.AddCaret(BufferCoord(2, 2));
+ FEditor.Selections.AddCaret(BufferCoord(2, 3));
+
+ FEditor.CommandProcessor(ecDeleteLastChar, #0);
+
+ Assert.AreEqual('ello World', FEditor.Lines[0]);
+ Assert.AreEqual('econd line', FEditor.Lines[1]);
+ Assert.AreEqual('hird line', FEditor.Lines[2]);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestCancelSelections;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ FEditor.Selections.AddCaret(BufferCoord(1, 3));
+ Assert.AreEqual(3, FEditor.Selections.Count);
+
+ FEditor.CommandProcessor(ecCancelSelections, #0);
+ Assert.AreEqual(1, FEditor.Selections.Count,
+ 'CancelSelections should reduce to 1');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestCancelSingleSelection;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.BlockBegin := BufferCoord(1, 1);
+ FEditor.BlockEnd := BufferCoord(6, 1);
+ Assert.IsTrue(FEditor.SelAvail);
+
+ FEditor.CommandProcessor(ecCancelSelections, #0);
+ Assert.IsFalse(FEditor.SelAvail,
+ 'CancelSelections on single should collapse selection');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMergeOverlapping;
+begin
+ // Place two carets adjacent — after editing they should merge
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(2, 1));
+ Assert.AreEqual(2, FEditor.Selections.Count);
+
+ // Delete char at both positions — they converge
+ FEditor.CommandProcessor(ecDeleteChar, #0);
+ // After merge, should be 1 selection
+ Assert.AreEqual(1, FEditor.Selections.Count,
+ 'Overlapping carets should merge');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestSelectAllMatchingText;
+begin
+ // Select "Hello" on line 1
+ FEditor.SetCaretAndSelection(
+ BufferCoord(6, 1), BufferCoord(1, 1), BufferCoord(6, 1));
+
+ Assert.AreEqual('Hello', FEditor.SelText, 'Selection should be "Hello"');
+
+ FEditor.CommandProcessor(ecSelMatchingText, #0);
+
+ // "Hello" appears on lines 1 and 4
+ Assert.AreEqual(2, FEditor.Selections.Count,
+ 'Should find 2 occurrences of "Hello"');
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestCaretsAtLineEnds;
+begin
+ // Select lines 1-3
+ FEditor.BlockBegin := BufferCoord(1, 1);
+ FEditor.BlockEnd := BufferCoord(1, 3);
+
+ FEditor.CommandProcessor(ecCaretsAtLineEnds, #0);
+
+ Assert.AreEqual(3, FEditor.Selections.Count,
+ 'Should have 3 carets (one per line)');
+ // Each caret should be at end of its line
+ Assert.AreEqual(12, FEditor.Selections[0].Caret.Char,
+ 'Caret 1 should be at end of "Hello World"');
+ Assert.AreEqual(1, FEditor.Selections[0].Caret.Line);
+ Assert.AreEqual(12, FEditor.Selections[1].Caret.Char,
+ 'Caret 2 should be at end of "Second line"');
+ Assert.AreEqual(2, FEditor.Selections[1].Caret.Line);
+ Assert.AreEqual(11, FEditor.Selections[2].Caret.Char,
+ 'Caret 3 should be at end of "Third line"');
+ Assert.AreEqual(3, FEditor.Selections[2].Caret.Line);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMultiCaretUndo;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+ Assert.AreEqual(2, FEditor.Selections.Count);
+
+ FEditor.CommandProcessor(ecChar, 'Z');
+ Assert.AreEqual('ZHello World', FEditor.Lines[0]);
+ Assert.AreEqual('ZSecond line', FEditor.Lines[1]);
+
+ FEditor.Undo;
+ Assert.AreEqual('Hello World', FEditor.Lines[0]);
+ Assert.AreEqual('Second line', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestMultiCaretRedo;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.Selections.AddCaret(BufferCoord(1, 2));
+
+ FEditor.CommandProcessor(ecChar, 'Z');
+ FEditor.Undo;
+ Assert.AreEqual('Hello World', FEditor.Lines[0]);
+
+ FEditor.Redo;
+ Assert.AreEqual('ZHello World', FEditor.Lines[0]);
+ Assert.AreEqual('ZSecond line', FEditor.Lines[1]);
+end;
+
+procedure TTestFMXSynEditMultiCaret.TestPartSelectionsForRow;
+begin
+ // Create a column selection spanning 3 lines, chars 3-6
+ FEditor.CaretXY := BufferCoord(3, 1);
+ FEditor.Selections.ColumnSelection(
+ BufferCoord(3, 1), BufferCoord(6, 3), 0);
+
+ Assert.AreEqual(3, FEditor.Selections.Count);
+
+ var Parts := FEditor.Selections.PartSelectionsForRow(
+ BufferCoord(1, 2), BufferCoord(12, 2));
+ Assert.AreEqual(1, Length(Parts),
+ 'Row 2 should have 1 partial selection');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditMultiCaret);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditOptions.pas b/Tests/FMX/TestFMXSynEditOptions.pas
new file mode 100644
index 00000000..cee9b528
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditOptions.pas
@@ -0,0 +1,125 @@
+unit TestFMXSynEditOptions;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditOptions = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestDefaultOptions;
+ [Test]
+ procedure TestSetOptionsInclude;
+ [Test]
+ procedure TestSetOptionsExclude;
+ [Test]
+ procedure TestReadOnlyDefault;
+ [Test]
+ procedure TestSetReadOnly;
+ [Test]
+ procedure TestReadOnlyBlocksTyping;
+ [Test]
+ procedure TestTabWidthDefault;
+ [Test]
+ procedure TestSetTabWidth;
+ [Test]
+ procedure TestInsertModeDefault;
+ [Test]
+ procedure TestRightEdgeDefault;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditOptions.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditOptions.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditOptions.TestDefaultOptions;
+begin
+ Assert.IsTrue(eoAutoIndent in FEditor.Options, 'eoAutoIndent should be in defaults');
+ Assert.IsTrue(eoTabsToSpaces in FEditor.Options, 'eoTabsToSpaces should be in defaults');
+ Assert.IsTrue(eoGroupUndo in FEditor.Options, 'eoGroupUndo should be in defaults');
+ Assert.IsTrue(eoKeepCaretX in FEditor.Options, 'eoKeepCaretX should be in defaults');
+ Assert.IsTrue(eoTabIndent in FEditor.Options, 'eoTabIndent should be in defaults');
+end;
+
+procedure TTestFMXSynEditOptions.TestSetOptionsInclude;
+begin
+ FEditor.Options := FEditor.Options + [eoNoCaret];
+ Assert.IsTrue(eoNoCaret in FEditor.Options);
+end;
+
+procedure TTestFMXSynEditOptions.TestSetOptionsExclude;
+begin
+ Assert.IsTrue(eoAutoIndent in FEditor.Options);
+ FEditor.Options := FEditor.Options - [eoAutoIndent];
+ Assert.IsFalse(eoAutoIndent in FEditor.Options);
+end;
+
+procedure TTestFMXSynEditOptions.TestReadOnlyDefault;
+begin
+ Assert.IsFalse(FEditor.ReadOnly);
+end;
+
+procedure TTestFMXSynEditOptions.TestSetReadOnly;
+begin
+ FEditor.ReadOnly := True;
+ Assert.IsTrue(FEditor.ReadOnly);
+end;
+
+procedure TTestFMXSynEditOptions.TestReadOnlyBlocksTyping;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.ReadOnly := True;
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('Hello', FEditor.Lines[0],
+ 'ReadOnly should prevent character insertion');
+end;
+
+procedure TTestFMXSynEditOptions.TestTabWidthDefault;
+begin
+ Assert.AreEqual(8, FEditor.TabWidth);
+end;
+
+procedure TTestFMXSynEditOptions.TestSetTabWidth;
+begin
+ FEditor.TabWidth := 4;
+ Assert.AreEqual(4, FEditor.TabWidth);
+end;
+
+procedure TTestFMXSynEditOptions.TestInsertModeDefault;
+begin
+ Assert.IsTrue(FEditor.InsertMode);
+end;
+
+procedure TTestFMXSynEditOptions.TestRightEdgeDefault;
+begin
+ Assert.AreEqual(80, FEditor.RightEdge);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditOptions);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditRenderer.pas b/Tests/FMX/TestFMXSynEditRenderer.pas
new file mode 100644
index 00000000..4ec0ac4b
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditRenderer.pas
@@ -0,0 +1,169 @@
+unit TestFMXSynEditRenderer;
+
+interface
+
+uses
+ DUnitX.TestFramework;
+
+type
+ [TestFixture]
+ TTestTColorToAlphaColor = class
+ public
+ [Test]
+ procedure TestBlack;
+ [Test]
+ procedure TestWhite;
+ [Test]
+ procedure TestRed;
+ [Test]
+ procedure TestGreen;
+ [Test]
+ procedure TestBlue;
+ [Test]
+ procedure TestMixedColorByteSwap;
+ [Test]
+ procedure TestSysNoneReturnsNull;
+ [Test]
+ procedure TestAlphaAlwaysFF;
+ end;
+
+ [TestFixture]
+ TTestSynFMXRendererMetrics = class
+ public
+ [Test]
+ procedure TestCharWidthPositive;
+ [Test]
+ procedure TestLineHeightPositive;
+ [Test]
+ procedure TestSetFontUpdatesMetrics;
+ end;
+
+implementation
+
+uses
+ System.UITypes,
+ System.UIConsts,
+ FMX.Graphics,
+ FMX.SynEditRenderer;
+
+{ TTestTColorToAlphaColor }
+
+procedure TTestTColorToAlphaColor.TestBlack;
+begin
+ // TColor black = $00000000 -> TAlphaColor = $FF000000
+ Assert.AreEqual(TAlphaColor($FF000000), TColorToAlphaColor(TColor($00000000)),
+ 'Black should convert to $FF000000');
+end;
+
+procedure TTestTColorToAlphaColor.TestWhite;
+begin
+ // TColor white = $00FFFFFF -> TAlphaColor = $FFFFFFFF
+ Assert.AreEqual(TAlphaColor($FFFFFFFF), TColorToAlphaColor(TColor($00FFFFFF)),
+ 'White should convert to $FFFFFFFF');
+end;
+
+procedure TTestTColorToAlphaColor.TestRed;
+begin
+ // TColor red = $000000FF (BB=00, GG=00, RR=FF) -> TAlphaColor = $FFFF0000
+ Assert.AreEqual(TAlphaColor($FFFF0000), TColorToAlphaColor(TColor($000000FF)),
+ 'Red TColor should become $FFFF0000');
+end;
+
+procedure TTestTColorToAlphaColor.TestGreen;
+begin
+ // TColor green = $0000FF00 (BB=00, GG=FF, RR=00) -> TAlphaColor = $FF00FF00
+ Assert.AreEqual(TAlphaColor($FF00FF00), TColorToAlphaColor(TColor($0000FF00)),
+ 'Green TColor should become $FF00FF00');
+end;
+
+procedure TTestTColorToAlphaColor.TestBlue;
+begin
+ // TColor blue = $00FF0000 (BB=FF, GG=00, RR=00) -> TAlphaColor = $FF0000FF
+ Assert.AreEqual(TAlphaColor($FF0000FF), TColorToAlphaColor(TColor($00FF0000)),
+ 'Blue TColor should become $FF0000FF');
+end;
+
+procedure TTestTColorToAlphaColor.TestMixedColorByteSwap;
+begin
+ // TColor = $00AABBCC (BB=AA, GG=BB, RR=CC) -> TAlphaColor = $FFCCBBAA
+ Assert.AreEqual(TAlphaColor($FFCCBBAA), TColorToAlphaColor(TColor($00AABBCC)),
+ 'Mixed color should byte-swap R and B channels');
+end;
+
+procedure TTestTColorToAlphaColor.TestSysNoneReturnsNull;
+begin
+ Assert.AreEqual(TAlphaColors.Null, TColorToAlphaColor(TColors.SysNone),
+ 'SysNone should map to TAlphaColors.Null');
+end;
+
+procedure TTestTColorToAlphaColor.TestAlphaAlwaysFF;
+var
+ Result: TAlphaColor;
+begin
+ // For any non-SysNone, non-system color, alpha byte should be $FF
+ Result := TColorToAlphaColor(TColor($00123456));
+ Assert.AreEqual(Byte($FF), Byte(Result shr 24),
+ 'Alpha channel should always be $FF for regular colors');
+end;
+
+{ TTestSynFMXRendererMetrics }
+
+procedure TTestSynFMXRendererMetrics.TestCharWidthPositive;
+var
+ Renderer: TSynFMXRenderer;
+begin
+ Renderer := TSynFMXRenderer.Create;
+ try
+ Assert.IsTrue(Renderer.CharWidth > 0,
+ 'CharWidth should be positive after creation');
+ finally
+ Renderer.Free;
+ end;
+end;
+
+procedure TTestSynFMXRendererMetrics.TestLineHeightPositive;
+var
+ Renderer: TSynFMXRenderer;
+begin
+ Renderer := TSynFMXRenderer.Create;
+ try
+ Assert.IsTrue(Renderer.LineHeight > 0,
+ 'LineHeight should be positive after creation');
+ finally
+ Renderer.Free;
+ end;
+end;
+
+procedure TTestSynFMXRendererMetrics.TestSetFontUpdatesMetrics;
+var
+ Renderer: TSynFMXRenderer;
+ OldCharWidth, OldLineHeight: Single;
+ NewFont: TFont;
+begin
+ Renderer := TSynFMXRenderer.Create;
+ try
+ OldCharWidth := Renderer.CharWidth;
+ OldLineHeight := Renderer.LineHeight;
+ NewFont := TFont.Create;
+ try
+ NewFont.Family := 'Consolas';
+ NewFont.Size := 24; // significantly different from default 10
+ Renderer.SetFont(NewFont);
+ finally
+ NewFont.Free;
+ end;
+ // Larger font should produce larger metrics
+ Assert.IsTrue(Renderer.CharWidth > OldCharWidth,
+ 'CharWidth should increase with larger font');
+ Assert.IsTrue(Renderer.LineHeight > OldLineHeight,
+ 'LineHeight should increase with larger font');
+ finally
+ Renderer.Free;
+ end;
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestTColorToAlphaColor);
+ TDUnitX.RegisterTestFixture(TTestSynFMXRendererMetrics);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditSearch.pas b/Tests/FMX/TestFMXSynEditSearch.pas
new file mode 100644
index 00000000..ddba1e48
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditSearch.pas
@@ -0,0 +1,166 @@
+unit TestFMXSynEditSearch;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit,
+ SynEditSearch,
+ SynEditRegexSearch;
+
+type
+ [TestFixture]
+ TTestFMXSynEditSearch = class
+ private
+ FEditor: TFMXSynEdit;
+ FSearchEngine: TSynEditSearch;
+ FRegexEngine: TSynEditRegexSearch;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestSearchFindsMatch;
+ [Test]
+ procedure TestSearchNoMatch;
+ [Test]
+ procedure TestSearchCaseSensitive;
+ [Test]
+ procedure TestSearchCaseInsensitive;
+ [Test]
+ procedure TestSearchWholeWord;
+ [Test]
+ procedure TestSearchReplace;
+ [Test]
+ procedure TestSearchReplaceAll;
+ [Test]
+ procedure TestRegexSearch;
+ [Test]
+ procedure TestRegexReplace;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes;
+
+procedure TTestFMXSynEditSearch.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FSearchEngine := TSynEditSearch.Create(nil);
+ FRegexEngine := TSynEditRegexSearch.Create(nil);
+end;
+
+procedure TTestFMXSynEditSearch.TearDown;
+begin
+ FEditor.SearchEngine := nil;
+ FRegexEngine.Free;
+ FSearchEngine.Free;
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchFindsMatch;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SearchEngine := FSearchEngine;
+ Count := FEditor.SearchReplace('World', '', [ssoEntireScope]);
+ Assert.AreEqual(1, Count, 'Should find exactly 1 "World" in text');
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchNoMatch;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SearchEngine := FSearchEngine;
+ Count := FEditor.SearchReplace('XYZ', '', [ssoEntireScope]);
+ Assert.AreEqual(0, Count, 'Should not find "XYZ" in text');
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchCaseSensitive;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SearchEngine := FSearchEngine;
+ // 'hello' with case-sensitive should NOT match 'Hello'
+ Count := FEditor.SearchReplace('hello', '', [ssoEntireScope, ssoMatchCase]);
+ Assert.AreEqual(0, Count, 'Case-sensitive search should not match different case');
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchCaseInsensitive;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'Hello World';
+ FEditor.SearchEngine := FSearchEngine;
+ // 'hello' without case-sensitive should match 'Hello'
+ Count := FEditor.SearchReplace('hello', '', [ssoEntireScope]);
+ Assert.AreEqual(1, Count, 'Case-insensitive search should match different case');
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchWholeWord;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'cat concatenate';
+ FEditor.SearchEngine := FSearchEngine;
+ // Replace all 'cat' whole-word only: should replace 'cat' but not 'cat' in 'concatenate'
+ Count := FEditor.SearchReplace('cat', 'dog',
+ [ssoEntireScope, ssoReplace, ssoReplaceAll, ssoWholeWord]);
+ Assert.AreEqual(1, Count, 'Whole-word should match only standalone "cat"');
+ Assert.AreEqual('dog concatenate', FEditor.Text);
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchReplace;
+begin
+ FEditor.Text := 'Hello World Hello';
+ FEditor.SearchEngine := FSearchEngine;
+ FEditor.SearchReplace('Hello', 'Hi',
+ [ssoEntireScope, ssoReplace]);
+ // Single replace: only the first occurrence should be replaced
+ Assert.AreEqual('Hi World Hello', FEditor.Text);
+end;
+
+procedure TTestFMXSynEditSearch.TestSearchReplaceAll;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'aaa bbb aaa bbb aaa';
+ FEditor.SearchEngine := FSearchEngine;
+ Count := FEditor.SearchReplace('aaa', 'xxx',
+ [ssoEntireScope, ssoReplace, ssoReplaceAll]);
+ Assert.AreEqual(3, Count, 'Should replace all 3 occurrences');
+ Assert.AreEqual('xxx bbb xxx bbb xxx', FEditor.Text);
+end;
+
+procedure TTestFMXSynEditSearch.TestRegexSearch;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'abc 123 def 456';
+ FEditor.SearchEngine := FRegexEngine;
+ Count := FEditor.SearchReplace('\d+', '', [ssoEntireScope]);
+ Assert.AreEqual(1, Count, 'Search without replace should find first match');
+end;
+
+procedure TTestFMXSynEditSearch.TestRegexReplace;
+var
+ Count: Integer;
+begin
+ FEditor.Text := 'abc 123 def 456';
+ FEditor.SearchEngine := FRegexEngine;
+ Count := FEditor.SearchReplace('\d+', 'NUM',
+ [ssoEntireScope, ssoReplace, ssoReplaceAll]);
+ Assert.AreEqual(2, Count, 'Should replace both digit sequences');
+ Assert.AreEqual('abc NUM def NUM', FEditor.Text);
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditSearch);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditSelection.pas b/Tests/FMX/TestFMXSynEditSelection.pas
new file mode 100644
index 00000000..18be470c
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditSelection.pas
@@ -0,0 +1,262 @@
+unit TestFMXSynEditSelection;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditSelection = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestEcSelLeft;
+ [Test]
+ procedure TestEcSelRight;
+ [Test]
+ procedure TestEcSelUp;
+ [Test]
+ procedure TestEcSelDown;
+ [Test]
+ procedure TestEcSelWordLeft;
+ [Test]
+ procedure TestEcSelWordRight;
+ [Test]
+ procedure TestEcSelLineStart;
+ [Test]
+ procedure TestEcSelLineEnd;
+ [Test]
+ procedure TestEcSelEditorTop;
+ [Test]
+ procedure TestEcSelEditorBottom;
+ [Test]
+ procedure TestAccumulatedSelection;
+ [Test]
+ procedure TestSelectionCollapseOnArrow;
+ [Test]
+ procedure TestTypingReplacesSelection;
+ [Test]
+ procedure TestDeleteReplacesSelection;
+ [Test]
+ procedure TestSelWordLeftAcrossLineBoundary;
+ [Test]
+ procedure TestSelWordRightAcrossLineBoundary;
+ [Test]
+ procedure TestSelLeftAtLineStart;
+ [Test]
+ procedure TestSelRightAtLineEnd;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditSelection.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Hello World' + sLineBreak +
+ 'Second line' + sLineBreak +
+ 'Third line';
+end;
+
+procedure TTestFMXSynEditSelection.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelLeft;
+begin
+ FEditor.CaretXY := BufferCoord(6, 1); // after 'Hello'
+ FEditor.ExecuteCommand(ecSelLeft, #0);
+ Assert.AreEqual(5, FEditor.CaretX, 'Caret should move left');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ Assert.AreEqual('o', FEditor.SelText, 'Should select one char to the left');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelRight;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual(2, FEditor.CaretX, 'Caret should move right');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ Assert.AreEqual('H', FEditor.SelText, 'Should select first char');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelUp;
+begin
+ FEditor.CaretXY := BufferCoord(3, 2);
+ FEditor.ExecuteCommand(ecSelUp, #0);
+ Assert.AreEqual(1, FEditor.CaretY, 'Caret should move up');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelDown;
+begin
+ FEditor.CaretXY := BufferCoord(3, 1);
+ FEditor.ExecuteCommand(ecSelDown, #0);
+ Assert.AreEqual(2, FEditor.CaretY, 'Caret should move down');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelWordLeft;
+begin
+ FEditor.CaretXY := BufferCoord(12, 1); // end of 'Hello World'
+ FEditor.ExecuteCommand(ecSelWordLeft, #0);
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ Assert.AreEqual('World', FEditor.SelText, 'Should select word "World"');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelWordRight;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelWordRight, #0);
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ // Word-right typically selects to end of current word including trailing space
+ Assert.IsTrue(Length(FEditor.SelText) >= 5,
+ 'Should select at least "Hello"');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelLineStart;
+begin
+ FEditor.CaretXY := BufferCoord(6, 1);
+ FEditor.ExecuteCommand(ecSelLineStart, #0);
+ Assert.AreEqual(1, FEditor.CaretX, 'Caret should be at line start');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ Assert.AreEqual('Hello', FEditor.SelText, 'Should select from start to original pos');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelLineEnd;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelLineEnd, #0);
+ Assert.AreEqual(12, FEditor.CaretX, 'Caret should be at line end');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ Assert.AreEqual('Hello World', FEditor.SelText, 'Should select entire line');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelEditorTop;
+begin
+ FEditor.CaretXY := BufferCoord(1, 3);
+ FEditor.ExecuteCommand(ecSelEditorTop, #0);
+ Assert.AreEqual(1, FEditor.CaretY, 'Caret should be at top');
+ Assert.AreEqual(1, FEditor.CaretX, 'Caret should be at column 1');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestEcSelEditorBottom;
+begin
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelEditorBottom, #0);
+ Assert.AreEqual(3, FEditor.CaretY, 'Caret should be at bottom');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestAccumulatedSelection;
+begin
+ // Multiple Shift+Right should accumulate selection
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual(4, FEditor.CaretX, 'Caret should be at pos 4');
+ Assert.AreEqual('Hel', FEditor.SelText, 'Should select 3 chars');
+end;
+
+procedure TTestFMXSynEditSelection.TestSelectionCollapseOnArrow;
+begin
+ // Select some text, then press arrow without shift to collapse
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+ // Now press Right without shift
+ FEditor.ExecuteCommand(ecRight, #0);
+ Assert.IsFalse(FEditor.SelAvail, 'Selection should be collapsed');
+end;
+
+procedure TTestFMXSynEditSelection.TestTypingReplacesSelection;
+begin
+ // Select "Hello" then type "X"
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual('Hello', FEditor.SelText);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('X World', FEditor.Lines[0],
+ 'Typing should replace selected text');
+end;
+
+procedure TTestFMXSynEditSelection.TestDeleteReplacesSelection;
+begin
+ // Select "Hello" then press Delete
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual('Hello', FEditor.SelText);
+ FEditor.ExecuteCommand(ecDeleteChar, #0);
+ Assert.AreEqual(' World', FEditor.Lines[0],
+ 'Delete should remove selected text');
+end;
+
+procedure TTestFMXSynEditSelection.TestSelWordLeftAcrossLineBoundary;
+begin
+ // At beginning of line 2, ecSelWordLeft should select into line 1
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecSelWordLeft, #0);
+ Assert.AreEqual(1, FEditor.CaretY,
+ 'Caret should move to previous line');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestSelWordRightAcrossLineBoundary;
+begin
+ // At end of line 1, ecSelWordRight should select into line 2
+ FEditor.CaretXY := BufferCoord(12, 1); // past 'Hello World'
+ FEditor.ExecuteCommand(ecSelWordRight, #0);
+ Assert.AreEqual(2, FEditor.CaretY,
+ 'Caret should move to next line');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestSelLeftAtLineStart;
+begin
+ // ecSelLeft at the beginning of line 2 should move to end of line 1
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecSelLeft, #0);
+ Assert.AreEqual(1, FEditor.CaretY,
+ 'Caret should move to previous line');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+procedure TTestFMXSynEditSelection.TestSelRightAtLineEnd;
+begin
+ // ecSelRight at the end of line 1 should move to start of line 2
+ FEditor.CaretXY := BufferCoord(12, 1);
+ FEditor.ExecuteCommand(ecSelRight, #0);
+ Assert.AreEqual(2, FEditor.CaretY,
+ 'Caret should move to next line');
+ Assert.AreEqual(1, FEditor.CaretX,
+ 'Caret should be at start of next line');
+ Assert.IsTrue(FEditor.SelAvail, 'Selection should be active');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditSelection);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditUndoRedo.pas b/Tests/FMX/TestFMXSynEditUndoRedo.pas
new file mode 100644
index 00000000..5e7688a2
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditUndoRedo.pas
@@ -0,0 +1,169 @@
+unit TestFMXSynEditUndoRedo;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit;
+
+type
+ [TestFixture]
+ TTestFMXSynEditUndoRedo = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestCanUndoInitiallyFalse;
+ [Test]
+ procedure TestCanRedoInitiallyFalse;
+ [Test]
+ procedure TestCanUndoAfterTextChange;
+ [Test]
+ procedure TestUndoRestoresText;
+ [Test]
+ procedure TestCanRedoAfterUndo;
+ [Test]
+ procedure TestRedoRestoresText;
+ [Test]
+ procedure TestClearAllResetsUndo;
+ [Test]
+ procedure TestMultipleUndoRedo;
+ [Test]
+ procedure TestRedoCaretPosition;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ SynEditTypes,
+ SynEditKeyCmds;
+
+procedure TTestFMXSynEditUndoRedo.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestCanUndoInitiallyFalse;
+begin
+ Assert.IsFalse(FEditor.CanUndo);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestCanRedoInitiallyFalse;
+begin
+ Assert.IsFalse(FEditor.CanRedo);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestCanUndoAfterTextChange;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FEditor.CanUndo);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestUndoRestoresText;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('XHello', FEditor.Lines[0]);
+ FEditor.Undo;
+ Assert.AreEqual('Hello', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestCanRedoAfterUndo;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ FEditor.Undo;
+ Assert.IsTrue(FEditor.CanRedo);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestRedoRestoresText;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ FEditor.Undo;
+ Assert.AreEqual('Hello', FEditor.Lines[0]);
+ FEditor.Redo;
+ Assert.AreEqual('XHello', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestClearAllResetsUndo;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.IsTrue(FEditor.CanUndo);
+ FEditor.ClearAll;
+ Assert.IsFalse(FEditor.CanUndo);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestMultipleUndoRedo;
+begin
+ FEditor.Text := 'AB';
+ // Type 'X' at position 1
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'X');
+ Assert.AreEqual('XAB', FEditor.Lines[0]);
+ // Type 'Y' at current position (2,1)
+ FEditor.ExecuteCommand(ecChar, 'Y');
+ Assert.AreEqual('XYAB', FEditor.Lines[0]);
+ // Undo 'Y'
+ FEditor.Undo;
+ Assert.AreEqual('XAB', FEditor.Lines[0]);
+ // Undo 'X'
+ FEditor.Undo;
+ Assert.AreEqual('AB', FEditor.Lines[0]);
+ // Redo 'X'
+ FEditor.Redo;
+ Assert.AreEqual('XAB', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXSynEditUndoRedo.TestRedoCaretPosition;
+begin
+ // Type two characters on separate lines, undo both, redo both
+ // Verify caret ends at the last redone item's position
+ FEditor.Text := 'Line1' + #13#10 + 'Line2';
+ // Type 'A' at start of line 1
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FEditor.ExecuteCommand(ecChar, 'A');
+ Assert.AreEqual('ALine1', FEditor.Lines[0]);
+ Assert.AreEqual(2, FEditor.CaretX, 'Caret should be at 2 after typing A');
+ // Type 'B' at start of line 2
+ FEditor.CaretXY := BufferCoord(1, 2);
+ FEditor.ExecuteCommand(ecChar, 'B');
+ Assert.AreEqual('BLine2', FEditor.Lines[1]);
+ Assert.AreEqual(2, FEditor.CaretX, 'Caret should be at 2 after typing B');
+ // Undo both
+ FEditor.Undo;
+ FEditor.Undo;
+ Assert.AreEqual('Line1', FEditor.Lines[0]);
+ Assert.AreEqual('Line2', FEditor.Lines[1]);
+ // Redo first (A on line 1)
+ FEditor.Redo;
+ Assert.AreEqual('ALine1', FEditor.Lines[0]);
+ Assert.AreEqual(1, FEditor.CaretY, 'Caret should be on line 1 after first redo');
+ // Redo second (B on line 2)
+ FEditor.Redo;
+ Assert.AreEqual('BLine2', FEditor.Lines[1]);
+ Assert.AreEqual(2, FEditor.CaretY, 'Caret should be on line 2 after second redo');
+ Assert.AreEqual(2, FEditor.CaretX, 'Caret X should be 2 after redoing B');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditUndoRedo);
+
+end.
diff --git a/Tests/FMX/TestFMXSynEditWordWrap.pas b/Tests/FMX/TestFMXSynEditWordWrap.pas
new file mode 100644
index 00000000..3ea9fe15
--- /dev/null
+++ b/Tests/FMX/TestFMXSynEditWordWrap.pas
@@ -0,0 +1,502 @@
+unit TestFMXSynEditWordWrap;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit,
+ SynEditTypes;
+
+type
+ [TestFixture]
+ TTestFMXSynEditWordWrap = class
+ private
+ FEditor: TFMXSynEdit;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestEnableDisable;
+ [Test]
+ procedure TestMutuallyExclusiveWithCodeFolding;
+ [Test]
+ procedure TestShortLineNoWrap;
+ [Test]
+ procedure TestEmptyLineOneRow;
+ [Test]
+ procedure TestLongLineWraps;
+ [Test]
+ procedure TestRowCount;
+ [Test]
+ procedure TestLineToRow;
+ [Test]
+ procedure TestRowToLine;
+ [Test]
+ procedure TestBufferToDisplayPos;
+ [Test]
+ procedure TestDisplayToBufferPos;
+ [Test]
+ procedure TestRoundTrip;
+ [Test]
+ procedure TestWrapAtWordBoundary;
+ [Test]
+ procedure TestWrapWithTabs;
+ [Test]
+ procedure TestEmergencyWrap;
+ [Test]
+ procedure TestCaretUpDown;
+ [Test]
+ procedure TestHorizontalScrollLocked;
+ [Test]
+ procedure TestGutterLineNumbers;
+ [Test]
+ procedure TestResizeReWraps;
+ [Test]
+ procedure TestTextChangeReWraps;
+ [Test]
+ procedure TestDisplayRowCount;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ FMX.SynEditWordWrap,
+ SynEditKeyCmds,
+ SynHighlighterJSON;
+
+procedure TTestFMXSynEditWordWrap.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Width := 400;
+ FEditor.Height := 300;
+end;
+
+procedure TTestFMXSynEditWordWrap.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestEnableDisable;
+begin
+ Assert.IsFalse(FEditor.WordWrap, 'WordWrap should be false by default');
+ FEditor.Text := 'Hello';
+ FEditor.WordWrap := True;
+ Assert.IsTrue(FEditor.WordWrap, 'WordWrap should be true after enabling');
+ FEditor.WordWrap := False;
+ Assert.IsFalse(FEditor.WordWrap, 'WordWrap should be false after disabling');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestMutuallyExclusiveWithCodeFolding;
+var
+ HL: TSynJSONSyn;
+begin
+ HL := TSynJSONSyn.Create(nil);
+ try
+ FEditor.Highlighter := HL;
+ FEditor.Text := '{"a":1}';
+ FEditor.UseCodeFolding := True;
+ Assert.IsTrue(FEditor.UseCodeFolding);
+
+ // Enabling word wrap should fail when code folding is active
+ FEditor.WordWrap := True;
+ Assert.IsFalse(FEditor.WordWrap,
+ 'WordWrap should not enable when code folding is active');
+
+ FEditor.UseCodeFolding := False;
+ FEditor.WordWrap := True;
+ Assert.IsTrue(FEditor.WordWrap);
+
+ // Enabling code folding should fail when word wrap is active
+ FEditor.UseCodeFolding := True;
+ Assert.IsFalse(FEditor.UseCodeFolding,
+ 'UseCodeFolding should not enable when WordWrap is active');
+ finally
+ FEditor.Highlighter := nil;
+ HL.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestShortLineNoWrap;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(80, 8);
+ Lines.Add('Short line');
+ Helper.Reset(Lines);
+ Assert.AreEqual(1, Helper.RowCount, 'Short line should produce 1 row');
+ Assert.AreEqual(10, Helper.GetRowLength(1), 'Row length should match line length');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestEmptyLineOneRow;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(80, 8);
+ Lines.Add('');
+ Helper.Reset(Lines);
+ Assert.AreEqual(1, Helper.RowCount, 'Empty line should produce 1 row');
+ Assert.AreEqual(0, Helper.GetRowLength(1), 'Empty row length should be 0');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestLongLineWraps;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ // 25 chars should wrap to 3 rows at width 10
+ Lines.Add('abcdefghij klmnopqrst uvwxy');
+ Helper.Reset(Lines);
+ Assert.IsTrue(Helper.RowCount > 1,
+ 'Long line should produce more than 1 row (got ' +
+ IntToStr(Helper.RowCount) + ')');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestRowCount;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('Short'); // 1 row
+ Lines.Add('Also short'); // 1 row (10 chars = exactly fits)
+ Lines.Add('This is a longer line that wraps'); // multiple rows
+ Helper.Reset(Lines);
+ Assert.IsTrue(Helper.RowCount >= 4,
+ 'Expected at least 4 rows, got ' + IntToStr(Helper.RowCount));
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestLineToRow;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('Short'); // row 1
+ Lines.Add('Hello world!'); // wraps: row 2+
+ Lines.Add('End'); // last rows
+ Helper.Reset(Lines);
+ Assert.AreEqual(1, Helper.LineToRow(1), 'Line 1 should start at row 1');
+ Assert.AreEqual(2, Helper.LineToRow(2), 'Line 2 should start at row 2');
+ // Line 3 should start after all rows of line 2
+ Assert.IsTrue(Helper.LineToRow(3) > Helper.LineToRow(2),
+ 'Line 3 should start after line 2');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestRowToLine;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('Short'); // row 1
+ Lines.Add('Hello world!'); // wraps to rows 2+
+ Lines.Add('End');
+ Helper.Reset(Lines);
+ Assert.AreEqual(1, Helper.RowToLine(1), 'Row 1 should be line 1');
+ Assert.AreEqual(2, Helper.RowToLine(2), 'Row 2 should be line 2');
+ // All wrapped rows of line 2 should map back to line 2
+ var Line2Start := Helper.LineToRow(2);
+ var Line3Start := Helper.LineToRow(3);
+ var I: Integer;
+ for I := Line2Start to Line3Start - 1 do
+ Assert.AreEqual(2, Helper.RowToLine(I),
+ 'Wrapped row ' + IntToStr(I) + ' should map to line 2');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestBufferToDisplayPos;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+ DC: TDisplayCoord;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('abcdefghij klmno'); // wraps at 10
+ Helper.Reset(Lines);
+ // First char
+ DC := Helper.BufferToDisplayPos(BufferCoord(1, 1));
+ Assert.AreEqual(1, DC.Column);
+ Assert.AreEqual(1, DC.Row);
+ // Char on second wrapped row
+ var Row2Start := Helper.GetRowLength(1) + 1;
+ DC := Helper.BufferToDisplayPos(BufferCoord(Row2Start, 1));
+ Assert.AreEqual(2, DC.Row, 'Char after wrap should be on row 2');
+ Assert.AreEqual(1, DC.Column, 'First char of wrapped row should be column 1');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestDisplayToBufferPos;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+ BC: TBufferCoord;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('abcdefghij klmno'); // wraps
+ Helper.Reset(Lines);
+ // Row 1 col 1 -> char 1 line 1
+ BC := Helper.DisplayToBufferPos(DisplayCoord(1, 1));
+ Assert.AreEqual(1, BC.Char);
+ Assert.AreEqual(1, BC.Line);
+ // Row 2 col 1 -> should be after first row's chars
+ BC := Helper.DisplayToBufferPos(DisplayCoord(1, 2));
+ Assert.AreEqual(1, BC.Line);
+ Assert.AreEqual(Helper.GetRowLength(1) + 1, BC.Char,
+ 'Row 2 col 1 should map to char after first row');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestRoundTrip;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+ BC, BC2: TBufferCoord;
+ DC: TDisplayCoord;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('Hello World Foo Bar');
+ Lines.Add('Short');
+ Helper.Reset(Lines);
+ // Test several positions
+ BC := BufferCoord(1, 1);
+ DC := Helper.BufferToDisplayPos(BC);
+ BC2 := Helper.DisplayToBufferPos(DC);
+ Assert.AreEqual(BC.Char, BC2.Char, 'Round trip char mismatch at (1,1)');
+ Assert.AreEqual(BC.Line, BC2.Line, 'Round trip line mismatch at (1,1)');
+
+ BC := BufferCoord(5, 1);
+ DC := Helper.BufferToDisplayPos(BC);
+ BC2 := Helper.DisplayToBufferPos(DC);
+ Assert.AreEqual(BC.Char, BC2.Char, 'Round trip char mismatch at (5,1)');
+ Assert.AreEqual(BC.Line, BC2.Line, 'Round trip line mismatch at (5,1)');
+
+ BC := BufferCoord(1, 2);
+ DC := Helper.BufferToDisplayPos(BC);
+ BC2 := Helper.DisplayToBufferPos(DC);
+ Assert.AreEqual(BC.Char, BC2.Char, 'Round trip char mismatch at (1,2)');
+ Assert.AreEqual(BC.Line, BC2.Line, 'Round trip line mismatch at (1,2)');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestWrapAtWordBoundary;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ // "Hello World" = 11 chars. Should wrap after "Hello " (6 chars) at the space
+ Lines.Add('Hello World');
+ Helper.Reset(Lines);
+ Assert.AreEqual(2, Helper.RowCount, 'Should wrap to 2 rows');
+ // First row should contain "Hello " (6 chars including space)
+ Assert.AreEqual(6, Helper.GetRowLength(1),
+ 'First row should break at word boundary (after space)');
+ Assert.AreEqual(5, Helper.GetRowLength(2),
+ 'Second row should contain remaining word');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestWrapWithTabs;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 4);
+ // Tab at position 0 expands to 4 visual columns + "abcdefgh" = 12 visual columns
+ Lines.Add(#9'abcdefgh');
+ Helper.Reset(Lines);
+ Assert.IsTrue(Helper.RowCount >= 2,
+ 'Tab-expanded line should wrap (got ' + IntToStr(Helper.RowCount) + ' rows)');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestEmergencyWrap;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(5, 8);
+ // No spaces -> emergency wrap at max width
+ Lines.Add('abcdefghijklmno');
+ Helper.Reset(Lines);
+ Assert.AreEqual(3, Helper.RowCount,
+ 'Should emergency-wrap 15 chars to 3 rows at width 5');
+ Assert.AreEqual(5, Helper.GetRowLength(1), 'Row 1 should be 5 chars');
+ Assert.AreEqual(5, Helper.GetRowLength(2), 'Row 2 should be 5 chars');
+ Assert.AreEqual(5, Helper.GetRowLength(3), 'Row 3 should be 5 chars');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+procedure TTestFMXSynEditWordWrap.TestCaretUpDown;
+begin
+ FEditor.Text := 'Hello World, this is a test' + sLineBreak + 'Short';
+ FEditor.WordWrap := True;
+ // Move caret to start
+ FEditor.CaretXY := BufferCoord(1, 1);
+ // Press Down - should move to next display row (possibly wrapped)
+ FEditor.ExecuteCommand(ecDown, #0);
+ // Caret should have moved
+ var NewPos := FEditor.CaretXY;
+ Assert.IsTrue((NewPos.Line > 1) or (NewPos.Char > 1),
+ 'Down arrow should move caret in word wrap mode');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestHorizontalScrollLocked;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.WordWrap := True;
+ FEditor.LeftChar := 5;
+ Assert.AreEqual(1, FEditor.LeftChar,
+ 'LeftChar should stay at 1 when word wrap is on');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestGutterLineNumbers;
+begin
+ // This is a behavioral test - verify the editor doesn't crash when painting
+ // with word wrap active and wrapped lines
+ FEditor.Text := StringOfChar('x', 200) + sLineBreak + 'Line 2';
+ FEditor.WordWrap := True;
+ // Trigger a repaint (no-op without parent but exercises the code path)
+ FEditor.Repaint;
+ Assert.Pass('Painting with word wrap should not raise exceptions');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestResizeReWraps;
+var
+ RowsBefore, RowsAfter: Integer;
+begin
+ FEditor.Text := StringOfChar('a', 100);
+ FEditor.WordWrap := True;
+ RowsBefore := FEditor.DisplayRowCount;
+ // Make editor narrower -> more wrapping
+ FEditor.Width := FEditor.Width / 2;
+ RowsAfter := FEditor.DisplayRowCount;
+ Assert.IsTrue(RowsAfter >= RowsBefore,
+ 'Narrower editor should produce >= rows (before=' +
+ IntToStr(RowsBefore) + ', after=' + IntToStr(RowsAfter) + ')');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestTextChangeReWraps;
+var
+ RowsBefore, RowsAfter: Integer;
+begin
+ FEditor.Text := 'Short';
+ FEditor.WordWrap := True;
+ RowsBefore := FEditor.DisplayRowCount;
+ Assert.AreEqual(1, RowsBefore, 'Short text should be 1 row');
+ // Add a long line
+ FEditor.Text := StringOfChar('x', 200);
+ RowsAfter := FEditor.DisplayRowCount;
+ Assert.IsTrue(RowsAfter > 1,
+ 'Long line should produce multiple rows after text change');
+end;
+
+procedure TTestFMXSynEditWordWrap.TestDisplayRowCount;
+var
+ Helper: TFMXWordWrapHelper;
+ Lines: TStringList;
+begin
+ Helper := TFMXWordWrapHelper.Create;
+ Lines := TStringList.Create;
+ try
+ Helper.SetWrapWidth(10, 8);
+ Lines.Add('Short'); // 1 row
+ Lines.Add(''); // 1 row
+ Lines.Add('Also short'); // 1 row
+ Helper.Reset(Lines);
+ Assert.AreEqual(3, Helper.RowCount,
+ 'Three short lines should produce 3 rows');
+ finally
+ Lines.Free;
+ Helper.Free;
+ end;
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynEditWordWrap);
+
+end.
diff --git a/Tests/FMX/TestFMXSynMacroRecorder.pas b/Tests/FMX/TestFMXSynMacroRecorder.pas
new file mode 100644
index 00000000..b957e361
--- /dev/null
+++ b/Tests/FMX/TestFMXSynMacroRecorder.pas
@@ -0,0 +1,769 @@
+unit TestFMXSynMacroRecorder;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ System.Classes,
+ SynEditTypes,
+ SynEditKeyCmds,
+ SynMacroRecorderShared,
+ FMX.SynEdit,
+ FMX.SynMacroRecorder;
+
+type
+ // --- Shared macro event unit tests ---
+ [TestFixture]
+ TTestSharedMacroEvents = class
+ private
+ FPlaybackCalled: Boolean;
+ FPlaybackCount: Integer;
+ FPlaybackCommand: TSynEditorCommand;
+ procedure PlaybackCallback(Command: TSynEditorCommand;
+ AChar: WideChar; Data: Pointer);
+ procedure PlaybackCountCallback(Command: TSynEditorCommand;
+ AChar: WideChar; Data: Pointer);
+ public
+ [Test]
+ procedure TestCreateMacroEventBasic;
+ [Test]
+ procedure TestCreateMacroEventChar;
+ [Test]
+ procedure TestCreateMacroEventString;
+ [Test]
+ procedure TestCreateMacroEventGotoXY;
+ [Test]
+ procedure TestBasicEventStreamRoundTrip;
+ [Test]
+ procedure TestCharEventStreamRoundTrip;
+ [Test]
+ procedure TestStringEventStreamRoundTrip;
+ [Test]
+ procedure TestPositionEventStreamRoundTrip;
+ [Test]
+ procedure TestBasicEventAsString;
+ [Test]
+ procedure TestCharEventAsString;
+ [Test]
+ procedure TestStringEventAsString;
+ [Test]
+ procedure TestPositionEventAsString;
+ [Test]
+ procedure TestPlaybackToCallsCallback;
+ [Test]
+ procedure TestRepeatCountPlaybackTo;
+ end;
+
+ // --- FMX editor hooked command handler tests ---
+ [TestFixture]
+ TTestFMXHookedCommandHandlers = class
+ private
+ FEditor: TFMXSynEdit;
+ FHandlerCallCount: Integer;
+ FHandler2CallCount: Integer;
+ FLastAfterProcessing: Boolean;
+ FLastCommand: TSynEditorCommand;
+ FSuppressCommand: Boolean;
+ procedure TestHandler(Sender: TObject; AfterProcessing: Boolean;
+ var Handled: Boolean; var Command: TSynEditorCommand;
+ var AChar: WideChar; Data: Pointer; HandlerData: Pointer);
+ procedure TestHandler2(Sender: TObject; AfterProcessing: Boolean;
+ var Handled: Boolean; var Command: TSynEditorCommand;
+ var AChar: WideChar; Data: Pointer; HandlerData: Pointer);
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestRegisterAndCallHandler;
+ [Test]
+ procedure TestHandlerCalledBeforeAndAfter;
+ [Test]
+ procedure TestHandlerCanSuppressCommand;
+ [Test]
+ procedure TestUnregisterRemovesHandler;
+ [Test]
+ procedure TestMultipleHandlers;
+ end;
+
+ // --- FMX macro recorder integration tests ---
+ [TestFixture]
+ TTestFMXMacroRecorder = class
+ private
+ FEditor: TFMXSynEdit;
+ FRecorder: TFMXSynMacroRecorder;
+ FStateChangeCount: Integer;
+ procedure OnStateChange(Sender: TObject);
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestInitialState;
+ [Test]
+ procedure TestRecordAndPlaybackTyping;
+ [Test]
+ procedure TestRecordAndPlaybackNavigation;
+ [Test]
+ procedure TestRecordAndPlaybackDeleteAndType;
+ [Test]
+ procedure TestPlaybackIsUndoable;
+ [Test]
+ procedure TestStateTransitions;
+ [Test]
+ procedure TestPauseResume;
+ [Test]
+ procedure TestCannotRecordWhilePlaying;
+ [Test]
+ procedure TestCannotPlayWhileRecording;
+ [Test]
+ procedure TestClear;
+ [Test]
+ procedure TestSaveLoadStreamRoundTrip;
+ [Test]
+ procedure TestAsStringRoundTrip;
+ [Test]
+ procedure TestEditorFreeUnhooksRecorder;
+ [Test]
+ procedure TestEmptyMacroPlayback;
+ [Test]
+ procedure TestRecordGotoXY;
+ [Test]
+ procedure TestOnStateChangeFires;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.IOUtils;
+
+{ TTestSharedMacroEvents }
+
+procedure TTestSharedMacroEvents.TestCreateMacroEventBasic;
+var
+ E: TSynMacroEvent;
+begin
+ E := CreateMacroEvent(ecRight);
+ try
+ Assert.IsTrue(E is TSynBasicEvent);
+ Assert.AreEqual(Integer(ecRight), Integer(TSynBasicEvent(E).Command));
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestCreateMacroEventChar;
+var
+ E: TSynMacroEvent;
+begin
+ E := CreateMacroEvent(ecChar);
+ try
+ Assert.IsTrue(E is TSynCharEvent);
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestCreateMacroEventString;
+var
+ E: TSynMacroEvent;
+begin
+ E := CreateMacroEvent(ecString);
+ try
+ Assert.IsTrue(E is TSynStringEvent);
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestCreateMacroEventGotoXY;
+var
+ E: TSynMacroEvent;
+begin
+ E := CreateMacroEvent(ecGotoXY);
+ try
+ Assert.IsTrue(E is TSynPositionEvent);
+ Assert.AreEqual(Integer(ecGotoXY), Integer(TSynPositionEvent(E).Command));
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestBasicEventStreamRoundTrip;
+var
+ E1, E2: TSynBasicEvent;
+ Stream: TMemoryStream;
+ Cmd: TSynEditorCommand;
+begin
+ E1 := TSynBasicEvent.Create;
+ Stream := TMemoryStream.Create;
+ try
+ E1.Command := ecRight;
+ E1.RepeatCount := 3;
+ E1.SaveToStream(Stream);
+
+ Stream.Position := 0;
+ Stream.Read(Cmd, SizeOf(Cmd));
+ E2 := TSynBasicEvent.Create;
+ try
+ E2.Command := Cmd;
+ E2.LoadFromStream(Stream);
+ Assert.AreEqual(Integer(ecRight), Integer(E2.Command));
+ Assert.AreEqual(Integer(3), Integer(E2.RepeatCount));
+ finally
+ E2.Free;
+ end;
+ finally
+ E1.Free;
+ Stream.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestCharEventStreamRoundTrip;
+var
+ E1, E2: TSynCharEvent;
+ Stream: TMemoryStream;
+ Cmd: TSynEditorCommand;
+begin
+ E1 := TSynCharEvent.Create;
+ Stream := TMemoryStream.Create;
+ try
+ E1.Initialize(ecChar, 'Z', nil);
+ E1.SaveToStream(Stream);
+
+ Stream.Position := 0;
+ Stream.Read(Cmd, SizeOf(Cmd));
+ E2 := TSynCharEvent.Create;
+ try
+ E2.LoadFromStream(Stream);
+ Assert.AreEqual('Z', string(E2.Key));
+ finally
+ E2.Free;
+ end;
+ finally
+ E1.Free;
+ Stream.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestStringEventStreamRoundTrip;
+var
+ E1, E2: TSynStringEvent;
+ Stream: TMemoryStream;
+ Cmd: TSynEditorCommand;
+ S: string;
+begin
+ E1 := TSynStringEvent.Create;
+ Stream := TMemoryStream.Create;
+ S := 'Hello';
+ try
+ E1.Initialize(ecString, #0, PChar(S));
+ E1.SaveToStream(Stream);
+
+ Stream.Position := 0;
+ Stream.Read(Cmd, SizeOf(Cmd));
+ E2 := TSynStringEvent.Create;
+ try
+ E2.LoadFromStream(Stream);
+ Assert.AreEqual('Hello', E2.Value);
+ finally
+ E2.Free;
+ end;
+ finally
+ E1.Free;
+ Stream.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestPositionEventStreamRoundTrip;
+var
+ E1, E2: TSynPositionEvent;
+ Stream: TMemoryStream;
+ Cmd: TSynEditorCommand;
+ RepeatCnt: Byte;
+ Pos: TBufferCoord;
+begin
+ E1 := TSynPositionEvent.Create;
+ Stream := TMemoryStream.Create;
+ try
+ E1.Command := ecGotoXY;
+ Pos := BufferCoord(5, 10);
+ E1.Initialize(ecGotoXY, #0, @Pos);
+ E1.SaveToStream(Stream);
+
+ // Stream format: Command(2) + RepeatCount(1) + Position(8)
+ Stream.Position := 0;
+ Stream.Read(Cmd, SizeOf(Cmd));
+ Stream.Read(RepeatCnt, SizeOf(RepeatCnt));
+ E2 := TSynPositionEvent.Create;
+ try
+ E2.Command := Cmd;
+ E2.LoadFromStream(Stream);
+ Assert.AreEqual(5, E2.Position.Char);
+ Assert.AreEqual(10, E2.Position.Line);
+ finally
+ E2.Free;
+ end;
+ finally
+ E1.Free;
+ Stream.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestBasicEventAsString;
+var
+ E: TSynBasicEvent;
+begin
+ E := TSynBasicEvent.Create;
+ try
+ E.Command := ecRight;
+ Assert.IsNotEmpty(E.AsString);
+ Assert.IsTrue(Pos('ecRight', E.AsString) > 0);
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestCharEventAsString;
+var
+ E: TSynCharEvent;
+begin
+ E := TSynCharEvent.Create;
+ try
+ E.Initialize(ecChar, 'A', nil);
+ Assert.IsNotEmpty(E.AsString);
+ Assert.IsTrue(Pos('A', E.AsString) > 0);
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestStringEventAsString;
+var
+ E: TSynStringEvent;
+ S: string;
+begin
+ E := TSynStringEvent.Create;
+ S := 'test';
+ try
+ E.Initialize(ecString, #0, PChar(S));
+ Assert.IsNotEmpty(E.AsString);
+ Assert.IsTrue(Pos('test', E.AsString) > 0);
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestPositionEventAsString;
+var
+ E: TSynPositionEvent;
+ Pos: TBufferCoord;
+begin
+ E := TSynPositionEvent.Create;
+ try
+ E.Command := ecGotoXY;
+ Pos := BufferCoord(3, 7);
+ E.Initialize(ecGotoXY, #0, @Pos);
+ Assert.IsNotEmpty(E.AsString);
+ Assert.IsTrue(Pos.Char > 0); // sanity
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.PlaybackCallback(
+ Command: TSynEditorCommand; AChar: WideChar; Data: Pointer);
+begin
+ FPlaybackCalled := True;
+ FPlaybackCommand := Command;
+end;
+
+procedure TTestSharedMacroEvents.PlaybackCountCallback(
+ Command: TSynEditorCommand; AChar: WideChar; Data: Pointer);
+begin
+ Inc(FPlaybackCount);
+end;
+
+procedure TTestSharedMacroEvents.TestPlaybackToCallsCallback;
+var
+ E: TSynBasicEvent;
+begin
+ FPlaybackCalled := False;
+ FPlaybackCommand := ecNone;
+ E := TSynBasicEvent.Create;
+ try
+ E.Command := ecRight;
+ E.PlaybackTo(PlaybackCallback);
+ Assert.IsTrue(FPlaybackCalled);
+ Assert.AreEqual(Integer(ecRight), Integer(FPlaybackCommand));
+ finally
+ E.Free;
+ end;
+end;
+
+procedure TTestSharedMacroEvents.TestRepeatCountPlaybackTo;
+var
+ E: TSynBasicEvent;
+begin
+ FPlaybackCount := 0;
+ E := TSynBasicEvent.Create;
+ try
+ E.Command := ecRight;
+ E.RepeatCount := 5;
+ E.PlaybackTo(PlaybackCountCallback);
+ Assert.AreEqual(5, FPlaybackCount);
+ finally
+ E.Free;
+ end;
+end;
+
+{ TTestFMXHookedCommandHandlers }
+
+procedure TTestFMXHookedCommandHandlers.TestHandler(Sender: TObject;
+ AfterProcessing: Boolean; var Handled: Boolean;
+ var Command: TSynEditorCommand; var AChar: WideChar;
+ Data: Pointer; HandlerData: Pointer);
+begin
+ Inc(FHandlerCallCount);
+ FLastAfterProcessing := AfterProcessing;
+ FLastCommand := Command;
+ if FSuppressCommand and (not AfterProcessing) then
+ Handled := True;
+end;
+
+procedure TTestFMXHookedCommandHandlers.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Hello World';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FHandlerCallCount := 0;
+ FLastAfterProcessing := False;
+ FLastCommand := ecNone;
+ FSuppressCommand := False;
+end;
+
+procedure TTestFMXHookedCommandHandlers.TearDown;
+begin
+ FEditor.Free;
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestRegisterAndCallHandler;
+begin
+ FEditor.RegisterCommandHandler(TestHandler, nil);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.UnregisterCommandHandler(TestHandler);
+ Assert.IsTrue(FHandlerCallCount > 0);
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestHandlerCalledBeforeAndAfter;
+begin
+ FEditor.RegisterCommandHandler(TestHandler, nil);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.UnregisterCommandHandler(TestHandler);
+ // Should be called twice: before and after
+ Assert.AreEqual(2, FHandlerCallCount);
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestHandlerCanSuppressCommand;
+begin
+ FSuppressCommand := True;
+ FEditor.RegisterCommandHandler(TestHandler, nil);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.UnregisterCommandHandler(TestHandler);
+ // Command was suppressed, so caret should not have moved
+ Assert.AreEqual(1, FEditor.CaretX);
+ // Only the pre-hook should fire (command suppressed)
+ Assert.AreEqual(1, FHandlerCallCount);
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestUnregisterRemovesHandler;
+begin
+ FEditor.RegisterCommandHandler(TestHandler, nil);
+ FEditor.UnregisterCommandHandler(TestHandler);
+ FEditor.CommandProcessor(ecRight, #0);
+ Assert.AreEqual(0, FHandlerCallCount);
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestHandler2(Sender: TObject;
+ AfterProcessing: Boolean; var Handled: Boolean;
+ var Command: TSynEditorCommand; var AChar: WideChar;
+ Data: Pointer; HandlerData: Pointer);
+begin
+ Inc(FHandler2CallCount);
+end;
+
+procedure TTestFMXHookedCommandHandlers.TestMultipleHandlers;
+begin
+ FHandler2CallCount := 0;
+ FEditor.RegisterCommandHandler(TestHandler, nil);
+ FEditor.RegisterCommandHandler(TestHandler2, nil);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.UnregisterCommandHandler(TestHandler);
+ FEditor.UnregisterCommandHandler(TestHandler2);
+ Assert.IsTrue(FHandlerCallCount > 0);
+ Assert.IsTrue(FHandler2CallCount > 0);
+end;
+
+{ TTestFMXMacroRecorder }
+
+procedure TTestFMXMacroRecorder.OnStateChange(Sender: TObject);
+begin
+ Inc(FStateChangeCount);
+end;
+
+procedure TTestFMXMacroRecorder.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FEditor.Text := 'Hello World' + sLineBreak + 'Second Line';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder := TFMXSynMacroRecorder.Create(nil);
+ FRecorder.Editor := FEditor;
+ FStateChangeCount := 0;
+end;
+
+procedure TTestFMXMacroRecorder.TearDown;
+begin
+ FRecorder.Free;
+ FEditor.Free;
+end;
+
+procedure TTestFMXMacroRecorder.TestInitialState;
+begin
+ Assert.AreEqual(Ord(msStopped), Ord(FRecorder.State));
+ Assert.IsTrue(FRecorder.IsEmpty);
+ Assert.AreEqual('unnamed', FRecorder.MacroName);
+ Assert.IsFalse(FRecorder.SaveMarkerPos);
+end;
+
+procedure TTestFMXMacroRecorder.TestRecordAndPlaybackTyping;
+begin
+ FEditor.Text := '';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecChar, 'A');
+ FEditor.CommandProcessor(ecChar, 'B');
+ FEditor.CommandProcessor(ecChar, 'C');
+ FRecorder.Stop;
+ Assert.AreEqual(3, FRecorder.EventCount);
+ // Playback on fresh text
+ FEditor.Text := '';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual('ABC', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXMacroRecorder.TestRecordAndPlaybackNavigation;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.CommandProcessor(ecRight, #0);
+ FRecorder.Stop;
+ Assert.AreEqual(3, FRecorder.EventCount);
+ // Playback from position 1
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual(4, FEditor.CaretX);
+end;
+
+procedure TTestFMXMacroRecorder.TestRecordAndPlaybackDeleteAndType;
+begin
+ FEditor.Text := 'ABC';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecDeleteChar, #0);
+ FEditor.CommandProcessor(ecChar, 'X');
+ FRecorder.Stop;
+ // Apply to fresh text
+ FEditor.Text := 'DEF';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual('XEF', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXMacroRecorder.TestPlaybackIsUndoable;
+var
+ OrigText: string;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ OrigText := FEditor.Text;
+ // Record: type 'X'
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecChar, 'X');
+ FRecorder.Stop;
+ // Reset and playback
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreNotEqual(OrigText, FEditor.Text);
+ // Undo
+ FEditor.Undo;
+ Assert.AreEqual(OrigText, FEditor.Text);
+end;
+
+procedure TTestFMXMacroRecorder.TestStateTransitions;
+begin
+ Assert.AreEqual(Ord(msStopped), Ord(FRecorder.State));
+ FRecorder.RecordMacro(FEditor);
+ Assert.AreEqual(Ord(msRecording), Ord(FRecorder.State));
+ FRecorder.Stop;
+ Assert.AreEqual(Ord(msStopped), Ord(FRecorder.State));
+end;
+
+procedure TTestFMXMacroRecorder.TestPauseResume;
+begin
+ FRecorder.RecordMacro(FEditor);
+ FRecorder.Pause;
+ Assert.AreEqual(Ord(msPaused), Ord(FRecorder.State));
+ FRecorder.Resume;
+ Assert.AreEqual(Ord(msRecording), Ord(FRecorder.State));
+ FRecorder.Stop;
+end;
+
+procedure TTestFMXMacroRecorder.TestCannotRecordWhilePlaying;
+begin
+ FRecorder.AddEvent(ecRight, #0, nil);
+ FRecorder.PlaybackMacro(FEditor);
+ // After playback completes, should be able to record
+ FRecorder.RecordMacro(FEditor);
+ Assert.AreEqual(Ord(msRecording), Ord(FRecorder.State));
+ FRecorder.Stop;
+end;
+
+procedure TTestFMXMacroRecorder.TestCannotPlayWhileRecording;
+var
+ Raised: Boolean;
+begin
+ Raised := False;
+ FRecorder.RecordMacro(FEditor);
+ try
+ FRecorder.PlaybackMacro(FEditor);
+ except
+ on E: Exception do
+ Raised := True;
+ end;
+ FRecorder.Stop;
+ Assert.IsTrue(Raised, 'Should raise exception when playing while recording');
+end;
+
+procedure TTestFMXMacroRecorder.TestClear;
+begin
+ FRecorder.AddEvent(ecRight, #0, nil);
+ FRecorder.AddEvent(ecLeft, #0, nil);
+ Assert.AreEqual(2, FRecorder.EventCount);
+ FRecorder.Clear;
+ Assert.IsTrue(FRecorder.IsEmpty);
+ Assert.AreEqual(0, FRecorder.EventCount);
+end;
+
+procedure TTestFMXMacroRecorder.TestSaveLoadStreamRoundTrip;
+var
+ Stream: TMemoryStream;
+begin
+ FEditor.Text := 'Test';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.CommandProcessor(ecChar, 'X');
+ FRecorder.Stop;
+ Assert.AreEqual(2, FRecorder.EventCount);
+
+ Stream := TMemoryStream.Create;
+ try
+ FRecorder.SaveToStream(Stream);
+ Assert.IsTrue(Stream.Size > 0);
+ FRecorder.Clear;
+ Stream.Position := 0;
+ FRecorder.LoadFromStream(Stream);
+ Assert.AreEqual(2, FRecorder.EventCount);
+ // Verify playback
+ FEditor.Text := 'Test';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual('TXest', FEditor.Lines[0]);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TTestFMXMacroRecorder.TestAsStringRoundTrip;
+var
+ MacroStr: string;
+begin
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.RecordMacro(FEditor);
+ FEditor.CommandProcessor(ecRight, #0);
+ FEditor.CommandProcessor(ecChar, 'Y');
+ FRecorder.Stop;
+ MacroStr := FRecorder.AsString;
+ Assert.IsNotEmpty(MacroStr);
+ FRecorder.Clear;
+ FRecorder.AsString := MacroStr;
+ Assert.AreEqual(2, FRecorder.EventCount);
+ FEditor.Text := 'Hello';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual('HYello', FEditor.Lines[0]);
+end;
+
+procedure TTestFMXMacroRecorder.TestEditorFreeUnhooksRecorder;
+var
+ TempEditor: TFMXSynEdit;
+begin
+ TempEditor := TFMXSynEdit.Create(nil);
+ try
+ FRecorder.Editor := TempEditor;
+ Assert.IsNotNull(TComponent(FRecorder.Editor));
+ finally
+ TempEditor.Free;
+ end;
+ // After editor is freed, recorder should have nil editor
+ Assert.IsNull(TComponent(FRecorder.Editor));
+ Assert.AreEqual(Ord(msStopped), Ord(FRecorder.State));
+end;
+
+procedure TTestFMXMacroRecorder.TestEmptyMacroPlayback;
+begin
+ FEditor.Text := 'Hello';
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual('Hello', FEditor.Text);
+end;
+
+procedure TTestFMXMacroRecorder.TestRecordGotoXY;
+var
+ Pos: TBufferCoord;
+begin
+ FEditor.Text := 'Hello' + sLineBreak + 'World';
+ FEditor.CaretXY := BufferCoord(1, 1);
+ // Manually add a GotoXY event
+ Pos := BufferCoord(3, 2);
+ FRecorder.AddEvent(ecGotoXY, #0, @Pos);
+ Assert.AreEqual(1, FRecorder.EventCount);
+ // Playback
+ FRecorder.PlaybackMacro(FEditor);
+ Assert.AreEqual(3, FEditor.CaretX);
+ Assert.AreEqual(2, FEditor.CaretY);
+end;
+
+procedure TTestFMXMacroRecorder.TestOnStateChangeFires;
+begin
+ FRecorder.OnStateChange := OnStateChange;
+ FStateChangeCount := 0;
+ FRecorder.RecordMacro(FEditor);
+ Assert.IsTrue(FStateChangeCount > 0, 'Should fire on record');
+ FRecorder.Stop;
+ Assert.AreEqual(2, FStateChangeCount, 'Should fire on record and stop');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestSharedMacroEvents);
+ TDUnitX.RegisterTestFixture(TTestFMXHookedCommandHandlers);
+ TDUnitX.RegisterTestFixture(TTestFMXMacroRecorder);
+end.
diff --git a/Tests/FMX/TestFMXSynSpellCheck.pas b/Tests/FMX/TestFMXSynSpellCheck.pas
new file mode 100644
index 00000000..2cbeaaf0
--- /dev/null
+++ b/Tests/FMX/TestFMXSynSpellCheck.pas
@@ -0,0 +1,261 @@
+unit TestFMXSynSpellCheck;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynSpellCheckTypes,
+ SynSpellCheckHunspellProvider;
+
+type
+ [TestFixture]
+ TTestFMXSynHunspellProvider = class
+ private
+ FProvider: ISynSpellCheckProvider;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ { Loading }
+ [Test]
+ procedure TestIsAvailable;
+ [Test]
+ procedure TestIsAvailableMissingPath;
+ [Test]
+ procedure TestGetLanguage;
+ [Test]
+ procedure TestSetLanguageReloads;
+ { Direct word checks }
+ [Test]
+ procedure TestCommonWordsValid;
+ [Test]
+ procedure TestMisspelledWordsInvalid;
+ [Test]
+ procedure TestCaseInsensitive;
+ { Suffix rules }
+ [Test]
+ procedure TestSuffixIng;
+ [Test]
+ procedure TestSuffixEd;
+ [Test]
+ procedure TestSuffixPlural;
+ [Test]
+ procedure TestSuffixIon;
+ [Test]
+ procedure TestSuffixIve;
+ { Prefix rules }
+ [Test]
+ procedure TestPrefixUn;
+ [Test]
+ procedure TestPrefixRe;
+ { Cross-product }
+ [Test]
+ procedure TestCrossProduct;
+ { Suggest }
+ [Test]
+ procedure TestSuggestReturnsResults;
+ [Test]
+ procedure TestSuggestMaxCount;
+ [Test]
+ procedure TestSuggestContainsCorrection;
+ { Native provider stub }
+ [Test]
+ procedure TestNativeNotAvailable;
+ [Test]
+ procedure TestNativeCheckWordTrue;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.IOUtils;
+
+const
+ DictLang = 'en_US';
+
+function GetDictPath: string;
+begin
+ // Resolve relative to exe location (Tests/bin/Win32/Debug/)
+ Result := TPath.GetFullPath(
+ TPath.Combine(ExtractFilePath(ParamStr(0)), '..\..\..\..\Dictionaries'));
+end;
+
+procedure TTestFMXSynHunspellProvider.Setup;
+begin
+ FProvider := TSynHunspellProvider.Create(GetDictPath, DictLang);
+end;
+
+procedure TTestFMXSynHunspellProvider.TearDown;
+begin
+ FProvider := nil;
+end;
+
+{ Loading }
+
+procedure TTestFMXSynHunspellProvider.TestIsAvailable;
+begin
+ Assert.IsTrue(FProvider.IsAvailable, 'en_US dictionary should be available');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestIsAvailableMissingPath;
+var
+ P: ISynSpellCheckProvider;
+begin
+ P := TSynHunspellProvider.Create('C:\nonexistent\path', 'en_US');
+ Assert.IsFalse(P.IsAvailable, 'Missing path should not be available');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestGetLanguage;
+begin
+ Assert.AreEqual('en_US', FProvider.GetLanguage);
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSetLanguageReloads;
+begin
+ // Force load
+ FProvider.IsAvailable;
+ // Change to non-existent language — should clear and fail to reload
+ FProvider.SetLanguage('xx_XX');
+ Assert.IsFalse(FProvider.IsAvailable, 'Invalid language should not be available');
+ // Change back — should reload successfully
+ FProvider.SetLanguage('en_US');
+ Assert.IsTrue(FProvider.IsAvailable, 'Restoring en_US should reload');
+end;
+
+{ Direct word checks }
+
+procedure TTestFMXSynHunspellProvider.TestCommonWordsValid;
+begin
+ Assert.IsTrue(FProvider.CheckWord('hello'), '"hello" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('world'), '"world" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('the'), '"the" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('computer'), '"computer" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestMisspelledWordsInvalid;
+begin
+ Assert.IsFalse(FProvider.CheckWord('helo'), '"helo" should be invalid');
+ Assert.IsFalse(FProvider.CheckWord('wrold'), '"wrold" should be invalid');
+ Assert.IsFalse(FProvider.CheckWord('teh'), '"teh" should be invalid');
+ Assert.IsFalse(FProvider.CheckWord('computr'), '"computr" should be invalid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestCaseInsensitive;
+begin
+ Assert.IsTrue(FProvider.CheckWord('Hello'), '"Hello" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('HELLO'), '"HELLO" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('hello'), '"hello" should be valid');
+end;
+
+{ Suffix rules }
+
+procedure TTestFMXSynHunspellProvider.TestSuffixIng;
+begin
+ Assert.IsTrue(FProvider.CheckWord('walking'), '"walking" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('talking'), '"talking" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuffixEd;
+begin
+ Assert.IsTrue(FProvider.CheckWord('walked'), '"walked" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('talked'), '"talked" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuffixPlural;
+begin
+ Assert.IsTrue(FProvider.CheckWord('classes'), '"classes" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('boxes'), '"boxes" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuffixIon;
+begin
+ Assert.IsTrue(FProvider.CheckWord('creation'), '"creation" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuffixIve;
+begin
+ Assert.IsTrue(FProvider.CheckWord('creative'), '"creative" should be valid');
+end;
+
+{ Prefix rules }
+
+procedure TTestFMXSynHunspellProvider.TestPrefixUn;
+begin
+ Assert.IsTrue(FProvider.CheckWord('unlikely'), '"unlikely" should be valid');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestPrefixRe;
+begin
+ Assert.IsTrue(FProvider.CheckWord('reuse'), '"reuse" should be valid');
+end;
+
+{ Cross-product }
+
+procedure TTestFMXSynHunspellProvider.TestCrossProduct;
+begin
+ Assert.IsTrue(FProvider.CheckWord('undoing'), '"undoing" should be valid');
+end;
+
+{ Suggest }
+
+procedure TTestFMXSynHunspellProvider.TestSuggestReturnsResults;
+var
+ Suggestions: TArray;
+begin
+ Suggestions := FProvider.Suggest('helo');
+ Assert.IsTrue(Length(Suggestions) >= 3,
+ '"helo" should produce at least 3 suggestions, got ' + IntToStr(Length(Suggestions)));
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuggestMaxCount;
+var
+ Suggestions: TArray;
+begin
+ Suggestions := FProvider.Suggest('helo');
+ Assert.IsTrue(Length(Suggestions) > 0,
+ 'Should return at least 1 suggestion');
+ Assert.IsTrue(Length(Suggestions) <= 10,
+ 'Should return at most 10 suggestions, got ' + IntToStr(Length(Suggestions)));
+end;
+
+procedure TTestFMXSynHunspellProvider.TestSuggestContainsCorrection;
+var
+ Suggestions: TArray;
+ S: string;
+ Found: Boolean;
+begin
+ Suggestions := FProvider.Suggest('walkin');
+ Found := False;
+ for S in Suggestions do
+ if SameText(S, 'walking') then
+ begin
+ Found := True;
+ Break;
+ end;
+ Assert.IsTrue(Found, '"walkin" suggestions should include "walking"');
+end;
+
+{ Native provider stub }
+
+procedure TTestFMXSynHunspellProvider.TestNativeNotAvailable;
+var
+ P: ISynSpellCheckProvider;
+begin
+ P := TSynHunspellNativeProvider.Create(GetDictPath, DictLang);
+ Assert.IsFalse(P.IsAvailable, 'Native provider should not be available');
+end;
+
+procedure TTestFMXSynHunspellProvider.TestNativeCheckWordTrue;
+var
+ P: ISynSpellCheckProvider;
+begin
+ P := TSynHunspellNativeProvider.Create(GetDictPath, DictLang);
+ Assert.IsTrue(P.CheckWord('anything'), 'Native stub should accept all words');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynHunspellProvider);
+
+end.
diff --git a/Tests/FMX/TestFMXSynSpellCheckComponent.pas b/Tests/FMX/TestFMXSynSpellCheckComponent.pas
new file mode 100644
index 00000000..6dad1e4c
--- /dev/null
+++ b/Tests/FMX/TestFMXSynSpellCheckComponent.pas
@@ -0,0 +1,385 @@
+unit TestFMXSynSpellCheckComponent;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ FMX.SynEdit,
+ SynSpellCheckTypes,
+ FMX.SynSpellCheck;
+
+type
+ [TestFixture]
+ TTestFMXSynSpellCheckComponent = class
+ private
+ FEditor: TFMXSynEdit;
+ FSpellCheck: TSynFMXSpellCheck;
+ FProvider: ISynSpellCheckProvider;
+ FEventFired: Boolean;
+ procedure OnCheckCompleteFired(Sender: TObject);
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ { Defaults }
+ [Test]
+ procedure TestDefaults;
+ { Editor assignment }
+ [Test]
+ procedure TestSetEditor;
+ [Test]
+ procedure TestSetEditorNil;
+ { CheckFile }
+ [Test]
+ procedure TestCheckFileFindsErrors;
+ [Test]
+ procedure TestCheckFileNoErrors;
+ [Test]
+ procedure TestCheckFileNoProvider;
+ [Test]
+ procedure TestCheckFileDisabled;
+ { CheckLine }
+ [Test]
+ procedure TestCheckLineSpecificLine;
+ [Test]
+ procedure TestCheckLineClearsOldErrors;
+ { ClearErrors }
+ [Test]
+ procedure TestClearErrors;
+ { ErrorAtPos }
+ [Test]
+ procedure TestErrorAtPosFound;
+ [Test]
+ procedure TestErrorAtPosNotFound;
+ [Test]
+ procedure TestErrorAtPosWrongLine;
+ { Enabled toggle }
+ [Test]
+ procedure TestEnabledToggleClearsErrors;
+ { Events }
+ [Test]
+ procedure TestOnCheckCompleteEvent;
+ { CheckSelection }
+ [Test]
+ procedure TestCheckSelectionFallback;
+ [Test]
+ procedure TestCheckSelectionClearsDuplicates;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ System.Generics.Collections,
+ SynEditTypes;
+
+type
+ TMockSpellProvider = class(TInterfacedObject, ISynSpellCheckProvider)
+ private
+ FValidWords: TList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function CheckWord(const AWord: string): Boolean;
+ function Suggest(const AWord: string): TArray;
+ function IsAvailable: Boolean;
+ function GetLanguage: string;
+ procedure SetLanguage(const Value: string);
+ end;
+
+{ TMockSpellProvider }
+
+constructor TMockSpellProvider.Create;
+begin
+ inherited Create;
+ FValidWords := TList.Create;
+ FValidWords.Add('hello');
+ FValidWords.Add('world');
+ FValidWords.Add('the');
+ FValidWords.Add('quick');
+ FValidWords.Add('brown');
+ FValidWords.Add('fox');
+end;
+
+destructor TMockSpellProvider.Destroy;
+begin
+ FValidWords.Free;
+ inherited;
+end;
+
+function TMockSpellProvider.CheckWord(const AWord: string): Boolean;
+var
+ S: string;
+begin
+ for S in FValidWords do
+ if SameText(S, AWord) then
+ Exit(True);
+ Result := False;
+end;
+
+function TMockSpellProvider.Suggest(const AWord: string): TArray;
+begin
+ Result := TArray.Create('hello');
+end;
+
+function TMockSpellProvider.IsAvailable: Boolean;
+begin
+ Result := True;
+end;
+
+function TMockSpellProvider.GetLanguage: string;
+begin
+ Result := 'mock';
+end;
+
+procedure TMockSpellProvider.SetLanguage(const Value: string);
+begin
+ // no-op
+end;
+
+{ TTestFMXSynSpellCheckComponent }
+
+procedure TTestFMXSynSpellCheckComponent.Setup;
+begin
+ FEditor := TFMXSynEdit.Create(nil);
+ FSpellCheck := TSynFMXSpellCheck.Create(nil);
+ FProvider := TMockSpellProvider.Create;
+ FSpellCheck.Provider := FProvider;
+ FSpellCheck.Editor := FEditor;
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TearDown;
+begin
+ FSpellCheck.Free;
+ FEditor.Free;
+ FProvider := nil;
+end;
+
+{ Defaults }
+
+procedure TTestFMXSynSpellCheckComponent.TestDefaults;
+var
+ SC: TSynFMXSpellCheck;
+begin
+ SC := TSynFMXSpellCheck.Create(nil);
+ try
+ Assert.IsTrue(SC.Enabled, 'Enabled should default to True');
+ Assert.AreEqual(0, SC.Errors.Count, 'Errors should be empty');
+ Assert.IsTrue(sctComment in SC.CheckTokens, 'sctComment should be in CheckTokens');
+ Assert.IsTrue(sctString in SC.CheckTokens, 'sctString should be in CheckTokens');
+ Assert.IsTrue(sctIdentifier in SC.CheckTokens, 'sctIdentifier should be in CheckTokens');
+ finally
+ SC.Free;
+ end;
+end;
+
+{ Editor assignment }
+
+procedure TTestFMXSynSpellCheckComponent.TestSetEditor;
+begin
+ // Setup already assigns editor — just verify no crash and editor is assigned
+ Assert.IsNotNull(FSpellCheck.Editor, 'Editor should be assigned');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestSetEditorNil;
+begin
+ FSpellCheck.Editor := nil;
+ Assert.IsNull(FSpellCheck.Editor, 'Editor should be nil after clearing');
+end;
+
+{ CheckFile }
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckFileFindsErrors;
+begin
+ // "hello" is valid, "wrold" is not, "the" is valid, "quik" is not
+ FEditor.Text := 'hello wrold the quik';
+ FSpellCheck.CheckFile;
+ Assert.AreEqual(2, FSpellCheck.Errors.Count,
+ 'Should find 2 misspelled words');
+ // First error: "wrold"
+ Assert.AreEqual('wrold', FSpellCheck.Errors[0].Word);
+ Assert.AreEqual(1, FSpellCheck.Errors[0].Line, 'Error should be on line 1');
+ Assert.AreEqual(7, FSpellCheck.Errors[0].StartChar, 'wrold starts at char 7');
+ Assert.AreEqual(12, FSpellCheck.Errors[0].EndChar, 'wrold ends at char 12');
+ // Second error: "quik"
+ Assert.AreEqual('quik', FSpellCheck.Errors[1].Word);
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckFileNoErrors;
+begin
+ FEditor.Text := 'hello world the';
+ FSpellCheck.CheckFile;
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'All valid words should produce no errors');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckFileNoProvider;
+begin
+ FSpellCheck.Provider := nil;
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckFile;
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'No provider should produce no errors');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckFileDisabled;
+begin
+ FSpellCheck.Enabled := False;
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckFile;
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'Disabled spell check should produce no errors');
+end;
+
+{ CheckLine }
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckLineSpecificLine;
+begin
+ FEditor.Lines.Clear;
+ FEditor.Lines.Add('hello world');
+ FEditor.Lines.Add('baaad wrold');
+ FEditor.Lines.Add('the fox');
+ FSpellCheck.CheckLine(2);
+ // Only errors from line 2 should appear
+ Assert.IsTrue(FSpellCheck.Errors.Count >= 1,
+ 'Should find errors on line 2');
+ Assert.AreEqual(2, FSpellCheck.Errors[0].Line,
+ 'Error should be on line 2');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckLineClearsOldErrors;
+begin
+ FEditor.Lines.Clear;
+ FEditor.Lines.Add('baaad');
+ FEditor.Lines.Add('wrold');
+ // Check line 1 first
+ FSpellCheck.CheckLine(1);
+ Assert.AreEqual(1, FSpellCheck.Errors.Count, 'Should have 1 error on line 1');
+ Assert.AreEqual('baaad', FSpellCheck.Errors[0].Word);
+ // Now fix line 1 and re-check
+ FEditor.Lines[0] := 'hello';
+ FSpellCheck.CheckLine(1);
+ // Line 1 errors replaced, line 2 error still from before (only if checked)
+ // Since we only checked line 1, and it's now valid, only remaining errors are
+ // from any previous line 2 checks. We never checked line 2, so 0 errors.
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'Re-checking line 1 with valid text should clear its errors');
+end;
+
+{ ClearErrors }
+
+procedure TTestFMXSynSpellCheckComponent.TestClearErrors;
+begin
+ FEditor.Text := 'wrold baaad';
+ FSpellCheck.CheckFile;
+ Assert.IsTrue(FSpellCheck.Errors.Count > 0, 'Should have errors');
+ FSpellCheck.ClearErrors;
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'ClearErrors should empty the list');
+end;
+
+{ ErrorAtPos }
+
+procedure TTestFMXSynSpellCheckComponent.TestErrorAtPosFound;
+begin
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckFile;
+ // "wrold" is at chars 7..11 on line 1
+ Assert.AreEqual(0, FSpellCheck.ErrorAtPos(1, 7),
+ 'ErrorAtPos should return index 0 for start of "wrold"');
+ Assert.AreEqual(0, FSpellCheck.ErrorAtPos(1, 10),
+ 'ErrorAtPos should return index 0 for middle of "wrold"');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestErrorAtPosNotFound;
+begin
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckFile;
+ // "hello" is valid, positions 1..5 should not have errors
+ Assert.AreEqual(-1, FSpellCheck.ErrorAtPos(1, 1),
+ 'ErrorAtPos should return -1 for valid word position');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestErrorAtPosWrongLine;
+begin
+ FEditor.Lines.Clear;
+ FEditor.Lines.Add('hello wrold');
+ FEditor.Lines.Add('hello world');
+ FSpellCheck.CheckFile;
+ // Error is on line 1 at char 7, line 2 should return -1 at same char
+ Assert.AreEqual(-1, FSpellCheck.ErrorAtPos(2, 7),
+ 'ErrorAtPos should return -1 for wrong line');
+end;
+
+{ Enabled toggle }
+
+procedure TTestFMXSynSpellCheckComponent.TestEnabledToggleClearsErrors;
+begin
+ FEditor.Text := 'wrold baaad';
+ FSpellCheck.CheckFile;
+ Assert.IsTrue(FSpellCheck.Errors.Count > 0, 'Should have errors');
+ FSpellCheck.Enabled := False;
+ Assert.AreEqual(0, FSpellCheck.Errors.Count,
+ 'Disabling should clear errors');
+end;
+
+{ Events }
+
+procedure TTestFMXSynSpellCheckComponent.OnCheckCompleteFired(Sender: TObject);
+begin
+ FEventFired := True;
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestOnCheckCompleteEvent;
+begin
+ FEventFired := False;
+ FSpellCheck.OnCheckComplete := OnCheckCompleteFired;
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckFile;
+ Assert.IsTrue(FEventFired, 'OnCheckComplete should fire after CheckFile');
+end;
+
+{ CheckSelection }
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckSelectionFallback;
+begin
+ // No selection set — should fall back to full-file check
+ FEditor.Text := 'hello wrold';
+ FSpellCheck.CheckSelection;
+ Assert.IsTrue(FSpellCheck.Errors.Count > 0,
+ 'CheckSelection with no selection should fall back to CheckFile');
+end;
+
+procedure TTestFMXSynSpellCheckComponent.TestCheckSelectionClearsDuplicates;
+var
+ CountAfterFirst, CountAfterSecond: Integer;
+begin
+ // Set up text with misspelled words on lines 2 and 3
+ FEditor.Lines.Clear;
+ FEditor.Lines.Add('hello world'); // line 1 - valid
+ FEditor.Lines.Add('baaad wrold'); // line 2 - 2 errors
+ FEditor.Lines.Add('quik foxx'); // line 3 - 2 errors
+ FEditor.Lines.Add('the fox'); // line 4 - valid
+
+ // Select lines 2-3 and check
+ FEditor.SetCaretAndSelection(
+ BufferCoord(1, 2),
+ BufferCoord(1, 2),
+ BufferCoord(10, 3));
+ FSpellCheck.CheckSelection;
+ CountAfterFirst := FSpellCheck.Errors.Count;
+ Assert.IsTrue(CountAfterFirst > 0, 'Should find errors in selection');
+
+ // Re-check same selection — errors should NOT accumulate
+ FSpellCheck.CheckSelection;
+ CountAfterSecond := FSpellCheck.Errors.Count;
+ Assert.AreEqual(CountAfterFirst, CountAfterSecond,
+ 'Re-checking same selection should not duplicate errors');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynSpellCheckComponent);
+
+end.
diff --git a/Tests/FMX/TestFMXSynWindowsSpellCheck.pas b/Tests/FMX/TestFMXSynWindowsSpellCheck.pas
new file mode 100644
index 00000000..924b9a0b
--- /dev/null
+++ b/Tests/FMX/TestFMXSynWindowsSpellCheck.pas
@@ -0,0 +1,178 @@
+unit TestFMXSynWindowsSpellCheck;
+
+{$IFDEF MSWINDOWS}
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynSpellCheckTypes,
+ SynSpellCheckWindowsProvider;
+
+type
+ [TestFixture]
+ TTestFMXSynWindowsSpellProvider = class
+ private
+ FProvider: ISynSpellCheckProvider;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+ [Test]
+ procedure TestIsAvailable;
+ [Test]
+ procedure TestGetLanguage;
+ [Test]
+ procedure TestCreateDefaultLanguage;
+ [Test]
+ procedure TestSetLanguageChangesChecker;
+ [Test]
+ procedure TestUnsupportedLanguage;
+ [Test]
+ procedure TestCheckWordValid;
+ [Test]
+ procedure TestCheckWordInvalid;
+ [Test]
+ procedure TestSuggestReturnsResults;
+ [Test]
+ procedure TestSuggestContainsCorrection;
+ [Test]
+ procedure TestSupportedLanguagesNotEmpty;
+ [Test]
+ procedure TestSupportedLanguagesContainsEnUS;
+ end;
+
+implementation
+
+uses
+ System.SysUtils;
+
+procedure TTestFMXSynWindowsSpellProvider.Setup;
+begin
+ FProvider := TSynWindowsSpellProvider.Create('en-US');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TearDown;
+begin
+ FProvider := nil;
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestIsAvailable;
+begin
+ Assert.IsTrue(FProvider.IsAvailable,
+ 'en-US provider should be available on Windows 8+');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestGetLanguage;
+begin
+ Assert.AreEqual('en-US', FProvider.GetLanguage);
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestCreateDefaultLanguage;
+var
+ P: ISynSpellCheckProvider;
+begin
+ P := TSynWindowsSpellProvider.Create;
+ Assert.AreEqual('en-US', P.GetLanguage,
+ 'Parameterless Create should default to en-US');
+ Assert.IsTrue(P.IsAvailable,
+ 'Default provider should be available');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestSetLanguageChangesChecker;
+begin
+ // Confirm initial state
+ Assert.IsTrue(FProvider.IsAvailable, 'Should start available');
+ // Change to a bogus language
+ FProvider.SetLanguage('xx-XX');
+ Assert.IsFalse(FProvider.IsAvailable,
+ 'Bogus language should not be available');
+ // Change back to en-US
+ FProvider.SetLanguage('en-US');
+ Assert.IsTrue(FProvider.IsAvailable,
+ 'Restoring en-US should be available again');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestUnsupportedLanguage;
+var
+ P: ISynSpellCheckProvider;
+begin
+ P := TSynWindowsSpellProvider.Create('xx-BOGUS');
+ Assert.IsFalse(P.IsAvailable,
+ 'Bogus language tag should not be available');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestCheckWordValid;
+begin
+ Assert.IsTrue(FProvider.CheckWord('hello'), '"hello" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('world'), '"world" should be valid');
+ Assert.IsTrue(FProvider.CheckWord('the'), '"the" should be valid');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestCheckWordInvalid;
+begin
+ Assert.IsFalse(FProvider.CheckWord('helo'), '"helo" should be invalid');
+ Assert.IsFalse(FProvider.CheckWord('wrold'), '"wrold" should be invalid');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestSuggestReturnsResults;
+var
+ Suggestions: TArray;
+begin
+ Suggestions := FProvider.Suggest('helo');
+ Assert.IsTrue(Length(Suggestions) >= 1,
+ '"helo" should produce at least 1 suggestion, got ' +
+ IntToStr(Length(Suggestions)));
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestSuggestContainsCorrection;
+var
+ Suggestions: TArray;
+ S: string;
+ Found: Boolean;
+begin
+ Suggestions := FProvider.Suggest('helo');
+ Found := False;
+ for S in Suggestions do
+ if SameText(S, 'hello') then
+ begin
+ Found := True;
+ Break;
+ end;
+ Assert.IsTrue(Found, '"helo" suggestions should include "hello"');
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestSupportedLanguagesNotEmpty;
+var
+ Langs: TArray;
+begin
+ Langs := TSynWindowsSpellProvider.SupportedLanguages;
+ Assert.IsTrue(Length(Langs) >= 1,
+ 'SupportedLanguages should return at least 1 language, got ' +
+ IntToStr(Length(Langs)));
+end;
+
+procedure TTestFMXSynWindowsSpellProvider.TestSupportedLanguagesContainsEnUS;
+var
+ Langs: TArray;
+ S: string;
+ Found: Boolean;
+begin
+ Langs := TSynWindowsSpellProvider.SupportedLanguages;
+ Found := False;
+ for S in Langs do
+ if SameText(S, 'en-US') then
+ begin
+ Found := True;
+ Break;
+ end;
+ Assert.IsTrue(Found, 'en-US should be in SupportedLanguages');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestFMXSynWindowsSpellProvider);
+
+{$ENDIF MSWINDOWS}
+
+end.
diff --git a/Tests/FMX/TestSynHighlighterCSSFolding.pas b/Tests/FMX/TestSynHighlighterCSSFolding.pas
new file mode 100644
index 00000000..52bfe366
--- /dev/null
+++ b/Tests/FMX/TestSynHighlighterCSSFolding.pas
@@ -0,0 +1,360 @@
+unit TestSynHighlighterCSSFolding;
+
+{ Tests for CSS highlighter fold range detection.
+ Uses only shared units (SynEditCodeFolding, SynHighlighterCss,
+ SynEditTextBuffer) — no FMX or VCL dependency. }
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynEditCodeFolding,
+ SynHighlighterCss;
+
+type
+ [TestFixture]
+ TTestCSSFolding = class
+ private
+ FHighlighter: TSynCssSyn;
+ FFoldRanges: TSynFoldRanges;
+ procedure ScanText(const AText: string);
+ function FindFoldAtLine(ALine: Integer): Integer;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+
+ { Basic rule block folding }
+ [Test]
+ procedure TestSingleRuleFolds;
+ [Test]
+ procedure TestMultipleRulesFold;
+
+ { Nested blocks }
+ [Test]
+ procedure TestNestedMediaQueryFolds;
+ [Test]
+ procedure TestDeeplyNestedBlocks;
+
+ { Same-line balanced braces }
+ [Test]
+ procedure TestSameLineBracesDoNotFold;
+
+ { Comments }
+ [Test]
+ procedure TestCommentDoesNotFold;
+ [Test]
+ procedure TestMultiLineCommentDoesNotFold;
+ [Test]
+ procedure TestBracesInCommentIgnored;
+
+ { Strings }
+ [Test]
+ procedure TestBracesInDoubleQuoteStringIgnored;
+ [Test]
+ procedure TestBracesInSingleQuoteStringIgnored;
+ [Test]
+ procedure TestEscapedQuoteInString;
+
+ { Edge cases }
+ [Test]
+ procedure TestEmptyRuleBlock;
+
+ { Full sample }
+ [Test]
+ procedure TestFullSampleFoldsCorrectly;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ SynEditTextBuffer;
+
+procedure TTestCSSFolding.Setup;
+begin
+ FHighlighter := TSynCssSyn.Create(nil);
+ FFoldRanges := TSynFoldRanges.Create;
+end;
+
+procedure TTestCSSFolding.TearDown;
+begin
+ FFoldRanges.Free;
+ FHighlighter.Free;
+end;
+
+procedure TTestCSSFolding.ScanText(const AText: string);
+var
+ Lines: TStringList;
+begin
+ Lines := TStringList.Create;
+ try
+ Lines.Text := AText;
+ FFoldRanges.StartScanning;
+ FHighlighter.ScanForFoldRanges(FFoldRanges, Lines, 0, Lines.Count - 1);
+ FFoldRanges.StopScanning(Lines);
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TTestCSSFolding.FindFoldAtLine(ALine: Integer): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FFoldRanges.Count - 1 do
+ if FFoldRanges[I].FromLine = ALine then
+ Exit(I);
+ Result := -1;
+end;
+
+{ --- Basic rule block folding --- }
+
+procedure TTestCSSFolding.TestSingleRuleFolds;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ ' color: red;' + sLineBreak + // line 2
+ '}' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'body fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'body fold should close at }');
+end;
+
+procedure TTestCSSFolding.TestMultipleRulesFold;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ ' color: red;' + sLineBreak + // line 2
+ '}' + sLineBreak + // line 3
+ 'h1 {' + sLineBreak + // line 4
+ ' font-size: 18px;' + sLineBreak + // line 5
+ '}' // line 6
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'body fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine);
+ Assert.IsTrue(FindFoldAtLine(4) >= 0, 'h1 fold should exist');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(4)].ToLine);
+end;
+
+{ --- Nested blocks --- }
+
+procedure TTestCSSFolding.TestNestedMediaQueryFolds;
+begin
+ ScanText(
+ '@media screen {' + sLineBreak + // line 1
+ ' body {' + sLineBreak + // line 2
+ ' color: red;' + sLineBreak + // line 3
+ ' }' + sLineBreak + // line 4
+ '}' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, '@media fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(1)].ToLine);
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'body fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine);
+end;
+
+procedure TTestCSSFolding.TestDeeplyNestedBlocks;
+begin
+ ScanText(
+ '@supports (display: grid) {' + sLineBreak + // line 1
+ ' @media screen {' + sLineBreak + // line 2
+ ' .container {' + sLineBreak + // line 3
+ ' display: grid;' + sLineBreak + // line 4
+ ' }' + sLineBreak + // line 5
+ ' }' + sLineBreak + // line 6
+ '}' // line 7
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, '@supports fold should exist');
+ Assert.AreEqual(7, FFoldRanges[FindFoldAtLine(1)].ToLine);
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, '@media fold should exist');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(2)].ToLine);
+ Assert.IsTrue(FindFoldAtLine(3) >= 0, '.container fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(3)].ToLine);
+end;
+
+{ --- Same-line balanced braces --- }
+
+procedure TTestCSSFolding.TestSameLineBracesDoNotFold;
+begin
+ ScanText(
+ 'body { color: red; }' + sLineBreak + // line 1
+ 'h1 { font-size: 18px; }' // line 2
+ );
+ Assert.AreEqual(-1, FindFoldAtLine(1),
+ 'same-line body rule must not fold');
+ Assert.AreEqual(-1, FindFoldAtLine(2),
+ 'same-line h1 rule must not fold');
+end;
+
+{ --- Comments --- }
+
+procedure TTestCSSFolding.TestCommentDoesNotFold;
+begin
+ ScanText(
+ '/* Single line comment */' + sLineBreak + // line 1
+ 'body {' + sLineBreak + // line 2
+ ' color: red;' + sLineBreak + // line 3
+ '}' // line 4
+ );
+ Assert.AreEqual(-1, FindFoldAtLine(1),
+ 'single-line comment must not fold');
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'body fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine);
+end;
+
+procedure TTestCSSFolding.TestMultiLineCommentDoesNotFold;
+begin
+ ScanText(
+ '/* Start of' + sLineBreak + // line 1
+ ' multi-line' + sLineBreak + // line 2
+ ' comment */' + sLineBreak + // line 3
+ 'body {' + sLineBreak + // line 4
+ ' color: red;' + sLineBreak + // line 5
+ '}' // line 6
+ );
+ Assert.AreEqual(-1, FindFoldAtLine(1),
+ 'multi-line comment start must not fold');
+ Assert.AreEqual(-1, FindFoldAtLine(2),
+ 'comment middle must not fold');
+ Assert.AreEqual(-1, FindFoldAtLine(3),
+ 'comment end must not fold');
+ Assert.IsTrue(FindFoldAtLine(4) >= 0, 'body fold should exist');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(4)].ToLine);
+end;
+
+procedure TTestCSSFolding.TestBracesInCommentIgnored;
+begin
+ ScanText(
+ '/* { not a fold } */' + sLineBreak + // line 1
+ 'body {' + sLineBreak + // line 2
+ ' /* } not a close */' + sLineBreak + // line 3
+ ' color: red;' + sLineBreak + // line 4
+ '}' // line 5
+ );
+ Assert.AreEqual(-1, FindFoldAtLine(1),
+ 'braces in comment must not fold');
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'body fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'comment brace must not affect fold range');
+end;
+
+{ --- Strings --- }
+
+procedure TTestCSSFolding.TestBracesInDoubleQuoteStringIgnored;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ ' content: "brace { here";' + sLineBreak + // line 2
+ '}' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'body fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'brace in double-quote string must not affect fold');
+end;
+
+procedure TTestCSSFolding.TestBracesInSingleQuoteStringIgnored;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ ' content: ''brace } here'';' + sLineBreak + // line 2
+ '}' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'body fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'brace in single-quote string must not affect fold');
+end;
+
+procedure TTestCSSFolding.TestEscapedQuoteInString;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ ' content: "escaped \" brace { x";' + sLineBreak + // line 2
+ '}' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'body fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'escaped quote must not end string early');
+end;
+
+{ --- Edge cases --- }
+
+procedure TTestCSSFolding.TestEmptyRuleBlock;
+begin
+ ScanText(
+ 'body {' + sLineBreak + // line 1
+ '}' // line 2
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'empty body fold should exist');
+ Assert.AreEqual(2, FFoldRanges[FindFoldAtLine(1)].ToLine);
+end;
+
+{ --- Full sample --- }
+
+procedure TTestCSSFolding.TestFullSampleFoldsCorrectly;
+var
+ SampleSource: string;
+ Idx: Integer;
+begin
+ SampleSource :=
+ '/* Main Stylesheet */'#13#10 + // line 1
+ 'body {'#13#10 + // line 2
+ ' font-family: Arial, sans-serif;'#13#10 + // line 3
+ ' font-size: 14px;'#13#10 + // line 4
+ ' color: #333;'#13#10 + // line 5
+ '}'#13#10 + // line 6
+ 'h1 {'#13#10 + // line 7
+ ' font-size: 24px;'#13#10 + // line 8
+ ' color: #000099;'#13#10 + // line 9
+ '}'#13#10 + // line 10
+ '@media screen and (max-width: 768px) {'#13#10 + // line 11
+ ' body {'#13#10 + // line 12
+ ' font-size: 12px;'#13#10 + // line 13
+ ' }'#13#10 + // line 14
+ ' h1 {'#13#10 + // line 15
+ ' font-size: 18px;'#13#10 + // line 16
+ ' }'#13#10 + // line 17
+ '}'; // line 18
+ ScanText(SampleSource);
+
+ // /* Main Stylesheet */ (line 1) — no fold
+ Assert.AreEqual(-1, FindFoldAtLine(1),
+ 'comment must not fold');
+
+ // body (line 2) folds to } (line 6)
+ Idx := FindFoldAtLine(2);
+ Assert.IsTrue(Idx >= 0, 'body fold should exist');
+ Assert.AreEqual(6, FFoldRanges[Idx].ToLine);
+
+ // h1 (line 7) folds to } (line 10)
+ Idx := FindFoldAtLine(7);
+ Assert.IsTrue(Idx >= 0, 'h1 fold should exist');
+ Assert.AreEqual(10, FFoldRanges[Idx].ToLine);
+
+ // @media (line 11) folds to } (line 18)
+ Idx := FindFoldAtLine(11);
+ Assert.IsTrue(Idx >= 0, '@media fold should exist');
+ Assert.AreEqual(18, FFoldRanges[Idx].ToLine);
+
+ // nested body (line 12) folds to } (line 14)
+ Idx := FindFoldAtLine(12);
+ Assert.IsTrue(Idx >= 0, 'nested body fold should exist');
+ Assert.AreEqual(14, FFoldRanges[Idx].ToLine);
+
+ // nested h1 (line 15) folds to } (line 17)
+ Idx := FindFoldAtLine(15);
+ Assert.IsTrue(Idx >= 0, 'nested h1 fold should exist');
+ Assert.AreEqual(17, FFoldRanges[Idx].ToLine);
+
+ // property lines and closing braces — no fold
+ Assert.AreEqual(-1, FindFoldAtLine(3), 'property line must not fold');
+ Assert.AreEqual(-1, FindFoldAtLine(13), 'nested property line must not fold');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestCSSFolding);
+
+end.
diff --git a/Tests/FMX/TestSynHighlighterDelphiFolding.pas b/Tests/FMX/TestSynHighlighterDelphiFolding.pas
new file mode 100644
index 00000000..0bdf547f
--- /dev/null
+++ b/Tests/FMX/TestSynHighlighterDelphiFolding.pas
@@ -0,0 +1,681 @@
+unit TestSynHighlighterDelphiFolding;
+
+{ Tests for Delphi highlighter fold range detection.
+ Uses only shared units (SynEditCodeFolding, SynHighlighterDelphi,
+ SynEditTextBuffer) — no FMX or VCL dependency. }
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynEditCodeFolding,
+ SynHighlighterDelphi;
+
+type
+ [TestFixture]
+ TTestDelphiFolding = class
+ private
+ FHighlighter: TSynDelphiSyn;
+ FFoldRanges: TSynFoldRanges;
+ procedure ScanText(const AText: string);
+ function FindFoldAtLine(ALine: Integer): Integer;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+
+ { Record folding }
+ [Test]
+ procedure TestRecordFoldsToEnd;
+ [Test]
+ procedure TestRecordWithClassVarFoldsCorrectly;
+ [Test]
+ procedure TestRecordDoesNotSwallowFollowingCode;
+ [Test]
+ procedure TestNestedRecordFolds;
+
+ { Class folding }
+ [Test]
+ procedure TestClassFoldsToEnd;
+ [Test]
+ procedure TestClassWithMethodsFoldsCorrectly;
+
+ { Begin..end folding }
+ [Test]
+ procedure TestBeginEndFolds;
+ [Test]
+ procedure TestNestedBeginEnd;
+
+ { Procedure/function folding }
+ [Test]
+ procedure TestProcedureFoldsFromHeader;
+ [Test]
+ procedure TestProcedureDeclarationInRecordDoesNotFold;
+ [Test]
+ procedure TestProcedureDeclarationInClassDoesNotFold;
+ [Test]
+ procedure TestProcedureWithVarFoldsFromHeader;
+ [Test]
+ procedure TestFunctionFoldsFromHeader;
+ [Test]
+ procedure TestConstructorDestructorFoldFromHeader;
+ [Test]
+ procedure TestFullSampleFoldsCorrectly;
+
+ { Try..end folding }
+ [Test]
+ procedure TestTryEndFolds;
+
+ { Case..end folding }
+ [Test]
+ procedure TestCaseEndFolds;
+
+ { Region folding }
+ [Test]
+ procedure TestRegionFolds;
+ [Test]
+ procedure TestRegionDoesNotInterfereWithBeginEnd;
+
+ { Interface/Implementation folding }
+ [Test]
+ procedure TestInterfaceSectionFolds;
+ [Test]
+ procedure TestImplementationSectionFolds;
+ [Test]
+ procedure TestProgramEndDotClosesBeginFold;
+
+ { Mixed scenarios }
+ [Test]
+ procedure TestRecordThenProcedure;
+ [Test]
+ procedure TestMultipleRecords;
+ [Test]
+ procedure TestClassVarDoesNotOpenFold;
+ [Test]
+ procedure TestClassFunctionDoesNotOpenClassFold;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ SynEditTextBuffer;
+
+procedure TTestDelphiFolding.Setup;
+begin
+ FHighlighter := TSynDelphiSyn.Create(nil);
+ FFoldRanges := TSynFoldRanges.Create;
+end;
+
+procedure TTestDelphiFolding.TearDown;
+begin
+ FFoldRanges.Free;
+ FHighlighter.Free;
+end;
+
+procedure TTestDelphiFolding.ScanText(const AText: string);
+var
+ Lines: TStringList;
+begin
+ Lines := TStringList.Create;
+ try
+ Lines.Text := AText;
+ FFoldRanges.StartScanning;
+ FHighlighter.ScanForFoldRanges(FFoldRanges, Lines, 0, Lines.Count - 1);
+ FFoldRanges.StopScanning(Lines);
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TTestDelphiFolding.FindFoldAtLine(ALine: Integer): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FFoldRanges.Count - 1 do
+ if FFoldRanges[I].FromLine = ALine then
+ Exit(I);
+ Result := -1;
+end;
+
+{ --- Record folding --- }
+
+procedure TTestDelphiFolding.TestRecordFoldsToEnd;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TPoint = record' + sLineBreak + // line 2
+ ' X: Integer;' + sLineBreak + // line 3
+ ' Y: Integer;' + sLineBreak + // line 4
+ ' end;' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0,
+ 'Should have a fold starting at the record line');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at end;');
+end;
+
+procedure TTestDelphiFolding.TestRecordWithClassVarFoldsCorrectly;
+begin
+ // This is the key bug scenario: "class var" contains the word "class"
+ // which must NOT open a new fold range
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TMyRecord = record' + sLineBreak + // line 2
+ ' class var Count: Integer;' + sLineBreak + // line 3
+ ' end;' // line 4
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0,
+ 'Should have a fold starting at the record line');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at end; (line 4), not extend further');
+end;
+
+procedure TTestDelphiFolding.TestRecordDoesNotSwallowFollowingCode;
+begin
+ // Record fold must not extend past its end; into subsequent code
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TMyRecord = record' + sLineBreak + // line 2
+ ' class var Count: Integer;' + sLineBreak + // line 3
+ ' end;' + sLineBreak + // line 4
+ '' + sLineBreak + // line 5
+ 'procedure DoSomething;' + sLineBreak + // line 6
+ 'begin' + sLineBreak + // line 7
+ ' WriteLn;' + sLineBreak + // line 8
+ 'end;' // line 9
+ );
+ // Record fold should end at line 4
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Record fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold must end at line 4, not swallow the procedure');
+
+ // Procedure fold should start at the procedure header, not begin
+ Assert.IsTrue(FindFoldAtLine(6) >= 0, 'Procedure fold should exist at line 6');
+ Assert.AreEqual(9, FFoldRanges[FindFoldAtLine(6)].ToLine,
+ 'Procedure fold should close at line 9');
+end;
+
+procedure TTestDelphiFolding.TestNestedRecordFolds;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TOuter = record' + sLineBreak + // line 2
+ ' Inner: record' + sLineBreak + // line 3
+ ' X: Integer;' + sLineBreak + // line 4
+ ' end;' + sLineBreak + // line 5
+ ' end;' // line 6
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Outer record fold should exist');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Outer record should fold to line 6');
+ Assert.IsTrue(FindFoldAtLine(3) >= 0, 'Inner record fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(3)].ToLine,
+ 'Inner record should fold to line 5');
+end;
+
+{ --- Class folding --- }
+
+procedure TTestDelphiFolding.TestClassFoldsToEnd;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TFoo = class' + sLineBreak + // line 2
+ ' FValue: Integer;' + sLineBreak + // line 3
+ ' end;' // line 4
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Class fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Class fold should close at end;');
+end;
+
+procedure TTestDelphiFolding.TestClassWithMethodsFoldsCorrectly;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TFoo = class' + sLineBreak + // line 2
+ ' procedure Bar;' + sLineBreak + // line 3
+ ' end;' + sLineBreak + // line 4
+ '' + sLineBreak + // line 5
+ 'procedure TFoo.Bar;' + sLineBreak + // line 6
+ 'begin' + sLineBreak + // line 7
+ 'end;' // line 8
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Class fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Class fold should close at its end; not extend to method end');
+end;
+
+{ --- Begin..end folding --- }
+
+procedure TTestDelphiFolding.TestBeginEndFolds;
+begin
+ ScanText(
+ 'begin' + sLineBreak + // line 1
+ ' DoSomething;' + sLineBreak + // line 2
+ 'end.' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'begin..end fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'begin fold should close at end.');
+end;
+
+procedure TTestDelphiFolding.TestNestedBeginEnd;
+begin
+ ScanText(
+ 'begin' + sLineBreak + // line 1
+ ' begin' + sLineBreak + // line 2
+ ' DoInner;' + sLineBreak + // line 3
+ ' end;' + sLineBreak + // line 4
+ 'end.' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'Outer begin fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Outer begin should fold to line 5');
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Inner begin fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Inner begin should fold to line 4');
+end;
+
+{ --- Procedure/function folding --- }
+
+procedure TTestDelphiFolding.TestProcedureFoldsFromHeader;
+begin
+ ScanText(
+ 'procedure Foo;' + sLineBreak + // line 1
+ 'begin' + sLineBreak + // line 2
+ ' WriteLn;' + sLineBreak + // line 3
+ 'end;' // line 4
+ );
+ // Fold should start at the procedure header, not at begin
+ Assert.IsTrue(FindFoldAtLine(1) >= 0,
+ 'Fold should start at procedure header line');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Procedure fold should close at end;');
+ // No separate fold at begin line
+ Assert.AreEqual(-1, FindFoldAtLine(2),
+ 'begin should not have its own separate fold');
+end;
+
+procedure TTestDelphiFolding.TestProcedureDeclarationInRecordDoesNotFold;
+begin
+ // procedure Save; inside a record is a declaration only — no body, no fold
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TMyHelper = record helper for TMyRecord' + sLineBreak + // line 2
+ ' procedure Save;' + sLineBreak + // line 3
+ ' end;' // line 4
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Record fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at end;');
+ Assert.AreEqual(-1, FindFoldAtLine(3),
+ 'procedure Save; declaration must not create a fold');
+end;
+
+procedure TTestDelphiFolding.TestProcedureDeclarationInClassDoesNotFold;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TFoo = class' + sLineBreak + // line 2
+ ' procedure DoWork;' + sLineBreak + // line 3
+ ' function GetValue: Integer;' + sLineBreak + // line 4
+ ' end;' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Class fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Class fold should close at end;');
+ Assert.AreEqual(-1, FindFoldAtLine(3),
+ 'procedure declaration in class must not fold');
+ Assert.AreEqual(-1, FindFoldAtLine(4),
+ 'function declaration in class must not fold');
+end;
+
+procedure TTestDelphiFolding.TestProcedureWithVarFoldsFromHeader;
+begin
+ // var block between procedure header and begin should be included in the fold
+ ScanText(
+ 'procedure Test;' + sLineBreak + // line 1
+ 'var' + sLineBreak + // line 2
+ ' X: Integer;' + sLineBreak + // line 3
+ 'begin' + sLineBreak + // line 4
+ ' X := 1;' + sLineBreak + // line 5
+ 'end;' // line 6
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0,
+ 'Fold should start at procedure header');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Procedure fold should include var block and close at end;');
+ Assert.AreEqual(-1, FindFoldAtLine(4),
+ 'begin should not have its own separate fold');
+end;
+
+procedure TTestDelphiFolding.TestFunctionFoldsFromHeader;
+begin
+ ScanText(
+ 'function Add(A, B: Integer): Integer;' + sLineBreak + // line 1
+ 'begin' + sLineBreak + // line 2
+ ' Result := A + B;' + sLineBreak + // line 3
+ 'end;' // line 4
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0,
+ 'Fold should start at function header');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Function fold should close at end;');
+end;
+
+procedure TTestDelphiFolding.TestConstructorDestructorFoldFromHeader;
+begin
+ ScanText(
+ 'constructor TFoo.Create;' + sLineBreak + // line 1
+ 'begin' + sLineBreak + // line 2
+ ' inherited;' + sLineBreak + // line 3
+ 'end;' + sLineBreak + // line 4
+ '' + sLineBreak + // line 5
+ 'destructor TFoo.Destroy;' + sLineBreak + // line 6
+ 'begin' + sLineBreak + // line 7
+ ' inherited;' + sLineBreak + // line 8
+ 'end;' // line 9
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0,
+ 'Constructor fold should start at header');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Constructor fold should close at end;');
+ Assert.IsTrue(FindFoldAtLine(6) >= 0,
+ 'Destructor fold should start at header');
+ Assert.AreEqual(9, FFoldRanges[FindFoldAtLine(6)].ToLine,
+ 'Destructor fold should close at end;');
+end;
+
+procedure TTestDelphiFolding.TestFullSampleFoldsCorrectly;
+var
+ SampleSource: string;
+ Idx: Integer;
+begin
+ // Test using the actual GetSampleSource text from the highlighter
+ SampleSource :=
+ 'unit ModernDelphi;'#13#10 + // line 1
+ 'interface'#13#10 + // line 2
+ 'type'#13#10 + // line 3
+ ' TMyRecord = record'#13#10 + // line 4
+ ' class var Count: Integer;'#13#10 + // line 5
+ ' end;'#13#10 + // line 6
+ ' TMyHelper = record helper for TMyRecord'#13#10 + // line 7
+ ' procedure Save;'#13#10 + // line 8
+ ' end;'#13#10 + // line 9
+ 'implementation'#13#10 + // line 10
+ 'procedure Test;'#13#10 + // line 11
+ 'var'#13#10 + // line 12
+ ' JSON: string;'#13#10 + // line 13
+ 'begin'#13#10 + // line 14
+ ' // Delphi 13 Multiline String'#13#10 + // line 15
+ ' JSON := '''#13#10 + // line 16
+ ' {'#13#10 + // line 17
+ ' "name": "Delphi",'#13#10 + // line 18
+ ' "version": 13'#13#10 + // line 19
+ ' }'#13#10 + // line 20
+ ' '''';'#13#10 + // line 21
+ 'end;'#13#10 + // line 22
+ 'end.'; // line 23
+ ScanText(SampleSource);
+
+ // interface (line 2) folds to line 9 (before implementation)
+ Idx := FindFoldAtLine(2);
+ Assert.IsTrue(Idx >= 0, 'Interface fold should exist at line 2');
+ Assert.AreEqual(9, FFoldRanges[Idx].ToLine,
+ 'Interface fold should close before implementation');
+
+ // TMyRecord = record (line 4) folds to end; (line 6)
+ Idx := FindFoldAtLine(4);
+ Assert.IsTrue(Idx >= 0, 'TMyRecord fold should exist at line 4');
+ Assert.AreEqual(6, FFoldRanges[Idx].ToLine,
+ 'TMyRecord should fold to line 6, not extend further');
+
+ // TMyHelper = record helper (line 7) folds to end; (line 9)
+ Idx := FindFoldAtLine(7);
+ Assert.IsTrue(Idx >= 0, 'TMyHelper fold should exist at line 7');
+ Assert.AreEqual(9, FFoldRanges[Idx].ToLine,
+ 'TMyHelper should fold to line 9');
+
+ // procedure Save; (line 8) must NOT have a fold — it is a declaration
+ Assert.AreEqual(-1, FindFoldAtLine(8),
+ 'procedure Save; declaration must not fold');
+
+ // implementation (line 10) folds to end. (line 23)
+ Idx := FindFoldAtLine(10);
+ Assert.IsTrue(Idx >= 0, 'Implementation fold should exist at line 10');
+ Assert.AreEqual(23, FFoldRanges[Idx].ToLine,
+ 'Implementation fold should close at end.');
+
+ // procedure Test (line 11) should fold to end; (line 22)
+ Idx := FindFoldAtLine(11);
+ Assert.IsTrue(Idx >= 0, 'procedure Test fold should exist at line 11');
+ Assert.AreEqual(22, FFoldRanges[Idx].ToLine,
+ 'procedure Test should fold to end; at line 22');
+
+ // begin at line 14 should NOT have its own fold
+ Assert.AreEqual(-1, FindFoldAtLine(14),
+ 'begin should not have a separate fold from procedure');
+end;
+
+{ --- Try..end folding --- }
+
+procedure TTestDelphiFolding.TestTryEndFolds;
+begin
+ ScanText(
+ 'begin' + sLineBreak + // line 1
+ ' try' + sLineBreak + // line 2
+ ' DoRisky;' + sLineBreak + // line 3
+ ' except' + sLineBreak + // line 4
+ ' end;' + sLineBreak + // line 5
+ 'end.' // line 6
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'try fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'try fold should close at its end;');
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'begin fold should exist');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'begin fold should close at end.');
+end;
+
+{ --- Case..end folding --- }
+
+procedure TTestDelphiFolding.TestCaseEndFolds;
+begin
+ ScanText(
+ 'begin' + sLineBreak + // line 1
+ ' case X of' + sLineBreak + // line 2
+ ' 1: DoA;' + sLineBreak + // line 3
+ ' 2: DoB;' + sLineBreak + // line 4
+ ' end;' + sLineBreak + // line 5
+ 'end.' // line 6
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'case fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'case fold should close at its end;');
+end;
+
+{ --- Region folding --- }
+
+procedure TTestDelphiFolding.TestRegionFolds;
+begin
+ ScanText(
+ '{$REGION ''MyRegion''}' + sLineBreak + // line 1
+ '// some code' + sLineBreak + // line 2
+ '{$ENDREGION}' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'Region fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Region fold should close at $ENDREGION');
+ Assert.AreEqual(FoldRegionType, FFoldRanges[FindFoldAtLine(1)].FoldType,
+ 'Region fold should have FoldRegionType');
+end;
+
+procedure TTestDelphiFolding.TestRegionDoesNotInterfereWithBeginEnd;
+begin
+ ScanText(
+ '{$REGION ''Block''}' + sLineBreak + // line 1
+ 'begin' + sLineBreak + // line 2
+ ' DoWork;' + sLineBreak + // line 3
+ 'end;' + sLineBreak + // line 4
+ '{$ENDREGION}' // line 5
+ );
+ // Region fold
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'Region fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'Region fold should span lines 1-5');
+ // begin..end fold inside the region
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'begin..end fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'begin..end fold should close at line 4');
+end;
+
+{ --- Interface/Implementation folding --- }
+
+procedure TTestDelphiFolding.TestInterfaceSectionFolds;
+begin
+ ScanText(
+ 'unit Foo;' + sLineBreak + // line 1
+ 'interface' + sLineBreak + // line 2
+ 'type' + sLineBreak + // line 3
+ ' TBar = record' + sLineBreak + // line 4
+ ' X: Integer;' + sLineBreak + // line 5
+ ' end;' + sLineBreak + // line 6
+ 'implementation' + sLineBreak + // line 7
+ 'end.' // line 8
+ );
+ // Interface section folds from line 2 to line 6 (before implementation)
+ Assert.IsTrue(FindFoldAtLine(2) >= 0,
+ 'Interface fold should exist at line 2');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Interface fold should close before implementation');
+ // Implementation section folds from line 7 to line 8
+ Assert.IsTrue(FindFoldAtLine(7) >= 0,
+ 'Implementation fold should exist at line 7');
+ Assert.AreEqual(8, FFoldRanges[FindFoldAtLine(7)].ToLine,
+ 'Implementation fold should close at end.');
+end;
+
+procedure TTestDelphiFolding.TestImplementationSectionFolds;
+begin
+ ScanText(
+ 'unit Foo;' + sLineBreak + // line 1
+ 'interface' + sLineBreak + // line 2
+ 'implementation' + sLineBreak + // line 3
+ 'procedure Bar;' + sLineBreak + // line 4
+ 'begin' + sLineBreak + // line 5
+ 'end;' + sLineBreak + // line 6
+ 'end.' // line 7
+ );
+ // Implementation section folds from line 3 to line 7
+ Assert.IsTrue(FindFoldAtLine(3) >= 0,
+ 'Implementation fold should exist');
+ Assert.AreEqual(7, FFoldRanges[FindFoldAtLine(3)].ToLine,
+ 'Implementation fold should close at end.');
+ // Procedure fold still works inside implementation
+ Assert.IsTrue(FindFoldAtLine(4) >= 0,
+ 'Procedure fold should exist at line 4');
+ Assert.AreEqual(6, FFoldRanges[FindFoldAtLine(4)].ToLine,
+ 'Procedure fold should close at end;');
+end;
+
+procedure TTestDelphiFolding.TestProgramEndDotClosesBeginFold;
+begin
+ // In a program (no interface/implementation), end. closes begin
+ ScanText(
+ 'program Foo;' + sLineBreak + // line 1
+ 'begin' + sLineBreak + // line 2
+ ' WriteLn;' + sLineBreak + // line 3
+ 'end.' // line 4
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0,
+ 'begin fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'begin fold should close at end.');
+end;
+
+{ --- Mixed scenarios --- }
+
+procedure TTestDelphiFolding.TestRecordThenProcedure;
+begin
+ // Record followed by procedure — each should fold independently
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TRec = record' + sLineBreak + // line 2
+ ' Value: Integer;' + sLineBreak + // line 3
+ ' end;' + sLineBreak + // line 4
+ '' + sLineBreak + // line 5
+ 'procedure Test;' + sLineBreak + // line 6
+ 'begin' + sLineBreak + // line 7
+ 'end;' // line 8
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Record fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at line 4');
+ Assert.IsTrue(FindFoldAtLine(6) >= 0, 'Procedure fold should exist at line 6');
+ Assert.AreEqual(8, FFoldRanges[FindFoldAtLine(6)].ToLine,
+ 'Procedure fold should close at line 8');
+end;
+
+procedure TTestDelphiFolding.TestMultipleRecords;
+begin
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TRec1 = record' + sLineBreak + // line 2
+ ' A: Integer;' + sLineBreak + // line 3
+ ' end;' + sLineBreak + // line 4
+ '' + sLineBreak + // line 5
+ ' TRec2 = record' + sLineBreak + // line 6
+ ' B: Integer;' + sLineBreak + // line 7
+ ' end;' // line 8
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'First record fold should exist');
+ Assert.AreEqual(4, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'First record should fold to line 4');
+ Assert.IsTrue(FindFoldAtLine(6) >= 0, 'Second record fold should exist');
+ Assert.AreEqual(8, FFoldRanges[FindFoldAtLine(6)].ToLine,
+ 'Second record should fold to line 8');
+end;
+
+procedure TTestDelphiFolding.TestClassVarDoesNotOpenFold;
+begin
+ // "class var" should NOT create a fold-open for the word "class"
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' TMyRecord = record' + sLineBreak + // line 2
+ ' class var A: Integer;' + sLineBreak + // line 3
+ ' class var B: Integer;' + sLineBreak + // line 4
+ ' end;' // line 5
+ );
+ // There should be exactly one fold range starting at line 2
+ Assert.AreEqual(-1, FindFoldAtLine(3),
+ 'class var on line 3 must not open a fold range');
+ Assert.AreEqual(-1, FindFoldAtLine(4),
+ 'class var on line 4 must not open a fold range');
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Record fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at end; on line 5');
+end;
+
+procedure TTestDelphiFolding.TestClassFunctionDoesNotOpenClassFold;
+begin
+ // "class function" / "class procedure" should be treated as code
+ // declarations, not as class block openers
+ ScanText(
+ 'type' + sLineBreak + // line 1
+ ' THelper = record' + sLineBreak + // line 2
+ ' class function Create: THelper; static;' + sLineBreak + // line 3
+ ' class procedure Reset; static;' + sLineBreak + // line 4
+ ' end;' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(2) >= 0, 'Record fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(2)].ToLine,
+ 'Record fold should close at end; on line 5');
+end;
+
+initialization
+ TDUnitX.RegisterTestFixture(TTestDelphiFolding);
+
+end.
diff --git a/Tests/FMX/TestSynHighlighterHTMLFolding.pas b/Tests/FMX/TestSynHighlighterHTMLFolding.pas
new file mode 100644
index 00000000..8630fd2e
--- /dev/null
+++ b/Tests/FMX/TestSynHighlighterHTMLFolding.pas
@@ -0,0 +1,330 @@
+unit TestSynHighlighterHTMLFolding;
+
+{ Tests for HTML highlighter fold range detection.
+ Uses only shared units (SynEditCodeFolding, SynHighlighterHtml,
+ SynEditTextBuffer) — no FMX or VCL dependency. }
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ SynEditCodeFolding,
+ SynHighlighterHtml;
+
+type
+ [TestFixture]
+ TTestHTMLFolding = class
+ private
+ FHighlighter: TSynHTMLSyn;
+ FFoldRanges: TSynFoldRanges;
+ procedure ScanText(const AText: string);
+ function FindFoldAtLine(ALine: Integer): Integer;
+ public
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+
+ { Basic tag folding }
+ [Test]
+ procedure TestSingleTagPairFolds;
+ [Test]
+ procedure TestNestedTagsFold;
+ [Test]
+ procedure TestDeeplyNestedTags;
+
+ { Void elements }
+ [Test]
+ procedure TestVoidElementsDoNotFold;
+ [Test]
+ procedure TestSelfClosingTagsDoNotFold;
+
+ { Same-line balanced tags }
+ [Test]
+ procedure TestBalancedTagsOnOneLineDoNotFold;
+
+ { Comments and DOCTYPE }
+ [Test]
+ procedure TestCommentsDoNotFold;
+ [Test]
+ procedure TestDoctypeDoesNotFold;
+
+ { Multi-line attributes }
+ [Test]
+ procedure TestMultiLineVoidTagDoesNotFold;
+
+ { Full sample source }
+ [Test]
+ procedure TestFullSampleFoldsCorrectly;
+
+ { Attributes with special characters }
+ [Test]
+ procedure TestQuotedGreaterThanInAttribute;
+ end;
+
+implementation
+
+uses
+ System.SysUtils,
+ System.Classes,
+ SynEditTextBuffer;
+
+procedure TTestHTMLFolding.Setup;
+begin
+ FHighlighter := TSynHTMLSyn.Create(nil);
+ FFoldRanges := TSynFoldRanges.Create;
+end;
+
+procedure TTestHTMLFolding.TearDown;
+begin
+ FFoldRanges.Free;
+ FHighlighter.Free;
+end;
+
+procedure TTestHTMLFolding.ScanText(const AText: string);
+var
+ Lines: TStringList;
+begin
+ Lines := TStringList.Create;
+ try
+ Lines.Text := AText;
+ FFoldRanges.StartScanning;
+ FHighlighter.ScanForFoldRanges(FFoldRanges, Lines, 0, Lines.Count - 1);
+ FFoldRanges.StopScanning(Lines);
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TTestHTMLFolding.FindFoldAtLine(ALine: Integer): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FFoldRanges.Count - 1 do
+ if FFoldRanges[I].FromLine = ALine then
+ Exit(I);
+ Result := -1;
+end;
+
+{ --- Basic tag folding --- }
+
+procedure TTestHTMLFolding.TestSingleTagPairFolds;
+begin
+ ScanText(
+ '' + sLineBreak + // line 1
+ ' content' + sLineBreak + // line 2
+ '
' // line 3
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'div fold should exist');
+ Assert.AreEqual(3, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'div fold should close at ');
+end;
+
+procedure TTestHTMLFolding.TestNestedTagsFold;
+begin
+ ScanText(
+ '' + sLineBreak + // line 1
+ ' ' + sLineBreak + // line 2
+ ' content' + sLineBreak + // line 3
+ ' ' + sLineBreak + // line 4
+ '' // line 5
+ );
+ Assert.IsTrue(FindFoldAtLine(1) >= 0, 'html fold should exist');
+ Assert.AreEqual(5, FFoldRanges[FindFoldAtLine(1)].ToLine,
+ 'html fold should close at