MaxY);
+
+ end; // NOT RegExp
end;
destructor TSynEditSearch.Destroy;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/syneditstrconst.pp lazarus-1.6+dfsg/components/synedit/syneditstrconst.pp
--- lazarus-1.4.4+dfsg/components/synedit/syneditstrconst.pp 2013-08-24 23:44:34.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/syneditstrconst.pp 2015-03-23 22:22:49.000000000 +0000
@@ -26,7 +26,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: syneditstrconst.pp 42488 2013-08-24 23:44:34Z martin $
+$Id: syneditstrconst.pp 48466 2015-03-23 22:22:49Z maxim $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -155,6 +155,8 @@
SYNS_AttrLineChanged = 'Diff Changed Line';
SYNS_AttrLineContext = 'Diff Context Line';
SYNS_AttrPrevValue = 'Previous value';
+ SYNS_AttrMeasurementUnitValue = 'Measurement unit';
+ SYNS_AttrSelectorValue = 'Selector';
SYNS_AttrFlags = 'Flags';
(* End of Attribute Names *)
@@ -270,6 +272,8 @@
SYNS_XML_AttrLineChanged = 'Diff Changed Line';
SYNS_XML_AttrLineContext = 'Diff Context Line';
SYNS_XML_AttrPrevValue = 'Previous value';
+ SYNS_XML_AttrMeasurementUnitValue = 'Measurement unit';
+ SYNS_XML_AttrSelectorValue = 'Selector';
SYNS_XML_AttrFlags = 'Flags';
(* End of Stored Attribute Names *)
@@ -389,7 +393,8 @@
SYNS_LangSynGenMsgfiles = 'SynGen Msg files';
SYNS_LangUnreal = 'Unreal';
SYNS_LangTeX = 'TeX';
- SYNS_LangPo = 'po language files';
+ SYNS_LangPo = 'po language files';
+ SYNS_LangPike = 'Pike';
resourcestring
@@ -397,6 +402,7 @@
SYNS_emcStartSelection = 'Selection';
SYNS_emcStartColumnSelections = 'Column Selection';
SYNS_emcStartLineSelections = 'Line Selection';
+ SYNS_emcStartLineSelectionsNoneEmpty = 'Line Selection (select immediate)';
SYNS_emcSelection_opt = 'Mode,Begin,Continue';
SYNS_emcSelectWord = 'Select Word';
SYNS_emcSelectLine = 'Select Line';
@@ -406,6 +412,7 @@
SYNS_emcPasteSelection = 'Quick Paste Selection';
SYNS_emcMouseLink = 'Source Link';
SYNS_emcMouseLink_opt = 'Underline,yes, no';
+ SYNS_emcStartDragMove_opt = '"Caret on up if not dragged",yes,no';
SYNS_emcContextMenu = 'Popup Menu';
SYNS_emcBreakPointToggle = 'Toggle Breakpoint';
SYNS_emcCodeFoldCollaps = 'Fold Code';
@@ -430,6 +437,8 @@
SYNS_emcContextMenuCaretMove_opt = '"Move caret, when selection exists", Never, "Click outside", Always';
SYNS_emcWheelScroll_opt = 'Speed,"System settings",Lines,Pages,"Pages (less one line)"';
+ SYNS_emcPluginMultiCaretToggleCaret = 'Toggle extra caret';
+ SYNS_emcPluginMultiCaretSelectionToCarets = 'Set carets at EOL in selected lines';
implementation
end.
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittextbase.pas lazarus-1.6+dfsg/components/synedit/synedittextbase.pas
--- lazarus-1.4.4+dfsg/components/synedit/synedittextbase.pas 2015-03-24 23:55:46.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittextbase.pas 2015-03-23 14:50:59.000000000 +0000
@@ -128,9 +128,9 @@
protected
// IsEqual is only needed/implemented for Carets
function IsEqualContent(AnItem: TSynEditUndoItem): Boolean; virtual;
- function IsEqual(AnItem: TSynEditUndoItem): Boolean;
function DebugString: String; virtual;
public
+ function IsEqual(AnItem: TSynEditUndoItem): Boolean;
function IsCaretInfo: Boolean; virtual;
function PerformUndo(Caller: TObject): Boolean; virtual; abstract;
end;
@@ -143,7 +143,7 @@
FCount, FCapacity: Integer;
FReason: TSynEditorCommand;
function GetItem(Index: Integer): TSynEditUndoItem;
- procedure Grow;
+ procedure Grow(ANeededCapacity: Integer = 0);
protected
Function HasUndoInfo: Boolean;
procedure Append(AnUndoGroup: TSynEditUndoItem);
@@ -158,7 +158,7 @@
procedure Assign(AnUndoGroup: TSynEditUndoGroup);
procedure Add(AnItem: TSynEditUndoItem);
- procedure Clear;
+ procedure Clear(OnlyFreeItems: Boolean = False);
procedure Insert(AIndex: Integer; AnItem: TSynEditUndoItem);
procedure Delete(AIndex: Integer);
function Pop: TSynEditUndoItem;
@@ -169,6 +169,14 @@
TSynGetCaretUndoProc = function: TSynEditUndoItem of object;
+ TSynUpdateCaretUndoProc = procedure(var AnUndoItem: TSynEditUndoItem; AnIsBeginUndo: Boolean) of object;
+
+ { TSynEditUpdateCaretUndoProcList }
+
+ TSynEditUpdateCaretUndoProcList = Class(TMethodList)
+ public
+ procedure CallSearchUpdateCaretUndoProcs(var AnUndoItem: TSynEditUndoItem; AnIsBeginUndo: Boolean);
+ end;
{ TSynEditUndoList }
@@ -184,6 +192,7 @@
fMaxUndoActions: integer;
fOnAdded: TNotifyEvent;
FOnNeedCaretUndo: TSynGetCaretUndoProc;
+ FOnNeedCaretUndoList: TSynEditUpdateCaretUndoProcList;
fUnModifiedItem: integer;
FForceGroupEnd: Boolean;
procedure EnsureMaxEntries;
@@ -220,6 +229,9 @@
property InGroupCount: integer read FInGroupCount;
{$ENDIF}
public
+ procedure RegisterUpdateCaretUndo(AnUpdateProc: TSynUpdateCaretUndoProc);
+ procedure UnregisterUpdateCaretUndo(AnUpdateProc: TSynUpdateCaretUndoProc);
+
property CanUndo: boolean read GetCanUndo;
property FullUndoImpossible: boolean read fFullUndoImposible;
property ItemCount: integer read GetItemCount;
@@ -247,6 +259,18 @@
raise ESynEditStorageMem.CreateFmt(SListIndexOutOfBounds, [Index]);
end;
+{ TSynEditUpdateCaretUndoProcList }
+
+procedure TSynEditUpdateCaretUndoProcList.CallSearchUpdateCaretUndoProcs(var AnUndoItem: TSynEditUndoItem;
+ AnIsBeginUndo: Boolean);
+var
+ i: LongInt;
+begin
+ i:=Count;
+ while NextDownIndex(i) do
+ TSynUpdateCaretUndoProc(Items[i])(AnUndoItem, AnIsBeginUndo);
+end;
+
{ TSynEditStringsBase }
function TSynEditStringsBase.GetPChar(ALineIndex: Integer): PChar;
@@ -262,6 +286,7 @@
begin
inherited Create;
// Create and keep one undo group => avoids resizing the FItems list
+ FOnNeedCaretUndoList := TSynEditUpdateCaretUndoProcList.Create;
FUndoGroup := TSynEditUndoGroup.Create;
FIsInsideRedo := False;
fItems := TList.Create;
@@ -275,6 +300,7 @@
Clear;
fItems.Free;
FreeAndNil(FUndoGroup);
+ FreeAndNil(FOnNeedCaretUndoList);
inherited Destroy;
end;
@@ -350,12 +376,18 @@
end;
procedure TSynEditUndoList.BeginBlock;
+var
+ c: TSynEditUndoItem;
begin
Inc(FInGroupCount);
if (FInGroupCount = 1) then begin
FUndoGroup.Clear;
+ c := nil;
if assigned(FOnNeedCaretUndo) then
- FUndoGroup.add(FOnNeedCaretUndo());
+ c := FOnNeedCaretUndo();
+ FOnNeedCaretUndoList.CallSearchUpdateCaretUndoProcs(c, True);
+ if c <> nil then
+ FUndoGroup.add(c);
end;
{$IFDEF SynUndoDebugCalls}
DebugLnEnter(['>> TSynEditUndoList.BeginBlock ', DebugName, ' ', DbgSName(self), ' ', dbgs(Self), ' fLockCount=', fLockCount, ' Cnt=', fItems.Count, ' FInGroupCount=', FInGroupCount, ' fUnModifiedItem=', fUnModifiedItem]);
@@ -379,15 +411,21 @@
procedure TSynEditUndoList.EndBlock;
var
ugroup: TSynEditUndoGroup;
+ c: TSynEditUndoItem;
begin
if FInGroupCount > 0 then begin
Dec(FInGroupCount);
if (FInGroupCount = 0) and FUndoGroup.HasUndoInfo then
begin
// Keep position for REDO; Do not replace if present
- if (not FUndoGroup.Items[FUndoGroup.Count - 1].IsCaretInfo)
- and assigned(FOnNeedCaretUndo) then
- FUndoGroup.Add(FOnNeedCaretUndo());
+ if (not FUndoGroup.Items[FUndoGroup.Count - 1].IsCaretInfo) then begin
+ c := nil;
+ if assigned(FOnNeedCaretUndo) then
+ c := FOnNeedCaretUndo();
+ FOnNeedCaretUndoList.CallSearchUpdateCaretUndoProcs(c, False);
+ if c <> nil then
+ FUndoGroup.add(c);
+ end;
if (fItems.Count > 0) and FGroupUndo and (not IsTopMarkedAsUnmodified) and
(not FForceGroupEnd) and
FUndoGroup.CanMergeWith(TSynEditUndoGroup(fItems[fItems.Count - 1])) then
@@ -528,6 +566,16 @@
Result := fUnModifiedItem >= 0;
end;
+procedure TSynEditUndoList.RegisterUpdateCaretUndo(AnUpdateProc: TSynUpdateCaretUndoProc);
+begin
+ FOnNeedCaretUndoList.Add(TMethod(AnUpdateProc));
+end;
+
+procedure TSynEditUndoList.UnregisterUpdateCaretUndo(AnUpdateProc: TSynUpdateCaretUndoProc);
+begin
+ FOnNeedCaretUndoList.Remove(TMethod(AnUpdateProc));
+end;
+
{ TSynEditUndoItem }
function TSynEditUndoItem.IsEqualContent(AnItem: TSynEditUndoItem): Boolean;
@@ -571,9 +619,12 @@
{ TSynEditUndoGroup }
-procedure TSynEditUndoGroup.Grow;
+procedure TSynEditUndoGroup.Grow(ANeededCapacity: Integer);
begin
- FCapacity := FCapacity + Max(10, FCapacity Div 8);
+ if ANeededCapacity > 0 then
+ FCapacity := Max(ANeededCapacity, FCapacity)
+ else
+ FCapacity := FCapacity + Max(10, FCapacity Div 8);
SetLength(FItems, FCapacity);
end;
@@ -629,8 +680,16 @@
procedure TSynEditUndoGroup.TranferTo(AnUndoGroup: TSynEditUndoGroup);
begin
- AnUndoGroup.Assign(self);
+ //AnUndoGroup.Assign(self);
+ AnUndoGroup.Clear(True);
+ AnUndoGroup.FCapacity := Count;
+ AnUndoGroup.FCount := Count;
+ AnUndoGroup.FItems := FItems;
+ FItems := nil;
+ FCapacity := 0;
FCount := 0; // Do not clear; that would free the items
+
+ AnUndoGroup.FReason := Reason;
end;
function TSynEditUndoGroup.CanMergeWith(AnUndoGroup: TSynEditUndoGroup): Boolean;
@@ -646,12 +705,20 @@
begin
// Merge other group to start
AnUndoGroup.Pop.Free;
- if AnUndoGroup.Count > 0 then begin
- fItems[0].Free;
- fItems[0] := AnUndoGroup.Pop;
- end;
- while AnUndoGroup.Count > 0 do
- Insert(0, AnUndoGroup.Pop);
+ if AnUndoGroup.Count = 0 then
+ exit;
+
+ Grow(Count + AnUndoGroup.Count); // since we replace item[0], this is one extra
+
+ If AnUndoGroup.Count > 1 then
+ System.Move(FItems[1], FItems[AnUndoGroup.Count],
+ (FCount - 1) * SizeOf(TSynEditUndoItem));
+ assert(Count > 0, 'TSynEditUndoGroup.MergeWith: Count > 0');
+ FItems[0].Free;
+ System.Move(AnUndoGroup.FItems[0], FItems[0],
+ (AnUndoGroup.Count) * SizeOf(TSynEditUndoItem));
+ FCount := FCount + AnUndoGroup.FCount - 1;
+ AnUndoGroup.FCount := 0;
end;
function TSynEditUndoGroup.GetItem(Index: Integer): TSynEditUndoItem;
@@ -667,7 +734,7 @@
destructor TSynEditUndoGroup.Destroy;
begin
- Clear;
+ Clear(True);
FItems := nil;
inherited Destroy;
end;
@@ -699,13 +766,13 @@
inc (FCount);
end;
-procedure TSynEditUndoGroup.Clear;
+procedure TSynEditUndoGroup.Clear(OnlyFreeItems: Boolean);
begin
while FCount > 0 do begin
dec(FCount);
FItems[FCount].Free;
end;
- if FCapacity > 100 then begin
+ if (not OnlyFreeItems) and (FCapacity > 100) then begin
FCapacity := 100;
SetLength(FItems, FCapacity);
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittextbuffer.pp lazarus-1.6+dfsg/components/synedit/synedittextbuffer.pp
--- lazarus-1.4.4+dfsg/components/synedit/synedittextbuffer.pp 2014-01-18 19:06:02.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittextbuffer.pp 2015-03-24 17:50:59.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synedittextbuffer.pp 43764 2014-01-18 19:06:02Z martin $
+$Id: synedittextbuffer.pp 48478 2015-03-24 17:50:59Z juha $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -1231,6 +1231,7 @@
begin
if FIsInDecPaintLock then exit;
if Updating then begin
+ SendNotification(senrBeforeIncPaintLock, Sender);
SendNotification(senrIncPaintLock, Sender); // DoIncPaintLock
SendNotification(senrAfterIncPaintLock, Sender);
FCachedNotify := False;
@@ -1245,6 +1246,7 @@
try
SendNotification(senrBeforeDecPaintLock, Sender);
SendNotification(senrDecPaintLock, Sender); // DoDecPaintLock
+ SendNotification(senrAfterDecPaintLock, Sender);
finally
FIsInDecPaintLock := False;
end;
@@ -1273,6 +1275,7 @@
var
s: string;
begin
+ Result := '';
if ByteLen <= 0 then
exit;
IncIsInEditAction;
@@ -1438,6 +1441,7 @@
FModifiedNotifyOldCount := FModifiedNotifyOldCount + i;
end;
+ oldcount := 0;
if AReason = senrLineCount then begin
if aCount < 0 then begin
oldcount := -aCount;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittextdoublewidthchars.pas lazarus-1.6+dfsg/components/synedit/synedittextdoublewidthchars.pas
--- lazarus-1.4.4+dfsg/components/synedit/synedittextdoublewidthchars.pas 2014-05-12 19:58:07.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittextdoublewidthchars.pas 2015-04-12 17:28:23.000000000 +0000
@@ -33,6 +33,7 @@
interface
uses
+ {$ifdef windows}{$IFDEF SynForceDoubeWidthHack} Windows, {$endif}{$endif}
Classes, SysUtils, LazSynEditText;
type
@@ -47,6 +48,370 @@
implementation
+{$IFDEF SynForceDoubeWidthHack}
+type
+{ For more information, see UAX #11: East Asian Width,
+ at http://www.unicode.org/reports/tr11/
+ EastAsianWidth-7.0.0.txt
+# Date: 2014-02-28, 23:15:00 GMT [KW, LI]
+# This file is an informative contributory data file in the
+# Unicode Character Database.
+}
+ TCharWidth = (cwN, cwA, cwH, cwW, cwF, cwNa);
+ TCharRange = record
+ l, h : Integer;
+ l8 : Int64; // utf8 encoding. UTF8 character is no longer that 6-bytes
+ h8 : Int64; // utf8 encoding
+ w : TCharWidth;
+ end;
+
+var
+ cjkarr : array of TCharRange = nil;
+
+procedure InitCJKWidth;
+begin
+ // Copyright (c) 1991-2014 Unicode, Inc.
+ // For terms of use, see http://www.unicode.org/terms_of_use.html
+ // this part is automatically generated based on EastAsianWidth.txt
+ SetLength(cjkarr,222);
+ SetLength(cjkarr,222);
+ with cjkarr[0] do begin l:=32; h:=126; w:=cwNa; l8:=$20; h8:=$7E; end;
+ with cjkarr[1] do begin l:=161; h:=161; w:=cwA; l8:=$C2A1; h8:=$C2A1; end;
+ with cjkarr[2] do begin l:=162; h:=163; w:=cwNa; l8:=$C2A2; h8:=$C2A3; end;
+ with cjkarr[3] do begin l:=164; h:=164; w:=cwA; l8:=$C2A4; h8:=$C2A4; end;
+ with cjkarr[4] do begin l:=165; h:=166; w:=cwNa; l8:=$C2A5; h8:=$C2A6; end;
+ with cjkarr[5] do begin l:=167; h:=168; w:=cwA; l8:=$C2A7; h8:=$C2A8; end;
+ with cjkarr[6] do begin l:=170; h:=170; w:=cwA; l8:=$C2AA; h8:=$C2AA; end;
+ with cjkarr[7] do begin l:=172; h:=172; w:=cwNa; l8:=$C2AC; h8:=$C2AC; end;
+ with cjkarr[8] do begin l:=173; h:=174; w:=cwA; l8:=$C2AD; h8:=$C2AE; end;
+ with cjkarr[9] do begin l:=175; h:=175; w:=cwNa; l8:=$C2AF; h8:=$C2AF; end;
+ with cjkarr[10] do begin l:=176; h:=180; w:=cwA; l8:=$C2B0; h8:=$C2B4; end;
+ with cjkarr[11] do begin l:=182; h:=186; w:=cwA; l8:=$C2B6; h8:=$C2BA; end;
+ with cjkarr[12] do begin l:=188; h:=191; w:=cwA; l8:=$C2BC; h8:=$C2BF; end;
+ with cjkarr[13] do begin l:=198; h:=198; w:=cwA; l8:=$C386; h8:=$C386; end;
+ with cjkarr[14] do begin l:=208; h:=208; w:=cwA; l8:=$C390; h8:=$C390; end;
+ with cjkarr[15] do begin l:=215; h:=216; w:=cwA; l8:=$C397; h8:=$C398; end;
+ with cjkarr[16] do begin l:=222; h:=225; w:=cwA; l8:=$C39E; h8:=$C3A1; end;
+ with cjkarr[17] do begin l:=230; h:=230; w:=cwA; l8:=$C3A6; h8:=$C3A6; end;
+ with cjkarr[18] do begin l:=232; h:=234; w:=cwA; l8:=$C3A8; h8:=$C3AA; end;
+ with cjkarr[19] do begin l:=236; h:=237; w:=cwA; l8:=$C3AC; h8:=$C3AD; end;
+ with cjkarr[20] do begin l:=240; h:=240; w:=cwA; l8:=$C3B0; h8:=$C3B0; end;
+ with cjkarr[21] do begin l:=242; h:=243; w:=cwA; l8:=$C3B2; h8:=$C3B3; end;
+ with cjkarr[22] do begin l:=247; h:=250; w:=cwA; l8:=$C3B7; h8:=$C3BA; end;
+ with cjkarr[23] do begin l:=252; h:=252; w:=cwA; l8:=$C3BC; h8:=$C3BC; end;
+ with cjkarr[24] do begin l:=254; h:=254; w:=cwA; l8:=$C3BE; h8:=$C3BE; end;
+ with cjkarr[25] do begin l:=257; h:=257; w:=cwA; l8:=$C481; h8:=$C481; end;
+ with cjkarr[26] do begin l:=273; h:=273; w:=cwA; l8:=$C491; h8:=$C491; end;
+ with cjkarr[27] do begin l:=275; h:=275; w:=cwA; l8:=$C493; h8:=$C493; end;
+ with cjkarr[28] do begin l:=283; h:=283; w:=cwA; l8:=$C49B; h8:=$C49B; end;
+ with cjkarr[29] do begin l:=294; h:=295; w:=cwA; l8:=$C4A6; h8:=$C4A7; end;
+ with cjkarr[30] do begin l:=299; h:=299; w:=cwA; l8:=$C4AB; h8:=$C4AB; end;
+ with cjkarr[31] do begin l:=305; h:=307; w:=cwA; l8:=$C4B1; h8:=$C4B3; end;
+ with cjkarr[32] do begin l:=312; h:=312; w:=cwA; l8:=$C4B8; h8:=$C4B8; end;
+ with cjkarr[33] do begin l:=319; h:=322; w:=cwA; l8:=$C4BF; h8:=$C582; end;
+ with cjkarr[34] do begin l:=324; h:=324; w:=cwA; l8:=$C584; h8:=$C584; end;
+ with cjkarr[35] do begin l:=328; h:=331; w:=cwA; l8:=$C588; h8:=$C58B; end;
+ with cjkarr[36] do begin l:=333; h:=333; w:=cwA; l8:=$C58D; h8:=$C58D; end;
+ with cjkarr[37] do begin l:=338; h:=339; w:=cwA; l8:=$C592; h8:=$C593; end;
+ with cjkarr[38] do begin l:=358; h:=359; w:=cwA; l8:=$C5A6; h8:=$C5A7; end;
+ with cjkarr[39] do begin l:=363; h:=363; w:=cwA; l8:=$C5AB; h8:=$C5AB; end;
+ with cjkarr[40] do begin l:=462; h:=462; w:=cwA; l8:=$C78E; h8:=$C78E; end;
+ with cjkarr[41] do begin l:=464; h:=464; w:=cwA; l8:=$C790; h8:=$C790; end;
+ with cjkarr[42] do begin l:=466; h:=466; w:=cwA; l8:=$C792; h8:=$C792; end;
+ with cjkarr[43] do begin l:=468; h:=468; w:=cwA; l8:=$C794; h8:=$C794; end;
+ with cjkarr[44] do begin l:=470; h:=470; w:=cwA; l8:=$C796; h8:=$C796; end;
+ with cjkarr[45] do begin l:=472; h:=472; w:=cwA; l8:=$C798; h8:=$C798; end;
+ with cjkarr[46] do begin l:=474; h:=474; w:=cwA; l8:=$C79A; h8:=$C79A; end;
+ with cjkarr[47] do begin l:=476; h:=476; w:=cwA; l8:=$C79C; h8:=$C79C; end;
+ with cjkarr[48] do begin l:=593; h:=593; w:=cwA; l8:=$C991; h8:=$C991; end;
+ with cjkarr[49] do begin l:=609; h:=609; w:=cwA; l8:=$C9A1; h8:=$C9A1; end;
+ with cjkarr[50] do begin l:=708; h:=708; w:=cwA; l8:=$CB84; h8:=$CB84; end;
+ with cjkarr[51] do begin l:=711; h:=711; w:=cwA; l8:=$CB87; h8:=$CB87; end;
+ with cjkarr[52] do begin l:=713; h:=715; w:=cwA; l8:=$CB89; h8:=$CB8B; end;
+ with cjkarr[53] do begin l:=717; h:=717; w:=cwA; l8:=$CB8D; h8:=$CB8D; end;
+ with cjkarr[54] do begin l:=720; h:=720; w:=cwA; l8:=$CB90; h8:=$CB90; end;
+ with cjkarr[55] do begin l:=728; h:=731; w:=cwA; l8:=$CB98; h8:=$CB9B; end;
+ with cjkarr[56] do begin l:=733; h:=733; w:=cwA; l8:=$CB9D; h8:=$CB9D; end;
+ with cjkarr[57] do begin l:=735; h:=735; w:=cwA; l8:=$CB9F; h8:=$CB9F; end;
+ with cjkarr[58] do begin l:=768; h:=879; w:=cwA; l8:=$CC80; h8:=$CDAF; end;
+ with cjkarr[59] do begin l:=913; h:=929; w:=cwA; l8:=$CE91; h8:=$CEA1; end;
+ with cjkarr[60] do begin l:=931; h:=937; w:=cwA; l8:=$CEA3; h8:=$CEA9; end;
+ with cjkarr[61] do begin l:=945; h:=961; w:=cwA; l8:=$CEB1; h8:=$CF81; end;
+ with cjkarr[62] do begin l:=963; h:=969; w:=cwA; l8:=$CF83; h8:=$CF89; end;
+ with cjkarr[63] do begin l:=1025; h:=1025; w:=cwA; l8:=$D081; h8:=$D081; end;
+ with cjkarr[64] do begin l:=1040; h:=1103; w:=cwA; l8:=$D090; h8:=$D18F; end;
+ with cjkarr[65] do begin l:=1105; h:=1105; w:=cwA; l8:=$D191; h8:=$D191; end;
+ with cjkarr[66] do begin l:=4352; h:=4447; w:=cwW; l8:=$E18480; h8:=$E1859F; end;
+ with cjkarr[67] do begin l:=8208; h:=8208; w:=cwA; l8:=$E28090; h8:=$E28090; end;
+ with cjkarr[68] do begin l:=8211; h:=8214; w:=cwA; l8:=$E28093; h8:=$E28096; end;
+ with cjkarr[69] do begin l:=8216; h:=8217; w:=cwA; l8:=$E28098; h8:=$E28099; end;
+ with cjkarr[70] do begin l:=8220; h:=8221; w:=cwA; l8:=$E2809C; h8:=$E2809D; end;
+ with cjkarr[71] do begin l:=8224; h:=8226; w:=cwA; l8:=$E280A0; h8:=$E280A2; end;
+ with cjkarr[72] do begin l:=8228; h:=8231; w:=cwA; l8:=$E280A4; h8:=$E280A7; end;
+ with cjkarr[73] do begin l:=8240; h:=8240; w:=cwA; l8:=$E280B0; h8:=$E280B0; end;
+ with cjkarr[74] do begin l:=8242; h:=8243; w:=cwA; l8:=$E280B2; h8:=$E280B3; end;
+ with cjkarr[75] do begin l:=8245; h:=8245; w:=cwA; l8:=$E280B5; h8:=$E280B5; end;
+ with cjkarr[76] do begin l:=8251; h:=8251; w:=cwA; l8:=$E280BB; h8:=$E280BB; end;
+ with cjkarr[77] do begin l:=8254; h:=8254; w:=cwA; l8:=$E280BE; h8:=$E280BE; end;
+ with cjkarr[78] do begin l:=8308; h:=8308; w:=cwA; l8:=$E281B4; h8:=$E281B4; end;
+ with cjkarr[79] do begin l:=8319; h:=8319; w:=cwA; l8:=$E281BF; h8:=$E281BF; end;
+ with cjkarr[80] do begin l:=8321; h:=8324; w:=cwA; l8:=$E28281; h8:=$E28284; end;
+ with cjkarr[81] do begin l:=8361; h:=8361; w:=cwH; l8:=$E282A9; h8:=$E282A9; end;
+ with cjkarr[82] do begin l:=8364; h:=8364; w:=cwA; l8:=$E282AC; h8:=$E282AC; end;
+ with cjkarr[83] do begin l:=8451; h:=8451; w:=cwA; l8:=$E28483; h8:=$E28483; end;
+ with cjkarr[84] do begin l:=8453; h:=8453; w:=cwA; l8:=$E28485; h8:=$E28485; end;
+ with cjkarr[85] do begin l:=8457; h:=8457; w:=cwA; l8:=$E28489; h8:=$E28489; end;
+ with cjkarr[86] do begin l:=8467; h:=8467; w:=cwA; l8:=$E28493; h8:=$E28493; end;
+ with cjkarr[87] do begin l:=8470; h:=8470; w:=cwA; l8:=$E28496; h8:=$E28496; end;
+ with cjkarr[88] do begin l:=8481; h:=8482; w:=cwA; l8:=$E284A1; h8:=$E284A2; end;
+ with cjkarr[89] do begin l:=8486; h:=8486; w:=cwA; l8:=$E284A6; h8:=$E284A6; end;
+ with cjkarr[90] do begin l:=8491; h:=8491; w:=cwA; l8:=$E284AB; h8:=$E284AB; end;
+ with cjkarr[91] do begin l:=8531; h:=8532; w:=cwA; l8:=$E28593; h8:=$E28594; end;
+ with cjkarr[92] do begin l:=8539; h:=8542; w:=cwA; l8:=$E2859B; h8:=$E2859E; end;
+ with cjkarr[93] do begin l:=8544; h:=8555; w:=cwA; l8:=$E285A0; h8:=$E285AB; end;
+ with cjkarr[94] do begin l:=8560; h:=8569; w:=cwA; l8:=$E285B0; h8:=$E285B9; end;
+ with cjkarr[95] do begin l:=8585; h:=8585; w:=cwA; l8:=$E28689; h8:=$E28689; end;
+ with cjkarr[96] do begin l:=8592; h:=8601; w:=cwA; l8:=$E28690; h8:=$E28699; end;
+ with cjkarr[97] do begin l:=8632; h:=8633; w:=cwA; l8:=$E286B8; h8:=$E286B9; end;
+ with cjkarr[98] do begin l:=8658; h:=8658; w:=cwA; l8:=$E28792; h8:=$E28792; end;
+ with cjkarr[99] do begin l:=8660; h:=8660; w:=cwA; l8:=$E28794; h8:=$E28794; end;
+ with cjkarr[100] do begin l:=8679; h:=8679; w:=cwA; l8:=$E287A7; h8:=$E287A7; end;
+ with cjkarr[101] do begin l:=8704; h:=8704; w:=cwA; l8:=$E28880; h8:=$E28880; end;
+ with cjkarr[102] do begin l:=8706; h:=8707; w:=cwA; l8:=$E28882; h8:=$E28883; end;
+ with cjkarr[103] do begin l:=8711; h:=8712; w:=cwA; l8:=$E28887; h8:=$E28888; end;
+ with cjkarr[104] do begin l:=8715; h:=8715; w:=cwA; l8:=$E2888B; h8:=$E2888B; end;
+ with cjkarr[105] do begin l:=8719; h:=8719; w:=cwA; l8:=$E2888F; h8:=$E2888F; end;
+ with cjkarr[106] do begin l:=8721; h:=8721; w:=cwA; l8:=$E28891; h8:=$E28891; end;
+ with cjkarr[107] do begin l:=8725; h:=8725; w:=cwA; l8:=$E28895; h8:=$E28895; end;
+ with cjkarr[108] do begin l:=8730; h:=8730; w:=cwA; l8:=$E2889A; h8:=$E2889A; end;
+ with cjkarr[109] do begin l:=8733; h:=8736; w:=cwA; l8:=$E2889D; h8:=$E288A0; end;
+ with cjkarr[110] do begin l:=8739; h:=8739; w:=cwA; l8:=$E288A3; h8:=$E288A3; end;
+ with cjkarr[111] do begin l:=8741; h:=8741; w:=cwA; l8:=$E288A5; h8:=$E288A5; end;
+ with cjkarr[112] do begin l:=8743; h:=8748; w:=cwA; l8:=$E288A7; h8:=$E288AC; end;
+ with cjkarr[113] do begin l:=8750; h:=8750; w:=cwA; l8:=$E288AE; h8:=$E288AE; end;
+ with cjkarr[114] do begin l:=8756; h:=8759; w:=cwA; l8:=$E288B4; h8:=$E288B7; end;
+ with cjkarr[115] do begin l:=8764; h:=8765; w:=cwA; l8:=$E288BC; h8:=$E288BD; end;
+ with cjkarr[116] do begin l:=8776; h:=8776; w:=cwA; l8:=$E28988; h8:=$E28988; end;
+ with cjkarr[117] do begin l:=8780; h:=8780; w:=cwA; l8:=$E2898C; h8:=$E2898C; end;
+ with cjkarr[118] do begin l:=8786; h:=8786; w:=cwA; l8:=$E28992; h8:=$E28992; end;
+ with cjkarr[119] do begin l:=8800; h:=8801; w:=cwA; l8:=$E289A0; h8:=$E289A1; end;
+ with cjkarr[120] do begin l:=8804; h:=8807; w:=cwA; l8:=$E289A4; h8:=$E289A7; end;
+ with cjkarr[121] do begin l:=8810; h:=8811; w:=cwA; l8:=$E289AA; h8:=$E289AB; end;
+ with cjkarr[122] do begin l:=8814; h:=8815; w:=cwA; l8:=$E289AE; h8:=$E289AF; end;
+ with cjkarr[123] do begin l:=8834; h:=8835; w:=cwA; l8:=$E28A82; h8:=$E28A83; end;
+ with cjkarr[124] do begin l:=8838; h:=8839; w:=cwA; l8:=$E28A86; h8:=$E28A87; end;
+ with cjkarr[125] do begin l:=8853; h:=8853; w:=cwA; l8:=$E28A95; h8:=$E28A95; end;
+ with cjkarr[126] do begin l:=8857; h:=8857; w:=cwA; l8:=$E28A99; h8:=$E28A99; end;
+ with cjkarr[127] do begin l:=8869; h:=8869; w:=cwA; l8:=$E28AA5; h8:=$E28AA5; end;
+ with cjkarr[128] do begin l:=8895; h:=8895; w:=cwA; l8:=$E28ABF; h8:=$E28ABF; end;
+ with cjkarr[129] do begin l:=8978; h:=8978; w:=cwA; l8:=$E28C92; h8:=$E28C92; end;
+ with cjkarr[130] do begin l:=9001; h:=9002; w:=cwW; l8:=$E28CA9; h8:=$E28CAA; end;
+ with cjkarr[131] do begin l:=9312; h:=9449; w:=cwA; l8:=$E291A0; h8:=$E293A9; end;
+ with cjkarr[132] do begin l:=9451; h:=9547; w:=cwA; l8:=$E293AB; h8:=$E2958B; end;
+ with cjkarr[133] do begin l:=9552; h:=9587; w:=cwA; l8:=$E29590; h8:=$E295B3; end;
+ with cjkarr[134] do begin l:=9600; h:=9615; w:=cwA; l8:=$E29680; h8:=$E2968F; end;
+ with cjkarr[135] do begin l:=9618; h:=9621; w:=cwA; l8:=$E29692; h8:=$E29695; end;
+ with cjkarr[136] do begin l:=9632; h:=9633; w:=cwA; l8:=$E296A0; h8:=$E296A1; end;
+ with cjkarr[137] do begin l:=9635; h:=9641; w:=cwA; l8:=$E296A3; h8:=$E296A9; end;
+ with cjkarr[138] do begin l:=9650; h:=9651; w:=cwA; l8:=$E296B2; h8:=$E296B3; end;
+ with cjkarr[139] do begin l:=9654; h:=9655; w:=cwA; l8:=$E296B6; h8:=$E296B7; end;
+ with cjkarr[140] do begin l:=9660; h:=9661; w:=cwA; l8:=$E296BC; h8:=$E296BD; end;
+ with cjkarr[141] do begin l:=9664; h:=9665; w:=cwA; l8:=$E29780; h8:=$E29781; end;
+ with cjkarr[142] do begin l:=9670; h:=9672; w:=cwA; l8:=$E29786; h8:=$E29788; end;
+ with cjkarr[143] do begin l:=9675; h:=9675; w:=cwA; l8:=$E2978B; h8:=$E2978B; end;
+ with cjkarr[144] do begin l:=9678; h:=9681; w:=cwA; l8:=$E2978E; h8:=$E29791; end;
+ with cjkarr[145] do begin l:=9698; h:=9701; w:=cwA; l8:=$E297A2; h8:=$E297A5; end;
+ with cjkarr[146] do begin l:=9711; h:=9711; w:=cwA; l8:=$E297AF; h8:=$E297AF; end;
+ with cjkarr[147] do begin l:=9733; h:=9734; w:=cwA; l8:=$E29885; h8:=$E29886; end;
+ with cjkarr[148] do begin l:=9737; h:=9737; w:=cwA; l8:=$E29889; h8:=$E29889; end;
+ with cjkarr[149] do begin l:=9742; h:=9743; w:=cwA; l8:=$E2988E; h8:=$E2988F; end;
+ with cjkarr[150] do begin l:=9748; h:=9749; w:=cwA; l8:=$E29894; h8:=$E29895; end;
+ with cjkarr[151] do begin l:=9756; h:=9756; w:=cwA; l8:=$E2989C; h8:=$E2989C; end;
+ with cjkarr[152] do begin l:=9758; h:=9758; w:=cwA; l8:=$E2989E; h8:=$E2989E; end;
+ with cjkarr[153] do begin l:=9792; h:=9792; w:=cwA; l8:=$E29980; h8:=$E29980; end;
+ with cjkarr[154] do begin l:=9794; h:=9794; w:=cwA; l8:=$E29982; h8:=$E29982; end;
+ with cjkarr[155] do begin l:=9824; h:=9825; w:=cwA; l8:=$E299A0; h8:=$E299A1; end;
+ with cjkarr[156] do begin l:=9827; h:=9829; w:=cwA; l8:=$E299A3; h8:=$E299A5; end;
+ with cjkarr[157] do begin l:=9831; h:=9834; w:=cwA; l8:=$E299A7; h8:=$E299AA; end;
+ with cjkarr[158] do begin l:=9836; h:=9837; w:=cwA; l8:=$E299AC; h8:=$E299AD; end;
+ with cjkarr[159] do begin l:=9839; h:=9839; w:=cwA; l8:=$E299AF; h8:=$E299AF; end;
+ with cjkarr[160] do begin l:=9886; h:=9887; w:=cwA; l8:=$E29A9E; h8:=$E29A9F; end;
+ with cjkarr[161] do begin l:=9918; h:=9919; w:=cwA; l8:=$E29ABE; h8:=$E29ABF; end;
+ with cjkarr[162] do begin l:=9924; h:=9933; w:=cwA; l8:=$E29B84; h8:=$E29B8D; end;
+ with cjkarr[163] do begin l:=9935; h:=9953; w:=cwA; l8:=$E29B8F; h8:=$E29BA1; end;
+ with cjkarr[164] do begin l:=9955; h:=9955; w:=cwA; l8:=$E29BA3; h8:=$E29BA3; end;
+ with cjkarr[165] do begin l:=9960; h:=9983; w:=cwA; l8:=$E29BA8; h8:=$E29BBF; end;
+ with cjkarr[166] do begin l:=10045; h:=10045; w:=cwA; l8:=$E29CBD; h8:=$E29CBD; end;
+ with cjkarr[167] do begin l:=10071; h:=10071; w:=cwA; l8:=$E29D97; h8:=$E29D97; end;
+ with cjkarr[168] do begin l:=10102; h:=10111; w:=cwA; l8:=$E29DB6; h8:=$E29DBF; end;
+ with cjkarr[169] do begin l:=10214; h:=10221; w:=cwNa; l8:=$E29FA6; h8:=$E29FAD; end;
+ with cjkarr[170] do begin l:=10629; h:=10630; w:=cwNa; l8:=$E2A685; h8:=$E2A686; end;
+ with cjkarr[171] do begin l:=11093; h:=11097; w:=cwA; l8:=$E2AD95; h8:=$E2AD99; end;
+ with cjkarr[172] do begin l:=11904; h:=11929; w:=cwW; l8:=$E2BA80; h8:=$E2BA99; end;
+ with cjkarr[173] do begin l:=11931; h:=12019; w:=cwW; l8:=$E2BA9B; h8:=$E2BBB3; end;
+ with cjkarr[174] do begin l:=12032; h:=12245; w:=cwW; l8:=$E2BC80; h8:=$E2BF95; end;
+ with cjkarr[175] do begin l:=12272; h:=12283; w:=cwW; l8:=$E2BFB0; h8:=$E2BFBB; end;
+ with cjkarr[176] do begin l:=12288; h:=12288; w:=cwF; l8:=$E38080; h8:=$E38080; end;
+ with cjkarr[177] do begin l:=12289; h:=12350; w:=cwW; l8:=$E38081; h8:=$E380BE; end;
+ with cjkarr[178] do begin l:=12353; h:=12438; w:=cwW; l8:=$E38181; h8:=$E38296; end;
+ with cjkarr[179] do begin l:=12441; h:=12543; w:=cwW; l8:=$E38299; h8:=$E383BF; end;
+ with cjkarr[180] do begin l:=12549; h:=12589; w:=cwW; l8:=$E38485; h8:=$E384AD; end;
+ with cjkarr[181] do begin l:=12593; h:=12686; w:=cwW; l8:=$E384B1; h8:=$E3868E; end;
+ with cjkarr[182] do begin l:=12688; h:=12730; w:=cwW; l8:=$E38690; h8:=$E386BA; end;
+ with cjkarr[183] do begin l:=12736; h:=12771; w:=cwW; l8:=$E38780; h8:=$E387A3; end;
+ with cjkarr[184] do begin l:=12784; h:=12830; w:=cwW; l8:=$E387B0; h8:=$E3889E; end;
+ with cjkarr[185] do begin l:=12832; h:=12871; w:=cwW; l8:=$E388A0; h8:=$E38987; end;
+ with cjkarr[186] do begin l:=12872; h:=12879; w:=cwA; l8:=$E38988; h8:=$E3898F; end;
+ with cjkarr[187] do begin l:=12880; h:=13054; w:=cwW; l8:=$E38990; h8:=$E38BBE; end;
+ with cjkarr[188] do begin l:=13056; h:=19903; w:=cwW; l8:=$E38C80; h8:=$E4B6BF; end;
+ with cjkarr[189] do begin l:=19968; h:=42124; w:=cwW; l8:=$E4B880; h8:=$EA928C; end;
+ with cjkarr[190] do begin l:=42128; h:=42182; w:=cwW; l8:=$EA9290; h8:=$EA9386; end;
+ with cjkarr[191] do begin l:=43360; h:=43388; w:=cwW; l8:=$EAA5A0; h8:=$EAA5BC; end;
+ with cjkarr[192] do begin l:=44032; h:=55203; w:=cwW; l8:=$EAB080; h8:=$ED9EA3; end;
+ with cjkarr[193] do begin l:=57344; h:=63743; w:=cwA; l8:=$EE8080; h8:=$EFA3BF; end;
+ with cjkarr[194] do begin l:=63744; h:=64255; w:=cwW; l8:=$EFA480; h8:=$EFABBF; end;
+ with cjkarr[195] do begin l:=65024; h:=65039; w:=cwA; l8:=$EFB880; h8:=$EFB88F; end;
+ with cjkarr[196] do begin l:=65040; h:=65049; w:=cwW; l8:=$EFB890; h8:=$EFB899; end;
+ with cjkarr[197] do begin l:=65072; h:=65106; w:=cwW; l8:=$EFB8B0; h8:=$EFB992; end;
+ with cjkarr[198] do begin l:=65108; h:=65126; w:=cwW; l8:=$EFB994; h8:=$EFB9A6; end;
+ with cjkarr[199] do begin l:=65128; h:=65131; w:=cwW; l8:=$EFB9A8; h8:=$EFB9AB; end;
+ with cjkarr[200] do begin l:=65281; h:=65376; w:=cwF; l8:=$EFBC81; h8:=$EFBDA0; end;
+ with cjkarr[201] do begin l:=65377; h:=65470; w:=cwH; l8:=$EFBDA1; h8:=$EFBEBE; end;
+ with cjkarr[202] do begin l:=65474; h:=65479; w:=cwH; l8:=$EFBF82; h8:=$EFBF87; end;
+ with cjkarr[203] do begin l:=65482; h:=65487; w:=cwH; l8:=$EFBF8A; h8:=$EFBF8F; end;
+ with cjkarr[204] do begin l:=65490; h:=65495; w:=cwH; l8:=$EFBF92; h8:=$EFBF97; end;
+ with cjkarr[205] do begin l:=65498; h:=65500; w:=cwH; l8:=$EFBF9A; h8:=$EFBF9C; end;
+ with cjkarr[206] do begin l:=65504; h:=65510; w:=cwF; l8:=$EFBFA0; h8:=$EFBFA6; end;
+ with cjkarr[207] do begin l:=65512; h:=65518; w:=cwH; l8:=$EFBFA8; h8:=$EFBFAE; end;
+ with cjkarr[208] do begin l:=65533; h:=65533; w:=cwA; l8:=$EFBFBD; h8:=$EFBFBD; end;
+ with cjkarr[209] do begin l:=110592; h:=110593; w:=cwW; l8:=$F09B8080; h8:=$F09B8081; end;
+ with cjkarr[210] do begin l:=127232; h:=127242; w:=cwA; l8:=$F09F8480; h8:=$F09F848A; end;
+ with cjkarr[211] do begin l:=127248; h:=127277; w:=cwA; l8:=$F09F8490; h8:=$F09F84AD; end;
+ with cjkarr[212] do begin l:=127280; h:=127337; w:=cwA; l8:=$F09F84B0; h8:=$F09F85A9; end;
+ with cjkarr[213] do begin l:=127344; h:=127386; w:=cwA; l8:=$F09F85B0; h8:=$F09F869A; end;
+ with cjkarr[214] do begin l:=127488; h:=127490; w:=cwW; l8:=$F09F8880; h8:=$F09F8882; end;
+ with cjkarr[215] do begin l:=127504; h:=127546; w:=cwW; l8:=$F09F8890; h8:=$F09F88BA; end;
+ with cjkarr[216] do begin l:=127552; h:=127560; w:=cwW; l8:=$F09F8980; h8:=$F09F8988; end;
+ with cjkarr[217] do begin l:=127568; h:=127569; w:=cwW; l8:=$F09F8990; h8:=$F09F8991; end;
+ with cjkarr[218] do begin l:=131072; h:=196605; w:=cwW; l8:=$F0A08080; h8:=$F0AFBFBD; end;
+ with cjkarr[219] do begin l:=196608; h:=262141; w:=cwW; l8:=$F0B08080; h8:=$F0BFBFBD; end;
+ with cjkarr[220] do begin l:=917760; h:=917999; w:=cwA; l8:=$F3A08480; h8:=$F3A087AF; end;
+ with cjkarr[221] do begin l:=983040; h:=1048573; w:=cwA; l8:=$F3B08080; h8:=$F3BFBFBD; end;
+ // end of automatically generated part
+end;
+
+
+
+
+function GetCJKWidth(u: Integer; defaultWidth: TCharWidth = cwN): TCharWidth;
+var
+ b: Integer;
+ e: Integer;
+ i: Integer;
+begin
+ if length(cjkarr)=0 then InitCJKWidth;
+
+ // simple binary search
+ b := 0;
+ e := length(cjkarr)-1;
+ Result := defaultWidth;
+
+ while (b <= e) do
+ begin
+ i := (b + e) div 2;
+ if (u>=cjkarr[i].l) and (u<=cjkarr[i].h) then begin
+ Result := cjkarr[i].w;
+ Break;
+ end else if cjkarr[i].l > u then
+ e := i - 1
+ else
+ b := i + 1;
+ end;
+end;
+
+function GetCJKWidth(utf8: PChar; charLen: Integer; defWidth: TCharWidth): TCharWidth; forward;
+
+function GetCJKWidth(utf8: PChar; defWidth: TCharWidth): TCharWidth;
+var
+ l : integer;
+const
+ len1 = $01 shl 7; mask1 = $00;
+ len2 = $07 shl 5; mask2 = $C0;
+ len3 = $0F shl 4; mask3 = $E0;
+ len4 = $1F shl 4; mask4 = $F0;
+ len5 = $3F shl 4; mask5 = $F8;
+ len6 = $7F shl 4; mask6 = $FC;
+begin
+ if not AssigneD(utf8) then begin
+ Result:=defWidth;
+ Exit;
+ end;
+ l:=0;
+ if byte(utf8^) and len1 = mask1 then l:=1
+ else if byte(utf8^) and len2 = mask2 then l:=2
+ else if byte(utf8^) and len3 = mask3 then l:=3
+ else if byte(utf8^) and len4 = mask4 then l:=4
+ else if byte(utf8^) and len5 = mask5 then l:=5
+ else if byte(utf8^) and len6 = mask6 then l:=6;
+ if l=0 then Result:=defWidth
+ else Result:=GetCJKWidth(utf8, l, defWidth)
+end;
+
+function GetCJKWidth(utf8: PChar; charLen: Integer; defWidth: TCharWidth): TCharWidth;
+var
+ c : Int64;
+ pb : PByteArray;
+ b: Integer;
+ e: Integer;
+ i: Integer;
+begin
+ {$IFDEF ENDIAN_LITTLE}
+ case charLen of
+ 1: c:=byte(utf8^);
+ 2: c:=SwapEndian(PWord(utf8)^);
+ 3: begin
+ pb:=PByteArray(utf8);
+ c:=(pb^[0] shl 16) or (pb^[1] shl 8) or (pb^[2]);
+ end;
+ 4: c:=SwapEndian(PLongWord(utf8)^);
+ 5: begin
+ pb:=PByteArray(utf8);
+ c:=(pb^[0] shl 32) or (pb^[1] shl 24) or (pb^[2] shl 16) or (pb^[3] shl 8) or (pb^[4]);
+ end;
+ 6: begin
+ pb:=PByteArray(utf8);
+ c:=(pb^[0] shl 40) or (pb^[1] shl 32) or (pb^[2] shl 24) or (pb^[3] shl 16) or (pb^[4] shl 8) or (pb^[5]);
+ end;
+ else
+ Result:=defWidth;
+ Exit;
+ end;
+ {$ELSE}
+ c:=0;
+ move(utf8^, c, charLen);
+ {$ENDIF}
+
+ // simple binary search
+ b := 0;
+ e := length(cjkarr)-1;
+ Result := defWidth;
+
+ while (b <= e) do
+ begin
+ i := (b + e) div 2;
+ if (c>=cjkarr[i].l8) and (c<=cjkarr[i].h8) then begin
+ Result := cjkarr[i].w;
+ Break;
+ end else if cjkarr[i].l8 > c then
+ e := i - 1
+ else
+ b := i + 1;
+ end;
+end;
+
+{$ENDIF}
+
+
{ SynEditTextDoubleWidthChars }
procedure SynEditStringDoubleWidthChars.DoGetPhysicalCharWidths(Line: PChar;
@@ -60,6 +425,40 @@
dec(Line);
dec(PWidths);
+
+ {$IFDEF SynForceDoubeWidthHack}
+ {$IF FPC_FULLVERSION>=20701}
+ if (DefaultSystemCodePage = 932) {Japanese}
+ {$ELSE}
+ if (GetACP = 932) {Japanese}
+ {$ENDIF}
+ then begin
+ for i := 0 to LineLen - 1 do begin
+ inc(Line);
+ inc(PWidths);
+ if PWidths^ = 0 then continue;
+
+ case GetCJKWidth(Line, cwN) of
+ cwN, cwH, cwNa: PWidths^ := 1;
+ cwA, cwW, cwF: PWidths^ := 2;
+ end;
+
+ (*
+ PWidths^:=2;
+ case Line^ of
+ #$01..#$7F: PWidths^ := 1;
+ #$80..#$BF: PWidths^ := 0;
+ #$EF: begin
+ if (Line[1] = #$bd) and (Line[2] in [#$A1..#$bf]) then PWidths^ := 1;
+ if (Line[1] = #$be) and (Line[2] in [#$80..#$9f]) then PWidths^ := 1;
+ end;
+ end;
+ *)
+ end;
+ exit;
+ end;
+ {$ENDIF}
+
for i := 0 to LineLen - 1 do begin
inc(Line);
inc(PWidths);
@@ -187,5 +586,11 @@
30000 f0 b0 80 80 .. 3FFFD f0 bf bf bd
*)
+
+{$IFDEF SynForceDoubeWidthHack}
+initialization
+ InitCJKWidth;
+{$ENDIF}
+
end.
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittextsystemcharwidth.pas lazarus-1.6+dfsg/components/synedit/synedittextsystemcharwidth.pas
--- lazarus-1.4.4+dfsg/components/synedit/synedittextsystemcharwidth.pas 2013-06-08 19:35:20.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittextsystemcharwidth.pas 2015-04-29 09:58:01.000000000 +0000
@@ -36,28 +36,39 @@
uses
{$IFDEF WindowsDesktop} windows, {$endif}
- Classes, SysUtils, LazSynEditText, LazUTF8, Controls, Graphics, LazLoggerBase;
+ Classes, SysUtils,
+ {$IFDEF WindowsDesktop}
+ Types,
+ {$endif}
+ LazSynEditText, SynTextDrawer, LazUTF8, Controls, Graphics,
+ LazLoggerBase;
type
- { TSynEditStringBidiChars }
-
{ TSynEditStringSystemWidthChars }
TSynEditStringSystemWidthChars = class(TSynEditStringsLinked)
private
+ FCharWidth: Integer;
FHandleOwner: TCanvas;
+ fTextDrawer: TheTextDrawer;
protected
+ {$IFDEF WindowsDesktop} // Do nothing on other OS/ parent handles default
procedure DoGetPhysicalCharWidths(Line: PChar; LineLen, Index: Integer; PWidths: PPhysicalCharWidth); override;
+ {$endif}
public
constructor Create(ASynStringSource: TSynEditStrings; AHandleOwner: TCanvas);
property HandleOwner: TCanvas read FHandleOwner;
+ property CharWidth: Integer read FCharWidth write FCharWidth;
+ property TextDrawer: TheTextDrawer read fTextDrawer write fTextDrawer;
end;
implementation
+{$IFDEF WindowsDesktop}
var
LOG_SynSystemWidthChars: PLazLoggerLogGroup;
+{$ENDIF}
{ TSynEditStringSystemWidthChars }
@@ -68,9 +79,9 @@
FHandleOwner := AHandleOwner;
end;
+{$IFDEF WindowsDesktop}
procedure TSynEditStringSystemWidthChars.DoGetPhysicalCharWidths(Line: PChar; LineLen,
Index: Integer; PWidths: PPhysicalCharWidth);
- {$IFDEF WindowsDesktop}
var
//s: UnicodeString;// wideString;
i: DWORD;
@@ -82,7 +93,6 @@
s: WideString;
j, k: Integer;
l: SizeUInt;
- {$endif}
begin
inherited DoGetPhysicalCharWidths(Line, LineLen, Index, PWidths);
if (not IsUtf8) then
@@ -94,9 +104,8 @@
debugln(LOG_SynSystemWidthChars, ['TSynEditStringSystemWidthChars NO HANDLE ']);
exit;
end;
+if TextDrawer= nil then exit;;
-
- {$IFDEF WindowsDesktop}
SetLength(s, LineLen+1); // wide chars of UTF-16 <= bytes of UTF-8 string
if ConvertUTF8ToUTF16(PWideChar(S), LineLen+1, Line, LineLen, [toInvalidCharToSymbol], l) <> trNoError then
exit;
@@ -111,8 +120,19 @@
SetLength(glyph, Length(s)+1); cpRes.lpGlyphs := @glyph[0];
cpRes.nGlyphs := length(s);
- i := GetCharacterPlacementW(FHandleOwner.Handle, pwidechar(s), length(s), 0,
- @cpRes, GCP_DIACRITIC + GCP_KASHIDA + GCP_LIGATE);
+//exit;
+ {$IFDEF WithSynExperimentalCharWidth}
+ // Need to find fallback font(s), and measure with them too.
+ TextDrawer.BeginDrawing(FHandleOwner.Handle);
+ i := GetFontLanguageInfo(textdrawer.StockDC);
+ if (i and GCP_ERROR) <> 0 then i := 0; //exit;
+ i := i and FLI_MASK or GCP_GLYPHSHAPE;
+
+ i := GetCharacterPlacementW(
+ textdrawer.StockDC, //FHandleOwner.Handle,
+ pwidechar(s), length(s), 0, @cpRes, i); //GCP_DIACRITIC + GCP_KASHIDA + GCP_LIGATE);
+ TextDrawer.EndDrawing;
+ {$endif}
if i = 0 then begin
debugln(LOG_SynSystemWidthChars, ['TSynEditStringSystemWidthChars FAILED for line ', Index]);
exit;
@@ -127,6 +147,8 @@
debugln(LOG_SynSystemWidthChars, ['TSynEditStringSystemWidthChars for line ', Index, ' set char at ', j, '(', k, ') to be drawn with previous']);
PWidths^ := 0;
end;
+ if dx[k] > fTextDrawer.CharWidth then
+ PWidths^ := 2; // assums that is the max size, if font is proportional
end;
inc(k);
end;
@@ -135,12 +157,14 @@
inc(Line);
end;
- {$endif}
end;
+{$endif}
+{$IFDEF WindowsDesktop}
initialization
LOG_SynSystemWidthChars := DebugLogger.RegisterLogGroup('SynSystemWidthChars' {$IFDEF SynSystemWidthChars} , True {$ENDIF} );
+{$ENDIF}
end.
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittexttabexpander.pas lazarus-1.6+dfsg/components/synedit/synedittexttabexpander.pas
--- lazarus-1.4.4+dfsg/components/synedit/synedittexttabexpander.pas 2014-02-05 12:07:46.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittexttabexpander.pas 2015-05-22 15:12:33.000000000 +0000
@@ -26,7 +26,7 @@
interface
uses
- LCLProc, Classes, SysUtils, LazSynEditText, SynEditTextBase;
+ LCLProc, Classes, SysUtils, math, LazSynEditText, SynEditTextBase;
type
@@ -55,11 +55,13 @@
private
FTabWidth: integer;
FIndexOfLongestLine: Integer;
+ FFirstUnknownLongestLine, FLastUnknownLongestLine: Integer;
FTabData: TSynEditStringTabData;
FLastLineHasTab: Boolean; // Last line, parsed by GetPhysicalCharWidths
FLastLinePhysLen: Integer;
FViewChangeStamp: int64;
procedure TextBufferChanged(Sender: TObject);
+ procedure LineTextChanged(Sender: TSynEditStrings; aIndex, aCount: Integer);
procedure LineCountChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
function ExpandedString(Index: integer): string;
function ExpandedStringLength(Index: integer): Integer;
@@ -135,11 +137,13 @@
constructor TSynEditStringTabExpander.Create(ASynStringSource: TSynEditStrings);
begin
FIndexOfLongestLine := -1;
+ FFirstUnknownLongestLine := -1;
+ FLastUnknownLongestLine := -1;
inherited Create(ASynStringSource);
TextBufferChanged(nil);
TabWidth := 8;
fSynStrings.AddChangeHandler(senrLineCount, @LineCountChanged);
- fSynStrings.AddChangeHandler(senrLineChange, @LineCountChanged);
+ fSynStrings.AddChangeHandler(senrLineChange, @LineTextChanged);
fSynStrings.AddNotifyHandler(senrTextBufferChanged, @TextBufferChanged);
end;
@@ -155,7 +159,7 @@
Data.Free;
end;
end;
- fSynStrings.RemoveChangeHandler(senrLineChange, @LineCountChanged);
+ fSynStrings.RemoveChangeHandler(senrLineChange, @LineTextChanged);
fSynStrings.RemoveChangeHandler(senrLineCount, @LineCountChanged);
fSynStrings.RemoveNotifyHandler(senrTextBufferChanged, @TextBufferChanged);
inherited Destroy;
@@ -178,6 +182,8 @@
FTabWidth := AValue;
FIndexOfLongestLine := -1;
+ FFirstUnknownLongestLine := -1;
+ FLastUnknownLongestLine := -1;
for i := 0 to Count - 1 do
if not(FTabData[i] >= NO_TAB_IN_LINE_OFFSET) then
FTabData[i] := LINE_LEN_UNKNOWN;
@@ -219,14 +225,47 @@
end
else
FTabData.IncRefCount;
- LineCountChanged(TSynEditStrings(Sender), 0, Count);
+ LineTextChanged(TSynEditStrings(Sender), 0, Count);
+end;
+
+procedure TSynEditStringTabExpander.LineTextChanged(Sender: TSynEditStrings; aIndex,
+ aCount: Integer);
+var
+ i: integer;
+begin
+ if (FIndexOfLongestLine >= AIndex) and (FIndexOfLongestLine < AIndex+ACount) then
+ FIndexOfLongestLine := -1;
+ if (FFirstUnknownLongestLine < 0) or (AIndex < FFirstUnknownLongestLine) then
+ FFirstUnknownLongestLine := AIndex;
+ if AIndex+ACount-1 > FLastUnknownLongestLine then
+ FLastUnknownLongestLine := AIndex+ACount-1;
+ for i := AIndex to AIndex + ACount - 1 do
+ FTabData[i] := LINE_LEN_UNKNOWN;
end;
procedure TSynEditStringTabExpander.LineCountChanged(Sender: TSynEditStrings; AIndex, ACount: Integer);
var
i: integer;
begin
- FIndexOfLongestLine := -1;
+ if ACount < 0 then begin
+ if (FIndexOfLongestLine >= AIndex) and (FIndexOfLongestLine < AIndex-ACount) then
+ FIndexOfLongestLine := -1;
+ if (FFirstUnknownLongestLine >= 0) then begin
+ if (AIndex < FFirstUnknownLongestLine) then
+ FFirstUnknownLongestLine := Max(AIndex, FFirstUnknownLongestLine + ACount);
+ if (AIndex < FLastUnknownLongestLine) then
+ FLastUnknownLongestLine := Max(AIndex, FLastUnknownLongestLine + ACount);
+ end;
+
+ exit;
+ end;
+
+ if (FIndexOfLongestLine >= AIndex) then
+ FIndexOfLongestLine := FIndexOfLongestLine + ACount;
+ if (FFirstUnknownLongestLine < 0) or (AIndex < FFirstUnknownLongestLine) then
+ FFirstUnknownLongestLine := AIndex;
+ if (AIndex < FLastUnknownLongestLine) or (FLastUnknownLongestLine < 0) then
+ FLastUnknownLongestLine := Max(AIndex, FLastUnknownLongestLine) +ACount;
for i := AIndex to AIndex + ACount - 1 do
FTabData[i] := LINE_LEN_UNKNOWN;
end;
@@ -334,20 +373,40 @@
i, j, m: Integer;
Line1, Line2: Integer;
begin
+ Result := 0;
Line1 := 0;
Line2 := Count - 1;
+
if (fIndexOfLongestLine >= 0) and (fIndexOfLongestLine < Count) then begin
Result := FTabData[fIndexOfLongestLine];
if Result <> LINE_LEN_UNKNOWN then begin
if Result >= NO_TAB_IN_LINE_OFFSET then Result := Result - NO_TAB_IN_LINE_OFFSET;
- exit;
+ if (FFirstUnknownLongestLine < 0) then
+ exit;
+ // Result has the value from index
+ Line1 := FFirstUnknownLongestLine;
+ if (FLastUnknownLongestLine < Line2) then
+ Line2 := FLastUnknownLongestLine;
+ end
+ else begin
+ Result := 0;
+ if (FFirstUnknownLongestLine < 0) then begin
+ Line1 := fIndexOfLongestLine;
+ Line2 := fIndexOfLongestLine;
+ end
+ else begin // TODO: Calculate for fIndexOfLongestLine, instead of extending the range
+ Line1 := Min(fIndexOfLongestLine, FFirstUnknownLongestLine);
+ if (FLastUnknownLongestLine < Line2) then
+ Line2 := Max(fIndexOfLongestLine, FLastUnknownLongestLine);
+ end;
end;
- Line1 := fIndexOfLongestLine;
- Line2 := fIndexOfLongestLine;
end;
+ FFirstUnknownLongestLine := -1;
+ FLastUnknownLongestLine := -1;
+
try
- Result := 0;
+ //Result := 0;
m := 0;
CharWidths := nil;
for i := Line1 to Line2 do begin
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittexttrimmer.pas lazarus-1.6+dfsg/components/synedit/synedittexttrimmer.pas
--- lazarus-1.4.4+dfsg/components/synedit/synedittexttrimmer.pas 2014-03-10 15:44:02.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittexttrimmer.pas 2015-03-24 17:50:59.000000000 +0000
@@ -1125,6 +1125,7 @@
Len: Integer;
SaveByteLen: LongInt;
begin
+ Result := '';
if (not fEnabled) or (ByteLen <= 0) then begin
fSynStrings.EditDelete(LogX, LogY, ByteLen);
exit;
@@ -1140,7 +1141,6 @@
IncIsInEditAction;
FlushNotificationCache;
SaveByteLen := ByteLen;
- Result := '';
IgnoreSendNotification(senrEditAction, True);
// Delete uncommited spaces (could also be ByteLen too big, due to past EOL)
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synedittypes.pp lazarus-1.6+dfsg/components/synedit/synedittypes.pp
--- lazarus-1.4.4+dfsg/components/synedit/synedittypes.pp 2014-10-01 00:15:17.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synedittypes.pp 2015-03-10 11:51:09.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synedittypes.pp 46389 2014-10-01 00:15:17Z martin $
+$Id: synedittypes.pp 48197 2015-03-10 11:51:09Z martin $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -41,7 +41,7 @@
interface
uses
- SysUtils;
+ SysUtils, types;
const
TSynSpecialChars = [#128..#255]; // MG: special chars. Meaning depends on system encoding/codepage.
@@ -59,6 +59,11 @@
TLinePos = type integer; // 1..high(Integer);
TLineIdx = type integer; // 0..high(Integer);
+ TLogCaretPoint = record
+ X, Y, Offs: Integer;
+ end;
+
+
TSynCoordinateMappingFlag = (
scmLimitToLines,
scmIncludePartVisible,
@@ -91,12 +96,26 @@
TSynStatusChange = (scCaretX, scCaretY,
scLeftChar, scTopLine, scLinesInWindow, scCharsInWindow,
- scInsertMode, scModified, scSelection, scReadOnly
+ scInsertMode, scModified, scSelection, scReadOnly,
+ scFocus, // received or lost focus
+ scOptions // some Options were changed (only triggered by some optinos)
);
TSynStatusChanges = set of TSynStatusChange;
TStatusChangeEvent = procedure(Sender: TObject; Changes: TSynStatusChanges)
of object;
+ TSynPaintEvent = (peBeforePaint, peAfterPaint);
+ TSynPaintEvents = set of TSynPaintEvent;
+ TSynPaintEventProc = procedure(Sender: TObject; EventType: TSynPaintEvent;
+ const rcClip: TRect
+ ) of object;
+
+ TSynScrollEvent = (peBeforeScroll, peAfterScroll, peAfterScrollFailed);
+ TSynScrollEvents = set of TSynScrollEvent;
+ TSynScrollEventProc = procedure(Sender: TObject; EventType: TSynScrollEvent;
+ dx, dy: Integer; const rcScroll, rcClip: TRect
+ ) of object;
+
TSynVisibleSpecialChar = (vscSpace, vscTabAtFirst, vscTabAtLast);
TSynVisibleSpecialChars = set of TSynVisibleSpecialChar;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synexporthtml.pas lazarus-1.6+dfsg/components/synedit/synexporthtml.pas
--- lazarus-1.4.4+dfsg/components/synedit/synexporthtml.pas 2012-06-25 22:49:31.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synexporthtml.pas 2015-09-27 19:19:24.000000000 +0000
@@ -29,7 +29,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synexporthtml.pas 37782 2012-06-25 22:49:31Z martin $
+$Id: synexporthtml.pas 49880 2015-09-27 19:19:24Z mattias $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -46,17 +46,31 @@
uses
Classes,
LCLIntf, LCLType, Graphics, ClipBrd,
- SynEditExport;
+ SynEditExport, LCLProc, LazUtf8;
type
THTMLFontSize = (fs01, fs02, fs03, fs04, fs05, fs06, fs07, fsDefault); //eb 2000-10-12
+ TExportHtmlOption = (
+ heoFragmentOnly, //no surrounding ... Note: will exclude heoDoctype, heoCharset
+ heoDoctype, //add doctype declaration
+ heoCharset, //add charset (UTF-8) information
+ heoWinClipHeader //add Clipboard header (affects Windows only) Note: cannot be set if ExportAsText = True!
+ );
+ TExportHtmlOptions = set of TExportHtmlOption;
+
+
+ { TSynExporterHTML }
+
TSynExporterHTML = class(TSynCustomExporter)
private
+ fOptions: TExportHtmlOptions;
fFontSize: THTMLFontSize;
function ColorToHTML(AColor: TColor): string;
+ procedure SetExportHtmlOptions(Value: TExportHtmlOptions);
+ function GetCreateHTMLFragment: Boolean;
+ procedure SetCreateHTMLFragment(Value: Boolean);
protected
- fCreateHTMLFragment: boolean;
procedure FormatAfterLastAttribute; override;
procedure FormatAttributeDone(BackgroundChanged, ForegroundChanged: boolean;
FontStylesChanged: TFontStyles); override;
@@ -70,13 +84,15 @@
function GetFooter: string; override;
function GetFormatName: string; override;
function GetHeader: string; override;
+ procedure SetExportAsText(Value: boolean); override;
public
constructor Create(AOwner: TComponent); override;
published
property Color;
- property CreateHTMLFragment: boolean read fCreateHTMLFragment
- write fCreateHTMLFragment default FALSE;
+ property CreateHTMLFragment: boolean read GetCreateHTMLFragment
+ write SetCreateHTMLFragment default FALSE; deprecated 'Use Options instead';
property DefaultFilter;
+ property Options: TExportHtmlOptions read fOptions write SetExportHtmlOptions default [heoDoctype, heoCharset];
property Font;
property Highlighter;
property HTMLFontSize: THTMLFontSize read fFontSize write fFontSize; //eb 2000-10-12
@@ -90,117 +106,144 @@
SysUtils,
SynEditStrConst;
+const
+ DocType = ''; //cannot use strict, because we use tag
+ Generator = '';
+ CharSet = '';
+ DocumentStart = ''+LineEnding+
+ ''+LineEnding+
+ '%s'+LineEnding+
+ ''+LineEnding+
+ '';
+ DocumentEnd = ''+LineEnding+'';
+ CodeStart = '';
+ CodeEnd = '
';
+ FontStart = '';
+ FontEnd = '';
+ WinClipHeaderFmt = 'Version:0.9' + LineEnding +
+ 'StartHTML:%.8d' + LineEnding +
+ 'EndHTML:%.8d' + LineEnding +
+ 'StartFragment:%.8d' + LineEnding +
+ 'EndFragment:%.8d' + LineEnding;
+
+ StartFragmentComment = '';
+ EndFragmentComment = '';
+
{ TSynExporterHTML }
constructor TSynExporterHTML.Create(AOwner: TComponent);
const
- CF_HTML = 'HTML Format';
+ HTML_Format = {$ifdef windows}'HTML Format'{$else}'text/html'{$endif};
begin
inherited Create(AOwner);
{**************}
- fClipboardFormat := RegisterClipboardFormat(CF_HTML);
+ fClipboardFormat := RegisterClipboardFormat(HTML_Format);
fFontSize := fs03;
+ fOptions := [heoDocType, heoCharset];
fDefaultFilter := SYNS_FilterHTML;
// setup array of chars to be replaced
fReplaceReserved['&'] := '&';
fReplaceReserved['<'] := '<';
fReplaceReserved['>'] := '>';
- fReplaceReserved['"'] := '"';
- fReplaceReserved[''] := '™';
- fReplaceReserved[''] := '©';
- fReplaceReserved[''] := '®';
- fReplaceReserved[''] := 'À';
- fReplaceReserved[''] := 'Á';
- fReplaceReserved[''] := 'Â';
- fReplaceReserved[''] := 'Ã';
- fReplaceReserved[''] := 'Ä';
- fReplaceReserved[''] := 'Å';
- fReplaceReserved[''] := 'Æ';
- fReplaceReserved[''] := 'Ç';
- fReplaceReserved[''] := 'È';
- fReplaceReserved[''] := 'É';
- fReplaceReserved[''] := 'Ê';
- fReplaceReserved[''] := 'Ë';
- fReplaceReserved[''] := 'Ì';
- fReplaceReserved[''] := 'Í';
- fReplaceReserved[''] := 'Î';
- fReplaceReserved[''] := 'Ï';
- fReplaceReserved[''] := 'Ð';
- fReplaceReserved[''] := 'Ñ';
- fReplaceReserved[''] := 'Ò';
- fReplaceReserved[''] := 'Ó';
- fReplaceReserved[''] := 'Ô';
- fReplaceReserved[''] := 'Õ';
- fReplaceReserved[''] := 'Ö';
- fReplaceReserved[''] := 'Ø';
- fReplaceReserved[''] := 'Ù';
- fReplaceReserved[''] := 'Ú';
- fReplaceReserved[''] := 'Û';
- fReplaceReserved[''] := 'Ü';
- fReplaceReserved[''] := 'Ý';
- fReplaceReserved[''] := 'Þ';
- fReplaceReserved[''] := 'ß';
- fReplaceReserved[''] := 'à';
- fReplaceReserved[''] := 'á';
- fReplaceReserved[''] := 'â';
- fReplaceReserved[''] := 'ã';
- fReplaceReserved[''] := 'ä';
- fReplaceReserved[''] := 'å';
- fReplaceReserved[''] := 'æ';
- fReplaceReserved[''] := 'ç';
- fReplaceReserved[''] := 'è';
- fReplaceReserved[''] := 'é';
- fReplaceReserved[''] := 'ê';
- fReplaceReserved[''] := 'ë';
- fReplaceReserved[''] := 'ì';
- fReplaceReserved[''] := 'í';
- fReplaceReserved[''] := 'î';
- fReplaceReserved[''] := 'ï';
- fReplaceReserved[''] := 'ð';
- fReplaceReserved[''] := 'ñ';
- fReplaceReserved[''] := 'ò';
- fReplaceReserved[''] := 'ó';
- fReplaceReserved[''] := 'ô';
- fReplaceReserved[''] := 'õ';
- fReplaceReserved[''] := 'ö';
- fReplaceReserved[''] := 'ø';
- fReplaceReserved[''] := 'ù';
- fReplaceReserved[''] := 'ú';
- fReplaceReserved[''] := 'û';
- fReplaceReserved[''] := 'ü';
- fReplaceReserved[''] := 'ý';
- fReplaceReserved[''] := 'þ';
- fReplaceReserved[''] := 'ÿ';
- fReplaceReserved[''] := '¡';
- fReplaceReserved[''] := '¢';
- fReplaceReserved[''] := '£';
- fReplaceReserved[''] := '¤';
- fReplaceReserved[''] := '¥';
- fReplaceReserved[''] := '¦';
- fReplaceReserved[''] := '§';
- fReplaceReserved[''] := '¨';
- fReplaceReserved[''] := 'ª';
- fReplaceReserved[''] := '«';
- fReplaceReserved[''] := '';
- fReplaceReserved[''] := '¯';
- fReplaceReserved[''] := '°';
- fReplaceReserved[''] := '±';
- fReplaceReserved[''] := '²';
- fReplaceReserved[''] := '³';
- fReplaceReserved[''] := '´';
- fReplaceReserved[''] := 'µ';
- fReplaceReserved[''] := '·';
- fReplaceReserved[''] := '¸';
- fReplaceReserved[''] := '¹';
- fReplaceReserved[''] := 'º';
- fReplaceReserved[''] := '»';
- fReplaceReserved[''] := '¼';
- fReplaceReserved[''] := '½';
- fReplaceReserved[''] := '¾';
- fReplaceReserved[''] := '¿';
- fReplaceReserved[''] := '×';
- fReplaceReserved[''] := '÷';
- fReplaceReserved[''] := '€';
+ //fReplaceReserved['"'] := '"'; //no need to replace this
+ //fReplaceReserved[''''] := '''; //no need to replace this
+{ The following characters are multi-byte in UTF-8:
+ fReplaceReserved['™'] := '™';
+ fReplaceReserved['©'] := '©';
+ fReplaceReserved['®'] := '®';
+ fReplaceReserved['À'] := 'À';
+ fReplaceReserved['Á'] := 'Á';
+ fReplaceReserved['Â'] := 'Â';
+ fReplaceReserved['Ã'] := 'Ã';
+ fReplaceReserved['Ä'] := 'Ä';
+ fReplaceReserved['Å'] := 'Å';
+ fReplaceReserved['Æ'] := 'Æ';
+ fReplaceReserved['Ç'] := 'Ç';
+ fReplaceReserved['È'] := 'È';
+ fReplaceReserved['É'] := 'É';
+ fReplaceReserved['Ê'] := 'Ê';
+ fReplaceReserved['Ë'] := 'Ë';
+ fReplaceReserved['Ì'] := 'Ì';
+ fReplaceReserved['Í'] := 'Í';
+ fReplaceReserved['Î'] := 'Î';
+ fReplaceReserved['Ï'] := 'Ï';
+ fReplaceReserved['Ð'] := 'Ð';
+ fReplaceReserved['Ñ'] := 'Ñ';
+ fReplaceReserved['Ò'] := 'Ò';
+ fReplaceReserved['Ó'] := 'Ó';
+ fReplaceReserved['Ô'] := 'Ô';
+ fReplaceReserved['Õ'] := 'Õ';
+ fReplaceReserved['Ö'] := 'Ö';
+ fReplaceReserved['Ø'] := 'Ø';
+ fReplaceReserved['Ù'] := 'Ù';
+ fReplaceReserved['Ú'] := 'Ú';
+ fReplaceReserved['Û'] := 'Û';
+ fReplaceReserved['Ü'] := 'Ü';
+ fReplaceReserved['Ý'] := 'Ý';
+ fReplaceReserved['Þ'] := 'Þ';
+ fReplaceReserved['ß'] := 'ß';
+ fReplaceReserved['à'] := 'à';
+ fReplaceReserved['á'] := 'á';
+ fReplaceReserved['â'] := 'â';
+ fReplaceReserved['ã'] := 'ã';
+ fReplaceReserved['ä'] := 'ä';
+ fReplaceReserved['å'] := 'å';
+ fReplaceReserved['æ'] := 'æ';
+ fReplaceReserved['ç'] := 'ç';
+ fReplaceReserved['è'] := 'è';
+ fReplaceReserved['é'] := 'é';
+ fReplaceReserved['ê'] := 'ê';
+ fReplaceReserved['ë'] := 'ë';
+ fReplaceReserved['ì'] := 'ì';
+ fReplaceReserved['í'] := 'í';
+ fReplaceReserved['î'] := 'î';
+ fReplaceReserved['ï'] := 'ï';
+ fReplaceReserved['ð'] := 'ð';
+ fReplaceReserved['ñ'] := 'ñ';
+ fReplaceReserved['ò'] := 'ò';
+ fReplaceReserved['ó'] := 'ó';
+ fReplaceReserved['ô'] := 'ô';
+ fReplaceReserved['õ'] := 'õ';
+ fReplaceReserved['ö'] := 'ö';
+ fReplaceReserved['ø'] := 'ø';
+ fReplaceReserved['ù'] := 'ù';
+ fReplaceReserved['ú'] := 'ú';
+ fReplaceReserved['û'] := 'û';
+ fReplaceReserved['ü'] := 'ü';
+ fReplaceReserved['ý'] := 'ý';
+ fReplaceReserved['þ'] := 'þ';
+ fReplaceReserved['ÿ'] := 'ÿ';
+ fReplaceReserved['¡'] := '¡';
+ fReplaceReserved['¢'] := '¢';
+ fReplaceReserved['£'] := '£';
+ fReplaceReserved['¤'] := '¤';
+ fReplaceReserved['¥'] := '¥';
+ fReplaceReserved['¦'] := '¦';
+ fReplaceReserved['§'] := '§';
+ fReplaceReserved['¨'] := '¨';
+ fReplaceReserved['ª'] := 'ª';
+ fReplaceReserved['«'] := '«';
+ fReplaceReserved['¬'] := '';
+ fReplaceReserved['¯'] := '¯';
+ fReplaceReserved['°'] := '°';
+ fReplaceReserved['±'] := '±';
+ fReplaceReserved['²'] := '²';
+ fReplaceReserved['³'] := '³';
+ fReplaceReserved['´'] := '´';
+ fReplaceReserved['µ'] := 'µ';
+ fReplaceReserved['·'] := '·';
+ fReplaceReserved['¸'] := '¸';
+ fReplaceReserved['¹'] := '¹';
+ fReplaceReserved['º'] := 'º';
+ fReplaceReserved['»'] := '»';
+ fReplaceReserved['¼'] := '¼';
+ fReplaceReserved['½'] := '½';
+ fReplaceReserved['¾'] := '¾';
+ fReplaceReserved['¿'] := '¿';
+ fReplaceReserved['×'] := '×';
+ fReplaceReserved['÷'] := '÷';
+ fReplaceReserved['€'] := '€';}
end;
function TSynExporterHTML.ColorToHTML(AColor: TColor): string;
@@ -317,11 +360,15 @@
function TSynExporterHTML.GetFooter: string;
begin
- Result := '';
- if fExportAsText then
- Result := ''#13#10''#13#10;
- if not fCreateHTMLFragment then
- Result := Result + ''#13#10'';
+ Result := FontEnd + LineEnding + CodeEnd;
+ if (heoWinClipHeader in Options) then
+ Result := Result + EndFragmentComment;
+
+ if not (heoFragmentOnly in Options) then
+ begin
+ if (Result <> '') then Result := Result + LineEnding;
+ Result := Result + DocumentEnd;
+ end;
end;
function TSynExporterHTML.GetFormatName: string;
@@ -330,48 +377,101 @@
end;
function TSynExporterHTML.GetHeader: string;
-const
- DescriptionSize = 105;
- HeaderSize = 47;
- FooterSize1 = 58;
- FooterSize2 = 24;
- NativeHeader = 'Version:0.9'#13#10 +
- 'StartHTML:%.10d'#13#10 +
- 'EndHTML:%.10d'#13#10 +
- 'StartFragment:%.10d'#13#10 +
- 'EndFragment:%.10d'#13#10;
- HTMLAsTextHeader = ''#13#10 +
- ''#13#10 +
- '%s'#13#10 +
- ''#13#10 +
- ''#13#10 +
- ''#13#10;
var
sFontSize: string; //eb 2000-10-12
+ DocHeader, HeadText, WinClipHeader, SFooter: String;
+ WinClipHeaderSize, FooterLen: Integer;
begin
Result := '';
- if fExportAsText then begin
- if not fCreateHTMLFragment then
- Result := Format(HTMLAsTextHeader, [Title, ColorToHtml(fFont.Color),
- ColorToHTML(fBackgroundColor)]);
-{begin} //eb 2000-10-12
- if fFontSize <> fsDefault then
- sFontSize := Format(' size=%d', [1 + Ord(fFontSize)])
+ DocHeader := '';
+ if not (heoFragmentOnly in Options) then
+ begin
+ if (heoDocType in fOptions) then
+ DocHeader := DocHeader + DocType + LineEnding;
+ HeadText := Generator;
+ if (heoCharSet in fOptions) then
+ HeadText := HeadText + LineEnding + CharSet;
+ HeadText := HeadText + LineEnding + Format('%s',[Title]);
+ DocHeader := DocHeader + Format(DocumentStart,[HeadText,ColorToHtml(fFont.Color),ColorToHTML(fBackgroundColor)]);
+ if (heoWinClipHeader in fOptions) then
+ DocHeader := DocHeader + LineEnding + StartFragmentComment;
+ DocHeader := DocHeader + CodeStart; //Don't add LineEndings after this point, because of tag
+ end //not heoFragmentOnly
+ else
+ begin
+ if (heoWinClipHeader in fOptions) then
+ DocHeader := DocHeader + StartFragmentComment + CodeStart
else
- sFontSize := '';
- Result := Result + Format(''#13#10'',
- [sFontSize, fFont.Name]);
-{end} //eb 2000-10-12
- end else begin
+ DocHeader := DocHeader + CodeStart;
+ end;
+ if fFontSize <> fsDefault then
+ sFontSize := Format(' size=%d', [1 + Ord(fFontSize)])
+ else
+ sFontSize := '';
+ DocHeader := DocHeader + Format(FontStart,[sFontSize, fFont.Name]);
+
+ if (heoWinClipHeader in fOptions) then
+ begin
+ WinClipHeaderSize := Length(Format(WinClipHeaderFmt,[0,0,0,0]));
+ SFooter := GetFooter;
+ FooterLen := Length(SFooter);
+
+ //debugln(['TSynExporterHtml.GetHeader: WinClipHeaderSize=',WinClipHeadersize]);
+ //debugln([' Footer="',Sfooter,'"']);
+ //debugln([' FooterLen=',FooterLen]);
+ //debugln([' BufferSize=',getBufferSize]);
+ //debugln([' length(docHeader)=',length(docheader)]);
+
// Described in http://msdn.microsoft.com/library/sdkdoc/htmlclip/htmlclipboard.htm
- Result := Format(NativeHeader, [DescriptionSize,
- DescriptionSize + HeaderSize + GetBufferSize + FooterSize1,
- DescriptionSize + HeaderSize,
- DescriptionSize + HeaderSize + GetBufferSize + FooterSize2]);
- if not fCreateHTMLFragment then
- Result := Result + ''#13#10''#13#10'';
- Result := Result + '';
- AddData('
');
+ WinClipHeader := Format(WinClipHeaderFmt,
+ [WinClipHeaderSize, //HtmlStart
+ WinClipHeaderSize + Length(DocHeader) + FooterLen + GetBufferSize - 1, //HtmlEnd
+ WinClipHeaderSize + Utf8Pos(StartFragmentComment, DocHeader) + Length(StartfragmentComment) - 1, //StartFragment
+ WinClipHeaderSize + Length(DocHeader) + Utf8Pos(EndFragmentComment, SFooter) + GetBufferSize - 1 //EndFragment
+ ]);
+ DocHeader := WinClipHeader + DocHeader;
+ end;
+
+ Result := DocHeader;
+end;
+
+procedure TSynExporterHTML.SetExportAsText(Value: boolean);
+begin
+ if (Value <> ExportAsText) then
+ begin
+ inherited SetExportAsText(Value);
+ if Value then
+ fOptions := fOptions - [heoWinClipHeader];
+ end;
+end;
+
+procedure TSynExporterHTML.SetExportHtmlOptions(Value: TExportHtmlOptions);
+begin
+ if (fOptions <> Value) then
+ begin
+ Clear;
+ fOptions := Value;
+ if ExportAsText then fOptions := fOptions - [heoWinClipHeader];
+ if (heoFragmentOnly in Value) then
+ begin
+ fOptions := fOptions - [heoDoctype, heoCharSet];
+ end;
+ end;
+end;
+
+function TSynExporterHTML.GetCreateHTMLFragment: Boolean;
+begin
+ Result := (heoFragmentOnly in fOptions);
+end;
+
+procedure TSynExporterHTML.SetCreateHTMLFragment(Value: Boolean);
+begin
+ if (GetCreateHTMLFragment <> Value) then
+ begin
+ if Value then
+ Options := Options + [heoFragmentOnly]
+ else
+ Options := Options - [heoFragmentOnly];
end;
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synguttercodefolding.pp lazarus-1.6+dfsg/components/synedit/synguttercodefolding.pp
--- lazarus-1.4.4+dfsg/components/synedit/synguttercodefolding.pp 2013-09-11 21:06:27.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synguttercodefolding.pp 2015-03-24 23:13:33.000000000 +0000
@@ -494,14 +494,13 @@
begin
AliasMode := Canvas.AntialiasingMode;
Canvas.AntialiasingMode:=amOff;
+ OdlCosmetic := Canvas.Pen.Cosmetic;
if nsoLostHl in SubType then begin
Canvas.Pen.Style := psDot;
- OdlCosmetic := Canvas.Pen.Cosmetic;
Canvas.Pen.Cosmetic := False;
end;
if nsoBlockSel in SubType then begin
Canvas.Pen.Style := psDash;
- OdlCosmetic := Canvas.Pen.Cosmetic;
Canvas.Pen.Cosmetic := False;
end;
Canvas.Rectangle(Rect);
diff -Nru lazarus-1.4.4+dfsg/components/synedit/syngutterlineoverview.pp lazarus-1.6+dfsg/components/synedit/syngutterlineoverview.pp
--- lazarus-1.4.4+dfsg/components/synedit/syngutterlineoverview.pp 2015-06-08 23:47:17.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/syngutterlineoverview.pp 2015-06-06 11:38:01.000000000 +0000
@@ -542,7 +542,7 @@
begin
if PixelHeight < 1 then exit(0);
- Result := Int64({%H-}ATxtLine - 1) * Int64(PixelHeight) div TextLineCount;
+ Result := (Int64(ATxtLine) - 1) * Int64(PixelHeight) div TextLineCount;
If FPixelPerLine * 2 < ItemHeight then
dec(Result)
@@ -740,7 +740,9 @@
Insert(i, LMarks);
end;
if i >= 0 then
- Result := Items[i];
+ Result := Items[i]
+ else
+ Result := nil;
end;
procedure TSynGutterLOvLineMarksList.SetItemHeight(const AValue: Integer);
diff -Nru lazarus-1.4.4+dfsg/components/synedit/syngutter.pp lazarus-1.6+dfsg/components/synedit/syngutter.pp
--- lazarus-1.4.4+dfsg/components/synedit/syngutter.pp 2013-02-09 02:27:21.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/syngutter.pp 2015-03-24 23:13:33.000000000 +0000
@@ -312,7 +312,9 @@
begin
MouseDownPart := PixelToPartIndex(AnInfo.MouseX);
if MouseDownPart < PartCount then
- Result := Parts[MouseDownPart].MaybeHandleMouseAction(AnInfo, HandleActionProc);
+ Result := Parts[MouseDownPart].MaybeHandleMouseAction(AnInfo, HandleActionProc)
+ else
+ Result := False;
if not Result then
Result := inherited MaybeHandleMouseAction(AnInfo, HandleActionProc);
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterany.pas lazarus-1.6+dfsg/components/synedit/synhighlighterany.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterany.pas 2013-12-14 13:40:04.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterany.pas 2015-07-04 23:08:00.000000000 +0000
@@ -57,7 +57,7 @@
interface
uses
- SysUtils, Classes, FileUtil, Controls, Graphics, Registry,
+ SysUtils, Classes, LazUTF8, LazFileUtils, Controls, Graphics, Registry,
SynEditTypes, SynEditHighlighter;
type
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlightercss.pas lazarus-1.6+dfsg/components/synedit/synhighlightercss.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlightercss.pas 2015-09-29 22:22:25.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlightercss.pas 2015-09-29 00:27:43.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlightercss.pas 49899 2015-09-29 22:22:25Z maxim $
+$Id: synhighlightercss.pas 49890 2015-09-29 00:27:43Z martin $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -57,9 +57,10 @@
type
TtkTokenKind = (tkComment, tkIdentifier, tkKey, tkNull, tkNumber, tkSpace,
- tkString, tkSymbol, tkUnknown);
+ tkString, tkSymbol, tkMeasurementUnit, tkSelector, tkUnknown);
- TRangeState = (rsUnknown, rsCStyle);
+ TRangeState = (rsCStyle, rsInDeclarationBlock);
+ TRangeStates = set of TRangeState;
TProcTableProc = procedure of object;
@@ -67,9 +68,12 @@
TIdentFuncTableFunc = function: TtkTokenKind of object;
type
+
+ { TSynCssSyn }
+
TSynCssSyn = class(TSynCustomHighlighter)
private
- fRange: TRangeState;
+ fRange: TRangeStates;
fLine: PChar;
fLineNumber: Integer;
fProcTable: array[#0..#255] of TProcTableProc;
@@ -86,6 +90,8 @@
fSpaceAttri: TSynHighlighterAttributes;
fStringAttri: TSynHighlighterAttributes;
fSymbolAttri: TSynHighlighterAttributes;
+ fMeasurementUnitAttri: TSynHighlighterAttributes;
+ fSelectorAttri: TSynHighlighterAttributes;
function KeyHash(ToHash: PChar): Integer;
function KeyComp(const aKey: String): Boolean;
function Func16: TtkTokenKind;
@@ -237,11 +243,17 @@
function Func250: TtkTokenKind;
function Func253: TtkTokenKind;
function Func275: TtkTokenKind;
- procedure AsciiCharProc;
+ procedure SymbolProc;
+ procedure ColonProc;
+ procedure SelectorProc;
+ procedure PercentProc;
+ procedure CurlyOpenProc;
+ procedure CurlyCloseProc;
procedure CRProc;
procedure CStyleCommentProc;
procedure DashProc;
procedure IdentProc;
+ procedure HashProc;
procedure IntegerProc;
procedure LFProc;
procedure NullProc;
@@ -293,6 +305,10 @@
write fStringAttri;
property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri
write fSymbolAttri;
+ property MeasurementUnitAttri: TSynHighlighterAttributes read fMeasurementUnitAttri
+ write fMeasurementUnitAttri;
+ property SelectorAttri: TSynHighlighterAttributes read fSelectorAttri
+ write fSelectorAttri;
end;
implementation
@@ -493,7 +509,7 @@
FStringLen := ToHash - FToIdent;
end;
-function TSynCssSyn.KeyComp(const aKey: string): Boolean;
+function TSynCssSyn.KeyComp(const aKey: String): Boolean;
var
iI : Integer;
Temp: PChar;
@@ -514,7 +530,10 @@
function TSynCssSyn.Func16: TtkTokenKind;
begin
- if KeyComp('cm') or KeyComp('deg') then
+ if KeyComp('cm') then
+ Result := tkMeasurementUnit
+ else
+ if KeyComp('deg') then
Result := tkKey
else
Result := tkIdentifier;
@@ -523,14 +542,16 @@
function TSynCssSyn.Func18: TtkTokenKind;
begin
if KeyComp('em') then
- Result := tkKey
+ Result := tkMeasurementUnit
else
Result := tkIdentifier;
end;
function TSynCssSyn.Func19: TtkTokenKind;
begin
- if KeyComp('pc') or KeyComp('s') then
+ if KeyComp('pc') then
+ Result := tkMeasurementUnit
+ else if KeyComp('s') then
Result := tkKey
else
Result := tkIdentifier;
@@ -538,7 +559,10 @@
function TSynCssSyn.Func23: TtkTokenKind;
begin
- if KeyComp('in') or KeyComp('rad') then
+ if KeyComp('in') then
+ Result := tkMeasurementUnit
+ else
+ if KeyComp('rad') then
Result := tkKey
else
Result := tkIdentifier;
@@ -555,15 +579,17 @@
function TSynCssSyn.Func26: TtkTokenKind;
begin
if KeyComp('mm') then
- Result := tkKey
+ Result := tkMeasurementUnit
else
Result := tkIdentifier;
end;
function TSynCssSyn.Func29: TtkTokenKind;
begin
- if KeyComp('page') or KeyComp('cue') or KeyComp('ex') then
+ if KeyComp('page') or KeyComp('cue') then
Result := tkKey
+ else if KeyComp('ex') then
+ Result := tkMeasurementUnit
else
Result := tkIdentifier;
end;
@@ -595,7 +621,7 @@
function TSynCssSyn.Func36: TtkTokenKind;
begin
if KeyComp('pt') then
- Result := tkKey
+ Result := tkMeasurementUnit
else
Result := tkIdentifier;
end;
@@ -610,7 +636,10 @@
function TSynCssSyn.Func40: TtkTokenKind;
begin
- if KeyComp('px') or KeyComp('clip') or KeyComp('src') then
+ if KeyComp('px') then
+ Result := tkMeasurementUnit
+ else
+ if KeyComp('clip') or KeyComp('src') then
Result := tkKey
else
Result := tkIdentifier;
@@ -1746,11 +1775,17 @@
begin
for chI := #0 to #255 do
case chI of
- '{', '}' : FProcTable[chI] := @AsciiCharProc;
+ '{' : FProcTable[chI] := @CurlyOpenProc;
+ '}' : FProcTable[chI] := @CurlyCloseProc;
+ ';' : FProcTable[chI] := @SymbolProc;
+ ':' : FProcTable[chI] := @ColonProc;
+ '.', '*', ',','>','+','~' : FProcTable[chI] := @SelectorProc;
+ '%' : FProcTable[chI] := @PercentProc;
#13 : FProcTable[chI] := @CRProc;
'-' : FProcTable[chI] := @DashProc;
'A'..'Z', 'a'..'z', '_','@' : FProcTable[chI] := @IdentProc;
- '#', '$' : FProcTable[chI] := @IntegerProc;
+ '#' : FProcTable[chI] := @HashProc;
+ '$' : FProcTable[chI] := @IntegerProc;
#10 : FProcTable[chI] := @LFProc;
#0 : FProcTable[chI] := @NullProc;
'0'..'9' : FProcTable[chI] := @NumberProc;
@@ -1782,11 +1817,15 @@
AddAttribute(fStringAttri);
fSymbolAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSymbol, SYNS_XML_AttrSymbol);
AddAttribute(fSymbolAttri);
+ fMeasurementUnitAttri := TSynHighlighterAttributes.Create(@SYNS_AttrMeasurementUnitValue, SYNS_XML_AttrMeasurementUnitValue);
+ AddAttribute(fMeasurementUnitAttri);
+ fSelectorAttri := TSynHighlighterAttributes.Create(@SYNS_AttrSelectorValue, SYNS_XML_AttrSelectorValue);
+ AddAttribute(fSelectorAttri);
SetAttributesOnChange(@DefHighlightChange);
InitIdent;
MakeMethodTables;
fDefaultFilter := SYNS_FilterCSS;
- fRange := rsUnknown;
+ fRange := [];
end;
procedure TSynCssSyn.SetLine(const NewValue: String; LineNumber: Integer);
@@ -1798,12 +1837,54 @@
Next;
end;
-procedure TSynCssSyn.AsciiCharProc;
+procedure TSynCssSyn.SymbolProc;
begin
- FTokenID := tkString;
+ if rsInDeclarationBlock in fRange then
+ FTokenID := tkSymbol
+ else
+ FTokenID := tkIdentifier;
+ Inc(Run);
+end;
+
+procedure TSynCssSyn.ColonProc;
+begin
+ if not(rsInDeclarationBlock in fRange) then
+ FTokenID := tkSelector
+ else
+ FTokenID := tkSymbol;
Inc(Run);
- while FLine[Run] in ['0'..'9'] do
- Inc(Run);
+end;
+
+procedure TSynCssSyn.SelectorProc;
+begin
+ if not(rsInDeclarationBlock in fRange) then
+ FTokenID := tkSelector
+ else
+ FTokenID := tkIdentifier;
+ Inc(Run);
+end;
+
+procedure TSynCssSyn.PercentProc;
+begin
+ if rsInDeclarationBlock in fRange then
+ FTokenID := tkMeasurementUnit
+ else
+ FTokenID := tkIdentifier;
+ Inc(Run);
+end;
+
+procedure TSynCssSyn.CurlyOpenProc;
+begin
+ FTokenID := tkSymbol;
+ Inc(Run);
+ fRange := fRange + [rsInDeclarationBlock];
+end;
+
+procedure TSynCssSyn.CurlyCloseProc;
+begin
+ FTokenID := tkSymbol;
+ Inc(Run);
+ fRange := fRange - [rsInDeclarationBlock];
end;
procedure TSynCssSyn.CRProc;
@@ -1822,7 +1903,7 @@
FTokenID := tkComment;
repeat
if (fLine[Run] = '*') and (fLine[Run + 1] = '/') then begin
- FRange := rsUnKnown;
+ FRange := fRange - [rsCStyle];
Inc(Run, 2);
Break;
end;
@@ -1853,9 +1934,25 @@
Inc(Run);
end;
+procedure TSynCssSyn.HashProc;
+begin
+ if (rsInDeclarationBlock in fRange) then begin
+ IntegerProc;
+ exit;
+ end;
+
+ Inc(Run);
+ FTokenID := tkSelector;
+end;
+
procedure TSynCssSyn.IntegerProc;
begin
Inc(Run);
+ if not(rsInDeclarationBlock in fRange) then begin
+ FTokenID := tkIdentifier;
+ exit;
+ end;
+
FTokenID := tkNumber;
while FLine[Run] in ['0'..'9', 'A'..'F', 'a'..'f'] do
Inc(Run);
@@ -1895,12 +1992,12 @@
Inc(Run);
if fLine[Run] = '*' then begin
FTokenID := tkComment;
- FRange := rsCStyle;
+ FRange := fRange + [rsCStyle];
Inc(Run);
if not (FLine[Run] in [#0, #10, #13]) then
CStyleCommentProc;
end else
- FTokenID := tkSymbol;
+ FTokenID := tkIdentifier;
end;
procedure TSynCssSyn.SpaceProc;
@@ -1942,13 +2039,13 @@
procedure TSynCssSyn.Next;
begin
FTokenPos := Run;
- if FRange = rsCStyle then
+ if rsCStyle in fRange then
CStyleCommentProc
else
FProcTable[FLine[Run]]();
end;
-function TSynCssSyn.GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes;
+function TSynCssSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
begin
case Index of
SYN_ATTR_COMMENT : Result := FCommentAttri;
@@ -1970,7 +2067,7 @@
function TSynCssSyn.GetRange: Pointer;
begin
- Result := Pointer(PtrInt(fRange));
+ Result := {%H-}Pointer(Integer(fRange));
end;
function TSynCssSyn.GetToken: string;
@@ -2003,6 +2100,8 @@
tkSpace : Result := FSpaceAttri;
tkString : Result := FStringAttri;
tkSymbol : Result := FSymbolAttri;
+ tkMeasurementUnit: Result := fMeasurementUnitAttri;
+ tkSelector : Result := fSelectorAttri;
tkUnknown : Result := FIdentifierAttri;
else
Result := nil;
@@ -2021,12 +2120,12 @@
procedure TSynCssSyn.ReSetRange;
begin
- FRange := rsUnknown;
+ FRange := [];
end;
procedure TSynCssSyn.SetRange(Value: Pointer);
begin
- FRange := TRangeState(PtrUInt(Value));
+ FRange := TRangeStates({%H-}Cardinal(Value));
end;
function TSynCssSyn.GetIdentChars: TSynIdentChars;
@@ -2049,7 +2148,7 @@
'}';
end;
-function TSynCSSSyn.KeyHash2(ToHash: PChar): Integer;
+function TSynCssSyn.KeyHash2(ToHash: PChar): Integer;
begin
Result := KeyHash(ToHash);
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterhtml.pp lazarus-1.6+dfsg/components/synedit/synhighlighterhtml.pp
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterhtml.pp 2015-09-29 22:22:25.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterhtml.pp 2015-09-29 00:25:46.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlighterhtml.pp 49899 2015-09-29 22:22:25Z maxim $
+$Id: synhighlighterhtml.pp 49889 2015-09-29 00:25:46Z martin $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -2769,7 +2769,7 @@
function TSynHTMLSyn.StartHtmlNodeCodeFoldBlock(ABlockType: THtmlCodeFoldBlockType;
OpenPos: Integer; AName: String): TSynCustomCodeFoldBlock;
begin
- if not FFoldConfig[ord(cfbtHtmlNode)].Enabled then exit;
+ if not FFoldConfig[ord(cfbtHtmlNode)].Enabled then exit(nil);
Result := inherited StartXmlNodeCodeFoldBlock(ord(ABlockType), OpenPos, AName);
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterjava.pas lazarus-1.6+dfsg/components/synedit/synhighlighterjava.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterjava.pas 2014-09-30 23:57:55.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterjava.pas 2015-03-14 10:42:05.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlighterjava.pas 46388 2014-09-30 23:57:55Z martin $
+$Id: synhighlighterjava.pas 48339 2015-03-14 10:42:05Z sekelsenmat $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -88,7 +88,6 @@
FTokenID: TtkTokenKind;
FExtTokenID: TxtkTokenKind;
fEol: Boolean;
- fIdentFuncTable: array[0..172] of TIdentFuncTableFunc;
fLineNumber: Integer;
fCommentAttri: TSynHighlighterAttributes;
fDocumentAttri: TSynHighlighterAttributes;
@@ -100,8 +99,6 @@
fStringAttri: TSynHighlighterAttributes;
fSymbolAttri: TSynHighlighterAttributes;
fAnnotationAttri: TSynHighlighterAttributes;
- function KeyHash(ToHash: PChar): Integer;
- function KeyComp(const aKey: String): Boolean;
function Func17: TtkTokenKind;
function Func21: TtkTokenKind;
function Func32: TtkTokenKind;
@@ -183,11 +180,14 @@
procedure TildeProc;
procedure XOrSymbolProc;
procedure UnknownProc;
- function AltFunc: TtkTokenKind;
- procedure InitIdent;
function IdentKind(MayBe: PChar): TtkTokenKind;
procedure MakeMethodTables;
protected
+ fIdentFuncTable: array[0..172] of TIdentFuncTableFunc;
+ function AltFunc: TtkTokenKind;
+ function KeyHash(ToHash: PChar): Integer;
+ function KeyComp(const aKey: String): Boolean;
+ procedure InitIdent; virtual;
function GetIdentChars: TSynIdentChars; override;
function GetSampleSource: string; override;
function GetExtTokenID: TxtkTokenKind;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterlfm.pas lazarus-1.6+dfsg/components/synedit/synhighlighterlfm.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterlfm.pas 2015-05-18 23:05:43.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterlfm.pas 2015-05-18 20:43:25.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlighterlfm.pas 49102 2015-05-18 23:05:43Z martin $
+$Id: synhighlighterlfm.pas 49091 2015-05-18 20:43:25Z martin $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlightermulti.pas lazarus-1.6+dfsg/components/synedit/synhighlightermulti.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlightermulti.pas 2013-06-14 21:41:35.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlightermulti.pas 2015-03-24 23:13:33.000000000 +0000
@@ -713,7 +713,9 @@
NewVLine := NewVLine + s.EndPos.y - s.StartPos.y;
LastEnd := s.EndPos.y;
end;
- end;
+ end
+ else
+ LastVline := 0; // ToDo: Initialize LastVline properly.
if VDiff = 0 then
VDiff := Count - FRScanStartedWithLineCount;
if VDiff < 0 then begin
@@ -1141,7 +1143,9 @@
CurRegStart.y := 0;
CurRegStart.x := 1;
CurRegTokenPos := 1;
- end;
+ end
+ else
+ CurRegTokenPos := 0;
StartAtLineIndex(Result); // Set FCurScheme
dec(Result);
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterpas.pp lazarus-1.6+dfsg/components/synedit/synhighlighterpas.pp
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterpas.pp 2014-09-30 14:04:46.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterpas.pp 2015-11-12 17:01:27.000000000 +0000
@@ -28,7 +28,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlighterpas.pp 46372 2014-09-30 14:04:46Z martin $
+$Id: synhighlighterpas.pp 50323 2015-11-12 17:01:27Z ondrej $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -78,6 +78,7 @@
// we need to detect: type TFoo = procedure; // must not fold
// var foo: procedure; // must not fold
rsAfterEqualOrColon, // very first word after "=" or ":"
+ rsAfterEqual, // between "=" and ";" (or block end) // a ^ means ctrl-char, not pointer to type
// Detect if class/object is type TFoo = class; // forward declaration
// TBar = class of TFoo;
@@ -85,14 +86,17 @@
// Also included after class modifiers "sealed" and "abstract"
rsAtClass,
rsAfterClass,
+ rsAfterIdentifierOrValue, // anywhere where a ^ deref can happen "foo^", "foo^^", "foo()^", "foo[]^"
+ rsAfterIdentifierOrValueAdd,
rsAtClosingBracket, // ')'
rsAtCaseLabel,
rsInProcHeader, // Declaration or implementation header of a Procedure, function, constructor...
rsAfterClassMembers, // Encountered a procedure, function, property, constructor or destructor in a class
rsAfterClassField, // after ";" of a field (static needs highlight)
- rsVarTypeInSpecification // between ":"/"=" and ";" in a var or type section (or class members)
- // var a: Integer; type b = Int64;
+ rsVarTypeInSpecification, // between ":"/"=" and ";" in a var or type section (or class members)
+ // var a: Integer; type b = Int64;
+ rsInTypeBlock
);
TRangeStates = set of TRangeState;
@@ -450,6 +454,7 @@
procedure OctalProc;
procedure LFProc;
procedure LowerProc;
+ procedure CaretProc;
procedure NullProc;
procedure NumberProc;
procedure PointProc;
@@ -1374,6 +1379,7 @@
if TopPascalCodeFoldBlockType in [cfbtProcedure]
then StartPascalCodeFoldBlock(cfbtLocalVarType)
else StartPascalCodeFoldBlock(cfbtVarType);
+ fRange := fRange + [rsInTypeBlock];
end;
Result := tkKey;
end
@@ -2283,8 +2289,9 @@
'0'..'9': fProcTable[I] := @NumberProc;
'A'..'Z', 'a'..'z', '_':
fProcTable[I] := @IdentProc;
+ '^': fProcTable[I] := @CaretProc;
'{': fProcTable[I] := @BraceOpenProc;
- '}', '!', '"', '('..'/', ':'..'@', '['..'^', '`', '~':
+ '}', '!', '"', '('..'/', ':'..'@', '[', ']', '\', '`', '~':
begin
case I of
'(': fProcTable[I] := @RoundOpenProc;
@@ -2737,6 +2744,36 @@
if fLine[Run] in ['=', '>'] then inc(Run);
end;
+procedure TSynPasSyn.CaretProc;
+var
+ t: TPascalCodeFoldBlockType;
+begin
+ inc(Run);
+ fTokenID := tkSymbol;
+
+ t := TopPascalCodeFoldBlockType;
+ if ( (t in PascalStatementBlocks - [cfbtAsm]) or //cfbtClass, cfbtClassSection,
+ ( ( (t in [cfbtVarType, cfbtLocalVarType]) or
+ ((t in [cfbtProcedure]) and (PasCodeFoldRange.BracketNestLevel > 0))
+ ) and
+ (fRange * [rsInTypeBlock, rsAfterEqual] = [rsAfterEqual])
+ )) and
+ not(rsAfterIdentifierOrValue in fRange)
+ then begin
+ if Run []) then
@@ -2861,6 +2899,7 @@
begin
inc(Run);
fTokenID := tkSymbol;
+ fRange := fRange + [rsAfterIdentifierOrValueAdd];
PasCodeFoldRange.DecBracketNestLevel;
end;
@@ -2868,7 +2907,7 @@
begin
inc(Run);
fTokenID := tkSymbol;
- fRange := fRange + [rsAfterEqualOrColon];
+ fRange := fRange + [rsAfterEqualOrColon, rsAfterEqual];
if (TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType, cfbtClass, cfbtClassSection, cfbtRecord]) and
not(rsAfterClassMembers in fRange)
then
@@ -2906,7 +2945,7 @@
(PasCodeFoldRange.BracketNestLevel = 0)
then
fRange := fRange - [rsProperty, rsInProcHeader];
- fRange := fRange - [rsVarTypeInSpecification];
+ fRange := fRange - [rsVarTypeInSpecification, rsAfterEqual];
end;
procedure TSynPasSyn.SlashProc;
@@ -3029,18 +3068,17 @@
if (FTokenID = tkKey) then
fRange := fRange - [rsAtCaseLabel];
end;
+
if not (FTokenID in [tkSpace, tkComment, tkIDEDirective, tkDirective]) then begin
if (PasCodeFoldRange.BracketNestLevel = 0) and
not(rsAtClosingBracket in fRange)
then
fRange := fRange - [rsAfterClass];
- if rsAfterEqualOrColon in FOldRange then
- fRange := fRange - [rsAfterEqualOrColon];
- if rsAtPropertyOrReadWrite in FOldRange then
- fRange := fRange - [rsAtPropertyOrReadWrite];
- fRange := fRange - [rsAtClosingBracket];
- if rsAfterClassField in FOldRange then
- fRange := fRange - [rsAfterClassField];
+
+ fRange := fRange -
+ (FOldRange * [rsAfterEqualOrColon, rsAtPropertyOrReadWrite, rsAfterClassField, rsAfterIdentifierOrValue]) -
+ [rsAtClosingBracket];
+
if rsAtClass in fRange then begin
if FOldRange * [rsAtClass, rsAfterClass] <> [] then
fRange := fRange + [rsAfterClass] - [rsAtClass]
@@ -3053,6 +3091,9 @@
if rsAtClass in fRange then
fRange := fRange + [rsAfterClass];
end;
+
+ if (FTokenID = tkIdentifier) or (rsAfterIdentifierOrValueAdd in fRange) then
+ fRange := fRange + [rsAfterIdentifierOrValue] - [rsAfterIdentifierOrValueAdd];
end
end;
if FAtLineStart and not(FTokenID in [tkSpace, tkComment, tkIDEDirective]) then
@@ -3720,7 +3761,7 @@
begin
BlockEnabled := FFoldConfig[ord(ABlockType)].Enabled;
if (not BlockEnabled) and OnlyEnabled then
- exit;
+ exit(nil);
FoldBlock := BlockEnabled and (FFoldConfig[ord(ABlockType)].Modes * [fmFold, fmHide] <> []);
p := 0;
if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet
@@ -3745,6 +3786,9 @@
nd: TSynFoldNodeInfo;
begin
BlockType := TopPascalCodeFoldBlockType;
+ if BlockType in [cfbtVarType, cfbtLocalVarType] then
+ fRange := fRange - [rsInTypeBlock];
+ fRange := fRange - [rsAfterEqual];
DecreaseLevel := TopCodeFoldBlockType < CountPascalCodeFoldBlockOffset;
if FCatchNodeInfo then begin // exclude subblocks, because they do not increase the foldlevel yet
BlockEnabled := FFoldConfig[ord(BlockType)].Enabled;
@@ -4182,7 +4226,7 @@
function TSynPasSyn.GetIdentChars: TSynIdentChars;
begin
- Result := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
+ Result := ['&', '_', '0'..'9', 'a'..'z', 'A'..'Z'];
end;
class function TSynPasSyn.GetLanguageName: string;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterpike.pas lazarus-1.6+dfsg/components/synedit/synhighlighterpike.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterpike.pas 1970-01-01 00:00:00.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterpike.pas 2015-03-15 10:27:56.000000000 +0000
@@ -0,0 +1,421 @@
+{-------------------------------------------------------------------------------
+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: SynHighlighterJava.pas, released 2000-04-10.
+The Original Code is based on the DcjSynJava.pas file from the
+mwEdit component suite by Martin Waldenburg and other developers, the Initial
+Author of this file is Michael Trier.
+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.
+
+$Id: synhighlighterjava.pas 46388 2014-09-30 23:57:55Z martin $
+
+You may retrieve the latest version of this file at the SynEdit home page,
+located at http://SynEdit.SourceForge.net
+
+Known Issues:
+-------------------------------------------------------------------------------}
+{
+@abstract(Provides a Pike highlighter for SynEdit)
+@author(Felipe Monteiro de Carvalho)
+@created(March 2015)
+@lastmod(2015-03-14)
+The SynHighlighterPike unit provides SynEdit with a Pike source (.pike) highlighter.
+}
+unit synhighlighterpike;
+
+{$I SynEdit.inc}
+
+interface
+
+uses
+ SysUtils, Classes,
+ LCLIntf, LCLType, Graphics,
+ SynEditHighlighter, synhighlighterjava;
+
+type
+ TSynPikeSyn = class(TSynJavaSyn)
+ private
+ function Func17: TtkTokenKind;
+ function Func21: TtkTokenKind;
+ function Func32: TtkTokenKind;
+ function Func34: TtkTokenKind;
+ function Func39: TtkTokenKind;
+ function Func40: TtkTokenKind;
+ function Func42: TtkTokenKind;
+ function Func45: TtkTokenKind;
+ function Func46: TtkTokenKind;
+ function Func47: TtkTokenKind;
+ function Func48: TtkTokenKind;
+ function Func54: TtkTokenKind;
+ function Func55: TtkTokenKind;
+ function Func57: TtkTokenKind;
+ function Func59: TtkTokenKind;
+ function Func60: TtkTokenKind;
+ function Func61: TtkTokenKind;
+ function Func62: TtkTokenKind;
+ function Func63: TtkTokenKind;
+ function Func66: TtkTokenKind;
+ function Func68: TtkTokenKind;
+ function Func69: TtkTokenKind;
+ function Func76: TtkTokenKind;
+ function Func78: TtkTokenKind;
+ function Func79: TtkTokenKind;
+ function Func83: TtkTokenKind;
+ function Func86: TtkTokenKind;
+ function Func88: TtkTokenKind;
+ function Func89: TtkTokenKind;
+ function Func90: TtkTokenKind;
+ function Func92: TtkTokenKind;
+ function Func93: TtkTokenKind;
+ function Func95: TtkTokenKind;
+ function Func97: TtkTokenKind;
+ function Func98: TtkTokenKind;
+ function Func102: TtkTokenKind;
+ function Func109: TtkTokenKind;
+ function Func110: TtkTokenKind;
+ function Func114: TtkTokenKind;
+ function Func115: TtkTokenKind;
+ function Func119: TtkTokenKind;
+ function Func127: TtkTokenKind;
+ function Func136: TtkTokenKind;
+ function Func172: TtkTokenKind;
+ protected
+ procedure InitIdent; override;
+ function GetSampleSource: string; override;
+ public
+ class function Pike_GetSampleSource: string;
+ class function GetLanguageName: string; override;
+ end;
+
+implementation
+
+uses
+ SynEditStrConst;
+
+procedure TSynPikeSyn.InitIdent;
+var
+ I: Integer;
+begin
+ for I := 0 to 172 do
+ Case I of
+ 17: fIdentFuncTable[I] := @Func17;
+ 21: fIdentFuncTable[I] := @Func21;
+ 32: fIdentFuncTable[I] := @Func32;
+ 34: fIdentFuncTable[I] := @Func34;
+ 39: fIdentFuncTable[I] := @Func39;
+ 40: fIdentFuncTable[I] := @Func40;
+ 42: fIdentFuncTable[I] := @Func42;
+ 45: fIdentFuncTable[I] := @Func45;
+ 46: fIdentFuncTable[I] := @Func46;
+ 47: fIdentFuncTable[I] := @Func47;
+ 48: fIdentFuncTable[I] := @Func48;
+ 54: fIdentFuncTable[I] := @Func54;
+ 55: fIdentFuncTable[I] := @Func55;
+ 57: fIdentFuncTable[I] := @Func57;
+ 59: fIdentFuncTable[I] := @Func59;
+ 60: fIdentFuncTable[I] := @Func60;
+ 61: fIdentFuncTable[I] := @Func61;
+ 62: fIdentFuncTable[I] := @Func62;
+ 63: fIdentFuncTable[I] := @Func63;
+ 66: fIdentFuncTable[I] := @Func66;
+ 68: fIdentFuncTable[I] := @Func68;
+ 69: fIdentFuncTable[I] := @Func69;
+ 76: fIdentFuncTable[I] := @Func76;
+ 78: fIdentFuncTable[I] := @Func78;
+ 79: fIdentFuncTable[I] := @Func79;
+ 83: fIdentFuncTable[I] := @Func83;
+ 86: fIdentFuncTable[I] := @Func86;
+ 88: fIdentFuncTable[I] := @Func88;
+ 89: fIdentFuncTable[I] := @Func89;
+ 90: fIdentFuncTable[I] := @Func90;
+ 92: fIdentFuncTable[I] := @Func92;
+ 93: fIdentFuncTable[I] := @Func93;
+ 95: fIdentFuncTable[I] := @Func95;
+ 97: fIdentFuncTable[I] := @Func97;
+ 98: fIdentFuncTable[I] := @Func98;
+ 102: fIdentFuncTable[I] := @Func102;
+ 109: fIdentFuncTable[I] := @Func109;
+ 110: fIdentFuncTable[I] := @Func110;
+ 114: fIdentFuncTable[I] := @Func114;
+ 115: fIdentFuncTable[I] := @Func115;
+ 119: fIdentFuncTable[I] := @Func119;
+ 127: fIdentFuncTable[I] := @Func127;
+ 136: fIdentFuncTable[I] := @Func136;
+ 172: fIdentFuncTable[I] := @Func172;
+ else fIdentFuncTable[I] := @AltFunc;
+ end;
+end;
+
+function TSynPikeSyn.Func17: TtkTokenKind;
+begin
+ if KeyComp('if') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func21: TtkTokenKind;
+begin
+ if KeyComp('do') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func32: TtkTokenKind;
+begin
+ if KeyComp('case') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func34: TtkTokenKind;
+begin
+ if KeyComp('char') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func39: TtkTokenKind;
+begin
+ if KeyComp('lambda') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func40: TtkTokenKind;
+begin
+ if KeyComp('catch') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func42: TtkTokenKind;
+begin
+ if KeyComp('for') then Result := tkKey else
+ if KeyComp('break') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func45: TtkTokenKind;
+begin
+ if KeyComp('else') or KeyComp('new') then
+ Result := tkKey
+ else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func46: TtkTokenKind;
+begin
+ if KeyComp('int') or KeyComp('gauge') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func47: TtkTokenKind;
+begin
+ if KeyComp('final') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func48: TtkTokenKind;
+begin
+ if KeyComp('false') or KeyComp('local') or KeyComp('bool') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func54: TtkTokenKind;
+begin
+ if KeyComp('void') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func55: TtkTokenKind;
+begin
+ if KeyComp('global') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func57: TtkTokenKind;
+begin
+ if KeyComp('enum') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func59: TtkTokenKind;
+begin
+ if KeyComp('class') or KeyComp('float') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func60: TtkTokenKind;
+begin
+ if KeyComp('this') or KeyComp('mixed') or KeyComp('prefed') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func61: TtkTokenKind;
+begin
+ if KeyComp('goto') or KeyComp('object') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func62: TtkTokenKind;
+begin
+ if KeyComp('while') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func63: TtkTokenKind;
+begin
+ if KeyComp('null') or KeyComp('foreach') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func66: TtkTokenKind;
+begin
+ if KeyComp('try') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func68: TtkTokenKind;
+begin
+ if KeyComp('true') or KeyComp('array') or KeyComp('sscanf') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func69: TtkTokenKind;
+begin
+ if KeyComp('public') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func76: TtkTokenKind;
+begin
+ if KeyComp('default') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func78: TtkTokenKind;
+begin
+ if KeyComp('static') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func79: TtkTokenKind;
+begin
+ if KeyComp('nomask') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func83: TtkTokenKind;
+begin
+ if KeyComp('mapping') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func86: TtkTokenKind;
+begin
+ if KeyComp('finally') or KeyComp('sizeof') or KeyComp('inline') then
+ Result := tkKey
+ else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func88: TtkTokenKind;
+begin
+ if KeyComp('switch') or KeyComp('typedef') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func89: TtkTokenKind;
+begin
+ if KeyComp('throw') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func90: TtkTokenKind;
+begin
+ if KeyComp('inherit') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func92: TtkTokenKind;
+begin
+ if KeyComp('variant') or KeyComp('extern') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func93: TtkTokenKind;
+begin
+ if KeyComp('string') or KeyComp('typeof') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func95: TtkTokenKind;
+begin
+ if KeyComp('program') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func97: TtkTokenKind;
+begin
+ if KeyComp('import') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func98: TtkTokenKind;
+begin
+ if KeyComp('private') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func102: TtkTokenKind;
+begin
+ if KeyComp('return') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func109: TtkTokenKind;
+begin
+ if KeyComp('continue') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func110: TtkTokenKind;
+begin
+ if KeyComp('function') or KeyComp('optional') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func114: TtkTokenKind;
+begin
+ if KeyComp('constant') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func115: TtkTokenKind;
+begin
+ if KeyComp('protected') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func119: TtkTokenKind;
+begin
+ if KeyComp('strictfp') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func127: TtkTokenKind;
+begin
+ if KeyComp('multiset') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func136: TtkTokenKind;
+begin
+ if KeyComp('implements') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.Func172: TtkTokenKind;
+begin
+ if KeyComp('synchronized') then Result := tkKey else Result := tkIdentifier;
+end;
+
+function TSynPikeSyn.GetSampleSource: string;
+begin
+ Result := Pike_GetSampleSource();
+end;
+
+class function TSynPikeSyn.Pike_GetSampleSource: string;
+begin
+ Result := '/* Pike syntax highlighting */'#13#10 +
+ 'int main()'#13#10 +
+ '{'#13#10 +
+ ' array(string) words = ({ "first", "second" });'#13#10 +
+ ' foreach(words, string cur_word)'#13#10 +
+ ' write("%O\n", cur_word);'#13#10 +
+ ' return 0;'#13#10 +
+ '}'#13#10 +
+ '/* Text Block */'#13#10 + #13#10;
+end;
+
+class function TSynPikeSyn.GetLanguageName: string;
+begin
+ Result := SYNS_LangPike;
+end;
+
+initialization
+ RegisterPlaceableHighlighter(TSynPikeSyn);
+
+end.
+
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterpo.pp lazarus-1.6+dfsg/components/synedit/synhighlighterpo.pp
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterpo.pp 2013-06-14 21:41:35.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterpo.pp 2015-12-24 15:05:23.000000000 +0000
@@ -359,7 +359,7 @@
function TSynPoSyn.GetIdentChars: TSynIdentChars;
begin
- Result := inherited GetIdentChars; //TSynValidStringChars;
+ Result := [#33..#255];
end;
class function TSynPoSyn.GetLanguageName: string;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlightertex.pas lazarus-1.6+dfsg/components/synedit/synhighlightertex.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlightertex.pas 2013-06-14 21:41:35.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlightertex.pas 2015-02-06 18:25:31.000000000 +0000
@@ -25,7 +25,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlightertex.pas 41721 2013-06-14 21:41:35Z mattias $
+$Id: synhighlightertex.pas 47604 2015-02-06 18:25:31Z juha $
You may retrieve the latest version of this file from sproessig@bs-webdesign.de
@@ -42,7 +42,7 @@
uses
SysUtils, Classes,
- LCLProc, LCLIntf, LCLType,
+ LCLIntf, LCLType, LazUTF8,
Controls, Graphics,
SynEditTypes, SynEditHighlighter;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synhighlighterxml.pas lazarus-1.6+dfsg/components/synedit/synhighlighterxml.pas
--- lazarus-1.4.4+dfsg/components/synedit/synhighlighterxml.pas 2013-06-14 21:41:35.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synhighlighterxml.pas 2015-03-24 17:50:59.000000000 +0000
@@ -25,7 +25,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synhighlighterxml.pas 41721 2013-06-14 21:41:35Z mattias $
+$Id: synhighlighterxml.pas 48478 2015-03-24 17:50:59Z juha $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -962,7 +962,7 @@
function TSynXMLSyn.StartXmlNodeCodeFoldBlock(ABlockType: TXmlCodeFoldBlockType;
OpenPos: Integer; AName: String): TSynCustomCodeFoldBlock;
begin
- if not FFoldConfig[ord(cfbtXmlNode)].Enabled then exit;
+ if not FFoldConfig[ord(cfbtXmlNode)].Enabled then exit(nil);
Result := inherited StartXmlNodeCodeFoldBlock(ord(ABlockType), OpenPos, AName);
end;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synmemo.pas lazarus-1.6+dfsg/components/synedit/synmemo.pas
--- lazarus-1.4.4+dfsg/components/synedit/synmemo.pas 2014-05-04 22:32:14.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synmemo.pas 2015-03-31 22:52:08.000000000 +0000
@@ -27,7 +27,7 @@
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
-$Id: synmemo.pas 44913 2014-05-04 22:32:14Z bart $
+$Id: synmemo.pas 48565 2015-03-31 22:52:08Z martin $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
@@ -58,7 +58,7 @@
function RowColToCharIndex(RowCol: TPoint): integer; //as 2000-11-09
procedure Append(const Value: String);
procedure Clear;
- end;
+ end deprecated 'use SynEdit instead';
TSynMemo = class(TCustomSynMemo)
{begin} //mh 2000-09-23
@@ -113,12 +113,15 @@
property InsertMode;
property Keystrokes;
property MouseActions;
+ property MouseTextActions;
property MouseSelActions;
property Lines;
property MaxLeftChar;
property MaxUndo;
property Options;
property Options2;
+ property MouseOptions;
+ property VisibleSpecialChars;
property OverwriteCaret;
property ReadOnly;
property RightEdge;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synpluginmulticaret.pp lazarus-1.6+dfsg/components/synedit/synpluginmulticaret.pp
--- lazarus-1.4.4+dfsg/components/synedit/synpluginmulticaret.pp 1970-01-01 00:00:00.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synpluginmulticaret.pp 2015-03-24 23:13:33.000000000 +0000
@@ -0,0 +1,2782 @@
+unit SynPluginMultiCaret;
+
+{$mode objfpc}{$H+}
+
+{$DEFINE SynMultiCaretAssert}
+{off $DEFINE SynMultiCaretDebug}
+
+{$IfDef SynMultiCaretAssert}
+ {$ASSERTIONS on}
+{$ENDIF}
+{ $INLINE off}
+interface
+
+uses
+ Classes, SysUtils, SynEdit, SynEditPointClasses, SynEditKeyCmds, SynEditTypes,
+ LazSynTextArea, SynEditMiscProcs, LazSynEditText, SynEditMiscClasses, SynEditMouseCmds,
+ SynEditStrConst, SynEditTextTrimmer, SynEditTextBase,
+ {$IfDef SynMultiCaretDebug} LazLoggerBase, {$ELSE} LazLoggerDummy, {$ENDIF}
+ LCLType, Controls, Graphics, Clipbrd;
+
+const
+
+ emcPluginMultiCaretToggleCaret = emcPluginFirstMultiCaret + 0;
+ emcPluginMultiCaretSelectionToCarets = emcPluginFirstMultiCaret + 1;
+
+ ecPluginMultiCaretSetCaret = ecPluginFirstMultiCaret + 0;
+ ecPluginMultiCaretUnsetCaret = ecPluginFirstMultiCaret + 1;
+ ecPluginMultiCaretToggleCaret = ecPluginFirstMultiCaret + 2;
+ ecPluginMultiCaretClearAll = ecPluginFirstMultiCaret + 3;
+
+ ecPluginMultiCaretModeCancelOnMove = ecPluginFirstMultiCaret + 4;
+ ecPluginMultiCaretModeMoveAll = ecPluginFirstMultiCaret + 5;
+
+ // last
+ ecPluginLastMultiCaret = ecPluginFirstMultiCaret + 5;
+
+const
+ EMPTY_LIST_LEN = 8;
+
+type
+
+ TSynMultiCaretCommandAction = (
+ ccaDefaultAction, // build in default, if any
+ ccaNoneRepeatCommand, // Run Command (onc), clear carets IF any changes (text,selection,main-caret)
+ ccaRepeatCommand, // Repeat the command for each caret
+ ccaRepeatCommandPerLine, // Repeat the command for the first caret on each line
+ ccaClearCarets, // Always Clear all carets
+ ccaAdjustCarets // Run the command once (for main-caret), keep and adjust all carets
+ );
+ TSynMultiCaretCommandFlag = ( // for extension
+ ccfDummy // do not use
+ );
+ TSynMultiCaretCommandFlags = set of TSynMultiCaretCommandFlag;
+
+ TSynMultiCaretBeforeCommand = procedure(Sender: TObject;
+ ACommand: TSynEditorCommand;
+ var AnAction: TSynMultiCaretCommandAction;
+ var AFlags: TSynMultiCaretCommandFlags) of object;
+
+ TLogCaretPointArray = Array of TLogCaretPoint;
+ TSynPluginMultiCaretVisualList = class;
+
+ { TSynPluginMultiCaretVisual }
+
+ TSynPluginMultiCaretVisual = class(TSynEditScreenCaret)
+ private
+ FListIndex: Integer;
+ FUsedList: TSynPluginMultiCaretVisualList;
+ FUnUsedList: TSynPluginMultiCaretVisualList;
+ {$IfDef SynMultiCaretAssert}
+ FIsUsed: Boolean;
+ {$ENDIF}
+ public
+ constructor Create(AHandleOwner: TWinControl;
+ APainterClass: TSynEditScreenCaretPainterClass;
+ AnUsedList, AnUnUsedList: TSynPluginMultiCaretVisualList);
+ procedure MoveToUsed;
+ procedure MoveToUnUsed;
+ property ListIndex: Integer read FListIndex;
+ property UsedList: TSynPluginMultiCaretVisualList read FUsedList;
+ property UnUsedList: TSynPluginMultiCaretVisualList read FUnUsedList;
+ end;
+
+ { TSynPluginMultiCaretVisualList }
+
+ TSynPluginMultiCaretVisualList = class
+ private
+ FList: Array of TSynPluginMultiCaretVisual;
+ FCount: Integer;
+ function GetScreenCaret(Index: Integer): TSynPluginMultiCaretVisual;
+ public
+ destructor Destroy; override;
+ procedure Add(AScreenCaret: TSynPluginMultiCaretVisual);
+ procedure Remove(AScreenCaret: TSynPluginMultiCaretVisual);
+ procedure Clear; // free visuals
+ function Count: Integer;
+ property ScreenCaret[Index: Integer]: TSynPluginMultiCaretVisual read GetScreenCaret; default;
+ end;
+
+ TCaretFlag = (cfMainCaret, cfNoneVisual, cfAddDuplicate, cfIterationDone);
+ TCaretFlags = set of TCaretFlag;
+
+ { TSynPluginMultiCaretList }
+
+ TSynPluginMultiCaretList = class
+ private type
+ //TCaretFlag = (cfMainCaret, cfNoneVisual);
+ //TCaretFlags = set of TCaretFlag;
+ TCaretData = record
+ x, y, offs: Integer; // logical
+ KeepX: Integer;
+ Flags: TCaretFlags;
+ Visual: TSynPluginMultiCaretVisual;
+ end;
+ PCaretData = ^TCaretData;
+ private
+ FLowIndex, FHighIndex: Integer;
+ FMainCaretIndex: Integer;
+ FMergeLock: Integer;
+ FCarets: Array of TCaretData;
+ function FindEqOrNextCaretRawIdx(X, Y, Offs: Integer; LowIdx: integer = -1; HighIdx: integer = -1): Integer;
+ function GetCaret(Index: Integer): TPoint; inline;
+ function GetCaretFull(Index: Integer): TLogCaretPoint; inline;
+ function GetCaretKeepX(Index: Integer): Integer; inline;
+ function GetCaretOffs(Index: Integer): Integer; inline;
+ function GetCaretX(Index: Integer): Integer; inline;
+ function GetCaretY(Index: Integer): Integer; inline;
+ function GetFlags(Index: Integer): TCaretFlags;
+ function GetMainCaretIndex: Integer;
+ function GetVisual(Index: Integer): TSynPluginMultiCaretVisual; inline;
+ procedure SetCaret(Index: Integer; AValue: TPoint); inline;
+ procedure SetCaretFull(Index: Integer; AValue: TLogCaretPoint); inline;
+ procedure SetCaretKeepX(Index: Integer; AValue: Integer); inline;
+ procedure SetCaretOffs(Index: Integer; AValue: Integer); inline;
+ procedure SetCaretX(Index: Integer; AValue: Integer); inline;
+ procedure SetCaretY(Index: Integer; AValue: Integer); inline;
+ procedure SetVisual(Index: Integer; AValue: TSynPluginMultiCaretVisual); inline;
+
+ function InternalRemoveCaretEx(RawIndex: Integer; AlternativeRawIndex: Integer = -1): Integer;
+ function InternalRemoveCaret(RawIndex: Integer): integer;
+ procedure AdjustAfterChange(RawIndex: Integer); inline;
+ public
+ constructor Create;
+ function AddCaret(X, Y, Offs: Integer; flags: TCaretFlags = []; PhysX: Integer = -1): Integer;
+ procedure RemoveCaret(Index: Integer);
+ procedure Clear(AFreeVisual: Boolean = False; ACapacity: Integer = EMPTY_LIST_LEN);
+ function Count: Integer;
+ function Capacity: Integer;
+ procedure ImportFromSortedList(AMultiCaretList: TLogCaretPointArray);
+ function FindCaretIdx(X, Y, Offs: Integer): Integer;
+ function FindEqOrNextCaretIdx(X, Y, Offs: Integer; LowIdx: integer = -1; HighIdx: integer = -1): Integer;
+ procedure AdjustAllAfterEdit(aLinePos, aBytePos, aCount, aLineBrkCnt: Integer);
+ procedure FindAndRemoveMergedCarets;
+ procedure IncMergeLock;
+ procedure DecMergeLock;
+
+ property Caret[Index: Integer]: TPoint read GetCaret write SetCaret;
+ property CaretFull[Index: Integer]: TLogCaretPoint read GetCaretFull write SetCaretFull;
+ property CaretX[Index: Integer]: Integer read GetCaretX write SetCaretX;
+ property CaretOffs[Index: Integer]: Integer read GetCaretOffs write SetCaretOffs;
+ property CaretKeepX[Index: Integer]: Integer read GetCaretKeepX write SetCaretKeepX;
+ property CaretY[Index: Integer]: Integer read GetCaretY write SetCaretY;
+ property Visual[Index: Integer]: TSynPluginMultiCaretVisual read GetVisual write SetVisual;
+ property Flags[Index: Integer]: TCaretFlags read GetFlags;
+ property MainCaretIndex: Integer read GetMainCaretIndex;
+
+ private
+ FCurrenCaret, FBeforeNextCaret: PCaretData;
+ FIterationDoneCount: Integer;
+ FLowCaret, FHighCaret: PCaretData; // used in AdjustAfterChange
+ FIteratoreMode: (mciNone, mciUp, mciDown);
+ function GetCurrentCaretFlags: TCaretFlags; inline;
+ function GetCurrentCaretFull: TLogCaretPoint; inline;
+ function GetCurrentCaretKeepX: Integer; inline;
+ procedure SetCurrentCaretFull(AValue: TLogCaretPoint); inline;
+ procedure SetCurrentCaretKeepX(AValue: Integer); inline;
+
+ procedure AdjustAfterChange(ACaret: PCaretData);
+ public
+ // During iteration no calls to add/remove are allowed
+ procedure StartIteratorAtFirst; // valid after first call to IterateNextUp
+ function IterateNextUp: Boolean; inline;
+ procedure StartIteratorAtLast;
+ function IterateNextDown: Boolean; inline;
+ function CanPeekCaret(AIndexOffset: Integer): Boolean; inline;
+ function PeekCaretY(AIndexOffset: Integer): Integer; inline;
+ function PeekCaretFull(AIndexOffset: Integer): TLogCaretPoint; inline;
+ //procedure AbortIterator;
+
+ property CurrentCaretFull: TLogCaretPoint read GetCurrentCaretFull write SetCurrentCaretFull;
+ property CurrentCaretKeepX: Integer read GetCurrentCaretKeepX write SetCurrentCaretKeepX;
+ property CurrentCaretFlags: TCaretFlags read GetCurrentCaretFlags;
+ //property CurrentCaret: TPoint read GetCurrentCaret write SetCurrentCaret;
+ //property CurrentCaretX: Integer read GetCurrentCaretX write SetCurrentCaretX;
+ //property CurrentCaretOffs: Integer read GetCurrentCaretOffs write SetCurrentCaretOffs;
+ //property CurrentCaretY: Integer read GetCurrentCaretY write SetCurrentCaretY;
+ end;
+
+ { TSynPluginMultiCaretBase }
+
+ TSynPluginMultiCaretBase = class(TLazSynEditPlugin)
+ private
+ FCarets: TSynPluginMultiCaretList;
+ FColor: TColor;
+ FUsedList: TSynPluginMultiCaretVisualList;
+ FUnUsedList: TSynPluginMultiCaretVisualList;
+ FInPaint: Boolean;
+ FPaintClip: TRect;
+
+ FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer;
+ FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer;
+ FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags;
+
+ FPaintLock: Integer;
+ FPaintLockFlags: set of
+ (plfUpdateCaretsPos, plfDeferUpdateCaretsPos, plfMergeCarets,
+ plfBoundsChanged, plfTextSizeChanged);
+
+ function GetTextArea: TLazSynTextArea;
+ procedure DoTextSizeChanged(Sender: TObject);
+ procedure DoBoundsChanged(Sender: TObject);
+ procedure MergeAndRemoveCarets(AForce: Boolean = False);
+ function IsCaretMergeRequested: Boolean;
+ procedure DoEditorPaintEvent(Sender: TObject; EventType: TSynPaintEvent;
+ const prcClip: TRect);
+ procedure DoEditorScrollEvent(Sender: TObject; EventType: TSynScrollEvent; dx,
+ dy: Integer; const prcScroll, prcClip: TRect);
+ procedure DoEditorStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
+ procedure DoAfterDecPaintLock(Sender: TObject); virtual;
+ procedure DoBeforeIncPaintLock(Sender: TObject); virtual;
+ procedure DoBufferChanged(Sender: TObject); virtual;
+ procedure SetColor(AValue: TColor);
+ property TextArea: TLazSynTextArea read GetTextArea;
+ function CreateVisual: TSynPluginMultiCaretVisual; virtual;
+ function GetVisual: TSynPluginMultiCaretVisual;
+ protected
+ function AddCaret(X, Y, Offs: Integer; flags: TCaretFlags = []; PhysX: Integer = -1): Integer;
+ procedure RemoveCaret(Index: Integer);
+ procedure UpdateCaretsPos;
+ procedure ClearCarets;
+ function CaretsCount: Integer;
+ procedure DoCleared; virtual;
+
+ procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
+ aLineBrkCnt: Integer; aText: String); virtual;
+ procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
+ procedure DoEditorAdded(AValue: TCustomSynEdit); override;
+
+ property Carets: TSynPluginMultiCaretList read FCarets;
+ property PaintLock: Integer read FPaintLock;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer; AFlags: TSynCustomCaretSizeFlags);
+ property Color: TColor read FColor write SetColor;
+ end;
+
+ { TSynPluginMultiCaretMouseActions }
+
+ TSynPluginMultiCaretMouseActions = class(TSynEditMouseActions)
+ public
+ procedure ResetDefaults; override;
+ end;
+
+ { TSynPluginMultiCaretKeyStrokes }
+
+ TSynPluginMultiCaretKeyStrokes = class(TSynEditKeyStrokes)
+ public
+ procedure ResetDefaults; override;
+ end;
+
+ TSynPluginMultiCaretMode = (
+ mcmCancelOnCaretMove,
+ mcmMoveAllCarets,
+ // Osly for ActiveMode
+ mcmNoCarets,
+ mcmAddingCarets // move main caret, keep others
+ );
+ TSynPluginMultiCaretDefaultMode = mcmCancelOnCaretMove..mcmMoveAllCarets;
+
+ TSynPluginMultiCaretStateFlag = (
+ sfProcessingCmd, sfProcessingMain, sfProcessingRepeat,
+ sfNoChangeIndicator,
+ sfExtendingColumnSel, sfSkipCaretsAtSelection,
+ sfCreateCaretAtCurrentPos,
+ sfSkipSelChanged, sfSkipCaretChanged,
+ sfSkipUndoCarets
+ );
+ TSynPluginMultiCaretStateFlags = set of TSynPluginMultiCaretStateFlag;
+
+ { TSynEditUndoMultiCaret }
+
+ TSynEditUndoMultiCaret = class(TSynEditUndoItem)
+ private
+ FCaretUndoItem: TSynEditUndoItem;
+ FBeginBlock: Boolean;
+ FActiveMode: TSynPluginMultiCaretMode;
+ FMultiCaretList: TLogCaretPointArray;
+ protected
+ function IsEqualContent(AnItem: TSynEditUndoItem): Boolean; override;
+ function DebugString: String; override;
+ public
+ constructor Create(ACaretUndoItem: TSynEditUndoItem; ABeginBlock: Boolean);
+ destructor Destroy; override;
+ constructor AddCaretsFrom(AList: TSynPluginMultiCaretList);
+ function IsCaretInfo: Boolean; override;
+ function PerformUndo(Caller: TObject): Boolean; override;
+ property ActiveMode: TSynPluginMultiCaretMode read FActiveMode write FActiveMode;
+ end;
+
+ { TSynCustomPluginMultiCaret }
+
+ TSynCustomPluginMultiCaret = class(TSynPluginMultiCaretBase)
+ private
+ FActiveMode: TSynPluginMultiCaretMode;
+ FDefaultColumnSelectMode: TSynPluginMultiCaretDefaultMode;
+ FDefaultMode: TSynPluginMultiCaretDefaultMode;
+ FEnableWithColumnSelection: Boolean;
+ FKeyStrokes: TSynPluginMultiCaretKeyStrokes;
+ FOnBeforeCommand: TSynMultiCaretBeforeCommand;
+ FStateFlags: TSynPluginMultiCaretStateFlags;
+ FMouseActions: TSynPluginMultiCaretMouseActions;
+ FSelY1, FSelY2, FSelX: Integer;
+ FColSelDoneY1, FColSelDoneY2, FColSelDonePhysX: Integer;
+ FSpaceTrimmerLocked: Boolean;
+ FForeignPaintLock, FNestedCommandProcessor: Integer;
+
+ function GetIsInMainExecution: Boolean;
+ function GetIsInRepeatExecution: Boolean;
+ procedure RemoveCaretsInSelection;
+ procedure SetActiveMode(AValue: TSynPluginMultiCaretMode);
+ procedure SetDefaultColumnSelectMode(AValue: TSynPluginMultiCaretDefaultMode);
+ procedure SetDefaultMode(AValue: TSynPluginMultiCaretDefaultMode);
+ procedure SetSkipCaretAtSel;
+
+ procedure UpdateCaretForUndo(var AnUndoItem: TSynEditUndoItem; AnIsBeginUndo: Boolean);
+ function HandleUndoRedoItem(Caller: TObject; Item: TSynEditUndoItem): Boolean;
+
+ procedure LockSpaceTrimmer; // Todo: per line lock / reverse: trimmer should ask / add event for trimmer via caretObj
+ procedure UnLockSpaceTrimmer;
+ protected
+ function LogPhysConvertor: TSynLogicalPhysicalConvertor; inline;
+ function PhysicalToLogical(AIndex, AColumn: Integer; out AColOffset: Integer;
+ ACharSide: TSynPhysCharSide= cspDefault;
+ AFlags: TSynLogPhysFlags = []): Integer; inline;
+
+
+ procedure DoEditorRemoving(AValue: TCustomSynEdit); override;
+ procedure DoEditorAdded(AValue: TCustomSynEdit); override;
+ procedure DoBufferChanged(Sender: TObject); override;
+
+ procedure DoAfterDecPaintLock(Sender: TObject); override;
+ procedure DoIncForeignPaintLock(Sender: TObject);
+ procedure DoDecForeignPaintLock(Sender: TObject);
+
+ procedure DoCleared; override;
+ procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
+ aLineBrkCnt: Integer; aText: String); override;
+ procedure DoCaretChanged(Sender: TObject);
+ procedure DoSelectionChanged(Sender: TObject);
+ procedure DoBeforeSetSelText(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar);
+ procedure TranslateKey(Sender: TObject; Code: word; SState: TShiftState;
+ var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
+ var Command: TSynEditorCommand; FinishComboOnly: Boolean;
+ var ComboKeyStrokes: TSynEditKeyStrokes);
+ procedure ProcessMySynCommand(Sender: TObject; AfterProcessing: boolean;
+ var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char;
+ Data: pointer; HandlerData: pointer);
+ procedure ProcessAllSynCommand(Sender: TObject; AfterProcessing: boolean;
+ var Handled: boolean; var Command: TSynEditorCommand;
+ var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
+ function MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
+ HandleActionProc: TSynEditMouseActionHandler): Boolean;
+ function DoHandleMouseAction(AnAction: TSynEditMouseAction;
+ var AnInfo: TSynEditMouseActionInfo): Boolean;
+
+ procedure AddStateFlags(AFlags: TSynPluginMultiCaretStateFlags; AnOnlyIfLocked: Boolean);
+ function CreateVisual: TSynPluginMultiCaretVisual; override;
+ property ViewedTextBuffer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure AddCaretAtLogPos(X, Y, Offs: Integer);
+ property IsInMainExecution: Boolean read GetIsInMainExecution;
+ property IsInRepeatExecution: Boolean read GetIsInRepeatExecution;
+ property MouseActions: TSynPluginMultiCaretMouseActions read FMouseActions;
+ property KeyStrokes: TSynPluginMultiCaretKeyStrokes read FKeyStrokes;
+ property EnableWithColumnSelection: Boolean read FEnableWithColumnSelection write FEnableWithColumnSelection default True;
+ property ActiveMode: TSynPluginMultiCaretMode read FActiveMode write SetActiveMode;
+ property DefaultMode: TSynPluginMultiCaretDefaultMode read FDefaultMode write SetDefaultMode default mcmMoveAllCarets;
+ property DefaultColumnSelectMode: TSynPluginMultiCaretDefaultMode
+ read FDefaultColumnSelectMode write SetDefaultColumnSelectMode default mcmCancelOnCaretMove;
+ property OnBeforeCommand: TSynMultiCaretBeforeCommand read FOnBeforeCommand write FOnBeforeCommand;
+ end;
+
+ TSynPluginMultiCaret = class(TSynCustomPluginMultiCaret)
+ published
+ property MouseActions;
+ property KeyStrokes;
+ property EnableWithColumnSelection;
+ property DefaultMode;
+ property DefaultColumnSelectMode;
+ property OnBeforeCommand;
+ end;
+
+implementation
+
+{$IfDef SynMultiCaretDebug}
+var
+ SynMCaretDebug: PLazLoggerLogGroup;
+{$EndIf}
+
+const
+ SynMouseCommandNames: array [0..1] of TIdentMapEntry = (
+ (Value: emcPluginMultiCaretToggleCaret; Name: 'emcPluginMultiCaretToggleCaret'),
+ (Value: emcPluginMultiCaretSelectionToCarets; Name: 'emcPluginMultiCaretSelectionToCarets')
+ );
+
+const
+ EditorKeyCommandStrs: array[0..5] of TIdentMapEntry = (
+ (Value: ecPluginMultiCaretSetCaret; Name: 'ecPluginMultiCaretSetCaret'),
+ (Value: ecPluginMultiCaretUnsetCaret; Name: 'ecPluginMultiCaretUnsetCaret'),
+ (Value: ecPluginMultiCaretToggleCaret; Name: 'ecPluginMultiCaretToggleCaret'),
+ (Value: ecPluginMultiCaretClearAll; Name: 'ecPluginMultiCaretClearAll'),
+ (Value: ecPluginMultiCaretModeCancelOnMove; Name: 'ecPluginMultiCaretModeCancelOnMove'),
+ (Value: ecPluginMultiCaretModeMoveAll; Name: 'ecPluginMultiCaretModeMoveAll')
+ );
+
+function IdentToKeyCommand(const Ident: string; var Cmd: longint): boolean;
+begin
+ Result := IdentToInt(Ident, Cmd, EditorKeyCommandStrs);
+end;
+
+function KeyCommandToIdent(Cmd: longint; var Ident: string): boolean;
+begin
+ Result := (Cmd >= ecPluginFirstMultiCaret) and (Cmd <= ecPluginLastMultiCaret);
+ if not Result then exit;
+ Result := IntToIdent(Cmd, Ident, EditorKeyCommandStrs);
+end;
+
+procedure GetEditorCommandValues(Proc: TGetStrProc);
+var
+ i: integer;
+begin
+ for i := Low(EditorKeyCommandStrs) to High(EditorKeyCommandStrs) do
+ Proc(EditorKeyCommandStrs[I].Name);
+end;
+
+function SynMouseCmdToIdent(SynMouseCmd: Longint; var Ident: String): Boolean;
+begin
+ Ident := '';
+ Result := IntToIdent(SynMouseCmd, Ident, SynMouseCommandNames);
+end;
+
+function IdentToSynMouseCmd(const Ident: string; var SynMouseCmd: Longint): Boolean;
+begin
+ SynMouseCmd := 0;
+ Result := IdentToInt(Ident, SynMouseCmd, SynMouseCommandNames);
+end;
+
+procedure GetEditorMouseCommandValues(Proc: TGetStrProc);
+var
+ i: Integer;
+begin
+ for i := Low(SynMouseCommandNames) to High(SynMouseCommandNames) do
+ Proc(SynMouseCommandNames[I].Name);
+end;
+
+function MouseCommandName(emc: TSynEditorMouseCommand): String;
+begin
+ case emc of
+ emcPluginMultiCaretToggleCaret: Result := SYNS_emcPluginMultiCaretToggleCaret;
+ emcPluginMultiCaretSelectionToCarets: Result := SYNS_emcPluginMultiCaretSelectionToCarets;
+ else
+ Result := '';
+ end;
+end;
+
+function MouseCommandConfigName(emc: TSynEditorMouseCommand): String;
+begin
+ case emc of
+ emcPluginMultiCaretToggleCaret,
+ emcPluginMultiCaretSelectionToCarets: Result := '';
+ else
+ Result := '';
+ end;
+end;
+
+{ TSynPluginMultiCaretVisual }
+
+constructor TSynPluginMultiCaretVisual.Create(AHandleOwner: TWinControl;
+ APainterClass: TSynEditScreenCaretPainterClass; AnUsedList,
+ AnUnUsedList: TSynPluginMultiCaretVisualList);
+begin
+ FListIndex := -1;
+ FUsedList := AnUsedList;
+ FUnUsedList := AnUnUsedList;
+ inherited Create(AHandleOwner, APainterClass);
+end;
+
+procedure TSynPluginMultiCaretVisual.MoveToUsed;
+begin
+ {$IfDef SynMultiCaretAssert}
+ assert((FListIndex < 0) or (not FIsUsed), 'TSynPluginMultiCaretVisual.MoveToUsed: not yet on list');
+ FIsUsed := True;
+ {$ENDIF}
+ if FListIndex >= 0 then
+ FUnUsedList.Remove(Self);
+ FUsedList.Add(Self);
+end;
+
+procedure TSynPluginMultiCaretVisual.MoveToUnUsed;
+begin
+ {$IfDef SynMultiCaretAssert}
+ assert((FListIndex < 0) or FIsUsed, 'TSynPluginMultiCaretVisual.MoveToUnUsed: not yet on list');
+ FIsUsed := False;
+ {$ENDIF}
+ if FListIndex >= 0 then
+ FUsedList.Remove(Self);
+ FUnUsedList.Add(Self);
+ Visible := False;
+end;
+
+{ TSynPluginMultiCaretVisualList }
+
+function TSynPluginMultiCaretVisualList.GetScreenCaret(Index: Integer): TSynPluginMultiCaretVisual;
+begin
+ Result := FList[Index];
+end;
+
+destructor TSynPluginMultiCaretVisualList.Destroy;
+begin
+ inherited Destroy;
+ Clear;
+end;
+
+procedure TSynPluginMultiCaretVisualList.Add(AScreenCaret: TSynPluginMultiCaretVisual);
+begin
+ if (AScreenCaret.ListIndex >= 0) and (AScreenCaret.ListIndex < FCount) and
+ (FList[AScreenCaret.ListIndex] = AScreenCaret)
+ then begin
+ assert(False, 'TSynPluginMultiCaretVisualList.Add: not on list');
+ exit;
+ end;
+
+ {$IfDef SynMultiCaretDebug}
+ if FCount = Length(FList) then debugln(SynMCaretDebug, ['TSynPluginMultiCaretVisualList.Add ', FCount + max(16, FCount div 16)]);
+ {$EndIf}
+ if FCount = Length(FList) then
+ SetLength(FList, FCount + max(16, FCount div 16));
+
+ FList[FCount] := AScreenCaret;
+ AScreenCaret.FListIndex := FCount;
+ inc(FCount);
+end;
+
+procedure TSynPluginMultiCaretVisualList.Remove(AScreenCaret: TSynPluginMultiCaretVisual);
+var
+ t: TSynPluginMultiCaretVisual;
+begin
+ if (AScreenCaret.ListIndex < 0) or (AScreenCaret.ListIndex >= FCount) or
+ (FList[AScreenCaret.ListIndex] <> AScreenCaret)
+ then begin
+ assert(False, 'TSynPluginMultiCaretVisualList.Remove: not on list');
+ exit;
+ end;
+ if AScreenCaret.ListIndex < FCount then begin
+ t := FList[FCount - 1];
+ FList[AScreenCaret.ListIndex] := t;
+ t.FListIndex := AScreenCaret.ListIndex;
+ end;
+ AScreenCaret.FListIndex := -1;
+ dec(FCount);
+end;
+
+procedure TSynPluginMultiCaretVisualList.Clear;
+var
+ i: Integer;
+begin
+ for i := 0 to FCount - 1 do
+ FList[i].Free;
+ FCount := 0;
+ SetLength(FList, EMPTY_LIST_LEN);
+end;
+
+function TSynPluginMultiCaretVisualList.Count: Integer;
+begin
+ Result := FCount;
+end;
+
+{ TSynPluginMultiCaretList }
+
+function TSynPluginMultiCaretList.FindEqOrNextCaretRawIdx(X, Y, Offs: Integer;
+ LowIdx: integer; HighIdx: integer): Integer;
+var
+ l, h: integer;
+ cp: ^TCaretData;
+begin
+ if LowIdx < 0
+ then l := FLowIndex
+ else l := LowIdx;
+ if HighIdx < 0
+ then h := FHighIndex
+ else h := HighIdx;
+
+ if h < l then begin
+ Result := h;
+ exit;
+ end;
+
+ Result := (l + h) div 2;
+ // FPC does not optimize the repeated array access
+ while (h > l) do begin
+ cp := @FCarets[Result];
+ if (cp^.y > y) or
+ ( (cp^.y = y) and
+ ( (cp^.x > x) or
+ ((cp^.x = x) and (cp^.offs >= Offs))
+ )
+ )
+ then
+ h := Result
+ else
+ l := Result + 1;
+ Result := cardinal(l + h) div 2;
+ end;
+ cp := @FCarets[Result];
+ if (cp^.y < y) or
+ ( (cp^.y = y) and
+ (cp^.x < x) or
+ ((cp^.x = x) and (cp^.offs < Offs))
+ )
+ then
+ inc(Result);
+end;
+
+function TSynPluginMultiCaretList.GetCaret(Index: Integer): TPoint;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaret: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result.x := FCarets[Index].x;
+ Result.y := FCarets[Index].y;
+end;
+
+function TSynPluginMultiCaretList.GetCaretFull(Index: Integer): TLogCaretPoint;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result.X := FCarets[Index].x;
+ Result.Y := FCarets[Index].y;
+ Result.Offs := FCarets[Index].offs;
+end;
+
+function TSynPluginMultiCaretList.GetCaretKeepX(Index: Integer): Integer;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].KeepX;
+end;
+
+function TSynPluginMultiCaretList.GetCaretOffs(Index: Integer): Integer;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].offs;
+end;
+
+function TSynPluginMultiCaretList.GetCaretX(Index: Integer): Integer;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].x;
+end;
+
+function TSynPluginMultiCaretList.GetCaretY(Index: Integer): Integer;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetCaretY: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].y;
+end;
+
+function TSynPluginMultiCaretList.GetFlags(Index: Integer): TCaretFlags;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetFlags: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].Flags;
+end;
+
+function TSynPluginMultiCaretList.GetMainCaretIndex: Integer;
+begin
+ if FMainCaretIndex >= FLowIndex then
+ Result := FMainCaretIndex - FLowIndex
+ else
+ Result := -1;
+end;
+
+function TSynPluginMultiCaretList.GetVisual(Index: Integer): TSynPluginMultiCaretVisual;
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.GetVisual: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ Result := FCarets[Index].Visual;
+end;
+
+procedure TSynPluginMultiCaretList.SetCaret(Index: Integer; AValue: TPoint);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaret: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if (FCarets[Index].x = AValue.x) and (FCarets[Index].y = AValue.y) then exit;
+ FCarets[Index].x := AValue.x;
+ FCarets[Index].y := AValue.y;
+ AdjustAfterChange(Index);
+end;
+
+procedure TSynPluginMultiCaretList.SetCaretFull(Index: Integer; AValue: TLogCaretPoint);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if (FCarets[Index].x = AValue.x) and (FCarets[Index].y = AValue.y) and (FCarets[Index].offs = AValue.Offs) then
+ exit;
+ FCarets[Index].x := AValue.X;
+ FCarets[Index].y := AValue.Y;
+ FCarets[Index].offs := AValue.Offs;
+ AdjustAfterChange(Index);
+end;
+
+procedure TSynPluginMultiCaretList.SetCaretKeepX(Index: Integer; AValue: Integer);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ //if FCarets[Index].KeepX = AValue then exit;
+ FCarets[Index].KeepX := AValue;
+end;
+
+procedure TSynPluginMultiCaretList.SetCaretOffs(Index: Integer; AValue: Integer);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if FCarets[Index].offs = AValue then exit;
+ FCarets[Index].offs := AValue;
+ AdjustAfterChange(Index);
+end;
+
+procedure TSynPluginMultiCaretList.SetCaretX(Index: Integer; AValue: Integer);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretX: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if FCarets[Index].x = AValue then exit;
+ FCarets[Index].x := AValue;
+ AdjustAfterChange(Index);
+end;
+
+procedure TSynPluginMultiCaretList.SetCaretY(Index: Integer; AValue: Integer);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetCaretY: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if FCarets[Index].y = AValue then exit;
+ FCarets[Index].y := AValue;
+ AdjustAfterChange(Index);
+end;
+
+procedure TSynPluginMultiCaretList.SetVisual(Index: Integer; AValue: TSynPluginMultiCaretVisual);
+begin
+ Index := Index + FLowIndex;
+ assert((Index>=FLowIndex) and (Index <= FHighIndex), 'TSynPluginMultiCaretList.SetVisual: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if FCarets[Index].Visual <> nil then
+ FCarets[Index].Visual.MoveToUnUsed;
+ FCarets[Index].Visual := AValue;
+ if AValue <> nil then
+ AValue.MoveToUsed;
+end;
+
+function TSynPluginMultiCaretList.InternalRemoveCaretEx(RawIndex: Integer;
+ AlternativeRawIndex: Integer): Integer;
+begin
+ assert((RawIndex>=FLowIndex) and (RawIndex <= FHighIndex), 'TSynPluginMultiCaretList.InternalRemoveCaretEx: (Index>=FLowIndex) and (Index <= FHighIndex)');
+ if (RawIndex = FMainCaretIndex) and (AlternativeRawIndex >= FLowIndex) then
+ Result := InternalRemoveCaret(AlternativeRawIndex)
+ else
+ Result := InternalRemoveCaret(RawIndex);
+end;
+
+function TSynPluginMultiCaretList.InternalRemoveCaret(RawIndex: Integer): integer;
+begin
+ assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone');
+ assert((RawIndex>=FLowIndex) and (RawIndex <= FHighIndex), 'TSynPluginMultiCaretList.InternalRemoveCaret: (RawIndex>=FLowIndex) and (RawIndex <= FHighIndex)');
+ Result := 0; // change to LowCaret .. RawIndex
+
+ if FCarets[RawIndex].Visual <> nil then
+ FCarets[RawIndex].Visual.MoveToUnUsed;
+ if RawIndex = FMainCaretIndex then
+ FMainCaretIndex := -1;
+
+ if RawIndex > (FHighIndex + FLowIndex) div 2 then begin
+ if (RawIndex < FHighIndex) then
+ Move(FCarets[RawIndex+1], FCarets[RawIndex], (FHighIndex - RawIndex) * SizeOf(FCarets[0]));
+ dec(FHighIndex);
+ if RawIndex < FMainCaretIndex then
+ dec(FMainCaretIndex);
+ end
+ else begin
+ if (RawIndex > FLowIndex) then
+ Move(FCarets[FLowIndex], FCarets[FLowIndex+1], (RawIndex - FLowIndex) * SizeOf(FCarets[0]));
+ inc(FLowIndex);
+ if RawIndex > FMainCaretIndex then
+ inc(FMainCaretIndex);
+ Result := 1; // FLowIndex was increasde by 1;
+ end;
+
+ //debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.InternalRemoveCaret ', RawIndex, ' , ', count]);
+end;
+
+procedure TSynPluginMultiCaretList.AdjustAfterChange(RawIndex: Integer);
+begin
+ assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone');
+ FLowCaret := @FCarets[FLowIndex];
+ FHighCaret := @FCarets[FHighIndex];
+ AdjustAfterChange(@FCarets[RawIndex]);
+end;
+
+constructor TSynPluginMultiCaretList.Create;
+begin
+ FLowIndex := 0;
+ FHighIndex := -1;
+ FMainCaretIndex := -1;
+end;
+
+function TSynPluginMultiCaretList.AddCaret(X, Y, Offs: Integer; flags: TCaretFlags;
+ PhysX: Integer): Integer;
+var
+ NewCarets: Array of TCaretData;
+ Len, AddLen, i, Middle: Integer;
+begin
+ assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.AddCaret: FIteratoreMode=mciNone');
+ Result := FindEqOrNextCaretRawIdx(x, y, Offs);
+ if Result < FLowIndex then
+ Result := FLowIndex;
+ if (Result <= FHighIndex) and (FCarets[Result].x = x) and (FCarets[Result].y = y) and
+ (FCarets[Result].offs = Offs) and not(cfAddDuplicate in flags)
+ then begin
+ if cfMainCaret in flags then begin
+ FMainCaretIndex := Result;
+ FCarets[Result].Flags := flags + [cfMainCaret];
+ end;
+ // TODO maybe update PhysX;
+ Result := Result - FLowIndex;
+ exit;
+ end;
+
+ Len := length(FCarets) - 1;
+ Middle := (FLowIndex + FHighIndex) div 2;
+ if (FLowIndex > 0) and ((Result < Middle) or (FHighIndex = len))
+ then begin
+ // use space in front of list
+ if (Result > FHighIndex) and (FHighIndex = High(FCarets)) // moving all entries
+ then i := max(FLowIndex div 2 - 1, 0) // Make some room at the end of the list
+ else i := 0;
+ if Result > FLowIndex then
+ Move(FCarets[FLowIndex], FCarets[FLowIndex-1-i], (Result-FLowIndex) * SizeOf(FCarets[0]));
+ FLowIndex := FLowIndex - 1 - i;
+ FHighIndex := FHighIndex - i;
+ Result := Result - 1 - i;
+ if Result > FMainCaretIndex
+ then FMainCaretIndex := FMainCaretIndex - 1 - i
+ else FMainCaretIndex := FMainCaretIndex - i;
+ end
+ else
+ if FHighIndex < Len then begin
+ // use space at end of list
+ if (Result = FLowIndex) and (FLowIndex = 0) // moving all entries
+ then i := max((High(FCarets)-FHighIndex) div 2 - 1, 0) // Make some room at the start of the list
+ else i := 0;
+ if Result <= FHighIndex then
+ Move(FCarets[Result], FCarets[Result+1+i], (FHighIndex-Result+1) * SizeOf(FCarets[0]));
+ FHighIndex := FHighIndex + 1 + i;
+ FLowIndex := FLowIndex + i;
+ Result := Result + i;
+ if Result <= FMainCaretIndex
+ then FMainCaretIndex := FMainCaretIndex + 1 + i
+ else FMainCaretIndex := FMainCaretIndex + i;
+ end
+ else begin
+ // realloc all
+ AddLen := Max(32, Len div 8);
+ SetLength(NewCarets, Len + 2 * AddLen);
+ i := Result-FLowIndex;
+ if i > 0 then
+ Move(FCarets[FLowIndex], NewCarets[AddLen], (i) * SizeOf(FCarets[0]));
+ if Result <= FHighIndex then
+ Move(FCarets[Result], NewCarets[AddLen+i+1], (FHighIndex-Result+1) * SizeOf(FCarets[0]));
+
+ if Result <= FMainCaretIndex
+ then FMainCaretIndex := FMainCaretIndex - FLowIndex + AddLen + 1
+ else FMainCaretIndex := FMainCaretIndex - FLowIndex + AddLen;
+
+ FLowIndex := AddLen;
+ FHighIndex := AddLen + Len + 1;
+ Result := i + AddLen;
+ FCarets := NewCarets;
+ end;
+
+ FCarets[Result].x := x;
+ FCarets[Result].offs := Offs;
+ FCarets[Result].y := y;
+ FCarets[Result].KeepX := PhysX;
+ FCarets[Result].Visual := nil;
+ FCarets[Result].Flags := flags - [cfAddDuplicate];
+
+ if cfMainCaret in flags then
+ FMainCaretIndex := Result;
+
+ Result := Result - FLowIndex;
+end;
+
+procedure TSynPluginMultiCaretList.RemoveCaret(Index: Integer);
+begin
+ assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.RemoveCaret: FIteratoreMode=mciNone');
+ InternalRemoveCaret(Index+FLowIndex);
+end;
+
+procedure TSynPluginMultiCaretList.Clear(AFreeVisual: Boolean; ACapacity: Integer);
+var
+ i: Integer;
+begin
+ assert(FIteratoreMode=mciNone, 'TSynPluginMultiCaretList.Clear: FIteratoreMode=mciNone');
+ if AFreeVisual then
+ begin
+ for i := FLowIndex to FHighIndex do
+ if FCarets[i].Visual <> nil then begin
+ FCarets[i].Visual.UsedList.Remove(FCarets[i].Visual);
+ FCarets[i].Visual.Free;
+ end
+ end
+ else
+ for i := FLowIndex to FHighIndex do
+ if FCarets[i].Visual <> nil then
+ FCarets[i].Visual.MoveToUnUsed;
+ SetLength(FCarets, ACapacity);
+ FLowIndex := Cardinal(ACapacity) div 2;
+ FHighIndex := FLowIndex - 1;
+ FMainCaretIndex := -1;
+end;
+
+function TSynPluginMultiCaretList.Count: Integer;
+begin
+ Result := FHighIndex - FLowIndex + 1;
+end;
+
+function TSynPluginMultiCaretList.Capacity: Integer;
+begin
+ Result := Length(FCarets);
+end;
+
+procedure TSynPluginMultiCaretList.ImportFromSortedList(AMultiCaretList: TLogCaretPointArray);
+var
+ i: Integer;
+ c: PCaretData;
+begin
+ Clear(False, Length(AMultiCaretList) + 32);
+ FLowIndex := 16;
+ FHighIndex := FLowIndex + High(AMultiCaretList);
+ c := @FCarets[FLowIndex];
+ for i := 0 to High(AMultiCaretList) do begin
+ c^.x := AMultiCaretList[i].X;
+ c^.offs := AMultiCaretList[i].Offs;
+ c^.y := AMultiCaretList[i].Y;
+ c^.KeepX := -1;
+ c^.Visual := nil;
+ c^.Flags := [];
+ inc(c);
+ end;
+end;
+
+function TSynPluginMultiCaretList.FindCaretIdx(X, Y, Offs: Integer): Integer;
+begin
+ Result := FindEqOrNextCaretRawIdx(x, y, offs);
+ if Result < FLowIndex then
+ exit(-1);
+ if (Result > FHighIndex) or (FCarets[Result].x <> x) or (FCarets[Result].offs <> Offs) or
+ (FCarets[Result].y <> y)
+ then
+ Result := -1
+ else
+ Result := Result - FLowIndex;
+end;
+
+function TSynPluginMultiCaretList.FindEqOrNextCaretIdx(X, Y, Offs: Integer; LowIdx: integer;
+ HighIdx: integer): Integer;
+begin
+ if LowIdx >= 0 then inc(LowIdx, FLowIndex);
+ if HighIdx >= 0 then inc(HighIdx, FLowIndex);
+ Result := FindEqOrNextCaretRawIdx(x, y, offs, LowIdx, HighIdx);
+ if (Result > FHighIndex)
+ then
+ Result := -1
+ else
+ Result := Result - FLowIndex;
+end;
+
+procedure TSynPluginMultiCaretList.AdjustAllAfterEdit(aLinePos, aBytePos, aCount,
+ aLineBrkCnt: Integer);
+var
+ i, j, lowest: Integer;
+begin
+ if Count = 0 then exit;
+ lowest := FindEqOrNextCaretRawIdx(aBytePos, aLinePos, 0);
+ if lowest < FLowIndex then lowest := FLowIndex;
+
+ if aLineBrkCnt = 0 then begin
+ if aCount < 0 then begin
+ i := lowest;
+ while i <= FHighIndex do begin
+ if (FCarets[i].y = aLinePos) and (FCarets[i].x >= aBytePos) then
+ FCarets[i].x := Max(aBytePos, FCarets[i].x + aCount)
+ else
+ break;
+ inc(i);
+ end;
+ end
+ else begin // aCount >= 0
+ for i := lowest to FHighIndex do begin
+ if (FCarets[i].y = aLinePos) and (FCarets[i].x >= aBytePos) then
+ FCarets[i].x := FCarets[i].x + aCount
+ else
+ break;
+ end;
+ end;
+ end
+ else // aLineBrkCnt = 0
+ begin // aCount is always 0 (aBytePos:=max(1,aBytePos+aCount)) // aBytePos is the end of line
+ if aLineBrkCnt < 0 then begin
+ j := aLinePos+(-aLineBrkCnt);
+ i := lowest;
+ while i <= FHighIndex do begin
+ if (FCarets[i].y < j) then
+ FCarets[i].x := aBytePos;
+ if (FCarets[i].y = j) then
+ FCarets[i].x := FCarets[i].x - 1 + aBytePos
+ else
+ break;
+ FCarets[i].y := aLinePos;
+ inc(i);
+ end;
+ while i <= FHighIndex do begin
+ FCarets[i].y := FCarets[i].y + aLineBrkCnt;
+ inc(i);
+ end;
+ end
+ else begin // aLineBrkCnt >= 0
+ i := lowest;
+ while i <= FHighIndex do begin
+ if (FCarets[i].y = aLinePos) then
+ FCarets[i].x := FCarets[i].x + 1 - aBytePos
+ else
+ break;
+ FCarets[i].y := FCarets[i].y + aLineBrkCnt;
+ inc(i);
+ end;
+ while i <= FHighIndex do begin
+ FCarets[i].y := FCarets[i].y + aLineBrkCnt;
+ inc(i);
+ end;
+ end;
+ end;
+end;
+
+procedure TSynPluginMultiCaretList.FindAndRemoveMergedCarets;
+var
+ i, i2: Integer;
+ c: TCaretData;
+begin
+ i := FLowIndex + 1;
+ while i <= FHighIndex do begin
+ if (FCarets[i].y = FCarets[i-1].y) and (FCarets[i].x = FCarets[i-1].x) then begin
+ i := i + InternalRemoveCaretEx(i, i-1);
+ continue;
+ end;
+ if (FCarets[i].y < FCarets[i-1].y) or
+ ((FCarets[i].y = FCarets[i-1].y) and (FCarets[i].x < FCarets[i-1].x))
+ then begin
+ // should not happen
+ {$IfDef SynMultiCaretDebug}
+ debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.FindAndRemoveMergedCarets BUBBLE SORTING']);
+ {$EndIf}
+ i2 := i;
+ c := FCarets[i2];
+ repeat
+ FCarets[i2] := FCarets[i2-1];
+ dec(i2);
+ until (i2 = FLowIndex) or (FCarets[i2].y > FCarets[i2-1].y) or
+ ((FCarets[i2].y = FCarets[i2-1].y) and (FCarets[i2].x > FCarets[i2-1].x));
+ FCarets[i2] := c;
+ if FMainCaretIndex = i then
+ FMainCaretIndex := i2;
+ if (FMainCaretIndex < i) and (FMainCaretIndex >= i2) then
+ inc(FMainCaretIndex);
+ end;
+ inc(i);
+ end;
+end;
+
+procedure TSynPluginMultiCaretList.IncMergeLock;
+begin
+ inc(FMergeLock);
+end;
+
+procedure TSynPluginMultiCaretList.DecMergeLock;
+begin
+ dec(FMergeLock);
+end;
+
+function TSynPluginMultiCaretList.GetCurrentCaretFull: TLogCaretPoint;
+begin
+ Result.X := FCurrenCaret^.x;
+ Result.Y := FCurrenCaret^.y;
+ Result.Offs := FCurrenCaret^.offs;
+end;
+
+function TSynPluginMultiCaretList.GetCurrentCaretFlags: TCaretFlags;
+begin
+ Result := FCurrenCaret^.Flags;
+end;
+
+function TSynPluginMultiCaretList.GetCurrentCaretKeepX: Integer;
+begin
+ Result := FCurrenCaret^.KeepX;
+end;
+
+procedure TSynPluginMultiCaretList.SetCurrentCaretFull(AValue: TLogCaretPoint);
+begin
+ FCurrenCaret^.x := AValue.X;
+ FCurrenCaret^.y := AValue.Y;
+ FCurrenCaret^.offs := AValue.Offs;
+ AdjustAfterChange(FCurrenCaret);
+end;
+
+procedure TSynPluginMultiCaretList.SetCurrentCaretKeepX(AValue: Integer);
+begin
+ FCurrenCaret^.KeepX := AValue;
+ AdjustAfterChange(FCurrenCaret);
+end;
+
+procedure TSynPluginMultiCaretList.AdjustAfterChange(ACaret: PCaretData);
+ function ToRawIndex(C: PCaretData): Integer;
+ begin
+ Result := (C - PCaretData(@FCarets[0])); // div SizeOf(FCarets[0]);
+ end;
+var
+ NewCaretPos, HelpCaretPos: PCaretData;
+ NewCaretIdx, y, x, o: Integer;
+ v: TCaretData;
+begin
+ assert((ACaret>=FLowCaret) and (ACaret <= FHighCaret) and (ACaret <> nil), 'TSynPluginMultiCaretList.AdjustAfterChange: (ACaret>=FLowCaret) and (ACaret <= FHighCaret)');
+ // if iterating then this must only be called with fcurrentcaret
+ assert((FIteratoreMode=mciNone) or ((ACaret = FCurrenCaret)), 'TSynPluginMultiCaretList.AdjustAfterChange: (FIteratoreMode=mciNone) or (ACaret = FCurrenCaret)');
+
+ y := ACaret^.y;
+
+ if (ACaret > FLowCaret) then begin
+ NewCaretPos := ACaret - 1;
+ if (y <= NewCaretPos^.y) then begin
+ x := ACaret^.x;
+ if (y < NewCaretPos^.y) or (x <= NewCaretPos^.x) then begin
+ o := ACaret^.offs;
+ if (x < NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o <= NewCaretPos^.offs) )
+ then begin
+ HelpCaretPos := NewCaretPos - 1;
+ if (HelpCaretPos >= FLowCaret) and
+ ( (y < HelpCaretPos^.y) or
+ ( (y = HelpCaretPos^.y) and
+ ( (x < HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o < HelpCaretPos^.offs) ) )
+ ) )
+ then begin
+ NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, FLowIndex, ToRawIndex(HelpCaretPos));
+ if NewCaretIdx > FHighIndex then NewCaretIdx := FHighIndex;
+ NewCaretPos := @FCarets[NewCaretIdx];
+ end;
+
+ if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
+ if FMergeLock = 0 then
+ InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
+ exit;
+ end;
+ v := ACaret^;
+ {$IfDef SynMultiCaretDebug}
+ debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]);
+ {$EndIf}
+ Move(NewCaretPos^, (NewCaretPos+1)^, Pointer(ACaret)-Pointer(NewCaretPos));
+ NewCaretPos^ := v;
+
+ assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil');
+ FCurrenCaret := NewCaretPos; // move down
+ case FIteratoreMode of
+ mciUp: FBeforeNextCaret := ACaret; // continue at ACaret+1;
+ mciDown: begin
+ FBeforeNextCaret := ACaret + 1; // continue at ACaret;
+ Include(FCurrenCaret^.Flags, cfIterationDone);
+ inc(FIterationDoneCount);
+ end;
+ end;
+ end
+ end;
+ end;
+ end;
+
+ if (ACaret < FHighCaret) then begin
+ NewCaretPos := ACaret + 1;
+ if (y >= NewCaretPos^.y) then begin
+ x := ACaret^.x;
+ if (y > NewCaretPos^.y) or (x >= NewCaretPos^.x) then begin
+ o := ACaret^.offs;
+ if (x > NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o >= NewCaretPos^.offs) )
+ then begin
+ HelpCaretPos := NewCaretPos + 1;
+ if (HelpCaretPos <= FHighCaret) and
+ ( (y > HelpCaretPos^.y) or
+ ( (y = HelpCaretPos^.y) and
+ ( (x > HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o > HelpCaretPos^.offs) ) )
+ ) )
+ then begin
+ NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, ToRawIndex(HelpCaretPos), FHighIndex);
+ if NewCaretIdx < FLowIndex then NewCaretIdx := FLowIndex;
+ NewCaretPos := @FCarets[NewCaretIdx];
+ end;
+
+ if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
+ if FMergeLock = 0 then
+ InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
+ exit;
+ end;
+ v := ACaret^;
+ {$IfDef SynMultiCaretDebug}
+ debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]);
+ {$EndIf}
+ Move((ACaret+1)^, ACaret^, Pointer(NewCaretPos)-Pointer(ACaret));
+ NewCaretPos^ := v;
+
+ assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil');
+ FCurrenCaret := NewCaretPos; // move down
+ case FIteratoreMode of
+ mciDown: FBeforeNextCaret := ACaret; // continue at ACaret-1;
+ mciUp: begin
+ FBeforeNextCaret := ACaret - 1; // continue at ACaret;
+ Include(FCurrenCaret^.Flags, cfIterationDone);
+ inc(FIterationDoneCount);
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+end;
+
+procedure TSynPluginMultiCaretList.StartIteratorAtFirst;
+begin
+ FBeforeNextCaret := nil;
+ if Length(FCarets) = 0 then begin
+ FLowCaret := nil;
+ FHighCaret := nil;
+ FCurrenCaret := nil;
+ exit;
+ end;
+ FLowCaret := @FCarets[FLowIndex];
+ FHighCaret := @FCarets[FHighIndex];
+ FCurrenCaret := FLowCaret - 1;
+ FIteratoreMode := mciUp;
+end;
+
+function TSynPluginMultiCaretList.IterateNextUp: Boolean;
+begin
+ if FBeforeNextCaret <> nil then begin
+ FCurrenCaret := FBeforeNextCaret;
+ FBeforeNextCaret := nil;
+ end;
+ repeat
+ Result := FCurrenCaret < FHighCaret;
+ if not Result then begin
+ FIteratoreMode := mciNone;
+ assert(FIterationDoneCount = 0, 'TSynPluginMultiCaretList.IterateNextUp: FIterationDoneCount = 0');
+ exit;
+ end;
+ inc(FCurrenCaret);
+ if not(cfIterationDone in FCurrenCaret^.Flags) then
+ break;
+ Exclude(FCurrenCaret^.Flags, cfIterationDone);
+ dec(FIterationDoneCount);
+ until False;
+end;
+
+procedure TSynPluginMultiCaretList.StartIteratorAtLast;
+begin
+ FBeforeNextCaret := nil;
+ if Length(FCarets) = 0 then begin
+ FLowCaret := nil;
+ FHighCaret := nil;
+ FCurrenCaret := nil;
+ exit;
+ end;
+ FLowCaret := @FCarets[FLowIndex];
+ FHighCaret := @FCarets[FHighIndex];
+ FCurrenCaret := FHighCaret + 1;
+ FIteratoreMode := mciDown;
+end;
+
+function TSynPluginMultiCaretList.IterateNextDown: Boolean;
+begin
+ if FBeforeNextCaret <> nil then begin
+ FCurrenCaret := FBeforeNextCaret;
+ FBeforeNextCaret := nil;
+ end;
+ repeat
+ Result := FCurrenCaret > FLowCaret;
+ if not Result then begin
+ FIteratoreMode := mciNone;
+ assert(FIterationDoneCount = 0, 'TSynPluginMultiCaretList.IterateNextDown: FIterationDoneCount = 0');
+ exit;
+ end;
+ dec(FCurrenCaret);
+ if not(cfIterationDone in FCurrenCaret^.Flags) then
+ break;
+ Exclude(FCurrenCaret^.Flags, cfIterationDone);
+ dec(FIterationDoneCount);
+ until False;
+end;
+
+function TSynPluginMultiCaretList.CanPeekCaret(AIndexOffset: Integer): Boolean;
+begin
+ if AIndexOffset < 0 then
+ Result := FCurrenCaret + AIndexOffset >= FLowCaret
+ else
+ Result := FCurrenCaret + AIndexOffset <= FHighCaret;
+end;
+
+function TSynPluginMultiCaretList.PeekCaretY(AIndexOffset: Integer): Integer;
+begin
+ Result := (FCurrenCaret+AIndexOffset)^.y;
+end;
+
+function TSynPluginMultiCaretList.PeekCaretFull(AIndexOffset: Integer): TLogCaretPoint;
+begin
+ Result.X := (FCurrenCaret+AIndexOffset)^.x;
+ Result.Y := (FCurrenCaret+AIndexOffset)^.y;
+ Result.Offs := (FCurrenCaret+AIndexOffset)^.offs;
+end;
+
+{ TSynPluginMultiCaretBase }
+
+procedure TSynPluginMultiCaretBase.DoBoundsChanged(Sender: TObject);
+var
+ i: Integer;
+ ta: TLazSynTextArea;
+begin
+ if FPaintLock > 0 then begin
+ include(FPaintLockFlags, plfBoundsChanged);
+ exit;
+ end;
+
+ ta := TextArea;
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].ClipRect := ta.Bounds;
+ UpdateCaretsPos;
+end;
+
+procedure TSynPluginMultiCaretBase.MergeAndRemoveCarets(AForce: Boolean);
+var
+ i: Integer;
+begin
+ if (FPaintLock > 0) and (not AForce) then begin
+ include(FPaintLockFlags, plfMergeCarets);
+ exit;
+ end;
+
+ Carets.FindAndRemoveMergedCarets;
+ i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset);
+ if i >= 0 then
+ Carets.RemoveCaret(i);
+end;
+
+function TSynPluginMultiCaretBase.IsCaretMergeRequested: Boolean;
+begin
+ Result := plfMergeCarets in FPaintLockFlags;
+end;
+
+procedure TSynPluginMultiCaretBase.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos,
+ aCount, aLineBrkCnt: Integer; aText: String);
+begin
+ Carets.AdjustAllAfterEdit(aLinePos, aBytePos, aCount, aLineBrkCnt);
+ MergeAndRemoveCarets;
+end;
+
+procedure TSynPluginMultiCaretBase.SetColor(AValue: TColor);
+var
+ i: Integer;
+begin
+ if FColor = AValue then Exit;
+ FColor := AValue;
+ for i := 0 to FUsedList.Count - 1 do
+ TSynEditScreenCaretPainterInternal(FUsedList[i].Painter).Color := FColor;
+end;
+
+function TSynPluginMultiCaretBase.CreateVisual: TSynPluginMultiCaretVisual;
+begin
+ Result := TSynPluginMultiCaretVisual.Create(Editor,
+ TSynEditScreenCaretPainterInternal,
+ FUsedList, FUnUsedList);
+ Result.PaintTimer:= ScreenCaret.PaintTimer;
+end;
+
+function TSynPluginMultiCaretBase.GetVisual: TSynPluginMultiCaretVisual;
+var
+ ta: TLazSynTextArea;
+ i: TSynCaretType;
+begin
+ if FUnUsedList.Count > 0 then
+ Result := FUnUsedList[FUnUsedList.Count-1]
+ else
+ Result := CreateVisual;
+
+ ta := TextArea;
+ Result.ClipRect := ta.Bounds;
+ Result.CharHeight := ta.LineHeight - Max(0, ta.ExtraLineSpacing);
+ Result.CharWidth := ta.CharWidth;
+ if Editor.InsertMode then
+ Result.DisplayType := Editor.InsertCaret
+ else
+ Result.DisplayType := Editor.OverwriteCaret;
+ for i := low(TSynCaretType) to high(TSynCaretType) do
+ Result.SetCaretTypeSize(i, FCustomPixelWidth[i], FCustomPixelHeight[i], FCustomOffsetX[i], FCustomOffsetY[i], FCustomFlags[i]);
+ TSynEditScreenCaretPainterInternal(Result.Painter).Color := FColor;
+end;
+
+procedure TSynPluginMultiCaretBase.DoTextSizeChanged(Sender: TObject);
+var
+ i: Integer;
+ ta: TLazSynTextArea;
+begin
+ if FPaintLock > 0 then begin
+ include(FPaintLockFlags, plfTextSizeChanged);
+ exit;
+ end;
+
+ ta := TextArea;
+ for i := 0 to FUsedList.Count - 1 do begin
+ FUsedList[i].CharHeight := ta.LineHeight - Max(0, ta.ExtraLineSpacing);
+ FUsedList[i].CharWidth := ta.CharWidth;
+ end;
+ UpdateCaretsPos;
+end;
+
+procedure TSynPluginMultiCaretBase.DoEditorPaintEvent(Sender: TObject;
+ EventType: TSynPaintEvent; const prcClip: TRect);
+var
+ i: Integer;
+begin
+ if EventType = peAfterPaint then
+ UpdateCaretsPos;
+
+ case EventType of
+ peBeforePaint:
+ begin
+ FInPaint := True;
+ FPaintClip := prcClip;
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].BeginPaint(prcClip);
+ for i := 0 to FUnUsedList.Count - 1 do
+ FUnUsedList[i].BeginPaint(prcClip);
+ end;
+ peAfterPaint:
+ begin
+ FInPaint := False;
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].FinishPaint(prcClip);
+ for i := 0 to FUnUsedList.Count - 1 do
+ FUnUsedList[i].FinishPaint(prcClip);
+ end;
+ end;
+end;
+
+procedure TSynPluginMultiCaretBase.DoEditorScrollEvent(Sender: TObject;
+ EventType: TSynScrollEvent; dx, dy: Integer; const prcScroll, prcClip: TRect);
+var
+ i: Integer;
+begin
+ case EventType of
+ peBeforeScroll:
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].BeginScroll(dx, dy, prcScroll, prcClip);
+ peAfterScroll:
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].FinishScroll(dx, dy, prcScroll, prcClip, True);
+ peAfterScrollFailed:
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].FinishScroll(dx, dy, prcScroll, prcClip, False);
+ end;
+
+ if EventType = peAfterScroll then
+ UpdateCaretsPos;
+end;
+
+procedure TSynPluginMultiCaretBase.DoEditorStatusChanged(Sender: TObject;
+ Changes: TSynStatusChanges);
+var
+ i: Integer;
+ v: Boolean;
+begin
+ if scFocus in Changes then begin
+ v := (Editor.Focused or (eoPersistentCaret in Editor.Options)) and not (eoNoCaret in Editor.Options);
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].Visible := v;
+ end;
+ if scInsertMode in Changes then
+ for i := 0 to FUsedList.Count - 1 do
+ if Editor.InsertMode
+ then FUsedList[i].DisplayType := Editor.InsertCaret
+ else FUsedList[i].DisplayType := Editor.OverwriteCaret;
+ if scOptions in Changes then begin
+ for i := 0 to FUsedList.Count - 1 do begin
+ if Editor.InsertMode
+ then FUsedList[i].DisplayType := Editor.InsertCaret
+ else FUsedList[i].DisplayType := Editor.OverwriteCaret;
+ UpdateCaretsPos;
+ end;
+ end;
+end;
+
+procedure TSynPluginMultiCaretBase.DoAfterDecPaintLock(Sender: TObject);
+begin
+ if FPaintLock > 0 then
+ Dec(FPaintLock);
+ if FPaintLock > 0 then
+ exit;
+
+ Include(FPaintLockFlags, plfDeferUpdateCaretsPos);
+ if plfBoundsChanged in FPaintLockFlags then
+ DoBoundsChanged(nil);
+ if plfTextSizeChanged in FPaintLockFlags then
+ DoTextSizeChanged(nil);
+ if plfMergeCarets in FPaintLockFlags then
+ MergeAndRemoveCarets;
+ Exclude(FPaintLockFlags, plfDeferUpdateCaretsPos);
+ if plfUpdateCaretsPos in FPaintLockFlags then
+ UpdateCaretsPos;
+ FPaintLockFlags := [];
+
+ ScreenCaret.UnLock; // unlock timer
+end;
+
+procedure TSynPluginMultiCaretBase.DoBeforeIncPaintLock(Sender: TObject);
+begin
+ inc(FPaintLock);
+
+ if FPaintLock = 1 then
+ ScreenCaret.Lock; // lock timer
+end;
+
+function TSynPluginMultiCaretBase.GetTextArea: TLazSynTextArea;
+begin
+ Result := TLazSynSurfaceManager(PaintArea).TextArea;
+end;
+
+function TSynPluginMultiCaretBase.AddCaret(X, Y, Offs: Integer; flags: TCaretFlags;
+ PhysX: Integer): Integer;
+var
+ y1, y2: Integer;
+begin
+ Result := Carets.AddCaret(x,y, Offs, flags, PhysX);
+ if cfNoneVisual in flags then
+ exit;
+
+ if FPaintLock > 0 then begin
+ UpdateCaretsPos;
+ exit;
+ end;
+
+ if (eoNoCaret in Editor.Options) then begin
+ Carets.Visual[Result] := nil;
+ exit;
+ end;
+
+ y1 := Editor.RowToScreenRow(y);
+ if (y1 < 0) or (y1 > Editor.LinesInWindow + 1) then
+ y := -1; // not visible
+ if y > 1 then
+ y2 := Editor.RowToScreenRow(y-1);
+
+ if (y > 0) and (y1 <> y2) or (y=1) then begin
+ if Carets.Visual[Result] = nil then
+ Carets.Visual[Result] := GetVisual;
+ x := ViewedTextBuffer.LogPhysConvertor.LogicalToPhysical(ToIdx(y), x, Offs); // TODO: check if offs was adjusted? But should not happen for NEW caret
+ Carets.Visual[Result].DisplayPos := TextArea.RowColumnToPixels(Point(x, y1));
+ Carets.Visual[Result].Visible := (eoPersistentCaret in Editor.Options) or Editor.Focused;
+ end
+ else
+ Carets.Visual[Result] := nil;
+end;
+
+procedure TSynPluginMultiCaretBase.RemoveCaret(Index: Integer);
+begin
+ Carets.RemoveCaret(Index);
+end;
+
+procedure TSynPluginMultiCaretBase.UpdateCaretsPos;
+var
+ i, x, y, o, w: Integer;
+ y1, y2: Integer;
+ vis: Boolean;
+begin
+ if plfDeferUpdateCaretsPos in FPaintLockFlags then exit;
+ if FPaintLock > 0 then begin
+ include(FPaintLockFlags, plfUpdateCaretsPos);
+ exit;
+ end;
+ if (eoNoCaret in Editor.Options) then begin
+ for i := 0 to CaretsCount - 1 do
+ Carets.Visual[i] := nil;
+ exit;
+ end;
+
+ vis := (eoPersistentCaret in Editor.Options) or Editor.Focused;
+
+ w := Editor.LinesInWindow + 1;
+ for i := 0 to CaretsCount - 1 do begin
+ if cfNoneVisual in Carets.Flags[i] then continue;
+
+ x := Carets.CaretX[i];
+ y := Carets.CaretY[i];
+ o := Carets.CaretOffs[i];
+ y1 := Editor.RowToScreenRow(y);
+ if (y1 < 0) or (y1 > w) then begin
+ Carets.Visual[i] := nil;
+ continue;
+ end;
+
+ if y > 1 then
+ y2 := Editor.RowToScreenRow(y-1);
+
+ if (y1 <> y2) or (y=1) then begin
+ if Carets.Visual[i] = nil then
+ Carets.Visual[i] := GetVisual;
+ x := ViewedTextBuffer.LogPhysConvertor.LogicalToPhysical(ToIdx(y), x, o);
+ Carets.Visual[i].DisplayPos := TextArea.RowColumnToPixels(Point(x, y1));
+ Carets.Visual[i].Visible := vis;
+//todo: remove if duplicate
+ // check if offs was adjusted
+ //if o <> Carets.CaretOffs[i] then
+ // Carets.CaretOffs[i] := o;
+ end
+ else
+ Carets.Visual[i] := nil;
+ end;
+end;
+
+procedure TSynPluginMultiCaretBase.ClearCarets;
+begin
+ Carets.Clear(True);
+ FUsedList.Clear;
+ FUnUsedList.Clear;
+ DoCleared;
+end;
+
+function TSynPluginMultiCaretBase.CaretsCount: Integer;
+begin
+ Result := Carets.Count;
+end;
+
+procedure TSynPluginMultiCaretBase.DoCleared;
+begin
+ //
+end;
+
+procedure TSynPluginMultiCaretBase.DoBufferChanged(Sender: TObject);
+begin
+ TSynEditStrings(Sender).RemoveNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock);
+ TSynEditStrings(Sender).RemoveNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock);
+ TSynEditStrings(Sender).RemoveEditHandler(@DoLinesEdited);
+ ViewedTextBuffer.AddEditHandler(@DoLinesEdited);
+ ViewedTextBuffer.AddNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock);
+ ViewedTextBuffer.AddNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock);
+end;
+
+procedure TSynPluginMultiCaretBase.DoEditorRemoving(AValue: TCustomSynEdit);
+begin
+ inherited DoEditorRemoving(AValue);
+ if Editor <> nil then begin
+ ClearCarets;
+ TextArea.RemoveBoundsChangeHandler(@DoBoundsChanged);
+ TextArea.RemoveTextSizeChangeHandler(@DoTextSizeChanged);
+ Editor.UnRegisterStatusChangedHandler(@DoEditorStatusChanged);
+ Editor.UnRegisterScrollEventHandler(@DoEditorScrollEvent);
+ Editor.UnRegisterPaintEventHandler(@DoEditorPaintEvent);
+ ViewedTextBuffer.RemoveNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock);
+ ViewedTextBuffer.RemoveNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock);
+ ViewedTextBuffer.RemoveEditHandler(@DoLinesEdited);
+ ViewedTextBuffer.RemoveGenericHandler(senrTextBufferChanged, TMethod(@DoBufferChanged));
+ end;
+end;
+
+procedure TSynPluginMultiCaretBase.DoEditorAdded(AValue: TCustomSynEdit);
+begin
+ if Editor <> nil then begin
+ ViewedTextBuffer.AddGenericHandler(senrTextBufferChanged, TMethod(@DoBufferChanged));
+ ViewedTextBuffer.AddEditHandler(@DoLinesEdited);
+ ViewedTextBuffer.AddNotifyHandler(senrBeforeIncPaintLock, @DoBeforeIncPaintLock);
+ ViewedTextBuffer.AddNotifyHandler(senrAfterDecPaintLock, @DoAfterDecPaintLock);
+ Editor.RegisterPaintEventHandler(@DoEditorPaintEvent, [peBeforePaint, peAfterPaint]);
+ Editor.RegisterScrollEventHandler(@DoEditorScrollEvent, [peBeforeScroll, peAfterScroll, peAfterScrollFailed]);
+ Editor.RegisterStatusChangedHandler(@DoEditorStatusChanged, [scInsertMode, scFocus, scOptions]);
+ TextArea.AddTextSizeChangeHandler(@DoTextSizeChanged);
+ TextArea.AddBoundsChangeHandler(@DoBoundsChanged);
+
+ if ScreenCaret.Painter.ClassType = TSynEditScreenCaretPainterSystem then
+ ScreenCaret.ChangePainter(TSynEditScreenCaretPainterInternal);
+ end;
+ inherited DoEditorAdded(AValue);
+end;
+
+constructor TSynPluginMultiCaretBase.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FColor := clBlack;
+ FCarets := TSynPluginMultiCaretList.Create;
+ FUsedList := TSynPluginMultiCaretVisualList.Create;
+ FUnUsedList := TSynPluginMultiCaretVisualList.Create;
+end;
+
+destructor TSynPluginMultiCaretBase.Destroy;
+begin
+ inherited Destroy;
+ FreeAndNil(FCarets);
+ FreeAndNil(FUsedList);
+ FreeAndNil(FUnUsedList);
+end;
+
+procedure TSynPluginMultiCaretBase.SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight,
+ AXOffs, AYOffs: Integer; AFlags: TSynCustomCaretSizeFlags);
+var
+ i: Integer;
+begin
+ FCustomPixelWidth[AType] := AWidth;
+ FCustomPixelHeight[AType] := AHeight;
+ FCustomOffsetX[AType] := AXOffs;
+ FCustomOffsetY[AType] := AYOffs;
+ FCustomFlags[AType] := AFlags;
+
+ for i := 0 to FUsedList.Count - 1 do
+ FUsedList[i].SetCaretTypeSize(AType, AWidth, AHeight, AXOffs, AYOffs, AFlags)
+end;
+
+{ TSynPluginMultiCaretMouseActions }
+
+procedure TSynPluginMultiCaretMouseActions.ResetDefaults;
+begin
+ Clear;
+ AddCommand(emcPluginMultiCaretToggleCaret, False, mbXLeft, ccAny, cdDown, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]);
+end;
+
+{ TSynPluginMultiCaretKeyStrokes }
+
+procedure TSynPluginMultiCaretKeyStrokes.ResetDefaults;
+ procedure AddKey(const ACmd: TSynEditorCommand; const AKey: word;
+ const AShift: TShiftState; const AShiftMask: TShiftState = []);
+ begin
+ with Add do
+ begin
+ Key := AKey;
+ Shift := AShift;
+ ShiftMask := AShiftMask;
+ Command := ACmd;
+ end;
+ end;
+begin
+ inherited ResetDefaults;
+ AddKey(ecPluginMultiCaretToggleCaret, VK_SPACE, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]);
+ AddKey(ecPluginMultiCaretClearAll, VK_ESCAPE, [ssShift, ssCtrl], [ssShift,ssCtrl,ssAlt]);
+end;
+
+{ TSynEditUndoMultiCaret }
+
+function TSynEditUndoMultiCaret.IsEqualContent(AnItem: TSynEditUndoItem): Boolean;
+begin
+ Result := (FCaretUndoItem = nil) or
+ FCaretUndoItem.IsEqual(TSynEditUndoMultiCaret(AnItem).FCaretUndoItem);
+ Result := Result and
+ (FActiveMode = TSynEditUndoMultiCaret(AnItem).FActiveMode) and
+ (Length(FMultiCaretList) = Length(TSynEditUndoMultiCaret(AnItem).FMultiCaretList));
+ if Result then
+ Result := 0 = CompareByte(FMultiCaretList[0], TSynEditUndoMultiCaret(AnItem).FMultiCaretList[0],
+ Length(FMultiCaretList)*SizeOf(FMultiCaretList[0]));
+end;
+
+function TSynEditUndoMultiCaret.DebugString: String;
+begin
+ Result := 'TSynEditUndoMultiCaret '+IntToStr(Length(FMultiCaretList));
+ //if FCaretUndoItem <> nil then
+ // Result := Result + ' / ' + FCaretUndoItem.DebugString;
+end;
+
+constructor TSynEditUndoMultiCaret.Create(ACaretUndoItem: TSynEditUndoItem;
+ ABeginBlock: Boolean);
+begin
+ FBeginBlock := ABeginBlock;
+ FCaretUndoItem := ACaretUndoItem;
+end;
+
+destructor TSynEditUndoMultiCaret.Destroy;
+begin
+ FCaretUndoItem.Free;
+ inherited Destroy;
+end;
+
+constructor TSynEditUndoMultiCaret.AddCaretsFrom(AList: TSynPluginMultiCaretList);
+var
+ i, j: Integer;
+begin
+ SetLength(FMultiCaretList, AList.Count);
+ j := 0;
+ for i := 0 to AList.Count-1 do
+ if not (cfNoneVisual in AList.Flags[i]) then begin
+ FMultiCaretList[j] := AList.CaretFull[i];
+ inc(j);
+ end;
+ SetLength(FMultiCaretList, j);
+end;
+
+function TSynEditUndoMultiCaret.IsCaretInfo: Boolean;
+begin
+ Result := True;
+end;
+
+function TSynEditUndoMultiCaret.PerformUndo(Caller: TObject): Boolean;
+var
+ C: TSynCustomPluginMultiCaret;
+ AnRedoItem: TSynEditUndoMultiCaret;
+ UList: TSynEditUndoList;
+begin
+ Result := Caller is TSynCustomPluginMultiCaret;
+ if not Result then exit;
+ C := TSynCustomPluginMultiCaret(Caller);
+ Result := (FCaretUndoItem <> nil) and FCaretUndoItem.PerformUndo(C.Editor);
+ if Result then begin
+ if FBeginBlock then begin
+ C.Carets.ImportFromSortedList(FMultiCaretList);
+ C.ActiveMode := ActiveMode;
+ C.UpdateCaretsPos;
+ C.AddStateFlags([sfSkipSelChanged, sfSkipCaretChanged], True);
+ end;
+ // redo
+ UList := C.ViewedTextBuffer.CurUndoList;
+ if UList.CurrentGroup = nil then exit; // should never happen / just added the caret.
+ AnRedoItem := TSynEditUndoMultiCaret.Create(UList.CurrentGroup.Pop, not FBeginBlock);
+ AnRedoItem.FMultiCaretList := FMultiCaretList;
+ AnRedoItem.ActiveMode := ActiveMode;
+ UList.AddChange(AnRedoItem);
+ end;
+end;
+
+{ TSynCustomPluginMultiCaret }
+
+procedure TSynCustomPluginMultiCaret.TranslateKey(Sender: TObject; Code: word;
+ SState: TShiftState; var Data: pointer; var IsStartOfCombo: boolean; var Handled: boolean;
+ var Command: TSynEditorCommand; FinishComboOnly: Boolean;
+ var ComboKeyStrokes: TSynEditKeyStrokes);
+begin
+ if Handled then
+ exit;
+ if not FinishComboOnly then
+ FKeyStrokes.ResetKeyCombo;
+ Command := FKeyStrokes.FindKeycodeEx(Code, SState, Data, IsStartOfCombo, FinishComboOnly, ComboKeyStrokes);
+
+ Handled := (Command <> ecNone) or IsStartOfCombo;
+end;
+
+procedure TSynCustomPluginMultiCaret.RemoveCaretsInSelection;
+var
+ i, x, y: Integer;
+ bb, be: TPoint;
+ sm: TSynSelectionMode;
+begin
+ bb := SelectionObj.FirstLineBytePos;
+ be := SelectionObj.LastLineBytePos;
+ sm := SelectionObj.ActiveSelectionMode;
+ if sm = smLine then begin
+ bb.x := 0;
+ be.x := MaxInt;
+ end;
+ if (sm = smColumn) and (bb.x > be.x) then begin
+ if bb.x = be.x then
+ exit;
+ i := bb.x;
+ bb.x := be.x;
+ be.x := i;
+ end;
+
+ i := CaretsCount;
+ while i > 0 do begin
+ dec(i);
+ x := Carets.Caret[i].x;
+ y := Carets.Caret[i].y;
+ if (y < bb.y) or
+ (y > be.y) or
+ ( ((y = bb.y) or (sm = smColumn)) and (x <= bb.x) ) or
+ ( ((y = be.y) or (sm = smColumn)) and (x >= be.x) )
+ then
+ Continue;
+ Carets.RemoveCaret(i);
+ end;
+end;
+
+function TSynCustomPluginMultiCaret.GetIsInMainExecution: Boolean;
+begin
+ Result := sfProcessingMain in FStateFlags;
+end;
+
+function TSynCustomPluginMultiCaret.GetIsInRepeatExecution: Boolean;
+begin
+ Result := sfProcessingRepeat in FStateFlags;
+end;
+
+procedure TSynCustomPluginMultiCaret.SetActiveMode(AValue: TSynPluginMultiCaretMode);
+begin
+ if FActiveMode = AValue then Exit;
+ FActiveMode := AValue;
+ if FActiveMode = mcmNoCarets then begin
+ ClearCarets;
+ UnLockSpaceTrimmer;
+ end
+ else
+ LockSpaceTrimmer;
+end;
+
+procedure TSynCustomPluginMultiCaret.SetDefaultColumnSelectMode(AValue: TSynPluginMultiCaretDefaultMode);
+begin
+ if FDefaultColumnSelectMode = AValue then Exit;
+ FDefaultColumnSelectMode := AValue;
+end;
+
+procedure TSynCustomPluginMultiCaret.SetDefaultMode(AValue: TSynPluginMultiCaretDefaultMode);
+begin
+ if FDefaultMode = AValue then Exit;
+ FDefaultMode := AValue;
+end;
+
+procedure TSynCustomPluginMultiCaret.SetSkipCaretAtSel;
+begin
+ Include(FStateFlags, sfSkipCaretsAtSelection);
+ FSelY1 := SelectionObj.FirstLineBytePos.y;
+ FSelY2 := SelectionObj.LastLineBytePos.y;
+ FSelX := SelectionObj.FirstLineBytePos.x;
+end;
+
+procedure TSynCustomPluginMultiCaret.UpdateCaretForUndo(var AnUndoItem: TSynEditUndoItem;
+ AnIsBeginUndo: Boolean);
+begin
+ if (FStateFlags * [sfProcessingCmd, sfSkipUndoCarets] = [sfProcessingCmd]) and // active edit
+ (CaretsCount > 0)
+ then begin
+ AnUndoItem := TSynEditUndoMultiCaret.Create(AnUndoItem, AnIsBeginUndo);
+ TSynEditUndoMultiCaret(AnUndoItem).AddCaretsFrom(Carets);
+ TSynEditUndoMultiCaret(AnUndoItem).ActiveMode := ActiveMode;
+ end;
+end;
+
+function TSynCustomPluginMultiCaret.HandleUndoRedoItem(Caller: TObject;
+ Item: TSynEditUndoItem): Boolean;
+begin
+ Result := Caller = Editor;
+ if not Result then exit;
+ Result := Item.PerformUndo(Self);
+end;
+
+procedure TSynCustomPluginMultiCaret.LockSpaceTrimmer;
+var
+ b: TSynEditStrings;
+begin
+ if FSpaceTrimmerLocked then exit;
+ FSpaceTrimmerLocked := True;
+ b := ViewedTextBuffer;
+ while b <> nil do begin
+ if b is TSynEditStringTrimmingList then TSynEditStringTrimmingList(b).Lock;
+ if b is TSynEditStringsLinked then
+ b := TSynEditStringsLinked(b).NextLines
+ else
+ b := nil;
+ end;
+end;
+
+procedure TSynCustomPluginMultiCaret.UnLockSpaceTrimmer;
+var
+ b: TSynEditStrings;
+begin
+ if not FSpaceTrimmerLocked then exit;
+ FSpaceTrimmerLocked := False;
+ b := ViewedTextBuffer;
+ while b <> nil do begin
+ if b is TSynEditStringTrimmingList then TSynEditStringTrimmingList(b).UnLock;
+ if b is TSynEditStringsLinked then
+ b := TSynEditStringsLinked(b).NextLines
+ else
+ b := nil;
+ end;
+end;
+
+function TSynCustomPluginMultiCaret.LogPhysConvertor: TSynLogicalPhysicalConvertor;
+begin
+ Result := ViewedTextBuffer.LogPhysConvertor;
+end;
+
+function TSynCustomPluginMultiCaret.PhysicalToLogical(AIndex, AColumn: Integer; out
+ AColOffset: Integer; ACharSide: TSynPhysCharSide; AFlags: TSynLogPhysFlags): Integer;
+var
+ s: String;
+begin
+ Result := LogPhysConvertor.PhysicalToLogical(AIndex, AColumn, AColOffset, ACharSide, AFlags);
+ if (AColOffset > 0) then begin
+ if (eoCaretSkipTab in Editor.Options2) then
+ AColOffset := 0
+ else
+ begin
+ s := ViewedTextBuffer[AIndex];
+ if (Result > Length(s)) or (s[Result] <> #9) then
+ AColOffset := 0;
+ end;
+ end;
+end;
+
+procedure TSynCustomPluginMultiCaret.DoEditorRemoving(AValue: TCustomSynEdit);
+begin
+ if Editor <> nil then begin
+ ViewedTextBuffer.RemoveNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock);
+ ViewedTextBuffer.RemoveNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock);
+ ViewedTextBuffer.UndoList.UnregisterUpdateCaretUndo(@UpdateCaretForUndo);
+ CaretObj.RemoveChangeHandler(@DoCaretChanged);
+ SelectionObj.RemoveChangeHandler(@DoSelectionChanged);
+ Editor.UnregisterCommandHandler(@ProcessAllSynCommand);
+ Editor.UnregisterCommandHandler(@ProcessMySynCommand);
+ Editor.UnRegisterKeyTranslationHandler(@TranslateKey);
+ Editor.UnregisterMouseActionSearchHandler(@MaybeHandleMouseAction);
+ Editor.UnregisterMouseActionExecHandler(@DoHandleMouseAction);
+ Editor.UnRegisterUndoRedoItemHandler(@HandleUndoRedoItem);
+ end;
+ inherited DoEditorRemoving(AValue);
+end;
+
+procedure TSynCustomPluginMultiCaret.DoEditorAdded(AValue: TCustomSynEdit);
+begin
+ inherited DoEditorAdded(AValue);
+ if Editor <> nil then begin
+ Editor.RegisterUndoRedoItemHandler(@HandleUndoRedoItem);
+ Editor.RegisterMouseActionSearchHandler(@MaybeHandleMouseAction);
+ Editor.RegisterMouseActionExecHandler(@DoHandleMouseAction);
+ Editor.RegisterCommandHandler(@ProcessAllSynCommand, nil, [hcfInit, hcfFinish]);
+ Editor.RegisterCommandHandler(@ProcessMySynCommand, nil, [hcfPreExec]);
+ Editor.RegisterKeyTranslationHandler(@TranslateKey);
+ SelectionObj.AddChangeHandler(@DoSelectionChanged);
+ CaretObj.AddChangeHandler(@DoCaretChanged);
+ ViewedTextBuffer.UndoList.RegisterUpdateCaretUndo(@UpdateCaretForUndo);
+ ViewedTextBuffer.AddNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock);
+ ViewedTextBuffer.AddNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock);
+ end;
+end;
+
+procedure TSynCustomPluginMultiCaret.DoBufferChanged(Sender: TObject);
+begin
+ inherited DoBufferChanged(Sender);
+ TSynEditStrings(Sender).RemoveNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock);
+ TSynEditStrings(Sender).RemoveNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock);
+ TSynEditStrings(Sender).UndoList.UnregisterUpdateCaretUndo(@UpdateCaretForUndo);
+ ViewedTextBuffer.UndoList.RegisterUpdateCaretUndo(@UpdateCaretForUndo);
+ ViewedTextBuffer.AddNotifyHandler(senrIncOwnedPaintLock, @DoIncForeignPaintLock);
+ ViewedTextBuffer.AddNotifyHandler(senrDecOwnedPaintLock, @DoDecForeignPaintLock);
+end;
+
+procedure TSynCustomPluginMultiCaret.DoAfterDecPaintLock(Sender: TObject);
+begin
+ if FPaintLock > 1 then begin
+ inherited DoAfterDecPaintLock(Sender);
+ exit;
+ end;
+
+ UpdateCaretsPos;
+ inherited DoAfterDecPaintLock(Sender);
+ FStateFlags := FStateFlags - [sfExtendingColumnSel, sfSkipSelChanged, sfSkipCaretChanged];
+end;
+
+procedure TSynCustomPluginMultiCaret.DoIncForeignPaintLock(Sender: TObject);
+begin
+ if Sender = Editor then exit;
+ inc(FForeignPaintLock);
+end;
+
+procedure TSynCustomPluginMultiCaret.DoDecForeignPaintLock(Sender: TObject);
+begin
+ if Sender = Editor then exit;
+ dec(FForeignPaintLock);
+end;
+
+procedure TSynCustomPluginMultiCaret.DoCleared;
+begin
+ inherited DoCleared;
+ ActiveMode := mcmNoCarets;
+ Exclude(FStateFlags, sfCreateCaretAtCurrentPos);
+ FColSelDoneY1 := -1;
+ FColSelDoneY2 := -2;
+ FColSelDonePhysX := -1;
+end;
+
+procedure TSynCustomPluginMultiCaret.DoLinesEdited(Sender: TSynEditStrings; aLinePos,
+ aBytePos, aCount, aLineBrkCnt: Integer; aText: String);
+begin
+ if (FStateFlags * [sfProcessingCmd] = []) and
+ (FForeignPaintLock = 0)
+ then
+ ClearCarets;
+
+
+ inherited DoLinesEdited(Sender, aLinePos, aBytePos, aCount, aLineBrkCnt, aText);
+ FStateFlags := FStateFlags - [sfCreateCaretAtCurrentPos, sfSkipCaretsAtSelection, sfNoChangeIndicator];
+end;
+
+procedure TSynCustomPluginMultiCaret.DoCaretChanged(Sender: TObject);
+var
+ p: TLogCaretPoint;
+begin
+ Exclude(FStateFlags, sfNoChangeIndicator);
+ if (sfCreateCaretAtCurrentPos in FStateFlags) then begin
+ p := CaretObj.OldFullLogicalPos;
+ AddCaret(p.x, p.y, p.Offs);
+ exclude(FStateFlags, sfCreateCaretAtCurrentPos);
+ exit;
+ end;
+ if (FStateFlags * [sfProcessingCmd, sfExtendingColumnSel, sfSkipCaretChanged] <> []) or
+ (ActiveMode = mcmAddingCarets) or
+ (FForeignPaintLock > 0)
+ then
+ exit;
+
+ ClearCarets;
+end;
+
+procedure TSynCustomPluginMultiCaret.DoSelectionChanged(Sender: TObject);
+ procedure AddCarets(StartY, EndY, PhysX: Integer);
+ var
+ i, XLog, Offs: Integer;
+ CurCar: TLogCaretPoint;
+ begin
+ i:= -1;
+ CurCar.Y := -1;
+ while StartY <= EndY do begin
+ XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs);
+ if StartY >= CurCar.Y then begin
+ i := Carets.FindEqOrNextCaretIdx(XLog, StartY, Offs, i+1);
+ if i >= 0 then
+ CurCar := Carets.CaretFull[i];
+ end;
+ if (CurCar.x <> XLog) or (CurCar.Offs <> Offs) or (CurCar.y <> StartY) then
+ AddCaret(XLog, StartY, Offs, [], PhysX); // TODO: pass "i-1" as KnowIndexOfCaretBefore (limit bin search)
+ inc(StartY);
+ end;
+ end;
+ procedure RemoveCarets(StartY, EndY, PhysX: Integer);
+ var
+ i, XLog, Offs: Integer;
+ begin
+ XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs);
+ i := Carets.FindEqOrNextCaretIdx(XLog, StartY, Offs);
+ if i >= 0 then begin
+ while Carets.CaretY[i] <= EndY do begin
+ if (Carets.CaretX[i] = XLog) and (Carets.CaretOffs[i] = Offs) then
+ Carets.RemoveCaret(i)
+ else
+ inc(i);
+ if i >= CaretsCount then
+ break;
+ if StartY <> Carets.CaretY[i] then begin
+ StartY := Carets.CaretY[i];
+ XLog := PhysicalToLogical(ToIdx(StartY), PhysX, Offs);
+ end;
+ end;
+ end;
+ end;
+var
+ i: Integer;
+ XPhys, XLog, Offs: Integer;
+ SelFirstY, SelLastY, CurY: Integer;
+ CurCaret: TLogCaretPoint;
+begin
+ Exclude(FStateFlags, sfNoChangeIndicator);
+ if (FStateFlags * [sfProcessingCmd, sfSkipSelChanged] <> []) or
+ (FForeignPaintLock > 0)
+ then exit;
+ SelFirstY := Editor.BlockBegin.y;
+ SelLastY := Editor.BlockEnd.y;
+ If not ((SelFirstY <> SelLastY) and (Editor.SelectionMode = smColumn) and EnableWithColumnSelection) then begin
+ ClearCarets;
+ exit;
+ end;
+
+
+ Include(FStateFlags, sfExtendingColumnSel);
+ if SelFirstY = CaretObj.LinePos then inc(SelFirstY);
+ if SelLastY = CaretObj.LinePos then dec(SelLastY);
+
+ if (FColSelDoneY2 >= FColSelDoneY1) then begin
+ // Delete carets at top, that are no longer in selection
+ if SelFirstY > FColSelDoneY1 then begin
+ RemoveCarets(FColSelDoneY1, SelFirstY - 1, FColSelDonePhysX);
+ FColSelDoneY1 := SelFirstY;
+ end;
+ // Delete carets at bottom, that are no longer in selection
+ if SelLastY < FColSelDoneY2 then begin
+ RemoveCarets(SelLastY + 1, FColSelDoneY2, FColSelDonePhysX);
+ FColSelDoneY2 := SelLastY;
+ end;
+ end;
+
+ XPhys := Editor.CaretX;
+ if (FColSelDoneY2 >= FColSelDoneY1) and (XPhys <> FColSelDonePhysX) then begin
+ // Move carets X
+ CurY := FColSelDoneY1;
+ XLog := PhysicalToLogical(ToIdx(CurY), FColSelDonePhysX, Offs);
+ i := Carets.FindEqOrNextCaretIdx(XLog, CurY, Offs);
+ if i >= 0 then begin
+ while True do begin
+ CurCaret := Carets.CaretFull[i];
+ if CurCaret.Y > FColSelDoneY2 then
+ break;
+ if (CurCaret.X = XLog) and (CurCaret.Offs = Offs) then begin
+ CurCaret.X := PhysicalToLogical(ToIdx(CurCaret.Y), XPhys, CurCaret.Offs);
+ Carets.CaretFull[i] := CurCaret;
+ Carets.CaretKeepX[i] := XPhys;
+ end;
+ inc(i);
+ if i >= CaretsCount then
+ break;
+ if CurY <> Carets.CaretY[i] then begin
+ CurY := Carets.CaretY[i];
+ XLog := PhysicalToLogical(ToIdx(CurY), FColSelDonePhysX, Offs);
+ end;
+ end;
+ end;
+ FColSelDonePhysX := XPhys;
+ end;
+
+ if (FColSelDoneY2 < FColSelDoneY1) then begin
+ // New Selection
+ AddCarets(SelFirstY, SelLastY, XPhys);
+ FColSelDoneY1 := SelFirstY;
+ FColSelDoneY2 := SelLastY;
+ FColSelDonePhysX := XPhys;
+ end
+ else
+ begin
+ // Extend
+ if SelFirstY < FColSelDoneY1 then begin
+ AddCarets(SelFirstY, FColSelDoneY1 - 1, FColSelDonePhysX);
+ FColSelDoneY1 := SelFirstY;
+ end;
+ if SelLastY > FColSelDoneY2 then begin
+ AddCarets(FColSelDoneY2 + 1, SelLastY, FColSelDonePhysX);
+ FColSelDoneY2 := SelLastY;
+ end;
+ end;
+
+ i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset);
+ if i >= 0 then
+ Carets.RemoveCaret(i);
+
+ if ActiveMode = mcmNoCarets then
+ ActiveMode := DefaultColumnSelectMode;
+end;
+
+procedure TSynCustomPluginMultiCaret.DoBeforeSetSelText(Sender: TObject; AMode: TSynSelectionMode;
+ ANewText: PChar);
+var
+ skip: Boolean;
+begin
+ SelectionObj.RemoveBeforeSetSelTextHandler(@DoBeforeSetSelText);
+
+ // only here if selectionexists and is smColumn;
+ skip := //Editor.SelAvail and (SelectionObj.ActiveSelectionMode = smColumn) and
+ not(eoPersistentBlock in Editor.Options2);
+ if skip then
+ SetSkipCaretAtSel;
+
+ RemoveCaretsInSelection;
+ SelectionObj.SelText := '';
+
+ if Carets.MainCaretIndex >= 0 then begin
+ Editor.LogicalCaretXY := Carets.Caret[Carets.MainCaretIndex];
+ FSelX := Carets.Caret[Carets.MainCaretIndex].x;
+ end
+ else
+ assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found');
+
+ if skip then
+ Include(FStateFlags, sfSkipCaretsAtSelection); // restore the flag
+end;
+
+procedure TSynCustomPluginMultiCaret.ProcessMySynCommand(Sender: TObject;
+ AfterProcessing: boolean; var Handled: boolean; var Command: TSynEditorCommand;
+ var AChar: TUTF8Char; Data: pointer; HandlerData: pointer);
+var
+ i: Integer;
+begin
+ // hcfPreExec
+ if Handled then exit;
+
+ Handled := True;
+ case Command of
+ ecPluginMultiCaretSetCaret: begin
+ if Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset) < 0 then
+ include(FStateFlags, sfCreateCaretAtCurrentPos);
+ ActiveMode := mcmAddingCarets;
+ end;
+ ecPluginMultiCaretUnsetCaret: begin
+ exclude(FStateFlags, sfCreateCaretAtCurrentPos);
+ i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset);
+ if i >= 0 then
+ RemoveCaret(i);
+ ActiveMode := mcmAddingCarets;
+ end;
+ ecPluginMultiCaretToggleCaret: begin
+ i := Carets.FindCaretIdx(CaretObj.BytePos, CaretObj.LinePos, CaretObj.BytePosOffset);
+ if (i > 0) or (sfCreateCaretAtCurrentPos in FStateFlags) then begin
+ exclude(FStateFlags, sfCreateCaretAtCurrentPos);
+ if i >= 0 then
+ RemoveCaret(i);
+ end
+ else begin
+ include(FStateFlags, sfCreateCaretAtCurrentPos);
+ end;
+ ActiveMode := mcmAddingCarets;
+ end;
+ ecPluginMultiCaretClearAll: begin
+ ClearCarets;
+ if not SelectionObj.SelAvail then
+ SelectionObj.Clear; // clear invisibel selection
+ end;
+
+ ecPluginMultiCaretModeCancelOnMove: ActiveMode := mcmCancelOnCaretMove;
+ ecPluginMultiCaretModeMoveAll: ActiveMode := mcmMoveAllCarets;
+ else
+ Handled := False;
+ end;
+end;
+
+procedure TSynCustomPluginMultiCaret.ProcessAllSynCommand(Sender: TObject; AfterProcessing: boolean;
+ var Handled: boolean; var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer;
+ HandlerData: pointer);
+
+ procedure ExecCommandRepeated(AOnePerLine: Boolean = False);
+ var
+ i, y: Integer;
+ p: TLogCaretPoint;
+ skip, noChange, SelAvail, IsUser: Boolean;
+ MainY: Integer;
+ begin
+ Handled := True;
+ Editor.BeginUpdate(True);
+ FCarets.IncMergeLock;
+ try
+ AddCaret(Editor.LogicalCaretXY.x, Editor.CaretY, CaretObj.BytePosOffset,
+ [cfMainCaret, cfNoneVisual {, cfAddDuplicate}], CaretObj.KeepCaretXPos);
+
+ // Execute Command at current caret pos
+ Include(FStateFlags, sfProcessingMain);
+ Include(FStateFlags, sfNoChangeIndicator);
+ if Editor.SelAvail and (SelectionObj.ActiveSelectionMode = smColumn) then
+ SelectionObj.AddBeforeSetSelTextHandler(@DoBeforeSetSelText);
+ Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]);
+ SelectionObj.RemoveBeforeSetSelTextHandler(@DoBeforeSetSelText);
+ Exclude(FStateFlags, sfProcessingMain);
+ noChange := sfNoChangeIndicator in FStateFlags;
+ Exclude(FStateFlags, sfNoChangeIndicator);
+
+ if noChange then begin
+ if Carets.MainCaretIndex >= 0 then
+ RemoveCaret(Carets.MainCaretIndex)
+ else
+ assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found');
+ exit;
+ end;
+
+ // Repeat command
+ Include(FStateFlags, sfProcessingRepeat);
+ CaretObj.IncForcePastEOL;
+ skip := sfSkipCaretsAtSelection in FStateFlags;
+ MainY := CaretObj.LinePos;
+ SelAvail := Editor.SelAvail;
+ IsUser := Command >= ecUserFirst;
+
+ y := FSelY2;
+ Carets.StartIteratorAtLast;
+ while Carets.IterateNextDown do begin
+ if cfMainCaret in Carets.CurrentCaretFlags then
+ continue;
+ p := Carets.CurrentCaretFull;
+ if y > p.y then y := p.y;
+ if (skip) and (y >= FSelY1) and
+ (y = p.y) and (FSelX = p.x)
+ then begin
+ dec(y);
+ continue;
+ end;
+ if AOnePerLine and
+ ( (p.y = MainY) or
+ ( Carets.CanPeekCaret(-1) and (Carets.PeekCaretY(-1) = p.y) ) )
+ then
+ continue;
+
+ CaretObj.FullLogicalPos := p;
+ if IsUser and not SelAvail then
+ SelectionObj.StartLineBytePos := Point(p.x, p.y);
+ i := Carets.CurrentCaretKeepX;
+ if i > 0 then
+ CaretObj.KeepCaretXPos := i;
+ Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]);
+ Carets.CurrentCaretFull := CaretObj.FullLogicalPos;
+ Carets.CurrentCaretKeepX := -1;
+ end;
+
+ CaretObj.DecForcePastEOL;
+ Exclude(FStateFlags, sfProcessingRepeat);
+
+ if Carets.MainCaretIndex >= 0 then begin
+ CaretObj.FullLogicalPos := Carets.CaretFull[Carets.MainCaretIndex];
+ //CaretObj.KeepCaretXPos := Carets.CaretKeepX[Carets.MainCaretIndex];
+ RemoveCaret(Carets.MainCaretIndex);
+ end
+ else
+ assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found');
+ finally
+ Exclude(FStateFlags, sfSkipCaretsAtSelection);
+ FCarets.DecMergeLock;
+ MergeAndRemoveCarets;
+ Editor.EndUpdate;
+ end;
+ end;
+
+ procedure ExecCaretMoveRepeated;
+ var
+ k, xk: Integer;
+ c: TLogCaretPoint;
+ begin
+ Handled := True;
+ Editor.BeginUpdate(True);
+ FCarets.IncMergeLock;
+ try
+ // Execute Command at current caret pos
+ Include(FStateFlags, sfProcessingMain);
+ Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]);
+ c := CaretObj.FullLogicalPos;
+ xk := CaretObj.KeepCaretXPos;
+ Exclude(FStateFlags, sfProcessingMain);
+
+ // Repeat command
+ Include(FStateFlags, sfProcessingRepeat);
+ case Command of
+ ecLeft, ecUp, ecWordLeft, ecLineStart, ecPageUp, ecPageLeft,
+ ecPageTop, ecLineTextStart, ecWordEndLeft, ecHalfWordLeft:
+ begin
+ Carets.StartIteratorAtFirst;
+ while Carets.IterateNextUp do begin
+ CaretObj.FullLogicalPos := Carets.CurrentCaretFull;
+ k := Carets.CurrentCaretKeepX;
+ if k > 0 then
+ CaretObj.KeepCaretXPos := k;
+ Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]);
+ Carets.CurrentCaretFull := CaretObj.FullLogicalPos;
+ Carets.CurrentCaretKeepX := CaretObj.KeepCaretXPos;
+ end;
+ end;
+ ecEditorTop, ecEditorBottom: ClearCarets;
+ else
+ begin
+ Carets.StartIteratorAtLast;
+ while Carets.IterateNextDown do begin
+ CaretObj.FullLogicalPos := Carets.CurrentCaretFull;
+ k := Carets.CurrentCaretKeepX;
+ if k > 0 then
+ CaretObj.KeepCaretXPos := k;
+ Editor.CommandProcessor(Command, AChar, nil, [hcfInit, hcfFinish]);
+ Carets.CurrentCaretFull := CaretObj.FullLogicalPos;
+ Carets.CurrentCaretKeepX := CaretObj.KeepCaretXPos;
+ end;
+ end;
+ end;
+ Exclude(FStateFlags, sfProcessingRepeat);
+
+ finally
+ FCarets.DecMergeLock;
+ CaretObj.FullLogicalPos := c;
+ CaretObj.KeepCaretXPos := xk;
+ MergeAndRemoveCarets;
+ Editor.EndUpdate;
+ end;
+ end;
+
+ procedure StartEditing;
+ begin
+ Include(FStateFlags, sfProcessingCmd);
+ if (ActiveMode = mcmAddingCarets) and (not Editor.ReadOnly) then
+ ActiveMode := DefaultMode;
+ end;
+
+var
+ ClipHelper: TSynClipboardStream;
+ Action: TSynMultiCaretCommandAction;
+ Flags: TSynMultiCaretCommandFlags;
+begin
+ // hcfFinish
+ if AfterProcessing then begin
+ if (FNestedCommandProcessor > 0) then begin
+ dec(FNestedCommandProcessor);
+ exit;
+ end;
+
+ FStateFlags := FStateFlags - [sfProcessingCmd, sfSkipUndoCarets, sfExtendingColumnSel];
+ if (CaretsCount = 0) then
+ exit;
+
+ if IsCaretMergeRequested then
+ MergeAndRemoveCarets(True); // is case of several commands in one paintlock
+ UpdateCaretsPos;
+
+ exit;
+ end;
+
+
+ // hcfInit
+ (* use Editor.CommandProcessor(... SkipInit=[hcfInit, hcfFinish])
+ command is already initialized / prevent macro recorder from recording again.
+ *)
+
+ if (sfProcessingCmd in FStateFlags) then
+ inc(FNestedCommandProcessor);
+ if (sfProcessingCmd in FStateFlags) or (CaretsCount = 0) then
+ exit;
+ if Handled then
+ exit;
+
+
+ case Command of
+ ecCopy, ecCut: Action := ccaNoneRepeatCommand;
+ ecGotoMarker0..ecGotoMarker9: Action := ccaClearCarets;
+ ecSelectAll: Action := ccaClearCarets;
+ else
+ if Command >= ecUserFirst then
+ Action := ccaNoneRepeatCommand
+ else
+ Action := ccaDefaultAction;
+ end;
+ Flags := [];
+ if FOnBeforeCommand <> nil then
+ FOnBeforeCommand(Self, Command, Action, Flags);
+
+ case Action of
+ //ccaDefaultAction: ;
+ ccaNoneRepeatCommand: begin
+ exit;
+ end;
+ ccaRepeatCommand: begin
+ StartEditing;
+ ExecCommandRepeated;
+ exit;
+ end;
+ ccaRepeatCommandPerLine: begin
+ StartEditing;
+ ExecCommandRepeated(True);
+ exit;
+ end;
+ ccaClearCarets: begin
+ ClearCarets;
+ exit;
+ end;
+ ccaAdjustCarets: begin
+ Include(FStateFlags, sfProcessingCmd);
+ exit;
+ end;
+ end;
+
+ case Command of
+ // TODO: delete and smColumn -- only delete once
+ ecDeleteLastChar..ecDeleteLine,
+ ecLineBreak..ecChar:
+ begin
+ StartEditing;
+ if Editor.ReadOnly then exit;
+ ExecCommandRepeated;
+ end;
+ ecPaste:
+ begin
+ StartEditing;
+ if Editor.ReadOnly then exit;
+
+ if (SelectionObj.ActiveSelectionMode = smColumn) and
+ (SelectionObj.StartLinePos <> SelectionObj.EndLinePos)
+ then begin
+ ClipHelper := TSynClipboardStream.Create;
+ try
+ ClipHelper.ReadFromClipboard(Clipboard);
+ if ClipHelper.SelectionMode = smColumn then begin
+ Exclude(FStateFlags, sfProcessingCmd);
+ exit;
+ end;
+ finally
+ ClipHelper.Free;
+ end;
+ end;
+
+ ExecCommandRepeated;
+ end;
+ ecTab..ecShiftTab:
+ begin
+ StartEditing;
+ if Editor.ReadOnly then exit;
+ if (eoTabIndent in Editor.Options) and Editor.SelAvail then begin
+ if (SelectionObj.ActiveSelectionMode = smColumn) then begin
+ // no indent for column mode, when multicaret
+ Editor.BeginUpdate(True);
+ try
+ AddCaret(Editor.LogicalCaretXY.x, Editor.CaretY, CaretObj.BytePosOffset, [cfMainCaret, cfNoneVisual, cfAddDuplicate]);
+ Editor.SelText := '';
+ if Carets.MainCaretIndex >= 0 then begin
+ Editor.LogicalCaretXY := Carets.Caret[Carets.MainCaretIndex];
+ RemoveCaret(Carets.MainCaretIndex);
+ end
+ else
+ assert(False, 'TSynCustomPluginMultiCaret.ProcessAllSynCommand: Maincaret index not found');
+ ExecCommandRepeated;
+ finally
+ Editor.EndUpdate;
+ end;
+ end
+ else // exec once and adjust
+ exit;
+ end
+ else
+ ExecCommandRepeated;
+ end;
+ ecSelColCmdRangeStart..ecSelColCmdRangeEnd:
+ begin
+ Include(FStateFlags, sfSkipUndoCarets);
+ Include(FStateFlags, sfExtendingColumnSel);
+ end;
+ ecLeft..ecHalfWordRight: begin
+ Include(FStateFlags, sfSkipUndoCarets);
+ if ActiveMode = mcmMoveAllCarets then begin
+ Include(FStateFlags, sfProcessingCmd);
+ ExecCaretMoveRepeated;
+ end
+ else
+ if ActiveMode = mcmAddingCarets then
+ Include(FStateFlags, sfProcessingCmd)
+ else
+ ClearCarets;
+ end;
+ ecUndo, ecRedo:
+ begin
+ // handle now / prevent carets from being cleared
+ Include(FStateFlags, sfProcessingCmd);
+ Include(FStateFlags, sfSkipUndoCarets);
+ Carets.Clear(False, Carets.Capacity); // will be restored at end of undo
+ Editor.CommandProcessor(Command, AChar, data, [hcfInit, hcfFinish]);
+ Handled := True;
+ end;
+ ecPluginFirstMultiCaret..ecPluginLastMultiCaret: ; // ignore and handle in hcfPreExec
+ else
+ begin
+ StartEditing;
+ if Editor.ReadOnly then exit;
+ ExecCommandRepeated;
+ end;
+ end;
+
+ //Exclude(FStateFlags, sfSkipCaretsAtSelection);
+end;
+
+function TSynCustomPluginMultiCaret.MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
+ HandleActionProc: TSynEditMouseActionHandler): Boolean;
+begin
+ Result := HandleActionProc(FMouseActions, AnInfo);
+end;
+
+function TSynCustomPluginMultiCaret.DoHandleMouseAction(AnAction: TSynEditMouseAction;
+ var AnInfo: TSynEditMouseActionInfo): Boolean;
+var
+ i, j: Integer;
+begin
+ Result := False;
+
+ case AnAction.Command of
+ emcPluginMultiCaretToggleCaret:
+ begin
+ Result := True;
+ i := Carets.FindCaretIdx(AnInfo.NewCaret.BytePos, AnInfo.NewCaret.LinePos, AnInfo.NewCaret.BytePosOffset);
+ if i >= 0 then
+ RemoveCaret(i)
+ else
+ if (AnInfo.NewCaret.BytePos <> CaretObj.BytePos) or (AnInfo.NewCaret.LinePos <> CaretObj.LinePos) then begin
+ AddCaret(AnInfo.NewCaret.BytePos, AnInfo.NewCaret.LinePos, AnInfo.NewCaret.BytePosOffset);
+ end;
+ if CaretsCount > 0 then
+ ActiveMode := DefaultMode
+ else
+ ActiveMode := mcmNoCarets;
+ exclude(FStateFlags, sfCreateCaretAtCurrentPos);
+ end;
+ emcPluginMultiCaretSelectionToCarets:
+ begin
+ Result := True;
+ j := SelectionObj.LastLineBytePos.y;
+ i := SelectionObj.FirstLineBytePos.y;
+ SelectionObj.Clear;
+ CaretObj.LineBytePos := Point(Length(ViewedTextBuffer[ToIdx(j)])+1, j);
+ while i < j do begin
+ AddCaret(Length(ViewedTextBuffer[ToIdx(i)])+1, i, 0);
+ inc(i);
+ end;
+ if CaretsCount > 0 then
+ ActiveMode := DefaultMode;
+ if FPaintLock > 0 then
+ FStateFlags := FStateFlags + [sfSkipSelChanged, sfSkipCaretChanged];
+ end;
+ end;
+end;
+
+procedure TSynCustomPluginMultiCaret.AddStateFlags(AFlags: TSynPluginMultiCaretStateFlags;
+ AnOnlyIfLocked: Boolean);
+begin
+ if (not AnOnlyIfLocked) or (FPaintLock > 0) then
+ FStateFlags := FStateFlags + AFlags;
+end;
+
+function TSynCustomPluginMultiCaret.CreateVisual: TSynPluginMultiCaretVisual;
+begin
+ Result := inherited CreateVisual;
+ if FInPaint then
+ Result.BeginPaint(FPaintClip);
+end;
+
+constructor TSynCustomPluginMultiCaret.Create(AOwner: TComponent);
+begin
+ FMouseActions := TSynPluginMultiCaretMouseActions.Create(Self);
+ FMouseActions.ResetDefaults;
+ FKeyStrokes := TSynPluginMultiCaretKeyStrokes.Create(Self);
+ FKeyStrokes.ResetDefaults;
+ FEnableWithColumnSelection := True;
+ FActiveMode := mcmNoCarets;
+ FDefaultMode := mcmMoveAllCarets;
+ FDefaultColumnSelectMode := mcmCancelOnCaretMove;
+ inherited Create(AOwner);
+end;
+
+destructor TSynCustomPluginMultiCaret.Destroy;
+begin
+ inherited Destroy;
+ FreeAndNil(FMouseActions);
+ FreeAndNil(FKeyStrokes);
+end;
+
+procedure TSynCustomPluginMultiCaret.AddCaretAtLogPos(X, Y, Offs: Integer);
+begin
+ AddCaret(x, y, Offs);
+ if ActiveMode = mcmNoCarets then
+ ActiveMode := FDefaultMode;
+end;
+
+initialization
+ RegisterMouseCmdIdentProcs(@IdentToSynMouseCmd, @SynMouseCmdToIdent);
+ RegisterExtraGetEditorMouseCommandValues(@GetEditorMouseCommandValues);
+ RegisterMouseCmdNameAndOptProcs(@MouseCommandName, @MouseCommandConfigName);
+
+ RegisterKeyCmdIdentProcs(@IdentToKeyCommand, @KeyCommandToIdent);
+ RegisterExtraGetEditorCommandValues(@GetEditorCommandValues);
+
+{$IfDef SynMultiCaretDebug}
+ SynMCaretDebug := DebugLogger.FindOrRegisterLogGroup('SynMultiCaretDebug' {$IFDEF SynMultiCaretDebug} , True {$ENDIF} );
+{$ENDIF}
+end.
+
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synpluginsyncroedit.pp lazarus-1.6+dfsg/components/synedit/synpluginsyncroedit.pp
--- lazarus-1.4.4+dfsg/components/synedit/synpluginsyncroedit.pp 2015-01-26 16:06:53.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synpluginsyncroedit.pp 2015-02-06 18:25:31.000000000 +0000
@@ -26,9 +26,9 @@
interface
uses
- Classes, Controls, SysUtils, LCLProc, Forms, Graphics, SynEditMiscClasses,
+ Classes, Controls, SysUtils, Forms, Graphics, SynEditMiscClasses,
LCLType, SynEdit, SynPluginSyncronizedEditBase, LazSynEditText, SynEditMiscProcs,
- SynEditMouseCmds, SynEditKeyCmds, SynEditTypes, LCLIntf;
+ SynEditMouseCmds, SynEditKeyCmds, SynEditTypes, LCLIntf, LazUTF8;
type
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synpluginsyncronizededitbase.pp lazarus-1.6+dfsg/components/synedit/synpluginsyncronizededitbase.pp
--- lazarus-1.4.4+dfsg/components/synedit/synpluginsyncronizededitbase.pp 2013-05-22 01:01:29.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synpluginsyncronizededitbase.pp 2015-03-16 16:42:16.000000000 +0000
@@ -183,7 +183,7 @@
FAreaMarkupEnabled: Boolean;
FMarkupEnabled: Boolean;
FEnabled: Boolean;
- FEditing: Boolean;
+ FEditing: Boolean; // In ApplyChangeList, edit actions are caused by the plugin itself
FPaintLock: Integer;
FOwnPaintLock: Integer;
FTextBufferChanging: Boolean;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/synregexpr.pas lazarus-1.6+dfsg/components/synedit/synregexpr.pas
--- lazarus-1.4.4+dfsg/components/synedit/synregexpr.pas 2013-07-20 11:18:42.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/synregexpr.pas 2015-03-24 17:50:59.000000000 +0000
@@ -2245,6 +2245,8 @@
begin
Result := nil;
flagp := WORST; // Tentatively.
+ RangeBeg := #0;
+ ret := nil;
inc (regparse);
case (regparse - 1)^ of
@@ -3545,6 +3547,7 @@
function TRegExpr.GetInputString : RegExprString;
begin
+ Result := '';
if not Assigned (fInputString) then begin
Error (reeGetInputStringWithoutInputString);
EXIT;
@@ -3695,6 +3698,7 @@
end;
begin
+ Result := '';
// Check programm and input string
if not IsProgrammOk
then EXIT;
@@ -3704,10 +3708,8 @@
end;
// Prepare for working
TemplateLen := length (ATemplate);
- if TemplateLen = 0 then begin // prevent nil pointers
- Result := '';
+ if TemplateLen = 0 then // prevent nil pointers
EXIT;
- end;
TemplateBeg := pointer (ATemplate);
TemplateEnd := TemplateBeg + TemplateLen;
// Count result length for speed optimization.
@@ -3896,6 +3898,7 @@
function TRegExpr.DumpOp (op : TREOp) : RegExprString;
// printable representation of opcode
begin
+ Result := '';
case op of
BOL: Result := 'BOL';
EOL: Result := 'EOL';
@@ -3962,11 +3965,11 @@
Ch : REChar;
{$ENDIF}
begin
+ Result := '';
if not IsProgrammOk //###0.929
then EXIT;
op := EXACTLY;
- Result := '';
s := programm + REOpSz;
while op <> EEND do begin // While that wasn't END last time...
op := s^;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/syntextdrawer.pp lazarus-1.6+dfsg/components/synedit/syntextdrawer.pp
--- lazarus-1.4.4+dfsg/components/synedit/syntextdrawer.pp 2015-03-17 02:44:32.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/syntextdrawer.pp 2015-08-07 17:20:40.000000000 +0000
@@ -55,7 +55,7 @@
Added BaseStyle property to TheFontFont class.
==============================================================================}
-// $Id: syntextdrawer.pp 48403 2015-03-17 02:44:32Z martin $
+// $Id: syntextdrawer.pp 49612 2015-08-07 17:20:40Z juha $
// SynEdit note: The name had to be changed to get SynEdit to install
// together with mwEdit into the same Delphi installation
@@ -67,7 +67,7 @@
interface
uses
- LCLProc, LCLType, LCLIntf, SysUtils, Classes, Graphics, GraphUtil, Types,
+ Classes, Types, SysUtils, LCLProc, LCLType, LCLIntf, Graphics, GraphUtil,
SynEditTypes, SynEditMiscProcs;
type
@@ -224,7 +224,6 @@
function GetUseUTF8: boolean;
function GetMonoSpace: boolean;
function CreateColorPen(AColor: TColor; AStyle: LongWord = PS_SOLID): HPen;
- property StockDC: HDC read FDC;
property DrawingCount: Integer read FDrawingCount;
property FontStock: TheFontStock read FFontStock;
property BaseCharWidth: Integer read FBaseCharWidth;
@@ -277,6 +276,7 @@
property CharExtra: Integer read GetCharExtra write SetCharExtra;
property UseUTF8: boolean read GetUseUTF8;
property MonoSpace: boolean read GetMonoSpace;
+ property StockDC: HDC read FDC;
end;
{ TheTextDrawerEx }
diff -Nru lazarus-1.4.4+dfsg/components/synedit/test/testbase.pas lazarus-1.6+dfsg/components/synedit/test/testbase.pas
--- lazarus-1.4.4+dfsg/components/synedit/test/testbase.pas 2015-01-24 17:10:25.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/test/testbase.pas 2015-03-11 18:27:30.000000000 +0000
@@ -103,6 +103,7 @@
procedure TearDown; override;
public
procedure TestIsCaret(Name: String; X, Y: Integer); // logical caret
+ procedure TestIsCaret(Name: String; X, Y, Offs: Integer); // logical caret
procedure TestIsCaretPhys(Name: String; X, Y: Integer);
procedure TestIsCaretAndSel(Name: String; LogX1, LogY1, LogX2, LogY2: Integer); // logical caret
procedure TestIsCaretAndSelBackward(Name: String; LogX1, LogY1, LogX2, LogY2: Integer); // logical caret
@@ -121,6 +122,13 @@
procedure TestIsFullText(Name: String; Lines: Array of String);
procedure TestIsFullText(Name: String; Lines: Array of String; Repl: Array of const);
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y: Integer; Text: String); // logical caret
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y: Integer; Lines: Array of String); // logical caret
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y: Integer; Lines: Array of String; Repl: Array of const); // logical caret
+
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer; Text: String); // logical caret
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer; Lines: Array of String); // logical caret
+ procedure TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer; Lines: Array of String; Repl: Array of const); // logical caret
end;
function MyDbg(t: String): String;
@@ -269,6 +277,16 @@
Format('X/Y=(%d, %d)', [SynEdit.LogicalCaretXY.X, SynEdit.LogicalCaretXY.Y]));
end;
+procedure TTestBase.TestIsCaret(Name: String; X, Y, Offs: Integer);
+begin
+ if (SynEdit.LogicalCaretXY.X <> X) or (SynEdit.LogicalCaretXY.Y <> Y) or
+ (SynEdit.CaretObj.BytePosOffset <> Offs)
+ then
+ TestFail(Name, 'IsCaret',
+ Format('X/Y=(%d, %d, %d)', [X, Y, Offs]),
+ Format('X/Y=(%d, %d, %d)', [SynEdit.LogicalCaretXY.X, SynEdit.LogicalCaretXY.Y, SynEdit.CaretObj.BytePosOffset]));
+end;
+
procedure TTestBase.TestIsCaretPhys(Name: String; X, Y: Integer);
begin
if (SynEdit.CaretXY.X <> X) or (SynEdit.CaretXY.Y <> Y) then
@@ -400,6 +418,46 @@
TestIsFullText(Name, LinesToText(LinesReplace(Lines, Repl)));
end;
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y: Integer; Text: String);
+begin
+ TestIsCaret(Name, X, Y);
+ TestIsFullText(Name, Text);
+end;
+
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y: Integer;
+ Lines: array of String);
+begin
+ TestIsCaret(Name, X, Y);
+ TestIsFullText(Name, Lines);
+end;
+
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y: Integer;
+ Lines: array of String; Repl: array of const);
+begin
+ TestIsCaret(Name, X, Y);
+ TestIsFullText(Name, Lines, Repl);
+end;
+
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer; Text: String);
+begin
+ TestIsCaret(Name, X, Y, Offs);
+ TestIsFullText(Name, Text);
+end;
+
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer;
+ Lines: array of String);
+begin
+ TestIsCaret(Name, X, Y, Offs);
+ TestIsFullText(Name, Lines);
+end;
+
+procedure TTestBase.TestIsCaretLogAndFullText(Name: String; X, Y, Offs: Integer;
+ Lines: array of String; Repl: array of const);
+begin
+ TestIsCaret(Name, X, Y, Offs);
+ TestIsFullText(Name, Lines, Repl);
+end;
+
procedure TTestBase.TestFail(Name, Func, Expect, Got: String; Result: Boolean = False);
begin
if Result then exit;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/test/testbasicsynedit.pas lazarus-1.6+dfsg/components/synedit/test/testbasicsynedit.pas
--- lazarus-1.4.4+dfsg/components/synedit/test/testbasicsynedit.pas 2015-01-24 17:10:25.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/test/testbasicsynedit.pas 2015-03-30 22:58:24.000000000 +0000
@@ -2342,6 +2342,17 @@
TestCoord(Name, ExpSearchCoord);
PopBaseName;
+ PushBaseName('Search ssoRegExprMultiLine');
+ SetLines(TheTestText);
+ if NextTestSetSelection.BBx > 0 then
+ with NextTestSetSelection do SetCaretAndSel(BBx, BBy, BEx, BEy)
+ else
+ SetCaret(CaretX, CaretY);
+ got := SynEdit.SearchReplace(Find, '', SrcOpts - [ssoReplace, ssoReplaceAll]+[ssoRegExprMultiLine]);
+ AssertEquals(BaseTestName + Name + 'Result Count', Min(ExpCnt,1), got);
+ TestCoord(Name, ExpSearchCoord);
+ PopBaseName;
+
if (SrcOpts * [ssoReplace, ssoReplaceAll]) = [] then exit;
PushBaseName('Replace');
@@ -2356,6 +2367,18 @@
TestCoord(Name, ExpReplCoord);
PopBaseName;
+ PushBaseName('Replace ssoRegExprMultiLine');
+ SetLines(TheTestText);
+ if NextTestSetSelection.BBx > 0 then
+ with NextTestSetSelection do SetCaretAndSel(BBx, BBy, BEx, BEy)
+ else
+ SetCaret(CaretX, CaretY);
+ got := SynEdit.SearchReplace(Find, Repl, SrcOpts+[ssoRegExprMultiLine]);
+ AssertEquals(BaseTestName + Name + 'Result Count', ExpCnt, got);
+ TestIsText(Name + 'Result Text', TheTestText, ExpTxt);
+ TestCoord(Name, ExpReplCoord);
+ PopBaseName;
+
NextTestSetSelection := expCNo(-1,-1);
end;
@@ -2390,6 +2413,7 @@
begin
TheTestText := TestText1;
txl := length(TheTestText)-1;
+ NextTestSetSelection := nextSel(0,0, 0,0);
PushBaseName('Find single line term ');
PushBaseName('no match ');
diff -Nru lazarus-1.4.4+dfsg/components/synedit/test/testhighlightpas.pas lazarus-1.6+dfsg/components/synedit/test/testhighlightpas.pas
--- lazarus-1.4.4+dfsg/components/synedit/test/testhighlightpas.pas 2014-01-26 15:16:02.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/test/testhighlightpas.pas 2015-01-25 15:20:40.000000000 +0000
@@ -58,6 +58,7 @@
procedure TestContextForClassHelper;
procedure TestContextForRecordHelper;
procedure TestContextForStatic;
+ procedure TestCaretAsString;
procedure TestFoldNodeInfo;
end;
@@ -1076,6 +1077,93 @@
]);
end;
+procedure TTestHighlighterPas.TestCaretAsString;
+begin
+ ReCreateEdit;
+ SetLines
+ ([ 'Unit A; interface', // 0
+ 'var',
+ 'a:char=^o;',
+ 'b:^char=nil;',
+ 'type',
+ 'c=^char;', // 5
+ 'implementation',
+ 'function x(f:^char=^k):^v;', // actually the compiler does not allow ^ as pointer for result
+ 'var',
+ 'a:char=^o;',
+ 'b:^char=nil;', // 10
+ 'type',
+ 'c=^char;',
+ 'begin',
+ 'i:=^f;',
+ 'x:=GetTypeData(PropInfo^.PropType{$IFNDEF FPC}^{$ENDIF});', // 15
+ 'c:=p^;',
+ 'c:=p ^;',
+ 'c:=p(**)^;',
+ 'c:=p{} ^;',
+ 'i:=f(1)^;', // 20
+ 'i:=f[1]^;',
+ 'i:=f^^;',
+ 'c:=p^+^i''e''^a#13^x;',
+ 'c:=x=^a and ^a=k and(^a^a=z);',
+ 'end;',
+ ''
+ ]);
+
+ CheckTokensForLine('a:char=^o;', 2,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
+ CheckTokensForLine('b:^char=nil;', 3,
+ [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
+ CheckTokensForLine('c=^char;', 5,
+ [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
+
+ CheckTokensForLine('function x(f:^char=^k):^v;', 7,
+ [tkKey, tkSpace, tkIdentifier, tkSymbol, tkIdentifier, // function x(f
+ tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkString, // :^char=^k
+ tkSymbol, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]); // ):^v;
+ CheckTokensForLine('LOCAL a:char=^o;', 9,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSymbol]);
+ CheckTokensForLine('LOCAL b:^char=nil;', 10,
+ [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol, tkKey, tkSymbol]);
+ CheckTokensForLine('LOCAL c=^char;', 12,
+ [tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, tkSymbol]);
+ CheckTokensForLine('i:=^f', 14,
+ [tkIdentifier, tkSymbol, tkString, tkSymbol]);
+
+ CheckTokensForLine('x:=GetTypeData(PropInfo^.PropType{$IFNDEF FPC}^{$ENDIF});', 15,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, // x:=GetTypeData(
+ tkIdentifier, tkSymbol, tkSymbol, tkIdentifier, // PropInfo^.PropType
+ tkDirective, tkSymbol, tkDirective, tkSymbol, tkSymbol]); // {$IFNDEF FPC}^{$ENDIF});
+
+ CheckTokensForLine('c:=p^;', 16,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkSymbol]);
+ CheckTokensForLine('c:=p ^;', 17,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSpace, tkSymbol, tkSymbol]);
+ CheckTokensForLine('c:=p(**)^;', 18,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkComment, tkSymbol, tkSymbol]);
+ CheckTokensForLine('c:=p{} ^;', 19,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkComment, tkSpace, tkSymbol, tkSymbol]);
+
+ CheckTokensForLine('c:=p(1)^;', 20,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkNumber, tkSymbol, tkSymbol]);
+ CheckTokensForLine('c:=p[1]^;', 21,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkNumber, tkSymbol, tkSymbol]);
+ CheckTokensForLine('c:=p^^;', 22,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkSymbol, tkSymbol]);
+
+ CheckTokensForLine('c:=p^+^i''e''^a#13^x;', 23,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkSymbol, // c:=p^+
+ tkString, tkString, tkString, tkString, tkString, tkSymbol // ^i'e'^a#13^x;
+ ]);
+ CheckTokensForLine('c:=x=^a and ^a=k and(^a^a=z);', 24,
+ [tkIdentifier, tkSymbol, tkIdentifier, tkSymbol, tkString, tkSpace, // c:=x=^a
+ tkKey, tkSpace, tkString, tkSymbol, tkIdentifier, tkSpace, // and ^a=k
+ tkKey, tkSymbol, tkString, tkString, tkSymbol, tkIdentifier, // and(^a^a=z
+ tkSymbol, tkSymbol // );'
+ ]);
+
+end;
+
procedure TTestHighlighterPas.TestFoldNodeInfo;
Procedure CheckNode(ALine: TLineIdx; AFilter: TSynFoldActions; AFoldGroup: Integer;
AColumn: integer;
diff -Nru lazarus-1.4.4+dfsg/components/synedit/test/testmulticaret.pas lazarus-1.6+dfsg/components/synedit/test/testmulticaret.pas
--- lazarus-1.4.4+dfsg/components/synedit/test/testmulticaret.pas 1970-01-01 00:00:00.000000000 +0000
+++ lazarus-1.6+dfsg/components/synedit/test/testmulticaret.pas 2015-03-16 16:42:16.000000000 +0000
@@ -0,0 +1,1582 @@
+unit TestMultiCaret;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, TestBase, SynEditKeyCmds, SynPluginMultiCaret, SynEdit, Clipbrd, Forms,
+ testregistry;
+
+type
+
+ TSynPluginMultiCaretTest = class(TSynPluginMultiCaret)
+ public
+ property Carets;
+ end;
+
+ { TTestMultiCaret }
+
+ TTestMultiCaret = class(TTestBase)
+ protected
+ FMultiCaret, FMultiCaret2: TSynPluginMultiCaretTest;
+ FOptAdd, FOptRemove: TSynEditorOptions;
+ FOpt2Add, FOpt2Remove: TSynEditorOptions2;
+ FEnableWithColumnSelection: Boolean;
+ FDefaultMode: TSynPluginMultiCaretDefaultMode;
+ FDefaultColumnSelectMode: TSynPluginMultiCaretDefaultMode;
+ FSynEdit2: TTestSynEdit;
+
+ procedure SetUp; override;
+ procedure TearDown; override;
+
+
+ procedure SetCaretAndColumnSelect(X, Y, Down, Right: Integer);
+ procedure SetCaretsByKey(X, Y: Integer; CaretMoves: Array of Integer; EndMode: TSynPluginMultiCaretMode = mcmAddingCarets); // [ {SET}, Right,DOwn, {SET}, Right,DOwn,..]
+ procedure SetCaretsByKey(CaretMoves: Array of Integer; EndMode: TSynPluginMultiCaretMode = mcmAddingCarets); // [ {SET}, Right,DOwn, {SET}, Right,DOwn,..]
+
+ procedure TestExtraCaretCount(AName: String; ExpCount: Integer);
+ procedure TestExtraCaretPos(AName: String; ExpCount: Integer; ExpPos: array of integer); // x,y
+ procedure TestExtraCaretPosAndOffs(AName: String; ExpCount: Integer; ExpPos: array of integer); // x,y,offs
+
+ procedure TestExtraCaretPos(AName: String; X, Y: Integer; ExpCount: Integer; ExpPos: array of integer); // x,y
+ procedure TestExtraCaretPosAndOffs(AName: String; X, Y, Offs: Integer; ExpCount: Integer; ExpPos: array of integer); // x,y,offs
+
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; chars: array of String;
+ X, Y: Integer; ExpLines: Array of String
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; // no chars
+ X, Y: Integer; ExpLines: Array of String
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; chars: array of String;
+ X, Y, Offs: Integer; ExpLines: Array of String
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; // no chars
+ X, Y, Offs: Integer; ExpLines: Array of String
+ );
+
+
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; chars: array of String;
+ X, Y: Integer; ExpLines: Array of String;
+ ExpCount: Integer; ExpPos: array of integer // x, [offs,] y
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; // no chars
+ X, Y: Integer; ExpLines: Array of String;
+ ExpCount: Integer; ExpPos: array of integer // x, [offs,] y
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; chars: array of String;
+ X, Y, Offs: Integer; ExpLines: Array of String;
+ ExpCount: Integer; ExpPos: array of integer // x, [offs,] y
+ );
+ procedure RunAndTest(AName: String;
+ cmds: Array of TSynEditorCommand; // no chars
+ X, Y, Offs: Integer; ExpLines: Array of String;
+ ExpCount: Integer; ExpPos: array of integer // x, [offs,] y
+ );
+
+ // y1/2 1-based
+ function DelCol(Lines: Array of String; y1,y2,X: Integer; Cnt: Integer = 1): TStringArray;
+ // ADel: y,x,cnt, y,x,cnt, .... 1-based
+ function DelCol(Lines: Array of String; ADel: Array of Integer): TStringArray;
+
+ function TestText1: TStringArray;
+ function TestText1(DelY1, DelY2, DelX: Integer; DelCnt: Integer = 1): TStringArray;
+ function TestText1(ADel: Array of Integer): TStringArray;
+ function TestText2: TStringArray;
+ function TestText2(DelY1, DelY2, DelX: Integer; DelCnt: Integer = 1): TStringArray;
+ function TestText2(ADel: Array of Integer): TStringArray;
+ public
+ procedure ReCreateEdit; reintroduce;
+ procedure ReCreateEdit(ALines: TStringArray);
+ procedure ReCreateSharedEdit(Reverse: boolean = False);
+ procedure SwapEdit; reintroduce;
+
+ procedure RunCmdSeq(cmds: Array of TSynEditorCommand; chars: array of String);
+ published
+ procedure CaretList;
+ procedure ColumnSelect;
+ procedure CursorMove;
+ procedure Edit;
+ procedure Delete;
+ procedure ReplaceColSel;
+ procedure TabKey;
+ procedure Paste;
+ procedure Undo;
+ end;
+
+implementation
+
+{ TTestMultiCaret }
+
+procedure TTestMultiCaret.SetUp;
+begin
+ FOptAdd := [];
+ FOptRemove := [];
+ FOpt2Add := [];
+ FOpt2Remove := [];
+ FEnableWithColumnSelection := True;
+ FDefaultMode := mcmMoveAllCarets;
+ FDefaultColumnSelectMode := mcmCancelOnCaretMove;
+
+ inherited SetUp;
+end;
+
+procedure TTestMultiCaret.TearDown;
+begin
+ FreeAndNil(FSynEdit2);
+ inherited TearDown;
+end;
+
+procedure TTestMultiCaret.SetCaretAndColumnSelect(X, Y, Down, Right: Integer);
+var
+ i: Integer;
+begin
+ SetCaret(X, Y);
+ if Down > 0 then
+ for i := 1 to Down do
+ RunCmdSeq([ecColSelDown], [])
+ else
+ if Down < 0 then
+ for i := 1 to -Down do
+ RunCmdSeq([ecColSelUp], []);
+
+ if Right > 0 then
+ for i := 1 to Right do
+ RunCmdSeq([ecColSelRight], [])
+ else
+ if Right < 0 then
+ for i := 1 to -Right do
+ RunCmdSeq([ecColSelLeft], []);
+end;
+
+procedure TTestMultiCaret.SetCaretsByKey(X, Y: Integer; CaretMoves: array of Integer;
+ EndMode: TSynPluginMultiCaretMode);
+begin
+ SetCaret(X, Y);
+ SetCaretsByKey(CaretMoves, EndMode);
+end;
+
+procedure TTestMultiCaret.SetCaretsByKey(CaretMoves: array of Integer;
+ EndMode: TSynPluginMultiCaretMode);
+var
+ i, j: Integer;
+begin
+ for i := 0 to (Length(CaretMoves) div 2) - 1 do begin
+ RunCmdSeq([ecPluginMultiCaretSetCaret], []);
+ if CaretMoves[i*2+1] > 0 then
+ for j := 1 to CaretMoves[i*2+1] do
+ RunCmdSeq([ecDown], [])
+ else
+ if CaretMoves[i*2+1] < 0 then
+ for j := 1 to -CaretMoves[i*2+1] do
+ RunCmdSeq([ecUp], []);
+
+ if CaretMoves[i*2+0] > 0 then
+ for j := 1 to CaretMoves[i*2+0] do
+ RunCmdSeq([ecRight], [])
+ else
+ if CaretMoves[i*2+0] < 0 then
+ for j := 1 to -CaretMoves[i*2+0] do
+ RunCmdSeq([ecLeft], []);
+ end;
+ FMultiCaret.ActiveMode := EndMode;
+end;
+
+procedure TTestMultiCaret.TestExtraCaretCount(AName: String; ExpCount: Integer);
+begin
+ AssertEquals(BaseTestName+' '+AName + ' extra count', ExpCount, FMultiCaret.Carets.Count);
+end;
+
+procedure TTestMultiCaret.TestExtraCaretPos(AName: String; ExpCount: Integer;
+ ExpPos: array of integer);
+var
+ i: Integer;
+begin
+ AssertEquals(BaseTestName+' '+AName + ' extra count', ExpCount, FMultiCaret.Carets.Count);
+ AssertEquals(BaseTestName+' '+AName + 'selftest',length(ExpPos), ExpCount*2);
+ for i := 0 to ExpCount - 1 do begin
+ AssertEquals(BaseTestName+' '+AName + ' extra pos x', ExpPos[i*2+0], FMultiCaret.Carets.CaretX[i]);
+ AssertEquals(BaseTestName+' '+AName + ' extra pos y', ExpPos[i*2+1], FMultiCaret.Carets.CaretY[i]);
+ end
+end;
+
+procedure TTestMultiCaret.TestExtraCaretPosAndOffs(AName: String; ExpCount: Integer;
+ ExpPos: array of integer);
+var
+ i: Integer;
+begin
+ AssertEquals(BaseTestName+' '+AName + ' extra count', ExpCount, FMultiCaret.Carets.Count);
+ AssertEquals(BaseTestName+' '+AName + 'selftest',length(ExpPos), ExpCount*3);
+ for i := 0 to ExpCount - 1 do begin
+ AssertEquals(BaseTestName+' '+AName + ' extra pos x', ExpPos[i*3+0], FMultiCaret.Carets.CaretX[i]);
+ AssertEquals(BaseTestName+' '+AName + ' extra pos y', ExpPos[i*3+1], FMultiCaret.Carets.CaretY[i]);
+ AssertEquals(BaseTestName+' '+AName + ' extra pos O', ExpPos[i*3+2], FMultiCaret.Carets.CaretOffs[i]);
+ end
+end;
+
+procedure TTestMultiCaret.TestExtraCaretPos(AName: String; X, Y: Integer; ExpCount: Integer;
+ ExpPos: array of integer);
+begin
+ TestIsCaret(AName, X, Y);
+ TestExtraCaretPos(AName, ExpCount, ExpPos);
+end;
+
+procedure TTestMultiCaret.TestExtraCaretPosAndOffs(AName: String; X, Y, Offs: Integer;
+ ExpCount: Integer; ExpPos: array of integer);
+begin
+ TestIsCaret(AName, X, Y, Offs);
+ TestExtraCaretPosAndOffs(AName, ExpCount, ExpPos);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand;
+ chars: array of String; X, Y: Integer; ExpLines: array of String);
+begin
+ RunCmdSeq(cmds, chars);
+ TestIsCaretLogAndFullText(AName, X, Y, ExpLines);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand; X,
+ Y: Integer; ExpLines: array of String);
+begin
+ RunAndTest(AName, cmds, [], X, Y, ExpLines);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand;
+ chars: array of String; X, Y, Offs: Integer; ExpLines: array of String);
+begin
+ RunCmdSeq(cmds, chars);
+ TestIsCaretLogAndFullText(AName, X, Y, Offs, ExpLines);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand; X, Y,
+ Offs: Integer; ExpLines: array of String);
+begin
+ RunAndTest(AName, cmds, [], X, Y, Offs, ExpLines);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand;
+ chars: array of String; X, Y: Integer; ExpLines: array of String; ExpCount: Integer;
+ ExpPos: array of integer);
+begin
+ RunAndTest(AName, cmds, chars, X, Y, 0, ExpLines, ExpCount, ExpPos);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand; X,
+ Y: Integer; ExpLines: array of String; ExpCount: Integer; ExpPos: array of integer);
+begin
+ RunAndTest(AName, cmds, [], X, Y, ExpLines, ExpCount, ExpPos);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand;
+ chars: array of String; X, Y, Offs: Integer; ExpLines: array of String; ExpCount: Integer;
+ ExpPos: array of integer);
+begin
+ RunAndTest(AName, cmds, chars, X, Y, Offs, ExpLines);
+ if length(ExpPos) = 0 then
+ TestExtraCaretCount(AName, ExpCount)
+ else
+ if length(ExpPos) = ExpCount * 2 then
+ TestExtraCaretPos(AName, ExpCount, ExpPos)
+ else
+ if length(ExpPos) = ExpCount * 3 then
+ TestExtraCaretPosAndOffs(AName, ExpCount, ExpPos)
+ else
+ AssertTrue(BaseTestName+' '+AName + 'selftest CaretCOUNT <> pos-array-len', false);
+end;
+
+procedure TTestMultiCaret.RunAndTest(AName: String; cmds: array of TSynEditorCommand; X, Y,
+ Offs: Integer; ExpLines: array of String; ExpCount: Integer; ExpPos: array of integer);
+begin
+ RunAndTest(AName, cmds, [], X, Y, Offs, ExpLines, ExpCount, ExpPos);
+end;
+
+function TTestMultiCaret.DelCol(Lines: array of String; y1, y2, X: Integer;
+ Cnt: Integer): TStringArray;
+var
+ i: Integer;
+begin
+ SetLength(Result, length(Lines));
+ for i := 0 to high(Lines) do
+ Result[i] := Lines[i];
+ for i := y1-1 to y2-1 do
+ system.Delete(Result[i], X, Cnt);
+end;
+
+function TTestMultiCaret.DelCol(Lines: array of String; ADel: array of Integer): TStringArray;
+var
+ i: Integer;
+begin
+ SetLength(Result, length(Lines));
+ for i := 0 to high(Lines) do
+ Result[i] := Lines[i];
+ for i := 0 to (length(ADel) div 3) - 1 do
+ system.Delete(Result[ADel[i*3+0]-1], ADel[i*3+1], ADel[i*3+2]);
+end;
+
+function TTestMultiCaret.TestText1: TStringArray;
+begin
+ SetLength(Result, 8);
+ Result[0] := '1abc def gh';
+ Result[1] := '2mno pqr st';
+ Result[2] := '3ABC DEF GH';
+ Result[3] := '4MNO PQR ST';
+ Result[4] := '5xyz klm op';
+ Result[5] := '6aA bB cC dD';
+ Result[6] := '7mM nN oO pP';
+ Result[7] := '';
+end;
+
+function TTestMultiCaret.TestText1(DelY1, DelY2, DelX: Integer; DelCnt: Integer): TStringArray;
+begin
+ Result := DelCol(TestText1(), DelY1, DelY2, DelX, DelCnt);
+end;
+
+function TTestMultiCaret.TestText1(ADel: array of Integer): TStringArray;
+begin
+ Result := DelCol(TestText1(), ADel);
+end;
+
+function TTestMultiCaret.TestText2: TStringArray;
+begin
+ SetLength(Result, 18);
+ Result[0] := '1abc def gh';
+ Result[1] := '2mno pqr st';
+ Result[2] := '1abc def gh Oo xx 99';
+ Result[3] := '2äöü pqr st Oo xx 99';
+ Result[4] := '3ÄÖÜ DEF GH Oo xx 99';
+ Result[5] := '4MNä PQR ST Oo xx 99';
+ Result[6] := '5xyÜ klm op';
+ Result[7] := '6aA b'#9#9'B cC dD';
+ Result[8] := '7mM n'#9#9'N oO pP';
+ Result[9] := '6aA b'#9#9'B cC dD';
+ Result[10] := '1abc アアウ gh Oo xx 99';
+ Result[11] := '2mno pqr アウ Oo xx 99';
+ Result[12] := '3アアウアアウ GH Oo xx 99';
+ Result[13] := '4Mアアウアアウ ST Oo xx 99';
+ Result[14] := '5xyz klm op bB cC dD';
+ Result[15] := '6a'#9#9#9#9'A';
+ Result[16] := '7mM nN oO pP';
+ Result[17] := '';
+end;
+
+function TTestMultiCaret.TestText2(DelY1, DelY2, DelX: Integer; DelCnt: Integer): TStringArray;
+begin
+ Result := DelCol(TestText2(), DelY1, DelY2, DelX, DelCnt);
+end;
+
+function TTestMultiCaret.TestText2(ADel: array of Integer): TStringArray;
+begin
+ Result := DelCol(TestText2(), ADel);
+end;
+
+procedure TTestMultiCaret.ReCreateEdit;
+begin
+ inherited;
+ FMultiCaret := TSynPluginMultiCaretTest.Create(SynEdit);
+
+ SynEdit.Options := SynEdit.Options - FOptRemove + FOptAdd;
+ SynEdit.Options2 := SynEdit.Options2 - FOpt2Remove + FOpt2Add;
+
+ FMultiCaret.EnableWithColumnSelection := FEnableWithColumnSelection;
+ FMultiCaret.DefaultMode := FDefaultMode;
+ FMultiCaret.DefaultColumnSelectMode := FDefaultColumnSelectMode;
+
+ SynEdit.BlockIndent := 2;
+ SynEdit.BlockTabIndent := 0;
+ SynEdit.TabWidth := 4;
+end;
+
+procedure TTestMultiCaret.ReCreateEdit(ALines: TStringArray);
+begin
+ ReCreateEdit;
+ SetLines(ALines);
+end;
+
+procedure TTestMultiCaret.ReCreateSharedEdit(Reverse: boolean);
+begin
+ FSynEdit2.Free;
+ Form.Height := 600;
+ Form.Width := 500;
+
+ FSynEdit2 := TTestSynEdit.Create(Form);
+ FSynEdit2.Parent := Form;
+ FSynEdit2.Top := 250;
+ FSynEdit2.Left := 0;
+ FSynEdit2.Width:= 500;
+ FSynEdit2.Height := 250;
+
+ FMultiCaret2 := TSynPluginMultiCaretTest.Create(FSynEdit2);
+
+ if Reverse then begin
+ FSynEdit2.Lines.Assign(FSynEdit.Lines);
+ FSynEdit.ShareTextBufferFrom(FSynEdit2)
+ end
+ else
+ FSynEdit2.ShareTextBufferFrom(FSynEdit);
+end;
+
+procedure TTestMultiCaret.SwapEdit;
+var
+ m: TSynPluginMultiCaretTest;
+ e: TTestSynEdit;
+begin
+ m := FMultiCaret;
+ e := FSynEdit;
+
+ FMultiCaret := FMultiCaret2;
+ FSynEdit := FSynEdit2;
+
+ FMultiCaret2 := m;
+ FSynEdit2 := e;
+end;
+
+procedure TTestMultiCaret.RunCmdSeq(cmds: array of TSynEditorCommand; chars: array of String);
+var
+ i, j: Integer;
+ a: String;
+begin
+ j := 0;
+ for i := 0 to high(cmds) do begin
+ a := '';
+ if (cmds[i] = ecChar) and (j <= high(chars)) then begin
+ a := chars[j];
+ inc(j);
+ end;
+ SynEdit.CommandProcessor(cmds[i], a, nil);
+ Application.ProcessMessages;
+ end;
+end;
+
+procedure TTestMultiCaret.CaretList;
+ procedure TestSequence(name: string; a: Array of Integer);
+ var
+ c: TSynPluginMultiCaretList;
+ i, j, k, n, m: Integer;
+ begin
+
+ c := TSynPluginMultiCaretList.Create;
+ for i := 0 to high(a) do begin
+ c.AddCaret(1,a[i],0);
+ for j := 1 to c.Count-1 do
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+ end;
+
+ c.Clear;
+ for i := 0 to high(a) do begin
+ k := c.AddCaret(1,a[i],0);
+ AssertEquals(Format(name+' Test %d %d', [i, j]),a[i], c.Caret[k].y);
+ for j := 1 to c.Count-1 do
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+ end;
+
+ c.Clear;
+ for i := 0 to high(a) do begin
+ c.AddCaret(1,a[i],0);
+ end;
+ for j := 1 to c.Count-1 do
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+
+ c.Clear;
+ for i := high(a) downto 0 do begin
+ k := c.AddCaret(1,a[i],0);
+ AssertEquals(Format(name+' Test %d %d', [i, j]),a[i], c.Caret[k].y);
+ for j := 1 to c.Count-1 do
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+ end;
+
+
+ for m := 0 to length(a)-1 do begin
+ for n := 0 to m do begin
+ c.Clear;
+ for i := 0 to m do begin
+ k := c.AddCaret(1,a[i],0);
+ AssertEquals(Format(name+' Test %d %d', [i, j]),a[i], c.Caret[k].y);
+ end;
+ for j := 1 to c.Count-1 do
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+ k := c.Caret[n].y;
+ c.RemoveCaret(n);
+ for j := 1 to c.Count-1 do begin
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y > c.Caret[j-1].y);
+ AssertTrue(Format(name+' Test %d %d', [i, j]), c.Caret[j].y <> k);
+ end;
+
+
+ end;
+ end;
+
+ c.Free;
+ end;
+ procedure TestSequenceEx(n: string; a: Array of Integer);
+ var
+ i, j: Integer;
+ b: Array of Integer;
+ begin
+ for i := 1 to length(a) do begin
+ TestSequence(n+IntToStr(i),a);
+ j := a[0];
+ if Length(a) > 1 then
+ move(a[1],a[0],(Length(a)-1)*SizeOf(a[0]));
+ a[high(a)] := j;
+ end;
+
+ SetLength(b, Length(a));
+ for i := 0 to length(a)-1 do
+ b[i] := a[high(a)-i];
+
+ for i := 1 to length(b) do begin
+ TestSequence(n+IntToStr(i),b);
+ j := b[0];
+ if Length(b) > 1 then
+ move(b[1],b[0],(Length(b)-1)*SizeOf(b[0]));
+ b[high(b)] := j;
+ end;
+ end;
+begin
+ TestSequence('XXX', [3,2,1,12,11,10,9,8,7,6,5,4]);
+ TestSequence('XXX', [4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3]);
+
+ TestSequenceEx('1', [1,2]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,8,9,10,11,12]);
+ TestSequenceEx('1', [1,99,2,98,3,97,4,96,5,95,6,94]);
+ TestSequenceEx('1', [1,2,99,98,3,4,97,96,5,6,95,94,7,8,93,92,9,10]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,8,9,10,11,12,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,8,9,10,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,8,9,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,8,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,6,7,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,6,-1]);
+ TestSequenceEx('1', [1,2,3,4,5,-1]);
+ TestSequenceEx('1', [1,2,3,4,-1]);
+end;
+
+procedure TTestMultiCaret.ColumnSelect;
+begin
+ PushBaseName('Simple 0 width col select ep/down');
+ ReCreateEdit(TestText1);
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelUp], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelUp], 3,3, TestText1, 0, []);
+ RunAndTest('', [ecColSelUp], 3,2, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,3, TestText1, 0, []);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ PopPushBaseName('column sel left/right');
+ RunAndTest('', [ecColSelLeft], 2,5, TestText1, 2, [2,3,0, 2,4,0]);
+ RunAndTest('', [ecColSelRight], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelRight], 4,5, TestText1, 2, [4,3,0, 4,4,0]);
+ RunAndTest('', [ecColSelRight], 5,5, TestText1, 2, [5,3,0, 5,4,0]);
+ PopPushBaseName('column sel, 2 width up/down');
+ RunAndTest('', [ecColSelDown], 5,6, TestText1, 3, [5,3,0, 5,4,0, 5,5,0]);
+ RunAndTest('', [ecColSelUp], 5,5, TestText1, 2, [5,3,0, 5,4,0]);
+ RunAndTest('', [ecColSelUp], 5,4, TestText1, 1, [5,3,0]);
+ PopBaseName;
+
+ PushBaseName('double width char');
+ FOptAdd := [eoKeepCaretX];
+ ReCreateEdit(TestText2);
+ // X at log pos 4 / phys 4 / 3 chars before
+ SetCaret(4,12);
+ // X goes to log pos 5 / phys 4 / 2 chars => 1 double width char
+ RunAndTest('', [ecColSelDown], 5,13, TestText2, 1, [4,12,0]);
+ // X goes to log pos 3 / phys 3 / 2 chars => pushed forward by following dbl-w char
+ RunAndTest('', [ecColSelDown], 3,14, TestText2, 2, [3,12,0, 2,13,0]); // 2,13 is pushed forward
+ // X goes to log pos 4 / phys 4 => keepcaretX // 1,14 is oout of line
+ RunAndTest('', [ecColSelDown], 4,15, TestText2, 3, [4,12,0, 5,13,0, 3,14,0]);
+
+ // X goes to log pos 3 / phys 3 / 2 chars => pushed forward by following dbl-w char
+ RunAndTest('', [ecColSelUp], 3,14, TestText2, 2, [3,12,0, 2,13,0]);
+ // X goes to log pos 5 / phys 4 / 2 chars => 1 double width char
+ RunAndTest('', [ecColSelUp], 5,13, TestText2, 1, [4,12,0]);
+
+ // X goes to log pos 3 / phys 3 / 2 chars => pushed forward by following dbl-w char
+ RunAndTest('', [ecColSelDown], 3,14, TestText2, 2, [3,12,0, 2,13,0]); // 2,13 is pushed forward
+
+end;
+
+procedure TTestMultiCaret.CursorMove;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 4);
+ Result[0] := ' 123 ';
+ Result[1] := ' abc ';
+ Result[2] := ' abc ';
+ Result[3] := '';
+ end;
+begin
+ PushBaseName('eoScrollPastEol, eoCaretSkipTab');
+ FOptAdd := [eoScrollPastEol];
+ FOptRemove := [];
+ FOpt2Add := [eoCaretSkipTab];
+ FOpt2Remove := [];
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+
+
+ PushBaseName('ecUp');
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 1,0);
+ RunAndTest('Height 2', [ecUp], 3,3, TestText1, 1, [3,2,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 2,0);
+ RunAndTest('Height 3', [ecUp], 3,4, TestText1, 2, [3,2,0, 3,3,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretsByKey(3,3, [1,0, 1,0], mcmMoveAllCarets);
+ RunAndTest('Width 3', [ecUp], 5,2, TestText1, 2, [3,2,0, 4,2,0]);
+ PopBaseName;
+
+ PushBaseName('ecUp');
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 1,0);
+ RunAndTest('Height 2', [ecDown], 3,5, TestText1, 1, [3,4,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 2,0);
+ RunAndTest('Height 3', [ecDown], 3,6, TestText1, 2, [3,4,0, 3,5,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretsByKey(3,3, [1,0, 1,0], mcmMoveAllCarets);
+ RunAndTest('Width 3', [ecDown], 5,4, TestText1, 2, [3,4,0, 4,4,0]);
+ PopBaseName;
+
+ PushBaseName('ecLeft');
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 1,0);
+ RunAndTest('Height 2', [ecLeft], 2,4, TestText1, 1, [2,3,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 2,0);
+ RunAndTest('Height 3', [ecLeft], 2,5, TestText1, 2, [2,3,0, 2,4,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretsByKey(3,3, [1,0, 1,0], mcmMoveAllCarets);
+ RunAndTest('Width 3', [ecLeft], 4,3, TestText1, 2, [2,3,0, 3,3,0]);
+ PopBaseName;
+
+ PushBaseName('ecRight');
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 1,0);
+ RunAndTest('Height 2', [ecRight], 4,4, TestText1, 1, [4,3,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,3, 2,0);
+ RunAndTest('Height 3', [ecRight], 4,5, TestText1, 2, [4,3,0, 4,4,0]);
+
+ ReCreateEdit(TestText1);
+ SetCaretsByKey(3,3, [1,0, 1,0], mcmMoveAllCarets);
+ RunAndTest('Width 3', [ecRight], 6,3, TestText1, 2, [4,3,0, 5,3,0]);
+ PopBaseName;
+ PopBaseName;
+
+ PushBaseName('eoScrollPastEol, NO eoCaretSkipTab - move through tab');
+ FOptAdd := [eoScrollPastEol];
+ FOptRemove := [];
+ FOpt2Add := [];
+ FOpt2Remove := [eoCaretSkipTab];
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+
+ PushBaseName('ecRight');
+ ReCreateEdit(TestText2); // tabw=4
+ SetCaretAndColumnSelect(6,8, 2,0); // before both tabs
+ RunAndTest('Height 3', [ecRight], 6,10,1, TestText2, 2, [6,8,1, 6,9,1]);
+ RunAndTest('Height 3', [ecRight], 6,10,2, TestText2, 2, [6,8,2, 6,9,2]);
+ RunAndTest('Height 3', [ecRight], 7,10,0, TestText2, 2, [7,8,0, 7,9,0]);
+ RunAndTest('Height 3', [ecRight], 7,10,1, TestText2, 2, [7,8,1, 7,9,1]);
+ PopBaseName;
+
+ PushBaseName('ecLeft');
+ ReCreateEdit(TestText2); // tabw=4
+ SetCaretAndColumnSelect(8,8, 2,0); // after both tabs
+ RunAndTest('Height 3', [ecLeft], 7,10,3, TestText2, 2, [7,8,3, 7,9,3]);
+ RunAndTest('Height 3', [ecLeft], 7,10,2, TestText2, 2, [7,8,2, 7,9,2]);
+ RunAndTest('Height 3', [ecLeft], 7,10,1, TestText2, 2, [7,8,1, 7,9,1]);
+ RunAndTest('Height 3', [ecLeft], 7,10,0, TestText2, 2, [7,8,0, 7,9,0]);
+ RunAndTest('Height 3', [ecLeft], 6,10,2, TestText2, 2, [6,8,2, 6,9,2]);
+ PopBaseName;
+ PopBaseName;
+
+ // move through tab, but not double-widths
+
+ PushBaseName('ecLineStart swap to carets');
+ FOptAdd := [eoScrollPastEol, eoEnhanceHomeKey];
+ FOptRemove := [eoTrimTrailingSpaces];
+ FOpt2Add := [eoEnhanceEndKey];
+ FOpt2Remove := [];
+
+ ReCreateEdit(LocalText1);
+ SetCaretsByKey(1,1, [2,0, 0,1], mcmMoveAllCarets);
+ TestExtraCaretPosAndOffs('', 3,2,0, 2, [1,1,0, 3,1,0]);
+ RunAndTest('3 carets', [ecLineStart], 1,2,0, LocalText1, 2, [1,1,0, 5,1,0]);
+ RunAndTest('3 carets Right', [ecRight], 2,2,0, LocalText1, 2, [2,1,0, 6,1,0]);
+ RunAndTest('3 carets', [ecLineStart], 1,2,0, LocalText1, 2, [1,1,0, 5,1,0]);
+ RunAndTest('3 carets', [ecLineStart], 7,2,0, LocalText1, 2, [1,1,0, 5,1,0]);
+
+ PopBaseName;
+end;
+
+procedure TTestMultiCaret.Edit;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1';
+ Result[1] := '2';
+ Result[2] := '3';
+ Result[3] := '4';
+ Result[4] := '5';
+ Result[5] := '6';
+ Result[6] := '7';
+ Result[7] := '';
+ end;
+ function LocalText1A: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1';
+ Result[1] := 'A2';
+ Result[2] := 'A3';
+ Result[3] := 'A4';
+ Result[4] := 'A5';
+ Result[5] := 'A6';
+ Result[6] := '7';
+ Result[7] := '';
+ end;
+ function LocalText1Del: TStringArray;
+ begin
+ SetLength(Result, 3);
+ Result[0] := '123456';
+ Result[1] := '7';
+ Result[2] := '';
+ end;
+
+begin
+ ReCreateEdit;
+ SetLines(LocalText1);
+
+ SetCaretAndColumnSelect(1,2, 4,0);
+ TestIsCaretLogAndFullText('', 1, 6, LocalText1);
+
+ RunCmdSeq([ecChar], ['A']);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1A);
+ TestExtraCaretPos('', 4, [2,2, 2,3, 2,4, 2,5]);
+
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 1, 6, LocalText1);
+ TestExtraCaretPos('', 4, [1,2, 1,3, 1,4, 1,5]);
+
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 6, 1, LocalText1Del);
+ TestExtraCaretPos('', 4, [2,1, 3,1, 4,1, 5,1]);
+
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 1, 1, LocalText1Del, [1, '6']);
+ // NO extra carets
+ AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
+
+
+
+end;
+
+procedure TTestMultiCaret.Delete;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := '2bB';
+ Result[2] := '3cC';
+ Result[3] := '4dD';
+ Result[4] := '5eE';
+ Result[5] := '6fF';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+ function LocalText1Del: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := '2B';
+ Result[2] := '3C';
+ Result[3] := '4D';
+ Result[4] := '5E';
+ Result[5] := '6F';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+ function LocalText1DelAndBS: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := 'B';
+ Result[2] := 'C';
+ Result[3] := 'D';
+ Result[4] := 'E';
+ Result[5] := 'F';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+ function LocalText1Del2: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := 'B';
+ Result[2] := 'C';
+ Result[3] := 'D';
+ Result[4] := 'E';
+ Result[5] := 'F';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+ function LocalText1DelExtra: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := '2B';
+ Result[2] := '3';
+ Result[3] := 'D';
+ Result[4] := '5E';
+ Result[5] := '6F';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+begin
+ PushBaseName('NO eoPersistentBlock, HAS eoOverwriteBlock');
+ FOpt2Add := [eoOverwriteBlock];
+ FOpt2Remove := [eoPersistentBlock];
+
+ PushBaseName('ecDeleteLastChar');
+
+ PushBaseName('ecDeleteLastChar - zero width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(3,2, 4,0);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopPushBaseName('ecDeleteLastChar - ONE width backward sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(3,2, 4,-1);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('BS again', 1, 6, LocalText1DelAndBS);
+
+ PopPushBaseName('ecDeleteLastChar - ONE width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,1);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopPushBaseName('ecDeleteLastChar - Two width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(1,2, 4,2);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 1, 6, LocalText1Del2);
+
+ PopPushBaseName('ecDeleteLastChar - ONE width sel / extra caret');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,1);
+ FMultiCaret.AddCaretAtLogPos(4,3,0);
+ FMultiCaret.AddCaretAtLogPos(2,4,0);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1DelExtra);
+
+ PopPushBaseName('ecDeleteChar');
+
+ PushBaseName('ecDeleteChar - zero width sel');
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 1,0);
+ RunAndTest('Height 2', [ecDeleteChar], 2, 3, TestText1(2,3, 2,1), 1, []);
+ RunAndTest('Height 2', [ecRight], 3, 3, TestText1(2,3, 2,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 2,0);
+ RunAndTest('Height 3', [ecDeleteChar], 2, 4, TestText1(2,4, 2,1), 2, []);
+ RunAndTest('Height 3', [ecRight], 3, 4, TestText1(2,4, 2,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 3,0);
+ RunAndTest('Height 4', [ecDeleteChar], 2, 5, TestText1(2,5, 2,1), 3, []);
+ RunAndTest('Height 4', [ecRight], 3, 5, TestText1(2,5, 2,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 4,0);
+ RunAndTest('Height 5', [ecDeleteChar], 2, 6, TestText1(2,6, 2,1), 4, []);
+ RunAndTest('Height 5', [ecRight], 3, 6, TestText1(2,6, 2,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 5,0);
+ RunAndTest('Height 5', [ecDeleteChar], 2, 7, TestText1(2,7, 2,1), 5, []);
+ RunAndTest('Height 5', [ecRight], 3, 7, TestText1(2,7, 2,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(2,2, 4,0);
+ RunAndTest('', [ecDeleteChar], 2, 6, TestText1(2,6, 2,1), 4, []);
+ RunAndTest('', [ecRight], 3, 6, TestText1(2,6, 2,1), 0, []);
+
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(1,2, 1,0);
+ RunAndTest('X=0, Height 2', [ecDeleteChar], 1, 3, TestText1(2,3, 1,1), 1, []);
+ RunAndTest('X=0, Height 2', [ecRight], 2, 3, TestText1(2,3, 1,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(1,2, 2,0);
+ RunAndTest('X=0, Height 3', [ecDeleteChar], 1, 4, TestText1(2,4, 1,1), 2, []);
+ RunAndTest('X=0, Height 3', [ecRight], 2, 4, TestText1(2,4, 1,1), 0, []);
+ RunCmdSeq([ecRight, ecUndo],[]);
+
+ ReCreateEdit(TestText1);
+FMultiCaret.DefaultColumnSelectMode := mcmMoveAllCarets;
+ SetCaretAndColumnSelect(1,2, 2,0);
+ RunAndTest('X=0, Height 3', [ecDeleteChar], 1, 4, TestText1(2,4, 1,1), 2, [1,2, 1,3]);
+ RunAndTest('X=0, Height 3', [ecRight], 2, 4, TestText1(2,4, 1,1), 2, [2,2, 2,3]);
+ RunCmdSeq([ecUndo],[]);
+
+ PopPushBaseName('ecDeleteChar - ONE width backward sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(3,2, 4,-1);
+ RunCmdSeq([ecDeleteChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopPushBaseName('ecDeleteChar - ONE width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,1);
+ RunCmdSeq([ecDeleteChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopPushBaseName('ecDeleteChar - Two width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(1,2, 4,2);
+ RunCmdSeq([ecDeleteChar], []);
+ TestIsCaretLogAndFullText('', 1, 6, LocalText1Del2);
+
+ PopBaseName;
+ PopBaseName;
+
+ PopPushBaseName('NO eoPersistentBlock, NO eoOverwriteBlock');
+ FOpt2Add := [];
+ FOpt2Remove := [eoOverwriteBlock, eoPersistentBlock];
+
+ PushBaseName('ecDeleteLastChar');
+ PopPushBaseName('ecDeleteLastChar - Two width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(1,2, 4,2);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopPushBaseName('ecDeleteChar');
+ PopPushBaseName('ecDeleteChar - Two width backward sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(4,2, 4,-2);
+ RunCmdSeq([ecDeleteChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+ PopBaseName;
+ PopBaseName;
+
+ PopPushBaseName('NO eoPersistentBlock, NO eoOverwriteBlock');
+ FOpt2Add := [eoPersistentBlock];
+ FOpt2Remove := [eoOverwriteBlock];
+
+ PopPushBaseName('ecDeleteLastChar - Two width sel');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(1,2, 4,2);
+ RunCmdSeq([ecDeleteLastChar], []);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1Del);
+
+ PopBaseName;
+
+ // Delete and merge caret
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(4,2, 0,0);
+ SetCaretsByKey([2,0, 2,0, 2,0]); // 4carets / main caret at end
+ RunAndTest('', [ecDeleteLastChar], 6,2, TestText1([2,9,1, 2,7,1, 2,5,1, 2,3,1]), 3, [3,2,0, 4,2,0, 5,2,0]);
+ RunAndTest('', [ecDeleteLastChar], 2,2, TestText1([2,2,8]), 0, []);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(10,2, 0,0);
+ SetCaretsByKey([-2,0, -2,0, -2,0]); // 4carets / main caret at start
+ RunAndTest('', [ecDeleteLastChar], 3,2, TestText1([2,9,1, 2,7,1, 2,5,1, 2,3,1]), 3, [4,2,0, 5,2,0, 6,2,0]);
+ RunAndTest('', [ecDeleteLastChar], 2,2, TestText1([2,2,8]), 0, []);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(10,2, 0,0);
+ SetCaretsByKey([-2,0, -4,0, +2,0]); // 4carets / main caret in middle
+ RunAndTest('', [ecDeleteLastChar], 4,2, TestText1([2,9,1, 2,7,1, 2,5,1, 2,3,1]), 3, [3,2,0, 5,2,0, 6,2,0]);
+ RunAndTest('', [ecDeleteLastChar], 2,2, TestText1([2,2,8]), 0, []);
+
+ ReCreateEdit(TestText1);
+ SetCaretAndColumnSelect(3,2, 0,0);
+ SetCaretsByKey([2,0, 2,0, 2,0]); // 4carets / main caret at end
+ RunAndTest('', [ecDeleteChar], 6,2, TestText1([2,9,1, 2,7,1, 2,5,1, 2,3,1]), 3, [3,2,0, 4,2,0, 5,2,0]);
+ RunAndTest('', [ecDeleteChar], 3,2, TestText1([2,3,8]), 0, []);
+
+
+end;
+
+procedure TTestMultiCaret.ReplaceColSel;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := '2bB';
+ Result[2] := '3cC';
+ Result[3] := '4dD';
+ Result[4] := '5eE';
+ Result[5] := '6fF';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+ function LocalText1X: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1aA';
+ Result[1] := '2XB';
+ Result[2] := '3XC';
+ Result[3] := '4XD';
+ Result[4] := '5XE';
+ Result[5] := '6XF';
+ Result[6] := '7gG';
+ Result[7] := '';
+ end;
+begin
+ ReCreateEdit;
+ SetLines(LocalText1);
+
+ SetCaretAndColumnSelect(2,2, 4,1);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1);
+
+ RunCmdSeq([ecChar], ['X']);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1X);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+
+end;
+
+procedure TTestMultiCaret.TabKey;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '2b';
+ Result[2] := '3c';
+ Result[3] := '4d';
+ Result[4] := '5e';
+ Result[5] := '6f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1Tab: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '2'#9'b';
+ Result[2] := '3'#9'c';
+ Result[3] := '4'#9'd';
+ Result[4] := '5'#9'e';
+ Result[5] := '6'#9'f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1Indent: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := ' 2b';
+ Result[2] := ' 3c';
+ Result[3] := ' 4d';
+ Result[4] := ' 5e';
+ Result[5] := ' 6f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1IndentX: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := ' 2b';
+ Result[2] := ' 3c';
+ Result[3] := ' 4d';
+ Result[4] := ' 5e';
+ Result[5] := ' 6f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1TabOver: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '2'#9;
+ Result[2] := '3'#9;
+ Result[3] := '4'#9;
+ Result[4] := '5'#9;
+ Result[5] := '6'#9;
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1AfterIndent: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := ' 2b';
+ Result[2] := ' 3c';
+ Result[3] := ' 4d';
+ Result[4] := '5e';
+ Result[5] := '6f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+begin
+ PushBaseName('WITH eoTabIndent');
+ FOptAdd := [eoTabIndent];
+ FOptRemove := [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+
+ PushBaseName('ZERO width selection');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,0);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1);
+
+ RunCmdSeq([ecTab], []);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1Tab);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+
+ PopPushBaseName('ONE width selection');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,1);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1);
+
+ RunCmdSeq([ecTab], []);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1TabOver);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+ PopBaseName;
+
+ PopPushBaseName('indent selection');
+ ReCreateEdit(LocalText1);
+ SetCaretAndSel(2,2, 2,4);
+ FMultiCaret.AddCaretAtLogPos(3,4,0);
+ FMultiCaret.ActiveMode := mcmMoveAllCarets;
+
+ RunCmdSeq([ecTab], []);
+ TestIsCaretLogAndFullText('', 4, 4, LocalText1AfterIndent);
+ TestExtraCaretPos('', 1, [5,4]);
+ PopBaseName;
+
+ PopBaseName;
+
+ PushBaseName('WITHOUT eoTabIndent');
+ FOptAdd := [];
+ FOptRemove := [eoTabIndent, eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+
+ PushBaseName('ZERO width selection');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,0);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1);
+
+ RunCmdSeq([ecTab], []);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1Tab);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+
+
+ PopPushBaseName('ONE width selection');
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(2,2, 4,1);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1);
+
+ RunCmdSeq([ecTab], []);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1TabOver);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+ PopBaseName;
+
+ PopBaseName;
+end;
+
+procedure TTestMultiCaret.Paste;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '2b';
+ Result[2] := '3c';
+ Result[3] := '4d';
+ Result[4] := '5e';
+ Result[5] := '6f';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1PasteNorm: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '21ab';
+ Result[2] := '31ac';
+ Result[3] := '41ad';
+ Result[4] := '51ae';
+ Result[5] := '61af';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1PasteNormOver: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '21a';
+ Result[2] := '31a';
+ Result[3] := '41a';
+ Result[4] := '51a';
+ Result[5] := '61a';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+ function LocalText1PasteCol: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '2b';
+ Result[2] := '3c';
+ Result[3] := '4d';
+ Result[4] := '5e';
+ Result[5] := '61f';
+ Result[6] := '72g';
+ Result[7] := '';
+ end;
+ function LocalText1PasteColOver: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := '1a';
+ Result[1] := '21';
+ Result[2] := '32';
+ Result[3] := '4';
+ Result[4] := '5';
+ Result[5] := '6';
+ Result[6] := '7g';
+ Result[7] := '';
+ end;
+begin
+ PushBaseName('ZERO width selection -- paste normal');
+ ReCreateEdit;
+ SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+ SetLines(LocalText1);
+
+ SetCaret(1,1);
+ RunCmdSeq([ecSelRight, ecSelRight, ecCopy], []); // copy
+
+ SetCaretAndColumnSelect(2,2, 4,0);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1);
+
+ RunCmdSeq([ecPaste], []);
+ TestIsCaretLogAndFullText('', 4, 6, LocalText1PasteNorm);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+
+
+ PopPushBaseName('ONE width selection -- paste normal');
+ ReCreateEdit;
+ SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+ SetLines(LocalText1);
+
+ SetCaret(1,1);
+ RunCmdSeq([ecSelRight, ecSelRight, ecCopy], []); // copy
+
+ SetCaretAndColumnSelect(2,2, 4,1);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1);
+
+ RunCmdSeq([ecPaste], []);
+ TestIsCaretLogAndFullText('', 4, 6, LocalText1PasteNormOver);
+ // 4 extra carets + main caret
+ AssertEquals(BaseTestName+'', 4, FMultiCaret.Carets.Count);
+
+
+
+ PushBaseName('ZERO width selection -- paste column');
+ ReCreateEdit;
+ SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+ SetLines(LocalText1);
+
+ SetCaretAndColumnSelect(1,1, 1,1);
+ RunCmdSeq([ecCopy], []); // copy
+
+ SetCaretAndColumnSelect(2,2, 4,0);
+ TestIsCaretLogAndFullText('', 2, 6, LocalText1);
+
+ RunCmdSeq([ecPaste], []);
+ TestIsCaretLogAndFullText('', 3, 7, LocalText1PasteCol);
+ AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
+
+
+ PopPushBaseName('ONE width selection -- paste column');
+ ReCreateEdit;
+ SynEdit.Options := SynEdit.Options + [eoTabIndent] - [eoTabsToSpaces, eoSmartTabs, eoTrimTrailingSpaces];
+ SetLines(LocalText1);
+
+ SetCaretAndColumnSelect(1,1, 1,1);
+ RunCmdSeq([ecCopy], []); // copy
+
+ SetCaretAndColumnSelect(2,2, 4,1);
+ TestIsCaretLogAndFullText('', 3, 6, LocalText1);
+
+ RunCmdSeq([ecPaste], []);
+ TestIsCaretLogAndFullText('', 3, 3, LocalText1PasteColOver);
+ AssertEquals(BaseTestName+'', 0, FMultiCaret.Carets.Count);
+
+end;
+
+procedure TTestMultiCaret.Undo;
+ function LocalText1: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := 'abcde';
+ Result[1] := 'ABCDE';
+ Result[2] := 'mnopq';
+ Result[3] := 'MNOPQ';
+ Result[4] := 'KLMXYZ';
+ Result[5] := 'klmxyz';
+ Result[6] := 'rsthi';
+ Result[7] := '';
+ end;
+ function LocalText1X: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := 'acde'; // b missing
+ Result[1] := 'ABCDE';
+ Result[2] := 'mnopq';
+ Result[3] := 'MNOPQ';
+ Result[4] := 'KLMXYZ';
+ Result[5] := 'klmxyz';
+ Result[6] := 'rsthi';
+ Result[7] := '';
+ end;
+ function LocalText1A: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := 'abcde';
+ Result[1] := 'AB123CDE';
+ Result[2] := 'mn123opq';
+ Result[3] := 'MN123OPQ';
+ Result[4] := 'KL123MXYZ';
+ Result[5] := 'kl123mxyz';
+ Result[6] := 'rsthi';
+ Result[7] := '';
+ end;
+ function LocalText1B: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := 'abcde';
+ Result[1] := 'AB145623CDE';
+ Result[2] := 'mn145623opq';
+ Result[3] := 'MN145623OPQ';
+ Result[4] := 'KL145623MXYZ';
+ Result[5] := 'kl145623mxyz';
+ Result[6] := 'rsthi';
+ Result[7] := '';
+ end;
+ function LocalText1C: TStringArray;
+ begin
+ SetLength(Result, 8);
+ Result[0] := 'abcde';
+ Result[1] := 'AB14578623CDE';
+ Result[2] := 'mn14578623opq';
+ Result[3] := 'MN14578623OPQ';
+ Result[4] := 'KL14578623MXYZ';
+ Result[5] := 'kl14578623mxyz';
+ Result[6] := 'rsthi';
+ Result[7] := '';
+ end;
+begin
+ FOptAdd := [eoGroupUndo];
+ PushBaseName('undo mcmCancelOnCaretMove');
+ FDefaultColumnSelectMode := mcmCancelOnCaretMove;
+ ReCreateEdit(TestText1);
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ PopPushBaseName('undo mcmMoveAllCarets');
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+ ReCreateEdit(TestText1);
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecLeft], 2,6, TestText1(3,6,3,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ PopBaseName();
+
+
+PopPushBaseName('SHARED');
+ PushBaseName('undo mcmCancelOnCaretMove');
+ FDefaultColumnSelectMode := mcmCancelOnCaretMove;
+ ReCreateEdit(TestText1);
+ ReCreateSharedEdit;
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ SwapEdit;
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+
+ PopPushBaseName('undo mcmMoveAllCarets');
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+ ReCreateEdit(TestText1);
+ ReCreateSharedEdit;
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecLeft], 2,6, TestText1(3,6,3,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ SwapEdit;
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+ PopBaseName();
+PopBaseName();
+
+PopPushBaseName('SHARED');
+ PushBaseName('undo mcmCancelOnCaretMove');
+ FDefaultColumnSelectMode := mcmCancelOnCaretMove;
+ ReCreateEdit(TestText1);
+ ReCreateSharedEdit(True);
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ SwapEdit;
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+
+ PopPushBaseName('undo mcmMoveAllCarets');
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+ ReCreateEdit(TestText1);
+ ReCreateSharedEdit(True);
+ SetCaret(3,3);
+ RunAndTest('', [ecColSelDown], 3,4, TestText1, 1, [3,3,0]);
+ RunAndTest('', [ecColSelDown], 3,5, TestText1, 2, [3,3,0, 3,4,0]);
+ RunAndTest('', [ecColSelDown], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteChar], 3,6, TestText1(3,6,3,1), 3, [3,3,0, 3,4,0, 3,5,0]);
+ RunAndTest('', [ecLeft], 2,6, TestText1(3,6,3,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+
+ RunAndTest('', [ecDeleteLastChar], 2,6, TestText1(3,6,2,1), 3, [2,3,0, 2,4,0, 2,5,0]);
+ SwapEdit;
+ RunAndTest('', [ecUndo], 3,6, TestText1, 3, [3,3,0, 3,4,0, 3,5,0]);
+ PopBaseName();
+PopBaseName();
+
+ PushBaseName('undo redo mcmMoveAllCarets');
+ FDefaultColumnSelectMode := mcmMoveAllCarets;
+ ReCreateEdit(LocalText1);
+ SetCaretAndColumnSelect(3,2, 4,0);
+ RunAndTest('', [ecChar,ecChar,ecChar], ['1','2','3'], 6,6, LocalText1A, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecLeft,ecLeft], 4,6, LocalText1A, 4, [4,2, 4,3, 4,4, 4,5]);
+ RunAndTest('', [ecChar,ecChar,ecChar], ['4','5','6'], 7,6, LocalText1B, 4, [7,2, 7,3, 7,4, 7,5]);
+ RunAndTest('', [ecLeft], 6,6, LocalText1B, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecChar,ecChar], ['7','8'], 8,6, LocalText1C, 4, [8,2, 8,3, 8,4, 8,5]);
+ RunAndTest('', [ecUndo], 6,6, LocalText1B, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecUndo], 4,6, LocalText1A, 4, [4,2, 4,3, 4,4, 4,5]);
+ RunAndTest('', [ecUndo], 3,6, LocalText1, 4, [3,2, 3,3, 3,4, 3,5]);
+
+ RunAndTest('', [ecRedo], 6,6, LocalText1A, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecRedo], 7,6, LocalText1B, 4, [7,2, 7,3, 7,4, 7,5]);
+ RunAndTest('', [ecRedo], ['7','8'], 8,6, LocalText1C, 4, [8,2, 8,3, 8,4, 8,5]);
+
+ RunAndTest('', [ecUndo], 6,6, LocalText1B, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecUndo], 4,6, LocalText1A, 4, [4,2, 4,3, 4,4, 4,5]);
+ RunAndTest('', [ecUndo], 3,6, LocalText1, 4, [3,2, 3,3, 3,4, 3,5]);
+
+ RunAndTest('', [ecRedo], 6,6, LocalText1A, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecRedo], 7,6, LocalText1B, 4, [7,2, 7,3, 7,4, 7,5]);
+
+
+ ReCreateEdit(LocalText1X);
+ SetCaret(2,1);
+ RunAndTest('', [ecChar], ['b'], 3,1, LocalText1, 0, []); // Undo to just ONE caret
+ RunCmdSeq([ecDown], []);
+ SetCaretsByKey([0,1, 0,1, 0,1, 0,1], mcmMoveAllCarets);
+ RunAndTest('', [ecChar,ecChar,ecChar], ['1','2','3'], 6,6, LocalText1A, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecLeft,ecLeft], 4,6, LocalText1A, 4, [4,2, 4,3, 4,4, 4,5]);
+ RunAndTest('', [ecChar,ecChar,ecChar], ['4','5','6'], 7,6, LocalText1B, 4, [7,2, 7,3, 7,4, 7,5]);
+ RunAndTest('', [ecUndo], 4,6, LocalText1A, 4, [4,2, 4,3, 4,4, 4,5]);
+ RunAndTest('', [ecUndo], 3,6, LocalText1, 4, [3,2, 3,3, 3,4, 3,5]);
+ RunAndTest('', [ecUndo], 2,1, LocalText1X, 0, []);
+
+ RunAndTest('', [ecRedo], 3,1, LocalText1, 0, []);
+ RunAndTest('', [ecRedo], 6,6, LocalText1A, 4, [6,2, 6,3, 6,4, 6,5]);
+ RunAndTest('', [ecRedo], 7,6, LocalText1B, 4, [7,2, 7,3, 7,4, 7,5]);
+
+
+// RunAndTest('', [ecColSelDown], 3,4, LocalText1, 1, [3,3,0]);
+
+ PopBaseName;
+end;
+
+initialization
+ RegisterTest(TTestMultiCaret);
+
+end.
+
diff -Nru lazarus-1.4.4+dfsg/components/tachart/aggpas/tadraweraggpas.pas lazarus-1.6+dfsg/components/tachart/aggpas/tadraweraggpas.pas
--- lazarus-1.4.4+dfsg/components/tachart/aggpas/tadraweraggpas.pas 2013-05-25 09:22:25.000000000 +0000
+++ lazarus-1.6+dfsg/components/tachart/aggpas/tadraweraggpas.pas 2016-01-18 23:01:48.000000000 +0000
@@ -56,6 +56,7 @@
AStartAngle16Deg, AAngleLength16Deg: Integer);
procedure Rectangle(const ARect: TRect);
procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
+ procedure ResetFont;
procedure SetBrushColor(AColor: TChartColor);
procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor);
@@ -196,6 +197,11 @@
FCanvas.Rectangle(ARect);
end;
+procedure TAggPasDrawer.ResetFont;
+begin
+ FCanvas.Font.Orientation := 0;
+end;
+
procedure TAggPasDrawer.SetBrush(ABrush: TFPCustomBrush);
begin
with FCanvas.Brush do begin
diff -Nru lazarus-1.4.4+dfsg/components/tachart/demo/fit/fitdemo.lpi lazarus-1.6+dfsg/components/tachart/demo/fit/fitdemo.lpi
--- lazarus-1.4.4+dfsg/components/tachart/demo/fit/fitdemo.lpi 2012-08-16 16:12:58.000000000 +0000
+++ lazarus-1.6+dfsg/components/tachart/demo/fit/fitdemo.lpi 2015-07-27 16:09:41.000000000 +0000
@@ -1,4 +1,4 @@
-
+
@@ -41,7 +41,6 @@
-
@@ -49,7 +48,6 @@
-
@@ -76,12 +74,6 @@
-
-
-
-
-
-
+ 'img', 'image':
+ begin
+ lRasterImage := nil;
+ lEmbVecImg := nil;
+ lWidth := -1;
+ lHeight := -1;
+ lAltText := '';
+
+ for i := 0 to lCurNode.Attributes.Length - 1 do
+ begin
+ lCurAttr := lCurNode.Attributes.Item[i];
+ lAttrName := lCurAttr.NodeName;
+ lAttrValue := lCurAttr.NodeValue;
+
+ case lAttrName of
+ 'alt':
+ begin
+ lAltText := lAttrValue;
+ end;
+ 'src':
+ begin
+ lAttrValue := lCurAttr.NodeValue;
+ lAttrValue := ExtractFilePath(FFilename) + lAttrValue;
+
+ if TvHTMLVectorialReader.IsSupportedRasterImage(lAttrValue) then
+ begin
+ if not FileExists(lAttrValue) then Continue;
+
+ lRasterImage := ADest.AddRasterImage();
+ lRasterImage.CreateImageFromFile(lAttrValue);
+ end
+ else if TvVectorialDocument.GetFormatFromExtension(lAttrValue, False) <> vfUnknown then
+ begin
+ lEmbVecImg := ADest.AddEmbeddedVectorialDoc();
+ lEmbVecImg.Document.ReadFromFile(lAttrValue);
+ end;
+ end;
+ 'xlink:href':
+ begin
+ lRasterImage := ADest.AddRasterImage();
+ lImageDataParts := TvSVGVectorialReader.ReadSpaceSeparatedStrings(lNodeValue, ':;,');
+ try
+ if (lImageDataParts.Strings[0] = 'data') and
+ (lImageDataParts.Strings[1] = 'image/png') and
+ (lImageDataParts.Strings[2] = 'base64') then
+ begin
+ lImageReader := TFPReaderPNG.Create;
+ lImageDataStream := TMemoryStream.Create;
+ try
+ lImageDataBase64 := lImageDataParts.Strings[3];
+ DecodeBase64(lImageDataBase64, lImageDataStream);
+ lImageDataStream.Position := 0;
+ lRasterImage.CreateRGB888Image(10, 10);
+ lRasterImage.RasterImage.LoadFromStream(lImageDataStream, lImageReader);
+ finally
+ lImageDataStream.Free;
+ lImageReader.Free;
+ end;
+ end
+ else
+ raise Exception.Create('[TvSVGVectorialReader.ReadImageFromNode] Unimplemented image format');
+ finally
+ lImageDataParts.Free;
+ end;
+ end;
+ 'width':
+ begin
+ lWidth := StrToInt(lAttrValue);
+ end;
+ 'height':
+ begin
+ lHeight := StrToInt(lAttrValue);
+ end;
+ end;
+ end;
+
+ if lRasterImage <> nil then
+ begin
+ if lWidth <= 0 then
+ lWidth := lRasterImage.RasterImage.Width;
+ if lHeight <= 0 then
+ lHeight := lRasterImage.RasterImage.Height;
+
+ lRasterImage.Width := lWidth;
+ lRasterImage.Height := lHeight;
+ lRasterImage.AltText := lAltText;
+ end
+ else if (lEmbVecImg <> nil) and (lWidth > 0) and (lHeight > 0) then
+ begin
+ lEmbVecImg.Width := lWidth;
+ lEmbVecImg.Height := lHeight;
+ end;
+ end;
+ end;
+
+ lCurNode := lCurNode.NextSibling;
+ end;
+
+ TextMerging();
end;
function TvHTMLVectorialReader.ReadSVGFromNode(ANode: TDOMNode;
@@ -150,6 +328,169 @@
end;
end;
+function TvHTMLVectorialReader.ReadTableFromNode(ANode: TDOMNode;
+ AData: TvTextPageSequence; ADoc: TvVectorialDocument): TvEntity;
+var
+ CurTable: TvTable;
+ lCurNode, lCurSubnode: TDOMNode;
+ lNodeName, lNodeValue: DOMString;
+ CurRow: TvTableRow;
+ Caption_Cell: TvTableCell;
+ CurCellPara: TvParagraph;
+ // attributes
+ i, lBorderNr: Integer;
+ lAttrName, lAttrValue: DOMString;
+
+ procedure SetBorderLineType(AType: TvTableBorderType);
+ begin
+ CurTable.Borders.Left.LineType := AType;
+ CurTable.Borders.Right.LineType := AType;
+ CurTable.Borders.Top.LineType := AType;
+ CurTable.Borders.Bottom.LineType := AType;
+ CurTable.Borders.InsideHoriz.LineType := AType;
+ CurTable.Borders.InsideVert.LineType := AType;
+ end;
+
+begin
+ Result := nil;
+ CurTable := AData.AddTable();
+ CurTable.CellSpacingLeft := 3;
+ CurTable.CellSpacingTop := 2;
+
+ // Default to no border without "border" attribute
+ SetBorderLineType(tbtNone);
+
+ // table attributes
+ for i := 0 to ANode.Attributes.Length - 1 do
+ begin
+ lAttrName := ANode.Attributes.Item[i].NodeName;
+ lAttrValue := ANode.Attributes.Item[i].NodeValue;
+
+ case lAttrName of
+ 'border':
+ begin
+ lBorderNr := StrToInt(lAttrValue);
+
+ SetBorderLineType(tbtSingle);
+ CurTable.Borders.Left.Width := lBorderNr;
+ CurTable.Borders.Right.Width := lBorderNr;
+ CurTable.Borders.Top.Width := lBorderNr;
+ CurTable.Borders.Bottom.Width := lBorderNr;
+ CurTable.Borders.InsideHoriz.Width := lBorderNr;
+ CurTable.Borders.InsideVert.Width := lBorderNr;
+
+ if lBorderNr = 0 then
+ SetBorderLineType(tbtNone);
+ end;
+ end;
+ end;
+
+ // table child nodes
+ lCurNode := ANode.FirstChild;
+ while Assigned(lCurNode) do
+ begin
+ lNodeName := lCurNode.NodeName;
+ lNodeValue := lCurNode.NodeValue;
+ case lNodeName of
+ 'caption':
+ begin
+ CurRow := CurTable.AddRow();
+ Caption_Cell := CurRow.AddCell();
+ {Caption_Cell.Borders.Left.LineType := tbtNone;
+ Caption_Cell.Borders.Top.LineType := tbtNone;
+ Caption_Cell.Borders.Right.LineType := tbtNone;
+ Caption_Cell.Borders.Bottom.LineType := tbtNone;}
+ CurCellPara := Caption_Cell.AddParagraph();
+ CurCellPara.Style := ADoc.StyleTextBodyCentralized;
+ CurCellPara.AddText(GetTextContentFromNode(lCurNode));
+ end;
+ 'tbody':
+ begin
+ lCurSubnode := lCurNode.FirstChild;
+ while Assigned(lCurSubnode) do
+ begin
+ ReadTableRowNode(CurTable, lCurSubnode, AData, ADoc);
+
+ lCurSubnode := lCurSubnode.NextSibling;
+ end;
+ end;
+ end;
+
+ lCurNode := lCurNode.NextSibling;
+ end;
+
+ // the caption spans all columns
+ Caption_Cell.SpannedCols := CurTable.GetColCount();
+end;
+
+function TvHTMLVectorialReader.ReadTableRowNode(ATable: TvTable; ANode: TDOMNode;
+ AData: TvTextPageSequence; ADoc: TvVectorialDocument): TvEntity;
+var
+ lCurNode: TDOMNode;
+ lNodeName, lNodeValue: DOMString;
+ CurRow: TvTableRow;
+ CurCell: TvTableCell;
+ CurCellPara: TvParagraph;
+begin
+ Result := nil;
+ CurRow := ATable.AddRow();
+
+ lCurNode := ANode.FirstChild;
+ while Assigned(lCurNode) do
+ begin
+ lNodeName := lCurNode.NodeName;
+ lNodeValue := lCurNode.NodeValue;
+ case lNodeName of
+ 'th':
+ begin
+ CurCell := CurRow.AddCell();
+ CurCellPara := CurCell.AddParagraph();
+ CurCellPara.Style := ADoc.StyleTextBodyBold;
+ CurCellPara.AddText(GetTextContentFromNode(lCurNode));
+ end;
+ 'td':
+ begin
+ CurCell := CurRow.AddCell();
+
+ CurCellPara := CurCell.AddParagraph();
+ Self.ReadParagraphFromNode(CurCellPara, lCurNode, AData, ADoc);
+ end;
+ end;
+
+ lCurNode := lCurNode.NextSibling;
+ end;
+end;
+
+function TvHTMLVectorialReader.ReadUListFromNode(ANode: TDOMNode;
+ AData: TvTextPageSequence; ADoc: TvVectorialDocument): TvEntity;
+var
+ lCurNode: TDOMNode;
+ lNodeName, lNodeValue: DOMString;
+ lNodeText: string;
+ //
+ lList: TvList;
+ lCurPara: TvParagraph;
+begin
+ Result := nil;
+ lList := AData.AddList();
+
+ lCurNode := ANode.FirstChild;
+ while Assigned(lCurNode) do
+ begin
+ lNodeName := lCurNode.NodeName;
+ lNodeValue := lCurNode.NodeValue;
+ case lNodeName of
+ 'li':
+ begin
+ lNodeText := GetTextContentFromNode(lCurNode);
+ lCurPara := lList.AddParagraph(lNodeText);
+ end;
+ end;
+
+ lCurNode := lCurNode.NextSibling;
+ end;
+end;
+
constructor TvHTMLVectorialReader.Create;
begin
inherited Create;
@@ -240,6 +581,18 @@
end;
end;
+class function TvHTMLVectorialReader.IsSupportedRasterImage(AFileName: string): Boolean;
+var
+ lExt: string;
+begin
+ Result := False;
+ lExt := LowerCase(ExtractFileExt(AFileName));
+ case lExt of
+ '.png', '.jpg', '.jpeg', '.bmp', '.xpm':
+ Result := True
+ end;
+end;
+
initialization
RegisterVectorialReader(TvHTMLVectorialReader, vfHTML);
diff -Nru lazarus-1.4.4+dfsg/components/fpvectorial/mathmlvectorialreader.pas lazarus-1.6+dfsg/components/fpvectorial/mathmlvectorialreader.pas
--- lazarus-1.4.4+dfsg/components/fpvectorial/mathmlvectorialreader.pas 2014-11-21 15:48:17.000000000 +0000
+++ lazarus-1.6+dfsg/components/fpvectorial/mathmlvectorialreader.pas 2015-03-24 17:50:02.000000000 +0000
@@ -13,9 +13,9 @@
interface
uses
- Classes, SysUtils, math,
+ Classes, SysUtils,
laz2_xmlread, laz2_dom,
- fpvectorial, fpvutils, lazutf8;
+ fpvectorial;
type
{ TvMathMLVectorialReader }
diff -Nru lazarus-1.4.4+dfsg/components/fpvectorial/odgvectorialreader.pas lazarus-1.6+dfsg/components/fpvectorial/odgvectorialreader.pas
--- lazarus-1.4.4+dfsg/components/fpvectorial/odgvectorialreader.pas 2014-03-06 14:06:04.000000000 +0000
+++ lazarus-1.6+dfsg/components/fpvectorial/odgvectorialreader.pas 2015-03-24 17:50:02.000000000 +0000
@@ -554,7 +554,6 @@
procedure TvODGVectorialReader.ApplyGraphicAttributeToPenAndBrush(ANodeName,
ANodeValue: string; var APen: TvPen; var ABrush: TvBrush);
var
- i: Integer;
lColor: TFPColor;
begin
case ANodeName of
@@ -920,10 +919,9 @@
procedure TvODGVectorialReader.ConvertPathStringToTPath(AStr: string;
AData: TvVectorialPage; ADest: TPath; ADeltaX, ADeltaY: Double; AInfo: TCustomShapeInfo);
var
- x1, y1, x2, y2, lCurX, lCurY: double;
+ x1, y1, x2, y2: double;
t1, t2, lSrcX, lSrcY, lDestX, lDestY: Double;
j: Integer;
- lNodeName, lNodeValue: string;
lTokenizer: TSVGPathTokenizer;
CurToken: TSVGToken;
begin
@@ -931,8 +929,6 @@
y1 := 0.0;
x2 := 0.0;
y2 := 0.0;
- lCurX := 0.0;
- lCurY := 0.0;
lTokenizer := TSVGPathTokenizer.Create;
try
@@ -1091,7 +1087,7 @@
x1, y1, x2, y2, lWidth, lHeight: double;
i: Integer;
lNodeName, lNodeValue: string;
- lCurNode, lTextNode, lEnhancedGeometryNode, lDrawTypeAttrib: TDOMNode;
+ lCurNode: TDOMNode;
lSkewX, lSkewY, lRotate, lTranslateX, lTranslateY: Double;
// various possible custom shape types
lGroup: TvEntityWithSubEntities;
@@ -1673,7 +1669,6 @@
var
lValue, lStr: string;
lStrings: TStringList;
- i: Integer;
begin
Result := colBlack;
lValue := Trim(LowerCase(AValue));
@@ -2302,7 +2297,6 @@
var
DocStylesNode, AutomaticStylesNode, MasterStylesNode, ElementNode: TDOMNode;
CurPage: TvVectorialPage;
- i: Integer;
lNodeName: String;
begin
DocStylesNode := AXMLDocument.DocumentElement;//.FindNode('office:document-styles');
diff -Nru lazarus-1.4.4+dfsg/components/fpvectorial/svgvectorialreader.pas lazarus-1.6+dfsg/components/fpvectorial/svgvectorialreader.pas
--- lazarus-1.4.4+dfsg/components/fpvectorial/svgvectorialreader.pas 2014-12-17 14:00:19.000000000 +0000
+++ lazarus-1.6+dfsg/components/fpvectorial/svgvectorialreader.pas 2016-01-18 22:55:11.000000000 +0000
@@ -67,13 +67,15 @@
{ TSVGPathTokenizer }
TSVGPathTokenizer = class
+ protected
+ Tokens: TSVGTokenList;
public
FPointSeparator, FCommaSeparator: TFormatSettings;
- Tokens: TSVGTokenList;
ExtraDebugStr: string;
constructor Create;
- Destructor Destroy; override;
+ destructor Destroy; override;
procedure AddToken(AStr: string);
+ procedure ClearTokens;
procedure TokenizePathString(AStr: string);
procedure TokenizeFunctions(AStr: string);
function DebugOutTokensAsString: string;
@@ -98,18 +100,22 @@
// debug symbols
FPathNumber: Integer;
function ReadSVGColor(AValue: string): TFPColor;
- function ReadSVGStyle(AValue: string; ADestEntity: TvEntityWithPen; ADestStyle: TvStyle = nil; AUseFillAsPen: Boolean = False): TvSetPenBrushAndFontElements;
+ function ReadSVGGradientColorStyle(AValue: String): TFPColor;
+ function ReadSVGStyle(AData: TvVectorialPage; AValue: string;
+ ADestEntity: TvEntityWithPen; ADestStyle: TvStyle = nil;
+ AUseFillAsPen: Boolean = False): TvSetPenBrushAndFontElements;
function ReadSVGStyleToStyleLists(AValue: string; AStyleKeys, AStyleValues: TStringList): TvSetPenBrushAndFontElements;
function ReadSVGPenStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPen): TvSetPenBrushAndFontElements;
function ReadSVGBrushStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPenAndBrush): TvSetPenBrushAndFontElements;
function ReadSVGFontStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPenBrushAndFont; ADestStyle: TvStyle = nil): TvSetPenBrushAndFontElements;
- function ReadSVGGeneralStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntity): TvSetPenBrushAndFontElements;
+ procedure ReadSVGGeneralStyleWithKeyAndValue(AData: TvVectorialPage;
+ AKey, AValue: string; ADestEntity: TvEntity);
function IsAttributeFromStyle(AStr: string): Boolean;
- procedure ApplyLayerStyles(ADestEntity: TvEntity);
+ procedure ApplyLayerStyles(AData: TvVectorialPage; ADestEntity: TvEntity);
function ReadSpaceSeparatedFloats(AInput: string; AOtherSeparators: string): TDoubleArray;
- function ReadSpaceSeparatedStrings(AInput: string; AOtherSeparators: string): TStringList;
procedure ReadSVGTransformationMatrix(AMatrix: string; out AA, AB, AC, AD, AE, AF: Double);
//
+ function GetTextContentFromNode(ANode: TDOMNode): string;
procedure ReadDefsFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
//
function ReadEntityFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument): TvEntity;
@@ -130,9 +136,12 @@
function ReadTextFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument): TvEntity;
function ReadUseFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument): TvEntity;
//
+ procedure StringToPenPattern(const AStr: String; var APen: TvPen);
function StringWithUnitToFloat(AStr: string; ACoordKind: TSVGCoordinateKind = sckUnknown;
ADefaultUnit: TSVGUnit = suPX; ATargetUnit: TSVGUnit = suPX): Double;
function StringFloatZeroToOneToWord(AStr: string): Word;
+ function StringWithPercentToFloat(AStr: String): Double;
+
procedure ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Double; var ADestX, ADestY: Double;
@@ -147,12 +156,14 @@
ADoViewBoxAdjust: Boolean = True);
procedure AutoDetectDocSize(var ALeft, ATop, ARight, ABottom: Double; ABaseNode: TDOMNode);
function SVGColorValueStrToWord(AStr: string): Word;
+
public
{ General reading methods }
constructor Create; override;
Destructor Destroy; override;
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
procedure ReadFromXML(Doc: TXMLDocument; AData: TvVectorialDocument); override;
+ class function ReadSpaceSeparatedStrings(AInput: string; AOtherSeparators: string): TStringList;
end;
implementation
@@ -166,8 +177,8 @@
// 90 inches per pixel = (1 / 90) * 25.4 = 0.2822
// FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel
- FLOAT_MILIMETERS_PER_PIXEL = 1; //0.2822; // DPI 90 = 1 / 90 inches per pixel => Actually I changed the value! Because otherwise it looks ugly!
- FLOAT_PIXELS_PER_MILIMETER = 1 / FLOAT_MILIMETERS_PER_PIXEL; // DPI 90 = 1 / 90 inches per pixel
+ FLOAT_MILLIMETERS_PER_PIXEL = 1; //0.2822; // DPI 90 = 1 / 90 inches per pixel => Actually I changed the value! Because otherwise it looks ugly!
+ FLOAT_PIXELS_PER_MILIMETER = 1 / FLOAT_MILLIMETERS_PER_PIXEL; // DPI 90 = 1 / 90 inches per pixel
FLOAT_POINTS_PER_PIXEL = 0.75; // For conversion
FLOAT_PIXEL_PER_POINT = 1 / FLOAT_POINTS_PER_PIXEL; // For conversion
@@ -205,8 +216,8 @@
destructor TSVGPathTokenizer.Destroy;
begin
+ ClearTokens;
Tokens.Free;
-
inherited Destroy;
end;
@@ -215,11 +226,12 @@
lToken: TSVGToken;
lStr: string;
begin
- lToken := TSVGToken.Create;
+// lToken := TSVGToken.Create;
lStr := Trim(AStr);
if lStr = '' then Exit;
+ lToken := TSVGToken.Create;
// Moves
if lStr[1] = 'M' then lToken.TokenType := sttMoveTo
else if lStr[1] = 'm' then lToken.TokenType := sttRelativeMoveTo
@@ -270,16 +282,27 @@
Tokens.Add(lToken);
end;
+procedure TSVGPathTokenizer.ClearTokens;
+var
+ i: Integer;
+begin
+ for i := Tokens.Count-1 downto 0 do
+ Tokens[i].Free;
+ Tokens.Clear;
+end;
+
procedure TSVGPathTokenizer.TokenizePathString(AStr: string);
const
Str_Space: Char = ' ';
Str_Comma: Char = ',';
+ Str_Plus: Char = '+';
+ Str_Minus: Char = '-';
ListOfCommandLetters: set of Char = ['a'..'d', 'f'..'z', 'A'..'D', 'F'..'Z'];
var
i: Integer;
lTmpStr: string = '';
lState: Integer;
- lFirstTmpStrChar, lCurChar: Char;
+ lFirstTmpStrChar, lCurChar, lPrevChar: Char;
begin
lState := 0;
@@ -289,6 +312,7 @@
case lState of
0: // Adding to the tmp string
begin
+ if i > 0 then lPrevChar := AStr[i-1];
lCurChar := AStr[i];
if lCurChar = Str_Space then
begin
@@ -301,6 +325,11 @@
AddToken(lTmpStr);
lTmpStr := '';
end
+ else if (lCurChar in [Str_Plus, Str_Minus]) and (lPrevChar in ['0'..'9']) then
+ begin
+ AddToken(lTmpStr);
+ lTmpStr := lCurChar;
+ end
else
begin
// Check for a break, from letter to number
@@ -487,332 +516,248 @@
// Support for named colors
// List here: http://www.december.com/html/spec/colorsvghex.html
- case lValue of
- 'black': Result := colBlack;
- 'navy': Result.Blue := $8080;
- 'darkblue':Result.Blue := $8B8B;
- 'mediumblue':Result.Blue := $CDCD;
- 'blue': Result := colBlue;
- 'darkgreen':Result.Green := $6464;
- 'green': Result.Green := $8080;
- 'teal':
- begin
- Result.Green := $8080;
- Result.Blue := $8080;
- end;
- 'darkcyan':
- begin
- Result.Green := $8B8B;
- Result.Blue := $8B8B;
- end;
- 'deepskyblue':
- begin
- Result.Green := $BFBF;
- Result.Blue := $FFFF;
- end;
- 'darkturquoise':
- begin
- Result.Green := $CECE;
- Result.Blue := $D1D1;
- end;
- 'mediumspringgreen':
- begin
- Result.Green := $FAFA;
- Result.Blue := $9A9A;
- end;
- 'lime': Result := colGreen;
- 'springgreen':
- begin
- Result.Green := $FFFF;
- Result.Blue := $7F7F;
- end;
- 'cyan': Result := colCyan;
- 'aqua': Result := colCyan;
- 'midnightblue':
- begin
- Result.Red := $1919;
- Result.Green := $1919;
- Result.Blue := $7070;
- end;
- 'dodgerblue':
- begin
- Result.Red := $1E1E;
- Result.Green := $9090;
- Result.Blue := $FFFF;
- end;
- 'lightseagreen':
- begin
- Result.Red := $2020;
- Result.Green := $B2B2;
- Result.Blue := $AAAA;
- end;
- 'forestgreen':
- begin
- Result.Red := $2222;
- Result.Green := $8B8B;
- Result.Blue := $2222;
- end;
- 'seagreen':
- begin
- Result.Red := $2E2E;
- Result.Green := $8B8B;
- Result.Blue := $5757;
- end;
- 'darkslategray', 'darkslategrey':
- begin
- Result.Red := $2F2F;
- Result.Green := $4F4F;
- Result.Blue := $4F4F;
+ case lValue[1] of
+ 'a': case lValue of
+ 'aliceblue' : Result := FPColor($F0F0, $F8F8, $FFFF);
+ 'antiquewhite' : Result := FPColor($FAFA, $EBEB, $D7D7);
+ 'aqua' : Result := colCyan;
+ 'aquamarine' : Result := FPColor($7F7F, $FFFF, $D4D4);
+ 'azure' : Result := FPColor($F0F0, $FFFF, $FFFF);
+ end;
+
+ 'b': case lValue of
+ 'beige' : Result := FPColor($F5F5, $F5F5, $DCDC);
+ 'bisque' : Result := FPColor($FFFF, $E4E4, $C4C4);
+ 'black' : Result := colBlack;
+ 'blanchedalmond' : Result := FPColor($FFFF, $EBEB, $CDCD);
+ 'blue' : Result := colBlue;
+ 'blueviolet' : Result := FPColor($8A8A, $2B2B, $E2E2);
+ 'brown' : Result := FPColor($A5A5, $2A2A, $2A2A);
+ 'burlywood' : Result := FPColor($DEDE, $B8B8, $8787);
+ end;
+
+ 'c': case lValue of
+ 'cadetblue' : Result := FPColor($5F5F, $9E9E, $A0A0);
+ 'chartreuse' : Result := FPColor($7F7F, $FFFF, $0000);
+ 'chocolate' : Result := FPColor($D2D2, $6969, $1E1E);
+ 'coral' : Result := FPColor($FFFF, $7F7F, $5050);
+ 'cornflowerblue' : Result := FPColor($6464, $9595, $EDED);
+ 'cornsilk' : Result := FPColor($FFFF, $F8F8, $DCDC);
+ 'crimson' : Result := FPColor($DCDC, $1414, $3C3C);
+ 'cyan' : Result := colCyan;
+ end;
+
+ 'd': case lValue of
+ 'darkblue' : Result.Blue := $8B8B;
+ 'darkcyan' : Result := FPColor($0000, $8B8B, $8B8B);
+ 'darkgoldenrod' : Result := FPColor($B8B8, $8686, $0B0B);
+ 'darkgray',
+ 'darkgrey' : Result := FPColor($A9A9, $A9A9, $A9A9);
+ 'darkgreen' : Result.Green := $6464;
+ 'darkkhaki' : Result := FPColor($BDBD, $B7B7, $6B6B);
+ 'darkmagenta' : Result := FPColor($8B8B, $0000, $8B8B);
+ 'darkolivegreen' : Result := FPColor($5555, $6B6B, $2F2F);
+ 'darkorange' : Result := FPColor($FFFF, $8C8C, $0000);
+ 'darkorchid' : Result := FPColor($9999, $3232, $CCCC);
+ 'darkred' : Result.Red := $8B8B;
+ 'darksalmon' : Result := FPColor($E9E9, $9696, $7A7A);
+ 'darkseagreen' : Result := FPColor($8F8F, $BCBC, $8F8F);
+ 'darkslateblue' : Result := FPColor($4848, $3D3D, $8B8B);
+ 'darkslategray',
+ 'darkslategrey' : Result := FPColor($2F2F, $4F4F, $4F4F);
+ 'darkturquoise' : Result := FPColor($0000, $CECE, $D1D1);
+ 'darkviolet' : Result := FPColor($9494, $0000, $D3D3);
+ 'deeppink' : Result := FPColor($FFFF, $1414, $9393);
+ 'deepskyblue' : Result := FPColor($0000, $BFBF, $FFFF);
+ 'dimgray',
+ 'dimgrey' : Result := FPColor($6969, $6969, $6969);
+ 'dodgerblue' : Result := FPColor($1E1E, $9090, $FFFF);
+ end;
+
+ 'f': case lValue of
+ 'firebrick' : Result := FPColor($B2B2, $2222, $2222);
+ 'floralwhite' : Result := FPColor($FFFF, $FAFA, $F0F0);
+ 'forestgreen' : Result := FPColor($2222, $8B8B, $2222);
+ 'fuchsia' : Result := colFuchsia;
+ end;
+
+ 'g': case lValue of
+ 'gainsboro' : Result := FPColor($DCDC, $DCDC, $DCDC);
+ 'ghostwhite' : Result := FPColor($F8F8, $F8F8, $FFFF);
+ 'gold' : Result := FPColor($FFFF, $D7D7, $0000);
+ 'goldenrod' : Result := FPColor($DADA, $A5A5, $2020);
+ 'gray', 'grey' : Result := colGray;
+ 'green' : Result.Green := $8080;
+ 'greenyellow' : Result := FPColor($ADAD, $FFFF, $2F2F);
+ end;
+
+ 'h': case lValue of
+ 'honeydew' : Result := FPColor($F0F0, $FFFF, $F0F0);
+ 'hotpink' : Result := FPColor($FFFF, $6969, $B4B4);
+ end;
+
+ 'i': case lValue of
+ 'indianred' : Result := FPColor($CDCD, $5C5C, $5C5C);
+ 'indigo' : Result := FPColor($4B4B, $0000, $8282);
+ 'ivory' : Result := FPColor($FFFF, $FFFF, $F0F0);
+ end;
+
+ 'k': case lValue of
+ 'khaki' : Result := FPColor($F0F0, $E6E6, $8C8C);
+ end;
+
+ 'l': case lValue of
+ 'lavender' : Result := FPColor($E6E6, $E6E6, $FAFA);
+ 'lavenderblush' : Result := FPColor($FFFF, $F0F0, $F5F5);
+ 'lawngreen' : Result := FPColor($7C7C, $FCFE, $0000);
+ 'lemonchiffon' : Result := FPColor($FFFF, $FAFA, $CDCD);
+ 'lightblue' : Result := FPColor($ADAD, $D8D8, $E6E6);
+ 'lightcoral' : Result := FPColor($F0F0, $8080, $8080);
+ 'lightcyan' : Result := FPColor($E0E0, $FFFF, $FFFF);
+ 'lightgoldenrodyellow': Result := FPColor($FAFA, $FAFA, $D2D2);
+ 'lightgray',
+ 'lightgrey' : Result := FPColor($D3D3, $D3D3, $D3D3);
+ 'lightgreen' : Result := FPColor($9090, $EEEE, $9090);
+ 'lightpink' : Result := FPColor($FFFF, $B6B6, $C1C1);
+ 'lightsalmon' : Result := FPColor($FFFF, $A0A0, $7A7A);
+ 'lightseagreen' : Result := FPColor($2020, $B2B2, $AAAA);
+ 'lightskyblue' : Result := FPColor($8787, $CECE, $FAFA);
+ 'lightslategray',
+ 'lightslategrey' : Result := FPColor($7777, $8888, $9999);
+ 'lightsteelblue' : Result := FPColor($B0B0, $C4C4, $DEDE);
+ 'lightyellow' : Result := FPColor($FFFF, $FEFE, $0000);
+ 'lime' : Result := colGreen;
+ 'limegreen' : Result := FPColor($3232, $CDCD, $3232);
+ 'linen' : Result := FPColor($FAFA, $F0F0, $E6E6);
+ end;
+
+ 'm': case lValue of
+ 'magenta' : Result := colMagenta;
+ 'maroon' : Result.Red := $8080;
+ 'mediumaquamarine' : Result := FPColor($6666, $CDCD, $AAAA);
+ 'mediumblue' : Result.Blue := $CDCD;
+ 'mediumorchid' : Result := FPColor($BABA, $5555, $D3D3);
+ 'mediumpurple' : Result := FPColor($9393, $7070, $DBDB);
+ 'mediumseagreen' : Result := FPColor($3C3C, $CBCB, $7171);
+ 'mediumslateblue' : Result := FPColor($7B7B, $6868, $EEEE);
+ 'mediumspringgreen' : Result := FPColor($0000, $FAFA, $9A9A);
+ 'mediumturquoise' : Result := FPColor($4848, $D1D1, $CCCC);
+ 'mediumvioletred' : Result := FPColor($C7C7, $1515, $8585);
+ 'midnightblue' : Result := FPColor($1919, $1919, $7070);
+ 'mintcream' : Result := FPColor($F5F5, $FFFF, $FAFA);
+ 'mistyrose' : Result := FPColor($FFFF, $E4E4, $E1E1);
+ 'moccasin' : Result := FPColor($FFFF, $E4E4, $B5B5);
+ end;
+
+ 'n': case lValue of
+ 'navajowhite' : Result := FPColor($FFFF, $DEDE, $ADAD);
+ 'navy' : Result.Blue := $8080;
+ end;
+
+ 'o': case lValue of
+ 'oldlace' : Result := FPColor($FDFD, $F5F5, $E6E6);
+ 'olive' : Result := colOlive;
+ 'olivedrab' : Result := FPColor($6B6B, $8E8E, $2323);
+ 'orange' : Result := FPColor($FFFF, $A5A5, $0000);
+ 'orangered' : Result := FPColor($FFFF, $4545, $0000);
+ 'orchid' : Result := FPColor($DADA, $7070, $D6D6);
+ end;
+
+ 'p': case lValue of
+ 'palegreen' : Result := FPColor($9898, $FBFB, $9898);
+ 'palegoldenrod' : Result := FPColor($EEEE, $E8E8, $AAAA);
+ 'paleturquoise' : Result := FPColor($AFAF, $EEEE, $EEEE);
+ 'palevioletred' : Result := FPColor($DBDB, $7070, $9393);
+ 'papayawhip' : Result := FPColor($FFFF, $EFEF, $D5D5);
+ 'peachpuff' : Result := FPColor($FFFF, $DADA, $B9B9);
+ 'peru' : Result := FPColor($CDCD, $8585, $3F3F);
+ 'pink' : Result := FPColor($FFFF, $C0C0, $CBCB);
+ 'plum' : Result := FPColor($DDDD, $A0A0, $DDDD);
+ 'powderblue' : Result := FPColor($B0B0, $E0E0, $E6E6);
+ 'purple' : Result := colPurple;
+ end;
+
+ 'r': case lValue of
+ 'red' : Result := colRed;
+ 'rosybrown' : Result := FPColor($BCBC, $8F8F, $8F8F);
+ 'royalblue' : Result := FPColor($4141, $6969, $E1E1);
+ end;
+
+ 's': case lValue of
+ 'saddlebrown' : Result := FPColor($8B8B, $4545, $1313);
+ 'salmon' : Result := FPColor($FAFA, $8080, $7272);
+ 'sandybrown' : Result := FPColor($F4F4, $A4A4, $6060);
+ 'seagreen' : Result := FPColor($2E2E, $8B8B, $5757);
+ 'seashell' : Result := FPColor($FFFF, $F5F5, $EEEE);
+ 'sienna' : Result := FPColor($A0A0, $5252, $2D2D);
+ 'silver' : Result := colSilver;
+ 'skyblue' : Result := FPColor($8787, $CECE, $EBEB);
+ 'slateblue' : Result := FPCOlor($6A6A, $5A5A, $CDCD);
+ 'slategray',
+ 'slategrey' : Result := FPColor($7070, $8080, $9090);
+ 'snow' : Result := FPColor($FFFF, $FAFA, $FAFA);
+ 'springgreen' : Result := FPColor($0000, $FFFF, $7F7F);
+ 'steelblue' : Result := FPColor($4646, $8282, $B4B4);
+ end;
+
+ 't': case lValue of
+ 'tan' : Result := FPColor($D2D2, $B4B4, $8C8C);
+ 'teal' : Result := FPColor($0000, $8080, $8080);
+ 'thistle' : Result := FPColor($D8D8, $BFBF, $D8D8);
+ 'tomato' : Result := FPColor($FFFF, $6363, $4747);
+ 'turquoise' : Result := FPColor($4040, $E0E0, $D0D0);
+ end;
+
+ 'v': case lValue of
+ 'violet' : Result := FPColor($EEEE, $8282, $EEEE);
+ end;
+
+ 'w': case lValue of
+ 'wheat' : Result := FPColor($F5F5, $DEDE, $B3B3);
+ 'white' : Result := colWhite;
+ 'whitesmoke' : Result := FPColor($F5F5, $F5F5, $F5F5);
+ end;
+
+ 'y': case lValue of
+ 'yellow' : Result := colYellow;
+ 'yellowgreen' : Result := FPColor($9A9A, $CDCD, $3232);
+ end;
end;
- 'limegreen':
- begin
- Result.Red := $3232;
- Result.Green := $CDCD;
- Result.Blue := $3232;
- end;
- 'mediumseagreen':
- begin
- Result.Red := $3C3C;
- Result.Green := $CBCB;
- Result.Blue := $7171;
- end;
- 'turquoise':
- begin
- Result.Red := $4040;
- Result.Green := $E0E0;
- Result.Blue := $D0D0;
- end;
- 'royalblue':
- begin
- Result.Red := $4141;
- Result.Green := $6969;
- Result.Blue := $E1E1;
- end;
- 'steelblue':
- begin
- Result.Red := $4646;
- Result.Green := $8282;
- Result.Blue := $B4B4;
- end;
- 'darkslateblue':
- begin
- Result.Red := $4848;
- Result.Green := $3D3D;
- Result.Blue := $8B8B;
- end;
- 'mediumturquoise':
- begin
- Result.Red := $4848;
- Result.Green := $D1D1;
- Result.Blue := $CCCC;
- end;
-{
-indigo #4B0082
- darkolivegreen #556B2F cadetblue #5F9EA0
-cornflowerblue #6495ED
- mediumaquamarine #66CDAA dimgrey #696969
-dimgray #696969
- slateblue #6A5ACD olivedrab #6B8E23
-slategrey #708090
- slategray #708090 lightslategray(Hex3) #778899
-lightslategrey(Hex3) #778899
- mediumslateblue #7B68EE lawngreen #7CFC00
-chartreuse #7FFF00
-}
- 'aquamarine':
- begin
- Result.Red := $7F7F;
- Result.Green := $FFFF;
- Result.Blue := $D4D4;
- end;
- 'maroon': Result.Red := $8080;
- 'purple': Result := colPurple;
- 'olive': Result := colOlive;
- 'gray', 'grey': Result := colGray;
- 'skyblue':
- begin
- Result.Red := $8787;
- Result.Green := $CECE;
- Result.Blue := $EBEB;
- end;
- 'lightskyblue':
- begin
- Result.Red := $8787;
- Result.Green := $CECE;
- Result.Blue := $FAFA;
- end;
- 'blueviolet':
- begin
- Result.Red := $8A8A;
- Result.Green := $2B2B;
- Result.Blue := $E2E2;
- end;
- 'darkred': Result.Red := $8B8B;
- 'darkmagenta':
- begin
- Result.Red := $8B8B;
- Result.Blue := $8B8B;
- end;
-{
-saddlebrown #8B4513
- darkseagreen #8FBC8F lightgreen #90EE90
-mediumpurple #9370DB
- darkviolet #9400D3 palegreen #98FB98
-darkorchid #9932CC
- yellowgreen #9ACD32 sienna #A0522D
-brown #A52A2A
- darkgray #A9A9A9 darkgrey #A9A9A9
-lightblue #ADD8E6
- greenyellow #ADFF2F paleturquoise #AFEEEE
-lightsteelblue #B0C4DE
- powderblue #B0E0E6 firebrick #B22222
-darkgoldenrod #B8860B
- mediumorchid #BA55D3 rosybrown #BC8F8F
-darkkhaki #BDB76B
-}
- 'silver': Result := colSilver;
- 'mediumvioletred':
- begin
- Result.Red := $C7C7;
- Result.Green := $1515;
- Result.Blue := $8585;
- end;
- 'indianred':
- begin
- Result.Red := $CDCD;
- Result.Green := $5C5C;
- Result.Blue := $5C5C;
- end;
- 'peru':
- begin
- Result.Red := $CDCD;
- Result.Green := $8585;
- Result.Blue := $3F3F;
- end;
- 'chocolate':
- begin
- Result.Red := $D2D2;
- Result.Green := $6969;
- Result.Blue := $1E1E;
- end;
-{
-tan #D2B48C
- lightgray #D3D3D3 lightgrey #D3D3D3
-thistle #D8BFD8
- orchid #DA70D6 goldenrod #DAA520
-palevioletred #DB7093
- crimson #DC143C gainsboro #DCDCDC
-plum #DDA0DD
- burlywood #DEB887 lightcyan #E0FFFF
-lavender #E6E6FA
-}
- 'darksalmon':
- begin
- Result.Red := $E9E9;
- Result.Green := $9696;
- Result.Blue := $7A7A;
- end;
- 'violet':
- begin
- Result.Red := $EEEE;
- Result.Green := $8282;
- Result.Blue := $EEEE;
- end;
- 'palegoldenrod':
- begin
- Result.Red := $EEEE;
- Result.Green := $E8E8;
- Result.Blue := $AAAA;
- end;
- 'lightcoral':
- begin
- Result.Red := $F0F0;
- Result.Green := $8080;
- Result.Blue := $8080;
- end;
- 'khaki':
- begin
- Result.Red := $F0F0;
- Result.Green := $E6E6;
- Result.Blue := $8C8C;
- end;
- 'aliceblue':
- begin
- Result.Red := $F0F0;
- Result.Green := $F8F8;
- Result.Blue := $FFFF;
- end;
- 'honeydew':
- begin
- Result.Red := $F0F0;
- Result.Green := $FFFF;
- Result.Blue := $F0F0;
- end;
- 'azure':
- begin
- Result.Red := $F0F0;
- Result.Green := $FFFF;
- Result.Blue := $FFFF;
- end;
- 'sandybrown':
- begin
- Result.Red := $F4F4;
- Result.Green := $A4A4;
- Result.Blue := $6060;
- end;
-{
- wheat #F5DEB3 beige #F5F5DC
-whitesmoke #F5F5F5
- mintcream #F5FFFA ghostwhite #F8F8FF
-salmon #FA8072
- antiquewhite #FAEBD7 linen #FAF0E6
-lightgoldenrodyellow #FAFAD2
- oldlace #FDF5E6
-}
- 'red': Result := colRed;
- 'fuchsia': Result := colFuchsia;
- 'magenta': Result := colMagenta;
-{ deeppink #FF1493
-orangered #FF4500
- tomato #FF6347 hotpink #FF69B4
-coral #FF7F50
- darkorange #FF8C00 lightsalmon #FFA07A
-orange #FFA500
- lightpink #FFB6C1 pink #FFC0CB
-gold #FFD700
- peachpuff #FFDAB9 navajowhite #FFDEAD
-moccasin #FFE4B5
- bisque #FFE4C4 mistyrose #FFE4E1
-blanchedalmond #FFEBCD
- papayawhip #FFEFD5 lavenderblush #FFF0F5
-seashell #FFF5EE
- cornsilk #FFF8DC lemonchiffon #FFFACD
-floralwhite #FFFAF0
-}
- 'snow':
- begin
- Result.Red := $FFFF;
- Result.Green := $FAFA;
- Result.Blue := $FAFA;
- end;
- 'yellow': Result := colYellow;
- 'lightyellow':
- begin
- Result.Red := $FFFF;
- Result.Green := $FEFE;
- end;
- 'ivory':
- begin
- Result.Red := $FFFF;
- Result.Green := $FFFF;
- Result.Blue := $F0F0;
- end;
- 'white': Result := colWhite;
+end;
+
+// style="stop-color:rgb(255,255,10);stop-opacity:1.0"
+function TvSVGVectorialReader.ReadSVGGradientColorStyle(AValue: String): TFPColor;
+var
+ lStr, lStyleKeyStr, lStyleValueStr: String;
+ lStrings: TStringList;
+ i: Integer;
+ p: Integer;
+begin
+ Result := colBlack;
+ if AValue = '' then Exit;
+ lStrings := TStringList.Create;
+ try
+ lStrings.Delimiter := ';';
+ lStrings.StrictDelimiter := True;
+ lStrings.DelimitedText := LowerCase(AValue);
+ for i := 0 to lStrings.Count-1 do
+ begin
+ lStr := lStrings.Strings[i];
+ p := Pos(':', lStr);
+ lStyleKeyStr := Trim(Copy(lStr, 1, p-1));
+ lStyleValueStr := Trim(Copy(lStr, p+1, MaxInt));
+ if lStyleKeyStr = 'stop-color' then
+ Result := ReadSVGColor(lStyleValueStr)
+ else if lStyleKeyStr = 'stop-opacity' then
+ Result.Alpha := Round(StrToFloat(lStyleValueStr, FPointSeparator)*$FFFF);
+ end;
+ finally
+ lStrings.Free;
end;
end;
// style="fill:none;stroke:black;stroke-width:3"
-function TvSVGVectorialReader.ReadSVGStyle(AValue: string;
+function TvSVGVectorialReader.ReadSVGStyle(AData: TvVectorialPage; AValue: string;
ADestEntity: TvEntityWithPen; ADestStyle: TvStyle = nil;
AUseFillAsPen: Boolean = False): TvSetPenBrushAndFontElements;
var
@@ -840,7 +785,7 @@
if ADestEntity <> nil then
begin
ReadSVGPenStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity);
- ReadSVGGeneralStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity);
+ ReadSVGGeneralStyleWithKeyAndValue(AData, lStyleKeyStr, lStyleValueStr, ADestEntity);
if AUseFillAsPen and (lStyleKeyStr = 'fill') then
Result := Result + ReadSVGPenStyleWithKeyAndValue('stroke', lStyleValueStr, ADestEntity)
else if ADestEntity is TvText then
@@ -919,7 +864,7 @@
end
else if AKey = 'stroke-opacity' then
begin
- ADestEntity.Pen.Color.Alpha := Round(StrToFloat(AValue)*$FFFF);
+ ADestEntity.Pen.Color.Alpha := Round(StrToFloat(AValue, FPointSeparator)*$FFFF);
end
else if AKey = 'stroke-linecap' then
begin
@@ -928,7 +873,9 @@
'round':
'square': ADestEntity.Pen;
end;}
- end;
+ end
+ else if AKey = 'stroke-dasharray' then
+ StringToPenPattern(AValue, ADestEntity.Pen);
end;
function TvSVGVectorialReader.ReadSVGBrushStyleWithKeyAndValue(AKey,
@@ -943,7 +890,7 @@
Result := [];
if AKey = 'fill' then
begin
- // Suppose for fill="url(#grad2)"
+ // Support for fill="url(#grad2)"
lDefName := Trim(AValue);
if Copy(lDefName, 0, 3) = 'url' then
begin
@@ -976,6 +923,13 @@
Result := Result + [spbfBrushColor, spbfBrushStyle];
end
+ else if AKey = 'fill-rule' then
+ begin
+ if AValue = 'evenodd' then
+ ADestEntity.WindingRule := vcmEvenOddRule else
+ if AValue = 'nonzero' then
+ ADestEntity.WindingRule := vcmNonzeroWindingRule; // to do: "inherit" missing here
+ end
else if AKey = 'fill-opacity' then
ADestEntity.Brush.Color.Alpha := StringFloatZeroToOneToWord(AValue)
// For linear gradient => stop-color:rgb(255,255,0);stop-opacity:1
@@ -983,7 +937,7 @@
begin
Len := Length(ADestEntity.Brush.Gradient_colors);
SetLength(ADestEntity.Brush.Gradient_colors, Len+1);
- ADestEntity.Brush.Gradient_colors[Len] := ReadSVGColor(AValue);
+ ADestEntity.Brush.Gradient_colors[Len].Color := ReadSVGColor(AValue);
end;
end;
@@ -991,6 +945,8 @@
AValue: string; ADestEntity: TvEntityWithPenBrushAndFont; ADestStyle: TvStyle = nil): TvSetPenBrushAndFontElements;
var
lLowerValue: String;
+ p: Integer;
+ fntName: String;
begin
Result := [];
lLowerValue := LowerCase(AValue);
@@ -1021,14 +977,21 @@
end
else if AKey = 'font-size' then
begin
- if ADestEntity <> nil then ADestEntity.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPX, suPT));
- if ADestStyle <> nil then ADestStyle.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPX, suPT));
+ if ADestEntity <> nil then ADestEntity.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPT, suPT));
+ if ADestStyle <> nil then ADestStyle.Font.Size := Round(StringWithUnitToFloat(AValue, sckXSize, suPT, suPT));
Result := Result + [spbfFontSize];
end
else if AKey = 'font-family' then
begin
- if ADestEntity <> nil then ADestEntity.Font.Name := AValue;
- if ADestStyle <> nil then ADestStyle.Font.Name := AValue;
+ // Extract the font name
+ // To do: Check if font name exists in system. Use replacement fonts which
+ // may follow after the comma.
+ p := pos(',', AValue);
+ if p = 0 then
+ fntName := AValue else
+ fntName := trim(Copy(AValue, 1, p-1));
+ if ADestEntity <> nil then ADestEntity.Font.Name := fntName;
+ if ADestStyle <> nil then ADestStyle.Font.Name := fntName;
Result := Result + [spbfFontName];
end
else if AKey = 'font-weight' then
@@ -1072,8 +1035,8 @@
ADestStyle.SetElements := ADestStyle.SetElements + Result;
end;
-function TvSVGVectorialReader.ReadSVGGeneralStyleWithKeyAndValue(AKey,
- AValue: string; ADestEntity: TvEntity): TvSetPenBrushAndFontElements;
+procedure TvSVGVectorialReader.ReadSVGGeneralStyleWithKeyAndValue(AData: TvVectorialPage;
+ AKey, AValue: string; ADestEntity: TvEntity);
var
// transform
MA, MB, MC, MD, ME, MF: Double;
@@ -1128,7 +1091,17 @@
end
else if lFunctionName = 'rotate' then
begin
- ADestEntity.Rotate(lMatrixElements[0], Make3DPoint(0, 0, 0));
+ lMRotate := -DegToRad(lMatrixElements[0]);
+ // "-" because of orientation of svg coordinate system
+ lMTranslateX := 0;
+ lMTranslateY := 0;
+ if Length(lMatrixElements) > 1 then
+ lMTranslateX := lMatrixElements[1];
+ if Length(lMatrixElements) > 2 then
+ lMTranslateY := lMatrixElements[2];
+ ConvertSVGCoordinatesToFPVCoordinates(AData,
+ lMTranslateX, lMTranslateY, lMTranslateX, lMTranslateY);
+ ADestEntity.Rotate(lMRotate, Make3DPoint(lMTranslateX, lMTranslateY));
end;
Inc(i, 2);
@@ -1151,11 +1124,12 @@
// brush
(AStr = 'fill') or (AStr = 'fill-opacity') or
// font
- (AStr = 'font-size') or (AStr = 'fill-family') or
+ (AStr = 'font-size') or (AStr = 'font-family') or
(AStr = 'font-weight') or (AStr = 'text-anchor');
end;
-procedure TvSVGVectorialReader.ApplyLayerStyles(ADestEntity: TvEntity);
+procedure TvSVGVectorialReader.ApplyLayerStyles(AData: TvVectorialPage;
+ ADestEntity: TvEntity);
var
lStringsKeys, lStringsValues: TStringList;
i, j: Integer;
@@ -1178,7 +1152,7 @@
if ADestEntity is TvEntityWithPenBrushAndFont then
ReadSVGFontStyleWithKeyAndValue(lCurKey, lCurValue, ADestEntity as TvEntityWithPenBrushAndFont);
// transform
- ReadSVGGeneralStyleWithKeyAndValue(lCurKey, lCurValue, ADestEntity);
+ ReadSVGGeneralStyleWithKeyAndValue(AData, lCurKey, lCurValue, ADestEntity);
end;
end;
end;
@@ -1214,7 +1188,7 @@
end;
end;
-function TvSVGVectorialReader.ReadSpaceSeparatedStrings(AInput: string;
+class function TvSVGVectorialReader.ReadSpaceSeparatedStrings(AInput: string;
AOtherSeparators: string): TStringList;
var
i: Integer;
@@ -1251,6 +1225,18 @@
AF := lMatrixElements[5];
end;
+function TvSVGVectorialReader.GetTextContentFromNode(ANode: TDOMNode): string;
+var
+ i: Integer;
+begin
+ Result := '';
+ for i := 0 to ANode.ChildNodes.Count-1 do
+ begin
+ if ANode.ChildNodes.Item[i] is TDOMText then
+ Result := ANode.ChildNodes.Item[i].NodeValue;
+ end;
+end;
+
procedure TvSVGVectorialReader.ReadDefsFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
@@ -1259,12 +1245,12 @@
lPreviousLayer: TvEntityWithSubEntities;
lAttrName, lAttrValue, lNodeName: DOMString;
lLayerName: String;
- i: Integer;
+ i, len: Integer;
lCurNode, lCurSubNode: TDOMNode;
lBrushEntity: TvEntityWithPenAndBrush;
lCurEntity: TvEntity;
- lOffset: Double;
- x1, x2, y1, y2: string;
+ lGradientColor: TvGradientColor;
+ x1, y1, x2, y2: Double;
begin
lCurNode := ANode.FirstChild;
while Assigned(lCurNode) do
@@ -1336,23 +1322,79 @@
lBrushEntity := TvEntityWithPenAndBrush.Create(nil);
//