Стартовый пул
This commit is contained in:
31
ATSynEdit/.gitignore
vendored
Normal file
31
ATSynEdit/.gitignore
vendored
Normal file
@@ -0,0 +1,31 @@
|
||||
*.exe
|
||||
*.rar
|
||||
*.zip
|
||||
*.dbg
|
||||
*.ico
|
||||
*.dll
|
||||
*.bpl
|
||||
*.bpi
|
||||
*.dcp
|
||||
*.so
|
||||
*.apk
|
||||
*.drc
|
||||
*.map
|
||||
*.dres
|
||||
*.rsm
|
||||
*.tds
|
||||
*.dcu
|
||||
*.dof
|
||||
*.deb
|
||||
*.zip
|
||||
*.ppu
|
||||
*.bak
|
||||
*.ini
|
||||
*.lps
|
||||
*.copy
|
||||
|
||||
lib/
|
||||
backup/
|
||||
project?
|
||||
demo
|
||||
lex_lib_demo
|
||||
143
ATSynEdit/app/demo_adapter_econtrol/demo.lpi
Normal file
143
ATSynEdit/app/demo_adapter_econtrol/demo.lpi
Normal file
@@ -0,0 +1,143 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="econtrol_package"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="11">
|
||||
<Unit0>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_adapter_econtrol.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Adapter_EControl"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\atsynedit\atsynedit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_canvasproc.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_CanvasProc"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_adapters.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Adapters"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\..\atsynedit\atstringproc.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStringProc"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\atsynedit\atstringproc_textbuffer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStringProc_TextBuffer"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_fold.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_ranges.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Ranges"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_hilite.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit10>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);..\..\atsynedit"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit;..\..\proc_lexer"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
ATSynEdit/app/demo_adapter_econtrol/demo.lpr
Normal file
22
ATSynEdit/app/demo_adapter_econtrol/demo.lpr
Normal file
@@ -0,0 +1,22 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
//heaptrc,
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, ATSynEdit, atsynedit_adapters, ATSynEdit_CanvasProc,
|
||||
ATStringProc_TextBuffer, ATSynEdit_Ranges, ecLists, ecStrUtils;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:= True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
26427
ATSynEdit/app/demo_adapter_econtrol/lib.lxl
Normal file
26427
ATSynEdit/app/demo_adapter_econtrol/lib.lxl
Normal file
File diff suppressed because it is too large
Load Diff
452
ATSynEdit/app/demo_adapter_econtrol/unit1.lfm
Normal file
452
ATSynEdit/app/demo_adapter_econtrol/unit1.lfm
Normal file
@@ -0,0 +1,452 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 391
|
||||
Height = 578
|
||||
Top = 237
|
||||
Width = 889
|
||||
Caption = 'Demo'
|
||||
ClientHeight = 578
|
||||
ClientWidth = 889
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 218
|
||||
Top = 360
|
||||
Width = 889
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 218
|
||||
ClientWidth = 889
|
||||
TabOrder = 0
|
||||
object chkWrap: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 8
|
||||
Width = 98
|
||||
Caption = 'word wrap'
|
||||
OnChange = chkWrapChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object edLexer: TComboBox
|
||||
Left = 9
|
||||
Height = 31
|
||||
Top = 120
|
||||
Width = 176
|
||||
DropDownCount = 24
|
||||
ItemHeight = 0
|
||||
OnChange = edLexerChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 5
|
||||
end
|
||||
object files: TShellListView
|
||||
Left = 352
|
||||
Height = 208
|
||||
Top = 3
|
||||
Width = 528
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
Color = clDefault
|
||||
HideSelection = False
|
||||
ReadOnly = True
|
||||
ShowColumnHeaders = False
|
||||
SortType = stText
|
||||
TabOrder = 12
|
||||
ToolTips = False
|
||||
ViewStyle = vsSmallIcon
|
||||
OnClick = filesClick
|
||||
ObjectTypes = [otNonFolders]
|
||||
end
|
||||
object chkFullSel: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 48
|
||||
Width = 129
|
||||
Caption = 'show full sel-bg'
|
||||
OnChange = chkFullSelChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkFullHilite: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 68
|
||||
Width = 154
|
||||
Caption = 'show full syntax-bg'
|
||||
OnChange = chkFullHiliteChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object bOpen: TButton
|
||||
Left = 192
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 152
|
||||
Caption = 'open...'
|
||||
OnClick = bOpenClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object chkUnpri: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 28
|
||||
Width = 130
|
||||
Caption = 'show unprinted'
|
||||
OnChange = chkUnpriChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object chkShowCur: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 88
|
||||
Width = 132
|
||||
Caption = 'show cur line bg'
|
||||
OnChange = chkShowCurChange
|
||||
TabOrder = 4
|
||||
end
|
||||
object chkLexer: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 152
|
||||
Width = 108
|
||||
Caption = 'enable lexer'
|
||||
Checked = True
|
||||
OnChange = chkLexerChange
|
||||
State = cbChecked
|
||||
TabOrder = 6
|
||||
end
|
||||
object chkDyn: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 176
|
||||
Width = 119
|
||||
Caption = 'dynamic hilite'
|
||||
OnChange = chkDynChange
|
||||
TabOrder = 7
|
||||
end
|
||||
object bComment: TButton
|
||||
Left = 192
|
||||
Height = 25
|
||||
Top = 40
|
||||
Width = 152
|
||||
Caption = 'comment sel'
|
||||
OnClick = bCommentClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object bUncomment: TButton
|
||||
Left = 192
|
||||
Height = 25
|
||||
Top = 72
|
||||
Width = 152
|
||||
Caption = 'uncomment sel'
|
||||
OnClick = bUncommentClick
|
||||
TabOrder = 10
|
||||
end
|
||||
object bExport: TButton
|
||||
Left = 192
|
||||
Height = 25
|
||||
Top = 104
|
||||
Width = 152
|
||||
Caption = 'export html'
|
||||
OnClick = bExportClick
|
||||
TabOrder = 11
|
||||
end
|
||||
end
|
||||
object Tree: TTreeView
|
||||
Left = 0
|
||||
Height = 360
|
||||
Top = 0
|
||||
Width = 240
|
||||
Align = alLeft
|
||||
HideSelection = False
|
||||
Images = ImageListTree
|
||||
ReadOnly = True
|
||||
RightClickSelect = True
|
||||
RowSelect = True
|
||||
TabOrder = 1
|
||||
OnClick = TreeClick
|
||||
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoRowSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
|
||||
end
|
||||
object PanelText: TPanel
|
||||
Left = 245
|
||||
Height = 360
|
||||
Top = 0
|
||||
Width = 644
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
Caption = 'PanelText'
|
||||
TabOrder = 2
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 240
|
||||
Height = 360
|
||||
Top = 0
|
||||
Width = 5
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
left = 264
|
||||
top = 176
|
||||
end
|
||||
object ImageListTree: TImageList
|
||||
AllocBy = 10
|
||||
left = 368
|
||||
top = 176
|
||||
Bitmap = {
|
||||
4C69080000001000000010000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000848484FF848484FF8484
|
||||
84FF848484FF848484FF00000000000000000000000000000000000000000000
|
||||
000000000000000000000000000000000000848484FFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF00FFFFFFC6C6C6FF848484FF000000000000000000000000000000000000
|
||||
0000000000000000000000000000848484FFC6C6C6FF00FFFFFFC6C6C6FF00FF
|
||||
FFFFC6C6C6FF00FFFFFFC6C6C6FF848484FF848484FF848484FF848484FF8484
|
||||
84FF848484FF0000000000000000848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6C6FF00FF
|
||||
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
|
||||
FFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6C6FF00FF
|
||||
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
|
||||
FFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6C6FF00FF
|
||||
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
|
||||
FFFF848484FF000000FF00000000848484FFFFFFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6
|
||||
C6FF848484FF000000FF00000000848484FFFFFFFFFF00FFFFFFC6C6C6FF00FF
|
||||
FFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FFFFFFC6C6C6FF00FF
|
||||
FFFF848484FF000000FF00000000848484FF848484FF848484FF848484FF8484
|
||||
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
|
||||
84FF848484FF000000FF0000000000000000000000FF000000FF000000FF0000
|
||||
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
|
||||
00FF000000FF000000FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000848400FF848400FFFF0000FFFF0000FF840000FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000FFFF00FFFFFFFFFFFF0000FFFF0000FFFF0000FF000000FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000848400FF848400FFFF0000FFFF0000FF000000FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000FFFF00FFFFFFFFFFFF0000FFFF0000FFFF0000FF000000FF8484
|
||||
84FF0000000000000000000000000000FFFF000084FF00000000000000000000
|
||||
0000848484FFFFFFFFFFFF0000FF848400FFFF0000FFFF0000FF000000FF8484
|
||||
84FF0000000000000000000000000000FFFF0000FFFF000084FF000084FF0000
|
||||
000000000000848484FF848484FF848484FF848484FF848484FF848484FF8484
|
||||
84FF0000000000000000000000000000FFFF0000FFFF000084FF000084FF0000
|
||||
84FF000084FFFFFFFFFFFFFFFFFFFFFFFFFF008484FF008484FF008484FF0000
|
||||
00000000000000000000000000000000FFFF0000FFFF0000FFFF000084FF0000
|
||||
84FF000084FF000000FFFFFFFFFF848484FF00FFFFFF00FFFFFF008484FF0084
|
||||
84FF0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000
|
||||
00FF000000FF848484FF008484FF00FFFFFF00FFFFFF008484FF008484FF0084
|
||||
84FF008484FF00000000000000000000FFFF0000FFFF0000FFFF000000FF8484
|
||||
84FF848484FF848484FF008484FF00FFFFFF008484FF008484FF008484FF0084
|
||||
84FF008484FF00000000000000000000FFFF000000FF000000FF848484FF8484
|
||||
84FF848484FF848484FF008484FF008484FF008484FF008484FF008484FF0084
|
||||
84FF000000FF848484FF000000000000000000000000848484FF848484FF8484
|
||||
84FF000000000000000000000000008484FF008484FF008484FF008484FF0084
|
||||
84FF000000FF848484FF00000000000000000000000000000000848484FF0000
|
||||
0000000000000000000000000000848484FF008484FF008484FF008484FF0000
|
||||
00FF848484FF848484FF00000000000000000000000000000000000000000000
|
||||
000000000000000000000000000000000000000000FF000000FF000000FF8484
|
||||
84FF848484FF0000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000848484FF848484FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF848484FF848484FF848484FF848484FF840000FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000FFFF00FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
0000FFFF00FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FF8484
|
||||
84FF0000000000000000000000000000FFFF000084FF00000000000000000000
|
||||
0000848484FF848484FFFF0000FF848400FFFF0000FFFF0000FF000000FF8484
|
||||
84FF0000000000000000000000000000FFFF848484FF000084FF000084FF0000
|
||||
000000000000848484FF848484FF848484FF848484FF848484FF848484FF8484
|
||||
84FF0000000000000000000000000000FFFF848484FF848484FF848484FF0000
|
||||
84FF000084FFFFFFFFFFFFFFFFFFFFFFFFFF008484FF008484FF008484FF0000
|
||||
00000000000000000000000000000000FFFF848484FFFFFFFFFFFFFFFFFF8484
|
||||
84FF848484FF000000FFFFFFFFFFFFFFFFFF00FFFFFF848484FF848484FF0084
|
||||
84FF0000000000000000000000000000FFFF848484FFFFFFFFFF0000FFFF0000
|
||||
00FF000000FF848484FF008484FF00FFFFFF848484FF848484FFFFFFFFFFFFFF
|
||||
FFFF008484FF00000000000000000000FFFF848484FF0000FFFF000000FF8484
|
||||
84FF848484FF848484FF008484FF848484FF848484FFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFF008484FF848484FF000000000000FFFF000000FF000000FF848484FF8484
|
||||
84FF848484FF848484FF008484FF848484FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFF000000FF848484FF000000000000000000000000848484FF848484FF8484
|
||||
84FF000000000000000000000000008484FF848484FFFFFFFFFFFFFFFFFF0084
|
||||
84FF000000FF848484FF00000000000000000000000000000000848484FF0000
|
||||
0000000000000000000000000000848484FF008484FF848484FF008484FF0000
|
||||
00FF848484FF0000000000000000000000000000000000000000000000000000
|
||||
000000000000000000000000000000000000000000FF000000FF000000FF8484
|
||||
84FF848484FF0000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000848484FF848484FF8484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000848484FF0000
|
||||
000000000000848484FF0000000000000000848484FF00000000000000008484
|
||||
84FF000000000000000000000000000000000000000000000000848484FF0000
|
||||
000000000000848484FF848400FF848400FFFF0000FF840000FF000000008484
|
||||
84FF00000000000000000000000000000000848484FF848484FF000000FF8484
|
||||
84FF848484FF000000FF848484FFFF0000FFFF0000FF000000FF848484FF0000
|
||||
00FF848484FF848484FF00000000000000000000000000000000848484FFFFFF
|
||||
FFFFFFFFFFFF848484FF848400FF848400FFFF0000FF000000FF848484FF8484
|
||||
84FF00000000000000000000000000000000000000000000FFFF000084FFFFFF
|
||||
FFFFFFFFFFFF848484FFFF0000FF848400FFFF0000FF000000FF848484FF8484
|
||||
84FF00000000000000000000000000000000848484FF0000FFFF0000FFFF0000
|
||||
84FF848484FF000000FF848484FF848484FF848484FF848484FF848484FF0000
|
||||
00FF848484FF848484FF0000000000000000000000000000FFFF0000FFFF0000
|
||||
84FF000084FF000084FFFFFFFFFFFFFFFFFF008484FF008484FFFFFFFFFF8484
|
||||
84FF00000000000000000000000000000000000000000000FFFF0000FFFF0000
|
||||
FFFF000000FF000000FF008484FF00FFFFFF00FFFFFF008484FF008484FF0084
|
||||
84FF00000000000000000000000000000000848484FF0000FFFF0000FFFF0000
|
||||
00FF848484FF848484FF008484FF00FFFFFF008484FF008484FF008484FF0084
|
||||
84FF848484FF848484FF0000000000000000000000000000FFFF000000FF8484
|
||||
84FF848484FF848484FF008484FF008484FF008484FF008484FF008484FF0000
|
||||
00FF000000000000000000000000000000000000000000000000848484FF8484
|
||||
84FFFFFFFFFF848484FFFFFFFFFF848484FF008484FF008484FF000000FF8484
|
||||
84FF00000000000000000000000000000000848484FF848484FF000000FF8484
|
||||
84FF848484FF000000FF848484FF848484FF000000FF000000FF848484FF8484
|
||||
84FF848484FF848484FF00000000000000000000000000000000848484FF0000
|
||||
000000000000848484FF0000000000000000848484FF848484FF848484FF8484
|
||||
84FF000000000000000000000000000000000000000000000000848484FF0000
|
||||
000000000000848484FF0000000000000000848484FF00000000000000008484
|
||||
84FF000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF848484FF000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000848484FFC6C6C6FFC6C6C6FF848484FF848484FF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000008484
|
||||
84FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF848484FF848484FF0000
|
||||
0000000000000000000000000000000000000000000000000000848484FFC6C6
|
||||
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF8484
|
||||
84FF848484FF00000000000000000000000000000000848484FFC6C6C6FFC6C6
|
||||
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF848484FF8484
|
||||
84FF000000FF00000000000000000000000000000000848484FFC6C6C6FFC6C6
|
||||
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF848484FF8484
|
||||
84FF000000FF00000000000000000000000000000000848484FFFFFFFFFFC6C6
|
||||
C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FFC6C6C6FF848484FF848484FF8484
|
||||
84FF000000FF00000000000000000000000000000000848484FFC6C6C6FFFFFF
|
||||
FFFFFFFFFFFFC6C6C6FFC6C6C6FFC6C6C6FF848484FF848484FF848484FF8484
|
||||
84FF000000FF00000000000000000000000000000000848484FFFFFFFFFFC6C6
|
||||
C6FFFFFFFFFFC6C6C6FFFFFFFFFFC6C6C6FF848484FF848484FF848484FF8484
|
||||
84FF000000FF00000000000000000000000000000000848484FFC6C6C6FFFFFF
|
||||
FFFFC6C6C6FFFFFFFFFFC6C6C6FFC6C6C6FF848484FF848484FF848484FF0000
|
||||
00FF000000000000000000000000000000000000000000000000848484FF8484
|
||||
84FFFFFFFFFFC6C6C6FFFFFFFFFFC6C6C6FF848484FF848484FF000000FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000848484FF848484FF848484FFC6C6C6FF848484FF000000FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000848484FF000000FF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000000000005A5A5AFF292929FF4A4A4AFF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000292929FF313131FF00000000212121FF424242FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000004A4A4AFF4A4A4AFF000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000001810
|
||||
18FF101010FF181818FF080808FF000000FF0000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000292921FF000000FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000292121FF212121FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00FF181818FF212121FF0000000000000000313131FF313131FF000000000000
|
||||
00FF181818FF0000000000000000000000000000000000000000000000000808
|
||||
08FF101010FF00000000000000000000000000000000393939FF080808FF3131
|
||||
31FF000000000000000000000000000000000000000000000000000000000808
|
||||
08FF313131FF000000000000000000000000000000FF101010FF212121FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000808
|
||||
08FF000000000000000000000000000000FF101010FF00000000212121FF2121
|
||||
21FF000000000000000000000000000000000000000000000000313131FF2121
|
||||
21FF000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000848484FF00FF00FF0000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF00FF00FF00FF00FF00FF00FF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF008400FF00FF00FF00FF00FF00FF00FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000008484
|
||||
84FF00000000848484FF008400FF008400FF00FF00FF00FF00FF00FF00FF0000
|
||||
000000FF00FF0000000000000000000000000000000000000000848484FF00FF
|
||||
00FF848484FF848484FF008400FF008400FF008400FF00FF00FF00FF00FF00FF
|
||||
00FF00FF00FF848484FF000000000000000000000000848484FF00FF00FF00FF
|
||||
00FF00FF00FF848484FF008400FF000000FF000000FF000000FF00FF00FF00FF
|
||||
00FF00FF00FF848484FF00000000000000000000000000000000000000FF00FF
|
||||
00FF00FF00FF00FF00FF008400FF000000FF848484FF008400FF00FF00FF00FF
|
||||
00FF00FF00FF848484FF00000000000000000000000000000000000000000000
|
||||
00FF00FF00FF00FF00FF008400FF000000FF848484FF00FF00FF00FF00FF00FF
|
||||
00FF00FF00FF848484FF00000000000000000000000000000000000000000000
|
||||
0000000000FF000000FF000000FF848484FF848484FF00000000848484FF8484
|
||||
84FF848484FF848484FF00000000000000000000000000000000000000000000
|
||||
000000000000848484FF848484FF848484FF0000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000848484FF00FFFFFF0000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000848484FF008484FF00FFFFFF00FFFFFF00FFFFFF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000008484
|
||||
84FF00000000848484FF008484FF008484FF00FFFFFF00FFFFFF00FFFFFF0000
|
||||
000000FFFFFF0000000000000000000000000000000000000000848484FF00FF
|
||||
FFFF848484FF848484FF008484FF008484FF008484FF00FFFFFF00FFFFFF00FF
|
||||
FFFF00FFFFFF848484FF000000000000000000000000848484FF00FFFFFF00FF
|
||||
FFFF00FFFFFF848484FF008484FF000000FF000000FF000000FF00FFFFFF00FF
|
||||
FFFF00FFFFFF848484FF00000000000000000000000000000000000000FF00FF
|
||||
FFFF00FFFFFF00FFFFFF008484FF000000FF848484FF008484FF00FFFFFF00FF
|
||||
FFFF00FFFFFF848484FF00000000000000000000000000000000000000000000
|
||||
00FF00FFFFFF00FFFFFF008484FF000000FF848484FF00FFFFFF00FFFFFF00FF
|
||||
FFFF00FFFFFF848484FF00000000000000000000000000000000000000000000
|
||||
0000000000FF000000FF000000FF848484FF848484FF00000000848484FF8484
|
||||
84FF848484FF848484FF00000000000000000000000000000000000000000000
|
||||
000000000000848484FF848484FF848484FF0000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000
|
||||
}
|
||||
end
|
||||
end
|
||||
360
ATSynEdit/app/demo_adapter_econtrol/unit1.pas
Normal file
360
ATSynEdit/app/demo_adapter_econtrol/unit1.pas
Normal file
@@ -0,0 +1,360 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, ShellCtrls, ComCtrls,
|
||||
LclIntf, LclType,
|
||||
ATSynEdit,
|
||||
ATStringProc,
|
||||
ATSynEdit_Adapter_EControl,
|
||||
ATSynEdit_Carets,
|
||||
ATSynEdit_Export_HTML,
|
||||
ecSyntAnal,
|
||||
proc_lexer;
|
||||
|
||||
type
|
||||
{ TfmMain }
|
||||
|
||||
TfmMain = class(TForm)
|
||||
bOpen: TButton;
|
||||
bComment: TButton;
|
||||
bUncomment: TButton;
|
||||
bExport: TButton;
|
||||
chkDyn: TCheckBox;
|
||||
chkFullHilite: TCheckBox;
|
||||
chkFullSel: TCheckBox;
|
||||
chkLexer: TCheckBox;
|
||||
chkShowCur: TCheckBox;
|
||||
chkUnpri: TCheckBox;
|
||||
chkWrap: TCheckBox;
|
||||
edLexer: TComboBox;
|
||||
files: TShellListView;
|
||||
ImageListTree: TImageList;
|
||||
OpenDialog1: TOpenDialog;
|
||||
Panel1: TPanel;
|
||||
PanelText: TPanel;
|
||||
Splitter1: TSplitter;
|
||||
Tree: TTreeView;
|
||||
procedure AdapterParseBegin(Sender: TObject);
|
||||
procedure AdapterParseDone(Sender: TObject);
|
||||
procedure bCommentClick(Sender: TObject);
|
||||
procedure bExportClick(Sender: TObject);
|
||||
procedure bOpenClick(Sender: TObject);
|
||||
procedure bUncommentClick(Sender: TObject);
|
||||
procedure chkDynChange(Sender: TObject);
|
||||
procedure chkFullHiliteChange(Sender: TObject);
|
||||
procedure chkFullSelChange(Sender: TObject);
|
||||
procedure chkLexerChange(Sender: TObject);
|
||||
procedure chkShowCurChange(Sender: TObject);
|
||||
procedure chkUnpriChange(Sender: TObject);
|
||||
procedure chkWrapChange(Sender: TObject);
|
||||
procedure EditorChangeCaretPos(Sender: TObject);
|
||||
procedure edLexerChange(Sender: TObject);
|
||||
procedure filesClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure TreeClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
ed: TATSynEdit;
|
||||
FDir: string;
|
||||
FFilename: string;
|
||||
procedure DoCommentAct(Act: TATCommentAction);
|
||||
procedure DoLexer(const aname: string);
|
||||
procedure DoOpenFile(const fn: string);
|
||||
procedure EditCalcStaple(Sender: TObject; ALine, AIndent: integer; var AColor: TColor);
|
||||
procedure EditClickGutter(Sender: TObject; ABand: integer; ALine: integer);
|
||||
function GetComment: string;
|
||||
procedure UpdateLexList;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmMain: TfmMain;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
var
|
||||
manager: TecSyntaxManager;
|
||||
adapter: TATAdapterEControl;
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
procedure TfmMain.UpdateLexList;
|
||||
var
|
||||
i: integer;
|
||||
sl: tstringlist;
|
||||
begin
|
||||
sl:= tstringlist.create;
|
||||
try
|
||||
for i:= 0 to manager.AnalyzerCount-1 do
|
||||
sl.Add(manager.Analyzers[i].LexerName);
|
||||
sl.sort;
|
||||
edLexer.Items.AddStrings(sl);
|
||||
finally
|
||||
sl.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmMain.DoOpenFile(const fn: string);
|
||||
var
|
||||
an: TecSyntAnalyzer;
|
||||
begin
|
||||
FFilename:= fn;
|
||||
|
||||
adapter.Lexer:= nil;
|
||||
Tree.Items.Clear;
|
||||
|
||||
ed.LoadFromFile(fn);
|
||||
ed.SetFocus;
|
||||
|
||||
an:= DoFindLexerForFilename(manager, fn);
|
||||
adapter.Lexer:= an;
|
||||
|
||||
if Assigned(an) then
|
||||
edLexer.ItemIndex:= edLexer.Items.IndexOf(an.LexerName);
|
||||
end;
|
||||
|
||||
procedure TfmMain.FormCreate(Sender: TObject);
|
||||
var
|
||||
fname_lxl: string;
|
||||
begin
|
||||
FDir:= ExtractFileDir(ExtractFileDir(ExtractFileDir(Application.ExeName)))+'/test_syntax_files/';
|
||||
fname_lxl:= ExtractFilePath(Application.ExeName)+'lib.lxl';
|
||||
|
||||
manager:= TecSyntaxManager.Create(Self);
|
||||
manager.LoadFromFile(fname_lxl);
|
||||
UpdateLexList;
|
||||
|
||||
ed:= TATSynEdit.Create(Self);
|
||||
ed.Font.Name:= 'Courier New';
|
||||
ed.Parent:= PanelText;
|
||||
ed.Align:= alClient;
|
||||
ed.OptUnprintedVisible:= false;
|
||||
ed.OptRulerVisible:= false;
|
||||
ed.Colors.TextBG:= $e0f0f0;
|
||||
ed.Colors.CurrentLineBG:= clTeal;
|
||||
|
||||
ed.Gutter[ed.GutterBandNum].Visible:= false;
|
||||
ed.Gutter.Update;
|
||||
|
||||
ed.OnClickGutter:= @EditClickGutter;
|
||||
ed.OnCalcStaple:= @EditCalcStaple;
|
||||
ed.OnChangeCaretPos:=@EditorChangeCaretPos;
|
||||
|
||||
adapter:= TATAdapterEControl.Create(Self);
|
||||
adapter.OnParseBegin:=@AdapterParseBegin;
|
||||
adapter.OnParseDone:=@AdapterParseDone;
|
||||
ed.AdapterHilite:= adapter;
|
||||
|
||||
chkWrap.Checked:= ed.OptWrapMode=cWrapOn;
|
||||
chkFullSel.Checked:= ed.OptShowFullSel;
|
||||
chkFullHilite.Checked:= ed.OptShowFullHilite;
|
||||
chkUnpri.Checked:= ed.OptUnprintedVisible;
|
||||
chkShowCur.Checked:= ed.OptShowCurLine;
|
||||
chkDyn.Checked:= adapter.DynamicHiliteEnabled;
|
||||
end;
|
||||
|
||||
procedure TfmMain.FormShow(Sender: TObject);
|
||||
begin
|
||||
if DirectoryExists(FDir) then
|
||||
files.Root:= FDir;
|
||||
end;
|
||||
|
||||
procedure TfmMain.TreeClick(Sender: TObject);
|
||||
var
|
||||
R: TecTextRange;
|
||||
P: TPoint;
|
||||
begin
|
||||
if adapter.TreeBusy then exit;
|
||||
if Tree.Selected=nil then exit;
|
||||
if Tree.Selected.Data=nil then exit;
|
||||
|
||||
R:= TecTextRange(Tree.Selected.Data);
|
||||
P:= adapter.TreeGetPositionOfRange(R);
|
||||
|
||||
ed.DoGotoPos_AndUnfold(P, 5, 5);
|
||||
ed.SetFocus;
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkWrapChange(Sender: TObject);
|
||||
begin
|
||||
if chkWrap.checked then
|
||||
ed.OptWrapMode:= cWrapOn
|
||||
else
|
||||
ed.OptWrapMode:= cWrapOff;
|
||||
end;
|
||||
|
||||
procedure TfmMain.EditorChangeCaretPos(Sender: TObject);
|
||||
begin
|
||||
adapter.TreeShowItemForCaret(Tree, Point(ed.Carets[0].PosX, ed.Carets[0].PosY));
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkFullSelChange(Sender: TObject);
|
||||
begin
|
||||
ed.OptShowFullSel:= chkFullSel.Checked;
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkLexerChange(Sender: TObject);
|
||||
begin
|
||||
adapter.Lexer:= nil;
|
||||
ed.Fold.Clear;
|
||||
|
||||
if chkLexer.Checked then
|
||||
adapter.Lexer:= DoFindLexerForFilename(manager, FFilename);
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkShowCurChange(Sender: TObject);
|
||||
begin
|
||||
ed.OptShowCurLine:= chkShowCur.Checked;
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkUnpriChange(Sender: TObject);
|
||||
begin
|
||||
ed.OptUnprintedVisible:= chkUnpri.Checked;
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkFullHiliteChange(Sender: TObject);
|
||||
begin
|
||||
ed.OptShowFullHilite:= chkFullHilite.Checked;
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.bOpenClick(Sender: TObject);
|
||||
begin
|
||||
with OpenDialog1 do
|
||||
begin
|
||||
Filename:= '';
|
||||
InitialDir:= FDir;
|
||||
if not Execute then exit;
|
||||
DoOpenFile(Filename);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfmMain.GetComment: string;
|
||||
var
|
||||
an: TecSyntAnalyzer;
|
||||
begin
|
||||
Result:= '';
|
||||
an:= adapter.Lexer;
|
||||
if Assigned(an) then
|
||||
Result:= an.LineComment;
|
||||
end;
|
||||
|
||||
procedure TfmMain.DoCommentAct(Act: TATCommentAction);
|
||||
var
|
||||
Str: string;
|
||||
begin
|
||||
Str:= GetComment;
|
||||
if Str='' then
|
||||
Showmessage('No line comment defined for lexer')
|
||||
else
|
||||
Ed.DoCommentSelectionLines(Act, Str);
|
||||
end;
|
||||
|
||||
procedure TfmMain.bCommentClick(Sender: TObject);
|
||||
begin
|
||||
DoCommentAct(cCommentAdd_AtNonespace_IfNone);
|
||||
end;
|
||||
|
||||
procedure TfmMain.bExportClick(Sender: TObject);
|
||||
var
|
||||
fn: string;
|
||||
begin
|
||||
fn:= GetTempDir+DirectorySeparator+'_export.html';
|
||||
DoEditorExportToHTML(Ed, fn, 'Export test',
|
||||
'Courier New', 12, false,
|
||||
clWhite, clMedGray);
|
||||
if FileExists(fn) then
|
||||
OpenDocument(fn);
|
||||
end;
|
||||
|
||||
procedure TfmMain.AdapterParseDone(Sender: TObject);
|
||||
begin
|
||||
adapter.TreeFill(Tree);
|
||||
EditorChangeCaretPos(Self);
|
||||
end;
|
||||
|
||||
procedure TfmMain.AdapterParseBegin(Sender: TObject);
|
||||
begin
|
||||
Tree.Items.Clear;
|
||||
end;
|
||||
|
||||
procedure TfmMain.bUncommentClick(Sender: TObject);
|
||||
begin
|
||||
DoCommentAct(cCommentRemove);
|
||||
end;
|
||||
|
||||
procedure TfmMain.chkDynChange(Sender: TObject);
|
||||
begin
|
||||
adapter.DynamicHiliteEnabled:= chkDyn.Checked;
|
||||
Ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.DoLexer(const aname: string);
|
||||
begin
|
||||
adapter.Lexer:= manager.FindAnalyzer(aname);
|
||||
ed.Update;
|
||||
end;
|
||||
|
||||
procedure TfmMain.edLexerChange(Sender: TObject);
|
||||
begin
|
||||
DoLexer(edLexer.Text);
|
||||
end;
|
||||
|
||||
procedure TfmMain.filesClick(Sender: TObject);
|
||||
var
|
||||
fn: string;
|
||||
begin
|
||||
if files.Selected=nil then exit;
|
||||
//while adapter.TreeBusy do Application.ProcessMessages;
|
||||
|
||||
fn:= files.GetPathFromItem(files.Selected);
|
||||
if FileExistsUTF8(fn) then
|
||||
DoOpenFile(fn);
|
||||
end;
|
||||
|
||||
procedure TfmMain.EditClickGutter(Sender: TObject; ABand: integer; ALine: integer);
|
||||
begin
|
||||
if ABand=ed.GutterBandBm then
|
||||
begin
|
||||
if ed.Strings.LinesBm[ALine]<>0 then
|
||||
ed.Strings.LinesBm[ALine]:= 0
|
||||
else
|
||||
ed.Strings.LinesBm[ALine]:= 1;
|
||||
ed.Update;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmMain.EditCalcStaple(Sender: TObject; ALine, AIndent: integer; var AColor: TColor);
|
||||
const
|
||||
nColors = 10;
|
||||
cl: array[0..nColors-1] of TColor = (
|
||||
clGray,
|
||||
clBlue,
|
||||
clRed,
|
||||
clGreen,
|
||||
clOlive,
|
||||
clMaroon,
|
||||
clLime,
|
||||
clMoneyGreen,
|
||||
clNavy,
|
||||
clTeal
|
||||
);
|
||||
begin
|
||||
AColor:= cl[AIndent div 2 mod nColors];
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
80
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerlib.lfm
Normal file
80
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerlib.lfm
Normal file
@@ -0,0 +1,80 @@
|
||||
object fmLexerLib: TfmLexerLib
|
||||
Left = 434
|
||||
Height = 468
|
||||
Top = 338
|
||||
Width = 459
|
||||
BorderIcons = [biSystemMenu]
|
||||
Caption = 'Lexer library'
|
||||
ClientHeight = 468
|
||||
ClientWidth = 459
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
ShowInTaskBar = stNever
|
||||
LCLVersion = '1.5'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 433
|
||||
Width = 447
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 2
|
||||
ShowButtons = [pbClose]
|
||||
ShowBevel = False
|
||||
end
|
||||
object ToolBar1: TToolBar
|
||||
Left = 0
|
||||
Height = 28
|
||||
Top = 0
|
||||
Width = 459
|
||||
AutoSize = True
|
||||
ButtonHeight = 28
|
||||
Caption = 'ToolBar1'
|
||||
EdgeInner = esNone
|
||||
EdgeOuter = esNone
|
||||
ShowCaptions = True
|
||||
TabOrder = 0
|
||||
object bProp: TToolButton
|
||||
Left = 1
|
||||
Top = 0
|
||||
Caption = 'Config'
|
||||
OnClick = bPropClick
|
||||
end
|
||||
object bDel: TToolButton
|
||||
Left = 88
|
||||
Top = 0
|
||||
Caption = 'Delete'
|
||||
OnClick = bDelClick
|
||||
end
|
||||
object bAdd: TToolButton
|
||||
Left = 52
|
||||
Top = 0
|
||||
Caption = 'Add'
|
||||
OnClick = bAddClick
|
||||
end
|
||||
end
|
||||
object List: TCheckListBox
|
||||
Left = 6
|
||||
Height = 393
|
||||
Top = 34
|
||||
Width = 447
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 0
|
||||
OnClickCheck = ListClickCheck
|
||||
TabOrder = 1
|
||||
TopIndex = -1
|
||||
end
|
||||
object OpenDlg: TOpenDialog
|
||||
Filter = 'Zip files|*.zip'
|
||||
Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing, ofViewDetail]
|
||||
left = 280
|
||||
top = 360
|
||||
end
|
||||
end
|
||||
216
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerlib.pas
Normal file
216
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerlib.pas
Normal file
@@ -0,0 +1,216 @@
|
||||
(*
|
||||
This Source Code Form is subject to the terms of the Mozilla Public
|
||||
License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
Copyright (c) Alexey Torgashin
|
||||
*)
|
||||
unit formlexerlib;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
||||
StdCtrls, ComCtrls, CheckLst,
|
||||
LCLIntf, LCLType, LCLProc,
|
||||
ecSyntAnal,
|
||||
formlexerprop, proc_lexer_install_zip,
|
||||
math;
|
||||
|
||||
type
|
||||
{ TfmLexerLib }
|
||||
|
||||
TfmLexerLib = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
List: TCheckListBox;
|
||||
OpenDlg: TOpenDialog;
|
||||
ToolBar1: TToolBar;
|
||||
bProp: TToolButton;
|
||||
bDel: TToolButton;
|
||||
bAdd: TToolButton;
|
||||
procedure bAddClick(Sender: TObject);
|
||||
procedure bDelClick(Sender: TObject);
|
||||
procedure bPropClick(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure ListClickCheck(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
procedure UpdateList;
|
||||
public
|
||||
FManager: TecSyntaxManager;
|
||||
FFontName: string;
|
||||
FFontSize: integer;
|
||||
FDirAcp: string;
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmLexerLib: TfmLexerLib;
|
||||
|
||||
function DoShowDialogLexerLib(ALexerManager: TecSyntaxManager;
|
||||
const ADirAcp: string;
|
||||
const AFontName: string;
|
||||
AFontSize: integer): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
function DoShowDialogLexerLib(ALexerManager: TecSyntaxManager;
|
||||
const ADirAcp: string; const AFontName: string; AFontSize: integer): boolean;
|
||||
var
|
||||
F: TfmLexerLib;
|
||||
begin
|
||||
F:= TfmLexerLib.Create(nil);
|
||||
try
|
||||
F.FManager:= ALexerManager;
|
||||
F.FFontName:= AFontName;
|
||||
F.FFontSize:= AFontSize;
|
||||
F.FDirAcp:= ADirAcp;
|
||||
F.ShowModal;
|
||||
Result:= F.FManager.Modified;
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function IsLexerLinkDup(an: TecSyntAnalyzer; LinkN: integer): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
for i:= 0 to LinkN-1 do
|
||||
if an.SubAnalyzers[i].SyntAnalyzer=an.SubAnalyzers[LinkN].SyntAnalyzer then
|
||||
begin
|
||||
Result:= true;
|
||||
exit
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TfmLexerLib }
|
||||
|
||||
procedure TfmLexerLib.FormShow(Sender: TObject);
|
||||
begin
|
||||
UpdateList;
|
||||
if List.Items.Count>0 then
|
||||
List.ItemIndex:= 0;
|
||||
end;
|
||||
|
||||
procedure TfmLexerLib.ListClickCheck(Sender: TObject);
|
||||
var
|
||||
an: TecSyntAnalyzer;
|
||||
n: integer;
|
||||
begin
|
||||
n:= List.ItemIndex;
|
||||
if n<0 then exit;
|
||||
an:= List.Items.Objects[n] as TecSyntAnalyzer;
|
||||
|
||||
an.Internal:= not List.Checked[n];
|
||||
FManager.Modified:= true;
|
||||
end;
|
||||
|
||||
procedure TfmLexerLib.bPropClick(Sender: TObject);
|
||||
var
|
||||
an: TecSyntAnalyzer;
|
||||
n: integer;
|
||||
begin
|
||||
n:= List.ItemIndex;
|
||||
if n<0 then exit;
|
||||
an:= List.Items.Objects[n] as TecSyntAnalyzer;
|
||||
|
||||
if DoShowDialogLexerProp(an, FFontName, FFontSize) then
|
||||
begin
|
||||
FManager.Modified:= true;
|
||||
UpdateList;
|
||||
List.ItemIndex:= n;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmLexerLib.bDelClick(Sender: TObject);
|
||||
var
|
||||
an: TecSyntAnalyzer;
|
||||
n: integer;
|
||||
begin
|
||||
n:= List.ItemIndex;
|
||||
if n<0 then exit;
|
||||
an:= List.Items.Objects[n] as TecSyntAnalyzer;
|
||||
|
||||
if Application.MessageBox(
|
||||
PChar(Format('Delete lexer "%s"?', [an.LexerName])),
|
||||
PChar(Caption),
|
||||
MB_OKCANCEL or MB_ICONWARNING)=id_ok then
|
||||
begin
|
||||
an.Free;
|
||||
FManager.Modified:= true;
|
||||
UpdateList;
|
||||
List.ItemIndex:= Min(n, List.Count-1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmLexerLib.bAddClick(Sender: TObject);
|
||||
var
|
||||
msg: string;
|
||||
begin
|
||||
OpenDlg.Filename:= '';
|
||||
if not OpenDlg.Execute then exit;
|
||||
if DoInstallLexerFromZip(OpenDlg.FileName, FManager, FDirAcp, msg) then
|
||||
begin
|
||||
UpdateList;
|
||||
Application.MessageBox(
|
||||
PChar('Installed:'#13+msg),
|
||||
PChar(Caption), MB_OK or MB_ICONINFORMATION);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmLexerLib.UpdateList;
|
||||
var
|
||||
sl: tstringlist;
|
||||
an: TecSyntAnalyzer;
|
||||
an_sub: TecSubAnalyzerRule;
|
||||
links: string;
|
||||
i, j: integer;
|
||||
begin
|
||||
List.Items.BeginUpdate;
|
||||
List.Items.Clear;
|
||||
|
||||
sl:= tstringlist.create;
|
||||
try
|
||||
for i:= 0 to FManager.AnalyzerCount-1 do
|
||||
begin
|
||||
an:= FManager.Analyzers[i];
|
||||
sl.AddObject(an.LexerName, an);
|
||||
end;
|
||||
sl.sort;
|
||||
|
||||
for i:= 0 to sl.count-1 do
|
||||
begin
|
||||
an:= sl.Objects[i] as TecSyntAnalyzer;
|
||||
|
||||
links:= '';
|
||||
for j:= 0 to an.SubAnalyzers.Count-1 do
|
||||
if not IsLexerLinkDup(an, j) then
|
||||
begin
|
||||
if links='' then
|
||||
links:= 'links: '
|
||||
else
|
||||
links:= links+', ';
|
||||
an_sub:= an.SubAnalyzers[j];
|
||||
if an_sub<>nil then
|
||||
if an_sub.SyntAnalyzer<>nil then
|
||||
links:= links+an_sub.SyntAnalyzer.LexerName;
|
||||
end;
|
||||
if links<>'' then links:= ' ('+links+')';
|
||||
|
||||
List.Items.AddObject(sl[i]+links, an);
|
||||
List.Checked[List.Count-1]:= not an.Internal;
|
||||
end;
|
||||
finally
|
||||
sl.free;
|
||||
end;
|
||||
List.Items.EndUpdate;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
548
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerprop.lfm
Normal file
548
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerprop.lfm
Normal file
@@ -0,0 +1,548 @@
|
||||
object fmLexerProp: TfmLexerProp
|
||||
Left = 218
|
||||
Height = 566
|
||||
Top = 300
|
||||
Width = 623
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Lexer properties'
|
||||
ClientHeight = 566
|
||||
ClientWidth = 623
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
Position = poScreenCenter
|
||||
ShowInTaskBar = stNever
|
||||
LCLVersion = '1.5'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 531
|
||||
Width = 611
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 1
|
||||
ShowButtons = [pbOK, pbCancel]
|
||||
ShowBevel = False
|
||||
end
|
||||
object chkBorderT: TPageControl
|
||||
Left = 0
|
||||
Height = 525
|
||||
Top = 0
|
||||
Width = 623
|
||||
ActivePage = TabSheetGen
|
||||
Align = alClient
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
object TabSheetGen: TTabSheet
|
||||
Caption = 'General'
|
||||
ClientHeight = 494
|
||||
ClientWidth = 619
|
||||
object Label2: TLabel
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 0
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Lexer name:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edName: TEdit
|
||||
Left = 6
|
||||
Height = 27
|
||||
Top = 20
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 3
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 50
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'File types:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edExt: TEdit
|
||||
Left = 6
|
||||
Height = 27
|
||||
Top = 70
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 3
|
||||
TabOrder = 1
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 100
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Line-comment string:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edLineCmt: TEdit
|
||||
Left = 6
|
||||
Height = 27
|
||||
Top = 120
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
BorderSpacing.Right = 6
|
||||
BorderSpacing.Bottom = 3
|
||||
TabOrder = 2
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 150
|
||||
Width = 607
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Right = 6
|
||||
Caption = 'Sample text:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edSample: TATSynEdit
|
||||
Left = 6
|
||||
Height = 315
|
||||
Top = 173
|
||||
Width = 607
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
BorderStyle = bsSingle
|
||||
Font.Height = -12
|
||||
Font.Name = 'Courier New'
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
TabStop = True
|
||||
CursorText = crIBeam
|
||||
CursorBm = crHandPoint
|
||||
Colors.TextFont = clBlack
|
||||
Colors.TextBG = clWhite
|
||||
Colors.TextDisabledFont = clMedGray
|
||||
Colors.TextDisabledBG = clSilver
|
||||
Colors.TextSelFont = clHighlightText
|
||||
Colors.TextSelBG = clHighlight
|
||||
Colors.Caret = clBlack
|
||||
Colors.GutterFont = clGray
|
||||
Colors.GutterBG = 14737632
|
||||
Colors.GutterCaretBG = 13158600
|
||||
Colors.GutterPlusBorder = clGray
|
||||
Colors.GutterPlusBG = 16053492
|
||||
Colors.GutterFoldLine = clGray
|
||||
Colors.GutterFoldBG = 13158600
|
||||
Colors.GutterSeparatorBG = clBlack
|
||||
Colors.CurrentLineBG = 14741744
|
||||
Colors.MarginRight = clSilver
|
||||
Colors.MarginCaret = clLime
|
||||
Colors.MarginUser = clYellow
|
||||
Colors.IndentVertLines = clMedGray
|
||||
Colors.BookmarkBG = clMoneyGreen
|
||||
Colors.RulerFont = clGray
|
||||
Colors.RulerBG = 14737632
|
||||
Colors.CollapseLine = 10510432
|
||||
Colors.CollapseMarkFont = 14712960
|
||||
Colors.CollapseMarkBG = clCream
|
||||
Colors.UnprintedFont = 5263600
|
||||
Colors.UnprintedBG = 14737632
|
||||
Colors.UnprintedHexFont = clMedGray
|
||||
Colors.MinimapBorder = clSilver
|
||||
Colors.MinimapSelBG = 15658734
|
||||
Colors.StateChanged = 61680
|
||||
Colors.StateAdded = 2146336
|
||||
Colors.StateSaved = clMedGray
|
||||
Colors.BlockStaple = clMedGray
|
||||
Colors.BlockSepLine = clMedGray
|
||||
Colors.LockedBG = 14737632
|
||||
Colors.TextHintFont = clGray
|
||||
Colors.ComboboxArrow = clGray
|
||||
Colors.ComboboxArrowBG = 15790320
|
||||
WantTabs = True
|
||||
OptTabSpaces = False
|
||||
OptTabSize = 8
|
||||
OptFoldStyle = cFoldHereWithTruncatedText
|
||||
OptTextLocked = 'wait...'
|
||||
OptTextHintFontStyle = [fsItalic]
|
||||
OptTextHintCenter = False
|
||||
OptTextOffsetTop = 0
|
||||
OptTextOffsetFromLine = 1
|
||||
OptAutoIndent = True
|
||||
OptAutoIndentKind = cIndentAsIs
|
||||
OptCopyLinesIfNoSel = True
|
||||
OptCutLinesIfNoSel = False
|
||||
OptLastLineOnTop = False
|
||||
OptOverwriteSel = True
|
||||
OptOverwriteAllowedOnPaste = False
|
||||
OptShowStapleStyle = cLineStyleSolid
|
||||
OptShowStapleIndent = -1
|
||||
OptShowStapleWidthPercent = 100
|
||||
OptShowFullSel = False
|
||||
OptShowFullHilite = True
|
||||
OptShowCurLine = False
|
||||
OptShowCurLineMinimal = True
|
||||
OptShowScrollHint = False
|
||||
OptShowCurColumn = False
|
||||
OptCaretManyAllowed = True
|
||||
OptCaretVirtual = True
|
||||
OptCaretShape = cCaretShapeVertPixels1
|
||||
OptCaretShapeOvr = cCaretShapeFull
|
||||
OptCaretShapeRO = cCaretShapeHorzPixels1
|
||||
OptCaretBlinkTime = 600
|
||||
OptCaretBlinkEnabled = True
|
||||
OptCaretStopUnfocused = True
|
||||
OptCaretPreferLeftSide = True
|
||||
OptGutterVisible = True
|
||||
OptGutterPlusSize = 4
|
||||
OptGutterShowFoldAlways = True
|
||||
OptGutterShowFoldLines = True
|
||||
OptGutterShowFoldLinesAll = False
|
||||
OptRulerVisible = False
|
||||
OptRulerSize = 20
|
||||
OptRulerFontSize = 8
|
||||
OptRulerMarkSizeSmall = 3
|
||||
OptRulerMarkSizeBig = 7
|
||||
OptRulerTextIndent = 0
|
||||
OptMinimapVisible = False
|
||||
OptMinimapCharWidth = 0
|
||||
OptMinimapShowSelBorder = False
|
||||
OptMinimapShowSelAlways = True
|
||||
OptMicromapVisible = False
|
||||
OptMicromapWidth = 30
|
||||
OptCharSpacingX = 0
|
||||
OptCharSpacingY = 1
|
||||
OptWrapMode = cWrapOff
|
||||
OptWrapIndented = True
|
||||
OptMarginRight = 80
|
||||
OptNumbersAutosize = True
|
||||
OptNumbersAlignment = taRightJustify
|
||||
OptNumbersFontSize = 0
|
||||
OptNumbersStyle = cNumbersNone
|
||||
OptNumbersShowFirst = True
|
||||
OptNumbersShowCarets = False
|
||||
OptNumbersSkippedChar = '.'
|
||||
OptNumbersIndentLeft = 5
|
||||
OptNumbersIndentRight = 5
|
||||
OptUnprintedVisible = False
|
||||
OptUnprintedSpaces = True
|
||||
OptUnprintedEnds = True
|
||||
OptUnprintedEndsDetails = True
|
||||
OptUnprintedReplaceSpec = True
|
||||
OptMouseEnableNormalSelection = True
|
||||
OptMouseEnableColumnSelection = True
|
||||
OptMouseDownForPopup = False
|
||||
OptMouseHideCursorOnType = False
|
||||
OptMouse2ClickSelectsLine = False
|
||||
OptMouse3ClickSelectsLine = True
|
||||
OptMouse2ClickDragSelectsWords = True
|
||||
OptMouseDragDrop = True
|
||||
OptMouseNiceScroll = True
|
||||
OptMouseRightClickMovesCaret = False
|
||||
OptMouseGutterClickSelectsLine = True
|
||||
OptKeyBackspaceUnindent = True
|
||||
OptKeyPageKeepsRelativePos = True
|
||||
OptKeyUpDownNavigateWrapped = True
|
||||
OptKeyUpDownKeepColumn = True
|
||||
OptKeyHomeEndNavigateWrapped = True
|
||||
OptKeyPageUpDownSize = cPageSizeFullMinus1
|
||||
OptKeyLeftRightSwapSel = True
|
||||
OptKeyLeftRightSwapSelAndSelect = False
|
||||
OptKeyHomeToNonSpace = True
|
||||
OptKeyEndToNonSpace = True
|
||||
OptKeyTabIndents = True
|
||||
OptIndentSize = 2
|
||||
OptIndentKeepsAlign = True
|
||||
OptShowIndentLines = True
|
||||
OptShowGutterCaretBG = True
|
||||
OptAllowScrollbarVert = True
|
||||
OptAllowScrollbarHorz = True
|
||||
OptAllowZooming = True
|
||||
OptAllowReadOnly = True
|
||||
OptUndoLimit = 5000
|
||||
OptUndoGrouped = True
|
||||
OptUndoAfterSave = True
|
||||
OptSavingForceFinalEol = False
|
||||
OptSavingTrimSpaces = False
|
||||
end
|
||||
end
|
||||
object TabSheetStyles: TTabSheet
|
||||
Caption = 'Styles'
|
||||
ClientHeight = 494
|
||||
ClientWidth = 619
|
||||
object ListStyles: TListBox
|
||||
Left = 6
|
||||
Height = 482
|
||||
Top = 6
|
||||
Width = 176
|
||||
Align = alLeft
|
||||
BorderSpacing.Around = 6
|
||||
ItemHeight = 0
|
||||
OnClick = ListStylesClick
|
||||
ScrollWidth = 174
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 188
|
||||
Height = 482
|
||||
Top = 6
|
||||
Width = 425
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 482
|
||||
ClientWidth = 425
|
||||
TabOrder = 1
|
||||
object edColorFont: TColorBox
|
||||
Left = 208
|
||||
Height = 31
|
||||
Top = 65
|
||||
Width = 190
|
||||
ColorRectWidth = 22
|
||||
NoneColorColor = clNone
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone, cbCustomColor, cbPrettyNames]
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
TabOrder = 2
|
||||
end
|
||||
object edColorBG: TColorBox
|
||||
Left = 8
|
||||
Height = 31
|
||||
Top = 65
|
||||
Width = 190
|
||||
ColorRectWidth = 22
|
||||
NoneColorColor = clNone
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone, cbCustomColor, cbPrettyNames]
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
TabOrder = 1
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 208
|
||||
Height = 17
|
||||
Top = 49
|
||||
Width = 91
|
||||
Caption = 'Color of font:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edStyleType: TComboBox
|
||||
Left = 8
|
||||
Height = 31
|
||||
Top = 18
|
||||
Width = 190
|
||||
ItemHeight = 0
|
||||
Items.Strings = (
|
||||
'Misc font (not supp.)'
|
||||
'Colors, styles'
|
||||
'Colors'
|
||||
'Color BG only'
|
||||
)
|
||||
OnChange = edStyleTypeChange
|
||||
Style = csDropDownList
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 0
|
||||
Width = 70
|
||||
Caption = 'Style type:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label7: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 48
|
||||
Width = 81
|
||||
Caption = 'Color of BG:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label8: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 104
|
||||
Width = 77
|
||||
Caption = 'Font styles:'
|
||||
ParentColor = False
|
||||
end
|
||||
object chkBold: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 120
|
||||
Width = 57
|
||||
Caption = 'Bold'
|
||||
TabOrder = 3
|
||||
end
|
||||
object chkItalic: TCheckBox
|
||||
Left = 88
|
||||
Height = 24
|
||||
Top = 120
|
||||
Width = 59
|
||||
Caption = 'Italic'
|
||||
TabOrder = 4
|
||||
end
|
||||
object chkStrik: TCheckBox
|
||||
Left = 280
|
||||
Height = 24
|
||||
Top = 120
|
||||
Width = 83
|
||||
Caption = 'Stikeout'
|
||||
TabOrder = 6
|
||||
end
|
||||
object chkUnder: TCheckBox
|
||||
Left = 168
|
||||
Height = 24
|
||||
Top = 120
|
||||
Width = 91
|
||||
Caption = 'Underline'
|
||||
TabOrder = 5
|
||||
end
|
||||
object bApplyStl: TButton
|
||||
Left = 8
|
||||
Height = 29
|
||||
Top = 304
|
||||
Width = 143
|
||||
AutoSize = True
|
||||
Caption = 'Apply style changes'
|
||||
OnClick = bApplyStlClick
|
||||
TabOrder = 12
|
||||
end
|
||||
object Label9: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 152
|
||||
Width = 58
|
||||
Caption = 'Borders:'
|
||||
ParentColor = False
|
||||
end
|
||||
object cbBorderL: TComboBox
|
||||
Left = 8
|
||||
Height = 31
|
||||
Top = 184
|
||||
Width = 100
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
Style = csDropDownList
|
||||
TabOrder = 7
|
||||
end
|
||||
object cbBorderT: TComboBox
|
||||
Left = 112
|
||||
Height = 31
|
||||
Top = 184
|
||||
Width = 100
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
Style = csDropDownList
|
||||
TabOrder = 8
|
||||
end
|
||||
object cbBorderR: TComboBox
|
||||
Left = 216
|
||||
Height = 31
|
||||
Top = 184
|
||||
Width = 100
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
Style = csDropDownList
|
||||
TabOrder = 9
|
||||
end
|
||||
object cbBorderB: TComboBox
|
||||
Left = 320
|
||||
Height = 31
|
||||
Top = 184
|
||||
Width = 100
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
Style = csDropDownList
|
||||
TabOrder = 10
|
||||
end
|
||||
object Label10: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 168
|
||||
Width = 28
|
||||
Caption = 'Left'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label11: TLabel
|
||||
Left = 112
|
||||
Height = 17
|
||||
Top = 168
|
||||
Width = 25
|
||||
Caption = 'Top'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label12: TLabel
|
||||
Left = 216
|
||||
Height = 17
|
||||
Top = 168
|
||||
Width = 35
|
||||
Caption = 'Right'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label13: TLabel
|
||||
Left = 320
|
||||
Height = 17
|
||||
Top = 168
|
||||
Width = 52
|
||||
Caption = 'Bottom'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label14: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 216
|
||||
Width = 109
|
||||
Caption = 'Color of border:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edColorBorder: TColorBox
|
||||
Left = 8
|
||||
Height = 31
|
||||
Top = 232
|
||||
Width = 190
|
||||
ColorRectWidth = 22
|
||||
NoneColorColor = clNone
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone, cbCustomColor, cbPrettyNames]
|
||||
DropDownCount = 20
|
||||
ItemHeight = 0
|
||||
TabOrder = 11
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheetNotes: TTabSheet
|
||||
Caption = 'Notes'
|
||||
ClientHeight = 494
|
||||
ClientWidth = 619
|
||||
object edNotes: TMemo
|
||||
Left = 6
|
||||
Height = 482
|
||||
Top = 6
|
||||
Width = 607
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
272
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerprop.pas
Normal file
272
ATSynEdit/app/demo_econtrol_lexer_lib/formlexerprop.pas
Normal file
@@ -0,0 +1,272 @@
|
||||
(*
|
||||
This Source Code Form is subject to the terms of the Mozilla Public
|
||||
License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
Copyright (c) Alexey Torgashin
|
||||
*)
|
||||
unit formlexerprop;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, FileUtil, Forms, Controls, StdCtrls,
|
||||
Dialogs, ButtonPanel, ComCtrls, ExtCtrls, ColorBox,
|
||||
ecSyntAnal,
|
||||
ATSynEdit,
|
||||
ATSynEdit_Adapter_EControl;
|
||||
|
||||
type
|
||||
{ TfmLexerProp }
|
||||
|
||||
TfmLexerProp = class(TForm)
|
||||
bApplyStl: TButton;
|
||||
ButtonPanel1: TButtonPanel;
|
||||
chkBold: TCheckBox;
|
||||
chkItalic: TCheckBox;
|
||||
chkStrik: TCheckBox;
|
||||
chkUnder: TCheckBox;
|
||||
cbBorderL: TComboBox;
|
||||
cbBorderT: TComboBox;
|
||||
cbBorderR: TComboBox;
|
||||
cbBorderB: TComboBox;
|
||||
edColorFont: TColorBox;
|
||||
edColorBG: TColorBox;
|
||||
edColorBorder: TColorBox;
|
||||
edStyleType: TComboBox;
|
||||
edExt: TEdit;
|
||||
edLineCmt: TEdit;
|
||||
edName: TEdit;
|
||||
edSample: TATSynEdit;
|
||||
Label1: TLabel;
|
||||
Label10: TLabel;
|
||||
Label11: TLabel;
|
||||
Label12: TLabel;
|
||||
Label13: TLabel;
|
||||
Label14: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
edNotes: TMemo;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Label7: TLabel;
|
||||
Label8: TLabel;
|
||||
Label9: TLabel;
|
||||
ListStyles: TListBox;
|
||||
chkBorderT: TPageControl;
|
||||
Panel1: TPanel;
|
||||
TabSheetGen: TTabSheet;
|
||||
TabSheetNotes: TTabSheet;
|
||||
TabSheetStyles: TTabSheet;
|
||||
procedure bApplyStlClick(Sender: TObject);
|
||||
procedure edStyleTypeChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure ListStylesClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
FAn: TecSyntAnalyzer;
|
||||
procedure InitBorder(cb: TCombobox);
|
||||
procedure UpdateStl;
|
||||
procedure UpdateStlEn(fmt: TecFormatType);
|
||||
procedure UpdateStlFromList;
|
||||
procedure UpdateStlToList;
|
||||
public
|
||||
{ public declarations }
|
||||
Adapter: TATAdapterEControl;
|
||||
end;
|
||||
|
||||
var
|
||||
fmLexerProp: TfmLexerProp;
|
||||
|
||||
function DoShowDialogLexerProp(an: TecSyntAnalyzer;
|
||||
AFontName: string; AFontSize: integer): boolean;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmLexerProp }
|
||||
|
||||
procedure TfmLexerProp.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Adapter:= TATAdapterEControl.Create(Self);
|
||||
edSample.AdapterHilite:= Adapter;
|
||||
|
||||
InitBorder(cbBorderL);
|
||||
InitBorder(cbBorderT);
|
||||
InitBorder(cbBorderR);
|
||||
InitBorder(cbBorderB);
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.bApplyStlClick(Sender: TObject);
|
||||
begin
|
||||
UpdateStlToList;
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.edStyleTypeChange(Sender: TObject);
|
||||
begin
|
||||
UpdateStlEn(TecFormatType(edStyleType.ItemIndex));
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
edSample.AdapterHilite:= nil;
|
||||
FreeAndNil(Adapter);
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.ListStylesClick(Sender: TObject);
|
||||
begin
|
||||
UpdateStlFromList;
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.UpdateStl;
|
||||
var
|
||||
i: integer;
|
||||
fmt: TecSyntaxFormat;
|
||||
begin
|
||||
ListStyles.Items.Clear;
|
||||
for i:= 0 to FAn.Formats.Count-1 do
|
||||
begin
|
||||
fmt:= FAn.Formats[i];
|
||||
ListStyles.Items.Add(fmt.DisplayName);
|
||||
end;
|
||||
|
||||
if ListStyles.Count>0 then
|
||||
ListStyles.ItemIndex:= 0;
|
||||
UpdateStlFromList;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TfmLexerProp.UpdateStlFromList;
|
||||
var
|
||||
n: integer;
|
||||
fmt: TecSyntaxFormat;
|
||||
begin
|
||||
n:= ListStyles.ItemIndex;
|
||||
if n<0 then exit;
|
||||
fmt:= FAn.Formats[n];
|
||||
UpdateStlEn(fmt.FormatType);
|
||||
|
||||
edStyleType.ItemIndex:= Ord(fmt.FormatType);
|
||||
edColorFont.Selected:= fmt.Font.Color;
|
||||
edColorBG.Selected:= fmt.BgColor;
|
||||
edColorBorder.Selected:= fmt.BorderColorBottom;
|
||||
|
||||
chkBold.Checked:= fsBold in fmt.Font.Style;
|
||||
chkItalic.Checked:= fsItalic in fmt.Font.Style;
|
||||
chkUnder.Checked:= fsUnderline in fmt.Font.Style;
|
||||
chkStrik.Checked:= fsStrikeOut in fmt.Font.Style;
|
||||
|
||||
cbBorderL.ItemIndex:= Ord(fmt.BorderTypeLeft);
|
||||
cbBorderT.ItemIndex:= Ord(fmt.BorderTypeTop);
|
||||
cbBorderR.ItemIndex:= Ord(fmt.BorderTypeRight);
|
||||
cbBorderB.ItemIndex:= Ord(fmt.BorderTypeBottom);
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.UpdateStlEn(fmt: TecFormatType);
|
||||
begin
|
||||
edColorFont.Enabled:= fmt in [ftCustomFont, ftFontAttr, ftColor];
|
||||
edColorBG.Enabled:= true;
|
||||
|
||||
chkBold.Enabled:= fmt in [ftCustomFont, ftFontAttr];
|
||||
chkItalic.Enabled:= chkBold.Enabled;
|
||||
chkUnder.Enabled:= chkBold.Enabled;
|
||||
chkStrik.Enabled:= chkBold.Enabled;
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.UpdateStlToList;
|
||||
var
|
||||
n: integer;
|
||||
fmt: TecSyntaxFormat;
|
||||
fs: TFontStyles;
|
||||
begin
|
||||
n:= ListStyles.ItemIndex;
|
||||
if n<0 then exit;
|
||||
fmt:= FAn.Formats[n];
|
||||
|
||||
fmt.FormatType:= TecFormatType(edStyleType.ItemIndex);
|
||||
fmt.Font.Color:= edColorFont.Selected;
|
||||
fmt.BgColor:= edColorBG.Selected;
|
||||
fmt.BorderColorBottom:= edColorBorder.Selected;
|
||||
|
||||
fs:= [];
|
||||
if chkBold.Checked then Include(fs, fsBold);
|
||||
if chkItalic.Checked then Include(fs, fsItalic);
|
||||
if chkUnder.Checked then Include(fs, fsUnderline);
|
||||
if chkStrik.Checked then Include(fs, fsStrikeOut);
|
||||
fmt.Font.Style:= fs;
|
||||
|
||||
fmt.BorderTypeLeft:= TecBorderLineType(cbBorderL.ItemIndex);
|
||||
fmt.BorderTypeTop:= TecBorderLineType(cbBorderT.ItemIndex);
|
||||
fmt.BorderTypeRight:= TecBorderLineType(cbBorderR.ItemIndex);
|
||||
fmt.BorderTypeBottom:= TecBorderLineType(cbBorderB.ItemIndex);
|
||||
end;
|
||||
|
||||
|
||||
function DoShowDialogLexerProp(an: TecSyntAnalyzer; AFontName: string;
|
||||
AFontSize: integer): boolean;
|
||||
var
|
||||
F: TfmLexerProp;
|
||||
begin
|
||||
Result:= false;
|
||||
if an=nil then exit;
|
||||
F:= TfmLexerProp.Create(nil);
|
||||
try
|
||||
F.FAn:= an;
|
||||
F.edName.Text:= an.LexerName;
|
||||
F.edExt.Text:= an.Extentions;
|
||||
F.edLineCmt.Text:= an.LineComment;
|
||||
F.edNotes.Lines.AddStrings(an.Notes);
|
||||
F.UpdateStl;
|
||||
|
||||
F.edSample.Font.Name:= AFontName;
|
||||
F.edSample.Font.Size:= AFontSize;
|
||||
F.edSample.Gutter[F.edSample.GutterBandBm].Visible:= false;
|
||||
F.edSample.Gutter[F.edSample.GutterBandNum].Visible:= false;
|
||||
F.Adapter.Lexer:= an;
|
||||
if Assigned(an.SampleText) then
|
||||
begin
|
||||
F.edSample.Strings.LoadFromString(an.SampleText.Text);
|
||||
F.edSample.Update(true);
|
||||
F.edSample.DoEventChange;
|
||||
end;
|
||||
|
||||
if F.ShowModal<>mrOk then exit;
|
||||
if Trim(F.edName.Text)='' then exit;
|
||||
Result:= true;
|
||||
|
||||
an.LexerName:= F.edName.Text;
|
||||
an.Extentions:= F.edExt.Text;
|
||||
an.LineComment:= F.edLineCmt.Text;
|
||||
an.Notes.Clear;
|
||||
an.Notes.AddStrings(F.edNotes.Lines);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmLexerProp.InitBorder(cb: TCombobox);
|
||||
begin
|
||||
with cb.Items do
|
||||
begin
|
||||
Clear;
|
||||
Add('none');
|
||||
Add('solid');
|
||||
Add('dash');
|
||||
Add('dot');
|
||||
Add('dash dot');
|
||||
Add('dash dot dot');
|
||||
Add('solid2');
|
||||
Add('solid3');
|
||||
Add('wave');
|
||||
Add('double');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
109
ATSynEdit/app/demo_econtrol_lexer_lib/lex_lib_demo.lpi
Normal file
109
ATSynEdit/app/demo_econtrol_lexer_lib/lex_lib_demo.lpi
Normal file
@@ -0,0 +1,109 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="atsynedit_package"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="econtrol_package"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="lex_lib_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unmain.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="formlexerlib.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="formlexerprop.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="lex_lib_demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../../atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
ATSynEdit/app/demo_econtrol_lexer_lib/lex_lib_demo.lpr
Normal file
22
ATSynEdit/app/demo_econtrol_lexer_lib/lex_lib_demo.lpr
Normal file
@@ -0,0 +1,22 @@
|
||||
program lex_lib_demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, unmain
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Title:='Demo';
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
23789
ATSynEdit/app/demo_econtrol_lexer_lib/lexlib/small.lxl
Normal file
23789
ATSynEdit/app/demo_econtrol_lexer_lib/lexlib/small.lxl
Normal file
File diff suppressed because it is too large
Load Diff
167
ATSynEdit/app/demo_econtrol_lexer_lib/proc_lexer_install_zip.pas
Normal file
167
ATSynEdit/app/demo_econtrol_lexer_lib/proc_lexer_install_zip.pas
Normal file
@@ -0,0 +1,167 @@
|
||||
unit proc_lexer_install_zip;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, FileUtil,
|
||||
ecSyntAnal;
|
||||
|
||||
function DoInstallLexerFromZip(const fn_zip: string;
|
||||
Manager: TecSyntaxManager;
|
||||
const dir_acp: string;
|
||||
out s_installed: string): boolean;
|
||||
|
||||
var
|
||||
cInstallLexerZipTitle: string = 'Install zip';
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLIntf, LCLProc, LCLType,
|
||||
IniFiles,
|
||||
Zipper;
|
||||
|
||||
function MsgBox(const msg: string; flags: integer): integer;
|
||||
begin
|
||||
Result:= Application.MessageBox(PChar(msg), PChar(cInstallLexerZipTitle), flags);
|
||||
end;
|
||||
|
||||
function DoInstallLexerFromZip(const fn_zip: string;
|
||||
Manager: TecSyntaxManager;
|
||||
const dir_acp: string;
|
||||
out s_installed: string): boolean;
|
||||
var
|
||||
unzip: TUnZipper;
|
||||
list: TStringlist;
|
||||
dir, fn_inf, fn_lexer, fn_acp: string;
|
||||
s_title, s_type, s_lexer: string;
|
||||
an, an_sub: TecSyntAnalyzer;
|
||||
i_lexer, i_sub: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
dir:= GetTempDir(false)+DirectorySeparator+'zip_lexer';
|
||||
if not DirectoryExists(dir) then
|
||||
CreateDir(dir);
|
||||
if not DirectoryExists(dir) then
|
||||
begin
|
||||
MsgBox('Cannot create dir:'#13+dir, mb_ok or mb_iconerror);
|
||||
exit
|
||||
end;
|
||||
|
||||
fn_inf:= dir+DirectorySeparator+'install.inf';
|
||||
if FileExists(fn_inf) then
|
||||
DeleteFile(fn_inf);
|
||||
|
||||
unzip:= TUnZipper.Create;
|
||||
try
|
||||
unzip.FileName:= fn_zip;
|
||||
unzip.OutputPath:= dir;
|
||||
unzip.Examine;
|
||||
|
||||
list:= TStringlist.create;
|
||||
try
|
||||
list.Add('install.inf');
|
||||
unzip.UnZipFiles(list);
|
||||
finally
|
||||
FreeAndNil(list);
|
||||
end;
|
||||
|
||||
if not FileExists(fn_inf) then
|
||||
begin
|
||||
MsgBox('Cannot find install.inf in zip', mb_ok or mb_iconerror);
|
||||
exit
|
||||
end;
|
||||
|
||||
unzip.Files.Clear;
|
||||
unzip.UnZipAllFiles;
|
||||
finally
|
||||
unzip.Free;
|
||||
end;
|
||||
|
||||
with TIniFile.Create(fn_inf) do
|
||||
try
|
||||
s_title:= ReadString('info', 'title', '');
|
||||
s_type:= ReadString('info', 'type', '');
|
||||
//s_subdir:= ReadString('info', 'subdir', '');
|
||||
finally
|
||||
Free
|
||||
end;
|
||||
|
||||
if (s_title='') or (s_type='') then
|
||||
begin
|
||||
MsgBox('Incorrect install.inf in zip', mb_ok or mb_iconerror);
|
||||
exit
|
||||
end;
|
||||
|
||||
if (s_type<>'lexer') then
|
||||
begin
|
||||
MsgBox('Unsupported addon type: '+s_type, mb_ok or mb_iconerror);
|
||||
exit
|
||||
end;
|
||||
|
||||
if MsgBox('This package contains:'#13#13+
|
||||
'title: '+s_title+#13+
|
||||
'type: '+s_type+#13#13+
|
||||
'Do you want to install it?',
|
||||
MB_OKCANCEL or MB_ICONQUESTION)<>id_ok then exit;
|
||||
|
||||
s_installed:= '';
|
||||
with TIniFile.Create(fn_inf) do
|
||||
try
|
||||
for i_lexer:= 1 to 20 do
|
||||
begin
|
||||
s_lexer:= ReadString('lexer'+Inttostr(i_lexer), 'file', '');
|
||||
if s_lexer='' then Break;
|
||||
|
||||
//lexer file
|
||||
fn_lexer:= ExtractFileDir(fn_inf)+DirectorySeparator+s_lexer+'.lcf';
|
||||
if not FileExists(fn_lexer) then
|
||||
begin
|
||||
MsgBox('Cannot find lexer file: '+fn_lexer, mb_ok or mb_iconerror);
|
||||
exit
|
||||
end;
|
||||
|
||||
fn_acp:= ExtractFileDir(fn_inf)+DirectorySeparator+s_lexer+'.acp';
|
||||
if FileExists(fn_acp) then
|
||||
if dir_acp<>'' then
|
||||
CopyFile(fn_acp, dir_acp+DirectorySeparator+s_lexer+'.acp');
|
||||
|
||||
an:= Manager.FindAnalyzer(s_lexer);
|
||||
if an=nil then
|
||||
an:= Manager.AddAnalyzer;
|
||||
an.LoadFromFile(fn_lexer);
|
||||
s_installed:= s_installed+s_lexer+#13;
|
||||
|
||||
//links
|
||||
for i_sub:= 0 to an.SubAnalyzers.Count-1 do
|
||||
begin
|
||||
s_lexer:= ReadString('lexer'+Inttostr(i_lexer), 'link'+Inttostr(i_sub+1), '');
|
||||
if s_lexer='' then Continue;
|
||||
if s_lexer='Style sheets' then s_lexer:= 'CSS';
|
||||
if s_lexer='Assembler' then s_lexer:= 'Assembly';
|
||||
|
||||
an_sub:= Manager.FindAnalyzer(s_lexer);
|
||||
if an_sub<>nil then
|
||||
begin
|
||||
an.SubAnalyzers.Items[i_sub].SyntAnalyzer:= an_sub;
|
||||
//MsgBox('Linked lexer "'+an.LexerName+'" to "'+s_lexer+'"', mb_ok or MB_ICONINFORMATION);
|
||||
end
|
||||
else
|
||||
begin
|
||||
MsgBox('Cannot find linked sublexer in library: '+s_lexer, MB_OK or MB_ICONWARNING);
|
||||
Continue;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Free
|
||||
end;
|
||||
|
||||
Result:= true;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
30
ATSynEdit/app/demo_econtrol_lexer_lib/unmain.lfm
Normal file
30
ATSynEdit/app/demo_econtrol_lexer_lib/unmain.lfm
Normal file
@@ -0,0 +1,30 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 428
|
||||
Height = 231
|
||||
Top = 408
|
||||
Width = 454
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Demo'
|
||||
ClientHeight = 231
|
||||
ClientWidth = 454
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object bShow: TButton
|
||||
Left = 144
|
||||
Height = 40
|
||||
Top = 80
|
||||
Width = 152
|
||||
Caption = 'Lexer lib dialog'
|
||||
OnClick = bShowClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 184
|
||||
Width = 45
|
||||
Caption = 'Label1'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
76
ATSynEdit/app/demo_econtrol_lexer_lib/unmain.pas
Normal file
76
ATSynEdit/app/demo_econtrol_lexer_lib/unmain.pas
Normal file
@@ -0,0 +1,76 @@
|
||||
unit unmain;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
LclIntf, LclProc, LclType,
|
||||
ecSyntAnal,
|
||||
formlexerlib;
|
||||
|
||||
type
|
||||
{ TfmMain }
|
||||
|
||||
TfmMain = class(TForm)
|
||||
bShow: TButton;
|
||||
Label1: TLabel;
|
||||
procedure bShowClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
procedure UpdStatus;
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmMain: TfmMain;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
var
|
||||
Manager: TecSyntaxManager;
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
procedure TfmMain.bShowClick(Sender: TObject);
|
||||
var
|
||||
dirAcp: string;
|
||||
begin
|
||||
dirAcp:= ExtractFileDir(Application.ExeName)+DirectorySeparator+'acp';
|
||||
CreateDir(dirAcp);
|
||||
|
||||
DoShowDialogLexerLib(Manager, dirAcp, 'Courier new', 9);
|
||||
if Manager.Modified then
|
||||
begin
|
||||
UpdStatus;
|
||||
Manager.Modified:= false;
|
||||
if Application.MessageBox('Lib was modified. Save file?', 'Demo',
|
||||
MB_OKCANCEL or MB_ICONQUESTION)=id_ok then
|
||||
Manager.SaveToFile(Manager.FileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfmMain.FormCreate(Sender: TObject);
|
||||
var
|
||||
fn: string;
|
||||
begin
|
||||
fn:= ExtractFileDir(Application.ExeName)+DirectorySeparator+
|
||||
'lexlib'+DirectorySeparator+'small.lxl';
|
||||
Manager:= TecSyntaxManager.Create(Self);
|
||||
Manager.LoadFromFile(fn);
|
||||
UpdStatus;
|
||||
end;
|
||||
|
||||
procedure TfmMain.UpdStatus;
|
||||
begin
|
||||
Label1.Caption:= Format('library "%s" has %d lexers',
|
||||
[Extractfilename(Manager.FileName), Manager.AnalyzerCount]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
266
ATSynEdit/app/demo_editor/demo.lpi
Normal file
266
ATSynEdit/app/demo_editor/demo.lpi
Normal file
@@ -0,0 +1,266 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<AutoCreateForms Value="False"/>
|
||||
<Title Value="Demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="37">
|
||||
<Unit0>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="formmain.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="formkey.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmCmd"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\atsynedit\atstrings_editing.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_carets.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_clipboard.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_editing.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_handler.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_keys.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_misc.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_proc.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_canvasproc.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_CanvasProc"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_keymap.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Keymap"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="..\..\atsynedit\atstringproc.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStringProc"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="..\..\atsynedit\atstringproc_wordjump.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStringProc_WordJump"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="..\..\atsynedit\atstrings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStrings"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_carets.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Carets"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="..\..\atsynedit\atsynedit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_commands.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Commands"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_keymap_init.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Keymap_Init"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_hilite.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_sel.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_gutter.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="formopt.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmOpt"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="..\..\atsynedit\atstrings_load.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="..\..\atsynedit\atstrings_undo.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="..\..\atsynedit\atstrings_save.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_wrapinfo.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_WrapInfo"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_cmd_sel.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit28>
|
||||
<Unit29>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_debug.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit29>
|
||||
<Unit30>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_edits.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Edits"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="formcombo.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmCombo"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit31>
|
||||
<Unit32>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_ranges.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Ranges"/>
|
||||
</Unit32>
|
||||
<Unit33>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_fold.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit33>
|
||||
<Unit34>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_adapters.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Adapters"/>
|
||||
</Unit34>
|
||||
<Unit35>
|
||||
<Filename Value="formfind.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmFind"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit35>
|
||||
<Unit36>
|
||||
<Filename Value="..\..\atsynedit\atsynedit_export_html.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Export_HTML"/>
|
||||
</Unit36>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);..\..\comp\atsynedit;..\..\atsynedit"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit;..\..\proc_lexer"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="4">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Name Value="ERegExpr"/>
|
||||
</Item4>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
41
ATSynEdit/app/demo_editor/demo.lpr
Normal file
41
ATSynEdit/app/demo_editor/demo.lpr
Normal file
@@ -0,0 +1,41 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
//heaptrc,
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms,
|
||||
atsynedit_canvasproc,
|
||||
atsynedit_keymap,
|
||||
atstringproc,
|
||||
atstringproc_wordjump,
|
||||
atstrings,
|
||||
atstrings_undo,
|
||||
atsynedit_carets,
|
||||
atsynedit,
|
||||
atsynedit_gutter,
|
||||
atsynedit_commands,
|
||||
atsynedit_keymap_init,
|
||||
atsynedit_wrapinfo,
|
||||
atsynedit_edits,
|
||||
atsynedit_ranges, ATSynEdit_Adapters,
|
||||
formmain,
|
||||
formkey,
|
||||
formopt,
|
||||
formcombo, formfind, atsynedit_export_html;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Title:= 'Demo';
|
||||
RequireDerivedFormResource:= True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.CreateForm(TfmOpt, fmOpt);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
21
ATSynEdit/app/demo_editor/demo.pas
Normal file
21
ATSynEdit/app/demo_editor/demo.pas
Normal file
@@ -0,0 +1,21 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, formmain,
|
||||
ATSynEdit, ATStrings, ATStringProc, ATCanvasProc;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
58
ATSynEdit/app/demo_editor/formcombo.lfm
Normal file
58
ATSynEdit/app/demo_editor/formcombo.lfm
Normal file
@@ -0,0 +1,58 @@
|
||||
object fmCombo: TfmCombo
|
||||
Left = 426
|
||||
Height = 240
|
||||
Top = 370
|
||||
Width = 397
|
||||
Caption = 'Combo'
|
||||
ClientHeight = 240
|
||||
ClientWidth = 397
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object Panel1: TPanel
|
||||
Left = 16
|
||||
Height = 49
|
||||
Top = 32
|
||||
Width = 335
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 49
|
||||
ClientWidth = 335
|
||||
TabOrder = 0
|
||||
object Label1: TLabel
|
||||
Left = 0
|
||||
Height = 17
|
||||
Top = 4
|
||||
Width = 97
|
||||
Caption = 'ATComboEdit:'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 205
|
||||
Width = 385
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 1
|
||||
ShowButtons = [pbClose]
|
||||
ShowBevel = False
|
||||
end
|
||||
object chkEnabled: TCheckBox
|
||||
Left = 17
|
||||
Height = 24
|
||||
Top = 174
|
||||
Width = 80
|
||||
Caption = 'Enabled'
|
||||
Checked = True
|
||||
OnChange = chkEnabledChange
|
||||
State = cbChecked
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
81
ATSynEdit/app/demo_editor/formcombo.pas
Normal file
81
ATSynEdit/app/demo_editor/formcombo.pas
Normal file
@@ -0,0 +1,81 @@
|
||||
unit formcombo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, ButtonPanel, ATSynEdit_Edits;
|
||||
|
||||
type
|
||||
{ TfmCombo }
|
||||
|
||||
TfmCombo = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
chkEnabled: TCheckBox;
|
||||
Label1: TLabel;
|
||||
Panel1: TPanel;
|
||||
procedure chkEnabledChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
procedure ComboCommand(Sender: TObject; ACmd: integer; const AText: string; var AHandled: boolean);
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
ed: TATComboEdit;
|
||||
end;
|
||||
|
||||
var
|
||||
fmCombo: TfmCombo;
|
||||
|
||||
implementation
|
||||
|
||||
uses ATSynEdit_Commands;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmCombo }
|
||||
|
||||
procedure TfmCombo.FormCreate(Sender: TObject);
|
||||
begin
|
||||
ed:= TATComboEdit.Create(Self);
|
||||
ed.Parent:= Panel1;
|
||||
ed.Align:= alBottom;
|
||||
ed.OnCommand:= @ComboCommand;
|
||||
ed.Text:= 'Test';
|
||||
ed.OptTextHint:= '(empty)';
|
||||
end;
|
||||
|
||||
procedure TfmCombo.chkEnabledChange(Sender: TObject);
|
||||
begin
|
||||
ed.Enabled:= chkEnabled.Checked;
|
||||
end;
|
||||
|
||||
procedure TfmCombo.ComboCommand(Sender: TObject; ACmd: integer;
|
||||
const AText: string; var AHandled: boolean);
|
||||
var
|
||||
s: string;
|
||||
n: integer;
|
||||
begin
|
||||
if ACmd=cCommand_KeyEnter then
|
||||
begin
|
||||
with ed do
|
||||
begin
|
||||
s:= UTF8Encode(Trim(Text));
|
||||
ShowMessage('Enter: '+s);
|
||||
|
||||
Text:= '';
|
||||
DoCaretSingle(0, 0);
|
||||
|
||||
n:= Items.IndexOf(s);
|
||||
if n>=0 then Items.Delete(n);
|
||||
Items.Insert(0, s);
|
||||
end;
|
||||
AHandled:= true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
149
ATSynEdit/app/demo_editor/formfind.lfm
Normal file
149
ATSynEdit/app/demo_editor/formfind.lfm
Normal file
@@ -0,0 +1,149 @@
|
||||
object fmFind: TfmFind
|
||||
Left = 521
|
||||
Height = 233
|
||||
Top = 265
|
||||
Width = 489
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Find/Replace'
|
||||
ClientHeight = 233
|
||||
ClientWidth = 489
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object bFind: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 48
|
||||
Width = 99
|
||||
Caption = 'find'
|
||||
ModalResult = 1
|
||||
TabOrder = 9
|
||||
end
|
||||
object bCancel: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 144
|
||||
Width = 99
|
||||
Cancel = True
|
||||
Caption = 'cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 14
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 9
|
||||
Height = 17
|
||||
Top = 8
|
||||
Width = 66
|
||||
Caption = 'find what:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edFind: TEdit
|
||||
Left = 9
|
||||
Height = 27
|
||||
Top = 32
|
||||
Width = 359
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkRegex: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 128
|
||||
Width = 64
|
||||
Caption = 'regex'
|
||||
OnChange = chkRegexChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object chkBack: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 200
|
||||
Width = 92
|
||||
Caption = 'backward'
|
||||
TabOrder = 6
|
||||
end
|
||||
object chkCase: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 152
|
||||
Width = 118
|
||||
Caption = 'case sensitive'
|
||||
TabOrder = 4
|
||||
end
|
||||
object chkWords: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 176
|
||||
Width = 142
|
||||
Caption = 'whole words only'
|
||||
TabOrder = 5
|
||||
end
|
||||
object edRep: TEdit
|
||||
Left = 9
|
||||
Height = 27
|
||||
Top = 88
|
||||
Width = 359
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkRep: TCheckBox
|
||||
Left = 9
|
||||
Height = 24
|
||||
Top = 64
|
||||
Width = 112
|
||||
Caption = 'replace with:'
|
||||
OnChange = chkRepChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object bRep: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 16
|
||||
Width = 99
|
||||
Caption = 'replace'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
TabOrder = 10
|
||||
end
|
||||
object bRepAll: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 48
|
||||
Width = 99
|
||||
Caption = 'replace all'
|
||||
ModalResult = 10
|
||||
TabOrder = 11
|
||||
end
|
||||
object chkFromCaret: TCheckBox
|
||||
Left = 216
|
||||
Height = 24
|
||||
Top = 128
|
||||
Width = 98
|
||||
Caption = 'from caret'
|
||||
TabOrder = 7
|
||||
end
|
||||
object bCount: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 80
|
||||
Width = 99
|
||||
Caption = 'count all'
|
||||
ModalResult = 5
|
||||
TabOrder = 12
|
||||
end
|
||||
object chkConfirm: TCheckBox
|
||||
Left = 216
|
||||
Height = 24
|
||||
Top = 152
|
||||
Width = 131
|
||||
Caption = 'confirm replace'
|
||||
TabOrder = 8
|
||||
end
|
||||
object bMarkAll: TButton
|
||||
Left = 376
|
||||
Height = 25
|
||||
Top = 112
|
||||
Width = 99
|
||||
Caption = 'mark all'
|
||||
ModalResult = 4
|
||||
TabOrder = 13
|
||||
end
|
||||
end
|
||||
85
ATSynEdit/app/demo_editor/formfind.pas
Normal file
85
ATSynEdit/app/demo_editor/formfind.pas
Normal file
@@ -0,0 +1,85 @@
|
||||
unit formfind;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
||||
StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfmFind }
|
||||
|
||||
TfmFind = class(TForm)
|
||||
bCount: TButton;
|
||||
bMarkAll: TButton;
|
||||
bFind: TButton;
|
||||
bCancel: TButton;
|
||||
bRep: TButton;
|
||||
bRepAll: TButton;
|
||||
chkFromCaret: TCheckBox;
|
||||
chkConfirm: TCheckBox;
|
||||
chkRep: TCheckBox;
|
||||
chkRegex: TCheckBox;
|
||||
chkBack: TCheckBox;
|
||||
chkCase: TCheckBox;
|
||||
chkWords: TCheckBox;
|
||||
edFind: TEdit;
|
||||
edRep: TEdit;
|
||||
Label1: TLabel;
|
||||
procedure chkRegexChange(Sender: TObject);
|
||||
procedure chkRepChange(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
procedure Update;
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmFind: TfmFind;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmFind }
|
||||
|
||||
procedure TfmFind.chkRegexChange(Sender: TObject);
|
||||
begin
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TfmFind.chkRepChange(Sender: TObject);
|
||||
begin
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TfmFind.FormShow(Sender: TObject);
|
||||
begin
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TfmFInd.Update;
|
||||
var
|
||||
rep: boolean;
|
||||
begin
|
||||
rep:= chkRep.Checked;
|
||||
|
||||
chkWords.Enabled:= not chkRegex.Checked;
|
||||
chkBack.Enabled:= not chkRegex.Checked;
|
||||
chkConfirm.Enabled:= rep;
|
||||
edRep.Enabled:= rep;
|
||||
bFind.Visible:= not rep;
|
||||
bRep.Visible:= rep;
|
||||
bRepAll.Visible:= rep;
|
||||
|
||||
if rep then Caption:= 'Replace' else Caption:= 'Find';
|
||||
if rep then bRep.Default:= true else bFind.Default:= true;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
59
ATSynEdit/app/demo_editor/formkey.lfm
Normal file
59
ATSynEdit/app/demo_editor/formkey.lfm
Normal file
@@ -0,0 +1,59 @@
|
||||
object fmCmd: TfmCmd
|
||||
Left = 425
|
||||
Height = 620
|
||||
Top = 120
|
||||
Width = 679
|
||||
ActiveControl = List
|
||||
Caption = 'Commands'
|
||||
ClientHeight = 620
|
||||
ClientWidth = 679
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object List: TListView
|
||||
Left = 6
|
||||
Height = 573
|
||||
Top = 6
|
||||
Width = 667
|
||||
Align = alClient
|
||||
AutoSort = False
|
||||
BorderSpacing.Around = 6
|
||||
Columns = <
|
||||
item
|
||||
Caption = 'name'
|
||||
Width = 350
|
||||
end
|
||||
item
|
||||
Caption = 'key1'
|
||||
Width = 150
|
||||
end
|
||||
item
|
||||
Caption = 'key2'
|
||||
Width = 150
|
||||
end>
|
||||
ColumnClick = False
|
||||
ReadOnly = True
|
||||
RowSelect = True
|
||||
TabOrder = 0
|
||||
ViewStyle = vsReport
|
||||
OnDblClick = ListDblClick
|
||||
end
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 585
|
||||
Width = 667
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 1
|
||||
ShowButtons = [pbOK, pbCancel]
|
||||
ShowGlyphs = []
|
||||
ShowBevel = False
|
||||
end
|
||||
end
|
||||
78
ATSynEdit/app/demo_editor/formkey.pas
Normal file
78
ATSynEdit/app/demo_editor/formkey.pas
Normal file
@@ -0,0 +1,78 @@
|
||||
unit formkey;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, comctrls,
|
||||
ButtonPanel, ATSynedit;
|
||||
|
||||
type
|
||||
{ TfmCmd }
|
||||
|
||||
TfmCmd = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
List: TListView;
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure ListDblClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
edit: TATSynEdit;
|
||||
end;
|
||||
|
||||
var
|
||||
fmCmd: TfmCmd;
|
||||
|
||||
function DoCommandDialog(AEdit: TATSynEdit): integer;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Menus, LCLProc;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
function DoCommandDialog(AEdit: TATSynEdit): integer;
|
||||
begin
|
||||
Result:= 0;
|
||||
with TfmCmd.Create(nil) do
|
||||
try
|
||||
edit:= AEdit;
|
||||
if ShowModal=mrOk then
|
||||
if List.Selected<>nil then
|
||||
Result:= StrToIntDef(List.Selected.SubItems[2], 0);
|
||||
finally
|
||||
Free
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TfmCmd }
|
||||
|
||||
procedure TfmCmd.FormShow(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= 0 to edit.Keymap.Count-1 do
|
||||
with edit.Keymap.Items[i] do
|
||||
with List.Items.Add do
|
||||
begin
|
||||
Caption:= Name;
|
||||
SubItems.Add(ShortCutToText(Keys1[0]));
|
||||
SubItems.Add(ShortCutToText(Keys2[0]));
|
||||
SubItems.Add(Inttostr(Command));
|
||||
end;
|
||||
|
||||
if List.Items.Count>0 then
|
||||
List.Selected:= List.Items[0];
|
||||
end;
|
||||
|
||||
procedure TfmCmd.ListDblClick(Sender: TObject);
|
||||
begin
|
||||
//ModalResult:= mrOk;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
73
ATSynEdit/app/demo_editor/formkeyoption.lfm
Normal file
73
ATSynEdit/app/demo_editor/formkeyoption.lfm
Normal file
@@ -0,0 +1,73 @@
|
||||
object fmKeyOpt: TfmKeyOpt
|
||||
Left = 464
|
||||
Height = 160
|
||||
Top = 241
|
||||
Width = 291
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Hotkey'
|
||||
ClientHeight = 160
|
||||
ClientWidth = 291
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.4.0.2'
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 33
|
||||
Top = 121
|
||||
Width = 279
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.Caption = 'Clear key'
|
||||
CloseButton.DefaultCaption = False
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 5
|
||||
ShowButtons = [pbOK, pbCancel, pbClose]
|
||||
ShowGlyphs = []
|
||||
end
|
||||
object chkCtrl: TCheckBox
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 16
|
||||
Width = 39
|
||||
Caption = 'Ctrl'
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkAlt: TCheckBox
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 40
|
||||
Width = 35
|
||||
Caption = 'Alt'
|
||||
TabOrder = 1
|
||||
end
|
||||
object chkShift: TCheckBox
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 64
|
||||
Width = 44
|
||||
Caption = 'Shift'
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkMeta: TCheckBox
|
||||
Left = 24
|
||||
Height = 19
|
||||
Top = 88
|
||||
Width = 47
|
||||
Caption = 'Meta'
|
||||
TabOrder = 3
|
||||
end
|
||||
object ed: TComboBox
|
||||
Left = 112
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 112
|
||||
DropDownCount = 30
|
||||
ItemHeight = 15
|
||||
Style = csDropDownList
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
129
ATSynEdit/app/demo_editor/formkeyoption.pas
Normal file
129
ATSynEdit/app/demo_editor/formkeyoption.pas
Normal file
@@ -0,0 +1,129 @@
|
||||
unit formkeyoption;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
|
||||
StdCtrls;
|
||||
|
||||
type
|
||||
{ TfmKeyOpt }
|
||||
|
||||
TfmKeyOpt = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
chkCtrl: TCheckBox;
|
||||
chkAlt: TCheckBox;
|
||||
chkShift: TCheckBox;
|
||||
chkMeta: TCheckBox;
|
||||
ed: TComboBox;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
function DoDialogHotkey(S: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
function DoDialogHotkey(S: string): string;
|
||||
var
|
||||
n: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
with TfmKeyOpt.Create(nil) do
|
||||
try
|
||||
chkCtrl.Checked:= Pos('Ctrl+', S)>0;
|
||||
chkAlt.Checked:= Pos('Alt+', S)>0;
|
||||
chkShift.Checked:= Pos('Shift+', S)>0;
|
||||
chkMeta.Checked:= Pos('Meta+', S)>0;
|
||||
|
||||
repeat
|
||||
n:= Pos('+', S);
|
||||
if n=0 then Break;
|
||||
Delete(S, 1, n);
|
||||
until false;
|
||||
|
||||
ed.ItemIndex:= ed.Items.IndexOf(S);
|
||||
if ed.ItemIndex<0 then
|
||||
ed.ItemIndex:= 0;
|
||||
|
||||
case ShowModal of
|
||||
mrOk:
|
||||
begin
|
||||
Result:= ed.Text;
|
||||
if chkMeta.Checked then Result:= 'Meta+'+Result;
|
||||
if chkShift.Checked then Result:= 'Shift+'+Result;
|
||||
if chkAlt.Checked then Result:= 'Alt+'+Result;
|
||||
if chkCtrl.Checked then Result:= 'Ctrl+'+Result;
|
||||
end;
|
||||
mrClose:
|
||||
Result:= '';
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TfmKeyOpt }
|
||||
|
||||
procedure TfmKeyOpt.FormCreate(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Ord('A') to Ord('Z') do
|
||||
ed.Items.Add(Chr(i));
|
||||
for i:= 0 to 9 do
|
||||
ed.Items.Add(Inttostr(i));
|
||||
for i:= 1 to 12 do
|
||||
ed.Items.Add('F'+Inttostr(i));
|
||||
|
||||
ed.Items.Add('Left');
|
||||
ed.Items.Add('Right');
|
||||
ed.Items.Add('Up');
|
||||
ed.Items.Add('Down');
|
||||
ed.Items.Add('Ins');
|
||||
ed.Items.Add('Del');
|
||||
ed.Items.Add('Home');
|
||||
ed.Items.Add('End');
|
||||
ed.Items.Add('PgUp');
|
||||
ed.Items.Add('PgDn');
|
||||
ed.Items.Add('Enter');
|
||||
ed.Items.Add('BkSp');
|
||||
ed.Items.Add('Tab');
|
||||
ed.Items.Add('Esc');
|
||||
ed.Items.Add('-');
|
||||
ed.Items.Add('=');
|
||||
ed.Items.Add('`');
|
||||
ed.Items.Add(',');
|
||||
ed.Items.Add('.');
|
||||
ed.Items.Add(';');
|
||||
ed.Items.Add('''');
|
||||
ed.Items.Add('\');
|
||||
ed.Items.Add('/');
|
||||
ed.Items.Add('[');
|
||||
ed.Items.Add(']');
|
||||
|
||||
for i:= 0 to 9 do
|
||||
ed.Items.Add('Num'+Inttostr(i));
|
||||
ed.Items.Add('NumPlus');
|
||||
ed.Items.Add('NumMinus');
|
||||
ed.Items.Add('NumMul');
|
||||
ed.Items.Add('NumDiv');
|
||||
ed.Items.Add('NumDot');
|
||||
ed.Items.Add('NumClear');
|
||||
|
||||
ed.Items.Add('NumLock');
|
||||
ed.Items.Add('ScrollLock');
|
||||
ed.Items.Add('CapsLock');
|
||||
ed.Items.Add('Break');
|
||||
ed.Items.Add('PopUp');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
556
ATSynEdit/app/demo_editor/formmain.lfm
Normal file
556
ATSynEdit/app/demo_editor/formmain.lfm
Normal file
@@ -0,0 +1,556 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 266
|
||||
Height = 498
|
||||
Top = 242
|
||||
Width = 953
|
||||
Caption = 'Demo'
|
||||
ClientHeight = 498
|
||||
ClientWidth = 953
|
||||
Menu = MainMenu1
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnResize = FormResize
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object PanelMain: TPanel
|
||||
Left = 0
|
||||
Height = 498
|
||||
Top = 0
|
||||
Width = 672
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 498
|
||||
ClientWidth = 672
|
||||
TabOrder = 0
|
||||
object Status: TStatusBar
|
||||
Left = 0
|
||||
Height = 21
|
||||
Top = 477
|
||||
Width = 672
|
||||
Panels = <>
|
||||
end
|
||||
object StatusMsg: TStatusBar
|
||||
Left = 0
|
||||
Height = 21
|
||||
Top = 456
|
||||
Width = 672
|
||||
Font.Color = clBlue
|
||||
Panels = <>
|
||||
ParentFont = False
|
||||
end
|
||||
object progress: TProgressBar
|
||||
AnchorSideLeft.Control = PanelMain
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = StatusMsg
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = StatusMsg
|
||||
AnchorSideBottom.Side = asrCenter
|
||||
Left = 507
|
||||
Height = 14
|
||||
Top = 459
|
||||
Width = 160
|
||||
Anchors = [akRight, akBottom]
|
||||
BorderSpacing.Right = 5
|
||||
Smooth = True
|
||||
Step = 1
|
||||
TabOrder = 2
|
||||
Visible = False
|
||||
end
|
||||
object btnStop: TButton
|
||||
AnchorSideRight.Control = progress
|
||||
AnchorSideBottom.Control = StatusMsg
|
||||
AnchorSideBottom.Side = asrCenter
|
||||
Left = 412
|
||||
Height = 22
|
||||
Top = 455
|
||||
Width = 90
|
||||
Anchors = [akRight, akBottom]
|
||||
BorderSpacing.Right = 5
|
||||
Caption = 'stop'
|
||||
OnClick = btnStopClick
|
||||
TabOrder = 3
|
||||
Visible = False
|
||||
end
|
||||
end
|
||||
object PanelRt: TPanel
|
||||
Left = 672
|
||||
Height = 498
|
||||
Top = 0
|
||||
Width = 281
|
||||
Align = alRight
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 498
|
||||
ClientWidth = 281
|
||||
TabOrder = 1
|
||||
object chkGutter: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 8
|
||||
Width = 68
|
||||
Caption = 'gutter'
|
||||
OnChange = chkGutterChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkRuler: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 28
|
||||
Width = 58
|
||||
Caption = 'ruler'
|
||||
OnChange = chkRulerChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object chkMinimap: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 48
|
||||
Width = 85
|
||||
Caption = 'minimap'
|
||||
OnChange = chkMinimapChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object edSpaceX: TSpinEdit
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 240
|
||||
Width = 52
|
||||
MaxValue = 10
|
||||
MinValue = -5
|
||||
OnChange = edSpaceXChange
|
||||
TabOrder = 8
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 67
|
||||
Height = 17
|
||||
Top = 244
|
||||
Width = 63
|
||||
Caption = 'spacing-x'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 67
|
||||
Height = 17
|
||||
Top = 308
|
||||
Width = 47
|
||||
Caption = 'margin'
|
||||
ParentColor = False
|
||||
end
|
||||
object edMarRt: TSpinEdit
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 304
|
||||
Width = 52
|
||||
MaxValue = 200
|
||||
MinValue = 20
|
||||
OnChange = edMarRtChange
|
||||
TabOrder = 10
|
||||
Value = 20
|
||||
end
|
||||
object gWrap: TGroupBox
|
||||
Left = 144
|
||||
Height = 104
|
||||
Top = 4
|
||||
Width = 128
|
||||
Caption = 'wrap'
|
||||
ClientHeight = 85
|
||||
ClientWidth = 124
|
||||
TabOrder = 11
|
||||
object chkWrapOff: TRadioButton
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 0
|
||||
Width = 46
|
||||
Caption = 'off'
|
||||
Checked = True
|
||||
OnChange = chkWrapOffChange
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
end
|
||||
object chkWrapOn: TRadioButton
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 20
|
||||
Width = 76
|
||||
Caption = 'at edge'
|
||||
OnChange = chkWrapOnChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object chkWrapMargin: TRadioButton
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 40
|
||||
Width = 90
|
||||
Caption = 'at margin'
|
||||
OnChange = chkWrapMarginChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkWrapIndent: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 60
|
||||
Width = 101
|
||||
Caption = 'with indent'
|
||||
OnChange = chkWrapIndentChange
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
object edFontsize: TSpinEdit
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 176
|
||||
Width = 52
|
||||
MaxValue = 40
|
||||
MinValue = 4
|
||||
OnChange = edFontsizeChange
|
||||
TabOrder = 6
|
||||
Value = 10
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 67
|
||||
Height = 17
|
||||
Top = 180
|
||||
Width = 58
|
||||
Caption = 'font size'
|
||||
ParentColor = False
|
||||
end
|
||||
object gUnpri: TGroupBox
|
||||
Left = 144
|
||||
Height = 104
|
||||
Top = 108
|
||||
Width = 128
|
||||
Caption = 'unprintable'
|
||||
ClientHeight = 85
|
||||
ClientWidth = 124
|
||||
TabOrder = 12
|
||||
object chkUnprintVis: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 1
|
||||
Width = 61
|
||||
Caption = 'show'
|
||||
OnChange = chkUnprintVisChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object chkUnprintSp: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 20
|
||||
Width = 72
|
||||
Caption = 'spaces'
|
||||
OnChange = chkUnprintSpChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object chkUnprintEnd: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 40
|
||||
Width = 58
|
||||
Caption = 'ends'
|
||||
OnChange = chkUnprintEndChange
|
||||
TabOrder = 2
|
||||
end
|
||||
object chkUnprintEndDet: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 60
|
||||
Width = 101
|
||||
Caption = 'end-details'
|
||||
OnChange = chkUnprintEndDetChange
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
object edTabsize: TSpinEdit
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 208
|
||||
Width = 52
|
||||
MaxValue = 12
|
||||
MinValue = 1
|
||||
OnChange = edTabsizeChange
|
||||
TabOrder = 7
|
||||
Value = 8
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 67
|
||||
Height = 17
|
||||
Top = 212
|
||||
Width = 52
|
||||
Caption = 'tab size'
|
||||
ParentColor = False
|
||||
end
|
||||
object bFont: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 92
|
||||
Width = 81
|
||||
Caption = 'font...'
|
||||
OnClick = bFontClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object chkMicromap: TCheckBox
|
||||
Left = 8
|
||||
Height = 24
|
||||
Top = 68
|
||||
Width = 95
|
||||
Caption = 'micromap'
|
||||
OnChange = chkMicromapChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object edSpaceY: TSpinEdit
|
||||
Left = 8
|
||||
Height = 27
|
||||
Top = 272
|
||||
Width = 52
|
||||
MaxValue = 10
|
||||
MinValue = -5
|
||||
OnChange = edSpaceYChange
|
||||
TabOrder = 9
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 67
|
||||
Height = 17
|
||||
Top = 276
|
||||
Width = 62
|
||||
Caption = 'spacing-y'
|
||||
ParentColor = False
|
||||
end
|
||||
object bOpt: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 120
|
||||
Width = 81
|
||||
Caption = 'opts...'
|
||||
OnClick = bOptClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Left = 14
|
||||
Height = 151
|
||||
Top = 336
|
||||
Width = 162
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 13
|
||||
Visible = False
|
||||
end
|
||||
object btnMarker: TButton
|
||||
Left = 144
|
||||
Height = 25
|
||||
Top = 224
|
||||
Width = 96
|
||||
Caption = 'marker'
|
||||
OnClick = btnMarkerClick
|
||||
TabOrder = 14
|
||||
end
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
Options = [ofFileMustExist, ofEnableSizing]
|
||||
left = 472
|
||||
top = 20
|
||||
end
|
||||
object FontDialog1: TFontDialog
|
||||
Title = 'Font'
|
||||
MinFontSize = 0
|
||||
MaxFontSize = 0
|
||||
left = 536
|
||||
top = 20
|
||||
end
|
||||
object SaveDialog1: TSaveDialog
|
||||
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
|
||||
left = 504
|
||||
top = 20
|
||||
end
|
||||
object MainMenu1: TMainMenu
|
||||
left = 432
|
||||
top = 80
|
||||
object mnuFile: TMenuItem
|
||||
Caption = 'File'
|
||||
object mnuFileOpen: TMenuItem
|
||||
Caption = 'Open..'
|
||||
ShortCut = 16463
|
||||
OnClick = mnuFileOpenClick
|
||||
end
|
||||
object mnuFileSav: TMenuItem
|
||||
Caption = 'Save..'
|
||||
OnClick = mnuFileSaveClick
|
||||
end
|
||||
object mnuFileEnd: TMenuItem
|
||||
Caption = 'Set ends'
|
||||
object mnuEndWin: TMenuItem
|
||||
Caption = 'win'
|
||||
OnClick = mnuEndWinClick
|
||||
end
|
||||
object mnuEndUnix: TMenuItem
|
||||
Caption = 'unix'
|
||||
OnClick = mnuEndUnixClick
|
||||
end
|
||||
object mnuEndMac: TMenuItem
|
||||
Caption = 'mac'
|
||||
OnClick = mnuEndMacClick
|
||||
end
|
||||
end
|
||||
object mnuFileHtml: TMenuItem
|
||||
Caption = 'Export HTML'
|
||||
OnClick = mnuFileHtmlClick
|
||||
end
|
||||
end
|
||||
object MenuItem9: TMenuItem
|
||||
Caption = 'Search'
|
||||
object mnuFind: TMenuItem
|
||||
Caption = 'find...'
|
||||
ShortCut = 16454
|
||||
OnClick = mnuFindClick
|
||||
end
|
||||
object mnuFindNext: TMenuItem
|
||||
Caption = 'find next'
|
||||
ShortCut = 114
|
||||
OnClick = mnuFindNextClick
|
||||
end
|
||||
object mnuGoto: TMenuItem
|
||||
Caption = 'go to..'
|
||||
ShortCut = 16455
|
||||
OnClick = bGotoClick
|
||||
end
|
||||
end
|
||||
object mnuEnc: TMenuItem
|
||||
Caption = 'Encoding'
|
||||
end
|
||||
object mnuTst: TMenuItem
|
||||
Caption = 'Test'
|
||||
object mnuTCaret1: TMenuItem
|
||||
Caption = 'set 100 cr''s'
|
||||
OnClick = mnuTCaret1Click
|
||||
end
|
||||
object mnuTCaretK: TMenuItem
|
||||
Caption = 'set 2000 cr''s'
|
||||
OnClick = bAddCrtClick
|
||||
end
|
||||
object mnuTMargin: TMenuItem
|
||||
Caption = 'set margins..'
|
||||
OnClick = mnuTMarginClick
|
||||
end
|
||||
object mnuTBms: TMenuItem
|
||||
Caption = 'toggle bookm'
|
||||
OnClick = mnuTBmsClick
|
||||
end
|
||||
object MenuItem5: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object mnuSyntax: TMenuItem
|
||||
Caption = 'hilite syntax'
|
||||
ShortCut = 16467
|
||||
OnClick = mnuSyntaxClick
|
||||
end
|
||||
object mnuUnderline: TMenuItem
|
||||
Caption = 'underline ''www'''
|
||||
OnClick = mnuUnderlineClick
|
||||
end
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object mnuPane: TMenuItem
|
||||
Caption = 'show pane'
|
||||
Checked = True
|
||||
OnClick = mnuPaneClick
|
||||
end
|
||||
object mnuOneLine: TMenuItem
|
||||
Caption = 'combo..'
|
||||
OnClick = mnuOneLineClick
|
||||
end
|
||||
end
|
||||
object mnuOpts: TMenuItem
|
||||
Caption = 'Options'
|
||||
object mnuOptDlg: TMenuItem
|
||||
Caption = 'options..'
|
||||
ShortCut = 120
|
||||
OnClick = bOptClick
|
||||
end
|
||||
object mnuOptSave: TMenuItem
|
||||
Caption = 'save'
|
||||
Visible = False
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
object mnuOptLoad: TMenuItem
|
||||
Caption = 'load'
|
||||
Visible = False
|
||||
OnClick = btnLoadClick
|
||||
end
|
||||
end
|
||||
object mnuHlp: TMenuItem
|
||||
Caption = 'Help'
|
||||
object mnuHelpKey: TMenuItem
|
||||
Caption = 'commands..'
|
||||
ShortCut = 112
|
||||
OnClick = bKeymapClick
|
||||
end
|
||||
object MenuItem2: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object mnuHelpMous: TMenuItem
|
||||
Caption = 'mouse help..'
|
||||
OnClick = mnuHelpMousClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object PopupBookmk: TPopupMenu
|
||||
left = 480
|
||||
top = 104
|
||||
object mnuBms: TMenuItem
|
||||
Caption = 'toggle all bm''s'
|
||||
OnClick = mnuBmsClick
|
||||
end
|
||||
end
|
||||
object PopupNums: TPopupMenu
|
||||
left = 523
|
||||
top = 128
|
||||
object MenuItem3: TMenuItem
|
||||
Caption = 'test nums'
|
||||
Enabled = False
|
||||
end
|
||||
end
|
||||
object PopupFold: TPopupMenu
|
||||
left = 568
|
||||
top = 152
|
||||
object MenuItem4: TMenuItem
|
||||
Caption = 'test fold'
|
||||
Enabled = False
|
||||
end
|
||||
end
|
||||
object PopupMinimap: TPopupMenu
|
||||
left = 448
|
||||
top = 192
|
||||
object MenuItem6: TMenuItem
|
||||
Caption = 'minimap'
|
||||
Enabled = False
|
||||
end
|
||||
end
|
||||
object PopupMicromap: TPopupMenu
|
||||
left = 496
|
||||
top = 216
|
||||
object MenuItem7: TMenuItem
|
||||
Caption = 'micromap'
|
||||
Enabled = False
|
||||
end
|
||||
end
|
||||
object PopupRuler: TPopupMenu
|
||||
left = 552
|
||||
top = 240
|
||||
object MenuItem8: TMenuItem
|
||||
Caption = 'ruler'
|
||||
Enabled = False
|
||||
end
|
||||
end
|
||||
object TimerHint: TTimer
|
||||
Enabled = False
|
||||
Interval = 5500
|
||||
OnTimer = TimerHintTimer
|
||||
left = 560
|
||||
top = 303
|
||||
end
|
||||
object ApplicationProperties1: TApplicationProperties
|
||||
ShowButtonGlyphs = sbgNever
|
||||
ShowMenuGlyphs = sbgNever
|
||||
left = 548
|
||||
top = 366
|
||||
end
|
||||
end
|
||||
1249
ATSynEdit/app/demo_editor/formmain.pas
Normal file
1249
ATSynEdit/app/demo_editor/formmain.pas
Normal file
File diff suppressed because it is too large
Load Diff
1174
ATSynEdit/app/demo_editor/formopt.lfm
Normal file
1174
ATSynEdit/app/demo_editor/formopt.lfm
Normal file
File diff suppressed because it is too large
Load Diff
474
ATSynEdit/app/demo_editor/formopt.pas
Normal file
474
ATSynEdit/app/demo_editor/formopt.pas
Normal file
@@ -0,0 +1,474 @@
|
||||
unit formopt;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ButtonPanel, Spin, ComCtrls, ATSynEdit, ATSynEdit_CanvasProc;
|
||||
|
||||
type
|
||||
{ TfmOpt }
|
||||
|
||||
TfmOpt = class(TForm)
|
||||
bColDown: TButton;
|
||||
bColUp: TButton;
|
||||
ButtonPanel1: TButtonPanel;
|
||||
chkCrBlinkEn: TCheckBox;
|
||||
chkMsNormalSel: TCheckBox;
|
||||
chkMsColumnSel: TCheckBox;
|
||||
chkUnprintArrowDown: TCheckBox;
|
||||
chkShowFullHilite: TCheckBox;
|
||||
chkMsHideCursor: TCheckBox;
|
||||
chkLeftRtSwapAndSel: TCheckBox;
|
||||
chkGutterSep: TCheckBox;
|
||||
chkGutterNumAuto: TCheckBox;
|
||||
chkGutterBm: TCheckBox;
|
||||
chkGutterEmpty: TCheckBox;
|
||||
chkGutterFold: TCheckBox;
|
||||
chkGutterNum: TCheckBox;
|
||||
chkGutterStat: TCheckBox;
|
||||
chkShowFoldLinesAll: TCheckBox;
|
||||
chkBackspUnindent: TCheckBox;
|
||||
chkEnterIndent: TCheckBox;
|
||||
chkMsMenuDown: TCheckBox;
|
||||
chkTabIndent: TCheckBox;
|
||||
chkUnindentKeepAlign: TCheckBox;
|
||||
chkUnprintAsciiRep: TCheckBox;
|
||||
chkShowFoldLines: TCheckBox;
|
||||
chkShowFoldAlways: TCheckBox;
|
||||
chkCrPreferLeft: TCheckBox;
|
||||
chkKeepCol: TCheckBox;
|
||||
chkCurLineMin: TCheckBox;
|
||||
chkScrollHint: TCheckBox;
|
||||
chkPageKeepRel: TCheckBox;
|
||||
chkNavHomeEnd: TCheckBox;
|
||||
chkMsNiceScroll: TCheckBox;
|
||||
chkSaveEol: TCheckBox;
|
||||
chkSaveTrim: TCheckBox;
|
||||
chkShowNum1st: TCheckBox;
|
||||
chkShowNumCr: TCheckBox;
|
||||
chkMapSelBorder: TCheckBox;
|
||||
chkMapSelAlways: TCheckBox;
|
||||
chkShowNumBg: TCheckBox;
|
||||
chkTabSpaces: TCheckBox;
|
||||
chkUndoSv: TCheckBox;
|
||||
chkUndoGr: TCheckBox;
|
||||
chkCutNoSel: TCheckBox;
|
||||
chkDotLn: TCheckBox;
|
||||
chkMsClickNumSel: TCheckBox;
|
||||
chkCrStopUnfocus: TCheckBox;
|
||||
chkEndNonspace: TCheckBox;
|
||||
chkHomeNonspace: TCheckBox;
|
||||
chkLeftRtSwap: TCheckBox;
|
||||
chkNavUpDown: TCheckBox;
|
||||
chkOvrSel: TCheckBox;
|
||||
chkMsRtClickMove: TCheckBox;
|
||||
chkMsDragDrop: TCheckBox;
|
||||
chkCrMul: TCheckBox;
|
||||
chkCrVirt: TCheckBox;
|
||||
chkMsClick2: TCheckBox;
|
||||
chkMsClick2Drag: TCheckBox;
|
||||
chkMsClick3: TCheckBox;
|
||||
chkShowFullSel: TCheckBox;
|
||||
chkCopyNoSel: TCheckBox;
|
||||
chkCurCol: TCheckBox;
|
||||
chkCurLine: TCheckBox;
|
||||
chkLastOnTop: TCheckBox;
|
||||
chkOvrPaste: TCheckBox;
|
||||
chkUnprintEnd: TCheckBox;
|
||||
chkUnprintEndDet: TCheckBox;
|
||||
chkUnprintSpace: TCheckBox;
|
||||
chkUnprintEn: TCheckBox;
|
||||
edMapCharWidth: TSpinEdit;
|
||||
edNumAlign: TComboBox;
|
||||
edIndentKind: TComboBox;
|
||||
edCrShape: TComboBox;
|
||||
edCrShape2: TComboBox;
|
||||
edCrTime: TSpinEdit;
|
||||
edSizeSep: TSpinEdit;
|
||||
edWordChars: TEdit;
|
||||
edIndentSize: TSpinEdit;
|
||||
edPlusSize: TSpinEdit;
|
||||
edNumChar: TEdit;
|
||||
edNumStyle: TComboBox;
|
||||
edPageSize: TComboBox;
|
||||
edRulerFSize: TSpinEdit;
|
||||
edRulerIndent: TSpinEdit;
|
||||
edRulerSize: TSpinEdit;
|
||||
edSizeBm: TSpinEdit;
|
||||
edSizeEmpty: TSpinEdit;
|
||||
edSizeFold: TSpinEdit;
|
||||
edSizeNum1: TSpinEdit;
|
||||
edSizeNum2: TSpinEdit;
|
||||
edSizeNum: TSpinEdit;
|
||||
edSizeState: TSpinEdit;
|
||||
edTabArrowSize: TSpinEdit;
|
||||
edTabArrowPnt: TSpinEdit;
|
||||
edTextHint: TEdit;
|
||||
GroupBox1: TGroupBox;
|
||||
GroupBox2: TGroupBox;
|
||||
groupIndent: TGroupBox;
|
||||
LabChars: TLabel;
|
||||
Label1: TLabel;
|
||||
Label10: TLabel;
|
||||
Label12: TLabel;
|
||||
Label13: TLabel;
|
||||
Label14: TLabel;
|
||||
Label15: TLabel;
|
||||
Label16: TLabel;
|
||||
Label17: TLabel;
|
||||
Label18: TLabel;
|
||||
Label19: TLabel;
|
||||
Label2: TLabel;
|
||||
Label20: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Label7: TLabel;
|
||||
Label8: TLabel;
|
||||
Label9: TLabel;
|
||||
LabelArr: TLabel;
|
||||
LabelArr1: TLabel;
|
||||
LabelHint: TLabel;
|
||||
ListCol: TListBox;
|
||||
ListShapes: TListBox;
|
||||
PageControl1: TPageControl;
|
||||
edUndo: TSpinEdit;
|
||||
edNumSize: TSpinEdit;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
TabSheet3: TTabSheet;
|
||||
TabSheet4: TTabSheet;
|
||||
TabSheet5: TTabSheet;
|
||||
TabSheet6: TTabSheet;
|
||||
TabSheet7: TTabSheet;
|
||||
TabSheet8: TTabSheet;
|
||||
TabSheet9: TTabSheet;
|
||||
procedure bColDownClick(Sender: TObject);
|
||||
procedure bColUpClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
procedure InitShape(ed: TCombobox);
|
||||
end;
|
||||
|
||||
var
|
||||
fmOpt: TfmOpt;
|
||||
|
||||
procedure DoConfigEditor(ed: TATSynEdit);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
nameBm = 'bookmk';
|
||||
nameNums = 'nums';
|
||||
nameState = 'states';
|
||||
nameFold = 'fold';
|
||||
nameSep = 'separator';
|
||||
|
||||
procedure DoConfigEditor(ed: TATSynEdit);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
with fmOpt do
|
||||
begin
|
||||
with ListCol do
|
||||
begin
|
||||
Items.Clear;
|
||||
for i:= 0 to 4 do
|
||||
begin
|
||||
if i=ed.GutterBandBm then Items.Add(nameBm);
|
||||
if i=ed.GutterBandNum then Items.Add(nameNums);
|
||||
if i=ed.GutterBandState then Items.Add(nameState);
|
||||
if i=ed.GutterBandFold then Items.Add(nameFold);
|
||||
if i=ed.GutterBandSep then Items.Add(nameSep);
|
||||
end;
|
||||
ItemIndex:= 0;
|
||||
end;
|
||||
|
||||
//general
|
||||
chkCurLine.Checked:= ed.OptShowCurLine;
|
||||
chkCurLineMin.Checked:= ed.OptShowCurLineMinimal;
|
||||
chkCurCol.Checked:= ed.OptShowCurColumn;
|
||||
chkLastOnTop.Checked:= ed.OptLastLineOnTop;
|
||||
chkShowFullSel.Checked:= ed.OptShowFullSel;
|
||||
chkShowFullHilite.Checked:= ed.OptShowFullHilite;
|
||||
chkCopyNoSel.Checked:= ed.OptCopyLinesIfNoSel;
|
||||
chkCutNoSel.Checked:= ed.OptCutLinesIfNoSel;
|
||||
chkOvrPaste.Checked:= ed.OptOverwriteAllowedOnPaste;
|
||||
chkDotLn.Checked:= ed.OptShowIndentLines;
|
||||
edTextHint.Text:= ed.OptTextHint;
|
||||
edWordChars.Text:= ed.OptWordChars;
|
||||
chkSaveEol.Checked:= ed.OptSavingForceFinalEol;
|
||||
chkSaveTrim.Checked:= ed.OptSavingTrimSpaces;
|
||||
chkScrollHint.Checked:= ed.OptShowScrollHint;
|
||||
|
||||
//unprint
|
||||
chkUnprintEn.Checked:= ed.OptUnprintedVisible;
|
||||
chkUnprintSpace.Checked:= ed.OptUnprintedSpaces;
|
||||
chkUnprintEnd.Checked:= ed.OptUnprintedEnds;
|
||||
chkUnprintEndDet.Checked:= ed.OptUnprintedEndsDetails;
|
||||
chkUnprintArrowDown.Checked:= OptUnprintedEndArrowOrDot;
|
||||
chkUnprintAsciiRep.Checked:= ed.OptUnprintedReplaceSpec;
|
||||
edTabArrowSize.Value:= OptUnprintedTabCharLength;
|
||||
edTabArrowPnt.Value:= OptUnprintedTabPointerScale;
|
||||
|
||||
//caret
|
||||
chkCrBlinkEn.Checked:= ed.OptCaretBlinkEnabled;
|
||||
edCrTime.Value:= ed.OptCaretBlinkTime;
|
||||
chkCrVirt.Checked:= ed.OptCaretVirtual;
|
||||
chkCrMul.Checked:= ed.OptCaretManyAllowed;
|
||||
chkCrStopUnfocus.Checked:= ed.OptCaretStopUnfocused;
|
||||
chkCrPreferLeft.Checked:= ed.OptCaretPreferLeftSide;
|
||||
edCrShape.ItemIndex:= Ord(ed.OptCaretShape);
|
||||
edCrShape2.ItemIndex:= Ord(ed.OptCaretShapeOvr);
|
||||
|
||||
//gutter
|
||||
edNumStyle.ItemIndex:= Ord(ed.OptNumbersStyle);
|
||||
edNumAlign.ItemIndex:= Ord(ed.OptNumbersAlignment);
|
||||
edNumSize.Value:= ed.OptNumbersFontSize;
|
||||
edNumChar.Text:= ed.OptNumbersSkippedChar;
|
||||
edPlusSize.Value:= ed.OptGutterPlusSize;
|
||||
chkShowNum1st.Checked:= ed.OptNumbersShowFirst;
|
||||
chkShowNumCr.Checked:= ed.OptNumbersShowCarets;
|
||||
chkShowNumBg.Checked:= ed.OptShowGutterCaretBG;
|
||||
chkShowFoldAlways.Checked:= ed.OptGutterShowFoldAlways;
|
||||
chkShowFoldLines.Checked:= ed.OptGutterShowFoldLines;
|
||||
chkShowFoldLinesAll.Checked:= ed.OptGutterShowFoldLinesAll;
|
||||
edRulerSize.Value:= ed.OptRulerSize;
|
||||
edRulerFSize.Value:= ed.OptRulerFontSize;
|
||||
edRulerIndent.Value:= ed.OptRulerTextIndent;
|
||||
|
||||
chkGutterBm.Checked:= ed.Gutter[ed.GutterBandBm].Visible;
|
||||
chkGutterNum.Checked:= ed.Gutter[ed.GutterBandNum].Visible;
|
||||
chkGutterFold.Checked:= ed.Gutter[ed.GutterBandFold].Visible;
|
||||
chkGutterStat.Checked:= ed.Gutter[ed.GutterBandState].Visible;
|
||||
chkGutterSep.Checked:= ed.Gutter[ed.GutterBandSep].Visible;
|
||||
chkGutterEmpty.Checked:= ed.Gutter[ed.GutterBandEmpty].Visible;
|
||||
edSizeBm.Value:= ed.Gutter[ed.GutterBandBm].Size;
|
||||
edSizeFold.Value:= ed.Gutter[ed.GutterBandFold].Size;
|
||||
edSizeState.Value:= ed.Gutter[ed.GutterBandState].Size;
|
||||
edSizeSep.Value:= ed.Gutter[ed.GutterBandSep].Size;
|
||||
edSizeEmpty.Value:= ed.Gutter[ed.GutterBandEmpty].Size;
|
||||
edSizeNum.Value:= ed.Gutter[ed.GutterBandNum].Size;
|
||||
edSizeNum1.Value:= ed.OptNumbersIndentLeft;
|
||||
edSizeNum2.Value:= ed.OptNumbersIndentRight;
|
||||
chkGutterNumAuto.Checked:= ed.OptNumbersAutosize;
|
||||
|
||||
//minimap
|
||||
edMapCharWidth.Value:= ed.OptMinimapCharWidth;
|
||||
chkMapSelBorder.Checked:= ed.OptMinimapShowSelBorder;
|
||||
chkMapSelAlways.Checked:= ed.OptMinimapShowSelAlways;
|
||||
|
||||
//key
|
||||
chkTabSpaces.Checked:= ed.OptTabSpaces;
|
||||
chkOvrSel.Checked:= ed.OptOverwriteSel;
|
||||
chkNavUpDown.Checked:= ed.OptKeyUpDownNavigateWrapped;
|
||||
chkNavHomeEnd.Checked:= ed.OptKeyHomeEndNavigateWrapped;
|
||||
chkKeepCol.Checked:= ed.OptKeyUpDownKeepColumn;
|
||||
chkLeftRtSwap.Checked:= ed.OptKeyLeftRightSwapSel;
|
||||
chkLeftRtSwapAndSel.Checked:= ed.OptKeyLeftRightSwapSelAndSelect;
|
||||
chkHomeNonspace.Checked:= ed.OptKeyHomeToNonSpace;
|
||||
chkEndNonspace.Checked:= ed.OptKeyEndToNonSpace;
|
||||
chkTabIndent.Checked:= ed.OptKeyTabIndents;
|
||||
chkEnterIndent.Checked:= ed.OptAutoIndent;
|
||||
chkBackspUnindent.Checked:= ed.OptKeyBackspaceUnindent;
|
||||
edIndentKind.ItemIndex:= Ord(ed.OptAutoIndentKind);
|
||||
edIndentSize.Value:= ed.OptIndentSize;
|
||||
chkUnindentKeepAlign.Checked:= ed.OptIndentKeepsAlign;
|
||||
edPageSize.ItemIndex:= Ord(ed.OptKeyPageUpDownSize);
|
||||
chkPageKeepRel.Checked:= ed.OptKeyPageKeepsRelativePos;
|
||||
|
||||
//mouse
|
||||
chkMsNormalSel.Checked:= ed.OptMouseEnableNormalSelection;
|
||||
chkMsColumnSel.Checked:= ed.OptMouseEnableColumnSelection;
|
||||
chkMsClick2.Checked:= ed.OptMouse2ClickSelectsLine;
|
||||
chkMsClick3.Checked:= ed.OptMouse3ClickSelectsLine;
|
||||
chkMsClick2Drag.Checked:= ed.OptMouse2ClickDragSelectsWords;
|
||||
chkMsClickNumSel.Checked:= ed.OptMouseGutterClickSelectsLine;
|
||||
chkMsDragDrop.Checked:= ed.OptMouseDragDrop;
|
||||
chkMsRtClickMove.Checked:= ed.OptMouseRightClickMovesCaret;
|
||||
chkMsNiceScroll.Checked:= ed.OptMouseNiceScroll;
|
||||
chkMsHideCursor.Checked:= ed.OptMouseHideCursorOnType;
|
||||
chkMsMenuDown.Checked:= ed.OptMouseDownForPopup;
|
||||
|
||||
//undo
|
||||
edUndo.Value:= ed.OptUndoLimit;
|
||||
chkUndoGr.Checked:= ed.OptUndoGrouped;
|
||||
chkUndoSv.Checked:= ed.OptUndoAfterSave;
|
||||
|
||||
if ShowModal=mrOk then
|
||||
begin
|
||||
ed.GutterBandBm:= ListCol.Items.IndexOf(nameBm);
|
||||
ed.GutterBandNum:= ListCol.Items.IndexOf(nameNums);
|
||||
ed.GutterBandState:= ListCol.Items.IndexOf(nameState);
|
||||
ed.GutterBandFold:= ListCol.Items.IndexOf(nameFold);
|
||||
ed.GutterBandSep:= ListCol.Items.IndexOf(nameSep);
|
||||
|
||||
//general
|
||||
ed.OptShowCurLine:= chkCurLine.Checked;
|
||||
ed.OptShowCurLineMinimal:= chkCurLineMin.Checked;
|
||||
ed.OptShowCurColumn:= chkCurCol.Checked;
|
||||
ed.OptTextHint:= edTextHint.Text;
|
||||
ed.OptWordChars:= edWordChars.Text;
|
||||
ed.OptOverwriteAllowedOnPaste:= chkOvrPaste.Checked;
|
||||
ed.OptCopyLinesIfNoSel:= chkCopyNoSel.Checked;
|
||||
ed.OptCutLinesIfNoSel:= chkCutNoSel.Checked;
|
||||
ed.OptShowFullSel:= chkShowFullSel.Checked;
|
||||
ed.OptShowFullHilite:= chkShowFullHilite.Checked;
|
||||
ed.OptLastLineOnTop:= chkLastOnTop.Checked;
|
||||
ed.OptShowIndentLines:= chkDotLn.Checked;
|
||||
ed.OptSavingForceFinalEol:= chkSaveEol.Checked;
|
||||
ed.OptSavingTrimSpaces:= chkSaveTrim.Checked;
|
||||
ed.OptShowScrollHint:= chkScrollHint.Checked;
|
||||
|
||||
//unprint
|
||||
ed.OptUnprintedVisible:= chkUnprintEn.Checked;
|
||||
ed.OptUnprintedSpaces:= chkUnprintSpace.Checked;
|
||||
ed.OptUnprintedEnds:= chkUnprintEnd.Checked;
|
||||
ed.OptUnprintedEndsDetails:= chkUnprintEndDet.Checked;
|
||||
ed.OptUnprintedReplaceSpec:= chkUnprintAsciiRep.Checked;
|
||||
OptUnprintedTabCharLength:= edTabArrowSize.Value;
|
||||
OptUnprintedTabPointerScale:= edTabArrowPnt.Value;
|
||||
OptUnprintedEndArrowOrDot:= chkUnprintArrowDown.Checked;
|
||||
|
||||
//caret
|
||||
ed.OptCaretBlinkEnabled:= chkCrBlinkEn.Checked;
|
||||
ed.OptCaretBlinkTime:= edCrTime.Value;
|
||||
ed.OptCaretShape:= TATSynCaretShape(edCrShape.ItemIndex);
|
||||
ed.OptCaretShapeOvr:= TATSynCaretShape(edCrShape2.ItemIndex);
|
||||
ed.OptCaretVirtual:= chkCrVirt.Checked;
|
||||
ed.OptCaretManyAllowed:= chkCrMul.Checked;
|
||||
ed.OptCaretStopUnfocused:= chkCrStopUnfocus.Checked;
|
||||
ed.OptCaretPreferLeftSide:= chkCrPreferLeft.Checked;
|
||||
|
||||
//gutter
|
||||
ed.OptNumbersFontSize:= edNumSize.Value;
|
||||
ed.OptNumbersStyle:= TATSynNumbersStyle(edNumStyle.ItemIndex);
|
||||
ed.OptNumbersAlignment:= TAlignment(edNumAlign.ItemIndex);
|
||||
ed.OptNumbersShowFirst:= chkShowNum1st.Checked;
|
||||
ed.OptNumbersShowCarets:= chkShowNumCr.Checked;
|
||||
ed.OptNumbersSkippedChar:= edNumChar.Text;
|
||||
ed.OptGutterShowFoldAlways:= chkShowFoldAlways.Checked;
|
||||
ed.OptGutterShowFoldLines:= chkShowFoldLines.Checked;
|
||||
ed.OptGutterShowFoldLinesAll:= chkShowFoldLinesAll.Checked;
|
||||
ed.OptGutterPlusSize:= edPlusSize.Value;
|
||||
ed.OptShowGutterCaretBG:= chkShowNumBg.Checked;
|
||||
ed.OptRulerSize:= edRulerSize.Value;
|
||||
ed.OptRulerFontSize:= edRulerFSize.Value;
|
||||
ed.OptRulerTextIndent:= edRulerIndent.Value;
|
||||
|
||||
ed.Gutter[ed.GutterBandBm].Visible:= chkGutterBm.Checked;
|
||||
ed.Gutter[ed.GutterBandNum].Visible:= chkGutterNum.Checked;
|
||||
ed.Gutter[ed.GutterBandFold].Visible:= chkGutterFold.Checked;
|
||||
ed.Gutter[ed.GutterBandState].Visible:= chkGutterStat.Checked;
|
||||
ed.Gutter[ed.GutterBandSep].Visible:= chkGutterSep.Checked;
|
||||
ed.Gutter[ed.GutterBandEmpty].Visible:= chkGutterEmpty.Checked;
|
||||
ed.Gutter[ed.GutterBandBm].Size:= edSizeBm.Value;
|
||||
ed.Gutter[ed.GutterBandNum].Size:= edSizeNum.Value;
|
||||
ed.Gutter[ed.GutterBandFold].Size:= edSizeFold.Value;
|
||||
ed.Gutter[ed.GutterBandState].Size:= edSizeState.Value;
|
||||
ed.Gutter[ed.GutterBandSep].Size:= edSizeSep.Value;
|
||||
ed.Gutter[ed.GutterBandEmpty].Size:= edSizeEmpty.Value;
|
||||
ed.OptNumbersAutosize:= chkGutterNumAuto.Checked;
|
||||
ed.OptNumbersIndentLeft:= edSizeNum1.Value;
|
||||
ed.OptNumbersIndentRight:= edSizeNum2.Value;
|
||||
|
||||
//minimap
|
||||
ed.OptMinimapCharWidth:= edMapCharWidth.Value;
|
||||
ed.OptMinimapShowSelBorder:= chkMapSelBorder.Checked;
|
||||
ed.OptMinimapShowSelAlways:= chkMapSelAlways.Checked;
|
||||
|
||||
//key
|
||||
ed.OptTabSpaces:= chkTabSpaces.Checked;
|
||||
ed.OptOverwriteSel:= chkOvrSel.Checked;
|
||||
ed.OptKeyUpDownKeepColumn:= chkKeepCol.Checked;
|
||||
ed.OptKeyUpDownNavigateWrapped:= chkNavUpDown.Checked;
|
||||
ed.OptKeyHomeEndNavigateWrapped:= chkNavHomeEnd.Checked;
|
||||
ed.OptKeyPageUpDownSize:= TATPageUpDownSize(edPageSize.ItemIndex);
|
||||
ed.OptKeyLeftRightSwapSel:= chkLeftRtSwap.Checked;
|
||||
ed.OptKeyLeftRightSwapSelAndSelect:= chkLeftRtSwapAndSel.Checked;
|
||||
ed.OptKeyHomeToNonSpace:= chkHomeNonspace.Checked;
|
||||
ed.OptKeyEndToNonSpace:= chkEndNonspace.Checked;
|
||||
ed.OptKeyPageKeepsRelativePos:= chkPageKeepRel.Checked;
|
||||
ed.OptKeyTabIndents:= chkTabIndent.Checked;
|
||||
ed.OptAutoIndent:= chkEnterIndent.Checked;
|
||||
ed.OptKeyBackspaceUnindent := chkBackspUnindent.Checked;
|
||||
ed.OptAutoIndentKind:= TATAutoIndentKind(edIndentKind.ItemIndex);
|
||||
ed.OptIndentSize:= edIndentSize.Value;
|
||||
ed.OptIndentKeepsAlign:= chkUnindentKeepAlign.Checked;
|
||||
|
||||
//mouse
|
||||
ed.OptMouseEnableNormalSelection:= chkMsNormalSel.Checked;
|
||||
ed.OptMouseEnableColumnSelection:= chkMsColumnSel.Checked;
|
||||
ed.OptMouse2ClickSelectsLine:= chkMsClick2.Checked;
|
||||
ed.OptMouse3ClickSelectsLine:= chkMsClick3.Checked;
|
||||
ed.OptMouse2ClickDragSelectsWords:= chkMsClick2Drag.Checked;
|
||||
ed.OptMouseGutterClickSelectsLine:= chkMsClickNumSel.Checked;
|
||||
ed.OptMouseDragDrop:= chkMsDragDrop.Checked;
|
||||
ed.OptMouseRightClickMovesCaret:= chkMsRtClickMove.Checked;
|
||||
ed.OptMouseNiceScroll:= chkMsNiceScroll.Checked;
|
||||
ed.OptMouseHideCursorOnType:= chkMsHideCursor.Checked;
|
||||
ed.OptMouseDownForPopup:= chkMsMenuDown.Checked;
|
||||
|
||||
//undo
|
||||
ed.OptUndoLimit:= edUndo.Value;
|
||||
ed.OptUndoGrouped:= chkUndoGr.Checked;
|
||||
ed.OptUndoAfterSave:= chkUndoSv.Checked;
|
||||
|
||||
//apply
|
||||
ed.Gutter.Update;
|
||||
ed.Update;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TfmOpt }
|
||||
|
||||
procedure TfmOpt.FormCreate(Sender: TObject);
|
||||
begin
|
||||
InitShape(edCrShape);
|
||||
InitShape(edCrShape2);
|
||||
end;
|
||||
|
||||
procedure SwapItems(L: TListbox; n1, n2: integer);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
s:= L.Items[n1];
|
||||
L.Items[n1]:= L.Items[n2];
|
||||
L.Items[n2]:= s;
|
||||
L.ItemIndex:= n2;
|
||||
end;
|
||||
|
||||
procedure TfmOpt.bColUpClick(Sender: TObject);
|
||||
begin
|
||||
with ListCol do
|
||||
if ItemIndex>0 then
|
||||
SwapItems(ListCol, ItemIndex, ItemIndex-1);
|
||||
end;
|
||||
|
||||
procedure TfmOpt.bColDownClick(Sender: TObject);
|
||||
begin
|
||||
with ListCol do
|
||||
if ItemIndex<Count-1 then
|
||||
SwapItems(ListCol, ItemIndex, ItemIndex+1);
|
||||
end;
|
||||
|
||||
procedure TfmOpt.InitShape(ed: TCombobox);
|
||||
begin
|
||||
ed.Items.Clear;
|
||||
ed.Items.AddStrings(ListShapes.Items);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
106
ATSynEdit/app/demo_load/project1.lpi
Normal file
106
ATSynEdit/app/demo_load/project1.lpi
Normal file
@@ -0,0 +1,106 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\atsynedit\atsynedit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\atsynedit\atstrings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
20
ATSynEdit/app/demo_load/project1.lpr
Normal file
20
ATSynEdit/app/demo_load/project1.lpr
Normal file
@@ -0,0 +1,20 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, atstrings, atsynedit;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
68
ATSynEdit/app/demo_load/unit1.lfm
Normal file
68
ATSynEdit/app/demo_load/unit1.lfm
Normal file
@@ -0,0 +1,68 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 222
|
||||
Height = 442
|
||||
Top = 254
|
||||
Width = 932
|
||||
Caption = 'App'
|
||||
ClientHeight = 442
|
||||
ClientWidth = 932
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
LCLVersion = '1.5'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 442
|
||||
Top = 0
|
||||
Width = 626
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
Caption = 'Panel1'
|
||||
TabOrder = 0
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 632
|
||||
Height = 442
|
||||
Top = 0
|
||||
Width = 300
|
||||
Align = alRight
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 442
|
||||
ClientWidth = 300
|
||||
TabOrder = 1
|
||||
object bGettext: TButton
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 400
|
||||
Width = 80
|
||||
Caption = 'Get text'
|
||||
OnClick = bGettextClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object List: TShellListView
|
||||
Left = 0
|
||||
Height = 442
|
||||
Top = 0
|
||||
Width = 300
|
||||
Align = alClient
|
||||
Color = clWhite
|
||||
HideSelection = False
|
||||
ReadOnly = True
|
||||
RowSelect = True
|
||||
SortColumn = 0
|
||||
SortType = stText
|
||||
TabOrder = 1
|
||||
ViewStyle = vsSmallIcon
|
||||
OnClick = ListClick
|
||||
ObjectTypes = [otNonFolders]
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 626
|
||||
Height = 442
|
||||
Top = 0
|
||||
Width = 6
|
||||
Align = alRight
|
||||
Beveled = True
|
||||
ResizeAnchor = akRight
|
||||
end
|
||||
end
|
||||
76
ATSynEdit/app/demo_load/unit1.pas
Normal file
76
ATSynEdit/app/demo_load/unit1.pas
Normal file
@@ -0,0 +1,76 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ExtCtrls, ShellCtrls, atstrings, atsynedit, atstringproc;
|
||||
|
||||
type
|
||||
{ TfmMain }
|
||||
TfmMain = class(TForm)
|
||||
bGettext: TButton;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
List: TShellListView;
|
||||
Splitter1: TSplitter;
|
||||
procedure bGettextClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure ListClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
fDir: string;
|
||||
ed: TATSynEdit;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmMain: TfmMain;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
procedure TfmMain.FormCreate(Sender: TObject);
|
||||
begin
|
||||
ed:= TATSynEdit.Create(Self);
|
||||
ed.Parent:= Panel1;
|
||||
ed.Align:= alClient;
|
||||
ed.Font.Name:= 'Courier New';
|
||||
ed.OptUnprintedVisible:= false;
|
||||
ed.OptRulerVisible:= false;
|
||||
ed.OptWrapMode:= cWrapOff;
|
||||
|
||||
fDir:= ExtractFilePath(Application.Exename)+'../../test_files';
|
||||
end;
|
||||
|
||||
procedure TfmMain.FormShow(Sender: TObject);
|
||||
begin
|
||||
List.Root:= fDir;
|
||||
end;
|
||||
|
||||
procedure TfmMain.ListClick(Sender: TObject);
|
||||
var
|
||||
s: string;
|
||||
begin
|
||||
s:= List.GetPathFromItem(List.Selected);
|
||||
if not FileExistsUTF8(s) then Exit;
|
||||
|
||||
ed.LoadFromFile(s);
|
||||
ed.SetFocus;
|
||||
Caption:= 'App - '+ExtractFileName(s);
|
||||
end;
|
||||
|
||||
procedure TfmMain.bGettextClick(Sender: TObject);
|
||||
begin
|
||||
ShowMessage(UTF8Encode(ed.Strings.TextString));
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
98
ATSynEdit/app/demo_simplest/demo.lpi
Normal file
98
ATSynEdit/app/demo_simplest/demo.lpi
Normal file
@@ -0,0 +1,98 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
ATSynEdit/app/demo_simplest/demo.lpr
Normal file
22
ATSynEdit/app/demo_simplest/demo.lpr
Normal file
@@ -0,0 +1,22 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Title:= 'Demo';
|
||||
RequireDerivedFormResource:= True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
10
ATSynEdit/app/demo_simplest/unit1.lfm
Normal file
10
ATSynEdit/app/demo_simplest/unit1.lfm
Normal file
@@ -0,0 +1,10 @@
|
||||
object Form1: TForm1
|
||||
Left = 260
|
||||
Height = 391
|
||||
Top = 262
|
||||
Width = 690
|
||||
Caption = 'Demo'
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.4.0.4'
|
||||
end
|
||||
52
ATSynEdit/app/demo_simplest/unit1.pas
Normal file
52
ATSynEdit/app/demo_simplest/unit1.pas
Normal file
@@ -0,0 +1,52 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ATSynEdit, ATSynEdit_Keymap_Init;
|
||||
|
||||
type
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
ed: TATSynEdit;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
ed:= TATSynEdit.Create(Self);
|
||||
ed.Parent:= Self;
|
||||
ed.Font.Name:= 'Courier New';
|
||||
ed.Align:= alClient;
|
||||
ed.OptUnprintedVisible:= false;
|
||||
ed.OptRulerVisible:= false;
|
||||
ed.Colors.TextBG:= $e0f0f0;
|
||||
ed.LoadFromFile(ExtractFilePath(Application.ExeName)+'unit1.pas');
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
begin
|
||||
ed.OptCaretBlinkEnabled:= not ed.OptCaretBlinkEnabled;
|
||||
ed.SetFocus;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
78
ATSynEdit/app/test_canvasline/demo.lpi
Normal file
78
ATSynEdit/app/test_canvasline/demo.lpi
Normal file
@@ -0,0 +1,78 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
19
ATSynEdit/app/test_canvasline/demo.lpr
Normal file
19
ATSynEdit/app/test_canvasline/demo.lpr
Normal file
@@ -0,0 +1,19 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1
|
||||
{ you can add units after this };
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
20
ATSynEdit/app/test_canvasline/unit1.lfm
Normal file
20
ATSynEdit/app/test_canvasline/unit1.lfm
Normal file
@@ -0,0 +1,20 @@
|
||||
object Form1: TForm1
|
||||
Left = 456
|
||||
Height = 278
|
||||
Top = 453
|
||||
Width = 500
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 278
|
||||
ClientWidth = 500
|
||||
OnPaint = FormPaint
|
||||
LCLVersion = '1.5'
|
||||
object Button1: TButton
|
||||
Left = 154
|
||||
Height = 25
|
||||
Top = 68
|
||||
Width = 75
|
||||
Caption = 'close'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
58
ATSynEdit/app/test_canvasline/unit1.pas
Normal file
58
ATSynEdit/app/test_canvasline/unit1.pas
Normal file
@@ -0,0 +1,58 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure FormPaint(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormPaint(Sender: TObject);
|
||||
var
|
||||
c: tcanvas;
|
||||
begin
|
||||
c:= self.canvas;
|
||||
c.brush.color:= clyellow;
|
||||
c.fillrect(0, 0, 200, 200);
|
||||
|
||||
c.pen.color:= clred;
|
||||
c.line(10,10,30,10);
|
||||
c.line(30,10,50,10);
|
||||
c.line(50,10,80,10);
|
||||
|
||||
c.line(10,10,10,30);
|
||||
c.line(10,30,10,50);
|
||||
c.line(10,50,10,80);
|
||||
end;
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
begin
|
||||
close;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
105
ATSynEdit/app/test_designtime/demo.lpi
Normal file
105
ATSynEdit/app/test_designtime/demo.lpi
Normal file
@@ -0,0 +1,105 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="demo"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="atsynedit_package"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\atsynedit\atsynedit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATSynEdit"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
ATSynEdit/app/test_designtime/demo.lpr
Normal file
21
ATSynEdit/app/test_designtime/demo.lpr
Normal file
@@ -0,0 +1,21 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, ATSynEdit
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:= True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
343
ATSynEdit/app/test_designtime/unit1.lfm
Normal file
343
ATSynEdit/app/test_designtime/unit1.lfm
Normal file
@@ -0,0 +1,343 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 359
|
||||
Height = 419
|
||||
Top = 457
|
||||
Width = 685
|
||||
Caption = 'Test'
|
||||
ClientHeight = 419
|
||||
ClientWidth = 685
|
||||
OnShow = FormShow
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object ed: TATSynEdit
|
||||
Left = 6
|
||||
Height = 308
|
||||
Top = 6
|
||||
Width = 673
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
BorderStyle = bsSingle
|
||||
Font.Height = -12
|
||||
Font.Name = 'Courier New'
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
CursorText = crIBeam
|
||||
CursorBm = crHandPoint
|
||||
Colors.TextFont = clBlack
|
||||
Colors.TextBG = clWhite
|
||||
Colors.TextDisabledFont = clGray
|
||||
Colors.TextDisabledBG = 15790320
|
||||
Colors.TextSelFont = clHighlightText
|
||||
Colors.TextSelBG = clHighlight
|
||||
Colors.Caret = clBlack
|
||||
Colors.GutterFont = clGray
|
||||
Colors.GutterBG = 14737632
|
||||
Colors.GutterCaretBG = 13158600
|
||||
Colors.GutterPlusBorder = clGray
|
||||
Colors.GutterPlusBG = 16053492
|
||||
Colors.GutterFoldLine = clGray
|
||||
Colors.GutterFoldBG = 13158600
|
||||
Colors.GutterSeparatorBG = clBlack
|
||||
Colors.CurrentLineBG = 14741744
|
||||
Colors.MarginRight = clSilver
|
||||
Colors.MarginCaret = clLime
|
||||
Colors.MarginUser = clYellow
|
||||
Colors.IndentVertLines = clMedGray
|
||||
Colors.BookmarkBG = clMoneyGreen
|
||||
Colors.RulerFont = clGray
|
||||
Colors.RulerBG = 14737632
|
||||
Colors.CollapseLine = 10510432
|
||||
Colors.CollapseMarkFont = 14712960
|
||||
Colors.CollapseMarkBG = clWhite
|
||||
Colors.UnprintedFont = 5263600
|
||||
Colors.UnprintedBG = 14737632
|
||||
Colors.UnprintedHexFont = clMedGray
|
||||
Colors.MinimapBorder = clSilver
|
||||
Colors.MinimapSelBG = 15658734
|
||||
Colors.StateChanged = 61680
|
||||
Colors.StateAdded = 2146336
|
||||
Colors.StateSaved = clMedGray
|
||||
Colors.BlockStaple = clMedGray
|
||||
Colors.BlockSepLine = clMedGray
|
||||
Colors.LockedBG = 14737632
|
||||
Colors.TextHintFont = clGray
|
||||
Colors.ComboboxArrow = clGray
|
||||
Colors.ComboboxArrowBG = 15790320
|
||||
WantTabs = True
|
||||
OptTabSpaces = False
|
||||
OptTabSize = 10
|
||||
OptFoldStyle = cFoldHereWithTruncatedText
|
||||
OptTextLocked = 'wait...'
|
||||
OptTextHintFontStyle = [fsItalic]
|
||||
OptTextHintCenter = False
|
||||
OptTextOffsetTop = 0
|
||||
OptTextOffsetFromLine = 1
|
||||
OptAutoIndent = True
|
||||
OptAutoIndentKind = cIndentAsIs
|
||||
OptCopyLinesIfNoSel = True
|
||||
OptCutLinesIfNoSel = False
|
||||
OptLastLineOnTop = False
|
||||
OptOverwriteSel = True
|
||||
OptOverwriteAllowedOnPaste = False
|
||||
OptShowStapleStyle = cLineStyleSolid
|
||||
OptShowStapleIndent = -1
|
||||
OptShowStapleWidthPercent = 100
|
||||
OptShowFullSel = False
|
||||
OptShowFullHilite = True
|
||||
OptShowCurLine = False
|
||||
OptShowCurLineMinimal = True
|
||||
OptShowScrollHint = False
|
||||
OptShowCurColumn = False
|
||||
OptCaretManyAllowed = True
|
||||
OptCaretVirtual = True
|
||||
OptCaretShape = cCaretShapeVertPixels1
|
||||
OptCaretShapeOvr = cCaretShapeFull
|
||||
OptCaretShapeRO = cCaretShapeHorzPixels1
|
||||
OptCaretBlinkTime = 600
|
||||
OptCaretBlinkEnabled = True
|
||||
OptCaretStopUnfocused = True
|
||||
OptCaretPreferLeftSide = True
|
||||
OptGutterVisible = True
|
||||
OptGutterPlusSize = 4
|
||||
OptGutterShowFoldAlways = True
|
||||
OptGutterShowFoldLines = True
|
||||
OptGutterShowFoldLinesAll = False
|
||||
OptRulerVisible = True
|
||||
OptRulerSize = 19
|
||||
OptRulerFontSize = 8
|
||||
OptRulerMarkSizeSmall = 3
|
||||
OptRulerMarkSizeBig = 7
|
||||
OptRulerTextIndent = 0
|
||||
OptMinimapVisible = False
|
||||
OptMinimapCharWidth = 0
|
||||
OptMinimapShowSelBorder = False
|
||||
OptMinimapShowSelAlways = True
|
||||
OptMicromapVisible = False
|
||||
OptMicromapWidth = 30
|
||||
OptCharSpacingX = 0
|
||||
OptCharSpacingY = 1
|
||||
OptWrapMode = cWrapOn
|
||||
OptWrapIndented = True
|
||||
OptMarginRight = 80
|
||||
OptNumbersAutosize = True
|
||||
OptNumbersAlignment = taRightJustify
|
||||
OptNumbersFontSize = 0
|
||||
OptNumbersStyle = cNumbersEach5th
|
||||
OptNumbersShowFirst = True
|
||||
OptNumbersShowCarets = False
|
||||
OptNumbersSkippedChar = '.'
|
||||
OptNumbersIndentLeft = 5
|
||||
OptNumbersIndentRight = 5
|
||||
OptUnprintedVisible = False
|
||||
OptUnprintedSpaces = True
|
||||
OptUnprintedEnds = True
|
||||
OptUnprintedEndsDetails = True
|
||||
OptUnprintedReplaceSpec = True
|
||||
OptMouseEnableNormalSelection = True
|
||||
OptMouseEnableColumnSelection = True
|
||||
OptMouseDownForPopup = False
|
||||
OptMouseHideCursorOnType = False
|
||||
OptMouse2ClickSelectsLine = False
|
||||
OptMouse3ClickSelectsLine = True
|
||||
OptMouse2ClickDragSelectsWords = True
|
||||
OptMouseDragDrop = True
|
||||
OptMouseNiceScroll = True
|
||||
OptMouseRightClickMovesCaret = False
|
||||
OptMouseGutterClickSelectsLine = True
|
||||
OptKeyBackspaceUnindent = True
|
||||
OptKeyPageKeepsRelativePos = True
|
||||
OptKeyUpDownNavigateWrapped = True
|
||||
OptKeyUpDownKeepColumn = True
|
||||
OptKeyHomeEndNavigateWrapped = True
|
||||
OptKeyPageUpDownSize = cPageSizeFullMinus1
|
||||
OptKeyLeftRightSwapSel = True
|
||||
OptKeyLeftRightSwapSelAndSelect = False
|
||||
OptKeyHomeToNonSpace = True
|
||||
OptKeyEndToNonSpace = True
|
||||
OptKeyTabIndents = True
|
||||
OptIndentSize = 2
|
||||
OptIndentKeepsAlign = True
|
||||
OptShowIndentLines = True
|
||||
OptShowGutterCaretBG = True
|
||||
OptAllowScrollbarVert = True
|
||||
OptAllowScrollbarHorz = True
|
||||
OptAllowZooming = True
|
||||
OptAllowReadOnly = True
|
||||
OptUndoLimit = 5000
|
||||
OptUndoGrouped = True
|
||||
OptUndoAfterSave = True
|
||||
OptSavingForceFinalEol = False
|
||||
OptSavingTrimSpaces = False
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 99
|
||||
Top = 320
|
||||
Width = 685
|
||||
Align = alBottom
|
||||
ClientHeight = 99
|
||||
ClientWidth = 685
|
||||
TabOrder = 1
|
||||
object ATComboEdit1: TATComboEdit
|
||||
Left = 8
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 300
|
||||
BorderStyle = bsSingle
|
||||
Font.Height = -12
|
||||
Font.Name = 'Courier New'
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
CursorText = crIBeam
|
||||
CursorBm = crHandPoint
|
||||
Colors.TextFont = clBlack
|
||||
Colors.TextBG = clWhite
|
||||
Colors.TextDisabledFont = clGray
|
||||
Colors.TextDisabledBG = 15790320
|
||||
Colors.TextSelFont = clHighlightText
|
||||
Colors.TextSelBG = clHighlight
|
||||
Colors.Caret = clBlack
|
||||
Colors.GutterFont = clGray
|
||||
Colors.GutterBG = 14737632
|
||||
Colors.GutterCaretBG = 13158600
|
||||
Colors.GutterPlusBorder = clGray
|
||||
Colors.GutterPlusBG = 16053492
|
||||
Colors.GutterFoldLine = clGray
|
||||
Colors.GutterFoldBG = 13158600
|
||||
Colors.GutterSeparatorBG = clBlack
|
||||
Colors.CurrentLineBG = 14741744
|
||||
Colors.MarginRight = clSilver
|
||||
Colors.MarginCaret = clLime
|
||||
Colors.MarginUser = clYellow
|
||||
Colors.IndentVertLines = clMedGray
|
||||
Colors.BookmarkBG = clMoneyGreen
|
||||
Colors.RulerFont = clGray
|
||||
Colors.RulerBG = 14737632
|
||||
Colors.CollapseLine = 10510432
|
||||
Colors.CollapseMarkFont = 14712960
|
||||
Colors.CollapseMarkBG = clCream
|
||||
Colors.UnprintedFont = 5263600
|
||||
Colors.UnprintedBG = 14737632
|
||||
Colors.UnprintedHexFont = clMedGray
|
||||
Colors.MinimapBorder = clSilver
|
||||
Colors.MinimapSelBG = 15658734
|
||||
Colors.StateChanged = 61680
|
||||
Colors.StateAdded = 2146336
|
||||
Colors.StateSaved = clMedGray
|
||||
Colors.BlockStaple = clMedGray
|
||||
Colors.BlockSepLine = clMedGray
|
||||
Colors.LockedBG = 14737632
|
||||
Colors.TextHintFont = clGray
|
||||
Colors.ComboboxArrow = clGray
|
||||
Colors.ComboboxArrowBG = 15790320
|
||||
WantTabs = False
|
||||
OptTabSpaces = False
|
||||
OptTabSize = 8
|
||||
OptFoldStyle = cFoldHereWithTruncatedText
|
||||
OptTextLocked = 'wait...'
|
||||
OptTextHintFontStyle = [fsItalic]
|
||||
OptTextHintCenter = False
|
||||
OptTextOffsetTop = 2
|
||||
OptTextOffsetFromLine = 1
|
||||
OptAutoIndent = True
|
||||
OptAutoIndentKind = cIndentAsIs
|
||||
OptCopyLinesIfNoSel = True
|
||||
OptCutLinesIfNoSel = False
|
||||
OptLastLineOnTop = False
|
||||
OptOverwriteSel = True
|
||||
OptOverwriteAllowedOnPaste = False
|
||||
OptShowStapleStyle = cLineStyleSolid
|
||||
OptShowStapleIndent = -1
|
||||
OptShowStapleWidthPercent = 100
|
||||
OptShowFullSel = False
|
||||
OptShowFullHilite = True
|
||||
OptShowCurLine = False
|
||||
OptShowCurLineMinimal = True
|
||||
OptShowScrollHint = False
|
||||
OptShowCurColumn = False
|
||||
OptCaretManyAllowed = False
|
||||
OptCaretVirtual = False
|
||||
OptCaretShape = cCaretShapeVertPixels1
|
||||
OptCaretShapeOvr = cCaretShapeFull
|
||||
OptCaretShapeRO = cCaretShapeHorzPixels1
|
||||
OptCaretBlinkTime = 600
|
||||
OptCaretBlinkEnabled = True
|
||||
OptCaretStopUnfocused = True
|
||||
OptCaretPreferLeftSide = True
|
||||
OptGutterVisible = False
|
||||
OptGutterPlusSize = 4
|
||||
OptGutterShowFoldAlways = True
|
||||
OptGutterShowFoldLines = True
|
||||
OptGutterShowFoldLinesAll = False
|
||||
OptRulerVisible = False
|
||||
OptRulerSize = 20
|
||||
OptRulerFontSize = 8
|
||||
OptRulerMarkSizeSmall = 3
|
||||
OptRulerMarkSizeBig = 7
|
||||
OptRulerTextIndent = 0
|
||||
OptMinimapVisible = False
|
||||
OptMinimapCharWidth = 0
|
||||
OptMinimapShowSelBorder = False
|
||||
OptMinimapShowSelAlways = True
|
||||
OptMicromapVisible = True
|
||||
OptMicromapWidth = 22
|
||||
OptCharSpacingX = 0
|
||||
OptCharSpacingY = 1
|
||||
OptWrapMode = cWrapOff
|
||||
OptWrapIndented = True
|
||||
OptMarginRight = 1000
|
||||
OptNumbersAutosize = True
|
||||
OptNumbersAlignment = taRightJustify
|
||||
OptNumbersFontSize = 0
|
||||
OptNumbersStyle = cNumbersEach5th
|
||||
OptNumbersShowFirst = True
|
||||
OptNumbersShowCarets = False
|
||||
OptNumbersSkippedChar = '.'
|
||||
OptNumbersIndentLeft = 5
|
||||
OptNumbersIndentRight = 5
|
||||
OptUnprintedVisible = False
|
||||
OptUnprintedSpaces = True
|
||||
OptUnprintedEnds = True
|
||||
OptUnprintedEndsDetails = True
|
||||
OptUnprintedReplaceSpec = True
|
||||
OptMouseEnableNormalSelection = True
|
||||
OptMouseEnableColumnSelection = True
|
||||
OptMouseDownForPopup = False
|
||||
OptMouseHideCursorOnType = False
|
||||
OptMouse2ClickSelectsLine = False
|
||||
OptMouse3ClickSelectsLine = True
|
||||
OptMouse2ClickDragSelectsWords = True
|
||||
OptMouseDragDrop = False
|
||||
OptMouseNiceScroll = False
|
||||
OptMouseRightClickMovesCaret = False
|
||||
OptMouseGutterClickSelectsLine = True
|
||||
OptKeyBackspaceUnindent = True
|
||||
OptKeyPageKeepsRelativePos = True
|
||||
OptKeyUpDownNavigateWrapped = True
|
||||
OptKeyUpDownKeepColumn = True
|
||||
OptKeyHomeEndNavigateWrapped = True
|
||||
OptKeyPageUpDownSize = cPageSizeFullMinus1
|
||||
OptKeyLeftRightSwapSel = True
|
||||
OptKeyLeftRightSwapSelAndSelect = False
|
||||
OptKeyHomeToNonSpace = True
|
||||
OptKeyEndToNonSpace = True
|
||||
OptKeyTabIndents = True
|
||||
OptIndentSize = 2
|
||||
OptIndentKeepsAlign = True
|
||||
OptShowIndentLines = True
|
||||
OptShowGutterCaretBG = True
|
||||
OptAllowScrollbarVert = False
|
||||
OptAllowScrollbarHorz = False
|
||||
OptAllowZooming = False
|
||||
OptAllowReadOnly = False
|
||||
OptUndoLimit = 200
|
||||
OptUndoGrouped = True
|
||||
OptUndoAfterSave = True
|
||||
OptSavingForceFinalEol = False
|
||||
OptSavingTrimSpaces = False
|
||||
OptComboboxArrowSize = 4
|
||||
end
|
||||
end
|
||||
end
|
||||
52
ATSynEdit/app/test_designtime/unit1.pas
Normal file
52
ATSynEdit/app/test_designtime/unit1.pas
Normal file
@@ -0,0 +1,52 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, ATSynEdit, ATSynEdit_Edits, LCLType;
|
||||
|
||||
type
|
||||
{ TfmMain }
|
||||
|
||||
TfmMain = class(TForm)
|
||||
ATComboEdit1: TATComboEdit;
|
||||
ed: TATSynEdit;
|
||||
Panel1: TPanel;
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmMain: TfmMain;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
procedure TfmMain.FormShow(Sender: TObject);
|
||||
begin
|
||||
ed.Strings.Clear;
|
||||
ed.Strings.LineAdd('This is demo text');
|
||||
ed.Strings.LineAdd('test');
|
||||
ed.Strings.LineAdd('test...');
|
||||
ed.Update(true);
|
||||
|
||||
{
|
||||
combo2:= tatcomboedit.create(Self);
|
||||
combo2.parent:= panel1;
|
||||
combo2.left:= 350;
|
||||
combo2.width:= 300;
|
||||
combo2.top:= 20;
|
||||
}
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
86
ATSynEdit/app/test_findmatch/project1.lpi
Normal file
86
ATSynEdit/app/test_findmatch/project1.lpi
Normal file
@@ -0,0 +1,86 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Finder test"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="fmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../../atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dUnicode"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
22
ATSynEdit/app/test_findmatch/project1.lpr
Normal file
22
ATSynEdit/app/test_findmatch/project1.lpr
Normal file
@@ -0,0 +1,22 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Title:='Finder test';
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfmMain, fmMain);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
137
ATSynEdit/app/test_findmatch/unit1.lfm
Normal file
137
ATSynEdit/app/test_findmatch/unit1.lfm
Normal file
@@ -0,0 +1,137 @@
|
||||
object fmMain: TfmMain
|
||||
Left = 516
|
||||
Height = 320
|
||||
Top = 250
|
||||
Width = 667
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Test Finder.FindMatch'
|
||||
ClientHeight = 320
|
||||
ClientWidth = 667
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object Memo1: TMemo
|
||||
Left = 8
|
||||
Height = 48
|
||||
Top = 24
|
||||
Width = 407
|
||||
Lines.Strings = (
|
||||
'register'
|
||||
)
|
||||
TabOrder = 0
|
||||
end
|
||||
object Memo2: TMemo
|
||||
Left = 8
|
||||
Height = 216
|
||||
Top = 96
|
||||
Width = 407
|
||||
Lines.Strings = (
|
||||
'unit shapeline_reg;'
|
||||
''
|
||||
'interface'
|
||||
''
|
||||
'uses'
|
||||
' SysUtils, Classes, Controls, LResources, shapeline;'
|
||||
''
|
||||
'procedure Register;'
|
||||
''
|
||||
'implementation'
|
||||
''
|
||||
'procedure Register;'
|
||||
'begin'
|
||||
' RegisterComponents(''Misc'', [TShapeLine]);'
|
||||
'end;'
|
||||
''
|
||||
'initialization'
|
||||
' {$I res/icons.lrs}'
|
||||
''
|
||||
'end.'
|
||||
)
|
||||
TabOrder = 1
|
||||
end
|
||||
object bFindNext: TButton
|
||||
Left = 431
|
||||
Height = 25
|
||||
Top = 62
|
||||
Width = 120
|
||||
Caption = 'find next'
|
||||
OnClick = bFindNextClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object bFind: TButton
|
||||
Left = 431
|
||||
Height = 25
|
||||
Top = 30
|
||||
Width = 120
|
||||
Caption = 'find first'
|
||||
OnClick = bFindClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 7
|
||||
Width = 62
|
||||
Caption = 'find what'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 8
|
||||
Height = 17
|
||||
Top = 80
|
||||
Width = 70
|
||||
Caption = 'find where'
|
||||
ParentColor = False
|
||||
end
|
||||
object Memo3: TMemo
|
||||
Left = 424
|
||||
Height = 58
|
||||
Top = 254
|
||||
Width = 230
|
||||
Lines.Strings = (
|
||||
''
|
||||
)
|
||||
ReadOnly = True
|
||||
TabOrder = 8
|
||||
end
|
||||
object chkBack: TCheckBox
|
||||
Left = 431
|
||||
Height = 24
|
||||
Top = 174
|
||||
Width = 92
|
||||
Caption = 'backward'
|
||||
TabOrder = 7
|
||||
end
|
||||
object chkCase: TCheckBox
|
||||
Left = 431
|
||||
Height = 24
|
||||
Top = 126
|
||||
Width = 89
|
||||
Caption = 'case sens'
|
||||
TabOrder = 5
|
||||
end
|
||||
object chkWords: TCheckBox
|
||||
Left = 431
|
||||
Height = 24
|
||||
Top = 150
|
||||
Width = 111
|
||||
Caption = 'whole words'
|
||||
TabOrder = 6
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 424
|
||||
Height = 17
|
||||
Top = 230
|
||||
Width = 39
|
||||
Caption = 'result'
|
||||
ParentColor = False
|
||||
end
|
||||
object chkRegex: TCheckBox
|
||||
Left = 431
|
||||
Height = 24
|
||||
Top = 102
|
||||
Width = 64
|
||||
Caption = 'regex'
|
||||
TabOrder = 4
|
||||
end
|
||||
end
|
||||
93
ATSynEdit/app/test_findmatch/unit1.pas
Normal file
93
ATSynEdit/app/test_findmatch/unit1.pas
Normal file
@@ -0,0 +1,93 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
atsynedit_finder, regexpr;
|
||||
|
||||
type
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
TfmMain = class(TForm)
|
||||
bFindNext: TButton;
|
||||
bFind: TButton;
|
||||
chkRegex: TCheckBox;
|
||||
chkBack: TCheckBox;
|
||||
chkCase: TCheckBox;
|
||||
chkWords: TCheckBox;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Memo1: TMemo;
|
||||
Memo2: TMemo;
|
||||
Memo3: TMemo;
|
||||
procedure bFindNextClick(Sender: TObject);
|
||||
procedure bFindClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
Finder: TATTextFinder;
|
||||
procedure DoFind(ANext: boolean);
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fmMain: TfmMain;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfmMain }
|
||||
|
||||
procedure TfmMain.bFindClick(Sender: TObject);
|
||||
begin
|
||||
DoFind(false);
|
||||
end;
|
||||
|
||||
procedure TfmMain.bFindNextClick(Sender: TObject);
|
||||
begin
|
||||
DoFind(true);
|
||||
end;
|
||||
|
||||
procedure TfmMain.DoFind(ANext: boolean);
|
||||
var
|
||||
NFromPos, NSkipLen: integer;
|
||||
begin
|
||||
Finder.StrFind:= trim(Memo1.Text);
|
||||
Finder.StrText:= trim(Memo2.Text);
|
||||
Finder.OptCase:= chkCase.Checked;
|
||||
Finder.OptWords:= chkWords.Checked;
|
||||
Finder.OptBack:= chkBack.Checked;
|
||||
Finder.OptRegex:= chkRegex.Checked;
|
||||
|
||||
NSkipLen:= Finder.MatchLen;
|
||||
if ANext then
|
||||
NFromPos:= Finder.MatchPos
|
||||
else
|
||||
if Finder.OptRegex then
|
||||
NFromPos:= 1
|
||||
else
|
||||
if Finder.OptBack then
|
||||
NFromPos:= Length(Finder.StrText)
|
||||
else
|
||||
NFromPos:= 1;
|
||||
|
||||
if not FInder.FindMatch(ANext, NSkipLen, NFromPos) then
|
||||
memo3.text:= '(not found)'
|
||||
else
|
||||
memo3.text:= 'context:'#13+Copy(Finder.StrText, Finder.MatchPos-2, FInder.MatchLen+4);
|
||||
end;
|
||||
|
||||
procedure TfmMain.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FInder:= TATTextFinder.Create;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
102
ATSynEdit/app/test_offsettocaret/project1.lpi
Normal file
102
ATSynEdit/app/test_offsettocaret/project1.lpi
Normal file
@@ -0,0 +1,102 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\atsynedit\atstringproc_textbuffer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ATStringProc_TextBuffer"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..\atsynedit"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
ATSynEdit/app/test_offsettocaret/project1.lpr
Normal file
21
ATSynEdit/app/test_offsettocaret/project1.lpr
Normal file
@@ -0,0 +1,21 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, atstringproc_textbuffer
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:= True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
27
ATSynEdit/app/test_offsettocaret/unit1.lfm
Normal file
27
ATSynEdit/app/test_offsettocaret/unit1.lfm
Normal file
@@ -0,0 +1,27 @@
|
||||
object Form1: TForm1
|
||||
Left = 350
|
||||
Height = 259
|
||||
Top = 362
|
||||
Width = 508
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 259
|
||||
ClientWidth = 508
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.5'
|
||||
object Memo1: TMemo
|
||||
Left = 0
|
||||
Height = 259
|
||||
Top = 0
|
||||
Width = 508
|
||||
Align = alClient
|
||||
Font.CharSet = RUSSIAN_CHARSET
|
||||
Font.Height = -12
|
||||
Font.Name = 'Courier New'
|
||||
Font.Pitch = fpFixed
|
||||
Font.Quality = fqDraft
|
||||
ParentFont = False
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
69
ATSynEdit/app/test_offsettocaret/unit1.pas
Normal file
69
ATSynEdit/app/test_offsettocaret/unit1.pas
Normal file
@@ -0,0 +1,69 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
atstringproc_textbuffer, Types;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Memo1: TMemo;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
buf: TATStringBuffer;
|
||||
s: tstringlist;
|
||||
list: tlist;
|
||||
i: integer;
|
||||
pos: integer;
|
||||
pnt0, pnt: tpoint;
|
||||
begin
|
||||
s:= tstringlist.create;
|
||||
for i:= 0 to 20 do
|
||||
s.add(stringofchar('t', random(40)));
|
||||
|
||||
list:= tlist.create;
|
||||
for i:= 0 to s.count-1 do
|
||||
list.add(pointer(length(s[i])));
|
||||
|
||||
buf:= TATStringBuffer.create;
|
||||
buf.Setup(s.text, list, 1);
|
||||
|
||||
for i:= 0 to 1000 do
|
||||
begin
|
||||
pnt0.y:= random(s.count);
|
||||
pnt0.x:= random(length(s[pnt0.y]));
|
||||
pos:= buf.CaretToStr(pnt0);
|
||||
pnt:= buf.StrToCaret(pos);
|
||||
if not PointsEqual(pnt, pnt0) then
|
||||
begin
|
||||
memo1.lines.add('bad test: line:col '+inttostr(pnt0.y)+':'+inttostr(pnt0.x));
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
memo1.lines.add('ok test');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
895
ATSynEdit/atsynedit/atstringproc.pas
Normal file
895
ATSynEdit/atsynedit/atstringproc.pas
Normal file
@@ -0,0 +1,895 @@
|
||||
unit ATStringProc;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
//{$define test_wide_char}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils;
|
||||
|
||||
type
|
||||
atString = UnicodeString;
|
||||
atChar = WideChar;
|
||||
PatChar = PWideChar;
|
||||
|
||||
type
|
||||
TATIntArray = array of Longint;
|
||||
TATRealArray = array of real;
|
||||
TATPointArray = array of TPoint;
|
||||
|
||||
function SCharUpper(ch: atChar): atChar;
|
||||
function SCharLower(ch: atChar): atChar;
|
||||
function SCaseTitle(const S, SWordChars: atString): atString;
|
||||
function SCaseInvert(const S: atString): atString;
|
||||
function SCaseSentence(const S, SWordChars: atString): atString;
|
||||
|
||||
{$Z1}
|
||||
type
|
||||
TATLineEnds = (cEndNone, cEndWin, cEndUnix, cEndMac);
|
||||
const
|
||||
cLineEndStrings: array[TATLineEnds] of atString = ('', #13#10, #10, #13);
|
||||
cLineEndNiceNames: array[TATLineEnds] of string = ('', 'win', 'un', 'mac');
|
||||
|
||||
const
|
||||
cMaxTabPositionToExpand = 500; //no sense to expand too far tabs
|
||||
cCharScaleFullwidth_Default = 1.7; //width of CJK chars
|
||||
cCharScaleHex = 6.0; //width of hex show: "<NNNN>"
|
||||
cMinWordWrapOffset = 3;
|
||||
|
||||
var
|
||||
OptHexCharsDefault: UnicodeString = ''; //show these chars as "<NNNN>"
|
||||
OptHexCharsUser: UnicodeString = ''; //these too
|
||||
OptCommaCharsWrapWithWords: UnicodeString = '.,;:''"`~?!&%$';
|
||||
cCharScaleFullwidth: Single = cCharScaleFullwidth_Default;
|
||||
|
||||
|
||||
function IsCharEol(ch: atChar): boolean;
|
||||
function IsCharWord(ch: atChar; const AWordChars: atString): boolean;
|
||||
function IsCharSpace(ch: atChar): boolean;
|
||||
function IsCharAsciiControl(ch: atChar): boolean;
|
||||
function IsCharAccent(ch: atChar): boolean;
|
||||
function IsCharHex(ch: atChar): boolean;
|
||||
function IsStringWithUnicodeChars(const S: atString): boolean;
|
||||
|
||||
function SBeginsWith(const S, SubStr: atString): boolean;
|
||||
function SBeginsWith(const S, SubStr: string): boolean;
|
||||
function SEndsWith(const S, SubStr: atString): boolean;
|
||||
function SEndsWith(const S, SubStr: string): boolean;
|
||||
|
||||
function STrimRight(const S: atString): atString;
|
||||
function SGetIndentChars(const S: atString): integer;
|
||||
function SGetIndentExpanded(const S: atString; ATabSize: integer): integer;
|
||||
function SGetNonSpaceLength(const S: atString): integer;
|
||||
|
||||
function STabsToSpaces(const S: atString; ATabSize: integer): atString;
|
||||
function SSpacesToTabs(const S: atString; ATabSize: integer): atString;
|
||||
function SCharPosToColumnPos(const S: atString; APos, ATabSize: integer): integer;
|
||||
function SColumnPosToCharPos(const S: atString; AColumn, ATabSize: integer): integer;
|
||||
|
||||
type
|
||||
TATCommentAction = (
|
||||
cCommentAdd_AtNonspace,
|
||||
cCommentAdd_AtNonespace_IfNone,
|
||||
cCommentAdd_AtStart,
|
||||
cCommentAdd_AtStart_IfNone,
|
||||
cCommentRemove,
|
||||
cCommentToggle_AtNonspace,
|
||||
cCommentToggle_AtStart
|
||||
);
|
||||
|
||||
function SCommentLineAction(L: TStringList; const AComment: atString; Act: TATCommentAction): boolean;
|
||||
|
||||
function SRemoveNewlineChars(const S: atString): atString;
|
||||
function SRemoveHexChars(const S: atString): atString;
|
||||
function SRemoveAsciiControlChars(const S: atString): atString;
|
||||
|
||||
procedure SCalcCharOffsets(const S: atString; var AList: TATRealArray;
|
||||
ATabSize: integer; ACharsSkipped: integer = 0);
|
||||
function SFindWordWrapOffset(const S: atString; AColumns, ATabSize: integer;
|
||||
const AWordChars: atString; AWrapIndented: boolean): integer;
|
||||
function SFindClickedPosition(const Str: atString;
|
||||
APixelsFromLeft, ACharSize, ATabSize: integer;
|
||||
AAllowVirtualPos: boolean;
|
||||
out AEndOfLinePos: boolean): integer;
|
||||
procedure SFindOutputSkipOffset(const S: atString; ATabSize, AScrollPos: integer;
|
||||
out ACharsSkipped: integer; out ASpacesSkipped: real);
|
||||
|
||||
function SIndentUnindent(const Str: atString; ARight: boolean;
|
||||
AIndentSize, ATabSize: integer): atString;
|
||||
function SGetItem(var S: string; const sep: Char = ','): string;
|
||||
function SGetItemAtEnd(var S: string; const sep: Char = ','): string;
|
||||
function SSwapEndian(const S: UnicodeString): UnicodeString;
|
||||
function SWithBreaks(const S: atString): boolean;
|
||||
procedure SAddStringToHistory(const S: string; List: TStrings; MaxItems: integer);
|
||||
|
||||
function BoolToPlusMinusOne(b: boolean): integer;
|
||||
procedure TrimStringList(L: TStringList);
|
||||
|
||||
type
|
||||
TATDecodeRec = record SFrom, STo: UnicodeString; end;
|
||||
function SDecodeRecords(const S: UnicodeString; const Decode: array of TATDecodeRec): UnicodeString;
|
||||
|
||||
procedure SReplaceAll(var s: string; const SFrom, STo: string);
|
||||
procedure SReplaceAllPercentChars(var S: string);
|
||||
procedure SDeleteFrom(var s: string; const SFrom: string);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Dialogs, Math;
|
||||
|
||||
function IsCharEol(ch: atChar): boolean;
|
||||
begin
|
||||
Result:= (ch=#10) or (ch=#13);
|
||||
end;
|
||||
|
||||
function IsCharWord(ch: atChar; const AWordChars: atString): boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
|
||||
case Ord(ch) of
|
||||
//Eng
|
||||
Ord('0')..Ord('9'),
|
||||
Ord('a')..Ord('z'),
|
||||
Ord('A')..Ord('Z'),
|
||||
Ord('_'),
|
||||
//German
|
||||
$E4, $C4, $E9, $F6, $D6, $FC, $DC, $DF,
|
||||
//Rus
|
||||
$0430..$044F, //a..z
|
||||
$0410..$042F, //A..Z
|
||||
$0451, $0401, //yo, Yo
|
||||
//Greek
|
||||
$0391..$03A9,
|
||||
$03B1..$03C9:
|
||||
begin Result:= true; Exit end;
|
||||
end;
|
||||
|
||||
if AWordChars<>'' then
|
||||
if Pos(ch, AWordChars)>0 then
|
||||
Result:= true;
|
||||
end;
|
||||
|
||||
function IsCharSpace(ch: atChar): boolean;
|
||||
begin
|
||||
Result:= (ch=' ') or (ch=#9);
|
||||
end;
|
||||
|
||||
function IsCharAsciiControl(ch: atChar): boolean;
|
||||
begin
|
||||
Result:= (ch<>#9) and (AnsiChar(ch)<' ');
|
||||
end;
|
||||
|
||||
function IsCharHex(ch: atChar): boolean;
|
||||
begin
|
||||
Result:= Pos(ch, OptHexCharsDefault+OptHexCharsUser)>0;
|
||||
end;
|
||||
|
||||
function IsStringWithUnicodeChars(const S: atString): boolean;
|
||||
var
|
||||
i, N: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
for i:= 1 to Length(S) do
|
||||
begin
|
||||
N:= Ord(S[i]);
|
||||
if (N<32) or (N>126) then exit(true);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure DoDebugOffsets(const List: TATRealArray);
|
||||
var
|
||||
i: integer;
|
||||
s: string;
|
||||
begin
|
||||
s:= '';
|
||||
for i:= Low(List) to High(List) do
|
||||
s:= s+FloatToStr(List[i])+' ';
|
||||
showmessage('Offsets'#13+s);
|
||||
end;
|
||||
|
||||
function SFindWordWrapOffset(const S: atString; AColumns, ATabSize: integer;
|
||||
const AWordChars: atString; AWrapIndented: boolean): integer;
|
||||
//
|
||||
//override IsCharWord to check also commas,dots,quotes
|
||||
//to wrap them with wordchars
|
||||
function _IsWord(ch: atChar): boolean;
|
||||
begin
|
||||
Result:= IsCharWord(ch, AWordChars+OptCommaCharsWrapWithWords);
|
||||
end;
|
||||
//
|
||||
var
|
||||
N, NMin, NAvg: integer;
|
||||
List: TATRealArray;
|
||||
begin
|
||||
if S='' then
|
||||
begin Result:= 0; Exit end;
|
||||
if AColumns<cMinWordWrapOffset then
|
||||
begin Result:= AColumns; Exit end;
|
||||
|
||||
SetLength(List, Length(S));
|
||||
SCalcCharOffsets(S, List, ATabSize);
|
||||
|
||||
if List[High(List)]<=AColumns then
|
||||
begin
|
||||
Result:= Length(S);
|
||||
Exit
|
||||
end;
|
||||
|
||||
//NAvg is average wrap offset, we use it if no correct offset found
|
||||
N:= Length(S)-1;
|
||||
while (N>0) and (List[N]>AColumns+1) do Dec(N);
|
||||
NAvg:= N;
|
||||
if NAvg<cMinWordWrapOffset then
|
||||
begin Result:= cMinWordWrapOffset; Exit end;
|
||||
|
||||
//find correct offset: not allowed at edge
|
||||
//a) 2 wordchars,
|
||||
//b) space as 2nd char (not nice look for Python src)
|
||||
NMin:= SGetIndentChars(S)+1;
|
||||
while (N>NMin) and
|
||||
((_IsWord(S[N]) and _IsWord(S[N+1])) or
|
||||
(AWrapIndented and IsCharSpace(S[N+1])))
|
||||
do Dec(N);
|
||||
|
||||
//use correct of avg offset
|
||||
if N>NMin then
|
||||
Result:= N
|
||||
else
|
||||
Result:= NAvg;
|
||||
end;
|
||||
|
||||
function SGetIndentChars(const S: atString): integer;
|
||||
begin
|
||||
Result:= 0;
|
||||
while (Result<Length(S)) and IsCharSpace(S[Result+1]) do
|
||||
Inc(Result);
|
||||
end;
|
||||
|
||||
function SGetNonSpaceLength(const S: atString): integer;
|
||||
begin
|
||||
Result:= Length(S);
|
||||
while (Result>0) and IsCharSpace(S[Result]) do Dec(Result);
|
||||
if Result=0 then
|
||||
Result:= Length(S);
|
||||
end;
|
||||
|
||||
function SGetIndentExpanded(const S: atString; ATabSize: integer): integer;
|
||||
var
|
||||
SIndent: atString;
|
||||
begin
|
||||
SIndent:= Copy(S, 1, SGetIndentChars(S));
|
||||
SIndent:= STabsToSpaces(SIndent, ATabSize);
|
||||
Result:= Length(SIndent);
|
||||
end;
|
||||
|
||||
function SSwapEndian(const S: UnicodeString): UnicodeString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
Result[i]:= WideChar(SwapEndian(Ord(Result[i])));
|
||||
end;
|
||||
|
||||
function SCalcTabulationSize(const ATabSize, APos: integer): integer;
|
||||
begin
|
||||
Result:= 1;
|
||||
if APos>cMaxTabPositionToExpand then Exit;
|
||||
while (APos+Result-1) mod ATabSize <> 0 do
|
||||
Inc(Result);
|
||||
end;
|
||||
|
||||
function STabsToSpaces(const S: atString; ATabSize: integer): atString;
|
||||
var
|
||||
N, NSize: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
repeat
|
||||
N:= Pos(#9, Result);
|
||||
if N=0 then Break;
|
||||
NSize:= SCalcTabulationSize(ATabSize, N);
|
||||
if NSize<=1 then
|
||||
Result[N]:= ' '
|
||||
else
|
||||
begin
|
||||
Delete(Result, N, 1);
|
||||
Insert(StringOfChar(' ', NSize), Result, N);
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
{
|
||||
http://en.wikipedia.org/wiki/Combining_character
|
||||
Combining Diacritical Marks (0300–036F), since version 1.0, with modifications in subsequent versions down to 4.1
|
||||
Combining Diacritical Marks Extended (1AB0–1AFF), version 7.0
|
||||
Combining Diacritical Marks Supplement (1DC0–1DFF), versions 4.1 to 5.2
|
||||
Combining Diacritical Marks for Symbols (20D0–20FF), since version 1.0, with modifications in subsequent versions down to 5.1
|
||||
Combining Half Marks (FE20–FE2F), versions 1.0, updates in 5.2
|
||||
}
|
||||
{
|
||||
http://www.unicode.org/charts/PDF/U0E80.pdf
|
||||
cannot render them ok anyway as accents:
|
||||
0EB1, 0EB4..0EBC, 0EC8..0ECD
|
||||
}
|
||||
function IsCharAccent(ch: atChar): boolean;
|
||||
begin
|
||||
case Ord(ch) of
|
||||
$0300..$036F,
|
||||
$1AB0..$1AFF,
|
||||
$1DC0..$1DFF,
|
||||
$20D0..$20FF,
|
||||
{$ifdef unix}
|
||||
$0EB1, $0EB4..$0EBC, $0EC8..$0ECD, //Lao accent chars
|
||||
{$endif}
|
||||
$FE20..$FE2F:
|
||||
Result:= true;
|
||||
else
|
||||
Result:= false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function IsCharFullWidth(ch: atChar): boolean;
|
||||
begin
|
||||
case Ord(ch) of
|
||||
$1100..$115F,
|
||||
$2329..$232A,
|
||||
$2E80..$303E,
|
||||
$3041..$33FF,
|
||||
$3400..$4DB5,
|
||||
$4E00..$9FC3,
|
||||
$A000..$A4C6,
|
||||
$AC00..$D7A3,
|
||||
$F900..$FAD9,
|
||||
$FE10..$FE19,
|
||||
$FE30..$FE6B,
|
||||
$FF01..$FF60,
|
||||
$FFE0..$FFE6:
|
||||
Result:= true;
|
||||
else
|
||||
Result:= false;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef test_wide_char}
|
||||
const
|
||||
cScaleTest = 1.9; //debug, for test code, commented
|
||||
{$endif}
|
||||
|
||||
procedure SCalcCharOffsets(const S: atString; var AList: TATRealArray;
|
||||
ATabSize: integer; ACharsSkipped: integer);
|
||||
var
|
||||
NSize, NTabSize, NCharsSkipped: integer;
|
||||
Scale: real;
|
||||
i: integer;
|
||||
begin
|
||||
if S='' then Exit;
|
||||
if Length(AList)<>Length(S) then
|
||||
raise Exception.Create('Bad list len: CalcCharOffsets');
|
||||
|
||||
NCharsSkipped:= ACharsSkipped;
|
||||
|
||||
for i:= 1 to Length(S) do
|
||||
begin
|
||||
Inc(NCharsSkipped);
|
||||
|
||||
Scale:= 1.0;
|
||||
if IsCharHex(S[i]) then
|
||||
Scale:= cCharScaleHex
|
||||
else
|
||||
if IsCharFullWidth(S[i]) then
|
||||
Scale:= cCharScaleFullwidth;
|
||||
|
||||
{$ifdef test_wide_char}
|
||||
if IsSpaceChar(S[i]) then
|
||||
Scale:= 1
|
||||
else
|
||||
Scale:= cScaleTest;
|
||||
{$endif}
|
||||
|
||||
if S[i]<>#9 then
|
||||
NSize:= 1
|
||||
else
|
||||
begin
|
||||
NTabSize:= SCalcTabulationSize(ATabSize, NCharsSkipped);
|
||||
NSize:= NTabSize;
|
||||
Inc(NCharsSkipped, NTabSize-1);
|
||||
end;
|
||||
|
||||
if (i<Length(S)) and IsCharAccent(S[i+1]) then
|
||||
NSize:= 0;
|
||||
|
||||
if i=1 then
|
||||
AList[i-1]:= NSize*Scale
|
||||
else
|
||||
AList[i-1]:= AList[i-2]+NSize*Scale;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SFindClickedPosition(const Str: atString;
|
||||
APixelsFromLeft, ACharSize, ATabSize: integer;
|
||||
AAllowVirtualPos: boolean;
|
||||
out AEndOfLinePos: boolean): integer;
|
||||
var
|
||||
ListReal: TATRealArray;
|
||||
ListEnds, ListMid: TATIntArray;
|
||||
i: integer;
|
||||
begin
|
||||
AEndOfLinePos:= false;
|
||||
if Str='' then
|
||||
begin
|
||||
if AAllowVirtualPos then
|
||||
Result:= 1+APixelsFromLeft div ACharSize
|
||||
else
|
||||
Result:= 1;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SetLength(ListReal, Length(Str));
|
||||
SetLength(ListEnds, Length(Str));
|
||||
SetLength(ListMid, Length(Str));
|
||||
SCalcCharOffsets(Str, ListReal, ATabSize);
|
||||
|
||||
//positions of each char end
|
||||
for i:= 0 to High(ListEnds) do
|
||||
ListEnds[i]:= Trunc(ListReal[i]*ACharSize);
|
||||
|
||||
//positions of each char middle
|
||||
for i:= 0 to High(ListEnds) do
|
||||
if i=0 then
|
||||
ListMid[i]:= ListEnds[i] div 2
|
||||
else
|
||||
ListMid[i]:= (ListEnds[i-1]+ListEnds[i]) div 2;
|
||||
|
||||
for i:= 0 to High(ListEnds) do
|
||||
if APixelsFromLeft<ListMid[i] then
|
||||
begin
|
||||
Result:= i+1;
|
||||
Exit
|
||||
end;
|
||||
|
||||
AEndOfLinePos:= true;
|
||||
if AAllowVirtualPos then
|
||||
Result:= Length(Str)+1 + (APixelsFromLeft - ListEnds[High(ListEnds)]) div ACharSize
|
||||
else
|
||||
Result:= Length(Str)+1;
|
||||
end;
|
||||
|
||||
procedure SFindOutputSkipOffset(const S: atString; ATabSize, AScrollPos: integer;
|
||||
out ACharsSkipped: integer; out ASpacesSkipped: real);
|
||||
var
|
||||
List: TATRealArray;
|
||||
begin
|
||||
ACharsSkipped:= 0;
|
||||
ASpacesSkipped:= 0;
|
||||
if (S='') or (AScrollPos=0) then Exit;
|
||||
|
||||
SetLength(List, Length(S));
|
||||
SCalcCharOffsets(S, List, ATabSize);
|
||||
|
||||
while (ACharsSkipped<Length(S)) and (List[ACharsSkipped]<AScrollPos) do
|
||||
Inc(ACharsSkipped);
|
||||
|
||||
if (ACharsSkipped>0) then
|
||||
ASpacesSkipped:= List[ACharsSkipped-1];
|
||||
end;
|
||||
|
||||
|
||||
function BoolToPlusMinusOne(b: boolean): integer;
|
||||
begin
|
||||
if b then Result:= 1 else Result:= -1;
|
||||
end;
|
||||
|
||||
function SGetItem(var S: string; const sep: Char = ','): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
i:= Pos(sep, s);
|
||||
if i=0 then i:= MaxInt;
|
||||
Result:= Copy(s, 1, i-1);
|
||||
Delete(s, 1, i);
|
||||
end;
|
||||
|
||||
function SGetItemAtEnd(var S: string; const sep: Char = ','): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= '';
|
||||
i:= Pos(sep, S);
|
||||
if i>0 then
|
||||
begin
|
||||
Result:= Copy(S, i+1, MaxInt);
|
||||
Delete(S, i, MaxInt);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TrimStringList(L: TStringList);
|
||||
begin
|
||||
//dont do "while", we need correct last empty lines
|
||||
if (L.Count>0) and (L[L.Count-1]='') then
|
||||
L.Delete(L.Count-1);
|
||||
end;
|
||||
|
||||
function SWithBreaks(const S: atString): boolean;
|
||||
begin
|
||||
Result:=
|
||||
(Pos(#13, S)>0) or
|
||||
(Pos(#10, S)>0);
|
||||
end;
|
||||
|
||||
function SSpacesToTabs(const S: atString; ATabSize: integer): atString;
|
||||
begin
|
||||
Result:= StringReplace(S, StringOfChar(' ', ATabSize), #9, [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
function SCharPosToColumnPos(const S: atString; APos, ATabSize: integer): integer;
|
||||
begin
|
||||
Result:= Length(STabsToSpaces(Copy(S, 1, APos), ATabSize));
|
||||
if APos>Length(S) then
|
||||
Inc(Result, APos-Length(S));
|
||||
end;
|
||||
|
||||
function SColumnPosToCharPos(const S: atString; AColumn, ATabSize: integer): integer;
|
||||
var
|
||||
size, i: integer;
|
||||
begin
|
||||
if AColumn=0 then exit(AColumn);
|
||||
if Pos(#9, S)=0 then exit(AColumn);
|
||||
|
||||
size:= 0;
|
||||
for i:= 1 to Length(S) do
|
||||
begin
|
||||
if S[i]<>#9 then
|
||||
Inc(size)
|
||||
else
|
||||
Inc(size, SCalcTabulationSize(ATabSize, size+1));
|
||||
if size>=AColumn then
|
||||
exit(i);
|
||||
end;
|
||||
|
||||
Result:= AColumn-Length(STabsToSpaces(S, ATabSize))+Length(S);
|
||||
end;
|
||||
|
||||
function SIndentUnindent(const Str: atString; ARight: boolean;
|
||||
AIndentSize, ATabSize: integer): atString;
|
||||
var
|
||||
StrIndent, StrText: atString;
|
||||
DecSpaces, N: integer;
|
||||
DoTabs: boolean;
|
||||
begin
|
||||
Result:= Str;
|
||||
|
||||
//indent<0 - use tabs
|
||||
if AIndentSize>=0 then
|
||||
begin
|
||||
StrIndent:= StringOfChar(' ', AIndentSize);
|
||||
DecSpaces:= AIndentSize;
|
||||
end
|
||||
else
|
||||
begin
|
||||
StrIndent:= StringOfChar(#9, Abs(AIndentSize));
|
||||
DecSpaces:= Abs(AIndentSize)*ATabSize;
|
||||
end;
|
||||
|
||||
if ARight then
|
||||
Result:= StrIndent+Str
|
||||
else
|
||||
begin
|
||||
N:= SGetIndentChars(Str);
|
||||
StrIndent:= Copy(Str, 1, N);
|
||||
StrText:= Copy(Str, N+1, MaxInt);
|
||||
DoTabs:= Pos(#9, StrIndent)>0;
|
||||
|
||||
StrIndent:= STabsToSpaces(StrIndent, ATabSize);
|
||||
if DecSpaces>Length(StrIndent) then
|
||||
DecSpaces:= Length(StrIndent);
|
||||
Delete(StrIndent, 1, DecSpaces);
|
||||
|
||||
if DoTabs then
|
||||
StrIndent:= SSpacesToTabs(StrIndent, ATabSize);
|
||||
Result:= StrIndent+StrText;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SRemoveAsciiControlChars(const S: atString): atString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
if IsCharAsciiControl(Result[i]) then
|
||||
Result[i]:= '.';
|
||||
end;
|
||||
|
||||
function SRemoveHexChars(const S: atString): atString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
if IsCharHex(Result[i]) then
|
||||
Result[i]:= '?';
|
||||
end;
|
||||
|
||||
function SRemoveNewlineChars(const S: atString): atString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
if IsCharEol(Result[i]) then
|
||||
Result[i]:= ' ';
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
http://unicode.org/reports/tr9/#Directional_Formatting_Characters
|
||||
Implicit Directional Formatting Characters LRM, RLM, ALM
|
||||
Explicit Directional Embedding and Override Formatting Characters LRE, RLE, LRO, RLO, PDF
|
||||
Explicit Directional Isolate Formatting Characters LRI, RLI, FSI, PDI
|
||||
}
|
||||
const
|
||||
cDirCodes: UnicodeString =
|
||||
#$202A {LRE} + #$202B {RLE} + #$202D {LRO} + #$202E {RLO} + #$202C {PDF} +
|
||||
#$2066 {LRI} + #$2067 {RLI} + #$2068 {FSI} + #$2069 {PDI} +
|
||||
#$200E {LRM} + #$200F {RLM} + #$061C {ALM};
|
||||
|
||||
procedure _InitCharsHex;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
OptHexCharsDefault:= '';
|
||||
|
||||
for i:= 0 to 31 do
|
||||
if (i<>13) and (i<>10) and (i<>9) then
|
||||
OptHexCharsDefault:= OptHexCharsDefault+Chr(i);
|
||||
|
||||
OptHexCharsDefault:= OptHexCharsDefault + cDirCodes;
|
||||
end;
|
||||
|
||||
|
||||
function STrimRight(const S: atString): atString;
|
||||
var
|
||||
N: integer;
|
||||
begin
|
||||
N:= Length(S);
|
||||
while (N>0) and (S[N]=' ') do Dec(N);
|
||||
Result:= Copy(S, 1, N);
|
||||
end;
|
||||
|
||||
function SBeginsWith(const S, SubStr: atString): boolean;
|
||||
begin
|
||||
Result:= (SubStr<>'') and (Copy(S, 1, Length(SubStr))=SubStr);
|
||||
end;
|
||||
|
||||
function SBeginsWith(const S, SubStr: string): boolean;
|
||||
begin
|
||||
Result:= (SubStr<>'') and (Copy(S, 1, Length(SubStr))=SubStr);
|
||||
end;
|
||||
|
||||
function SEndsWith(const S, SubStr: atString): boolean;
|
||||
begin
|
||||
Result:= (SubStr<>'') and (Length(SubStr)<=Length(S)) and
|
||||
(Copy(S, Length(S)-Length(SubStr)+1, MaxInt)=SubStr);
|
||||
end;
|
||||
|
||||
function SEndsWith(const S, SubStr: string): boolean;
|
||||
begin
|
||||
Result:= (SubStr<>'') and (Length(SubStr)<=Length(S)) and
|
||||
(Copy(S, Length(S)-Length(SubStr)+1, MaxInt)=SubStr);
|
||||
end;
|
||||
|
||||
|
||||
function SCharUpper(ch: atChar): atChar;
|
||||
begin
|
||||
Result:= UnicodeUpperCase(ch)[1];
|
||||
end;
|
||||
|
||||
function SCharLower(ch: atChar): atChar;
|
||||
begin
|
||||
Result:= UnicodeLowerCase(ch)[1];
|
||||
end;
|
||||
|
||||
|
||||
function SCaseTitle(const S, SWordChars: atString): atString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
if (i=1) or not IsCharWord(S[i-1], SWordChars) then
|
||||
Result[i]:= SCharUpper(Result[i])
|
||||
else
|
||||
Result[i]:= SCharLower(Result[i]);
|
||||
end;
|
||||
|
||||
function SCaseInvert(const S: atString): atString;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= S;
|
||||
for i:= 1 to Length(Result) do
|
||||
if S[i]<>SCharUpper(S[i]) then
|
||||
Result[i]:= SCharUpper(Result[i])
|
||||
else
|
||||
Result[i]:= SCharLower(Result[i]);
|
||||
end;
|
||||
|
||||
function SCaseSentence(const S, SWordChars: atString): atString;
|
||||
var
|
||||
dot: boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:= S;
|
||||
dot:= True;
|
||||
for i:= 1 to Length(Result) do
|
||||
begin
|
||||
if IsCharWord(Result[i], SWordChars) then
|
||||
begin
|
||||
if dot then
|
||||
Result[i]:= SCharUpper(Result[i])
|
||||
else
|
||||
Result[i]:= SCharLower(Result[i]);
|
||||
dot:= False;
|
||||
end
|
||||
else
|
||||
if (Result[i] = '.') or (Result[i] = '!') or (Result[i] = '?') then
|
||||
dot:= True;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function SDecodeRecords(const S: UnicodeString; const Decode: array of TATDecodeRec): UnicodeString;
|
||||
var
|
||||
i, j: Integer;
|
||||
DoDecode: Boolean;
|
||||
begin
|
||||
Result := '';
|
||||
i := 1;
|
||||
repeat
|
||||
if i > Length(S) then Break;
|
||||
DoDecode := False;
|
||||
for j := Low(Decode) to High(Decode) do
|
||||
with Decode[j] do
|
||||
if SFrom = Copy(S, i, Length(SFrom)) then
|
||||
begin
|
||||
DoDecode := True;
|
||||
Result := Result + STo;
|
||||
Inc(i, Length(SFrom));
|
||||
Break
|
||||
end;
|
||||
if DoDecode then Continue;
|
||||
Result := Result + S[i];
|
||||
Inc(i);
|
||||
until False;
|
||||
end;
|
||||
|
||||
|
||||
function SCommentLineAction(L: TStringList;
|
||||
const AComment: atString; Act: TATCommentAction): boolean;
|
||||
var
|
||||
Str, Str0: atString;
|
||||
IndentThis, IndentAll, i: integer;
|
||||
IsCmtThis, IsCmtAll: boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
if L.Count=0 then exit;
|
||||
|
||||
IndentAll:= MaxInt;
|
||||
for i:= 0 to L.Count-1 do
|
||||
IndentAll:= Min(IndentAll, SGetIndentChars(L[i])+1);
|
||||
//no need Utf8decode
|
||||
|
||||
for i:= 0 to L.Count-1 do
|
||||
begin
|
||||
Str:= Utf8Decode(L[i]);
|
||||
Str0:= Str;
|
||||
|
||||
//IndentThis, IsCmtThis: regarding indent if this line
|
||||
//IndentAll, IsCmtAll: regarding minimal indent of block
|
||||
IndentThis:= SGetIndentChars(Str)+1;
|
||||
IsCmtThis:= Copy(Str, IndentThis, Length(AComment))=AComment;
|
||||
IsCmtAll:= Copy(Str, IndentAll, Length(AComment))=AComment;
|
||||
|
||||
case Act of
|
||||
cCommentAdd_AtNonspace:
|
||||
begin
|
||||
Insert(AComment, Str, IndentAll);
|
||||
end;
|
||||
cCommentAdd_AtNonespace_IfNone:
|
||||
begin
|
||||
if not IsCmtAll then
|
||||
Insert(AComment, Str, IndentAll);
|
||||
end;
|
||||
cCommentAdd_AtStart:
|
||||
begin
|
||||
Insert(AComment, Str, 1);
|
||||
end;
|
||||
cCommentAdd_AtStart_IfNone:
|
||||
begin
|
||||
if not IsCmtAll then
|
||||
Insert(AComment, Str, 1);
|
||||
end;
|
||||
cCommentRemove:
|
||||
begin
|
||||
if IsCmtAll then
|
||||
Delete(Str, IndentAll, Length(AComment))
|
||||
else
|
||||
if IsCmtThis then
|
||||
Delete(Str, IndentThis, Length(AComment))
|
||||
end;
|
||||
cCommentToggle_AtNonspace:
|
||||
begin
|
||||
if IsCmtAll then
|
||||
Delete(Str, IndentAll, Length(AComment))
|
||||
else
|
||||
Insert(AComment, Str, IndentAll);
|
||||
end;
|
||||
cCommentToggle_AtStart:
|
||||
begin
|
||||
if IsCmtAll then
|
||||
Delete(Str, IndentAll, Length(AComment))
|
||||
else
|
||||
Insert(AComment, Str, 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
if Str<>Str0 then
|
||||
begin
|
||||
Result:= true; //modified
|
||||
L[i]:= Utf8Encode(Str);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure SReplaceAll(var s: string; const SFrom, STo: string);
|
||||
begin
|
||||
S:= StringReplace(S, SFrom, STo, [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
procedure SReplaceAllPercentChars(var S: string);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:= $20 to $2F do
|
||||
SReplaceAll(S, '%'+IntToHex(i, 2), Chr(i));
|
||||
|
||||
i:= $7C;
|
||||
SReplaceAll(S, '%'+IntToHex(i, 2), Chr(i));
|
||||
end;
|
||||
|
||||
procedure SDeleteFrom(var s: string; const SFrom: string);
|
||||
var
|
||||
n: integer;
|
||||
begin
|
||||
n:= Pos(SFrom, S);
|
||||
if n>0 then
|
||||
Delete(S, n, MaxInt);
|
||||
end;
|
||||
|
||||
procedure SAddStringToHistory(const S: string; List: TStrings; MaxItems: integer);
|
||||
var
|
||||
n: integer;
|
||||
begin
|
||||
if s<>'' then
|
||||
begin
|
||||
n:= List.IndexOf(s);
|
||||
if n>=0 then
|
||||
List.Delete(n);
|
||||
List.Insert(0, s);
|
||||
end;
|
||||
|
||||
while List.Count>MaxItems do
|
||||
List.Delete(List.Count-1);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
_InitCharsHex;
|
||||
|
||||
end.
|
||||
|
||||
81
ATSynEdit/atsynedit/atstringproc_htmlcolor.pas
Normal file
81
ATSynEdit/atsynedit/atstringproc_htmlcolor.pas
Normal file
@@ -0,0 +1,81 @@
|
||||
unit ATStringProc_HtmlColor;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics;
|
||||
|
||||
//convert TColor -> HTML color string #rrggbb
|
||||
function SColorToHtmlColor(Color: TColor): string;
|
||||
//convert string which starts with HTML color token #rgb, #rrggbb -> TColor, get len of color-string
|
||||
function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function IsCharWord(ch: char): boolean;
|
||||
begin
|
||||
Result:= ch in ['a'..'z', 'A'..'Z', '_', '0'..'9'];
|
||||
end;
|
||||
|
||||
function IsCharHex(ch: char): boolean;
|
||||
begin
|
||||
Result:= ch in ['0'..'9', 'a'..'f', 'A'..'F'];
|
||||
end;
|
||||
|
||||
function SColorToHtmlColor(Color: TColor): string;
|
||||
var
|
||||
N: Longint;
|
||||
begin
|
||||
if Color=clNone then
|
||||
begin Result:= ''; exit end;
|
||||
N:= ColorToRGB(Color);
|
||||
Result:= '#'+
|
||||
IntToHex(Red(N), 2)+
|
||||
IntToHex(Green(N), 2)+
|
||||
IntToHex(Blue(N), 2);
|
||||
end;
|
||||
|
||||
function SHtmlColorToColor(s: string; out Len: integer; Default: TColor): TColor;
|
||||
var
|
||||
N1, N2, N3: integer;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= Default;
|
||||
Len:= 0;
|
||||
if (s<>'') and (s[1]='#') then Delete(s, 1, 1);
|
||||
if (s='') then exit;
|
||||
|
||||
//delete after first nonword char
|
||||
i:= 1;
|
||||
while (i<=Length(s)) and IsCharWord(s[i]) do Inc(i);
|
||||
Delete(s, i, Maxint);
|
||||
|
||||
//allow only #rgb, #rrggbb
|
||||
Len:= Length(s);
|
||||
if (Len<>3) and (Len<>6) then exit;
|
||||
|
||||
for i:= 1 to Len do
|
||||
if not IsCharHex(s[i]) then exit;
|
||||
|
||||
if Len=6 then
|
||||
begin
|
||||
N1:= StrToInt('$'+Copy(s, 1, 2));
|
||||
N2:= StrToInt('$'+Copy(s, 3, 2));
|
||||
N3:= StrToInt('$'+Copy(s, 5, 2));
|
||||
end
|
||||
else
|
||||
begin
|
||||
N1:= StrToInt('$'+s[1]+s[1]);
|
||||
N2:= StrToInt('$'+s[2]+s[2]);
|
||||
N3:= StrToInt('$'+s[3]+s[3]);
|
||||
end;
|
||||
|
||||
Result:= RGBToColor(N1, N2, N3);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
204
ATSynEdit/atsynedit/atstringproc_textbuffer.pas
Normal file
204
ATSynEdit/atsynedit/atstringproc_textbuffer.pas
Normal file
@@ -0,0 +1,204 @@
|
||||
unit ATStringProc_TextBuffer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Dialogs,
|
||||
ATStringProc;
|
||||
|
||||
type
|
||||
TTextChangedEvent = procedure(Sender: TObject; Pos, Count, LineChange: integer) of object;
|
||||
|
||||
type
|
||||
{ TATStringBuffer }
|
||||
|
||||
TATStringBuffer = class
|
||||
private
|
||||
FStarts: TList; //contains offsets of lines
|
||||
FLenEol: integer;
|
||||
FOnChange: TTextChangedEvent;
|
||||
public
|
||||
FText: atString;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Setup(const AText: atString; ALineLens: TList; ALenEol: integer);
|
||||
procedure SetupSlow(const AText: atString);
|
||||
procedure Clear;
|
||||
function CaretToStr(APnt: TPoint): integer;
|
||||
function StrToCaret(APos: integer): TPoint;
|
||||
function SubString(AFrom, ALen: integer): atString;
|
||||
function TextLength: integer;
|
||||
function LineIndex(N: integer): integer;
|
||||
function LineLength(N: integer): integer;
|
||||
function LineSpace(N: integer): integer;
|
||||
function Count: integer;
|
||||
property OnChange: TTextChangedEvent read FOnChange write FOnChange;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
cInitListCapacity = 10000;
|
||||
|
||||
{ TATStringBuffer }
|
||||
|
||||
constructor TATStringBuffer.Create;
|
||||
begin
|
||||
FText:= '';
|
||||
FStarts:= TList.Create;
|
||||
FStarts.Capacity:= cInitListCapacity;
|
||||
FLenEol:= 1;
|
||||
end;
|
||||
|
||||
destructor TATStringBuffer.Destroy;
|
||||
begin
|
||||
FStarts.Clear;
|
||||
FreeAndNil(FStarts);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TATStringBuffer.Setup(const AText: atString; ALineLens: TList;
|
||||
ALenEol: integer);
|
||||
var
|
||||
Pos, NLen, i: integer;
|
||||
begin
|
||||
FText:= AText;
|
||||
FLenEol:= ALenEol;
|
||||
|
||||
FStarts.Clear;
|
||||
Pos:= 0;
|
||||
FStarts.Add(nil);
|
||||
for i:= 0 to ALineLens.Count-1 do
|
||||
begin
|
||||
NLen:= integer(ALineLens[i]);
|
||||
Inc(Pos, NLen+FLenEol);
|
||||
FStarts.Add(pointer(Pos));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStringBuffer.SetupSlow(const AText: atString);
|
||||
var
|
||||
STextFinal: atString;
|
||||
L: TStringList;
|
||||
Lens: TList;
|
||||
i: integer;
|
||||
begin
|
||||
if Trim(AText)='' then
|
||||
begin
|
||||
FText:= '';
|
||||
FStarts.Clear;
|
||||
Exit
|
||||
end;
|
||||
|
||||
L:= TStringList.Create;
|
||||
Lens:= TList.Create;
|
||||
try
|
||||
L.TextLineBreakStyle:= tlbsLF;
|
||||
L.Text:= UTF8Encode(AText);
|
||||
STextFinal:= UTF8Decode(L.Text); //this converts eol to LF
|
||||
for i:= 0 to L.Count-1 do
|
||||
Lens.Add(pointer(Length(UTF8Decode(L[i]))));
|
||||
Setup(STextFinal, Lens, 1);
|
||||
finally
|
||||
FreeAndNil(Lens);
|
||||
FreeAndNil(L);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStringBuffer.Clear;
|
||||
begin
|
||||
FText:= '';
|
||||
FStarts.Clear;
|
||||
end;
|
||||
|
||||
function TATStringBuffer.CaretToStr(APnt: TPoint): integer;
|
||||
var
|
||||
Len: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
if (APnt.Y<0) then Exit;
|
||||
if (APnt.X<0) then Exit;
|
||||
if (APnt.Y>=FStarts.Count) then Exit;
|
||||
|
||||
//handle caret pos after eol
|
||||
Len:= LineLength(APnt.Y);
|
||||
if APnt.X>Len then
|
||||
APnt.X:= Len;
|
||||
|
||||
Result:= integer(FStarts[APnt.Y])+APnt.X;
|
||||
end;
|
||||
|
||||
function TATStringBuffer.StrToCaret(APos: integer): TPoint;
|
||||
var
|
||||
a, b, m, dif: integer;
|
||||
begin
|
||||
Result.Y:= -1;
|
||||
Result.X:= 0;
|
||||
if APos<=0 then
|
||||
begin Result.Y:= 0; Exit end;
|
||||
|
||||
a:= 0;
|
||||
b:= FStarts.Count-1;
|
||||
if b<0 then Exit;
|
||||
|
||||
repeat
|
||||
dif:= integer(FStarts[a])-APos;
|
||||
if dif=0 then begin m:= a; Break end;
|
||||
|
||||
//middle, which is near b if not exact middle
|
||||
m:= (a+b+1) div 2;
|
||||
|
||||
dif:= integer(FStarts[m])-APos;
|
||||
if dif=0 then Break;
|
||||
|
||||
if Abs(a-b)<=1 then begin m:= a; Break end;
|
||||
if dif>0 then b:= m else a:= m;
|
||||
until false;
|
||||
|
||||
Result.Y:= m;
|
||||
Result.X:= APos-integer(FStarts[Result.Y]);
|
||||
end;
|
||||
|
||||
function TATStringBuffer.SubString(AFrom, ALen: integer): atString;
|
||||
begin
|
||||
Result:= Copy(FText, AFrom, ALen);
|
||||
end;
|
||||
|
||||
function TATStringBuffer.TextLength: integer;
|
||||
begin
|
||||
Result:= Length(FText);
|
||||
end;
|
||||
|
||||
function TATStringBuffer.LineIndex(N: integer): integer;
|
||||
begin
|
||||
if N<0 then Result:= 0
|
||||
else
|
||||
if N>=FStarts.Count then Result:= TextLength-1
|
||||
else
|
||||
Result:= integer(FStarts[N]);
|
||||
end;
|
||||
|
||||
function TATStringBuffer.LineLength(N: integer): integer;
|
||||
begin
|
||||
if N<0 then Result:= 0
|
||||
else
|
||||
if N>=FStarts.Count-1 then Result:= 0
|
||||
else
|
||||
Result:= integer(FStarts[N+1])-integer(FStarts[N])-FLenEol;
|
||||
end;
|
||||
|
||||
function TATStringBuffer.LineSpace(N: integer): integer;
|
||||
begin
|
||||
Result:= LineLength(N)+FLenEol;
|
||||
end;
|
||||
|
||||
function TATStringBuffer.Count: integer;
|
||||
begin
|
||||
Result:= FStarts.Count;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
68
ATSynEdit/atsynedit/atstringproc_utf8detect.pas
Normal file
68
ATSynEdit/atsynedit/atstringproc_utf8detect.pas
Normal file
@@ -0,0 +1,68 @@
|
||||
|
||||
//Code by Christian Ghisler (ghisler.com)
|
||||
//Christian gave code to open-source at TCmd forum
|
||||
|
||||
unit atstringproc_utf8detect;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
//PartialAllowed must be set to true if the buffer is smaller than the file.
|
||||
function IsBufferUtf8(buf:PAnsiChar;PartialAllowed:boolean):boolean;
|
||||
|
||||
implementation
|
||||
|
||||
const bytesFromUTF8:array[AnsiChar] of byte = (
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 32
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 64
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 96
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //128
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //160
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, //192
|
||||
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, //224
|
||||
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5); //256
|
||||
|
||||
function GetUtf8CharWidth(firstchar:AnsiChar):integer;
|
||||
begin
|
||||
result:=bytesFromUTF8[firstchar]+1;
|
||||
end;
|
||||
|
||||
function IsFirstUTF8Char(thechar:AnsiChar):boolean;
|
||||
{The remaining bytes in a multi-byte sequence have 10 as their two most significant bits.}
|
||||
begin
|
||||
result:=(byte(thechar) and (128+64))<>128;
|
||||
end;
|
||||
|
||||
function IsSecondaryUTF8Char(thechar:AnsiChar):boolean;
|
||||
{The remaining bytes in a multi-byte sequence have 10 as their two most significant bits.}
|
||||
begin
|
||||
result:=(byte(thechar) and (128+64))=128;
|
||||
end;
|
||||
|
||||
function IsBufferUtf8(buf:PAnsiChar;PartialAllowed:boolean):boolean;
|
||||
{Buffer contains only valid UTF-8 characters, no secondary alone,
|
||||
no primary without the correct nr of secondary}
|
||||
var p:PAnsiChar;
|
||||
utf8bytes:integer;
|
||||
hadutf8bytes:boolean;
|
||||
begin
|
||||
p:=buf;
|
||||
hadutf8bytes:=false;
|
||||
result:=false;
|
||||
utf8bytes:=0;
|
||||
while p[0]<>#0 do begin
|
||||
if utf8bytes>0 then begin {Expecting secondary AnsiChar}
|
||||
hadutf8bytes:=true;
|
||||
if not IsSecondaryUTF8Char(p[0]) then exit; {Fail!}
|
||||
dec(utf8bytes);
|
||||
end else if IsFirstUTF8Char(p[0]) then
|
||||
utf8bytes:=GetUtf8CharWidth(p[0])-1
|
||||
else if IsSecondaryUTF8Char(p[0]) then
|
||||
exit; {Fail!}
|
||||
inc(p);
|
||||
end;
|
||||
result:=hadutf8bytes and (PartialAllowed or (utf8bytes=0));
|
||||
end;
|
||||
|
||||
end.
|
||||
105
ATSynEdit/atsynedit/atstringproc_wordjump.pas
Normal file
105
ATSynEdit/atsynedit/atstringproc_wordjump.pas
Normal file
@@ -0,0 +1,105 @@
|
||||
unit ATStringProc_WordJump;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
ATStringProc;
|
||||
|
||||
function SFindWordOffset(const S: atString; AOffset: integer; ANext, ABigJump: boolean;
|
||||
const AWordChars: atString): integer;
|
||||
procedure SFindWordBounds(const S: atString; AOffset: integer; out AOffset1, AOffset2: integer;
|
||||
const AWordChars: atString);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
//no EOL here, we jump only inside line
|
||||
cCharsSp: atString = ' '#9;
|
||||
//no chars '@' (email) and '$' (used in php)
|
||||
cCharsSymb: atString = '!"#%&''()[]{}<>*+-/=,.:;?\^`|~‚„…‹›‘’“”–—¦«»±';
|
||||
|
||||
|
||||
type
|
||||
TCharGr = (cgSp, cgSymb, cgWord);
|
||||
|
||||
function SCharGr(ch: atChar; const AWordChars: atString): TCharGr;
|
||||
begin
|
||||
if (AWordChars<>'') and (Pos(ch, AWordChars)>0) then Result:= cgWord else
|
||||
if Pos(ch, cCharsSp)>0 then Result:= cgSp else
|
||||
if Pos(ch, cCharsSymb)>0 then Result:= cgSymb else
|
||||
Result:= cgWord;
|
||||
end;
|
||||
|
||||
function SFindWordOffset(const S: atString; AOffset: integer; ANext,
|
||||
ABigJump: boolean; const AWordChars: atString): integer;
|
||||
var
|
||||
n: integer;
|
||||
//------------
|
||||
procedure Next;
|
||||
var gr: TCharGr;
|
||||
begin
|
||||
if not ((n>=0) and (n<Length(s))) then Exit;
|
||||
gr:= SCharGr(s[n+1], AWordChars);
|
||||
repeat Inc(n)
|
||||
until
|
||||
(n>=Length(s)) or (SCharGr(s[n+1], AWordChars)<>gr);
|
||||
end;
|
||||
//------------
|
||||
procedure Home;
|
||||
var gr: TCharGr;
|
||||
begin
|
||||
if not ((n>0) and (n<Length(s))) then Exit;
|
||||
gr:= SCharGr(s[n+1], AWordChars);
|
||||
while (n>0) and (SCharGr(s[n], AWordChars)=gr) do
|
||||
Dec(n);
|
||||
end;
|
||||
//------------
|
||||
begin
|
||||
n:= AOffset;
|
||||
if ANext then
|
||||
begin
|
||||
Next;
|
||||
if ABigJump then
|
||||
if (n<Length(s)) and (SCharGr(s[n+1], AWordChars)= cgSp) then
|
||||
Next;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//if we at word middle, jump to word start
|
||||
if (n>0) and (n<Length(s)) and (SCharGr(s[n], AWordChars)=SCharGr(s[n+1], AWordChars)) then
|
||||
Home
|
||||
else
|
||||
begin
|
||||
//jump lefter, then jump to prev word start
|
||||
if (n>0) then
|
||||
begin Dec(n); Home end;
|
||||
if ABigJump then
|
||||
if (n>0) and (SCharGr(s[n+1], AWordChars)= cgSp) then
|
||||
begin Dec(n); Home end;
|
||||
end
|
||||
end;
|
||||
Result:= n;
|
||||
end;
|
||||
|
||||
procedure SFindWordBounds(const S: atString; AOffset: integer; out AOffset1,
|
||||
AOffset2: integer; const AWordChars: atString);
|
||||
begin
|
||||
AOffset1:= AOffset;
|
||||
AOffset2:= AOffset;
|
||||
|
||||
if (AOffset>=0) and (AOffset<Length(S)) and
|
||||
IsCharWord(S[AOffset+1], AWordChars) then
|
||||
begin
|
||||
//jump left only if at middle of word
|
||||
if (AOffset>0) and IsCharWord(S[AOffset], AWordChars) then
|
||||
AOffset1:= SFindWordOffset(S, AOffset, false, false, AWordChars);
|
||||
//jump right always
|
||||
AOffset2:= SFindWordOffset(S, AOffset, true, false, AWordChars);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
1118
ATSynEdit/atsynedit/atstrings.pas
Normal file
1118
ATSynEdit/atsynedit/atstrings.pas
Normal file
File diff suppressed because it is too large
Load Diff
355
ATSynEdit/atsynedit/atstrings_editing.inc
Normal file
355
ATSynEdit/atsynedit/atstrings_editing.inc
Normal file
@@ -0,0 +1,355 @@
|
||||
{$ifdef none}begin end;{$endif}
|
||||
|
||||
procedure TATStrings.TextInsert(AX, AY: integer; const AText: atString; AOverwrite: boolean; out AShift, APosAfter: TPoint);
|
||||
var
|
||||
Str, StrLead, StrTail: atString;
|
||||
List: TATStrings;
|
||||
bWithEol, bInsertAtEnd: boolean;
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
if AX<0 then Exit;
|
||||
if AText='' then Exit;
|
||||
|
||||
Str:= Lines[AY];
|
||||
bInsertAtEnd:= AX>=Length(Str);
|
||||
|
||||
if not bInsertAtEnd then
|
||||
begin
|
||||
StrLead:= Copy(Str, 1, AX);
|
||||
StrTail:= Copy(Str, AX+1, MaxInt);
|
||||
end
|
||||
else
|
||||
begin
|
||||
StrLead:= Str+StringOfChar(' ', AX-Length(Str));
|
||||
StrTail:= '';
|
||||
end;
|
||||
|
||||
if AOverwrite then
|
||||
Delete(StrTail, 1, Length(AText));
|
||||
|
||||
//------------------
|
||||
//Insert single line
|
||||
|
||||
if not SWithBreaks(AText) then
|
||||
begin
|
||||
Lines[AY]:= StrLead+AText+StrTail;
|
||||
if not AOverwrite then
|
||||
AShift.X:= Length(AText);
|
||||
APosAfter.X:= AX+Length(AText);
|
||||
Exit
|
||||
end;
|
||||
|
||||
//----------------------
|
||||
//Insert multi-line text
|
||||
|
||||
List:= TATStrings.Create;
|
||||
BeginUndoGroup;
|
||||
try
|
||||
List.LoadFromString(StrLead+AText);
|
||||
List.ActionDeleteFakeLine;
|
||||
if List.Count=0 then Exit;
|
||||
|
||||
if StrTail<>'' then
|
||||
Lines[AY]:= StrTail
|
||||
else
|
||||
if Lines[AY]<>'' then
|
||||
LineDelete(AY);
|
||||
|
||||
bWithEol:= SEndsWith(AText, #10) or
|
||||
SEndsWith(AText, #13) or
|
||||
bInsertAtEnd //need for (paste N lines, no final eol, at end of line)
|
||||
;
|
||||
LineInsertStrings(AY, List, bWithEol);
|
||||
|
||||
if bWithEol then
|
||||
begin
|
||||
APosAfter.X:= 0;
|
||||
APosAfter.Y:= AY+List.Count;
|
||||
end
|
||||
else
|
||||
begin
|
||||
APosAfter.X:= Length(List.Lines[List.Count-1]);
|
||||
APosAfter.Y:= AY+List.Count-1;
|
||||
end;
|
||||
AShift.Y:= APosAfter.Y-AY;
|
||||
|
||||
finally
|
||||
FreeAndNil(List);
|
||||
EndUndoGroup;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextDeleteLeft(AX, AY: integer; ALen: integer; out AShift,
|
||||
APosAfter: TPoint);
|
||||
var
|
||||
Str, StrPrev: atString;
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
Str:= Lines[AY];
|
||||
|
||||
//handle spec case: caret on last fake line, BkSp pressed:
|
||||
//delete fake line,
|
||||
//delete EOL at prev line
|
||||
if (AX=0) and (AY=Count-1) and (AY>0) and IsLastLineFake then
|
||||
begin
|
||||
LineDelete(AY, false);
|
||||
LinesEnds[AY-1]:= cEndNone;
|
||||
AShift.Y:= -1;
|
||||
APosAfter.X:= Length(Lines[AY-1]);
|
||||
APosAfter.Y:= AY-1;
|
||||
exit
|
||||
end;
|
||||
|
||||
if AX>0 then
|
||||
begin
|
||||
if AX<=Length(Str) then
|
||||
begin
|
||||
System.Delete(Str, Max(1, AX+1-ALen), ALen);
|
||||
Lines[AY]:= Str;
|
||||
end;
|
||||
AShift.X:= -Min(AX, ALen);
|
||||
APosAfter.X:= Max(0, AX-ALen);
|
||||
end
|
||||
else
|
||||
if AY>0 then
|
||||
begin
|
||||
StrPrev:= Lines[AY-1];
|
||||
Lines[AY-1]:= StrPrev+Str;
|
||||
LineDelete(AY);
|
||||
AShift.Y:= -1;
|
||||
APosAfter.X:= Length(StrPrev);
|
||||
APosAfter.Y:= AY-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextDeleteRight(AX, AY: integer; ALen: integer; out AShift,
|
||||
APosAfter: TPoint; ACanDelEol: boolean = true);
|
||||
var
|
||||
Str: atString;
|
||||
DelEol: boolean;
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
Str:= Lines[AY];
|
||||
|
||||
//special case: last fake line
|
||||
if (AY=Count-1) and (Str='') and (LinesEnds[AY]=cEndNone) then
|
||||
Exit;
|
||||
|
||||
DelEol:= false;
|
||||
if AX<Length(Str) then
|
||||
begin
|
||||
System.Delete(Str, AX+1, ALen);
|
||||
Lines[AY]:= Str;
|
||||
AShift.X:= -ALen;
|
||||
end
|
||||
else
|
||||
DelEol:= ACanDelEol;
|
||||
|
||||
if DelEol then
|
||||
if Str='' then //handle for simpler line-states
|
||||
begin
|
||||
AShift.Y:= -1;
|
||||
if (AY>0) and (AY=Count-1) then
|
||||
begin
|
||||
APosAfter.X:= 0;
|
||||
APosAfter.Y:= AY-1;
|
||||
end;
|
||||
LineDelete(AY);
|
||||
end
|
||||
else
|
||||
begin
|
||||
//add spaces if we are after eol
|
||||
if AX>=Length(Str) then
|
||||
Str:= Str+StringOfChar(' ', AX-Length(Str));
|
||||
|
||||
//not last: del next line
|
||||
if AY+1<Count then
|
||||
begin
|
||||
Lines[AY]:= Str+Lines[AY+1];
|
||||
LineDelete(AY+1, false{not force});
|
||||
//maybe also eol
|
||||
if AY=Count-1 then
|
||||
LinesEnds[AY]:= cEndNone;
|
||||
end
|
||||
else
|
||||
//last line: del eol
|
||||
LinesEnds[AY]:= cEndNone;
|
||||
|
||||
AShift.Y:= -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextDeleteRange(AFromX, AFromY, AToX, AToY: integer;
|
||||
out AShift, APosAfter: TPoint);
|
||||
var
|
||||
Str: atString;
|
||||
bDelEmpty: boolean;
|
||||
bNoEol: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AFromX;
|
||||
APosAfter.Y:= AFromY;
|
||||
if not IsIndexValid(AFromY) then Exit;
|
||||
if not IsIndexValid(AToY) then Exit;
|
||||
if (AFromX=AToX) and (AFromY=AToY) then Exit;
|
||||
if (AFromY>AToY) then Exit;
|
||||
|
||||
if AFromY=AToY then
|
||||
begin
|
||||
//delete range in one line
|
||||
Str:= Lines[AFromY];
|
||||
Delete(Str, AFromX+1, AToX-AFromX);
|
||||
Lines[AFromY]:= Str;
|
||||
|
||||
AShift.X:= -(AToX-AFromX);
|
||||
end
|
||||
else
|
||||
begin
|
||||
bDelEmpty:= false;
|
||||
//correct AToX/AToY to not del extra empty line
|
||||
if (AToX=0) and (Lines[AToY]='') then //for empty last line
|
||||
begin
|
||||
AToY:= Max(0, AToY-1);
|
||||
AToX:= Length(Lines[AToY]);
|
||||
bDelEmpty:= true;
|
||||
end;
|
||||
|
||||
//remember no final Eol
|
||||
bNoEol:= (AToY=Count-1) and (LinesEnds[AToY]=cEndNone);
|
||||
|
||||
//place ramaining parts of 1st+last lines
|
||||
Str:= Copy(Lines[AFromY], 1, AFromX) + Copy(Lines[AToY], AToX+1, MaxInt);
|
||||
Lines[AFromY]:= Str;
|
||||
|
||||
//del middle lines
|
||||
for i:= AToY downto AFromY+1 do
|
||||
LineDelete(i);
|
||||
|
||||
//del empty line?
|
||||
if bDelEmpty then
|
||||
if Str='' then
|
||||
LineDelete(AFromY);
|
||||
|
||||
if bNoEol then
|
||||
begin
|
||||
ActionDeleteFakeLine;
|
||||
if Count>0 then
|
||||
LinesEnds[Count-1]:= cEndNone;
|
||||
end;
|
||||
|
||||
AShift.Y:= -(AToY-AFromY);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATStrings.TextInsertColumnBlock(AX, AY: integer; ABlock: TATStrings; AOverwrite: boolean);
|
||||
var
|
||||
Shift, PosAfter: TPoint;
|
||||
i: integer;
|
||||
begin
|
||||
for i:= 0 to ABlock.Count-1 do
|
||||
begin
|
||||
TextInsert(AX, AY+i, ABlock.Lines[i], AOverwrite, Shift, PosAfter);
|
||||
LinesEnds[AY+i]:= Endings; //force eol
|
||||
if not IsIndexValid(AY+i+1) then
|
||||
LineAddRaw('', cEndNone);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextInsertEol(AX, AY: integer; AKeepCaret: boolean; const AStrIndent: atString; out AShift, APosAfter: TPoint);
|
||||
var
|
||||
Str, StrMove: atString;
|
||||
NewEnd: TATLineEnds;
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
|
||||
Str:= Lines[AY];
|
||||
StrMove:= '';
|
||||
|
||||
//special case AX=0: just insert empty line
|
||||
//(less changes in undo)
|
||||
if AX=0 then
|
||||
begin
|
||||
LineInsertRaw(AY, '', Endings);
|
||||
end
|
||||
else
|
||||
begin
|
||||
BeginUndoGroup;
|
||||
|
||||
if (AX<Length(Str)) then
|
||||
begin
|
||||
StrMove:= Copy(Str, AX+1, MaxInt);
|
||||
Delete(Str, AX+1, MaxInt);
|
||||
Lines[AY]:= Str;
|
||||
end;
|
||||
|
||||
//handle situation when we at non-eol line, this must give
|
||||
//inserted line also w/o eol
|
||||
NewEnd:= LinesEnds[AY];
|
||||
LinesEnds[AY]:= Endings; //force eol to cur line
|
||||
LineInsertRaw(AY+1, AStrIndent+StrMove, NewEnd);
|
||||
|
||||
EndUndoGroup;
|
||||
end;
|
||||
|
||||
if not AKeepCaret then
|
||||
begin
|
||||
APosAfter.X:= Length(AStrIndent);
|
||||
APosAfter.Y:= AY+1;
|
||||
AShift.Y:= 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextDeleteLine(AX, AY: integer; out AShift, APosAfter: TPoint);
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
|
||||
AShift.Y:= -1;
|
||||
APosAfter.X:= 0;
|
||||
|
||||
LineDelete(AY);
|
||||
if AY>=Count then
|
||||
LineAddEx('', cEndNone);
|
||||
end;
|
||||
|
||||
procedure TATStrings.TextDuplicateLine(AX, AY: integer; out AShift, APosAfter: TPoint);
|
||||
begin
|
||||
AShift.X:= 0;
|
||||
AShift.Y:= 0;
|
||||
APosAfter.X:= AX;
|
||||
APosAfter.Y:= AY;
|
||||
if not IsIndexValid(AY) then Exit;
|
||||
|
||||
LineInsert(AY+1, Lines[AY]);
|
||||
|
||||
if LinesEnds[AY]<>Endings then
|
||||
LinesEnds[AY]:= Endings;
|
||||
LinesEnds[AY+1]:= Endings;
|
||||
|
||||
AShift.Y:= 1;
|
||||
end;
|
||||
|
||||
|
||||
299
ATSynEdit/atsynedit/atstrings_load.inc
Normal file
299
ATSynEdit/atsynedit/atstrings_load.inc
Normal file
@@ -0,0 +1,299 @@
|
||||
{$ifdef nn}begin end;{$endif}
|
||||
|
||||
function IsStreamWithSignature(Stream: TStream; const Sign: AnsiString): boolean;
|
||||
var
|
||||
Buf: AnsiString;
|
||||
begin
|
||||
Result:= false;
|
||||
if Stream.Size<Length(Sign) then Exit;
|
||||
SetLength(Buf, Length(Sign));
|
||||
Stream.Position:= 0;
|
||||
Stream.ReadBuffer(Buf[1], Length(Sign));
|
||||
Stream.Position:= 0;
|
||||
Result:= Buf=Sign;
|
||||
end;
|
||||
|
||||
function IsStreamWithUt8NoBom(Stream: TStream; BufSizeKb: word): boolean;
|
||||
const
|
||||
cMinLen = 15;
|
||||
var
|
||||
Buf: PChar;
|
||||
Size: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
if Stream.Size<cMinLen then Exit;
|
||||
|
||||
if BufSizeKb=0 then BufSizeKb:= 1;
|
||||
Size:= BufSizeKb*1024;
|
||||
GetMem(Buf, Size);
|
||||
try
|
||||
FillChar(Buf^, Size, 0);
|
||||
Stream.Position:= 0;
|
||||
Stream.Read(Buf^, Size-1{trail zero});
|
||||
Stream.Position:= 0;
|
||||
Result:= IsBufferUtf8(Buf, true);
|
||||
finally
|
||||
FreeMem(Buf);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoDetectStreamEncoding(Stream: TStream;
|
||||
out Enc: TATFileEncoding;
|
||||
out SignLen: integer;
|
||||
out EncWithBom: boolean;
|
||||
BufSizeKb: integer);
|
||||
begin
|
||||
Enc:= cEncAnsi;
|
||||
EncWithBom:= true;
|
||||
SignLen:= 0;
|
||||
|
||||
if IsStreamWithSignature(Stream, cSignUTF8) then
|
||||
begin
|
||||
Enc:= cEncUTF8;
|
||||
SignLen:= Length(cSignUTF8);
|
||||
Exit
|
||||
end;
|
||||
|
||||
if IsStreamWithSignature(Stream, cSignWideLE) then
|
||||
begin
|
||||
Enc:= cEncWideLE;
|
||||
SignLen:= Length(cSignWideLE);
|
||||
Exit
|
||||
end;
|
||||
|
||||
if IsStreamWithSignature(Stream, cSignWideBE) then
|
||||
begin
|
||||
Enc:= cEncWideBE;
|
||||
SignLen:= Length(cSignWideBE);
|
||||
Exit
|
||||
end;
|
||||
|
||||
if IsStreamWithUt8NoBom(Stream, BufSizeKb) then
|
||||
begin
|
||||
Enc:= cEncUTF8;
|
||||
EncWithBom:= false;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATStrings.LoadFromString(const AText: atString);
|
||||
var
|
||||
MS: TMemoryStream;
|
||||
i: integer;
|
||||
begin
|
||||
if ReadOnly then exit;
|
||||
Clear;
|
||||
if AText='' then
|
||||
begin
|
||||
ActionAddFakeLineIfNeeded;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
MS:= TMemoryStream.Create;
|
||||
try
|
||||
MS.Write(AText[1], Length(AText)*SizeOf(atChar));
|
||||
MS.Position:= 0;
|
||||
|
||||
Encoding:= cEncWideLE;
|
||||
EncodingDetect:= false;
|
||||
LoadFromStream(MS);
|
||||
ActionAddFakeLineIfNeeded;
|
||||
finally
|
||||
FreeAndNil(MS);
|
||||
end;
|
||||
|
||||
Modified:= true;
|
||||
for i:= 0 to Count-1 do
|
||||
SetLineState(i, cLineStateAdded);
|
||||
end;
|
||||
|
||||
procedure TATStrings.DoLoadFromStream(Stream: TStream);
|
||||
var
|
||||
Buf: PAnsiChar;
|
||||
BufSize: int64;
|
||||
CharSize: integer;
|
||||
|
||||
function _BufferCharCode(NPos: integer): Word;
|
||||
begin
|
||||
case FEncoding of
|
||||
cEncAnsi,
|
||||
cEncUTF8:
|
||||
Result:= PByte(Buf)[NPos];
|
||||
cEncWideLE:
|
||||
Result:= PByte(Buf)[NPos] + $100 * PByte(Buf)[NPos+1];
|
||||
cEncWideBE:
|
||||
Result:= PByte(Buf)[NPos+1] + $100 * PByte(Buf)[NPos];
|
||||
else
|
||||
DoEncError;
|
||||
end;
|
||||
end;
|
||||
|
||||
function _FindNextEol(NPos: integer): integer;
|
||||
begin
|
||||
Result:= NPos;
|
||||
while (Result<BufSize) and not IsCharEol(Widechar(_BufferCharCode(Result))) do
|
||||
Inc(Result, CharSize);
|
||||
end;
|
||||
|
||||
var
|
||||
NStart, NEnd, Len: integer;
|
||||
SA: AnsiString;
|
||||
SW: UnicodeString;
|
||||
LineEnd: TATLineEnds;
|
||||
bWithBom, bEncoded: boolean;
|
||||
NPercents: integer;
|
||||
begin
|
||||
Clear;
|
||||
|
||||
Len:= 0;
|
||||
if FEncodingDetect then
|
||||
begin
|
||||
DoDetectStreamEncoding(Stream, FEncoding, Len, bWithBom, FEncodingDetectBufSizeKb);
|
||||
case FEncoding of
|
||||
cEncUTF8: SaveSignUtf8:= bWithBom;
|
||||
cEncWideBE,
|
||||
cEncWideLE: SaveSignWide:= bWithBom;
|
||||
end;
|
||||
end;
|
||||
CharSize:= cEncodingSize[FEncoding];
|
||||
|
||||
BufSize:= Stream.Size-Len;
|
||||
if BufSize<=0 then Exit;
|
||||
|
||||
GetMem(Buf, BufSize);
|
||||
try
|
||||
Stream.Position:= Len;
|
||||
Stream.ReadBuffer(Buf^, BufSize);
|
||||
|
||||
NStart:= 0;
|
||||
repeat
|
||||
NEnd:= _FindNextEol(NStart);
|
||||
Len:= NEnd-NStart;
|
||||
|
||||
if Stream.Size>=cMinSizeForProgress then
|
||||
begin
|
||||
NPercents:= Int64(NEnd)*100 div Stream.Size;
|
||||
if Abs(NPercents-FProgress)>=cMinIncForProgress then
|
||||
begin
|
||||
FProgress:= NPercents;
|
||||
if Assigned(FOnProgress) then
|
||||
FOnProgress(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
//detect+skip Eol
|
||||
LineEnd:= cEndNone;
|
||||
if (Int64(NEnd)+CharSize<BufSize) and (_BufferCharCode(NEnd)=13) and (_BufferCharCode(NEnd+CharSize)=10) then
|
||||
begin
|
||||
LineEnd:= cEndWin;
|
||||
Inc(NEnd, CharSize*2);
|
||||
end
|
||||
else
|
||||
if (NEnd<BufSize) and (_BufferCharCode(NEnd)=10) then
|
||||
begin
|
||||
LineEnd:= cEndUnix;
|
||||
Inc(NEnd, CharSize);
|
||||
end
|
||||
else
|
||||
if (NEnd<BufSize) and (_BufferCharCode(NEnd)=13) then
|
||||
begin
|
||||
LineEnd:= cEndMac;
|
||||
Inc(NEnd, CharSize);
|
||||
end
|
||||
else
|
||||
Inc(NEnd, CharSize);
|
||||
|
||||
if Len=0 then
|
||||
LineAddRaw('', LineEnd)
|
||||
else
|
||||
begin
|
||||
case FEncoding of
|
||||
cEncAnsi:
|
||||
begin
|
||||
SA:= '';
|
||||
SetLength(SA, Len);
|
||||
Move(Buf[NStart], SA[1], Len);
|
||||
|
||||
//if codepage set, convert string->utf8->UnicodeString
|
||||
//else just string->UnicodeString
|
||||
if FEncodingCodepage='' then
|
||||
SW:= SA
|
||||
else
|
||||
begin
|
||||
{$ifdef laz15}
|
||||
SA:= ConvertEncodingToUTF8(SA, FEncodingCodepage, bEncoded);
|
||||
{$else}
|
||||
SA:= ConvertEncoding(SA, FEncodingCodepage, '');
|
||||
{$endif}
|
||||
SW:= UTF8Decode(SA);
|
||||
end;
|
||||
|
||||
LineAddRaw(SW, LineEnd);
|
||||
end;
|
||||
|
||||
cEncUTF8:
|
||||
begin
|
||||
SA:= '';
|
||||
SetLength(SA, Len);
|
||||
Move(Buf[NStart], SA[1], Len);
|
||||
SW:= UTF8Decode(SA);
|
||||
LineAddRaw(SW, LineEnd);
|
||||
end;
|
||||
|
||||
cEncWideLE,
|
||||
cEncWideBE:
|
||||
begin
|
||||
SW:= '';
|
||||
SetLength(SW, Len div 2);
|
||||
Move(Buf[NStart], SW[1], Len);
|
||||
if FEncoding=cEncWideBE then
|
||||
SW:= SSwapEndian(SW);
|
||||
LineAddRaw(SW, LineEnd);
|
||||
end;
|
||||
|
||||
else
|
||||
DoEncError;
|
||||
end;
|
||||
end;
|
||||
|
||||
NStart:= NEnd;
|
||||
if (NStart>=BufSize) then Break;
|
||||
until false;
|
||||
|
||||
finally
|
||||
FreeMem(Buf);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.LoadFromStream(Stream: TStream);
|
||||
begin
|
||||
DoClearUndo(true);
|
||||
DoLoadFromStream(Stream);
|
||||
DoFinalizeLoading;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATStrings.LoadFromFile(const Filename: string);
|
||||
var
|
||||
fs: TFileStream;
|
||||
begin
|
||||
fs:= TFileStream.Create(Filename, fmOpenRead);
|
||||
try
|
||||
LoadFromStream(fs);
|
||||
finally
|
||||
FreeAndNil(fs);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.DoFinalizeLoading;
|
||||
begin
|
||||
DoDetectEndings;
|
||||
ActionAddFakeLineIfNeeded;
|
||||
DoClearLineStates(false);
|
||||
DoClearUndo;
|
||||
Modified:= false;
|
||||
FProgress:= 0;
|
||||
end;
|
||||
|
||||
|
||||
102
ATSynEdit/atsynedit/atstrings_save.inc
Normal file
102
ATSynEdit/atsynedit/atstrings_save.inc
Normal file
@@ -0,0 +1,102 @@
|
||||
{$ifdef nn}begin end;{$endif}
|
||||
|
||||
procedure TATStrings.SaveToStream(Stream: TStream; AEncoding: TATFileEncoding; AWithSignature: boolean);
|
||||
var
|
||||
i: integer;
|
||||
Item: TATStringItem;
|
||||
SA: AnsiString;
|
||||
SW: UnicodeString;
|
||||
Sign: AnsiString;
|
||||
bEncoded: boolean;
|
||||
begin
|
||||
if AWithSignature then
|
||||
begin
|
||||
Sign:= '';
|
||||
case FEncoding of
|
||||
cEncUTF8: Sign:= cSignUTF8;
|
||||
cEncWideLE: Sign:= cSignWideLE;
|
||||
cEncWideBE: Sign:= cSignWideBE;
|
||||
end;
|
||||
if Sign<>'' then
|
||||
Stream.WriteBuffer(Sign[1], Length(Sign));
|
||||
end;
|
||||
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Item:= TATStringItem(FList[i]);
|
||||
SW:= Item.ItemString + cLineEndStrings[Item.ItemEnd];
|
||||
if SW<>'' then
|
||||
case AEncoding of
|
||||
cEncAnsi:
|
||||
begin
|
||||
//if codepage set, convert UnicodeString->utf8->Ansistring
|
||||
//else just UnicodeString->Ansistring
|
||||
if FEncodingCodepage='' then
|
||||
SA:= SW
|
||||
else
|
||||
begin
|
||||
SA:= UTF8Encode(SW);
|
||||
{$ifdef laz15}
|
||||
SA:= ConvertEncodingFromUTF8(SA, FEncodingCodepage, bEncoded);
|
||||
{$else}
|
||||
SA:= ConvertEncoding(SA, '', FEncodingCodepage);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
Stream.WriteBuffer(SA[1], Length(SA));
|
||||
end;
|
||||
|
||||
cEncUTF8:
|
||||
begin
|
||||
SA:= UTF8Encode(SW);
|
||||
Stream.WriteBuffer(SA[1], Length(SA));
|
||||
end;
|
||||
|
||||
cEncWideLE,
|
||||
cEncWideBE:
|
||||
begin
|
||||
if AEncoding=cEncWideBE then
|
||||
SW:= SSwapEndian(SW);
|
||||
Stream.WriteBuffer(SW[1], Length(SW)*2);
|
||||
end;
|
||||
|
||||
else
|
||||
DoEncError;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATStrings.SaveToFile(const AFilename: string);
|
||||
var
|
||||
fs: TFileStream;
|
||||
WithSign: boolean;
|
||||
begin
|
||||
WithSign:=
|
||||
((FEncoding in [cEncUTF8]) and FSaveSignUtf8) or
|
||||
((FEncoding in [cEncWideLE, cEncWideBE]) and FSaveSignWide);
|
||||
|
||||
fs:= TFileStream.Create(AFilename, fmCreate or fmOpenWrite);
|
||||
try
|
||||
SaveToStream(fs, FEncoding, WithSign);
|
||||
finally
|
||||
FreeAndNil(fs);
|
||||
end;
|
||||
|
||||
DoFinalizeSaving;
|
||||
end;
|
||||
|
||||
procedure TATStrings.DoFinalizeSaving;
|
||||
begin
|
||||
DoClearLineStates(true);
|
||||
|
||||
if not FUndoAfterSave then
|
||||
DoClearUndo
|
||||
else
|
||||
begin
|
||||
FUndoList.DeleteUnmodifiedMarks;
|
||||
FRedoList.DeleteUnmodifiedMarks;
|
||||
end;
|
||||
|
||||
Modified:= false;
|
||||
end;
|
||||
|
||||
273
ATSynEdit/atsynedit/atstrings_undo.pas
Normal file
273
ATSynEdit/atsynedit/atstrings_undo.pas
Normal file
@@ -0,0 +1,273 @@
|
||||
unit ATStrings_Undo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils,
|
||||
ATStringProc;
|
||||
|
||||
type
|
||||
TATEditAction = (
|
||||
cEditActionChange,
|
||||
cEditActionChangeEol,
|
||||
cEditActionInsert,
|
||||
cEditActionDelete,
|
||||
cEditActionClearModified
|
||||
);
|
||||
|
||||
const
|
||||
StrEditActionDescriptions: array[TATEditAction] of string = (
|
||||
'change',
|
||||
'change-eol',
|
||||
'insert',
|
||||
'delete',
|
||||
'clear-mod'
|
||||
);
|
||||
|
||||
type
|
||||
{ TATUndoItem }
|
||||
|
||||
TATUndoItem = class
|
||||
ItemAction: TATEditAction;
|
||||
ItemIndex: integer;
|
||||
ItemText: atString;
|
||||
ItemEnd: TATLineEnds;
|
||||
ItemCarets: TATPointArray;
|
||||
ItemSoftMark: boolean;
|
||||
ItemHardMark: boolean;
|
||||
constructor Create(AAction: TATEditAction; AIndex: integer;
|
||||
const AText: atString; AEnd: TATLineEnds; ASoftMark, AHardMark: boolean;
|
||||
const ACarets: TATPointArray); virtual;
|
||||
end;
|
||||
|
||||
type
|
||||
{ TATUndoList }
|
||||
|
||||
TATUndoList = class
|
||||
private
|
||||
FList: TList;
|
||||
FMaxCount: integer;
|
||||
FLocked: boolean;
|
||||
FSoftMark: boolean;
|
||||
FHardMark: boolean;
|
||||
function GetItem(N: integer): TATUndoItem;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
function IsItemsEqual(N1, N2: integer): boolean;
|
||||
function Count: integer;
|
||||
function Last: TATUndoItem;
|
||||
property Items[N: integer]: TATUndoItem read GetItem; default;
|
||||
property MaxCount: integer read FMaxCount write FMaxCount;
|
||||
property SoftMark: boolean read FSoftMark write FSoftMark;
|
||||
property HardMark: boolean read FHardMark write FHardMark;
|
||||
property Locked: boolean read FLocked write FLocked;
|
||||
procedure Clear;
|
||||
procedure Delete(N: integer);
|
||||
procedure DeleteLast;
|
||||
procedure DeleteUnmodifiedMarks;
|
||||
procedure Add(AAction: TATEditAction; AIndex: integer; const AText: atString;
|
||||
AEnd: TATLineEnds; const ACarets: TATPointArray);
|
||||
procedure AddUnmodifiedMark;
|
||||
procedure DebugShow;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, Dialogs;
|
||||
|
||||
{ TATUndoItem }
|
||||
|
||||
constructor TATUndoItem.Create(AAction: TATEditAction; AIndex: integer;
|
||||
const AText: atString; AEnd: TATLineEnds; ASoftMark, AHardMark: boolean;
|
||||
const ACarets: TATPointArray);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
ItemAction:= AAction;
|
||||
ItemIndex:= AIndex;
|
||||
ItemText:= AText;
|
||||
ItemEnd:= AEnd;
|
||||
ItemSoftMark:= ASoftMark;
|
||||
ItemHardMark:= AHardMark;
|
||||
|
||||
SetLength(ItemCarets, Length(ACarets));
|
||||
for i:= 0 to High(ACarets) do
|
||||
begin
|
||||
ItemCarets[i]:= ACarets[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TATUndoList }
|
||||
|
||||
function TATUndoList.GetItem(N: integer): TATUndoItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
Result:= TATUndoItem(FList[N])
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
constructor TATUndoList.Create;
|
||||
begin
|
||||
FList:= TList.Create;
|
||||
FMaxCount:= 5000;
|
||||
FSoftMark:= false;
|
||||
FHardMark:= false;
|
||||
FLocked:= false;
|
||||
end;
|
||||
|
||||
destructor TATUndoList.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TATUndoList.Count: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATUndoList.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<Count);
|
||||
end;
|
||||
|
||||
function TATUndoList.IsItemsEqual(N1, N2: integer): boolean;
|
||||
var
|
||||
i1, i2: TATUndoItem;
|
||||
begin
|
||||
Result:= false;
|
||||
i1:= Items[N1];
|
||||
i2:= Items[N2];
|
||||
if not Assigned(i1) or not Assigned(i2) then Exit;
|
||||
Result:=
|
||||
(i1.ItemAction=cEditActionChange) and
|
||||
(i1.ItemAction=i2.ItemAction) and
|
||||
(i1.ItemIndex=i2.ItemIndex) and
|
||||
(i1.ItemText=i2.ItemText);
|
||||
end;
|
||||
|
||||
procedure TATUndoList.Delete(N: integer);
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
begin
|
||||
TObject(FList[N]).Free;
|
||||
FList.Delete(N);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATUndoList.DeleteLast;
|
||||
begin
|
||||
Delete(Count-1);
|
||||
end;
|
||||
|
||||
procedure TATUndoList.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Count-1 downto 0 do
|
||||
Delete(i);
|
||||
end;
|
||||
|
||||
procedure TATUndoList.Add(AAction: TATEditAction; AIndex: integer;
|
||||
const AText: atString; AEnd: TATLineEnds;
|
||||
const ACarets: TATPointArray);
|
||||
var
|
||||
Item: TATUndoItem;
|
||||
begin
|
||||
if FLocked then Exit;
|
||||
|
||||
//not dup change?
|
||||
if (Count>0) and (AAction in [cEditActionChange, cEditActionChangeEol]) then
|
||||
begin
|
||||
Item:= Items[Count-1];
|
||||
if (Item.ItemAction=AAction) and
|
||||
(Item.ItemIndex=AIndex) and
|
||||
(Item.ItemText=AText) then
|
||||
Exit;
|
||||
end;
|
||||
|
||||
//not insert/delete same index?
|
||||
if (Count>0) and (AAction=cEditActionDelete) then
|
||||
begin
|
||||
Item:= Items[Count-1];
|
||||
if (Item.ItemAction=cEditActionInsert) and
|
||||
(Item.ItemIndex=AIndex) then
|
||||
begin
|
||||
DeleteLast;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
Item:= TATUndoItem.Create(AAction, AIndex, AText, AEnd, FSoftMark, FHardMark, ACarets);
|
||||
FList.Add(Item);
|
||||
FSoftMark:= false;
|
||||
|
||||
while Count>MaxCount do
|
||||
Delete(0);
|
||||
end;
|
||||
|
||||
|
||||
procedure TATUndoList.AddUnmodifiedMark;
|
||||
var
|
||||
Item: TATUndoItem;
|
||||
Carets: TATPointArray;
|
||||
begin
|
||||
//if FLocked then exit; //on load file called with Locked=true
|
||||
|
||||
//don't do two marks
|
||||
Item:= Last;
|
||||
if Assigned(Item) then
|
||||
if Item.ItemAction=cEditActionClearModified then exit;
|
||||
|
||||
SetLength(Carets, 0);
|
||||
Item:= TATUndoItem.Create(cEditActionClearModified, 0, '', cEndNone, false, false, Carets);
|
||||
FList.Add(Item);
|
||||
end;
|
||||
|
||||
procedure TATUndoList.DeleteUnmodifiedMarks;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Count-1 downto 0 do
|
||||
if Items[i].ItemAction=cEditActionClearModified then
|
||||
Delete(i);
|
||||
end;
|
||||
|
||||
procedure TATUndoList.DebugShow;
|
||||
var
|
||||
i: integer;
|
||||
s: string;
|
||||
Item: TATUndoItem;
|
||||
begin
|
||||
s:= '';
|
||||
for i:= 0 to Min(40, Count)-1 do
|
||||
begin
|
||||
Item:= Items[i];
|
||||
s:= s+Format('%s, text "%s", %s, index %d', [
|
||||
StrEditActionDescriptions[Item.ItemAction],
|
||||
UTF8Encode(Item.ItemText),
|
||||
IfThen(Item.ItemEnd=cEndNone, 'no-eol', ''),
|
||||
Item.ItemIndex
|
||||
])+#13;
|
||||
end;
|
||||
ShowMessage('Undo list:'#13+s);
|
||||
end;
|
||||
|
||||
function TATUndoList.Last: TATUndoItem;
|
||||
begin
|
||||
if Count>0 then
|
||||
Result:= Items[Count-1]
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
4433
ATSynEdit/atsynedit/atsynedit.pas
Normal file
4433
ATSynEdit/atsynedit/atsynedit.pas
Normal file
File diff suppressed because it is too large
Load Diff
1017
ATSynEdit/atsynedit/atsynedit_adapter_econtrol.pas
Normal file
1017
ATSynEdit/atsynedit/atsynedit_adapter_econtrol.pas
Normal file
File diff suppressed because it is too large
Load Diff
66
ATSynEdit/atsynedit/atsynedit_adapters.pas
Normal file
66
ATSynEdit/atsynedit/atsynedit_adapters.pas
Normal file
@@ -0,0 +1,66 @@
|
||||
unit ATSynEdit_Adapters;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics,
|
||||
ATSynEdit_CanvasProc;
|
||||
|
||||
type
|
||||
{ TATAdapterHilite }
|
||||
|
||||
TATAdapterHilite = class(TComponent)
|
||||
public
|
||||
procedure OnEditorChange(Sender: TObject); virtual;
|
||||
procedure OnEditorCalcHilite(Sender: TObject;
|
||||
var AParts: TATLineParts;
|
||||
ALineIndex, ACharIndex, ALineLen: integer;
|
||||
var AColorAfterEol: TColor); virtual;
|
||||
procedure OnEditorCalcPosColor(Sender: TObject;
|
||||
AX, AY: integer; var AColor: TColor); virtual;
|
||||
procedure OnEditorCaretMove(Sender: TObject); virtual;
|
||||
procedure OnEditorScroll(Sender: TObject); virtual;
|
||||
procedure OnEditorBeforeCalcHilite(Sender: TObject); virtual;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TATAdapterHilite }
|
||||
|
||||
procedure TATAdapterHilite.OnEditorChange(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TATAdapterHilite.OnEditorCalcHilite(Sender: TObject;
|
||||
var AParts: TATLineParts; ALineIndex, ACharIndex, ALineLen: integer;
|
||||
var AColorAfterEol: TColor);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TATAdapterHilite.OnEditorCalcPosColor(Sender: TObject; AX,
|
||||
AY: integer; var AColor: TColor);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TATAdapterHilite.OnEditorCaretMove(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TATAdapterHilite.OnEditorScroll(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TATAdapterHilite.OnEditorBeforeCalcHilite(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
912
ATSynEdit/atsynedit/atsynedit_canvasproc.pas
Normal file
912
ATSynEdit/atsynedit/atsynedit_canvasproc.pas
Normal file
@@ -0,0 +1,912 @@
|
||||
unit ATSynEdit_CanvasProc;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
//{$define invert_pixels} //test Mac caret blinking
|
||||
{$ifdef darwin}
|
||||
{$define invert_pixels}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Types,
|
||||
ATStringProc;
|
||||
|
||||
var
|
||||
OptUnprintedTabCharLength: integer = 1;
|
||||
OptUnprintedTabPointerScale: integer = 22;
|
||||
OptUnprintedSpaceDotScale: integer = 15;
|
||||
OptUnprintedEndDotScale: integer = 30;
|
||||
OptUnprintedEndFontScale: integer = 80;
|
||||
OptUnprintedEndFontDx: integer = 3;
|
||||
OptUnprintedEndFontDy: integer = 2;
|
||||
OptUnprintedEndArrowOrDot: boolean = true;
|
||||
OptUnprintedEndArrowLength: integer = 70;
|
||||
|
||||
type
|
||||
TATLineStyle = (
|
||||
cLineStyleNone,
|
||||
cLineStyleSolid,
|
||||
cLineStyleDash,
|
||||
cLineStyleSolid2px,
|
||||
cLineStyleDotted,
|
||||
cLineStyleRounded,
|
||||
cLineStyleWave
|
||||
);
|
||||
|
||||
type
|
||||
TATLinePart = record
|
||||
Offset, Len: integer;
|
||||
ColorFont, ColorBG, ColorBorder: TColor;
|
||||
FontBold, FontItalic, FontStrikeOut: boolean;
|
||||
BorderUp, BorderDown, BorderLeft, BorderRight: TATLineStyle;
|
||||
end;
|
||||
|
||||
type
|
||||
TATLinePartClass = class
|
||||
public
|
||||
Data: TATLinePart;
|
||||
end;
|
||||
|
||||
const
|
||||
cMaxLineParts = 1000; //big two monitors have total about 1000 chars (small font)
|
||||
type
|
||||
TATLineParts = array[0..cMaxLineParts-1] of TATLinePart;
|
||||
PATLineParts = ^TATLineParts;
|
||||
|
||||
type
|
||||
TATSynEditDrawLineEvent = procedure(Sender: TObject; C: TCanvas;
|
||||
AX, AY: integer; const AStr: atString; ACharSize: TPoint;
|
||||
const AExtent: TATIntArray) of object;
|
||||
|
||||
procedure CanvasLineEx(C: TCanvas; Color: TColor; Style: TATLineStyle;
|
||||
P1, P2: TPoint; AtDown: boolean);
|
||||
|
||||
procedure CanvasTextOut(C: TCanvas;
|
||||
PosX, PosY: integer;
|
||||
Str: atString;
|
||||
ATabSize: integer;
|
||||
ACharSize: TPoint;
|
||||
AMainText: boolean;
|
||||
AShowUnprintable: boolean;
|
||||
AColorUnprintable: TColor;
|
||||
AColorHex: TColor;
|
||||
out AStrWidth: integer;
|
||||
ACharsSkipped: integer;
|
||||
AParts: PATLineParts;
|
||||
ADrawEvent: TATSynEditDrawLineEvent;
|
||||
ATextOffsetFromLine: integer;
|
||||
AControlWidth: integer
|
||||
);
|
||||
|
||||
procedure CanvasTextOutMinimap(C: TCanvas;
|
||||
const AStr: atString;
|
||||
APos: TPoint;
|
||||
ACharSize: TPoint;
|
||||
ATabSize: integer;
|
||||
AParts: PATLineParts
|
||||
);
|
||||
|
||||
procedure DoPaintUnprintedEol(C: TCanvas;
|
||||
const AStrEol: atString;
|
||||
APoint: TPoint;
|
||||
ACharSize: TPoint;
|
||||
AColorFont, AColorBG: TColor;
|
||||
ADetails: boolean);
|
||||
|
||||
function CanvasTextSpaces(const S: atString; ATabSize: integer): real;
|
||||
function CanvasTextWidth(const S: atString; ATabSize: integer; ACharSize: TPoint): integer;
|
||||
|
||||
function CanvasFontSizes(C: TCanvas): TPoint;
|
||||
procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
|
||||
procedure CanvasDottedVertLine_Alt(C: TCanvas; Color: TColor; X1, Y1, Y2: integer);
|
||||
procedure CanvasDottedHorzVertLine(C: TCanvas; Color: TColor; P1, P2: TPoint);
|
||||
procedure CanvasWavyHorzLine(C: TCanvas; Color: TColor; P1, P2: TPoint; AtDown: boolean);
|
||||
|
||||
procedure CanvasPaintTriangleDown(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer);
|
||||
procedure CanvasPaintPlusMinus(C: TCanvas; AColorBorder, AColorBG: TColor; ACenter: TPoint; ASize: integer; APlus: boolean);
|
||||
|
||||
procedure DoPartFind(const AParts: TATLineParts; APos: integer; out AIndex, AOffsetLeft: integer);
|
||||
procedure DoPartInsert(var AParts: TATLineParts; const APart: TATLinePart; AKeepFontStyles: boolean);
|
||||
procedure DoPartSetColorBG(var AParts: TATLineParts; AColor: TColor; AForceColor: boolean);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math,
|
||||
LCLType,
|
||||
LCLIntf;
|
||||
|
||||
var
|
||||
_Pen: TPen = nil;
|
||||
|
||||
type
|
||||
TATBorderSide = (cSideLeft, cSideRight, cSideUp, cSideDown);
|
||||
|
||||
|
||||
procedure DoPaintUnprintedSpace(C: TCanvas; const ARect: TRect; AScale: integer; AFontColor: TColor);
|
||||
const
|
||||
cMinDotSize = 2;
|
||||
var
|
||||
R: TRect;
|
||||
NSize: integer;
|
||||
begin
|
||||
NSize:= Max(cMinDotSize, (ARect.Bottom-ARect.Top) * AScale div 100);
|
||||
R.Left:= (ARect.Left+ARect.Right) div 2 - NSize div 2;
|
||||
R.Top:= (ARect.Top+ARect.Bottom) div 2 - NSize div 2;
|
||||
R.Right:= R.Left + NSize;
|
||||
R.Bottom:= R.Top + NSize;
|
||||
C.Pen.Color:= AFontColor;
|
||||
C.Brush.Color:= AFontColor;
|
||||
C.FillRect(R);
|
||||
end;
|
||||
|
||||
procedure DoPaintUnprintedTabulation(C: TCanvas;
|
||||
const ARect: TRect;
|
||||
AColorFont: TColor;
|
||||
ACharSizeX: integer);
|
||||
const
|
||||
cIndent = 1; //offset left/rt
|
||||
var
|
||||
XLeft, XRight, X1, X2, Y, Dx: integer;
|
||||
begin
|
||||
XLeft:= ARect.Left+cIndent;
|
||||
XRight:= ARect.Right-cIndent;
|
||||
|
||||
if OptUnprintedTabCharLength=0 then
|
||||
begin;
|
||||
X1:= XLeft;
|
||||
X2:= XRight;
|
||||
end
|
||||
else
|
||||
begin
|
||||
X1:= XLeft;
|
||||
X2:= Min(XRight, X1+OptUnprintedTabCharLength*ACharSizeX);
|
||||
end;
|
||||
|
||||
Y:= (ARect.Top+ARect.Bottom) div 2;
|
||||
Dx:= (ARect.Bottom-ARect.Top) * OptUnprintedTabPointerScale div 100;
|
||||
C.Pen.Color:= AColorFont;
|
||||
|
||||
C.MoveTo(X2, Y);
|
||||
C.LineTo(X1, Y);
|
||||
C.MoveTo(X2, Y);
|
||||
C.LineTo(X2-Dx, Y-Dx);
|
||||
C.MoveTo(X2, Y);
|
||||
C.LineTo(X2-Dx, Y+Dx);
|
||||
end;
|
||||
|
||||
|
||||
procedure DoPaintUnprintedArrowDown(C: TCanvas;
|
||||
const ARect: TRect;
|
||||
AColorFont: TColor);
|
||||
var
|
||||
Len, X, Y1, Y2, Dx: integer;
|
||||
begin
|
||||
X:= (ARect.Left+ARect.Right) div 2;
|
||||
Len:= (ARect.Bottom-ARect.Top) * OptUnprintedEndArrowLength div 100;
|
||||
Dx:= (ARect.Bottom-ARect.Top) * OptUnprintedTabPointerScale div 100;
|
||||
C.Pen.Color:= AColorFont;
|
||||
|
||||
Y1:= (ARect.Bottom+ARect.Top-Len) div 2;
|
||||
Y2:= Y1+Len;
|
||||
|
||||
C.MoveTo(X, Y1);
|
||||
C.LineTo(X, Y2);
|
||||
C.MoveTo(X, Y2);
|
||||
C.LineTo(X-Dx, Y2-Dx);
|
||||
C.MoveTo(X, Y2);
|
||||
C.LineTo(X+Dx, Y2-Dx);
|
||||
end;
|
||||
|
||||
procedure DoPaintUnprintedChars(C: TCanvas;
|
||||
const AString: atString;
|
||||
const AOffsets: TATIntArray;
|
||||
APoint: TPoint;
|
||||
ACharSize: TPoint;
|
||||
AColorFont: TColor);
|
||||
var
|
||||
R: TRect;
|
||||
i: integer;
|
||||
begin
|
||||
if AString='' then Exit;
|
||||
|
||||
for i:= 1 to Length(AString) do
|
||||
if (AString[i]=' ') or (AString[i]=#9) then
|
||||
begin
|
||||
R.Left:= APoint.X;
|
||||
R.Right:= APoint.X;
|
||||
if i>1 then
|
||||
Inc(R.Left, AOffsets[i-2]);
|
||||
Inc(R.Right, AOffsets[i-1]);
|
||||
|
||||
R.Top:= APoint.Y;
|
||||
R.Bottom:= R.Top+ACharSize.Y;
|
||||
|
||||
if AString[i]=' ' then
|
||||
DoPaintUnprintedSpace(C, R, OptUnprintedSpaceDotScale, AColorFont)
|
||||
else
|
||||
DoPaintUnprintedTabulation(C, R, AColorFont, ACharSize.X);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CanvasSimpleLine(C: TCanvas; P1, P2: TPoint);
|
||||
begin
|
||||
if P1.Y=P2.Y then
|
||||
C.Line(P1.X, P1.Y, P2.X+1, P2.Y)
|
||||
else
|
||||
C.Line(P1.X, P1.Y, P2.X, P2.Y+1);
|
||||
end;
|
||||
|
||||
procedure CanvasRoundedLine(C: TCanvas; Color: TColor; P1, P2: TPoint; AtDown: boolean);
|
||||
var
|
||||
cPixel: TColor;
|
||||
begin
|
||||
cPixel:= Color;
|
||||
C.Pen.Color:= Color;
|
||||
if P1.Y=P2.Y then
|
||||
begin
|
||||
C.Line(P1.X+2, P1.Y, P2.X-1, P2.Y);
|
||||
if AtDown then
|
||||
begin
|
||||
C.Pixels[P1.X+1, P1.Y-1]:= cPixel;
|
||||
C.Pixels[P2.X-1, P2.Y-1]:= cPixel;
|
||||
end
|
||||
else
|
||||
begin
|
||||
C.Pixels[P1.X+1, P1.Y+1]:= cPixel;
|
||||
C.Pixels[P2.X-1, P2.Y+1]:= cPixel;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
C.Line(P1.X, P1.Y+2, P2.X, P2.Y-1);
|
||||
//don't draw pixels, other lines did it
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CanvasWavyHorzLine(C: TCanvas; Color: TColor; P1, P2: TPoint; AtDown: boolean);
|
||||
const
|
||||
cWavePeriod = 4;
|
||||
cWaveInc: array[0..cWavePeriod-1] of integer = (0, 1, 2, 1);
|
||||
var
|
||||
i, y, sign: integer;
|
||||
begin
|
||||
if AtDown then sign:= -1 else sign:= 1;
|
||||
for i:= P1.X to P2.X do
|
||||
begin
|
||||
y:= P2.Y + sign * cWaveInc[(i-P1.X) mod cWavePeriod];
|
||||
C.Pixels[i, y]:= Color;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CanvasDottedHorzVertLine(C: TCanvas; Color: TColor; P1, P2: TPoint);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if P1.Y=P2.Y then
|
||||
begin
|
||||
for i:= P1.X to P2.X do
|
||||
if Odd(i-P1.X+1) then
|
||||
C.Pixels[i, P2.Y]:= Color;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for i:= P1.Y to P2.Y do
|
||||
if Odd(i-P1.Y+1) then
|
||||
C.Pixels[P1.X, i]:= Color;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CanvasLineEx(C: TCanvas; Color: TColor; Style: TATLineStyle; P1, P2: TPoint; AtDown: boolean);
|
||||
begin
|
||||
case Style of
|
||||
cLineStyleSolid:
|
||||
begin
|
||||
C.Pen.Color:= Color;
|
||||
CanvasSimpleLine(C, P1, P2);
|
||||
end;
|
||||
|
||||
cLineStyleSolid2px:
|
||||
begin
|
||||
C.Pen.Color:= Color;
|
||||
CanvasSimpleLine(C, P1, P2);
|
||||
if P1.Y=P2.Y then
|
||||
begin
|
||||
if AtDown then
|
||||
begin Dec(P1.Y); Dec(P2.Y) end
|
||||
else
|
||||
begin Inc(P1.Y); Inc(P2.Y) end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if AtDown then
|
||||
begin Dec(P1.X); Dec(P2.X) end
|
||||
else
|
||||
begin Inc(P1.X); Inc(P2.X) end;
|
||||
end;
|
||||
CanvasSimpleLine(C, P1, P2);
|
||||
end;
|
||||
|
||||
cLineStyleDash:
|
||||
begin
|
||||
C.Pen.Color:= Color;
|
||||
C.Pen.Style:= psDot;
|
||||
CanvasSimpleLine(C, P1, P2);
|
||||
C.Pen.Style:= psSolid;
|
||||
end;
|
||||
|
||||
cLineStyleDotted:
|
||||
CanvasDottedHorzVertLine(C, Color, P1, P2);
|
||||
|
||||
cLineStyleRounded:
|
||||
CanvasRoundedLine(C, Color, P1, P2, AtDown);
|
||||
|
||||
cLineStyleWave:
|
||||
CanvasWavyHorzLine(C, Color, P1, P2, AtDown);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoPaintBorder(C: TCanvas; Color: TColor; R: TRect; Side: TATBorderSide; Style: TATLineStyle);
|
||||
begin
|
||||
if Style=cLineStyleNone then Exit;
|
||||
Dec(R.Right);
|
||||
Dec(R.Bottom);
|
||||
|
||||
case Side of
|
||||
cSideDown:
|
||||
CanvasLineEx(C, Color, Style,
|
||||
Point(R.Left, R.Bottom),
|
||||
Point(R.Right, R.Bottom),
|
||||
true);
|
||||
cSideLeft:
|
||||
CanvasLineEx(C, Color, Style,
|
||||
Point(R.Left, R.Top),
|
||||
Point(R.Left, R.Bottom),
|
||||
false);
|
||||
cSideRight:
|
||||
CanvasLineEx(C, Color, Style,
|
||||
Point(R.Right, R.Top),
|
||||
Point(R.Right, R.Bottom),
|
||||
true);
|
||||
cSideUp:
|
||||
CanvasLineEx(C, Color, Style,
|
||||
Point(R.Left, R.Top),
|
||||
Point(R.Right, R.Top),
|
||||
false);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure DoPaintHexChars(C: TCanvas;
|
||||
const AString: atString;
|
||||
ADx: PIntegerArray;
|
||||
APoint: TPoint;
|
||||
ACharSize: TPoint;
|
||||
AColorFont,
|
||||
AColorBg: TColor);
|
||||
var
|
||||
Buf: string;
|
||||
R: TRect;
|
||||
i, j: integer;
|
||||
begin
|
||||
if AString='' then Exit;
|
||||
|
||||
for i:= 1 to Length(AString) do
|
||||
if IsCharHex(AString[i]) then
|
||||
begin
|
||||
R.Left:= APoint.X;
|
||||
R.Right:= APoint.X;
|
||||
|
||||
for j:= 0 to i-2 do
|
||||
Inc(R.Left, ADx^[j]);
|
||||
R.Right:= R.Left+ADx^[i-1];
|
||||
|
||||
R.Top:= APoint.Y;
|
||||
R.Bottom:= R.Top+ACharSize.Y;
|
||||
|
||||
C.Font.Color:= AColorFont;
|
||||
C.Brush.Color:= AColorBg;
|
||||
|
||||
Buf:= '<'+IntToHex(Ord(AString[i]), 4)+'>';
|
||||
ExtTextOut(C.Handle,
|
||||
R.Left, R.Top,
|
||||
ETO_CLIPPED+ETO_OPAQUE,
|
||||
@R,
|
||||
PChar(Buf),
|
||||
Length(Buf),
|
||||
nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoPaintUnprintedEol(C: TCanvas;
|
||||
const AStrEol: atString;
|
||||
APoint: TPoint;
|
||||
ACharSize: TPoint;
|
||||
AColorFont, AColorBG: TColor;
|
||||
ADetails: boolean);
|
||||
var
|
||||
NPrevSize: integer;
|
||||
begin
|
||||
if AStrEol='' then Exit;
|
||||
|
||||
if ADetails then
|
||||
begin
|
||||
NPrevSize:= C.Font.Size;
|
||||
C.Font.Size:= C.Font.Size * OptUnprintedEndFontScale div 100;
|
||||
C.Font.Color:= AColorFont;
|
||||
C.Brush.Color:= AColorBG;
|
||||
C.TextOut(
|
||||
APoint.X+OptUnprintedEndFontDx,
|
||||
APoint.Y+OptUnprintedEndFontDy,
|
||||
AStrEol);
|
||||
C.Font.Size:= NPrevSize;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if OptUnprintedEndArrowOrDot then
|
||||
DoPaintUnprintedArrowDown(C,
|
||||
Rect(APoint.X, APoint.Y, APoint.X+ACharSize.X, APoint.Y+ACharSize.Y),
|
||||
AColorFont)
|
||||
else
|
||||
DoPaintUnprintedSpace(C,
|
||||
Rect(APoint.X, APoint.Y, APoint.X+ACharSize.X, APoint.Y+ACharSize.Y),
|
||||
OptUnprintedEndDotScale,
|
||||
AColorFont);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function CanvasFontSizes(C: TCanvas): TPoint;
|
||||
var
|
||||
Size: TSize;
|
||||
begin
|
||||
Size:= C.TextExtent('M');
|
||||
Result.X:= Size.cx;
|
||||
Result.Y:= Size.cy;
|
||||
end;
|
||||
|
||||
function CanvasTextSpaces(const S: atString; ATabSize: integer): real;
|
||||
var
|
||||
List: TATRealArray;
|
||||
begin
|
||||
Result:= 0;
|
||||
if S='' then Exit;
|
||||
SetLength(List, Length(S));
|
||||
SCalcCharOffsets(S, List, ATabSize);
|
||||
Result:= List[High(List)];
|
||||
end;
|
||||
|
||||
function CanvasTextWidth(const S: atString; ATabSize: integer; ACharSize: TPoint): integer;
|
||||
begin
|
||||
Result:= Trunc(CanvasTextSpaces(S, ATabSize)*ACharSize.X);
|
||||
end;
|
||||
|
||||
|
||||
function CanvasTextOutNeedsOffsets(const Str: atString): boolean;
|
||||
begin
|
||||
{$ifdef darwin} exit(true); {$endif}
|
||||
Result:= IsStringWithUnicodeChars(Str);
|
||||
end;
|
||||
|
||||
procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer; Str: atString;
|
||||
ATabSize: integer; ACharSize: TPoint; AMainText: boolean;
|
||||
AShowUnprintable: boolean; AColorUnprintable: TColor; AColorHex: TColor; out
|
||||
AStrWidth: integer; ACharsSkipped: integer; AParts: PATLineParts;
|
||||
ADrawEvent: TATSynEditDrawLineEvent; ATextOffsetFromLine: integer;
|
||||
AControlWidth: integer);
|
||||
var
|
||||
ListReal: TATRealArray;
|
||||
ListInt: TATIntArray;
|
||||
Dx: TATIntArray;
|
||||
i, j: integer;
|
||||
PartStr: atString;
|
||||
PartOffset, PartLen,
|
||||
PixOffset1, PixOffset2: integer;
|
||||
PartPtr: ^TATLinePart;
|
||||
PartFontStyle: TFontStyles;
|
||||
PartRect: TRect;
|
||||
Buf: AnsiString;
|
||||
DxPointer: PInteger;
|
||||
begin
|
||||
if Str='' then Exit;
|
||||
|
||||
SetLength(ListReal, Length(Str));
|
||||
SetLength(ListInt, Length(Str));
|
||||
SetLength(Dx, Length(Str));
|
||||
|
||||
SCalcCharOffsets(Str, ListReal, ATabSize, ACharsSkipped);
|
||||
|
||||
for i:= 0 to High(ListReal) do
|
||||
ListInt[i]:= Trunc(ListReal[i]*ACharSize.X);
|
||||
|
||||
//truncate str, to not paint over screen
|
||||
for i:= 1 to High(ListInt) do
|
||||
if ListInt[i]>AControlWidth then
|
||||
begin
|
||||
SetLength(Str, i);
|
||||
break;
|
||||
end;
|
||||
|
||||
for i:= 0 to High(ListReal) do
|
||||
if i=0 then
|
||||
Dx[i]:= ListInt[i]
|
||||
else
|
||||
Dx[i]:= ListInt[i]-ListInt[i-1];
|
||||
|
||||
if AParts=nil then
|
||||
begin
|
||||
Buf:= UTF8Encode(SRemoveHexChars(Str));
|
||||
if CanvasTextOutNeedsOffsets(Str) then
|
||||
DxPointer:= @Dx[0]
|
||||
else
|
||||
DxPointer:= nil;
|
||||
ExtTextOut(C.Handle, PosX, PosY, 0, nil, PChar(Buf), Length(Buf), DxPointer);
|
||||
|
||||
DoPaintHexChars(C,
|
||||
Str,
|
||||
@Dx[0],
|
||||
Point(PosX, PosY),
|
||||
ACharSize,
|
||||
AColorHex,
|
||||
C.Brush.Color
|
||||
);
|
||||
end
|
||||
else
|
||||
for j:= 0 to High(TATLineParts) do
|
||||
begin
|
||||
PartPtr:= @AParts^[j];
|
||||
PartLen:= PartPtr^.Len;
|
||||
if PartLen=0 then Break;
|
||||
PartOffset:= PartPtr^.Offset;
|
||||
PartStr:= Copy(Str, PartOffset+1, PartLen);
|
||||
if PartStr='' then Break;
|
||||
|
||||
PartFontStyle:= [];
|
||||
if PartPtr^.FontBold then Include(PartFontStyle, fsBold);
|
||||
if PartPtr^.FontItalic then Include(PartFontStyle, fsItalic);
|
||||
if PartPtr^.FontStrikeOut then Include(PartFontStyle, fsStrikeOut);
|
||||
|
||||
if PartOffset>0 then
|
||||
PixOffset1:= ListInt[PartOffset-1]
|
||||
else
|
||||
PixOffset1:= 0;
|
||||
|
||||
i:= Min(PartOffset+PartLen, Length(Str));
|
||||
if i>0 then
|
||||
PixOffset2:= ListInt[i-1]
|
||||
else
|
||||
PixOffset2:= 0;
|
||||
|
||||
C.Font.Color:= PartPtr^.ColorFont;
|
||||
C.Brush.Color:= PartPtr^.ColorBG;
|
||||
C.Font.Style:= PartFontStyle;
|
||||
|
||||
PartRect:= Rect(
|
||||
PosX+PixOffset1,
|
||||
PosY,
|
||||
PosX+PixOffset2,
|
||||
PosY+ACharSize.Y);
|
||||
|
||||
Buf:= UTF8Encode(SRemoveHexChars(PartStr));
|
||||
if CanvasTextOutNeedsOffsets(PartStr) then
|
||||
DxPointer:= @Dx[PartOffset]
|
||||
else
|
||||
DxPointer:= nil;
|
||||
|
||||
ExtTextOut(C.Handle,
|
||||
PosX+PixOffset1,
|
||||
PosY+ATextOffsetFromLine,
|
||||
ETO_CLIPPED+ETO_OPAQUE,
|
||||
@PartRect,
|
||||
PChar(Buf),
|
||||
Length(Buf),
|
||||
DxPointer);
|
||||
|
||||
DoPaintHexChars(C,
|
||||
PartStr,
|
||||
@Dx[PartOffset],
|
||||
Point(PosX+PixOffset1, PosY),
|
||||
ACharSize,
|
||||
AColorHex,
|
||||
PartPtr^.ColorBG
|
||||
);
|
||||
|
||||
if AMainText then
|
||||
begin
|
||||
DoPaintBorder(C, PartPtr^.ColorBorder, PartRect, cSideDown, PartPtr^.BorderDown);
|
||||
DoPaintBorder(C, PartPtr^.ColorBorder, PartRect, cSideUp, PartPtr^.BorderUp);
|
||||
DoPaintBorder(C, PartPtr^.ColorBorder, PartRect, cSideLeft, PartPtr^.BorderLeft);
|
||||
DoPaintBorder(C, PartPtr^.ColorBorder, PartRect, cSideRight, PartPtr^.BorderRight);
|
||||
end;
|
||||
end;
|
||||
|
||||
if AShowUnprintable then
|
||||
DoPaintUnprintedChars(C, Str, ListInt, Point(PosX, PosY), ACharSize, AColorUnprintable);
|
||||
|
||||
AStrWidth:= ListInt[High(ListInt)];
|
||||
|
||||
if Str<>'' then
|
||||
if Assigned(ADrawEvent) then
|
||||
ADrawEvent(nil, C, PosX, PosY, Str, ACharSize, ListInt);
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef invert_pixels}
|
||||
procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
for j:= R.Top to R.Bottom-1 do
|
||||
for i:= R.Left to R.Right-1 do
|
||||
C.Pixels[i, j]:= C.Pixels[i, j] xor (not AColor and $ffffff);
|
||||
end;
|
||||
{$else}
|
||||
procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
|
||||
var
|
||||
X: integer;
|
||||
AM: TAntialiasingMode;
|
||||
begin
|
||||
AM:= C.AntialiasingMode;
|
||||
_Pen.Assign(C.Pen);
|
||||
|
||||
X:= (R.Left+R.Right) div 2;
|
||||
C.Pen.Mode:= pmNotXor;
|
||||
C.Pen.Style:= psSolid;
|
||||
C.Pen.Color:= AColor;
|
||||
C.AntialiasingMode:= amOff;
|
||||
C.Pen.EndCap:= pecFlat;
|
||||
C.Pen.Width:= R.Right-R.Left;
|
||||
|
||||
C.MoveTo(X, R.Top);
|
||||
C.LineTo(X, R.Bottom);
|
||||
|
||||
C.Pen.Assign(_Pen);
|
||||
C.AntialiasingMode:= AM;
|
||||
C.Rectangle(0, 0, 0, 0); //apply pen
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure CanvasDottedVertLine_Alt(C: TCanvas; Color: TColor; X1, Y1, Y2: integer);
|
||||
var
|
||||
j: integer;
|
||||
begin
|
||||
for j:= Y1 to Y2 do
|
||||
if Odd(j) then
|
||||
C.Pixels[X1, j]:= Color;
|
||||
end;
|
||||
|
||||
|
||||
procedure CanvasPaintTriangleDown(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer);
|
||||
begin
|
||||
C.Brush.Color:= AColor;
|
||||
C.Pen.Color:= AColor;
|
||||
C.Polygon([
|
||||
Point(ACoord.X, ACoord.Y),
|
||||
Point(ACoord.X+ASize*2, ACoord.Y),
|
||||
Point(ACoord.X+ASize, ACoord.Y+ASize)
|
||||
]);
|
||||
end;
|
||||
|
||||
procedure CanvasPaintPlusMinus(C: TCanvas; AColorBorder, AColorBG: TColor;
|
||||
ACenter: TPoint; ASize: integer; APlus: boolean);
|
||||
begin
|
||||
C.Brush.Color:= AColorBG;
|
||||
C.Pen.Color:= AColorBorder;
|
||||
C.Rectangle(ACenter.X-ASize, ACenter.Y-ASize, ACenter.X+ASize+1, ACenter.Y+ASize+1);
|
||||
C.Line(ACenter.X-ASize+2, ACenter.Y, ACenter.X+ASize-1, ACenter.Y);
|
||||
if APlus then
|
||||
C.Line(ACenter.X, ACenter.Y-ASize+2, ACenter.X, ACenter.Y+ASize-1);
|
||||
end;
|
||||
|
||||
|
||||
procedure DoPartFind(const AParts: TATLineParts; APos: integer; out
|
||||
AIndex, AOffsetLeft: integer);
|
||||
var
|
||||
iStart, iEnd, i: integer;
|
||||
begin
|
||||
AIndex:= -1;
|
||||
AOffsetLeft:= 0;
|
||||
|
||||
for i:= Low(AParts) to High(AParts)-1 do
|
||||
begin
|
||||
if AParts[i].Len=0 then
|
||||
begin
|
||||
//pos after last part?
|
||||
if i>Low(AParts) then
|
||||
if APos>=AParts[i-1].Offset+AParts[i-1].Len then
|
||||
AIndex:= i;
|
||||
Break;
|
||||
end;
|
||||
|
||||
iStart:= AParts[i].Offset;
|
||||
iEnd:= iStart+AParts[i].Len;
|
||||
|
||||
//pos at part begin?
|
||||
if APos=iStart then
|
||||
begin AIndex:= i; Break end;
|
||||
|
||||
//pos at part middle?
|
||||
if (APos>=iStart) and (APos<iEnd) then
|
||||
begin AIndex:= i; AOffsetLeft:= APos-iStart; Break end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure DoPartInsert(var AParts: TATLineParts; const APart: TATLinePart;
|
||||
AKeepFontStyles: boolean);
|
||||
var
|
||||
ResultParts: TATLineParts;
|
||||
ResultPartIndex: integer;
|
||||
//
|
||||
procedure AddPart(const P: TATLinePart);
|
||||
begin
|
||||
if P.Len>0 then
|
||||
begin
|
||||
Move(P, ResultParts[ResultPartIndex], SizeOf(P));
|
||||
Inc(ResultPartIndex);
|
||||
end;
|
||||
end;
|
||||
//
|
||||
var
|
||||
PartSelBegin, PartSelEnd: TATLinePart;
|
||||
nIndex1, nIndex2,
|
||||
nOffset1, nOffset2,
|
||||
newLen1, newLen2, newOffset2: integer;
|
||||
i: integer;
|
||||
begin
|
||||
DoPartFind(AParts, APart.Offset, nIndex1, nOffset1);
|
||||
DoPartFind(AParts, APart.Offset+APart.Len, nIndex2, nOffset2);
|
||||
if nIndex1<0 then Exit;
|
||||
if nIndex2<0 then Exit;
|
||||
|
||||
//these 2 parts are for edges of selection
|
||||
FillChar(PartSelBegin{%H-}, SizeOf(TATLinePart), 0);
|
||||
FillChar(PartSelEnd{%H-}, SizeOf(TATLinePart), 0);
|
||||
|
||||
PartSelBegin.ColorFont:= APart.ColorFont;
|
||||
PartSelBegin.ColorBG:= APart.ColorBG;
|
||||
PartSelBegin.Offset:= AParts[nIndex1].Offset+nOffset1;
|
||||
PartSelBegin.Len:= AParts[nIndex1].Len-nOffset1;
|
||||
PartSelBegin.FontBold:= AParts[nIndex1].FontBold;
|
||||
PartSelBegin.FontItalic:= AParts[nIndex1].FontItalic;
|
||||
PartSelBegin.FontStrikeOut:= AParts[nIndex1].FontStrikeOut;
|
||||
|
||||
PartSelEnd.ColorFont:= APart.ColorFont;
|
||||
PartSelEnd.ColorBG:= APart.ColorBG;
|
||||
PartSelEnd.Offset:= AParts[nIndex2].Offset;
|
||||
PartSelEnd.Len:= nOffset2;
|
||||
PartSelEnd.FontBold:= AParts[nIndex2].FontBold;
|
||||
PartSelEnd.FontItalic:= AParts[nIndex2].FontItalic;
|
||||
PartSelEnd.FontStrikeOut:= AParts[nIndex2].FontStrikeOut;
|
||||
|
||||
with AParts[nIndex1] do
|
||||
begin
|
||||
newLen1:= nOffset1;
|
||||
end;
|
||||
with AParts[nIndex2] do
|
||||
begin
|
||||
newLen2:= Len-nOffset2;
|
||||
newOffset2:= Offset+nOffset2;
|
||||
end;
|
||||
|
||||
FillChar(ResultParts, SizeOf(ResultParts), 0);
|
||||
ResultPartIndex:= 0;
|
||||
|
||||
//add parts before selection
|
||||
for i:= 0 to nIndex1-1 do
|
||||
AddPart(AParts[i]);
|
||||
if nOffset1>0 then
|
||||
begin
|
||||
AParts[nIndex1].Len:= newLen1;
|
||||
AddPart(AParts[nIndex1]);
|
||||
end;
|
||||
|
||||
//add middle (one APart of many parts)
|
||||
if not AKeepFontStyles then
|
||||
AddPart(APart)
|
||||
else
|
||||
begin
|
||||
AddPart(PartSelBegin);
|
||||
|
||||
for i:= nIndex1+1 to nIndex2-1 do
|
||||
begin
|
||||
AParts[i].ColorFont:= APart.ColorFont;
|
||||
AParts[i].ColorBG:= APart.ColorBG;
|
||||
AddPart(AParts[i]);
|
||||
end;
|
||||
|
||||
if nIndex1<nIndex2 then
|
||||
AddPart(PartSelEnd);
|
||||
end;
|
||||
|
||||
//add parts after selection
|
||||
if nOffset2>0 then
|
||||
begin
|
||||
AParts[nIndex2].Len:= newLen2;
|
||||
AParts[nIndex2].Offset:= newOffset2;
|
||||
end;
|
||||
|
||||
for i:= nIndex2 to High(AParts) do
|
||||
begin
|
||||
if AParts[i].Len=0 then Break;
|
||||
AddPart(AParts[i]);
|
||||
end;
|
||||
|
||||
//application.mainform.caption:= format('n1 %d, n2 %d, of len %d %d',
|
||||
// [nindex1, nindex2, aparts[nindex2].offset, aparts[nindex2].len]);
|
||||
|
||||
//copy result
|
||||
Move(ResultParts, AParts, SizeOf(AParts));
|
||||
end;
|
||||
|
||||
|
||||
procedure DoPartSetColorBG(var AParts: TATLineParts; AColor: TColor;
|
||||
AForceColor: boolean);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Low(AParts) to High(AParts) do
|
||||
begin
|
||||
if AParts[i].Len=0 then Break;
|
||||
if AForceColor or (AParts[i].ColorBG=clNone) then
|
||||
AParts[i].ColorBG:= AColor;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure CanvasTextOutMinimap(C: TCanvas; const AStr: atString; APos: TPoint;
|
||||
ACharSize: TPoint; ATabSize: integer; AParts: PATLineParts);
|
||||
const
|
||||
cLowChars = '.,:;_''-+`~=^*';
|
||||
var
|
||||
Offsets: TATIntArray;
|
||||
Part: ^TATLinePart;
|
||||
ch: Widechar;
|
||||
nPos, nCharSize: integer;
|
||||
i, j: integer;
|
||||
X1, Y1, Y2: integer;
|
||||
begin
|
||||
if AStr='' then exit;
|
||||
SetLength(Offsets, Length(AStr)+1);
|
||||
Offsets[0]:= 0;
|
||||
for i:= 2 to Length(AStr) do
|
||||
Offsets[i-1]:= Offsets[i-2]+IfThen(AStr[i-1]=#9, ATabSize, 1);
|
||||
|
||||
for i:= Low(TATLineParts) to High(TATLineParts) do
|
||||
begin
|
||||
Part:= @AParts^[i];
|
||||
if Part^.Len=0 then Break;
|
||||
for j:= 1 to Part^.Len do
|
||||
begin
|
||||
nPos:= Part^.Offset+j;
|
||||
if nPos>Length(AStr) then Continue;
|
||||
ch:= AStr[nPos];
|
||||
if IsCharSpace(ch) then Continue;
|
||||
|
||||
nCharSize:= ACharSize.Y;
|
||||
if Pos(ch, cLowChars)>0 then
|
||||
nCharSize:= nCharSize div 2;
|
||||
|
||||
X1:= APos.X+ACharSize.X*Offsets[nPos-1];
|
||||
Y2:= APos.Y+ACharSize.Y;
|
||||
Y1:= Y2-nCharSize;
|
||||
|
||||
C.Pen.Color:= Part^.ColorFont;
|
||||
C.Line(X1, Y1, X1, Y2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//------------------
|
||||
initialization
|
||||
_Pen:= TPen.Create;
|
||||
|
||||
finalization
|
||||
if Assigned(_Pen) then
|
||||
FreeAndNil(_Pen);
|
||||
|
||||
end.
|
||||
|
||||
659
ATSynEdit/atsynedit/atsynedit_carets.inc
Normal file
659
ATSynEdit/atsynedit/atsynedit_carets.inc
Normal file
@@ -0,0 +1,659 @@
|
||||
{$ifdef nnnn}begin end;{$endif}
|
||||
|
||||
|
||||
function TATSynEdit.IsLineWithCaret(ALine: integer): boolean;
|
||||
begin
|
||||
Result:= FCarets.IsLineListed(ALine);
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsLinePartWithCaret(ALine: integer; ACoordY: integer): boolean;
|
||||
var
|
||||
i: integer;
|
||||
Caret: TATCaretItem;
|
||||
Coord: TPoint;
|
||||
begin
|
||||
Result:= false;
|
||||
//like Carets.IsLineListed with more code
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
if Caret.PosY=ALine then
|
||||
begin
|
||||
Coord:= CaretPosToClientPos(Point(Caret.PosX, Caret.PosY));
|
||||
if Coord.Y=ACoordY then
|
||||
begin
|
||||
Result:= true;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCaretAddToPoint(AX, AY: integer);
|
||||
var
|
||||
N: integer;
|
||||
begin
|
||||
N:= Carets.IndexOfPosXY(AX, AY);
|
||||
if Carets.IsIndexValid(N) then
|
||||
begin
|
||||
if Carets.Count>1 then
|
||||
Carets.Delete(N);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Carets.Add(AX, AY);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretsColumnToPoint(AX, AY: integer);
|
||||
var
|
||||
P, PM1, PM2: TPoint;
|
||||
EolPos: boolean;
|
||||
begin
|
||||
DoCaretSingleAsIs;
|
||||
with Carets[0] do
|
||||
begin P.X:= PosX; P.Y:= PosY; end;
|
||||
|
||||
PM1:= CaretPosToClientPos(P);
|
||||
PM2:= CaretPosToClientPos(Point(AX, AY));
|
||||
|
||||
//clicked above caret?
|
||||
if PM2.Y<PM1.Y then
|
||||
SwapInt(PM1.Y, PM2.Y);
|
||||
|
||||
Carets.Clear;
|
||||
P:= ClientPosToCaretPos(PM1, EolPos);
|
||||
if P.Y>=0 then
|
||||
Carets.Add(P.X, P.Y);
|
||||
|
||||
repeat
|
||||
Inc(PM1.Y, FCharSize.Y);
|
||||
P:= ClientPosToCaretPos(PM1, EolPos);
|
||||
if P.Y>=0 then
|
||||
if not Carets.IsLineListed(P.Y) then
|
||||
Carets.Add(P.X, P.Y);
|
||||
until PM1.Y>=PM2.Y;
|
||||
|
||||
if Carets.Count=0 then
|
||||
Carets.Add(AX, AY);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretsSort;
|
||||
begin
|
||||
Carets.Sort;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.UpdateCaretsCoords(AOnlyLast: boolean = false);
|
||||
var
|
||||
P: TPoint;
|
||||
NStart, i: integer;
|
||||
Caret: TATCaretItem;
|
||||
Marker: TATMarkerItem;
|
||||
begin
|
||||
if AOnlyLast then
|
||||
NStart:= Carets.Count-1
|
||||
else
|
||||
NStart:= 0;
|
||||
|
||||
for i:= NStart to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
P.X:= Caret.PosX;
|
||||
P.Y:= Caret.PosY;
|
||||
if IsPosFolded(P.X, P.Y) then
|
||||
begin
|
||||
Caret.CoordX:= -1;
|
||||
Caret.CoordY:= -1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
P:= CaretPosToClientPos(P);
|
||||
Caret.CoordX:= P.X;
|
||||
Caret.CoordY:= P.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
for i:= 0 to Markers.Count-1 do
|
||||
begin
|
||||
Marker:= Markers[i];
|
||||
P.X:= Marker.PosX;
|
||||
P.Y:= Marker.PosY;
|
||||
if IsPosFolded(P.X, P.Y) then
|
||||
begin
|
||||
Marker.CoordX:= -1;
|
||||
Marker.CoordY:= -1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
P:= CaretPosToClientPos(P);
|
||||
Marker.CoordX:= P.X;
|
||||
Marker.CoordY:= P.Y;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function _DoCaretPosToClientPos(
|
||||
P: TPoint;
|
||||
AWrapInfo: TATSynWrapInfo;
|
||||
AStrings: TATStrings;
|
||||
ACharSize: TPoint;
|
||||
ATabSize: integer;
|
||||
const ARect: TRect;
|
||||
const AScrollHorz, AScrollVert: TATSynScrollInfo;
|
||||
APreferLeftSide: boolean): TPoint;
|
||||
var
|
||||
Item: TATSynWrapItem;
|
||||
NIndex1, NIndex2, i: integer;
|
||||
NFromStart: integer;
|
||||
Str: atString;
|
||||
begin
|
||||
Result.X:= -1;
|
||||
Result.Y:= -1;
|
||||
|
||||
AWrapInfo.FindIndexesOfLineNumber(P.Y, NIndex1, NIndex2);
|
||||
if NIndex1<0 then Exit;
|
||||
|
||||
for i:= NIndex1 to NIndex2 do
|
||||
begin
|
||||
Item:= AWrapInfo.Items[i];
|
||||
|
||||
if (P.X<Item.NCharIndex-1) then Continue;
|
||||
if (Item.NFinal=cWrapItemMiddle) then
|
||||
if (P.X>Item.NCharIndex-1+Item.NLength) or
|
||||
((P.X=Item.NCharIndex-1+Item.NLength) and APreferLeftSide) then
|
||||
Continue;
|
||||
|
||||
NFromStart:= P.X+1-Item.NCharIndex;
|
||||
Str:= Copy(AStrings.Lines[P.Y], Item.NCharIndex, Min(NFromStart, Item.NLength));
|
||||
|
||||
Result.X:= CanvasTextWidth(Str, ATabSize, ACharSize);
|
||||
if NFromStart>Item.NLength then
|
||||
Inc(Result.X, (NFromStart-Item.NLength)*ACharSize.X);
|
||||
|
||||
Inc(Result.X, (Item.NIndent-AScrollHorz.NPos)*ACharSize.X);
|
||||
Result.Y:= (i-AScrollVert.NPos)*ACharSize.Y;
|
||||
|
||||
Inc(Result.X, ARect.Left);
|
||||
Inc(Result.Y, ARect.Top);
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
function _DoClientPosToCaretPos(
|
||||
P: TPoint;
|
||||
AWrapInfo: TATSynWrapInfo;
|
||||
AStrings: TATStrings;
|
||||
ACharSize: TPoint;
|
||||
ATabSize: integer;
|
||||
const ARect: TRect;
|
||||
const AScrollHorz, AScrollVert: TATSynScrollInfo;
|
||||
AVirtualPos: boolean;
|
||||
out AWrappedEnd: boolean): TPoint;
|
||||
var
|
||||
NPixels, NIndex: integer;
|
||||
Item: TATSynWrapItem;
|
||||
Str: atString;
|
||||
AllowVirtual: boolean;
|
||||
begin
|
||||
AWrappedEnd:= false;
|
||||
Result.X:= 0;
|
||||
Result.Y:= -1;
|
||||
if (ACharSize.X<=0) or (ACharSize.Y<=0) then Exit;
|
||||
|
||||
P.X:= Max(P.X, ARect.Left);
|
||||
NIndex:= (P.Y-ARect.Top) div ACharSize.Y + AScrollVert.NPos;
|
||||
|
||||
if NIndex<0 then
|
||||
//click above all text
|
||||
begin
|
||||
Result.X:= 0;
|
||||
Result.Y:= 0;
|
||||
end
|
||||
else
|
||||
if not AWrapInfo.IsIndexValid(NIndex) then
|
||||
//click below all text
|
||||
begin
|
||||
NIndex:= AWrapInfo.Count-1;
|
||||
if AWrapInfo.IsIndexValid(NIndex) then
|
||||
begin
|
||||
Item:= AWrapInfo.Items[NIndex];
|
||||
Result.Y:= Item.NLineIndex;
|
||||
Result.X:= Item.NCharIndex+Item.NLength-1;
|
||||
end;
|
||||
end
|
||||
else
|
||||
//click in text
|
||||
begin
|
||||
Item:= AWrapInfo.Items[NIndex];
|
||||
Result.Y:= Item.NLineIndex;
|
||||
|
||||
Str:= Copy(AStrings.Lines[Result.Y], Item.NCharIndex, Item.NLength);
|
||||
|
||||
AllowVirtual:= AVirtualPos and (Item.NFinal=cWrapItemFinal);
|
||||
NPixels:= P.X-ARect.Left + ACharSize.X*(AScrollHorz.NPos-Item.NIndent);
|
||||
Result.X:= SFindClickedPosition(Str, NPixels, ACharSize.X, ATabSize, AllowVirtual, AWrappedEnd) + Item.NCharIndex - 2;
|
||||
|
||||
if Item.NFinal=cWrapItemFinal then //don't set AWrappedEnd for real eol
|
||||
AWrappedEnd:= false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.CaretPosToClientPos(P: TPoint): TPoint;
|
||||
begin
|
||||
Result:= _DoCaretPosToClientPos(P,
|
||||
FWrapInfo,
|
||||
Strings,
|
||||
FCharSize,
|
||||
FTabSize,
|
||||
FRectMain,
|
||||
FScrollHorz,
|
||||
FScrollVert,
|
||||
FCaretSpecPos or FOptCaretPreferLeftSide
|
||||
);
|
||||
end;
|
||||
|
||||
function TATSynEdit.ClientPosToCaretPos(P: TPoint; out AEndOfLinePos: boolean): TPoint;
|
||||
begin
|
||||
Result:= _DoClientPosToCaretPos(P,
|
||||
FWrapInfo,
|
||||
Strings,
|
||||
FCharSize,
|
||||
FTabSize,
|
||||
FRectMain,
|
||||
FScrollHorz,
|
||||
FScrollVert,
|
||||
FCaretVirtual,
|
||||
AEndOfLinePos);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.SetCaretShapeIns(AValue: TATSynCaretShape);
|
||||
begin
|
||||
if FCaretShapeIns=AValue then Exit;
|
||||
DoPaintModeStatic;
|
||||
FCaretShapeIns:= AValue;
|
||||
DoPaintModeBlinking;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.SetCaretShapeOvr(AValue: TATSynCaretShape);
|
||||
begin
|
||||
if FCaretShapeOvr=AValue then Exit;
|
||||
DoPaintModeStatic;
|
||||
FCaretShapeOvr:= AValue;
|
||||
DoPaintModeBlinking;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.SetCaretShapeRO(AValue: TATSynCaretShape);
|
||||
begin
|
||||
if FCaretShapeRO=AValue then Exit;
|
||||
DoPaintModeStatic;
|
||||
FCaretShapeRO:= AValue;
|
||||
DoPaintModeBlinking;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.SetCaretBlinkEnabled(AValue: boolean);
|
||||
begin
|
||||
if FCaretBlinkEnabled=AValue then Exit;
|
||||
FCaretBlinkEnabled:= AValue;
|
||||
DoPaintModeStatic;
|
||||
DoPaintModeBlinking;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoGotoPos(APnt: TPoint; AIndentHorz, AIndentVert: integer);
|
||||
var
|
||||
NIndex, NVisLines, NChars: integer;
|
||||
begin
|
||||
if IsPosFolded(APnt.X, APnt.Y) then Exit;
|
||||
|
||||
NVisLines:= GetVisibleLines;
|
||||
APnt:= CaretPosToClientPos(APnt);
|
||||
NIndex:= GetWrapInfoIndex(APnt);
|
||||
if NIndex<0 then Exit;
|
||||
|
||||
//for y
|
||||
//negative AIndentVert: indent always from top
|
||||
//positive: from top (goto up) or bottom (goto down)
|
||||
if (NIndex<FScrollVert.NPos) then
|
||||
begin
|
||||
FScrollVert.NPos:= Max(0, NIndex-Abs(AIndentVert));
|
||||
UpdateScrollbars;
|
||||
end
|
||||
else
|
||||
if (NIndex>FScrollVert.NPos+NVisLines-1) then
|
||||
begin
|
||||
if AIndentVert<0 then
|
||||
FScrollVert.NPos:= Max(0, NIndex-Abs(AIndentVert))
|
||||
else
|
||||
FScrollVert.NPos:= Max(0, NIndex-NVisLines+1+Abs(AIndentVert));
|
||||
UpdateScrollbars;
|
||||
end;
|
||||
|
||||
//for x
|
||||
if APnt.X<FRectMain.Left then
|
||||
begin
|
||||
NChars:= (FRectMain.Left-APnt.X) div FCharSize.X + 1 + AIndentHorz;
|
||||
FScrollHorz.NPos:= Max(0, FScrollHorz.NPos-NChars);
|
||||
UpdateScrollbars;
|
||||
end
|
||||
else
|
||||
if APnt.X>FRectMain.Right-FCharSize.X then
|
||||
begin
|
||||
NChars:= (APnt.X-FRectMain.Right) div FCharSize.X + 2 + AIndentHorz;
|
||||
Inc(FScrollHorz.NPos, NChars);
|
||||
UpdateScrollbars;
|
||||
end;
|
||||
|
||||
UpdateCaretsCoords();
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoGotoCaret(AEdge: TATCaretEdge);
|
||||
begin
|
||||
DoGotoPos(Carets.CaretAtEdge(AEdge), cScrollIndentCaretHorz, cScrollIndentCaretVert);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoGotoPos_AndUnfold(APnt: TPoint;
|
||||
AIndentHorz, AIndentVert: integer);
|
||||
begin
|
||||
if not Strings.IsIndexValid(APnt.Y) then Exit;
|
||||
|
||||
if IsLineFolded(APnt.Y, true) then
|
||||
begin
|
||||
DoUnfoldLine(APnt.Y);
|
||||
Update;
|
||||
end;
|
||||
|
||||
DoCaretSingle(APnt.X, APnt.Y);
|
||||
DoEventCarets;
|
||||
DoGotoPos(APnt, AIndentHorz, AIndentVert);
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretsDeleteOnSameLines;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Carets.Count-1 downto 1{!} do
|
||||
begin
|
||||
if Carets[i].PosY=Carets[i-1].PosY then
|
||||
Carets.Delete(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretSingleAsIs;
|
||||
begin
|
||||
FSelRect:= cRectEmpty;
|
||||
|
||||
if Carets.Count=0 then
|
||||
Carets.Add(0, 0);
|
||||
|
||||
while Carets.Count>1 do
|
||||
Carets.Delete(Carets.Count-1);
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCaretSingle(APosX, APosY, AEndX, AEndY: integer; AUseEndXY: boolean);
|
||||
begin
|
||||
FSelRect:= cRectEmpty;
|
||||
|
||||
if Carets.Count=0 then
|
||||
Carets.Add(0, 0);
|
||||
|
||||
while Carets.Count>1 do
|
||||
Carets.Delete(Carets.Count-1);
|
||||
|
||||
with Carets[0] do
|
||||
begin
|
||||
PosX:= APosX;
|
||||
PosY:= APosY;
|
||||
if AUseEndXY then
|
||||
begin
|
||||
EndX:= AEndX;
|
||||
EndY:= AEndY;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretSingle(AX, AY: integer; AClearSelection: boolean);
|
||||
begin
|
||||
DoCaretSingle(AX, AY, -1, -1, AClearSelection);
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetCaretSelectionIndex(P: TPoint): integer;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
X1, Y1, X2, Y2, i: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
Result:= -1;
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Item:= Carets[i];
|
||||
Item.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then Continue;
|
||||
if IsPosInRange(P.X, P.Y, X1, Y1, X2, Y2)=cRelateInside then
|
||||
begin
|
||||
Result:= i;
|
||||
Break
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCaretSwapEdge(AMoveLeft: boolean): boolean;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
bSel, bAtLeft: boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
if Carets.Count<>1 then Exit;
|
||||
|
||||
Item:= Carets[0];
|
||||
Item.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then Exit;
|
||||
Result:= true;
|
||||
|
||||
bAtLeft:= IsPosSorted(Item.PosX, Item.PosY, Item.EndX, Item.EndY, true);
|
||||
|
||||
//Left/Rt pressed at left/rt side of selection?
|
||||
//yes: cancel selection, don't move caret
|
||||
if bAtLeft=AMoveLeft then
|
||||
begin
|
||||
Item.EndX:= -1;
|
||||
Item.EndY:= -1;
|
||||
Exit
|
||||
end;
|
||||
|
||||
//else swap edge
|
||||
SwapInt(Item.PosX, Item.EndX);
|
||||
SwapInt(Item.PosY, Item.EndY);
|
||||
|
||||
if not FOptKeyLeftRightSwapSelAndSelect then
|
||||
begin
|
||||
Item.EndX:= -1;
|
||||
Item.EndY:= -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetCaretsArray: TATPointArray;
|
||||
begin
|
||||
if Assigned(FCarets) then
|
||||
Result:= FCarets.SaveToArray;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.SetCaretsArray(const L: TATPointArray);
|
||||
begin
|
||||
if Assigned(FCarets) then
|
||||
FCarets.LoadFromArray(L);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretsExtend(ADown: boolean; ALines: integer);
|
||||
var
|
||||
MoreCarets: TATCarets;
|
||||
X, Y: integer;
|
||||
i, j: integer;
|
||||
begin
|
||||
MoreCarets:= TATCarets.Create;
|
||||
try
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
with Carets[i] do
|
||||
begin
|
||||
for j:= 1 to ALines do
|
||||
begin
|
||||
X:= PosX;
|
||||
Y:= PosY+BoolToPlusMinusOne(ADown)*j;
|
||||
if (Y<0) or (Y>=Strings.Count) then Break;
|
||||
MoreCarets.Add(X, Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
for i:= 0 to MoreCarets.Count-1 do
|
||||
with MoreCarets[i] do
|
||||
Carets.Add(PosX, PosY);
|
||||
Carets.Sort;
|
||||
finally
|
||||
FreeAndNil(MoreCarets);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCaretsAssign(NewCarets: TATCarets);
|
||||
begin
|
||||
Carets.Clear;
|
||||
if NewCarets.Count>0 then
|
||||
Carets.Assign(NewCarets)
|
||||
else
|
||||
DoCaretSingle(0, 0);
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsCaretBlocked: boolean;
|
||||
begin
|
||||
Result:= FCaretStopUnfocused and not Focused;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.UpdateIncorrectCaretPositions;
|
||||
begin
|
||||
Carets.UpdateIncorrectPositions(Strings.Count-1);
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCaretsShift_CaretItem(Caret: TATCaretItem;
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX: integer);
|
||||
begin
|
||||
//carets below src, apply ShiftY/ShiftBelowX
|
||||
if Caret.PosY>APosY then
|
||||
begin
|
||||
if AShiftY=0 then exit;
|
||||
|
||||
if Caret.PosY=APosY+1 then
|
||||
Inc(Caret.PosX, AShiftBelowX);
|
||||
|
||||
Inc(Caret.PosY, AShiftY);
|
||||
end
|
||||
else
|
||||
//carets on same line as src, apply ShiftX
|
||||
begin
|
||||
if Caret.PosX>APosX then
|
||||
Inc(Caret.PosX, AShiftX);
|
||||
end;
|
||||
|
||||
//same, but for EndX/EndY
|
||||
if Caret.EndY>APosY then
|
||||
begin
|
||||
if Caret.EndY=APosY+1 then
|
||||
Inc(Caret.EndX, AShiftBelowX);
|
||||
|
||||
Inc(Caret.EndY, AShiftY);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Caret.EndX>APosX then
|
||||
Inc(Caret.EndX, AShiftX);
|
||||
end;
|
||||
|
||||
if Caret.PosX<0 then Caret.PosX:= 0;
|
||||
if Caret.PosY<0 then Caret.PosY:= 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCaretsShift_MarkerItem(Mark: TATMarkerItem;
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX: integer;
|
||||
APosAfter: TPoint);
|
||||
begin
|
||||
//marker below src, apply ShiftY/ShiftBelowX
|
||||
if Mark.PosY>APosY then
|
||||
begin
|
||||
if AShiftY=0 then exit;
|
||||
|
||||
if Mark.PosY=APosY+1 then
|
||||
Inc(Mark.PosX, AShiftBelowX);
|
||||
|
||||
Inc(Mark.PosY, AShiftY);
|
||||
end
|
||||
else
|
||||
//marker on same line as src
|
||||
if Mark.PosY=APosY then
|
||||
begin
|
||||
if Mark.PosX=APosX then
|
||||
begin
|
||||
Mark.PosX:= APosAfter.X;
|
||||
Mark.PosY:= APosAfter.Y;
|
||||
end
|
||||
else
|
||||
if Mark.PosX>=APosX then
|
||||
if AShiftY=0 then
|
||||
Inc(Mark.PosX, AShiftX)
|
||||
else
|
||||
begin
|
||||
Inc(Mark.PosX, -APosX+APosAfter.X);
|
||||
Inc(Mark.PosY, AShiftY);
|
||||
end;
|
||||
end;
|
||||
|
||||
if Mark.PosX<0 then Mark.PosX:= 0;
|
||||
if Mark.PosY<0 then Mark.PosY:= 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCaretsShift(APosX, APosY: integer; AShiftX,
|
||||
AShiftY: integer; APosAfter: TPoint; AShiftBelowX: integer);
|
||||
var
|
||||
NStart, i: integer;
|
||||
{$ifdef debug_markers_shift}
|
||||
S: string;
|
||||
{$endif}
|
||||
begin
|
||||
if APosX<0 then Exit;
|
||||
if APosY<0 then Exit;
|
||||
|
||||
//adjust carets
|
||||
//(optimized, from index NStart, to fast do on 200 carets)
|
||||
NStart:= Carets.IndexOfPosYAvg(APosY);
|
||||
if NStart>=0 then
|
||||
for i:= NStart to Carets.Count-1 do
|
||||
DoCaretsShift_CaretItem(Carets[i],
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX);
|
||||
|
||||
{$ifdef debug_markers_shift}
|
||||
S:= '';
|
||||
for i:= 0 to Markers.Count-1 do
|
||||
S:= S+Format('mark[%d] %d %d, ', [i, Markers[i].PosX, Markers[i].PosY]);
|
||||
Application.Mainform.Caption:= S+' -- '+Format(
|
||||
'pos %d %d, shift %d %d, posafter %d %d',
|
||||
[APosX, APosY, AShiftX, AShiftY, APosAfter.X, APosAfter.Y]);
|
||||
{$endif}
|
||||
|
||||
//adjust markers
|
||||
//(cannot optimize, markers not sorted)
|
||||
for i:= 0 to Markers.Count-1 do
|
||||
DoCaretsShift_MarkerItem(Markers[i],
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX, APosAfter);
|
||||
|
||||
for i:= 0 to Attribs.Count-1 do
|
||||
DoCaretsShift_MarkerItem(Attribs[i],
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX, APosAfter);
|
||||
|
||||
for i:= 0 to FMarkedRange.Count-1 do
|
||||
DoCaretsShift_MarkerItem(FMarkedRange[i],
|
||||
APosX, APosY, AShiftX, AShiftY, AShiftBelowX, APosAfter);
|
||||
end;
|
||||
|
||||
586
ATSynEdit/atsynedit/atsynedit_carets.pas
Normal file
586
ATSynEdit/atsynedit/atsynedit_carets.pas
Normal file
@@ -0,0 +1,586 @@
|
||||
unit ATSynEdit_Carets;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
ATStringProc;
|
||||
|
||||
type
|
||||
TATPosRelation = (cRelateBefore, cRelateInside, cRelateAfter);
|
||||
|
||||
procedure SwapInt(var n1, n2: integer);
|
||||
function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean;
|
||||
function IsPosInRange(X, Y, X1, Y1, X2, Y2: integer): TATPosRelation;
|
||||
|
||||
|
||||
type
|
||||
{ TATCaretItem }
|
||||
|
||||
TATCaretItem = class
|
||||
public
|
||||
PosX, PosY, //caret blinking pos
|
||||
EndX, EndY: integer; //end of selection or -1
|
||||
CoordX, CoordY: integer; //screen coords
|
||||
CoordColumn: integer; //saved CoordX to use in keys Up/Down cmd
|
||||
procedure SelectToPoint(AX, AY: integer);
|
||||
procedure GetRange(out AX1, AY1, AX2, AY2: integer; out ASel: boolean);
|
||||
procedure GetSelLines(out AFrom, ATo: integer; AllowNoSel: boolean=false);
|
||||
end;
|
||||
|
||||
type
|
||||
TATCaretEdge = (
|
||||
cEdgeTop,
|
||||
cEdgeBottom,
|
||||
cEdgeLeft,
|
||||
cEdgeRight
|
||||
);
|
||||
|
||||
type
|
||||
{ TATCarets }
|
||||
|
||||
TATCarets = class
|
||||
private
|
||||
FList: TList;
|
||||
FManyAllowed: boolean;
|
||||
FOneLine: boolean;
|
||||
function GetItem(N: integer): TATCaretItem;
|
||||
procedure DeleteDups;
|
||||
function IsJoinNeeded(N1, N2: integer;
|
||||
out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Delete(N: integer);
|
||||
function Count: integer;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
property Items[N: integer]: TATCaretItem read GetItem; default;
|
||||
procedure Add(APosX, APosY: integer);
|
||||
procedure Add(XFrom, YFrom, XTo, YTo: integer);
|
||||
procedure Sort;
|
||||
procedure Assign(Obj: TATCarets);
|
||||
function IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean= false): integer;
|
||||
function IndexOfPosYAvg(APosY: integer): integer;
|
||||
function IndexOfLeftRight(ALeft: boolean): integer;
|
||||
function IsLineListed(APosY: integer): boolean;
|
||||
function IsSelection: boolean;
|
||||
function IsPosSelected(AX, AY: integer): boolean;
|
||||
function CaretAtEdge(AEdge: TATCaretEdge): TPoint;
|
||||
function DebugText: string;
|
||||
property ManyAllowed: boolean read FManyAllowed write FManyAllowed;
|
||||
property OneLine: boolean read FOneLine write FOneLine;
|
||||
function SaveToArray: TATPointArray;
|
||||
procedure LoadFromArray(const L: TATPointArray);
|
||||
procedure UpdateColumnCoord(ASaveColumn: boolean);
|
||||
procedure UpdateIncorrectPositions(AMaxLine: integer);
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math{%H-};
|
||||
|
||||
function IsPosSorted(X1, Y1, X2, Y2: integer; AllowEq: boolean): boolean;
|
||||
begin
|
||||
if Y1<>Y2 then
|
||||
Result:= Y1<Y2
|
||||
else
|
||||
Result:= (X1<X2) or (AllowEq and (X1=X2));
|
||||
end;
|
||||
|
||||
procedure GetPositionMinOrMax(X1, Y1, X2, Y2: integer; AMaximal: boolean; out OutX, OutY: integer);
|
||||
begin
|
||||
if IsPosSorted(X1, Y1, X2, Y2, true) xor AMaximal then
|
||||
begin
|
||||
OutX:= X1;
|
||||
OutY:= Y1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
OutX:= X2;
|
||||
OutY:= Y2;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function IsPosInRange(X, Y, X1, Y1, X2, Y2: integer): TATPosRelation;
|
||||
var
|
||||
b1, b2: boolean;
|
||||
begin
|
||||
b1:= IsPosSorted(X, Y, X1, Y1, false);
|
||||
b2:= IsPosSorted(X, Y, X2, Y2, false);
|
||||
if b1 then Result:= cRelateBefore else
|
||||
if b2 then Result:= cRelateInside else
|
||||
Result:= cRelateAfter;
|
||||
end;
|
||||
|
||||
procedure SwapInt(var n1, n2: integer);
|
||||
var
|
||||
n: integer;
|
||||
begin
|
||||
n:= n1;
|
||||
n1:= n2;
|
||||
n2:= n;
|
||||
end;
|
||||
|
||||
{ TATCaretItem }
|
||||
|
||||
procedure TATCaretItem.GetRange(out AX1, AY1, AX2, AY2: integer; out ASel: boolean);
|
||||
begin
|
||||
AX1:= PosX;
|
||||
AY1:= PosY;
|
||||
AX2:= EndX;
|
||||
AY2:= EndY;
|
||||
ASel:= false;
|
||||
|
||||
if (AX2<0) or (AY2<0) then Exit;
|
||||
if (AX1=AX2) and (AY1=AY2) then Exit;
|
||||
|
||||
ASel:= true;
|
||||
if IsPosSorted(AX2, AY2, AX1, AY1, false) then
|
||||
begin
|
||||
SwapInt(AX1, AX2);
|
||||
SwapInt(AY1, AY2);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATCaretItem.GetSelLines(out AFrom, ATo: integer;
|
||||
AllowNoSel: boolean = false);
|
||||
var
|
||||
X1, Y1, X2, Y2: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
AFrom:= -1;
|
||||
ATo:= -1;
|
||||
|
||||
GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then
|
||||
begin
|
||||
if AllowNoSel then
|
||||
begin AFrom:= PosY; ATo:= PosY; end;
|
||||
Exit
|
||||
end;
|
||||
|
||||
AFrom:= Y1;
|
||||
ATo:= Y2;
|
||||
//sel ended at line-start?
|
||||
if (X2=0) and (Y2>0) then Dec(ATo);
|
||||
end;
|
||||
|
||||
procedure TATCaretItem.SelectToPoint(AX, AY: integer);
|
||||
begin
|
||||
if EndX<0 then EndX:= PosX;
|
||||
if EndY<0 then EndY:= PosY;
|
||||
PosX:= AX;
|
||||
PosY:= AY;
|
||||
end;
|
||||
|
||||
{ TATCarets }
|
||||
|
||||
function TATCarets.GetItem(N: integer): TATCaretItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
Result:= TATCaretItem(FList[N])
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
constructor TATCarets.Create;
|
||||
begin
|
||||
inherited;
|
||||
FList:= TList.Create;
|
||||
FManyAllowed:= true;
|
||||
FOneLine:= false;
|
||||
end;
|
||||
|
||||
destructor TATCarets.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TATCarets.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= FList.Count-1 downto 0 do
|
||||
Delete(i);
|
||||
end;
|
||||
|
||||
procedure TATCarets.Delete(N: integer);
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
begin
|
||||
TObject(FList[N]).Free;
|
||||
FList.Delete(N);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATCarets.Count: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATCarets.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<FList.Count);
|
||||
end;
|
||||
|
||||
procedure TATCarets.Add(APosX, APosY: integer);
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
begin
|
||||
if (not FManyAllowed) and (Count>=1) then Exit;
|
||||
|
||||
if FOneLine then APosY:= 0;
|
||||
|
||||
Item:= TATCaretItem.Create;
|
||||
Item.PosX:= APosX;
|
||||
Item.PosY:= APosY;
|
||||
Item.EndX:= -1;
|
||||
Item.EndY:= -1;
|
||||
|
||||
FList.Add(Item);
|
||||
end;
|
||||
|
||||
function _ListCaretsCompare(Item1, Item2: Pointer): Integer;
|
||||
var
|
||||
Obj1, Obj2: TATCaretItem;
|
||||
begin
|
||||
Obj1:= TATCaretItem(Item1);
|
||||
Obj2:= TATCaretItem(Item2);
|
||||
Result:= Obj1.PosY-Obj2.PosY;
|
||||
if Result=0 then
|
||||
Result:= Obj1.PosX-Obj2.PosX;
|
||||
end;
|
||||
|
||||
procedure TATCarets.Sort;
|
||||
begin
|
||||
FList.Sort(@_ListCaretsCompare);
|
||||
DeleteDups;
|
||||
end;
|
||||
|
||||
procedure TATCarets.DeleteDups;
|
||||
var
|
||||
i: integer;
|
||||
Item1, Item2: TATCaretItem;
|
||||
OutPosX, OutPosY, OutEndX, OutEndY: integer;
|
||||
begin
|
||||
for i:= Count-1 downto 1 do
|
||||
begin
|
||||
Item1:= GetItem(i);
|
||||
Item2:= GetItem(i-1);
|
||||
|
||||
if (Item1.PosY=Item2.PosY) and (Item1.PosX=Item2.PosX) then
|
||||
Delete(i);
|
||||
|
||||
if IsJoinNeeded(i, i-1, OutPosX, OutPosY, OutEndX, OutEndY) then
|
||||
begin
|
||||
Delete(i);
|
||||
Item2.PosX:= OutPosX;
|
||||
Item2.PosY:= OutPosY;
|
||||
Item2.EndX:= OutEndX;
|
||||
Item2.EndY:= OutEndY;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATCarets.Assign(Obj: TATCarets);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Clear;
|
||||
for i:= 0 to Obj.Count-1 do
|
||||
begin
|
||||
Add(0, 0);
|
||||
with Items[Count-1] do
|
||||
begin
|
||||
PosX:= Obj[i].PosX;
|
||||
PosY:= Obj[i].PosY;
|
||||
EndX:= Obj[i].EndX;
|
||||
EndY:= Obj[i].EndY;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATCarets.IndexOfPosXY(APosX, APosY: integer; AUseEndXY: boolean = false): integer;
|
||||
var
|
||||
iStart, i: integer;
|
||||
Item: TATCaretItem;
|
||||
XUse, YUse: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
|
||||
iStart:= 0;
|
||||
//todo--fix for case called from TimerScrollTick, dont work for cScrollUp
|
||||
//iStart:= IndexOfPosYAvg(APosY);
|
||||
//if iStart<0 then Exit;
|
||||
|
||||
for i:= iStart to Count-1 do
|
||||
begin
|
||||
Item:= Items[i];
|
||||
|
||||
if AUseEndXY and (Item.EndY>=0) then
|
||||
begin XUse:= Item.EndX; YUse:= Item.EndY; end
|
||||
else
|
||||
begin XUse:= Item.PosX; YUse:= Item.PosY; end;
|
||||
|
||||
if (YUse>APosY) then Break;
|
||||
if (XUse=APosX) and (YUse=APosY) then
|
||||
begin Result:= i; Break end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//todo-- binary search
|
||||
function TATCarets.IndexOfPosYAvg(APosY: integer): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
for i:= 0 to FList.Count-1 do
|
||||
if TATCaretItem(FList[i]).PosY>=APosY then
|
||||
begin Result:= i; Exit end;
|
||||
end;
|
||||
|
||||
function TATCarets.IndexOfLeftRight(ALeft: boolean): integer;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
i, NPos: integer;
|
||||
Upd: boolean;
|
||||
begin
|
||||
Result:= -1;
|
||||
if Count>0 then
|
||||
NPos:= Items[0].PosX;
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Item:= Items[i];
|
||||
if ALeft then
|
||||
Upd:= Item.PosX<=NPos
|
||||
else
|
||||
Upd:= Item.PosX>=NPos;
|
||||
if Upd then
|
||||
begin
|
||||
Result:= i;
|
||||
NPos:= Item.PosX;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATCarets.IsLineListed(APosY: integer): boolean;
|
||||
var
|
||||
i: integer;
|
||||
Item: TATCaretItem;
|
||||
begin
|
||||
Result:= false;
|
||||
for i:= 0 to FList.Count-1 do
|
||||
begin
|
||||
Item:= TATCaretItem(FList[i]);
|
||||
if Item.PosY=APosY then
|
||||
begin
|
||||
Result:= true;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATCarets.IsSelection: boolean;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Item:= Items[i];
|
||||
if (Item.EndX<0) or (Item.EndY<0) then Continue;
|
||||
if (Item.PosX<>Item.EndX) or (Item.PosY<>Item.EndY) then
|
||||
begin Result:= true; Exit end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATCarets.IsPosSelected(AX, AY: integer): boolean;
|
||||
var
|
||||
X1, Y1, X2, Y2: integer;
|
||||
bSel: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Items[i].GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then Continue;
|
||||
|
||||
//carets sorted: can stop
|
||||
if Y1>AY then Exit;
|
||||
|
||||
if IsPosInRange(AX, AY, X1, Y1, X2, Y2)=cRelateInside then
|
||||
begin Result:= true; Break end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TATCarets.CaretAtEdge(AEdge: TATCaretEdge): TPoint;
|
||||
var
|
||||
N: integer;
|
||||
begin
|
||||
Result:= Point(0, 0);
|
||||
case AEdge of
|
||||
cEdgeTop: N:= 0;
|
||||
cEdgeBottom: N:= Count-1;
|
||||
cEdgeLeft: N:= IndexOfLeftRight(true);
|
||||
cEdgeRight: N:= IndexOfLeftRight(false);
|
||||
end;
|
||||
if IsIndexValid(N) then
|
||||
with Items[N] do
|
||||
Result:= Point(PosX, PosY);
|
||||
end;
|
||||
|
||||
function TATCarets.IsJoinNeeded(N1, N2: integer;
|
||||
out OutPosX, OutPosY, OutEndX, OutEndY: integer): boolean;
|
||||
var
|
||||
Item1, Item2: TATCaretItem;
|
||||
XMin1, XMin2, YMin1, YMin2, XMax1, XMax2, YMax1, YMax2: integer;
|
||||
Sel1, Sel2: boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
if not IsIndexValid(N1) then Exit;
|
||||
if not IsIndexValid(N2) then Exit;
|
||||
|
||||
Item1:= Items[N1];
|
||||
Item2:= Items[N2];
|
||||
Item1.GetRange(XMin1, YMin1, XMax1, YMax1, Sel1);
|
||||
Item2.GetRange(XMin2, YMin2, XMax2, YMax2, Sel2);
|
||||
|
||||
//caret1 w/out selection inside caret2 selection?
|
||||
if not Sel1 and not Sel2 then Exit;
|
||||
if not Sel1 then
|
||||
begin
|
||||
Result:= IsPosInRange(Item1.PosX, Item1.PosY, XMin2, YMin2, XMax2, YMax2)=cRelateInside;
|
||||
if Result then
|
||||
begin OutPosX:= Item2.PosX; OutPosY:= Item2.PosY; OutEndX:= Item2.EndX; OutEndY:= Item2.EndY; end;
|
||||
Exit
|
||||
end;
|
||||
if not Sel2 then
|
||||
begin
|
||||
Result:= IsPosInRange(Item2.PosX, Item2.PosY, XMin1, YMin1, XMax1, YMax1)=cRelateInside;
|
||||
if Result then
|
||||
begin OutPosX:= Item1.PosX; OutPosY:= Item1.PosY; OutEndX:= Item1.EndX; OutEndY:= Item1.EndY; end;
|
||||
Exit
|
||||
end;
|
||||
|
||||
//calc join-result, needed only for Result=true
|
||||
//minimal point
|
||||
GetPositionMinOrMax(XMin1, YMin1, XMin2, YMin2, false, OutPosX, OutPosY);
|
||||
//maximal point
|
||||
GetPositionMinOrMax(XMax1, YMax1, XMax2, YMax2, true, OutEndX, OutEndY);
|
||||
|
||||
//swap points?
|
||||
if not IsPosSorted(Item1.PosX, Item1.PosY, Item1.EndX, Item1.EndY, false) then
|
||||
begin
|
||||
SwapInt(OutPosX, OutEndX);
|
||||
SwapInt(OutPosY, OutEndY);
|
||||
end;
|
||||
|
||||
if IsPosSorted(XMax1, YMax1, XMin2, YMin2, false) then Exit; //ranges not overlap [x1, y1]...[x2, y2]
|
||||
if IsPosSorted(XMax2, YMax2, XMin1, YMin1, false) then Exit; //ranges not overlap [x2, y2]...[x1, y1]
|
||||
Result:= true; //ranges overlap
|
||||
end;
|
||||
|
||||
function TATCarets.DebugText: string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= '';
|
||||
for i:= 0 to Count-1 do
|
||||
with Items[i] do
|
||||
Result:= Result+Format('caret[%d] pos %d:%d end %d:%d', [
|
||||
i, posy, posx, endy, endx
|
||||
])+sLineBreak;
|
||||
end;
|
||||
|
||||
function TATCarets.SaveToArray: TATPointArray;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
i: integer;
|
||||
begin
|
||||
SetLength(Result, Count*2);
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Item:= Items[i];
|
||||
Result[i*2].X:= Item.PosX;
|
||||
Result[i*2].Y:= Item.PosY;
|
||||
Result[i*2+1].X:= Item.EndX;
|
||||
Result[i*2+1].Y:= Item.EndY;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATCarets.LoadFromArray(const L: TATPointArray);
|
||||
var
|
||||
i: integer;
|
||||
Item: TATCaretItem;
|
||||
begin
|
||||
Clear;
|
||||
for i:= 0 to Length(L) div 2 - 1 do
|
||||
begin
|
||||
Add(0, 0);
|
||||
Item:= Items[Count-1];
|
||||
Item.PosX:= L[i*2].X;
|
||||
Item.PosY:= L[i*2].Y;
|
||||
Item.EndX:= L[i*2+1].X;
|
||||
Item.EndY:= L[i*2+1].Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATCarets.Add(XFrom, YFrom, XTo, YTo: integer);
|
||||
begin
|
||||
if (XFrom=XTo) and (YFrom=YTo) then Exit;
|
||||
Add(0, 0);
|
||||
with Items[Count-1] do
|
||||
begin
|
||||
PosX:= XTo;
|
||||
PosY:= YTo;
|
||||
EndX:= XFrom;
|
||||
EndY:= YFrom;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATCarets.UpdateColumnCoord(ASaveColumn: boolean);
|
||||
var
|
||||
i: integer;
|
||||
Caret: TATCaretItem;
|
||||
begin
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Caret:= Items[i];
|
||||
if ASaveColumn then
|
||||
begin
|
||||
if Caret.CoordColumn=0 then
|
||||
Caret.CoordColumn:= Caret.CoordX;
|
||||
end
|
||||
else
|
||||
Caret.CoordColumn:= 0
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATCarets.UpdateIncorrectPositions(AMaxLine: integer);
|
||||
var
|
||||
i: integer;
|
||||
Caret: TATCaretItem;
|
||||
begin
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
Caret:= Items[i];
|
||||
if Caret.PosY>AMaxLine then Caret.PosY:= AMaxLine;
|
||||
if Caret.EndY>AMaxLine then Caret.EndY:= AMaxLine;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
166
ATSynEdit/atsynedit/atsynedit_cmd_clipboard.inc
Normal file
166
ATSynEdit/atsynedit/atsynedit_cmd_clipboard.inc
Normal file
@@ -0,0 +1,166 @@
|
||||
{$ifdef nn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCommand_ClipboardPaste(AKeepCaret, ASelectThen: boolean): TATCommandResults;
|
||||
var
|
||||
Str: atString;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
//column block
|
||||
if Clipboard.HasFormat(cATClipboardFormatId) then
|
||||
begin
|
||||
if ModeOneLine then Exit;
|
||||
Result:= DoCommand_ClipboardPasteColumnBlock(AKeepCaret);
|
||||
Exit
|
||||
end;
|
||||
|
||||
//usual text
|
||||
Str:= UTF8Decode(Clipboard.AsText);
|
||||
if ModeOneLine then
|
||||
Str:= SRemoveNewlineChars(Str);
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
DoCommand_TextDeleteSelection;
|
||||
Result:= DoCommand_TextInsertAtCarets(Str,
|
||||
AKeepCaret,
|
||||
FOverwrite and FOptOverwriteAllowedOnPaste,
|
||||
ASelectThen);
|
||||
Strings.EndUndoGroup;
|
||||
|
||||
//workaround: paste on last line end
|
||||
if Carets.Count>0 then
|
||||
if Carets[0].PosY>=Strings.Count then
|
||||
Strings.ActionAddFakeLineIfNeeded;
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_ClipboardPasteColumnBlock(AKeepCaret: boolean): TATCommandResults;
|
||||
var
|
||||
Str: atString;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Str:= UTF8Decode(Clipboard.AsText);
|
||||
Strings.BeginUndoGroup;
|
||||
Result:= DoCommand_TextInsertColumnBlockOnce(Str, AKeepCaret);
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_ClipboardCut: TATCommandResults;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
if Carets.IsSelection then
|
||||
begin
|
||||
DoCommand_ClipboardCopy;
|
||||
Result:= DoCommand_TextDeleteSelection;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if FOptCutLinesIfNoSel then
|
||||
begin
|
||||
DoCommand_ClipboardCopy;
|
||||
Result:= DoCommand_TextDeleteLines;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ClipboardCopy(Append: boolean): TATCommandResults;
|
||||
begin
|
||||
if not IsSelRectEmpty then
|
||||
begin
|
||||
Clipboard.AsText:= GetTextForClipboard;
|
||||
Clipboard.AddFormat(cATClipboardFormatId, cATClipboardSignatureColBlock, SizeOf(cATClipboardSignatureColBlock));
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Append then
|
||||
Clipboard.AsText:= Clipboard.AsText+GetTextForClipboard
|
||||
else
|
||||
Clipboard.AsText:= GetTextForClipboard;
|
||||
end;
|
||||
|
||||
Result:= [];
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetTextForClipboard: string;
|
||||
var
|
||||
ListNum: TList;
|
||||
ListStr: TStringList;
|
||||
Caret: TATCaretItem;
|
||||
i, NLen, X1, Y1, X2, Y2: integer;
|
||||
bSel: boolean;
|
||||
Str: atString;
|
||||
begin
|
||||
Result:= '';
|
||||
|
||||
if not IsSelRectEmpty then
|
||||
begin
|
||||
for i:= FSelRect.Top to FSelRect.Bottom do
|
||||
begin
|
||||
Str:= Strings.Lines[i];
|
||||
X1:= SColumnPosToCharPos(Str, FSelRect.Left, OptTabSize);
|
||||
X2:= SColumnPosToCharPos(Str, FSelRect.Right, OptTabSize);
|
||||
Str:= Strings.TextSubstring(X1, i, X2, i);
|
||||
NLen:= X2-X1-Length(Str);
|
||||
if NLen>0 then
|
||||
Str:= Str+StringOfChar(' ', NLen);
|
||||
Result:= Result+UTF8Encode(Str)+sLineBreak;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ListNum:= TList.Create;
|
||||
ListStr:= TStringList.Create;
|
||||
|
||||
try
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
if ListNum.IndexOf(pointer{%H-}(Caret.PosY))<0 then
|
||||
ListNum.Add(pointer{%H-}(Caret.PosY));
|
||||
end;
|
||||
|
||||
//no selections-- copy entire lines
|
||||
if not Carets.IsSelection then
|
||||
begin
|
||||
if FOptCopyLinesIfNoSel then
|
||||
begin
|
||||
for i:= 0 to ListNum.Count-1 do
|
||||
begin
|
||||
Str:= Strings.Lines[NativeInt{%H-}(ListNum[i])];
|
||||
if Str<>'' then
|
||||
ListStr.Add(UTF8Encode(Str));
|
||||
end;
|
||||
Result:= ListStr.Text; //always use Text, need eol
|
||||
end;
|
||||
end
|
||||
else
|
||||
//selections-- copy selected ranges
|
||||
begin
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Caret.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then Continue;
|
||||
|
||||
Str:= Strings.TextSubstring(X1, Y1, X2, Y2);
|
||||
if Str<>'' then
|
||||
ListStr.Add(UTF8Encode(Str));
|
||||
end;
|
||||
|
||||
if ListStr.Count=1 then
|
||||
Result:= ListStr[0] //don't use Text to skip eol
|
||||
else
|
||||
Result:= ListStr.Text;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(ListStr);
|
||||
FreeAndNil(ListNum);
|
||||
end;
|
||||
end;
|
||||
|
||||
771
ATSynEdit/atsynedit/atsynedit_cmd_editing.inc
Normal file
771
ATSynEdit/atsynedit/atsynedit_cmd_editing.inc
Normal file
@@ -0,0 +1,771 @@
|
||||
{$ifdef nnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCommand_TextTabulation: TATCommandResults;
|
||||
var
|
||||
N1, N2: integer;
|
||||
begin
|
||||
//multiline selection?
|
||||
//instead of tabulation, do indent
|
||||
if FOptKeyTabIndents then
|
||||
if Carets.Count=1 then
|
||||
begin
|
||||
Carets[0].GetSelLines(N1, N2);
|
||||
if (N1>=0) and (N2>N1) then
|
||||
begin
|
||||
Result:= DoCommand_TextIndentUnindent(true);
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
if FOptTabSpaces then
|
||||
Result:= DoCommand_TextInsertTabSpacesAtCarets(FOverwrite)
|
||||
else
|
||||
Result:= DoCommand_TextInsertAtCarets(#9, false, FOverwrite, false);
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_TextInsertAtCarets(const AText: atString;
|
||||
AKeepCaret, AOvrMode, ASelectThen: boolean): TATCommandResults;
|
||||
var
|
||||
List: TStringList;
|
||||
//
|
||||
function TextItem(i: integer): atString;
|
||||
begin
|
||||
if Assigned(List) and (Carets.Count=List.Count) and (i>=0) and (i<List.Count) then
|
||||
Result:= UTF8Decode(List[i])
|
||||
else
|
||||
Result:= AText;
|
||||
end;
|
||||
//
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
bNeedGroup: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
List:= nil;
|
||||
|
||||
bNeedGroup:= (Carets.Count>1) or (Carets.IsSelection);
|
||||
if bNeedGroup then Strings.BeginUndoGroup;
|
||||
|
||||
DoSelectionDeleteOrReset;
|
||||
|
||||
//list allows to insert each clip-line into one caret
|
||||
if (AText<>sLineBreak) and (Length(AText)>1) and (Carets.Count>1) then
|
||||
begin
|
||||
List:= TStringList.Create;
|
||||
List.Text:= UTF8Encode(AText);
|
||||
end;
|
||||
|
||||
try
|
||||
for i:= Carets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Strings.TextInsert(Caret.PosX, Caret.PosY, TextItem(i), AOvrMode, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
|
||||
if not AKeepCaret then
|
||||
begin
|
||||
Caret.EndX:= IfThen(ASelectThen, Caret.PosX, -1);
|
||||
Caret.EndY:= IfThen(ASelectThen, Caret.PosY, -1);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
if Assigned(List) then
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
|
||||
if bNeedGroup then Strings.EndUndoGroup;
|
||||
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextInsertTabSpacesAtCarets(AOvrMode: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
StrSpaces: atString;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
DoSelectionDeleteOrReset;
|
||||
|
||||
for i:= Carets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
StrSpaces:= StringOfChar(' ', FTabSize - Caret.PosX mod FTabSize);
|
||||
Strings.TextInsert(Caret.PosX, Caret.PosY, StrSpaces, AOvrMode, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
Caret.EndX:= -1;
|
||||
Caret.EndY:= -1;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCalcIndentCharsFromPrevLines(AX, AY: integer): integer;
|
||||
var
|
||||
Str: atString;
|
||||
NIndent, i: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
if not Strings.IsIndexValid(AY) then Exit;
|
||||
|
||||
//allow smart unindent only if caret on 1st nonspace char
|
||||
//(else Bksp must delete 1 char)
|
||||
Str:= Strings.Lines[AY];
|
||||
NIndent:= SGetIndentChars(Str);
|
||||
if not ((AX=NIndent) and (NIndent>0)) then Exit;
|
||||
|
||||
//calc indent of N prev lines.
|
||||
//if indent<AX then ok
|
||||
for i:= 1 to FOptMaxLinesToCountUnindent do
|
||||
begin
|
||||
Dec(AY);
|
||||
if not Strings.IsIndexValid(AY) then Exit;
|
||||
|
||||
Str:= Strings.Lines[AY];
|
||||
NIndent:= SGetIndentChars(Str);
|
||||
if NIndent<AX then
|
||||
Exit(NIndent);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteLeft(ALen: integer; AAllowUnindent: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
NIndent, NDeleteLen: integer;
|
||||
bNeedGroup: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
//selection? delete it, exit.
|
||||
if Carets.IsSelection then
|
||||
begin
|
||||
Result:= DoCommand_TextDeleteSelection;
|
||||
Exit
|
||||
end;
|
||||
|
||||
bNeedGroup:= Carets.Count>1;
|
||||
if bNeedGroup then Strings.BeginUndoGroup;
|
||||
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
NDeleteLen:= ALen;
|
||||
|
||||
if AAllowUnindent then
|
||||
begin
|
||||
NIndent:= DoCalcIndentCharsFromPrevLines(Caret.PosX, Caret.PosY);
|
||||
if NIndent>=0 then
|
||||
if Caret.PosX>NIndent then
|
||||
NDeleteLen:= Caret.PosX-NIndent
|
||||
else
|
||||
NDeleteLen:= Caret.PosX;
|
||||
end;
|
||||
|
||||
Strings.TextDeleteLeft(Caret.PosX, Caret.PosY, NDeleteLen, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
|
||||
if bNeedGroup then Strings.EndUndoGroup;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDelete: TATCommandResults;
|
||||
var
|
||||
bColBlock: boolean;
|
||||
begin
|
||||
bColBlock:= not IsSelRectEmpty;
|
||||
if bColBlock then
|
||||
if FSelRect.Left=FSelRect.Right then
|
||||
begin
|
||||
DoSelect_None;
|
||||
bColBlock:= false;
|
||||
end;
|
||||
|
||||
if bColBlock or Carets.IsSelection then
|
||||
Result:= DoCommand_TextDeleteSelection
|
||||
else
|
||||
Result:= DoCommand_TextDeleteRight(1);
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteSelection: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
i: integer;
|
||||
AX1, AY1, AX2, AY2: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
if not IsSelRectEmpty and not OptCaretManyAllowed then
|
||||
begin
|
||||
DoSelectionDeleteColumnBlock;
|
||||
Result:= [cResultText, cResultCaretTop];
|
||||
Exit
|
||||
end;
|
||||
|
||||
if not Carets.IsSelection then Exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Caret.GetRange(AX1, AY1, AX2, AY2, bSel);
|
||||
if not bSel then Continue;
|
||||
|
||||
Strings.TextDeleteRange(AX1, AY1, AX2, AY2, Shift, PosAfter);
|
||||
DoCaretsShift(AX1, AY1, Shift.X, Shift.Y, PosAfter);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
Caret.EndX:= -1;
|
||||
Caret.EndY:= -1;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretTop];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteRight(ALen: integer): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
i, Len, ShiftBelowX: integer;
|
||||
Shift, PosAfter: TPoint;
|
||||
bNeedGroup: boolean;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
//selection? delete it, exit.
|
||||
if Carets.IsSelection then
|
||||
begin
|
||||
Result:= DoCommand_TextDeleteSelection;
|
||||
exit
|
||||
end;
|
||||
|
||||
bNeedGroup:= Carets.Count>1;
|
||||
if bNeedGroup then Strings.BeginUndoGroup;
|
||||
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
|
||||
//offsetX for carets in line[PosY+1]
|
||||
ShiftBelowX:= 0;
|
||||
Len:= Length(Strings.Lines[Caret.PosY]);
|
||||
if Caret.PosX=Len then
|
||||
ShiftBelowX:= Len;
|
||||
|
||||
Strings.TextDeleteRight(Caret.PosX, Caret.PosY, ALen, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter, ShiftBelowX);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
|
||||
if bNeedGroup then Strings.EndUndoGroup;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextInsertEol(AKeepCaret: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
Str: atString;
|
||||
bNeedGroup: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
if ModeOneLine then Exit;
|
||||
|
||||
bNeedGroup:= Carets.Count>1;
|
||||
if bNeedGroup then Strings.BeginUndoGroup;
|
||||
|
||||
DoSelectionDeleteOrReset;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Str:= GetAutoIndentString(Caret.PosX, Caret.PosY);
|
||||
Strings.TextInsertEol(Caret.PosX, Caret.PosY, AKeepCaret, Str, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
|
||||
if bNeedGroup then Strings.EndUndoGroup;
|
||||
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteLines: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
DoCaretsDeleteOnSameLines;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Strings.TextDeleteLine(Caret.PosX, Caret.PosY, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDuplicateLine: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Shift, PosAfter: TPoint;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
DoCaretsDeleteOnSameLines;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Strings.TextDuplicateLine(Caret.PosX, Caret.PosY, Shift, PosAfter);
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteToLineBegin: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
DoCaretsDeleteOnSameLines;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
Delete(Str, 1, Caret.PosX);
|
||||
Strings.Lines[Caret.PosY]:= Str;
|
||||
Caret.PosX:= 0;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretLeft];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteToLineEnd: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
DoCaretsDeleteOnSameLines;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
if Caret.PosX<Length(Str) then
|
||||
begin
|
||||
Delete(Str, Caret.PosX+1, MaxInt);
|
||||
Strings.Lines[Caret.PosY]:= Str;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteWord(ANext: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
Shift, PosAfter: TPoint;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
if not Strings.IsIndexValid(Caret.PosY) then Continue;
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
Shift.X:= 0;
|
||||
Shift.Y:= 0;
|
||||
PosAfter.X:= Caret.PosX;
|
||||
PosAfter.Y:= Caret.PosY;
|
||||
|
||||
//delete to prev line?
|
||||
if (Caret.PosX=0) and (not ANext) then
|
||||
begin
|
||||
Strings.TextDeleteLeft(Caret.PosX, Caret.PosY, 1, Shift, PosAfter);
|
||||
end
|
||||
else
|
||||
//delete to next line?
|
||||
if (Caret.PosX>=Length(Str)) and ANext then
|
||||
begin
|
||||
Strings.TextDeleteRight(Caret.PosX, Caret.PosY, 1, Shift, PosAfter);
|
||||
end
|
||||
else
|
||||
//jump from beyond eol to eol?
|
||||
if (Caret.PosX>Length(Str)) and (not ANext) then
|
||||
begin
|
||||
Caret.PosX:= Length(Str);
|
||||
end
|
||||
else
|
||||
//delete inside line?
|
||||
if (Caret.PosX<=Length(Str)) then
|
||||
begin
|
||||
PosAfter.X:= SFindWordOffset(Str, Caret.PosX, ANext, false, FOptWordChars);
|
||||
if PosAfter.X<>Caret.PosX then
|
||||
begin
|
||||
System.Delete(Str, Min(Caret.PosX, PosAfter.X)+1, Abs(Caret.PosX-PosAfter.X));
|
||||
Strings.Lines[Caret.PosY]:= Str;
|
||||
Shift.X:= -Abs(Caret.PosX-PosAfter.X);
|
||||
PosAfter.X:= Min(Caret.PosX, PosAfter.X);
|
||||
end;
|
||||
end;
|
||||
|
||||
DoCaretsShift(Caret.PosX, Caret.PosY, Shift.X, Shift.Y, PosAfter);
|
||||
|
||||
if ((Caret.PosX<>PosAfter.X) or (Caret.PosY<>PosAfter.Y)) and
|
||||
(FCarets.IndexOfPosXY(PosAfter.X, PosAfter.Y)>=0) then
|
||||
begin
|
||||
if FCarets.Count>1 then
|
||||
FCarets.Delete(i);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
if ANext then
|
||||
Result:= [cResultText, cResultCaretBottom]
|
||||
else
|
||||
Result:= [cResultText, cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextIndentUnindent(ARight: boolean): TATCommandResults;
|
||||
var
|
||||
Y1, Y2: integer;
|
||||
NDecSpaces, NMinSpaces, i: integer;
|
||||
Str: atString;
|
||||
Caret: TATCaretItem;
|
||||
NShiftInit, NShift1, NShift2, NIndent1, NIndent2: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
DoCaretSingleAsIs;
|
||||
|
||||
Caret:= Carets[0];
|
||||
Caret.GetSelLines(Y1, Y2, true{Allow no sel});
|
||||
if Y1<0 then Exit;
|
||||
|
||||
if Caret.EndY<0 then
|
||||
begin
|
||||
Caret.EndX:= Caret.PosX;
|
||||
Caret.EndY:= Caret.PosY;
|
||||
end;
|
||||
|
||||
if FOptIndentSize>=0 then
|
||||
NDecSpaces:= FOptIndentSize
|
||||
else
|
||||
NDecSpaces:= Abs(FOptIndentSize)*FTabSize;
|
||||
|
||||
//calc minimal indent of all
|
||||
NMinSpaces:= MaxInt;
|
||||
for i:= Y1 to Y2 do
|
||||
begin
|
||||
Str:= Strings.Lines[i];
|
||||
if Trim(Str)='' then Continue;
|
||||
NMinSpaces:= Min(NMinSpaces, SGetIndentExpanded(Str, FTabSize));
|
||||
end;
|
||||
if NMinSpaces=MaxInt then Exit;
|
||||
|
||||
//consider "Unindent keeps align"
|
||||
if FOptIndentKeepsAlign then
|
||||
if (not ARight) and (NMinSpaces<NDecSpaces) then Exit;
|
||||
|
||||
//calc shifts (emulate Laz ide indent)
|
||||
NIndent1:= SGetIndentChars(Strings.Lines[Caret.PosY]);
|
||||
NIndent2:= SGetIndentChars(Strings.Lines[Caret.EndY]);
|
||||
NShiftInit:= Abs(FOptIndentSize) * IfThen(ARight, 1, -1);
|
||||
NShift1:= IfThen((Caret.PosX>=NIndent1) and (Caret.PosX>0), NShiftInit, 0);
|
||||
NShift2:= IfThen((Caret.EndX>=NIndent2), NShiftInit, 0);
|
||||
|
||||
//do indent
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
for i:= Y1 to Y2 do
|
||||
begin
|
||||
Str:= Strings.Lines[i];
|
||||
if Trim(Str)='' then Continue;
|
||||
Str:= SIndentUnindent(Str, ARight, FOptIndentSize, FTabSize);
|
||||
if Strings.Lines[i]<>Str then
|
||||
Strings.Lines[i]:= Str;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
//correct selection
|
||||
Caret.PosX:= Max(0, Caret.PosX+NShift1);
|
||||
Caret.EndX:= Max(0, Caret.EndX+NShift2);
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_Undo: TATCommandResults;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.Undo(FOptUndoGrouped);
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_Redo: TATCommandResults;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.SetGroupMark;
|
||||
Strings.Redo(FOptUndoGrouped);
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_TextInsertColumnBlockOnce(const AText: atString;
|
||||
AKeepCaret: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Block: TATStrings;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
//cannot handle carets/selections for colblock
|
||||
DoCaretSingleAsIs;
|
||||
DoSelect_None;
|
||||
Caret:= FCarets[0];
|
||||
|
||||
Block:= TATStrings.Create;
|
||||
try
|
||||
Block.LoadFromString(AText);
|
||||
Block.ActionDeleteFakeLine;
|
||||
if Block.Count=0 then Exit;
|
||||
|
||||
Strings.TextInsertColumnBlock(Caret.PosX, Caret.PosY, Block, FOverwrite);
|
||||
if not AKeepCaret then
|
||||
Inc(Caret.PosY, Block.Count-1);
|
||||
finally
|
||||
FreeAndNil(Block);
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_TextDeleteToFileEnd: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
DoCaretSingleAsIs;
|
||||
|
||||
Caret:= FCarets[0];
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
if Caret.PosX<Length(Str) then
|
||||
begin
|
||||
Delete(Str, Caret.PosX+1, MaxInt);
|
||||
Strings.Lines[Caret.PosY]:= Str;
|
||||
end;
|
||||
|
||||
for i:= Strings.Count-1 downto Caret.PosY+1 do
|
||||
Strings.LineDelete(i);
|
||||
|
||||
if Caret.PosY>=Strings.Count-1 then
|
||||
Strings.LinesEnds[Caret.PosY]:= cEndNone;
|
||||
|
||||
Result:= [cResultText, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_TextInsertEmptyAboveBelow(ADown: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
PosAfter: TPoint;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
DoCaretsDeleteOnSameLines;
|
||||
|
||||
for i:= Carets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Strings.LineInsert(Caret.PosY + IfThen(ADown, 1), '');
|
||||
|
||||
PosAfter.X:= 0;
|
||||
PosAfter.Y:= Caret.PosY+IfThen(ADown, 1);
|
||||
|
||||
DoCaretsShift(0, Caret.PosY, 0, 1, PosAfter);
|
||||
|
||||
Caret.PosX:= PosAfter.X;
|
||||
Caret.PosY:= PosAfter.Y;
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextChangeCase(AMode: TATCaseConvert): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str1, Str2: atString;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
Shift, PosAfter: TPoint;
|
||||
bSel: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
for i:= Carets.Count-1 downto 0 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Caret.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then
|
||||
begin
|
||||
SFindWordBounds(Strings.Lines[Caret.PosY], Caret.PosX, X1, X2, FOptWordChars);
|
||||
if X1<0 then Continue;
|
||||
Y1:= Caret.PosY;
|
||||
Y2:= Caret.PosY;
|
||||
end;
|
||||
|
||||
Str1:= Strings.TextSubstring(X1, Y1, X2, Y2);
|
||||
case AMode of
|
||||
cCaseLower: Str2:= UnicodeLowerCase(Str1);
|
||||
cCaseUpper: Str2:= UnicodeUpperCase(Str1);
|
||||
cCaseTitle: Str2:= SCaseTitle(Str1, FOptWordChars);
|
||||
cCaseInvert: Str2:= SCaseInvert(Str1);
|
||||
cCaseSentence: Str2:= SCaseSentence(Str1, FOptWordChars);
|
||||
end;
|
||||
if Str1=Str2 then Continue;
|
||||
|
||||
Strings.TextDeleteRange(X1, Y1, X2, Y2, Shift, PosAfter);
|
||||
Strings.TextInsert(X1, Y1, Str2, false, Shift, PosAfter);
|
||||
end;
|
||||
Strings.EndUndoGroup;
|
||||
|
||||
Result:= [cResultText, cResultCaretAny];
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCommentSelectionLines(Act: TATCommentAction; const AComment: atString);
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
L: TStringList;
|
||||
NFrom, NTo, i: integer;
|
||||
Shift, PosAfter: TPoint;
|
||||
bChange: boolean;
|
||||
begin
|
||||
if Carets.Count=0 then exit;
|
||||
Caret:= Carets[0];
|
||||
Caret.GetSelLines(NFrom, NTo, true);
|
||||
if NFrom<0 then exit;
|
||||
if NTo<0 then exit;
|
||||
|
||||
L:= TStringList.Create;
|
||||
try
|
||||
for i:= NFrom to NTo do
|
||||
L.Add(Utf8Encode(Strings.Lines[i]));
|
||||
|
||||
bChange:= SCommentLineAction(L, AComment, Act);
|
||||
if not bChange then exit;
|
||||
Assert(L.Count=(NTo-NFrom+1), 'DoCommentSel changed line count');
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
for i:= NFrom to NTo do
|
||||
Strings.Lines[i]:= Utf8Decode(L[i-NFrom]);
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
|
||||
DoEventChange;
|
||||
Update(true);
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextTrimSpaces(AMode: TATTrimSpaces
|
||||
): TATCommandResults;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
if Strings.ActionTrimSpaces(AMode) then
|
||||
Result:= [cResultCaretAny, cResultText];
|
||||
end;
|
||||
|
||||
301
ATSynEdit/atsynedit/atsynedit_cmd_handler.inc
Normal file
301
ATSynEdit/atsynedit/atsynedit_cmd_handler.inc
Normal file
@@ -0,0 +1,301 @@
|
||||
{$ifdef none}begin end;{$endif}
|
||||
|
||||
procedure TATSynEdit.DoMenuText;
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
P:= ClientToScreen(Point(0, 0));
|
||||
if Assigned(FMenuText) then
|
||||
FMenuText.PopUp(P.X, P.Y)
|
||||
else
|
||||
FMenuStd.PopUp(P.X, P.Y);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
if not FWantTabs then
|
||||
if Key=vk_tab then Exit;
|
||||
|
||||
if Key=vk_apps then
|
||||
begin
|
||||
DoMenuText;
|
||||
Exit
|
||||
end;
|
||||
|
||||
DoPaintModeStatic;
|
||||
try
|
||||
DoCommand(GetCommandFromKey(Key, Shift));
|
||||
finally
|
||||
DoPaintModeBlinking;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.UTF8KeyPress(var UTF8Key: TUTF8Char);
|
||||
var
|
||||
Str: atString;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
//skip control Ascii chars
|
||||
if Ord(UTF8Key[1])<32 then Exit;
|
||||
|
||||
Str:= Utf8Decode(Utf8Key);
|
||||
DoCommand(cCommand_TextInsert, Str);
|
||||
Utf8Key:= '';
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetCommandFromKey(var Key: Word; Shift: TShiftState): integer;
|
||||
var
|
||||
Shortcut: TShortcut;
|
||||
begin
|
||||
Result:= 0;
|
||||
|
||||
if (Key=VK_TAB) and (Shift=[]) then
|
||||
begin
|
||||
Result:= cCommand_KeyTab;
|
||||
Key:= 0;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if IsEditableTextKey(Key) and ((Shift=[]) or (Shift=[ssShift])) then
|
||||
Exit;
|
||||
|
||||
if not Assigned(FKeymap) then
|
||||
begin
|
||||
ShowMessage('Keymap not assigned: cannot input keys');
|
||||
Exit
|
||||
end;
|
||||
|
||||
Shortcut:= KeyToShortCut(Key, Shift);
|
||||
Result:= FKeymap.GetCommandFromShortcut(Shortcut);
|
||||
if Result>0 then
|
||||
Key:= 0;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCommandResults(Res: TATCommandResults);
|
||||
begin
|
||||
if cResultText in Res then
|
||||
begin
|
||||
FWrapUpdateNeeded:= true;
|
||||
UpdateWrapInfo;
|
||||
|
||||
if FOptMouseHideCursor then
|
||||
if PtInRect(FRectMain, ScreenToClient(Mouse.CursorPos)) then
|
||||
SetCursor(crNone);
|
||||
end;
|
||||
|
||||
DoCaretsSort;
|
||||
UpdateCaretsCoords;
|
||||
|
||||
if cResultCaretLeft in Res then DoGotoCaret(cEdgeLeft);
|
||||
if cResultCaretRight in Res then DoGotoCaret(cEdgeRight);
|
||||
if cResultCaretTop in Res then DoGotoCaret(cEdgeTop);
|
||||
if cResultCaretBottom in Res then DoGotoCaret(cEdgeBottom);
|
||||
|
||||
if Res*[cResultCaretAny,
|
||||
cResultCaretLeft, cResultCaretRight,
|
||||
cResultCaretTop, cResultCaretBottom]<>[] then
|
||||
begin
|
||||
if not (cResultKeepColumnSel in Res) then
|
||||
FSelRect:= cRectEmpty;
|
||||
DoEventCarets;
|
||||
end;
|
||||
|
||||
if cResultText in Res then
|
||||
begin
|
||||
FSelRect:= cRectEmpty;
|
||||
DoEventChange;
|
||||
end;
|
||||
|
||||
if cResultScroll in Res then
|
||||
DoEventScroll;
|
||||
|
||||
if cResultState in Res then
|
||||
DoEventState;
|
||||
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCommand(ACmd: integer; const AText: atString = '');
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Res: TATCommandResults;
|
||||
i: integer;
|
||||
begin
|
||||
if ACmd<=0 then Exit;
|
||||
if DoEventCommand(ACmd, AText) then Exit;
|
||||
|
||||
Res:= [];
|
||||
FCaretSpecPos:= false;
|
||||
|
||||
//---handle special command bits (cCmdNNNNN)
|
||||
if ACmd and cCmdSelKeep <> 0 then
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
if Caret.EndY<0 then Caret.EndY:= Caret.PosY;
|
||||
if Caret.EndX<0 then Caret.EndX:= Caret.PosX;
|
||||
end;
|
||||
|
||||
if ACmd and cCmdSelReset <> 0 then
|
||||
DoSelect_None;
|
||||
|
||||
if ACmd and cCmdCaret <> 0 then
|
||||
begin
|
||||
Strings.SetGroupMark;
|
||||
|
||||
//save column for Up/Down movement
|
||||
Carets.UpdateColumnCoord(
|
||||
(ACmd=cCommand_KeyUp) or
|
||||
(ACmd=cCommand_KeyDown) or
|
||||
(ACmd=cCommand_KeyUp_Sel) or
|
||||
(ACmd=cCommand_KeyDown_Sel)
|
||||
);
|
||||
end;
|
||||
|
||||
//debug
|
||||
//if FCaretMoved then Beep;
|
||||
//--------
|
||||
|
||||
case ACmd of
|
||||
//most used commands
|
||||
cCommand_KeyLeft: Res:= DoCommand_KeyLeft(false);
|
||||
cCommand_KeyLeft_Sel: Res:= DoCommand_KeyLeft(true);
|
||||
cCommand_KeyRight: Res:= DoCommand_KeyRight(false);
|
||||
cCommand_KeyRight_Sel: Res:= DoCommand_KeyRight(true);
|
||||
cCommand_KeyUp,
|
||||
cCommand_KeyUp_Sel: Res:= DoCommand_KeyUpDown(false, 1, false);
|
||||
cCommand_KeyDown,
|
||||
cCommand_KeyDown_Sel: Res:= DoCommand_KeyUpDown(true, 1, false);
|
||||
cCommand_KeyHome,
|
||||
cCommand_KeyHome_Sel: Res:= DoCommand_KeyHome;
|
||||
cCommand_KeyEnd,
|
||||
cCommand_KeyEnd_Sel: Res:= DoCommand_KeyEnd;
|
||||
cCommand_KeyPageUp,
|
||||
cCommand_KeyPageUp_Sel: Res:= DoCommand_KeyUpDown(false, GetPageLines, FOptKeyPageKeepsRelativePos);
|
||||
cCommand_KeyPageDown,
|
||||
cCommand_KeyPageDown_Sel: Res:= DoCommand_KeyUpDown(true, GetPageLines, FOptKeyPageKeepsRelativePos);
|
||||
|
||||
cCommand_ColSelectLeft: Res:= DoCommand_SelectColumn(cDirColumnLeft);
|
||||
cCommand_ColSelectRight: Res:= DoCommand_SelectColumn(cDirColumnRight);
|
||||
cCommand_ColSelectUp: Res:= DoCommand_SelectColumn(cDirColumnUp);
|
||||
cCommand_ColSelectDown: Res:= DoCommand_SelectColumn(cDirColumnDown);
|
||||
cCommand_ColSelectPageUp: Res:= DoCommand_SelectColumn(cDirColumnPageUp);
|
||||
cCommand_ColSelectPageDown: Res:= DoCommand_SelectColumn(cDirColumnPageDown);
|
||||
cCommand_ColSelectToLineBegin: Res:= DoCommand_SelectColumnToLineEdge(false);
|
||||
cCommand_ColSelectToLineEnd: Res:= DoCommand_SelectColumnToLineEdge(true);
|
||||
|
||||
cCommand_TextInsert: Res:= DoCommand_TextInsertAtCarets(AText, false, FOverwrite, false);
|
||||
cCommand_TextInsertTabChar: Res:= DoCommand_TextInsertAtCarets(#9, false, FOverwrite, false);
|
||||
cCommand_KeyBackspace: Res:= DoCommand_TextBackspace;
|
||||
cCommand_KeyDelete: Res:= DoCommand_TextDelete;
|
||||
cCommand_KeyTab: Res:= DoCommand_TextTabulation;
|
||||
cCommand_KeyEnter: Res:= DoCommand_TextInsertEol(false);
|
||||
|
||||
cCommand_Undo: Res:= DoCommand_Undo;
|
||||
cCommand_Redo: Res:= DoCommand_Redo;
|
||||
//end of most used
|
||||
|
||||
cCommand_TextDeleteSelection: Res:= DoCommand_TextDeleteSelection;
|
||||
cCommand_TextDeleteLine: Res:= DoCommand_TextDeleteLines;
|
||||
cCommand_TextDuplicateLine: Res:= DoCommand_TextDuplicateLine;
|
||||
cCommand_TextDeleteToLineBegin: Res:= DoCommand_TextDeleteToLineBegin;
|
||||
cCommand_TextDeleteToLineEnd: Res:= DoCommand_TextDeleteToLineEnd;
|
||||
cCommand_TextDeleteToTextEnd: Res:= DoCommand_TextDeleteToFileEnd;
|
||||
cCommand_TextDeleteWordPrev: Res:= DoCommand_TextDeleteWord(false);
|
||||
cCommand_TextDeleteWordNext: Res:= DoCommand_TextDeleteWord(true);
|
||||
|
||||
cCommand_SelectAll: Res:= DoCommand_SelectAll;
|
||||
cCommand_SelectNone: Res:= [cResultCaretAny];
|
||||
cCommand_SelectInverted: Res:= DoCommand_SelectInverted;
|
||||
cCommand_SelectSplitToLines: Res:= DoCommand_SelectSplitToLines;
|
||||
cCommand_SelectExtendByLine: Res:= DoCommand_SelectExtendByLine;
|
||||
cCommand_SelectWords: Res:= DoCommand_SelectWords;
|
||||
cCommand_SelectLines: Res:= DoCommand_SelectLines;
|
||||
|
||||
cCommand_GotoTextBegin,
|
||||
cCommand_GotoTextBegin_Sel: Res:= DoCommand_GotoTextBegin;
|
||||
cCommand_GotoTextEnd,
|
||||
cCommand_GotoTextEnd_Sel: Res:= DoCommand_GotoTextEnd;
|
||||
cCommand_GotoWordNext,
|
||||
cCommand_GotoWordNext_Sel: Res:= DoCommand_GotoWord(true);
|
||||
cCommand_GotoWordPrev,
|
||||
cCommand_GotoWordPrev_Sel: Res:= DoCommand_GotoWord(false);
|
||||
|
||||
cCommand_ToggleOverwrite: Res:= DoCommand_ToggleOverwrite;
|
||||
cCommand_ToggleReadOnly: Res:= DoCommand_ToggleReadOnly;
|
||||
cCommand_ToggleWordWrap: Res:= DoCommand_ToggleWordWrap;
|
||||
cCommand_ToggleUnprinted: Res:= DoCommand_ToggleUnprinted;
|
||||
cCommand_ToggleUnprintedSpaces: Res:= DoCommand_ToggleUnprintedSpaces;
|
||||
cCommand_ToggleUnprintedEnds: Res:= DoCommand_ToggleUnprintedEnds;
|
||||
cCommand_ToggleUnprintedEndDetails: Res:= DoCommand_ToggleUnprintedEndDetails;
|
||||
cCommand_ToggleLineNums: Res:= DoCommand_ToggleLineNums;
|
||||
cCommand_ToggleFolding: Res:= DoCommand_ToggleFolding;
|
||||
cCommand_ToggleRuler: Res:= DoCommand_ToggleRuler;
|
||||
cCommand_ToggleMinimap: Res:= DoCommand_ToggleMinimap;
|
||||
|
||||
cCommand_TextIndent: Res:= DoCommand_TextIndentUnindent(true);
|
||||
cCommand_TextUnindent: Res:= DoCommand_TextIndentUnindent(false);
|
||||
|
||||
cCommand_ScrollLineUp: Res:= DoCommand_ScrollVert(-1);
|
||||
cCommand_ScrollLineDown: Res:= DoCommand_ScrollVert(1);
|
||||
cCommand_ScrollToCaretTop: Res:= [cResultCaretTop];
|
||||
cCommand_ScrollToCaretBottom: Res:= [cResultCaretBottom];
|
||||
cCommand_ScrollToCaretLeft: Res:= [cResultCaretLeft];
|
||||
cCommand_ScrollToCaretRight: Res:= [cResultCaretRight];
|
||||
|
||||
cCommand_ClipboardCopy: Res:= DoCommand_ClipboardCopy;
|
||||
cCommand_ClipboardCopyAdd: Res:= DoCommand_ClipboardCopy(true);
|
||||
cCommand_ClipboardCut: Res:= DoCommand_ClipboardCut;
|
||||
cCommand_ClipboardPaste: Res:= DoCommand_ClipboardPaste(false, false);
|
||||
cCommand_ClipboardPaste_Select: Res:= DoCommand_ClipboardPaste(false, true);
|
||||
cCommand_ClipboardPaste_KeepCaret: Res:= DoCommand_ClipboardPaste(true, false);
|
||||
cCommand_ClipboardPaste_Column: Res:= DoCommand_ClipboardPasteColumnBlock(false);
|
||||
cCommand_ClipboardPaste_ColumnKeepCaret: Res:= DoCommand_ClipboardPasteColumnBlock(true);
|
||||
|
||||
cCommand_MoveSelectionUp: Res:= DoCommand_MoveSelectionUpDown(false);
|
||||
cCommand_MoveSelectiondown: Res:= DoCommand_MoveSelectionUpDown(true);
|
||||
cCommand_TextInsertEmptyAbove: Res:= DoCommand_TextInsertEmptyAboveBelow(false);
|
||||
cCommand_TextInsertEmptyBelow: Res:= DoCommand_TextInsertEmptyAboveBelow(true);
|
||||
|
||||
cCommand_TextCaseLower: Res:= DoCommand_TextChangeCase(cCaseLower);
|
||||
cCommand_TextCaseUpper: Res:= DoCommand_TextChangeCase(cCaseUpper);
|
||||
cCommand_TextCaseTitle: Res:= DoCommand_TextChangeCase(cCaseTitle);
|
||||
cCommand_TextCaseInvert: Res:= DoCommand_TextChangeCase(cCaseInvert);
|
||||
cCommand_TextCaseSentence: Res:= DoCommand_TextChangeCase(cCaseSentence);
|
||||
|
||||
cCommand_TextTrimSpacesLeft: Res:= DoCommand_TextTrimSpaces(cTrimLeft);
|
||||
cCommand_TextTrimSpacesRight: Res:= DoCommand_TextTrimSpaces(cTrimRight);
|
||||
cCommand_TextTrimSpacesAll: Res:= DoCommand_TextTrimSpaces(cTrimAll);
|
||||
|
||||
cCommand_FoldAll: Res:= DoCommand_FoldUnfoldAll(true);
|
||||
cCommand_UnfoldAll: Res:= DoCommand_FoldUnfoldAll(false);
|
||||
cCommand_FoldLevel2..
|
||||
cCommand_FoldLevel9: Res:= DoCommand_FoldLevel(ACmd-cCommand_FoldLevel2+1);
|
||||
|
||||
cCommand_Cancel: Res:= DoCommand_Cancel;
|
||||
cCommand_CaretsExtendUpLine: Res:= DoCommand_CaretsExtend(false, 1);
|
||||
cCommand_CaretsExtendUpPage: Res:= DoCommand_CaretsExtend(false, GetPageLines);
|
||||
cCommand_CaretsExtendUpToTop: Res:= DoCommand_CaretsExtend(false, Strings.Count);
|
||||
cCommand_CaretsExtendDownLine: Res:= DoCommand_CaretsExtend(true, 1);
|
||||
cCommand_CaretsExtendDownPage: Res:= DoCommand_CaretsExtend(true, GetPageLines);
|
||||
cCommand_CaretsExtendDownToEnd: Res:= DoCommand_CaretsExtend(true, Strings.Count);
|
||||
|
||||
cCommand_ZoomIn: Res:= DoCommand_SizeChange(true);
|
||||
cCommand_ZoomOut: Res:= DoCommand_SizeChange(false);
|
||||
cCommand_RepeatTextCommand: DoCommand(FLastTextCmd, FLastTextCmdText);
|
||||
end;
|
||||
|
||||
if cResultText in Res then
|
||||
if ACmd<>cCommand_RepeatTextCommand then
|
||||
begin
|
||||
FLastTextCmd:= ACmd;
|
||||
FLastTextCmdText:= AText;
|
||||
end;
|
||||
|
||||
DoCommandResults(Res);
|
||||
end;
|
||||
|
||||
|
||||
335
ATSynEdit/atsynedit/atsynedit_cmd_keys.inc
Normal file
335
ATSynEdit/atsynedit/atsynedit_cmd_keys.inc
Normal file
@@ -0,0 +1,335 @@
|
||||
{$ifdef nnnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCommand_KeyHome: TATCommandResults;
|
||||
var
|
||||
i, NIndent, NWrapped: integer;
|
||||
Caret: TATCaretItem;
|
||||
Pnt: TPoint;
|
||||
EolPos: boolean;
|
||||
begin
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
NWrapped:= 0;
|
||||
NIndent:= 0;
|
||||
|
||||
if FOptKeyHomeEndNavigateWrapped and (FWrapMode<>cWrapOff) then
|
||||
begin
|
||||
Pnt.X:= 0;
|
||||
Pnt.Y:= Caret.CoordY;
|
||||
Pnt:= ClientPosToCaretPos(Pnt, EolPos);
|
||||
NWrapped:= Pnt.X;
|
||||
end;
|
||||
|
||||
if FOptKeyHomeToNonSpace then
|
||||
NIndent:= SGetIndentChars(Strings.Lines[Caret.PosY]);
|
||||
|
||||
if (NWrapped>0) and (Caret.PosX>NWrapped) then
|
||||
Caret.PosX:= NWrapped
|
||||
else
|
||||
if (NIndent>0) and (Caret.PosX>NIndent) then
|
||||
Caret.PosX:= NIndent
|
||||
else
|
||||
Caret.PosX:= 0;
|
||||
end;
|
||||
|
||||
Result:= [cResultCaretLeft];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyEnd: TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
Pnt: TPoint;
|
||||
i, NLen, NWrapped: integer;
|
||||
EolPos: boolean;
|
||||
begin
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
NLen:= 0;
|
||||
NWrapped:= 0;
|
||||
|
||||
if FOptKeyHomeEndNavigateWrapped and (FWrapMode<>cWrapOff) then
|
||||
begin
|
||||
Pnt.X:= ClientWidth;
|
||||
Pnt.Y:= Caret.CoordY;
|
||||
Pnt:= ClientPosToCaretPos(Pnt, EolPos);
|
||||
if Pnt.X<Length(Str) then
|
||||
NWrapped:= Pnt.X-1;
|
||||
//-1 here: need to jump not to last chr but to last-1 chr
|
||||
//(like Synwrite; to not blink caret at next part of wrapped line)
|
||||
end;
|
||||
|
||||
if FOptKeyEndToNonSpace then
|
||||
NLen:= SGetNonSpaceLength(Str);
|
||||
|
||||
if (NWrapped>0) and (Caret.PosX<NWrapped) then
|
||||
Caret.PosX:= NWrapped
|
||||
else
|
||||
if (NLen>0) and (Caret.PosX<NLen) then
|
||||
Caret.PosX:= NLen
|
||||
else
|
||||
Caret.PosX:= Length(Str);
|
||||
end;
|
||||
|
||||
Result:= [cResultCaretRight];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyLeft(ASelCommand: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [cResultCaretLeft];
|
||||
|
||||
if not ASelCommand then
|
||||
begin
|
||||
if FOptKeyLeftRightSwapSel then
|
||||
if DoCaretSwapEdge(true) then Exit;
|
||||
DoSelect_None;
|
||||
end;
|
||||
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
if (Caret.PosX>0) then
|
||||
Dec(Caret.PosX)
|
||||
else
|
||||
if (Caret.PosY>0) and not FCaretVirtual then
|
||||
begin
|
||||
Dec(Caret.PosY);
|
||||
Caret.PosX:= Length(Strings.Lines[Caret.PosY]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyRight(ASelCommand: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= [cResultCaretRight];
|
||||
|
||||
if not ASelCommand then
|
||||
begin
|
||||
if FOptKeyLeftRightSwapSel then
|
||||
if DoCaretSwapEdge(false) then Exit;
|
||||
DoSelect_None;
|
||||
end;
|
||||
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
if (Caret.PosX<Length(Strings.Lines[Caret.PosY])) or FCaretVirtual then
|
||||
Inc(Caret.PosX)
|
||||
else
|
||||
if (Caret.PosY<Strings.Count-1) then
|
||||
begin
|
||||
Caret.PosX:= 0;
|
||||
Inc(Caret.PosY);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyUpDown(ADown: boolean; ALines: integer;
|
||||
AKeepRelativePos: boolean): TATCommandResults;
|
||||
var
|
||||
NRelative: integer;
|
||||
begin
|
||||
FCaretSpecPos:= true;
|
||||
|
||||
if AKeepRelativePos then
|
||||
NRelative:= LinesFromTop;
|
||||
|
||||
//don't check here FWrapMode<>cWrapOff
|
||||
if FOptKeyUpDownNavigateWrapped then
|
||||
Result:= DoCommand_KeyUpDown_Wrapped(ADown, ALines)
|
||||
else
|
||||
Result:= DoCommand_KeyUpDown_NextLine(ADown, ALines);
|
||||
|
||||
if AKeepRelativePos then
|
||||
LinesFromTop:= NRelative;
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyUpDown_NextLine(ADown: boolean; ALines: integer): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
i, Y: integer;
|
||||
begin
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Caret:= Carets[i];
|
||||
Y:= Caret.PosY;
|
||||
|
||||
repeat
|
||||
Y:= Y+ALines*BoolToPlusMinusOne(ADown);
|
||||
until not Strings.IsIndexValid(Y) or not IsLineFolded(Y);
|
||||
|
||||
if not IsLineFolded(Y) then
|
||||
begin
|
||||
if Y<0 then Y:= GetFirstUnfoldedLineNumber;
|
||||
if Y>=Strings.Count then Y:= GetLastUnfoldedLineNumber;
|
||||
Caret.PosY:= Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
if ADown then
|
||||
Result:= [cResultCaretBottom]
|
||||
else
|
||||
Result:= [cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_KeyUpDown_Wrapped(ADown: boolean; ALines: integer): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Pnt: TPoint;
|
||||
i: integer;
|
||||
EolPos: boolean;
|
||||
begin
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
|
||||
if IsPosFolded(Caret.PosX, Caret.PosY) then
|
||||
begin
|
||||
Caret.PosX:= 0;
|
||||
Caret.PosY:= GetNextUnfoldedLineNumber(Caret.PosY, ADown);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
Pnt.X:= Caret.CoordX;
|
||||
if FOptKeyUpDownKeepColumn and (Caret.CoordColumn>0) then
|
||||
Pnt.X:= Caret.CoordColumn;
|
||||
|
||||
Pnt.Y:= Caret.CoordY + ALines*FCharSize.Y*BoolToPlusMinusOne(ADown);
|
||||
Pnt:= ClientPosToCaretPos(Pnt, EolPos);
|
||||
if Pnt.Y<0 then Continue;
|
||||
|
||||
if EolPos and (Pnt.X>0) then
|
||||
Dec(Pnt.X); //-1 so up/down won't jump to eol pos (caret may paint on next line)
|
||||
|
||||
Caret.PosX:= Pnt.X;
|
||||
Caret.PosY:= Pnt.Y;
|
||||
end;
|
||||
|
||||
if ADown then
|
||||
Result:= [cResultCaretBottom]
|
||||
else
|
||||
Result:= [cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_TextBackspace: TATCommandResults;
|
||||
var
|
||||
bColBlock: boolean;
|
||||
begin
|
||||
bColBlock:= not IsSelRectEmpty;
|
||||
if bColBlock then
|
||||
if FSelRect.Left=FSelRect.Right then
|
||||
begin
|
||||
DoSelect_None;
|
||||
bColBlock:= false;
|
||||
end;
|
||||
|
||||
if bColBlock then
|
||||
Result:= DoCommand_TextDeleteSelection
|
||||
else
|
||||
Result:= DoCommand_TextDeleteLeft(1, FOptKeyBackspaceUnindent);
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_GotoTextBegin: TATCommandResults;
|
||||
var
|
||||
Item: TATSynWrapItem;
|
||||
begin
|
||||
Item:= FWrapInfo[0];
|
||||
if Assigned(Item) then
|
||||
DoCaretSingle(0, Item.NLineIndex, false);
|
||||
|
||||
FScrollHorz.NPos:= 0;
|
||||
FScrollVert.NPos:= 0;
|
||||
|
||||
Result:= [cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_GotoTextEnd: TATCommandResults;
|
||||
var
|
||||
Item: TATSynWrapItem;
|
||||
begin
|
||||
Item:= FWrapInfo[FWrapInfo.Count-1];
|
||||
if Assigned(Item) then
|
||||
DoCaretSingle(Length(Strings.Lines[Item.NLineIndex]), Item.NLineIndex, false);
|
||||
|
||||
Result:= [cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ScrollVert(ALines: integer): TATCommandResults;
|
||||
begin
|
||||
DoScrollByDelta(0, ALines);
|
||||
Result:= [cResultScroll];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_GotoWord(ANext: boolean): TATCommandResults;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
i: integer;
|
||||
begin
|
||||
for i:= 0 to FCarets.Count-1 do
|
||||
begin
|
||||
Caret:= FCarets[i];
|
||||
if not Strings.IsIndexValid(Caret.PosY) then Continue;
|
||||
Str:= Strings.Lines[Caret.PosY];
|
||||
|
||||
//jump to prev line?
|
||||
if (Caret.PosX=0) and (not ANext) then
|
||||
begin
|
||||
if Caret.PosY>0 then
|
||||
begin
|
||||
Dec(Caret.PosY);
|
||||
Caret.PosX:= Length(Strings.Lines[Caret.PosY]);
|
||||
end;
|
||||
end
|
||||
else
|
||||
//jump to next line?
|
||||
if (Caret.PosX>=Length(Str)) and ANext then
|
||||
begin
|
||||
if Caret.PosY<Strings.Count-1 then
|
||||
begin
|
||||
Inc(Caret.PosY);
|
||||
Caret.PosX:= SGetIndentChars(Strings.Lines[Caret.PosY]);
|
||||
end;
|
||||
end
|
||||
else
|
||||
//jump from beyond eol to eol?
|
||||
if (Caret.PosX>Length(Str)) and (not ANext) then
|
||||
begin
|
||||
Caret.PosX:= Length(Str);
|
||||
end
|
||||
else
|
||||
//jump inside line?
|
||||
if (Caret.PosX<=Length(Str)) then
|
||||
begin
|
||||
Caret.PosX:= SFindWordOffset(Str, Caret.PosX, ANext, true, FOptWordChars);
|
||||
end;
|
||||
end;
|
||||
|
||||
if ANext then
|
||||
Result:= [cResultCaretBottom]
|
||||
else
|
||||
Result:= [cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_Cancel: TATCommandResults;
|
||||
begin
|
||||
DoCaretSingleAsIs;
|
||||
DoSelect_None;
|
||||
|
||||
FMouseDragDropping:= false;
|
||||
UpdateCursor;
|
||||
|
||||
Result:= [cResultCaretTop];
|
||||
end;
|
||||
|
||||
|
||||
126
ATSynEdit/atsynedit/atsynedit_cmd_misc.inc
Normal file
126
ATSynEdit/atsynedit/atsynedit_cmd_misc.inc
Normal file
@@ -0,0 +1,126 @@
|
||||
{$ifdef nnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleOverwrite: TATCommandResults;
|
||||
begin
|
||||
ModeOverwrite:= not ModeOverwrite;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleWordWrap: TATCommandResults;
|
||||
begin
|
||||
if FWrapMode=cWrapOff then
|
||||
FWrapMode:= cWrapOn
|
||||
else
|
||||
FWrapMode:= cWrapOff;
|
||||
FWrapUpdateNeeded:= true;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleUnprinted: TATCommandResults;
|
||||
begin
|
||||
OptUnprintedVisible:= not OptUnprintedVisible;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleUnprintedSpaces: TATCommandResults;
|
||||
begin
|
||||
OptUnprintedSpaces:= not OptUnprintedSpaces;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleUnprintedEnds: TATCommandResults;
|
||||
begin
|
||||
OptUnprintedEnds:= not OptUnprintedEnds;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleUnprintedEndDetails: TATCommandResults;
|
||||
begin
|
||||
OptUnprintedEndsDetails:= not OptUnprintedEndsDetails;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleLineNums: TATCommandResults;
|
||||
begin
|
||||
with Gutter.Items[GutterBandNum] do
|
||||
Visible:= not Visible;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleFolding: TATCommandResults;
|
||||
begin
|
||||
with Gutter.Items[GutterBandFold] do
|
||||
Visible:= not Visible;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleRuler: TATCommandResults;
|
||||
begin
|
||||
OptRulerVisible:= not OptRulerVisible;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleMinimap: TATCommandResults;
|
||||
begin
|
||||
OptMinimapVisible:= not OptMinimapVisible;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_ToggleReadOnly: TATCommandResults;
|
||||
begin
|
||||
ModeReadOnly:= not ModeReadOnly;
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_CaretsExtend(ADown: boolean; ALines: integer): TATCommandResults;
|
||||
begin
|
||||
DoCaretsExtend(ADown, ALines);
|
||||
Result:= [cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SizeChange(AIncrease: boolean): TATCommandResults;
|
||||
begin
|
||||
DoSizeChange(AIncrease);
|
||||
Result:= [cResultState];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_FoldUnfoldAll(ADoFold: boolean): TATCommandResults;
|
||||
var
|
||||
Ar: TATIntArray;
|
||||
R: TATSynRange;
|
||||
i: integer;
|
||||
begin
|
||||
if ADoFold then
|
||||
begin
|
||||
Ar:= Fold.FindRangesContainingLines(
|
||||
0, Strings.Count-1, nil,
|
||||
false{OnlyFolded}, true{TopLevelOnly}, cRngHasAnyOfLines);
|
||||
for i:= Low(Ar) to High(Ar) do
|
||||
begin
|
||||
R:= Fold.Items[Ar[i]];
|
||||
if not R.Folded then
|
||||
DoRangeFold(R);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for i:= 0 to Fold.Count-1 do
|
||||
begin
|
||||
R:= Fold.Items[i];
|
||||
if R.Folded then
|
||||
DoRangeUnfold(R);
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:= [cResultCaretAny, cResultScroll];
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.DoCommand_FoldLevel(ALevel: integer): TATCommandResults;
|
||||
begin
|
||||
DoFoldForLevel(ALevel);
|
||||
Result:= [cResultCaretAny, cResultScroll];
|
||||
end;
|
||||
|
||||
|
||||
222
ATSynEdit/atsynedit/atsynedit_cmd_sel.inc
Normal file
222
ATSynEdit/atsynedit/atsynedit_cmd_sel.inc
Normal file
@@ -0,0 +1,222 @@
|
||||
{$ifdef nnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCommand_SelectAll: TATCommandResults;
|
||||
begin
|
||||
DoSelect_All;
|
||||
Result:= [cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectInverted: TATCommandResults;
|
||||
begin
|
||||
DoSelect_Inverted;
|
||||
Result:= [cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectSplitToLines: TATCommandResults;
|
||||
begin
|
||||
DoSelect_SplitSelectionToLines;
|
||||
Result:= [cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectExtendByLine: TATCommandResults;
|
||||
begin
|
||||
DoSelect_ExtendSelectionByLine;
|
||||
Result:= [cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectColumn(ADir: TATSelectColumnDirection): TATCommandResults;
|
||||
var
|
||||
PntBegin, PntEnd: TPoint;
|
||||
N, NPageLines, i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if Carets.Count=0 then Exit;
|
||||
|
||||
if IsSelRectEmpty or (FSelRectBegin.X<0) then
|
||||
begin
|
||||
DoSelect_NormalSelToColumnSel(PntBegin, PntEnd);
|
||||
DoCaretSingleAsIs;
|
||||
DoSelect_None;
|
||||
FSelRectBegin:= PntBegin;
|
||||
FSelRectEnd:= PntEnd;
|
||||
end;
|
||||
|
||||
if ADir in [cDirColumnPageUp, cDirColumnPageDown] then
|
||||
NPageLines:= GetPageLines
|
||||
else
|
||||
NPageLines:= 1;
|
||||
|
||||
case ADir of
|
||||
cDirColumnLeft:
|
||||
begin
|
||||
N:= SColumnPosToCharPos(Strings.Lines[FSelRectEnd.Y], FSelRectEnd.X, OptTabSize);
|
||||
if N>0 then Dec(N);
|
||||
N:= SCharPosToColumnPos(Strings.Lines[FSelRectEnd.Y], N, OptTabSize);
|
||||
FSelRectEnd.X:= N;
|
||||
Result:= [cResultKeepColumnSel, cResultCaretLeft];
|
||||
end;
|
||||
cDirColumnRight:
|
||||
begin
|
||||
N:= SColumnPosToCharPos(Strings.Lines[FSelRectEnd.Y], FSelRectEnd.X, OptTabSize);
|
||||
Inc(N);
|
||||
N:= SCharPosToColumnPos(Strings.Lines[FSelRectEnd.Y], N, OptTabSize);
|
||||
FSelRectEnd.X:= N;
|
||||
Result:= [cResultKeepColumnSel, cResultCaretRight];
|
||||
end;
|
||||
cDirColumnUp,
|
||||
cDirColumnPageUp:
|
||||
begin
|
||||
for i:= 1 to NPageLines do
|
||||
if FSelRectEnd.Y>0 then
|
||||
begin
|
||||
Dec(FSelRectEnd.Y);
|
||||
FSelRectEnd.Y:= GetNextUnfoldedLineNumber(FSelRectEnd.Y, false);
|
||||
end;
|
||||
Result:= [cResultKeepColumnSel, cResultCaretTop];
|
||||
end;
|
||||
cDirColumnDown,
|
||||
cDirColumnPageDown:
|
||||
begin
|
||||
for i:= 1 to NPageLines do
|
||||
if FSelRectEnd.Y<Strings.Count-1 then
|
||||
begin
|
||||
Inc(FSelRectEnd.Y);
|
||||
FSelRectEnd.Y:= GetNextUnfoldedLineNumber(FSelRectEnd.Y, true);
|
||||
end;
|
||||
Result:= [cResultKeepColumnSel, cResultCaretBottom];
|
||||
end;
|
||||
end;
|
||||
|
||||
DoSelect_ColumnBlock(FSelRectBegin, FSelRectEnd);
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectColumnToLineEdge(AToEnd: boolean): TATCommandResults;
|
||||
var
|
||||
NPos, i: integer;
|
||||
begin
|
||||
Result:= [];
|
||||
if Carets.Count=0 then Exit;
|
||||
|
||||
if IsSelRectEmpty or (FSelRectBegin.X<0) then Exit;
|
||||
//maybe todo: make column sel if normal sel active here
|
||||
//like DoCommand_SelectColumn
|
||||
|
||||
if not AToEnd then
|
||||
begin
|
||||
FSelRectEnd.X:= 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
NPos:= 0;
|
||||
for i:= FSelRectBegin.Y to FSelRectEnd.Y do
|
||||
if Strings.IsIndexValid(i) then
|
||||
NPos:= Max(NPos, Length(STabsToSpaces(Strings.Lines[i], FTabSize)));
|
||||
FSelRectEnd.X:= NPos;
|
||||
end;
|
||||
|
||||
DoSelect_ColumnBlock(FSelRectBegin, FSelRectEnd);
|
||||
Result:= [cResultKeepColumnSel, cResultCaretBottom];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_MoveSelectionUpDown(ADown: boolean): TATCommandResults;
|
||||
var
|
||||
NFrom, NTo, NLastLine: integer;
|
||||
Caret: TATCaretItem;
|
||||
Str: atString;
|
||||
Pnt: TPoint;
|
||||
begin
|
||||
Result:= [];
|
||||
if ModeReadOnly then Exit;
|
||||
|
||||
DoCaretSingleAsIs;
|
||||
Caret:= Carets[0];
|
||||
Caret.GetSelLines(NFrom, NTo);
|
||||
if NFrom<0 then
|
||||
begin
|
||||
NFrom:= Caret.PosY;
|
||||
NTo:= NFrom;
|
||||
end;
|
||||
|
||||
if ADown then
|
||||
begin
|
||||
NLastLine:= Strings.Count-1;
|
||||
if Strings.IsLastLineFake then
|
||||
Dec(NLastLine);
|
||||
if NTo>=NLastLine then Exit;
|
||||
|
||||
Str:= Strings.Lines[NTo+1];
|
||||
Strings.LineDelete(NTo+1);
|
||||
Strings.LineInsert(NFrom, Str);
|
||||
|
||||
Inc(Caret.PosY);
|
||||
if Caret.EndY>=0 then
|
||||
Inc(Caret.EndY);
|
||||
|
||||
//correct caret if out of file
|
||||
if Caret.PosY>=Strings.Count then
|
||||
begin
|
||||
Pnt:= GetEndOfFilePos;
|
||||
Caret.PosX:= Pnt.X;
|
||||
Caret.PosY:= Pnt.Y;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if NFrom<=0 then Exit;
|
||||
Str:= Strings.Lines[NFrom-1];
|
||||
Strings.LineDelete(NFrom-1);
|
||||
Strings.LineInsert(NTo, Str);
|
||||
|
||||
Dec(Caret.PosY);
|
||||
if Caret.EndY>=0 then
|
||||
Dec(Caret.EndY);
|
||||
end;
|
||||
|
||||
Result:= [cResultText, cResultCaretTop];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectWords: TATCommandResults;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
i, NOffset1, NOffset2: integer;
|
||||
Str: atString;
|
||||
begin
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Item:= FCarets[i];
|
||||
if not Strings.IsIndexValid(Item.PosY) then Continue;
|
||||
|
||||
Str:= Strings.Lines[Item.PosY];
|
||||
SFindWordBounds(Str, Item.PosX, NOffset1, NOffset2, FOptWordChars);
|
||||
if NOffset1<>NOffset2 then
|
||||
begin
|
||||
Item.EndY:= Item.PosY;
|
||||
Item.EndX:= NOffset1;
|
||||
Item.PosX:= NOffset2;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:= [cResultCaretAny];
|
||||
end;
|
||||
|
||||
function TATSynEdit.DoCommand_SelectLines: TATCommandResults;
|
||||
var
|
||||
Item: TATCaretItem;
|
||||
i: integer;
|
||||
Str: atString;
|
||||
begin
|
||||
for i:= FCarets.Count-1 downto 0 do
|
||||
begin
|
||||
Item:= FCarets[i];
|
||||
if not Strings.IsIndexValid(Item.PosY) then Continue;
|
||||
|
||||
Str:= Strings.Lines[Item.PosY];
|
||||
Item.EndY:= Item.PosY;
|
||||
Item.EndX:= 0;
|
||||
Item.PosX:= Length(Str);
|
||||
end;
|
||||
|
||||
Result:= [cResultCaretAny];
|
||||
end;
|
||||
|
||||
|
||||
155
ATSynEdit/atsynedit/atsynedit_colors.pas
Normal file
155
ATSynEdit/atsynedit/atsynedit_colors.pas
Normal file
@@ -0,0 +1,155 @@
|
||||
unit ATSynEdit_Colors;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics;
|
||||
|
||||
type
|
||||
TATSynEditColors = class(TPersistent)
|
||||
private
|
||||
FTextFont,
|
||||
FTextBG,
|
||||
FTextDisabledFont,
|
||||
FTextDisabledBG,
|
||||
FTextSelFont,
|
||||
FTextSelBG,
|
||||
FCaret,
|
||||
FMarkers,
|
||||
FGutterFont,
|
||||
FGutterBG,
|
||||
FGutterCaretBG,
|
||||
FGutterPlusBorder,
|
||||
FGutterPlusBG,
|
||||
FGutterFoldLine,
|
||||
FGutterFoldBG,
|
||||
FGutterSeparatorBG,
|
||||
FCurrentLineBG,
|
||||
FMarginRight,
|
||||
FMarginCaret,
|
||||
FMarginUser,
|
||||
FIndentVertLines,
|
||||
FBookmarkBG,
|
||||
FRulerFont,
|
||||
FRulerBG,
|
||||
FCollapseLine,
|
||||
FCollapseMarkFont,
|
||||
FCollapseMarkBG,
|
||||
FCollapseMarkBorder,
|
||||
FUnprintedFont,
|
||||
FUnprintedBG,
|
||||
FUnprintedHexFont,
|
||||
FMinimapBorder,
|
||||
FMinimapSelBG,
|
||||
FStateChanged,
|
||||
FStateAdded,
|
||||
FStateSaved,
|
||||
FTextHintFont,
|
||||
FBlockStaple,
|
||||
FBlockSepLine,
|
||||
FLockedBG,
|
||||
FMarkedLinesBG,
|
||||
FComboboxArrow,
|
||||
FComboboxArrowBG: TColor;
|
||||
published
|
||||
property TextFont: TColor read FTextFont write FTextFont;
|
||||
property TextBG: TColor read FTextBG write FTextBG;
|
||||
property TextDisabledFont: TColor read FTextDisabledFont write FTextDisabledFont;
|
||||
property TextDisabledBG: TColor read FTextDisabledBG write FTextDisabledBG;
|
||||
property TextSelFont: TColor read FTextSelFont write FTextSelFont;
|
||||
property TextSelBG: TColor read FTextSelBG write FTextSelBG;
|
||||
property Caret: TColor read FCaret write FCaret;
|
||||
property Markers: TColor read FMarkers write FMarkers;
|
||||
property GutterFont: TColor read FGutterFont write FGutterFont;
|
||||
property GutterBG: TColor read FGutterBG write FGutterBG;
|
||||
property GutterCaretBG: TColor read FGutterCaretBG write FGutterCaretBG;
|
||||
property GutterPlusBorder: TColor read FGutterPlusBorder write FGutterPlusBorder;
|
||||
property GutterPlusBG: TColor read FGutterPlusBG write FGutterPlusBG;
|
||||
property GutterFoldLine: TColor read FGutterFoldLine write FGutterFoldLine;
|
||||
property GutterFoldBG: TColor read FGutterFoldBG write FGutterFoldBG;
|
||||
property GutterSeparatorBG: TColor read FGutterSeparatorBG write FGutterSeparatorBG;
|
||||
property CurrentLineBG: TColor read FCurrentLineBG write FCurrentLineBG;
|
||||
property MarginRight: TColor read FMarginRight write FMarginRight;
|
||||
property MarginCaret: TColor read FMarginCaret write FMarginCaret;
|
||||
property MarginUser: TColor read FMarginUser write FMarginUser;
|
||||
property IndentVertLines: TColor read FIndentVertLines write FIndentVertLines;
|
||||
property BookmarkBG: TColor read FBookmarkBG write FBookmarkBG;
|
||||
property RulerFont: TColor read FRulerFont write FRulerFont;
|
||||
property RulerBG: TColor read FRulerBG write FRulerBG;
|
||||
property CollapseLine: TColor read FCollapseLine write FCollapseLine;
|
||||
property CollapseMarkFont: TColor read FCollapseMarkFont write FCollapseMarkFont;
|
||||
property CollapseMarkBG: TColor read FCollapseMarkBG write FCollapseMarkBG;
|
||||
property CollapseMarkBorder: TColor read FCollapseMarkBorder write FCollapseMarkBorder;
|
||||
property UnprintedFont: TColor read FUnprintedFont write FUnprintedFont;
|
||||
property UnprintedBG: TColor read FUnprintedBG write FUnprintedBG;
|
||||
property UnprintedHexFont: TColor read FUnprintedHexFont write FUnprintedHexFont;
|
||||
property MinimapBorder: TColor read FMinimapBorder write FMinimapBorder;
|
||||
property MinimapSelBG: TColor read FMinimapSelBG write FMinimapSelBG;
|
||||
property StateChanged: TColor read FStateChanged write FStateChanged;
|
||||
property StateAdded: TColor read FStateAdded write FStateAdded;
|
||||
property StateSaved: TColor read FStateSaved write FStateSaved;
|
||||
property BlockStaple: TColor read FBlockStaple write FBlockStaple;
|
||||
property BlockSepLine: TColor read FBlockSepLine write FBlockSepLine;
|
||||
property LockedBG: TColor read FLockedBG write FLockedBG;
|
||||
property TextHintFont: TColor read FTextHintFont write FTextHintFont;
|
||||
property MarkedLinesBG: TColor read FMarkedLinesBG write FMarkedLinesBG;
|
||||
property ComboboxArrow: TColor read FComboboxArrow write FComboboxArrow;
|
||||
property ComboboxArrowBG: TColor read FComboboxArrowBG write FComboboxArrowBG;
|
||||
end;
|
||||
|
||||
procedure InitDefaultColors(C: TATSynEditColors);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitDefaultColors(C: TATSynEditColors);
|
||||
begin
|
||||
C.TextFont:= clBlack;
|
||||
C.TextBG:= clWhite;
|
||||
C.TextSelFont:= clHighlightText;
|
||||
C.TextSelBG:= clHighlight;
|
||||
C.TextDisabledFont:= clGray;
|
||||
C.TextDisabledBG:= $f0f0f0;
|
||||
C.Caret:= clBlack;
|
||||
C.Markers:= $0000c0;
|
||||
C.GutterFont:= clGray;
|
||||
C.GutterBG:= $e0e0e0;
|
||||
C.GutterCaretBG:= $c8c8c8;
|
||||
C.GutterPlusBorder:= clGray;
|
||||
C.GutterPlusBG:= $f4f4f4;
|
||||
C.GutterFoldLine:= clGray;
|
||||
C.GutterFoldBG:= $c8c8c8;
|
||||
C.GutterSeparatorBG:= clBlack;
|
||||
C.CurrentLineBG:= $e0f0f0;
|
||||
C.BookmarkBG:= clMoneyGreen;
|
||||
C.RulerBG:= C.GutterBG;
|
||||
C.RulerFont:= clGray;
|
||||
C.CollapseLine:= $a06060;
|
||||
C.CollapseMarkFont:= $e08080;
|
||||
C.CollapseMarkBG:= clCream;
|
||||
C.CollapseMarkBorder:= $e08080;
|
||||
C.MarginRight:= clLtGray;
|
||||
C.MarginCaret:= clLime;
|
||||
C.MarginUser:= clYellow;
|
||||
C.IndentVertLines:= clMedGray;
|
||||
C.UnprintedFont:= $5050f0;
|
||||
C.UnprintedBG:= $e0e0e0;
|
||||
C.UnprintedHexFont:= clMedGray;
|
||||
C.MinimapBorder:= clLtGray;
|
||||
C.MinimapSelBG:= $eeeeee;
|
||||
C.StateChanged:= $00f0f0;
|
||||
C.StateAdded:= $20c020;
|
||||
C.StateSaved:= clMedGray;
|
||||
C.TextHintFont:= clGray;
|
||||
C.BlockStaple:= clMedGray;
|
||||
C.BlockSepLine:= clMedGray;
|
||||
C.LockedBG:= $e0e0e0;
|
||||
C.MarkedLinesBG:= $f0e0b0;
|
||||
C.ComboboxArrow:= clGray;
|
||||
C.ComboboxArrowBG:= $f0f0f0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
164
ATSynEdit/atsynedit/atsynedit_commands.pas
Normal file
164
ATSynEdit/atsynedit/atsynedit_commands.pas
Normal file
@@ -0,0 +1,164 @@
|
||||
unit ATSynEdit_Commands;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
cCmdSelKeep = $10000; //cmd continues selection (new caret pos makes bigger selection)
|
||||
cCmdSelReset = $20000; //before command reset selection
|
||||
cCmdCaret = $80000; //cmd moves caret and makes new undo-group
|
||||
|
||||
const
|
||||
_base_KeyUp = 100 or cCmdCaret;
|
||||
_base_KeyDown = 101 or cCmdCaret;
|
||||
_base_KeyLeft = 102 or cCmdCaret;
|
||||
_base_KeyRight = 103 or cCmdCaret;
|
||||
_base_KeyHome = 104 or cCmdCaret;
|
||||
_base_KeyEnd = 105 or cCmdCaret;
|
||||
_base_KeyPageUp = 106 or cCmdCaret;
|
||||
_base_KeyPageDown = 107 or cCmdCaret;
|
||||
|
||||
cCommand_KeyUp = _base_KeyUp or cCmdSelReset;
|
||||
cCommand_KeyDown = _base_KeyDown or cCmdSelReset;
|
||||
cCommand_KeyLeft = _base_KeyLeft; //handles sel
|
||||
cCommand_KeyRight = _base_KeyRight; //handles sel
|
||||
cCommand_KeyHome = _base_KeyHome or cCmdSelReset;
|
||||
cCommand_KeyEnd = _base_KeyEnd or cCmdSelReset;
|
||||
cCommand_KeyPageUp = _base_KeyPageUp or cCmdSelReset;
|
||||
cCommand_KeyPageDown = _base_KeyPageDown or cCmdSelReset;
|
||||
|
||||
cCommand_KeyUp_Sel = _base_KeyUp or cCmdSelKeep;
|
||||
cCommand_KeyDown_Sel = _base_KeyDown or cCmdSelKeep;
|
||||
cCommand_KeyLeft_Sel = _base_KeyLeft or cCmdSelKeep;
|
||||
cCommand_KeyRight_Sel = _base_KeyRight or cCmdSelKeep;
|
||||
cCommand_KeyHome_Sel = _base_KeyHome or cCmdSelKeep;
|
||||
cCommand_KeyEnd_Sel = _base_KeyEnd or cCmdSelKeep;
|
||||
cCommand_KeyPageUp_Sel = _base_KeyPageUp or cCmdSelKeep;
|
||||
cCommand_KeyPageDown_Sel = _base_KeyPageDown or cCmdSelKeep;
|
||||
|
||||
cCommand_ColSelectUp = 110;
|
||||
cCommand_ColSelectDown = 111;
|
||||
cCommand_ColSelectLeft = 112;
|
||||
cCommand_ColSelectRight = 113;
|
||||
cCommand_ColSelectToLineBegin = 114;
|
||||
cCommand_ColSelectToLineEnd = 115;
|
||||
cCommand_ColSelectPageUp = 116;
|
||||
cCommand_ColSelectPageDown = 117;
|
||||
|
||||
cCommand_TextInsert = 150;
|
||||
cCommand_TextInsertTabChar = 151;
|
||||
cCommand_KeyBackspace = 152;
|
||||
cCommand_KeyDelete = 153;
|
||||
cCommand_KeyEnter = 154;
|
||||
cCommand_KeyTab = 155;
|
||||
|
||||
cCommand_TextDeleteSelection = 170;
|
||||
cCommand_TextDeleteLine = 171 or cCmdSelReset;
|
||||
cCommand_TextDuplicateLine = 172 or cCmdSelReset;
|
||||
cCommand_TextDeleteToLineBegin = 173 or cCmdSelReset;
|
||||
cCommand_TextDeleteToLineEnd = 174 or cCmdSelReset;
|
||||
cCommand_TextDeleteToTextEnd = 175 or cCmdSelReset;
|
||||
cCommand_TextDeleteWordNext = 176 or cCmdSelReset;
|
||||
cCommand_TextDeleteWordPrev = 177 or cCmdSelReset;
|
||||
|
||||
_base_GotoTextBegin = 200 or cCmdCaret;
|
||||
_base_GotoTextEnd = 201 or cCmdCaret;
|
||||
_base_GotoWordNext = 202 or cCmdCaret;
|
||||
_base_GotoWordPrev = 203 or cCmdCaret;
|
||||
|
||||
cCommand_GotoTextBegin = _base_GotoTextBegin or cCmdSelReset;
|
||||
cCommand_GotoTextEnd = _base_GotoTextEnd or cCmdSelReset;
|
||||
cCommand_GotoWordNext = _base_GotoWordNext or cCmdSelReset;
|
||||
cCommand_GotoWordPrev = _base_GotoWordPrev or cCmdSelReset;
|
||||
|
||||
cCommand_GotoTextBegin_Sel = _base_GotoTextBegin or cCmdSelKeep;
|
||||
cCommand_GotoTextEnd_Sel = _base_GotoTextEnd or cCmdSelKeep;
|
||||
cCommand_GotoWordNext_Sel = _base_GotoWordNext or cCmdSelKeep;
|
||||
cCommand_GotoWordPrev_Sel = _base_GotoWordPrev or cCmdSelKeep;
|
||||
|
||||
cCommand_Undo = 235 or cCmdSelReset;
|
||||
cCommand_Redo = 236 or cCmdSelReset;
|
||||
|
||||
cCommand_TextIndent = 240;
|
||||
cCommand_TextUnindent = 241;
|
||||
|
||||
cCommand_ScrollLineUp = 250;
|
||||
cCommand_ScrollLineDown = 251;
|
||||
cCommand_ScrollToCaretTop = 252;
|
||||
cCommand_ScrollToCaretBottom = 253;
|
||||
cCommand_ScrollToCaretLeft = 254;
|
||||
cCommand_ScrollToCaretRight = 255;
|
||||
|
||||
cCommand_SelectAll = 260 or cCmdSelReset or cCmdCaret;
|
||||
cCommand_SelectNone = 261 or cCmdSelReset or cCmdCaret;
|
||||
cCommand_SelectWords = 262 or cCmdSelReset or cCmdCaret;
|
||||
cCommand_SelectLines = 263 or cCmdSelReset or cCmdCaret;
|
||||
cCommand_SelectInverted = 264 or cCmdCaret;
|
||||
cCommand_SelectSplitToLines = 265 or cCmdCaret;
|
||||
cCommand_SelectExtendByLine = 266 or cCmdCaret;
|
||||
|
||||
cCommand_MoveSelectionUp = 268 or cCmdCaret;
|
||||
cCommand_MoveSelectionDown = 269 or cCmdCaret;
|
||||
cCommand_TextInsertEmptyAbove = 270 or cCmdSelReset or cCmdCaret;
|
||||
cCommand_TextInsertEmptyBelow = 271 or cCmdSelReset or cCmdCaret;
|
||||
|
||||
cCommand_ToggleOverwrite = 300;
|
||||
cCommand_ToggleReadOnly = 301;
|
||||
cCommand_ToggleWordWrap = 302;
|
||||
cCommand_ToggleUnprinted = 303;
|
||||
cCommand_ToggleUnprintedSpaces = 304;
|
||||
cCommand_ToggleUnprintedEnds = 305;
|
||||
cCommand_ToggleUnprintedEndDetails = 306;
|
||||
cCommand_ToggleLineNums = 307;
|
||||
cCommand_ToggleFolding = 308;
|
||||
cCommand_ToggleRuler = 309;
|
||||
cCommand_ToggleMinimap = 310;
|
||||
|
||||
cCommand_ClipboardPaste = 1000;
|
||||
cCommand_ClipboardPaste_Select = 1001;
|
||||
cCommand_ClipboardPaste_KeepCaret = 1002;
|
||||
cCommand_ClipboardPaste_Column = 1003 or cCmdSelReset;
|
||||
cCommand_ClipboardPaste_ColumnKeepCaret = 1004 or cCmdSelReset;
|
||||
cCommand_ClipboardCopy = 1006;
|
||||
cCommand_ClipboardCopyAdd = 1007;
|
||||
cCommand_ClipboardCut = 1008;
|
||||
|
||||
cCommand_TextCaseLower = 1020;
|
||||
cCommand_TextCaseUpper = 1021;
|
||||
cCommand_TextCaseTitle = 1022;
|
||||
cCommand_TextCaseInvert = 1023;
|
||||
cCommand_TextCaseSentence = 1024;
|
||||
|
||||
cCommand_TextTrimSpacesLeft = 1026;
|
||||
cCommand_TextTrimSpacesRight = 1027;
|
||||
cCommand_TextTrimSpacesAll = 1028;
|
||||
|
||||
cCommand_FoldAll = 1030;
|
||||
cCommand_UnfoldAll = 1031;
|
||||
cCommand_FoldLevel2 = 1032;
|
||||
cCommand_FoldLevel3 = 1033;
|
||||
cCommand_FoldLevel4 = 1034;
|
||||
cCommand_FoldLevel5 = 1035;
|
||||
cCommand_FoldLevel6 = 1036;
|
||||
cCommand_FoldLevel7 = 1037;
|
||||
cCommand_FoldLevel8 = 1038;
|
||||
cCommand_FoldLevel9 = 1039;
|
||||
|
||||
cCommand_Cancel = 2001;
|
||||
cCommand_RepeatTextCommand = 2002;
|
||||
cCommand_ZoomIn = 2003;
|
||||
cCommand_ZoomOut = 2004;
|
||||
cCommand_ComboboxRecentsMenu = 2005;
|
||||
|
||||
cCommand_CaretsExtendDownLine = 2010;
|
||||
cCommand_CaretsExtendDownPage = 2011;
|
||||
cCommand_CaretsExtendDownToEnd = 2012;
|
||||
cCommand_CaretsExtendUpLine = 2013;
|
||||
cCommand_CaretsExtendUpPage = 2014;
|
||||
cCommand_CaretsExtendUpToTop = 2015;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
42
ATSynEdit/atsynedit/atsynedit_debug.inc
Normal file
42
ATSynEdit/atsynedit/atsynedit_debug.inc
Normal file
@@ -0,0 +1,42 @@
|
||||
{$ifdef nn}begin end;{$endif}
|
||||
|
||||
procedure TATSynEdit.DebugFindWrapIndex;
|
||||
var
|
||||
i, j, n1, n2: integer;
|
||||
begin
|
||||
for i:= 0 to Strings.Count-1 do
|
||||
begin
|
||||
FWrapInfo.FindIndexesOfLineNumber(i, n1, n2);
|
||||
if n1<0 then
|
||||
begin
|
||||
Application.MainForm.caption:= format('fail findindex: %d', [i]);
|
||||
Exit
|
||||
end;
|
||||
for j:= n1 to n2 do
|
||||
if FWrapInfo.Items[j].NLineIndex<>i then
|
||||
begin
|
||||
Application.MainForm.caption:= format('fail findindex: %d', [i]);
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
Application.MainForm.caption:= 'ok findindex';
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoDebugInitFoldList;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
FFold.Clear;
|
||||
|
||||
//sorted by 2nd param
|
||||
FFold.Add(1, 4, 15, false, '');
|
||||
FFold.Add(1, 5, 9, false, '');
|
||||
FFold.Add(1, 7, 8, false, '');
|
||||
FFold.Add(1, 11, 14, false, '');
|
||||
|
||||
for i:= 2 to (Strings.Count-1) div 10 do
|
||||
if Odd(i) then
|
||||
FFold.Add(4, i*10, i*10+9, false, '');
|
||||
end;
|
||||
|
||||
|
||||
197
ATSynEdit/atsynedit/atsynedit_edits.pas
Normal file
197
ATSynEdit/atsynedit/atsynedit_edits.pas
Normal file
@@ -0,0 +1,197 @@
|
||||
unit ATSynEdit_Edits;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Controls,
|
||||
Menus, Math,
|
||||
ATSynEdit,
|
||||
ATSynEdit_CanvasProc,
|
||||
ATStringProc;
|
||||
|
||||
type
|
||||
{ TATEdit }
|
||||
|
||||
TATEdit = class(TATSynEdit)
|
||||
protected
|
||||
function DoGetTextString: atString; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
end;
|
||||
|
||||
type
|
||||
{ TATComboEdit }
|
||||
|
||||
TATComboEdit = class(TATEdit)
|
||||
private
|
||||
FItems: TStringList;
|
||||
FMenu: TPopupMenu;
|
||||
FArrowSize: integer;
|
||||
FSelectedIndex: integer;
|
||||
procedure DoComboUpDown(ADown: boolean);
|
||||
procedure MicromapClick(Sender: TObject; AX, AY: integer);
|
||||
procedure MicromapDraw(Sender: TObject; C: TCanvas; const ARect: TRect);
|
||||
procedure DoMenu;
|
||||
procedure MenuItemClick(Sender: TObject);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property Items: TStringList read FItems;
|
||||
procedure DoCommand(ACmd: integer; const AText: atString = ''); override;
|
||||
procedure DoAddLineToHistory(const AStr: atString; AMaxItems: integer);
|
||||
published
|
||||
property OptComboboxArrowSize: integer read FArrowSize write FArrowSize;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Types,
|
||||
ATSynEdit_Commands,
|
||||
ATSynEdit_Keymap_Init;
|
||||
|
||||
{ TATEdit }
|
||||
|
||||
function TATEdit.DoGetTextString: atString;
|
||||
begin
|
||||
Result:= inherited;
|
||||
//gets text with EOLs, strip them
|
||||
while (Result<>'') and
|
||||
IsCharEol(Result[Length(Result)]) do
|
||||
SetLength(Result, Length(Result)-1);
|
||||
end;
|
||||
|
||||
constructor TATEdit.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
WantTabs:= false;
|
||||
ModeOneLine:= true;
|
||||
BorderStyle:= bsSingle;
|
||||
|
||||
Keymap:= KeymapCombo;
|
||||
|
||||
OptTextOffsetTop:= 2;
|
||||
Height:= 26;
|
||||
end;
|
||||
|
||||
{ TATComboEdit }
|
||||
|
||||
constructor TATComboEdit.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FItems:= TStringList.Create;
|
||||
FMenu:= TPopupMenu.Create(Self);
|
||||
FSelectedIndex:= -1;
|
||||
|
||||
OptMicromapVisible:= true;
|
||||
OptMicromapWidth:= 22;
|
||||
OptComboboxArrowSize:= 4;
|
||||
OnClickMicromap:= @MicromapClick;
|
||||
OnDrawMicromap:= @MicromapDraw;
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.MicromapClick(Sender: TObject; AX, AY: integer);
|
||||
begin
|
||||
DoMenu;
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.MicromapDraw(Sender: TObject; C: TCanvas;
|
||||
const ARect: TRect);
|
||||
begin
|
||||
C.Brush.Color:= Colors.ComboboxArrowBG;
|
||||
C.FillRect(ARect);
|
||||
|
||||
CanvasPaintTriangleDown(C, Colors.ComboboxArrow,
|
||||
Point(
|
||||
(ARect.Left+ARect.Right) div 2 - FArrowSize,
|
||||
(ARect.Top+ARect.Bottom) div 2 - FArrowSize div 2),
|
||||
FArrowSize);
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.DoMenu;
|
||||
var
|
||||
p: TPoint;
|
||||
i: integer;
|
||||
mi: TMenuItem;
|
||||
begin
|
||||
p:= ClientToScreen(Point(Width-OptMicromapWidth, Height));
|
||||
with FMenu.Items do
|
||||
begin
|
||||
Clear;
|
||||
for i:= 0 to FItems.Count-1 do
|
||||
begin
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Caption:= FItems[i];
|
||||
mi.Tag:= i;
|
||||
mi.OnClick:= @MenuItemClick;
|
||||
Add(mi);
|
||||
end;
|
||||
end;
|
||||
FMenu.PopUp(p.x, p.y);
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.MenuItemClick(Sender: TObject);
|
||||
var
|
||||
n: integer;
|
||||
begin
|
||||
n:= (Sender as TMenuItem).Tag;
|
||||
if n>=0 then
|
||||
begin
|
||||
Text:= UTF8Decode(FItems[n]);
|
||||
DoEventChange;
|
||||
|
||||
//scroll to left, select all
|
||||
DoScrollByDelta(-10000, 0);
|
||||
DoCommand(cCommand_SelectAll);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.DoCommand(ACmd: integer; const AText: atString);
|
||||
begin
|
||||
inherited;
|
||||
case ACmd of
|
||||
cCommand_ComboboxRecentsMenu:
|
||||
begin
|
||||
DoMenu;
|
||||
end;
|
||||
cCommand_KeyDown,
|
||||
cCommand_KeyUp:
|
||||
begin
|
||||
DoComboUpDown(ACmd=cCommand_KeyDown);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.DoAddLineToHistory(const AStr: atString;
|
||||
AMaxItems: integer);
|
||||
begin
|
||||
FSelectedIndex:= -1;
|
||||
SAddStringToHistory(Utf8Encode(AStr), FItems, AMaxItems);
|
||||
end;
|
||||
|
||||
procedure TATComboEdit.DoComboUpDown(ADown: boolean);
|
||||
begin
|
||||
if FItems.Count=0 then exit;
|
||||
if ADown then Inc(FSelectedIndex) else Dec(FSelectedIndex);
|
||||
FSelectedIndex:= Max(0, Min(FItems.Count-1, FSelectedIndex));
|
||||
|
||||
Text:= Utf8Decode(FItems[FSelectedIndex]);
|
||||
DoEventChange;
|
||||
DoCommand(cCommand_SelectAll);
|
||||
end;
|
||||
|
||||
destructor TATComboEdit.Destroy;
|
||||
begin
|
||||
FreeAndNil(FMenu);
|
||||
FreeAndNil(FItems);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
132
ATSynEdit/atsynedit/atsynedit_export_html.pas
Normal file
132
ATSynEdit/atsynedit/atsynedit_export_html.pas
Normal file
@@ -0,0 +1,132 @@
|
||||
unit ATSynEdit_Export_HTML;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, StrUtils,
|
||||
ATSynEdit,
|
||||
ATSynEdit_CanvasProc,
|
||||
ATStringProc_HtmlColor,
|
||||
LazUTF8Classes;
|
||||
|
||||
procedure DoEditorExportToHTML(Ed: TATSynEdit;
|
||||
const AFilename, APageTitle, AFontName: string;
|
||||
AFontSize: integer; AWithNumbers: boolean;
|
||||
AColorBg, AColorNumbers: TColor);
|
||||
|
||||
implementation
|
||||
|
||||
procedure DoEditorExportToHTML(Ed: TATSynEdit; const AFilename, APageTitle,
|
||||
AFontName: string; AFontSize: integer; AWithNumbers: boolean; AColorBg,
|
||||
AColorNumbers: TColor);
|
||||
var
|
||||
L: TStringListUTF8;
|
||||
Parts: TATLineParts;
|
||||
PPart: ^TATLinePart;
|
||||
NColorFont: TColor;
|
||||
NColorAfter: TColor;
|
||||
NeedStyle: boolean;
|
||||
Str0, Str1: string;
|
||||
i, j: integer;
|
||||
begin
|
||||
NColorFont:= clBlack;
|
||||
FillChar(Parts, Sizeof(Parts), 0);
|
||||
|
||||
if FileExists(AFilename) then
|
||||
DeleteFile(AFilename);
|
||||
|
||||
L:= TStringListUTF8.Create;
|
||||
try
|
||||
L.Add('<!-- Generated by ATSynEdit Exporter -->');
|
||||
L.Add('<html>'+sLineBreak+
|
||||
'<head>'+sLineBreak+
|
||||
' <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />'+sLineBreak+
|
||||
' <title>'+APageTitle+'</title>'+sLineBreak+
|
||||
' <style>'+sLineBreak+
|
||||
' body, table {'+sLineBreak+
|
||||
' color: '+SColorToHtmlColor(NColorFont)+';'+sLineBreak+
|
||||
' background-color: '+SColorToHtmlColor(AColorBg)+';'+sLineBreak+
|
||||
' }'+sLineBreak+
|
||||
' pre, code {'+sLineBreak+
|
||||
' font-family: "'+AFontName+'", sans-serif;'+sLineBreak+
|
||||
' font-size: '+IntToStr(AFontSize)+'px;'+sLineBreak+
|
||||
' }'+sLineBreak+
|
||||
' table, td {'+sLineBreak+
|
||||
' border-style: hidden;'+sLineBreak+
|
||||
' }'+sLineBreak+
|
||||
' td {'+sLineBreak+
|
||||
' vertical-align: top;'+sLineBreak+
|
||||
' }'+sLineBreak+
|
||||
' td.num {'+sLineBreak+
|
||||
' color: '+SColorToHtmlColor(AColorNumbers)+';'+sLineBreak+
|
||||
' text-align: right;'+sLineBreak+
|
||||
' }'+sLineBreak+
|
||||
' </style>'+sLineBreak+
|
||||
'</head>'+sLineBreak+
|
||||
'<body>');
|
||||
|
||||
if AWithNumbers then
|
||||
begin
|
||||
L.Add('<table>'+sLineBreak+'<tr>'+sLineBreak+'<td class="num">');
|
||||
L.Add('<pre><code>'); //??? eol
|
||||
for i:= 0 to Ed.Strings.Count-1 do
|
||||
L.Add(IntToStr(i+1)+' ');
|
||||
L.Add('</code></pre>');
|
||||
L.Add('</td>'+sLineBreak+'<td>');
|
||||
end;
|
||||
|
||||
L.Add('<pre><code>');
|
||||
|
||||
for i:= 0 to Ed.Strings.Count-1 do
|
||||
begin
|
||||
Str0:= '';
|
||||
if not Ed.DoCalcLineHiliteEx(i, Parts, AColorBG, NColorAfter) then break;
|
||||
for j:= 0 to High(Parts) do
|
||||
begin
|
||||
PPart:= @Parts[j];
|
||||
if PPart^.Len=0 then Break;
|
||||
if PPart^.FontBold then Str0:= Str0+'<b>';
|
||||
if PPart^.FontItalic then Str0:= Str0+'<i>';
|
||||
if PPart^.FontStrikeOut then Str0:= Str0+'<s>';
|
||||
|
||||
NeedStyle:=
|
||||
(PPart^.ColorFont<>NColorFont) or
|
||||
(PPart^.ColorBG<>AColorBG);
|
||||
if NeedStyle then
|
||||
Str0:= Str0+'<span style="'+
|
||||
IfThen(PPart^.ColorFont<>NColorFont, 'color: '+SColorToHtmlColor(PPart^.ColorFont)+'; ')+
|
||||
IfThen(PPart^.ColorBG<>AColorBG, 'background: '+SColorToHtmlColor(PPart^.ColorBG)+'; ')+
|
||||
'">';
|
||||
|
||||
Str1:= Utf8Encode(Copy(Ed.Strings.Lines[i], PPart^.Offset+1, PPart^.Len));
|
||||
Str1:= StringReplace(Str1, '<', '<', [rfReplaceAll]);
|
||||
Str1:= StringReplace(Str1, '>', '>', [rfReplaceAll]);
|
||||
|
||||
Str0:= Str0+Str1;
|
||||
if NeedStyle then
|
||||
Str0:= Str0+'</span>';
|
||||
|
||||
if PPart^.FontStrikeOut then Str0:= Str0+'</s>';
|
||||
if PPart^.FontItalic then Str0:= Str0+'</i>';
|
||||
if PPart^.FontBold then Str0:= Str0+'</b>';
|
||||
end;
|
||||
L.Add(Str0);
|
||||
end;
|
||||
|
||||
L.Add('</code></pre>');
|
||||
if AWithNumbers then
|
||||
L.Add('</td></tr></table>');
|
||||
|
||||
L.Add('</body>');
|
||||
L.Add('</html>');
|
||||
|
||||
L.SaveToFile(AFilename);
|
||||
finally
|
||||
FreeAndNil(L);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
721
ATSynEdit/atsynedit/atsynedit_finder.pas
Normal file
721
ATSynEdit/atsynedit/atsynedit_finder.pas
Normal file
@@ -0,0 +1,721 @@
|
||||
unit ATSynEdit_Finder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Dialogs, Forms,
|
||||
Math,
|
||||
RegExpr, //must be with {$define Unicode}
|
||||
ATSynEdit,
|
||||
ATSynEdit_Carets,
|
||||
ATStringProc,
|
||||
ATStringProc_TextBuffer;
|
||||
|
||||
type
|
||||
TATFinderProgress = procedure(Sender: TObject; ACurPos, AMaxPos: integer;
|
||||
var AContinue: boolean) of object;
|
||||
TATFinderFound = procedure(Sender: TObject; APos1, APos2: TPoint) of object;
|
||||
TATFinderConfirmReplace = procedure(Sender: TObject;
|
||||
APos1, APos2: TPoint; AForMany: boolean;
|
||||
var AConfirm, AContinue: boolean) of object;
|
||||
|
||||
type
|
||||
{ TATTextFinder }
|
||||
|
||||
TATTextFinder = class
|
||||
private
|
||||
FMatchPos: integer;
|
||||
FMatchLen: integer;
|
||||
FStrFind: UnicodeString;
|
||||
FStrReplace: UnicodeString;
|
||||
FStrReplacement: UnicodeString;
|
||||
FOnProgress: TATFinderProgress;
|
||||
FOnBadRegex: TNotifyEvent;
|
||||
function DoCountMatchesRegex(FromPos: integer; AWithEvent: boolean): integer;
|
||||
function DoCountMatchesUsual(FromPos: integer; AWithEvent: boolean): Integer;
|
||||
function DoFindMatchRegex(FromPos: integer; var MatchPos, MatchLen: integer): boolean;
|
||||
function DoFindMatchUsual(FromPos: integer): Integer;
|
||||
function IsMatchUsual(APos: integer): boolean;
|
||||
procedure SetStrFind(const AValue: UnicodeString);
|
||||
procedure SetStrReplace(const AValue: UnicodeString);
|
||||
protected
|
||||
procedure DoOnFound; virtual;
|
||||
public
|
||||
OptBack: boolean; //for non-regex
|
||||
OptWords: boolean; //for non-regex
|
||||
OptCase: boolean; //for regex and usual
|
||||
OptRegex: boolean;
|
||||
OptWrapped: boolean;
|
||||
StrText: UnicodeString;
|
||||
property StrFind: UnicodeString read FStrFind write SetStrFind;
|
||||
property StrReplace: UnicodeString read FStrReplace write SetStrReplace;
|
||||
property StrReplacement: UnicodeString read FStrReplacement; //for regex
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function FindMatch(ANext: boolean; ASkipLen: integer; AStartPos: integer): boolean;
|
||||
property MatchPos: integer read FMatchPos; //have meaning if FindMatch returned True
|
||||
property MatchLen: integer read FMatchLen; //too
|
||||
property OnProgress: TATFinderProgress read FOnProgress write FOnProgress;
|
||||
property OnBadRegex: TNotifyEvent read FOnBadRegex write FOnBadRegex;
|
||||
end;
|
||||
|
||||
type
|
||||
{ TATEditorFinder }
|
||||
|
||||
TATEditorFinder = class(TATTextFinder)
|
||||
private
|
||||
FBuffer: TATStringBuffer;
|
||||
FEditor: TATSynEdit;
|
||||
FSkipLen: integer;
|
||||
FOnFound: TATFinderFound;
|
||||
FOnConfirmReplace: TATFinderConfirmReplace;
|
||||
function DoFindOrReplace_Internal(ANext, AReplace, AForMany: boolean; out
|
||||
AChanged: boolean; AStartPos: integer): boolean;
|
||||
procedure DoFixCaretSelectionDirection;
|
||||
procedure DoReplaceTextInEditor(P1, P2: TPoint);
|
||||
function GetOffsetOfCaret: integer;
|
||||
function GetOffsetStartPos: integer;
|
||||
function GetRegexSkipIncrement: integer;
|
||||
protected
|
||||
procedure DoOnFound; override;
|
||||
public
|
||||
OptFromCaret: boolean;
|
||||
OptConfirmReplace: boolean;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure UpdateBuffer;
|
||||
property Editor: TATSynEdit read FEditor write FEditor;
|
||||
property OnFound: TATFinderFound read FOnFound write FOnFound;
|
||||
property OnConfirmReplace: TATFinderConfirmReplace read FOnConfirmReplace write FOnConfirmReplace;
|
||||
function DoFindOrReplace(ANext, AReplace, AForMany: boolean; out AChanged: boolean): boolean;
|
||||
function DoReplaceSelectedMatch: boolean;
|
||||
function DoCountAll(AWithEvent: boolean): integer;
|
||||
function DoReplaceAll: integer;
|
||||
function IsSelectionStartsAtFoundMatch: boolean;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function IsWordChar(ch: Widechar): boolean;
|
||||
begin
|
||||
Result:= ATStringProc.IsCharWord(ch, '');
|
||||
end;
|
||||
|
||||
function SRegexReplaceEscapedTabs(const AStr: string): string;
|
||||
begin
|
||||
Result:= AStr;
|
||||
Result:= StringReplace(Result, '\\', #1, [rfReplaceAll]);
|
||||
Result:= StringReplace(Result, '\t', #9, [rfReplaceAll]);
|
||||
Result:= StringReplace(Result, #1, '\\', [rfReplaceAll]);
|
||||
end;
|
||||
|
||||
|
||||
function TATTextFinder.IsMatchUsual(APos: integer): boolean;
|
||||
var
|
||||
LenF, LastPos: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
if StrFind='' then exit;
|
||||
if StrText='' then exit;
|
||||
|
||||
LenF:= Length(StrFind);
|
||||
LastPos:= Length(StrText)-LenF+1;
|
||||
|
||||
if OptCase then
|
||||
Result:= CompareMem(@StrFind[1], @StrText[APos], LenF*2)
|
||||
else
|
||||
Result:=
|
||||
UnicodeLowerCase(StrFind) =
|
||||
UnicodeLowerCase(Copy(StrText, APos, LenF));
|
||||
|
||||
if Result then
|
||||
if OptWords then
|
||||
Result:=
|
||||
((APos <= 1) or (not IsWordChar(StrText[APos - 1]))) and
|
||||
((APos >= LastPos) or (not IsWordChar(StrText[APos + LenF])));
|
||||
end;
|
||||
|
||||
procedure TATTextFinder.SetStrFind(const AValue: UnicodeString);
|
||||
begin
|
||||
if FStrFind=AValue then Exit;
|
||||
FStrFind:= AValue;
|
||||
FMatchPos:= -1;
|
||||
FMatchLen:= 0;
|
||||
end;
|
||||
|
||||
procedure TATTextFinder.SetStrReplace(const AValue: UnicodeString);
|
||||
begin
|
||||
if FStrReplace=AValue then Exit;
|
||||
FStrReplace:= AValue;
|
||||
end;
|
||||
|
||||
procedure TATTextFinder.DoOnFound;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
function TATTextFinder.DoFindMatchUsual(FromPos: integer): Integer;
|
||||
var
|
||||
LastPos, i: integer;
|
||||
begin
|
||||
Result:= 0;
|
||||
if StrText='' then exit;
|
||||
if StrFind='' then exit;
|
||||
LastPos:= Length(StrText) - Length(StrFind) + 1;
|
||||
|
||||
if not OptBack then
|
||||
for i:= FromPos to LastPos do
|
||||
begin
|
||||
if IsMatchUsual(i) then
|
||||
begin
|
||||
Result:= i;
|
||||
Break
|
||||
end;
|
||||
end
|
||||
else
|
||||
for i:= FromPos downto 1 do
|
||||
begin
|
||||
if IsMatchUsual(i) then
|
||||
begin
|
||||
Result:= i;
|
||||
Break
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATTextFinder.DoFindMatchRegex(FromPos: integer; var MatchPos,
|
||||
MatchLen: integer): boolean;
|
||||
var
|
||||
Obj: TRegExpr;
|
||||
begin
|
||||
Result:= false;
|
||||
if StrText='' then exit;
|
||||
if StrFind='' then exit;
|
||||
|
||||
Obj:= TRegExpr.Create;
|
||||
try
|
||||
Obj.ModifierS:= false; //don't catch all text by .*
|
||||
Obj.ModifierM:= true; //allow to work with ^$
|
||||
Obj.ModifierI:= not OptCase;
|
||||
|
||||
try
|
||||
Obj.Expression:= StrFind;
|
||||
Obj.InputString:= StrText;
|
||||
Result:= Obj.ExecPos(FromPos);
|
||||
except
|
||||
if Assigned(FOnBadRegex) then
|
||||
FOnBadRegex(Self);
|
||||
Result:= false;
|
||||
end;
|
||||
|
||||
if Result then
|
||||
begin
|
||||
MatchPos:= Obj.MatchPos[0];
|
||||
MatchLen:= Obj.MatchLen[0];
|
||||
if StrReplace<>'' then
|
||||
FStrReplacement:= Obj.Replace(Obj.Match[0], SRegexReplaceEscapedTabs(StrReplace), true);
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(Obj);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATTextFinder.DoCountMatchesUsual(FromPos: integer; AWithEvent: boolean
|
||||
): Integer;
|
||||
var
|
||||
LastPos, i: Integer;
|
||||
Ok: boolean;
|
||||
begin
|
||||
Result:= 0;
|
||||
if StrText='' then exit;
|
||||
if StrFind='' then exit;
|
||||
LastPos:= Length(StrText) - Length(StrFind) + 1;
|
||||
|
||||
for i:= FromPos to LastPos do
|
||||
begin
|
||||
if Application.Terminated then exit;
|
||||
if IsMatchUsual(i) then
|
||||
begin
|
||||
Inc(Result);
|
||||
if AWithEvent then
|
||||
begin
|
||||
FMatchPos:= i;
|
||||
FMatchLen:= Length(StrFind);
|
||||
DoOnFound;
|
||||
end;
|
||||
|
||||
if Assigned(FOnProgress) then
|
||||
begin
|
||||
Ok:= true;
|
||||
FOnProgress(Self, i, LastPos, Ok);
|
||||
if not Ok then Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATTextFinder.DoCountMatchesRegex(FromPos: integer; AWithEvent: boolean
|
||||
): integer;
|
||||
var
|
||||
Obj: TRegExpr;
|
||||
Ok: boolean;
|
||||
begin
|
||||
Result:= 0;
|
||||
if StrFind='' then exit;
|
||||
if StrText='' then exit;
|
||||
|
||||
Obj:= TRegExpr.Create;
|
||||
try
|
||||
Obj.ModifierS:= false;
|
||||
Obj.ModifierM:= true;
|
||||
Obj.ModifierI:= not OptCase;
|
||||
|
||||
try
|
||||
Obj.Expression:= StrFind;
|
||||
Obj.InputString:= StrText;
|
||||
Ok:= Obj.ExecPos(FromPos);
|
||||
except
|
||||
if Assigned(FOnBadRegex) then
|
||||
FOnBadRegex(Self);
|
||||
Result:= 0;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Ok then
|
||||
begin
|
||||
Inc(Result);
|
||||
if AWithEvent then
|
||||
begin
|
||||
FMatchPos:= Obj.MatchPos[0];
|
||||
FMatchLen:= Obj.MatchLen[0];
|
||||
DoOnFound;
|
||||
end;
|
||||
|
||||
while Obj.ExecNext do
|
||||
begin
|
||||
if Application.Terminated then exit;
|
||||
Inc(Result);
|
||||
if AWithEvent then
|
||||
begin
|
||||
FMatchPos:= Obj.MatchPos[0];
|
||||
FMatchLen:= Obj.MatchLen[0];
|
||||
DoOnFound;
|
||||
end;
|
||||
|
||||
if Assigned(FOnProgress) then
|
||||
begin
|
||||
Ok:= true;
|
||||
FOnProgress(Self, Obj.MatchPos[0], Length(StrText), Ok);
|
||||
if not Ok then Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(Obj);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATEditorFinder.UpdateBuffer;
|
||||
var
|
||||
Lens: TList;
|
||||
i: integer;
|
||||
begin
|
||||
Lens:= TList.Create;
|
||||
try
|
||||
Lens.Clear;
|
||||
for i:= 0 to FEditor.Strings.Count-1 do
|
||||
Lens.Add(pointer(Length(FEditor.Strings.Lines[i])));
|
||||
FBuffer.Setup(FEditor.Strings.TextString, Lens, 1);
|
||||
finally
|
||||
FreeAndNil(Lens);
|
||||
end;
|
||||
|
||||
StrText:= FBuffer.FText;
|
||||
end;
|
||||
|
||||
constructor TATEditorFinder.Create;
|
||||
begin
|
||||
inherited;
|
||||
FEditor:= nil;
|
||||
FBuffer:= TATStringBuffer.Create;
|
||||
OptFromCaret:= false;
|
||||
OptConfirmReplace:= false;
|
||||
end;
|
||||
|
||||
destructor TATEditorFinder.Destroy;
|
||||
begin
|
||||
FEditor:= nil;
|
||||
FreeAndNil(FBuffer);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TATEditorFinder.GetOffsetOfCaret: integer;
|
||||
var
|
||||
Pnt: TPoint;
|
||||
begin
|
||||
with FEditor.Carets[0] do
|
||||
begin
|
||||
Pnt.X:= PosX;
|
||||
Pnt.Y:= PosY;
|
||||
end;
|
||||
|
||||
Result:= FBuffer.CaretToStr(Pnt);
|
||||
Inc(Result); //was 0-based
|
||||
|
||||
//find-back must goto previous match
|
||||
if OptBack then
|
||||
Dec(Result, Length(StrFind));
|
||||
|
||||
if Result<1 then
|
||||
Result:= 1;
|
||||
end;
|
||||
|
||||
function TATEditorFinder.DoCountAll(AWithEvent: boolean): integer;
|
||||
begin
|
||||
UpdateBuffer;
|
||||
if OptRegex then
|
||||
Result:= DoCountMatchesRegex(1, AWithEvent)
|
||||
else
|
||||
Result:= DoCountMatchesUsual(1, AWithEvent);
|
||||
end;
|
||||
|
||||
function TATEditorFinder.DoReplaceAll: integer;
|
||||
var
|
||||
Ok, Changed: boolean;
|
||||
begin
|
||||
Result:= 0;
|
||||
if DoFindOrReplace(false, true, true, Changed) then
|
||||
begin
|
||||
if Changed then Inc(Result);
|
||||
while DoFindOrReplace(true, true, true, Changed) do
|
||||
begin
|
||||
if Application.Terminated then exit;
|
||||
if Changed then Inc(Result);
|
||||
if Assigned(FOnProgress) then
|
||||
begin
|
||||
Ok:= true;
|
||||
FOnProgress(Self, FMatchPos, Length(StrText), Ok);
|
||||
if not Ok then Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATEditorFinder.DoReplaceTextInEditor(P1, P2: TPoint);
|
||||
var
|
||||
Shift, PosAfter: TPoint;
|
||||
Str: UnicodeString;
|
||||
begin
|
||||
if OptRegex then
|
||||
Str:= StrReplacement
|
||||
else
|
||||
Str:= StrReplace;
|
||||
|
||||
FEditor.Strings.BeginUndoGroup;
|
||||
FEditor.Strings.TextDeleteRange(P1.X, P1.Y, P2.X, P2.Y, Shift, PosAfter);
|
||||
FEditor.Strings.TextInsert(P1.X, P1.Y, Str, false, Shift, PosAfter);
|
||||
FEditor.Strings.EndUndoGroup;
|
||||
|
||||
//correct caret pos
|
||||
//(e.g. replace "dddddd" to "--": move lefter)
|
||||
if not OptBack then
|
||||
FEditor.Carets[0].PosX:= P1.X+Length(Str);
|
||||
end;
|
||||
|
||||
function TATEditorFinder.GetOffsetStartPos: integer;
|
||||
begin
|
||||
if OptFromCaret then
|
||||
Result:= GetOffsetOfCaret
|
||||
else
|
||||
if OptRegex then
|
||||
Result:= 1
|
||||
else
|
||||
if OptBack then
|
||||
Result:= Length(StrText)
|
||||
else
|
||||
Result:= 1;
|
||||
end;
|
||||
|
||||
procedure TATEditorFinder.DoFixCaretSelectionDirection;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
if FEditor.Carets.Count=0 then exit;
|
||||
Caret:= FEditor.Carets[0];
|
||||
Caret.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then exit;
|
||||
|
||||
if OptBack then
|
||||
begin
|
||||
Caret.PosX:= X1;
|
||||
Caret.PosY:= Y1;
|
||||
Caret.EndX:= X2;
|
||||
Caret.EndY:= Y2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Caret.PosX:= X2;
|
||||
Caret.PosY:= Y2;
|
||||
Caret.EndX:= X1;
|
||||
Caret.EndY:= Y1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATEditorFinder.DoFindOrReplace(ANext, AReplace, AForMany: boolean;
|
||||
out AChanged: boolean): boolean;
|
||||
var
|
||||
NStartPos: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
AChanged:= false;
|
||||
|
||||
if not Assigned(FEditor) then
|
||||
begin
|
||||
Showmessage('Finder.Editor not set');
|
||||
Exit
|
||||
end;
|
||||
if StrFind='' then
|
||||
begin
|
||||
Showmessage('Finder.StrFind not set');
|
||||
Exit
|
||||
end;
|
||||
if FEditor.Carets.Count=0 then
|
||||
begin
|
||||
Showmessage('Editor has not caret');
|
||||
Exit
|
||||
end;
|
||||
|
||||
if AReplace and FEditor.ModeReadOnly then exit;
|
||||
if OptRegex then OptBack:= false;
|
||||
|
||||
DoFixCaretSelectionDirection;
|
||||
|
||||
NStartPos:= GetOffsetStartPos;
|
||||
Result:= DoFindOrReplace_Internal(ANext, AReplace, AForMany, AChanged, NStartPos);
|
||||
|
||||
if not Result and OptWrapped then
|
||||
if (not OptBack and (NStartPos>1)) or
|
||||
(OptBack and (NStartPos<Length(StrText))) then
|
||||
begin
|
||||
//we must have AReplace=false
|
||||
//(if not, need more actions: don't allow to replace in wrapped part if too big pos)
|
||||
//
|
||||
if DoFindOrReplace_Internal(ANext, false, AForMany, AChanged,
|
||||
IfThen(not OptBack, 1, Length(StrText))) then
|
||||
begin
|
||||
Result:= (not OptBack and (MatchPos<NStartPos)) or
|
||||
(OptBack and (MatchPos>NStartPos));
|
||||
if not Result then
|
||||
begin
|
||||
FMatchPos:= -1;
|
||||
FMatchLen:= 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TATEditorFinder.DoFindOrReplace_Internal(ANext, AReplace, AForMany: boolean;
|
||||
out AChanged: boolean; AStartPos: integer): boolean;
|
||||
//function usually called 1 time in outer func,
|
||||
//or 1-2 times if OptWrap=true
|
||||
var
|
||||
P1, P2: TPoint;
|
||||
ConfirmThis, ConfirmContinue: boolean;
|
||||
begin
|
||||
AChanged:= false;
|
||||
Result:= FindMatch(ANext, FSkipLen, AStartPos);
|
||||
FSkipLen:= FMatchLen;
|
||||
|
||||
if Result then
|
||||
begin
|
||||
P1:= FBuffer.StrToCaret(MatchPos-1);
|
||||
P2:= FBuffer.StrToCaret(MatchPos-1+MatchLen);
|
||||
FEditor.DoCaretSingle(P1.X, P1.Y);
|
||||
|
||||
if AReplace then
|
||||
begin
|
||||
ConfirmThis:= true;
|
||||
ConfirmContinue:= true;
|
||||
|
||||
if OptConfirmReplace then
|
||||
if Assigned(FOnConfirmReplace) then
|
||||
FOnConfirmReplace(Self, P1, P2, AForMany, ConfirmThis, ConfirmContinue);
|
||||
|
||||
if not ConfirmContinue then
|
||||
begin
|
||||
Result:= false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if ConfirmThis then
|
||||
begin
|
||||
DoReplaceTextInEditor(P1, P2);
|
||||
UpdateBuffer;
|
||||
|
||||
if OptRegex then
|
||||
FSkipLen:= Length(StrReplacement)+GetRegexSkipIncrement
|
||||
else
|
||||
FSkipLen:= Length(StrReplace);
|
||||
AChanged:= true;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AReplace then
|
||||
//don't select
|
||||
FEditor.DoCaretSingle(P1.X, P1.Y)
|
||||
else
|
||||
//select to right (find forward) or to left (find back)
|
||||
if OptBack then
|
||||
FEditor.DoCaretSingle(P1.X, P1.Y, P2.X, P2.Y, true)
|
||||
else
|
||||
FEditor.DoCaretSingle(P2.X, P2.Y, P1.X, P1.Y, true);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATEditorFinder.IsSelectionStartsAtFoundMatch: boolean;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
PosOfBegin, PosOfEnd: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
if FEditor.Carets.Count=0 then exit;
|
||||
Caret:= FEditor.Carets[0];
|
||||
Caret.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then exit;
|
||||
|
||||
PosOfBegin:= FBuffer.CaretToStr(Point(X1, Y1))+1;
|
||||
PosOfEnd:= FBuffer.CaretToStr(Point(X2, Y2))+1;
|
||||
|
||||
//allow to replace, also if selection=Strfind
|
||||
Result:=
|
||||
((PosOfBegin=FMatchPos) and (PosOfEnd=FMatchPos+FMatchLen)) or
|
||||
((StrFind<>'') and (FEditor.TextSelected=StrFind));
|
||||
end;
|
||||
|
||||
function TATEditorFinder.DoReplaceSelectedMatch: boolean;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
P1, P2: TPoint;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
bSel: boolean;
|
||||
begin
|
||||
Result:= false;
|
||||
if not IsSelectionStartsAtFoundMatch then
|
||||
begin
|
||||
//do Find-next (from caret)
|
||||
DoFindOrReplace(false, false, false, bSel);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Caret:= FEditor.Carets[0];
|
||||
Caret.GetRange(X1, Y1, X2, Y2, bSel);
|
||||
if not bSel then exit;
|
||||
P1:= Point(X1, Y1);
|
||||
P2:= Point(X2, Y2);
|
||||
|
||||
Caret.EndX:= -1;
|
||||
Caret.EndY:= -1;
|
||||
|
||||
DoReplaceTextInEditor(P1, P2);
|
||||
UpdateBuffer;
|
||||
|
||||
if OptRegex then
|
||||
FSkipLen:= Length(StrReplacement)
|
||||
else
|
||||
FSkipLen:= Length(StrReplace);
|
||||
Result:= true;
|
||||
end;
|
||||
|
||||
|
||||
constructor TATTextFinder.Create;
|
||||
begin
|
||||
StrText:= '';
|
||||
FStrFind:= '';
|
||||
FStrReplace:= '';
|
||||
FStrReplacement:= '';
|
||||
OptBack:= false;
|
||||
OptCase:= false;
|
||||
OptWords:= false;
|
||||
OptRegex:= false;
|
||||
FMatchPos:= -1;
|
||||
FMatchLen:= 0;
|
||||
end;
|
||||
|
||||
destructor TATTextFinder.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TATTextFinder.FindMatch(ANext: boolean; ASkipLen: integer; AStartPos: integer): boolean;
|
||||
var
|
||||
FromPos: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
if StrText='' then Exit;
|
||||
if StrFind='' then Exit;
|
||||
|
||||
//regex code
|
||||
if OptRegex then
|
||||
begin
|
||||
if not ANext then
|
||||
FromPos:= AStartPos
|
||||
else
|
||||
FromPos:= FMatchPos+ASkipLen;
|
||||
Result:= DoFindMatchRegex(FromPos, FMatchPos, FMatchLen);
|
||||
if Result then DoOnFound;
|
||||
Exit
|
||||
end;
|
||||
|
||||
//usual code
|
||||
if not ANext then
|
||||
begin
|
||||
FMatchPos:= AStartPos;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if FMatchPos<=0 then
|
||||
FMatchPos:= 1;
|
||||
if not OptBack then
|
||||
Inc(FMatchPos, ASkipLen)
|
||||
else
|
||||
Dec(FMatchPos, ASkipLen);
|
||||
end;
|
||||
|
||||
FMatchPos:= DoFindMatchUsual(FMatchPos);
|
||||
Result:= FMatchPos>0;
|
||||
if Result then
|
||||
begin
|
||||
FMatchLen:= Length(StrFind);
|
||||
DoOnFound;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATEditorFinder.DoOnFound;
|
||||
var
|
||||
P1, P2: TPoint;
|
||||
begin
|
||||
if Assigned(FOnFound) then
|
||||
begin
|
||||
P1:= FBuffer.StrToCaret(MatchPos-1);
|
||||
P2:= FBuffer.StrToCaret(MatchPos-1+MatchLen);
|
||||
FOnFound(Self, P1, P2);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATEditorFinder.GetRegexSkipIncrement: integer;
|
||||
//this is to solve loop-forever if regex "$" replaced-all to eg "==="
|
||||
//(need to skip one more char)
|
||||
begin
|
||||
Result:= 0;
|
||||
if StrFind='$' then Result:= 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
405
ATSynEdit/atsynedit/atsynedit_fold.inc
Normal file
405
ATSynEdit/atsynedit/atsynedit_fold.inc
Normal file
@@ -0,0 +1,405 @@
|
||||
{$ifdef nn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.IsLineFolded(ALine: integer; ADetectPartialFold: boolean): boolean;
|
||||
var
|
||||
Flag: integer;
|
||||
begin
|
||||
if not Strings.IsIndexValid(ALine) then
|
||||
begin
|
||||
Result:= false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Flag:= Strings.LinesHidden[ALine, FEditorIndex];
|
||||
Result:= (Flag=-1) or (ADetectPartialFold and (Flag>0));
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsLineFoldedFull(ALine: integer): boolean;
|
||||
begin
|
||||
Result:= IsLineFolded(ALine, false);
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetFirstUnfoldedLineNumber: integer;
|
||||
begin
|
||||
Result:= GetNextUnfoldedLineNumber(0, true);
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetLastUnfoldedLineNumber: integer;
|
||||
begin
|
||||
Result:= GetNextUnfoldedLineNumber(Strings.Count-1, false);
|
||||
end;
|
||||
|
||||
function TATSynEdit.GetNextUnfoldedLineNumber(ALine: integer; ADown: boolean): integer;
|
||||
var
|
||||
N: integer;
|
||||
begin
|
||||
Result:= ALine;
|
||||
N:= Result;
|
||||
while IsLineFolded(N) and Strings.IsIndexValid(N) do
|
||||
N:= N+BoolToPlusMinusOne(ADown);
|
||||
if Strings.IsIndexValid(N) then Result:= N;
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsPosFolded(AX, AY: integer): boolean;
|
||||
begin
|
||||
Result:= Strings.IsPosFolded(AX, AY, FEditorIndex);
|
||||
end;
|
||||
|
||||
(*
|
||||
example of CPP file which is hard to unfold (if nested ranges folded).
|
||||
{
|
||||
d1
|
||||
{
|
||||
d2a
|
||||
}
|
||||
{
|
||||
d2b
|
||||
{
|
||||
d3a
|
||||
}
|
||||
{
|
||||
d3b
|
||||
{
|
||||
d4a
|
||||
}
|
||||
{
|
||||
d4b
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
what we do. for each line in range:
|
||||
a) if line not in any subrange, show it
|
||||
b) for all subranges at top level:
|
||||
b1) if subrange marked folded, unfold 1st line "[...]"
|
||||
b2) if subrange marked unfolded, recursion
|
||||
*)
|
||||
procedure TATSynEdit.DoRangeUnfold(ARange: TATSynRange);
|
||||
var
|
||||
List: TATIntArray;
|
||||
R: TATSynRange;
|
||||
i, j: integer;
|
||||
InSubrange: boolean;
|
||||
begin
|
||||
ARange.Folded:= false;
|
||||
FWrapUpdateNeeded:= true;
|
||||
|
||||
List:= FFold.FindRangesContainingLines(-1, -1, ARange,
|
||||
false{OnlyFolded}, true{TopLevel}, cRngIgnore);
|
||||
|
||||
//show all lines not in subranges
|
||||
for i:= ARange.Y to ARange.Y2 do
|
||||
begin
|
||||
InSubrange:= false;
|
||||
for j:= Low(List) to High(List) do
|
||||
if FFold[List[j]].IsLineInside(i) then
|
||||
begin
|
||||
InSubrange:= true;
|
||||
Break
|
||||
end;
|
||||
|
||||
if not InSubrange then
|
||||
Strings.LinesHidden[i, FEditorIndex]:= 0;
|
||||
end;
|
||||
|
||||
//unfold subranges, resursion
|
||||
for i:= Low(List) to High(List) do
|
||||
begin
|
||||
R:= FFold[List[i]];
|
||||
if R.Folded then
|
||||
Strings.LinesHidden[R.Y, FEditorIndex]:= R.X
|
||||
else
|
||||
DoRangeUnfold(R);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoRangeFold(ARange: TATSynRange);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
ARange.Folded:= true;
|
||||
FWrapUpdateNeeded:= true;
|
||||
|
||||
//partially fold 1st line
|
||||
if ARange.Hint<>'' then
|
||||
begin
|
||||
Strings.LinesHidden[ARange.Y, FEditorIndex]:= ARange.X;
|
||||
end
|
||||
else
|
||||
case FFoldStyle of
|
||||
cFoldHereWithDots:
|
||||
begin
|
||||
Strings.LinesHidden[ARange.Y, FEditorIndex]:= ARange.X;
|
||||
end;
|
||||
cFoldHereWithTruncatedText:
|
||||
begin
|
||||
Strings.LinesHidden[ARange.Y, FEditorIndex]:= ARange.X;
|
||||
ARange.Hint:= Copy(Strings.Lines[ARange.Y], ARange.X, cFoldedLenOfEmptyHint)+'...';
|
||||
end;
|
||||
cFoldFromEndOfLine:
|
||||
begin
|
||||
Strings.LinesHidden[ARange.Y, FEditorIndex]:= Length(Strings.Lines[ARange.Y])+1;
|
||||
end;
|
||||
cFoldFromNextLine:
|
||||
begin
|
||||
//don't fold line
|
||||
end;
|
||||
end;
|
||||
|
||||
//fully fold next lines
|
||||
for i:= ARange.Y+1 to ARange.Y2 do
|
||||
Strings.LinesHidden[i, FEditorIndex]:= -1;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoUnfoldLine(ALine: integer);
|
||||
var
|
||||
List: TATIntArray;
|
||||
i: integer;
|
||||
begin
|
||||
List:= FFold.FindRangesContainingLines(ALine, ALine, nil,
|
||||
true{OnlyFolded}, false{TopLevelOnly}, cRngHasAllLines);
|
||||
for i:= Low(List) to High(List) do
|
||||
DoRangeUnfold(FFold[List[i]]);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoFoldbarClick(ALine: integer);
|
||||
var
|
||||
R: TATSynRange;
|
||||
begin
|
||||
R:= FFold.FindRangeWithPlusAtLine(ALine);
|
||||
if Assigned(R) then
|
||||
begin
|
||||
if R.Folded then
|
||||
DoRangeUnfold(R)
|
||||
else
|
||||
DoRangeFold(R);
|
||||
Update;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TATSynEdit.GetFoldedMarkText(ALine: integer): string;
|
||||
var
|
||||
R: TATSynRange;
|
||||
begin
|
||||
Result:= '';
|
||||
R:= FFold.FindRangeWithPlusAtLine(ALine);
|
||||
if Assigned(R) then
|
||||
Result:= R.Hint;
|
||||
if Result='' then
|
||||
Result:= '...';
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.UpdateFoldedFromLinesHidden;
|
||||
var
|
||||
i, j: integer;
|
||||
N: integer;
|
||||
R: TATSynRange;
|
||||
begin
|
||||
for i:= 0 to Strings.Count-1 do
|
||||
begin
|
||||
N:= Strings.LinesHidden[i, FEditorIndex];
|
||||
if N<=0 then Continue;
|
||||
|
||||
for j:= 0 to Fold.Count-1 do
|
||||
begin
|
||||
R:= Fold.Items[j];
|
||||
if (R.Y>i) then Break;
|
||||
if (R.Y=i) and (R.X=N) then
|
||||
begin
|
||||
DoRangeFold(R); //do not just R.Folded:= true;
|
||||
Break
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsFoldLineNeededBeforeWrapitem(N: integer): boolean;
|
||||
var
|
||||
NLineCur, NLinePrev: integer;
|
||||
begin
|
||||
if FWrapInfo.IsIndexValid(N) and (N>0) then
|
||||
begin
|
||||
NLineCur:= FWrapInfo.Items[N].NLineIndex;
|
||||
NLinePrev:= FWrapInfo.Items[N-1].NLineIndex;
|
||||
//before this line some is skipped
|
||||
Result:= NLineCur-NLinePrev > 1;
|
||||
//and prev visible line is fully visible
|
||||
if Result then
|
||||
Result:= Strings.LinesHidden[NLinePrev, FEditorIndex]=0;
|
||||
end
|
||||
else
|
||||
Result:= false;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoMenuGutterFold;
|
||||
var
|
||||
Menu: TPopupMenu;
|
||||
mi, miSub: TMenuItem;
|
||||
i: integer;
|
||||
begin
|
||||
InitResourcesFoldbar;
|
||||
if FMenuGutterFoldStd=nil then
|
||||
FMenuGutterFoldStd:= TPopupMenu.Create(Self);
|
||||
|
||||
Menu:= FMenuGutterFoldStd;
|
||||
Menu.Images:= FFoldImageList;
|
||||
Menu.Items.Clear;
|
||||
|
||||
//items "fold all", "unfold all"
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Caption:= cStrMenuItemFoldAll;
|
||||
mi.OnClick:= @MenuFoldFoldAllClick;
|
||||
mi.Enabled:= Fold.Count>0;
|
||||
Menu.Items.Add(mi);
|
||||
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Caption:= cStrMenuItemUnfoldAll;
|
||||
mi.OnClick:= @MenuFoldUnfoldAllClick;
|
||||
mi.Enabled:= Fold.Count>0;
|
||||
Menu.Items.Add(mi);
|
||||
|
||||
//submenu "fold level"
|
||||
miSub:= TMenuItem.Create(Self);
|
||||
miSub.Caption:= cStrMenuItemFoldLevel;
|
||||
miSub.Enabled:= Fold.Count>0;
|
||||
Menu.Items.Add(miSub);
|
||||
|
||||
for i:= 2 to 9 do
|
||||
begin
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Caption:= Inttostr(i);
|
||||
mi.Tag:= i-1;
|
||||
mi.OnClick:=@MenuFoldLevelClick;
|
||||
miSub.Add(mi);
|
||||
end;
|
||||
|
||||
//dynamic items [+], [-]
|
||||
DoMenuGutterFold_AddDynamicItems(Menu);
|
||||
|
||||
Menu.Popup;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoMenuGutterFold_AddDynamicItems(Menu: TPopupMenu);
|
||||
var
|
||||
Pnt: TPoint;
|
||||
AtEnd: boolean;
|
||||
NLine: integer;
|
||||
IntList: TATIntArray;
|
||||
Rng: TATSynRange;
|
||||
mi: TMenuItem;
|
||||
i: integer;
|
||||
begin
|
||||
//calc ranges for curr line
|
||||
Pnt:= ScreenToClient(Mouse.CursorPos);
|
||||
Pnt:= ClientPosToCaretPos(Pnt, AtEnd);
|
||||
NLine:= Pnt.Y;
|
||||
if NLine<0 then Exit;
|
||||
|
||||
IntList:= Fold.FindRangesContainingLines(NLine, NLine, nil,
|
||||
false{OnlyFolded}, false{TopLevel}, cRngHasAllLines);
|
||||
if Length(IntList)=0 then Exit;
|
||||
|
||||
//separator
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Caption:= '-';
|
||||
Menu.Items.Add(mi);
|
||||
|
||||
//items for ranges for current line
|
||||
for i:= 0 to High(IntList) do
|
||||
begin
|
||||
Rng:= Fold[IntList[i]];
|
||||
mi:= TMenuItem.Create(Self);
|
||||
mi.Tag:= ptrint(Rng);
|
||||
mi.OnClick:= @MenuFoldPlusMinusClick;
|
||||
|
||||
mi.Caption:=
|
||||
cHintScrollPrefix+' '+Inttostr(Rng.Y+1)+': '+
|
||||
UTF8Encode(Copy(Strings.Lines[Rng.Y], 1, cFoldedLenOfEmptyHint));
|
||||
|
||||
if Rng.Folded then
|
||||
mi.ImageIndex:= 0
|
||||
else
|
||||
mi.ImageIndex:= 1;
|
||||
|
||||
Menu.Items.Add(mi);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.InitResourcesFoldbar;
|
||||
begin
|
||||
if FFoldImageList=nil then
|
||||
begin
|
||||
FFoldImageList:= TImageList.Create(Self);
|
||||
FFoldImageList.Width:= 12;
|
||||
FFoldImageList.Height:= 12;
|
||||
FFoldImageList.AddResourceName(HInstance, 'FOLDBAR_P');
|
||||
FFoldImageList.AddResourceName(HInstance, 'FOLDBAR_M');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.MenuFoldPlusMinusClick(Sender: TObject);
|
||||
var
|
||||
Rng: TATSynRange;
|
||||
begin
|
||||
Rng:= TATSynRange((Sender as TComponent).Tag);
|
||||
if Rng.Folded then
|
||||
DoRangeUnfold(Rng)
|
||||
else
|
||||
DoRangeFold(Rng);
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.MenuFoldFoldAllClick(Sender: TObject);
|
||||
begin
|
||||
DoCommand(cCommand_FoldAll);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.MenuFoldLevelClick(Sender: TObject);
|
||||
begin
|
||||
DoFoldForLevel((Sender as TComponent).Tag);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.MenuFoldUnfoldAllClick(Sender: TObject);
|
||||
begin
|
||||
DoCommand(cCommand_UnfoldAll);
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoFoldForLevelAndLines(ALineFrom, ALineTo: integer;
|
||||
ALevel: integer; AForThisRange: TATSynRange);
|
||||
var
|
||||
List: TATIntArray;
|
||||
R: TATSynRange;
|
||||
i: integer;
|
||||
begin
|
||||
//this func recursive. it calls itself with ALevel-1.
|
||||
//folds ranges if ALevel=0, else goes to subranges until found ALevel=0.
|
||||
if ALevel<0 then exit;
|
||||
|
||||
List:= Fold.FindRangesContainingLines(ALineFrom, ALineTo, AForThisRange,
|
||||
false{OnlyFolded}, true{TopLevel}, cRngExceptThisRange);
|
||||
|
||||
for i:= Low(List) to High(List) do
|
||||
begin
|
||||
R:= Fold.Items[List[i]];
|
||||
if R.IsSimple then Continue;
|
||||
if R.Folded then Continue;
|
||||
if ALevel=0 then
|
||||
DoRangeFold(R)
|
||||
else
|
||||
DoFoldForLevelAndLines(R.Y, R.Y2, ALevel-1, R);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoFoldForLevel(ALevel: integer);
|
||||
begin
|
||||
DoCommand(cCommand_UnfoldAll);
|
||||
DoFoldForLevelAndLines(0, Strings.Count-1, ALevel, nil);
|
||||
Update;
|
||||
end;
|
||||
|
||||
31
ATSynEdit/atsynedit/atsynedit_form_complete.lfm
Normal file
31
ATSynEdit/atsynedit/atsynedit_form_complete.lfm
Normal file
@@ -0,0 +1,31 @@
|
||||
object FormATSynEditComplete: TFormATSynEditComplete
|
||||
Left = 528
|
||||
Height = 240
|
||||
Top = 447
|
||||
Width = 320
|
||||
BorderStyle = bsNone
|
||||
ClientHeight = 240
|
||||
ClientWidth = 320
|
||||
FormStyle = fsStayOnTop
|
||||
KeyPreview = True
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnDeactivate = FormDeactivate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnShow = FormShow
|
||||
OnUTF8KeyPress = FormUTF8KeyPress
|
||||
LCLVersion = '1.5'
|
||||
object List: TATListbox
|
||||
Left = 4
|
||||
Height = 232
|
||||
Top = 4
|
||||
Width = 312
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
Color = clSilver
|
||||
ItemHeight = 28
|
||||
OnClick = ListClick
|
||||
OnDrawItem = ListDrawItem
|
||||
end
|
||||
end
|
||||
447
ATSynEdit/atsynedit/atsynedit_form_complete.pas
Normal file
447
ATSynEdit/atsynedit/atsynedit_form_complete.pas
Normal file
@@ -0,0 +1,447 @@
|
||||
unit atsynedit_form_complete;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics,
|
||||
Dialogs,
|
||||
LclProc, LclType,
|
||||
ATSynEdit,
|
||||
ATSynEdit_Carets,
|
||||
ATSynEdit_Commands,
|
||||
ATStringProc,
|
||||
ATListbox,
|
||||
Math;
|
||||
|
||||
type
|
||||
TATCompletionPropEvent = procedure (Sender: TObject;
|
||||
out AText, ASuffix: string; out ACharsLeft, ACharsRight: integer) of object;
|
||||
|
||||
//AText is #13-separated strings, each string is '|'-separated items.
|
||||
//Usually item_0 is prefix to show,
|
||||
//item_1 is actual text (result of function),
|
||||
//item_2..etc are only to show.
|
||||
//e.g. 'func|Func1|(param1, param2)'+#13+'var|Var1'+#13+'var|Var2'
|
||||
//AChars: how many chars to replace before caret.
|
||||
|
||||
procedure DoEditorCompletionListbox(AEd: TATSynEdit;
|
||||
AOnGetProp: TATCompletionPropEvent);
|
||||
|
||||
procedure EditorGetCurrentWord(Ed: TATSynEdit; const AWordChars: atString;
|
||||
out AWord: atString; out ACharsLeft, ACharsRight: integer);
|
||||
|
||||
type
|
||||
{ TFormATSynEditComplete }
|
||||
|
||||
TFormATSynEditComplete = class(TForm)
|
||||
List: TATListbox;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDeactivate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
|
||||
procedure ListClick(Sender: TObject);
|
||||
procedure ListDrawItem(Sender: TObject; C: TCanvas; AIndex: integer;
|
||||
const ARect: TRect);
|
||||
private
|
||||
{ private declarations }
|
||||
SList: TStringlist;
|
||||
FOnGetProp: TATCompletionPropEvent;
|
||||
FEdit: TATSynEdit;
|
||||
FCharsLeft,
|
||||
FCharsRight: integer;
|
||||
FSuffix: string;
|
||||
FHintWnd: THintWindow;
|
||||
procedure DoHintHide;
|
||||
procedure DoHintShow(const AHint: string);
|
||||
procedure DoReplaceTo(const Str: string);
|
||||
procedure DoResult;
|
||||
procedure DoUpdate;
|
||||
function GetItemText(S: string; AIndex: integer): string;
|
||||
function GetResultText: string;
|
||||
public
|
||||
{ public declarations }
|
||||
property Editor: TATSynEdit read FEdit write FEdit;
|
||||
property OnGetProp: TATCompletionPropEvent read FOnGetProp write FOnGetProp;
|
||||
end;
|
||||
|
||||
const
|
||||
cCompleteItemCount = 5;
|
||||
var
|
||||
cCompleteColorFont: array[0..cCompleteItemCount-1] of TColor =
|
||||
(clPurple, clBlack, clNavy, clBlack, clBlack);
|
||||
cCompleteFontStyles: array[0..cCompleteItemCount-1] of TFontStyles =
|
||||
([fsBold], [], [], [], []);
|
||||
cCompleteColorBg: TColor = $e0e0e0;
|
||||
cCompleteColorSelBg: TColor = clMedGray;
|
||||
|
||||
cCompleteIndexOfText: integer = 1;
|
||||
cCompleteIndexOfDesc: integer = 2;
|
||||
cCompleteSepChar: char = '|';
|
||||
cCompleteHintChar: char = #9;
|
||||
cCompleteListSort: boolean = false;
|
||||
cCompleteKeyUpDownWrap: boolean = true;
|
||||
cCompleteInsertAlsoBracket: boolean = true;
|
||||
cCompleteFontName: string = 'default';
|
||||
cCompleteFontSize: integer = 10;
|
||||
cCompleteItemHeight: integer = 17;
|
||||
cCompleteBorderSize: integer = 4;
|
||||
cCompleteFormSizeX: integer = 500;
|
||||
cCompleteFormSizeY: integer = 200;
|
||||
cCompleteHintSizeX: integer = 400;
|
||||
cCompleteTextIndent0: integer = 4;
|
||||
cCompleteTextIndent: integer = 8;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
var
|
||||
FormComplete: TFormATSynEditComplete = nil;
|
||||
|
||||
procedure DoEditorCompletionListbox(AEd: TATSynEdit;
|
||||
AOnGetProp: TATCompletionPropEvent);
|
||||
begin
|
||||
if AEd.ModeReadOnly then exit;
|
||||
if AEd.Carets.Count<>1 then exit;
|
||||
|
||||
if FormComplete=nil then
|
||||
FormComplete:= TFormATSynEditComplete.Create(nil);
|
||||
|
||||
FormComplete.Editor:= AEd;
|
||||
FormComplete.OnGetProp:= AOnGetProp;
|
||||
FormComplete.DoUpdate;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.DoReplaceTo(const Str: string);
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
Pos, Shift, PosAfter: TPoint;
|
||||
begin
|
||||
if Str<>'' then
|
||||
begin
|
||||
Caret:= Editor.Carets[0];
|
||||
Pos.X:= Caret.PosX;
|
||||
Pos.Y:= Caret.PosY;
|
||||
|
||||
FCharsLeft:= Min(Pos.X, FCharsLeft);
|
||||
Dec(Pos.X, FCharsLeft);
|
||||
Editor.Strings.TextDeleteRight(Pos.X, Pos.Y, FCharsLeft+FCharsRight, Shift, PosAfter, false);
|
||||
Editor.Strings.TextInsert(Pos.X, Pos.Y, Utf8Decode(Str), false, Shift, PosAfter);
|
||||
|
||||
Caret.PosX:= Pos.X+Length(Utf8Decode(Str));
|
||||
Caret.EndX:= -1;
|
||||
Caret.EndY:= -1;
|
||||
|
||||
Editor.Update(true);
|
||||
Editor.DoEventChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFormATSynEditComplete }
|
||||
|
||||
procedure TFormATSynEditComplete.FormCreate(Sender: TObject);
|
||||
begin
|
||||
SList:= TStringList.Create;
|
||||
FHintWnd:= THintWindow.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormDeactivate(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
DoHintHide;
|
||||
if Assigned(FEdit) then
|
||||
FEdit.OptCaretStopUnfocused:= true;
|
||||
CloseAction:= caHide;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
SList.Free;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if (key=vk_up) and (shift=[]) then
|
||||
begin
|
||||
if List.ItemIndex>0 then
|
||||
List.ItemIndex:= List.ItemIndex-1
|
||||
else
|
||||
if cCompleteKeyUpDownWrap then
|
||||
List.ItemIndex:= List.ItemCount-1;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=vk_down) and (shift=[]) then
|
||||
begin
|
||||
if List.ItemIndex<List.ItemCount-1 then
|
||||
List.ItemIndex:= List.ItemIndex+1
|
||||
else
|
||||
if cCompleteKeyUpDownWrap then
|
||||
List.ItemIndex:= 0;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_PRIOR) and (shift=[]) then
|
||||
begin
|
||||
List.ItemIndex:= Max(0, List.ItemIndex-List.VisibleItems);
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_NEXT) and (shift=[]) then
|
||||
begin
|
||||
List.ItemIndex:= Min(List.Itemcount-1, List.ItemIndex+List.VisibleItems);
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=vk_home) then
|
||||
begin
|
||||
List.ItemIndex:= 0;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=vk_end) then
|
||||
begin
|
||||
List.ItemIndex:= List.ItemCount-1;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_ESCAPE) then
|
||||
begin
|
||||
Close;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_RETURN) or (key=VK_TAB) then
|
||||
begin
|
||||
DoResult;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_LEFT) and (shift=[]) then
|
||||
begin
|
||||
Editor.DoCommand(cCommand_KeyLeft, '');
|
||||
DoUpdate;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (key=VK_RIGHT) and (shift=[]) then
|
||||
begin
|
||||
Editor.DoCommand(cCommand_KeyRight, '');
|
||||
DoUpdate;
|
||||
key:= 0;
|
||||
exit
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormShow(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FEdit) then
|
||||
FEdit.OptCaretStopUnfocused:= false;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.FormUTF8KeyPress(Sender: TObject;
|
||||
var UTF8Key: TUTF8Char);
|
||||
var
|
||||
Str: atString;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
//backsp
|
||||
if (UTF8Key=#8) then
|
||||
begin
|
||||
FEdit.DoCommand(cCommand_KeyBackspace, '');
|
||||
DoUpdate;
|
||||
Utf8Key:= '';
|
||||
exit;
|
||||
end;
|
||||
|
||||
//skip control Ascii chars
|
||||
if Ord(UTF8Key[1])<32 then Exit;
|
||||
|
||||
Str:= Utf8Decode(Utf8Key);
|
||||
FEdit.DoCommand(cCommand_TextInsert, Str);
|
||||
DoUpdate;
|
||||
Utf8Key:= '';
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.ListClick(Sender: TObject);
|
||||
begin
|
||||
DoResult;
|
||||
end;
|
||||
|
||||
function TFormATSynEditComplete.GetItemText(S: string; AIndex: integer): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= 0 to AIndex do
|
||||
Result:= SGetItem(S, cCompleteSepChar);
|
||||
end;
|
||||
|
||||
function TFormATSynEditComplete.GetResultText: string;
|
||||
var
|
||||
SText, SDesc: string;
|
||||
begin
|
||||
Result:= '';
|
||||
if List.ItemIndex>=0 then
|
||||
begin
|
||||
SText:= GetItemText(SList[List.ItemIndex], cCompleteIndexOfText);
|
||||
SDesc:= GetItemText(SList[List.ItemIndex], cCompleteIndexOfDesc);
|
||||
Result:= SText;
|
||||
|
||||
if FSuffix<>'' then
|
||||
Result:= Result+FSuffix
|
||||
else
|
||||
if cCompleteInsertAlsoBracket then
|
||||
if SBeginsWith(SDesc, '(') then
|
||||
Result:= Result+'(';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.ListDrawItem(Sender: TObject; C: TCanvas;
|
||||
AIndex: integer; const ARect: TRect);
|
||||
var
|
||||
Str, SItem, SHint: string;
|
||||
NSize, i: integer;
|
||||
begin
|
||||
Str:= SList[AIndex];
|
||||
SHint:= SGetItemAtEnd(Str, cCompleteHintChar);
|
||||
|
||||
if AIndex=List.ItemIndex then
|
||||
DoHintShow(SHint);
|
||||
|
||||
if AIndex=List.ItemIndex then
|
||||
C.Brush.Color:= cCompleteColorSelBg
|
||||
else
|
||||
C.Brush.Color:= cCompleteColorBg;
|
||||
C.FillRect(ARect);
|
||||
|
||||
C.Font.Assign(List.Font);
|
||||
NSize:= cCompleteTextIndent0;
|
||||
|
||||
for i:= 0 to cCompleteItemCount-1 do
|
||||
begin
|
||||
SItem:= SGetItem(Str, cCompleteSepChar);
|
||||
C.Font.Style:= cCompleteFontStyles[i];
|
||||
C.Font.Color:= cCompleteColorFont[i];
|
||||
C.TextOut(ARect.Left+NSize, ARect.Top, SItem);
|
||||
Inc(NSize, C.TextWidth(SItem)+cCompleteTextIndent);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.DoResult;
|
||||
begin
|
||||
DoReplaceTo(GetResultText);
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.DoUpdate;
|
||||
var
|
||||
AText: string;
|
||||
P: TPoint;
|
||||
begin
|
||||
if Assigned(FOnGetProp) then
|
||||
FOnGetProp(Editor, AText, FSuffix, FCharsLeft, FCharsRight);
|
||||
|
||||
if (AText='') then
|
||||
begin Close; exit end;
|
||||
|
||||
SList.Text:= AText;
|
||||
if SList.Count=0 then exit;
|
||||
if cCompleteListSort then SList.Sort;
|
||||
|
||||
List.ItemCount:= SList.Count;
|
||||
List.ItemIndex:= 0;
|
||||
|
||||
Color:= cCompleteColorBg;
|
||||
List.Color:= cCompleteColorBg;
|
||||
List.Font.Name:= cCompleteFontName;
|
||||
List.Font.Size:= cCompleteFontSize;
|
||||
List.ItemHeight:= cCompleteItemHeight;
|
||||
List.BorderSpacing.Around:= cCompleteBorderSize;
|
||||
List.Invalidate;
|
||||
|
||||
P.X:= Editor.Carets[0].CoordX-Editor.TextCharSize.X*FCharsLeft;
|
||||
P.Y:= Editor.Carets[0].CoordY+Editor.TextCharSize.Y;
|
||||
P:= Editor.ClientToScreen(P);
|
||||
|
||||
SetBounds(P.X, P.Y, cCompleteFormSizeX, cCompleteFormSizeY);
|
||||
Show;
|
||||
end;
|
||||
|
||||
|
||||
procedure EditorGetCurrentWord(Ed: TATSynEdit; const AWordChars: atString;
|
||||
out AWord: atString; out ACharsLeft, ACharsRight: integer);
|
||||
var
|
||||
str: atString;
|
||||
n: integer;
|
||||
begin
|
||||
AWord:= '';
|
||||
ACharsLeft:= 0;
|
||||
ACharsRight:= 0;
|
||||
|
||||
str:= Ed.Strings.Lines[Ed.Carets[0].PosY];
|
||||
n:= Ed.Carets[0].PosX;
|
||||
if (n>Length(str)) then exit;
|
||||
|
||||
while (n>0) and (IsCharWord(str[n], AWordChars)) do
|
||||
begin
|
||||
AWord:= str[n]+AWord;
|
||||
Dec(n);
|
||||
Inc(ACharsLeft);
|
||||
end;
|
||||
|
||||
n:= Ed.Carets[0].PosX;
|
||||
while (n<Length(str)) and (IsCharWord(str[n+1], AWordChars)) do
|
||||
begin
|
||||
Inc(n);
|
||||
Inc(ACharsRight);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.DoHintShow(const AHint: string);
|
||||
var
|
||||
P: TPoint;
|
||||
R: TRect;
|
||||
begin
|
||||
R:= FHintWnd.CalcHintRect(cCompleteHintSizeX, AHint, nil);
|
||||
|
||||
P:= ClientToScreen(Point(Width, 0));
|
||||
OffsetRect(R, P.X, P.Y);
|
||||
|
||||
FHintWnd.ActivateHint(R, AHint);
|
||||
FHintWnd.Invalidate; //for Win
|
||||
Editor.Invalidate; //for Win
|
||||
end;
|
||||
|
||||
procedure TFormATSynEditComplete.DoHintHide;
|
||||
begin
|
||||
if Assigned(FHintWnd) then
|
||||
FHintWnd.Hide;
|
||||
end;
|
||||
|
||||
finalization
|
||||
if Assigned(FormComplete) then
|
||||
FormComplete.Free;
|
||||
|
||||
end.
|
||||
|
||||
171
ATSynEdit/atsynedit/atsynedit_form_complete_css.pas
Normal file
171
ATSynEdit/atsynedit/atsynedit_form_complete_css.pas
Normal file
@@ -0,0 +1,171 @@
|
||||
unit atsynedit_form_complete_css;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics,
|
||||
ATSynEdit,
|
||||
ATSynEdit_Carets,
|
||||
RegExpr,
|
||||
Dialogs;
|
||||
|
||||
//it needs file css_list.ini from SynWrite distro
|
||||
procedure DoEditorCompletionCss(AEdit: TATSynEdit;
|
||||
const AFilenameCssList: string);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ATStringProc,
|
||||
ATSynEdit_form_complete;
|
||||
|
||||
type
|
||||
{ TAcp }
|
||||
|
||||
TAcp = class
|
||||
private
|
||||
List: TStringlist;
|
||||
procedure DoOnGetCompleteProp(Sender: TObject; out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
public
|
||||
Ed: TATSynEdit;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
Acp: TAcp = nil;
|
||||
|
||||
|
||||
function SFindRegex(const SText, SRegex: string; NGroup: integer): string;
|
||||
var
|
||||
R: TRegExpr;
|
||||
begin
|
||||
Result:= '';
|
||||
R:= TRegExpr.Create;
|
||||
try
|
||||
R.ModifierS:= false;
|
||||
R.ModifierM:= true;
|
||||
R.ModifierI:= true;
|
||||
|
||||
R.Expression:= SRegex;
|
||||
R.InputString:= SText;
|
||||
|
||||
if R.ExecPos(1) then
|
||||
Result:= Copy(SText, R.MatchPos[NGroup], R.MatchLen[NGroup]);
|
||||
finally
|
||||
R.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function EditorGetCssTag(Ed: TATSynEdit): string;
|
||||
const
|
||||
//char class for all chars in css values
|
||||
cRegexChars = '[''"\w\s\.,:/~&%@!=\#\$\^\-\+\(\)\?]';
|
||||
//regex to catch css property name, before css attribs and before ":", at line end
|
||||
cRegexProp = '([\w\-]+):\s*' + cRegexChars + '*$';
|
||||
cRegexGroup = 1; //group 1 in (..)
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
S: atString;
|
||||
begin
|
||||
Result:= '';
|
||||
Caret:= Ed.Carets[0];
|
||||
S:= Ed.Strings.Lines[Caret.PosY];
|
||||
S:= Copy(S, 1, Caret.PosX);
|
||||
if S<>'' then
|
||||
Result:= SFindRegex(S, cRegexProp, cRegexGroup);
|
||||
end;
|
||||
|
||||
|
||||
procedure TAcp.DoOnGetCompleteProp(Sender: TObject; out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
const
|
||||
cWordChars = '-#!@.'; //don't include ':'
|
||||
var
|
||||
s_word: atString;
|
||||
s_tag, s_item, s_val: string;
|
||||
n: integer;
|
||||
ok: boolean;
|
||||
begin
|
||||
AText:= '';
|
||||
ASuffix:= '';
|
||||
ACharsLeft:= 0;
|
||||
ACharsRight:= 0;
|
||||
|
||||
s_tag:= EditorGetCssTag(Ed);
|
||||
if s_tag<>'' then
|
||||
//show list of values for s_tag
|
||||
begin
|
||||
s_item:= List.Values[s_tag];
|
||||
if s_item='' then exit;
|
||||
repeat
|
||||
s_val:= SGetItem(s_item);
|
||||
if s_val='' then Break;
|
||||
AText:= AText+'css '+s_tag+'|'+s_val+#13;
|
||||
until false;
|
||||
end
|
||||
else
|
||||
//show list of all tags
|
||||
begin
|
||||
ASuffix:= ': ';
|
||||
EditorGetCurrentWord(Ed, cWordChars, s_word, ACharsLeft, ACharsRight);
|
||||
|
||||
for n:= 0 to List.Count-1 do
|
||||
begin
|
||||
s_item:= List.Names[n];
|
||||
|
||||
//filter by cur word (not case sens)
|
||||
if s_word<>'' then
|
||||
begin
|
||||
ok:= SBeginsWith(UpperCase(s_item), UpperCase(s_word));
|
||||
if not ok then Continue;
|
||||
end;
|
||||
|
||||
AText:= AText+'css'+'|'+s_item+#13;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TAcp.Create;
|
||||
begin
|
||||
inherited;
|
||||
List:= TStringlist.create;
|
||||
end;
|
||||
|
||||
destructor TAcp.Destroy;
|
||||
begin
|
||||
FreeAndNil(List);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure DoEditorCompletionCss(AEdit: TATSynEdit;
|
||||
const AFilenameCssList: string);
|
||||
begin
|
||||
Acp.Ed:= AEdit;
|
||||
|
||||
//load file only once
|
||||
if Acp.List.Count=0 then
|
||||
begin
|
||||
if not FileExists(AFilenameCssList) then exit;
|
||||
Acp.List.LoadFromFile(AFilenameCssList);
|
||||
end;
|
||||
|
||||
DoEditorCompletionListbox(AEdit, @Acp.DoOnGetCompleteProp);
|
||||
end;
|
||||
|
||||
initialization
|
||||
Acp:= TAcp.Create;
|
||||
|
||||
cCompleteFontStyles[0]:= [];
|
||||
cCompleteColorFont[0]:= clPurple;
|
||||
cCompleteColorFont[1]:= clBlack;
|
||||
|
||||
finalization
|
||||
FreeAndNil(Acp);
|
||||
|
||||
end.
|
||||
|
||||
263
ATSynEdit/atsynedit/atsynedit_form_complete_html.pas
Normal file
263
ATSynEdit/atsynedit/atsynedit_form_complete_html.pas
Normal file
@@ -0,0 +1,263 @@
|
||||
unit atsynedit_form_complete_html;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics,
|
||||
ATSynEdit,
|
||||
ATSynEdit_Carets,
|
||||
RegExpr,
|
||||
Dialogs;
|
||||
|
||||
//it needs file html_list.ini from SynWrite distro
|
||||
procedure DoEditorCompletionHtml(AEdit: TATSynEdit;
|
||||
const AFilenameHtmlList: string);
|
||||
|
||||
type
|
||||
TCompleteHtmlMode = (
|
||||
acpModeNone,
|
||||
acpModeTags,
|
||||
acpModeTagsClose,
|
||||
acpModeAttrs,
|
||||
acpModeVals
|
||||
);
|
||||
|
||||
//detect tag and its attribute at caret pos
|
||||
procedure EditorGetHtmlTag(Ed: TATSynedit; out STag, SAttr: string;
|
||||
out AMode: TCompleteHtmlMode);
|
||||
function EditorHasCssAtCaret(Ed: TATSynEdit): boolean;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ATStringProc,
|
||||
ATSynEdit_form_complete;
|
||||
|
||||
type
|
||||
{ TAcp }
|
||||
|
||||
TAcp = class
|
||||
private
|
||||
List: TStringlist;
|
||||
procedure DoOnGetCompleteProp(Sender: TObject; out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
public
|
||||
Ed: TATSynEdit;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
Acp: TAcp = nil;
|
||||
|
||||
function SFindRegex(const SText, SRegex: string; NGroup: integer): string;
|
||||
var
|
||||
R: TRegExpr;
|
||||
begin
|
||||
Result:= '';
|
||||
R:= TRegExpr.Create;
|
||||
try
|
||||
R.ModifierS:= false;
|
||||
R.ModifierM:= true;
|
||||
R.ModifierI:= true;
|
||||
|
||||
R.Expression:= SRegex;
|
||||
R.InputString:= SText;
|
||||
|
||||
if R.ExecPos(1) then
|
||||
Result:= Copy(SText, R.MatchPos[NGroup], R.MatchLen[NGroup]);
|
||||
finally
|
||||
R.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure EditorGetHtmlTag(Ed: TATSynedit; out STag, SAttr: string; out AMode: TCompleteHtmlMode);
|
||||
const
|
||||
//regex to catch tag name at line start
|
||||
cRegexTagPart = '^\w+\b';
|
||||
cRegexTagOnly = '^\w*$';
|
||||
cRegexTagClose = '^/\w*$';
|
||||
//character class for all chars inside quotes
|
||||
cRegexChars = '[\s\w,\.:;\-\+\*\?=\(\)\[\]\{\}/\\\|~`\^\$&%\#@!]';
|
||||
//regex to catch attrib name, followed by "=" and not-closed quote, only at line end
|
||||
cRegexAttr = '\b([\w\-]+)\s*\=\s*([''"]' + cRegexChars + '*)?$';
|
||||
//regex group
|
||||
cGroupTagPart = 0;
|
||||
cGroupTagOnly = 0;
|
||||
cGroupTagClose = 0;
|
||||
cGroupAttr = 1;
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
S: atString;
|
||||
N: integer;
|
||||
begin
|
||||
STag:= '';
|
||||
SAttr:= '';
|
||||
AMode:= acpModeNone;
|
||||
|
||||
//str before caret
|
||||
Caret:= Ed.Carets[0];
|
||||
S:= Ed.Strings.Lines[Caret.PosY];
|
||||
S:= Copy(S, 1, Caret.PosX);
|
||||
if S='' then Exit;
|
||||
|
||||
//cut string before last "<" or ">" char
|
||||
N:= Length(S);
|
||||
while (N>0) and (S[N]<>'<') and (S[N]<>'>') do Dec(N);
|
||||
if N=0 then Exit;
|
||||
Delete(S, 1, N);
|
||||
|
||||
STag:= SFindRegex(S, cRegexTagClose, cGroupTagClose);
|
||||
if STag<>'' then
|
||||
begin AMode:= acpModeTagsClose; exit end;
|
||||
|
||||
STag:= SFindRegex(S, cRegexTagOnly, cGroupTagOnly);
|
||||
if STag<>'' then
|
||||
begin AMode:= acpModeTags; exit end;
|
||||
|
||||
STag:= SFindRegex(S, cRegexTagPart, cGroupTagPart);
|
||||
if STag<>'' then
|
||||
begin
|
||||
SAttr:= SFindRegex(S, cRegexAttr, cGroupAttr);
|
||||
if SAttr<>'' then
|
||||
AMode:= acpModeVals
|
||||
else
|
||||
AMode:= acpModeAttrs;
|
||||
end
|
||||
else
|
||||
AMode:= acpModeTags;
|
||||
end;
|
||||
|
||||
function EditorHasCssAtCaret(Ed: TATSynEdit): boolean;
|
||||
var
|
||||
STag, SAttr: string;
|
||||
Mode: TCompleteHtmlMode;
|
||||
begin
|
||||
EditorGetHtmlTag(Ed, STag, SAttr, Mode);
|
||||
Result:= (Mode=acpModeVals) and (LowerCase(SAttr)='style');
|
||||
end;
|
||||
|
||||
|
||||
procedure TAcp.DoOnGetCompleteProp(Sender: TObject; out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
const
|
||||
cWordChars = '-';
|
||||
var
|
||||
mode: TCompleteHtmlMode;
|
||||
s_word: atString;
|
||||
s_tag, s_attr, s_item, s_subitem, s_value: string;
|
||||
i: integer;
|
||||
ok: boolean;
|
||||
begin
|
||||
AText:= '';
|
||||
ASuffix:= '';
|
||||
ACharsLeft:= 0;
|
||||
ACharsRight:= 0;
|
||||
|
||||
EditorGetHtmlTag(Ed, s_tag, s_attr, mode);
|
||||
EditorGetCurrentWord(Ed, cWordChars, s_word, ACharsLeft, ACharsRight);
|
||||
|
||||
case mode of
|
||||
acpModeTags,
|
||||
acpModeTagsClose:
|
||||
begin
|
||||
if mode=acpModeTagsClose then
|
||||
ASuffix:= '>'
|
||||
else
|
||||
ASuffix:= ' ';
|
||||
|
||||
for i:= 0 to List.Count-1 do
|
||||
begin
|
||||
s_item:= List.Names[i];
|
||||
|
||||
//filter items
|
||||
if s_word<>'' then
|
||||
begin
|
||||
ok:= SBeginsWith(UpperCase(s_item), UpperCase(s_word));
|
||||
if not ok then Continue;
|
||||
end;
|
||||
AText:= AText+'tag|'+s_item+#13;
|
||||
end;
|
||||
end;
|
||||
|
||||
acpModeAttrs:
|
||||
begin
|
||||
ASuffix:='=';
|
||||
s_item:= List.Values[s_tag];
|
||||
if s_item='' then exit;
|
||||
repeat
|
||||
s_subitem:= SGetItem(s_item, '|');
|
||||
if s_subitem='' then Break;
|
||||
s_subitem:= SGetItem(s_subitem, '<');
|
||||
|
||||
//filter items
|
||||
if s_word<>'' then
|
||||
begin
|
||||
ok:= SBeginsWith(UpperCase(s_subitem), UpperCase(s_word));
|
||||
if not ok then Continue;
|
||||
end;
|
||||
AText:= AText+s_tag+' attrib|'+s_subitem+#13;
|
||||
until false;
|
||||
end;
|
||||
|
||||
acpModeVals:
|
||||
begin
|
||||
ASuffix:=' ';
|
||||
s_item:= List.Values[s_tag];
|
||||
if s_item='' then exit;
|
||||
repeat
|
||||
s_subitem:= SGetItem(s_item, '|');
|
||||
if s_subitem='' then Break;
|
||||
if SGetItem(s_subitem, '<')<>s_attr then Continue;
|
||||
repeat
|
||||
s_value:= SGetItem(s_subitem, '?');
|
||||
if s_value='' then Break;
|
||||
AText:= AText+s_attr+' value|"'+s_value+'"'+#13;
|
||||
until false;
|
||||
until false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TAcp.Create;
|
||||
begin
|
||||
inherited;
|
||||
List:= TStringlist.create;
|
||||
end;
|
||||
|
||||
destructor TAcp.Destroy;
|
||||
begin
|
||||
FreeAndNil(List);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure DoEditorCompletionHtml(AEdit: TATSynEdit;
|
||||
const AFilenameHtmlList: string);
|
||||
begin
|
||||
Acp.Ed:= AEdit;
|
||||
|
||||
//load file only once
|
||||
if Acp.List.Count=0 then
|
||||
begin
|
||||
if not FileExists(AFilenameHtmlList) then exit;
|
||||
Acp.List.LoadFromFile(AFilenameHtmlList);
|
||||
end;
|
||||
|
||||
DoEditorCompletionListbox(AEdit, @Acp.DoOnGetCompleteProp);
|
||||
end;
|
||||
|
||||
initialization
|
||||
Acp:= TAcp.Create;
|
||||
|
||||
cCompleteFontStyles[0]:= [];
|
||||
cCompleteColorFont[0]:= clPurple;
|
||||
cCompleteColorFont[1]:= clBlack;
|
||||
|
||||
finalization
|
||||
FreeAndNil(Acp);
|
||||
|
||||
end.
|
||||
|
||||
237
ATSynEdit/atsynedit/atsynedit_form_complete_synwrite.pas
Normal file
237
ATSynEdit/atsynedit/atsynedit_form_complete_synwrite.pas
Normal file
@@ -0,0 +1,237 @@
|
||||
unit atsynedit_form_complete_synwrite;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StrUtils, Graphics,
|
||||
Dialogs,
|
||||
ATSynEdit;
|
||||
|
||||
procedure DoEditorCompletionAcp(AEdit: TATSynEdit;
|
||||
const AFilenameAcp: string; ACaseSens, AIsPascal: boolean);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ATStringProc,
|
||||
ATSynEdit_form_complete;
|
||||
|
||||
type
|
||||
{ TAcp }
|
||||
|
||||
TAcp = class
|
||||
private
|
||||
ListAcpType: TStringlist;
|
||||
ListAcpText: TStringlist;
|
||||
ListAcpDesc: TStringlist;
|
||||
FWordChars: string;
|
||||
procedure DoLoadAcpFile(const fn: string; IsPascal: boolean);
|
||||
procedure DoOnGetCompleteProp(Sender: TObject;
|
||||
out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
public
|
||||
Ed: TATSynEdit;
|
||||
CaseSens: boolean;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
Acp: TAcp = nil;
|
||||
|
||||
//parse control string from .acp file (starts with #)
|
||||
procedure SParseString_AcpControlLine(const s: string;
|
||||
var WordChars: string;
|
||||
var IsBracketSep: boolean);
|
||||
var
|
||||
n: Integer;
|
||||
begin
|
||||
if SBeginsWith(s, '#chars') then
|
||||
begin
|
||||
WordChars:= '';
|
||||
IsBracketSep:= true;
|
||||
n:= Pos(' ', s);
|
||||
if n>0 then
|
||||
begin
|
||||
WordChars:= Copy(s, n+1, MaxInt);
|
||||
IsBracketSep:= Pos('(', WordChars)=0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
//parse string from .acp file
|
||||
procedure SParseString_AcpStd(
|
||||
const S: string;
|
||||
IsBracketSep: boolean;
|
||||
out SType, SId, SPar, SHint: string);
|
||||
const
|
||||
cMaxHintLen = 300;
|
||||
var
|
||||
a, b, c: Integer;
|
||||
begin
|
||||
SType:= '';
|
||||
SId:= '';
|
||||
SPar:= '';
|
||||
SHint:= '';
|
||||
if Trim(s)='' then Exit;
|
||||
|
||||
a:= PosEx(' ', s, 1);
|
||||
b:= PosEx(' ', s, a+1);
|
||||
if b=0 then
|
||||
b:= Length(s)+1;
|
||||
|
||||
if IsBracketSep then
|
||||
begin
|
||||
c:= PosEx('(', s, a+1);
|
||||
if (c<b) and (c<>0) then
|
||||
b:= c;
|
||||
end;
|
||||
|
||||
c:= PosEx('|', s, b);
|
||||
if c=0 then
|
||||
c:= MaxInt div 2;
|
||||
|
||||
SType:= Copy(s, 1, a-1);
|
||||
SId:= Copy(s, a+1, b-a-1);
|
||||
SPar:= Copy(s, b, c-b);
|
||||
SHint:= Copy(s, c+1, cMaxHintLen);
|
||||
|
||||
SReplaceAllPercentChars(SId);
|
||||
SReplaceAllPercentChars(SPar);
|
||||
|
||||
SReplaceAll(SPar, ';', ','); //Pascal lexer has ";" param separator
|
||||
SReplaceAll(SPar, '[,', ',['); //for optional params
|
||||
end;
|
||||
|
||||
|
||||
procedure TAcp.DoLoadAcpFile(const fn: string; IsPascal: boolean);
|
||||
var
|
||||
List: TStringList;
|
||||
s, SType, SText, SPar, SHint: string;
|
||||
IsBracketSep: boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
ListAcpType.Clear;
|
||||
ListAcpText.Clear;
|
||||
ListAcpDesc.Clear;
|
||||
|
||||
FWordChars:= '';
|
||||
IsBracketSep:= true;
|
||||
|
||||
List:= TStringList.Create;
|
||||
try
|
||||
List.LoadFromFile(fn);
|
||||
for i:= 0 to List.Count-1 do
|
||||
begin
|
||||
s:= List[i];
|
||||
if s='' then
|
||||
Continue;
|
||||
|
||||
if s[1]='#' then
|
||||
begin
|
||||
SParseString_AcpControlLine(s, FWordChars, IsBracketSep);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
SParseString_AcpStd(s, IsBracketSep, SType, SText, SPar, SHint);
|
||||
if SText<>'' then
|
||||
begin
|
||||
if IsPascal then
|
||||
begin
|
||||
SDeleteFrom(SText, ':');
|
||||
if Pos('):', SPar)>0 then
|
||||
begin
|
||||
SDeleteFrom(SPar, '):');
|
||||
SPar:= SPar+')';
|
||||
end;
|
||||
end;
|
||||
|
||||
ListAcpType.Add(SType);
|
||||
ListAcpText.Add(SText);
|
||||
ListAcpDesc.Add(SPar+cCompleteHintChar+SHint);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(List);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TAcp.DoOnGetCompleteProp(Sender: TObject; out AText, ASuffix: string;
|
||||
out ACharsLeft, ACharsRight: integer);
|
||||
var
|
||||
s_word_w: atString;
|
||||
s_type, s_text, s_desc, s_word: string;
|
||||
n: integer;
|
||||
ok: boolean;
|
||||
begin
|
||||
AText:= '';
|
||||
ASuffix:= '';
|
||||
ACharsLeft:= 0;
|
||||
ACharsRight:= 0;
|
||||
EditorGetCurrentWord(Ed, FWordChars, s_word_w, ACharsLeft, ACharsRight);
|
||||
s_word:= Utf8Encode(s_word_w);
|
||||
|
||||
for n:= 0 to ListAcpText.Count-1 do
|
||||
begin
|
||||
s_type:= ListAcpType[n];
|
||||
s_text:= ListAcpText[n];
|
||||
s_desc:= ListAcpDesc[n];
|
||||
|
||||
if s_word<>'' then
|
||||
begin
|
||||
if CaseSens then
|
||||
ok:= SBeginsWith(s_text, s_word)
|
||||
else
|
||||
ok:= SBeginsWith(UpperCase(s_text), UpperCase(s_word));
|
||||
if not ok then Continue;
|
||||
end;
|
||||
|
||||
AText:= AText+s_type+'|'+s_text+'|'+s_desc+#13;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TAcp.Create;
|
||||
begin
|
||||
inherited;
|
||||
ListAcpType:= TStringlist.create;
|
||||
ListAcpText:= TStringlist.create;
|
||||
ListAcpDesc:= TStringlist.create;
|
||||
end;
|
||||
|
||||
destructor TAcp.Destroy;
|
||||
begin
|
||||
FreeAndNil(ListAcpType);
|
||||
FreeAndNil(ListAcpText);
|
||||
FreeAndNil(ListAcpDesc);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure DoEditorCompletionAcp(AEdit: TATSynEdit;
|
||||
const AFilenameAcp: string; ACaseSens, AIsPascal: boolean);
|
||||
begin
|
||||
if not FileExists(AFilenameAcp) then exit;
|
||||
Acp.DoLoadAcpFile(AFilenameAcp, AIsPascal);
|
||||
Acp.Ed:= AEdit;
|
||||
Acp.CaseSens:= ACaseSens;
|
||||
DoEditorCompletionListbox(AEdit, @Acp.DoOnGetCompleteProp);
|
||||
end;
|
||||
|
||||
initialization
|
||||
Acp:= TAcp.Create;
|
||||
|
||||
cCompleteFontStyles[0]:= [];
|
||||
cCompleteColorFont[0]:= clPurple;
|
||||
cCompleteColorFont[1]:= clBlack;
|
||||
cCompleteColorFont[2]:= clGray;
|
||||
cCompleteColorFont[3]:= clGreen;
|
||||
|
||||
finalization
|
||||
FreeAndNil(Acp);
|
||||
|
||||
end.
|
||||
|
||||
141
ATSynEdit/atsynedit/atsynedit_gutter.pas
Normal file
141
ATSynEdit/atsynedit/atsynedit_gutter.pas
Normal file
@@ -0,0 +1,141 @@
|
||||
unit ATSynEdit_Gutter;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TATGutterItem = class
|
||||
Visible: boolean;
|
||||
Size: integer;
|
||||
Left, Right: integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TATGutter = class
|
||||
private
|
||||
FList: TList;
|
||||
function GetItem(N: Integer): TATGutterItem;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
procedure Add(ASize: integer);
|
||||
procedure Delete(N: integer);
|
||||
procedure Clear;
|
||||
function Count: integer;
|
||||
property Items[N: integer]: TATGutterItem read GetItem; default;
|
||||
function Width: integer;
|
||||
procedure Update;
|
||||
function IndexAt(AX: integer): integer;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TATGutter }
|
||||
|
||||
function TATGutter.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<FList.Count);
|
||||
end;
|
||||
|
||||
function TATGutter.GetItem(N: Integer): TATGutterItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
Result:= TATGutterItem(FList[N])
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
constructor TATGutter.Create;
|
||||
begin
|
||||
inherited;
|
||||
FList:= TList.Create;
|
||||
end;
|
||||
|
||||
destructor TATGutter.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TATGutter.Add(ASize: integer);
|
||||
var
|
||||
Item: TATGutterItem;
|
||||
begin
|
||||
Item:= TATGutterItem.Create;
|
||||
Item.Size:= ASize;
|
||||
Item.Visible:= true;
|
||||
FList.Add(Item);
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TATGutter.Delete(N: integer);
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
begin
|
||||
TObject(FList[N]).Free;
|
||||
FList.Delete(N);
|
||||
end;
|
||||
Update;
|
||||
end;
|
||||
|
||||
procedure TATGutter.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Count-1 downto 0 do
|
||||
Delete(i);
|
||||
end;
|
||||
|
||||
function TATGutter.Count: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATGutter.Width: integer;
|
||||
begin
|
||||
if Count>0 then
|
||||
Result:= Items[Count-1].Right
|
||||
else
|
||||
Result:= 0;
|
||||
end;
|
||||
|
||||
procedure TATGutter.Update;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= 0 to Count-1 do
|
||||
with Items[i] do
|
||||
begin
|
||||
if i>0 then
|
||||
Left:= Items[i-1].Right
|
||||
else
|
||||
Left:= 0;
|
||||
Right:= Left;
|
||||
if Visible then
|
||||
Inc(Right, Size);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATGutter.IndexAt(AX: integer): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
for i:= 0 to Count-1 do
|
||||
with Items[i] do
|
||||
if (AX>=Left) and (AX<Right) then
|
||||
begin
|
||||
Result:= i;
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
239
ATSynEdit/atsynedit/atsynedit_hilite.inc
Normal file
239
ATSynEdit/atsynedit/atsynedit_hilite.inc
Normal file
@@ -0,0 +1,239 @@
|
||||
{$ifdef nnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.DoCalcLineHiliteEx(ALineIndex: integer;
|
||||
var AParts: TATLineParts;
|
||||
AColorBG: TColor; out AColorAfter: TColor): boolean;
|
||||
const
|
||||
cMaxCharsInLine = 50*1024;
|
||||
var
|
||||
WrapItem: TATSynWrapItem;
|
||||
Str: atString;
|
||||
begin
|
||||
Result:= Strings.IsIndexValid(ALineIndex);
|
||||
if not Result then exit;
|
||||
FillChar(AParts, SizeOf(AParts), 0);
|
||||
|
||||
Str:= Strings.Lines[ALineIndex];
|
||||
if Str='' then exit;
|
||||
|
||||
WrapItem:= TATSynWrapItem.Create(ALineIndex, 1, Length(Str), 0, cWrapItemFinal);
|
||||
try
|
||||
AColorAfter:= AColorBG;
|
||||
DoCalcLineHilite(WrapItem, AParts, 0, cMaxCharsInLine,
|
||||
AColorBG, false, AColorAfter);
|
||||
finally
|
||||
FreeAndNil(WrapItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCalcLineHilite(const AItem: TATSynWrapItem;
|
||||
var AParts: TATLineParts; ACharsSkipped, ACharsMax: integer;
|
||||
AColorBG: TColor; AColorForced: boolean; var AColorAfter: TColor);
|
||||
var
|
||||
nMaxOffset, nCharIndex, nLineIndex, nLineLen: integer;
|
||||
begin
|
||||
nMaxOffset:= Min(ACharsMax, AItem.NLength-ACharsSkipped);
|
||||
nLineIndex:= AItem.NLineIndex;
|
||||
nLineLen:= AItem.NLength;
|
||||
nCharIndex:= AItem.NCharIndex+ACharsSkipped;
|
||||
|
||||
FillChar(AParts, SizeOf(AParts), 0);
|
||||
if Assigned(FAdapterHilite) then
|
||||
FAdapterHilite.OnEditorCalcHilite(Self, AParts, nLineIndex, nCharIndex, nLineLen, AColorAfter);
|
||||
if Assigned(FOnCalcHilite) then
|
||||
FOnCalcHilite(Self, AParts, nLineIndex, nCharIndex, nLineLen, AColorAfter);
|
||||
|
||||
DoPartSetColorBG(AParts, AColorBG, AColorForced);
|
||||
if AColorForced then
|
||||
AColorAfter:= AColorBG;
|
||||
|
||||
//first add Attribs,
|
||||
//selection must be over attribs
|
||||
DoPartCalc_ApplyAttribsOver(AParts, nMaxOffset, nLineIndex, nCharIndex-1);
|
||||
|
||||
//Createnew makes parts for selection and fills empty AParts with these parts.
|
||||
//Applyover makes parts for selection and inserts these one-by-one over ready AParts
|
||||
//calculated before (in adapter or OnCalc event).
|
||||
//Maybe possible to always use Applyover but it's slower so i made Createnew for
|
||||
//faster render w/out adapter
|
||||
if AParts[0].Len>0 then
|
||||
begin
|
||||
DoPartCalc_ApplyOver(AParts, nMaxOffset, nLineIndex, nCharIndex-1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
DoPartCalc_CreateNew(AParts, nMaxOffset, nLineIndex, nCharIndex-1, AColorBG);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoPartCalc_CreateNew(var AParts: TATLineParts;
|
||||
AOffsetMax, ALineIndex, ACharIndex: integer; AColorBG: TColor);
|
||||
var
|
||||
bSel, bSelPrev, bAdd: boolean;
|
||||
nIndex, i: integer;
|
||||
begin
|
||||
bSel:= false;
|
||||
bSelPrev:= false;
|
||||
nIndex:= -1;
|
||||
|
||||
for i:= 0 to AOffsetMax do
|
||||
begin
|
||||
bSel:= IsPosSelected(ACharIndex+i, ALineIndex);
|
||||
|
||||
if nIndex<0 then
|
||||
bAdd:= true
|
||||
else
|
||||
bAdd:= bSel<>bSelPrev;
|
||||
bSelPrev:= bSel;
|
||||
|
||||
if not bAdd then
|
||||
begin
|
||||
Inc(AParts[nIndex].Len);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(nIndex);
|
||||
if nIndex>=High(AParts) then Break;
|
||||
with AParts[nIndex] do
|
||||
begin
|
||||
Offset:= i;
|
||||
Len:= 1;
|
||||
if bSel then
|
||||
begin
|
||||
ColorFont:= FColors.TextSelFont;//random($ffff);
|
||||
ColorBG:= FColors.TextSelBG;
|
||||
end
|
||||
else
|
||||
begin
|
||||
ColorFont:= GetColorTextFont;//random($ffff);
|
||||
ColorBG:= AColorBG;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoPartCalc_ApplyOver(var AParts: TATLineParts; AOffsetMax,
|
||||
ALineIndex, ACharIndex: integer);
|
||||
var
|
||||
bSel, bSelPrev: boolean;
|
||||
Part: TATLinePart;
|
||||
i: integer;
|
||||
begin
|
||||
FillChar(Part{%H-}, SizeOf(Part), 0);
|
||||
Part.ColorFont:= Colors.TextSelFont;
|
||||
Part.ColorBG:= Colors.TextSelBG;
|
||||
|
||||
bSel:= false;
|
||||
bSelPrev:= false;
|
||||
|
||||
for i:= 0 to AOffsetMax do
|
||||
begin
|
||||
bSel:= IsPosSelected(ACharIndex+i, ALineIndex);
|
||||
|
||||
if bSel and (i=AOffsetMax) then
|
||||
begin
|
||||
DoPartInsert(AParts, Part, true);
|
||||
Break
|
||||
end;
|
||||
|
||||
if bSel and bSelPrev then
|
||||
Inc(Part.Len)
|
||||
else
|
||||
if not bSelPrev and bSel then
|
||||
begin
|
||||
Part.Offset:= i;
|
||||
Part.Len:= 1;
|
||||
end
|
||||
else
|
||||
if bSelPrev and not bSel then
|
||||
begin
|
||||
DoPartInsert(AParts, Part, true);
|
||||
end;
|
||||
bSelPrev:= bSel;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoCalcPosColor(AX, AY: integer; var AColor: TColor);
|
||||
begin
|
||||
if Assigned(FAdapterHilite) then
|
||||
FAdapterHilite.OnEditorCalcPosColor(Self, AX, AY, AColor);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoCalcLineEntireColor(ALine: integer; ACoordTop: integer;
|
||||
ALineWithCaret: boolean; out AColor: TColor; out AColorForced: boolean);
|
||||
var
|
||||
BmKind: integer;
|
||||
begin
|
||||
AColor:= clNone;
|
||||
|
||||
BmKind:= Strings.LinesBm[ALine];
|
||||
if BmKind<>0 then
|
||||
begin
|
||||
AColor:= Colors.BookmarkBG;
|
||||
if Assigned(FOnCalcBookmarkColor) then
|
||||
FOnCalcBookmarkColor(Self, BmKind, AColor);
|
||||
end;
|
||||
|
||||
if FOptShowCurLine then
|
||||
begin
|
||||
if FOptShowCurLineMinimal then
|
||||
begin
|
||||
if ALineWithCaret and IsLinePartWithCaret(ALine, ACoordTop) then
|
||||
AColor:= Colors.CurrentLineBG;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if ALineWithCaret then
|
||||
AColor:= Colors.CurrentLineBG;
|
||||
end;
|
||||
end;
|
||||
|
||||
if FMarkedRange.Count=2 then
|
||||
if (ALine>=FMarkedRange.Items[0].PosY) and
|
||||
(ALine<=FMarkedRange.Items[1].PosY) then
|
||||
AColor:= Colors.MarkedLinesBG;
|
||||
|
||||
AColorForced:= AColor<>clNone;
|
||||
if not AColorForced then
|
||||
AColor:= GetColorTextBG;
|
||||
end;
|
||||
|
||||
|
||||
procedure TATSynEdit.DoPartCalc_ApplyAttribsOver(var AParts: TATLineParts;
|
||||
AOffsetMax, ALineIndex, ACharIndex: integer);
|
||||
var
|
||||
i: integer;
|
||||
Attr: TATMarkerItem;
|
||||
Part: TATLinePart;
|
||||
PartObj: TATLinePartClass;
|
||||
begin
|
||||
for i:= 0 to Attribs.Count-1 do
|
||||
begin
|
||||
Attr:= Attribs[i];
|
||||
PartObj:= TATLinePartClass(Attr.Ptr);
|
||||
if Assigned(PartObj) then
|
||||
if Attr.PosY=ALineIndex then
|
||||
begin
|
||||
//empty parts? init part for whole line, for DoPartInsert to work
|
||||
if AParts[0].Len=0 then
|
||||
begin
|
||||
AParts[0].Offset:= 0;
|
||||
AParts[0].Len:= AOffsetMax;
|
||||
AParts[0].ColorBG:= Colors.TextBG;
|
||||
AParts[0].ColorFont:= Colors.TextFont;
|
||||
end;
|
||||
|
||||
Part:= PartObj.Data;
|
||||
Part.Len:= Attr.SelLen;
|
||||
Part.Offset:= Attr.PosX-ACharIndex;
|
||||
DoPartInsert(AParts, Part, false);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
290
ATSynEdit/atsynedit/atsynedit_keymap.pas
Normal file
290
ATSynEdit/atsynedit/atsynedit_keymap.pas
Normal file
@@ -0,0 +1,290 @@
|
||||
unit ATSynEdit_Keymap;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
//{$define test_correct_keynames}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms;
|
||||
|
||||
const
|
||||
cMaxKeyCombo = 3; //3 must be enougth for everybody..
|
||||
|
||||
type
|
||||
TATKeyArray = array[0..Pred(cMaxKeyCombo)] of TShortcut;
|
||||
|
||||
function KeyArrayToString(const K: TATKeyArray): string;
|
||||
function KeyArraysEqualNotEmpty(const a1, a2: TATKeyArray): boolean;
|
||||
function KeyArrayLength(const K: TATKeyArray): integer;
|
||||
|
||||
type
|
||||
{ TATKeymapItem }
|
||||
|
||||
TATKeymapItem = class
|
||||
public
|
||||
Command: integer;
|
||||
Name: string;
|
||||
Keys1,
|
||||
Keys2: TATKeyArray;
|
||||
end;
|
||||
|
||||
type
|
||||
{ TATKeymap }
|
||||
|
||||
TATKeymap = class
|
||||
private
|
||||
FList: TList;
|
||||
FHistory: TATKeyArray;
|
||||
function GetItem(N: integer): TATKeymapItem;
|
||||
procedure ClearHistory;
|
||||
procedure AddToHistory(sh: TShortcut);
|
||||
function IsMatchedKeys(const AKeys: TATKeyArray; AKey: TShortcut;
|
||||
AAllowOneKey: boolean): boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function Count: integer;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
property Items[N: integer]: TATKeymapItem read GetItem; default;
|
||||
procedure Add(ACmd: integer; const AName: string; const AKeys1, AKeys2: array of string);
|
||||
procedure Delete(N: integer);
|
||||
function IndexOf(ACmd: integer): integer;
|
||||
function GetShortcutFromCommand(ACode: integer): TShortcut;
|
||||
function GetCommandFromShortcut(AKey: TShortcut): integer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math,
|
||||
LCLProc,
|
||||
Dialogs;
|
||||
|
||||
function KeyArrayLength(const K: TATKeyArray): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= 0;
|
||||
for i:= Low(K) to High(K) do
|
||||
if K[i]<>0 then
|
||||
Inc(Result);
|
||||
end;
|
||||
|
||||
{ TATKeymap }
|
||||
|
||||
constructor TATKeymap.Create;
|
||||
begin
|
||||
FList:= TList.Create;
|
||||
ClearHistory;
|
||||
end;
|
||||
|
||||
destructor TATKeymap.Destroy;
|
||||
begin
|
||||
ClearHistory;
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TATKeymap.GetItem(N: integer): TATKeymapItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
Result:= TATKeymapItem(FList[N])
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
procedure TATKeymap.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= FList.Count-1 downto 0 do
|
||||
TObject(FList[i]).Free;
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
function TATKeymap.Count: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATKeymap.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<FList.Count);
|
||||
end;
|
||||
|
||||
function _TextToShortcut(const S: string): TShortcut;
|
||||
begin
|
||||
Result:= TextToShortCut(S);
|
||||
{$ifdef test_correct_keynames}
|
||||
if Result=0 then
|
||||
Showmessage('Incorrect key in keymap: "'+S+'"');
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TATKeymap.Add(ACmd: integer; const AName: string; const AKeys1,
|
||||
AKeys2: array of string);
|
||||
var
|
||||
Item: TATKeymapItem;
|
||||
i: integer;
|
||||
begin
|
||||
Item:= TATKeymapItem.Create;
|
||||
Item.Command:= ACmd;
|
||||
Item.Name:= AName;
|
||||
|
||||
FillChar(Item.Keys1, Sizeof(Item.Keys1), 0);
|
||||
FillChar(Item.Keys2, Sizeof(Item.Keys2), 0);
|
||||
|
||||
for i:= 0 to Min(High(AKeys1), High(Item.Keys1)) do Item.Keys1[i]:= _TextToShortcut(AKeys1[i]);
|
||||
for i:= 0 to Min(High(AKeys2), High(Item.Keys2)) do Item.Keys2[i]:= _TextToShortcut(AKeys2[i]);
|
||||
|
||||
FList.Add(Item);
|
||||
end;
|
||||
|
||||
procedure TATKeymap.Delete(N: integer);
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
FList.Delete(N);
|
||||
end;
|
||||
|
||||
function TATKeymap.IndexOf(ACmd: integer): integer;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= -1;
|
||||
for i:= 0 to Count-1 do
|
||||
if Items[i].Command=ACmd then
|
||||
begin Result:= i; Exit end;
|
||||
end;
|
||||
|
||||
function TATKeymap.GetShortcutFromCommand(ACode: integer): TShortcut;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= scNone;
|
||||
for i:= 0 to Count-1 do
|
||||
if Items[i].Command=ACode then
|
||||
begin
|
||||
Result:= Items[i].Keys1[0];
|
||||
Exit
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATKeymap.GetCommandFromShortcut(AKey: TShortcut): integer;
|
||||
var
|
||||
bCheckSingle: boolean;
|
||||
i: integer;
|
||||
begin
|
||||
Result:= 0;
|
||||
|
||||
//first check combos, then check single-keys
|
||||
for bCheckSingle:= false to true do
|
||||
for i:= 0 to Count-1 do
|
||||
if IsMatchedKeys(Items[i].Keys1, AKey, bCheckSingle) or
|
||||
IsMatchedKeys(Items[i].Keys2, AKey, bCheckSingle) then
|
||||
begin
|
||||
Result:= Items[i].Command;
|
||||
ClearHistory;
|
||||
Exit
|
||||
end;
|
||||
|
||||
if AKey>0 then
|
||||
AddToHistory(AKey);
|
||||
end;
|
||||
|
||||
function TATKeymap.IsMatchedKeys(const AKeys: TATKeyArray; AKey: TShortcut;
|
||||
AAllowOneKey: boolean): boolean;
|
||||
//function called first for all items with Allow=false (for combos)
|
||||
//if not found, called for all items with Allow=true (for single keys)
|
||||
var
|
||||
LenThis, LenStack, IndexStack, i: integer;
|
||||
begin
|
||||
Result:= false;
|
||||
|
||||
LenThis:= KeyArrayLength(AKeys);
|
||||
if LenThis=0 then Exit;
|
||||
|
||||
if LenThis=1 then
|
||||
begin
|
||||
Result:= AAllowOneKey and (AKeys[0]=AKey);
|
||||
Exit
|
||||
end;
|
||||
|
||||
//AKey is last in combo AKeys?
|
||||
if AKeys[LenThis-1]<>AKey then Exit;
|
||||
|
||||
//stack filled?
|
||||
LenStack:= KeyArrayLength(FHistory);
|
||||
if LenStack<LenThis-1 then
|
||||
begin
|
||||
//showmessage('no match: if lenstack');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
//first keys (except last) of combo lie in stack?
|
||||
for i:= LenThis-2 downto 0 do
|
||||
begin
|
||||
IndexStack:= LenStack-1-(LenThis-2-i);
|
||||
if (IndexStack>=Low(FHistory)) and (IndexStack<=High(FHistory)) then
|
||||
if AKeys[i]<>FHistory[IndexStack] then
|
||||
begin
|
||||
//showmessage('no match: check items');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:= true;
|
||||
end;
|
||||
|
||||
procedure TATKeymap.ClearHistory;
|
||||
begin
|
||||
FillChar(FHistory, Sizeof(FHistory), 0);
|
||||
end;
|
||||
|
||||
procedure TATKeymap.AddToHistory(sh: TShortcut);
|
||||
var
|
||||
len: integer;
|
||||
begin
|
||||
len:= KeyArrayLength(FHistory);
|
||||
if len>=Length(FHistory) then
|
||||
begin
|
||||
ClearHistory;
|
||||
len:= KeyArrayLength(FHistory);
|
||||
end;
|
||||
FHistory[len]:= sh;
|
||||
end;
|
||||
|
||||
|
||||
function KeyArrayToString(const K: TATKeyArray): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
result:= '';
|
||||
for i:= Low(K) to High(K) do
|
||||
if K[i]<>0 then
|
||||
begin
|
||||
if result<>'' then
|
||||
result:= result+' * ';
|
||||
result:= result+ShortcutToText(K[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function KeyArraysEqualNotEmpty(const a1, a2: TATKeyArray): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= true;
|
||||
|
||||
if a1[0]=0 then Exit(false);
|
||||
if a2[0]=0 then Exit(false);
|
||||
|
||||
for i:= Low(a1) to High(a1) do
|
||||
if a1[i]<>a2[i] then Exit(false);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
233
ATSynEdit/atsynedit/atsynedit_keymap_init.pas
Normal file
233
ATSynEdit/atsynedit/atsynedit_keymap_init.pas
Normal file
@@ -0,0 +1,233 @@
|
||||
unit ATSynEdit_Keymap_Init;
|
||||
|
||||
//{$define test_combo}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ATSynEdit_Keymap,
|
||||
ATSynEdit_Commands;
|
||||
|
||||
procedure InitKeymapFull(var M: TATKeymap);
|
||||
procedure InitKeymapCombo(var M: TATKeymap);
|
||||
|
||||
var
|
||||
KeymapFull: TATKeymap = nil;
|
||||
KeymapCombo: TATKeymap = nil;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
LCLProc,
|
||||
Dialogs;
|
||||
|
||||
const
|
||||
//Mac: instead of Ctrl use Command-key
|
||||
cXControl = {$ifdef darwin} 'Meta' {$else} 'Ctrl' {$endif};
|
||||
|
||||
|
||||
procedure InitKeymapFull(var M: TATKeymap);
|
||||
begin
|
||||
M.Clear;
|
||||
|
||||
M.Add(cCommand_KeyLeft, 'caret char left', ['Left'], []);
|
||||
M.Add(cCommand_KeyLeft_Sel, 'caret char left + select', ['Shift+Left'], []);
|
||||
M.Add(cCommand_KeyRight, 'caret char right', ['Right'], []);
|
||||
M.Add(cCommand_KeyRight_Sel, 'caret char right + select', ['Shift+Right'], []);
|
||||
M.Add(cCommand_KeyUp, 'caret line up', ['Up'], []);
|
||||
M.Add(cCommand_KeyUp_Sel, 'caret line up + select', ['Shift+Up'], []);
|
||||
M.Add(cCommand_KeyDown, 'caret line down', ['Down'], []);
|
||||
M.Add(cCommand_KeyDown_Sel, 'caret line down + select', ['Shift+Down'], []);
|
||||
M.Add(cCommand_KeyHome, 'caret to line start', ['Home'], []);
|
||||
M.Add(cCommand_KeyHome_Sel, 'caret to line start + select', ['Shift+Home'], []);
|
||||
M.Add(cCommand_KeyEnd, 'caret to line end', ['End'], []);
|
||||
M.Add(cCommand_KeyEnd_Sel, 'caret to line end + select', ['Shift+End'], []);
|
||||
M.Add(cCommand_KeyPageUp, 'caret page up', ['PgUp'], []);
|
||||
M.Add(cCommand_KeyPageUp_Sel, 'caret page up + select', ['Shift+PgUp'], []);
|
||||
M.Add(cCommand_KeyPageDown, 'caret page down', ['PgDn'], []);
|
||||
M.Add(cCommand_KeyPageDown_Sel, 'caret page down + select', ['Shift+PgDn'], []);
|
||||
|
||||
M.Add(cCommand_ColSelectLeft, 'column select: left', ['Shift+Alt+Left'], []);
|
||||
M.Add(cCommand_ColSelectRight, 'column select: right', ['Shift+Alt+Right'], []);
|
||||
M.Add(cCommand_ColSelectUp, 'column select: up', ['Shift+Alt+Up'], []);
|
||||
M.Add(cCommand_ColSelectDown, 'column select: down', ['Shift+Alt+Down'], []);
|
||||
M.Add(cCommand_ColSelectPageUp, 'column select: page up', ['Shift+Alt+PgUp'], []);
|
||||
M.Add(cCommand_ColSelectPageDown, 'column select: page down', ['Shift+Alt+PgDn'], []);
|
||||
M.Add(cCommand_ColSelectToLineBegin, 'column select: to line begin', ['Shift+Alt+Home'], []);
|
||||
M.Add(cCommand_ColSelectToLineEnd, 'column select: to line end', ['Shift+Alt+End'], []);
|
||||
|
||||
M.Add(cCommand_KeyBackspace, 'delete char left (backspace)', ['Bksp'], []);
|
||||
M.Add(cCommand_KeyDelete, 'delete char right (delete)', ['Del'], []);
|
||||
M.Add(cCommand_KeyEnter, 'insert line-break (enter)', ['Enter'], []);
|
||||
M.Add(cCommand_KeyTab, 'tabulation key', [], []);
|
||||
M.Add(cCommand_TextInsertTabChar, 'insert tab char', [], []);
|
||||
|
||||
M.Add(cCommand_TextDeleteLine, 'delete line', [cXControl+'+Y'], []);
|
||||
M.Add(cCommand_TextDuplicateLine, 'duplicate line', [cXControl+'+D'], []);
|
||||
|
||||
M.Add(cCommand_GotoTextBegin, 'goto text begin', [cXControl+'+Home'], []);
|
||||
M.Add(cCommand_GotoTextBegin_Sel, 'goto text begin + select', [cXControl+'+Shift+Home'], []);
|
||||
M.Add(cCommand_GotoTextEnd, 'goto text end', [cXControl+'+End'], []);
|
||||
M.Add(cCommand_GotoTextEnd_Sel, 'goto text end + select', [cXControl+'+Shift+End'], []);
|
||||
M.Add(cCommand_GotoWordPrev, 'goto word left', [cXControl+'+Left'], []);
|
||||
M.Add(cCommand_GotoWordPrev_Sel, 'goto word left + select', [cXControl+'+Shift+Left'], []);
|
||||
M.Add(cCommand_GotoWordNext, 'goto word right', [cXControl+'+Right'], []);
|
||||
M.Add(cCommand_GotoWordNext_Sel, 'goto word right + select', [cXControl+'+Shift+Right'], []);
|
||||
|
||||
M.Add(cCommand_SelectAll, 'selection: select all', [cXControl+'+A'], []);
|
||||
M.Add(cCommand_TextDeleteSelection, 'selection: delete selected text', [], []);
|
||||
M.Add(cCommand_SelectInverted, 'selection: invert selection', [], []);
|
||||
M.Add(cCommand_SelectSplitToLines, 'selection: split selection into lines', [], []);
|
||||
M.Add(cCommand_SelectExtendByLine, 'selection: extend selection by line', [cXControl+'+L'], []);
|
||||
M.Add(cCommand_SelectWords, 'selection: select words at carets', [], []);
|
||||
M.Add(cCommand_SelectLines, 'selection: select lines at carets', [], []);
|
||||
M.Add(cCommand_SelectNone, 'selection: cancel selection', [], []);
|
||||
M.Add(cCommand_Cancel, 'selection: cancel carets, selection, drag-drop', ['Esc'], []);
|
||||
|
||||
M.Add(cCommand_ToggleOverwrite, 'toggle insert/overwrite mode', ['Ins'], []);
|
||||
M.Add(cCommand_ToggleReadOnly, 'toggle read-only mode', ['Ctrl+Shift+R'], []);
|
||||
M.Add(cCommand_ToggleWordWrap, 'toggle word-wrap mode', [cXControl+'+U'], []);
|
||||
|
||||
M.Add(cCommand_ToggleUnprinted, 'toggle unprinted chars: enable all', [], []);
|
||||
M.Add(cCommand_ToggleUnprintedSpaces, 'toggle unprinted chars: spaces/tabs', [], []);
|
||||
M.Add(cCommand_ToggleUnprintedEnds, 'toggle unprinted chars: ends', [], []);
|
||||
M.Add(cCommand_ToggleUnprintedEndDetails, 'toggle unprinted chars: end details', [], []);
|
||||
|
||||
M.Add(cCommand_ToggleLineNums, 'toggle show line numbers', [], []);
|
||||
M.Add(cCommand_ToggleFolding, 'toggle show folding bar', [], []);
|
||||
M.Add(cCommand_ToggleRuler, 'toggle show ruler', [], []);
|
||||
M.Add(cCommand_ToggleMinimap, 'toggle show minimap', [], []);
|
||||
|
||||
M.Add(cCommand_TextDeleteWordPrev, 'delete word left', [cXControl+'+Bksp'], []);
|
||||
M.Add(cCommand_TextDeleteWordNext, 'delete word right', [cXControl+'+Del'], []);
|
||||
M.Add(cCommand_TextDeleteToLineBegin, 'delete to line start', [], []);
|
||||
M.Add(cCommand_TextDeleteToLineEnd, 'delete to line end', [cXControl+'+K'], []);
|
||||
M.Add(cCommand_TextDeleteToTextEnd, 'delete to text end', [], []);
|
||||
|
||||
M.Add(cCommand_TextIndent, 'indent selection', [cXControl+'+I'], []);
|
||||
M.Add(cCommand_TextUnindent, 'unindent selection', ['Shift+Tab'], []);
|
||||
|
||||
M.Add(cCommand_Undo, 'perform undo', [cXControl+'+Z'], []);
|
||||
M.Add(cCommand_Redo, 'perform redo', [cXControl+'+Shift+Z'], []);
|
||||
|
||||
M.Add(cCommand_ClipboardCopy, 'clipboard: copy', [cXControl+'+C'], [cXControl+'+Ins']);
|
||||
M.Add(cCommand_ClipboardCopyAdd, 'clipboard: copy/append', [], []);
|
||||
M.Add(cCommand_ClipboardCut, 'clipboard: cut', [cXControl+'+X'], ['Shift+Del']);
|
||||
M.Add(cCommand_ClipboardPaste, 'clipboard: paste', [cXControl+'+V'], ['Shift+Ins']);
|
||||
M.Add(cCommand_ClipboardPaste_Select, 'clipboard: paste, select', [], []);
|
||||
M.Add(cCommand_ClipboardPaste_KeepCaret, 'clipboard: paste, keep caret', [], []);
|
||||
M.Add(cCommand_ClipboardPaste_Column, 'clipboard: paste, force column block', [], []);
|
||||
M.Add(cCommand_ClipboardPaste_ColumnKeepCaret, 'clipboard: paste, force column block, keep caret', [], []);
|
||||
|
||||
M.Add(cCommand_ScrollLineUp, 'scroll line up', [cXControl+'+Up'], []);
|
||||
M.Add(cCommand_ScrollLineDown, 'scroll line down', [cXControl+'+Down'], []);
|
||||
M.Add(cCommand_ScrollToCaretTop, 'scroll to caret, top', [], []);
|
||||
M.Add(cCommand_ScrollToCaretBottom, 'scroll to caret, bottom', [], []);
|
||||
M.Add(cCommand_ScrollToCaretLeft, 'scroll to caret, left', [], []);
|
||||
M.Add(cCommand_ScrollToCaretRight, 'scroll to caret, right', [], []);
|
||||
|
||||
M.Add(cCommand_MoveSelectionUp, 'move selected lines up', ['Alt+Up'], []);
|
||||
M.Add(cCommand_MoveSelectionDown, 'move selected lines down', ['Alt+Down'], []);
|
||||
M.Add(cCommand_TextInsertEmptyAbove, 'insert empty line above', [], []);
|
||||
M.Add(cCommand_TextInsertEmptyBelow, 'insert empty line below', [], []);
|
||||
|
||||
M.Add(cCommand_CaretsExtendUpLine, 'carets extend: up a line', [], []);
|
||||
M.Add(cCommand_CaretsExtendUpPage, 'carets extend: up a page', [], []);
|
||||
M.Add(cCommand_CaretsExtendUpToTop, 'carets extend: up to top', [], []);
|
||||
M.Add(cCommand_CaretsExtendDownLine, 'carets extend: down a line', [], []);
|
||||
M.Add(cCommand_CaretsExtendDownPage, 'carets extend: down a page', [], []);
|
||||
M.Add(cCommand_CaretsExtendDownToEnd, 'carets extend: down to end', [], []);
|
||||
|
||||
{$ifdef test_combo}
|
||||
M.Add(cCommand_ZoomIn, 'zoom in', ['Ctrl+B', 'Ctrl+P'], []);
|
||||
M.Add(cCommand_ZoomOut, 'zoom out', ['Ctrl+B', 'Ctrl+B', 'Ctrl+M'], []);
|
||||
{$else}
|
||||
M.Add(cCommand_ZoomIn, 'zoom in', [], []);
|
||||
M.Add(cCommand_ZoomOut, 'zoom out', [], []);
|
||||
{$endif}
|
||||
|
||||
M.Add(cCommand_TextCaseLower, 'convert case: lower case', [], []);
|
||||
M.Add(cCommand_TextCaseUpper, 'convert case: upper case', [], []);
|
||||
M.Add(cCommand_TextCaseTitle, 'convert case: title case', [], []);
|
||||
M.Add(cCommand_TextCaseInvert, 'convert case: invert case', [], []);
|
||||
M.Add(cCommand_TextCaseSentence, 'convert case: sentence case', [], []);
|
||||
|
||||
M.Add(cCommand_TextTrimSpacesLeft, 'trim spaces: left', [], []);
|
||||
M.Add(cCommand_TextTrimSpacesRight, 'trim spaces: right', [], []);
|
||||
M.Add(cCommand_TextTrimSpacesAll, 'trim spaces: all', [], []);
|
||||
|
||||
M.Add(cCommand_RepeatTextCommand, 'repeat last text command', [], []);
|
||||
|
||||
M.Add(cCommand_FoldAll, 'folding: fold all', [], []);
|
||||
M.Add(cCommand_UnfoldAll, 'folding: unfold all', [], []);
|
||||
M.Add(cCommand_FoldLevel2, 'folding: fold level 2', [], []);
|
||||
M.Add(cCommand_FoldLevel3, 'folding: fold level 3', [], []);
|
||||
M.Add(cCommand_FoldLevel4, 'folding: fold level 4', [], []);
|
||||
M.Add(cCommand_FoldLevel5, 'folding: fold level 5', [], []);
|
||||
M.Add(cCommand_FoldLevel6, 'folding: fold level 6', [], []);
|
||||
M.Add(cCommand_FoldLevel7, 'folding: fold level 7', [], []);
|
||||
M.Add(cCommand_FoldLevel8, 'folding: fold level 8', [], []);
|
||||
M.Add(cCommand_FoldLevel9, 'folding: fold level 9', [], []);
|
||||
end;
|
||||
|
||||
procedure InitKeymapCombo(var M: TATKeymap);
|
||||
begin
|
||||
M.Clear;
|
||||
|
||||
M.Add(cCommand_KeyLeft, 'caret char left', ['Left'], []);
|
||||
M.Add(cCommand_KeyLeft_Sel, 'caret char left + select', ['Shift+Left'], []);
|
||||
M.Add(cCommand_KeyRight, 'caret char right', ['Right'], []);
|
||||
M.Add(cCommand_KeyRight_Sel, 'caret char right + select', ['Shift+Right'], []);
|
||||
M.Add(cCommand_KeyHome, 'caret to line start', ['Home'], []);
|
||||
M.Add(cCommand_KeyHome_Sel, 'caret to line start + select', ['Shift+Home'], []);
|
||||
M.Add(cCommand_KeyEnd, 'caret to line end', ['End'], []);
|
||||
M.Add(cCommand_KeyEnd_Sel, 'caret to line end + select', ['Shift+End'], []);
|
||||
|
||||
M.Add(cCommand_KeyBackspace, 'delete char left (backspace)', ['Bksp'], []);
|
||||
M.Add(cCommand_KeyDelete, 'delete char right (delete)', ['Del'], []);
|
||||
M.Add(cCommand_KeyEnter, 'insert line-break (enter)', ['Enter'], []);
|
||||
M.Add(cCommand_KeyTab, 'tabulation key', [], []);
|
||||
|
||||
M.Add(cCommand_GotoWordPrev, 'goto word left', [cXControl+'+Left'], []);
|
||||
M.Add(cCommand_GotoWordPrev_Sel, 'goto word left + select', [cXControl+'+Shift+Left'], []);
|
||||
M.Add(cCommand_GotoWordNext, 'goto word right', [cXControl+'+Right'], []);
|
||||
M.Add(cCommand_GotoWordNext_Sel, 'goto word right + select', [cXControl+'+Shift+Right'], []);
|
||||
|
||||
M.Add(cCommand_SelectAll, 'selection: select all', [cXControl+'+A'], []);
|
||||
M.Add(cCommand_TextDeleteSelection, 'selection: delete selected text', [], []);
|
||||
|
||||
M.Add(cCommand_ToggleOverwrite, 'toggle insert/overwrite mode', ['Ins'], []);
|
||||
|
||||
M.Add(cCommand_TextDeleteWordPrev, 'delete word left', [cXControl+'+Bksp'], []);
|
||||
M.Add(cCommand_TextDeleteWordNext, 'delete word right', [cXControl+'+Del'], []);
|
||||
|
||||
M.Add(cCommand_Undo, 'perform undo', [cXControl+'+Z'], []);
|
||||
M.Add(cCommand_Redo, 'perform redo', [cXControl+'+Shift+Z'], []);
|
||||
|
||||
M.Add(cCommand_ClipboardCopy, 'clipboard: copy', [cXControl+'+C'], [cXControl+'+Ins']);
|
||||
M.Add(cCommand_ClipboardCopyAdd, 'clipboard: copy/append', [], []);
|
||||
M.Add(cCommand_ClipboardCut, 'clipboard: cut', [cXControl+'+X'], ['Shift+Del']);
|
||||
M.Add(cCommand_ClipboardPaste, 'clipboard: paste', [cXControl+'+V'], ['Shift+Ins']);
|
||||
|
||||
M.Add(cCommand_ComboboxRecentsMenu, 'combobox: recent items menu', ['Alt+Down'], [cXControl+'+Down']);
|
||||
|
||||
M.Add(cCommand_KeyUp, 'blocked: caret line up', ['Up'], []);
|
||||
M.Add(cCommand_KeyDown, 'blocked: caret line down', ['Down'], []);
|
||||
M.Add(cCommand_KeyPageUp, 'blocked: caret page up', ['PgUp'], []);
|
||||
M.Add(cCommand_KeyPageDown, 'blocked: caret page down', ['PgDn'], []);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
KeymapFull:= TATKeymap.Create;
|
||||
KeymapCombo:= TATKeymap.Create;
|
||||
InitKeymapFull(KeymapFull);
|
||||
InitKeymapCombo(KeymapCombo);
|
||||
|
||||
finalization
|
||||
FreeAndNil(KeymapFull);
|
||||
FreeAndNil(KeymapCombo);
|
||||
|
||||
end.
|
||||
|
||||
120
ATSynEdit/atsynedit/atsynedit_markers.pas
Normal file
120
ATSynEdit/atsynedit/atsynedit_markers.pas
Normal file
@@ -0,0 +1,120 @@
|
||||
unit ATSynEdit_Markers;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TATMarkerItem = class
|
||||
public
|
||||
PosX, PosY: integer;
|
||||
CoordX, CoordY: integer; //screen coords
|
||||
Tag: integer;
|
||||
//used in CudaText: when "collect marker" runs, for all markers
|
||||
//with the same Tag>0 multi-carets placed
|
||||
SelLen: integer;
|
||||
//used in CudaText: when "collect marker" runs, caret will
|
||||
//be with selection of this len
|
||||
Ptr: TObject;
|
||||
//used in Attribs object of ATSynedit
|
||||
end;
|
||||
|
||||
type
|
||||
{ TATMarkers }
|
||||
|
||||
TATMarkers = class
|
||||
private
|
||||
FList: TList;
|
||||
function GetItem(N: integer): TATMarkerItem;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Delete(N: integer);
|
||||
function Count: integer;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
property Items[N: integer]: TATMarkerItem read GetItem; default;
|
||||
procedure Add(APosX, APosY: integer;
|
||||
ATag: integer=0; ASelLen: integer=0; APtr: TObject=nil);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TATMarkers }
|
||||
|
||||
constructor TATMarkers.Create;
|
||||
begin
|
||||
inherited;
|
||||
FList:= TList.Create;
|
||||
end;
|
||||
|
||||
destructor TATMarkers.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TATMarkers.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= FList.Count-1 downto 0 do
|
||||
Delete(i);
|
||||
end;
|
||||
|
||||
procedure TATMarkers.Delete(N: integer);
|
||||
var
|
||||
Mark: TATMarkerItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
begin
|
||||
Mark:= TATMarkerItem(FList[N]);
|
||||
if Assigned(Mark.Ptr) then
|
||||
Mark.Ptr.Free;
|
||||
Mark.Free;
|
||||
|
||||
FList.Delete(N);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATMarkers.Count: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATMarkers.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<FList.Count);
|
||||
end;
|
||||
|
||||
function TATMarkers.GetItem(N: integer): TATMarkerItem;
|
||||
begin
|
||||
if IsIndexValid(N) then
|
||||
Result:= TATMarkerItem(FList[N])
|
||||
else
|
||||
Result:= nil;
|
||||
end;
|
||||
|
||||
procedure TATMarkers.Add(APosX, APosY: integer; ATag: integer;
|
||||
ASelLen: integer; APtr: TObject);
|
||||
var
|
||||
Item: TATMarkerItem;
|
||||
begin
|
||||
Item:= TATMarkerItem.Create;
|
||||
Item.PosX:= APosX;
|
||||
Item.PosY:= APosY;
|
||||
Item.CoordX:= -1;
|
||||
Item.CoordY:= -1;
|
||||
Item.Tag:= ATag;
|
||||
Item.SelLen:= ASelLen;
|
||||
Item.Ptr:= APtr;
|
||||
|
||||
FList.Add(Item);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
116
ATSynEdit/atsynedit/atsynedit_package.lpk
Normal file
116
ATSynEdit/atsynedit/atsynedit_package.lpk
Normal file
@@ -0,0 +1,116 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="atsynedit_package"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value="Alexey Torgashin"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value=".;..\proc_lexer"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="ATSynEdit"/>
|
||||
<License Value="MPL 2.0"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="19">
|
||||
<Item1>
|
||||
<Filename Value="atsynedit_register.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="ATSynEdit_Register"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="atstringproc.pas"/>
|
||||
<UnitName Value="ATStringProc"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="atstringproc_textbuffer.pas"/>
|
||||
<UnitName Value="ATStringProc_TextBuffer"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="atstringproc_utf8detect.pas"/>
|
||||
<UnitName Value="atstringproc_utf8detect"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="atstringproc_wordjump.pas"/>
|
||||
<UnitName Value="ATStringProc_WordJump"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="atstrings.pas"/>
|
||||
<UnitName Value="ATStrings"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="atstrings_undo.pas"/>
|
||||
<UnitName Value="ATStrings_Undo"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="atsynedit.pas"/>
|
||||
<UnitName Value="ATSynEdit"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="atsynedit_adapters.pas"/>
|
||||
<UnitName Value="ATSynEdit_Adapters"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="atsynedit_canvasproc.pas"/>
|
||||
<UnitName Value="ATSynEdit_CanvasProc"/>
|
||||
</Item10>
|
||||
<Item11>
|
||||
<Filename Value="atsynedit_carets.pas"/>
|
||||
<UnitName Value="atsynedit_carets"/>
|
||||
</Item11>
|
||||
<Item12>
|
||||
<Filename Value="atsynedit_commands.pas"/>
|
||||
<UnitName Value="ATSynEdit_Commands"/>
|
||||
</Item12>
|
||||
<Item13>
|
||||
<Filename Value="atsynedit_edits.pas"/>
|
||||
<UnitName Value="ATSynEdit_Edits"/>
|
||||
</Item13>
|
||||
<Item14>
|
||||
<Filename Value="atsynedit_gutter.pas"/>
|
||||
<UnitName Value="ATSynEdit_Gutter"/>
|
||||
</Item14>
|
||||
<Item15>
|
||||
<Filename Value="atsynedit_keymap.pas"/>
|
||||
<UnitName Value="ATSynEdit_Keymap"/>
|
||||
</Item15>
|
||||
<Item16>
|
||||
<Filename Value="atsynedit_keymap_init.pas"/>
|
||||
<UnitName Value="ATSynEdit_Keymap_Init"/>
|
||||
</Item16>
|
||||
<Item17>
|
||||
<Filename Value="atsynedit_package.pas"/>
|
||||
<UnitName Value="atsynedit_package"/>
|
||||
</Item17>
|
||||
<Item18>
|
||||
<Filename Value="atsynedit_ranges.pas"/>
|
||||
<UnitName Value="ATSynEdit_Ranges"/>
|
||||
</Item18>
|
||||
<Item19>
|
||||
<Filename Value="atsynedit_wrapinfo.pas"/>
|
||||
<UnitName Value="ATSynEdit_WrapInfo"/>
|
||||
</Item19>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<CustomOptions Items="ExternHelp" Version="2">
|
||||
<_ExternHelp Items="Count"/>
|
||||
</CustomOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
26
ATSynEdit/atsynedit/atsynedit_package.pas
Normal file
26
ATSynEdit/atsynedit/atsynedit_package.pas
Normal file
@@ -0,0 +1,26 @@
|
||||
{ This file was automatically created by Lazarus. Do not edit!
|
||||
This source is only used to compile and install the package.
|
||||
}
|
||||
|
||||
unit atsynedit_package;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ATSynEdit_Register, ATStringProc, ATStringProc_TextBuffer,
|
||||
atstringproc_utf8detect, ATStringProc_WordJump, ATStrings, ATStrings_Undo,
|
||||
ATSynEdit, ATSynEdit_Adapters, ATSynEdit_CanvasProc, atsynedit_carets,
|
||||
ATSynEdit_Commands, ATSynEdit_Edits, ATSynEdit_Gutter, ATSynEdit_Keymap,
|
||||
ATSynEdit_Keymap_Init, ATSynEdit_Ranges, ATSynEdit_WrapInfo,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('ATSynEdit_Register', @ATSynEdit_Register.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('atsynedit_package', @Register);
|
||||
end.
|
||||
68
ATSynEdit/atsynedit/atsynedit_proc.inc
Normal file
68
ATSynEdit/atsynedit/atsynedit_proc.inc
Normal file
@@ -0,0 +1,68 @@
|
||||
//for browser-scroll feature
|
||||
var
|
||||
cBitmapNiceScroll: TBitmap = nil;
|
||||
const
|
||||
cBitmapNiceScrollRadius = 16;
|
||||
crNiceScrollNone = TCursor(-30);
|
||||
crNiceScrollUp = TCursor(-31);
|
||||
crNiceScrollDown = TCursor(-32);
|
||||
crNiceScrollLeft = TCursor(-33);
|
||||
crNiceScrollRight = TCursor(-34);
|
||||
|
||||
const
|
||||
//under Mac don't use Ctrl key, use Meta key as default (e.g. Meta+C, Meta+A)
|
||||
ssXControl = {$ifndef darwin} ssCtrl {$else} ssMeta {$endif};
|
||||
|
||||
procedure AppProcessMessages;
|
||||
begin
|
||||
//why we need it?
|
||||
//1) ScrollTop:=N applies for drawed control (it needs wrapinfo),
|
||||
//and it needs paint called. paint called only passive, QT+Mac needs it.
|
||||
//so need to call processmessages to wait for paint..
|
||||
//2) for showing "wait" on loading huge file
|
||||
|
||||
{$ifdef allow_proc_msg}
|
||||
Application.ProcessMessages;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure DoClearScrollInfo(var Info: TATSynScrollInfo);
|
||||
begin
|
||||
Info.NPos:= 0;
|
||||
Info.NMin:= 0;
|
||||
Info.NMax:= 1;
|
||||
Info.NPage:= 1;
|
||||
end;
|
||||
|
||||
function IsEqualScrollInfo(const Info1, Info2: TATSynScrollInfo): boolean;
|
||||
begin
|
||||
Result:=
|
||||
(Info1.NPos=Info2.NPos) and
|
||||
(Info1.NMin=Info2.NMin) and
|
||||
(Info1.NMax=Info2.NMax) and
|
||||
(Info1.NPage=Info2.NPage);
|
||||
end;
|
||||
|
||||
procedure InitClipboardFormat;
|
||||
begin
|
||||
cATClipboardFormatId:= RegisterClipboardFormat('Application/X-Laz-ATSynEdit-Block');
|
||||
end;
|
||||
|
||||
procedure InitResourcesNicescroll;
|
||||
begin
|
||||
cBitmapNiceScroll:= TBitmap.Create;
|
||||
cBitmapNiceScroll.LoadFromResourceName(HInstance, 'AB_MOVE');
|
||||
cBitmapNiceScroll.Transparent:= true;
|
||||
|
||||
Screen.Cursors[crNiceScrollNone]:= LoadCursor(HInstance, 'AB_MOVE');
|
||||
Screen.Cursors[crNiceScrollUp]:= LoadCursor(HInstance, 'AB_MOVE_U');
|
||||
Screen.Cursors[crNiceScrollDown]:= LoadCursor(HInstance, 'AB_MOVE_D');
|
||||
Screen.Cursors[crNiceScrollLeft]:= LoadCursor(HInstance, 'AB_MOVE_L');
|
||||
Screen.Cursors[crNiceScrollRight]:= LoadCursor(HInstance, 'AB_MOVE_R');
|
||||
end;
|
||||
|
||||
procedure FreeResources;
|
||||
begin
|
||||
FreeAndNil(cBitmapNiceScroll);
|
||||
end;
|
||||
|
||||
302
ATSynEdit/atsynedit/atsynedit_ranges.pas
Normal file
302
ATSynEdit/atsynedit/atsynedit_ranges.pas
Normal file
@@ -0,0 +1,302 @@
|
||||
unit ATSynEdit_Ranges;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
//{$define show_unfold_rng}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Dialogs,
|
||||
ATStringProc;
|
||||
|
||||
type
|
||||
{ TATSynRange }
|
||||
|
||||
TATSynRange = class
|
||||
private
|
||||
FX, //start column
|
||||
FY, //start line
|
||||
FY2: integer; //end line which is fully folded (can't partially fold)
|
||||
FFolded: boolean;
|
||||
FStaple: boolean;
|
||||
FHint: string;
|
||||
public
|
||||
property X: integer read FX;
|
||||
property Y: integer read FY;
|
||||
property Y2: integer read FY2;
|
||||
property Folded: boolean read FFolded write FFolded;
|
||||
property Staple: boolean read FStaple;
|
||||
property Hint: string read FHint write FHint;
|
||||
constructor Create(AX, AY, AY2: integer; AStaple: boolean; const AHint: string); virtual;
|
||||
function IsSimple: boolean;
|
||||
function IsLineInside(ALine: integer): boolean;
|
||||
function MessageText: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TATRangeHasLines = (
|
||||
cRngIgnore,
|
||||
cRngHasAllLines,
|
||||
cRngHasAnyOfLines,
|
||||
cRngExceptThisRange
|
||||
);
|
||||
|
||||
type
|
||||
{ TATSynRanges }
|
||||
|
||||
TATSynRanges = class
|
||||
private
|
||||
FList: TList;
|
||||
function GetCount: integer;
|
||||
function GetItems(Index: integer): TATSynRange;
|
||||
function MessageTextForIndexList(L: TList): string;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
property Count: integer read GetCount;
|
||||
function IsIndexValid(N: integer): boolean;
|
||||
procedure Clear;
|
||||
procedure Add(AX, AY, AY2: integer; AWithStaple: boolean; const AHint: string);
|
||||
procedure Insert(Index: integer; AX, AY, AY2: integer; AWithStaple: boolean;
|
||||
const AHint: string);
|
||||
procedure Delete(Index: integer);
|
||||
property Items[Index: integer]: TATSynRange read GetItems; default;
|
||||
function IsRangeInsideOther(R1, R2: TATSynRange): boolean;
|
||||
function IsRangesSame(R1, R2: TATSynRange): boolean;
|
||||
function FindRangesContainingLines(ALineFrom, ALineTo: integer;
|
||||
AInRange: TATSynRange; AOnlyFolded, ATopLevelOnly: boolean;
|
||||
ALineMode: TATRangeHasLines): TATIntArray;
|
||||
function FindRangeWithPlusAtLine(ALine: integer): TATSynRange;
|
||||
function MessageText(Cnt: integer): string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math,
|
||||
ATSynEdit_Carets;
|
||||
|
||||
//we allow one block to hangout 1 line by Y2 from outer block:
|
||||
//it's needed for Pascal econtrol lexer
|
||||
//(don't know why it gives such blocks)
|
||||
const
|
||||
cAllowHangoutLines = 1; //0 or 1, do not bigger
|
||||
|
||||
|
||||
{ TATSynRange }
|
||||
|
||||
constructor TATSynRange.Create(AX, AY, AY2: integer; AStaple: boolean;
|
||||
const AHint: string);
|
||||
begin
|
||||
if (AX<=0) then raise Exception.Create('Incorrect range with x<=0: '+MessageText);
|
||||
if (AY<0) then raise Exception.Create('Incorrect range with y<0: '+MessageText);
|
||||
if (AY>AY2) then raise Exception.Create('Incorrect range with y>y2: '+MessageText);
|
||||
|
||||
FX:= AX;
|
||||
FY:= AY;
|
||||
FY2:= AY2;
|
||||
FStaple:= AStaple;
|
||||
FHint:= AHint;
|
||||
end;
|
||||
|
||||
function TATSynRange.IsSimple: boolean;
|
||||
begin
|
||||
Result:= Y=Y2;
|
||||
end;
|
||||
|
||||
function TATSynRange.IsLineInside(ALine: integer): boolean;
|
||||
begin
|
||||
Result:= (ALine>=Y) and (ALine<=Y2);
|
||||
end;
|
||||
|
||||
function TATSynRange.MessageText: string;
|
||||
begin
|
||||
Result:= Format('%d..%d', [Y+1, Y2+1]);
|
||||
end;
|
||||
|
||||
{ TATSynRanges }
|
||||
|
||||
function TATSynRanges.IsIndexValid(N: integer): boolean;
|
||||
begin
|
||||
Result:= (N>=0) and (N<FList.Count);
|
||||
end;
|
||||
|
||||
function TATSynRanges.GetCount: integer;
|
||||
begin
|
||||
Result:= FList.Count;
|
||||
end;
|
||||
|
||||
function TATSynRanges.GetItems(Index: integer): TATSynRange;
|
||||
begin
|
||||
Result:= TATSynRange(FList[Index]);
|
||||
{
|
||||
if IsIndexValid(Index) then
|
||||
Result:= TATSynRange(FList[Index])
|
||||
else
|
||||
Result:= nil;
|
||||
}
|
||||
end;
|
||||
|
||||
constructor TATSynRanges.Create;
|
||||
begin
|
||||
FList:= TList.Create;
|
||||
FList.Capacity:= 4000;
|
||||
end;
|
||||
|
||||
destructor TATSynRanges.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TATSynRanges.Clear;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Count-1 downto 0 do
|
||||
TObject(FList[i]).Free;
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
procedure TATSynRanges.Add(AX, AY, AY2: integer; AWithStaple: boolean; const AHint: string);
|
||||
begin
|
||||
FList.Add(TATSynRange.Create(AX, AY, AY2, AWithStaple, AHint));
|
||||
end;
|
||||
|
||||
procedure TATSynRanges.Insert(Index: integer; AX, AY, AY2: integer; AWithStaple: boolean; const AHint: string);
|
||||
begin
|
||||
FList.Insert(Index, TATSynRange.Create(AX, AY, AY2, AWithStaple, AHint));
|
||||
end;
|
||||
|
||||
procedure TATSynRanges.Delete(Index: integer);
|
||||
begin
|
||||
if IsIndexValid(Index) then
|
||||
begin
|
||||
TObject(FList[Index]).Free;
|
||||
FList.Delete(Index);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynRanges.IsRangeInsideOther(R1, R2: TATSynRange): boolean;
|
||||
begin
|
||||
Result:=
|
||||
IsPosSorted(R2.X, R2.Y, R1.X, R1.Y, true)
|
||||
and (R1.Y2-cAllowHangoutLines<=R2.Y2);
|
||||
end;
|
||||
|
||||
function TATSynRanges.IsRangesSame(R1, R2: TATSynRange): boolean;
|
||||
begin
|
||||
if R1=R2 then
|
||||
begin Result:= true; Exit end;
|
||||
if (R1.X=R2.X) and (R1.Y=R2.Y) and (Abs(R1.Y2-R2.Y2)<=cAllowHangoutLines) then
|
||||
begin Result:= true; Exit end;
|
||||
|
||||
Result:= false;
|
||||
end;
|
||||
|
||||
function TATSynRanges.FindRangesContainingLines(ALineFrom, ALineTo: integer;
|
||||
AInRange: TATSynRange; AOnlyFolded, ATopLevelOnly: boolean; ALineMode: TATRangeHasLines): TATIntArray;
|
||||
var
|
||||
L: TList;
|
||||
R: TATSynRange;
|
||||
i, j: integer;
|
||||
Ok: boolean;
|
||||
begin
|
||||
SetLength(Result, 0);
|
||||
L:= TList.Create;
|
||||
L.Capacity:= 512;
|
||||
try
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
R:= Items[i];
|
||||
if (not R.IsSimple) then
|
||||
if (not AOnlyFolded or R.Folded) then
|
||||
begin
|
||||
case ALineMode of
|
||||
cRngIgnore: Ok:= true;
|
||||
cRngHasAllLines: Ok:= (R.Y<=ALineFrom) and (R.Y2>=ALineTo);
|
||||
cRngHasAnyOfLines: Ok:= (R.Y<=ALineTo) and (R.Y2>=ALineFrom);
|
||||
cRngExceptThisRange: Ok:= R<>AInRange;
|
||||
else raise Exception.Create('unknown LineMode');
|
||||
end;
|
||||
if not Ok then Continue;
|
||||
|
||||
if AInRange=nil then
|
||||
Ok:= true
|
||||
else
|
||||
Ok:= not IsRangesSame(AInRange, R) and IsRangeInsideOther(R, AInRange);
|
||||
|
||||
if Ok then
|
||||
L.Add(pointer(i));
|
||||
end;
|
||||
end;
|
||||
|
||||
if ATopLevelOnly then
|
||||
begin
|
||||
{$ifdef show_unfold_rng}
|
||||
s1:= 'toplevel: ranges shortlist'#13+MessageTextForIndexList(L);
|
||||
{$endif}
|
||||
|
||||
for i:= L.Count-1 downto 1 do
|
||||
for j:= 0 to i-1 do
|
||||
if IsRangeInsideOther(Items[integer(L[i])], Items[integer(L[j])]) then
|
||||
begin
|
||||
L.Delete(i);
|
||||
Break
|
||||
end;
|
||||
|
||||
{$ifdef show_unfold_rng}
|
||||
s2:= 'toplevel: ranges done'#13+MessageTextForIndexList(L);
|
||||
if l.count>0 then
|
||||
showmessage(s1+#13+s2);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
SetLength(Result, L.Count);
|
||||
for i:= 0 to L.Count-1 do
|
||||
Result[i]:= integer(L[i]);
|
||||
finally
|
||||
FreeAndNil(L);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynRanges.FindRangeWithPlusAtLine(ALine: integer): TATSynRange;
|
||||
var
|
||||
i: integer;
|
||||
R: TATSynRange;
|
||||
begin
|
||||
Result:= nil;
|
||||
for i:= 0 to Count-1 do
|
||||
begin
|
||||
R:= Items[i];
|
||||
if (not R.IsSimple) and (R.Y=ALine) then
|
||||
begin
|
||||
Result:= R;
|
||||
Break
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TATSynRanges.MessageText(Cnt: integer): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= '';
|
||||
for i:= 0 to Min(Count-1, Cnt) do
|
||||
Result:= Result+Items[i].MessageText+#13;
|
||||
end;
|
||||
|
||||
function TATSynRanges.MessageTextForIndexList(L: TList): string;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= '';
|
||||
if L.Count=0 then exit;
|
||||
for i:= 0 to L.Count-1 do
|
||||
Result:= Result+items[integer(L[i])].MessageText+#13;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
28
ATSynEdit/atsynedit/atsynedit_register.pas
Normal file
28
ATSynEdit/atsynedit/atsynedit_register.pas
Normal file
@@ -0,0 +1,28 @@
|
||||
unit ATSynEdit_Register;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ATSynEdit, ATSynEdit_Edits,
|
||||
LResources;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{ Registration }
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Misc', [TATSynEdit, TATEdit, TATComboEdit]);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
//lrs file must be made by command:
|
||||
// ~/lazarus/tools/lazres icons.lrs *.png
|
||||
{$I res/ide/icons.lrs}
|
||||
|
||||
end.
|
||||
|
||||
360
ATSynEdit/atsynedit/atsynedit_sel.inc
Normal file
360
ATSynEdit/atsynedit/atsynedit_sel.inc
Normal file
@@ -0,0 +1,360 @@
|
||||
{$ifdef nnn}begin end;{$endif}
|
||||
|
||||
function TATSynEdit.IsPosSelected(AX, AY: integer): boolean;
|
||||
var
|
||||
NPosLeft,
|
||||
NPosRight: integer;
|
||||
SLine: atString;
|
||||
begin
|
||||
if not IsSelRectEmpty then
|
||||
begin
|
||||
if not ((AY>=FSelRect.Top) and (AY<=FSelRect.Bottom)) then exit(False);
|
||||
|
||||
SLine:= Strings.Lines[AY];
|
||||
NPosLeft:= SColumnPosToCharPos(SLine, FSelRect.Left, OptTabSize);
|
||||
NPosRight:= SColumnPosToCharPos(SLine, FSelRect.Right, OptTabSize);
|
||||
Result:= (AX>=NPosLeft) and (AX<NPosRight);
|
||||
end
|
||||
else
|
||||
Result:= Carets.IsPosSelected(AX, AY);
|
||||
end;
|
||||
|
||||
function TATSynEdit.IsSelRectEmpty: boolean;
|
||||
begin
|
||||
Result:= EqualRect(FSelRect, cRectEmpty);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_Word(P: TPoint);
|
||||
var
|
||||
N1, N2: integer;
|
||||
begin
|
||||
if not Strings.IsIndexValid(P.Y) then Exit;
|
||||
SFindWordBounds(Strings.Lines[P.Y], P.X, N1, N2, FOptWordChars);
|
||||
if N1<>N2 then
|
||||
begin
|
||||
DoCaretSingle(P.X, P.Y);
|
||||
with Carets[0] do
|
||||
begin
|
||||
EndY:= P.Y;
|
||||
EndX:= N1;
|
||||
PosX:= N2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_CharRange(ACaretIndex: integer; Pnt: TPoint);
|
||||
begin
|
||||
if not Carets.IsIndexValid(ACaretIndex) then Exit;
|
||||
Carets[ACaretIndex].SelectToPoint(Pnt.X, Pnt.Y);
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_WordRange(ACaretIndex: integer; P1, P2: TPoint);
|
||||
begin
|
||||
if not Carets.IsIndexValid(ACaretIndex) then Exit;
|
||||
if not Strings.IsIndexValid(P1.Y) then Exit;
|
||||
if not Strings.IsIndexValid(P2.Y) then Exit;
|
||||
|
||||
if not IsPosSorted(P1.X, P1.Y, P2.X, P2.Y, true) then
|
||||
begin
|
||||
SwapInt(P1.X, P2.X);
|
||||
SwapInt(P1.Y, P2.Y);
|
||||
end;
|
||||
|
||||
P1.X:= SFindWordOffset(Strings.Lines[P1.Y], P1.X, false, false, FOptWordChars);
|
||||
P2.X:= SFindWordOffset(Strings.Lines[P2.Y], P2.X, true, false, FOptWordChars);
|
||||
|
||||
with Carets[ACaretIndex] do
|
||||
begin
|
||||
PosX:= P2.X;
|
||||
PosY:= P2.Y;
|
||||
EndX:= P1.X;
|
||||
EndY:= P1.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_Line(P: TPoint);
|
||||
var
|
||||
PLast: TPoint;
|
||||
begin
|
||||
if not Strings.IsIndexValid(P.Y) then Exit;
|
||||
|
||||
DoCaretSingle(P.X, P.Y);
|
||||
with Carets[0] do
|
||||
begin
|
||||
if P.Y<Strings.Count-1 then
|
||||
begin
|
||||
PosX:= 0;
|
||||
PosY:= P.Y+1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
PLast:= GetEndOfFilePos;
|
||||
PosX:= PLast.X;
|
||||
PosY:= PLast.Y;
|
||||
end;
|
||||
EndX:= 0;
|
||||
EndY:= P.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_All;
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
P:= GetEndOfFilePos;
|
||||
DoCaretSingle(P.X, P.Y);
|
||||
with Carets[0] do
|
||||
begin
|
||||
EndX:= 0;
|
||||
EndY:= 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_Inverted;
|
||||
var
|
||||
NewCarets: TATCarets;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
XPrev, YPrev: integer;
|
||||
i: integer;
|
||||
Sel: boolean;
|
||||
PosLast: TPoint;
|
||||
begin
|
||||
XPrev:= 0;
|
||||
YPrev:= 0;
|
||||
NewCarets:= TATCarets.Create;
|
||||
try
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Carets[i].GetRange(X1, Y1, X2, Y2, Sel);
|
||||
if not Sel then Continue;
|
||||
|
||||
//add range
|
||||
NewCarets.Add(XPrev, YPrev, X1, Y1);
|
||||
XPrev:= X2;
|
||||
YPrev:= Y2;
|
||||
end;
|
||||
|
||||
//add range after last caret
|
||||
PosLast:= GetEndOfFilePos;
|
||||
NewCarets.Add(XPrev, YPrev, PosLast.X, PosLast.Y);
|
||||
|
||||
DoCaretsAssign(NewCarets);
|
||||
finally
|
||||
FreeAndNil(NewCarets);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_SplitSelectionToLines;
|
||||
var
|
||||
NewCarets: TATCarets;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
i, j: integer;
|
||||
Sel: boolean;
|
||||
begin
|
||||
NewCarets:= TATCarets.Create;
|
||||
try
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Carets[i].GetRange(X1, Y1, X2, Y2, Sel);
|
||||
if not Sel then
|
||||
begin
|
||||
NewCarets.Add(X1, Y1);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if Y1=Y2 then
|
||||
begin
|
||||
NewCarets.Add(X1, Y1, X2, Y2);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
//add first part
|
||||
if X1<Length(Strings.Lines[Y1]) then
|
||||
NewCarets.Add(X1, Y1, Length(Strings.Lines[Y1]), Y1)
|
||||
else
|
||||
NewCarets.Add(X1, Y1);
|
||||
|
||||
//add middle parts
|
||||
for j:= Y1+1 to Y2-1 do
|
||||
begin
|
||||
if Strings.Lines[j]='' then
|
||||
NewCarets.Add(0, j)
|
||||
else
|
||||
NewCarets.Add(0, j, Length(Strings.Lines[j]), j);
|
||||
end;
|
||||
|
||||
//add last part
|
||||
NewCarets.Add(0, Y2, X2, Y2);
|
||||
end;
|
||||
|
||||
DoCaretsAssign(NewCarets);
|
||||
finally
|
||||
FreeAndNil(NewCarets);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_ExtendSelectionByLine;
|
||||
var
|
||||
NewCarets: TATCarets;
|
||||
X1, Y1, X2, Y2: integer;
|
||||
i: integer;
|
||||
Sel: boolean;
|
||||
PosLast: TPoint;
|
||||
begin
|
||||
NewCarets:= TATCarets.Create;
|
||||
try
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
begin
|
||||
Carets[i].GetRange(X1, Y1, X2, Y2, Sel);
|
||||
if not Sel then
|
||||
begin X2:= X1; Y2:= Y1; end;
|
||||
|
||||
X1:= 0; //select entire 1st line
|
||||
if Y2<Strings.Count-1 then
|
||||
begin
|
||||
//select till start of next ln
|
||||
X2:= 0;
|
||||
Y2:= Y2+1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//select till eof
|
||||
PosLast:= GetEndOfFilePos;
|
||||
X2:= PosLast.X;
|
||||
Y2:= PosLast.Y;
|
||||
end;
|
||||
|
||||
NewCarets.Add(X1, Y1, X2, Y2);
|
||||
end;
|
||||
|
||||
DoCaretsAssign(NewCarets);
|
||||
finally
|
||||
FreeAndNil(NewCarets);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_LineRange(ALineFrom: integer; P: TPoint);
|
||||
var
|
||||
CItem: TATCaretItem;
|
||||
begin
|
||||
DoCaretSingle(P.X, P.Y);
|
||||
CItem:= Carets[0];
|
||||
|
||||
if P.Y<ALineFrom then
|
||||
begin
|
||||
CItem.EndX:= 0;
|
||||
CItem.EndY:= ALineFrom+1;
|
||||
end
|
||||
else
|
||||
if P.Y>ALineFrom then
|
||||
begin
|
||||
CItem.EndX:= 0;
|
||||
CItem.EndY:= ALineFrom;
|
||||
end
|
||||
else
|
||||
if P.Y=ALineFrom then
|
||||
begin
|
||||
DoSelect_Line(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_None;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
FSelRect:= cRectEmpty;
|
||||
FSelRectBegin:= Point(-1, -1);
|
||||
|
||||
for i:= 0 to Carets.Count-1 do
|
||||
with Carets[i] do
|
||||
begin
|
||||
EndX:= -1;
|
||||
EndY:= -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_ColumnBlock(P1, P2: TPoint);
|
||||
var
|
||||
NPosLeft, NPosRight: integer;
|
||||
i: integer;
|
||||
begin
|
||||
if P1.Y>P2.Y then
|
||||
SwapInt(P1.Y, P2.Y);
|
||||
|
||||
FSelRect.Left:= Min(P1.X, P2.X);
|
||||
FSelRect.Right:= Max(P1.X, P2.X);
|
||||
FSelRect.Top:= P1.Y;
|
||||
FSelRect.Bottom:= P2.Y;
|
||||
|
||||
for i:= P1.Y to P2.Y do
|
||||
begin
|
||||
if i=P1.Y then Carets.Clear;
|
||||
Carets.Add(0, 0);
|
||||
with Carets[Carets.Count-1] do
|
||||
begin
|
||||
PosX:= SColumnPosToCharPos(Strings.Lines[i], FSelRect.Right, OptTabSize);
|
||||
PosY:= i;
|
||||
EndX:= SColumnPosToCharPos(Strings.Lines[i], FSelRect.Left, OptTabSize);
|
||||
EndY:= i;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelectionDeleteOrReset;
|
||||
begin
|
||||
if FOptOverwriteSel then
|
||||
DoCommand_TextDeleteSelection
|
||||
else
|
||||
DoSelect_None;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelect_NormalSelToColumnSel(out ABegin, AEnd: TPoint);
|
||||
var
|
||||
Caret: TATCaretItem;
|
||||
begin
|
||||
Caret:= Carets[0];
|
||||
if (Caret.EndY>=0) and (Caret.EndX>=0) then
|
||||
begin
|
||||
ABegin.X:= SCharPosToColumnPos(Strings.Lines[Caret.EndY], Caret.EndX, OptTabSize);
|
||||
ABegin.Y:= Caret.EndY;
|
||||
AEnd.X:= SCharPosToColumnPos(Strings.Lines[Caret.PosY], Caret.PosX, OptTabSize);
|
||||
AEnd.Y:= Caret.PosY;
|
||||
end
|
||||
else
|
||||
begin
|
||||
ABegin.X:= SCharPosToColumnPos(Strings.Lines[Caret.PosY], Caret.PosX, OptTabSize);
|
||||
ABegin.Y:= Caret.PosY;
|
||||
AEnd:= ABegin;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TATSynEdit.DoSelectionDeleteColumnBlock;
|
||||
var
|
||||
X1, X2, i: Integer;
|
||||
Str, StrNew: atString;
|
||||
begin
|
||||
if IsSelRectEmpty then exit;
|
||||
|
||||
Strings.BeginUndoGroup;
|
||||
try
|
||||
for i:= FSelRect.Top to FSelRect.Bottom do
|
||||
begin
|
||||
Str:= Strings.Lines[i];
|
||||
X1:= SColumnPosToCharPos(Str, FSelRect.Left, OptTabSize);
|
||||
X2:= SColumnPosToCharPos(Str, FSelRect.Right, OptTabSize);
|
||||
|
||||
StrNew:= Str;
|
||||
Delete(StrNew, X1+1, X2-X1);
|
||||
if StrNew<>Str then
|
||||
Strings.Lines[i]:= StrNew;
|
||||
end;
|
||||
finally
|
||||
Strings.EndUndoGroup;
|
||||
end;
|
||||
|
||||
DoSelect_None;
|
||||
|
||||
if Carets.Count>0 then
|
||||
Carets[0].PosX:= X1;
|
||||
end;
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user