lazarus/components/projectgroups/projectgroupeditor.pas

1933 lines
58 KiB
ObjectPascal

{
Todo:
- run (with debug):
- start compile server, keep running, restart when options change
- close on IDE quit
- activate project when project is opened
- deactivate project when project is closed
- show active build mode
}
unit ProjectGroupEditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
// LCL
Forms, Controls, Graphics, Dialogs, ComCtrls, Menus,
ActnList, Clipbrd, ImgList, LCLType,
// LazUtils
FileUtil, LazFileUtils, LazLoggerBase, LazFileCache,
// BuildIntf
PackageIntf, ProjectIntf,
// IdeIntf
LazIDEIntf, ProjectGroupIntf, MenuIntf, IDEWindowIntf, IDEDialogs, IDECommands,
IDEImagesIntf,
// ProjectGroups
ProjectGroupStrConst, ProjectGroup, PrjGrpOptionsFrm, PrjGrpInfoFrm;
type
TNodeType = (
ntUnknown,
ntProjectGroup,
ntTarget,
ntMissingTarget,
ntBuildModes,
ntBuildMode,
ntFiles,
ntFile,
ntDependencies,
ntDependency
);
TNodeData = class(TObject)
NodeType: TNodeType;
Target, ParentTarget: TPGCompileTarget;
Value: string; // ntFile = Filename, ntDependency = PkgName, ntBuildMode = BuildMode name
end;
{ TProjectGroupEditorForm }
TProjectGroupEditorForm = class(TForm)
AProjectGroupOpen: TAction;
AProjectGroupAddAll: TAction;
AProjectGroupNew: TAction;
AProjectGroupAddCurrent: TAction;
ATargetInfo: TAction;
AProjectGroupOptions: TAction;
AProjectGroupRedo: TAction;
AProjectGroupUndo: TAction;
AProjectGroupReload: TAction;
ATargetCompileFromHere: TAction;
ATargetCompileCleanFromHere: TAction;
ATargetCopyFilename: TAction;
AProjectGroupAddExisting: TAction;
ATargetCompile: TAction;
ATargetCompileClean: TAction;
AProjectGroupAddNew: TAction;
ATargetActivate: TAction;
ATargetOpen: TAction;
AProjectGroupSaveAs: TAction;
ATargetUninstall: TAction;
ATargetInstall: TAction;
ATargetRun: TAction;
ATargetProperties: TAction;
ATargetLater: TAction;
ATargetEarlier: TAction;
AProjectGroupDelete: TAction;
AProjectGroupSave: TAction;
ActionListMain: TActionList;
PMIAddAll: TMenuItem;
PMINew: TMenuItem;
PMIAddExisting: TMenuItem;
PMIAddCurrent: TMenuItem;
PMIInfo: TMenuItem;
PMIOptions: TMenuItem;
PMIRedo: TMenuItem;
PMIUndo: TMenuItem;
PMICompileFromHere: TMenuItem;
PMICompileCleanFromHere: TMenuItem;
PMIRunMenuItem: TMenuItem;
PMICopyFilenameMenuItem: TMenuItem;
PMIOpen: TMenuItem;
PMISaveAs: TMenuItem;
PMIProperties: TMenuItem;
PMILater: TMenuItem;
PMIEarlier: TMenuItem;
PMIDelete: TMenuItem;
PMICompileClean: TMenuItem;
PMICompile: TMenuItem;
OpenDialogTarget: TOpenDialog;
PopupMenuAdd: TPopupMenu;
PopupMenuOpen: TPopupMenu;
PopupMenuMore: TPopupMenu;
PopupMenuTree: TPopupMenu;
SBPG: TStatusBar;
SelectDirectoryDialog: TSelectDirectoryDialog;
TBProjectGroup: TToolBar;
TBSave: TToolButton;
TBAdd: TToolButton;
TBNewTarget: TToolButton;
TBDelete: TToolButton;
TBCompile: TToolButton;
TBCompileClean: TToolButton;
TBOpen: TToolButton;
ToolButton1: TToolButton;
TBTargetUp: TToolButton;
TBTargetLater: TToolButton;
TBMore: TToolButton;
TBActivate: TToolButton;
TBReload: TToolButton;
TVPG: TTreeView;
procedure AProjectGroupAddAllExecute(Sender: TObject);
procedure AProjectGroupAddAllUpdate(Sender: TObject);
procedure AProjectGroupAddCurrentExecute(Sender: TObject);
procedure AProjectGroupAddCurrentUpdate(Sender: TObject);
procedure AProjectGroupAddExistingExecute(Sender: TObject);
procedure AProjectGroupAddExistingUpdate(Sender: TObject);
procedure AProjectGroupDeleteExecute(Sender: TObject);
procedure AProjectGroupDeleteUpdate(Sender: TObject);
procedure AProjectGroupNewExecute(Sender: TObject);
procedure AProjectGroupOpenExecute(Sender: TObject);
procedure AProjectGroupOptionsExecute(Sender: TObject);
procedure AProjectGroupRedoExecute(Sender: TObject);
procedure AProjectGroupRedoUpdate(Sender: TObject);
procedure AProjectGroupReloadExecute(Sender: TObject);
procedure AProjectGroupSaveAsExecute(Sender: TObject);
procedure AProjectGroupSaveAsUpdate(Sender: TObject);
procedure AProjectGroupSaveExecute(Sender: TObject);
procedure AProjectGroupSaveUpdate(Sender: TObject);
procedure AProjectGroupUndoExecute(Sender: TObject);
procedure AProjectGroupUndoUpdate(Sender: TObject);
procedure ATargetActivateExecute(Sender: TObject);
procedure ATargetActivateUpdate(Sender: TObject);
procedure ATargetCompileCleanExecute(Sender: TObject);
procedure ATargetCompileCleanUpdate(Sender: TObject);
procedure ATargetCompileExecute(Sender: TObject);
procedure ATargetCompileFromHereExecute(Sender: TObject);
procedure ATargetCompileFromHereUpdate(Sender: TObject);
procedure ATargetCompileCleanFromHereExecute(Sender: TObject);
procedure ATargetCompileCleanFromHereUpdate(Sender: TObject);
procedure ATargetCompileUpdate(Sender: TObject);
procedure ATargetCopyFilenameExecute(Sender: TObject);
procedure ATargetCopyFilenameUpdate(Sender: TObject);
procedure ATargetEarlierExecute(Sender: TObject);
procedure ATargetEarlierUpdate(Sender: TObject);
procedure ATargetInfoExecute(Sender: TObject);
procedure ATargetInstallExecute(Sender: TObject);
procedure ATargetInstallUpdate(Sender: TObject);
procedure ATargetLaterExecute(Sender: TObject);
procedure ATargetLaterUpdate(Sender: TObject);
procedure ATargetOpenExecute(Sender: TObject);
procedure ATargetOpenUpdate(Sender: TObject);
procedure ATargetPropertiesExecute(Sender: TObject);
procedure ATargetPropertiesUpdate(Sender: TObject);
procedure ATargetRunExecute(Sender: TObject);
procedure ATargetRunUpdate(Sender: TObject);
procedure ATargetUninstallExecute(Sender: TObject);
procedure ATargetUninstallUpdate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PopupMenuMorePopup(Sender: TObject);
procedure PopupMenuOpenPopup(Sender: TObject);
procedure TVPGAdvancedCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; {%H-}State: TCustomDrawState; Stage: TCustomDrawStage;
var {%H-}PaintImages, {%H-}DefaultDraw: Boolean);
procedure TVPGDblClick(Sender: TObject);
procedure TVPGKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure TVPGMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TVPGSelectionChanged(Sender: TObject);
private
// Nodelist image indexes
NIProjectGroup : integer;// = 0;
NITargetProject : integer;// = 3;
NITargetPackage : integer;// = 4;
NITargetProjectGroup : integer;// = 5;
NIBuildModes : integer;// = 12;
NIBuildMode : integer;// = 12;
NIFiles : integer;// = 16;
NIFile : integer;// = 17;
NIDependencies : integer;// = 1;
NIDependency : integer;// = 1;
// Node state image index
NSIActive : Integer;// = 20; // State index for active.
NSIMissing : Integer; // State index for missing
// overlay index
NSIChecked : Integer;// = 22;
NSIUnchecked : Integer;// = 23;
procedure LoadImages;
private
FBuildCommandRedirected: boolean;
FProjectGroup: TProjectGroup;
FProjectGroupTVNode: TTreeNode;
FActiveTarget: TPGCompileTarget;
FLastShowTargetPaths: boolean;
FOldBuildExecute, FOldBuildUpdate: TNotifyEvent;
FOldCompileExecute, FOldCompileUpdate: TNotifyEvent;
// Event handlers
procedure IDEProjectGroupManagerEditorOptionsChanged(Sender: TObject);
procedure ApplicationActivate(Sender: TObject);
procedure BuildExecute(Sender: TObject);
procedure BuildUpdate(Sender: TObject);
procedure CompileExecute(Sender: TObject);
procedure CompileUpdate(Sender: TObject);
procedure IDEClose(Sender: TObject);
procedure ProjectGroupDestroy(Sender: TObject);
procedure ProjectGroupFileNameChanged(Sender: TObject);
procedure TargetInserted(Sender: TObject; Target: TPGCompileTarget);
procedure TargetDeleted(Sender: TObject; Target: TPGCompileTarget);
procedure TargetActiveChanged(Sender: TObject; Target: TPGCompileTarget);
procedure TargetExchanged(Sender: TObject; Target1, Target2: TPGCompileTarget);
function AllowPerform(ATargetAction: TPGTargetAction; AAction: TAction= Nil): Boolean;
procedure ClearEventCallBacks(AProjectGroup: TProjectGroup);
procedure InitTVNode(Node: TTreeNode; Const ACaption: String; ANodeData: TNodeData);
procedure SetBuildCommandRedirected(const AValue: boolean);
procedure SetEventCallBacks(AProjectGroup: TProjectGroup);
// Some helpers
procedure SetProjectGroup(AValue: TProjectGroup);
function ShowDependencies(AParent: TTreeNode; T: TPGCompileTarget): TTreeNode;
procedure ShowFileName;
procedure Perform(ATargetAction: TPGTargetAction);
function GetActiveTarget: TPGCompileTarget;
// Treeview Node management
function FindTVNodeOfTarget(ATarget: TPGCompileTarget): TTreeNode;
function FindBuildModeNodeRecursively(TVNode: TTreeNode; aMode: string): TTreeNode;
function FindTVNodeOfBuildMode(aMode: TPGBuildMode): TTreeNode;
procedure FreeNodeData;
class function TargetFromNode(N: TTreeNode): TPGCompileTarget;
function DisplayFileName(aTarget: TPGCompileTarget): string;
function DisplayFileName(Node: TTreeNode): string;
function DisplayFileName(NodeData: TNodeData): string;
function CreateSectionNode(AParent: TTreeNode; Const ACaption: String; ANodeType: TNodeType): TTreeNode;
function CreateTargetNode(AParent: TTreeNode; ANodeType: TNodeType; aTarget: TPGCompileTarget): TTreeNode;
function CreateSubNode(AParent: TTreeNode; ANodeType: TNodeType; aParentTarget: TPGCompileTarget; aValue: string): TTreeNode;
procedure ClearNodeData(TVNode: TTreeNode);
procedure ClearChildNodes(TVNode: TTreeNode);
procedure FillPackageNode(TVNode: TTreeNode; T: TPGCompileTarget);
procedure FillProjectNode(TVNode: TTreeNode; T: TPGCompileTarget);
procedure FillTargetNode(TVNode: TTreeNode; T: TPGCompileTarget);
procedure FillProjectGroupNode(TVNode: TTreeNode; AProjectGroup: TProjectGroup);
function GetNodeImageIndex(ANodeType: TNodeType; ANodeData: TPGCompileTarget ): Integer;
procedure AddTarget(const aFileName: string);
function SelectedNodeData: TNodeData;
function SelectedTarget: TPGCompileTarget;
function GetTVNodeFilename(TVNode: TTreeNode): string;
function GetBuildMode(TVNode: TTreeNode): TPGBuildMode;
function GetNearestTarget(TVNode: TTreeNode): TPGCompileTarget;
function SelectedNodeType: TPGCompileTarget;
procedure UpdateIDEMenuCommandFromAction(Sender: TObject; Item: TIDEMenuCommand);
procedure UpdateStatusBarTargetCount;
procedure UpdateRecentProjectGroupMenu;
procedure DoOpenRecentClick(Sender: TObject);
protected
procedure Localize;
procedure ShowProjectGroup;
procedure UpdateShowing; override;
public
property ProjectGroup: TProjectGroup Read FProjectGroup Write SetProjectGroup;
property ActiveTarget: TPGCompileTarget Read GetActiveTarget;
procedure UpdateNodeTexts;
property BuildCommandRedirected: boolean read FBuildCommandRedirected write SetBuildCommandRedirected;
end;
var
ProjectGroupEditorForm: TProjectGroupEditorForm;
ProjectGroupEditorCreator: TIDEWindowCreator; // set by RegProjectGroup.Register
const
ProjectGroupEditorName = 'ProjectGroupEditor';
procedure ShowProjectGroupEditor(Sender: TObject; AProjectGroup: TProjectGroup; BringToFront: boolean);
procedure CreateProjectGroupEditor(Sender: TObject; aFormName: string;
var AForm: TCustomForm; DoDisableAutoSizing: boolean);
procedure SetProjectGroupEditorCallBack;
function dbgs(NodeType: TNodeType): string; overload;
implementation
{$R *.lfm}
const
// Status bar Panel indexes
piTargetCount = 0;
piActiveTarget = 1;
procedure ShowProjectGroupEditor(Sender: TObject; AProjectGroup: TProjectGroup; BringToFront: boolean);
begin
IDEWindowCreators.ShowForm(ProjectGroupEditorCreator.FormName,BringToFront);
if AProjectGroup<>nil then
ProjectGroupEditorForm.ProjectGroup:=AProjectGroup;
end;
procedure CreateProjectGroupEditor(Sender: TObject; aFormName: string;
var AForm: TCustomForm; DoDisableAutoSizing: boolean);
begin
if CompareText(aFormName,ProjectGroupEditorName)<>0 then begin
DebugLn(['ERROR: CreateProjectGroupEditor: there is already a form with this name']);
exit;
end;
IDEWindowCreators.CreateForm(AForm,TProjectGroupEditorForm,DoDisableAutoSizing,
LazarusIDE.OwningComponent);
AForm.Name:=aFormName;
end;
procedure SetProjectGroupEditorCallBack;
begin
ProjectGroupEditorCreator:=IDEWindowCreators.Add(ProjectGroupEditorName,
@CreateProjectGroupEditor,nil,
'30%','30%','+30%','+40%','ProjectGroupEditor',alNone);
OnShowProjectGroupEditor:=@ShowProjectGroupEditor;
end;
function dbgs(NodeType: TNodeType): string;
begin
str(NodeType,Result);
end;
{ TProjectGroupEditorForm }
procedure TProjectGroupEditorForm.ClearEventCallBacks(AProjectGroup: TProjectGroup);
Var
PG: TIDEProjectGroup;
begin
//debugln(['TProjectGroupEditorForm.ClearEventCallBacks ']);
PG:=AProjectGroup as TIDEProjectGroup;
PG.RemoveAllHandlersOfObject(Self);
PG.OnFileNameChange:=Nil;
PG.OnTargetInserted:=Nil;
PG.OnTargetDeleted:=Nil;
PG.OnTargetActiveChanged:=Nil;
PG.OnTargetsExchanged:=Nil;
end;
procedure TProjectGroupEditorForm.ClearNodeData(TVNode: TTreeNode);
begin
if TVNode.Data<>nil then
begin
TObject(TVNode.Data).Free;
TVNode.Data:=nil;
end;
end;
procedure TProjectGroupEditorForm.SetBuildCommandRedirected(
const AValue: boolean);
var
CompileCmd, BuildCmd: TIDECommand;
begin
if FBuildCommandRedirected=AValue then Exit;
FBuildCommandRedirected:=AValue;
if IDECommandList=nil then exit;
BuildCmd:=IDECommandList.FindIDECommand(ecBuild);
CompileCmd:=IDECommandList.FindIDECommand(ecCompile);
if FBuildCommandRedirected then begin
// ecBuild
FOldBuildExecute:=BuildCmd.OnExecute;
FOldBuildUpdate:=BuildCmd.OnUpdate;
BuildCmd.OnExecute:=@BuildExecute;
BuildCmd.OnUpdate:=@BuildUpdate;
// ecCompile
FOldCompileExecute:=CompileCmd.OnExecute;
FOldCompileUpdate:=CompileCmd.OnUpdate;
CompileCmd.OnExecute:=@CompileExecute;
CompileCmd.OnUpdate:=@CompileUpdate;
end else begin
// build
BuildCmd.OnExecute:=FOldBuildExecute;
BuildCmd.OnUpdate:=FOldBuildUpdate;
// compile
CompileCmd.OnExecute:=FOldCompileExecute;
CompileCmd.OnUpdate:=FOldCompileUpdate;
end;
end;
procedure TProjectGroupEditorForm.SetEventCallBacks(AProjectGroup: TProjectGroup);
Var
PG: TIDEProjectGroup;
begin
PG:=AProjectGroup as TIDEProjectGroup;
PG.AddHandlerOnDestroy(@ProjectGroupDestroy);
PG.OnFileNameChange:=@ProjectGroupFileNameChanged;
PG.OnTargetInserted:=@TargetInserted;
PG.OnTargetDeleted:=@TargetDeleted;
PG.OnTargetActiveChanged:=@TargetActiveChanged;
PG.OnTargetsExchanged:=@TargetExchanged;
end;
procedure TProjectGroupEditorForm.SetProjectGroup(AValue: TProjectGroup);
begin
//debugln(['TProjectGroupEditorForm.SetProjectGroup START ',FProjectGroup=AValue,' new=',DbgSName(AValue)]);
if FProjectGroup=AValue then Exit;
if ProjectGroup<>nil then
ClearEventCallBacks(ProjectGroup);
FProjectGroup:=AValue;
if ProjectGroup<>nil then
SetEventCallBacks(ProjectGroup);
FActiveTarget:=Nil;
ShowProjectGroup;
end;
procedure TProjectGroupEditorForm.Localize;
procedure ConfigAction(A: TAction; AImageName: string; Const ACaption,AHint: String; Mnu: TIDEMenuCommand);
begin
A.Caption:=ACaption;
A.Hint:=AHint;
if AImageName<>'' then
A.ImageIndex:=IDEImages.GetImageIndex(AImageName)
else
A.ImageIndex:=-1;
If Assigned(mnu) then
Mnu.OnClick:=A.OnExecute;
end;
begin
ConfigAction(AProjectGroupOpen,'pg_open_simple',lisProjectGroupOpenCaption,lisProjectGroupOpenHint,Nil);
ConfigAction(AProjectGroupSave,'pg_save_simple',lisProjectGroupSaveCaption,lisProjectGroupSaveHint,Nil);
ConfigAction(AProjectGroupSaveAs,'pg_save_as_simple',lisProjectGroupSaveAsCaption,lisProjectGroupSaveAsHint,Nil);
ConfigAction(AProjectGroupNew,'pg_new',lisProjectGroupNewCaption,lisProjectGroupNewHint,Nil);
ConfigAction(AProjectGroupAddAll,'',lisAddAllFromDirectoryCaption,lisAddAllFromDirectoryHint,Nil);
ConfigAction(AProjectGroupAddExisting,'pg_add_project_from_file',lisProjectGroupAddExistingCaption,lisProjectGroupAddExistingHint,Nil);
ConfigAction(AProjectGroupAddCurrent,'pg_add_project',lisProjectGroupAddCurrentProjectCaption,lisProjectGroupAddCurrentProjectHint,Nil);
ConfigAction(AProjectGroupDelete,'laz_delete',lisProjectGroupDeleteCaption,lisProjectGroupDeleteHint,Nil);
ConfigAction(AProjectGroupAddNew,'menu_project_new',lisProjectGroupAddNewCaption,lisProjectGroupAddNewHint,Nil);
ConfigAction(ATargetEarlier,'arrow_up',lisTargetEarlierCaption,lisTargetEarlierHint,Nil);
ConfigAction(ATargetLater,'arrow_down',lisTargetLaterCaption,lisTargetLaterHint,Nil);
ConfigAction(ATargetCompile,'menu_build',lisTargetCompileCaption,lisTargetCompileHint,Nil);
ConfigAction(ATargetCompileClean,'menu_build_clean',lisTargetCompileCleanCaption,lisTargetCompileCleanHint,Nil);
ConfigAction(ATargetProperties,'menu_project_options',lisTargetPropertiesCaption,lisTargetPropertiesHint,Nil);
ConfigAction(ATargetRun,'menu_run',lisTargetRunCaption,lisTargetRunHint,Nil);
ConfigAction(ATargetInstall,'pkg_install',lisTargetInstallCaption,lisTargetInstallHint,Nil);
ConfigAction(ATargetUninstall,'pkg_package_uninstall',lisTargetUninstallCaption,lisTargetUninstallHint,Nil);
ConfigAction(ATargetInfo,'menu_information',lisTargetInfoCaption,'',Nil);
ConfigAction(ATargetActivate,'',lisTargetActivateCaption,lisTargetActivateHint,Nil);
ConfigAction(ATargetOpen,'',lisTargetOpenCaption,lisTargetOpenHint,Nil);
ConfigAction(ATargetCopyFilename,'',lisTargetCopyFilename,'',Nil);
ConfigAction(ATargetCompileFromHere,'',lisTargetCompileFromHere,'',Nil);
ConfigAction(ATargetCompileCleanFromHere,'',lisTargetCompileCleanFromHere,'',Nil);
ConfigAction(AProjectGroupReload,'laz_refresh',lisProjectGroupReload,'',Nil);
ConfigAction(AProjectGroupUndo, 'menu_undo', lisUndo, '', nil);
ConfigAction(AProjectGroupRedo, 'menu_redo', lisRedo, '', nil);
ConfigAction(AProjectGroupOptions, 'menu_environment_options', lisOptions, '', nil);
TBMore.Caption:=lisMore;
TBAdd.Caption := lisProjectGroupAddCaption;
TBAdd.ImageIndex := IDEImages.GetImageIndex('laz_add');
TBAdd.Hint := lisProjectGroupAddHint;
ActionListMain.Images := IDEImages.Images_16;
PopupMenuMore.Images := ActionListMain.Images;
PopupMenuAdd.Images := ActionListMain.Images;
PopupMenuTree.Images := ActionListMain.Images;
TBProjectGroup.Images := ActionListMain.Images;
TVPG.Images := ActionListMain.Images;
TVPG.StateImages := ActionListMain.Images;
end;
procedure TProjectGroupEditorForm.AProjectGroupSaveUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=(FProjectGroup<>nil)
and (FProjectGroup.Modified or (FProjectGroup.FileName=''));
TBAdd.Enabled:=(FProjectGroup<>nil);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdSaveProjectGroup);
end;
procedure TProjectGroupEditorForm.AProjectGroupUndoExecute(Sender: TObject);
begin
IDEProjectGroupManager.Undo;
end;
procedure TProjectGroupEditorForm.AProjectGroupUndoUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=IDEProjectGroupManager.CanUndo;
end;
procedure TProjectGroupEditorForm.ATargetEarlierExecute(Sender: TObject);
Var
T: TNodeData;
I: Integer;
PG: TProjectGroup;
begin
T:=SelectedNodeData;
if (T=nil) or (T.Target=nil) or (T.Target.Parent=nil) then
exit;
PG:=T.Target.Parent.ProjectGroup;
if PG=nil then exit;
I:=PG.IndexOfTarget(T.Target);
if I>0 then
PG.ExchangeTargets(I,I-1);
end;
procedure TProjectGroupEditorForm.ATargetEarlierUpdate(Sender: TObject);
Var
T: TNodeData;
I: Integer;
PG: TProjectGroup;
begin
I:=0;
T:=SelectedNodeData;
if (T<>nil) and (T.Target<>nil) and (T.Target.Parent<>nil) then
begin
PG:=T.Target.Parent.ProjectGroup;
if PG<>nil then begin
I:=PG.IndexOfTarget(T.Target);
end;
end;
(Sender as TAction).Enabled:=I>0;
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetEarlier);
end;
procedure TProjectGroupEditorForm.ATargetInfoExecute(Sender: TObject);
begin
ShowPrgGrpInfo(SelectedTarget as TIDECompileTarget);
end;
procedure TProjectGroupEditorForm.ATargetLaterExecute(Sender: TObject);
Var
T: TNodeData;
I: Integer;
PG: TProjectGroup;
begin
T:=SelectedNodeData;
if (T=nil) or (T.Target=nil) or (T.Target.Parent=nil) then
exit;
PG:=T.Target.Parent.ProjectGroup;
if PG=nil then exit;
I:=PG.IndexOfTarget(T.Target);
if I<0 then exit;
if (I+1<PG.TargetCount) then
PG.ExchangeTargets(I,I+1);
end;
procedure TProjectGroupEditorForm.ATargetLaterUpdate(Sender: TObject);
Var
T: TNodeData;
I: Integer;
PG: TProjectGroup;
begin
T:=SelectedNodeData;
I:=-1;
PG:=nil;
if (T<>nil) and (T.Target<>nil) and (T.Target.Parent<>nil) then
begin
PG:=T.Target.Parent.ProjectGroup;
if PG<>nil then
I:=PG.IndexOfTarget(T.Target);
end;
(Sender as TAction).Enabled:=(PG<>nil) and (I+1<PG.TargetCount);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetLater);
end;
procedure TProjectGroupEditorForm.ATargetUninstallExecute(Sender: TObject);
begin
Perform(taInstall);
end;
procedure TProjectGroupEditorForm.ATargetUninstallUpdate(Sender: TObject);
begin
AllowPerform(taUninstall,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetUninstall);
end;
procedure TProjectGroupEditorForm.FormCloseQuery(Sender: TObject;
var CanClose: boolean);
begin
CanClose:=IDEProjectGroupManager.CheckSaved;
end;
procedure TProjectGroupEditorForm.UpdateIDEMenuCommandFromAction(
Sender: TObject; Item: TIDEMenuCommand);
begin
Item.Enabled:=(Sender as TAction).Enabled;
Item.Visible:=(Sender as TAction).Visible;
end;
procedure TProjectGroupEditorForm.UpdateStatusBarTargetCount;
var
Cnt: Integer;
begin
if FProjectGroup<>nil then
Cnt:=FProjectGroup.TargetCount
else
Cnt:=0;
SBPG.Panels[piTargetCount].Text:=Format(lisTargetCount, [Cnt]);
end;
procedure TProjectGroupEditorForm.FormCreate(Sender: TObject);
procedure SetItem(Item: TIDEMenuCommand; AnOnClick: TNotifyEvent;
aShow: boolean = true; AEnable: boolean = true);
begin
//debugln(['SetItem ',Item.Caption,' Visible=',aShow,' Enable=',AEnable]);
Item.OnClick:=AnOnClick;
Item.Visible:=aShow;
Item.Enabled:=AEnable;
end;
begin
if ProjectGroupEditorForm=nil then
ProjectGroupEditorForm:=Self;
IDEProjectGroupManager.Editor:=Self;
IDEProjectGroupManager.OnEditorOptionsChanged:=@IDEProjectGroupManagerEditorOptionsChanged;
PGEditMenuSectionMisc.MenuItem:=PopupMenuMore.Items;
SetItem(MnuCmdTargetAdd,@AProjectGroupAddExistingExecute);
SetItem(MnuCmdTargetRemove,@AProjectGroupDeleteExecute);
SetItem(MnuCmdTargetCompile,@ATargetCompileExecute);
SetItem(MnuCmdTargetCompileClean,@ATargetCompileCleanExecute);
SetItem(MnuCmdTargetCompileFromHere,@ATargetCompileFromHereExecute);
SetItem(MnuCmdTargetCompileCleanFromHere,@ATargetCompileCleanFromHereExecute);
SetItem(MnuCmdTargetInstall,@ATargetInstallExecute);
SetItem(MnuCmdTargetUninstall,@ATargetUnInstallExecute);
SetItem(MnuCmdTargetLater,@ATargetLaterExecute);
SetItem(MnuCmdTargetEarlier,@ATargetEarlierExecute);
SetItem(MnuCmdTargetCopyFilename,@ATargetCopyFilenameExecute);
SetItem(MnuCmdProjGrpUndo,@AProjectGroupUndoExecute);
SetItem(MnuCmdProjGrpRedo,@AProjectGroupRedoExecute);
SetItem(MnuCmdProjGrpOptions,@AProjectGroupOptionsExecute);
LazarusIDE.AddHandlerOnIDEClose(@IDEClose);
Application.AddOnActivateHandler(@ApplicationActivate);
if IDEProjectGroupManager.Options.BuildCommandToCompileTarget then
BuildCommandRedirected:=true;
LoadImages;
end;
procedure TProjectGroupEditorForm.FormDestroy(Sender: TObject);
begin
//debugln(['TProjectGroupEditorForm.FormDestroy START ',ProjectGroup<>nil]);
BuildCommandRedirected:=false;
ProjectGroup:=nil;
if ProjectGroupEditorForm=Self then
ProjectGroupEditorForm:=nil;
ProjectGroupManager.Editor:=Self;
if (PGEditMenuSectionMisc<>nil)
and (IDEMenuRoots <> nil) // it is RegisterIDEMenuSection, and will be freed by the IDE, but PGEditMenuSectionMisc will not be nil
and (PGEditMenuSectionMisc.MenuItem=PopupMenuMore.Items) then
PGEditMenuSectionMisc.MenuItem:=nil;
//debugln(['TProjectGroupEditorForm.FormDestroy END ',ProjectGroup<>nil]);
end;
procedure TProjectGroupEditorForm.PopupMenuMorePopup(Sender: TObject);
var
ND: TNodeData;
AllowedActions: TPGTargetActions;
begin
ND:=SelectedNodeData;
if (ND<>nil) and (ND.Target<>nil) then begin
AllowedActions:=PGTargetActions[ND.Target.TargetType];
end else begin
AllowedActions:=[taOpen,taSettings];
end;
PMIOpen.Visible:=taOpen in AllowedActions;
PMIProperties.Visible:=taSettings in AllowedActions;
PMICompile.Visible:=taCompile in AllowedActions;
PMICompileClean.Visible:=taCompileClean in AllowedActions;
PMIRunMenuItem.Visible:=taRun in AllowedActions;
end;
procedure TProjectGroupEditorForm.PopupMenuOpenPopup(Sender: TObject);
begin
UpdateRecentProjectGroupMenu;
end;
procedure TProjectGroupEditorForm.TVPGAdvancedCustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
procedure PaintOverlayImage(const AImageIndex: Integer);
var
r: TRect;
y: LongInt;
ImagesRes: TScaledImageListResolution;
begin
ImagesRes :=Sender.Images.ResolutionForControl[Sender.ImagesWidth, Sender];
r:=Node.DisplayRect(true);
r.Left:=Node.DisplayIconLeft+1;
y:=(r.Top+r.Bottom-ImagesRes.Height) div 2;
ImagesRes.Draw(Sender.Canvas,r.Left,y,AImageIndex);
end;
var
ND: TNodeData;
r: TRect;
y: LongInt;
begin
if Stage=cdPostPaint then begin
ND:=TNodeData(Node.Data);
if (ND.Target<>nil) and ND.Target.Missing then begin
// Missing target file: draw red line strike through text an
PaintOverlayImage(NSIMissing);
r:=Node.DisplayRect(true);
TVPG.Canvas.Pen.Color:=clRed;
y:=(r.Top+r.Bottom) div 2;
TVPG.Canvas.Line(r.Left,y,r.Right,y);
end;
end;
end;
procedure TProjectGroupEditorForm.TVPGDblClick(Sender: TObject);
Var
ND: TNodeData;
aFilename, PkgName: String;
PG: TProjectGroup;
begin
ND:=SelectedNodeData;
//debugln(['TProjectGroupEditorForm.TVPGDblClick ',DbgSName(Sender),' ',TVPG.Selected.Text,' ',ND<>nil]);
if ND=nil then exit;
case ND.NodeType of
ntProjectGroup,
ntTarget:
begin
PG:=ND.Target.GetOwnerProjectGroup;
if PG=nil then exit;
case ND.Target.TargetType of
ttProject,
ttPackage,
ttPascalFile:
PG.Perform(ND.Target,taOpen)
end;
end;
ntMissingTarget:
;
ntFile:
begin
// open file in source editor
aFilename:=ND.Value;
//debugln(['TProjectGroupEditorForm.TVPGDblClick File=',aFilename]);
if aFilename='' then exit;
LazarusIDE.DoOpenEditorFile(aFilename,-1,-1,[ofAddToRecent,
ofRegularFile,ofDoNotLoadResource,ofOnlyIfExists]);
end;
ntDependency:
begin
// open package editor
PkgName:=ND.Value;
if PackageEditingInterface.DoOpenPackageWithName(PkgName,[pofAddToRecent],false)<>mrOk
then begin
IDEMessageDialog(lisPackageNotFound, Format(lisPackageNotFound2, [PkgName]), mtError, [mbOk]);
exit;
end;
end;
end;
end;
procedure TProjectGroupEditorForm.TVPGKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_RETURN:
begin
TVPGDblClick(Sender);
Key := 0;
end;
VK_F5:
begin
TBReload.Click;
Key := 0;
end;
VK_UP:
if Shift=[ssCtrl] then
begin
TBTargetUp.Click;
Key := 0;
end;
VK_DOWN:
if Shift=[ssCtrl] then
begin
TBTargetLater.Click;
Key := 0;
end;
Ord('O'):
if Shift=[ssCtrl] then
begin
TBOpen.Click;
Key := 0;
end;
Ord('S'):
begin
if Shift=[ssCtrl] then
TBSave.Click
else
if Shift=[ssCtrl, ssShift] then
PMISaveAs.Click;
Key := 0;
end;
end;
end;
procedure TProjectGroupEditorForm.TVPGMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
TVNode: TTreeNode;
ND: TNodeData;
aMode: TPGBuildMode;
begin
TVNode:=TVPG.GetNodeAt(X,Y);
if TVNode=nil then exit;
ND:=TNodeData(TVNode.Data);
if ND=nil then exit;
if mbLeft=Button then begin
if (ND.NodeType=ntBuildMode) and ([ssShift,ssCtrl]*Shift=[]) then
begin
if (TVNode.DisplayStateIconLeft<=X) and (X<TVNode.DisplayIconLeft) then
begin
if TVNode.StateIndex=NSIChecked then
TVNode.StateIndex:=NSIUnchecked
else
TVNode.StateIndex:=NSIChecked;
aMode:=GetBuildMode(TVNode);
if aMode<>nil then
aMode.Compile:=TVNode.StateIndex=NSIChecked;
end;
end;
end;
end;
procedure TProjectGroupEditorForm.TVPGSelectionChanged(Sender: TObject);
var
TVNode: TTreeNode;
ND: TNodeData;
s: String;
begin
TVNode:=TVPG.Selected;
s:='';
if (TVNode<>nil) and (TVNode.Data<>nil) then begin
ND:=TNodeData(TVNode.Data);
if ND.Target<>nil then begin
s:=ND.Target.Filename;
end else begin
case ND.NodeType of
ntBuildMode: s := Format(lisBuildMode2, [ND.Value]);
ntFile: s:=ND.Value;
end;
end;
end;
SBPG.Panels[piActiveTarget].Text:=s;
end;
procedure TProjectGroupEditorForm.TargetInserted(Sender: TObject;
Target: TPGCompileTarget);
Var
N: TTreeNode;
begin
(Target as TIDECompileTarget).LoadTarget(true);
if Sender<>ProjectGroup then exit; // ToDo: sub groups
TVPG.BeginUpdate;
try
N:=CreateTargetNode(FProjectGroupTVNode,ntTarget,Target);
N.Index:=Target.GetIndex;
FillTargetNode(N,Target);
TVPG.Selected:=N;
finally
TVPG.EndUpdate;
end;
UpdateStatusBarTargetCount;
end;
procedure TProjectGroupEditorForm.TargetDeleted(Sender: TObject;
Target: TPGCompileTarget);
Var
N: TTreeNode;
begin
if Sender<>ProjectGroup then exit; // ToDo: sub groups
N:=FindTVNodeOfTarget(Target);
TVPG.BeginUpdate;
try
ClearChildNodes(N);
ClearNodeData(N);
TVPG.Items.Delete(N);
TVPG.Selected:=FProjectGroupTVNode;
finally
TVPG.EndUpdate;
end;
UpdateStatusBarTargetCount;
end;
procedure TProjectGroupEditorForm.TargetActiveChanged(Sender: TObject;
Target: TPGCompileTarget);
Var
OldActiveTVNode,NewActiveTVNode: TTreeNode;
begin
OldActiveTVNode:=FindTVNodeOfTarget(FActiveTarget);
NewActiveTVNode:=FindTVNodeOfTarget(Target);
if (OldActiveTVNode<>NewActiveTVNode) then
begin
if Assigned(OldActiveTVNode) then
OldActiveTVNode.StateIndex:=-1;
if Assigned(NewActiveTVNode) then
NewActiveTVNode.StateIndex:=NSIActive;
FActiveTarget:=Target;
end;
if Assigned(Target) then
SBPG.Panels[piActiveTarget].Text:=Format(lisActiveTarget,[DisplayFileName(Target)])
else
TVPGSelectionChanged(Nil); // Restore the original status text.
end;
procedure TProjectGroupEditorForm.TargetExchanged(Sender: TObject; Target1,
Target2: TPGCompileTarget);
var
N1, N2: TTreeNode;
OldIndex: Integer;
begin
N1:=FindTVNodeOfTarget(Target1);
N2:=FindTVNodeOfTarget(Target2);
If (N1=Nil) or (N2=Nil) then
exit;
OldIndex:=N1.Index;
N1.Index:=N2.Index;
N2.Index:=OldIndex;
end;
procedure TProjectGroupEditorForm.AProjectGroupSaveExecute(Sender: TObject);
Var
P: String;
begin
if FProjectGroup=nil then exit;
P:=FProjectGroup.FileName;
ProjectGroupManager.SaveProjectGroup;
if P<>FProjectGroup.FileName then
ShowProjectGroup;
end;
procedure TProjectGroupEditorForm.AProjectGroupAddExistingExecute(Sender: TObject);
var
i: Integer;
begin
if FProjectGroup=nil then exit;
InitIDEFileDialog(OpenDialogTarget);
OpenDialogTarget.Filter :=
lisLazarusSupportedInProjectGroups + '|*.lpi;*.lpk;*.lpg;*.pas;*.pp;*.p'
+ '|' + lisLazarusProjectsLpi + '|*.lpi'
+ '|' + lisLazarusPackagesLpk + '|*.lpk'
+ '|' + lisLazarusProjectGroupsLpg + '|*.lpg'
+ '|' + lisPascalFilePasPpP + '|*.pas;*.pp;*.p';
If OpenDialogTarget.Execute then
for i:=0 to OpenDialogTarget.Files.Count-1 do
AddTarget(OpenDialogTarget.Files[i]);
StoreIDEFileDialog(OpenDialogTarget);
end;
procedure TProjectGroupEditorForm.AProjectGroupAddExistingUpdate(
Sender: TObject);
begin
(Sender as TAction).Enabled:=FProjectGroup<>nil;
end;
procedure TProjectGroupEditorForm.ATargetActivateUpdate(Sender: TObject);
Var
T: TPGCompileTarget;
begin
T:=SelectedTarget;
(Sender as TAction).Enabled:=Assigned(T) and Not T.Active;
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetActivate);
end;
procedure TProjectGroupEditorForm.ATargetActivateExecute(Sender: TObject);
Var
ND: TNodeData;
begin
ND:=SelectedNodeData;
if (ND=nil) or (ND.Target=nil) then
exit;
ND.Target.Activate;
end;
procedure TProjectGroupEditorForm.AProjectGroupReloadExecute(Sender: TObject);
var
PG: TIDEProjectGroup;
begin
if ProjectGroup=nil then exit;
if FileExistsCached(ProjectGroup.FileName) then
begin
PG:=TIDEProjectGroup(ProjectGroup);
if PG.Modified then begin
PG.UpdateMissing;
if IDEMessageDialog(lisProjectGroupModified, lisChangesGetLostAtReload, mtConfirmation, mbYesNo)<>mrYes then
exit;
end;
ProjectGroup:=nil;
try
PG.LoadFromFile([pgloLoadRecursively]);
finally
ProjectGroup:=PG;
end;
end else
PG.UpdateMissing;
end;
procedure TProjectGroupEditorForm.AProjectGroupSaveAsUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=(FProjectGroup<>nil);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdSaveProjectGroupAs);
end;
procedure TProjectGroupEditorForm.ATargetCompileCleanExecute(Sender: TObject);
begin
Perform(taCompileClean);
end;
procedure TProjectGroupEditorForm.ATargetCompileCleanUpdate(Sender: TObject);
begin
AllowPerform(taCompileClean,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompileClean);
end;
function TProjectGroupEditorForm.AllowPerform(ATargetAction: TPGTargetAction;
AAction: TAction): Boolean;
Var
ND: TNodeData;
aTarget: TPGCompileTarget;
begin
Result:=false;
ND:=SelectedNodeData;
if ND<>nil then begin
if ND.Target<>nil then begin
Result:=(not ND.Target.Missing) and (ATargetAction in ND.Target.AllowedActions);
end else begin
aTarget:=GetNearestTarget(TVPG.Selected);
case ND.NodeType of
ntBuildMode:
Result:=(not aTarget.Missing)
and (ATargetAction in [taCompile,taCompileClean,taCompileFromHere,taCompileCleanFromHere,taRun]);
end;
end;
end;
If Assigned(AAction) then
AAction.Enabled:=Result;
end;
procedure TProjectGroupEditorForm.AProjectGroupAddCurrentExecute(Sender: TObject);
begin
if LazarusIDE.ActiveProject.ProjectInfoFile<>'' then
AddTarget(LazarusIDE.ActiveProject.ProjectInfoFile);
end;
procedure TProjectGroupEditorForm.AProjectGroupAddAllExecute(Sender: TObject);
var
i: PtrInt;
Files: TStringList;
begin
if FProjectGroup=nil then exit;
InitIDEFileDialog(SelectDirectoryDialog);
If SelectDirectoryDialog.Execute then
begin
Files := FindAllFiles(SelectDirectoryDialog.FileName, '*.lpi;*.lpk;*.lpg');
for i := 0 to Files.Count - 1 do
AddTarget(Files[i]);
FreeAndNil(Files);
end;
StoreIDEFileDialog(SelectDirectoryDialog);
end;
procedure TProjectGroupEditorForm.AProjectGroupAddAllUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=FProjectGroup<>nil;
end;
procedure TProjectGroupEditorForm.AProjectGroupAddCurrentUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := (FProjectGroup<>nil) and (LazarusIDE.ActiveProject<>nil)
and (LazarusIDE.ActiveProject.ProjectInfoFile<>'');
end;
procedure TProjectGroupEditorForm.AddTarget(const aFileName: string);
var
aTarget: TIDECompileTarget;
aMode: TPGBuildMode;
TVNode: TTreeNode;
begin
if FProjectGroup.IndexOfTarget(aFileName)>=0 then
Exit;
aTarget:=FProjectGroup.AddTarget(aFileName) as TIDECompileTarget;
aTarget.LoadTarget(true);
if aTarget.BuildModeCount>1 then
begin
aMode:=aTarget.BuildModes[0];
aMode.Compile:=true;
// ToDo: implement changed notification
TVNode:=FindTVNodeOfBuildMode(aMode);
TVNode.StateIndex:=NSIChecked;
end;
end;
procedure TProjectGroupEditorForm.Perform(ATargetAction: TPGTargetAction);
Var
ND: TNodeData;
aTarget: TPGCompileTarget;
begin
ND:=SelectedNodeData;
if (ND=nil) then exit;
aTarget:=ND.Target;
if aTarget<>nil then
aTarget.GetOwnerProjectGroup.Perform(aTarget,ATargetAction)
else begin
aTarget:=GetNearestTarget(TVPG.Selected);
case ND.NodeType of
ntBuildMode:
aTarget.PerformBuildModeAction(ATargetAction,ND.Value);
end;
end;
end;
procedure TProjectGroupEditorForm.ATargetCompileExecute(Sender: TObject);
begin
Perform(taCompile);
end;
procedure TProjectGroupEditorForm.ATargetCompileFromHereExecute(Sender: TObject);
begin
Perform(taCompileFromHere);
end;
procedure TProjectGroupEditorForm.ATargetCompileFromHereUpdate(Sender: TObject);
begin
AllowPerform(taCompileFromHere,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompile);
end;
procedure TProjectGroupEditorForm.ATargetCompileCleanFromHereExecute(Sender: TObject);
begin
Perform(taCompileCleanFromHere);
end;
procedure TProjectGroupEditorForm.ATargetCompileCleanFromHereUpdate(Sender: TObject);
begin
AllowPerform(taCompileCleanFromHere,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompile);
end;
procedure TProjectGroupEditorForm.ATargetCompileUpdate(Sender: TObject);
begin
AllowPerform(taCompile,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCompile);
end;
procedure TProjectGroupEditorForm.AProjectGroupDeleteExecute(Sender: TObject);
Var
T: TPGCompileTarget;
begin
T:=SelectedTarget;
if (T=nil) or (T.Parent=nil) then exit;
T.Parent.ProjectGroup.RemoveTarget(T);
end;
procedure TProjectGroupEditorForm.AProjectGroupDeleteUpdate(Sender: TObject);
Var
T: TPGCompileTarget;
begin
T:=SelectedTarget;
(Sender as TAction).Enabled:=(T<>nil) and (T<>ProjectGroup.SelfTarget);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetRemove);
end;
procedure TProjectGroupEditorForm.AProjectGroupNewExecute(Sender: TObject);
begin
IDEProjectGroupManager.DoNewClick(Sender);
end;
procedure TProjectGroupEditorForm.AProjectGroupOpenExecute(Sender: TObject);
begin
IDEProjectGroupManager.DoOpenClick(Sender);
end;
procedure TProjectGroupEditorForm.AProjectGroupOptionsExecute(Sender: TObject);
begin
LazarusIDE.DoOpenIDEOptions(TProjGrpOptionsFrame);
end;
procedure TProjectGroupEditorForm.AProjectGroupRedoExecute(Sender: TObject);
begin
// ToDo
debugln(['TProjectGroupEditorForm.AProjectGroupRedoExecute Todo']);
end;
procedure TProjectGroupEditorForm.AProjectGroupRedoUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled:=IDEProjectGroupManager.CanRedo;
end;
procedure TProjectGroupEditorForm.ATargetCopyFilenameExecute(Sender: TObject);
var
ND: TNodeData;
aFilename: String;
begin
ND:=SelectedNodeData;
if ND=nil then exit;
if ND.Target<>nil then
aFilename:=ND.Target.Filename
else if ND.NodeType=ntFile then
aFilename:=ND.Value
else
exit;
Clipboard.AsText:=aFilename;
end;
procedure TProjectGroupEditorForm.ATargetCopyFilenameUpdate(Sender: TObject);
var
ND: TNodeData;
begin
ND:=SelectedNodeData;
(Sender as TAction).Enabled:=(ND<>nil)
and ((ND.Target<>nil) or (ND.NodeType in [ntFile]));
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetCopyFilename);
end;
procedure TProjectGroupEditorForm.ATargetInstallExecute(Sender: TObject);
begin
Perform(taInstall);
end;
procedure TProjectGroupEditorForm.ATargetInstallUpdate(Sender: TObject);
begin
AllowPerform(taInstall,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetInstall);
end;
procedure TProjectGroupEditorForm.ATargetOpenExecute(Sender: TObject);
begin
Perform(taOpen);
end;
procedure TProjectGroupEditorForm.ATargetOpenUpdate(Sender: TObject);
begin
AllowPerform(taOpen,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetOpen);
end;
procedure TProjectGroupEditorForm.ATargetPropertiesExecute(Sender: TObject);
begin
Perform(taSettings);
end;
procedure TProjectGroupEditorForm.ATargetPropertiesUpdate(Sender: TObject);
begin
AllowPerform(taSettings,Sender as Taction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetProperties);
end;
procedure TProjectGroupEditorForm.ATargetRunExecute(Sender: TObject);
begin
Perform(taRun);
end;
procedure TProjectGroupEditorForm.ATargetRunUpdate(Sender: TObject);
begin
AllowPerform(taRun,Sender as TAction);
UpdateIDEMenuCommandFromAction(Sender,MnuCmdTargetRun);
end;
procedure TProjectGroupEditorForm.AProjectGroupSaveAsExecute(Sender: TObject);
begin
IDEProjectGroupManager.DoSaveAsClick(Sender);
end;
procedure TProjectGroupEditorForm.FreeNodeData;
Var
N: TTreeNode;
I: Integer;
begin
FActiveTarget:=nil;
FProjectGroupTVNode:=Nil;
For I:=0 to TVPG.Items.Count-1 do
begin
N:=TVPG.Items[I];
TNodeData(N.Data).Free; // Would be nice to have a FreeAndNilData method in TTreeNode.
N.Data:=Nil;
end;
end;
function TProjectGroupEditorForm.GetNodeImageIndex(ANodeType: TNodeType;
ANodeData: TPGCompileTarget): Integer;
begin
case ANodeType of
ntProjectGroup: Result:=NIProjectGroup;
ntTarget, ntMissingTarget :
Case ANodeData.TargetType of
ttProject: Result:=NITargetProject;
ttPackage: Result:=NITargetPackage;
ttProjectGroup: Result:=NITargetProjectGroup;
ttPascalFile: Result:=NIFile;
end;
ntBuildModes: Result:=NIBuildModes;
ntBuildMode: Result:=NIBuildMode;
ntFiles: Result:=NIFiles;
ntFile: Result:=NIFile;
//ntRemovedFiles: Result:=NIRemovedFiles;
//ntRemovedFile: Result:=NIRemovedFile;
ntDependencies: Result:=NIDependencies;
ntDependency: Result:=NIDependency;
//ntRemovedDependencies: Result:=NIRemovedDependencies;
//ntRemovedDependency: Result:=NIRemovedDependency;
else
Result:=-1;
end;
end;
function TProjectGroupEditorForm.SelectedNodeData: TNodeData;
Var
N: TTreeNode;
begin
N:=TVPG.Selected;
If Assigned(N) then
Result:=TNodeData(N.Data)
else
Result:=Nil;
end;
function TProjectGroupEditorForm.SelectedTarget: TPGCompileTarget;
Var
N: TNodeData;
begin
N:=SelectedNodeData;
if Assigned(N) then
Result:=N.Target
else
Result:=Nil;
end;
function TProjectGroupEditorForm.GetTVNodeFilename(TVNode: TTreeNode): string;
var
ND: TNodeData;
begin
Result:='';
if (TVNode=nil) then exit;
ND:=TNodeData(TVNode.Data);
if (ND.Target<>nil) then
exit(ND.Target.Filename);
case ND.NodeType of
ntFile: Result:=ND.Value;
end;
end;
function TProjectGroupEditorForm.GetBuildMode(TVNode: TTreeNode): TPGBuildMode;
var
ND: TNodeData;
begin
Result:=nil;
if TVNode=nil then exit;
ND:=TNodeData(TVNode.Data);
if (ND=nil) or (ND.NodeType<>ntBuildMode) then exit;
while TVNode<>nil do begin
if (TVNode.Data<>nil) and (TNodeData(TVNode.Data).Target<>nil) then
begin
Result:=TNodeData(TVNode.Data).Target.FindBuildMode(ND.Value);
exit;
end;
TVNode:=TVNode.Parent;
end;
end;
function TProjectGroupEditorForm.GetNearestTarget(TVNode: TTreeNode
): TPGCompileTarget;
begin
Result:=nil;
while (TVNode<>nil) do begin
if (TVNode.Data<>nil) then begin
Result:=TNodeData(TVNode.Data).Target;
if Result<>nil then exit;
end;
TVNode:=TVNode.Parent;
end;
Result:=nil;
end;
function TProjectGroupEditorForm.SelectedNodeType: TPGCompileTarget;
Var
N: TNodeData;
begin
N:=SelectedNodeData;
if Assigned(N) then
Result:=N.Target
else
Result:=Nil;
end;
procedure TProjectGroupEditorForm.InitTVNode(Node: TTreeNode;
const ACaption: String; ANodeData: TNodeData);
begin
Node.Data:=ANodeData;
If (ACaption<>'') then
Node.Text:=ACaption;
Node.ImageIndex:=GetNodeImageIndex(ANodeData.NodeType,ANodeData.Target);
Node.SelectedIndex:=Node.ImageIndex;
if Assigned(ANodeData.Target) and ANodeData.Target.Active then
Node.StateIndex:=NSIActive
else
Node.StateIndex:=-1;
end;
procedure TProjectGroupEditorForm.LoadImages;
begin
NIProjectGroup := IDEImages.GetImageIndex('pg_item');
NITargetProject := IDEImages.GetImageIndex('item_project');
NITargetPackage := IDEImages.GetImageIndex('item_package');
NITargetProjectGroup := NIProjectGroup;
NIBuildModes := IDEImages.GetImageIndex('menu_build_all');
NIBuildMode := IDEImages.GetImageIndex('menu_build');
NIFiles := IDEImages.GetImageIndex('pkg_files');
NIFile := IDEImages.GetImageIndex('item_unit');
NIDependencies := IDEImages.GetImageIndex('pkg_required');
NIDependency := IDEImages.GetImageIndex('pkg_required');
// Node state image index
NSIActive := IDEImages.GetImageIndex('pg_active');
NSIMissing := IDEImages.GetImageIndex('laz_cancel');
// overlay index
NSIChecked := IDEImages.GetImageIndex('laz_tick');
NSIUnchecked := IDEImages.GetImageIndex('laz_cancel');
end;
procedure TProjectGroupEditorForm.IDEProjectGroupManagerEditorOptionsChanged(
Sender: TObject);
var
Opts: TIDEProjectGroupOptions;
begin
Invalidate;
Opts:=IDEProjectGroupManager.Options;
if Opts.BuildCommandToCompileTarget then
BuildCommandRedirected:=true;
if FLastShowTargetPaths<>Opts.ShowTargetPaths then
UpdateNodeTexts;
end;
procedure TProjectGroupEditorForm.ApplicationActivate(Sender: TObject);
begin
if ProjectGroup<>nil then
ProjectGroup.UpdateMissing;
end;
procedure TProjectGroupEditorForm.BuildExecute(Sender: TObject);
var
ND: TNodeData;
begin
if IDEProjectGroupManager.Options.BuildCommandToCompileTarget then begin
ND:=SelectedNodeData;
if (ND<>nil) and (ND.Target<>nil) then begin
Perform(taCompileClean);
exit;
end;
end;
if Assigned(FOldBuildExecute) then
FOldBuildExecute(Sender);
end;
procedure TProjectGroupEditorForm.BuildUpdate(Sender: TObject);
begin
if IDEProjectGroupManager.Options.BuildCommandToCompileTarget then ;
if Assigned(FOldBuildUpdate) then
FOldBuildUpdate(Sender);
end;
procedure TProjectGroupEditorForm.CompileExecute(Sender: TObject);
var
ND: TNodeData;
begin
if IDEProjectGroupManager.Options.BuildCommandToCompileTarget then begin
ND:=SelectedNodeData;
if (ND<>nil) and (ND.Target<>nil) then begin
Perform(taCompile);
exit;
end;
end;
// execute IDE's compile action
if Assigned(FOldCompileExecute) then
FOldCompileExecute(Sender);
end;
procedure TProjectGroupEditorForm.CompileUpdate(Sender: TObject);
begin
//debugln(['TProjectGroupEditorForm.OnCompileUpdate ',DbgSName(Sender)]);
if IDEProjectGroupManager.Options.BuildCommandToCompileTarget then ;
if Assigned(FOldCompileUpdate) then
FOldCompileUpdate(Sender);
end;
procedure TProjectGroupEditorForm.IDEClose(Sender: TObject);
var
Opts: TIDEProjectGroupOptions;
begin
if IsVisible then
begin
Opts:=IDEProjectGroupManager.Options;
if Opts.OpenLastGroupOnStart then
begin
if (ProjectGroup<>nil) and FilenameIsAbsolute(ProjectGroup.FileName) then
Opts.LastGroupFile:=ProjectGroup.FileName
else
Opts.LastGroupFile:='';
if Opts.Modified then
Opts.SaveSafe;
end;
end;
end;
procedure TProjectGroupEditorForm.ProjectGroupDestroy(Sender: TObject);
begin
if Sender=FProjectGroup then begin
ProjectGroup:=nil;
end;
end;
procedure TProjectGroupEditorForm.ProjectGroupFileNameChanged(Sender: TObject);
begin
if Sender<>ProjectGroup then exit; // ToDo: sub groups
ShowFileName;
UpdateNodeTexts;
end;
function TProjectGroupEditorForm.CreateSectionNode(AParent: TTreeNode;
const ACaption: String; ANodeType: TNodeType): TTreeNode;
Var
ND: TNodeData;
begin
ND:=TNodeData.Create;
ND.NodeType:=ANodeType;
Result:=TVPG.Items.AddChild(AParent,ACaption);
InitTVNode(Result,'',ND);
end;
function TProjectGroupEditorForm.CreateTargetNode(AParent: TTreeNode;
ANodeType: TNodeType; aTarget: TPGCompileTarget): TTreeNode;
var
ND: TNodeData;
begin
ND:=TNodeData.Create;
ND.NodeType:=ANodeType;
ND.Target:=aTarget;
if aTarget<>nil then
ND.ParentTarget:=aTarget.Parent;
Result:=TVPG.Items.AddChild(AParent,DisplayFileName(ND));
InitTVNode(Result,'',ND);
end;
function TProjectGroupEditorForm.CreateSubNode(AParent: TTreeNode;
ANodeType: TNodeType; aParentTarget: TPGCompileTarget; aValue: string
): TTreeNode;
var
ND: TNodeData;
aCaption: String;
begin
ND:=TNodeData.Create;
ND.NodeType:=ANodeType;
ND.ParentTarget:=aParentTarget;
ND.Value:=aValue;
aCaption:=aValue;
if ANodeType=ntFile then
aCaption:=CreateRelativePath(aCaption,ExtractFilePath(aParentTarget.Filename));
Result:=TVPG.Items.AddChild(AParent,aCaption);
InitTVNode(Result,'',ND);
end;
procedure TProjectGroupEditorForm.ClearChildNodes(TVNode: TTreeNode);
procedure FreeChildrenNodeData(aTVNode: TTreeNode);
var
i: Integer;
ChildNode: TTreeNode;
begin
if aTVNode=nil then exit;
for i:=0 to aTVNode.Count-1 do
begin
ChildNode:=aTVNode[i];
ClearNodeData(ChildNode);
FreeChildrenNodeData(ChildNode);
end;
end;
begin
FreeChildrenNodeData(TVNode);
TVNode.DeleteChildren;
end;
function TProjectGroupEditorForm.DisplayFileName(aTarget: TPGCompileTarget
): string;
var
BaseDir: String;
begin
Result:='';
if aTarget=nil then exit('?');
if IDEProjectGroupManager.Options.ShowTargetPaths then
begin
if aTarget.Parent<>nil then
BaseDir:=ExtractFilePath(aTarget.Parent.Filename)
else
BaseDir:='';
Result:=aTarget.Filename;
if Result='' then
Result:='?'
else
Result:=CreateRelativePath(Result,BaseDir);
end else begin
//debugln(['TProjectGroupEditorForm.DisplayFileName ',aTarget.Filename,' ',aTarget.TargetType=ttPascalFile]);
if aTarget.TargetType in [ttPascalFile] then
Result:=ExtractFileName(aTarget.Filename)
else
Result:=ExtractFileNameOnly(aTarget.Filename);
end;
end;
function TProjectGroupEditorForm.DisplayFileName(Node: TTreeNode): string;
begin
Result:='';
if (Node=nil) or (Node.Data=nil) then exit;
Result:=DisplayFileName(TNodeData(Node.Data));
end;
procedure TProjectGroupEditorForm.DoOpenRecentClick(Sender: TObject);
var
Item: TMenuItem;
aFilename: String;
begin
Item:=Sender as TMenuItem;
aFilename:=Item.Caption;
//debugln(['TProjectGroupEditorForm.DoOpenRecentClick ',aFilename]);
IDEProjectGroupManager.LoadProjectGroup(aFilename,[pgloBringToFront, pgloLoadRecursively]);
end;
function TProjectGroupEditorForm.DisplayFileName(NodeData: TNodeData): string;
begin
if NodeData=nil then exit('');
Result:=DisplayFileName(NodeData.Target);
end;
procedure TProjectGroupEditorForm.ShowFileName;
Var
N: String;
begin
if FProjectGroup=nil then
N:=''
else
N:=FProjectGroup.FileName;
if (N='') then
Caption:=lisNewProjectGroup
else
Caption:=Format(LisProjectGroup,[DisplayFileName(FProjectGroup.SelfTarget)]);
if Assigned(FProjectGroupTVNode) then
FProjectGroupTVNode.Text:=DisplayFileName(FProjectGroupTVNode);
end;
function TProjectGroupEditorForm.FindTVNodeOfTarget(ATarget: TPGCompileTarget): TTreeNode;
Var
I: Integer;
begin
Result:=Nil;
if ATarget=nil then exit;
I:=0;
While (Result=Nil) and (I<TVPG.Items.Count) do
begin
Result:=TVPG.Items[I];
If Not (Assigned(Result.Data) and (TNodeData(Result.Data).Target=ATarget)) then
Result:=Nil;
Inc(I);
end;
end;
function TProjectGroupEditorForm.FindBuildModeNodeRecursively(
TVNode: TTreeNode; aMode: string): TTreeNode;
var
ND: TNodeData;
begin
Result:=nil;
if TVNode=nil then exit;
if (TVNode.Data=nil) then exit;
ND:=TNodeData(TVNode.Data);
if (ND.NodeType=ntBuildMode) and (CompareText(ND.Value,aMode)=0) then
exit(TVNode);
TVNode:=TVNode.GetFirstChild;
while TVNode<>nil do begin
Result:=FindBuildModeNodeRecursively(TVNode,aMode);
if Result<>nil then exit;
TVNode:=TVNode.GetNextSibling;
end;
end;
function TProjectGroupEditorForm.FindTVNodeOfBuildMode(aMode: TPGBuildMode
): TTreeNode;
begin
Result:=nil;
if aMode=nil then exit;
// find project node
Result:=FindTVNodeOfTarget(aMode.Target);
if Result=nil then exit;
// find build mode node
Result:=FindBuildModeNodeRecursively(Result,aMode.Identifier);
end;
procedure TProjectGroupEditorForm.ShowProjectGroup;
Var
N: TTreeNode;
begin
FLastShowTargetPaths:=IDEProjectGroupManager.Options.ShowTargetPaths;
TVPG.BeginUpdate;
try
FreeNodeData;
ShowFileName; // Needs FProjectGroupTVNode
TVPG.Items.Clear;
if FProjectGroup<>nil then begin
FProjectGroupTVNode:=CreateTargetNode(Nil,
ntProjectGroup,ProjectGroup.SelfTarget);
FillProjectGroupNode(FProjectGroupTVNode,FProjectGroup);
N:=FindTVNodeOfTarget(FActiveTarget);
if (N=Nil) then
begin
FActiveTarget:=ProjectGroup.SelfTarget;
TVPG.Selected:=FProjectGroupTVNode;
end else
TVPG.Selected:=N;
end else begin
FProjectGroupTVNode:=nil;
end;
UpdateStatusBarTargetCount;
finally
TVPG.EndUpdate;
end;
end;
procedure TProjectGroupEditorForm.UpdateShowing;
begin
inherited UpdateShowing;
if IsVisible then
Localize;
end;
procedure TProjectGroupEditorForm.UpdateNodeTexts;
var
TVNode: TTreeNode;
NodeData: TNodeData;
begin
FLastShowTargetPaths:=IDEProjectGroupManager.Options.ShowTargetPaths;
TVPG.BeginUpdate;
try
for TVNode in TVPG.Items do begin
NodeData:=TNodeData(TVNode.Data);
if NodeData is TNodeData then begin
if (NodeData.NodeType in [ntTarget]) and (NodeData.Target<>nil) then begin
TVNode.Text:=DisplayFileName(TVNode);
end;
end;
end;
finally
TVPG.EndUpdate;
end;
end;
procedure TProjectGroupEditorForm.UpdateRecentProjectGroupMenu;
var
i, l: Integer;
Item: TMenuItem;
aFilename: String;
begin
i:=0;
l:=0;
while l<IDEProjectGroupManager.Options.RecentProjectGroups.Count do begin
aFilename:=IDEProjectGroupManager.Options.RecentProjectGroups[l];
inc(l);
if not FileExists(aFilename) then
continue;
if i<PopupMenuOpen.Items.Count then begin
Item:=PopupMenuOpen.Items[i];
end
else begin
Item:=TMenuItem.Create(Self);
PopupMenuOpen.Items.Add(Item);
Item.OnClick:=@DoOpenRecentClick;
end;
Item.Caption:=aFilename;
inc(i);
end;
while i<PopupMenuOpen.Items.Count do
PopupMenuOpen.Items[i].Free;
end;
procedure TProjectGroupEditorForm.FillProjectGroupNode(TVNode: TTreeNode;
AProjectGroup: TProjectGroup);
Const
TNT: Array[Boolean] of TNodeType = (ntTarget,ntMissingTarget);
Var
T: TPGCompileTarget;
TN: TTreeNode;
I: Integer;
begin
TVPG.BeginUpdate;
try
ClearChildNodes(TVNode);
// 2 Passes: one to show all nodes, one to fill them with target-specific data.
// Display all nodes
For I:=0 to AProjectGroup.TargetCount-1 do
begin
T:=AProjectGroup.Targets[i];
CreateTargetNode(TVNode,TNT[T.Missing],T);
end;
// Fill all nodes.
For I:=0 to TVNode.Count-1 do
begin
TN:=TVNode.Items[i];
FillTargetNode(TN,TargetFromNode(TN));
end;
TVNode.Expand(False);
finally
TVPG.EndUpdate;
end;
end;
function TProjectGroupEditorForm.ShowDependencies(AParent: TTreeNode;
T: TPGCompileTarget): TTreeNode;
Var
i: Integer;
Pkg: TIDEPackage;
PkgName: String;
begin
Result:=CreateSectionNode(AParent,lisNodeDependencies,ntDependencies);
For i:=0 to T.RequiredPackageCount-1 do
begin
PkgName:=T.RequiredPackages[i].PackageName;
Pkg:=PackageEditingInterface.FindPackageWithName(PkgName);
if Pkg<>nil then
PkgName:=Pkg.Name;
CreateSubNode(Result,ntDependency,T,PkgName);
end;
end;
procedure TProjectGroupEditorForm.FillProjectNode(TVNode: TTreeNode;
T: TPGCompileTarget);
Var
FilesNode: TTreeNode;
i: Integer;
BuildModeNode, SubTVNode: TTreeNode;
aMode: TPGBuildMode;
begin
TVPG.BeginUpdate;
try
ClearChildNodes(TVNode);
// buildmodes
if T.BuildModeCount>1 then
begin
BuildModeNode:=CreateSectionNode(TVNode,lisNodeBuildModes,ntBuildModes);
for i:=0 to T.BuildModeCount-1 do
begin
aMode:=T.BuildModes[i];
SubTVNode:=CreateSubNode(BuildModeNode,ntBuildMode,T,aMode.Identifier);
if aMode.Compile then
SubTVNode.StateIndex:=NSIChecked
else
SubTVNode.StateIndex:=NSIUnchecked;
end;
end;
// files
FilesNode:=CreateSectionNode(TVNode,lisNodeFiles,ntFiles);
for i:=0 to T.FileCount-1 do
CreateSubNode(FilesNode,ntFile,T,T.Files[i]);
// dependencies
ShowDependencies(TVNode,T);
finally
TVPG.EndUpdate;
end;
end;
procedure TProjectGroupEditorForm.FillPackageNode(TVNode: TTreeNode;
T: TPGCompileTarget);
Var
FilesNode: TTreeNode;
i: Integer;
begin
TVPG.BeginUpdate;
try
ClearChildNodes(TVNode);
FilesNode:=CreateSectionNode(TVNode,lisNodeFiles,ntFiles);
for i:=0 to T.FileCount-1 do
CreateSubNode(FilesNode,ntFile,T,T.Files[i]);
ShowDependencies(TVNode,T);
finally
TVPG.EndUpdate;
end;
end;
procedure TProjectGroupEditorForm.FillTargetNode(TVNode: TTreeNode;
T: TPGCompileTarget);
begin
TVPG.BeginUpdate;
try
ClearChildNodes(TVNode);
If T=Nil then
T:=TargetFromNode(TVNode);
if T=Nil then
exit;
case T.TargetType of
ttProject: FillProjectNode(TVNode,T);
ttPackage: FillPackageNode(TVNode,T);
ttProjectGroup: FillProjectgroupNode(TVNode,T.ProjectGroup);
ttPascalFile: ;
end;
finally
TVPG.EndUpdate;
end;
end;
function TProjectGroupEditorForm.GetActiveTarget: TPGCompileTarget;
begin
Result:=FActiveTarget;
end;
class function TProjectGroupEditorForm.TargetFromNode(N: TTreeNode
): TPGCompileTarget;
begin
if (N<>Nil) and (N.Data<>Nil) then
Result:=TNodeData(N.Data).Target
else
Result:=Nil;
end;
end.