diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index 3b70d8ec..3b341556 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -138,7 +138,7 @@ - + @@ -389,6 +389,17 @@ + + + + + + + + + + + diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr index cd844544..58d59c90 100644 --- a/lazproj/coedit.lpr +++ b/lazproj/coedit.lpr @@ -11,7 +11,7 @@ uses ce_main, ce_writableComponent, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, - ce_lcldragdrop, ce_stringrange, ce_dlangmaps; + ce_lcldragdrop, ce_stringrange, ce_dlangmaps, ce_projgroup, ce_anyprojloader; {$R *.res} diff --git a/src/ce_anyprojloader.pas b/src/ce_anyprojloader.pas new file mode 100644 index 00000000..23e9aebe --- /dev/null +++ b/src/ce_anyprojloader.pas @@ -0,0 +1,58 @@ +unit ce_anyprojloader; +{$I ce_defines.inc} + +interface + +uses + Classes, SysUtils, + ce_nativeproject, ce_dubproject, ce_interfaces, ce_common, ce_observer; + +(** + * Loads either a DUB or a CE project. If the filename is invalid or if it + * doesn't points to a valid project, nil is returned, otherwise a project. + * When 'discret' is set to true, the ICEPorjectObserver are not notified + * that a new project is created and focused + *) +function loadProject(const filename: string; discret: boolean): ICECommonProject; + +implementation + +function loadProject(const filename: string; discret: boolean): ICECommonProject; +var + isDubProject: boolean = false; + isCeProject: boolean = false; + dubProj: TCEDubProject; + ceProj: TCENativeProject; +begin + result := nil; + if not filename.fileExists then + exit; + + EntitiesConnector.beginUpdate; + if isValidDubProject(filename) then + isDubProject := true + else if isValidNativeProject(filename) then + isCeProject := true; + EntitiesConnector.endUpdate; + if not isDubProject and not isCeProject then + exit; + + if discret then + EntitiesConnector.beginUpdate; + if isDubProject then + begin + dubProj := TCEDubProject.create(nil); + dubproj.loadFromFile(filename); + result := dubProj as ICECommonProject; + end + else begin + ceProj := TCENativeProject.create(nil); + ceProj.loadFromFile(filename); + result := ceProj as ICECommonProject; + end; + if discret then + EntitiesConnector.endUpdate; +end; + +end. + diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas index 50894bfb..b53b4f9a 100644 --- a/src/ce_dubproject.pas +++ b/src/ce_dubproject.pas @@ -13,6 +13,7 @@ type TCEDubProject = class(TComponent, ICECommonProject) private + fInGroup: boolean; fDubProc: TCEProcess; fPreCompilePath: string; fPackageName: string; @@ -59,6 +60,8 @@ type procedure loadFromFile(const aFilename: string); procedure saveToFile(const aFilename: string); // + function inGroup: boolean; + procedure inGroup(value: boolean); function getFormat: TCEProjectFormat; function getProject: TObject; function modified: boolean; @@ -142,6 +145,17 @@ end; {$ENDREGION --------------------------------------------------------------------} {$REGION ICECommonProject: project props ---------------------------------------} +function TCEDubProject.inGroup: boolean; +begin + exit(fInGroup); +end; + +procedure TCEDubProject.inGroup(value: boolean); +begin + fInGroup:=value; +end; + + function TCEDubProject.getFormat: TCEProjectFormat; begin exit(pfDub); diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas index 8795bd94..72f0f055 100644 --- a/src/ce_interfaces.pas +++ b/src/ce_interfaces.pas @@ -27,6 +27,10 @@ type // general properties ------------------------------------------------------ + // indicates if the project is owned by a group. + function inGroup: boolean; + // flag the project as grouped + procedure inGroup(value: boolean); // indicates the project format function getFormat: TCEProjectFormat; // returns an untyped object that can be casted using getFormat() @@ -279,7 +283,7 @@ type function documentCount: Integer; // returns the nth document function getDocument(index: Integer): TCESynMemo; - // returns true if the document matching aFielanme is already opened. + // returns true if the document matching aFilename is already opened. function findDocument(aFilename: string): TCESynMemo; // open or set the focus on the document matching aFilename procedure openDocument(aFilename: string); @@ -292,6 +296,25 @@ type end; + (** + * Single service related to the project groups + *) + ICEProjectGroup = interface(ICESingleService) + // add a project to the gtoup; + procedure addProject(aProject: ICECommonProject); + // open a group of project. + procedure openGroup(aFilename: string); + // save the group to a file. + procedure saveGroup(aFilename: string); + // close a group a initialize a new one + procedure closeGroup; + // indicates wether one of the project is modified or if the group is changed + function groupModified: boolean; + // indicates the group filename + function groupFilename: string; + end; + + (** * Single service related to the expansion of Coedit "symbolic strings". @@ -337,6 +360,7 @@ type function getprocInputHandler: ICEProcInputHandler; function getMultiDocHandler: ICEMultiDocHandler; function getSymStringExpander: ICESymStringExpander; + function getProjectGroup: ICEProjectGroup; implementation @@ -466,6 +490,12 @@ function getSymStringExpander: ICESymStringExpander; begin exit(EntitiesConnector.getSingleService('ICESymStringExpander') as ICESymStringExpander); end; + +function getProjectGroup: ICEProjectGroup; +begin + exit(EntitiesConnector.getSingleService('ICEProjectGroup') as ICEProjectGroup); +end; + {$ENDREGION} end. diff --git a/src/ce_lcldragdrop.pas b/src/ce_lcldragdrop.pas index 5bf94f74..7a66a212 100644 --- a/src/ce_lcldragdrop.pas +++ b/src/ce_lcldragdrop.pas @@ -130,8 +130,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if fProj.modified and not fProj.inGroup and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCENativeProject.create(nil); @@ -141,8 +142,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if fProj.modified and not fProj.inGroup and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCEDubProject.create(nil); diff --git a/src/ce_libmaneditor.lfm b/src/ce_libmaneditor.lfm index 512de948..c76fe0c4 100644 --- a/src/ce_libmaneditor.lfm +++ b/src/ce_libmaneditor.lfm @@ -178,27 +178,27 @@ inherited CELibManEditorWidget: TCELibManEditorWidget item AutoSize = True Caption = 'Alias' - Width = 629 + Width = 39 end item AutoSize = True Caption = 'Library file or folder of sources' - Width = 172 + Width = 195 end item AutoSize = True Caption = 'Sources root' - Width = 78 + Width = 88 end item AutoSize = True Caption = 'project' - Width = 49 + Width = 54 end item AutoSize = True Caption = 'enabled' - Width = 54 + Width = 236 end> GridLines = True HideSelection = False diff --git a/src/ce_libmaneditor.pas b/src/ce_libmaneditor.pas index d917f7d0..9785eb98 100644 --- a/src/ce_libmaneditor.pas +++ b/src/ce_libmaneditor.pas @@ -513,8 +513,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if fProj.modified and not fProj.inGroup and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCENativeProject.create(nil); @@ -524,8 +525,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if fProj.modified and not fProj.inGroup and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCEDubProject.create(nil); diff --git a/src/ce_main.lfm b/src/ce_main.lfm index 4b392b3d..b410dd2b 100644 --- a/src/ce_main.lfm +++ b/src/ce_main.lfm @@ -3032,6 +3032,9 @@ object CEMainForm: TCEMainForm ADFFB0B0AEEA000000000000000000000000FFFFFF00FFFFFF00 } end + object MenuItem86: TMenuItem + Action = actProjAddToGroup + end object MenuItem29: TMenuItem Caption = '-' end @@ -3473,6 +3476,21 @@ object CEMainForm: TCEMainForm 0000000000000000000000000000000000000000000000000000 } end + object MenuItem81: TMenuItem + Caption = '-' + end + object MenuItem82: TMenuItem + Action = actProjNewGroup + end + object MenuItem83: TMenuItem + Action = actProjOpenGroup + end + object MenuItem84: TMenuItem + Action = actProjSaveGroup + end + object MenuItem85: TMenuItem + Action = actProjSaveGroupAs + end end object MenuItem8: TMenuItem Caption = 'Compilation' @@ -4383,6 +4401,37 @@ object CEMainForm: TCEMainForm OnExecute = actFileDscannerExecute OnUpdate = updateDocumentBasedAction end + object actProjOpenGroup: TAction + Category = 'Project' + Caption = 'Open project group...' + ImageIndex = 9 + OnExecute = actProjOpenGroupExecute + end + object actProjSaveGroup: TAction + Category = 'Project' + Caption = 'Save project group' + ImageIndex = 3 + OnExecute = actProjSaveGroupExecute + end + object actProjSaveGroupAs: TAction + Category = 'Project' + Caption = 'Save project group as...' + ImageIndex = 2 + OnExecute = actProjSaveGroupAsExecute + end + object actProjNewGroup: TAction + Category = 'Project' + Caption = 'New project group' + ImageIndex = 8 + OnExecute = actProjNewGroupExecute + end + object actProjAddToGroup: TAction + Category = 'Project' + Caption = 'Add current project to group' + ImageIndex = 7 + OnExecute = actProjAddToGroupExecute + OnUpdate = updateProjectBasedAction + end end object imgList: TImageList left = 64 diff --git a/src/ce_main.pas b/src/ce_main.pas index 06218469..8ada2a14 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -13,7 +13,8 @@ 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_dubproject, ce_dialogs, ce_dubprojeditor, (*ce_gdb,*) ce_dfmt, ce_lcldragdrop; + ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor, (*ce_gdb,*) ce_dfmt, + ce_lcldragdrop, ce_projgroup; type @@ -47,6 +48,11 @@ type actFileRun: TAction; actFileDscanner: TAction; actFileRunOut: TAction; + actProjAddToGroup: TAction; + actProjNewGroup: TAction; + actProjOpenGroup: TAction; + actProjSaveGroup: TAction; + actProjSaveGroupAs: TAction; actProjNewDubJson: TAction; actProjNewNative: TAction; actSetRunnableSw: TAction; @@ -151,6 +157,12 @@ type MenuItem78: TMenuItem; MenuItem79: TMenuItem; MenuItem80: TMenuItem; + MenuItem81: TMenuItem; + MenuItem82: TMenuItem; + MenuItem83: TMenuItem; + MenuItem84: TMenuItem; + MenuItem85: TMenuItem; + MenuItem86: TMenuItem; mnuLayout: TMenuItem; mnuItemMruFile: TMenuItem; mnuItemMruProj: TMenuItem; @@ -166,8 +178,14 @@ type procedure actFileRunExecute(Sender: TObject); procedure actFileRunOutExecute(Sender: TObject); procedure actFileSaveCopyAsExecute(Sender: TObject); + procedure actNewGroupExecute(Sender: TObject); + procedure actProjAddToGroupExecute(Sender: TObject); procedure actProjNewDubJsonExecute(Sender: TObject); + procedure actProjNewGroupExecute(Sender: TObject); procedure actProjNewNativeExecute(Sender: TObject); + procedure actProjOpenGroupExecute(Sender: TObject); + procedure actProjSaveGroupAsExecute(Sender: TObject); + procedure actProjSaveGroupExecute(Sender: TObject); procedure actSetRunnableSwExecute(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure MenuItem77Click(Sender: TObject); @@ -227,6 +245,7 @@ type fRunnableCompiler: TCECompiler; fRunnableDestination: string; fSymStringExpander: ICESymStringExpander; + fProjectGroup: ICEProjectGroup; fCovModUt: boolean; fDscanUnittests: boolean; fAlwaysUseDest: boolean; @@ -256,6 +275,7 @@ type fSymlWidg: TCESymbolListWidget; fInfoWidg: TCEInfoWidget; fDubProjWidg: TCEDubProjectEditorWidget; + fPrjGrpWidg: TCEProjectGroupWidget; //fGdbWidg: TCEGdbWidget; fDfmtWidg: TCEDfmtWidget; @@ -386,12 +406,14 @@ type procedure setTargets(projs: TCEMRUFileList; files: TCEMRUFileList); end; + //TODO-cprojectgroup: handle auto reloading of the previous group + TCELastDocsAndProjs = class(TWritableLfmTextComponent) private fDocuments: TStringList; fProject: string; fDocIndex: integer; - //fProjectGRoup: string; + fProjectGroup: string; procedure setDocuments(aValue: TStringList); protected procedure beforeSave; override; @@ -400,7 +422,7 @@ type property documentIndex: integer read fDocIndex write fDocIndex; property documents: TStringList read fDocuments write setDocuments; property project: string read fProject write fProject; - // property projectGroup: string read fProjectGroup write fProjectGroup; + property projectGroup: string read fProjectGroup write fProjectGroup; public constructor create(aOwner: TComponent); override; destructor destroy; override; @@ -662,6 +684,10 @@ begin itf := TCEMainForm(aSource).fProjectInterface; if itf = nil then exit; fProject := itf.filename; + fProjectGroup := getProjectGroup.groupFilename; + // reload from group + if itf.inGroup and fProjectGroup.fileExists then + fProject := ''; end else inherited; end; @@ -679,8 +705,8 @@ begin if dst.fProjFromCommandLine then exit; itf := dst.fProjectInterface; - if (itf <> nil) and (itf.filename = fProject) then - exit; + if (itf <> nil) and (itf.filename = fProject) and + (itf.filename.fileExists) then exit; if fProject.isNotEmpty and fProject.fileExists then begin dst.openProj(fProject); @@ -693,6 +719,10 @@ begin else mem.Highlighter := JsSyn; end; + if fProjectGroup.isNotEmpty and fProjectGroup.fileExists then + begin + getProjectGroup.openGroup(fProjectGroup); + end; end else inherited; end; @@ -848,6 +878,7 @@ begin updateMainMenuProviders; EntitiesConnector.forceUpdate; fSymStringExpander:= getSymStringExpander; + fProjectGroup := getProjectGroup; // getCMdParams; if fNativeProject.isNil then @@ -923,23 +954,25 @@ var act: TAction; itm: TMenuItem; begin - fWidgList := TCEWidgetList.Create; - fMesgWidg := TCEMessagesWidget.create(self); - fEditWidg := TCEEditorWidget.create(self); - fProjWidg := TCEProjectInspectWidget.create(self); - fPrjCfWidg:= TCEProjectConfigurationWidget.create(self); - fFindWidg := TCESearchWidget.create(self); - fExplWidg := TCEMiniExplorerWidget.create(self); - fLibMWidg := TCELibManEditorWidget.create(self); - fTlsEdWidg:= TCEToolsEditorWidget.create(self); - fPrInpWidg:= TCEProcInputWidget.create(self); - fTodolWidg:= TCETodoListWidget.create(self); - fOptEdWidg:= TCEOptionEditorWidget.create(self); - fSymlWidg := TCESymbolListWidget.create(self); - fInfoWidg := TCEInfoWidget.create(self); + fWidgList := TCEWidgetList.Create; + fMesgWidg := TCEMessagesWidget.create(self); + fEditWidg := TCEEditorWidget.create(self); + fProjWidg := TCEProjectInspectWidget.create(self); + fPrjCfWidg := TCEProjectConfigurationWidget.create(self); + fFindWidg := TCESearchWidget.create(self); + fExplWidg := TCEMiniExplorerWidget.create(self); + fLibMWidg := TCELibManEditorWidget.create(self); + fTlsEdWidg := TCEToolsEditorWidget.create(self); + fPrInpWidg := TCEProcInputWidget.create(self); + fTodolWidg := TCETodoListWidget.create(self); + fOptEdWidg := TCEOptionEditorWidget.create(self); + fSymlWidg := TCESymbolListWidget.create(self); + fInfoWidg := TCEInfoWidget.create(self); fDubProjWidg:= TCEDubProjectEditorWidget.create(self); - //fGdbWidg := TCEGdbWidget.create(self); - fDfmtWidg := TCEDfmtWidget.create(self); + fDfmtWidg := TCEDfmtWidget.create(self); + fPrjGrpWidg := TCEProjectGroupWidget.create(self); + + //fGdbWidg := TCEGdbWidget.create(self); getMessageDisplay(fMsgs); @@ -957,8 +990,11 @@ begin fWidgList.addWidget(@fSymlWidg); fWidgList.addWidget(@fInfoWidg); fWidgList.addWidget(@fDubProjWidg); - //fWidgList.addWidget(@fGdbWidg); fWidgList.addWidget(@fDfmtWidg); + fWidgList.addWidget(@fPrjGrpWidg); + + //fWidgList.addWidget(@fGdbWidg); + fWidgList.sort(@CompareWidgCaption); for widg in fWidgList do @@ -2599,7 +2635,8 @@ procedure TCEMainForm.closeProj; begin if fProjectInterface = nil then exit; // - fProjectInterface.getProject.Free; + if not fProjectInterface.inGroup then + fProjectInterface.getProject.Free; fProjectInterface := nil; fNativeProject := nil; fDubProject := nil; @@ -2608,16 +2645,18 @@ end; procedure TCEMainForm.actProjNewDubJsonExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProjectInterface <> nil) and not fProjectInterface.inGroup + and fProjectInterface.modified and + (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; closeProj; newDubProj; end; procedure TCEMainForm.actProjNewNativeExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProjectInterface <> nil) and not fProjectInterface.inGroup + and fProjectInterface.modified and + (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; closeProj; newNativeProj; end; @@ -2665,18 +2704,22 @@ end; procedure TCEMainForm.mruProjItemClick(Sender: TObject); begin - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProjectInterface <> nil) and not fProjectInterface.inGroup and + fProjectInterface.modified and + (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; openProj(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actProjCloseExecute(Sender: TObject); begin - if (fProjectInterface <> nil) and fProjectInterface.modified and - (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; + if (fProjectInterface <> nil) and not fProjectInterface.inGroup and + fProjectInterface.modified and + (dlgFileChangeClose(fProjectInterface.filename) = mrCancel) then exit; closeProj; end; +//TODO-cprojectgroup: handle filename change when grouped + procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); begin with TSaveDialog.Create(nil) do @@ -2739,6 +2782,71 @@ begin if fProjectInterface = nil then exit; dlgOkInfo(fProjectInterface.getCommandLine); end; + +procedure TCEMainForm.actProjOpenGroupExecute(Sender: TObject); +begin + if fProjectGroup.groupModified then + begin + if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then + exit; + end; + fProjectGroup.closeGroup; + with TOpenDialog.Create(nil) do + try + if execute then + fProjectGroup.openGroup(filename); + finally + free; + end; +end; + +procedure TCEMainForm.actProjSaveGroupAsExecute(Sender: TObject); +begin + with TSaveDialog.Create(nil) do + try + if execute then + fProjectGroup.saveGroup(filename); + finally + free; + end; +end; + +procedure TCEMainForm.actProjSaveGroupExecute(Sender: TObject); +begin + if not fProjectGroup.groupFilename.fileExists then + actProjSaveGroupAs.Execute + else + fProjectGroup.saveGroup(fProjectGroup.groupFilename); +end; + +procedure TCEMainForm.actNewGroupExecute(Sender: TObject); +begin + if fProjectGroup.groupModified then + begin + if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then + exit; + end; + fProjectGroup.closeGroup; +end; + +procedure TCEMainForm.actProjAddToGroupExecute(Sender: TObject); +begin + if fProjectInterface = nil then + exit; + if fProjectInterface.inGroup then + exit; + fProjectGroup.addProject(fProjectInterface); +end; + +procedure TCEMainForm.actProjNewGroupExecute(Sender: TObject); +begin + if fProjectGroup.groupModified then + begin + if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then + exit; + end; + fProjectGroup.closeGroup; +end; {$ENDREGION} initialization diff --git a/src/ce_miniexplorer.pas b/src/ce_miniexplorer.pas index c13c2cdd..f5060972 100644 --- a/src/ce_miniexplorer.pas +++ b/src/ce_miniexplorer.pas @@ -472,8 +472,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if not fProj.inGroup and fProj.modified and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCENativeProject.create(nil); @@ -483,8 +484,9 @@ begin begin if assigned(fProj) then begin - if fProj.modified and (dlgFileChangeClose(fProj.filename) = mrCancel) then - exit; + if not fProj.inGroup and fProj.modified and + (dlgFileChangeClose(fProj.filename) = mrCancel) then + exit; fProj.getProject.Free; end; TCEDubProject.create(nil); diff --git a/src/ce_nativeproject.pas b/src/ce_nativeproject.pas index 3345141b..9d5ab2d6 100644 --- a/src/ce_nativeproject.pas +++ b/src/ce_nativeproject.pas @@ -27,6 +27,7 @@ type *) TCENativeProject = class(TWritableLfmTextComponent, ICECommonProject) private + fInGroup: boolean; fCompilProc: TCEProcess; fOnChange: TNotifyEvent; fModified: boolean; @@ -88,6 +89,8 @@ type function addConfiguration: TCompilerConfiguration; procedure getOpts(const aList: TStrings); // + procedure inGroup(value: boolean); + function inGroup: boolean; function getFormat: TCEProjectFormat; function getProject: TObject; function filename: string; @@ -176,6 +179,16 @@ begin inherited; end; +function TCENativeProject.inGroup: boolean; +begin + exit(fInGroup); +end; + +procedure TCENativeProject.inGroup(value: boolean); +begin + fInGroup:=value; +end; + function TCENativeProject.getFormat: TCEProjectFormat; begin exit(pfNative); diff --git a/src/ce_projgroup.lfm b/src/ce_projgroup.lfm new file mode 100644 index 00000000..a9d38539 --- /dev/null +++ b/src/ce_projgroup.lfm @@ -0,0 +1,121 @@ +inherited CEProjectGroupWidget: TCEProjectGroupWidget + Left = 866 + Height = 240 + Top = 277 + Width = 561 + Caption = 'Project group' + ClientHeight = 240 + ClientWidth = 561 + inherited Back: TPanel + Height = 240 + Width = 561 + ClientHeight = 240 + ClientWidth = 561 + inherited Content: TPanel + Height = 240 + Width = 561 + ClientHeight = 240 + ClientWidth = 561 + object Panel1: TPanel[0] + Left = 4 + Height = 26 + Top = 4 + Width = 553 + Align = alTop + BorderSpacing.Around = 4 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 553 + TabOrder = 0 + object BtnAddProj: TBitBtn + Left = 0 + Height = 26 + Hint = 'add a project to the group' + Top = 0 + Width = 28 + Align = alLeft + Layout = blGlyphBottom + OnClick = BtnAddProjClick + Spacing = 0 + TabOrder = 0 + end + object btnRemProj: TBitBtn + Left = 28 + Height = 26 + Hint = 'remove selected project from the group' + Top = 0 + Width = 28 + Align = alLeft + Layout = blGlyphBottom + OnClick = btnRemProjClick + Spacing = 0 + TabOrder = 1 + end + object btnMoveDown: TBitBtn + Left = 56 + Height = 26 + Hint = 'move selected project down' + Top = 0 + Width = 28 + Align = alLeft + Layout = blGlyphBottom + OnClick = btnMoveDownClick + Spacing = 0 + TabOrder = 2 + end + object btnMoveUp: TBitBtn + Left = 84 + Height = 26 + Hint = 'move selected project up' + Top = 0 + Width = 28 + Align = alLeft + Layout = blGlyphBottom + OnClick = btnMoveUpClick + Spacing = 0 + TabOrder = 3 + end + end + object lstProj: TListView[1] + Left = 4 + Height = 202 + Top = 34 + Width = 553 + Align = alClient + AutoSort = False + AutoWidthLastColumn = True + BorderSpacing.Around = 4 + Columns = < + item + AutoSize = True + Caption = 'Name' + Width = 47 + end + item + AutoSize = True + Caption = 'Type' + Width = 39 + end + item + AutoSize = True + Caption = 'Configuration' + Width = 94 + end + item + Caption = 'Location' + Width = 369 + end> + GridLines = True + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 1 + ViewStyle = vsReport + OnDblClick = lstProjDblClick + end + end + end + inherited contextMenu: TPopupMenu + left = 272 + top = 56 + end +end diff --git a/src/ce_projgroup.pas b/src/ce_projgroup.pas new file mode 100644 index 00000000..df25137a --- /dev/null +++ b/src/ce_projgroup.pas @@ -0,0 +1,435 @@ +unit ce_projgroup; +{$I ce_defines.inc} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls, Menus, + Buttons, dialogs, ComCtrls, + ce_widget, ce_common, ce_interfaces, ce_writableComponent, ce_observer, + ce_nativeproject, ce_dubproject, ce_anyprojloader, ce_sharedres; + +type + + (** + * Represents a project in a project group + *) + TProjectGroupItem = class(TCollectionItem) + private + fFilename: string; + fProj: ICECommonProject; + published + property filename: string read fFilename write fFilename; + public + property project: ICECommonProject read fProj; + procedure lazyLoad; + destructor destroy; override; + end; + + (** + * Collection that handles several project at once. + *) + TProjectGroup = class(TWritableLfmTextComponent, ICEProjectGroup) + private + fIndex: integer; + fItems: TCollection; + fModified: boolean; + fOnChanged: TNotifyEvent; + procedure setItems(value: TCollection); + procedure setIndex(value: integer); + function getItem(index: integer): TProjectGroupItem; + procedure doChanged; + // + procedure addProject(aProject: ICECommonProject); + procedure openGroup(aFilename: string); + procedure saveGroup(aFilename: string); + procedure closeGroup; + function groupModified: boolean; + function groupFilename: string; + function singleServiceName: string; + protected + procedure afterLoad; override; + procedure afterSave; override; + published + property items: TCollection read fItems write setItems; + property index: integer read fIndex write setIndex; + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + // + function projectCount: Integer; + function getProject(ix: Integer): ICECommonProject; + function findProject(aFilename: string): ICECommonProject; + // + function addItem(const fname: string): TProjectGroupItem; + property item[ix: integer]: TProjectGroupItem read getItem; default; + property onChanged: TNotifyEvent read fOnChanged write fOnChanged; + end; + + (** + * GUI for a project group + *) + + { TCEProjectGroupWidget } + + TCEProjectGroupWidget = class(TCEWidget, ICEProjectObserver) + BtnAddProj: TBitBtn; + btnMoveDown: TBitBtn; + btnMoveUp: TBitBtn; + btnRemProj: TBitBtn; + lstProj: TListView; + Panel1: TPanel; + procedure BtnAddProjClick(Sender: TObject); + procedure btnMoveDownClick(Sender: TObject); + procedure btnMoveUpClick(Sender: TObject); + procedure btnRemProjClick(Sender: TObject); + procedure lstProjDblClick(Sender: TObject); + private + fUngrouped: ICECommonProject; + fFromGroup: boolean; + fProjSubj: TCEProjectSubject; + // + procedure projNew(aProject: ICECommonProject); + procedure projChanged(aProject: ICECommonProject); + procedure projClosing(aProject: ICECommonProject); + procedure projFocused(aProject: ICECommonProject); + procedure projCompiling(aProject: ICECommonProject); + procedure projCompiled(aProject: ICECommonProject; success: boolean); + // + procedure updateList; + procedure handleChanged(sender: TObject); + protected + procedure DoShow; override; + public + constructor create(aOwner: TCOmponent); override; + destructor destroy; override; + end; + +implementation +{$R *.lfm} + +var + projectGroup: TProjectGroup; + +{$REGION TProjectGroup ---------------------------------------------------------} +constructor TProjectGroup.create(aOwner: TComponent); +begin + inherited; + fItems := TCollection.Create(TProjectGroupItem); + EntitiesConnector.addSingleService(self); +end; + +destructor TProjectGroup.destroy; +begin + fItems.Free; + inherited; +end; + +procedure TProjectGroup.setItems(value: TCollection); +begin + fItems.Assign(value); +end; + +function TProjectGroup.getItem(index: integer): TProjectGroupItem; +begin + exit(TProjectGroupItem(fItems.Items[index])); +end; + +procedure tProjectGroup.doChanged; +begin + if assigned(fOnChanged) then + fOnChanged(self); +end; + +procedure TProjectGroup.setIndex(value: integer); +begin + if value < 0 then + value := 0 + else if value > fItems.Count-1 then + value := fItems.Count-1; + if fIndex <> value then + begin + fIndex := value; + fModified := true; + end; +end; + +function TProjectGroup.addItem(const fname: string): TProjectGroupItem; +var + it: TCollectionItem; +begin + fModified := true; + for it in fItems do + begin + if SameFileName(TProjectGroupItem(it).fFilename, fname) then + exit(TProjectGroupItem(it)); + end; + result := TProjectGroupItem(fItems.Add); + result.fFilename := fname; +end; + +function TProjectGroup.projectCount: Integer; +begin + exit(fItems.Count); +end; + +function TProjectGroup.getProject(ix: Integer): ICECommonProject; +begin + item[ix].lazyLoad; + exit(item[ix].fProj); +end; + +function TProjectGroup.findProject(aFilename: string): ICECommonProject; +var + i: integer; +begin + result := nil; + for i := 0 to projectCount-1 do + if SameFileName(item[i].fFilename, aFilename) then + begin + item[i].lazyLoad; + exit(item[i].fProj); + end; +end; + +procedure TProjectGroup.afterLoad; +begin + inherited; + fModified:=false; +end; + +procedure TProjectGroup.afterSave; +begin + inherited; + fModified:=false; +end; + +procedure TProjectGroup.addProject(aProject: ICECommonProject); +var + it: TCollectionItem; +begin + fModified := true; + for it in fItems do + begin + if SameFileName(TProjectGroupItem(it).fFilename, aProject.filename) then + exit; + end; + it := fItems.Add; + TProjectGroupItem(it).fFilename := aProject.filename; + TProjectGroupItem(it).fProj := aProject; + aProject.inGroup(true); + fIndex := it.Index; + doChanged; +end; + +procedure TProjectGroup.openGroup(aFilename: string); +begin + loadFromFile(aFilename); + doChanged; +end; + +procedure TProjectGroup.saveGroup(aFilename: string); +begin + saveToFile(aFilename); +end; + +procedure TProjectGroup.closeGroup; +begin + fItems.Clear; + fFilename:= ''; + fModified:=false; + fIndex := -1; + doChanged; +end; + +function TProjectGroup.groupModified: boolean; +var + i: integer; + b: boolean = false; +begin + for i:= 0 to fItems.Count-1 do + if (getItem(i).fProj <> nil) and getItem(i).fProj.modified then + begin + b := true; + break; + end; + exit(fModified or b); +end; + +function TProjectGroup.groupFilename: string; +begin + exit(Filename); +end; + +function TProjectGroup.singleServiceName: string; +begin + exit('ICEProjectGroup'); +end; + +procedure TProjectGroupItem.lazyLoad; +begin + if fProj = nil then + begin + fProj := loadProject(fFilename, true); + fProj.inGroup(true); + end; +end; + +destructor TProjectGroupItem.destroy; +begin + if fProj <> nil then + fProj.getProject.free; + inherited; +end; +{$ENDREGION} + +{$REGION Widget Standard component things --------------------------------------} +constructor TCEProjectGroupWidget.create(aOwner: TCOmponent); +begin + inherited; + AssignPng(btnMoveUp, 'arrow_up'); + AssignPng(btnMoveDown, 'arrow_down'); + AssignPng(BtnAddProj, 'document_add'); + AssignPng(btnRemProj, 'document_delete'); + projectGroup.onChanged:= @handleChanged; + fProjSubj:= TCEProjectSubject.Create; +end; + +destructor TCEProjectGroupWidget.destroy; +begin + inherited; + fProjSubj.free; +end; + +procedure TCEProjectGroupWidget.DoShow; +begin + inherited; + updateList; +end; +{$ENDREGION} + +{$REGION Widget ICEProjectObserver ---------------------------------------------} +procedure TCEProjectGroupWidget.projNew(aProject: ICECommonProject); +begin + if not fFromGroup then + fUngrouped := aProject; +end; + +procedure TCEProjectGroupWidget.projChanged(aProject: ICECommonProject); +begin + updateList; +end; + +procedure TCEProjectGroupWidget.projClosing(aProject: ICECommonProject); +begin + if not fFromGroup then + fUngrouped := nil; +end; + +procedure TCEProjectGroupWidget.projFocused(aProject: ICECommonProject); +begin + if not fFromGroup then + fUngrouped := aProject; +end; + +procedure TCEProjectGroupWidget.projCompiling(aProject: ICECommonProject); +begin +end; + +procedure TCEProjectGroupWidget.projCompiled(aProject: ICECommonProject; success: boolean); +begin +end; +{$ENDREGION} + +{$REGION Widget project group things -------------------------------------------} +procedure TCEProjectGroupWidget.BtnAddProjClick(Sender: TObject); +begin + with TOpenDialog.Create(nil) do + try + if not execute then + exit; + if projectGroup.findProject(filename) <> nil then + exit; + projectGroup.addItem(filename); + updateList; + finally + free; + end; +end; + +procedure TCEProjectGroupWidget.btnMoveDownClick(Sender: TObject); +begin + if lstProj.ItemIndex = -1 then exit; + if lstProj.ItemIndex = lstProj.Items.Count-1 then exit; + // + projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1); + lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1); +end; + +procedure TCEProjectGroupWidget.btnMoveUpClick(Sender: TObject); +begin + if lstProj.ItemIndex = -1 then exit; + if lstProj.ItemIndex = 0 then exit; + // + projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1); + lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1); +end; + +procedure TCEProjectGroupWidget.btnRemProjClick(Sender: TObject); +begin + if lstProj.ItemIndex = -1 then exit; + projectGroup.items.Delete(lstProj.Selected.Index); +end; + +procedure TCEProjectGroupWidget.lstProjDblClick(Sender: TObject); +begin + if lstProj.ItemIndex = -1 then + exit; + fFromGroup := true; + TProjectGroupItem(lstProj.Selected.Data).lazyLoad; + subjProjFocused(fProjSubj, TProjectGroupItem(lstProj.Selected.Data).project); + if projectGroup.index <> lstProj.ItemIndex then + projectGroup.index := lstProj.ItemIndex; + fFromGroup := false; +end; + +procedure TCEProjectGroupWidget.handleChanged(sender: TObject); +begin + updateList; + if (projectGroup.index <> -1) and (projectGroup.index <> lstProj.ItemIndex) then + begin + lstProj.ItemIndex := projectGroup.index; + lstProjDblClick(nil); + end; +end; + +procedure TCEProjectGroupWidget.updateList; +var + i: integer; + p: TProjectGroupItem; +const + typeStr: array[TCEProjectFormat] of string = ('CE','DUB'); +begin + lstProj.Clear; + for i := 0 to projectGroup.projectCount-1 do + begin + with lstProj.Items.Add do + begin + p := projectGroup.item[i]; + p.lazyLoad; + Data:= p; + Caption := p.fFilename.extractFileName; + SubItems.Add(typeStr[p.fProj.getFormat]); + SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex)); + SubItems.Add(p.fFilename.extractFilePath); + end; + end; +end; +{$ENDREGION} + +initialization + projectGroup := TProjectGroup.create(nil); +finalization + projectGroup.Free; +end. +