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

r4

This commit is contained in:
Basile Burg 2014-06-14 15:02:35 +02:00
parent 5591812bae
commit 3320792161
19 changed files with 2164 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lazproj/coedit.lpi
View File

@ -50,11 +50,6 @@
<UseHeaptrc Value="True"/> <UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/> <UseExternalDbgSyms Value="True"/>
</Debugging> </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking> </Linking>
<Other> <Other>
<CompilerMessages> <CompilerMessages>
@ -115,18 +110,21 @@
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="3"> <RequiredPackages Count="4">
<Item1> <Item1>
<PackageName Value="SynEdit"/> <PackageName Value="RunTimeTypeInfoControls"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="LazControls"/> <PackageName Value="SynEdit"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="LCL"/> <PackageName Value="LazControls"/>
</Item3> </Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="10"> <Units Count="13">
<Unit0> <Unit0>
<Filename Value="coedit.lpr"/> <Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -192,6 +190,30 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ce_dmdwrap"/> <UnitName Value="ce_dmdwrap"/>
</Unit9> </Unit9>
<Unit10>
<Filename Value="..\src\ce_projconfframe.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjConfFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ce_projconfframe"/>
</Unit10>
<Unit11>
<Filename Value="..\src\ce_projconf.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjectConfigurationWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_projconf"/>
</Unit11>
<Unit12>
<Filename Value="..\src\ce_projconfall.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjConfAll"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ce_projconfall"/>
</Unit12>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

6
lazproj/coedit.lpr
View File

@ -6,9 +6,9 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_main, ce_widget,
Forms, lazcontrols, ce_main, ce_widget, ce_common, ce_common, ce_messages, ce_editor, ce_project, ce_synmemo, ce_dmdwrap,
ce_messages, ce_editor, ce_project, ce_synmemo, ce_dmdwrap; ce_projconf, ce_projconfframe, ce_projconfall;
{$R *.res} {$R *.res}

39
src/ce_common.pas
View File

@ -45,7 +45,7 @@ type
fFilename: string; fFilename: string;
fBasePath: string; fBasePath: string;
fOptsColl: TCollection; fOptsColl: TCollection;
fSrcs, fSrcsCop: TStringList; // an editor can be associated to a file using the Object[] property fSrcs, fSrcsCop: TStringList;
fConfIx: Integer; fConfIx: Integer;
procedure doChanged; procedure doChanged;
procedure subMemberChanged(sender : TObject); procedure subMemberChanged(sender : TObject);
@ -55,6 +55,7 @@ type
procedure setConfIx(aValue: Integer); procedure setConfIx(aValue: Integer);
function getConfig(const ix: integer): TCompilerConfiguration; function getConfig(const ix: integer): TCompilerConfiguration;
function getSrcs: TStringList; function getSrcs: TStringList;
function getCurrConf: TCompilerConfiguration;
published published
property OptionsCollection: TCollection read fOptsColl write setOptsColl; property OptionsCollection: TCollection read fOptsColl write setOptsColl;
property Sources: TStringList read fSrcs write setSrcs; // 'read' should return a copy to avoid abs/rel errors property Sources: TStringList read fSrcs write setSrcs; // 'read' should return a copy to avoid abs/rel errors
@ -69,6 +70,7 @@ type
function getOpts: string; function getOpts: string;
// //
property configuration[ix: integer]: TCompilerConfiguration read getConfig; property configuration[ix: integer]: TCompilerConfiguration read getConfig;
property currentConfiguration: TCompilerConfiguration read getCurrConf;
property fileName: string read fFilename write setFname; property fileName: string read fFilename write setFname;
property onChange: TNotifyEvent read fOnChange write fOnChange; property onChange: TNotifyEvent read fOnChange write fOnChange;
end; end;
@ -111,7 +113,10 @@ begin
str1.Position := 0; str1.Position := 0;
ObjectTextToBinary(str1,str2); ObjectTextToBinary(str1,str2);
str2.Position := 0; str2.Position := 0;
str2.ReadComponent(aComp); try
str2.ReadComponent(aComp);
except
end;
finally finally
str1.Free; str1.Free;
str2.Free; str2.Free;
@ -133,7 +138,7 @@ begin
end; end;
end; end;
// TODO: comments handling // TODO: block comments handling
function getModuleName(const aSource: TStrings): string; function getModuleName(const aSource: TStrings): string;
var var
ln: string; ln: string;
@ -161,14 +166,17 @@ begin
end; end;
if tok then if ln[pos] = ';'then if tok then if ln[pos] = ';'then
begin exit(id);
result := id;
exit;
end;
id += ln[pos]; id += ln[pos];
Inc(pos); Inc(pos);
if id = '//' then
begin
Inc(pos, length(ln));
break;
end;
if id = 'module' then if id = 'module' then
begin begin
tok := true; tok := true;
@ -188,9 +196,9 @@ begin
inherited create(aOwner); inherited create(aOwner);
fSrcs := TStringList.Create; fSrcs := TStringList.Create;
fSrcsCop := TStringList.Create; fSrcsCop := TStringList.Create;
fSrcs.OnChange := @subMemberChanged;
fOptsColl := TCollection.create(TCompilerConfiguration); fOptsColl := TCollection.create(TCompilerConfiguration);
reset; reset;
fSrcs.OnChange := @subMemberChanged;
end; end;
destructor TCEProject.destroy; destructor TCEProject.destroy;
@ -269,11 +277,20 @@ procedure TCEProject.doChanged;
begin begin
fModified := true; fModified := true;
if assigned(fOnChange) then fOnChange(Self); if assigned(fOnChange) then fOnChange(Self);
{$IFDEF DEBUG}
writeln(getOpts);
{$ENDIF}
end; end;
function TCEProject.getConfig(const ix: integer): TCompilerConfiguration; function TCEProject.getConfig(const ix: integer): TCompilerConfiguration;
begin begin
result := TCompilerConfiguration(fOptsColl.Items[ix]); result := TCompilerConfiguration(fOptsColl.Items[ix]);
result.onChanged := @subMemberChanged;
end;
function TCEProject.getCurrConf: TCompilerConfiguration;
begin
result := TCompilerConfiguration(fOptsColl.Items[fConfIx]);
end; end;
function TCEProject.getSrcs: TStringList; function TCEProject.getSrcs: TStringList;
@ -300,13 +317,12 @@ procedure TCEProject.reset;
var var
defConf: TCompilerConfiguration; defConf: TCompilerConfiguration;
begin begin
fConfIx := 0;
fOptsColl.Clear; fOptsColl.Clear;
defConf := addConfiguration; defConf := addConfiguration;
defConf.name := 'default'; defConf.name := 'default';
fSrcs.Clear; fSrcs.Clear;
fFilename := ''; fFilename := '';
fModified := true;
fConfIx := 0;
doChanged; doChanged;
end; end;
@ -315,12 +331,13 @@ var
rel, abs: string; rel, abs: string;
begin begin
result := ''; result := '';
if fConfIx = -1 then exit;
for rel in fSrcs do for rel in fSrcs do
begin begin
abs := expandFilenameEx(fBasePath,rel); abs := expandFilenameEx(fBasePath,rel);
result += '"' + abs + '"'; result += '"' + abs + '"';
end; end;
result += TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts; result += ' ' + TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts;
end; end;
function TCEProject.getAbsoluteSourceName(const aIndex: integer): string; function TCEProject.getAbsoluteSourceName(const aIndex: integer): string;

