Merge branch 'dub-integration'

This commit is contained in:
Basile Burg 2015-09-02 14:46:33 +02:00
commit 24d141ab88
13 changed files with 514 additions and 215 deletions

View File

@ -135,7 +135,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item6> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="39"> <Units Count="40">
<Unit0> <Unit0>
<Filename Value="coedit.lpr"/> <Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -341,6 +341,10 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
</Unit38> </Unit38>
<Unit39>
<Filename Value="..\src\ce_dubproject.pas"/>
<IsPartOfProject Value="True"/>
</Unit39>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -9,7 +9,7 @@ uses
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_sharedres, Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_sharedres,
ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent,
ce_symstring, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions, ce_symstring, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions,
ce_shortcutseditor, ce_mru, ce_processes; ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject;
{$R *.res} {$R *.res}

View File

@ -5,7 +5,8 @@ unit ce_dmdwrap;
interface interface
uses uses
classes, sysutils, process, asyncprocess, ce_common, ce_inspectors, ce_processes; classes, sysutils, process, asyncprocess, ce_common, ce_inspectors,
ce_processes, ce_interfaces;
(* (*
@ -103,11 +104,6 @@ type
*) *)
TTargetSystem = (auto, os32bit, os64bit); TTargetSystem = (auto, os32bit, os64bit);
(**
* Describes the output kind.
*)
TBinaryKind = (executable, staticlib, sharedlib, obj);
(** (**
* Describes the bounds check kinds. * Describes the bounds check kinds.
*) *)
@ -119,7 +115,7 @@ type
TOutputOpts = class(TOptsGroup) TOutputOpts = class(TOptsGroup)
private private
fTrgKind: TTargetSystem; fTrgKind: TTargetSystem;
fBinKind: TBinaryKind; fBinKind: TProjectBinaryKind;
fUnittest: boolean; fUnittest: boolean;
fVerIds: TStringList; fVerIds: TStringList;
fInline: boolean; fInline: boolean;
@ -135,7 +131,7 @@ type
procedure setAllInst(const aValue: boolean); procedure setAllInst(const aValue: boolean);
procedure setUnittest(const aValue: boolean); procedure setUnittest(const aValue: boolean);
procedure setTrgKind(const aValue: TTargetSystem); procedure setTrgKind(const aValue: TTargetSystem);
procedure setBinKind(const aValue: TBinaryKind); procedure setBinKind(const aValue: TProjectBinaryKind);
procedure setInline(const aValue: boolean); procedure setInline(const aValue: boolean);
procedure setBoundsCheck(const aValue: TBoundCheckKind); procedure setBoundsCheck(const aValue: TBoundCheckKind);
procedure setOptims(const aValue: boolean); procedure setOptims(const aValue: boolean);
@ -147,7 +143,7 @@ type
published published
property alwaysLinkStaticLibs: boolean read fAlwayLinkLibs write setAlwaysLinkLibs default false; property alwaysLinkStaticLibs: boolean read fAlwayLinkLibs write setAlwaysLinkLibs default false;
property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto; property targetKind: TTargetSystem read fTrgKind write setTrgKind default auto;
property binaryKind: TBinaryKind read fBinKind write setBinKind default executable; property binaryKind: TProjectBinaryKind read fBinKind write setBinKind default executable;
property inlining: boolean read fInline write setInline default false; property inlining: boolean read fInline write setInline default false;
property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck default safeOnly; property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck default safeOnly;
property optimizations: boolean read fOptimz write setOptims default false; property optimizations: boolean read fOptimz write setOptims default false;
@ -562,7 +558,7 @@ var
opt: string; opt: string;
const const
trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64'); trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
binKindStr: array[TBinaryKind] of string = ('', '-lib', '-shared', '-c'); binKindStr: array[TProjectBinaryKind] of string = ('', '-lib', '-shared', '-c');
bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off'); bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
begin begin
opt := binKindStr[fBinKind]; opt := binKindStr[fBinKind];
@ -657,7 +653,7 @@ begin
doChanged; doChanged;
end; end;
procedure TOutputOpts.setBinKind(const aValue: TBinaryKind); procedure TOutputOpts.setBinKind(const aValue: TProjectBinaryKind);
begin begin
if fBinKind = aValue then exit; if fBinKind = aValue then exit;
fBinKind := aValue; fBinKind := aValue;

220
src/ce_dubproject.pas Normal file
View File

@ -0,0 +1,220 @@
unit ce_dubproject;
{$I ce_defines.inc}
interface
uses
Classes, SysUtils, fpjson, jsonparser, jsonscanner, process,
ce_common, ce_interfaces, ce_observer ;
type
TCEDubProject = class(TComponent, ICECommonProject)
private
fFilename: string;
fModified: boolean;
fJson: TJSONObject;
fProjectSubject: TCEProjectSubject;
//
procedure dubProcOutput(proc: TProcess);
//
function getFormat: TCEProjectFormat;
function getProject: TObject;
//
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
//
function getFilename: string;
procedure loadFromFile(const aFilename: string);
procedure saveToFile(const aFilename: string);
function getIfModified: boolean;
function getBinaryKind: TProjectBinaryKind;
//
function getIfIsSource(const aFilename: string): boolean;
function getOutputFilename: string;
//
function getConfigurationCount: integer;
procedure setActiveConfiguration(index: integer);
function getConfigurationName(index: integer): string;
//
function compile: boolean;
function run(const runArgs: string = ''): boolean;
end;
implementation
constructor TCEDubProject.create(aOwner: TComponent);
begin
inherited;
fProjectSubject := TCEProjectSubject.Create;
//
subjProjNew(fProjectSubject, self);
subjProjChanged(fProjectSubject, self);
end;
destructor TCEDubProject.destroy;
begin
subjProjClosing(fProjectSubject, self);
fProjectSubject.free;
//
fJSon.Free;
inherited;
end;
procedure TCEDubProject.dubProcOutput(proc: TProcess);
var
lst: TStringList;
str: string;
msgs: ICEMessagesDisplay;
begin
lst := TStringList.Create;
msgs := getMessageDisplay;
try
processOutputToStrings(proc, lst);
for str in lst do
msgs.message(str, self as ICECommonProject, amcProj, amkAuto);
finally
lst.Free;
end;
end;
function TCEDubProject.getFormat: TCEProjectFormat;
begin
exit(pfDub);
end;
function TCEDubProject.getProject: TObject;
begin
exit(self);
end;
function TCEDubProject.getFilename: string;
begin
exit(fFilename);
end;
function TCEDubProject.getBinaryKind: TProjectBinaryKind;
begin
//TODO-cDUB: implement
exit(executable);
end;
procedure TCEDubProject.loadFromFile(const aFilename: string);
var
loader: TMemoryStream;
parser : TJSONParser;
begin
loader := TMemoryStream.Create;
try
fFilename:= aFilename;
loader.LoadFromFile(fFilename);
fJSon.Free;
parser := TJSONParser.Create(loader);
subjProjChanged(fProjectSubject, self);
try
fJSon := parser.Parse as TJSONObject;
finally
parser.Free;
end;
finally
loader.Free;
fModified := false;
end;
end;
procedure TCEDubProject.saveToFile(const aFilename: string);
var
saver: TMemoryStream;
str: string;
begin
saver := TMemoryStream.Create;
try
fFilename := aFilename;
str := fJson.FormatJSON;
saver.Write(str[1], length(str));
saver.SaveToFile(fFilename);
finally
saver.Free;
fModified := false;
end;
end;
function TCEDubProject.getIfModified: boolean;
begin
exit(fModified);
end;
function TCEDubProject.getIfIsSource(const aFilename: string): boolean;
begin
//TODO-cDUB: implement
exit(false);
end;
function TCEDubProject.getOutputFilename: string;
begin
//TODO-cDUB: implement
exit('');
end;
function TCEDubProject.getConfigurationCount: integer;
begin
//TODO-cDUB: implement
exit(0);
end;
procedure TCEDubProject.setActiveConfiguration(index: integer);
begin
//TODO-cDUB: implement
end;
function TCEDubProject.getConfigurationName(index: integer): string;
begin
//TODO-cDUB: implement
exit('');
end;
function TCEDubProject.compile: boolean;
var
dubproc: TProcess;
olddir: string = '';
prjname: string;
msgs: ICEMessagesDisplay;
begin
result := false;
msgs := getMessageDisplay;
msgs.clearByData(Self);
prjname := shortenPath(fFilename);
dubproc := TProcess.Create(nil);
getDir(0, olddir);
try
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
chDir(extractFilePath(fFilename));
dubproc.Executable := 'dub' + exeExt;
dubproc.Options := dubproc.Options + [poStderrToOutPut, poUsePipes];
dubproc.CurrentDirectory := extractFilePath(fFilename);
dubproc.ShowWindow := swoHIDE;
dubproc.Parameters.Add('build');
dubproc.Execute;
while dubproc.Running do
dubProcOutput(dubproc);
if dubproc.ExitStatus = 0 then begin
msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf);
result := true;
end else
msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn);
finally
chDir(olddir);
dubproc.Free;
end;
end;
function TCEDubProject.run(const runArgs: string = ''): boolean;
begin
//TODO-cDUB: implement
result := false;
end;
end.

