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

Merge branch 'dub-integration'

This commit is contained in:
Basile Burg 2015-09-02 14:46:33 +02:00
parent 8091356ba5 e1993bafea
commit 24d141ab88
13 changed files with 514 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lazproj/coedit.lpi
View File

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

2
lazproj/coedit.lpr
View File

@ -9,7 +9,7 @@ uses
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_sharedres,
ce_observer, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent,
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}

18
src/ce_dmdwrap.pas
View File

@ -5,7 +5,8 @@ unit ce_dmdwrap;
interface
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);
(**
* Describes the output kind.
*)
TBinaryKind = (executable, staticlib, sharedlib, obj);
(**
* Describes the bounds check kinds.
*)
@ -119,7 +115,7 @@ type
TOutputOpts = class(TOptsGroup)
private
fTrgKind: TTargetSystem;
fBinKind: TBinaryKind;
fBinKind: TProjectBinaryKind;
fUnittest: boolean;
fVerIds: TStringList;
fInline: boolean;
@ -135,7 +131,7 @@ type
procedure setAllInst(const aValue: boolean);
procedure setUnittest(const aValue: boolean);
procedure setTrgKind(const aValue: TTargetSystem);
procedure setBinKind(const aValue: TBinaryKind);
procedure setBinKind(const aValue: TProjectBinaryKind);
procedure setInline(const aValue: boolean);
procedure setBoundsCheck(const aValue: TBoundCheckKind);
procedure setOptims(const aValue: boolean);
@ -147,7 +143,7 @@ type
published
property alwaysLinkStaticLibs: boolean read fAlwayLinkLibs write setAlwaysLinkLibs default false;
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 boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck default safeOnly;
property optimizations: boolean read fOptimz write setOptims default false;
@ -562,7 +558,7 @@ var
opt: string;
const
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');
begin
opt := binKindStr[fBinKind];
@ -657,7 +653,7 @@ begin
doChanged;
end;
procedure TOutputOpts.setBinKind(const aValue: TBinaryKind);
procedure TOutputOpts.setBinKind(const aValue: TProjectBinaryKind);
begin
if fBinKind = aValue then exit;
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.

54
src/ce_interfaces.pas
View File

@ -13,8 +13,14 @@ type
// describes the project kind. Used as a hint to cast ICECommonProject.getProject()
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']
@ -23,12 +29,26 @@ type
// returns an untyped object that can be casted using getFormat()
function getProject: TObject;
//// project file
//function filename: string;
//procedure loadFromFile(const aFilename: string);
//procedure saveToFile(const aFilename: string);
//procedure save;
//
// sub routines for the actions --------------------------------------------
// tries to compile and returns true if it does
function compile: boolean;
// 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
//function sourceCount: integer;
//function source(index: integer): string;
@ -36,9 +56,23 @@ type
//function stringImport(index: integer): string;
//function moduleImportCount: integer;
//function moduleImport(index: integer): string;
//function configurationCount: integer;
//function configuration(index: integer): string;
//function outputFilename: string;
// returns true if aFilename is a project source
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;
(**

7
src/ce_libmaneditor.pas
View File

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

3
src/ce_main.lfm
View File

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

151
src/ce_main.pas
View File

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

24
src/ce_messages.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
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;
type
@ -83,7 +83,7 @@ type
fActCopyMsg: TAction;
fActSelAll: TAction;
fMaxMessCnt: Integer;
fProj: TCENativeProject;
fProj: ICECommonProject;
fDoc: TCESynMemo;
fCtxt: TCEAppMessageCtxt;
fAutoSelect: boolean;
@ -586,16 +586,13 @@ end;
{$REGION ICEProjectObserver ----------------------------------------------------}
procedure TCEMessagesWidget.projNew(aProject: ICECommonProject);
begin
case aProject.getFormat of
pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub:fProj := nil;
end;
fProj := aProject;
filterMessages(fCtxt);
end;
procedure TCEMessagesWidget.projClosing(aProject: ICECommonProject);
begin
if fProj <> aProject.getProject then
if fProj <> aProject then
exit;
//
clearbyData(fProj);
@ -605,11 +602,8 @@ end;
procedure TCEMessagesWidget.projFocused(aProject: ICECommonProject);
begin
if fProj = aProject.getProject then exit;
case aProject.getFormat of
pfNative: fProj := TCENativeProject(aProject.getProject);
pfDub:fProj := nil;
end;
if fProj = aProject then exit;
fProj := aProject;
filterMessages(fCtxt);
end;
@ -795,7 +789,7 @@ begin
Itm.Visible := true
else case msgdt^.ctxt of
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;
amcMisc: itm.Visible := aCtxt = amcMisc;
end;
@ -927,13 +921,13 @@ begin
exit(true);
end;
// 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
begin
getMultiDocHandler.openDocument(absName);
exit(true);
end;
absName := expandFilenameEx(symbolExpander.get('<CPP>') + DirectorySeparator, ident);
absName := expandFilenameEx(symbolExpander.get('<CPR>') + DirectorySeparator, ident);
if fileExists(absName) then
begin
getMultiDocHandler.openDocument(absName);

12
src/ce_mru.pas
View File

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

110
src/ce_nativeproject.pas
View File

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

102
src/ce_symstring.pas
View File

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

20
src/ce_todolist.pas
View File

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