Skip to content

Commit 21a0e40

Browse files
rvelthuisrvelthuis
committedMar 4, 2018
First commit
0 parents  commit 21a0e40

8 files changed

+1041
-0
lines changed
 

‎.gitignore

+2
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
*.dcu
2+
*.dproj.local

‎AddAutoSuffixProjectMenu.pas

+116
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
unit AddAutoSuffixProjectMenu;
2+
3+
interface
4+
5+
procedure Register;
6+
7+
implementation
8+
9+
uses
10+
ToolsAPI, System.SysUtils, System.Classes, Vcl.Dialogs, OpenTools.LocalMenus;
11+
12+
const
13+
CInvalidNotifier = -1;
14+
15+
type
16+
TAutoSuffixContextMenu = class(TNotifierObject, IOTANotifier, IOTAProjectMenuItemCreatorNotifier)
17+
procedure AddMenu(const Project: IOTAProject; const IdentList: TStrings;
18+
const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
19+
end;
20+
21+
TAutoSuffixLocalMenu = class(TLocalMenuBase, IOTAProjectManagerMenu)
22+
// IOTAProjectManagerMenu
23+
function GetIsMultiSelectable: Boolean;
24+
procedure SetIsMultiSelectable(Value: Boolean);
25+
procedure Execute(const MenuContextList: IInterfaceList); overload;
26+
function PreExecute(const MenuContextList: IInterfaceList): Boolean;
27+
function PostExecute(const MenuContextList: IInterfaceList): Boolean;
28+
property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
29+
end;
30+
31+
var
32+
FNotifierIndex: Integer;
33+
34+
{ TAutoSuffixContextMenu }
35+
36+
procedure TAutoSuffixContextMenu.AddMenu(const Project: IOTAProject; const IdentList: TStrings;
37+
const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
38+
var
39+
LMenu: TAutoSuffixLocalMenu;
40+
begin
41+
if (Project.ApplicationType = sPackage) and (not IsMultiSelect) and Assigned(Project) and (IdentList.IndexOf(sProjectContainer) <> -1) and
42+
Assigned(ProjectManagerMenuList) then
43+
begin
44+
LMenu := TAutoSuffixLocalMenu.Create;
45+
LMenu.Caption := 'Add Version Suffix';
46+
LMenu.Enabled := True;
47+
LMenu.Position := pmmpUserRename;
48+
ProjectManagerMenuList.Add(LMenu)
49+
end;
50+
end;
51+
52+
{ TAutoSuffixContextMenuLocal }
53+
54+
procedure TAutoSuffixLocalMenu.Execute(const MenuContextList: IInterfaceList);
55+
var
56+
LMenuContext: IOTAProjectMenuContext;
57+
LProject: IOTAProject;
58+
LProjectOptions: IOTAProjectOptions;
59+
LAutoSuffix: string;
60+
LOffset: Integer;
61+
begin
62+
if RTLVersion <= 20.0 then
63+
LOffset := 8
64+
else
65+
LOffset := 7;
66+
LAutoSuffix := IntToStr(10 * (Trunc(RTLVersion) - LOffset)); // Should work for most versions.
67+
LMenuContext := MenuContextList.Items[0] as IOTAProjectMenuContext;
68+
LProject := LMenuContext.Project;
69+
if LProject.ApplicationType <> sPackage then
70+
Exit;
71+
72+
73+
LProjectOptions := LProject.GetProjectOptions;
74+
LProjectOptions.SetOptionValue('SOSuffix', LAutoSuffix);
75+
ShowMessageFmt('Suffix set to ''%s''', [LAutoSuffix]);
76+
end;
77+
78+
function TAutoSuffixLocalMenu.GetIsMultiSelectable: Boolean;
79+
begin
80+
Result := False;
81+
end;
82+
83+
function TAutoSuffixLocalMenu.PostExecute(const MenuContextList: IInterfaceList): Boolean;
84+
begin
85+
Result := True;
86+
end;
87+
88+
function TAutoSuffixLocalMenu.PreExecute(const MenuContextList: IInterfaceList): Boolean;
89+
begin
90+
Result := True;
91+
end;
92+
93+
procedure TAutoSuffixLocalMenu.SetIsMultiSelectable(Value: Boolean);
94+
begin
95+
// stub implementation.
96+
end;
97+
98+
procedure Register;
99+
begin
100+
FNotifierIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuItemCreatorNotifier
101+
(TAutoSuffixContextMenu.Create);
102+
end;
103+
104+
initialization
105+
106+
FNotifierIndex := CInvalidNotifier;
107+
108+
finalization
109+
110+
if FNotifierIndex > CInvalidNotifier then
111+
begin
112+
(BorlandIDEServices as IOTAProjectManager).RemoveMenuItemCreatorNotifier(FNotifierIndex);
113+
FNotifierIndex := CInvalidNotifier;
114+
end;
115+
116+
end.

‎AutoSuffix.dpk

+40
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
package AutoSuffix;
2+
3+
{$R *.res}
4+
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
5+
{$ALIGN 8}
6+
{$ASSERTIONS ON}
7+
{$BOOLEVAL OFF}
8+
{$DEBUGINFO OFF}
9+
{$EXTENDEDSYNTAX ON}
10+
{$IMPORTEDDATA ON}
11+
{$IOCHECKS ON}
12+
{$LOCALSYMBOLS ON}
13+
{$LONGSTRINGS ON}
14+
{$OPENSTRINGS ON}
15+
{$OPTIMIZATION ON}
16+
{$OVERFLOWCHECKS OFF}
17+
{$RANGECHECKS OFF}
18+
{$REFERENCEINFO ON}
19+
{$SAFEDIVIDE OFF}
20+
{$STACKFRAMES OFF}
21+
{$TYPEDADDRESS OFF}
22+
{$VARSTRINGCHECKS ON}
23+
{$WRITEABLECONST OFF}
24+
{$MINENUMSIZE 1}
25+
{$IMAGEBASE $400000}
26+
{$DEFINE DEBUG}
27+
{$ENDIF IMPLICITBUILDING}
28+
{$DESCRIPTION 'Velthuis.AutoSuffix: Automatically add suffix to package project'}
29+
{$LIBSUFFIX '250'}
30+
{$IMPLICITBUILD ON}
31+
32+
requires
33+
designide,
34+
rtl;
35+
36+
contains
37+
AddAutoSuffixProjectMenu in 'AddAutoSuffixProjectMenu.pas',
38+
OpenTools.LocalMenus in 'OpenTools.LocalMenus.pas';
39+
40+
end.

‎AutoSuffix.dproj

+595
Large diffs are not rendered by default.

‎AutoSuffix.res

6.39 KB
Binary file not shown.

‎OpenTools.LocalMenus.pas

+132
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
unit OpenTools.LocalMenus;
2+
3+
interface
4+
5+
uses
6+
ToolsAPI, System.Classes;
7+
8+
type
9+
TLocalMenuBase = class(TNotifierObject, IOTALocalMenu)
10+
private
11+
FCaption: string;
12+
FChecked: Boolean;
13+
FEnabled: Boolean;
14+
FHelpContext: Integer;
15+
FName: string;
16+
FParent: string;
17+
FPosition: Integer;
18+
FVerb: string;
19+
FOnExecute: TNotifyEvent;
20+
public
21+
// IOTALocalMenu
22+
function GetCaption: string;
23+
function GetChecked: Boolean;
24+
function GetEnabled: Boolean;
25+
function GetHelpContext: Integer;
26+
function GetName: string;
27+
function GetParent: string;
28+
function GetPosition: Integer;
29+
function GetVerb: string;
30+
procedure SetCaption(const Value: string);
31+
procedure SetChecked(Value: Boolean);
32+
procedure SetEnabled(Value: Boolean);
33+
procedure SetHelpContext(Value: Integer);
34+
procedure SetName(const Value: string);
35+
procedure SetParent(const Value: string);
36+
procedure SetPosition(Value: Integer);
37+
procedure SetVerb(const Value: string);
38+
39+
property Caption: string read GetCaption write SetCaption;
40+
property Checked: Boolean read GetChecked write SetChecked;
41+
property Enabled: Boolean read GetEnabled write SetEnabled;
42+
property HelpContext: Integer read GetHelpContext write SetHelpContext;
43+
property Name: string read GetName write SetName;
44+
property Parent: string read GetParent write SetParent;
45+
property Position: Integer read GetPosition write SetPosition;
46+
property Verb: string read GetVerb write SetVerb;
47+
property OnExute: TNotifyEvent read FOnExecute write FOnExecute;
48+
end;
49+
50+
implementation
51+
52+
function TLocalMenuBase.GetCaption: string;
53+
begin
54+
Result := FCaption;
55+
end;
56+
57+
function TLocalMenuBase.GetChecked: Boolean;
58+
begin
59+
Result := FChecked;
60+
end;
61+
62+
function TLocalMenuBase.GetEnabled: Boolean;
63+
begin
64+
Result := FEnabled;
65+
end;
66+
67+
function TLocalMenuBase.GetHelpContext: Integer;
68+
begin
69+
Result := FHelpContext;
70+
end;
71+
72+
function TLocalMenuBase.GetName: string;
73+
begin
74+
Result := FName;
75+
end;
76+
77+
function TLocalMenuBase.GetParent: string;
78+
begin
79+
Result := FParent;
80+
end;
81+
82+
function TLocalMenuBase.GetPosition: Integer;
83+
begin
84+
Result := FPosition;
85+
end;
86+
87+
function TLocalMenuBase.GetVerb: string;
88+
begin
89+
Result := FVerb;
90+
end;
91+
92+
procedure TLocalMenuBase.SetCaption(const Value: string);
93+
begin
94+
FCaption := Value;
95+
end;
96+
97+
procedure TLocalMenuBase.SetChecked(Value: Boolean);
98+
begin
99+
FChecked := Value;
100+
end;
101+
102+
procedure TLocalMenuBase.SetEnabled(Value: Boolean);
103+
begin
104+
FEnabled := Value;
105+
end;
106+
107+
procedure TLocalMenuBase.SetHelpContext(Value: Integer);
108+
begin
109+
FHelpContext := Value;
110+
end;
111+
112+
procedure TLocalMenuBase.SetName(const Value: string);
113+
begin
114+
FName := Value;
115+
end;
116+
117+
procedure TLocalMenuBase.SetParent(const Value: string);
118+
begin
119+
FParent := Value;
120+
end;
121+
122+
procedure TLocalMenuBase.SetPosition(Value: Integer);
123+
begin
124+
FPosition := Value;
125+
end;
126+
127+
procedure TLocalMenuBase.SetVerb(const Value: string);
128+
begin
129+
FVerb := Value;
130+
end;
131+
132+
end.

‎__history/AddAutoSuffixProjectMenu.pas.~1~

+116
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
unit AddAutoSuffixProjectMenu;
2+
3+
interface
4+
5+
procedure Register;
6+
7+
implementation
8+
9+
uses
10+
ToolsAPI, System.SysUtils, System.Classes, Vcl.Dialogs, OpenTools.LocalMenus;
11+
12+
const
13+
CInvalidNotifier = -1;
14+
15+
type
16+
TAutoSuffixContextMenu = class(TNotifierObject, IOTANotifier, IOTAProjectMenuItemCreatorNotifier)
17+
procedure AddMenu(const Project: IOTAProject; const IdentList: TStrings;
18+
const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
19+
end;
20+
21+
TAutoSuffixLocalMenu = class(TLocalMenuBase, IOTAProjectManagerMenu)
22+
// IOTAProjectManagerMenu
23+
function GetIsMultiSelectable: Boolean;
24+
procedure SetIsMultiSelectable(Value: Boolean);
25+
procedure Execute(const MenuContextList: IInterfaceList); overload;
26+
function PreExecute(const MenuContextList: IInterfaceList): Boolean;
27+
function PostExecute(const MenuContextList: IInterfaceList): Boolean;
28+
property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
29+
end;
30+
31+
var
32+
FNotifierIndex: Integer;
33+
34+
{ TAutoSuffixContextMenu }
35+
36+
procedure TAutoSuffixContextMenu.AddMenu(const Project: IOTAProject; const IdentList: TStrings;
37+
const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
38+
var
39+
LMenu: TAutoSuffixLocalMenu;
40+
begin
41+
if (Project.ApplicationType = sPackage) and (not IsMultiSelect) and Assigned(Project) and (IdentList.IndexOf(sProjectContainer) <> -1) and
42+
Assigned(ProjectManagerMenuList) then
43+
begin
44+
LMenu := TAutoSuffixLocalMenu.Create;
45+
LMenu.Caption := 'Add Version Suffix';
46+
LMenu.Enabled := True;
47+
LMenu.Position := pmmpUserRename;
48+
ProjectManagerMenuList.Add(LMenu)
49+
end;
50+
end;
51+
52+
{ TAutoSuffixContextMenuLocal }
53+
54+
procedure TAutoSuffixLocalMenu.Execute(const MenuContextList: IInterfaceList);
55+
var
56+
LMenuContext: IOTAProjectMenuContext;
57+
LProject: IOTAProject;
58+
LProjectOptions: IOTAProjectOptions;
59+
LAutoSuffix: string;
60+
LOffset: Integer;
61+
begin
62+
if RTLVersion <= 20.0 then
63+
LOffset := 8
64+
else
65+
LOffset := 7;
66+
LAutoSuffix := IntToStr(10 * (Trunc(RTLVersion) - LOffset)); // Should work for most versions.
67+
LMenuContext := MenuContextList.Items[0] as IOTAProjectMenuContext;
68+
LProject := LMenuContext.Project;
69+
if LProject.ApplicationType <> sPackage then
70+
Exit;
71+
72+
73+
LProjectOptions := LProject.GetProjectOptions;
74+
LProjectOptions.SetOptionValue('SOSuffix', LAutoSuffix);
75+
ShowMessageFmt('Suffix set to ''%s''', [LAutoSuffix]);
76+
end;
77+
78+
function TAutoSuffixLocalMenu.GetIsMultiSelectable: Boolean;
79+
begin
80+
Result := False;
81+
end;
82+
83+
function TAutoSuffixLocalMenu.PostExecute(const MenuContextList: IInterfaceList): Boolean;
84+
begin
85+
Result := True;
86+
end;
87+
88+
function TAutoSuffixLocalMenu.PreExecute(const MenuContextList: IInterfaceList): Boolean;
89+
begin
90+
Result := True;
91+
end;
92+
93+
procedure TAutoSuffixLocalMenu.SetIsMultiSelectable(Value: Boolean);
94+
begin
95+
// stub implementation.
96+
end;
97+
98+
procedure Register;
99+
begin
100+
FNotifierIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuItemCreatorNotifier
101+
(TAutoSuffixContextMenu.Create);
102+
end;
103+
104+
initialization
105+
106+
FNotifierIndex := CInvalidNotifier;
107+
108+
finalization
109+
110+
if FNotifierIndex > CInvalidNotifier then
111+
begin
112+
(BorlandIDEServices as IOTAProjectManager).RemoveMenuItemCreatorNotifier(FNotifierIndex);
113+
FNotifierIndex := CInvalidNotifier;
114+
end;
115+
116+
end.

‎__history/AutoSuffix.dpk.~1~

+40
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
package AutoSuffix;
2+
3+
{$R *.res}
4+
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
5+
{$ALIGN 8}
6+
{$ASSERTIONS ON}
7+
{$BOOLEVAL OFF}
8+
{$DEBUGINFO OFF}
9+
{$EXTENDEDSYNTAX ON}
10+
{$IMPORTEDDATA ON}
11+
{$IOCHECKS ON}
12+
{$LOCALSYMBOLS ON}
13+
{$LONGSTRINGS ON}
14+
{$OPENSTRINGS ON}
15+
{$OPTIMIZATION ON}
16+
{$OVERFLOWCHECKS OFF}
17+
{$RANGECHECKS OFF}
18+
{$REFERENCEINFO ON}
19+
{$SAFEDIVIDE OFF}
20+
{$STACKFRAMES OFF}
21+
{$TYPEDADDRESS OFF}
22+
{$VARSTRINGCHECKS ON}
23+
{$WRITEABLECONST OFF}
24+
{$MINENUMSIZE 1}
25+
{$IMAGEBASE $400000}
26+
{$DEFINE DEBUG}
27+
{$ENDIF IMPLICITBUILDING}
28+
{$DESCRIPTION 'Velthuis.AutoSuffix: Automatically add suffix to package project'}
29+
{$LIBSUFFIX '250'}
30+
{$IMPLICITBUILD ON}
31+
32+
requires
33+
designide,
34+
rtl;
35+
36+
contains
37+
AddAutoSuffixProjectMenu in '..\..\Extending the Delphi XE IDE\ProjMenu\AddAutoSuffixProjectMenu.pas',
38+
OpenTools.LocalMenus in '..\..\Extending the Delphi XE IDE\ProjMenu\OpenTools.LocalMenus.pas';
39+
40+
end.

0 commit comments

Comments
 (0)
Please sign in to comment.