155
src/ce_dmdwrap.pas
View File

@ -64,7 +64,6 @@ type
fWarnEx: boolean; fWarnEx: boolean;
fVtls: boolean; fVtls: boolean;
fQuiet: boolean; fQuiet: boolean;
fProp: boolean;
procedure setDepHandling(const aValue: TDepHandling); procedure setDepHandling(const aValue: TDepHandling);
procedure setVerb(const aValue: boolean); procedure setVerb(const aValue: boolean);
procedure setWarn(const aValue: boolean); procedure setWarn(const aValue: boolean);
@ -79,20 +78,39 @@ type
property tlsInformations: boolean read fVtls write setVtls; property tlsInformations: boolean read fVtls write setVtls;
property quiet: boolean read fQuiet write setQuiet; property quiet: boolean read fQuiet write setQuiet;
public public
constructor create;
function getOpts: string; override; function getOpts: string; override;
end; end;
(*****************************************************************************
* Describes the target registry size
*)
TTargetSystem = (auto, os32bit, os64bit);
(**
* Describes the output kind
*)
TBinaryKind = (executable, staticlib, sharedlib, obj);
(***************************************************************************** (*****************************************************************************
* Encapsulates the options/args related to the analysis & the code gen. * Encapsulates the options/args related to the analysis & the code gen.
*) *)
TOutputOpts= class(TOptsGroup) TOutputOpts= class(TOptsGroup)
private private
fTrgKind: TTargetSystem;
fBinKind: TBinaryKind;
fUt: boolean;
fVerId: string;
fInline: boolean; fInline: boolean;
fNoBounds: boolean; fNoBounds: boolean;
fOptims: boolean; fOptimz: boolean;
fGenStack: boolean; fGenStack: boolean;
fMain: boolean; fMain: boolean;
fRelease: boolean; fRelease: boolean;
procedure setUt(const aValue: boolean);
procedure setVerId(const aValue: string);
procedure setTrgKind(const aValue: TTargetSystem);
procedure setBinKind(const aValue: TBinaryKind);
procedure setInline(const aValue: boolean); procedure setInline(const aValue: boolean);
procedure setNoBounds(const aValue: boolean); procedure setNoBounds(const aValue: boolean);
procedure setOptims(const aValue: boolean); procedure setOptims(const aValue: boolean);
@ -100,25 +118,20 @@ type
procedure setMain(const aValue: boolean); procedure setMain(const aValue: boolean);
procedure setRelease(const aValue: boolean); procedure setRelease(const aValue: boolean);
published published
property targetKind: TTargetSystem read fTrgKind write setTrgKind;
property binaryKind: TBinaryKind read fBinKind write setBinKind;
property inlining: boolean read fInline write setInline; property inlining: boolean read fInline write setInline;
property noBoundsCheck: boolean read fNoBounds write setNoBounds; property noBoundsCheck: boolean read fNoBounds write setNoBounds;
property optimisations: boolean read fOptims write setOptims; property optimizations: boolean read fOptimz write setOptims;
property generateStackFrame: boolean read fGenStack write setGenStack; property generateStackFrame: boolean read fGenStack write setGenStack;
property addMain: boolean read fMain write setMain; property addMain: boolean read fMain write setMain;
property release: boolean read fRelease write setRelease; property release: boolean read fRelease write setRelease;
property unittest: boolean read fUt write setUt;
property versionIdentifier: string read fVerId write setVerId;
public public
function getOpts: string; override; function getOpts: string; override;
end; 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 * Encapsulates the options/args related to the debuging
*) *)
@ -129,9 +142,19 @@ type
fDbgD: boolean; fDbgD: boolean;
fDbgC: boolean; fDbgC: boolean;
fMap: boolean; fMap: boolean;
procedure setDbg(const aValue: boolean);
procedure setDbgIdent(const aValue: string);
procedure setDbgD(const aValue: boolean);
procedure setDbgC(const aValue: boolean);
procedure setMap(const aValue: boolean);
published published
property debug: boolean read fDbg write setDbg;
property debugIdentifier: string read fDbgIdent write setDbgIdent;
property addDInformations: boolean read fDbgD write setDbgD;
property addCInformations: boolean read fDbgC write setDbgC;
property generateMapFile: boolean read fMap write setMap;
public public
//function getOpts: string; override; function getOpts: string; override;
end; end;
(***************************************************************************** (*****************************************************************************
@ -269,9 +292,14 @@ end;
(******************************************************************************* (*******************************************************************************
* TMsgOpts * TMsgOpts
*) *)
constructor TMsgOpts.create;
begin
fDepHandling := TDepHandling.warning;
end;
function TMsgOpts.getOpts: string; function TMsgOpts.getOpts: string;
const const
DepStr : array[TDepHandling] of string = ('-d ','-dw ','-de '); DepStr : array[TDepHandling] of string = ('-d ','-dw ', '-de ');
begin begin
result := DepStr[fDepHandling]; result := DepStr[fDepHandling];
if fVerb then result += '-v '; if fVerb then result += '-v ';
@ -327,16 +355,50 @@ end;
* TOutputOpts * TOutputOpts
*) *)
function TOutputOpts.getOpts: string; function TOutputOpts.getOpts: string;
const
trgKindStr: array[TTargetSystem] of string = ('', '-m32 ','-m64 ');
binKindStr: array[TBinaryKind] of string = ('', '-lib ', '-shared ', '-c ');
begin begin
result := ''; result := binKindStr[fBinKind];
result += trgKindStr[fTrgKind];
if fUt then result += '-unittest ';
if fVerId <> '' then result += '-version=' + fVerId + ' ';;
if fInline then result += '-inline '; if fInline then result += '-inline ';
if fNoBounds then result += '-noboundscheck '; if fNoBounds then result += '-noboundscheck ';
if fOptims then result += '-O '; if fOptimz then result += '-O ';
if fGenStack then result += '-gs '; if fGenStack then result += '-gs ';
if fMain then result += '-main '; if fMain then result += '-main ';
if fRelease then result += '-release '; if fRelease then result += '-release ';
end; end;
procedure TOutputOpts.setUt(const aValue: boolean);
begin
if fUt = aValue then exit;
fUt := aValue;
doChanged;
end;
procedure TOutputOpts.setVerId(const aValue: string);
begin
if fVerId = aValue then exit;
fVerId := aValue;
doChanged;
end;
procedure TOutputOpts.setTrgKind(const aValue: TTargetSystem);
begin
if fTrgKind = aValue then exit;
fTrgKind := aValue;
doChanged;
end;
procedure TOutputOpts.setBinKind(const aValue: TBinaryKind);
begin
if fBinKind = aValue then exit;
fBinKind := aValue;
doChanged;
end;
procedure TOutputOpts.setInline(const aValue: boolean); procedure TOutputOpts.setInline(const aValue: boolean);
begin begin
if fInline = aValue then exit; if fInline = aValue then exit;
@ -353,8 +415,8 @@ end;
procedure TOutputOpts.setOptims(const aValue: boolean); procedure TOutputOpts.setOptims(const aValue: boolean);
begin begin
if fOptims = aValue then exit; if fOptimz = aValue then exit;
fOptims := aValue; fOptimz := aValue;
doChanged; doChanged;
end; end;
@ -379,6 +441,54 @@ begin
doChanged; doChanged;
end; end;
(*******************************************************************************
* TDebugOpts
*)
function TDebugOpts.getOpts: string;
begin
result := '';
if fDbg then result += '-debug ';
if fDbgIdent <> '' then result += '-debug=' + fDbgIdent + ' ';
if fDbgD then result += '-g ';
if fDbgC then result += '-gc ';
if fMap then result += '-map ';
end;
procedure TDebugOpts.setDbg(const aValue: boolean);
begin
if fDbg = aValue then exit;
fDbg := aValue;
doChanged;
end;
procedure TDebugOpts.setDbgIdent(const aValue: string);
begin
if fDbgIdent = aValue then exit;
fDbgIdent := aValue;
doChanged;
end;
procedure TDebugOpts.setDbgD(const aValue: boolean);
begin
if fDbgD = aValue then exit;
fDbgD := aValue;
doChanged;
end;
procedure TDebugOpts.setDbgC(const aValue: boolean);
begin
if fDbgC = aValue then exit;
fDbgC := aValue;
doChanged;
end;
procedure TDebugOpts.setMap(const aValue: boolean);
begin
if fMap = aValue then exit;
fMap := aValue;
doChanged;
end;
(******************************************************************************* (*******************************************************************************
* TPathsOpts * TPathsOpts
*) *)
@ -515,11 +625,11 @@ end;
function TCompilerConfiguration.getCmdLine: string; function TCompilerConfiguration.getCmdLine: string;
begin begin
result := result :=
fDocOpts.getOpts + (*fDebugOpts.getOpts +*) fMsgOpts.getOpts fDocOpts.getOpts + fDebugOpts.getOpts + fMsgOpts.getOpts
+ fOutputOpts.getOpts + fPathsOpts.getOpts + fOthers.getOpts; + fOutputOpts.getOpts + fPathsOpts.getOpts + fOthers.getOpts;
if result[length(result)] = ' ' then if result[length(result)] = ' ' then
setlength(result, length(result)-1); setlength(result, length(result)-1);
end; end;
procedure TCompilerConfiguration.setName(const aValue: string); procedure TCompilerConfiguration.setName(const aValue: string);
@ -528,6 +638,7 @@ begin
fName := aValue; fName := aValue;
if fName = '' then fName := nameFromID; if fName = '' then fName := nameFromID;
Changed(true); Changed(true);
doChanged;
end; end;
procedure TCompilerConfiguration.subOptsChanged(sender: TObject); procedure TCompilerConfiguration.subOptsChanged(sender: TObject);

