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

projects, CE & DUB, async compilation

This commit is contained in:
Basile Burg 2016-01-30 04:18:30 +01:00
parent ccc3f7c956
commit a533057ff5
19 changed files with 251 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/ce_dcd.pas
View File

@ -42,6 +42,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docFocused(aDoc: TCESynMemo);
@ -175,6 +176,10 @@ end;
procedure TCEDcdWrapper.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEDcdWrapper.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}

107
src/ce_dubproject.pas
View File

@ -5,13 +5,15 @@ unit ce_dubproject;
interface
uses
Classes, SysUtils, fpjson, jsonparser, jsonscanner, process, strutils,
ce_common, ce_interfaces, ce_observer, ce_dialogs;
Classes, SysUtils, fpjson, jsonparser, jsonscanner, process, strutils, LazFileUtils,
ce_common, ce_interfaces, ce_observer, ce_dialogs, ce_processes;
type
TCEDubProject = class(TComponent, ICECommonProject)
private
fDubProc: TCEProcess;
fPreCompilePath: string;
fPackageName: string;
fFilename: string;
fModified: boolean;
@ -29,6 +31,7 @@ type
fModificationCount: integer;
fOutputFileName: string;
fSaveAsUtf8: boolean;
fCompiled: boolean;
//
procedure doModified;
procedure updateFields;
@ -39,7 +42,8 @@ type
procedure updateImportPathsFromJson;
procedure updateOutputNameFromJson;
function findTargetKindInd(value: TJSONObject): boolean;
procedure dubProcOutput(proc: TProcess);
procedure dubProcOutput(proc: TObject);
procedure dubProcTerminated(proc: TObject);
function getCurrentCustomConfig: TJSONObject;
function compileOrRun(run: boolean; const runArgs: string = ''): boolean;
public
@ -73,7 +77,8 @@ type
procedure setActiveConfigurationIndex(index: integer);
function configurationName(index: integer): string;
//
function compile: boolean;
procedure compile;
function compiled: boolean;
function run(const runArgs: string = ''): boolean;
function targetUpToDate: boolean;
//
@ -348,7 +353,7 @@ end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION ICECommonProject: actions ---------------------------------------------}
procedure TCEDubProject.dubProcOutput(proc: TProcess);
procedure TCEDubProject.dubProcOutput(proc: TObject);
var
lst: TStringList;
str: string;
@ -357,7 +362,7 @@ begin
lst := TStringList.Create;
msgs := getMessageDisplay;
try
processOutputToStrings(proc, lst);
fDubProc.getFullLines(lst);
for str in lst do
msgs.message(str, self as ICECommonProject, amcProj, amkAuto);
finally
@ -365,65 +370,93 @@ begin
end;
end;
procedure TCEDubProject.dubProcTerminated(proc: TObject);
var
msgs: ICEMessagesDisplay;
prjname: string;
begin
dubProcOutput(proc);
msgs := getMessageDisplay;
prjname := shortenPath(filename);
fCompiled := fDubProc.ExitStatus = 0;
if fCompiled then
msgs.message(prjname + ' has been successfully compiled',
self as ICECommonProject, amcProj, amkInf)
else
msgs.message(prjname + ' has not been compiled',
self as ICECommonProject, amcProj, amkWarn);
subjProjCompiled(fProjectSubject, self as ICECommonProject, fCompiled);
SetCurrentDirUTF8(fPreCompilePath);
end;
function TCEDubProject.compileOrRun(run: boolean; const runArgs: string = ''): boolean;
var
dubproc: TProcess;
olddir: string;
prjname: string;
msgs: ICEMessagesDisplay;
begin
result := false;
msgs := getMessageDisplay;
if fDubProc.isNotNil and fDubProc.Active then
begin
msgs.message('the project is already being compiled',
self as ICECommonProject, amcProj, amkWarn);
exit;
end;
killProcess(fDubProc);
fCompiled := false;
if not fFilename.fileExists then
begin
dlgOkInfo('The DUB project must be saved before being compiled or run !');
exit;
end;
msgs := getMessageDisplay;
msgs.clearByData(Self as ICECommonProject);
prjname := shortenPath(fFilename);
dubproc := TProcess.Create(nil);
olddir := GetCurrentDir;
fDubProc:= TCEProcess.Create(nil);
olddir := GetCurrentDir;
try
if not run then
begin
subjProjCompiling(fProjectSubject, self as ICECommonProject);
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
if modified then saveToFile(fFilename);
end;
chDir(fFilename.extractFilePath);
dubproc.Executable := 'dub' + exeExt;
dubproc.Options := dubproc.Options + [poStderrToOutPut, poUsePipes];
dubproc.CurrentDirectory := fFilename.extractFilePath;
dubproc.ShowWindow := swoHIDE;
if not run then
dubproc.Parameters.Add('build')
else
dubproc.Parameters.Add('run');
dubproc.Parameters.Add('--build=' + fBuildTypes.Strings[fBuiltTypeIx]);
if (fConfigs.Count <> 1) and (fConfigs.Strings[0] <> DubDefaultConfigName) then
dubproc.Parameters.Add('--config=' + fConfigs.Strings[fConfigIx]);
dubProc.Parameters.Add('--compiler=' + DubCompilerFilename);
if run and runArgs.isNotEmpty then
dubproc.Parameters.Add('--' + runArgs);
dubproc.Execute;
while dubproc.Running do
dubProcOutput(dubproc);
fDubProc.Executable := 'dub' + exeExt;
fDubProc.Options := fDubProc.Options + [poStderrToOutPut, poUsePipes];
fDubProc.CurrentDirectory := fFilename.extractFilePath;
fDubProc.ShowWindow := swoHIDE;
fDubProc.OnReadData:= @dubProcOutput;
if not run then
begin
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);
fDubProc.Parameters.Add('build');
fDubProc.OnTerminate:= @dubProcTerminated;
end
else
begin
fDubProc.Parameters.Add('run');
fDubProc.OnTerminate:= @dubProcOutput;
end;
fDubProc.Parameters.Add('--build=' + fBuildTypes.Strings[fBuiltTypeIx]);
if (fConfigs.Count <> 1) and (fConfigs.Strings[0] <> DubDefaultConfigName) then
fDubProc.Parameters.Add('--config=' + fConfigs.Strings[fConfigIx]);
fDubProc.Parameters.Add('--compiler=' + DubCompilerFilename);
if run and runArgs.isNotEmpty then
fDubProc.Parameters.Add('--' + runArgs);
fDubProc.Execute;
finally
chDir(olddir);
dubproc.Free;
SetCurrentDirUTF8(olddir);
end;
end;
function TCEDubProject.compile: boolean;
procedure TCEDubProject.compile;
begin
result := compileOrRun(false);
fPreCompilePath := GetCurrentDirUTF8;
compileOrRun(false);
end;
function TCEDubProject.compiled: boolean;
begin
exit(fCompiled);
end;
function TCEDubProject.run(const runArgs: string = ''): boolean;

