forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

r1

This commit is contained in:
Basile Burg 2014-06-10 12:23:58 +02:00
commit 9866f22820
18 changed files with 2915 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
lazproj/coedit.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

222
lazproj/coedit.lpi Normal file
View File

@ -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>

21
lazproj/coedit.lpr Normal file
View File

@ -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.

23
notes.txt Normal file
View File

@ -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.

125
src/ce_common.pas Normal file
View File

@ -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.

807
src/ce_d2syn.pas Normal file
View File

@ -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.

577
src/ce_dmdwrap.pas Normal file
View File

@ -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.

42
src/ce_editor.lfm Normal file
View File

@ -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

119
src/ce_editor.pas Normal file
View File

@ -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.

40
src/ce_frame.lfm Normal file
View File

@ -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

71
src/ce_frame.pas Normal file
View File

@ -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.

176
src/ce_main.lfm Normal file
View File

@ -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

453
src/ce_main.pas Normal file
View File

@ -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.

36
src/ce_messages.lfm Normal file
View File

@ -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

52
src/ce_messages.pas Normal file
View File

@ -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.

37
src/ce_project.lfm Normal file
View File

@ -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

56
src/ce_project.pas Normal file
View File

@ -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.

58
src/ce_synmemo.pas Normal file
View File

@ -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.