28
src/ce_editor.lfm
View File

@ -1,37 +1,39 @@
inherited CEEditorWidget: TCEEditorWidget inherited CEEditorWidget: TCEEditorWidget
Left = 1248 Left = 1248
Height = 517 Height = 336
Top = 89 Top = 89
Width = 481 Width = 481
Caption = 'EditorWidget' Caption = 'EditorWidget'
ClientHeight = 517 ClientHeight = 336
ClientWidth = 481 ClientWidth = 481
inherited Back: TPanel inherited Back: TPanel
Height = 517 Height = 336
Width = 481 Width = 481
ClientHeight = 517 ClientHeight = 336
ClientWidth = 481 ClientWidth = 481
inherited Content: TScrollBox inherited Content: TScrollBox
Height = 491 Height = 310
Width = 481 Width = 481
HorzScrollBar.Page = 477 HorzScrollBar.Page = 477
VertScrollBar.Page = 487 VertScrollBar.Page = 306
ClientHeight = 487 ClientHeight = 306
ClientWidth = 477 ClientWidth = 477
object PageControl: TExtendedNotebook[0] object PageControl: TExtendedNotebook[0]
Left = 2 Left = 2
Height = 460 Height = 279
Top = 2 Top = 2
Width = 473 Width = 473
Align = alClient Align = alClient
BorderSpacing.Around = 2 BorderSpacing.Around = 2
TabOrder = 0 TabOrder = 0
OnChange = PageControlChange OnChange = PageControlChange
TabDragMode = dmAutomatic
TabDragAcceptMode = dmAutomatic
end end
object editorStatus: TStatusBar[1] object editorStatus: TStatusBar[1]
Left = 0 Left = 0
Height = 23 Height = 23
Top = 464 Top = 283
Width = 477 Width = 477
Panels = < Panels = <
item item
@ -50,11 +52,12 @@ inherited CEEditorWidget: TCEEditorWidget
Width = 481 Width = 481
end end
end end
object macRecorder: TSynMacroRecorder[1] object macRecorder: TSynMacroRecorder[2]
RecordShortCut = 24658 RecordShortCut = 24658
PlaybackShortCut = 24656 PlaybackShortCut = 24656
left = 64
end end
object imgList: TImageList[2] object imgList: TImageList[3]
left = 32 left = 32
Bitmap = { Bitmap = {
4C69010000001000000010000000CCCBC900CCCBC900CCCBC900CCCBC900CCCB 4C69010000001000000010000000CCCBC900CCCBC900CCCBC900CCCBC900CCCB
@ -92,7 +95,4 @@ inherited CEEditorWidget: TCEEditorWidget
0000000000000000000000000000 0000000000000000000000000000
} }
end end
object ApplicationProperties1: TApplicationProperties[3]
left = 64
end
end end

1
src/ce_editor.pas
View File

@ -13,7 +13,6 @@ uses
type type
{ TCEEditorWidget } { TCEEditorWidget }
TCEEditorWidget = class(TCEWidget) TCEEditorWidget = class(TCEWidget)
ApplicationProperties1: TApplicationProperties;
imgList: TImageList; imgList: TImageList;
PageControl: TExtendedNotebook; PageControl: TExtendedNotebook;
macRecorder: TSynMacroRecorder; macRecorder: TSynMacroRecorder;

1425
src/ce_main.lfm
View File

File diff suppressed because it is too large Load Diff