5
src/ce_dubprojeditor.pas
View File

@ -62,6 +62,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
protected
procedure SetVisible(Value: boolean); override;
@ -211,6 +212,10 @@ end;
procedure TCEDubProjectEditorWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEDubProjectEditorWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION Editor ----------------------------------------------------------------}

5
src/ce_editor.pas
View File

@ -75,6 +75,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
function SingleServiceName: string;
function documentCount: Integer;
@ -226,6 +227,10 @@ end;
procedure TCEEditorWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEEditorWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocHandler ----------------------------------------------------}

6
src/ce_gdb.pas
View File

@ -108,13 +108,13 @@ type
procedure gdbCommand(aCommand: string; outputCatcher: TNotifyEvent = nil);
procedure infoRegs;
procedure infoStack;
//
procedure projNew(aProject: ICECommonProject);
procedure projChanged(aProject: ICECommonProject);
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docFocused(aDoc: TCESynMemo);
@ -179,6 +179,10 @@ end;
procedure TCEGdbWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEGdbWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}

68
src/ce_interfaces.pas
View File

@ -76,8 +76,10 @@ type
// sub routines for the actions --------------------------------------------
// tries to compile and returns true if it does
function compile: boolean;
// tries to compile.
procedure compile;
// indicates wether last complation was successful.
function compiled: boolean;
// tries to un the project output and returns true if it did
function run(const runArgs: string = ''): boolean;
// returns true if the target has not to be recompiled
@ -138,6 +140,8 @@ type
procedure projFocused(aProject: ICECommonProject);
// aProject is about to be compiled
procedure projCompiling(aProject: ICECommonProject);
// aProject compilation is finsihed
procedure projCompiled(aProject: ICECommonProject; success: boolean);
end;
(**
* An implementer informs some ICEProjectObserver about the current project(s)
@ -289,30 +293,6 @@ type
(**
* Single service provided by the library manager
* In both cases, if someAliases is empty then all the available entries are passed.
*)
ICELibraryInformer = interface(ICESingleService)
// fills aList with the filenames of the static libraries matching to someAliases content.
procedure getLibsFiles(someAliases: TStrings; aList: TStrings);
// fills aList with the path to static libraries sources matching to someAliases content.
procedure getLibsPaths(someAliases: TStrings; aList: TStrings);
// fills aList with all the available libraries aliases.
procedure getLibsAliases(aList: TStrings);
end;
(**
* Single service that allows objects with a short life-time
* to get the project information.
*)
//ICEProjectInfos = interface(ICESingleService)
// function getCurrentProjectInterface: ICECommonProject;
//end;
{
subject primitives:
@ -336,28 +316,17 @@ type
procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: ICECommonProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjChanged(aSubject: TCEProjectSubject; aProj: ICECommonProject); {$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjCompiling(aSubject: TCEProjectSubject; aProj: ICECommonProject);{$IFDEF RELEASE}inline;{$ENDIF}
procedure subjProjCompiled(aSubject: TCEProjectSubject; aProj: ICECommonProject; success: boolean);{$IFDEF RELEASE}inline;{$ENDIF}
{
Service getters:
The first overload assign the variable only when not yet set, the second is
designed for a punctual usage, for example if a widget needs the service in
a single and rarely called method.
}
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; overload;
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay;
function getMessageDisplay: ICEMessagesDisplay; overload;
function getprocInputHandler(var obj: ICEProcInputHandler): ICEProcInputHandler; overload;
function getprocInputHandler: ICEProcInputHandler; overload;
function getMultiDocHandler(var obj: ICEMultiDocHandler): ICEMultiDocHandler; overload;
function getMultiDocHandler: ICEMultiDocHandler; overload;
function getLibraryInformer(var obj: ICELibraryInformer): ICELibraryInformer; overload;
function getLibraryInformer: ICELibraryInformer; overload;
implementation
{$REGION TCEMultiDocSubject ----------------------------------------------------}
@ -434,6 +403,15 @@ begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projCompiling(aProj);
end;
procedure subjProjCompiled(aSubject: TCEProjectSubject; aProj: ICECommonProject; success: boolean);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projCompiled(aProj, success);
end;
{$ENDREGION}
{$REGION ICESingleService getters ----------------------------------------------}
@ -472,18 +450,6 @@ function getMultiDocHandler: ICEMultiDocHandler;
begin
exit(EntitiesConnector.getSingleService('ICEMultiDocHandler') as ICEMultiDocHandler);
end;
function getLibraryInformer(var obj: ICELibraryInformer): ICELibraryInformer;
begin
if obj = nil then
obj := EntitiesConnector.getSingleService('ICELibraryInformer') as ICELibraryInformer;
exit(obj);
end;
function getLibraryInformer: ICELibraryInformer;
begin
exit(EntitiesConnector.getSingleService('ICELibraryInformer') as ICELibraryInformer);
end;
{$ENDREGION}
end.

6
src/ce_lcldragdrop.pas
View File

@ -19,6 +19,8 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
function getFilename(src: TObject): string;
public
constructor create;
@ -71,6 +73,10 @@ procedure TDDHandler.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TDDHandler.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
function TDDHandler.getFilename(src: TObject): string;
var
lst: TListView;

5
src/ce_libmaneditor.pas
View File

@ -52,6 +52,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure dataToGrid;
procedure gridToData;
@ -128,6 +129,10 @@ procedure TCELibManEditorWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCELibManEditorWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
procedure TCELibManEditorWidget.ListEdited(Sender: TObject; Item: TListItem; var AValue: string);
begin
gridToData;

34
src/ce_main.pas
View File

@ -225,9 +225,11 @@ type
fSymlWidg: TCESymbolListWidget;
fInfoWidg: TCEInfoWidget;
fDubProjWidg: TCEDubProjectEditorWidget;
fGdbWidg: TCEGdbWidget;
//fGdbWidg: TCEGdbWidget;
fDfmtWidg: TCEDfmtWidget;
fRunProjAfterCompArg: boolean;
fRunProjAfterCompile: boolean;
fFirstShown: boolean;
fProjFromCommandLine: boolean;
fInitialized: boolean;
@ -255,6 +257,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
// ICEEditableShortcut
function scedWantFirst: boolean;
@ -830,7 +833,7 @@ begin
fSymlWidg := TCESymbolListWidget.create(self);
fInfoWidg := TCEInfoWidget.create(self);
fDubProjWidg:= TCEDubProjectEditorWidget.create(self);
fGdbWidg := TCEGdbWidget.create(self);
//fGdbWidg := TCEGdbWidget.create(self);
fDfmtWidg := TCEDfmtWidget.create(self);
getMessageDisplay(fMsgs);
@ -849,7 +852,7 @@ begin
fWidgList.addWidget(@fSymlWidg);
fWidgList.addWidget(@fInfoWidg);
fWidgList.addWidget(@fDubProjWidg);
fWidgList.addWidget(@fGdbWidg);
//fWidgList.addWidget(@fGdbWidg);
fWidgList.addWidget(@fDfmtWidg);
fWidgList.sort(@CompareWidgCaption);
@ -1384,6 +1387,20 @@ end;
procedure TCEMainForm.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEMainForm.projCompiled(aProject: ICECommonProject; success: boolean);
var
runArgs: string = '';
begin
if fRunProjAfterCompile and assigned(fProjectInterface) then
begin
if fRunProjAfterCompArg and not InputQuery('Execution arguments', '', runargs) then
runargs := '';
fProjectInterface.run(runargs);
end;
fRunProjAfterCompile := false;
fRunProjAfterCompArg := false;
end;
{$ENDREGION}
{$REGION ICEEditableShortCut ---------------------------------------------------}
@ -1991,18 +2008,13 @@ end;
procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject);
begin
if fProjectInterface.compile then
fProjectInterface.run;
fRunProjAfterCompile := true;
fProjectInterface.compile;
end;
procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject);
var
runargs: string = '';
begin
if not fProjectInterface.compile then
exit;
if InputQuery('Execution arguments', '', runargs) then
fProjectInterface.run(runargs);
fRunProjAfterCompArg := true;
end;
procedure TCEMainForm.actProjRunExecute(Sender: TObject);

5
src/ce_messages.pas
View File

@ -133,6 +133,7 @@ type
procedure projFocused(aProject: ICECommonProject);
procedure projChanged(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docClosing(aDoc: TCESynMemo);
@ -655,6 +656,10 @@ end;
procedure TCEMessagesWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEMessagesWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}

5
src/ce_miniexplorer.pas
View File

@ -113,6 +113,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docFocused(aDoc: TCESynMemo);
@ -328,6 +329,10 @@ end;
procedure TCEMiniExplorerWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEMiniExplorerWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultidocObserver ---------------------------------------------------}

