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_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 new file mode 100644 index 00000000..e73f0b6a --- /dev/null +++ b/src/ce_dubproject.pas @@ -0,0 +1,220 @@ +unit ce_dubproject; + +{$I ce_defines.inc} + +interface + +uses + Classes, SysUtils, fpjson, jsonparser, jsonscanner, process, + ce_common, ce_interfaces, ce_observer ; + +type + + TCEDubProject = class(TComponent, ICECommonProject) + private + fFilename: string; + fModified: boolean; + fJson: TJSONObject; + fProjectSubject: TCEProjectSubject; + // + procedure dubProcOutput(proc: TProcess); + // + function getFormat: TCEProjectFormat; + function getProject: TObject; + // + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + // + function getFilename: string; + procedure loadFromFile(const aFilename: string); + procedure saveToFile(const aFilename: string); + function getIfModified: boolean; + function getBinaryKind: TProjectBinaryKind; + // + function getIfIsSource(const aFilename: string): boolean; + function getOutputFilename: string; + // + function getConfigurationCount: integer; + procedure setActiveConfiguration(index: integer); + function getConfigurationName(index: integer): string; + // + function compile: boolean; + function run(const runArgs: string = ''): boolean; + end; + +implementation + +constructor TCEDubProject.create(aOwner: TComponent); +begin + inherited; + fProjectSubject := TCEProjectSubject.Create; + // + subjProjNew(fProjectSubject, self); + subjProjChanged(fProjectSubject, self); +end; + +destructor TCEDubProject.destroy; +begin + subjProjClosing(fProjectSubject, self); + fProjectSubject.free; + // + fJSon.Free; + inherited; +end; + +procedure TCEDubProject.dubProcOutput(proc: TProcess); +var + lst: TStringList; + str: string; + msgs: ICEMessagesDisplay; +begin + lst := TStringList.Create; + msgs := getMessageDisplay; + try + processOutputToStrings(proc, lst); + for str in lst do + msgs.message(str, self as ICECommonProject, amcProj, amkAuto); + finally + lst.Free; + end; +end; + +function TCEDubProject.getFormat: TCEProjectFormat; +begin + exit(pfDub); +end; + +function TCEDubProject.getProject: TObject; +begin + exit(self); +end; + +function TCEDubProject.getFilename: string; +begin + exit(fFilename); +end; + +function TCEDubProject.getBinaryKind: TProjectBinaryKind; +begin + //TODO-cDUB: implement + exit(executable); +end; + +procedure TCEDubProject.loadFromFile(const aFilename: string); +var + loader: TMemoryStream; + parser : TJSONParser; +begin + loader := TMemoryStream.Create; + try + fFilename:= aFilename; + loader.LoadFromFile(fFilename); + fJSon.Free; + parser := TJSONParser.Create(loader); + subjProjChanged(fProjectSubject, self); + try + fJSon := parser.Parse as TJSONObject; + finally + parser.Free; + end; + finally + loader.Free; + fModified := false; + end; +end; + +procedure TCEDubProject.saveToFile(const aFilename: string); +var + saver: TMemoryStream; + str: string; +begin + saver := TMemoryStream.Create; + try + fFilename := aFilename; + str := fJson.FormatJSON; + saver.Write(str[1], length(str)); + saver.SaveToFile(fFilename); + finally + saver.Free; + fModified := false; + end; +end; + +function TCEDubProject.getIfModified: boolean; +begin + exit(fModified); +end; + +function TCEDubProject.getIfIsSource(const aFilename: string): boolean; +begin + //TODO-cDUB: implement + exit(false); +end; + +function TCEDubProject.getOutputFilename: string; +begin + //TODO-cDUB: implement + exit(''); +end; + +function TCEDubProject.getConfigurationCount: integer; +begin + //TODO-cDUB: implement + exit(0); +end; + +procedure TCEDubProject.setActiveConfiguration(index: integer); +begin + //TODO-cDUB: implement +end; + +function TCEDubProject.getConfigurationName(index: integer): string; +begin + //TODO-cDUB: implement + exit(''); +end; + +function TCEDubProject.compile: boolean; +var + dubproc: TProcess; + olddir: string = ''; + prjname: string; + msgs: ICEMessagesDisplay; +begin + result := false; + msgs := getMessageDisplay; + msgs.clearByData(Self); + prjname := shortenPath(fFilename); + dubproc := TProcess.Create(nil); + getDir(0, olddir); + try + msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf); + chDir(extractFilePath(fFilename)); + dubproc.Executable := 'dub' + exeExt; + dubproc.Options := dubproc.Options + [poStderrToOutPut, poUsePipes]; + dubproc.CurrentDirectory := extractFilePath(fFilename); + dubproc.ShowWindow := swoHIDE; + dubproc.Parameters.Add('build'); + dubproc.Execute; + while dubproc.Running do + dubProcOutput(dubproc); + if dubproc.ExitStatus = 0 then begin + msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf); + result := true; + end else + msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn); + finally + chDir(olddir); + dubproc.Free; + end; +end; + +function TCEDubProject.run(const runArgs: string = ''): boolean; +begin + //TODO-cDUB: implement + result := false; +end; + +end. + diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 70808a70..77d32ecb 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -13,8 +13,14 @@ type // describes the project kind. Used as a hint to cast ICECommonProject.getProject() TCEProjectFormat = (pfNative, pfDub); + // describes the binary kind produces when compiling a project + TProjectBinaryKind = (executable, staticlib, sharedlib, obj); + (** - * Common project interface + * Common project interface. + * + * Each project format has its own dedicated editors. + * The few common properties allow some generic operations whatever is the format. *) ICECommonProject = interface ['ICECommonProject'] @@ -23,12 +29,26 @@ type // returns an untyped object that can be casted using getFormat() function getProject: TObject; - //// project file - //function filename: string; - //procedure loadFromFile(const aFilename: string); - //procedure saveToFile(const aFilename: string); - //procedure save; - // + // sub routines for the actions -------------------------------------------- + + // tries to compile and returns true if it does + function compile: boolean; + // tries to un the project and returns true if it did + function run(const runArgs: string = ''): boolean; + + // project file - allows main form to create/load/save --------------------- + + // returns the project filename + function getFilename: string; + // loads project from filename + procedure loadFromFile(const aFilename: string); + // saves project to filename + procedure saveToFile(const aFilename: string); + // indicates of the project is modified (should be saved or not) + function getIfModified: boolean; + + // various properties used by several widgets (todo ana, dcd, ...)---------- + //// common project properties //function sourceCount: integer; //function source(index: integer): string; @@ -36,9 +56,23 @@ type //function stringImport(index: integer): string; //function moduleImportCount: integer; //function moduleImport(index: integer): string; - //function configurationCount: integer; - //function configuration(index: integer): string; - //function outputFilename: string; + + // returns true if aFilename is a project source + function getIfIsSource(const aFilename: string): boolean; + // returns the name of the file produced when a project is compiled + function getOutputFilename: string; + // returns the binary kind produced according to the current configuration + function getBinaryKind: TProjectBinaryKind; + + // configs ----------------------------------------------------------------- + + // returns the count of configuration + function getConfigurationCount: integer; + // sets the active configuration + procedure setActiveConfiguration(index: integer); + // returns the name of the index-th configuration + function getConfigurationName(index: integer): string; + end; (** diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index 8e8d7e5a..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); @@ -204,10 +205,10 @@ begin with List.Items.Add do begin Caption := ExtractFileNameOnly(fProj.Filename); - if ExtractFileExt(fProj.outputFilename) <> libExt then - SubItems.add(fProj.outputFilename + libExt) + if ExtractFileExt(fProj.getOutputFilename) <> libExt then + SubItems.add(fProj.getOutputFilename + libExt) else - SubItems.add(fProj.outputFilename); + SubItems.add(fProj.getOutputFilename); SubItems.add(root); if not FileExists(SubItems[0]) then dlgOkInfo('the library file does not exist, maybe the project not been already compiled ?'); 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 diff --git a/src/ce_main.pas b/src/ce_main.pas index 8217a710..d236e240 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; @@ -208,6 +210,8 @@ type fSymlWidg: TCESymbolListWidget; fInfoWidg: TCEInfoWidget; + //TODO-cDUB: widget to edit and view, select config of, a DUB project + fInitialized: boolean; fRunnableSw: string; fRunProc: TCEProcess; @@ -259,7 +263,8 @@ type // project sub routines procedure saveProjSource(const aEditor: TCESynMemo); - procedure newProj; + procedure newNativeProj; + procedure newDubProj; procedure saveProj; procedure saveProjAs(const aFilename: string); procedure openProj(const aFilename: string); @@ -417,7 +422,7 @@ begin EntitiesConnector.forceUpdate; // getCMdParams; - if fProject = nil then newProj; + if fNativeProject = nil then newNativeProj; // fInitialized := true; end; @@ -795,7 +800,7 @@ var i: Integer; begin canClose := false; - if fProject <> nil then if fProject.modified then + if fProjectInterface <> nil then if fProjectInterface.getIfModified then if ce_common.dlgOkCancel( 'The project modifications are not saved, quit anyway ?') <> mrOK then exit; @@ -814,7 +819,7 @@ end; procedure TCEMainForm.updateProjectBasedAction(sender: TObject); begin - TAction(sender).Enabled := fProject <> nil; + TAction(sender).Enabled := fProjectInterface <> nil; end; procedure TCEMainForm.updateDocEditBasedAction(sender: TObject); @@ -1112,11 +1117,11 @@ end; procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject); begin - if fProject = nil then exit; - if not fileExists(fProject.fileName) then exit; + if fProjectInterface = nil then exit; + if not fileExists(fProjectInterface.getFilename) then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; - fExplWidg.expandPath(extractFilePath(fProject.fileName)); + fExplWidg.expandPath(extractFilePath(fProjectInterface.getFilename)); end; procedure TCEMainForm.actFileNewExecute(Sender: TObject); @@ -1171,12 +1176,13 @@ end; procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); begin + //TODO-cDUB: update 'add file to project' for a DUB project if fDoc = nil then exit; if fDoc.isProjectSource then exit; - if fProject = nil then exit; + if fNativeProject = nil then exit; // if fileExists(fDoc.fileName) and (not fDoc.isTemporary) then - fProject.addSource(fDoc.fileName) + fNativeProject.addSource(fDoc.fileName) else dlgOkInfo('the file has not been added to the project because it does not exist'); end; @@ -1500,24 +1506,24 @@ end; procedure TCEMainForm.actProjCompileExecute(Sender: TObject); begin - fProject.compileProject; + fProjectInterface.compile; end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin - if fProject.compileProject then - fProject.runProject; + if fProjectInterface.compile then + fProjectInterface.run; end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin - if not fProject.compileProject then + if not fProjectInterface.compile then exit; runargs := ''; if InputQuery('Execution arguments', '', runargs) then - fProject.runProject(runargs); + fProjectInterface.run(runargs); end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); @@ -1528,32 +1534,40 @@ label _rbld, _run; begin - if fProject.currentConfiguration.outputOptions.binaryKind <> executable then + if fProjectInterface.getBinaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); exit; end; - if not fileExists(fProject.outputFilename) then + if not fileExists(fProjectInterface.getOutputFilename) then begin if dlgOkCancel('The project output is missing, build ?') <> mrOK then exit; goto _rbld; end; - dt := fileAge(fProject.outputFilename); - for i := 0 to fProject.Sources.Count-1 do + + // TODO-cICECommonInterface, add function to check if rebuild needed. + if fProjectInterface.getFormat = pfNative then begin - if fileAge(fProject.getAbsoluteSourceName(i)) > dt then - if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then - goto _rbld - else - break; - end; + dt := fileAge(fNativeProject.getOutputFilename); + for i := 0 to fNativeProject.Sources.Count-1 do + begin + if fileAge(fNativeProject.getAbsoluteSourceName(i)) > dt then + if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then + goto _rbld + else + break; + end; + end + // DUB checks this automatically + else fProjectInterface.compile; + goto _run; _rbld: - fProject.compileProject; + fProjectInterface.compile; _run: - if fileExists(fProject.outputFilename) then - fProject.runProject; + if fileExists(fProjectInterface.getOutputFilename) then + fProjectInterface.run; end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); @@ -1562,7 +1576,7 @@ var begin runargs := ''; if InputQuery('Execution arguments', '', runargs) then - fProject.runProject(runargs); + fProjectInterface.run(runargs); end; {$ENDREGION} @@ -1708,58 +1722,74 @@ end; {$REGION project ---------------------------------------------------------------} procedure TCEMainForm.showProjTitle; begin - if (fProject <> nil) and fileExists(fProject.Filename) then - caption := format('Coedit - %s', [shortenPath(fProject.Filename, 30)]) + if (fProjectInterface <> nil) and fileExists(fProjectInterface.getFilename) then + caption := format('Coedit - %s', [shortenPath(fProjectInterface.getFilename, 30)]) else caption := 'Coedit'; end; procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); begin - if fProject = nil then exit; - if fProject.fileName <> aEditor.fileName then exit; + if fProjectInterface = nil then exit; + if fProjectInterface.getFilename <> aEditor.fileName then exit; // - aEditor.saveToFile(fProject.fileName); - openProj(fProject.fileName); + aEditor.saveToFile(fProjectInterface.getFilename); + openProj(fProjectInterface.getFilename); end; procedure TCEMainForm.closeProj; begin - fProject.Free; - fProject := nil; + if fProjectInterface = nil then exit; + // + fProjectInterface.getProject.Free; + fProjectInterface := nil; + fNativeProject := nil; + fDubProject := nil; showProjTitle; end; -procedure TCEMainForm.newProj; +procedure TCEMainForm.newNativeProj; begin - fProject := TCENativeProject.Create(nil); - fProject.Name := 'CurrentProject'; + fNativeProject := TCENativeProject.Create(nil); + fNativeProject.Name := 'CurrentProject'; + fProjectInterface := fNativeProject as ICECommonProject; + showProjTitle; +end; + +procedure TCEMainForm.newDubProj; +begin + fDubProject := TCEDubProject.Create(nil); + fDubProject.Name := 'CurrentProject'; + fProjectInterface := fDubProject as ICECommonProject; showProjTitle; end; procedure TCEMainForm.saveProj; begin - fProject.saveToFile(fProject.fileName); + fProjectInterface.saveToFile(fProjectInterface.getFilename); end; procedure TCEMainForm.saveProjAs(const aFilename: string); begin - fProject.fileName := aFilename; - fProject.saveToFile(fProject.fileName); + fProjectInterface.saveToFile(aFilename); showProjTitle; end; procedure TCEMainForm.openProj(const aFilename: string); begin closeProj; - newProj; - fProject.loadFromFile(aFilename); + if LowerCase(ExtractFileExt(aFilename)) = '.json' then + newDubProj + else + newNativeProj; + // + fProjectInterface.loadFromFile(aFilename); showProjTitle; end; procedure TCEMainForm.mruProjItemClick(Sender: TObject); begin - if fProject <> nil then if fProject.modified then if dlgOkCancel( + if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel( 'The project modifications are not saved, continue ?') = mrCancel then exit; openProj(TMenuItem(Sender).Hint); @@ -1767,17 +1797,17 @@ end; procedure TCEMainForm.actProjNewExecute(Sender: TObject); begin - if fProject <> nil then if fProject.modified then if dlgOkCancel( + if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel( 'The project modifications are not saved, continue ?') = mrCancel then exit; closeProj; - newProj; + newNativeProj; end; procedure TCEMainForm.actProjCloseExecute(Sender: TObject); begin - if fProject = nil then exit; - if fProject.modified then if dlgOkCancel( + if fProjectInterface = nil then exit; + if fProjectInterface.getIfModified then if dlgOkCancel( 'The project modifications are not saved, continue ?') = mrCancel then exit; closeProj; @@ -1785,8 +1815,9 @@ end; procedure TCEMainForm.addSource(const aFilename: string); begin - if fProject.Sources.IndexOf(aFilename) >= 0 then exit; - fProject.addSource(aFilename); + //TODO-cDUB: add addSource() method to ICECommonProject + if fNativeProject.Sources.IndexOf(aFilename) >= 0 then exit; + fNativeProject.addSource(aFilename); end; procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); @@ -1801,13 +1832,14 @@ end; procedure TCEMainForm.actProjSaveExecute(Sender: TObject); begin - if fProject.fileName <> '' then saveProj + if fProjectInterface = nil then exit; + if fProjectInterface.getFilename <> '' then saveProj else actProjSaveAs.Execute; end; procedure TCEMainForm.actProjOpenExecute(Sender: TObject); begin - if fProject <> nil then if fProject.modified then if dlgOkCancel( + if fProjectInterface <> nil then if fProjectInterface.getIfModified then if dlgOkCancel( 'The project modifications are not saved, continue ?') = mrCancel then exit; with TOpenDialog.Create(nil) do @@ -1830,10 +1862,11 @@ end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin - if fProject = nil then exit; - if not fileExists(fProject.fileName) then exit; + if fProjectInterface = nil then exit; + if not fileExists(fProjectInterface.getFilename) then exit; // - openFile(fProject.fileName); + openFile(fProjectInterface.getFilename); + //TODO-cDUB: add json highligher to edit json project in CE fDoc.Highlighter := LfmSyn; end; @@ -1843,7 +1876,7 @@ var begin lst := TStringList.Create; try - fProject.getOpts(lst); + fNativeProject.getOpts(lst); dlgOkInfo(lst.Text); finally lst.Free; 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_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 diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index 88eb4aad..da161a33 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; @@ -74,21 +74,28 @@ type procedure endUpdate; procedure reset; procedure addDefaults; - function isProjectSource(const aFilename: string): boolean; + function getIfIsSource(const aFilename: string): boolean; function getAbsoluteSourceName(aIndex: integer): string; function getAbsoluteFilename(const aFilename: string): string; procedure addSource(const aFilename: string); function addConfiguration: TCompilerConfiguration; procedure getOpts(const aList: TStrings); - function runProject(const runArgs: string = ''): Boolean; - function compileProject: Boolean; + function run(const runArgs: string = ''): Boolean; + function compile: Boolean; + // + function getIfModified: boolean; + function getOutputFilename: string; + function getConfigurationCount: integer; + procedure setActiveConfiguration(index: integer); + function getConfigurationName(index: integer): string; + function getFilename: string; + function getBinaryKind: TProjectBinaryKind; // property configuration[ix: integer]: TCompilerConfiguration read getConfig; property currentConfiguration: TCompilerConfiguration read getCurrConf; property onChange: TNotifyEvent read fOnChange write fOnChange; property modified: Boolean read fModified; property canBeRun: Boolean read fCanBeRun; - property outputFilename: string read fOutputFilename; end; // native project have no ext constraint, this function tells if filename is project @@ -109,7 +116,7 @@ begin fSrcs := TStringList.Create; fSrcs.OnChange := @subMemberChanged; fSrcsCop := TStringList.Create; - fOptsColl := TCollection.create(TCompilerConfiguration); + fConfigs := TCollection.create(TCompilerConfiguration); // reset; addDefaults; @@ -132,7 +139,7 @@ begin fLibAliases.Free; fSrcs.free; fSrcsCop.Free; - fOptsColl.free; + fConfigs.free; killProcess(fRunner); inherited; end; @@ -149,7 +156,7 @@ end; function TCENativeProject.addConfiguration: TCompilerConfiguration; begin - result := TCompilerConfiguration(fOptsColl.Add); + result := TCompilerConfiguration(fConfigs.Add); result.onChanged := @subMemberChanged; end; @@ -157,8 +164,8 @@ procedure TCENativeProject.setOptsColl(const aValue: TCollection); var i: nativeInt; begin - fOptsColl.Assign(aValue); - for i:= 0 to fOptsColl.Count-1 do + fConfigs.Assign(aValue); + for i:= 0 to fConfigs.Count-1 do Configuration[i].onChanged := @subMemberChanged; end; @@ -226,7 +233,7 @@ procedure TCENativeProject.setConfIx(aValue: Integer); begin beginUpdate; if aValue < 0 then aValue := 0; - if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1; + if aValue > fConfigs.Count-1 then aValue := fConfigs.Count-1; fConfIx := aValue; endUpdate; end; @@ -282,31 +289,31 @@ end; function TCENativeProject.getConfig(const ix: integer): TCompilerConfiguration; begin - result := TCompilerConfiguration(fOptsColl.Items[ix]); + result := TCompilerConfiguration(fConfigs.Items[ix]); result.onChanged := @subMemberChanged; end; function TCENativeProject.getCurrConf: TCompilerConfiguration; begin - result := TCompilerConfiguration(fOptsColl.Items[fConfIx]); + result := TCompilerConfiguration(fConfigs.Items[fConfIx]); end; procedure TCENativeProject.addDefaults; begin - with TCompilerConfiguration(fOptsColl.Add) do + with TCompilerConfiguration(fConfigs.Add) do begin Name := 'debug'; debugingOptions.debug := true; debugingOptions.codeviewCformat := true; outputOptions.boundsCheck := onAlways; end; - with TCompilerConfiguration(fOptsColl.Add) do + with TCompilerConfiguration(fConfigs.Add) do begin Name := 'unittest'; outputOptions.unittest := true; outputOptions.boundsCheck := onAlways; end; - with TCompilerConfiguration(fOptsColl.Add) do + with TCompilerConfiguration(fConfigs.Add) do begin Name := 'release'; outputOptions.release := true; @@ -322,7 +329,7 @@ var begin beginUpdate; fConfIx := 0; - fOptsColl.Clear; + fConfigs.Clear; defConf := addConfiguration; defConf.name := 'default'; fSrcs.Clear; @@ -389,7 +396,7 @@ begin end; end; -function TCENativeProject.isProjectSource(const aFilename: string): boolean; +function TCENativeProject.getIfIsSource(const aFilename: string): boolean; var i: Integer; begin @@ -635,7 +642,7 @@ begin end; end; -function TCENativeProject.compileProject: Boolean; +function TCENativeProject.compile: Boolean; var config: TCompilerConfiguration; compilproc: TProcess; @@ -649,7 +656,7 @@ begin if config = nil then begin msgs.message('unexpected project error: no active configuration', - Self, amcProj, amkErr); + self as ICECommonProject, amcProj, amkErr); exit; end; // @@ -658,7 +665,7 @@ begin // if not runPrePostProcess(config.preBuildProcess) then msgs.message('project warning: the pre-compilation process has not been properly executed', - Self, amcProj, amkWarn); + self as ICECommonProject, amcProj, amkWarn); // if (Sources.Count = 0) and (config.pathsOptions.extraSources.Count = 0) then exit; @@ -668,7 +675,7 @@ begin olddir := ''; getDir(0, olddir); try - msgs.message('compiling ' + prjname, Self, amcProj, amkInf); + msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf); prjpath := extractFilePath(fileName); if directoryExists(prjpath) then begin @@ -683,14 +690,14 @@ begin while compilProc.Running do compProcOutput(compilproc); if compilproc.ExitStatus = 0 then begin - msgs.message(prjname + ' has been successfully compiled', Self, amcProj, amkInf); + msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf); result := true; end else - msgs.message(prjname + ' has not been compiled', Self, amcProj, amkWarn); + msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn); if not runPrePostProcess(config.PostBuildProcess) then msgs.message( 'project warning: the post-compilation process has not been properly executed', - Self, amcProj, amkWarn); + self as ICECommonProject, amcProj, amkWarn); finally updateOutFilename; @@ -699,7 +706,7 @@ begin end; end; -function TCENativeProject.runProject(const runArgs: string = ''): Boolean; +function TCENativeProject.run(const runArgs: string = ''): Boolean; var prm: string; i: Integer; @@ -722,14 +729,14 @@ begin until prm = ''; end; // - if not fileExists(outputFilename) then + if not fileExists(getOutputFilename) then begin - getMessageDisplay.message('output executable missing: ' + shortenPath(outputFilename, 25), - Self, amcProj, amkErr); + getMessageDisplay.message('output executable missing: ' + shortenPath(getOutputFilename, 25), + self as ICECommonProject, amcProj, amkErr); exit; end; // - fRunner.Executable := outputFilename; + fRunner.Executable := getOutputFilename; if fRunner.CurrentDirectory = '' then fRunner.CurrentDirectory := extractFilePath(fRunner.Executable); if poUsePipes in fRunner.Options then begin @@ -757,7 +764,7 @@ begin else processOutputToStrings(TProcess(sender), lst); for str in lst do - msgs.message(str, Self, amcProj, amkBub); + msgs.message(str, self as ICECommonProject, amcProj, amkBub); finally lst.Free; end; @@ -777,12 +784,49 @@ begin try processOutputToStrings(proc, lst); for str in lst do - msgs.message(str, Self, amcProj, amkAuto); + msgs.message(str, self as ICECommonProject, amcProj, amkAuto); finally lst.Free; end; end; +function TCENativeProject.getIfModified: boolean; +begin + exit(fModified); +end; + +function TCENativeProject.getOutputFilename: string; +begin + exit(fOutputFilename); +end; + +function TCENativeProject.getConfigurationCount: integer; +begin + exit(fConfigs.Count); +end; + +procedure TCENativeProject.setActiveConfiguration(index: integer); +begin + setConfIx(index); +end; + +function TCENativeProject.getConfigurationName(index: integer): string; +begin + if index > fConfigs.Count -1 then index := fConfigs.Count -1; + if index < 0 then index := 0; + result := getConfig(index).name; +end; + +function TCENativeProject.getFilename: string; +begin + exit(fFilename); +end; + +function TCENativeProject.getBinaryKind: TProjectBinaryKind; +begin + exit(currentConfiguration.outputOptions.binaryKind); +end; + function isValidNativeProject(const filename: string): boolean; var maybe: TCENativeProject; diff --git a/src/ce_symstring.pas b/src/ce_symstring.pas index 3ca1f4f9..d5c468ce 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; @@ -140,72 +145,57 @@ end; {$REGION Symbol things ---------------------------------------------------------} procedure TCESymbolExpander.updateSymbols; var - hasProj: boolean; + hasNativeProj: boolean; + hasProjItf: boolean; hasDoc: boolean; fname: string; i: Integer; + e: TCESymbol; str: TStringList; const na = '``'; begin if not fNeedUpdate then exit; fNeedUpdate := false; - hasProj := fProj <> nil; + // + hasNativeProj := fProj <> nil; + hasProjItf := fProjInterface <> nil; hasDoc := fDoc <> nil; + // + for e := low(TCESymbol) to high(TCESymbol) do + fSymbols[e] := na; + // // application fSymbols[CAF] := Application.ExeName; - fSymbols[CAP] := ExtractFilePath(Application.ExeName); + fSymbols[CAP] := ExtractFilePath(fSymbols[CAF]); // document if hasDoc then begin - if fileExists(fDoc.fileName) then - begin - fSymbols[CFF] := fDoc.fileName; - fSymbols[CFP] := ExtractFilePath(fDoc.fileName); - end - else - begin - fSymbols[CFF] := na; - fSymbols[CFP] := na; - end; + if not fileExists(fDoc.fileName) then + fDoc.saveTempFile; + fSymbols[CFF] := fDoc.fileName; + fSymbols[CFP] := ExtractFilePath(fDoc.fileName); if fDoc.Identifier <> '' then - fSymbols[CI] := fDoc.Identifier - else - fSymbols[CI] := na; - end - else - begin - fSymbols[CFF] := na; - fSymbols[CFP] := na; - fSymbols[CI] := na; + fSymbols[CI] := fDoc.Identifier; end; - // project - if hasProj then + // project interface + if hasProjItf then + begin + fSymbols[CPF] := fProjInterface.getFilename; + fSymbols[CPP] := ExtractFilePath(fSymbols[CPF]); + fSymbols[CPN] := stripFileExt(extractFileName(fSymbols[CPF])); + end; + // TODO-cDUB: move to upper block expansion of CPO, CPFS & CPCD when implemented in ICECOmmonProject + if hasNativeProj then begin if fileExists(fProj.fileName) then begin - fSymbols[CPF] := fProj.fileName; - fSymbols[CPP] := ExtractFilePath(fProj.fileName); fSymbols[CPR] := fProj.getAbsoluteFilename(fProj.RootFolder); - fSymbols[CPN] := stripFileExt(extractFileName(fProj.fileName)); - fSymbols[CPO] := fProj.outputFilename; + fSymbols[CPO] := fProj.getOutputFilename; if fSymbols[CPR] = '' then fSymbols[CPR] := fSymbols[CPP]; - end - else - begin - fSymbols[CPF] := na; - fSymbols[CPP] := na; - fSymbols[CPR] := na; - fSymbols[CPN] := na; - fSymbols[CPO] := na; end; - if fProj.Sources.Count = 0 then - begin - fSymbols[CPFS] := na; - fSymbols[CPCD] := na; - end - else + if fProj.Sources.Count <> 0 then begin str := TStringList.Create; try @@ -225,16 +215,6 @@ begin str.Free; end; end; - end - else - begin - fSymbols[CPF] := na; - fSymbols[CPP] := na; - fSymbols[CPR] := na; - fSymbols[CPN] := na; - fSymbols[CPO] := na; - fSymbols[CPFS] := na; - fSymbols[CPCD] := na; end; end; @@ -287,16 +267,16 @@ begin 'CAF', 'CoeditApplicationFile': Result += fSymbols[CAF]; 'CAP', 'CoeditApplicationPath': Result += fSymbols[CAP]; // - 'CFF', 'CurrentFileFile': Result += fSymbols[CFF]; - 'CFP', 'CurrentFilePath': Result += fSymbols[CFP]; - 'CI', 'CurrentIdentifier': Result += fSymbols[CI]; + 'CFF', 'CurrentFileFile' : Result += fSymbols[CFF]; + 'CFP', 'CurrentFilePath' : Result += fSymbols[CFP]; + 'CI', 'CurrentIdentifier' : Result += fSymbols[CI]; // - 'CPF', 'CurrentProjectFile': Result += fSymbols[CPF]; - 'CPFS', 'CurrentProjectFiles': Result += fSymbols[CPFS]; - 'CPN', 'CurrentProjectName': Result += fSymbols[CPN]; - 'CPO', 'CurrentProjectOutput': Result += fSymbols[CPO]; - 'CPP', 'CurrentProjectPath': Result += fSymbols[CPP]; - 'CPR', 'CurrentProjectRoot': Result += fSymbols[CPR]; + 'CPF', 'CurrentProjectFile' : Result += fSymbols[CPF]; + 'CPFS', 'CurrentProjectFiles' : Result += fSymbols[CPFS]; + 'CPN', 'CurrentProjectName' : Result += fSymbols[CPN]; + 'CPO', 'CurrentProjectOutput' : Result += fSymbols[CPO]; + 'CPP', 'CurrentProjectPath' : Result += fSymbols[CPP]; + 'CPR', 'CurrentProjectRoot' : Result += fSymbols[CPR]; 'CPCD','CurrentProjectCommonDirectory': Result += fSymbols[CPCD]; end; end; 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);