View File

@ -13,8 +13,14 @@ type
// describes the project kind. Used as a hint to cast ICECommonProject.getProject() // describes the project kind. Used as a hint to cast ICECommonProject.getProject()
TCEProjectFormat = (pfNative, pfDub); TCEProjectFormat = (pfNative, pfDub);
// describes the binary kind produces when compiling a project
TProjectBinaryKind = (executable, staticlib, sharedlib, obj);
(** (**
* Common project interface * Common project interface.
*
* Each project format has its own dedicated editors.
* The few common properties allow some generic operations whatever is the format.
*) *)
ICECommonProject = interface ICECommonProject = interface
['ICECommonProject'] ['ICECommonProject']
@ -23,12 +29,26 @@ type
// returns an untyped object that can be casted using getFormat() // returns an untyped object that can be casted using getFormat()
function getProject: TObject; function getProject: TObject;
//// project file // sub routines for the actions --------------------------------------------
//function filename: string;
//procedure loadFromFile(const aFilename: string); // tries to compile and returns true if it does
//procedure saveToFile(const aFilename: string); function compile: boolean;
//procedure save; // tries to un the project and returns true if it did
// function run(const runArgs: string = ''): boolean;
// project file - allows main form to create/load/save ---------------------
// returns the project filename
function getFilename: string;
// loads project from filename
procedure loadFromFile(const aFilename: string);
// saves project to filename
procedure saveToFile(const aFilename: string);
// indicates of the project is modified (should be saved or not)
function getIfModified: boolean;
// various properties used by several widgets (todo ana, dcd, ...)----------
//// common project properties //// common project properties
//function sourceCount: integer; //function sourceCount: integer;
//function source(index: integer): string; //function source(index: integer): string;
@ -36,9 +56,23 @@ type
//function stringImport(index: integer): string; //function stringImport(index: integer): string;
//function moduleImportCount: integer; //function moduleImportCount: integer;
//function moduleImport(index: integer): string; //function moduleImport(index: integer): string;
//function configurationCount: integer;
//function configuration(index: integer): string; // returns true if aFilename is a project source
//function outputFilename: string; function getIfIsSource(const aFilename: string): boolean;
// returns the name of the file produced when a project is compiled
function getOutputFilename: string;
// returns the binary kind produced according to the current configuration
function getBinaryKind: TProjectBinaryKind;
// configs -----------------------------------------------------------------
// returns the count of configuration
function getConfigurationCount: integer;
// sets the active configuration
procedure setActiveConfiguration(index: integer);
// returns the name of the index-th configuration
function getConfigurationName(index: integer): string;
end; end;
(** (**

View File

@ -37,6 +37,7 @@ type
procedure ListEdited(Sender: TObject; Item: TListItem; var AValue: string); procedure ListEdited(Sender: TObject; Item: TListItem; var AValue: string);
private private
fProj: TCENativeProject; fProj: TCENativeProject;
//TODO-cDUB: register a static lib in libman via a DUB project
procedure updateRegistrable; procedure updateRegistrable;
procedure projNew(aProject: ICECommonProject); procedure projNew(aProject: ICECommonProject);
procedure projChanged(aProject: ICECommonProject); procedure projChanged(aProject: ICECommonProject);
@ -204,10 +205,10 @@ begin
with List.Items.Add do with List.Items.Add do
begin begin
Caption := ExtractFileNameOnly(fProj.Filename); Caption := ExtractFileNameOnly(fProj.Filename);
if ExtractFileExt(fProj.outputFilename) <> libExt then if ExtractFileExt(fProj.getOutputFilename) <> libExt then
SubItems.add(fProj.outputFilename + libExt) SubItems.add(fProj.getOutputFilename + libExt)
else else
SubItems.add(fProj.outputFilename); SubItems.add(fProj.getOutputFilename);
SubItems.add(root); SubItems.add(root);
if not FileExists(SubItems[0]) then if not FileExists(SubItems[0]) then
dlgOkInfo('the library file does not exist, maybe the project not been already compiled ?'); dlgOkInfo('the library file does not exist, maybe the project not been already compiled ?');

View File

@ -3755,7 +3755,7 @@ object CEMainForm: TCEMainForm
end end
object actProjSource: TAction object actProjSource: TAction
Category = 'Project' Category = 'Project'
Caption = 'View project source' Caption = 'Edit project file'
ImageIndex = 12 ImageIndex = 12
OnExecute = actProjSourceExecute OnExecute = actProjSourceExecute
OnUpdate = updateProjectBasedAction OnUpdate = updateProjectBasedAction
@ -5037,5 +5037,6 @@ object CEMainForm: TCEMainForm
object ApplicationProperties1: TApplicationProperties object ApplicationProperties1: TApplicationProperties
OnException = ApplicationProperties1Exception OnException = ApplicationProperties1Exception
left = 96 left = 96
top = 1
end end
end end

View File

@ -12,7 +12,7 @@ uses
ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf,
ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer, ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer,
ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes, ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes,
ce_infos; ce_infos, ce_dubproject;
type type
@ -190,7 +190,9 @@ type
fMultidoc: ICEMultiDocHandler; fMultidoc: ICEMultiDocHandler;
fScCollectCount: Integer; fScCollectCount: Integer;
fUpdateCount: NativeInt; fUpdateCount: NativeInt;
fProject: TCENativeProject; fProjectInterface: ICECommonProject;
fDubProject: TCEDubProject;
fNativeProject: TCENativeProject;
fProjMru: TCEMRUProjectList; fProjMru: TCEMRUProjectList;
fFileMru: TCEMRUDocumentList; fFileMru: TCEMRUDocumentList;
fWidgList: TCEWidgetList; fWidgList: TCEWidgetList;
@ -208,6 +210,8 @@ type
fSymlWidg: TCESymbolListWidget; fSymlWidg: TCESymbolListWidget;
fInfoWidg: TCEInfoWidget; fInfoWidg: TCEInfoWidget;
//TODO-cDUB: widget to edit and view, select config of, a DUB project
fInitialized: boolean; fInitialized: boolean;
fRunnableSw: string; fRunnableSw: string;
fRunProc: TCEProcess; fRunProc: TCEProcess;
@ -259,7 +263,8 @@ type
// project sub routines // project sub routines
procedure saveProjSource(const aEditor: TCESynMemo); procedure saveProjSource(const aEditor: TCESynMemo);
procedure newProj; procedure newNativeProj;
procedure newDubProj;
procedure saveProj; procedure saveProj;
procedure saveProjAs(const aFilename: string); procedure saveProjAs(const aFilename: string);
procedure openProj(const aFilename: string); procedure openProj(const aFilename: string);
@ -417,7 +422,7 @@ begin
EntitiesConnector.forceUpdate; EntitiesConnector.forceUpdate;
// //
getCMdParams; getCMdParams;
if fProject = nil then newProj; if fNativeProject = nil then newNativeProj;
// //
fInitialized := true; fInitialized := true;
end; end;
@ -795,7 +800,7 @@ var
i: Integer; i: Integer;
begin begin
canClose := false; canClose := false;
if fProject <> nil then if fProject.modified then if fProjectInterface <> nil then if fProjectInterface.getIfModified then
if ce_common.dlgOkCancel( if ce_common.dlgOkCancel(
'The project modifications are not saved, quit anyway ?') <> mrOK then 'The project modifications are not saved, quit anyway ?') <> mrOK then
exit; exit;
@ -814,7 +819,7 @@ end;
procedure TCEMainForm.updateProjectBasedAction(sender: TObject); procedure TCEMainForm.updateProjectBasedAction(sender: TObject);
begin begin
TAction(sender).Enabled := fProject <> nil; TAction(sender).Enabled := fProjectInterface <> nil;
end; end;
procedure TCEMainForm.updateDocEditBasedAction(sender: TObject); procedure TCEMainForm.updateDocEditBasedAction(sender: TObject);
@ -1112,11 +1117,11 @@ end;
procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject); procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject);
begin begin
if fProject = nil then exit; if fProjectInterface = nil then exit;
if not fileExists(fProject.fileName) then exit; if not fileExists(fProjectInterface.getFilename) then exit;
// //
DockMaster.GetAnchorSite(fExplWidg).Show; DockMaster.GetAnchorSite(fExplWidg).Show;
fExplWidg.expandPath(extractFilePath(fProject.fileName)); fExplWidg.expandPath(extractFilePath(fProjectInterface.getFilename));
end; end;
procedure TCEMainForm.actFileNewExecute(Sender: TObject); procedure TCEMainForm.actFileNewExecute(Sender: TObject);
@ -1171,12 +1176,13 @@ end;
procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject);
begin begin
//TODO-cDUB: update 'add file to project' for a DUB project
if fDoc = nil then exit; if fDoc = nil then exit;
if fDoc.isProjectSource then exit; if fDoc.isProjectSource then exit;
if fProject = nil then exit; if fNativeProject = nil then exit;
// //
if fileExists(fDoc.fileName) and (not fDoc.isTemporary) then if fileExists(fDoc.fileName) and (not fDoc.isTemporary) then
fProject.addSource(fDoc.fileName) fNativeProject.addSource(fDoc.fileName)
else dlgOkInfo('the file has not been added to the project because it does not exist'); else dlgOkInfo('the file has not been added to the project because it does not exist');
end; end;
@ -1500,24 +1506,24 @@ end;
procedure TCEMainForm.actProjCompileExecute(Sender: TObject); procedure TCEMainForm.actProjCompileExecute(Sender: TObject);
begin begin
fProject.compileProject; fProjectInterface.compile;
end; end;
procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject);
begin begin
if fProject.compileProject then if fProjectInterface.compile then
fProject.runProject; fProjectInterface.run;
end; end;
procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject);
var var
runargs: string; runargs: string;
begin begin
if not fProject.compileProject then if not fProjectInterface.compile then
exit; exit;
runargs := ''; runargs := '';
if InputQuery('Execution arguments', '', runargs) then if InputQuery('Execution arguments', '', runargs) then
fProject.runProject(runargs); fProjectInterface.run(runargs);
end; end;
procedure TCEMainForm.actProjRunExecute(Sender: TObject); procedure TCEMainForm.actProjRunExecute(Sender: TObject);
@ -1528,32 +1534,40 @@ label
_rbld, _rbld,
_run; _run;
begin begin
if fProject.currentConfiguration.outputOptions.binaryKind <> executable then if fProjectInterface.getBinaryKind <> executable then
begin begin
dlgOkInfo('Non executable projects cant be run'); dlgOkInfo('Non executable projects cant be run');
exit; exit;
end; end;
if not fileExists(fProject.outputFilename) then if not fileExists(fProjectInterface.getOutputFilename) then
begin begin
if dlgOkCancel('The project output is missing, build ?') <> mrOK then if dlgOkCancel('The project output is missing, build ?') <> mrOK then
exit; exit;
goto _rbld; goto _rbld;
end; end;
dt := fileAge(fProject.outputFilename);
for i := 0 to fProject.Sources.Count-1 do // TODO-cICECommonInterface, add function to check if rebuild needed.
if fProjectInterface.getFormat = pfNative then
begin begin
if fileAge(fProject.getAbsoluteSourceName(i)) > dt then dt := fileAge(fNativeProject.getOutputFilename);
if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then for i := 0 to fNativeProject.Sources.Count-1 do
goto _rbld begin
else if fileAge(fNativeProject.getAbsoluteSourceName(i)) > dt then
break; if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then
end; goto _rbld
else
break;
end;
end
// DUB checks this automatically
else fProjectInterface.compile;
goto _run; goto _run;
_rbld: _rbld:
fProject.compileProject; fProjectInterface.compile;
_run: _run:
if fileExists(fProject.outputFilename) then if fileExists(fProjectInterface.getOutputFilename) then
fProject.runProject; fProjectInterface.run;
end; end;
procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject);
@ -1562,7 +1576,7 @@ var
begin begin
runargs := ''; runargs := '';
if InputQuery('Execution arguments', '', runargs) then if InputQuery('Execution arguments', '', runargs) then
fProject.runProject(runargs); fProjectInterface.run(runargs);
end; end;
{$ENDREGION} {$ENDREGION}
@ -1708,58 +1722,74 @@ end;
{$REGION project ---------------------------------------------------------------} {$REGION project ---------------------------------------------------------------}
procedure TCEMainForm.showProjTitle; procedure TCEMainForm.showProjTitle;
begin begin
if (fProject <> nil) and fileExists(fProject.Filename) then if (fProjectInterface <> nil) and fileExists(fProjectInterface.getFilename) then
caption := format('Coedit - %s', [shortenPath(fProject.Filename, 30)]) caption := format('Coedit - %s', [shortenPath(fProjectInterface.getFilename, 30)])
else else
caption := 'Coedit'; caption := 'Coedit';
end; end;
procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo);
begin begin
if fProject = nil then exit; if fProjectInterface = nil then exit;
if fProject.fileName <> aEditor.fileName then exit; if fProjectInterface.getFilename <> aEditor.fileName then exit;
// //
aEditor.saveToFile(fProject.fileName); aEditor.saveToFile(fProjectInterface.getFilename);
openProj(fProject.fileName); openProj(fProjectInterface.getFilename);
end; end;
procedure TCEMainForm.closeProj; procedure TCEMainForm.closeProj;
begin begin
fProject.Free; if fProjectInterface = nil then exit;
fProject := nil; //
fProjectInterface.getProject.Free;
fProjectInterface := nil;
fNativeProject := nil;
fDubProject := nil;
showProjTitle; showProjTitle;
end; end;
procedure TCEMainForm.newProj; procedure TCEMainForm.newNativeProj;
begin begin
fProject := TCENativeProject.Create(nil); fNativeProject := TCENativeProject.Create(nil);
fProject.Name := 'CurrentProject'; fNativeProject.Name := 'CurrentProject';
fProjectInterface := fNativeProject as ICECommonProject;
showProjTitle;
end;
procedure TCEMainForm.newDubProj;
begin
fDubProject := TCEDubProject.Create(nil);
fDubProject.Name := 'CurrentProject';
fProjectInterface := fDubProject as ICECommonProject;
showProjTitle; showProjTitle;
end; end;
procedure TCEMainForm.saveProj; procedure TCEMainForm.saveProj;
begin begin
fProject.saveToFile(fProject.fileName); fProjectInterface.saveToFile(fProjectInterface.getFilename);
end; end;
procedure TCEMainForm.saveProjAs(const aFilename: string); procedure TCEMainForm.saveProjAs(const aFilename: string);
begin begin
fProject.fileName := aFilename; fProjectInterface.saveToFile(aFilename);
fProject.saveToFile(fProject.fileName);
showProjTitle; showProjTitle;
end; end;
procedure TCEMainForm.openProj(const aFilename: string); procedure TCEMainForm.openProj(const aFilename: string);
begin begin
closeProj; closeProj;
newProj; if LowerCase(ExtractFileExt(aFilename)) = '.json' then
fProject.loadFromFile(aFilename); newDubProj
else
newNativeProj;
//
fProjectInterface.loadFromFile(aFilename);
showProjTitle; showProjTitle;
end; end;
procedure TCEMainForm.mruProjItemClick(Sender: TObject); procedure TCEMainForm.mruProjItemClick(Sender: TObject);
begin begin
if fProject <> nil then if fProject.modified then if dlgOkCancel( if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel(
'The project modifications are not saved, continue ?') 'The project modifications are not saved, continue ?')
= mrCancel then exit; = mrCancel then exit;
openProj(TMenuItem(Sender).Hint); openProj(TMenuItem(Sender).Hint);
@ -1767,17 +1797,17 @@ end;
procedure TCEMainForm.actProjNewExecute(Sender: TObject); procedure TCEMainForm.actProjNewExecute(Sender: TObject);
begin begin
if fProject <> nil then if fProject.modified then if dlgOkCancel( if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel(
'The project modifications are not saved, continue ?') 'The project modifications are not saved, continue ?')
= mrCancel then exit; = mrCancel then exit;
closeProj; closeProj;
newProj; newNativeProj;
end; end;
procedure TCEMainForm.actProjCloseExecute(Sender: TObject); procedure TCEMainForm.actProjCloseExecute(Sender: TObject);
begin begin
if fProject = nil then exit; if fProjectInterface = nil then exit;
if fProject.modified then if dlgOkCancel( if fProjectInterface.getIfModified then if dlgOkCancel(
'The project modifications are not saved, continue ?') 'The project modifications are not saved, continue ?')
= mrCancel then exit; = mrCancel then exit;
closeProj; closeProj;
@ -1785,8 +1815,9 @@ end;
procedure TCEMainForm.addSource(const aFilename: string); procedure TCEMainForm.addSource(const aFilename: string);
begin begin
if fProject.Sources.IndexOf(aFilename) >= 0 then exit; //TODO-cDUB: add addSource() method to ICECommonProject
fProject.addSource(aFilename); if fNativeProject.Sources.IndexOf(aFilename) >= 0 then exit;
fNativeProject.addSource(aFilename);
end; end;
procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject);
@ -1801,13 +1832,14 @@ end;
procedure TCEMainForm.actProjSaveExecute(Sender: TObject); procedure TCEMainForm.actProjSaveExecute(Sender: TObject);
begin begin
if fProject.fileName <> '' then saveProj if fProjectInterface = nil then exit;
if fProjectInterface.getFilename <> '' then saveProj
else actProjSaveAs.Execute; else actProjSaveAs.Execute;
end; end;
procedure TCEMainForm.actProjOpenExecute(Sender: TObject); procedure TCEMainForm.actProjOpenExecute(Sender: TObject);
begin begin
if fProject <> nil then if fProject.modified then if dlgOkCancel( if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel(
'The project modifications are not saved, continue ?') 'The project modifications are not saved, continue ?')
= mrCancel then exit; = mrCancel then exit;
with TOpenDialog.Create(nil) do with TOpenDialog.Create(nil) do
@ -1830,10 +1862,11 @@ end;
procedure TCEMainForm.actProjSourceExecute(Sender: TObject); procedure TCEMainForm.actProjSourceExecute(Sender: TObject);
begin begin
if fProject = nil then exit; if fProjectInterface = nil then exit;
if not fileExists(fProject.fileName) then exit; if not fileExists(fProjectInterface.getFilename) then exit;
// //
openFile(fProject.fileName); openFile(fProjectInterface.getFilename);
//TODO-cDUB: add json highligher to edit json project in CE
fDoc.Highlighter := LfmSyn; fDoc.Highlighter := LfmSyn;
end; end;
@ -1843,7 +1876,7 @@ var
begin begin
lst := TStringList.Create; lst := TStringList.Create;
try try
fProject.getOpts(lst); fNativeProject.getOpts(lst);
dlgOkInfo(lst.Text); dlgOkInfo(lst.Text);
finally finally
lst.Free; lst.Free;