5
src/ce_mru.pas
View File

@ -68,6 +68,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
public
constructor create; override;
destructor destroy; override;
@ -208,6 +209,10 @@ procedure TCEMRUProjectList.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEMRUProjectList.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
procedure TCEMRUProjectList.projClosing(aProject: ICECommonProject);
var
fname: string;

118
src/ce_nativeproject.pas
View File

@ -26,8 +26,10 @@ type
*)
TCENativeProject = class(TWritableLfmTextComponent, ICECommonProject)
private
fCompilProc: TCEProcess;
fOnChange: TNotifyEvent;
fModified: boolean;
fPreCompilePath: string;
fRootFolder: string;
fBasePath: string;
fRunnerOldCwd: string;
@ -41,6 +43,7 @@ type
fOutputFilename: string;
fCanBeRun: boolean;
fBaseConfig: TCompilerConfiguration;
fCompiled: boolean;
procedure updateOutFilename;
procedure doChanged;
procedure getBaseConfig;
@ -56,7 +59,8 @@ type
// passes pre/post/executed project/ outputs as bubles.
procedure runProcOutput(sender: TObject);
// passes compilation message as "to be guessed"
procedure compProcOutput(proc: TProcess);
procedure compProcOutput(proc: TObject);
procedure compProcTerminated(proc: TObject);
protected
procedure beforeLoad; override;
procedure afterSave; override;
@ -103,7 +107,8 @@ type
function importPath(index: integer): string;
//
function run(const runArgs: string = ''): Boolean;
function compile: Boolean;
function compiled: Boolean;
procedure compile;
function targetUpToDate: boolean;
//
property configuration[ix: integer]: TCompilerConfiguration read getConfig;
@ -156,6 +161,7 @@ destructor TCENativeProject.destroy;
begin
subjProjClosing(fProjectSubject, self);
fProjectSubject.Free;
fCompilProc.Free;
//
fOnChange := nil;
fLibAliases.Free;
@ -708,17 +714,28 @@ begin
end;
end;
function TCENativeProject.compile: Boolean;
function TCENativeProject.compiled: boolean;
begin
exit(fCompiled);
end;
procedure TCENativeProject.compile;
var
config: TCompilerConfiguration;
compilproc: TProcess;
prjpath, oldCwd, str: string;
prjpath: string;
prjname: string;
msgs: ICEMessagesDisplay;
begin
result := false;
config := currentConfiguration;
msgs := getMessageDisplay;
if fCompilProc.isNotNil and fCompilProc.Active then
begin
msgs.message('the project is already being compiled',
self as ICECommonProject, amcProj, amkWarn);
exit;
end;
killProcess(fCompilProc);
fCompiled := false;
config := currentConfiguration;
if config.isNil then
begin
msgs.message('unexpected project error: no active configuration',
@ -730,55 +747,35 @@ begin
subjProjCompiling(fProjectSubject, Self);
//
prjpath := fFileName.extractFilePath;
oldCwd := GetCurrentDirUTF8;
fPreCompilePath := GetCurrentDirUTF8;
SetCurrentDirUTF8(prjpath);
//
if not runPrePostProcess(config.preBuildProcess) then
msgs.message('warning: pre-compilation process or commands not properly executed',
self as ICECommonProject, amcProj, amkWarn);
//
SetCurrentDirUTF8(prjpath);
//
if (Sources.Count = 0) and (config.pathsOptions.extraSources.Count = 0) then
begin
SetCurrentDirUTF8(oldCwd);
SetCurrentDirUTF8(fPreCompilePath);
exit;
end;
//
prjname := shortenPath(filename, 25);
compilproc := TProcess.Create(nil);
try
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
// this doesn't work under linux, so the previous ChDir.
if prjpath.dirExists then
compilproc.CurrentDirectory := prjpath;
compilproc.Executable := NativeProjectCompilerFilename;
compilproc.Options := compilproc.Options + [poStderrToOutPut, poUsePipes];
compilproc.ShowWindow := swoHIDE;
getOpts(compilproc.Parameters);
compilproc.Execute;
if NativeProjectCompiler = gdc then
begin
str := 'gdc';
compilproc.Input.Write(str[1], 3);
compilproc.CloseInput;
end;
while compilProc.Running do
compProcOutput(compilproc);
if compilproc.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
updateOutFilename;
compilproc.Free;
end;
SetCurrentDirUTF8(prjpath);
//
if not runPrePostProcess(config.PostBuildProcess) then
msgs.message( 'warning: post-compilation process or commands not properly executed',
self as ICECommonProject, amcProj, amkWarn);
SetCurrentDirUTF8(oldCwd);
fCompilProc := TCEProcess.Create(nil);
subjProjCompiling(fProjectSubject, self as ICECommonProject);
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
// this doesn't work under linux, so the previous ChDir.
if prjpath.dirExists then
fCompilProc.CurrentDirectory := prjpath;
fCompilProc.Executable := NativeProjectCompilerFilename;
fCompilProc.Options := fCompilProc.Options + [poStderrToOutPut, poUsePipes];
fCompilProc.ShowWindow := swoHIDE;
fCompilProc.OnReadData:= @compProcOutput;
fCompilProc.OnTerminate:= @compProcTerminated;
getOpts(fCompilProc.Parameters);
fCompilProc.Execute;
end;
function TCENativeProject.run(const runArgs: string = ''): Boolean;
@ -792,7 +789,7 @@ begin
if fRunnerOldCwd.dirExists then
ChDir(fRunnerOldCwd);
//
fRunner := TCEProcess.Create(nil); // fRunner can use the input process widget.
fRunner := TCEProcess.Create(nil);
currentConfiguration.runOptions.setProcess(fRunner);
if runArgs.isNotEmpty then
begin
@ -836,7 +833,7 @@ var
lst: TStringList;
str: string;
msgs: ICEMessagesDisplay;
proc : TProcess;
proc: TProcess;
begin
lst := TStringList.Create;
msgs := getMessageDisplay;
@ -863,16 +860,16 @@ begin
end;
end;
procedure TCENativeProject.compProcOutput(proc: TProcess);
procedure TCENativeProject.compProcOutput(proc: TObject);
var
lst: TStringList;
str: string;
msgs: ICEMessagesDisplay;
begin
lst := TStringList.Create;
msgs := getMessageDisplay;
try
processOutputToStrings(proc, lst);
msgs := getMessageDisplay;
fCompilProc.getFullLines(lst);
for str in lst do
msgs.message(str, self as ICECommonProject, amcProj, amkAuto);
finally
@ -880,6 +877,31 @@ begin
end;
end;
procedure TCENativeProject.compProcTerminated(proc: TObject);
var
msgs: ICEMessagesDisplay;
prjname: string;
begin
compProcOutput(proc);
msgs := getMessageDisplay;
prjname := shortenPath(filename);
fCompiled := fCompilProc.ExitStatus = 0;
updateOutFilename;
if fCompiled then
msgs.message(prjname + ' has been successfully compiled',
self as ICECommonProject, amcProj, amkInf)
else
msgs.message(prjname + ' has not been compiled',
self as ICECommonProject, amcProj, amkWarn);
//
if not runPrePostProcess(getCurrConf.postBuildProcess) then
msgs.message( 'warning: post-compilation process or commands not properly executed',
self as ICECommonProject, amcProj, amkWarn);
subjProjCompiled(fProjectSubject, self as ICECommonProject, fCompiled);
//
SetCurrentDirUTF8(fPreCompilePath);
end;
function TCENativeProject.targetUpToDate: boolean;
var
dt: double;

8
src/ce_observer.pas
View File

@ -65,7 +65,6 @@ type
// anObserver must be removed.
procedure removeObserver(anObserver: TObject);
// optionally implemented to trigger all the methods of the observer interface.
procedure updateObservers;
end;
// Base type for an interface that contains the methods of a subject.
@ -89,7 +88,6 @@ type
//
procedure addObserver(anObserver: TObject);
procedure removeObserver(anObserver: TObject);
procedure updateObservers; virtual;
//
property observersCount: Integer read getObserversCount;
property observers[index: Integer]: TObject read getObserver; default;
@ -227,7 +225,6 @@ begin
exit(fServices[i]);
end;
end;
{$ENDREGION}
{$REGION TCECustomSubject ------------------------------------------------------}
@ -272,11 +269,6 @@ procedure TCECustomSubject.removeObserver(anObserver: TObject);
begin
fObservers.Remove(anObserver);
end;
procedure TCECustomSubject.updateObservers;
begin
end;
{$ENDREGION}
initialization

5
src/ce_projconf.pas
View File

@ -50,6 +50,7 @@ type
procedure projChanged(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
protected
procedure updateImperative; override;
procedure SetVisible(Value: boolean); override;
@ -146,6 +147,10 @@ end;
procedure TCEProjectConfigurationWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEProjectConfigurationWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION config. things --------------------------------------------------------}

5
src/ce_projinspect.pas
View File

@ -50,6 +50,7 @@ type
procedure projFocused(aProject: ICECommonProject);
procedure projChanged(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
protected
function contextName: string; override;
function contextActionCount: integer; override;
@ -183,6 +184,10 @@ end;
procedure TCEProjectInspectWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCEProjectInspectWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION Inspector things -------------------------------------------------------}

5
src/ce_search.pas
View File

@ -90,6 +90,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docClosing(aDoc: TCESynMemo);
@ -482,6 +483,10 @@ end;
procedure TCESearchWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCESearchWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}

5
src/ce_symstring.pas
View File

@ -32,6 +32,7 @@ type
procedure projFocused(aProject: ICECommonProject);
procedure projChanged(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
//
procedure docNew(aDoc: TCESynMemo);
procedure docClosing(aDoc: TCESynMemo);
@ -108,6 +109,10 @@ end;
procedure TCESymbolExpander.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCESymbolExpander.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}

5
src/ce_todolist.pas
View File

@ -104,6 +104,7 @@ type
procedure projClosing(aProject: ICECommonProject);
procedure projFocused(aProject: ICECommonProject);
procedure projCompiling(aProject: ICECommonProject);
procedure projCompiled(aProject: ICECommonProject; success: boolean);
// ICEEditableOptions
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
@ -373,6 +374,10 @@ end;
procedure TCETodoListWidget.projCompiling(aProject: ICECommonProject);
begin
end;
procedure TCETodoListWidget.projCompiled(aProject: ICECommonProject; success: boolean);
begin
end;
{$ENDREGION}
{$REGION Todo list things ------------------------------------------------------}