From d373a15012d19a0901246ae4061abf03dc0816a6 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 15:35:23 +0200 Subject: [PATCH 1/7] di-1 --- lazproj/coedit.lpi | 6 +- lazproj/coedit.lpr | 2 +- src/ce_dubproject.pas | 197 +++++++++++++++++++++++++++++++++++++++ src/ce_interfaces.pas | 44 +++++++-- src/ce_libmaneditor.pas | 6 +- src/ce_main.pas | 127 ++++++++++++++----------- src/ce_messages.pas | 24 ++--- src/ce_nativeproject.pas | 96 +++++++++++++------ src/ce_symstring.pas | 11 ++- 9 files changed, 397 insertions(+), 116 deletions(-) create mode 100644 src/ce_dubproject.pas diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index bdc8e50e..d2ec2ec0 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -135,7 +135,7 @@ - + @@ -341,6 +341,10 @@ + + + + diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr index 56f2a8d6..9475f138 100644 --- a/lazproj/coedit.lpr +++ b/lazproj/coedit.lpr @@ -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} diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas new file mode 100644 index 00000000..fd9c3b76 --- /dev/null +++ b/src/ce_dubproject.pas @@ -0,0 +1,197 @@ +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 getOutputFilename: string; + // + function getConfigurationCount: integer; + procedure setActiveConfiguration(index: integer); + function getConfigurationName(index: integer): string; + // + function compile: 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; + +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; + +//TODO -cDUB: conserve pretty formatting +procedure TCEDubProject.saveToFile(const aFilename: string); +var + saver: TMemoryStream; + str: string; +begin + saver := TMemoryStream.Create; + try + fFilename := aFilename; + str := fJson.AsJSON; + 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.getOutputFilename: string; +begin + exit(''); +end; + +function TCEDubProject.getConfigurationCount: integer; +begin + exit(0); +end; + +procedure TCEDubProject.setActiveConfiguration(index: integer); +begin + +end; + +function TCEDubProject.getConfigurationName(index: integer): string; +begin + 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; + +end. + diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 70808a70..9dffae2b 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -14,7 +14,10 @@ type TCEProjectFormat = (pfNative, pfDub); (** - * 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 +26,23 @@ 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 -------------------------------------------- + + function compile: 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 +50,19 @@ 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 the name of the file produced when a project is compiled + function getOutputFilename: string; + + // 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; (** diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index 8e8d7e5a..0b88c31f 100644 --- a/src/ce_libmaneditor.pas +++ b/src/ce_libmaneditor.pas @@ -204,10 +204,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 ?'); diff --git a/src/ce_main.pas b/src/ce_main.pas index 8217a710..5ec6757b 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -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; @@ -259,7 +261,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 +420,7 @@ begin EntitiesConnector.forceUpdate; // getCMdParams; - if fProject = nil then newProj; + if fNativeProject = nil then newNativeProj; // fInitialized := true; end; @@ -795,7 +798,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 +817,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 +1115,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); @@ -1173,10 +1176,10 @@ procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); begin 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 +1503,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 fNativeProject.compile then + fNativeProject.runProject; end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin - if not fProject.compileProject then + if not fNativeProject.compile then exit; runargs := ''; if InputQuery('Execution arguments', '', runargs) then - fProject.runProject(runargs); + fNativeProject.runProject(runargs); end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); @@ -1528,21 +1531,21 @@ label _rbld, _run; begin - if fProject.currentConfiguration.outputOptions.binaryKind <> executable then + if fNativeProject.currentConfiguration.outputOptions.binaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); exit; end; - if not fileExists(fProject.outputFilename) then + if not fileExists(fNativeProject.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 + dt := fileAge(fNativeProject.getOutputFilename); + for i := 0 to fNativeProject.Sources.Count-1 do begin - if fileAge(fProject.getAbsoluteSourceName(i)) > dt then + if fileAge(fNativeProject.getAbsoluteSourceName(i)) > dt then if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then goto _rbld else @@ -1550,10 +1553,10 @@ begin end; goto _run; _rbld: - fProject.compileProject; + fNativeProject.compile; _run: - if fileExists(fProject.outputFilename) then - fProject.runProject; + if fileExists(fNativeProject.getOutputFilename) then + fNativeProject.runProject; end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); @@ -1562,7 +1565,7 @@ var begin runargs := ''; if InputQuery('Execution arguments', '', runargs) then - fProject.runProject(runargs); + fNativeProject.runProject(runargs); end; {$ENDREGION} @@ -1708,58 +1711,73 @@ 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 fNativeProject = nil then exit; + if fNativeProject.fileName <> aEditor.fileName then exit; // - aEditor.saveToFile(fProject.fileName); - openProj(fProject.fileName); + aEditor.saveToFile(fNativeProject.fileName); + openProj(fNativeProject.fileName); 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(fNativeProject.fileName); 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 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 +1785,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 +1803,8 @@ end; procedure TCEMainForm.addSource(const aFilename: string); begin - if fProject.Sources.IndexOf(aFilename) >= 0 then exit; - fProject.addSource(aFilename); + if fNativeProject.Sources.IndexOf(aFilename) >= 0 then exit; + fNativeProject.addSource(aFilename); end; procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); @@ -1801,13 +1819,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 +1849,10 @@ end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin - if fProject = nil then exit; - if not fileExists(fProject.fileName) then exit; + if fNativeProject = nil then exit; + if not fileExists(fNativeProject.fileName) then exit; // - openFile(fProject.fileName); + openFile(fNativeProject.fileName); fDoc.Highlighter := LfmSyn; end; @@ -1843,7 +1862,7 @@ var begin lst := TStringList.Create; try - fProject.getOpts(lst); + fNativeProject.getOpts(lst); dlgOkInfo(lst.Text); finally lst.Free; diff --git a/src/ce_messages.pas b/src/ce_messages.pas index d6cfd5af..ce38c083 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -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('') + DirectorySeparator, ident); + absName := expandFilenameEx(symbolExpander.get('') + DirectorySeparator, ident); if fileExists(absName) then begin getMultiDocHandler.openDocument(absName); exit(true); end; - absName := expandFilenameEx(symbolExpander.get('') + DirectorySeparator, ident); + absName := expandFilenameEx(symbolExpander.get('') + DirectorySeparator, ident); if fileExists(absName) then begin getMultiDocHandler.openDocument(absName); diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index 88eb4aad..b290d179 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -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; @@ -81,14 +81,20 @@ type function addConfiguration: TCompilerConfiguration; procedure getOpts(const aList: TStrings); function runProject(const runArgs: string = ''): Boolean; - function compileProject: Boolean; + function compile: Boolean; + // + function getIfModified: boolean; + function getOutputFilename: string; + function getConfigurationCount: integer; + procedure setActiveConfiguration(index: integer); + function getConfigurationName(index: integer): string; + function getFilename: string; // 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 +115,7 @@ begin fSrcs := TStringList.Create; fSrcs.OnChange := @subMemberChanged; fSrcsCop := TStringList.Create; - fOptsColl := TCollection.create(TCompilerConfiguration); + fConfigs := TCollection.create(TCompilerConfiguration); // reset; addDefaults; @@ -132,7 +138,7 @@ begin fLibAliases.Free; fSrcs.free; fSrcsCop.Free; - fOptsColl.free; + fConfigs.free; killProcess(fRunner); inherited; end; @@ -149,7 +155,7 @@ end; function TCENativeProject.addConfiguration: TCompilerConfiguration; begin - result := TCompilerConfiguration(fOptsColl.Add); + result := TCompilerConfiguration(fConfigs.Add); result.onChanged := @subMemberChanged; end; @@ -157,8 +163,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 +232,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 +288,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 +328,7 @@ var begin beginUpdate; fConfIx := 0; - fOptsColl.Clear; + fConfigs.Clear; defConf := addConfiguration; defConf.name := 'default'; fSrcs.Clear; @@ -635,7 +641,7 @@ begin end; end; -function TCENativeProject.compileProject: Boolean; +function TCENativeProject.compile: Boolean; var config: TCompilerConfiguration; compilproc: TProcess; @@ -649,7 +655,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 +664,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 +674,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 +689,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; @@ -722,14 +728,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 +763,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 +783,44 @@ 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 isValidNativeProject(const filename: string): boolean; var maybe: TCENativeProject; diff --git a/src/ce_symstring.pas b/src/ce_symstring.pas index 3ca1f4f9..fdd5db73 100644 --- a/src/ce_symstring.pas +++ b/src/ce_symstring.pas @@ -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; @@ -184,11 +189,11 @@ begin begin if fileExists(fProj.fileName) then begin - fSymbols[CPF] := fProj.fileName; - fSymbols[CPP] := ExtractFilePath(fProj.fileName); + fSymbols[CPF] := fProjInterface.getFilename; + fSymbols[CPP] := ExtractFilePath(fProjInterface.getFilename); 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 From d1c255d44b47cd9bb281ba25aa9c912da5588279 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 16:37:51 +0200 Subject: [PATCH 2/7] di-2 symbol list, CPP is working to make DUB messages clickable. still TODO in ce_dubproject to expose fsources file names --- src/ce_symstring.pas | 95 ++++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 60 deletions(-) diff --git a/src/ce_symstring.pas b/src/ce_symstring.pas index fdd5db73..d5c468ce 100644 --- a/src/ce_symstring.pas +++ b/src/ce_symstring.pas @@ -145,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] := fProjInterface.getFilename; - fSymbols[CPP] := ExtractFilePath(fProjInterface.getFilename); fSymbols[CPR] := fProj.getAbsoluteFilename(fProj.RootFolder); - fSymbols[CPN] := stripFileExt(extractFileName(fProj.fileName)); 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 @@ -230,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; @@ -292,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; From fa9b5751038c0e047a36b2b03aec93d30d37a3a6 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 16:48:11 +0200 Subject: [PATCH 3/7] di-3 - todo list widget ready --- src/ce_dubproject.pas | 12 +++++++++++- src/ce_interfaces.pas | 2 ++ src/ce_nativeproject.pas | 4 ++-- src/ce_todolist.pas | 20 +++++++------------- 4 files changed, 22 insertions(+), 16 deletions(-) diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index fd9c3b76..9f9b8f4d 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -31,6 +31,7 @@ type procedure saveToFile(const aFilename: string); function getIfModified: boolean; // + function getIfIsSource(const aFilename: string): boolean; function getOutputFilename: string; // function getConfigurationCount: integer; @@ -138,23 +139,32 @@ 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; diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 9dffae2b..db9edc26 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -51,6 +51,8 @@ type //function moduleImportCount: integer; //function moduleImport(index: integer): 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; diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index b290d179..f1c40147 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -74,7 +74,7 @@ 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); @@ -395,7 +395,7 @@ begin end; end; -function TCENativeProject.isProjectSource(const aFilename: string): boolean; +function TCENativeProject.getIfIsSource(const aFilename: string): boolean; var i: Integer; begin diff --git a/src/ce_todolist.pas b/src/ce_todolist.pas index 106bdb63..69d02cbb 100644 --- a/src/ce_todolist.pas +++ b/src/ce_todolist.pas @@ -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); From fedc07005e022c9e6960736efd40d4f33f066fee Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 17:03:01 +0200 Subject: [PATCH 4/7] di-4 --- src/ce_libmaneditor.pas | 1 + src/ce_main.pas | 10 +++++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index 0b88c31f..ab678391 100644 --- a/src/ce_libmaneditor.pas +++ b/src/ce_libmaneditor.pas @@ -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); diff --git a/src/ce_main.pas b/src/ce_main.pas index 5ec6757b..d119a16b 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -1174,6 +1174,7 @@ 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 fNativeProject = nil then exit; @@ -1508,6 +1509,7 @@ end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin + //TODO-cDUB: implement compile proj and run for DUB projects if fNativeProject.compile then fNativeProject.runProject; end; @@ -1516,6 +1518,7 @@ procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin + // TODO-cDUB: implement compile proj and run with arg for DUB projects if not fNativeProject.compile then exit; runargs := ''; @@ -1531,6 +1534,7 @@ label _rbld, _run; begin + // TODO-cDUB: implement proj run for DUB projects if fNativeProject.currentConfiguration.outputOptions.binaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); @@ -1564,6 +1568,7 @@ var runargs: string; begin runargs := ''; + // TODO-cDUB: change to fProjInterface.runProject when sub routine implemented if InputQuery('Execution arguments', '', runargs) then fNativeProject.runProject(runargs); end; @@ -1719,6 +1724,7 @@ end; procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); begin + //TODO-cDUB: implement save project source for a DUB json file edited in CE if fNativeProject = nil then exit; if fNativeProject.fileName <> aEditor.fileName then exit; // @@ -1755,7 +1761,7 @@ end; procedure TCEMainForm.saveProj; begin - fProjectInterface.saveToFile(fNativeProject.fileName); + fProjectInterface.saveToFile(fProjectInterface.getFilename); end; procedure TCEMainForm.saveProjAs(const aFilename: string); @@ -1803,6 +1809,7 @@ end; procedure TCEMainForm.addSource(const aFilename: string); begin + //TODO-cDUB: add addSource() method to ICECommonProject if fNativeProject.Sources.IndexOf(aFilename) >= 0 then exit; fNativeProject.addSource(aFilename); end; @@ -1849,6 +1856,7 @@ end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin + //TODO-cDUB: add json highligher to edit json project in CE if fNativeProject = nil then exit; if not fileExists(fNativeProject.fileName) then exit; // From f389b08008777099ad0fef6f90ce51e4bfb95182 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 17:05:57 +0200 Subject: [PATCH 5/7] di-5 project MRU list ready --- src/ce_mru.pas | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/ce_mru.pas b/src/ce_mru.pas index 79e246b3..3d916f7c 100644 --- a/src/ce_mru.pas +++ b/src/ce_mru.pas @@ -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 From c208316f146ffb0913d7c1c7b084eed8ad60a49d Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Tue, 1 Sep 2015 19:55:42 +0200 Subject: [PATCH 6/7] di-6 - action related to run proj in main, ok, but sub routines missing for TCEDubProject - pretty format DUB proj on save - proj binary kind in TCECOmmonProject itf, moved enum so that TCEDubProject can use the same values --- src/ce_dmdwrap.pas | 18 ++++------ src/ce_dubproject.pas | 17 +++++++-- src/ce_interfaces.pas | 8 +++++ src/ce_main.pas | 74 ++++++++++++++++++++++------------------ src/ce_nativeproject.pas | 10 ++++-- 5 files changed, 78 insertions(+), 49 deletions(-) diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas index d55eed36..c24a7536 100644 --- a/src/ce_dmdwrap.pas +++ b/src/ce_dmdwrap.pas @@ -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; diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index 9f9b8f4d..e73f0b6a 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -30,6 +30,7 @@ type 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; @@ -39,6 +40,7 @@ type function getConfigurationName(index: integer): string; // function compile: boolean; + function run(const runArgs: string = ''): boolean; end; implementation @@ -93,6 +95,12 @@ begin exit(fFilename); end; +function TCEDubProject.getBinaryKind: TProjectBinaryKind; +begin + //TODO-cDUB: implement + exit(executable); +end; + procedure TCEDubProject.loadFromFile(const aFilename: string); var loader: TMemoryStream; @@ -116,7 +124,6 @@ begin end; end; -//TODO -cDUB: conserve pretty formatting procedure TCEDubProject.saveToFile(const aFilename: string); var saver: TMemoryStream; @@ -125,7 +132,7 @@ begin saver := TMemoryStream.Create; try fFilename := aFilename; - str := fJson.AsJSON; + str := fJson.FormatJSON; saver.Write(str[1], length(str)); saver.SaveToFile(fFilename); finally @@ -203,5 +210,11 @@ begin end; end; +function TCEDubProject.run(const runArgs: string = ''): boolean; +begin + //TODO-cDUB: implement + result := false; +end; + end. diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index db9edc26..77d32ecb 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -13,6 +13,9 @@ 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. * @@ -28,7 +31,10 @@ type // 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 --------------------- @@ -55,6 +61,8 @@ type 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 ----------------------------------------------------------------- diff --git a/src/ce_main.pas b/src/ce_main.pas index d119a16b..d236e240 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -210,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; @@ -1509,21 +1511,19 @@ end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin - //TODO-cDUB: implement compile proj and run for DUB projects - if fNativeProject.compile then - fNativeProject.runProject; + if fProjectInterface.compile then + fProjectInterface.run; end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin - // TODO-cDUB: implement compile proj and run with arg for DUB projects - if not fNativeProject.compile then + if not fProjectInterface.compile then exit; runargs := ''; if InputQuery('Execution arguments', '', runargs) then - fNativeProject.runProject(runargs); + fProjectInterface.run(runargs); end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); @@ -1534,33 +1534,40 @@ label _rbld, _run; begin - // TODO-cDUB: implement proj run for DUB projects - if fNativeProject.currentConfiguration.outputOptions.binaryKind <> executable then + if fProjectInterface.getBinaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); exit; end; - if not fileExists(fNativeProject.getOutputFilename) then + if not fileExists(fProjectInterface.getOutputFilename) then begin if dlgOkCancel('The project output is missing, build ?') <> mrOK then exit; goto _rbld; end; - dt := fileAge(fNativeProject.getOutputFilename); - for i := 0 to fNativeProject.Sources.Count-1 do + + // TODO-cICECommonInterface, add function to check if rebuild needed. + if fProjectInterface.getFormat = pfNative then 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; + 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: - fNativeProject.compile; + fProjectInterface.compile; _run: - if fileExists(fNativeProject.getOutputFilename) then - fNativeProject.runProject; + if fileExists(fProjectInterface.getOutputFilename) then + fProjectInterface.run; end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); @@ -1568,9 +1575,8 @@ var runargs: string; begin runargs := ''; - // TODO-cDUB: change to fProjInterface.runProject when sub routine implemented if InputQuery('Execution arguments', '', runargs) then - fNativeProject.runProject(runargs); + fProjectInterface.run(runargs); end; {$ENDREGION} @@ -1724,12 +1730,11 @@ end; procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); begin - //TODO-cDUB: implement save project source for a DUB json file edited in CE - if fNativeProject = nil then exit; - if fNativeProject.fileName <> aEditor.fileName then exit; + if fProjectInterface = nil then exit; + if fProjectInterface.getFilename <> aEditor.fileName then exit; // - aEditor.saveToFile(fNativeProject.fileName); - openProj(fNativeProject.fileName); + aEditor.saveToFile(fProjectInterface.getFilename); + openProj(fProjectInterface.getFilename); end; procedure TCEMainForm.closeProj; @@ -1773,9 +1778,10 @@ end; procedure TCEMainForm.openProj(const aFilename: string); begin closeProj; - if ExtractFileExt(aFilename) = '.json' then newDubProj - else newNativeProj; - + if LowerCase(ExtractFileExt(aFilename)) = '.json' then + newDubProj + else + newNativeProj; // fProjectInterface.loadFromFile(aFilename); showProjTitle; @@ -1856,11 +1862,11 @@ end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin - //TODO-cDUB: add json highligher to edit json project in CE - if fNativeProject = nil then exit; - if not fileExists(fNativeProject.fileName) then exit; + if fProjectInterface = nil then exit; + if not fileExists(fProjectInterface.getFilename) then exit; // - openFile(fNativeProject.fileName); + openFile(fProjectInterface.getFilename); + //TODO-cDUB: add json highligher to edit json project in CE fDoc.Highlighter := LfmSyn; end; diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index f1c40147..da161a33 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -80,7 +80,7 @@ type procedure addSource(const aFilename: string); function addConfiguration: TCompilerConfiguration; procedure getOpts(const aList: TStrings); - function runProject(const runArgs: string = ''): Boolean; + function run(const runArgs: string = ''): Boolean; function compile: Boolean; // function getIfModified: boolean; @@ -89,6 +89,7 @@ type 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; @@ -705,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; @@ -821,6 +822,11 @@ begin exit(fFilename); end; +function TCENativeProject.getBinaryKind: TProjectBinaryKind; +begin + exit(currentConfiguration.outputOptions.binaryKind); +end; + function isValidNativeProject(const filename: string): boolean; var maybe: TCENativeProject; From e1993bafea5cffe2f83e87b2a0d4a015e61c97e5 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Wed, 2 Sep 2015 11:18:06 +0200 Subject: [PATCH 7/7] more explicit action caption --- src/ce_main.lfm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ce_main.lfm b/src/ce_main.lfm index c5ce8040..2b28df91 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -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