126
src/ce_main.pas
View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, SynEditKeyCmds, Forms, Controls, Graphics, Classes, SysUtils, FileUtil, SynEditKeyCmds, Forms, Controls, Graphics,
Dialogs, Menus, ActnList, ce_common, ce_widget, ce_messages, ce_editor, Dialogs, Menus, ActnList, ce_common, ce_widget, ce_messages, ce_editor,
ce_project, ce_synmemo, process; ce_project, ce_synmemo, ce_projconf, process, ce_dmdwrap;
type type
@ -15,8 +15,10 @@ type
TCEMainForm = class(TForm) TCEMainForm = class(TForm)
actCompAndRunFile: TAction; actCompAndRunFile: TAction;
actCompileProj: TAction; actCompileProj: TAction;
ActCompileAndRunProj: TAction; actCompileAndRunProj: TAction;
ActCompAndRunFileWithArgs: TAction; ActCompAndRunFileWithArgs: TAction;
actCompAndRunProjWithArgs: TAction;
actProjOpts: TAction;
actNewProj: TAction; actNewProj: TAction;
actOpenProj: TAction; actOpenProj: TAction;
actSaveProjAs: TAction; actSaveProjAs: TAction;
@ -63,6 +65,17 @@ type
MenuItem3: TMenuItem; MenuItem3: TMenuItem;
MenuItem30: TMenuItem; MenuItem30: TMenuItem;
MenuItem31: TMenuItem; MenuItem31: TMenuItem;
MenuItem32: TMenuItem;
MenuItem33: TMenuItem;
MenuItem34: TMenuItem;
MenuItem35: TMenuItem;
MenuItem36: TMenuItem;
MenuItem37: TMenuItem;
MenuItem38: TMenuItem;
MenuItem39: TMenuItem;
MenuItem40: TMenuItem;
MenuItem41: TMenuItem;
mnuItemWin: TMenuItem;
MenuItem4: TMenuItem; MenuItem4: TMenuItem;
MenuItem5: TMenuItem; MenuItem5: TMenuItem;
MenuItem6: TMenuItem; MenuItem6: TMenuItem;
@ -72,6 +85,7 @@ type
procedure actAddCurrToProjExecute(Sender: TObject); procedure actAddCurrToProjExecute(Sender: TObject);
procedure actCompAndRunFileExecute(Sender: TObject); procedure actCompAndRunFileExecute(Sender: TObject);
procedure ActCompAndRunFileWithArgsExecute(Sender: TObject); procedure ActCompAndRunFileWithArgsExecute(Sender: TObject);
procedure actCompileProjExecute(Sender: TObject);
procedure actCopyExecute(Sender: TObject); procedure actCopyExecute(Sender: TObject);
procedure actCutExecute(Sender: TObject); procedure actCutExecute(Sender: TObject);
procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
@ -83,25 +97,31 @@ type
procedure actOpenFileExecute(Sender: TObject); procedure actOpenFileExecute(Sender: TObject);
procedure actOpenProjExecute(Sender: TObject); procedure actOpenProjExecute(Sender: TObject);
procedure actPasteExecute(Sender: TObject); procedure actPasteExecute(Sender: TObject);
procedure actProjOptsExecute(Sender: TObject);
procedure actRedoExecute(Sender: TObject); procedure actRedoExecute(Sender: TObject);
procedure actSaveFileAsExecute(Sender: TObject); procedure actSaveFileAsExecute(Sender: TObject);
procedure actSaveFileExecute(Sender: TObject); procedure actSaveFileExecute(Sender: TObject);
procedure actSaveProjAsExecute(Sender: TObject); procedure actSaveProjAsExecute(Sender: TObject);
procedure actSaveProjExecute(Sender: TObject); procedure actSaveProjExecute(Sender: TObject);
procedure actUndoExecute(Sender: TObject); procedure actUndoExecute(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
private private
fProject: TCEProject; fProject: TCEProject;
fWidgList: TCEWidgetList; fWidgList: TCEWidgetList;
fMesgWidg: TCEMessagesWidget; fMesgWidg: TCEMessagesWidget;
fEditWidg: TCEEditorWidget; fEditWidg: TCEEditorWidget;
fProjWidg: TCEProjectWidget; fProjWidg: TCEProjectWidget;
fPrjCfWidg: TCEProjectConfigurationWidget;
// widget interfaces subroutines // widget interfaces subroutines
procedure checkWidgetActions(const aWidget: TCEWidget); procedure checkWidgetActions(const aWidget: TCEWidget);
procedure widgetShowFromAction(sender: TObject);
// run & exec sub routines // run & exec sub routines
procedure ProcessOutputToMsg(const aProcess: TProcess); procedure ProcessOutputToMsg(const aProcess: TProcess);
procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
procedure compileProject(const aProject: TCEProject);
procedure runProject(const aProject: TCEProject);
// file sub routines // file sub routines
procedure newFile; procedure newFile;
@ -141,6 +161,10 @@ uses
{$REGION std comp methods ******************************************************} {$REGION std comp methods ******************************************************}
constructor TCEMainForm.create(aOwner: TComponent); constructor TCEMainForm.create(aOwner: TComponent);
var
act: TAction;
itm: TMenuItem;
widg: TCEWidget;
begin begin
inherited create(aOwner); inherited create(aOwner);
// //
@ -148,19 +172,31 @@ begin
fMesgWidg := TCEMessagesWidget.create(nil); fMesgWidg := TCEMessagesWidget.create(nil);
fEditWidg := TCEEditorWidget.create(nil); fEditWidg := TCEEditorWidget.create(nil);
fProjWidg := TCEProjectWidget.create(nil); fProjWidg := TCEProjectWidget.create(nil);
fPrjCfWidg:= TCEProjectConfigurationWidget.create(nil);
fWidgList.addWidget(@fMesgWidg); fWidgList.addWidget(@fMesgWidg);
fWidgList.addWidget(@fEditWidg); fWidgList.addWidget(@fEditWidg);
fWidgList.addWidget(@fProjWidg); fWidgList.addWidget(@fProjWidg);
fWidgList.addWidget(@fPrjCfWidg);
checkWidgetActions(fMesgWidg); for widg in fWidgList do widg.Show;
fMesgWidg.Show; for widg in fWidgList do
fEditWidg.Show; begin
fProjWidg.Show; act := TAction.Create(self);
act.Category := 'Window';
act.Caption := widg.Caption;
act.OnExecute := @widgetShowFromAction;
act.Tag := ptrInt(widg);
itm := TMenuItem.Create(self);
itm.Action := act;
itm.Tag := ptrInt(widg);
mnuItemWin.Add(itm);
end;
fProject := TCEProject.Create(self); fProject := TCEProject.Create(self);
fProject.onChange := @projChange; fProject.onChange := @projChange;
projChange(nil);
end; end;
@ -170,6 +206,7 @@ begin
fMesgWidg.Free; fMesgWidg.Free;
fEditWidg.Free; fEditWidg.Free;
fProjWidg.Free; fProjWidg.Free;
fPrjCfWidg.Free;
// //
inherited; inherited;
end; end;
@ -399,6 +436,14 @@ begin
str := fEditWidg.editor[fEditWidg.editorIndex].fileName; str := fEditWidg.editor[fEditWidg.editorIndex].fileName;
fProject.addSource(str); fProject.addSource(str);
end; end;
procedure TCEMainForm.FormDropFiles(Sender: TObject;const FileNames: array of String);
var
fname: string;
begin
for fname in FileNames do
openFile(fname);
end;
{$ENDREGION} {$ENDREGION}
{$REGION edit ******************************************************************} {$REGION edit ******************************************************************}
@ -503,18 +548,21 @@ procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs:
var var
dmdproc: TProcess; dmdproc: TProcess;
runproc: TProcess; runproc: TProcess;
fname, temppath: string; fname, temppath, olddir: string;
begin begin
olddir := '';
dmdproc := TProcess.Create(nil); dmdproc := TProcess.Create(nil);
runproc := TProcess.Create(nil); runproc := TProcess.Create(nil);
getDir(0,olddir);
try try
temppath := GetTempDir; temppath := GetTempDir(false);
chDir(temppath);
{$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF} {$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF}
fname := temppath + format('temp_%.8x',[LongWord(@dmdproc)]); fname := temppath + format('temp_%.8x',[LongWord(@dmdproc)]);
{$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF} {$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF}
fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d'); fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d');
dmdproc.Options:= [poWaitOnExit,poUsePipes,poStdErrToOutput]; dmdproc.Options:= [poWaitOnExit,poStdErrToOutput,poUsePipes];
dmdproc.Executable:= 'dmd'; dmdproc.Executable:= 'dmd';
dmdproc.Parameters.Text := '"'+ fname +'.d"'; dmdproc.Parameters.Text := '"'+ fname +'.d"';
try try
@ -547,9 +595,39 @@ begin
finally finally
dmdproc.Free; dmdproc.Free;
runproc.Free; runproc.Free;
chDir(olddir);
end; end;
end; end;
procedure TCEMainForm.compileProject(const aProject: TCEProject);
var
dmdproc: TProcess;
olddir, prjpath: string;
begin
dmdproc := TProcess.Create(nil);
getDir(0,olddir);
try
prjpath := extractFilePath(aProject.fileName);
if directoryExists(prjpath) then chDir(prjpath);
dmdproc.Options:= [poStdErrToOutput,poUsePipes];
dmdproc.Executable := 'dmd';
dmdproc.Parameters.Text := aProject.getOpts;
dmdproc.Execute;
ProcessOutputToMsg(dmdproc);
finally
dmdproc.Free;
chDir(olddir);
end;
end;
procedure TCEMainForm.runProject(const aProject: TCEProject);
begin
if aProject.currentConfiguration.outputOptions.binaryKind <>
executable then exit;
end;
procedure TCEMainForm.actCompAndRunFileExecute(Sender: TObject); procedure TCEMainForm.actCompAndRunFileExecute(Sender: TObject);
begin begin
if fEditWidg = nil then exit; if fEditWidg = nil then exit;
@ -569,9 +647,19 @@ begin
if InputQuery('Execution arguments', 'enter switches and arguments', if InputQuery('Execution arguments', 'enter switches and arguments',
runargs) then compileAndRunFile(fEditWidg.editorIndex, runargs); runargs) then compileAndRunFile(fEditWidg.editorIndex, runargs);
end; end;
procedure TCEMainForm.actCompileProjExecute(Sender: TObject);
begin
compileProject(fProject);
end;
{$ENDREGION} {$ENDREGION}
{$REGION view ******************************************************************} {$REGION view ******************************************************************}
procedure TCEMainForm.widgetShowFromAction(sender: TObject);
begin
TCEWidget( TComponent(sender).tag ).Show;
end;
{$ENDREGION} {$ENDREGION}
{$REGION project ***************************************************************} {$REGION project ***************************************************************}
@ -584,8 +672,21 @@ begin
end; end;
procedure TCEMainForm.newProj; procedure TCEMainForm.newProj;
var
// cf. with ce_projconf, fProject is hook
// ICEProjectMonitor would recquire beforeProjChanged-), afterProjChage(), ...
old: TCEProject;
begin begin
fProject.reset; old := fProject;
fProject := nil;
projChange(nil);
//
old.Free;
old := nil;
//
fProject := TCEProject.Create(self);
fProject.onChange := @projChange;
projChange(nil);
end; end;
procedure TCEMainForm.saveProj; procedure TCEMainForm.saveProj;
@ -647,5 +748,10 @@ begin
Free; Free;
end; end;
end; end;
procedure TCEMainForm.actProjOptsExecute(Sender: TObject);
begin
fPrjCfWidg.Show;
end;
{$ENDREGION} {$ENDREGION}
end. end.