View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, TreeFilterEdit, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, TreeFilterEdit,
Buttons, math,ce_writableComponent, ce_common, ce_nativeproject, ce_synmemo, GraphType, Buttons, math,ce_writableComponent, ce_common, ce_synmemo, GraphType,
ce_dlangutils, ce_interfaces, ce_observer, ce_symstring; ce_dlangutils, ce_interfaces, ce_observer, ce_symstring;
type type
@ -83,7 +83,7 @@ type
fActCopyMsg: TAction; fActCopyMsg: TAction;
fActSelAll: TAction; fActSelAll: TAction;
fMaxMessCnt: Integer; fMaxMessCnt: Integer;
fProj: TCENativeProject; fProj: ICECommonProject;
fDoc: TCESynMemo; fDoc: TCESynMemo;
fCtxt: TCEAppMessageCtxt; fCtxt: TCEAppMessageCtxt;
fAutoSelect: boolean; fAutoSelect: boolean;
@ -586,16 +586,13 @@ end;
{$REGION ICEProjectObserver ----------------------------------------------------} {$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCEMessagesWidget.projNew(aProject: ICECommonProject); procedure TCEMessagesWidget.projNew(aProject: ICECommonProject);
begin begin
case aProject.getFormat of fProj := aProject;
pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub:fProj := nil;
end;
filterMessages(fCtxt); filterMessages(fCtxt);
end; end;
procedure TCEMessagesWidget.projClosing(aProject: ICECommonProject); procedure TCEMessagesWidget.projClosing(aProject: ICECommonProject);
begin begin
if fProj <> aProject.getProject then if fProj <> aProject then
exit; exit;
// //
clearbyData(fProj); clearbyData(fProj);
@ -605,11 +602,8 @@ end;
procedure TCEMessagesWidget.projFocused(aProject: ICECommonProject); procedure TCEMessagesWidget.projFocused(aProject: ICECommonProject);
begin begin
if fProj = aProject.getProject then exit; if fProj = aProject then exit;
case aProject.getFormat of fProj := aProject;
pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub:fProj := nil;
end;
filterMessages(fCtxt); filterMessages(fCtxt);
end; end;
@ -795,7 +789,7 @@ begin
Itm.Visible := true Itm.Visible := true
else case msgdt^.ctxt of else case msgdt^.ctxt of
amcEdit: itm.Visible := (fDoc = TCESynMemo(msgdt^.data)) and (aCtxt = amcEdit); amcEdit: itm.Visible := (fDoc = TCESynMemo(msgdt^.data)) and (aCtxt = amcEdit);
amcProj: itm.Visible := (fProj = TCENativeProject(msgdt^.data)) and (aCtxt = amcProj); amcProj: itm.Visible := (fProj = ICECommonProject(msgdt^.data)) and (aCtxt = amcProj);
amcApp: itm.Visible := aCtxt = amcApp; amcApp: itm.Visible := aCtxt = amcApp;
amcMisc: itm.Visible := aCtxt = amcMisc; amcMisc: itm.Visible := aCtxt = amcMisc;
end; end;
@ -927,13 +921,13 @@ begin
exit(true); exit(true);
end; end;
// if fname relative to native project path or project filed 'root' // if fname relative to native project path or project filed 'root'
absName := expandFilenameEx(symbolExpander.get('<CPR>') + DirectorySeparator, ident); absName := expandFilenameEx(symbolExpander.get('<CPP>') + DirectorySeparator, ident);
if fileExists(absName) then if fileExists(absName) then
begin begin
getMultiDocHandler.openDocument(absName); getMultiDocHandler.openDocument(absName);
exit(true); exit(true);
end; end;
absName := expandFilenameEx(symbolExpander.get('<CPP>') + DirectorySeparator, ident); absName := expandFilenameEx(symbolExpander.get('<CPR>') + DirectorySeparator, ident);
if fileExists(absName) then if fileExists(absName) then
begin begin
getMultiDocHandler.openDocument(absName); getMultiDocHandler.openDocument(absName);

View File

@ -210,14 +210,12 @@ end;
procedure TCEMRUProjectList.projClosing(aProject: ICECommonProject); procedure TCEMRUProjectList.projClosing(aProject: ICECommonProject);
var var
natProj: TCENativeProject; fname: string;
begin begin
if aProject.getFormat = pfNative then if aProject = nil then exit;
begin //
natProj := TCENativeProject(aProject.getProject); fname := aProject.getFilename;
if FileExists(natProj.fileName) then if FileExists(fname) then Insert(0, fname);
Insert(0, natProj.fileName);
end;
end; end;
initialization initialization

View File

@ -28,7 +28,7 @@ type
fRootFolder: string; fRootFolder: string;
fBasePath: string; fBasePath: string;
fLibAliases: TStringList; fLibAliases: TStringList;
fOptsColl: TCollection; fConfigs: TCollection;
fSrcs, fSrcsCop: TStringList; fSrcs, fSrcsCop: TStringList;
fConfIx: Integer; fConfIx: Integer;
fUpdateCount: NativeInt; fUpdateCount: NativeInt;
@ -63,7 +63,7 @@ type
var PropName: string; IsPath: Boolean; var Handled, Skip: Boolean); override; var PropName: string; IsPath: Boolean; var Handled, Skip: Boolean); override;
published published
property RootFolder: string read fRootFolder write setRoot; property RootFolder: string read fRootFolder write setRoot;
property OptionsCollection: TCollection read fOptsColl write setOptsColl; property OptionsCollection: TCollection read fConfigs 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
property ConfigurationIndex: Integer read fConfIx write setConfIx; property ConfigurationIndex: Integer read fConfIx write setConfIx;
property LibraryAliases: TStringList read fLibAliases write setLibAliases; property LibraryAliases: TStringList read fLibAliases write setLibAliases;
@ -74,21 +74,28 @@ type
procedure endUpdate; procedure endUpdate;
procedure reset; procedure reset;
procedure addDefaults; procedure addDefaults;
function isProjectSource(const aFilename: string): boolean; function getIfIsSource(const aFilename: string): boolean;
function getAbsoluteSourceName(aIndex: integer): string; function getAbsoluteSourceName(aIndex: integer): string;
function getAbsoluteFilename(const aFilename: string): string; function getAbsoluteFilename(const aFilename: string): string;
procedure addSource(const aFilename: string); procedure addSource(const aFilename: string);
function addConfiguration: TCompilerConfiguration; function addConfiguration: TCompilerConfiguration;
procedure getOpts(const aList: TStrings); procedure getOpts(const aList: TStrings);
function runProject(const runArgs: string = ''): Boolean; function run(const runArgs: string = ''): Boolean;
function compileProject: Boolean; function compile: Boolean;
//
function getIfModified: boolean;
function getOutputFilename: string;
function getConfigurationCount: integer;
procedure setActiveConfiguration(index: integer);
function getConfigurationName(index: integer): string;
function getFilename: string;
function getBinaryKind: TProjectBinaryKind;
// //
property configuration[ix: integer]: TCompilerConfiguration read getConfig; property configuration[ix: integer]: TCompilerConfiguration read getConfig;
property currentConfiguration: TCompilerConfiguration read getCurrConf; property currentConfiguration: TCompilerConfiguration read getCurrConf;
property onChange: TNotifyEvent read fOnChange write fOnChange; property onChange: TNotifyEvent read fOnChange write fOnChange;
property modified: Boolean read fModified; property modified: Boolean read fModified;
property canBeRun: Boolean read fCanBeRun; property canBeRun: Boolean read fCanBeRun;
property outputFilename: string read fOutputFilename;
end; end;
// native project have no ext constraint, this function tells if filename is project // native project have no ext constraint, this function tells if filename is project
@ -109,7 +116,7 @@ begin
fSrcs := TStringList.Create; fSrcs := TStringList.Create;
fSrcs.OnChange := @subMemberChanged; fSrcs.OnChange := @subMemberChanged;
fSrcsCop := TStringList.Create; fSrcsCop := TStringList.Create;
fOptsColl := TCollection.create(TCompilerConfiguration); fConfigs := TCollection.create(TCompilerConfiguration);
// //
reset; reset;
addDefaults; addDefaults;
@ -132,7 +139,7 @@ begin
fLibAliases.Free; fLibAliases.Free;
fSrcs.free; fSrcs.free;
fSrcsCop.Free; fSrcsCop.Free;
fOptsColl.free; fConfigs.free;
killProcess(fRunner); killProcess(fRunner);
inherited; inherited;
end; end;
@ -149,7 +156,7 @@ end;
function TCENativeProject.addConfiguration: TCompilerConfiguration; function TCENativeProject.addConfiguration: TCompilerConfiguration;
begin begin
result := TCompilerConfiguration(fOptsColl.Add); result := TCompilerConfiguration(fConfigs.Add);
result.onChanged := @subMemberChanged; result.onChanged := @subMemberChanged;
end; end;
@ -157,8 +164,8 @@ procedure TCENativeProject.setOptsColl(const aValue: TCollection);
var var
i: nativeInt; i: nativeInt;
begin begin
fOptsColl.Assign(aValue); fConfigs.Assign(aValue);
for i:= 0 to fOptsColl.Count-1 do for i:= 0 to fConfigs.Count-1 do
Configuration[i].onChanged := @subMemberChanged; Configuration[i].onChanged := @subMemberChanged;
end; end;
@ -226,7 +233,7 @@ procedure TCENativeProject.setConfIx(aValue: Integer);
begin begin
beginUpdate; beginUpdate;
if aValue < 0 then aValue := 0; if aValue < 0 then aValue := 0;
if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1; if aValue > fConfigs.Count-1 then aValue := fConfigs.Count-1;
fConfIx := aValue; fConfIx := aValue;
endUpdate; endUpdate;
end; end;
@ -282,31 +289,31 @@ end;
function TCENativeProject.getConfig(const ix: integer): TCompilerConfiguration; function TCENativeProject.getConfig(const ix: integer): TCompilerConfiguration;
begin begin
result := TCompilerConfiguration(fOptsColl.Items[ix]); result := TCompilerConfiguration(fConfigs.Items[ix]);
result.onChanged := @subMemberChanged; result.onChanged := @subMemberChanged;
end; end;
function TCENativeProject.getCurrConf: TCompilerConfiguration; function TCENativeProject.getCurrConf: TCompilerConfiguration;
begin begin
result := TCompilerConfiguration(fOptsColl.Items[fConfIx]); result := TCompilerConfiguration(fConfigs.Items[fConfIx]);
end; end;
procedure TCENativeProject.addDefaults; procedure TCENativeProject.addDefaults;
begin begin
with TCompilerConfiguration(fOptsColl.Add) do with TCompilerConfiguration(fConfigs.Add) do
begin begin
Name := 'debug'; Name := 'debug';
debugingOptions.debug := true; debugingOptions.debug := true;
debugingOptions.codeviewCformat := true; debugingOptions.codeviewCformat := true;
outputOptions.boundsCheck := onAlways; outputOptions.boundsCheck := onAlways;
end; end;
with TCompilerConfiguration(fOptsColl.Add) do with TCompilerConfiguration(fConfigs.Add) do
begin begin
Name := 'unittest'; Name := 'unittest';
outputOptions.unittest := true; outputOptions.unittest := true;
outputOptions.boundsCheck := onAlways; outputOptions.boundsCheck := onAlways;
end; end;
with TCompilerConfiguration(fOptsColl.Add) do with TCompilerConfiguration(fConfigs.Add) do
begin begin
Name := 'release'; Name := 'release';
outputOptions.release := true; outputOptions.release := true;
@ -322,7 +329,7 @@ var
begin begin
beginUpdate; beginUpdate;
fConfIx := 0; fConfIx := 0;
fOptsColl.Clear; fConfigs.Clear;
defConf := addConfiguration; defConf := addConfiguration;
defConf.name := 'default'; defConf.name := 'default';
fSrcs.Clear; fSrcs.Clear;
@ -389,7 +396,7 @@ begin
end; end;
end; end;
function TCENativeProject.isProjectSource(const aFilename: string): boolean; function TCENativeProject.getIfIsSource(const aFilename: string): boolean;
var var
i: Integer; i: Integer;
begin begin
@ -635,7 +642,7 @@ begin
end; end;
end; end;
function TCENativeProject.compileProject: Boolean; function TCENativeProject.compile: Boolean;
var var
config: TCompilerConfiguration; config: TCompilerConfiguration;
compilproc: TProcess; compilproc: TProcess;
@ -649,7 +656,7 @@ begin
if config = nil then if config = nil then
begin begin
msgs.message('unexpected project error: no active configuration', msgs.message('unexpected project error: no active configuration',
Self, amcProj, amkErr); self as ICECommonProject, amcProj, amkErr);
exit; exit;
end; end;
// //
@ -658,7 +665,7 @@ begin
// //
if not runPrePostProcess(config.preBuildProcess) then if not runPrePostProcess(config.preBuildProcess) then
msgs.message('project warning: the pre-compilation process has not been properly executed', msgs.message('project warning: the pre-compilation process has not been properly executed',
Self, amcProj, amkWarn); self as ICECommonProject, amcProj, amkWarn);
// //
if (Sources.Count = 0) and (config.pathsOptions.extraSources.Count = 0) then if (Sources.Count = 0) and (config.pathsOptions.extraSources.Count = 0) then
exit; exit;
@ -668,7 +675,7 @@ begin
olddir := ''; olddir := '';
getDir(0, olddir); getDir(0, olddir);
try try
msgs.message('compiling ' + prjname, Self, amcProj, amkInf); msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
prjpath := extractFilePath(fileName); prjpath := extractFilePath(fileName);
if directoryExists(prjpath) then if directoryExists(prjpath) then
begin begin
@ -683,14 +690,14 @@ begin
while compilProc.Running do while compilProc.Running do
compProcOutput(compilproc); compProcOutput(compilproc);
if compilproc.ExitStatus = 0 then begin if compilproc.ExitStatus = 0 then begin
msgs.message(prjname + ' has been successfully compiled', Self, amcProj, amkInf); msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf);
result := true; result := true;
end else end else
msgs.message(prjname + ' has not been compiled', Self, amcProj, amkWarn); msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn);
if not runPrePostProcess(config.PostBuildProcess) then if not runPrePostProcess(config.PostBuildProcess) then
msgs.message( 'project warning: the post-compilation process has not been properly executed', msgs.message( 'project warning: the post-compilation process has not been properly executed',
Self, amcProj, amkWarn); self as ICECommonProject, amcProj, amkWarn);
finally finally
updateOutFilename; updateOutFilename;
@ -699,7 +706,7 @@ begin
end; end;
end; end;
function TCENativeProject.runProject(const runArgs: string = ''): Boolean; function TCENativeProject.run(const runArgs: string = ''): Boolean;
var var
prm: string; prm: string;
i: Integer; i: Integer;
@ -722,14 +729,14 @@ begin
until prm = ''; until prm = '';
end; end;
// //
if not fileExists(outputFilename) then if not fileExists(getOutputFilename) then
begin begin
getMessageDisplay.message('output executable missing: ' + shortenPath(outputFilename, 25), getMessageDisplay.message('output executable missing: ' + shortenPath(getOutputFilename, 25),
Self, amcProj, amkErr); self as ICECommonProject, amcProj, amkErr);
exit; exit;
end; end;
// //
fRunner.Executable := outputFilename; fRunner.Executable := getOutputFilename;
if fRunner.CurrentDirectory = '' then if fRunner.CurrentDirectory = '' then
fRunner.CurrentDirectory := extractFilePath(fRunner.Executable); fRunner.CurrentDirectory := extractFilePath(fRunner.Executable);
if poUsePipes in fRunner.Options then begin if poUsePipes in fRunner.Options then begin
@ -757,7 +764,7 @@ begin
else else
processOutputToStrings(TProcess(sender), lst); processOutputToStrings(TProcess(sender), lst);
for str in lst do for str in lst do
msgs.message(str, Self, amcProj, amkBub); msgs.message(str, self as ICECommonProject, amcProj, amkBub);
finally finally
lst.Free; lst.Free;
end; end;
@ -777,12 +784,49 @@ begin
try try
processOutputToStrings(proc, lst); processOutputToStrings(proc, lst);
for str in lst do for str in lst do
msgs.message(str, Self, amcProj, amkAuto); msgs.message(str, self as ICECommonProject, amcProj, amkAuto);
finally finally
lst.Free; lst.Free;
end; end;
end; end;
function TCENativeProject.getIfModified: boolean;
begin
exit(fModified);
end;
function TCENativeProject.getOutputFilename: string;
begin
exit(fOutputFilename);
end;
function TCENativeProject.getConfigurationCount: integer;
begin
exit(fConfigs.Count);
end;
procedure TCENativeProject.setActiveConfiguration(index: integer);
begin
setConfIx(index);
end;
function TCENativeProject.getConfigurationName(index: integer): string;
begin
if index > fConfigs.Count -1 then index := fConfigs.Count -1;
if index < 0 then index := 0;
result := getConfig(index).name;
end;
function TCENativeProject.getFilename: string;
begin
exit(fFilename);
end;
function TCENativeProject.getBinaryKind: TProjectBinaryKind;
begin
exit(currentConfiguration.outputOptions.binaryKind);
end;
function isValidNativeProject(const filename: string): boolean; function isValidNativeProject(const filename: string): boolean;
var var
maybe: TCENativeProject; maybe: TCENativeProject;

