mirror of https://gitlab.com/basile.b/dexed.git
This commit is contained in:
Basile Burg
commit
9866f22820
Binary file not shown.
|
After Width: | Height: | Size: 134 KiB |
|
|
@ -0,0 +1,222 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="coedit"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="3">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
<Item2 Name="Debug">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="coedit"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<IncludeAssertionCode Value="True"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<IOChecks Value="True"/>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
<UseHeaptrc Value="True"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dDEBUG"/>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
<Item3 Name="Release">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="coedit"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="3"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dRELEASE"/>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item3>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="SynEdit"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LazControls"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="9">
|
||||
<Unit0>
|
||||
<Filename Value="coedit.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="coedit"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="..\src\ce_main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEMainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="ce_main"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\src\ce_frame.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="ce_frame"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\src\ce_common.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ce_common"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\src\ce_messages.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEMessagesWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="ce_messages"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\src\ce_editor.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEEditorWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="ce_editor"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\src\ce_d2syn.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ce_d2syn"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\src\ce_project.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CEProjectWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="ce_project"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="..\src\ce_synmemo.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ce_synmemo"/>
|
||||
</Unit8>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="coedit"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
program coedit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces,
|
||||
Forms, lazcontrols, ce_main, ce_frame, ce_common,
|
||||
ce_messages, ce_editor, ce_project, ce_synmemo;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TCEMainForm, mainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
----------------------------------------
|
||||
combined D compiler (Co) & editor (edit)
|
||||
----------------------------------------
|
||||
|
||||
Multi-plateform D code editor and D compiler wrapper.
|
||||
|
||||
Initial features:
|
||||
|
||||
- projects.
|
||||
- multi projects configurations (set of switches and options).
|
||||
- project configurations templates (release, debug, etc.).
|
||||
- D syntax highlighter.
|
||||
- compile, run directly from UI.
|
||||
- instant run (without saving, script-like).
|
||||
- basic auto completion (brackets, KW, ...)
|
||||
|
||||
Future:
|
||||
- project groups.
|
||||
- plug-in interface.
|
||||
- completion proposal (dcd or using json doc).
|
||||
- dynamic grammatical verification
|
||||
- Git integration.
|
||||
- debugger.
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
unit ce_common;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ce_dmdwrap;
|
||||
|
||||
type
|
||||
|
||||
(**
|
||||
* An implementer is informed when a new document is added, focused or closed.
|
||||
*)
|
||||
ICEMultiDocMonitor = interface
|
||||
procedure docChange(const aNewIndex: integer);
|
||||
procedure docClose(const aNewIndex: integer);
|
||||
end;
|
||||
|
||||
(**
|
||||
* An implementer informs when a new document is added, focused or closed.
|
||||
*)
|
||||
ICEMultiDocEmitter = interface
|
||||
procedure docChange(const aNewIndex: integer);
|
||||
procedure docClose(const aNewIndex: integer);
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Writable project.
|
||||
*)
|
||||
TCEProject = class(TComponent)
|
||||
private
|
||||
fModified: boolean;
|
||||
fFilename: string;
|
||||
fOptsColl: TCollection;
|
||||
fSrcs: TStringList; // an editor can be associated to a file using the Object[] property
|
||||
fConfIx: Integer;
|
||||
procedure subMemberChanged(sender : TObject);
|
||||
procedure setOptsColl(const aValue: TCollection);
|
||||
procedure setFname(const aValue: string);
|
||||
procedure setSrcs(const aValue: TStringList);
|
||||
procedure setConfIx(aValue: Integer);
|
||||
function getConfig(const ix: integer): TCompilerConfiguration;
|
||||
published
|
||||
property OptionsCollection: TCollection read fOptsColl write setOptsColl;
|
||||
property Sources: TStringList read fSrcs write setSrcs;
|
||||
property ConfigurationIndex: Integer read fConfIx write setConfIx;
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
function addConfiguration: TCompilerConfiguration;
|
||||
property configuration[ix: integer]: TCompilerConfiguration read getConfig;
|
||||
property fileName: string read fFilename write setFname;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
(*****************************************************************************
|
||||
* TProject
|
||||
*)
|
||||
constructor TCEProject.create(aOwner: TComponent);
|
||||
var
|
||||
defConf: TCompilerConfiguration;
|
||||
begin
|
||||
inherited create(aOwner);
|
||||
fSrcs := TStringList.Create;
|
||||
fSrcs.OnChange := @subMemberChanged;
|
||||
fOptsColl := TCollection.create(TCompilerConfiguration);
|
||||
|
||||
defConf := addConfiguration;
|
||||
defConf.name := 'default';
|
||||
end;
|
||||
|
||||
destructor TCEProject.destroy;
|
||||
begin
|
||||
fSrcs.free;
|
||||
fOptsColl.free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCEProject.addConfiguration: TCompilerConfiguration;
|
||||
begin
|
||||
result := TCompilerConfiguration(fOptsColl.Add);
|
||||
result.onChanged := @subMemberChanged;
|
||||
end;
|
||||
|
||||
procedure TCEProject.setOptsColl(const aValue: TCollection);
|
||||
begin
|
||||
fOptsColl.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCEProject.setFname(const aValue: string);
|
||||
begin
|
||||
if fFilename = aValue then exit;
|
||||
fFilename := aValue;
|
||||
subMemberChanged(nil);
|
||||
end;
|
||||
|
||||
procedure TCEProject.setSrcs(const aValue: TStringList);
|
||||
begin
|
||||
fSrcs.Assign(aValue);
|
||||
subMemberChanged(nil);
|
||||
end;
|
||||
|
||||
procedure TCEProject.setConfIx(aValue: Integer);
|
||||
begin
|
||||
if fConfIx = aValue then exit;
|
||||
if aValue < 0 then aValue := 0;
|
||||
if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1;
|
||||
fConfIx := aValue;
|
||||
subMemberChanged(nil);
|
||||
end;
|
||||
|
||||
procedure TCEProject.subMemberChanged(sender : TObject);
|
||||
begin
|
||||
fModified := true;
|
||||
end;
|
||||
|
||||
function TCEProject.getConfig(const ix: integer): TCompilerConfiguration;
|
||||
begin
|
||||
result := TCompilerConfiguration(fOptsColl.Items[ix]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,807 @@
|
|||
unit ce_d2syn;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics,
|
||||
SynEditHighlighter, SynEditHighlighterFoldBase, SynEditTypes;
|
||||
|
||||
const
|
||||
|
||||
D2Kw: array[0..109] of string =
|
||||
( 'abstract', 'alias', 'align', 'asm', 'assert', 'auto',
|
||||
'body', 'bool', 'break', 'byte',
|
||||
'case', 'cast', 'catch', 'cdouble', 'cent', 'cfloat', 'char', 'class',
|
||||
'const', 'continue', 'creal',
|
||||
'dchar', 'debug', 'default', 'delegate', 'delete', 'deprecated', 'do', 'double',
|
||||
'else', 'enum', 'export', 'extern',
|
||||
'false', 'final', 'finally', 'float', 'for', 'foreach',
|
||||
'foreach_reverse', 'function',
|
||||
'goto',
|
||||
'idouble', 'if', 'ifloat', 'immutable', 'import', 'in', 'inout', 'int',
|
||||
'interface', 'invariant', 'ireal', 'is',
|
||||
'lazy', 'long',
|
||||
'macro', 'mixin', 'module',
|
||||
'new', 'nothrow', 'null',
|
||||
'out', 'override',
|
||||
'package', 'pragma', 'private', 'protected', 'ptrdiff_t', 'public', 'pure',
|
||||
'real', 'ref', 'return',
|
||||
'size_t', 'scope', 'shared', 'short', 'static', 'string', 'struct',
|
||||
'super', 'switch', 'synchronized',
|
||||
'template', 'this', 'throw', 'true', 'try', 'typedef', 'typeid', 'typeof',
|
||||
'ubyte', 'ucent', 'uint', 'ulong', 'union', 'unittest', 'ushort',
|
||||
'version', 'void', 'volatile',
|
||||
'wchar', 'while', 'with',
|
||||
'__FILE__', '__MODULE__', '__LINE__', '__FUNCTION__', '__PRETTY_FUNCTION__'
|
||||
);
|
||||
|
||||
type
|
||||
|
||||
TD2DictionaryEntry = record
|
||||
filled: Boolean;
|
||||
values: array of string;
|
||||
end;
|
||||
|
||||
TD2Dictionary = object
|
||||
private
|
||||
fLongest: NativeInt;
|
||||
fEntries: array[0..1024] of TD2DictionaryEntry;
|
||||
function toHash(const aValue: string): word;
|
||||
procedure addEntry(const aValue: string);
|
||||
public
|
||||
constructor create;
|
||||
function find(const aValue: string): boolean;
|
||||
end;
|
||||
|
||||
TTokenKind = (tkCommt, tkIdent, tkKeywd, tkStrng, tkBlank, tkSymbl, tkNumbr, tkCurrI);
|
||||
|
||||
TRangeKind = (rkNone, rkString1, rkString2, rkBlockCom1, rkBlockCom2, rkAsm);
|
||||
|
||||
TFoldKind = (fkBrackets, fkComments1, fkComments2);
|
||||
TFoldKinds = set of TFoldKind;
|
||||
|
||||
TSynD2Syn = class (TSynCustomFoldHighlighter)
|
||||
private
|
||||
fWhiteAttrib: TSynHighlighterAttributes;
|
||||
fNumbrAttrib: TSynHighlighterAttributes;
|
||||
fSymblAttrib: TSynHighlighterAttributes;
|
||||
fIdentAttrib: TSynHighlighterAttributes;
|
||||
fCommtAttrib: TSynHighlighterAttributes;
|
||||
fStrngAttrib: TSynHighlighterAttributes;
|
||||
fKeywdAttrib: TSynHighlighterAttributes;
|
||||
fCurrIAttrib: TSynHighlighterAttributes;
|
||||
fKeyWords: TD2Dictionary;
|
||||
fCurrIdent: string;
|
||||
fLineBuf: string;
|
||||
fTokStart, fTokStop: Integer;
|
||||
fTokKind: TTokenKind;
|
||||
fRange: TRangeKind;
|
||||
fFoldKinds: TFoldKinds;
|
||||
fAttribLut: array[TTokenKind] of TSynHighlighterAttributes;
|
||||
function readNext: Char;
|
||||
function readCurr: Char;
|
||||
function readPrev: Char;
|
||||
procedure setFoldKinds(aValue: TFoldKinds);
|
||||
procedure setWhiteAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setNumbrAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setSymblAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setIdentAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setCommtAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setStrngAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setKeywdAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure setCurrIAttrib(aValue: TSynHighlighterAttributes);
|
||||
procedure doAttribChange(sender: TObject);
|
||||
procedure setCurrIdent(const aValue: string);
|
||||
procedure doChanged;
|
||||
published
|
||||
property FoldKinds: TFoldKinds read fFoldKinds write setFoldKinds;
|
||||
property WhiteAttrib: TSynHighlighterAttributes read fWhiteAttrib write setWhiteAttrib;
|
||||
property NumbrAttrib: TSynHighlighterAttributes read fNumbrAttrib write setNumbrAttrib;
|
||||
property SymblAttrib: TSynHighlighterAttributes read fSymblAttrib write setSymblAttrib;
|
||||
property IdentAttrib: TSynHighlighterAttributes read fIdentAttrib write setIdentAttrib;
|
||||
property CommtAttrib: TSynHighlighterAttributes read fCommtAttrib write setCommtAttrib;
|
||||
property StrngAttrib: TSynHighlighterAttributes read fStrngAttrib write setStrngAttrib;
|
||||
property KeywdAttrib: TSynHighlighterAttributes read fKeywdAttrib write setKeywdAttrib;
|
||||
property CurrIAttrib: TSynHighlighterAttributes read fCurrIAttrib write setCurrIAttrib;
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
|
||||
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
|
||||
procedure setLine(const NewValue: String; LineNumber: Integer); override;
|
||||
procedure next; override;
|
||||
function GetTokenAttribute: TSynHighlighterAttributes; override;
|
||||
function GetToken: string; override;
|
||||
function GetTokenKind: integer; override;
|
||||
function GetTokenPos: Integer; override;
|
||||
function GetEol: Boolean; override;
|
||||
procedure SetRange(Value: Pointer); override;
|
||||
procedure ResetRange; override;
|
||||
function GetRange: Pointer; override;
|
||||
property CurrentIdentifier: string read fCurrIdent write setCurrIdent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function isWhite(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := c in [#0..#32];
|
||||
end;
|
||||
|
||||
function isSpace(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := c in [#9,' '];
|
||||
end;
|
||||
|
||||
function isAlpha(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := (c in ['a'..'z']) or (c in ['A'..'Z']);
|
||||
end;
|
||||
|
||||
function isNumber(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := (c in ['0'..'9']);
|
||||
end;
|
||||
|
||||
function isDigit(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := (c in ['0'..'1']);
|
||||
end;
|
||||
|
||||
function isAlNum(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := isAlpha(c) or isNumber(c);
|
||||
end;
|
||||
|
||||
function isHex(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := isNumber(c) or (c in ['A'..'F']) or (c in ['a'..'f']);
|
||||
end;
|
||||
|
||||
function isSymbol(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := c in [';', '{', '}', '(', ')', '[', ']', ',', '.', ':' , '"', #39, '?'];
|
||||
end;
|
||||
|
||||
function isOperator(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := c in ['/', '*', '-', '+', '%', '>', '<', '=', '!',
|
||||
'&', '|', '^', '~', '$'];
|
||||
end;
|
||||
|
||||
function isDoubleOperator(const s: string): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := false;
|
||||
case s[1] of
|
||||
'.': result := (s[2] = '.');
|
||||
|
||||
'>': result := s[2] in ['>', '='];
|
||||
'<': result := s[2] in ['<', '=', '>'];
|
||||
'=': result := s[2] in ['=', '>'];
|
||||
'!': result := s[2] in ['=', '>', '<'];
|
||||
|
||||
'+': result := s[2] in ['+', '='];
|
||||
'-': result := s[2] in ['-', '='];
|
||||
'/': result := s[2] in ['='];
|
||||
'*': result := s[2] in ['='];
|
||||
'%': result := s[2] in ['='];
|
||||
'~': result := s[2] in ['='];
|
||||
|
||||
'&': result := s[2] in ['&', '='];
|
||||
'|': result := s[2] in ['|', '='];
|
||||
'^': result := s[2] in ['^', '='];
|
||||
end;
|
||||
end;
|
||||
|
||||
function isTripleOperator(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF}
|
||||
begin
|
||||
result := false;
|
||||
case s[1] of
|
||||
'.': result := (s[2] = '.') and (s[3] = '.');
|
||||
'^': result := (s[2] = '^') and (s[3] = '=');
|
||||
'>': result := (s[2] = '>') and (s[3] in ['>', '=']);
|
||||
'<': result := ((s[2] = '<') and (s[3] in ['<', '=']))
|
||||
or (s[2] = '>') and (s[3] = '=');
|
||||
'!': result := ((s[2] = '<') and (s[3] in ['>', '=']))
|
||||
or ((s[2] = '>')and (s[3] = '='));
|
||||
end;
|
||||
end;
|
||||
|
||||
function isQuadOperator(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF}
|
||||
begin
|
||||
result := (s = '>>>=') or (s = '!<>=');
|
||||
end;
|
||||
|
||||
constructor TD2Dictionary.create;
|
||||
var
|
||||
value: string;
|
||||
begin
|
||||
for value in D2Kw do
|
||||
begin
|
||||
addEntry(value);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF DEBUG}{$R-}{$ENDIF}
|
||||
function TD2Dictionary.toHash(const aValue: string): word;
|
||||
var
|
||||
i, len: Integer;
|
||||
prev: word;
|
||||
begin
|
||||
result := 0;
|
||||
prev := 0;
|
||||
len := length(aValue);
|
||||
for i := 1 to len do
|
||||
begin
|
||||
result += ((Byte(aValue[i]) + 64) shl i) xor prev;
|
||||
prev := Byte(aValue[i]);
|
||||
end;
|
||||
result := result and 1023;
|
||||
end;
|
||||
{$IFDEF DEBUG}{$R+}{$ENDIF}
|
||||
|
||||
procedure TD2Dictionary.addEntry(const aValue: string);
|
||||
var
|
||||
hash: word;
|
||||
begin
|
||||
if find(aValue) then
|
||||
exit;
|
||||
|
||||
hash := toHash(aValue);
|
||||
assert(hash < 1024);
|
||||
|
||||
fEntries[hash].filled := true;
|
||||
setLength(fEntries[hash].values, length(fEntries[hash].values) + 1);
|
||||
fEntries[hash].values[high(fEntries[hash].values)] := aValue;
|
||||
if fLongest <= length(aValue) then
|
||||
fLongest := length(aValue);
|
||||
end;
|
||||
|
||||
function TD2Dictionary.find(const aValue: string): boolean;
|
||||
var
|
||||
hash: word;
|
||||
i: NativeInt;
|
||||
begin
|
||||
if length(aValue) > fLongest then
|
||||
result := false
|
||||
else
|
||||
begin
|
||||
hash := toHash(aValue);
|
||||
if (not fEntries[hash].filled) then
|
||||
result := false else
|
||||
begin
|
||||
for i:= 0 to high(fEntries[hash].values) do
|
||||
begin
|
||||
if fEntries[hash].values[i] = aValue then
|
||||
begin
|
||||
result := true;
|
||||
exit;
|
||||
end;
|
||||
result := false;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TSynD2Syn.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited create(aOwner);
|
||||
|
||||
DefaultFilter:= '.d|.di';
|
||||
|
||||
fKeyWords.create;
|
||||
|
||||
fFoldKinds := [fkBrackets];
|
||||
|
||||
fWhiteAttrib := TSynHighlighterAttributes.Create('White','White');
|
||||
fNumbrAttrib := TSynHighlighterAttributes.Create('Number','Number');
|
||||
fSymblAttrib := TSynHighlighterAttributes.Create('Symbol','Symbol');
|
||||
fIdentAttrib := TSynHighlighterAttributes.Create('Identifier','Identifier');
|
||||
fCommtAttrib := TSynHighlighterAttributes.Create('Comment','Comment');
|
||||
fStrngAttrib := TSynHighlighterAttributes.Create('String','String');
|
||||
fKeywdAttrib := TSynHighlighterAttributes.Create('Keyword','Keyword');
|
||||
fCurrIAttrib := TSynHighlighterAttributes.Create('CurrentIdentifier','CurrentIdentifier');
|
||||
|
||||
fNumbrAttrib.Foreground := $000079F2;
|
||||
fSymblAttrib.Foreground := clMaroon;
|
||||
fIdentAttrib.Foreground := clBlack;
|
||||
fCommtAttrib.Foreground := clGreen;
|
||||
fStrngAttrib.Foreground := clBlue;
|
||||
fKeywdAttrib.Foreground := clNavy;
|
||||
|
||||
fCurrIAttrib.Foreground := clBlack;
|
||||
fCurrIAttrib.FrameEdges:= sfeAround;
|
||||
fCurrIAttrib.FrameColor:= clRed;
|
||||
|
||||
fCommtAttrib.Style := [fsItalic];
|
||||
fKeywdAttrib.Style := [fsBold];
|
||||
|
||||
AddAttribute(fWhiteAttrib);
|
||||
AddAttribute(fNumbrAttrib);
|
||||
AddAttribute(fSymblAttrib);
|
||||
AddAttribute(fIdentAttrib);
|
||||
AddAttribute(fCommtAttrib);
|
||||
AddAttribute(fStrngAttrib);
|
||||
AddAttribute(fKeywdAttrib);
|
||||
AddAttribute(fCurrIAttrib);
|
||||
|
||||
fAttribLut[TTokenKind.tkident] := fIdentAttrib;
|
||||
fAttribLut[TTokenKind.tkBlank] := fWhiteAttrib;
|
||||
fAttribLut[TTokenKind.tkCommt] := fCommtAttrib;
|
||||
fAttribLut[TTokenKind.tkKeywd] := fKeywdAttrib;
|
||||
fAttribLut[TTokenKind.tkNumbr] := fNumbrAttrib;
|
||||
fAttribLut[TTokenKind.tkStrng] := fStrngAttrib;
|
||||
fAttribLut[TTokenKind.tksymbl] := fSymblAttrib;
|
||||
fAttribLut[TTokenKind.tkCurrI] := fCurrIAttrib;
|
||||
|
||||
SetAttributesOnChange(@doAttribChange);
|
||||
fTokStop := 1;
|
||||
next;
|
||||
end;
|
||||
|
||||
destructor TSynD2Syn.destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.doChanged;
|
||||
begin
|
||||
BeginUpdate;
|
||||
fUpdateChange := true;
|
||||
EndUpdate;
|
||||
end;
|
||||
|
||||
{$HINTS OFF}
|
||||
procedure TSynD2Syn.doAttribChange(sender: TObject);
|
||||
begin
|
||||
doChanged;
|
||||
end;
|
||||
{$HINTS ON}
|
||||
|
||||
procedure TSynD2Syn.setFoldKinds(aValue: TFoldKinds);
|
||||
begin
|
||||
fFoldKinds := aValue;
|
||||
DoFoldConfigChanged(Self);
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setWhiteAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fWhiteAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setNumbrAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fNumbrAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setSymblAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fSymblAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setIdentAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fIdentAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setCommtAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fCommtAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setStrngAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fStrngAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setKeywdAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fKeywdAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setCurrIAttrib(aValue: TSynHighlighterAttributes);
|
||||
begin
|
||||
fCurrIAttrib.Assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setCurrIdent(const aValue: string);
|
||||
begin
|
||||
if aValue = '' then exit;
|
||||
if fCurrIdent = aValue then Exit;
|
||||
fCurrIdent := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.setLine(const NewValue: String; LineNumber: Integer);
|
||||
begin
|
||||
inherited;
|
||||
fLineBuf := NewValue + #10;
|
||||
fTokStop := 1;
|
||||
next;
|
||||
end;
|
||||
|
||||
{$IFDEF DEBUG}{$R-}{$ENDIF}
|
||||
function TSynD2Syn.readNext: Char; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
Inc(fTokStop);
|
||||
result := fLineBuf[fTokStop];
|
||||
end;
|
||||
{$IFDEF DEBUG}{$R+}{$ENDIF}
|
||||
|
||||
function TSynD2Syn.readCurr: Char; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := fLineBuf[fTokStop];
|
||||
end;
|
||||
|
||||
function TSynD2Syn.readPrev: Char; {$IFNDEF DEBUG}inline;{$ENDIF}
|
||||
begin
|
||||
result := fLineBuf[fTokStop-1];
|
||||
end;
|
||||
|
||||
{
|
||||
TODO:
|
||||
- binary literals.
|
||||
- alternative attributes for ddoc comments.
|
||||
- asm range.
|
||||
- stricter number litterals.
|
||||
- string literals: custom token, escape "\" not handled.
|
||||
- correct nested comments handling.
|
||||
}
|
||||
|
||||
procedure TSynD2Syn.next;
|
||||
begin
|
||||
|
||||
fTokStart := fTokStop;
|
||||
fTokStop := fTokStart;
|
||||
|
||||
// EOL
|
||||
if fTokStop > length(fLineBuf) then exit;
|
||||
|
||||
// spaces
|
||||
if isWhite(readCurr) then
|
||||
begin
|
||||
fTokKind := tkBlank;
|
||||
while (isWhite(readNext)) do (*!*);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// line comment
|
||||
if fRange = rkNone then if (readCurr = '/') then
|
||||
begin
|
||||
if (readNext = '/') then
|
||||
begin
|
||||
while readNext <> #10 do (*!*);
|
||||
fTokKind := tkCommt;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
Dec(fTokStop);
|
||||
end;
|
||||
|
||||
// block comments 1
|
||||
if fRange = rkBlockCom1 then
|
||||
begin
|
||||
while(true) do
|
||||
begin
|
||||
if readCurr = #10 then break;
|
||||
if readNext = #10 then break;
|
||||
if (readPrev = '*') and (readCurr = '/') then break;
|
||||
end;
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkBlockCom1;
|
||||
fTokKind := tkCommt;
|
||||
exit;
|
||||
end;
|
||||
if (readCurr = '/') then
|
||||
begin
|
||||
fTokKind := tkCommt;
|
||||
fRange := rkNone;
|
||||
readNext;
|
||||
if fkComments1 in fFoldKinds then
|
||||
EndCodeFoldBlock;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if fRange <> rkBlockCom2 then if (readCurr <> #10) and (readCurr = '/') then if (readNext = '*') then
|
||||
begin
|
||||
if fRange = rkNone then
|
||||
begin
|
||||
while(true) do
|
||||
begin
|
||||
if readCurr = #10 then break;
|
||||
if readNext = #10 then break;
|
||||
if (readPrev = '*') and (readCurr = '/') then break;
|
||||
end;
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkBlockCom1;
|
||||
if fkComments1 in fFoldKinds then
|
||||
StartCodeFoldBlock(nil);
|
||||
end
|
||||
else readNext;
|
||||
fTokKind := tkCommt;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else Dec(fTokStop);
|
||||
|
||||
// block comments 2
|
||||
if fRange = rkBlockCom2 then
|
||||
begin
|
||||
while(true) do
|
||||
begin
|
||||
if readCurr = #10 then break;
|
||||
if readNext = #10 then break;
|
||||
if (readPrev = '+') and (readCurr = '/') then break;
|
||||
end;
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkBlockCom2;
|
||||
fTokKind := tkCommt;
|
||||
exit;
|
||||
end;
|
||||
if (readCurr = '/') then
|
||||
begin
|
||||
fTokKind := tkCommt;
|
||||
fRange := rkNone;
|
||||
readNext;
|
||||
if fkComments2 in fFoldKinds then
|
||||
EndCodeFoldBlock;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if fRange <> rkBlockCom1 then if (readCurr <> #10) and (readCurr = '/') then if (readNext = '+') then
|
||||
begin
|
||||
if fRange = rkNone then
|
||||
begin
|
||||
while(true) do
|
||||
begin
|
||||
if readCurr = #10 then break;
|
||||
if readNext = #10 then break;
|
||||
if (readPrev = '+') and (readCurr = '/') then break;
|
||||
end;
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkBlockCom2;
|
||||
if fkComments2 in fFoldKinds then
|
||||
StartCodeFoldBlock(nil);
|
||||
end
|
||||
else readNext;
|
||||
fTokKind := tkCommt;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else Dec(fTokStop);
|
||||
|
||||
// string 1
|
||||
if fRange = rkString1 then
|
||||
begin
|
||||
if (readCurr <> '"') then while ((readNext <> '"') and (not (readCurr = #10))) do (*!*);
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkString1;
|
||||
fTokKind := tkStrng;
|
||||
exit;
|
||||
end;
|
||||
if (readCurr = '"') then
|
||||
begin
|
||||
fTokKind := tkStrng;
|
||||
fRange := rkNone;
|
||||
readNext;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if fRange <> rkString2 then if (readCurr = '"') then
|
||||
begin
|
||||
if fRange = rkNone then
|
||||
begin
|
||||
while ((readNext <> '"') and (not (readCurr = #10))) do (*!*);
|
||||
if (readCurr = #10) then fRange := rkString1
|
||||
else readNext;
|
||||
fTokKind := tkStrng;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// string 2
|
||||
if fRange = rkString2 then
|
||||
begin
|
||||
if (readCurr <> '`') then while ((readNext <> '`') and (not (readCurr = #10))) do (*!*);
|
||||
if (readCurr = #10) then
|
||||
begin
|
||||
fRange := rkString2;
|
||||
fTokKind := tkStrng;
|
||||
exit;
|
||||
end;
|
||||
if (readCurr = '`') then
|
||||
begin
|
||||
fTokKind := tkStrng;
|
||||
fRange := rkNone;
|
||||
readNext;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if fRange <> rkString1 then if (readCurr = '`') then
|
||||
begin
|
||||
if fRange = rkNone then
|
||||
begin
|
||||
while ((readNext <> '`') and (not (readCurr = #10))) do (*!*);
|
||||
if (readCurr = #10) then fRange := rkString2
|
||||
else readNext;
|
||||
fTokKind := tkStrng;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// char literals
|
||||
if fRange = rkNone then if (readCurr = #39) then
|
||||
begin
|
||||
while ((readNext <> #39) and (not (readCurr = #10))) do (*!*);
|
||||
if (readCurr = #39) then
|
||||
begin
|
||||
fTokKind := tkStrng;
|
||||
readNext;
|
||||
exit;
|
||||
end;
|
||||
fTokStop := fTokStart;
|
||||
end;
|
||||
|
||||
// numbers 1
|
||||
if (isNumber(readCurr)) then
|
||||
begin
|
||||
while isAlNum(readNext) or (readCurr = '_') or (readCurr = '.') do (*!*);
|
||||
fTokKind := tkNumbr;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// symbols 1: ponctuation
|
||||
if isSymbol(readCurr) then
|
||||
begin
|
||||
fTokKind := tkSymbl;
|
||||
if (fkBrackets in fFoldKinds) then case readCurr of
|
||||
'{': StartCodeFoldBlock(nil);
|
||||
'}': EndCodeFoldBlock;
|
||||
end;
|
||||
readNext;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// symbols 2: operators
|
||||
if isOperator(readCurr) then
|
||||
begin
|
||||
fTokKind := tkSymbl;
|
||||
while isOperator(readNext) do (*!*);
|
||||
case fTokStop - fTokStart of
|
||||
1:begin
|
||||
if not isOperator(readCurr) then exit
|
||||
else Dec(fTokStop);
|
||||
end;
|
||||
2:begin
|
||||
if (not isOperator(readCurr)) and
|
||||
isDoubleOperator(fLineBuf[fTokStart..fTokStop-1])
|
||||
then exit
|
||||
else Dec(fTokStop, 2);
|
||||
end;
|
||||
3:begin
|
||||
if (not isOperator(readCurr)) and
|
||||
isTripleOperator(fLineBuf[fTokStart..fTokStop-1])
|
||||
then exit
|
||||
else Dec(fTokStop, 3);
|
||||
end;
|
||||
4:begin
|
||||
if (not isOperator(readCurr)) and
|
||||
isQuadOperator(fLineBuf[fTokStart..fTokStop-1])
|
||||
then exit
|
||||
else Dec(fTokStop, 4);
|
||||
end;
|
||||
end;
|
||||
fTokKind := tkIdent;
|
||||
end;
|
||||
|
||||
// Keyword - Identifier
|
||||
if not isWhite(readCurr) then
|
||||
begin
|
||||
fTokKind := tkIdent;
|
||||
while(true) do
|
||||
begin
|
||||
if isWhite(readNext) then break;
|
||||
if isSymbol(readCurr) then break;
|
||||
if isOperator(readCurr) then break;
|
||||
end;
|
||||
if fKeyWords.find(fLineBuf[FTokStart..fTokStop-1]) then
|
||||
fTokKind := tkKeywd
|
||||
else
|
||||
if fLineBuf[FTokStart..fTokStop-1] = fCurrIdent then
|
||||
fTokKind := tkCurrI;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if fLineBuf[fTokStop] = #10 then exit;
|
||||
|
||||
// Should not happend
|
||||
assert(false);
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetEol: Boolean;
|
||||
begin
|
||||
result := fTokStop > length(fLineBuf);
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetTokenAttribute: TSynHighlighterAttributes;
|
||||
begin
|
||||
result := fAttribLut[fTokKind];
|
||||
end;
|
||||
|
||||
{$WARNINGS OFF} {$HINTS OFF}
|
||||
procedure TSynD2Syn.SetRange(Value: Pointer);
|
||||
begin
|
||||
inherited SetRange(Value);
|
||||
fRange := TRangeKind(PtrInt(CodeFoldRange.RangeType));
|
||||
end;
|
||||
{$HINTS ON} {$WARNINGS ON}
|
||||
|
||||
{$HINTS OFF}
|
||||
function TSynD2Syn.GetRange: Pointer;
|
||||
begin
|
||||
CodeFoldRange.RangeType := Pointer(PtrInt(fRange));
|
||||
Result := inherited GetRange;
|
||||
end;
|
||||
{$HINTS ON}
|
||||
|
||||
procedure TSynD2Syn.ResetRange;
|
||||
begin
|
||||
fRange := rkNone;
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetTokenPos: Integer;
|
||||
begin
|
||||
result := fTokStart - 1;
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetToken: string;
|
||||
begin
|
||||
result := copy(fLineBuf, FTokStart, fTokStop - FTokStart);
|
||||
end;
|
||||
|
||||
procedure TSynD2Syn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
|
||||
begin
|
||||
TokenStart := @fLineBuf[FTokStart];
|
||||
TokenLength := fTokStop - FTokStart;
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
|
||||
begin
|
||||
case Index of
|
||||
SYN_ATTR_COMMENT: Result := fCommtAttrib;
|
||||
SYN_ATTR_IDENTIFIER: Result := fIdentAttrib;
|
||||
SYN_ATTR_KEYWORD: Result := fKeywdAttrib;
|
||||
SYN_ATTR_STRING: Result := fStrngAttrib;
|
||||
SYN_ATTR_WHITESPACE: Result := fWhiteAttrib;
|
||||
SYN_ATTR_SYMBOL: Result := fSymblAttrib;
|
||||
else Result := fIdentAttrib;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSynD2Syn.GetTokenKind: integer;
|
||||
var
|
||||
a: TSynHighlighterAttributes;
|
||||
begin
|
||||
Result := SYN_ATTR_IDENTIFIER;
|
||||
a := GetTokenAttribute;
|
||||
if a = fIdentAttrib then Result := SYN_ATTR_IDENTIFIER else
|
||||
if a = fWhiteAttrib then Result := SYN_ATTR_WHITESPACE else
|
||||
if a = fCommtAttrib then Result := SYN_ATTR_COMMENT else
|
||||
if a = fKeywdAttrib then Result := SYN_ATTR_KEYWORD else
|
||||
if a = fStrngAttrib then Result := SYN_ATTR_STRING else
|
||||
if a = fSymblAttrib then Result := SYN_ATTR_SYMBOL else
|
||||
if a = fNumbrAttrib then Result := Ord(TTokenKind.tkNumbr);
|
||||
end;
|
||||
|
||||
initialization
|
||||
registerClasses([TSynD2Syn]);
|
||||
end.
|
||||
|
|
@ -0,0 +1,577 @@
|
|||
unit ce_dmdwrap;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
classes, sysutils;
|
||||
|
||||
|
||||
type
|
||||
|
||||
(*****************************************************************************
|
||||
* Base class for encapsulating some compiler options.
|
||||
* A descendant must be able to generate the related options
|
||||
* as a string representing the partial switches/arguments.
|
||||
*)
|
||||
TOptsGroup = class(TPersistent)
|
||||
private
|
||||
fOnChange: TNotifyEvent;
|
||||
procedure doChanged;
|
||||
protected
|
||||
property onChange: TNotifyEvent read fOnChange write fOnChange;
|
||||
public
|
||||
function getOpts: string; virtual; abstract;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates the options/args related to the DDoc and JSON generation.
|
||||
*)
|
||||
TDocOpts = class(TOptsGroup)
|
||||
private
|
||||
fGenDoc: boolean;
|
||||
fDocDir: string;
|
||||
fGenJson: boolean;
|
||||
fJsonFname: string;
|
||||
procedure setGenDoc(const aValue: boolean);
|
||||
procedure setGenJSON(const aValue: boolean);
|
||||
procedure setDocDir(const aValue: string);
|
||||
procedure setJSONFile(const aValue: string);
|
||||
published
|
||||
property generateDocumentation: boolean read fGenDoc write setGenDoc;
|
||||
property generateJSON: boolean read fGenJson write setGenJSON;
|
||||
property DocumentationDirectory: string read fDocDir write setDocDir;
|
||||
property JSONFilename: string read fJsonFname write setJSONFile;
|
||||
public
|
||||
function getOpts: string; override;
|
||||
end;
|
||||
|
||||
|
||||
(*****************************************************************************
|
||||
* Describes the different depreciation treatments.
|
||||
*)
|
||||
TDepHandling = (silent, warning, error);
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates the options/args related to the compiler output messages.
|
||||
*)
|
||||
TMsgOpts = class(TOptsGroup)
|
||||
private
|
||||
fDepHandling : TDepHandling; // could be also related to analysis
|
||||
fVerb: boolean;
|
||||
fWarn: boolean;
|
||||
fWarnEx: boolean;
|
||||
fVtls: boolean;
|
||||
fQuiet: boolean;
|
||||
fProp: boolean;
|
||||
procedure setDepHandling(const aValue: TDepHandling);
|
||||
procedure setVerb(const aValue: boolean);
|
||||
procedure setWarn(const aValue: boolean);
|
||||
procedure setWarnEx(const aValue: boolean);
|
||||
procedure setVtls(const aValue: boolean);
|
||||
procedure setQuiet(const aValue: boolean);
|
||||
published
|
||||
property depreciationHandling: TDepHandling read fDepHandling write setDepHandling;
|
||||
property verbose: boolean read fVerb write setVerb;
|
||||
property warnings: boolean read fWarn write setWarn;
|
||||
property additionalWarnings: boolean read fWarnEx write setWarnEx;
|
||||
property tlsInformations: boolean read fVtls write setVtls;
|
||||
property quiet: boolean read fQuiet write setQuiet;
|
||||
public
|
||||
function getOpts: string; override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates the options/args related to the analysis & the code gen.
|
||||
*)
|
||||
TOutputOpts= class(TOptsGroup)
|
||||
private
|
||||
fInline: boolean;
|
||||
fNoBounds: boolean;
|
||||
fOptims: boolean;
|
||||
fGenStack: boolean;
|
||||
fMain: boolean;
|
||||
fRelease: boolean;
|
||||
procedure setInline(const aValue: boolean);
|
||||
procedure setNoBounds(const aValue: boolean);
|
||||
procedure setOptims(const aValue: boolean);
|
||||
procedure setGenStack(const aValue: boolean);
|
||||
procedure setMain(const aValue: boolean);
|
||||
procedure setRelease(const aValue: boolean);
|
||||
published
|
||||
property inlining: boolean read fInline write setInline;
|
||||
property noBoundsCheck: boolean read fNoBounds write setNoBounds;
|
||||
property optimisations: boolean read fOptims write setOptims;
|
||||
property generateStackFrame: boolean read fGenStack write setGenStack;
|
||||
property addMain: boolean read fMain write setMain;
|
||||
property release: boolean read fRelease write setRelease;
|
||||
public
|
||||
function getOpts: string; override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Describes the target registry size
|
||||
*)
|
||||
TTargetSystem = (auto, os32bit, os64bit);
|
||||
(**
|
||||
* Describes the output kind
|
||||
*)
|
||||
TBinaryKind = (executable, staticlib, sharedlib);
|
||||
|
||||
(**
|
||||
* Encapsulates the options/args related to the debuging
|
||||
*)
|
||||
TDebugOpts = class(TOptsGroup)
|
||||
private
|
||||
fDbg: boolean;
|
||||
fDbgIdent: string;
|
||||
fDbgD: boolean;
|
||||
fDbgC: boolean;
|
||||
fMap: boolean;
|
||||
published
|
||||
public
|
||||
//function getOpts: string; override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates the options/args related to the output and include paths
|
||||
*)
|
||||
TPathsOpts = class(TOptsGroup)
|
||||
private
|
||||
fSrcs: TStringList;
|
||||
fIncl: TStringList;
|
||||
fImpt: TStringList;
|
||||
fFname: string;
|
||||
fObjDir: string;
|
||||
procedure setFname(const aValue: string);
|
||||
procedure setObjDir(const aValue: string);
|
||||
procedure setSrcs(const aValue: TStringList);
|
||||
procedure setIncl(const aValue: TStringList);
|
||||
procedure setImpt(const aValue: TStringList);
|
||||
published
|
||||
property outputFilename: string read fFname write setFname;
|
||||
property objectDirectory: string read fObjDir write setObjDir;
|
||||
property Sources: TStringList read fSrcs write setSrcs; // not common srcs, made for static libs
|
||||
property Includes: TStringList read fIncl write setIncl;
|
||||
property Imports: TStringList read fImpt write setImpt;
|
||||
public
|
||||
constructor create;
|
||||
destructor destroy; override;
|
||||
function getOpts: string; override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates the unclassified and custom options/args
|
||||
*)
|
||||
TOtherOpts = class(TOptsGroup)
|
||||
private
|
||||
fCustom: TStringList;
|
||||
procedure setCustom(const aValue: TStringList);
|
||||
published
|
||||
property customOptions: TStringList read fCustom write setCustom;
|
||||
public
|
||||
constructor create;
|
||||
destructor destroy; override;
|
||||
function getOpts: string; override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
* Encapsulates all the contextual options/args
|
||||
*)
|
||||
TCompilerConfiguration = class(TCollectionItem)
|
||||
private
|
||||
fName: string;
|
||||
fOnChanged: TNotifyEvent;
|
||||
fDocOpts: TDocOpts;
|
||||
fDebugOpts: TDebugOpts;
|
||||
fMsgOpts: TMsgOpts;
|
||||
fOutputOpts: TOutputOpts;
|
||||
fPathsOpts: TPathsOpts;
|
||||
fOthers: TOtherOpts;
|
||||
procedure doChanged;
|
||||
procedure subOptsChanged(sender: TObject);
|
||||
procedure setName(const aValue: string);
|
||||
procedure setDocOpts(const aValue: TDocOpts);
|
||||
procedure setDebugOpts(const aValue: TDebugOpts);
|
||||
procedure setMsgOpts(const aValue: TMsgOpts);
|
||||
procedure setOutputOpts(const aValue: TOutputOpts);
|
||||
procedure setPathsOpts(const aValue: TPathsOpts);
|
||||
procedure setOthers(const aValue: TOtherOpts);
|
||||
protected
|
||||
function nameFromID: string;
|
||||
function getCmdLine: string;
|
||||
published
|
||||
property name: string read fName write setName;
|
||||
property documentationOptions: TDocOpts read fDocOpts write setDocOpts;
|
||||
property debugingOptions: TDebugOpts read fDebugOpts write setDebugOpts;
|
||||
property messagesOptions: TMsgOpts read fMsgOpts write setMsgOpts;
|
||||
property outputOptions: TOutputOpts read fOutputOpts write setOutputOpts;
|
||||
property pathsOptions: TPathsOpts read fPathsOpts write setPathsOpts;
|
||||
property otherOptions: TOtherOpts read fOthers write setOthers;
|
||||
public
|
||||
constructor create(aCollection: TCollection); override;
|
||||
destructor destroy; override;
|
||||
property cmdLine: string read getCmdLine;
|
||||
property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
(*******************************************************************************
|
||||
* TOptsGroup
|
||||
*)
|
||||
procedure TOptsGroup.doChanged;
|
||||
begin
|
||||
if assigned(fOnChange) then fOnChange(self);
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TDocOpts
|
||||
*)
|
||||
function TDocOpts.getOpts: string;
|
||||
begin
|
||||
result := '';
|
||||
if fGenDoc then result += '-D ';
|
||||
if fGenJson then result += '-X ';
|
||||
if fDocDir <> '' then result += '-Dd' + '"' + fDocDir + '" ';
|
||||
if fJsonFname <> '' then result += '-Xf' + '"'+ fJsonFname + '" ';
|
||||
end;
|
||||
|
||||
procedure TDocOpts.setGenDoc(const aValue: boolean);
|
||||
begin
|
||||
if fGenDoc = aValue then exit;
|
||||
fGenDoc := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TDocOpts.setGenJSON(const aValue: boolean);
|
||||
begin
|
||||
if fGenJson = aValue then exit;
|
||||
fGenJson := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TDocOpts.setDocDir(const aValue: string);
|
||||
begin
|
||||
if fDocDir = aValue then exit;
|
||||
fDocDir := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TDocOpts.setJSONFile(const aValue: string);
|
||||
begin
|
||||
if fJsonFname = aValue then exit;
|
||||
fJsonFname := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TMsgOpts
|
||||
*)
|
||||
function TMsgOpts.getOpts: string;
|
||||
const
|
||||
DepStr : array[TDepHandling] of string = ('-d ','-dw ','-de ');
|
||||
begin
|
||||
result := DepStr[fDepHandling];
|
||||
if fVerb then result += '-v ';
|
||||
if fWarn then result += '-w ';
|
||||
if fWarnEx then result += '-wi ';
|
||||
if fVtls then result += '-vtls ';
|
||||
if fQuiet then result += '-quiet ';
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setDepHandling(const aValue: TDepHandling);
|
||||
begin
|
||||
if fDepHandling = aValue then exit;
|
||||
fDepHandling := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setVerb(const aValue: boolean);
|
||||
begin
|
||||
if fVerb = aValue then exit;
|
||||
fVerb := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setWarn(const aValue: boolean);
|
||||
begin
|
||||
if fWarn = aValue then exit;
|
||||
fWarn := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setWarnEx(const aValue: boolean);
|
||||
begin
|
||||
if fWarnEx = aValue then exit;
|
||||
fWarnEx := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setVtls(const aValue: boolean);
|
||||
begin
|
||||
if fVtls = aValue then exit;
|
||||
fVtls := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.setQuiet(const aValue: boolean);
|
||||
begin
|
||||
if fQuiet = aValue then exit;
|
||||
fQuiet := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TOutputOpts
|
||||
*)
|
||||
function TOutputOpts.getOpts: string;
|
||||
begin
|
||||
result := '';
|
||||
if fInline then result += '-inline ';
|
||||
if fNoBounds then result += '-noboundscheck ';
|
||||
if fOptims then result += '-O ';
|
||||
if fGenStack then result += '-gs ';
|
||||
if fMain then result += '-main ';
|
||||
if fRelease then result += '-release ';
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setInline(const aValue: boolean);
|
||||
begin
|
||||
if fInline = aValue then exit;
|
||||
fInline := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setNoBounds(const aValue: boolean);
|
||||
begin
|
||||
if fNoBounds = aValue then exit;
|
||||
fNoBounds := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setOptims(const aValue: boolean);
|
||||
begin
|
||||
if fOptims = aValue then exit;
|
||||
fOptims := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setGenStack(const aValue: boolean);
|
||||
begin
|
||||
if fGenStack = aValue then exit;
|
||||
fGenStack := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setMain(const aValue: boolean);
|
||||
begin
|
||||
if fMain = aValue then exit;
|
||||
fMain := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.setRelease(const aValue: boolean);
|
||||
begin
|
||||
if fRelease = aValue then exit;
|
||||
fRelease := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TPathsOpts
|
||||
*)
|
||||
function TPathsOpts.getOpts: string;
|
||||
var
|
||||
str: string;
|
||||
begin
|
||||
result := '';
|
||||
for str in fSrcs do
|
||||
result += '"'+ str +'" ';
|
||||
for str in fIncl do
|
||||
result += '-I"'+ str +'" ';
|
||||
for str in fImpt do
|
||||
result += '-J"'+ str +'" ';
|
||||
if fFname <> '' then result += '-of"' + fFname + '" ';
|
||||
if fObjDir <> '' then result += '-od"' + fObjDir + '" ';
|
||||
end;
|
||||
|
||||
constructor TPathsOpts.create;
|
||||
begin
|
||||
fSrcs := TStringList.Create;
|
||||
fIncl := TStringList.Create;
|
||||
fImpt := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TPathsOpts.destroy;
|
||||
begin
|
||||
fSrcs.free;
|
||||
fIncl.free;
|
||||
fImpt.free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.setFname(const aValue: string);
|
||||
begin
|
||||
if fFname = aValue then exit;
|
||||
fFname := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.setObjDir(const aValue: string);
|
||||
begin
|
||||
if fObjDir = aValue then exit;
|
||||
fObjDir := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.setSrcs(const aValue: TStringList);
|
||||
begin
|
||||
fSrcs.Assign(aValue);
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.setIncl(const aValue: TStringList);
|
||||
begin
|
||||
fIncl.Assign(aValue);
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.setImpt(const aValue: TStringList);
|
||||
begin
|
||||
fImpt.Assign(aValue);
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TOtherOpts
|
||||
*)
|
||||
constructor TOtherOpts.create;
|
||||
begin
|
||||
fCustom := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TOtherOpts.destroy;
|
||||
begin
|
||||
fCustom.Destroy;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TOtherOpts.getOpts: string;
|
||||
var
|
||||
str: string;
|
||||
begin
|
||||
result := '';
|
||||
for str in fCustom do
|
||||
result += str + ' ';
|
||||
end;
|
||||
|
||||
procedure TOtherOpts.setCustom(const aValue: TStringList);
|
||||
begin
|
||||
fCustom.Assign(aValue);
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TCompilerConfiguration
|
||||
*)
|
||||
constructor TCompilerConfiguration.create(aCollection: TCollection);
|
||||
begin
|
||||
inherited create(aCollection);
|
||||
|
||||
fDocOpts := TDocOpts.create;
|
||||
fDebugOpts := TDebugOpts.create;
|
||||
fMsgOpts := TMsgOpts.create;
|
||||
fOutputOpts := TOutputOpts.create;
|
||||
fPathsOpts := TPathsOpts.create;
|
||||
fOthers := TOtherOpts.create;
|
||||
|
||||
fDocOpts.onChange := @subOptsChanged;
|
||||
fDebugOpts.onChange := @subOptsChanged;
|
||||
fMsgOpts.onChange := @subOptsChanged;
|
||||
fOutputOpts.onChange := @subOptsChanged;
|
||||
fPathsOpts.onChange := @subOptsChanged;
|
||||
fOthers.onChange := @subOptsChanged;
|
||||
|
||||
fName := nameFromID;
|
||||
end;
|
||||
|
||||
destructor TCompilerConfiguration.destroy;
|
||||
begin
|
||||
fDocOpts.free;
|
||||
fDebugOpts.free;
|
||||
fMsgOpts.free;
|
||||
fOutputOpts.free;
|
||||
fPathsOpts.free;
|
||||
fOthers.free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCompilerConfiguration.nameFromID: string;
|
||||
begin
|
||||
result := format('<configuration %d>',[ID]);
|
||||
end;
|
||||
|
||||
function TCompilerConfiguration.getCmdLine: string;
|
||||
begin
|
||||
result :=
|
||||
fDocOpts.getOpts + (*fDebugOpts.getOpts +*) fMsgOpts.getOpts
|
||||
+ fOutputOpts.getOpts + fPathsOpts.getOpts + fOthers.getOpts;
|
||||
if result[length(result)] = ' ' then
|
||||
setlength(result, length(result)-1);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setName(const aValue: string);
|
||||
begin
|
||||
if fName = aValue then exit;
|
||||
fName := aValue;
|
||||
if fName = '' then fName := nameFromID;
|
||||
Changed(true);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.subOptsChanged(sender: TObject);
|
||||
begin
|
||||
Changed(true);
|
||||
doChanged;
|
||||
{$IFDEF DEBUG}
|
||||
writeln( #13#10 + getCmdLine);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.doChanged;
|
||||
begin
|
||||
if assigned(fOnChanged) then fOnChanged(self);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setDocOpts(const aValue: TDocOpts);
|
||||
begin
|
||||
fDocOpts.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setDebugOpts(const aValue: TDebugOpts);
|
||||
begin
|
||||
fDebugOpts.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setMsgOpts(const aValue: TMsgOpts);
|
||||
begin
|
||||
fMsgOpts.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setOutputOpts(const aValue: TOutputOpts);
|
||||
begin
|
||||
fOutputOpts.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setPathsOpts(const aValue: TPathsOpts);
|
||||
begin
|
||||
fPathsOpts.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setOthers(const aValue: TOtherOpts);
|
||||
begin
|
||||
fOthers.Assign(aValue);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
inherited CEEditorWidget: TCEEditorWidget
|
||||
Left = 1248
|
||||
Height = 514
|
||||
Top = 89
|
||||
Width = 457
|
||||
Caption = 'EditorWidget'
|
||||
ClientHeight = 514
|
||||
ClientWidth = 457
|
||||
inherited Back: TPanel
|
||||
Height = 514
|
||||
Width = 457
|
||||
ClientHeight = 514
|
||||
ClientWidth = 457
|
||||
inherited Content: TScrollBox
|
||||
Height = 488
|
||||
Width = 457
|
||||
HorzScrollBar.Page = 453
|
||||
VertScrollBar.Page = 484
|
||||
ClientHeight = 484
|
||||
ClientWidth = 453
|
||||
object PageControl: TExtendedNotebook[0]
|
||||
Left = 2
|
||||
Height = 480
|
||||
Top = 2
|
||||
Width = 449
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 2
|
||||
TabOrder = 0
|
||||
OnChange = PageControlChange
|
||||
end
|
||||
end
|
||||
inherited Header: TPanel
|
||||
Width = 457
|
||||
end
|
||||
end
|
||||
object macRecorder: TSynMacroRecorder[1]
|
||||
RecordShortCut = 24658
|
||||
PlaybackShortCut = 24656
|
||||
left = 8
|
||||
top = 8
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,119 @@
|
|||
unit ce_editor;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, ExtendedNotebook, Forms, Controls, Graphics,
|
||||
SynEditKeyCmds, ComCtrls, SynEditHighlighter, SynEditHighlighterFoldBase, SynMacroRecorder,
|
||||
SynPluginSyncroEdit, SynEdit, Dialogs, ExtCtrls, ce_frame, ce_d2syn, ce_synmemo;
|
||||
|
||||
type
|
||||
{ TCEWidgetEditor }
|
||||
|
||||
{ TCEEditorWidget }
|
||||
|
||||
TCEEditorWidget = class(TCEWidget)
|
||||
PageControl: TExtendedNotebook;
|
||||
macRecorder: TSynMacroRecorder;
|
||||
procedure PageControlChange(Sender: TObject);
|
||||
private
|
||||
function getCurrentEditor: TCESynMemo;
|
||||
function getEditor(index: NativeInt): TCESynMemo;
|
||||
function getEditorCount: NativeInt;
|
||||
function getEditorIndex: NativeInt;
|
||||
procedure identifierToD2Syn(const aMemo: TCESynMemo);
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
procedure addEditor;
|
||||
//
|
||||
procedure memoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure memoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
//
|
||||
property currentEditor: TCESynMemo read getCurrentEditor;
|
||||
property editor[index: NativeInt]: TCESynMemo read getEditor;
|
||||
property editorCount: NativeInt read getEditorCount;
|
||||
property editorIndex: NativeInt read getEditorIndex;
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
constructor TCEEditorWidget.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fID := 'ID_EDIT';
|
||||
end;
|
||||
|
||||
destructor TCEEditorWidget.destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCEEditorWidget.getEditorCount: NativeInt;
|
||||
begin
|
||||
result := pageControl.PageCount;
|
||||
end;
|
||||
|
||||
function TCEEditorWidget.getEditorIndex: NativeInt;
|
||||
begin
|
||||
result := pageControl.PageIndex;
|
||||
end;
|
||||
|
||||
function TCEEditorWidget.getCurrentEditor: TCESynMemo;
|
||||
begin
|
||||
if pageControl.PageCount = 0 then result := nil
|
||||
else result := TCESynMemo(pageControl.ActivePage.Controls[0]);
|
||||
end;
|
||||
|
||||
function TCEEditorWidget.getEditor(index: NativeInt): TCESynMemo;
|
||||
begin
|
||||
result := TCESynMemo(pageControl.Pages[index].Controls[0]);
|
||||
end;
|
||||
|
||||
procedure TCEEditorWidget.PageControlChange(Sender: TObject);
|
||||
begin
|
||||
//http://bugs.freepascal.org/view.php?id=26320
|
||||
macRecorder.Editor := getCurrentEditor;
|
||||
end;
|
||||
|
||||
procedure TCEEditorWidget.addEditor;
|
||||
var
|
||||
sheet: TTabSheet;
|
||||
memo: TCESynMemo;
|
||||
begin
|
||||
sheet := pageControl.AddTabSheet;
|
||||
memo := TCESynMemo.Create(sheet);
|
||||
//
|
||||
memo.Align:=alClient;
|
||||
memo.Parent := sheet;
|
||||
//
|
||||
memo.OnKeyDown := @memoKeyDown;
|
||||
memo.OnKeyUp := @memoKeyDown;
|
||||
memo.OnMouseDown := @memoMouseDown;
|
||||
//
|
||||
macRecorder.Editor := memo; //http://bugs.freepascal.org/view.php?id=26320
|
||||
end;
|
||||
|
||||
procedure TCEEditorWidget.identifierToD2Syn(const aMemo: TCESynMemo);
|
||||
begin
|
||||
D2Syn.CurrentIdentifier := aMemo.GetWordAtRowCol(aMemo.LogicalCaretXY);
|
||||
end;
|
||||
|
||||
procedure TCEEditorWidget.memoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if (sender is TCESynMemo) then
|
||||
identifierToD2Syn(TCESynMemo(Sender));
|
||||
end;
|
||||
|
||||
procedure TCEEditorWidget.memoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if (sender is TCESynMemo) then
|
||||
identifierToD2Syn(TCESynMemo(Sender));
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
object CEWidget: TCEWidget
|
||||
Left = 1180
|
||||
Height = 327
|
||||
Top = 523
|
||||
Width = 320
|
||||
Caption = 'CEWidget'
|
||||
ClientHeight = 327
|
||||
ClientWidth = 320
|
||||
LCLVersion = '1.2.2.0'
|
||||
object Back: TPanel
|
||||
Left = 0
|
||||
Height = 327
|
||||
Top = 0
|
||||
Width = 320
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 327
|
||||
ClientWidth = 320
|
||||
TabOrder = 0
|
||||
object Content: TScrollBox
|
||||
Left = 0
|
||||
Height = 301
|
||||
Top = 26
|
||||
Width = 320
|
||||
HorzScrollBar.Page = 316
|
||||
VertScrollBar.Page = 297
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
end
|
||||
object Header: TPanel
|
||||
Left = 0
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 320
|
||||
Align = alTop
|
||||
BevelOuter = bvNone
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
unit ce_frame;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, ce_common;
|
||||
|
||||
type
|
||||
|
||||
(**
|
||||
* Base type for an UI module.
|
||||
*)
|
||||
PTCEWidget = ^TCEWidget;
|
||||
|
||||
{ TCEWidget }
|
||||
TCEWidget = class(TForm)
|
||||
Content: TScrollBox;
|
||||
Back: TPanel;
|
||||
Header: TPanel;
|
||||
protected
|
||||
fID: string;
|
||||
published
|
||||
property ID: string read fID write fID;
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
end;
|
||||
|
||||
(**
|
||||
* Holds a list of TCEWidget.
|
||||
*)
|
||||
TCEWidgetList = class(TList)
|
||||
private
|
||||
function getWidget(index: integer): TCEWidget;
|
||||
public
|
||||
procedure addWidget(aValue: PTCEWidget);
|
||||
property frame[index: integer]: TCEWidget read getWidget;
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
|
||||
constructor TCEWidget.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fID := 'ID_XXXX';
|
||||
end;
|
||||
|
||||
destructor TCEWidget.destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
(*******************************************************************************
|
||||
* TFrameList
|
||||
*)
|
||||
function TCEWidgetList.getWidget(index: integer): TCEWidget;
|
||||
begin
|
||||
result := PTCEWidget(Items[index])^;
|
||||
end;
|
||||
|
||||
procedure TCEWidgetList.addWidget(aValue: PTCEWidget);
|
||||
begin
|
||||
add(Pointer(aValue));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
object CEMainForm: TCEMainForm
|
||||
Left = 1248
|
||||
Height = 52
|
||||
Top = 0
|
||||
Width = 655
|
||||
Caption = 'Coedit'
|
||||
Menu = mainMenu
|
||||
LCLVersion = '1.2.2.0'
|
||||
object mainMenu: TMainMenu
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = 'File'
|
||||
object MenuItem5: TMenuItem
|
||||
Action = actNewFile
|
||||
end
|
||||
object MenuItem2: TMenuItem
|
||||
Action = actOpenFile
|
||||
end
|
||||
object MenuItem6: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object MenuItem3: TMenuItem
|
||||
Action = actSaveFileAs
|
||||
end
|
||||
object MenuItem4: TMenuItem
|
||||
Action = actSaveFile
|
||||
end
|
||||
end
|
||||
object MenuItem7: TMenuItem
|
||||
Caption = 'Edit'
|
||||
object MenuItem15: TMenuItem
|
||||
Action = actCopy
|
||||
end
|
||||
object MenuItem16: TMenuItem
|
||||
Action = actCut
|
||||
end
|
||||
object MenuItem17: TMenuItem
|
||||
Action = actPaste
|
||||
end
|
||||
object MenuItem18: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object MenuItem19: TMenuItem
|
||||
Action = actUndo
|
||||
end
|
||||
object MenuItem20: TMenuItem
|
||||
Action = actRedo
|
||||
end
|
||||
object MenuItem21: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object MenuItem22: TMenuItem
|
||||
Action = actMacStartStop
|
||||
end
|
||||
object MenuItem23: TMenuItem
|
||||
Action = actMacPlay
|
||||
end
|
||||
end
|
||||
object MenuItem14: TMenuItem
|
||||
Caption = 'Project'
|
||||
end
|
||||
object MenuItem8: TMenuItem
|
||||
Caption = 'Run'
|
||||
object MenuItem9: TMenuItem
|
||||
Action = actCompAndRunFile
|
||||
end
|
||||
object MenuItem13: TMenuItem
|
||||
Action = ActCompAndRunFileWithArgs
|
||||
end
|
||||
object MenuItem10: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object MenuItem11: TMenuItem
|
||||
Action = actCompileProj
|
||||
end
|
||||
object MenuItem12: TMenuItem
|
||||
Action = ActCompileAndRunProj
|
||||
end
|
||||
end
|
||||
end
|
||||
object Actions: TActionList
|
||||
OnUpdate = ActionsUpdate
|
||||
left = 32
|
||||
object actSaveFile: TAction
|
||||
Category = 'File'
|
||||
Caption = 'Save file'
|
||||
OnExecute = actSaveFileExecute
|
||||
end
|
||||
object actCopy: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Copy'
|
||||
OnExecute = actCopyExecute
|
||||
ShortCut = 16451
|
||||
end
|
||||
object Action3: TAction
|
||||
Category = 'Project'
|
||||
Caption = 'Action3'
|
||||
end
|
||||
object Action4: TAction
|
||||
Category = 'Windows'
|
||||
Caption = 'Action4'
|
||||
end
|
||||
object actSaveFileAs: TAction
|
||||
Category = 'File'
|
||||
Caption = 'Save file as...'
|
||||
OnExecute = actSaveFileAsExecute
|
||||
end
|
||||
object actOpenFile: TAction
|
||||
Category = 'File'
|
||||
Caption = 'Open file...'
|
||||
OnExecute = actOpenFileExecute
|
||||
end
|
||||
object actNewFile: TAction
|
||||
Category = 'File'
|
||||
Caption = 'new empty file'
|
||||
OnExecute = actNewFileExecute
|
||||
end
|
||||
object actCompAndRunFile: TAction
|
||||
Category = 'Run'
|
||||
Caption = 'Compile and run file'
|
||||
OnExecute = actCompAndRunFileExecute
|
||||
end
|
||||
object ActCompAndRunFileWithArgs: TAction
|
||||
Category = 'Run'
|
||||
Caption = 'Compile and run file...'
|
||||
OnExecute = ActCompAndRunFileWithArgsExecute
|
||||
end
|
||||
object actCompileProj: TAction
|
||||
Category = 'Run'
|
||||
Caption = 'Compile project'
|
||||
end
|
||||
object ActCompileAndRunProj: TAction
|
||||
Category = 'Run'
|
||||
Caption = 'Compile and run project'
|
||||
end
|
||||
object Action1: TAction
|
||||
Category = 'Project'
|
||||
Caption = 'Action1'
|
||||
end
|
||||
object actPaste: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Paste'
|
||||
OnExecute = actPasteExecute
|
||||
ShortCut = 16470
|
||||
end
|
||||
object actCut: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Cut'
|
||||
OnExecute = actCutExecute
|
||||
ShortCut = 16472
|
||||
end
|
||||
object actUndo: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Undo'
|
||||
OnExecute = actUndoExecute
|
||||
ShortCut = 16474
|
||||
end
|
||||
object actRedo: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Redo'
|
||||
OnExecute = actRedoExecute
|
||||
ShortCut = 24666
|
||||
end
|
||||
object actMacStartStop: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Start/stop macro recording'
|
||||
OnExecute = actMacStartStopExecute
|
||||
ShortCut = 24658
|
||||
end
|
||||
object actMacPlay: TAction
|
||||
Category = 'Edit'
|
||||
Caption = 'Play macro'
|
||||
OnExecute = actMacPlayExecute
|
||||
ShortCut = 24656
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,453 @@
|
|||
unit ce_main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
|
||||
ActnList, ce_common, ce_frame, ce_messages, ce_editor, ce_project,
|
||||
ce_synmemo;
|
||||
|
||||
type
|
||||
|
||||
{ TCEMainForm }
|
||||
TCEMainForm = class(TForm)
|
||||
actCompAndRunFile: TAction;
|
||||
actCompileProj: TAction;
|
||||
ActCompileAndRunProj: TAction;
|
||||
ActCompAndRunFileWithArgs: TAction;
|
||||
Action1: TAction;
|
||||
actCut: TAction;
|
||||
actMacPlay: TAction;
|
||||
actMacStartStop: TAction;
|
||||
actRedo: TAction;
|
||||
actUndo: TAction;
|
||||
actPaste: TAction;
|
||||
actNewFile: TAction;
|
||||
actOpenFile: TAction;
|
||||
actSaveFileAs: TAction;
|
||||
actSaveFile: TAction;
|
||||
actCopy: TAction;
|
||||
Action3: TAction;
|
||||
Action4: TAction;
|
||||
Actions: TActionList;
|
||||
mainMenu: TMainMenu;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem10: TMenuItem;
|
||||
MenuItem11: TMenuItem;
|
||||
MenuItem12: TMenuItem;
|
||||
MenuItem13: TMenuItem;
|
||||
MenuItem14: TMenuItem;
|
||||
MenuItem15: TMenuItem;
|
||||
MenuItem16: TMenuItem;
|
||||
MenuItem17: TMenuItem;
|
||||
MenuItem18: TMenuItem;
|
||||
MenuItem19: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem20: TMenuItem;
|
||||
MenuItem21: TMenuItem;
|
||||
MenuItem22: TMenuItem;
|
||||
MenuItem23: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
MenuItem4: TMenuItem;
|
||||
MenuItem5: TMenuItem;
|
||||
MenuItem6: TMenuItem;
|
||||
MenuItem7: TMenuItem;
|
||||
MenuItem8: TMenuItem;
|
||||
MenuItem9: TMenuItem;
|
||||
procedure actCompAndRunFileExecute(Sender: TObject);
|
||||
procedure ActCompAndRunFileWithArgsExecute(Sender: TObject);
|
||||
procedure actCopyExecute(Sender: TObject);
|
||||
procedure actCutExecute(Sender: TObject);
|
||||
procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
|
||||
procedure actMacPlayExecute(Sender: TObject);
|
||||
procedure actMacStartStopExecute(Sender: TObject);
|
||||
procedure actNewFileExecute(Sender: TObject);
|
||||
procedure actOpenFileExecute(Sender: TObject);
|
||||
procedure actPasteExecute(Sender: TObject);
|
||||
procedure actRedoExecute(Sender: TObject);
|
||||
procedure actSaveFileAsExecute(Sender: TObject);
|
||||
procedure actSaveFileExecute(Sender: TObject);
|
||||
procedure actUndoExecute(Sender: TObject);
|
||||
private
|
||||
fProject: TCEProject;
|
||||
fWidgList: TCEWidgetList;
|
||||
fMesgWidg: TCEMessagesWidget;
|
||||
fEditWidg: TCEEditorWidget;
|
||||
fProjWidg: TCEProjectWidget;
|
||||
//
|
||||
procedure newFile;
|
||||
function findFile(const aFilename: string): NativeInt;
|
||||
procedure openFile(const aFilename: string);
|
||||
procedure saveFile(const edIndex: NativeInt);
|
||||
procedure saveFileAs(const edIndex: NativeInt; const aFilename: string);
|
||||
//
|
||||
procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
end;
|
||||
|
||||
var
|
||||
mainForm: TCEMainForm;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
process, SynMacroRecorder;
|
||||
|
||||
{$REGION std comp methods ******************************************************}
|
||||
constructor TCEMainForm.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited create(aOwner);
|
||||
//
|
||||
fWidgList := TCEWidgetList.Create;
|
||||
fMesgWidg := TCEMessagesWidget.create(nil);
|
||||
fEditWidg := TCEEditorWidget.create(nil);
|
||||
fProjWidg := TCEProjectWidget.create(nil);
|
||||
|
||||
fWidgList.addWidget(@fMesgWidg);
|
||||
fWidgList.addWidget(@fEditWidg);
|
||||
fWidgList.addWidget(@fProjWidg);
|
||||
|
||||
fMesgWidg.Show;
|
||||
fEditWidg.Show;
|
||||
fProjWidg.Show;
|
||||
|
||||
fProject := TCEProject.Create(self);
|
||||
fProjWidg.project := fProject;
|
||||
end;
|
||||
|
||||
destructor TCEMainForm.destroy;
|
||||
begin
|
||||
fWidgList.Free;
|
||||
fMesgWidg.Free;
|
||||
fEditWidg.Free;
|
||||
fProjWidg.Free;
|
||||
//
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
hasEd: boolean;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
//
|
||||
curr := fEditWidg.currentEditor;
|
||||
hasEd := curr <> nil;
|
||||
if hasEd then
|
||||
begin
|
||||
actCopy.Enabled := curr.SelAvail;
|
||||
actCut.Enabled := curr.SelAvail;
|
||||
actPaste.Enabled := curr.CanPaste;
|
||||
actUndo.Enabled := curr.CanUndo;
|
||||
actRedo.Enabled := curr.CanRedo;
|
||||
actMacPlay.Enabled := true;
|
||||
actMacStartStop.Enabled := true;
|
||||
//
|
||||
actCompAndRunFile.Enabled := true;
|
||||
actCompAndRunFileWithArgs.Enabled := true;
|
||||
//
|
||||
actSaveFile.Enabled := true;
|
||||
actSaveFileAs.Enabled := true;
|
||||
end
|
||||
else begin
|
||||
actCopy.Enabled := false;
|
||||
actCut.Enabled := false ;
|
||||
actPaste.Enabled := false ;
|
||||
actUndo.Enabled := false ;
|
||||
actRedo.Enabled := false ;
|
||||
actMacPlay.Enabled := false;
|
||||
actMacStartStop.Enabled := false;
|
||||
//
|
||||
actCompAndRunFile.Enabled := false;
|
||||
actCompAndRunFileWithArgs.Enabled := false;
|
||||
//
|
||||
actSaveFile.Enabled := false;
|
||||
actSaveFileAs.Enabled := false;
|
||||
end;
|
||||
|
||||
end;
|
||||
{$ENDREGION}
|
||||
|
||||
{$REGION file ******************************************************************}
|
||||
procedure TCEMainForm.newFile;
|
||||
var
|
||||
i: NativeInt;
|
||||
str: string;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
//
|
||||
i := fEditWidg.editorCount;
|
||||
fEditWidg.addEditor;
|
||||
i := 0;
|
||||
while(true) do
|
||||
begin
|
||||
str := format('<new %d>',[i]);
|
||||
if findFile(str) = -1 then break;
|
||||
if i >= high(NativeInt) then break;
|
||||
i += 1;
|
||||
end;
|
||||
fEditWidg.editor[i].fileName := str;
|
||||
fEditWidg.editor[i].modified := true;
|
||||
fEditWidg.PageControl.PageIndex := i;
|
||||
end;
|
||||
|
||||
function TCEMainForm.findFile(const aFilename: string): NativeInt;
|
||||
var
|
||||
i: NativeInt;
|
||||
begin
|
||||
result := -1;
|
||||
if fEditWidg = nil then exit;
|
||||
for i := 0 to fEditWidg.editorCount-1 do
|
||||
if fEditWidg.editor[i].fileName = aFilename then
|
||||
begin
|
||||
result := i;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.openFile(const aFilename: string);
|
||||
var
|
||||
i: NativeInt;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
//
|
||||
i := findFile(aFilename);
|
||||
if i > -1 then
|
||||
begin
|
||||
fEditWidg.PageControl.PageIndex := i;
|
||||
exit;
|
||||
end;
|
||||
i := fEditWidg.editorCount;
|
||||
fEditWidg.addEditor;
|
||||
fEditWidg.editor[i].Lines.LoadFromFile(aFilename);
|
||||
fEditWidg.PageControl.PageIndex := i;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.saveFile(const edIndex: NativeInt);
|
||||
var
|
||||
str: string;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if edIndex >= fEditWidg.editorCount then exit;
|
||||
//
|
||||
str := fEditWidg.editor[edIndex].fileName;
|
||||
if str = '' then exit;
|
||||
try
|
||||
fEditWidg.editor[edIndex].Lines.SaveToFile(str);
|
||||
finally
|
||||
fEditWidg.editor[edIndex].modified := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.saveFileAs(const edIndex: NativeInt; const aFilename: string);
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if edIndex < 0 then exit;
|
||||
if edIndex >= fEditWidg.editorCount then exit;
|
||||
//
|
||||
try
|
||||
fEditWidg.editor[edIndex].Lines.SaveToFile(aFilename);
|
||||
finally
|
||||
fEditWidg.editor[edIndex].fileName := aFilename;
|
||||
fEditWidg.editor[edIndex].modified := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actOpenFileExecute(Sender: TObject);
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
//
|
||||
with TOpenDialog.Create(nil) do
|
||||
try
|
||||
if execute then
|
||||
begin
|
||||
openFile(filename);
|
||||
end;
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actNewFileExecute(Sender: TObject);
|
||||
begin
|
||||
newFile;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actSaveFileAsExecute(Sender: TObject);
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if fEditWidg.editorIndex < 0 then exit;
|
||||
//
|
||||
with TSaveDialog.Create(nil) do
|
||||
try
|
||||
if execute then
|
||||
begin
|
||||
saveFileAs(fEditWidg.editorIndex, filename);
|
||||
end;
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actSaveFileExecute(Sender: TObject);
|
||||
var
|
||||
str: string;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if fEditWidg.editorIndex < 0 then exit;
|
||||
//
|
||||
str := fEditWidg.editor[fEditWidg.editorIndex].fileName;
|
||||
if fileExists(str) then saveFile(fEditWidg.editorIndex)
|
||||
else actSaveFileAs.Execute;
|
||||
end;
|
||||
{$ENDREGION}
|
||||
|
||||
{$REGION edit ******************************************************************}
|
||||
procedure TCEMainForm.actCopyExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then curr.CopyToClipboard;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actCutExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then curr.CutToClipboard;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actPasteExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then curr.PasteFromClipboard;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actUndoExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then curr.Undo;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actRedoExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then curr.Redo;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actMacPlayExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then fEditWidg.macRecorder.PlaybackMacro(curr);
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actMacStartStopExecute(Sender: TObject);
|
||||
var
|
||||
curr: TCESynMemo;
|
||||
begin
|
||||
curr := fEditWidg.currentEditor;
|
||||
if assigned(curr) then
|
||||
begin
|
||||
if fEditWidg.macRecorder.State = msRecording then
|
||||
fEditWidg.macRecorder.Stop
|
||||
else fEditWidg.macRecorder.RecordMacro(curr);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$ENDREGION}
|
||||
|
||||
{$REGION run ******************************************************************}
|
||||
procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
|
||||
var
|
||||
dmdproc: TProcess;
|
||||
runproc: TProcess;
|
||||
fname, temppath: string;
|
||||
begin
|
||||
dmdproc := TProcess.Create(nil);
|
||||
runproc := TProcess.Create(nil);
|
||||
try
|
||||
temppath := '';
|
||||
{$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF}
|
||||
fname := temppath + format('temp_%.8x',[NativeInt(@dmdproc)]);
|
||||
{$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF}
|
||||
fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d');
|
||||
|
||||
dmdproc.Options:= [poWaitOnExit];
|
||||
dmdproc.Executable:= 'dmd';
|
||||
dmdproc.Parameters.Text := '"'+ fname +'.d"';
|
||||
try
|
||||
dmdproc.Execute;
|
||||
finally
|
||||
DeleteFile(fname + '.d');
|
||||
end;
|
||||
// + output to msgs widget
|
||||
|
||||
if dmdProc.ExitStatus = 0 then
|
||||
begin
|
||||
runproc.Options:= [poWaitOnExit,poStderrToOutPut];
|
||||
{$IFDEF MSWINDOWS}
|
||||
runproc.Executable := fname + '.exe';
|
||||
runproc.Parameters.Text := runArgs;
|
||||
{$ELSE}
|
||||
runproc.Executable := fname;
|
||||
{$ENDIF}
|
||||
runproc.Execute;
|
||||
// + output to msgs widget
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
DeleteFile(fname + '.exe');
|
||||
DeleteFile(fname + '.obj');
|
||||
{$ELSE}
|
||||
DeleteFile(fname);
|
||||
DeleteFile(fname + '.o');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
finally
|
||||
dmdproc.Free;
|
||||
runproc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.actCompAndRunFileExecute(Sender: TObject);
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if fEditWidg.editorIndex < 0 then exit;
|
||||
//
|
||||
compileAndRunFile(fEditWidg.editorIndex);
|
||||
end;
|
||||
|
||||
procedure TCEMainForm.ActCompAndRunFileWithArgsExecute(Sender: TObject);
|
||||
var
|
||||
runargs: string;
|
||||
begin
|
||||
if fEditWidg = nil then exit;
|
||||
if fEditWidg.editorIndex < 0 then exit;
|
||||
//
|
||||
runargs := '';
|
||||
if InputQuery('Execution arguments', 'enter switches and arguments',
|
||||
runargs) then compileAndRunFile(fEditWidg.editorIndex, runargs);
|
||||
end;
|
||||
{$ENDREGION}
|
||||
|
||||
{$REGION view ******************************************************************}
|
||||
{$ENDREGION}
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
inherited CEMessagesWidget: TCEMessagesWidget
|
||||
Left = 1248
|
||||
Height = 139
|
||||
Top = 640
|
||||
Width = 652
|
||||
Caption = 'MessagesWidget'
|
||||
ClientHeight = 139
|
||||
ClientWidth = 652
|
||||
inherited Back: TPanel
|
||||
Height = 139
|
||||
Width = 652
|
||||
ClientHeight = 139
|
||||
ClientWidth = 652
|
||||
inherited Content: TScrollBox
|
||||
Height = 113
|
||||
Width = 652
|
||||
HorzScrollBar.Page = 631
|
||||
VertScrollBar.Page = 109
|
||||
ClientHeight = 109
|
||||
ClientWidth = 631
|
||||
object List: TListView[0]
|
||||
Left = 2
|
||||
Height = 150
|
||||
Top = 2
|
||||
Width = 627
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 2
|
||||
Columns = <>
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
inherited Header: TPanel
|
||||
Width = 652
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
unit ce_messages;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, ComCtrls, ce_frame, ce_common;
|
||||
|
||||
type
|
||||
|
||||
{ TCEWidgetMessages }
|
||||
|
||||
TCEMessagesWidget = class(TCEWidget,ICEMultiDocMonitor)
|
||||
List: TListView;
|
||||
private
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
//
|
||||
procedure docChange(const aNewIndex: integer);
|
||||
procedure docClose(const aNewIndex: integer);
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
constructor TCEMessagesWidget.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fID := 'ID_MSGS';
|
||||
end;
|
||||
|
||||
destructor TCEMessagesWidget.destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCEMessagesWidget.docChange(const aNewIndex: integer);
|
||||
begin
|
||||
// can grow the list...
|
||||
// can display matching msgs from a list...
|
||||
end;
|
||||
|
||||
procedure TCEMessagesWidget.docClose(const aNewIndex: integer);
|
||||
begin
|
||||
// can shrink the list...
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
inherited CEProjectWidget: TCEProjectWidget
|
||||
Left = 1721
|
||||
Height = 514
|
||||
Top = 89
|
||||
Width = 180
|
||||
Caption = 'ProjectWidget'
|
||||
ClientHeight = 514
|
||||
ClientWidth = 180
|
||||
inherited Back: TPanel
|
||||
Height = 514
|
||||
Width = 180
|
||||
ClientHeight = 514
|
||||
ClientWidth = 180
|
||||
inherited Content: TScrollBox
|
||||
Height = 488
|
||||
Width = 180
|
||||
HorzScrollBar.Page = 176
|
||||
VertScrollBar.Page = 484
|
||||
ClientHeight = 484
|
||||
ClientWidth = 176
|
||||
object Tree: TTreeView[0]
|
||||
Left = 2
|
||||
Height = 206
|
||||
Top = 2
|
||||
Width = 172
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 2
|
||||
DefaultItemHeight = 18
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
inherited Header: TPanel
|
||||
Width = 180
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
unit ce_project;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
ComCtrls, ce_common, ce_frame;
|
||||
|
||||
type
|
||||
|
||||
{ TCEWidgetProject }
|
||||
|
||||
TCEProjectWidget = class(TCEWidget)
|
||||
Tree: TTreeView;
|
||||
private
|
||||
fProject: TCEProject;
|
||||
procedure updateView;
|
||||
procedure setProject(aValue: TCEProject);
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
//
|
||||
property project: TCEProject read fProject write setProject;
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
constructor TCEProjectWidget.create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fID := 'ID_PROJ';
|
||||
end;
|
||||
|
||||
destructor TCEProjectWidget.destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCEProjectWidget.setProject(aValue: TCEProject);
|
||||
begin
|
||||
if fProject = aValue then exit;
|
||||
fProject := aValue;
|
||||
if aValue = nil then exit;
|
||||
updateView;
|
||||
end;
|
||||
|
||||
procedure TCEProjectWidget.updateView;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
unit ce_synmemo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SynEdit, SynMemo, ce_common, ce_d2syn,
|
||||
SynPluginSyncroEdit, SynEditKeyCmds;
|
||||
|
||||
type
|
||||
|
||||
TCESynMemo = class(TSynMemo)
|
||||
private
|
||||
fFilename: string;
|
||||
fModified: boolean;
|
||||
fAssocProject: TCEProject;
|
||||
public
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
//
|
||||
property fileName: string read fFilename write fFilename;
|
||||
property modified: boolean read fModified write fModified;
|
||||
property project: TCEProject read fAssocProject write fAssocProject;
|
||||
end;
|
||||
|
||||
var
|
||||
D2Syn: TSynD2Syn;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
graphics;
|
||||
|
||||
constructor TCESynMemo.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
Font.Quality := fqProof;
|
||||
TabWidth := 4;
|
||||
Options :=
|
||||
[ eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoTabsToSpaces,
|
||||
eoTrimTrailingSpaces, eoDragDropEditing, eoShowCtrlMouseLinks];
|
||||
Options2 := [eoEnhanceEndKey, eoFoldedCopyPaste, eoOverwriteBlock];
|
||||
//
|
||||
Gutter.LineNumberPart.ShowOnlyLineNumbersMultiplesOf := 5;
|
||||
Gutter.LineNumberPart.MarkupInfo.Foreground := clSilver;
|
||||
Gutter.SeparatorPart.LineOffset:=1;
|
||||
Gutter.SeparatorPart.LineWidth:=1;
|
||||
Gutter.SeparatorPart.MarkupInfo.Foreground := clSilver;
|
||||
Gutter.CodeFoldPart.MarkupInfo.Foreground := clSilver;
|
||||
//
|
||||
Highlighter := D2Syn;
|
||||
end;
|
||||
|
||||
initialization
|
||||
D2Syn := TSynD2Syn.create(nil);
|
||||
finalization
|
||||
D2Syn.free;
|
||||
end.
|
||||
Loading…
Reference in New Issue