forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mostly done #68, project group

This commit is contained in:
Basile Burg 2016-06-12 10:43:44 +02:00
parent 7cf05e5167
commit 08ec1796be
14 changed files with 896 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lazproj/coedit.lpi
View File

@ -138,7 +138,7 @@
<PackageName Value="LCL"/>
</Item6>
</RequiredPackages>
<Units Count="48">
<Units Count="50">
<Unit0>
<Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/>
@ -389,6 +389,17 @@
<Filename Value="..\src\ce_dlangmaps.pas"/>
<IsPartOfProject Value="True"/>
</Unit47>
<Unit48>
<Filename Value="..\src\ce_projgroup.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjectGroupWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit48>
<Unit49>
<Filename Value="..\src\ce_anyprojloader.pas"/>
<IsPartOfProject Value="True"/>
</Unit49>
</Units>
</ProjectOptions>
<CompilerOptions>

2
lazproj/coedit.lpr
View File

@ -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}

58
src/ce_anyprojloader.pas Normal file
View File

@ -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.

14
src/ce_dubproject.pas
View File

@ -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);

32
src/ce_interfaces.pas
View File

@ -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.

10
src/ce_lcldragdrop.pas
View File

@ -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);

10
src/ce_libmaneditor.lfm
View File

@ -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

10
src/ce_libmaneditor.pas
View File

@ -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);

49
src/ce_main.lfm
View File

@ -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

170
src/ce_main.pas
View File

@ -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

10
src/ce_miniexplorer.pas
View File

@ -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);

13
src/ce_nativeproject.pas
View File

@ -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);

121
src/ce_projgroup.lfm Normal file
View File

@ -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

435
src/ce_projgroup.pas Normal file
View File

@ -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.