42
src/ce_messages.lfm
View File

@ -1,35 +1,35 @@
inherited CEMessagesWidget: TCEMessagesWidget inherited CEMessagesWidget: TCEMessagesWidget
Left = 1248 Left = 1247
Height = 186 Height = 85
Top = 643 Top = 463
Width = 657 Width = 658
Caption = 'MessagesWidget' Caption = 'MessagesWidget'
ClientHeight = 186 ClientHeight = 85
ClientWidth = 657 ClientWidth = 658
inherited Back: TPanel inherited Back: TPanel
Height = 186 Height = 85
Width = 657 Width = 658
ClientHeight = 186 ClientHeight = 85
ClientWidth = 657 ClientWidth = 658
inherited Content: TScrollBox inherited Content: TScrollBox
Height = 160 Height = 59
Width = 657 Width = 658
HorzScrollBar.Page = 653 HorzScrollBar.Page = 637
VertScrollBar.Page = 156 VertScrollBar.Page = 55
ClientHeight = 156 ClientHeight = 55
ClientWidth = 653 ClientWidth = 637
object List: TListView[0] object List: TListView[0]
Left = 2 Left = 2
Height = 152 Height = 150
Top = 2 Top = 2
Width = 649 Width = 633
Align = alClient Align = alClient
AutoSort = False AutoSort = False
AutoWidthLastColumn = True AutoWidthLastColumn = True
BorderSpacing.Around = 2 BorderSpacing.Around = 2
Columns = < Columns = <
item item
Width = 645 Width = 629
end> end>
GridLines = True GridLines = True
IconOptions.Arrangement = iaLeft IconOptions.Arrangement = iaLeft
@ -40,10 +40,10 @@ inherited CEMessagesWidget: TCEMessagesWidget
end end
end end
inherited Header: TPanel inherited Header: TPanel
Width = 657 Width = 658
end end
end end
object imgList: TImageList[1] object imgList: TImageList[2]
Bitmap = { Bitmap = {
4C69030000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 4C69030000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

119
src/ce_projconf.lfm Normal file
View File

@ -0,0 +1,119 @@
inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Left = 1249
Height = 377
Top = 587
Width = 546
Caption = 'ProjectConfigurationWidget'
ClientHeight = 377
ClientWidth = 546
inherited Back: TPanel
Height = 377
Width = 546
ClientHeight = 377
ClientWidth = 546
inherited Content: TScrollBox
Height = 351
Width = 546
HorzScrollBar.Page = 542
VertScrollBar.Page = 347
ClientHeight = 347
ClientWidth = 542
object Tree: TTreeView[0]
Left = 4
Height = 313
Top = 30
Width = 190
Align = alLeft
BorderSpacing.Around = 4
DefaultItemHeight = 18
ScrollBars = ssAutoBoth
ShowRoot = False
TabOrder = 0
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoShowButtons, tvoShowLines, tvoToolTips, tvoThemedDraw]
Items.Data = {
F9FFFFFF020003000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000
0000000700000047656E6572616CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0500
000000000000010A00000043617465676F72696573FFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFF000000000000000000080000004D65737361676573FFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFF000000000000000000080000004465627567696E67FF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000000D000000446F6375
6D656E746174696F6EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000
0000060000004F7574707574FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000
0000000000060000004F7468657273FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00
00000000000000000E000000416C6C2063617465676F72696573
}
end
inline frameEditAll: TCEProjConfAll[1]
Left = 198
Height = 317
Top = 28
Width = 342
Align = alClient
BorderSpacing.Around = 2
ClientHeight = 317
ClientWidth = 342
TabOrder = 1
DesignLeft = 1406
DesignTop = 572
inherited Grid: TTIPropertyGrid
Left = 2
Height = 313
Top = 2
Width = 338
BorderSpacing.Around = 2
DefaultItemHeight = 22
PreferredSplitterX = 150
SplitterX = 150
end
end
object Panel1: TPanel[2]
Left = 2
Height = 24
Top = 2
Width = 538
Align = alTop
BorderSpacing.Around = 2
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 538
TabOrder = 2
object selConf: TComboBox
Left = 0
Height = 23
Top = 1
Width = 297
Align = alClient
BorderSpacing.Top = 1
BorderSpacing.Right = 1
ItemHeight = 15
OnChange = selConfChange
Style = csDropDownList
TabOrder = 0
end
object btnAddConf: TButton
Left = 298
Height = 24
Top = 0
Width = 120
Align = alRight
Caption = 'Add configuration'
OnClick = btnAddConfClick
TabOrder = 1
end
object btnDelConf: TButton
Left = 418
Height = 24
Top = 0
Width = 120
Align = alRight
Caption = 'Delete configuration'
OnClick = btnDelConfClick
TabOrder = 2
end
end
end
inherited Header: TPanel
Width = 546
end
end
end

107
src/ce_projconf.pas Normal file
View File

@ -0,0 +1,107 @@
unit ce_projconf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ComCtrls, StdCtrls, ce_widget, ce_common, ce_projconfall, ce_dmdwrap;
type
{ TCEProjectConfigurationWidget }
TCEProjectConfigurationWidget = class(TCEWidget)
btnAddConf: TButton;
btnDelConf: TButton;
selConf: TComboBox;
frameEditAll: TCEProjConfAll;
Panel1: TPanel;
Tree: TTreeView;
procedure btnAddConfClick(Sender: TObject);
procedure btnDelConfClick(Sender: TObject);
procedure selConfChange(Sender: TObject);
private
fProj: TCEProject;
protected
procedure updaterProc2; //override;
public
procedure projChange(const aProject: TCEProject); override;
property project: TCEProject read fProj;
end;
implementation
{$R *.lfm}
procedure TCEProjectConfigurationWidget.projChange(const aProject: TCEProject);
begin
fProj := aProject;
updaterProc2;
end;
procedure TCEProjectConfigurationWidget.selConfChange(Sender: TObject);
begin
if fUpdating then exit;
if fProj = nil then exit;
if selConf.ItemIndex = -1 then exit;
//
fProj.ConfigurationIndex := selConf.ItemIndex;
updaterProc2;
end;
procedure TCEProjectConfigurationWidget.btnAddConfClick(Sender: TObject);
var
nme: string;
cfg: TCompilerConfiguration;
begin
if fProj = nil then exit;
//
cfg := fProj.addConfiguration;
nme := '';
if InputQuery('Configuration name', '', nme) then cfg.name := nme;
fProj.ConfigurationIndex := cfg.Index;
end;
procedure TCEProjectConfigurationWidget.btnDelConfClick(Sender: TObject);
begin
if fProj = nil then exit;
if fProj.OptionsCollection.Count = 1 then exit;
//
frameEditAll.Grid.TIObject := nil;
frameEditAll.Grid.Clear;
frameEditAll.Invalidate;
fProj.OptionsCollection.Delete(selConf.ItemIndex);
fProj.ConfigurationIndex := 0;
updaterProc2;
end;
procedure TCEProjectConfigurationWidget.updaterProc2;
var
i: NativeInt;
obj: TPersistent;
begin
selConf.Clear;
if (fProj = nil) then
begin
frameEditAll.Grid.Selection.Clear;
frameEditAll.Grid.Clear;
// AV if the previous TIObject is already destroyed
frameEditAll.Grid.TIObject := nil;
frameEditAll.Invalidate;
exit;
end;
for i:= 0 to fProj.OptionsCollection.Count-1 do
selConf.Items.Add(fProj.configuration[i].name);
selConf.ItemIndex := fProj.ConfigurationIndex;
obj := fProj.configuration[fProj.ConfigurationIndex];
if frameEditAll.Grid.TIObject <> obj then
frameEditAll.Grid.TIObject := obj;
end;
end.

20
src/ce_projconfall.lfm Normal file
View File

@ -0,0 +1,20 @@
inherited CEProjConfAll: TCEProjConfAll
Height = 428
Width = 297
ClientHeight = 428
ClientWidth = 297
DesignLeft = 1271
DesignTop = 500
object Grid: TTIPropertyGrid[0]
Left = 0
Height = 428
Top = 0
Width = 297
Align = alClient
DefaultValueFont.Color = clWindowText
Filter = [tkInteger, tkChar, tkEnumeration, tkFloat, tkSet, tkMethod, tkSString, tkLString, tkAString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkClass, tkObject, tkWChar, tkBool, tkInt64, tkQWord, tkDynArray, tkInterfaceRaw, tkProcVar, tkUString, tkUChar, tkHelper]
Indent = 16
NameFont.Color = clWindowText
ValueFont.Color = clMaroon
end
end

28
src/ce_projconfall.pas Normal file
View File

@ -0,0 +1,28 @@
unit ce_projconfall;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, RTTIGrids, Forms, Controls, Graphics, Dialogs,
ce_projconfframe;
type
{ TCEProjConfAll }
TCEProjConfAll = class(TCEProjConfFrame)
Grid: TTIPropertyGrid;
private
{ private declarations }
public
{ public declarations }
end;
implementation
{$R *.lfm}
end.

9
src/ce_projconfframe.lfm Normal file
View File

@ -0,0 +1,9 @@
object CEProjConfFrame: TCEProjConfFrame
Left = 0
Height = 240
Top = 0
Width = 320
TabOrder = 0
DesignLeft = 677
DesignTop = 497
end

20
src/ce_projconfframe.pas Normal file
View File

@ -0,0 +1,20 @@
unit ce_projconfframe;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, ce_common;
type
TCEProjConfFrame = class(TFrame)
private
protected
end;
implementation
{$R *.lfm}
end.

86
src/ce_project.lfm
View File

@ -1,29 +1,29 @@
inherited CEProjectWidget: TCEProjectWidget inherited CEProjectWidget: TCEProjectWidget
Left = 1745 Left = 1745
Height = 517 Height = 336
Top = 89 Top = 89
Width = 163 Width = 163
Caption = 'ProjectWidget' Caption = 'ProjectWidget'
ClientHeight = 517 ClientHeight = 336
ClientWidth = 163 ClientWidth = 163
inherited Back: TPanel inherited Back: TPanel
Height = 517 Height = 336
Width = 163 Width = 163
ClientHeight = 517 ClientHeight = 336
ClientWidth = 163 ClientWidth = 163
inherited Content: TScrollBox inherited Content: TScrollBox
Height = 491 Height = 310
Width = 163 Width = 163
HorzScrollBar.Page = 159 HorzScrollBar.Page = 159
VertScrollBar.Page = 487 VertScrollBar.Page = 306
ClientHeight = 487 ClientHeight = 306
ClientWidth = 159 ClientWidth = 159
object Tree: TTreeView[0] object Tree: TTreeView[0]
Left = 2 Left = 2
Height = 206 Height = 302
Top = 2 Top = 2
Width = 155 Width = 155
Align = alTop Align = alClient
AutoExpand = True AutoExpand = True
BorderSpacing.Around = 2 BorderSpacing.Around = 2
DefaultItemHeight = 18 DefaultItemHeight = 18
@ -45,7 +45,7 @@ inherited CEProjectWidget: TCEProjectWidget
end end
end end
object imgList: TImageList[2] object imgList: TImageList[2]
top = 3 left = 32
Bitmap = { Bitmap = {
4C69040000001000000010000000B3B3B1EFB0B0ADFFAEAEACFFAEAEACFFAEAE 4C69040000001000000010000000B3B3B1EFB0B0ADFFAEAEACFFAEAEACFFAEAE
ACFFAFAFACFFAFAFADFFB1B1AFD5B4B4B100B5B5B300B5B5B300B5B5B300B5B5 ACFFAFAFACFFAFAFADFFB1B1AFD5B4B4B100B5B5B300B5B5B300B5B5B300B5B5
@ -111,39 +111,39 @@ inherited CEProjectWidget: TCEProjectWidget
71FFD17B47AFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 71FFD17B47AFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D58757D5D58351FFD17D4BFFD179 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D58757D5D58351FFD17D4BFFD179
45AFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 45AFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00BB871F00BB871F00BB871E00B9841A00B67E FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000001C00000033000000360000
0FEAC4973BFFC79D49FFC39538FFB37904FFB47A07FFB47A07FFB47A08FFB57C 0036000000360000003600000036000000360000003600000036000000200000
0AFFB67F0FFFB88114FFBA851B23BB871F00BB871F00BA861D00B7801283E4CF 0002FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000033F8F8F8F0FBFBFBFDFCFC
A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF FCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFF8F8F8FF949494910000
FFFFE9DABAFFEEE2C9FFB67F14BFBB871F00BB871F00B9851B00B27A09E5FFFF 002000000002FFFFFF00FFFFFF00FFFFFF0000000036FBFBFBFDF4F4F4FFF5F5
FFFFFFFFFFFFFFFFFCFFFFFFFCFFFFFFFCFFFFFFFCFFFFFFFDFFFFFFFEFFFFFF F5FFF5F5F5FFF5F5F5FFF1F1F1FFEFEFEFFFE9E9E9FFFCFCFCFFE7E7E7FF9595
FFFFC69941FFECDFC2FFC19234FFBB871F00BB871E00B9831800C89E4AFFFFFF 95910000002000000002FFFFFF000000000100000036FCFCFCFFF7F7F7FFF9F9
FFFFFFFDF7FFFFFCF5FFFFFCF4FFFEFBF4FFFEFBF3FFFFFCF4FFFFFDF6FFFFFF F9FFF7F7F7FFF7F7F7FFF3F3F3FFF0F0F0FFEAEAEAFFFCFCFCFFF6F6F6FFF4F4
FFFFB27701FFBA851CFFBC8922FFBB871F00BB861E00B882150CCDA557FFFFFF F4FF9999999100000020FFFFFF000000000100000036FCFCFCFFF9F9F9FFC0C0
FFFF96989BFFC3C1BEFFC2C0BDFFC0BFBCFFFFFBF0FF96979AFFC3C2C2FFFFFF C0FFBABABAFFB4B4B4FFAFAFAFFFAAAAAAFFA5A5A5FFFCFCFCFFFCFCFCFFFCFC
FFFFAA7508D00000003300000033BB871F00BB861D00B07B1134DDC18AFFFFFF FCFFFCFCFCFF00000036000000010000000100000036FCFCFCFFFBFBFBFFFCFC
FFFFFFF9EBFFFFF9EAFFFEF7E9FFFDF7E9FFFEF7E9FFFFF8E9FFFFFFFAFFF0E4 FCFFFCFCFCFFFBFBFBFFF8F8F8FFF5F5F5FFF1F1F1FFECECECFFEAEAEAFFE6E6
CAFFA8740CB2BA851C00BD8C2800BB871F00BA861D00AE790F73EDDDBDFFC1C4 E6FFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFC7C7
C7FFA8A9A9FFC2C1BAFFC0BFB9FFFBF4E1FF989A9EFFC0BFB8FFFFFFFCFFE4D0 C7FFC2C2C2FFBEBEBEFFB8B8B8FFB4B4B4FFB1B1B1FFAEAEAEFFACACACFFEDED
A4FFA2710E90BA861D00BB871E00BB871F00BA851C00AB770C9BF3E6CDFFFDF5 EDFFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFFCFC
E4FFFAF2DBFFFAF1DBFFF8EFDAFFF7EFD9FFFAF0DAFFF8EFD9FFFFFFFFFFD7B8 FCFFFCFCFCFFFCFCFCFFFCFCFCFFFBFBFBFFF8F8F8FFF6F6F6FFF3F3F3FFF2F2
79FF9A6C106BBB861D00BB871F00BB871F00BA851C00B07A0BD2FFFFFFFF999D F2FFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFCECE
A4FFC0BFB8FFBFBEB8FFBEBDB7FFF6EDD4FF999BA2FFBEBCB5FFFFFFFFFFC9A0 CEFFCACACAFFC6C6C6FFC3C3C3FFC0C0C0FFBDBDBDFFBCBCBCFFBABABAFFF6F6
4BFF90661141BB871E00BB871F00BB871E00B9841900B8821BEFFFFFFFFFF4EC F6FFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFFCFC
D4FFF5ECD3FFF4EBD4FFF4EBD3FFF3EAD4FFF3E9D1FFF1E6CCFFFFFFFFFFC190 FCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFBFBFBFFF9F9F9FFF9F9F9FFF8F8
31FF0000000ABB871F00BB871F00B98419FFB67E0EFFB67F10FFC0902EFFBF8E F8FFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFD6D6
2AFFBF8E29FFC08E2AFFC08F2BFFC0902DFFD8BB7DFFF1E9D2FFFFFFFDFFB57C D6FFD3D3D3FFCFCFCFFFCDCDCDFFCBCBCBFFC8C8C8FFC8C8C8FFC6C6C6FFF8F8
0AFFBA851B00BB871F00BB871F00B78012FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF F8FFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFFCFC
FFFFFFFFFFFFFFFFFFFFFFFFFFFFE9D9B7FFBB861DFFF4EEDCFFF6F0E2FFB17B FCFFFCFCFCFFFBFBFBFFFBFBFBFFFAFAFAFFFAFAFAFFFAFAFAFFFAFAFAFFFAFA
0FE8BA851D00BB871F00BB871F00AC7A14CADCC189FFF5F0E0FFF4EDDBFFF4ED FAFFFCFCFCFF00000036000000010000000100000036FCFCFCFFFCFCFCFFDDDD
DBFFF4EDDBFFF4EDDBFFF5EFDDFFF7F2E3FFDFCA99FFF8F4EAFFCFAB61FF9D6F DDFFDBDBDBFFD9D9D9FFD7D7D7FFD5D5D5FFD4D4D4FFD4D4D4FFD4D4D4FFFBFB
1399BB861E00BB871F00BB871F0060440E44B88114FFB67E0FFFB57D0DFFB57D FBFFFCFCFCFF00000036000000010000000100000036FCFCFCFEFCFCFCFFFCFC
0CFFB57D0CFFB57D0CFFB67D0DFFB67E0FFFB77F11FFB78012FFB58016EE0000 FCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFC
001ABB871F00BB871F00BB871F00000000070000003300000033000000330000 FCFFFCFCFCFD00000036FFFFFF00FFFFFF0000000034F9F9F9F5FCFCFCFDFCFC
00330000003300000033000000330000003300000033000000330000002F0000 FCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFC
0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FCFDF9F9F9F300000033FFFFFF00FFFFFF000000001D00000034000000360000
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 0036000000360000003600000036000000360000003600000036000000360000
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 0036000000330000001DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

11
src/ce_project.pas
View File

@ -66,13 +66,15 @@ begin
if i > -1 then if i > -1 then
begin begin
fname := fProject.getAbsoluteSourceName(i); fname := fProject.getAbsoluteSourceName(i);
mainForm.openFile(fname); if fileExists(fname) then
mainForm.openFile(fname);
end; end;
end end
else if Tree.Selected.Parent = fConfNode then else if Tree.Selected.Parent = fConfNode then
begin begin
i := Tree.Selected.Index; i := Tree.Selected.Index;
fProject.ConfigurationIndex:= i; fProject.ConfigurationIndex := i;
updateView;
end; end;
end; end;
@ -82,10 +84,10 @@ var
itm: TTreeNode; itm: TTreeNode;
i: NativeInt; i: NativeInt;
begin begin
if fProject = nil then exit;
//
fConfNode.DeleteChildren; fConfNode.DeleteChildren;
fFileNode.DeleteChildren; fFileNode.DeleteChildren;
if fProject = nil then exit;
//
for src in fProject.Sources do for src in fProject.Sources do
begin begin
itm := Tree.Items.AddChild(fFileNode, src); itm := Tree.Items.AddChild(fFileNode, src);
@ -95,6 +97,7 @@ begin
for i := 0 to fProject.OptionsCollection.Count-1 do for i := 0 to fProject.OptionsCollection.Count-1 do
begin begin
conf := fProject.configuration[i].name; conf := fProject.configuration[i].name;
if i = fProject.ConfigurationIndex then conf += ' (active)';
itm := Tree.Items.AddChild(fConfNode, conf); itm := Tree.Items.AddChild(fConfNode, conf);
itm.ImageIndex := 3; itm.ImageIndex := 3;
itm.SelectedIndex:= 3; itm.SelectedIndex:= 3;

8
src/ce_widget.lfm
View File

@ -1,11 +1,11 @@
object CEWidget: TCEWidget object CEWidget: TCEWidget
Left = 1373 Left = 1264
Height = 327 Height = 327
Top = 440 Top = 448
Width = 320 Width = 320
Caption = 'CEWidget' Caption = 'CEWidget'
ClientHeight = 327 ClientHeight = 0
ClientWidth = 320 ClientWidth = 0
LCLVersion = '1.2.2.0' LCLVersion = '1.2.2.0'
object Back: TPanel object Back: TPanel
Left = 0 Left = 0

40
src/ce_widget.pas
View File

@ -5,7 +5,7 @@ unit ce_widget;
interface interface
uses uses
Classes, SysUtils, FileUtil, DividerBevel, Forms, Controls, ExtCtrls, Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls,
ce_common, ActnList; ce_common, ActnList;
type type
@ -26,6 +26,7 @@ type
protected protected
fID: string; fID: string;
fNeedUpdate: boolean; fNeedUpdate: boolean;
fUpdating: boolean;
procedure UpdaterProc; virtual; procedure UpdaterProc; virtual;
published published
property ID: string read fID write fID; property ID: string read fID write fID;
@ -51,6 +52,16 @@ type
property widget[index: integer]: TCEWidget read getWidget; property widget[index: integer]: TCEWidget read getWidget;
end; end;
TWidgetEnumerator = class
fList: TCEWidgetList;
fIndex: Integer;
function getCurrent: TCEWidget;
Function moveNext: boolean;
property current: TCEWidget read getCurrent;
end;
operator enumerator(aWidgetList: TCEWidgetList): TWidgetEnumerator;
implementation implementation
{$R *.lfm} {$R *.lfm}
@ -72,8 +83,13 @@ end;
procedure TCEWidget.updaterTimer(Sender: TObject); procedure TCEWidget.updaterTimer(Sender: TObject);
begin begin
if not fNeedUpdate then exit; if not fNeedUpdate then exit;
fNeedUpdate := false; fUpdating := true;
UpdaterProc; try
UpdaterProc;
finally
fUpdating := false;
fNeedUpdate := false;
end;
end; end;
procedure TCEWidget.UpdaterProc; procedure TCEWidget.UpdaterProc;
@ -112,5 +128,23 @@ begin
add(Pointer(aValue)); add(Pointer(aValue));
end; end;
function TWidgetEnumerator.getCurrent:TCEWidget;
begin
result := fList.widget[fIndex];
end;
function TWidgetEnumerator.moveNext: boolean;
begin
Inc(fIndex);
result := fIndex < fList.Count;
end;
operator enumerator(aWidgetList: TCEWidgetList): TWidgetEnumerator;
begin
result := TWidgetEnumerator.Create;
result.fList := aWidgetList;
result.fIndex := -1;
end;
end. end.