View File

@ -21,6 +21,7 @@ type
TCESymbolExpander = class(ICEMultiDocObserver, ICEProjectObserver) TCESymbolExpander = class(ICEMultiDocObserver, ICEProjectObserver)
private private
fProj: TCENativeProject; fProj: TCENativeProject;
fProjInterface: ICECommonProject;
fDoc: TCESynMemo; fDoc: TCESynMemo;
fNeedUpdate: boolean; fNeedUpdate: boolean;
fSymbols: array[TCESymbol] of string; fSymbols: array[TCESymbol] of string;
@ -69,6 +70,7 @@ end;
{$REGION ICEProjectObserver ----------------------------------------------------} {$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCESymbolExpander.projNew(aProject: ICECommonProject); procedure TCESymbolExpander.projNew(aProject: ICECommonProject);
begin begin
fProjInterface := aProject;
case aProject.getFormat of case aProject.getFormat of
pfNative: fProj := TCENativeProject(aProject.getProject); pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub: fProj := nil; pfDub: fProj := nil;
@ -78,6 +80,7 @@ end;
procedure TCESymbolExpander.projClosing(aProject: ICECommonProject); procedure TCESymbolExpander.projClosing(aProject: ICECommonProject);
begin begin
fProjInterface := nil;
if fProj <> aProject.getProject then if fProj <> aProject.getProject then
exit; exit;
fProj := nil; fProj := nil;
@ -86,6 +89,7 @@ end;
procedure TCESymbolExpander.projFocused(aProject: ICECommonProject); procedure TCESymbolExpander.projFocused(aProject: ICECommonProject);
begin begin
fProjInterface := aProject;
case aProject.getFormat of case aProject.getFormat of
pfNative: fProj := TCENativeProject(aProject.getProject); pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub: fProj := nil; pfDub: fProj := nil;
@ -95,6 +99,7 @@ end;
procedure TCESymbolExpander.projChanged(aProject: ICECommonProject); procedure TCESymbolExpander.projChanged(aProject: ICECommonProject);
begin begin
fProjInterface := aProject;
if fProj <> aProject.getProject then if fProj <> aProject.getProject then
exit; exit;
fNeedUpdate := true; fNeedUpdate := true;
@ -140,72 +145,57 @@ end;
{$REGION Symbol things ---------------------------------------------------------} {$REGION Symbol things ---------------------------------------------------------}
procedure TCESymbolExpander.updateSymbols; procedure TCESymbolExpander.updateSymbols;
var var
hasProj: boolean; hasNativeProj: boolean;
hasProjItf: boolean;
hasDoc: boolean; hasDoc: boolean;
fname: string; fname: string;
i: Integer; i: Integer;
e: TCESymbol;
str: TStringList; str: TStringList;
const const
na = '``'; na = '``';
begin begin
if not fNeedUpdate then exit; if not fNeedUpdate then exit;
fNeedUpdate := false; fNeedUpdate := false;
hasProj := fProj <> nil; //
hasNativeProj := fProj <> nil;
hasProjItf := fProjInterface <> nil;
hasDoc := fDoc <> nil; hasDoc := fDoc <> nil;
//
for e := low(TCESymbol) to high(TCESymbol) do
fSymbols[e] := na;
//
// application // application
fSymbols[CAF] := Application.ExeName; fSymbols[CAF] := Application.ExeName;
fSymbols[CAP] := ExtractFilePath(Application.ExeName); fSymbols[CAP] := ExtractFilePath(fSymbols[CAF]);
// document // document
if hasDoc then if hasDoc then
begin begin
if fileExists(fDoc.fileName) then if not fileExists(fDoc.fileName) then
begin fDoc.saveTempFile;
fSymbols[CFF] := fDoc.fileName; fSymbols[CFF] := fDoc.fileName;
fSymbols[CFP] := ExtractFilePath(fDoc.fileName); fSymbols[CFP] := ExtractFilePath(fDoc.fileName);
end
else
begin
fSymbols[CFF] := na;
fSymbols[CFP] := na;
end;
if fDoc.Identifier <> '' then if fDoc.Identifier <> '' then
fSymbols[CI] := fDoc.Identifier fSymbols[CI] := fDoc.Identifier;
else
fSymbols[CI] := na;
end
else
begin
fSymbols[CFF] := na;
fSymbols[CFP] := na;
fSymbols[CI] := na;
end; end;
// project // project interface
if hasProj then if hasProjItf then
begin
fSymbols[CPF] := fProjInterface.getFilename;
fSymbols[CPP] := ExtractFilePath(fSymbols[CPF]);
fSymbols[CPN] := stripFileExt(extractFileName(fSymbols[CPF]));
end;
// TODO-cDUB: move to upper block expansion of CPO, CPFS & CPCD when implemented in ICECOmmonProject
if hasNativeProj then
begin begin
if fileExists(fProj.fileName) then if fileExists(fProj.fileName) then
begin begin
fSymbols[CPF] := fProj.fileName;
fSymbols[CPP] := ExtractFilePath(fProj.fileName);
fSymbols[CPR] := fProj.getAbsoluteFilename(fProj.RootFolder); fSymbols[CPR] := fProj.getAbsoluteFilename(fProj.RootFolder);
fSymbols[CPN] := stripFileExt(extractFileName(fProj.fileName)); fSymbols[CPO] := fProj.getOutputFilename;
fSymbols[CPO] := fProj.outputFilename;
if fSymbols[CPR] = '' then if fSymbols[CPR] = '' then
fSymbols[CPR] := fSymbols[CPP]; fSymbols[CPR] := fSymbols[CPP];
end
else
begin
fSymbols[CPF] := na;
fSymbols[CPP] := na;
fSymbols[CPR] := na;
fSymbols[CPN] := na;
fSymbols[CPO] := na;
end; end;
if fProj.Sources.Count = 0 then if fProj.Sources.Count <> 0 then
begin
fSymbols[CPFS] := na;
fSymbols[CPCD] := na;
end
else
begin begin
str := TStringList.Create; str := TStringList.Create;
try try
@ -225,16 +215,6 @@ begin
str.Free; str.Free;
end; end;
end; end;
end
else
begin
fSymbols[CPF] := na;
fSymbols[CPP] := na;
fSymbols[CPR] := na;
fSymbols[CPN] := na;
fSymbols[CPO] := na;
fSymbols[CPFS] := na;
fSymbols[CPCD] := na;
end; end;
end; end;
@ -287,16 +267,16 @@ begin
'CAF', 'CoeditApplicationFile': Result += fSymbols[CAF]; 'CAF', 'CoeditApplicationFile': Result += fSymbols[CAF];
'CAP', 'CoeditApplicationPath': Result += fSymbols[CAP]; 'CAP', 'CoeditApplicationPath': Result += fSymbols[CAP];
// //
'CFF', 'CurrentFileFile': Result += fSymbols[CFF]; 'CFF', 'CurrentFileFile' : Result += fSymbols[CFF];
'CFP', 'CurrentFilePath': Result += fSymbols[CFP]; 'CFP', 'CurrentFilePath' : Result += fSymbols[CFP];
'CI', 'CurrentIdentifier': Result += fSymbols[CI]; 'CI', 'CurrentIdentifier' : Result += fSymbols[CI];
// //
'CPF', 'CurrentProjectFile': Result += fSymbols[CPF]; 'CPF', 'CurrentProjectFile' : Result += fSymbols[CPF];
'CPFS', 'CurrentProjectFiles': Result += fSymbols[CPFS]; 'CPFS', 'CurrentProjectFiles' : Result += fSymbols[CPFS];
'CPN', 'CurrentProjectName': Result += fSymbols[CPN]; 'CPN', 'CurrentProjectName' : Result += fSymbols[CPN];
'CPO', 'CurrentProjectOutput': Result += fSymbols[CPO]; 'CPO', 'CurrentProjectOutput' : Result += fSymbols[CPO];
'CPP', 'CurrentProjectPath': Result += fSymbols[CPP]; 'CPP', 'CurrentProjectPath' : Result += fSymbols[CPP];
'CPR', 'CurrentProjectRoot': Result += fSymbols[CPR]; 'CPR', 'CurrentProjectRoot' : Result += fSymbols[CPR];
'CPCD','CurrentProjectCommonDirectory': Result += fSymbols[CPCD]; 'CPCD','CurrentProjectCommonDirectory': Result += fSymbols[CPCD];
end; end;
end; end;

View File

@ -81,7 +81,7 @@ type
private private
fAutoRefresh: Boolean; fAutoRefresh: Boolean;
fSingleClick: Boolean; fSingleClick: Boolean;
fProj: TCENativeProject; fProj: ICECommonProject;
fDoc: TCESynMemo; fDoc: TCESynMemo;
fToolProc: TCEProcess; fToolProc: TCEProcess;
fTodos: TTodoItems; fTodos: TTodoItems;
@ -336,15 +336,12 @@ end;
{$REGION ICEProjectObserver ----------------------------------------------------} {$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCETodoListWidget.projNew(aProject: ICECommonProject); procedure TCETodoListWidget.projNew(aProject: ICECommonProject);
begin begin
fProj := nil; fProj := aProject;
if aProject.getFormat <> pfNative then
exit;
fProj := TCENativeProject(aProject.getProject);
end; end;
procedure TCETodoListWidget.projChanged(aProject: ICECommonProject); procedure TCETodoListWidget.projChanged(aProject: ICECommonProject);
begin begin
if fProj <> aProject.getProject then if fProj <> aProject then
exit; exit;
if Visible and fAutoRefresh then if Visible and fAutoRefresh then
callToolProcess; callToolProcess;
@ -352,7 +349,7 @@ end;
procedure TCETodoListWidget.projClosing(aProject: ICECommonProject); procedure TCETodoListWidget.projClosing(aProject: ICECommonProject);
begin begin
if fProj <> aProject.getProject then if fProj <> aProject then
exit; exit;
fProj := nil; fProj := nil;
if Visible and fAutoRefresh then if Visible and fAutoRefresh then
@ -361,12 +358,9 @@ end;
procedure TCETodoListWidget.projFocused(aProject: ICECommonProject); procedure TCETodoListWidget.projFocused(aProject: ICECommonProject);
begin begin
if aProject.getProject = fProj then if aProject = fProj then
exit; exit;
fProj := nil; fProj := aProject;
if aProject.getFormat <> pfNative then
exit;
fProj := TCENativeProject(aProject.getProject);
if Visible and fAutoRefresh then if Visible and fAutoRefresh then
callToolProcess; callToolProcess;
end; end;
@ -386,7 +380,7 @@ begin
if ((fProj <> nil) and (fDoc = nil)) then if ((fProj <> nil) and (fDoc = nil)) then
exit(tcProject); exit(tcProject);
// //
if fProj.isProjectSource(fDoc.fileName) then if fProj.getIfIsSource(fDoc.fileName) then
exit(tcProject) exit(tcProject)
else else
exit(tcFile); exit(tcFile);