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