diff --git a/src/ce_dcd.pas b/src/ce_dcd.pas index a46e4230..88328685 100644 --- a/src/ce_dcd.pas +++ b/src/ce_dcd.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index ae9dbf4c..968757da 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -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; diff --git a/src/ce_dubprojeditor.pas b/src/ce_dubprojeditor.pas index 22b14c60..84dfd155 100644 --- a/src/ce_dubprojeditor.pas +++ b/src/ce_dubprojeditor.pas @@ -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 ----------------------------------------------------------------} diff --git a/src/ce_editor.pas b/src/ce_editor.pas index 39c6cb88..0c455617 100644 --- a/src/ce_editor.pas +++ b/src/ce_editor.pas @@ -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 ----------------------------------------------------} diff --git a/src/ce_gdb.pas b/src/ce_gdb.pas index d74c5279..c1bd4431 100644 --- a/src/ce_gdb.pas +++ b/src/ce_gdb.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 37855b36..eeb6b36f 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -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. diff --git a/src/ce_lcldragdrop.pas b/src/ce_lcldragdrop.pas index 7bd14a19..694ea0bd 100644 --- a/src/ce_lcldragdrop.pas +++ b/src/ce_lcldragdrop.pas @@ -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; diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index 9da7858a..78b0d475 100644 --- a/src/ce_libmaneditor.pas +++ b/src/ce_libmaneditor.pas @@ -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; diff --git a/src/ce_main.pas b/src/ce_main.pas index 0a1d6b29..6960830f 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -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); diff --git a/src/ce_messages.pas b/src/ce_messages.pas index c687292a..1ef807f8 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_miniexplorer.pas b/src/ce_miniexplorer.pas index aa348319..59b9fc65 100644 --- a/src/ce_miniexplorer.pas +++ b/src/ce_miniexplorer.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_mru.pas b/src/ce_mru.pas index 970beaf7..930787ab 100644 --- a/src/ce_mru.pas +++ b/src/ce_mru.pas @@ -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; diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index be708f7e..7bede719 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -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; diff --git a/src/ce_observer.pas b/src/ce_observer.pas index 12757266..962d0df6 100644 --- a/src/ce_observer.pas +++ b/src/ce_observer.pas @@ -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 diff --git a/src/ce_projconf.pas b/src/ce_projconf.pas index 888c383e..74669354 100644 --- a/src/ce_projconf.pas +++ b/src/ce_projconf.pas @@ -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 --------------------------------------------------------} diff --git a/src/ce_projinspect.pas b/src/ce_projinspect.pas index 7286313c..b8a9a78f 100644 --- a/src/ce_projinspect.pas +++ b/src/ce_projinspect.pas @@ -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 -------------------------------------------------------} diff --git a/src/ce_search.pas b/src/ce_search.pas index d9e365c9..4c52c41e 100644 --- a/src/ce_search.pas +++ b/src/ce_search.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_symstring.pas b/src/ce_symstring.pas index 7c96dfef..48a45800 100644 --- a/src/ce_symstring.pas +++ b/src/ce_symstring.pas @@ -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 ---------------------------------------------------} diff --git a/src/ce_todolist.pas b/src/ce_todolist.pas index 59166f30..1fb04efb 100644 --- a/src/ce_todolist.pas +++ b/src/ce_todolist.pas @@ -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 ------------------------------------------------------}