Menu
▾
▴
jcl-checkins-diff — SVN file check-in notifications with file differences included
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
|
Mar
|
Apr
(20) |
May
(48) |
Jun
(8) |
Jul
(23) |
Aug
(41) |
Sep
(42) |
Oct
(22) |
Nov
(17) |
Dec
(36) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
(43) |
Feb
(42) |
Mar
(17) |
Apr
(39) |
May
(16) |
Jun
(35) |
Jul
(37) |
Aug
(47) |
Sep
(49) |
Oct
(9) |
Nov
(52) |
Dec
(37) |
| 2008 |
Jan
(48) |
Feb
(21) |
Mar
(7) |
Apr
(2) |
May
(5) |
Jun
(17) |
Jul
(17) |
Aug
(40) |
Sep
(58) |
Oct
(38) |
Nov
(19) |
Dec
(32) |
| 2009 |
Jan
(67) |
Feb
(46) |
Mar
(54) |
Apr
(34) |
May
(37) |
Jun
(52) |
Jul
(67) |
Aug
(72) |
Sep
(48) |
Oct
(35) |
Nov
(27) |
Dec
(12) |
| 2010 |
Jan
(56) |
Feb
(46) |
Mar
(19) |
Apr
(14) |
May
(21) |
Jun
(3) |
Jul
(13) |
Aug
(48) |
Sep
(34) |
Oct
(51) |
Nov
(16) |
Dec
(32) |
| 2011 |
Jan
(36) |
Feb
(14) |
Mar
(12) |
Apr
(3) |
May
(5) |
Jun
(24) |
Jul
(15) |
Aug
(30) |
Sep
(21) |
Oct
(4) |
Nov
(25) |
Dec
(23) |
| 2012 |
Jan
(45) |
Feb
(42) |
Mar
(19) |
Apr
(14) |
May
(13) |
Jun
(7) |
Jul
(3) |
Aug
(46) |
Sep
(21) |
Oct
(10) |
Nov
(2) |
Dec
|
| 2013 |
Jan
(5) |
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <usc...@us...> - 2007-12-30 13:17:57
|
Revision: 2287
http://jcl.svn.sourceforge.net/jcl/?rev=2287&view=rev
Author: uschuster
Date: 2007-12-30 05:17:56 -0800 (Sun, 30 Dec 2007)
Log Message:
-----------
fixed extraction of some selected files of a solid archive (Mantis #4324)
(Mantis #4324)
Modified Paths:
--------------
branches/compression/jcl/source/common/JclCompression.pas
Modified: branches/compression/jcl/source/common/JclCompression.pas
===================================================================
--- branches/compression/jcl/source/common/JclCompression.pas 2007-12-30 12:55:48 UTC (rev 2286)
+++ branches/compression/jcl/source/common/JclCompression.pas 2007-12-30 13:17:56 UTC (rev 2287)
@@ -3242,7 +3242,7 @@
destructor TJclSevenzipOutStream.Destroy;
begin
ReleaseStream;
-
+
inherited Destroy;
end;
@@ -4048,6 +4048,14 @@
begin
FLastStream := Index;
+ Assert(askExtractMode in [kExtract, kTest, kSkip]);
+
+ if askExtractMode in [kTest, kSkip] then
+ begin
+ OutStream := nil;
+ Result := S_OK;
+ end
+ else
if FArchive.Items[Index].ValidateExtraction(Index) then
begin
OutStream := TJclSevenzipOutStream.Create(FArchive, Index);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-30 12:55:50
|
Revision: 2286
http://jcl.svn.sourceforge.net/jcl/?rev=2286&view=rev
Author: outchy
Date: 2007-12-30 04:55:48 -0800 (Sun, 30 Dec 2007)
Log Message:
-----------
some cleaning: elimination of useless loops.
Modified Paths:
--------------
trunk/jcl/experts/versioncontrol/VersionControlImpl.pas
Modified: trunk/jcl/experts/versioncontrol/VersionControlImpl.pas
===================================================================
--- trunk/jcl/experts/versioncontrol/VersionControlImpl.pas 2007-12-29 19:42:35 UTC (rev 2285)
+++ trunk/jcl/experts/versioncontrol/VersionControlImpl.pas 2007-12-30 12:55:48 UTC (rev 2286)
@@ -21,7 +21,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -81,6 +81,20 @@
TJclVersionControlActions = set of TJclVersionControlAction;
+ TJclVersionControlStandardAction = class(TCustomAction)
+ private
+ FControlAction: TJclVersionControlAction;
+ public
+ property ControlAction: TJclVersionControlAction read FControlAction write FControlAction;
+ end;
+
+ TJclVersionControlDropDownAction = class(TDropDownAction)
+ private
+ FControlAction: TJclVersionControlAction;
+ public
+ property ControlAction: TJclVersionControlAction read FControlAction write FControlAction;
+ end;
+
TJclVersionControlExpert = class;
TJclVersionControlPlugin = class
@@ -502,6 +516,17 @@
Result := 0;
end;
+function ActionToControlAction(AAction: TCustomAction): TJclVersionControlAction;
+begin
+ if AAction is TJclVersionControlDropDownAction then
+ Result := TJclVersionControlDropDownAction(AAction).ControlAction
+ else
+ if AAction is TJclVersionControlStandardAction then
+ Result := TJclVersionControlStandardAction(AAction).ControlAction
+ else
+ raise EJclExpertException.CreateTrace('Internal error: invalid action');
+end;
+
type
TJclVersionControlActionRec = record
Sandbox: Boolean;
@@ -783,72 +808,69 @@
var
Index: Integer;
AAction: TCustomAction;
- AControlAction: TJclVersionControlAction;
+ ControlAction: TJclVersionControlAction;
APlugin: TJclVersionControlPlugin;
AFileName: string;
AFileCache: TJclVersionControlCache;
begin
try
AAction := Sender as TCustomAction;
- for AControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do
- if FActions[AControlAction] = AAction then
+ ControlAction := ActionToControlAction(AAction);
+
+ if VersionControlActionInfos[ControlAction].Sandbox then
begin
- if VersionControlActionInfos[AControlAction].Sandbox then
+ AFileCache := CurrentCache;
+ if not Assigned(AFileCache) or VersionControlActionInfos[ControlAction].AllPlugins then
+ Exit;
+ if ActOnTopSandbox then
begin
- AFileCache := CurrentCache;
- if not Assigned(AFileCache) or VersionControlActionInfos[AControlAction].AllPlugins then
+ for Index := AFileCache.SandboxCount - 1 downto 0 do
+ if ControlAction in AFileCache.SandboxActions[Index] then
+ begin
+ if VersionControlActionInfos[ControlAction].SaveFile then
+ SaveModules(AFileCache.SandBoxes[Index], True);
+ AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
Exit;
- if ActOnTopSandbox then
+ end;
+ end
+ else
+ begin
+ for Index := 0 to AFileCache.SandboxCount - 1 do
+ if ControlAction in AFileCache.SandboxActions[Index] then
begin
- for Index := AFileCache.SandboxCount - 1 downto 0 do
- if AControlAction in AFileCache.SandboxActions[Index] then
- begin
- if VersionControlActionInfos[AControlAction].SaveFile then
- SaveModules(AFileCache.SandBoxes[Index], True);
- AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], AControlAction);
- Exit;
- end;
- end
- else
+ if VersionControlActionInfos[ControlAction].SaveFile then
+ SaveModules(AFileCache.SandBoxes[Index], True);
+ AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
+ Exit;
+ end;
+ end;
+ end
+ else
+ begin
+ AFileName := CurrentFileName;
+ if VersionControlActionInfos[ControlAction].SaveFile then
+ SaveModules(AFileName, False);
+
+ if VersionControlActionInfos[ControlAction].AllPlugins then
+ begin
+ for Index := 0 to FPluginList.Count - 1 do
begin
- for Index := 0 to AFileCache.SandboxCount - 1 do
- if AControlAction in AFileCache.SandboxActions[Index] then
+ AFileCache := GetFileCache(AFileName,
+ TJclVersionControlPlugin(FPluginList.Items[Index]));
+
+ if ControlAction in AFileCache.Actions then
begin
- if VersionControlActionInfos[AControlAction].SaveFile then
- SaveModules(AFileCache.SandBoxes[Index], True);
- AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], AControlAction);
+ AFileCache.Plugin.ExecuteAction(AFileName, ControlAction);
Exit;
end;
end;
end
else
begin
- AFileName := CurrentFileName;
- if VersionControlActionInfos[AControlAction].SaveFile then
- SaveModules(AFileName, False);
-
- if VersionControlActionInfos[AControlAction].AllPlugins then
- begin
- for Index := 0 to FPluginList.Count - 1 do
- begin
- AFileCache := GetFileCache(AFileName,
- TJclVersionControlPlugin(FPluginList.Items[Index]));
-
- if AControlAction in AFileCache.Actions then
- begin
- AFileCache.Plugin.ExecuteAction(AFileName, AControlAction);
- Exit;
- end;
- end;
- end
- else
- begin
- APlugin := CurrentPlugin;
- if Assigned(APlugin) then
- APlugin.ExecuteAction(AFileName, AControlAction);
- end;
+ APlugin := CurrentPlugin;
+ if Assigned(APlugin) then
+ APlugin.ExecuteAction(AFileName, ControlAction);
end;
- Exit;
end;
except
on ExceptionObj: TObject do
@@ -863,14 +885,15 @@
var
IndexSandbox, IndexPlugin: Integer;
AAction: TCustomAction;
- AControlAction: TJclVersionControlAction;
+ ControlAction: TJclVersionControlAction;
AFileCache: TJclVersionControlCache;
AFileName: string;
begin
try
AAction := Sender as TCustomAction;
+ ControlAction := ActionToControlAction(AAction);
AFileCache := CurrentCache;
-
+
if IconType = -1 then
begin
if Assigned(AFileCache) then
@@ -879,83 +902,79 @@
FLastPlugin := nil;
RefreshIcon(AAction);
end;
-
- for AControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do
- if FActions[AControlAction] = AAction then
+
+ if HideActions and not VersionControlActionInfos[ControlAction].AllPlugins then
+ AAction.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
+ and (ControlAction in AFileCache.Plugin.SupportActions)
+ else
+ AAction.Visible := True;
+
+ if DisableActions then
begin
- if HideActions and not VersionControlActionInfos[AControlAction].AllPlugins then
- AAction.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
- and (AControlAction in AFileCache.Plugin.SupportActions)
- else
- AAction.Visible := True;
-
- if DisableActions then
+ if VersionControlActionInfos[ControlAction].Sandbox then
begin
- if VersionControlActionInfos[AControlAction].Sandbox then
+ if VersionControlActionInfos[ControlAction].AllPlugins then
begin
- if VersionControlActionInfos[AControlAction].AllPlugins then
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to FPluginList.Count - 1 do
begin
- AFileName := CurrentFileName;
- for IndexPlugin := 0 to FPluginList.Count - 1 do
+ AFileCache := GetFileCache(AFileName,
+ TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]));
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
begin
- AFileCache := GetFileCache(AFileName,
- TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]));
- for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
- if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then
- begin
- AAction.Enabled := True;
- Exit;
- end;
- AAction.Enabled := False;
+ AAction.Enabled := True;
Exit;
end;
- end
- else // work for all plugin
- begin
- if Assigned(AFileCache) then
- begin
- for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
- if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then
- begin
- AAction.Enabled := True;
- Exit;
- end;
- AAction.Enabled := False;
- Exit;
- end
- else
- AAction.Enabled := False;
+ AAction.Enabled := False;
+ Exit;
end;
- Exit;
end
- else // file
+ else // work for all plugin
begin
- if VersionControlActionInfos[AControlAction].AllPlugins then
+ if Assigned(AFileCache) then
begin
- AFileName := CurrentFileName;
- for IndexPlugin := 0 to FPluginList.Count - 1 do
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
begin
- AFileCache := GetFileCache(AFileName,
- TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]));
- if AControlAction in AFileCache.Actions then
- begin
- AAction.Enabled := True;
- Exit;
- end;
+ AAction.Enabled := True;
+ Exit;
end;
AAction.Enabled := False;
Exit;
end
- else // only the current plugin
+ else
+ AAction.Enabled := False;
+ end;
+ Exit;
+ end
+ else // file
+ begin
+ if VersionControlActionInfos[ControlAction].AllPlugins then
+ begin
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to FPluginList.Count - 1 do
begin
- AFileCache := CurrentCache;
- AAction.Enabled := Assigned(AFileCache) and (AControlAction in AFileCache.Actions);
+ AFileCache := GetFileCache(AFileName,
+ TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]));
+ if ControlAction in AFileCache.Actions then
+ begin
+ AAction.Enabled := True;
+ Exit;
+ end;
end;
+ AAction.Enabled := False;
+ Exit;
+ end
+ else // only the current plugin
+ begin
+ AFileCache := CurrentCache;
+ AAction.Enabled := Assigned(AFileCache) and (ControlAction in AFileCache.Actions);
end;
- end
- else
- AAction.Enabled := True;
- end;
+ end;
+ end
+ else
+ AAction.Enabled := True;
except
on ExceptionObj: TObject do
begin
@@ -1480,49 +1499,45 @@
procedure TJclVersionControlExpert.RefreshIcon(const AAction: TCustomAction);
var
- ControlAction: TJclVersionControlAction;
+ AControlAction: TJclVersionControlAction;
IndexPlugin: Integer;
begin
if not Assigned(AAction) then
Exit;
- for ControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do
- if FActions[ControlAction] = AAction then
- begin
- case IconType of
- // No icon
- -3 :
- AAction.ImageIndex := -1;
- // JCL icons
- // TODO: create resources
- -2 :
- AAction.ImageIndex := -1;
- // auto icons
- -1 :
- if VersionControlActionInfos[ControlAction].AllPlugins then
+ AControlAction := ActionToControlAction(AAction);
+ case IconType of
+ // No icon
+ -3 :
+ AAction.ImageIndex := -1;
+ // JCL icons
+ // TODO: create resources
+ -2 :
+ AAction.ImageIndex := -1;
+ // auto icons
+ -1 :
+ if VersionControlActionInfos[AControlAction].AllPlugins then
+ begin
+ for IndexPlugin := 0 to FPluginList.Count - 1 do
begin
- for IndexPlugin := 0 to FPluginList.Count - 1 do
- begin
- AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]).Icons[ControlAction];
- if AAction.ImageIndex > -1 then
- Break;
- end;
- end
- else
- begin
- if Assigned(FLastPlugin) then
- AAction.ImageIndex := FLastPlugin.GetIcon(ControlAction)
- else
- AAction.ImageIndex := -1;
+ AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]).Icons[AControlAction];
+ if AAction.ImageIndex > -1 then
+ Break;
end;
- // Specific icons
- 0..High(Integer) :
- if IconType < FPluginList.Count then
- AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IconType]).Icons[ControlAction]
+ end
+ else
+ begin
+ if Assigned(FLastPlugin) then
+ AAction.ImageIndex := FLastPlugin.GetIcon(AControlAction)
else
AAction.ImageIndex := -1;
- end;
- Exit;
+ end;
+ // Specific icons
+ 0..High(Integer) :
+ if IconType < FPluginList.Count then
+ AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IconType]).Icons[AControlAction]
+ else
+ AAction.ImageIndex := -1;
end;
end;
@@ -1682,8 +1697,9 @@
IDEToolsItem: TMenuItem;
IDEActionList: TCustomActionList;
I: Integer;
+ AStandardAction: TJclVersionControlStandardAction;
+ ADropDownAction: TJclVersionControlDropDownAction;
AAction: TCustomAction;
- ADropDownAction: TDropDownAction;
IconTypeStr: string;
ControlAction: TJclVersionControlAction;
begin
@@ -1732,7 +1748,8 @@
begin
if VersionControlActionInfos[ControlAction].Sandbox then
begin
- ADropDownAction := TDropDownAction.Create(nil);
+ ADropDownAction := TJclVersionControlDropDownAction.Create(nil);
+ ADropDownAction.ControlAction := ControlAction;
ADropDownAction.DropdownMenu := TPopupMenu.Create(nil);
ADropDownAction.DropdownMenu.AutoPopup := True;
ADropDownAction.DropdownMenu.AutoHotkeys := maManual;
@@ -1741,7 +1758,11 @@
AAction := ADropDownAction;
end
else
- AAction := TAction.Create(nil);
+ begin
+ AStandardAction := TJclVersionControlStandardAction.Create(nil);
+ AStandardAction.ControlAction := ControlAction;
+ AAction := AStandardAction;
+ end;
AAction.Caption := VersionControlActionInfos[ControlAction].Caption;
AAction.Name := VersionControlActionInfos[ControlAction].ActionName;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-29 19:42:39
|
Revision: 2285
http://jcl.svn.sourceforge.net/jcl/?rev=2285&view=rev
Author: outchy
Date: 2007-12-29 11:42:35 -0800 (Sat, 29 Dec 2007)
Log Message:
-----------
Minor style cleaning: renaming name of constant for project analyzer and others.
Refactoring of the declaration of ProjectManager to be shared by design-time experts.
Implementation of a context menu item in the project manager for the project analyzer expert.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaConsts.pas
trunk/jcl/experts/common/JclOtaResources.pas
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-29 18:25:43 UTC (rev 2284)
+++ trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-29 19:42:35 UTC (rev 2285)
@@ -121,7 +121,7 @@
JclIniFileLocation = 'experts\useswizard\JediUsesWizard.ini';
//=== Project analyser =====================================================
- JclProjectAnalyserExpertName = 'JclProjectAnalyzerExpert';
+ JclProjectAnalyzerExpertName = 'JclProjectAnalyzerExpert';
AnalyzerViewName = 'AnalyzerView';
JclProjectAnalyzeActionName = 'JCLProjectAnalyseCommand';
JclProjectAnalyzeMenuName = 'JCLProjectAnalyseMenu';
Modified: trunk/jcl/experts/common/JclOtaResources.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaResources.pas 2007-12-29 18:25:43 UTC (rev 2284)
+++ trunk/jcl/experts/common/JclOtaResources.pas 2007-12-29 19:42:35 UTC (rev 2285)
@@ -20,7 +20,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -44,6 +44,7 @@
RsENoWizardServices = 'Unable to get Borland Wizard Services';
RsENoPackageServices = 'Unable to get Borland Package Services';
RsENoPersonalityServices = 'Unable to get Borland Personality Services';
+ RsENoProjectManager = 'Unable to get project manager';
RsENoMessageServices = 'Unable to get Borland Message Services';
RsENoGalleryCategoryManager = 'Unable to get Borland Gallery Category Manager';
RsENoModule = 'Unable to get Module';
@@ -250,7 +251,6 @@
RsENoProjectGroup = 'No project group';
RsDebugConfigPageCaption = 'Debug info converter';
RsEInvalidDebugExpertAction = '%d is not a debug expert action';
- RsENoProjectManager = 'Unable to get project manager';
//=== JclDebugIdeConfigFrame.pas =============================================
resourcestring
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-29 18:25:43 UTC (rev 2284)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-29 19:42:35 UTC (rev 2285)
@@ -140,6 +140,9 @@
{$IFDEF BDS}
FOTAPersonalityServices: IOTAPersonalityServices;
{$ENDIF BDS}
+ {$IFDEF BDS4_UP}
+ FProjectManager: IOTAProjectManager;
+ {$ENDIF BDS4_UP}
FOTAMessageServices: IOTAMessageServices;
function GetModuleHInstance: Cardinal;
function GetActiveProject: IOTAProject;
@@ -193,6 +196,9 @@
{$IFDEF BDS}
property OTAPersonalityServices: IOTAPersonalityServices read FOTAPersonalityServices;
{$ENDIF BDS}
+ {$IFDEF BDS4_UP}
+ property ProjectManager: IOTAProjectManager read FProjectManager;
+ {$ENDIF BDS4_UP}
property OTAMessageServices: IOTAMessageServices read FOTAMessageServices;
property ActivePersonality: TJclBorPersonality read GetActivePersonality;
@@ -862,6 +868,11 @@
raise EJclExpertException.CreateTrace(RsENoPersonalityServices);
{$ENDIF BDS}
+ {$IFDEF BDS4_UP}
+ if not Supports(BorlandIDEServices, IOTAProjectManager, FProjectManager) then
+ raise EJclExpertException.CreateRes(@RsENoProjectManager);
+ {$ENDIF BDS4_UP}
+
Supports(BorlandIDEServices, IOTAModuleServices, FOTAModuleServices);
if not Assigned(FOTAModuleServices) then
raise EJclExpertException.CreateTrace(RsENoModuleServices);
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-29 18:25:43 UTC (rev 2284)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-29 19:42:35 UTC (rev 2285)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -75,7 +75,6 @@
FSaveBuildAllProjectsActionExecute: TNotifyEvent;
FIDENotifierIndex: Integer;
{$IFDEF BDS4_UP}
- ProjectManager: IOTAProjectManager;
FProjectManagerNotifierIndex: Integer;
{$ENDIF BDS4_UP}
FConfigFrame: TJclDebugIdeConfigFrame;
@@ -285,10 +284,6 @@
constructor TJclDebugExtension.Create;
begin
inherited Create(JclDebugExpertRegKey);
- {$IFDEF BDS4_UP}
- if not Supports(BorlandIDEServices, IOTAProjectManager, ProjectManager) then
- raise EJclExpertException.CreateRes(@RsENoProjectManager);
- {$ENDIF BDS4_UP}
end;
procedure TJclDebugExtension.AddConfigurationPages(
@@ -1508,6 +1503,8 @@
{$IFDEF BDS4_UP}
+//=== { TProjectManagerNotifier } ============================================
+
constructor TProjectManagerNotifier.Create(ADebugExtension: TJclDebugExtension;
const ANTAServices: INTAServices; const AOTAProjectManager: IOTAProjectManager);
begin
Modified: trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
===================================================================
--- trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 18:25:43 UTC (rev 2284)
+++ trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 19:42:35 UTC (rev 2285)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -38,8 +38,12 @@
private
FBuildMenuItem: TMenuItem;
FBuildAction: TAction;
+ {$IFDEF BDS4_UP}
+ FProjectManagerNotifierIndex: Integer;
+ {$ENDIF BDS4_UP}
procedure ActionExecute(Sender: TObject);
procedure ActionUpdate(Sender: TObject);
+ procedure AnalyzeProject(const AProject: IOTAProject);
public
constructor Create; reintroduce;
destructor Destroy; override;
@@ -47,6 +51,21 @@
procedure UnregisterCommands; override;
end;
+ {$IFDEF BDS4_UP}
+ TProjectManagerNotifier = class(TNotifierObject, IOTANotifier, INTAProjectMenuCreatorNotifier)
+ private
+ FProjectAnalyser: TJclProjectAnalyzerExpert;
+ FOTAProjectManager: IOTAProjectManager;
+ procedure AnalyzeProjectMenuClick(Sender: TObject);
+ protected
+ { INTAProjectMenuCreatorNotifier }
+ function AddMenu(const Ident: string): TMenuItem;
+ function CanHandle(const Ident: string): Boolean;
+ public
+ constructor Create(AProjectAnalyzer: TJclProjectAnalyzerExpert; const AOTAProjectManager: IOTAProjectManager);
+ end;
+ {$ENDIF BDS4_UP}
+
// design package entry point
procedure Register;
@@ -129,7 +148,7 @@
constructor TJclProjectAnalyzerExpert.Create;
begin
- inherited Create(JclProjectAnalyserExpertName);
+ inherited Create(JclProjectAnalyzerExpertName);
end;
destructor TJclProjectAnalyzerExpert.Destroy;
@@ -141,6 +160,48 @@
procedure TJclProjectAnalyzerExpert.ActionExecute(Sender: TObject);
var
TempActiveProject: IOTAProject;
+begin
+ try
+ TempActiveProject := ActiveProject;
+ if TempActiveProject <> nil then
+ AnalyzeProject(TempActiveProject)
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclProjectAnalyzerExpert.ActionUpdate(Sender: TObject);
+var
+ TempActiveProject: IOTAProject;
+ ProjectName: string;
+begin
+ try
+ TempActiveProject := ActiveProject;
+ if Assigned(TempActiveProject) then
+ ProjectName := ExtractFileName(TempActiveProject.FileName)
+ else
+ ProjectName := '';
+ FBuildAction.Enabled := Assigned(TempActiveProject);
+ if not FBuildAction.Enabled then
+ ProjectName := RsProjectNone;
+ FBuildAction.Caption := Format(RsAnalyzeActionCaption, [ProjectName]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclProjectAnalyzerExpert.AnalyzeProject(const AProject: IOTAProject);
+var
BuildOK, Succ: Boolean;
ProjOptions: IOTAProjectOptions;
SaveMapFile: Variant;
@@ -150,20 +211,16 @@
try
JclDisablePostCompilationProcess := True;
- TempActiveProject := ActiveProject;
- if not Assigned(TempActiveProject) then
- raise EJclExpertException.CreateTrace(RsENoActiveProject);
-
- ProjectFileName := TempActiveProject.FileName;
+ ProjectFileName := AProject.FileName;
ProjectName := ExtractFileName(ProjectFileName);
Succ := False;
- ProjOptions := TempActiveProject.ProjectOptions;
+ ProjOptions := AProject.ProjectOptions;
if not Assigned(ProjOptions) then
raise EJclExpertException.CreateTrace(RsENoProjectOptions);
- OutputDirectory := GetOutputDirectory(TempActiveProject);
- MapFileName := GetMapFileName(TempActiveProject);
+ OutputDirectory := GetOutputDirectory(AProject);
+ MapFileName := GetMapFileName(AProject);
if ProjectAnalyzerForm = nil then
begin
@@ -179,7 +236,7 @@
ProjOptions.ModifiedState := True;
//TempActiveProject.Save(False, True);
- BuildOK := TempActiveProject.ProjectBuilder.BuildProject(cmOTABuild, False);
+ BuildOK := AProject.ProjectBuilder.BuildProject(cmOTABuild, False);
ProjOptions.Values[MapFileOptionName] := SaveMapFile;
// workaround for MsBuild, the project has to be saved (seems useless with Delphi 2007 update 1)
@@ -206,41 +263,11 @@
if BuildOK then
MessageDlg(RsCantFindFiles, mtError, [mbOk], 0);
end;
+ finally
JclDisablePostCompilationProcess := False;
- except
- on ExceptionObj: TObject do
- begin
- JclExpertShowExceptionDialog(ExceptionObj);
- JclDisablePostCompilationProcess := False;
- raise;
- end;
end;
end;
-procedure TJclProjectAnalyzerExpert.ActionUpdate(Sender: TObject);
-var
- TempActiveProject: IOTAProject;
- ProjectName: string;
-begin
- try
- TempActiveProject := ActiveProject;
- if Assigned(TempActiveProject) then
- ProjectName := ExtractFileName(TempActiveProject.FileName)
- else
- ProjectName := '';
- FBuildAction.Enabled := Assigned(TempActiveProject);
- if not FBuildAction.Enabled then
- ProjectName := RsProjectNone;
- FBuildAction.Caption := Format(RsAnalyzeActionCaption, [ProjectName]);
- except
- on ExceptionObj: TObject do
- begin
- JclExpertShowExceptionDialog(ExceptionObj);
- raise;
- end;
- end;
-end;
-
procedure TJclProjectAnalyzerExpert.RegisterCommands;
var
IDEMainMenu: TMainMenu;
@@ -251,6 +278,7 @@
begin
inherited RegisterCommands;
+ // create actions
FBuildAction := TAction.Create(nil);
FBuildAction.Caption := Format(RsAnalyzeActionCaption, [RsProjectNone]);
FBuildAction.Visible := True;
@@ -265,6 +293,13 @@
ImageBmp.Free;
end;
+ // create project manager notifier
+ {$IFDEF BDS4_UP}
+ FProjectManagerNotifierIndex := ProjectManager.AddMenuCreatorNotifier(TProjectManagerNotifier.Create(Self,
+ ProjectManager));
+ {$ENDIF BDS4_UP}
+
+ // create menu item
IDEMainMenu := NTAServices.MainMenu;
IDEProjectItem := nil;
with IDEMainMenu do
@@ -301,10 +336,82 @@
procedure TJclProjectAnalyzerExpert.UnregisterCommands;
begin
inherited UnregisterCommands;
+ // remove notifier
+ {$IFDEF BDS4_UP}
+ if FProjectManagerNotifierIndex <> -1 then
+ ProjectManager.RemoveMenuCreatorNotifier(FProjectManagerNotifierIndex);
+ {$ENDIF BDS4_UP}
UnregisterAction(FBuildAction);
FreeAndNil(FBuildMenuItem);
FreeAndNil(FBuildAction);
end;
+{$IFDEF BDS4_UP}
+
+//=== { TProjectManagerNotifier } ============================================
+
+constructor TProjectManagerNotifier.Create(AProjectAnalyzer: TJclProjectAnalyzerExpert;
+ const AOTAProjectManager: IOTAProjectManager);
+begin
+ inherited Create;
+ FProjectAnalyser := AProjectAnalyzer;
+ FOTAProjectManager := AOTAProjectManager;
+end;
+
+function TProjectManagerNotifier.AddMenu(const Ident: string): TMenuItem;
+var
+ SelectedIdent: string;
+ AProject: IOTAProject;
+begin
+ try
+ SelectedIdent := Ident;
+ AProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if AProject <> nil then
+ begin
+ // root item
+ Result := TMenuItem.Create(nil);
+ Result.Visible := True;
+ Result.Caption := Format(RsAnalyzeActionCaption, [ExtractFileName(AProject.FileName)]);
+ Result.OnClick := AnalyzeProjectMenuClick;
+ end
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.AnalyzeProjectMenuClick(Sender: TObject);
+var
+ TempProject: IOTAProject;
+ SelectedIdent: string;
+begin
+ try
+ SelectedIdent := '';
+ TempProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if TempProject <> nil then
+ FProjectAnalyser.AnalyzeProject(TempProject)
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+function TProjectManagerNotifier.CanHandle(const Ident: string): Boolean;
+begin
+ Result := Ident = sProjectContainer;
+end;
+
+{$ENDIF BDS4_UP}
+
end.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-29 18:25:44
|
Revision: 2284
http://jcl.svn.sourceforge.net/jcl/?rev=2284&view=rev
Author: outchy
Date: 2007-12-29 10:25:43 -0800 (Sat, 29 Dec 2007)
Log Message:
-----------
fixed incompatibilities between project analyzer and debug expert.
minor style cleaning: icon for confirmation messages of the debug expert.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-29 17:42:36 UTC (rev 2283)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-29 18:25:43 UTC (rev 2284)
@@ -229,6 +229,10 @@
function GetProjectProperties(const AProject: IOTAProject; const PropIDs: TDynAnsiStringArray): TDynAnsiStringArray;
function SetProjectProperties(const AProject: IOTAProject; const PropIDs, PropValues: TDynAnsiStringArray): Integer;
+// set to true to temporary disable experts that alter compiled files after they were compiled
+var
+ JclDisablePostCompilationProcess: Boolean = False;
+
implementation
uses
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-29 17:42:36 UTC (rev 2283)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-29 18:25:43 UTC (rev 2284)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -320,7 +320,7 @@
end;
begin
- if FCurrentProject = nil then
+ if JclDisablePostCompilationProcess or (FCurrentProject = nil) then
Exit;
EnabledActions := GetProjectActions(FCurrentProject);
@@ -423,7 +423,7 @@
if MessageDlg(Format(RsCantInsertToInstalledPackage, [Project.FileName]), mtError, [mbYes, mbNo], 0) = mrYes then
begin
DisableExpert(Project);
- MessageDlg(RsDisabledDebugExpert, mtError, [mbOK], 0);
+ MessageDlg(RsDisabledDebugExpert, mtInformation, [mbOK], 0);
end
else
begin
@@ -449,7 +449,7 @@
else
begin
DisableExpert(Project);
- MessageDlg(RsDisabledDebugExpert, mtError, [mbOK], 0);
+ MessageDlg(RsDisabledDebugExpert, mtInformation, [mbOK], 0);
end;
end;
end;
Modified: trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
===================================================================
--- trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 17:42:36 UTC (rev 2283)
+++ trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 18:25:43 UTC (rev 2284)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -148,6 +148,8 @@
ProjectName: string;
begin
try
+ JclDisablePostCompilationProcess := True;
+
TempActiveProject := ActiveProject;
if not Assigned(TempActiveProject) then
raise EJclExpertException.CreateTrace(RsENoActiveProject);
@@ -204,10 +206,12 @@
if BuildOK then
MessageDlg(RsCantFindFiles, mtError, [mbOk], 0);
end;
+ JclDisablePostCompilationProcess := False;
except
on ExceptionObj: TObject do
begin
JclExpertShowExceptionDialog(ExceptionObj);
+ JclDisablePostCompilationProcess := False;
raise;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-29 17:42:37
|
Revision: 2283
http://jcl.svn.sourceforge.net/jcl/?rev=2283&view=rev
Author: outchy
Date: 2007-12-29 09:42:36 -0800 (Sat, 29 Dec 2007)
Log Message:
-----------
minor style cleaning: moving project analyzer expert name to JclOtaConsts.pas.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaConsts.pas
trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-29 17:17:13 UTC (rev 2282)
+++ trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-29 17:42:36 UTC (rev 2283)
@@ -121,9 +121,10 @@
JclIniFileLocation = 'experts\useswizard\JediUsesWizard.ini';
//=== Project analyser =====================================================
- AnalyzerViewName = 'AnalyzerView';
- JclProjectAnalyzeActionName = 'JCLProjectAnalyseCommand';
- JclProjectAnalyzeMenuName = 'JCLProjectAnalyseMenu';
+ JclProjectAnalyserExpertName = 'JclProjectAnalyzerExpert';
+ AnalyzerViewName = 'AnalyzerView';
+ JclProjectAnalyzeActionName = 'JCLProjectAnalyseCommand';
+ JclProjectAnalyzeMenuName = 'JCLProjectAnalyseMenu';
//=== Repository Expert ====================================================
JclRepositoryCategoryDelphiFiles = {$IFDEF BDS} sCategoryDelphiNewFiles {$ELSE BDS} '' {$ENDIF BDS};
Modified: trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas
===================================================================
--- trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 17:17:13 UTC (rev 2282)
+++ trunk/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas 2007-12-29 17:42:36 UTC (rev 2283)
@@ -129,7 +129,7 @@
constructor TJclProjectAnalyzerExpert.Create;
begin
- inherited Create('JclProjectAnalyzerExpert');
+ inherited Create(JclProjectAnalyserExpertName);
end;
destructor TJclProjectAnalyzerExpert.Destroy;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-29 17:17:19
|
Revision: 2282
http://jcl.svn.sourceforge.net/jcl/?rev=2282&view=rev
Author: outchy
Date: 2007-12-29 09:17:13 -0800 (Sat, 29 Dec 2007)
Log Message:
-----------
Fixed access violation when AfterCompile was called without a call to BeforeCompile (when the package is just installed).
Added support for adding menu items to the context menus of the project manager.
Fixed the disablement of the expert when prerequisites fail.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaResources.pas
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
Modified: trunk/jcl/experts/common/JclOtaResources.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaResources.pas 2007-12-27 17:55:14 UTC (rev 2281)
+++ trunk/jcl/experts/common/JclOtaResources.pas 2007-12-29 17:17:13 UTC (rev 2282)
@@ -20,7 +20,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -250,6 +250,7 @@
RsENoProjectGroup = 'No project group';
RsDebugConfigPageCaption = 'Debug info converter';
RsEInvalidDebugExpertAction = '%d is not a debug expert action';
+ RsENoProjectManager = 'Unable to get project manager';
//=== JclDebugIdeConfigFrame.pas =============================================
resourcestring
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-27 17:55:14 UTC (rev 2281)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-29 17:17:13 UTC (rev 2282)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
@@ -73,7 +73,11 @@
FSaveBuildProjectActionExecute: TNotifyEvent;
FSaveBuildAllProjectsAction: TCustomAction;
FSaveBuildAllProjectsActionExecute: TNotifyEvent;
- FNotifierIndex: Integer;
+ FIDENotifierIndex: Integer;
+ {$IFDEF BDS4_UP}
+ ProjectManager: IOTAProjectManager;
+ FProjectManagerNotifierIndex: Integer;
+ {$ENDIF BDS4_UP}
FConfigFrame: TJclDebugIdeConfigFrame;
FGlobalStates: array [TDebugExpertAction] of TDebugExpertState;
procedure DebugExpertActionExecute(Sender: TObject);
@@ -129,15 +133,36 @@
private
FDebugExtension: TJclDebugExtension;
protected
+ { IOTAIDENotifier }
+ procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
+ procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
procedure AfterCompile(Succeeded: Boolean); overload;
+ { IOTAIDENotifier50 }
+ procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
- procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
- procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
- procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
public
constructor Create(ADebugExtension: TJclDebugExtension);
end;
+ {$IFDEF BDS4_UP}
+ TProjectManagerNotifier = class(TNotifierObject, IOTANotifier, INTAProjectMenuCreatorNotifier)
+ private
+ FDebugExtension: TJclDebugExtension;
+ FOTAProjectManager: IOTAProjectManager;
+ FNTAServices: INTAServices;
+ procedure GenerateJdbgSubMenuClick(Sender: TObject);
+ procedure InsertJdbgSubMenuClick(Sender: TObject);
+ procedure DeleteMapFileSubMenuClick(Sender: TObject);
+ protected
+ { INTAProjectMenuCreatorNotifier }
+ function AddMenu(const Ident: string): TMenuItem;
+ function CanHandle(const Ident: string): Boolean;
+ public
+ constructor Create(ADebugExtension: TJclDebugExtension; const ANTAServices: INTAServices;
+ const AOTAProjectManager: IOTAProjectManager);
+ end;
+ {$ENDIF BDS4_UP}
+
// design package entry point
procedure Register;
@@ -260,6 +285,10 @@
constructor TJclDebugExtension.Create;
begin
inherited Create(JclDebugExpertRegKey);
+ {$IFDEF BDS4_UP}
+ if not Supports(BorlandIDEServices, IOTAProjectManager, ProjectManager) then
+ raise EJclExpertException.CreateRes(@RsENoProjectManager);
+ {$ENDIF BDS4_UP}
end;
procedure TJclDebugExtension.AddConfigurationPages(
@@ -291,6 +320,9 @@
end;
begin
+ if FCurrentProject = nil then
+ Exit;
+
EnabledActions := GetProjectActions(FCurrentProject);
if EnabledActions <> [] then
begin
@@ -467,7 +499,9 @@
procedure TJclDebugExtension.DisableExpert(const AProject: IOTAProject);
begin
-
+ ProjectStates[deGenerateJdbg, AProject] := DisableDebugExpertState(ProjectStates[deGenerateJdbg, AProject]);
+ ProjectStates[deInsertJdbg, AProject] := DisableDebugExpertState(ProjectStates[deInsertJdbg, AProject]);
+ ProjectStates[deDeleteMapFile, AProject] := DisableDebugExpertState(ProjectStates[deDeleteMapFile, AProject]);
end;
procedure TJclDebugExtension.DisplayResults;
@@ -1316,7 +1350,13 @@
ImageBmp.Free;
end;
- FNotifierIndex := Services.AddNotifier(TIdeNotifier.Create(Self));
+ // register notifiers
+ FIDENotifierIndex := Services.AddNotifier(TIdeNotifier.Create(Self));
+ {$IFDEF BDS4_UP}
+ FProjectManagerNotifierIndex := ProjectManager.AddMenuCreatorNotifier(TProjectManagerNotifier.Create(Self,
+ NTAServices, ProjectManager));
+ {$ENDIF BDS4_UP}
+
LoadExpertValues;
// insert menus
@@ -1379,8 +1419,12 @@
procedure TJclDebugExtension.UnregisterCommands;
begin
inherited UnregisterCommands;
- if FNotifierIndex <> -1 then
- Services.RemoveNotifier(FNotifierIndex);
+ {$IFDEF BDS4_UP}
+ if FProjectManagerNotifierIndex <> -1 then
+ ProjectManager.RemoveMenuCreatorNotifier(FProjectManagerNotifierIndex);
+ {$ENDIF BDS4_UP}
+ if FIDENotifierIndex <> -1 then
+ Services.RemoveNotifier(FIDENotifierIndex);
// save settings
SaveExpertValues;
@@ -1462,4 +1506,207 @@
begin
end;
+{$IFDEF BDS4_UP}
+
+constructor TProjectManagerNotifier.Create(ADebugExtension: TJclDebugExtension;
+ const ANTAServices: INTAServices; const AOTAProjectManager: IOTAProjectManager);
+begin
+ inherited Create;
+ FDebugExtension := ADebugExtension;
+ FNTAServices := ANTAServices;
+ FOTAProjectManager := AOTAProjectManager;
+end;
+
+function TProjectManagerNotifier.AddMenu(const Ident: string): TMenuItem;
+ procedure FillSubMenu(AMenuItem: TMenuItem; const AOnClickEvent: TNotifyEvent; AState: TDebugExpertState);
+ var
+ SubMenuItem: TMenuItem;
+ begin
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsAlwaysEnabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deAlwaysEnabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deAlwaysEnabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsProjectEnabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deProjectEnabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deProjectEnabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsProjectDisabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deProjectDisabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deProjectDisabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsAlwaysDisabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deAlwaysDisabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deAlwaysDisabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+ end;
+var
+ SelectedIdent: string;
+ AProject: IOTAProject;
+ ADeleteMapFileState, AGenerateJdbgState, AInsertJdbgState: TDebugExpertState;
+ ActionMenuItem: TMenuItem;
+begin
+ try
+ SelectedIdent := Ident;
+ AProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if AProject <> nil then
+ begin
+ ADeleteMapFileState := FDebugExtension.ProjectStates[deDeleteMapFile, AProject];
+ AGenerateJdbgState := FDebugExtension.ProjectStates[deGenerateJdbg, AProject];
+ AInsertJdbgState := FDebugExtension.ProjectStates[deInsertJdbg, AProject];
+
+ // root item
+ Result := TMenuItem.Create(nil);
+ Result.Visible := True;
+ Result.Caption := RsDebugExpertCaption;
+ if (ADeleteMapFileState in [deAlwaysEnabled, deProjectEnabled])
+ or (AGenerateJdbgState in [deAlwaysEnabled, deProjectEnabled])
+ or (AInsertJdbgState in [deAlwaysEnabled, deProjectEnabled]) then
+ begin
+ Result.Checked := True;
+ Result.ImageIndex := FDebugExtension.FDebugImageIndex
+ end
+ else
+ Result.ImageIndex := FDebugExtension.FNoDebugImageIndex;
+ Result.SubMenuImages := FNTAServices.ImageList;
+
+ // actions items
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDebugGenerateJdbg;
+ if AGenerateJdbgState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FGenerateJdbgImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoGenerateJdbgImageIndex;
+ FillSubMenu(ActionMenuItem, GenerateJdbgSubMenuClick, AGenerateJdbgState);
+ Result.Add(ActionMenuItem);
+
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDebugInsertJdbg;
+ if AInsertJdbgState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FInsertJdbgImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoInsertJdbgImageIndex;
+ FillSubMenu(ActionMenuItem, InsertJdbgSubMenuClick, AInsertJdbgState);
+ Result.Add(ActionMenuItem);
+
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDeleteMapFile;
+ if ADeleteMapFileState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FDeleteMapFileImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoDeleteMapFileImageIndex;
+ FillSubMenu(ActionMenuItem, DeleteMapFileSubMenuClick, ADeleteMapFileState);
+ Result.Add(ActionMenuItem);
+ end
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+function TProjectManagerNotifier.CanHandle(const Ident: string): Boolean;
+begin
+ Result := Ident = sProjectContainer;
+end;
+
+procedure TProjectManagerNotifier.DeleteMapFileSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deDeleteMapFile, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.GenerateJdbgSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deGenerateJdbg, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.InsertJdbgSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deInsertJdbg, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+{$ENDIF BDS4_UP}
+
end.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-27 17:55:17
|
Revision: 2281
http://jcl.svn.sourceforge.net/jcl/?rev=2281&view=rev
Author: outchy
Date: 2007-12-27 09:55:14 -0800 (Thu, 27 Dec 2007)
Log Message:
-----------
Removing UTF-8 BOM
Modified Paths:
--------------
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-27 17:52:36 UTC (rev 2280)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-27 17:55:14 UTC (rev 2281)
@@ -17,7 +17,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-27 17:52:40
|
Revision: 2280
http://jcl.svn.sourceforge.net/jcl/?rev=2280&view=rev
Author: outchy
Date: 2007-12-27 09:52:36 -0800 (Thu, 27 Dec 2007)
Log Message:
-----------
Mantis 4307 make "Insert JCL Debug data" project-specific
Reworking JCL debug expert to have global and project specific settings.
4 buttons can be placed on toolbars:
- global activation of debug expert
- activation of the generation of .jdbg files
- activation of the insertion of Jedi Debug Data into the binary
- activation of the deletion of MAP files when things are finished
JclOtaUtils.pas: new functions to read and write properties at the very beginning of project files (GetProjectProperties and SetProjectProperties)
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaConsts.pas
trunk/jcl/experts/common/JclOtaResources.pas
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.dfm
trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.pas
trunk/jcl/experts/debug/converter/JclDebugIdeIcon.res
trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
Modified: trunk/jcl/experts/common/JclOtaConsts.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/common/JclOtaConsts.pas 2007-12-27 17:52:36 UTC (rev 2280)
@@ -67,21 +67,31 @@
JclConfigureMenuName = 'JCLConfigureMenu';
//=== Debug Expert =========================================================
- JclDebugExpertRegKey = 'JclDebugExpert';
- JclDebugEnabledRegValue = 'JclDebugEnabled';
- JclDebugGenerateJdbgRegValue = 'JclDebugGenerateJdbg';
- JclDebugInsertJdbgRegValue = 'JclDebugInsertJdbg';
- MapFileOptionName = 'MapFile';
- OutputDirOptionName = 'OutputDir';
- RuntimeOnlyOptionName = 'RuntimeOnly';
- PkgDllDirOptionName = 'PkgDllDir';
- BPLOutputDirOptionName = 'PackageDPLOutput';
- LIBPREFIXOptionName = 'SOPrefix';
- LIBSUFFIXOptionName = 'SOSuffix';
- ColumnRegName = 'Column%d';
- JclDebugMessagePrefix = 'Jcl Debug Expert';
- JclInsertDataActionName = 'JCLInsertDataCommand';
- JclInsertDataMenuName = 'JCLInsertDataMenu';
+ JclDebugExpertRegKey = 'JclDebugExpert';
+ JclDebugEnabledRegValue = 'JclDebugEnabled';
+ JclDebugGenerateJdbgRegValue = 'JclDebugGenerateJdbg';
+ JclDebugInsertJdbgRegValue = 'JclDebugInsertJdbg';
+ JclDebugDeleteMapFileRegValue = 'JclDebugDeleteMapFile';
+ MapFileOptionName = 'MapFile';
+ OutputDirOptionName = 'OutputDir';
+ RuntimeOnlyOptionName = 'RuntimeOnly';
+ PkgDllDirOptionName = 'PkgDllDir';
+ BPLOutputDirOptionName = 'PackageDPLOutput';
+ LIBPREFIXOptionName = 'SOPrefix';
+ LIBSUFFIXOptionName = 'SOSuffix';
+ ColumnRegName = 'Column%d';
+ JclDebugMessagePrefix = 'Jcl Debug Expert';
+ JclDebugExpertActionName = 'JCLDebugExpertCommand';
+ JclDebugExpertMenuName = 'JCLDebugExpertMenu';
+ JclGenerateJdbgActionName = 'JCLGenerateJdbgCommand';
+ JclGenerateJdbgMenuName = 'JCLGenerateJdbgMenu';
+ JclInsertJdbgActionName = 'JCLInsertJdbgCommand';
+ JclInsertJdbgMenuName = 'JCLInsertJdbgMenu';
+ JclDeleteMapFileActionName = 'JCLDeleteMapFileCommand';
+ JclDeleteMapFileMenuName = 'JCLDeleteMapFileMenu';
+ JclDebugGenerateJdbgSetting = 'JCL_DEBUG_EXPERT_GENERATEJDBG';
+ JclDebugInsertJdbgSetting = 'JCL_DEBUG_EXPERT_INSERTJDBG';
+ JclDebugDeleteMapfileSetting = 'JCL_DEBUG_EXPERT_DELETEMAPFILE';
//=== Favorite Folders Expert ==============================================
JclFavoritesExpertName = 'JclFavoriteFoldersExpert';
Modified: trunk/jcl/experts/common/JclOtaResources.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaResources.pas 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/common/JclOtaResources.pas 2007-12-27 17:52:36 UTC (rev 2280)
@@ -64,6 +64,8 @@
RsActionSheet = 'Common\Actions';
RsENoBitmapResources = 'Unable to load bitmap resource';
RsENoEnvironmentOptions = 'Environment options are not available';
+ RsELineTooLong = 'Line too long in project file';
+ RsEUnterminatedComment = 'Unterminated comment in project file';
//=== JclExceptionForm.pas ===================================================
resourcestring
@@ -219,15 +221,24 @@
resourcestring
RsENoProjectOptions = 'Project options are not available';
RsCantInsertToInstalledPackage = 'JCL Debug IDE Expert: Can not insert debug information to installed package' +
- AnsiLineBreak + '%s' + AnsiLineBreak + 'Would you like to disable inserting JCL Debug data ?';
+ AnsiLineBreak + '%s' + AnsiLineBreak + 'Would you like to disable the insertion of JCL Debug data ?';
+ RsChangeMapFileOption = 'JCL Debug expert: the project "%s" must be configured to generate a detailled MAP file.' +
+ AnsiLineBreak + 'Do you want the expert to change this setting?';
+ RsDisabledDebugExpert = 'JCL Debug expert is disabled';
RsCompilationAborted = 'JCL Debug data cannot be inserted to installed package' + AnsiLineBreak + 'Compilation aborted';
- RsInsertDataCaption = 'Insert JCL Debug data';
+ RsDebugExpertCaption = 'JCL Debug expert';
+ RsAlwaysDisabled = 'Always &disabled';
+ RsProjectDisabled = 'D&isabled for this project';
+ RsProjectEnabled = 'E&nabled for this project';
+ RsAlwaysEnabled = 'Always &enabled';
RsEExecutableNotFound = 'Executable file for project "%s" not found.' +
'JCL debug data can''t be added to the binary.';
RsEMapFileNotFound = 'Map file "%s" for project "%s" not found.' +
'No conversions of debug information were made';
RsConvertedMapToJdbg = 'Converted MAP file "%s" (%d bytes) to .jdbg (%d bytes)';
RsInsertedJdbg = 'Converted MAP file "%s" (%d bytes) and inserted debug information (%d bytes) into the binary';
+ RsDeletedMapFile = 'Deleted %s file "%s"';
+ RsEFailedToDeleteMapFile = 'Failed to delete %s file "%s"';
RsEMapConversion = 'Failed to convert MAP file "%s"';
RsENoActiveProject = 'No active project';
RsENoProjectMenuItem = 'Project menu item not found';
@@ -238,12 +249,16 @@
RsENoBuildAllAction = 'Build All action not found';
RsENoProjectGroup = 'No project group';
RsDebugConfigPageCaption = 'Debug info converter';
+ RsEInvalidDebugExpertAction = '%d is not a debug expert action';
//=== JclDebugIdeConfigFrame.pas =============================================
resourcestring
- RsDebugEnableExpert = 'Enable debug expert';
+ RsDefaultDisabled = 'D&isabled by default (can be enabled per project)';
+ RsDefaultEnabled = 'E&nabled by default (can be disabled per project)';
RsDebugGenerateJdbg = 'Generate .jdbg files';
- RsDebugInsertJdbg = 'Insert data into the binary';
+ RsDebugInsertJdbg = 'Insert JDBG data into the binary';
+ RsDeleteMapFile = 'Delete map files after conversion';
+ RsEInvalidDebugExpertState = '%d is not a valid debug expert state';
//=== JclSIMDView.pas ========================================================
resourcestring
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-27 17:52:36 UTC (rev 2280)
@@ -41,6 +41,7 @@
// with a drop down menu, this class seems to have the same interface
// as TControlAction defined in Controls.pas for newer versions of Delphi
{$ENDIF COMPILER8_UP}
+ JclBase,
{$IFDEF MSWINDOWS}
JclDebug,
{$ENDIF MSWINDOWS}
@@ -223,6 +224,11 @@
procedure RegisterAboutBox;
{$ENDIF BDS}
+// properties are stored as "// PropID PropValue" in project file
+// they have to be placed before any identifiers and after comments at the beginning of the file
+function GetProjectProperties(const AProject: IOTAProject; const PropIDs: TDynAnsiStringArray): TDynAnsiStringArray;
+function SetProjectProperties(const AProject: IOTAProject; const PropIDs, PropValues: TDynAnsiStringArray): Integer;
+
implementation
uses
@@ -312,6 +318,265 @@
end;
{$ENDIF BDS}
+// result[] > 0: the property was found, result is the position of the first char of the property value
+// result[] <= 0: the property was not found, -result is the position where the property could be inserted
+function InternalLocateProperties(const AReader: IOTAEditReader; const PropIDs: TDynAnsiStringArray): TDynIntegerArray;
+const
+ BufferSize = 4096;
+var
+ Buffer, Line: AnsiString;
+ BufferStart, BufferCount, BufferPosition, LineStart, Position, PropIndex, PropCount, PropMatches: Integer;
+ InsideLineComment, InsideComment, InsideBrace: Boolean;
+ procedure LoadNextBuffer;
+ begin
+ BufferStart := Position;
+ BufferCount := AReader.GetText(BufferStart, PAnsiChar(Buffer), BufferSize);
+ BufferPosition := Position - BufferStart;
+ end;
+begin
+ BufferStart := 0;
+ BufferCount := 0;
+ LineStart := 0;
+ Position := 0;
+ PropMatches := 0;
+ InsideLineComment := False;
+ InsideComment := False;
+ InsideBrace := False;
+ PropCount := Length(PropIDs);
+ SetLength(Result, PropCount);
+ for PropIndex := 0 to PropCount - 1 do
+ Result[PropIndex] := -1;
+
+ SetLength(Buffer, BufferSize);
+ repeat
+ BufferPosition := Position - BufferStart;
+
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+
+ case Buffer[BufferPosition + 1] of
+ AnsiLineFeed,
+ AnsiCarriageReturn:
+ begin
+ if InsideLineComment and not (InsideComment or InsideBrace) then
+ begin
+ // process line
+ InsideLineComment := False;
+ if (LineStart - BufferStart) < 0 then
+ raise EJclExpertException.CreateRes(@RsELineTooLong);
+ Line := Copy(Buffer, LineStart - BufferStart + 1, Position - LineStart);
+ for PropIndex := 0 to PropCount - 1 do
+ if Pos(PropIDs[PropIndex], Line) = 4 then
+ begin
+ Result[PropIndex] := LineStart + Length(PropIDs[PropIndex]) + 4;
+ Inc(PropMatches);
+ end;
+ end;
+ LineStart := Position + 1;
+ end;
+ '/':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ begin
+ if (Buffer[BufferPosition + 2] = '/') then
+ begin
+ Inc(Position);
+ InsideLineComment := True;
+ end
+ else
+ // end of comments
+ Break;
+ end;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '(':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ begin
+ if (Buffer[BufferPosition + 2] = '*') then
+ begin
+ Inc(Position);
+ InsideComment := True;
+ end
+ else
+ // end of comments
+ Break;
+ end;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '*':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if InsideComment then
+ begin
+ if (Buffer[BufferPosition + 2] = ')') then
+ begin
+ Inc(Position);
+ InsideComment := False;
+ end;
+ end
+ else
+ if not (InsideLineComment or InsideBrace) then
+ // end of comments
+ Break;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '{':
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ InsideBrace := True;
+ '}':
+ if InsideBrace then
+ InsideBrace := False
+ else
+ if not (InsideLineComment or InsideComment) then
+ // end of comments
+ Break;
+ else
+ if not (Buffer[BufferPosition + 1] in AnsiWhiteSpace) and not InsideLineComment
+ and not InsideComment and not InsideBrace then
+ // end of comments
+ Break;
+ end;
+ Inc(Position);
+ until (BufferCount = 0) or (PropMatches = PropCount);
+ if InsideLineComment or InsideComment or InsideBrace then
+ raise EJclExpertException.CreateRes(@RsEUnterminatedComment);
+ for PropIndex := 0 to PropCount - 1 do
+ if Result[PropIndex] = -1 then
+ Result[PropIndex] := -Position;
+end;
+
+function GetProjectProperties(const AProject: IOTAProject; const PropIDs: TDynAnsiStringArray): TDynAnsiStringArray;
+const
+ BufferSize = 4096;
+var
+ FileIndex, PropCount, PropIndex, BufferIndex: Integer;
+ AEditor: IOTAEditor;
+ FileExtension: string;
+ PropLocations: TDynIntegerArray;
+ AReader: IOTAEditReader;
+begin
+ PropCount := Length(PropIDs);
+ SetLength(Result, PropCount);
+ for FileIndex := 0 to AProject.GetModuleFileCount - 1 do
+ begin
+ AEditor := AProject.GetModuleFileEditor(FileIndex);
+ FileExtension := ExtractFileExt(AEditor.FileName);
+ if AnsiSameText(FileExtension, '.dpr') or AnsiSameText(FileExtension, '.dpk')
+ or AnsiSameText(FileExtension, '.bpf') or AnsiSameText(FileExtension, '.cpp') then
+ begin
+ AReader := (AEditor as IOTASourceEditor).CreateReader;
+ try
+ PropLocations := InternalLocateProperties(AReader, PropIDs);
+ for PropIndex := 0 to PropCount - 1 do
+ if PropLocations[PropIndex] > 0 then
+ begin
+ SetLength(Result[PropIndex], BufferSize);
+ SetLength(Result[PropIndex], AReader.GetText(PropLocations[PropIndex], PAnsiChar(Result[PropIndex]), BufferSize));
+ for BufferIndex := 1 to Length(Result[PropIndex]) do
+ if Result[PropIndex][BufferIndex] in [AnsiCarriageReturn, AnsiLineFeed] then
+ begin
+ SetLength(Result[PropIndex], BufferIndex - 1);
+ Break;
+ end;
+ end;
+ finally
+ AReader := nil;
+ end;
+ Break;
+ end;
+ end;
+end;
+
+function SetProjectProperties(const AProject: IOTAProject; const PropIDs, PropValues: TDynAnsiStringArray): Integer;
+const
+ BufferSize = 4096;
+var
+ FileIndex, PropCount, PropIndex, BufferIndex, PropSize: Integer;
+ AEditor: IOTAEditor;
+ ASourceEditor: IOTASourceEditor;
+ FileExtension: string;
+ Buffer: AnsiString;
+ PropLocations: TDynIntegerArray;
+ AReader: IOTAEditReader;
+ AWriter: IOTAEditWriter;
+begin
+ PropCount := Length(PropIDs);
+ Result := 0;
+ for FileIndex := 0 to AProject.GetModuleFileCount - 1 do
+ begin
+ AEditor := AProject.GetModuleFileEditor(FileIndex);
+ FileExtension := ExtractFileExt(AEditor.FileName);
+ if AnsiSameText(FileExtension, '.dpr') or AnsiSameText(FileExtension, '.dpk')
+ or AnsiSameText(FileExtension, '.bpf') or AnsiSameText(FileExtension, '.cpp') then
+ begin
+ ASourceEditor := AEditor as IOTASourceEditor;
+ for PropIndex := 0 to PropCount - 1 do
+ begin
+ PropSize := 0;
+ AReader := ASourceEditor.CreateReader;
+ try
+ PropLocations := InternalLocateProperties(AReader, Copy(PropIDs, PropIndex, 1));
+ if PropLocations[0] > 0 then
+ begin
+ SetLength(Buffer, BufferSize);
+ SetLength(Buffer, AReader.GetText(PropLocations[0], PAnsiChar(Buffer), BufferSize));
+ for BufferIndex := 1 to Length(Buffer) do
+ if Buffer[BufferIndex] in [AnsiCarriageReturn, AnsiLineFeed] then
+ begin
+ PropSize := BufferIndex - 1;
+ Break;
+ end;
+ end;
+ finally
+ // release the reader before allocating the writer
+ AReader := nil;
+ end;
+
+ AWriter := ASourceEditor.CreateUndoableWriter;
+ try
+ if PropLocations[0] > 0 then
+ begin
+ AWriter.CopyTo(PropLocations[0]);
+ AWriter.DeleteTo(PropLocations[0] + PropSize);
+ AWriter.Insert(PAnsiChar(PropValues[PropIndex]));
+ end
+ else
+ begin
+ AWriter.CopyTo(-PropLocations[0]);
+ AWriter.Insert(PAnsiChar(Format('// %s %s%s', [PropIDs[PropIndex], PropValues[PropIndex], AnsiLineBreak])));
+ end;
+ finally
+ // release the writter before allocating the reader
+ AWriter := nil;
+ end;
+ Inc(Result);
+ end;
+ Break;
+ end;
+ end;
+end;
+
//=== { EJclExpertException } ================================================
constructor EJclExpertException.CreateTrace(const Msg: string);
@@ -330,7 +595,7 @@
end;
{$ENDIF MSWINDOWS}
-{ TJclOTASettings }
+//=== { TJclOTASettings } ====================================================
constructor TJclOTASettings.Create(ExpertName: string);
var
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.dfm
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.dfm 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.dfm 2007-12-27 17:52:36 UTC (rev 2280)
@@ -3,34 +3,46 @@
Top = 0
Width = 369
Height = 375
+ AutoScroll = True
TabOrder = 0
TabStop = True
- object CheckBoxGenerateJdbg: TCheckBox
- Left = 32
- Top = 56
- Width = 321
- Height = 17
- Anchors = [akLeft, akTop, akRight]
+ object RadioGroupGenerateJdbg: TRadioGroup
+ Left = 3
+ Top = 3
+ Width = 347
+ Height = 129
Caption = 'RsDebugGenerateJdbg'
+ Items.Strings = (
+ 'RsAlwaysDisabled'
+ 'RsDefaultDisabled'
+ 'RsDefaultEnabled'
+ 'RsAlwaysEnabled')
TabOrder = 0
end
- object CheckBoxInsertJdbg: TCheckBox
- Left = 32
- Top = 87
- Width = 321
- Height = 17
- Anchors = [akLeft, akTop, akRight]
+ object RadioGroupInsertJdbg: TRadioGroup
+ Left = 3
+ Top = 138
+ Width = 347
+ Height = 129
Caption = 'RsDebugInsertJdbg'
+ Items.Strings = (
+ 'RsAlwaysDisabled'
+ 'RsDefaultDisabled'
+ 'RsDefaultEnabled'
+ 'RsAlwaysEnabled')
TabOrder = 1
end
- object CheckBoxEnableExpert: TCheckBox
- Left = 16
- Top = 24
- Width = 337
- Height = 17
- Anchors = [akLeft, akTop, akRight]
- Caption = 'RsDebugEnableExpert'
+ object RadioGroupDeleteMapFile: TRadioGroup
+ Left = 3
+ Top = 273
+ Width = 347
+ Height = 129
+ Caption = 'RsDeleteMapFile'
+ Items.Strings = (
+ 'RsDataAlwaysDisabled'
+ 'RsDataDefaultDisabled'
+ 'RsDataDefaultEnabled'
+ 'RsDataAlwaysEnabled')
TabOrder = 2
- OnClick = CheckBoxEnableExpertClick
end
end
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.pas 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeConfigFrame.pas 2007-12-27 17:52:36 UTC (rev 2280)
@@ -30,29 +30,37 @@
interface
uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
+ TDebugExpertState = (deAlwaysDisabled, deProjectDisabled, deProjectEnabled, deAlwaysEnabled);
+
TJclDebugIdeConfigFrame = class(TFrame)
- CheckBoxGenerateJdbg: TCheckBox;
- CheckBoxInsertJdbg: TCheckBox;
- CheckBoxEnableExpert: TCheckBox;
- procedure CheckBoxEnableExpertClick(Sender: TObject);
+ RadioGroupGenerateJdbg: TRadioGroup;
+ RadioGroupInsertJdbg: TRadioGroup;
+ RadioGroupDeleteMapFile: TRadioGroup;
private
- function GetEnableExpert: Boolean;
- function GetGenerateJdbg: Boolean;
- function GetInsertJdbg: Boolean;
- procedure SetEnableExpert(const Value: Boolean);
- procedure SetGenerateJdbg(const Value: Boolean);
- procedure SetInsertJdbg(const Value: Boolean);
+ function GetGenerateJdbgState: TDebugExpertState;
+ function GetInsertJdbgState: TDebugExpertState;
+ function GetDeleteMapFileState: TDebugExpertState;
+ procedure SetGenerateJdbgState(Value: TDebugExpertState);
+ procedure SetInsertJdbgState(Value: TDebugExpertState);
+ procedure SetDeleteMapFileState(Value: TDebugExpertState);
public
constructor Create(AOwner: TComponent); override;
- property EnableExpert: Boolean read GetEnableExpert write SetEnableExpert;
- property GenerateJdbg: Boolean read GetGenerateJdbg write SetGenerateJdbg;
- property InsertJdbg: Boolean read GetInsertJdbg write SetInsertJdbg;
+ property GenerateJdbgState: TDebugExpertState read GetGenerateJdbgState write SetGenerateJdbgState;
+ property InsertJdbgState: TDebugExpertState read GetInsertJdbgState write SetInsertJdbgState;
+ property DeleteMapFileState: TDebugExpertState read GetDeleteMapFileState write SetDeleteMapFileState;
end;
+function DebugExpertStateToInt(Value: TDebugExpertState): Integer;
+function IntToDebugExpertState(Value: Integer): TDebugExpertState;
+function ToggleDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function EnableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function DisableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function ApplyDebugExpertState(GlobalState: TDebugExpertState; LocalEnabled: Boolean): TDebugExpertState;
+
implementation
{$R *.dfm}
@@ -60,50 +68,155 @@
uses
JclOtaResources;
-procedure TJclDebugIdeConfigFrame.CheckBoxEnableExpertClick(Sender: TObject);
+function DebugExpertStateToInt(Value: TDebugExpertState): Integer;
begin
- CheckBoxGenerateJdbg.Enabled := CheckBoxEnableExpert.Checked;
- CheckBoxInsertJdbg.Enabled := CheckBoxEnableExpert.Checked;
+ case Value of
+ deAlwaysDisabled:
+ Result := 0;
+ deProjectDisabled:
+ Result := 1;
+ deProjectEnabled:
+ Result := 2;
+ deAlwaysEnabled:
+ Result := 3;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
end;
+function IntToDebugExpertState(Value: Integer): TDebugExpertState;
+begin
+ case Value of
+ 0:
+ Result := deAlwaysDisabled;
+ 1:
+ Result := deProjectDisabled;
+ 2:
+ Result := deProjectEnabled;
+ 3:
+ Result := deAlwaysEnabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Value]);
+ end;
+end;
+
+function ToggleDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled:
+ Result := deAlwaysEnabled;
+ deProjectDisabled:
+ Result := deProjectEnabled;
+ deProjectEnabled:
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysDisabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function EnableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled:
+ Result := deAlwaysEnabled;
+ deProjectDisabled:
+ Result := deProjectEnabled;
+ deProjectEnabled,
+ deAlwaysEnabled:
+ Result := Value;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function DisableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled,
+ deProjectDisabled:
+ Result := Value;
+ deProjectEnabled:
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysDisabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function ApplyDebugExpertState(GlobalState: TDebugExpertState; LocalEnabled: Boolean): TDebugExpertState;
+begin
+ case GlobalState of
+ deAlwaysDisabled:
+ Result := deAlwaysDisabled;
+ deProjectDisabled,
+ deProjectEnabled:
+ if LocalEnabled then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysEnabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(GlobalState)]);
+ end;
+end;
+
+//=== { TJclDebugIdeConfigFrame } ============================================
+
constructor TJclDebugIdeConfigFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
- CheckBoxEnableExpert.Caption := RsDebugEnableExpert;
- CheckBoxGenerateJdbg.Caption := RsDebugGenerateJdbg;
- CheckBoxInsertJdbg.Caption := RsDebugInsertJdbg;
+
+ RadioGroupGenerateJdbg.Caption := RsDebugGenerateJdbg;
+ RadioGroupGenerateJdbg.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupGenerateJdbg.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupGenerateJdbg.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupGenerateJdbg.Items.Strings[3] := RsAlwaysEnabled;
+
+ RadioGroupInsertJdbg.Caption := RsDebugInsertJdbg;
+ RadioGroupInsertJdbg.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupInsertJdbg.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupInsertJdbg.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupInsertJdbg.Items.Strings[3] := RsAlwaysEnabled;
+
+ RadioGroupDeleteMapFile.Caption := RsDeleteMapFile;
+ RadioGroupDeleteMapFile.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupDeleteMapFile.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupDeleteMapFile.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupDeleteMapFile.Items.Strings[3] := RsAlwaysEnabled;
end;
-function TJclDebugIdeConfigFrame.GetEnableExpert: Boolean;
+function TJclDebugIdeConfigFrame.GetGenerateJdbgState: TDebugExpertState;
begin
- Result := CheckBoxEnableExpert.Checked;
+ Result := IntToDebugExpertState(RadioGroupGenerateJdbg.ItemIndex);
end;
-function TJclDebugIdeConfigFrame.GetGenerateJdbg: Boolean;
+function TJclDebugIdeConfigFrame.GetInsertJdbgState: TDebugExpertState;
begin
- Result := CheckBoxGenerateJdbg.Checked;
+ Result := IntToDebugExpertState(RadioGroupInsertJdbg.ItemIndex);
end;
-function TJclDebugIdeConfigFrame.GetInsertJdbg: Boolean;
+function TJclDebugIdeConfigFrame.GetDeleteMapFileState: TDebugExpertState;
begin
- Result := CheckBoxInsertJdbg.Checked;
+ Result := IntToDebugExpertState(RadioGroupDeleteMapFile.ItemIndex);
end;
-procedure TJclDebugIdeConfigFrame.SetEnableExpert(const Value: Boolean);
+procedure TJclDebugIdeConfigFrame.SetGenerateJdbgState(Value: TDebugExpertState);
begin
- CheckBoxEnableExpert.Checked := Value;
- CheckBoxGenerateJdbg.Enabled := Value;
- CheckBoxInsertJdbg.Enabled := Value;
+ RadioGroupGenerateJdbg.ItemIndex := DebugExpertStateToInt(Value);
end;
-procedure TJclDebugIdeConfigFrame.SetGenerateJdbg(const Value: Boolean);
+procedure TJclDebugIdeConfigFrame.SetInsertJdbgState(Value: TDebugExpertState);
begin
- CheckBoxGenerateJdbg.Checked := Value;
+ RadioGroupInsertJdbg.ItemIndex := DebugExpertStateToInt(Value);
end;
-procedure TJclDebugIdeConfigFrame.SetInsertJdbg(const Value: Boolean);
+procedure TJclDebugIdeConfigFrame.SetDeleteMapFileState(Value: TDebugExpertState);
begin
- CheckBoxInsertJdbg.Checked := Value;
+ RadioGroupDeleteMapFile.ItemIndex := DebugExpertStateToInt(Value);
end;
end.
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeIcon.res
===================================================================
(Binary files differ)
Modified: trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas
===================================================================
--- trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-25 16:16:35 UTC (rev 2279)
+++ trunk/jcl/experts/debug/converter/JclDebugIdeImpl.pas 2007-12-27 17:52:36 UTC (rev 2280)
@@ -31,7 +31,8 @@
uses
Windows, Classes, Menus, ActnList, SysUtils, Graphics, Dialogs, Controls, Forms, ToolsAPI,
- JclOtaUtils, JclDebugIdeConfigFrame;
+ JclOtaUtils, JclOtaConsts,
+ JclDebugIdeConfigFrame;
type
TJclDebugDataInfo = record
@@ -43,35 +44,70 @@
Success: Boolean;
end;
+ TDebugExpertAction = (deGenerateJdbg, deInsertJdbg, deDeleteMapFile);
+ TDebugExpertActions = set of TDebugExpertAction;
+
TJclDebugExtension = class(TJclOTAExpert)
private
FResultInfo: array of TJclDebugDataInfo;
FStoreResults: Boolean;
- FImageIndex: Integer;
FBuildError: Boolean;
- FInsertDataItem: TMenuItem;
- FInsertDataAction: TAction;
- FDisabledImageIndex: Integer;
+ FDebugExpertAction: TDropDownAction;
+ FDebugExpertItem: TMenuItem;
+ FGenerateJdbgAction: TDropDownAction;
+ FGenerateJdbgItem: TMenuItem;
+ FInsertJdbgAction: TDropDownAction;
+ FInsertJdbgItem: TMenuItem;
+ FDeleteMapFileAction: TDropDownAction;
+ FDeleteMapFileItem: TMenuItem;
+ FDebugImageIndex: Integer;
+ FNoDebugImageIndex: Integer;
+ FGenerateJdbgImageIndex: Integer;
+ FNoGenerateJdbgImageIndex: Integer;
+ FInsertJdbgImageIndex: Integer;
+ FNoInsertJdbgImageIndex: Integer;
+ FDeleteMapFileImageIndex: Integer;
+ FNoDeleteMapFileImageIndex: Integer;
FCurrentProject: IOTAProject;
- FSaveBuildProject: TAction;
- FSaveBuildProjectExecute: TNotifyEvent;
- FSaveBuildAllProjects: TAction;
- FSaveBuildAllProjectsExecute: TNotifyEvent;
+ FSaveBuildProjectAction: TCustomAction;
+ FSaveBuildProjectActionExecute: TNotifyEvent;
+ FSaveBuildAllProjectsAction: TCustomAction;
+ FSaveBuildAllProjectsActionExecute: TNotifyEvent;
FNotifierIndex: Integer;
- FSaveMapFile: Integer;
FConfigFrame: TJclDebugIdeConfigFrame;
- FGenerateJdbg: Boolean;
- FInsertJdbg: Boolean;
- FEnableExpert: Boolean;
- procedure InsertDataExecute(Sender: TObject);
+ FGlobalStates: array [TDebugExpertAction] of TDebugExpertState;
+ procedure DebugExpertActionExecute(Sender: TObject);
+ procedure DebugExpertActionUpdate(Sender: TObject);
+ procedure DebugExpertMenuClick(Sender: TObject);
+ procedure DebugExpertMenuDropDown(Sender: TObject);
+ procedure DebugExpertSubMenuClick(Sender: TObject);
+ procedure GenerateJdbgActionExecute(Sender: TObject);
+ procedure GenerateJdbgActionUpdate(Sender: TObject);
+ procedure GenerateJdbgMenuClick(Sender: TObject);
+ procedure GenerateJdbgMenuDropDown(Sender: TObject);
+ procedure GenerateJdbgSubMenuClick(Sender: TObject);
+ procedure InsertJdbgActionExecute(Sender: TObject);
+ procedure InsertJdbgActionUpdate(Sender: TObject);
+ procedure InsertJdbgMenuClick(Sender: TObject);
+ procedure InsertJdbgMenuDropDown(Sender: TObject);
+ procedure InsertJdbgSubMenuClick(Sender: TObject);
+ procedure DeleteMapFileActionExecute(Sender: TObject);
+ procedure DeleteMapFileActionUpdate(Sender: TObject);
+ procedure DeleteMapFileMenuClick(Sender: TObject);
+ procedure DeleteMapFileMenuDropDown(Sender: TObject);
+ procedure DeleteMapFileSubMenuClick(Sender: TObject);
procedure LoadExpertValues;
procedure SaveExpertValues;
- procedure BuildAllProjects(Sender: TObject); // (New) Build All Projects command hook
- procedure BuildProject(Sender: TObject); // (New) Build Project command hook
+ procedure BuildAllProjects(Sender: TObject);
+ procedure BuildProject(Sender: TObject);
procedure BeginStoreResults;
procedure DisplayResults;
procedure EndStoreResults;
- procedure SetEnableExpert(const Value: Boolean);
+ function GetGlobalState(Index: TDebugExpertAction): TDebugExpertState;
+ procedure SetGlobalState(Index: TDebugExpertAction; Value: TDebugExpertState);
+ function GetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject): TDebugExpertState;
+ procedure SetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject; Value: TDebugExpertState);
+ function GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
public
constructor Create; reintroduce;
procedure AfterCompile(Succeeded: Boolean);
@@ -80,9 +116,13 @@
procedure UnregisterCommands; override;
procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
- property GenerateJdbg: Boolean read FGenerateJdbg write FGenerateJdbg;
- property InsertJdbg: Boolean read FInsertJdbg write FInsertJdbg;
- property EnableExpert: Boolean read FEnableExpert write SetEnableExpert;
+ procedure DisableExpert(const AProject: IOTAProject);
+ procedure ChangeProjectAction(const AProject: IOTAProject; AAction: TDebugExpertAction; AEnabled: Boolean);
+ property GlobalStates[Index: TDebugExpertAction]: TDebugExpertState read GetGlobalState
+ write SetGlobalState;
+ property ProjectStates[Index: TDebugExpertAction; const AProject: IOTAProject]: TDebugExpertState
+ read GetProjectState write SetProjectState;
+ property ProjectActions[const AProject: IOTAProject]: TDebugExpertActions read GetProjectActions;
end;
TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50)
@@ -106,13 +146,23 @@
RegisterProc: TWizardRegisterProc;
var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
+const
+ DebugActionNames: array [TDebugExpertAction] of string =
+ ( JclDebugGenerateJdbgSetting, // deGenerateJdbg
+ JclDebugInsertJdbgSetting, // deInsertJdbg
+ JclDebugDeleteMapfileSetting // deDeleteMapFile);
+ );
+ DebugActionValues: array [False..True] of string =
+ ( 'OFF', 'ON' );
+
implementation
{$R JclDebugIdeIcon.res}
uses
- JclBorlandTools, JclDebug, JclDebugIdeResult,
- JclOtaConsts, JclOtaResources;
+ TypInfo,
+ JclBase, JclBorlandTools, JclDebug, JclDebugIdeResult,
+ JclOtaResources;
procedure Register;
begin
@@ -178,6 +228,18 @@
//=== { TJclDebugExtension } =================================================
+procedure TJclDebugExtension.ChangeProjectAction(const AProject: IOTAProject; AAction: TDebugExpertAction;
+ AEnabled: Boolean);
+var
+ PropIDs, PropValues: TDynAnsiStringArray;
+begin
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[AAction];
+ SetLength(PropValues, 1);
+ PropValues[0] := DebugActionValues[AEnabled];
+ SetProjectProperties(AProject, PropIDs, PropValues);
+end;
+
procedure TJclDebugExtension.ConfigurationClosed(AControl: TControl;
SaveChanges: Boolean);
begin
@@ -185,9 +247,9 @@
begin
if SaveChanges then
begin
- EnableExpert := FConfigFrame.EnableExpert;
- GenerateJdbg := FConfigFrame.GenerateJdbg;
- InsertJdbg := FConfigFrame.InsertJdbg;
+ GlobalStates[deGenerateJdbg] := FConfigFrame.GenerateJdbgState;
+ GlobalStates[deInsertJdbg] := FConfigFrame.InsertJdbgState;
+ GlobalStates[deDeleteMapFile] := FConfigFrame.DeleteMapFileState;
end;
FreeAndNil(FConfigFrame);
end
@@ -205,9 +267,9 @@
begin
inherited AddConfigurationPages(AddPageFunc);
FConfigFrame := TJclDebugIdeConfigFrame.Create(nil);
- FConfigFrame.EnableExpert := EnableExpert;
- FConfigFrame.GenerateJdbg := GenerateJdbg;
- FConfigFrame.InsertJdbg := InsertJdbg;
+ FConfigFrame.GenerateJdbgState := GlobalStates[deGenerateJdbg];
+ FConfigFrame.InsertJdbgState := GlobalStates[deInsertJdbg];
+ FConfigFrame.DeleteMapFileState := GlobalStates[deDeleteMapFile];
AddPageFunc(FConfigFrame, RsDebugConfigPageCaption, Self);
end;
@@ -215,19 +277,10 @@
var
ProjectFileName, MapFileName, DrcFileName, ExecutableFileName, JdbgFileName: string;
OutputDirectory, LinkerBugUnit: string;
- ProjOptions: IOTAProjectOptions;
Succ: Boolean;
MapFileSize, JclDebugDataSize, LineNumberErrors, C: Integer;
+ EnabledActions: TDebugExpertActions;
- procedure DeleteMapAndDrcFile;
- begin
- if FSaveMapFile <> MapFileOptionDetailed then
- begin // delete MAP and DRC file
- DeleteFile(MapFileName);
- DeleteFile(DrcFileName);
- end;
- end;
-
procedure OutputToolMessage(const Msg: string);
begin
if Assigned(FCurrentProject) then
@@ -238,17 +291,9 @@
end;
begin
- if EnableExpert and Assigned(FCurrentProject) then
+ EnabledActions := GetProjectActions(FCurrentProject);
+ if EnabledActions <> [] then
begin
- ProjOptions := FCurrentProject.ProjectOptions;
-
- if FSaveMapFile <> MapFileOptionDetailed then
- begin
- ProjOptions.Values[MapFileOptionName] := FSaveMapFile;
- // workaround for MsBuild, the project has to be saved (seems useless with Delphi 2007 update 1)
- ProjOptions.ModifiedState := True;
- //FCurrentProject.Save(False, True);
- end;
ProjectFileName := FCurrentProject.FileName;
OutputDirectory := GetOutputDirectory(FCurrentProject);
MapFileName := GetMapFileName(FCurrentProject);
@@ -267,7 +312,7 @@
OutputToolMessage(Format(RsEMapFileNotFound, [MapFileName, ProjectFileName]));
// creation of .jdbg
- if Succ and GenerateJdbg then
+ if Succ and (deGenerateJdbg in EnabledActions) then
begin
Succ := ConvertMapFileToJdbgFile(MapFileName, LinkerBugUnit, LineNumberErrors,
MapFileSize, JclDebugDataSize);
@@ -278,7 +323,7 @@
end;
// insertion of JEDI Debug Information into the binary
- if Succ and InsertJdbg then
+ if Succ and (deInsertJdbg in EnabledActions) then
begin
Succ := FindExecutableName(MapFileName, OutputDirectory, ExecutableFileName);
if Succ then
@@ -293,14 +338,27 @@
else
OutputToolMessage(Format(RsEExecutableNotFound, [ProjectFileName]));
end;
+
+ // deletion of MAP files
+ if Succ and (deDeleteMapFile in EnabledActions) then
+ begin
+ Succ := DeleteFile(MapFileName);
+ if Succ then
+ OutputToolMessage(Format(RsDeletedMapFile, ['MAP', MapFileName]))
+ else
+ OutputToolMessage(Format(RsEFailedToDeleteMapFile, ['MAP', MapFileName]));
+ if DeleteFile(DrcFileName) then
+ OutputToolMessage(Format(RsDeletedMapFile, ['DRC', DrcFileName]))
+ else
+ OutputToolMessage(Format(RsEFailedToDeleteMapFile, ['DRC', DrcFileName]));
+ end;
+
Screen.Cursor := crDefault;
except
Screen.Cursor := crDefault;
raise;
end;
- DeleteMapAndDrcFile;
-
if FStoreResults then
begin
C := Length(FResultInfo);
@@ -315,10 +373,7 @@
end;
end
else
- begin
FBuildError := True;
- DeleteMapAndDrcFile;
- end;
FCurrentProject := nil;
end;
end;
@@ -326,13 +381,18 @@
procedure TJclDebugExtension.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
var
ProjOptions: IOTAProjectOptions;
+ EnabledActions: TDebugExpertActions;
begin
- if EnableExpert then
+ EnabledActions := GetProjectActions(Project);
+ if EnabledActions <> [] then
begin
if IsInstalledPackage(Project) then
begin
if MessageDlg(Format(RsCantInsertToInstalledPackage, [Project.FileName]), mtError, [mbYes, mbNo], 0) = mrYes then
- EnableExpert := False
+ begin
+ DisableExpert(Project);
+ MessageDlg(RsDisabledDebugExpert, mtError, [mbOK], 0);
+ end
else
begin
Cancel := True;
@@ -346,12 +406,20 @@
if not Assigned(ProjOptions) then
raise EJclExpertException.CreateTrace(RsENoProjectOptions);
- FSaveMapFile := ProjOptions.Values[MapFileOptionName];
- if FSaveMapFile <> MapFileOptionDetailed then
- ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed;
- // workaround for MsBuild, the project has to be saved (seems useless with Delphi 2007 update 1)
- ProjOptions.ModifiedState := True;
- //Project.Save(False, True);
+
+ if ProjOptions.Values[MapFileOptionName] <> MapFileOptionDetailed then
+ begin
+ if MessageDlg(Format(RsChangeMapFileOption, [ExtractFileName(Project.FileName)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
+ begin
+ ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed;
+ ProjOptions.ModifiedState := True;
+ end
+ else
+ begin
+ DisableExpert(Project);
+ MessageDlg(RsDisabledDebugExpert, mtError, [mbOK], 0);
+ end;
+ end;
end;
end;
end;
@@ -368,9 +436,8 @@
BeginStoreResults;
try
try
- FSaveBuildAllProjectsExecute(Sender);
- if EnableExpert then
- DisplayResults;
+ FSaveBuildAllProjectsActionExecute(Sender);
+ DisplayResults;
except
on ExceptionObj: TObject do
JclExpertShowExceptionDialog(ExceptionObj);
@@ -386,9 +453,8 @@
BeginStoreResults;
try
try
- FSaveBuildProjectExecute(Sender);
- if EnableExpert then
- DisplayResults;
+ FSaveBuildProjectActionExecute(Sender);
+ DisplayResults;
except
on ExceptionObj: TObject do
JclExpertShowExceptionDialog(ExceptionObj);
@@ -399,6 +465,11 @@
end;
end;
+procedure TJclDebugExtension.DisableExpert(const AProject: IOTAProject);
+begin
+
+end;
+
procedure TJclDebugExtension.DisplayResults;
var
I: Integer;
@@ -447,11 +518,29 @@
FResultInfo := nil;
end;
-procedure TJclDebugExtension.InsertDataExecute(Sender: TObject);
+procedure TJclDebugExtension.DebugExpertActionExecute(Sender: TObject);
+var
+ AProject: IOTAProject;
begin
try
- EnableExpert := not FInsertDataAction.Checked;
- SaveExpertValues;
+ AProject := ActiveProject;
+ if AProject <> nil then
+ begin
+ if ProjectActions[AProject] <> [] then
+ begin
+ // disable all actions
+ ProjectStates[deGenerateJdbg, AProject] := DisableDebugExpertState(ProjectStates[deGenerateJdbg, AProject]);
+ ProjectStates[deInsertJdbg, AProject] := DisableDebugExpertState(ProjectStates[deInsertJdbg, AProject]);
+ ProjectStates[deDeleteMapFile, AProject] := DisableDebugExpertState(ProjectStates[deDeleteMapFile, AProject]);
+ end
+ else
+ begin
+ // enable all actions
+ ProjectStates[deGenerateJdbg, AProject] := EnableDebugExpertState(ProjectStates[deGenerateJdbg, AProject]);
+ ProjectStates[deInsertJdbg, AProject] := EnableDebugExpertState(ProjectStates[deInsertJdbg, AProject]);
+ ProjectStates[deDeleteMapFile, AProject] := EnableDebugExpertState(ProjectStates[deDeleteMapFile, AProject]);
+ end;
+ end;
except
on ExceptionObj: TObject do
begin
@@ -461,43 +550,651 @@
end;
end;
+procedure TJclDebugExtension.DebugExpertActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ AProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ AProject := ActiveProject;
+ AEnabled := AProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectActions[AProject] <> [];
+ AAction.ImageIndex := FDebugImageIndex;
+ end
+ else
+ AAction.ImageIndex := FNoDebugImageIndex;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertMenuClick(Sender: TObject);
+var
+ EnabledActions: TDebugExpertActions;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ EnabledActions := ProjectActions[AProject]
+ else
+ EnabledActions := [];
+ FGenerateJdbgItem.Checked := deGenerateJdbg in EnabledActions;
+ FInsertJdbgItem.Checked := deInsertJdbg in EnabledActions;
+ FDeleteMapFileItem.Checked := deDeleteMapFile in EnabledActions;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertMenuDropDown(Sender: TObject);
+var
+ CheckTag, Index: Integer;
+ APopupMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ AProject: IOTAProject;
+ TestState: TDebugExpertState;
+ IndexAction: TDebugExpertAction;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ begin
+ TestState := ProjectStates[Low(TDebugExpertAction), AProject];
+ CheckTag := DebugExpertStateToInt(TestState);
+ for IndexAction := Succ(Low(TDebugExpertAction)) to High(TDebugExpertAction) do
+ if TestState <> ProjectStates[IndexAction, AProject] then
+ begin
+ CheckTag := -1;
+ Break;
+ end;
+ end
+ else
+ begin
+ TestState := GlobalStates[Low(TDebugExpertAction)];
+ CheckTag := DebugExpertStateToInt(TestState);
+ for IndexAction := Succ(Low(TDebugExpertAction)) to High(TDebugExpertAction) do
+ if TestState <> GlobalStates[IndexAction] then
+ begin
+ CheckTag := -1;
+ Break;
+ end;
+ end;
+ APopupMenu := Sender as TPopupMenu;
+ for Index := 0 to APopupMenu.Items.Count - 1 do
+ begin
+ AMenuItem := APopupMenu.Items.Items[Index];
+ AMenuItem.Enabled := (AProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ AProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ AProject := ActiveProject;
+ if AProject <> nil then
+ begin
+ ProjectStates[deGenerateJdbg, AProject] := AState;
+ ProjectStates[deInsertJdbg, AProject] := AState;
+ ProjectStates[deDeleteMapFile, AProject] := AState;
+ end
+ else
+ begin
+ GlobalStates[deGenerateJdbg] := AState;
+ GlobalStates[deInsertJdbg] := AState;
+ GlobalStates[deDeleteMapFile] := AState;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileActionExecute(Sender: TObject);
+var
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deDeleteMapFile, AProject] := ToggleDebugExpertState(ProjectStates[deDeleteMapFile, AProject])
+ else
+ GlobalStates[deDeleteMapFile] := ToggleDebugExpertState(GlobalStates[deDeleteMapFile]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ AProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ AProject := ActiveProject;
+ AEnabled := AProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deDeleteMapFile, AProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FDeleteMapFileImageIndex;
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoDeleteMapFileImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deDeleteMapFile, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deDeleteMapFile]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (AProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deDeleteMapFile, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deDeleteMapFile]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (AProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ AProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deDeleteMapFile, AProject] := AState
+ else
+ GlobalStates[deDeleteMapFile] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgActionExecute(Sender: TObject);
+var
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deGenerateJdbg, AProject] := ToggleDebugExpertState(ProjectStates[deGenerateJdbg, AProject])
+ else
+ GlobalStates[deGenerateJdbg] := ToggleDebugExpertState(GlobalStates[deGenerateJdbg]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ AProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ AProject := ActiveProject;
+ AEnabled := AProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deGenerateJdbg, AProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FGenerateJdbgImageIndex;
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoGenerateJdbgImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deGenerateJdbg, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deGenerateJdbg]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (AProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deGenerateJdbg, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deGenerateJdbg]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (AProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ AProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deGenerateJdbg, AProject] := AState
+ else
+ GlobalStates[deGenerateJdbg] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function TJclDebugExtension.GetGlobalState(Index: TDebugExpertAction): TDebugExpertState;
+begin
+ Result := FGlobalStates[Index];
+end;
+
+function TJclDebugExtension.GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
+var
+ PropIDs, PropValues: TDynAnsiStringArray;
+ Index: TDebugExpertAction;
+begin
+ SetLength(PropIDs, Integer(High(TDebugExpertAction)) - Integer(Low(TDebugExpertAction)) + 1);
+ for Index := Low(TDebugExpertAction) to High(TDebugExpertAction) do
+ PropIDs[Integer(Index)] := DebugActionNames[Index];
+ PropValues := GetProjectProperties(AProject, PropIDs);
+ Result := [];
+ for Index := Low(TDebugExpertAction) to High(TDebugExpertAction) do
+ case FGlobalStates[Index] of
+ deAlwaysEnabled:
+ Include(Result, Index);
+ deProjectEnabled:
+ if PropValues[Integer(Index)] <> DebugActionValues[False] then
+ Include(Result, Index);
+ deProjectDisabled:
+ if PropValues[Integer(Index)] = DebugActionValues[True] then
+ Include(Result, Index);
+ end;
+end;
+
+function TJclDebugExtension.GetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject): TDebugExpertState;
+var
+ PropIDs: TDynAnsiStringArray;
+begin
+ case FGlobalStates[Index] of
+ deAlwaysDisabled:
+ Result := deAlwaysDisabled;
+ deProjectDisabled:
+ begin
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ if GetProjectProperties(AProject, PropIDs)[0] = DebugActionValues[True] then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ end;
+ deProjectEnabled:
+ begin
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ if GetProjectProperties(AProject, PropIDs)[0] <> DebugActionValues[False] then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ end;
+ deAlwaysEnabled:
+ Result := deAlwaysEnabled;
+ else
+ raise EJclExpertException.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(FGlobalStates[Index])]);
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgActionExecute(Sender: TObject);
+var
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deInsertJdbg, AProject] := ToggleDebugExpertState(ProjectStates[deInsertJdbg, AProject])
+ else
+ GlobalStates[deInsertJdbg] := ToggleDebugExpertState(GlobalStates[deInsertJdbg]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ AProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ AProject := ActiveProject;
+ AEnabled := AProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deInsertJdbg, AProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FInsertJdbgImageIndex
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoInsertJdbgImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deInsertJdbg, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deInsertJdbg]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (AProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ AProject: IOTAProject;
+begin
+ try
+ AProject := ActiveProject;
+ if AProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deInsertJdbg, AProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deInsertJdbg]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (AProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ AProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ AProject := ActiveProject;
+ if AProject <> nil then
+ ProjectStates[deInsertJdbg, AProject] := AState
+ else
+ GlobalStates[deInsertJdbg] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
procedure TJclDebugExtension.LoadExpertValues;
begin
- EnableExpert := Settings.LoadBool(JclDebugEnabledRegValue, False);
- GenerateJdbg := Settings.LoadBool(JclDebugGenerateJdbgRegValue, False);
- InsertJdbg := Settings.LoadBool(JclDebugInsertJdbgRegValue, True);
+ GlobalStates[deGenerateJdbg] := IntToDebugExpertState(Settings.LoadInteger(JclDebugGenerateJdbgRegValue, 0));
+ GlobalStates[deInsertJdbg] := IntToDebugExpertState(Settings.LoadInteger(JclDebugInsertJdbgRegValue, 0));
+ GlobalStates[deDeleteMapFile] := IntToDebugExpertState(Settings.LoadInteger(JclDebugDeleteMapFileRegValue, 0));
end;
procedure TJclDebugExtension.SaveExpertValues;
...
[truncated message content] |
|
From: <ou...@us...> - 2007-12-25 16:16:37
|
Revision: 2279
http://jcl.svn.sourceforge.net/jcl/?rev=2279&view=rev
Author: outchy
Date: 2007-12-25 08:16:35 -0800 (Tue, 25 Dec 2007)
Log Message:
-----------
Moved declaration of action with drop down menu to shared design-time package.
Modified Paths:
--------------
trunk/jcl/experts/common/JclOtaUtils.pas
trunk/jcl/experts/versioncontrol/VersionControlImpl.pas
Modified: trunk/jcl/experts/common/JclOtaUtils.pas
===================================================================
--- trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-25 09:23:00 UTC (rev 2278)
+++ trunk/jcl/experts/common/JclOtaUtils.pas 2007-12-25 16:16:35 UTC (rev 2279)
@@ -35,6 +35,12 @@
uses
SysUtils, Classes, Windows,
Controls, ComCtrls, ActnList, Menus,
+ {$IFNDEF COMPILER8_UP}
+ Idemenuaction, // dependency walker reports a class TPopupAction in
+ // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons
+ // with a drop down menu, this class seems to have the same interface
+ // as TControlAction defined in Controls.pas for newer versions of Delphi
+ {$ENDIF COMPILER8_UP}
{$IFDEF MSWINDOWS}
JclDebug,
{$ENDIF MSWINDOWS}
@@ -45,6 +51,13 @@
MapFileOptionDetailed = 3;
type
+ // class of actions with a drop down menu on tool bars
+ {$IFDEF COMPILER8_UP}
+ TDropDownAction = TControlAction;
+ {$ELSE COMPILER8_UP}
+ TDropDownAction = TPopupAction;
+ {$ENDIF COMPILER8_UP}
+
// note to developers
// to avoid JCL exceptions to be reported as Borland's exceptions in automatic
// bug reports, all entry points should be protected with this code model:
Modified: trunk/jcl/experts/versioncontrol/VersionControlImpl.pas
===================================================================
--- trunk/jcl/experts/versioncontrol/VersionControlImpl.pas 2007-12-25 09:23:00 UTC (rev 2278)
+++ trunk/jcl/experts/versioncontrol/VersionControlImpl.pas 2007-12-25 16:16:35 UTC (rev 2279)
@@ -36,12 +36,6 @@
uses
SysUtils, Classes, Graphics, Controls, Menus, ActnList, Dialogs,
ToolsAPI,
-{$IFNDEF COMPILER8_UP}
- Idemenuaction, // dependency walker reports a class TPopupAction in
- // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons
- // with a drop down menu, this class seems to have the same interface
- // as TControlAction defined in Controls.pas for newer versions of Delphi
-{$ENDIF COMPILER8_UP}
JclOtaUtils, JclVersionCtrlCommonOptions;
type
@@ -229,12 +223,6 @@
const Action: TJclVersionControlAction): Boolean; override;
end;
-{$IFDEF COMPILER8_UP}
- TDropDownAction = TControlAction;
-{$ELSE COMPILER8_UP}
- TDropDownAction = TPopupAction;
-{$ENDIF COMPILER8_UP}
-
// design package entry point
procedure Register;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-25 09:23:02
|
Revision: 2278
http://jcl.svn.sourceforge.net/jcl/?rev=2278&view=rev
Author: outchy
Date: 2007-12-25 01:23:00 -0800 (Tue, 25 Dec 2007)
Log Message:
-----------
Mantis 4291 WithBOM is never used in JclUnicode.TWideStrings.SaveToStream
Modified Paths:
--------------
trunk/jcl/source/windows/JclUnicode.pas
Modified: trunk/jcl/source/windows/JclUnicode.pas
===================================================================
--- trunk/jcl/source/windows/JclUnicode.pas 2007-12-24 13:20:45 UTC (rev 2277)
+++ trunk/jcl/source/windows/JclUnicode.pas 2007-12-25 09:23:00 UTC (rev 2278)
@@ -5279,20 +5279,23 @@
case SaveFormat of
sfUTF16LSB :
begin
- Stream.WriteBuffer(BOM_UTF16_LSB[0],SizeOf(BOM_UTF16_LSB));
+ if WithBOM then
+ Stream.WriteBuffer(BOM_UTF16_LSB[0],SizeOf(BOM_UTF16_LSB));
Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16));
FSaved := True;
end;
sfUTF16MSB :
begin
- Stream.WriteBuffer(BOM_UTF16_MSB[0],SizeOf(BOM_UTF16_MSB));
+ if WithBOM then
+ Stream.WriteBuffer(BOM_UTF16_MSB[0],SizeOf(BOM_UTF16_MSB));
StrSwapByteOrder(PWideChar(SW));
Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16));
FSaved := True;
end;
sfUTF8 :
begin
- Stream.WriteBuffer(BOM_UTF8[0],SizeOf(BOM_UTF8));
+ if WithBOM then
+ Stream.WriteBuffer(BOM_UTF8[0],SizeOf(BOM_UTF8));
SA := WideStringToUTF8(SW);
Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(UTF8));
FSaved := True;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-24 13:20:47
|
Revision: 2277
http://jcl.svn.sourceforge.net/jcl/?rev=2277&view=rev
Author: outchy
Date: 2007-12-24 05:20:45 -0800 (Mon, 24 Dec 2007)
Log Message:
-----------
added xml and html mime types to subversion properties
Modified Paths:
--------------
trunk/thirdparty/svn_cleaner/SvnCleaner.xml
Property Changed:
----------------
trunk/donations/dcl/doc/Algorithms.html
trunk/donations/dcl/doc/Classes/AbstractContainer.html
trunk/donations/dcl/doc/Classes/ArrayList.html
trunk/donations/dcl/doc/Classes/ArraySet.html
trunk/donations/dcl/doc/Classes/BinaryTree.html
trunk/donations/dcl/doc/Classes/HashMap.html
trunk/donations/dcl/doc/Classes/HashSet.html
trunk/donations/dcl/doc/Classes/LinkedList.html
trunk/donations/dcl/doc/Classes/Queue.html
trunk/donations/dcl/doc/Classes/Stack.html
trunk/donations/dcl/doc/Classes/Vector.html
trunk/donations/dcl/doc/Interfaces/Array.html
trunk/donations/dcl/doc/Interfaces/Cloneable.html
trunk/donations/dcl/doc/Interfaces/Collection.html
trunk/donations/dcl/doc/Interfaces/Iterator.html
trunk/donations/dcl/doc/Interfaces/List.html
trunk/donations/dcl/doc/Interfaces/Map.html
trunk/donations/dcl/doc/Interfaces/Queue.html
trunk/donations/dcl/doc/Interfaces/Set.html
trunk/donations/dcl/doc/Interfaces/Stack.html
trunk/donations/dcl/doc/Interfaces/Tree.html
trunk/donations/dcl/doc/index.html
trunk/jcl/devtools/pgEdit.xml
trunk/jcl/docs/Contacting authors.html
trunk/jcl/docs/Contributors.html
trunk/jcl/docs/Experts.html
trunk/jcl/docs/MPL FAQ.html
trunk/jcl/docs/Readme.html
trunk/jcl/docs/cps.html
trunk/jcl/packages/xml/Jcl-R.xml
trunk/jcl/packages/xml/JclBaseExpert-D.xml
trunk/jcl/packages/xml/JclDebugExpert-D.xml
trunk/jcl/packages/xml/JclDebugExpertDLL-L.xml
trunk/jcl/packages/xml/JclFavoriteFoldersExpert-D.xml
trunk/jcl/packages/xml/JclFavoriteFoldersExpertDLL-L.xml
trunk/jcl/packages/xml/JclProjectAnalysisExpert-D.xml
trunk/jcl/packages/xml/JclProjectAnalysisExpertDLL-L.xml
trunk/jcl/packages/xml/JclRepositoryExpert-D.xml
trunk/jcl/packages/xml/JclRepositoryExpertDLL-L.xml
trunk/jcl/packages/xml/JclSIMDViewExpert-D.xml
trunk/jcl/packages/xml/JclSIMDViewExpertDLL-L.xml
trunk/jcl/packages/xml/JclThreadNameExpert-D.xml
trunk/jcl/packages/xml/JclThreadNameExpertDLL-L.xml
trunk/jcl/packages/xml/JclUsesExpert-D.xml
trunk/jcl/packages/xml/JclUsesExpertDLL-L.xml
trunk/jcl/packages/xml/JclVClx-R.xml
trunk/jcl/packages/xml/JclVcl-R.xml
trunk/jcl/packages/xml/JclVersionControlExpert-D.xml
trunk/jcl/packages/xml/JclVersionControlExpertDLL-L.xml
trunk/thirdparty/InnoSetup/InnoSetup/isfaq.htm
trunk/thirdparty/svn_cleaner/SvnCleaner.xml
Property changes on: trunk/donations/dcl/doc/Algorithms.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/AbstractContainer.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/ArrayList.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/ArraySet.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/BinaryTree.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/HashMap.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/HashSet.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/LinkedList.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/Queue.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/Stack.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Classes/Vector.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Array.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Cloneable.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Collection.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Iterator.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/List.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Map.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Queue.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Set.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Stack.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/Interfaces/Tree.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/donations/dcl/doc/index.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/devtools/pgEdit.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/docs/Contacting authors.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/docs/Contributors.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/docs/Experts.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/docs/MPL FAQ.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/docs/Readme.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/docs/cps.html
___________________________________________________________________
Name: svn:mime-type
+ text/html
Property changes on: trunk/jcl/packages/xml/Jcl-R.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclBaseExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclDebugExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclDebugExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclFavoriteFoldersExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclFavoriteFoldersExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclProjectAnalysisExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclProjectAnalysisExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclRepositoryExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclRepositoryExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclSIMDViewExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclSIMDViewExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclThreadNameExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclThreadNameExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclUsesExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclUsesExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclVClx-R.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclVcl-R.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclVersionControlExpert-D.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/jcl/packages/xml/JclVersionControlExpertDLL-L.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
Property changes on: trunk/thirdparty/InnoSetup/InnoSetup/isfaq.htm
___________________________________________________________________
Name: svn:mime-type
+ text/html
Modified: trunk/thirdparty/svn_cleaner/SvnCleaner.xml
===================================================================
--- trunk/thirdparty/svn_cleaner/SvnCleaner.xml 2007-12-24 12:57:36 UTC (rev 2276)
+++ trunk/thirdparty/svn_cleaner/SvnCleaner.xml 2007-12-24 13:20:45 UTC (rev 2277)
@@ -60,6 +60,16 @@
<value>*</value>
</property>
</setting>
+ <setting path="" mask="*.htm *.HTM *.html *.HTML" recurse="yes" dironly="no">
+ <property name="svn:mime-type">
+ <value>text/html</value>
+ </property>
+ </setting>
+ <setting path="" mask="*.xml *.XML" recurse="yes" dironly="no">
+ <property name="svn:mime-type">
+ <value>text/xml</value>
+ </property>
+ </setting>
<!-- specific properties based on directories -->
Property changes on: trunk/thirdparty/svn_cleaner/SvnCleaner.xml
___________________________________________________________________
Name: svn:mime-type
+ text/xml
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-24 12:57:41
|
Revision: 2276
http://jcl.svn.sourceforge.net/jcl/?rev=2276&view=rev
Author: outchy
Date: 2007-12-24 04:57:36 -0800 (Mon, 24 Dec 2007)
Log Message:
-----------
Mantis 4321 Memory leak occured in TJclBorRADToolInstallation.SubstitutePath
FEnvironmentVariables is never destroyed
Modified Paths:
--------------
trunk/jcl/source/common/JclBorlandTools.pas
Modified: trunk/jcl/source/common/JclBorlandTools.pas
===================================================================
--- trunk/jcl/source/common/JclBorlandTools.pas 2007-12-21 22:41:23 UTC (rev 2275)
+++ trunk/jcl/source/common/JclBorlandTools.pas 2007-12-24 12:57:36 UTC (rev 2276)
@@ -3218,6 +3218,7 @@
{$IFDEF KYLIX}
FConfigData.UpdateFile; // TMemIniFile.Destroy doesn't call UpdateFile
{$ENDIF KYLIX}
+ FreeAndNil(FEnvironmentVariables);
FreeAndNil(FConfigData);
inherited Destroy;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-21 22:41:27
|
Revision: 2275
http://jcl.svn.sourceforge.net/jcl/?rev=2275&view=rev
Author: outchy
Date: 2007-12-21 14:41:23 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Mantis 4317: BCB5 install not start: JclWin32.pas(72): Fatal: File not found: 'AccCtrl.dcu'
Fix: installer has to be built against rtl and vcl runtime packages
Modified Paths:
--------------
trunk/jcl/Install.bat
trunk/jcl/install/build/dcc32ex.dpr
trunk/jcl/install/build/dcc32ex.exe
Modified: trunk/jcl/Install.bat
===================================================================
--- trunk/jcl/Install.bat 2007-12-21 13:44:26 UTC (rev 2274)
+++ trunk/jcl/Install.bat 2007-12-21 22:41:23 UTC (rev 2275)
@@ -16,7 +16,7 @@
:: compile installer
-build\dcc32ex.exe -q -w -dJCLINSTALL -E..\bin -I..\source -U..\source\common;..\source\windows JediInstaller.dpr
+build\dcc32ex.exe --runtime-package-rtl --runtime-package-vcl --preserve-config -q -w -dJCLINSTALL -E..\bin -I..\source -U..\source\common;..\source\windows JediInstaller.dpr
if ERRORLEVEL 1 goto FailedCompile
Modified: trunk/jcl/install/build/dcc32ex.dpr
===================================================================
--- trunk/jcl/install/build/dcc32ex.dpr 2007-12-21 13:44:26 UTC (rev 2274)
+++ trunk/jcl/install/build/dcc32ex.dpr 2007-12-21 22:41:23 UTC (rev 2275)
@@ -24,6 +24,8 @@
UseJvclSource: Boolean;
RequireJclVersion: string;
RequireJvclVersion: string;
+ RuntimePackageRtl: Boolean;
+ RuntimePackageVcl: Boolean;
{ Helper functions because no SysUtils unit is used. }
{******************************************************************************}
@@ -770,6 +772,12 @@
if SameText('--use-jvcl-source', S) then
UseJvclSource := True
else
+ if SameText('--runtime-package-rtl', S) then
+ RuntimePackageRtl := True
+ else
+ if SameText('--runtime-package-vcl', S) then
+ RuntimePackageVcl := True
+ else
Break;
Result := CmdLine;
end;
@@ -853,12 +861,36 @@
WriteLn(f, '-I"' + Target.LibDirs + '"');
WriteLn(f, '-R"' + Target.LibDirs + '"');
WriteLn(f, '-O"' + Target.LibDirs + '"');
+ if (Target.Version = 5) then
+ begin
+ if RuntimePackageRtl or RuntimePackageVcl then
+ WriteLn(f, '-LUvcl50')
+ end
+ else
+ begin
+ if RuntimePackageRtl then
+ WriteLn(f, '-LUrtl');
+ if RuntimePackageVcl then
+ WriteLn(f, '-LUvcl');
+ end;
CloseFile(f);
{$I+}
if IOResult <> 0 then
begin
//WriteLn(ErrOutput, 'Failed to write file ', Dcc32Cfg);
ExtraOpts := ExtraOpts + '-U"' + Target.LibDirs + '" -I"' + Target.LibDirs + '" -R"' + Target.LibDirs + '" -O"' + Target.LibDirs + '" ';
+ if (Target.Version = 5) then
+ begin
+ if RuntimePackageRtl or RuntimePackageVcl then
+ ExtraOpts := ExtraOpts + '-LUvcl50 '
+ end
+ else
+ begin
+ if RuntimePackageRtl then
+ ExtraOpts := ExtraOpts + '-LUrtl ';
+ if RuntimePackageVcl then
+ ExtraOpts := ExtraOpts + '-LUvcl ';
+ end;
DeleteFile(PChar(Dcc32Cfg));
Dcc32Cfg := '';
end;
@@ -903,6 +935,8 @@
WriteLn(' --requires-jvcl Requires an installed JVCL');
WriteLn(' --use-jcl-source Use the source code instead of the DCUs for the JCL');
WriteLn(' --use-jvcl-source Use the source code instead of the DCUs for the JVCL');
+ WriteLn(' --runtime-package-rtl Link the executable against the rtl package');
+ WriteLn(' --runtime-package-vcl Link the executable against the vcl package');
WriteLn;
WriteLn('Environment variables:');
WriteLn(' DELPHIVERSION = d11 Prefer this Delphi/BCB/BDS version');
Modified: trunk/jcl/install/build/dcc32ex.exe
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:44:29
|
Revision: 2274
http://jcl.svn.sourceforge.net/jcl/?rev=2274&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:44:26 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Correction in test result table
Modified Paths:
--------------
trunk/help/Strings.dtx
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2007-12-21 13:44:03 UTC (rev 2273)
+++ trunk/help/Strings.dtx 2007-12-21 13:44:26 UTC (rev 2274)
@@ -3816,7 +3816,7 @@
Delphi Highlander Delphi 2005 positive positive
Delphi Highlander Delphi Highlander positive positive
Foobar v0.9.4 Foobar v0.10.3 negative positive
-Foobar v0.9.4 Foobar V0.9.4 positive positive
+Foobar v0.9.4 Foobar V0.9.4 negative negative
\xA0
0002 1 negative negative
1.5 1.06 positive negative
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:44:05
|
Revision: 2273
http://jcl.svn.sourceforge.net/jcl/?rev=2273&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:44:03 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Tests adapted to actual Ansi compare method
Modified Paths:
--------------
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2007-12-21 13:43:32 UTC (rev 2272)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2007-12-21 13:44:03 UTC (rev 2273)
@@ -1352,7 +1352,7 @@
AddCheck('Delphi Highlander', 'Delphi 2005', 1);
AddCheck('Delphi Highlander', 'Delphi Highlander', 1);
AddCheck('Foobar v0.9.4', 'Foobar v0.10.3', -1);
- AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', 1); // case-sensitivity test
+ AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', -1); // case-sensitivity test
// version/revision numbering schemes
AddCheck('1.2', '1.10', -1);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:43:33
|
Revision: 2272
http://jcl.svn.sourceforge.net/jcl/?rev=2272&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:43:32 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Now it actually uses the Ansi compare method ;)
Modified Paths:
--------------
trunk/jcl/source/common/JclStrings.pas
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2007-12-21 13:15:30 UTC (rev 2271)
+++ trunk/jcl/source/common/JclStrings.pas 2007-12-21 13:43:32 UTC (rev 2272)
@@ -5938,9 +5938,9 @@
else
begin
if insensitive then
- Result := StrLIComp(cur1, cur2, 1)
+ Result := AnsiStrLIComp(cur1, cur2, 1)
else
- Result := StrLComp(cur1, cur2, 1);
+ Result := AnsiStrLComp(cur1, cur2, 1);
Inc(cur1);
Inc(cur2);
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:15:34
|
Revision: 2271
http://jcl.svn.sourceforge.net/jcl/?rev=2271&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:15:30 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Added dunit tests for AnsiCompareNaturalStr and AnsiCompareNaturalText routines
Modified Paths:
--------------
trunk/qa/automated/dunit/units/TestJclStrings.pas
Modified: trunk/qa/automated/dunit/units/TestJclStrings.pas
===================================================================
--- trunk/qa/automated/dunit/units/TestJclStrings.pas 2007-12-21 13:15:05 UTC (rev 2270)
+++ trunk/qa/automated/dunit/units/TestJclStrings.pas 2007-12-21 13:15:30 UTC (rev 2271)
@@ -57,7 +57,7 @@
{ TJclStringTransformation }
type
- TJclStringTransormation = class (TTestCase)
+ TJclStringTransformation = class (TTestCase)
private
StringArray : array[0..5000] of string;
StringArray2 : array[0..5000] of string;
@@ -114,9 +114,16 @@
TJclStringSearchandReplace = class (TTestCase)
private
- StringArray : array[0..5000] of string;
- StringArray2 : array[0..5000] of string;
+ StringArray: array[0..5000] of string;
+ StringArray2: array[0..5000] of string;
+ ResultArray: array[0..5000] of Integer;
+ fillIdx: Integer;
+ procedure AddCheck(const s1, s2: string; const res: Integer);
+ function NormalizeCompareResult(res: Integer): Integer;
+ procedure TestCompare(idx: Integer; res: Integer; msgFmt: string);
published
+ procedure _AnsiCompareNaturalStr;
+ procedure _AnsiCompareNaturalText;
procedure _StrCharCount;
procedure _StrCharsCount;
procedure _StrStrCount;
@@ -362,10 +369,10 @@
end;
//==================================================================================================
-// TJclStringTransormation
+// TJclStringTransformation
//==================================================================================================
-procedure TJclStringTransormation._StrIsAlpha_StrIsAlpaNum_StrIsAlphaNumUnderscore;
+procedure TJclStringTransformation._StrIsAlpha_StrIsAlpaNum_StrIsAlphaNumUnderscore;
var
i: Integer;
s: String;
@@ -401,14 +408,14 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrContainsChars;
+procedure TJclStringTransformation._StrContainsChars;
begin
Fail('TODO: StrContainsChars');
end;
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrSame;
+procedure TJclStringTransformation._StrSame;
var
i: Integer;
@@ -429,7 +436,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrIsDigit_StrConsistsOfNumberChars_StrIsSubset;
+procedure TJclStringTransformation._StrIsDigit_StrConsistsOfNumberChars_StrIsSubset;
begin
// StrIsDigit
CheckEquals(StrIsDigit('') , False,'StrIsDigit'); // per doc
@@ -443,7 +450,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrCenter;
+procedure TJclStringTransformation._StrCenter;
var
i: Integer;
s, SN: String;
@@ -483,7 +490,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrCharPosLower;
+procedure TJclStringTransformation._StrCharPosLower;
begin
CheckEquals('This is a test.', StrCharPosLower('This is a test.', -1));
CheckEquals('This is a test.', StrCharPosLower('This is a test.', 0));
@@ -492,7 +499,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrCharPosUpper;
+procedure TJclStringTransformation._StrCharPosUpper;
begin
CheckEquals('This is a test.', StrCharPosUpper('This is a test.', -1));
CheckEquals('This is a test.', StrCharPosUpper('This is a test.', 0));
@@ -502,7 +509,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrDoubleQuote;
+procedure TJclStringTransformation._StrDoubleQuote;
var
SN, S: string;
i: Integer;
@@ -528,7 +535,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrEnsurePrefix;
+procedure TJclStringTransformation._StrEnsurePrefix;
var
Prefix, s, SN: String;
I: Integer;
@@ -564,7 +571,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrEnsureSuffix;
+procedure TJclStringTransformation._StrEnsureSuffix;
var
Suffix, s, SN: String;
I: Integer;
@@ -599,7 +606,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrEscapedToString_StrStringToEscaped;
+procedure TJclStringTransformation._StrEscapedToString_StrStringToEscaped;
var
s, sn: string;
i: Integer;
@@ -623,7 +630,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrLower_StrLowerInPlace_StrLowerBuff;
+procedure TJclStringTransformation._StrLower_StrLowerInPlace_StrLowerBuff;
var
sp: pointer;
i: Integer;
@@ -658,7 +665,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrMove;
+procedure TJclStringTransformation._StrMove;
var
Dest: string;
@@ -694,7 +701,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrPadLeft;
+procedure TJclStringTransformation._StrPadLeft;
var
S, S3: String;
I, v,t: Integer;
@@ -733,7 +740,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrPadRight;
+procedure TJclStringTransformation._StrPadRight;
var
S, S3: String;
I, v,t: Integer;
@@ -769,7 +776,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrProper_StrProperBuff;
+procedure TJclStringTransformation._StrProper_StrProperBuff;
var
s, s3, sn: string;
i: Integer;
@@ -804,7 +811,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrQuote;
+procedure TJclStringTransformation._StrQuote;
var
i: Integer;
s: string;
@@ -841,7 +848,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrRemoveChars;
+procedure TJclStringTransformation._StrRemoveChars;
var
i, t, v: Integer;
s, s3, sn: string;
@@ -884,7 +891,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrKeepChars;
+procedure TJclStringTransformation._StrKeepChars;
var
i, t: Integer;
s, s3, sn: String;
@@ -925,7 +932,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrReplace;
+procedure TJclStringTransformation._StrReplace;
var
s: string;
@@ -941,7 +948,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrReplaceChar;
+procedure TJclStringTransformation._StrReplaceChar;
begin
CheckEquals(StrReplaceChar('', 'a', 'b'),'','StrReplaceChar');
CheckEquals(StrReplaceChar('', #0, #0),'','StrReplaceChar');
@@ -952,7 +959,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrReplaceChars;
+procedure TJclStringTransformation._StrReplaceChars;
begin
CheckEquals(StrReplaceChars('', ['a'], 'b'),'','StrReplaceChars');
CheckEquals(StrReplaceChars('', ['a'], 'b'),'','StrReplaceChars');
@@ -962,7 +969,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrReplacebutChars;
+procedure TJclStringTransformation._StrReplacebutChars;
begin
CheckEquals(StrReplaceButChars('', ['a'], 'b'),'','StrReplaceButChars');
CheckEquals(StrReplaceButChars('xabababx', ['a','b'], 'v'),'vabababv','StrReplaceChars');
@@ -971,7 +978,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrRepeat;
+procedure TJclStringTransformation._StrRepeat;
var
i,t, v: Integer;
s, s3: string;
@@ -1004,7 +1011,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrRepeatLength;
+procedure TJclStringTransformation._StrRepeatLength;
begin
CheckEquals(StrRepeatLength('Test',0),'','StrRepeatLength');
CheckEquals(StrRepeatLength('Test',1),'T','StrRepeatLength');
@@ -1019,7 +1026,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrReverse_StrReverseInPlace;
+procedure TJclStringTransformation._StrReverse_StrReverseInPlace;
var
i,t: Integer;
s, s3: string;
@@ -1055,7 +1062,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrSingleQuote;
+procedure TJclStringTransformation._StrSingleQuote;
var
i: Integer;
s: string;
@@ -1075,7 +1082,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrSmartCase;
+procedure TJclStringTransformation._StrSmartCase;
begin
CheckEquals(StrSmartCase('',[' ']), '', 'StrSmartCase');
CheckEquals(StrSmartCase('project jedi',[' ']),'Project Jedi', 'StrSmartCase');
@@ -1087,7 +1094,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrStripNonNumberChars;
+procedure TJclStringTransformation._StrStripNonNumberChars;
var
i: Integer;
s: string;
@@ -1109,7 +1116,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrToHex;
+procedure TJclStringTransformation._StrToHex;
var
s, sn: string;
@@ -1128,7 +1135,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrTrimCharLeft;
+procedure TJclStringTransformation._StrTrimCharLeft;
var
i,t: Integer;
s, s3, sn: string;
@@ -1162,14 +1169,14 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrTrimCharsLeft;
+procedure TJclStringTransformation._StrTrimCharsLeft;
begin
Fail('TODO: StrTrimCharsLeft');
end;
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrTrimCharRight;
+procedure TJclStringTransformation._StrTrimCharRight;
var
i,t: Integer;
s, sn, s3: string;
@@ -1205,14 +1212,14 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrTrimCharsRight;
+procedure TJclStringTransformation._StrTrimCharsRight;
begin
Fail('TODO: _StrTrimCharsLeft');
end;
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrTrimQuotes;
+procedure TJclStringTransformation._StrTrimQuotes;
var
i: Integer;
s, s3, s4: string;
@@ -1239,7 +1246,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrUpper_StrUpperInPlace_StrUpperBuff;
+procedure TJclStringTransformation._StrUpper_StrUpperInPlace_StrUpperBuff;
var
i: Integer;
s4, s, s3: string;
@@ -1264,7 +1271,7 @@
//--------------------------------------------------------------------------------------------------
-procedure TJclStringTransormation._StrOemToAnsi_StrAnsiToOem;
+procedure TJclStringTransformation._StrOemToAnsi_StrAnsiToOem;
begin
Fail('TODO: _StrOemToAnsi_StrAnsiToOem');
end;
@@ -1305,6 +1312,120 @@
// String Search and Replace
//==================================================================================================
+procedure TJclStringSearchandReplace.AddCheck(const s1, s2: string; const res: Integer);
+begin
+ StringArray[fillIdx] := s1;
+ StringArray2[fillIdx] := s2;
+ ResultArray[fillIdx] := res;
+ Inc(fillIdx);
+end;
+
+function TJclStringSearchandReplace.NormalizeCompareResult(res: Integer): Integer;
+begin
+ if res < 0 then
+ Result := -1
+ else
+ if res > 0 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+procedure TJclStringSearchandReplace.TestCompare(idx: Integer; res: Integer; msgFmt: string);
+begin
+ CheckEquals(ResultArray[idx], res, Format('[%d] ' + msgFmt, [idx, QuotedStr(StringArray[idx]), QuotedStr(StringArray2[idx])]));
+end;
+
+procedure TJclStringSearchandReplace._AnsiCompareNaturalStr;
+var
+ idx: Integer;
+ s1: string;
+ s2: string;
+begin
+ fillIdx := 0;
+
+ // mixed strings, whitespace ignoring for number components only
+ AddCheck('Delphi 5', 'Delphi 2005', -1);
+ AddCheck('Delphi 5', 'Delphi 2005', -1);
+ AddCheck('Delphi 5', 'Delphi 6', -1);
+ AddCheck('Delphi 5', 'Delphi 6', -1);
+ AddCheck('Delphi Highlander', 'Delphi 2005', 1);
+ AddCheck('Delphi Highlander', 'Delphi Highlander', 1);
+ AddCheck('Foobar v0.9.4', 'Foobar v0.10.3', -1);
+ AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', 1); // case-sensitivity test
+
+ // version/revision numbering schemes
+ AddCheck('1.2', '1.10', -1);
+ AddCheck('1.20', '1.3a', 1);
+ AddCheck('1.1.1', '1.1', 1);
+ AddCheck('1.1', '1.1a', -1);
+ AddCheck('1.1.a', '1.1a', -1);
+ AddCheck('a', '1', 1);
+ AddCheck('a', 'b', -1);
+ AddCheck('1', '2', -1);
+
+ // leading zeroes overrule normal number comparisons
+ AddCheck('0002', '1', -1);
+ AddCheck('1.5', '1.06', 1);
+
+ // hyphen binds looser than period (technically compares a number against a non-number component)
+ AddCheck('1-2', '1-1', 1);
+ AddCheck('1-2', '1.2', -1);
+
+ // handling of positive/negative number comparisons
+ AddCheck('0', '-5', 1);
+ AddCheck('-5', '+2', -1);
+
+ for idx := 0 to fillIdx - 1 do
+ begin
+ s1 := StringArray[idx];
+ s2 := StringArray2[idx];
+ TestCompare(idx, NormalizeCompareResult(AnsiCompareNaturalStr(s1, s2)), 'AnsiCompareNaturalStr(%s, %s)');
+ end;
+end;
+
+procedure TJclStringSearchandReplace._AnsiCompareNaturalText;
+var
+ idx: Integer;
+begin
+ fillIdx := 0;
+
+ // mixed strings, whitespace ignoring for number components only
+ AddCheck('Delphi 5', 'Delphi 2005', -1);
+ AddCheck('Delphi 5', 'Delphi 2005', -1);
+ AddCheck('Delphi 5', 'Delphi 6', -1);
+ AddCheck('Delphi 5', 'Delphi 6', -1);
+ AddCheck('Delphi Highlander', 'Delphi 2005', 1);
+ AddCheck('Delphi Highlander', 'Delphi Highlander', 1);
+ AddCheck('Foobar v0.9.4', 'Foobar v0.10.3', -1);
+ AddCheck('Foobar v0.9.4', 'Foobar V0.9.4', 0); // case-sensitivity test
+
+ // version/revision numbering schemes
+ AddCheck('1.2', '1.10', -1);
+ AddCheck('1.20', '1.3a', 1);
+ AddCheck('1.1.1', '1.1', 1);
+ AddCheck('1.1', '1.1a', -1);
+ AddCheck('1.1.a', '1.1a', -1);
+ AddCheck('a', '1', 1);
+ AddCheck('a', 'b', -1);
+ AddCheck('1', '2', -1);
+
+ // leading zeroes overrule normal number comparisons
+ AddCheck('0002', '1', -1);
+ AddCheck('1.5', '1.06', 1);
+
+ // hyphen binds looser than period (technically compares a number against a non-number component)
+ AddCheck('1-2', '1-1', 1);
+ AddCheck('1-2', '1.2', -1);
+
+ // handling of positive/negative number comparisons
+ AddCheck('0', '-5', 1);
+ AddCheck('-5', '+2', -1);
+
+ for idx := 0 to fillIdx - 1 do
+ TestCompare(idx, NormalizeCompareResult(AnsiCompareNaturalText(StringArray[idx], StringArray2[idx])), 'AnsiCompareNaturalText(%s, %s)');
+end;
+
procedure TJclStringSearchandReplace._StrCharCount;
var
s: string;
@@ -2541,7 +2662,7 @@
end;
initialization
- RegisterTest('JCLStrings', TJclStringTransormation.Suite);
+ RegisterTest('JCLStrings', TJclStringTransformation.Suite);
RegisterTest('JCLStrings', TJclStringManagment.Suite);
RegisterTest('JCLStrings', TJclStringSearchandReplace.Suite);
RegisterTest('JCLStrings', TJclStringCharacterTestRoutines.Suite);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:15:08
|
Revision: 2270
http://jcl.svn.sourceforge.net/jcl/?rev=2270&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:15:05 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Added documentation for AnsiCompareNaturalStr and AnsiCompareNaturalText routines
Modified Paths:
--------------
trunk/help/Strings.dtx
Modified: trunk/help/Strings.dtx
===================================================================
--- trunk/help/Strings.dtx 2007-12-21 13:14:32 UTC (rev 2269)
+++ trunk/help/Strings.dtx 2007-12-21 13:15:05 UTC (rev 2270)
@@ -3789,4 +3789,97 @@
TJclTabSet.TabFrom
Donator:
Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@AnsiCompareNaturalStr
+<GROUP StringManipulation.StringTestRoutines>
+Summary:
+ Compares strings based on the current locale with case sensitivity and using a
+ 'natural order' algorithm.
+Description:
+ AnsiCompareNaturalStr implements a case-sensitive, 'natural' comparison
+ between the two supplied strings. It performs identical to the AnsiCompareStr
+ function but compares number components numerically, instead of
+ alphabetically.
+ Leading spaces are ignored when comparing numbers, but leading zeroes aren't.
+ This gives more sensible order when comparing and sorting fractional numbers.
+
+ The table below shows the behaviour of both AnsiCompareNaturalStr and
+ AnsiCompareStr:
+ <TABLE>
+S1 S2 AnsiCompareNaturalStr AnsiCompareStr
+------------ ------------ --------------------- --------------
+Delphi 5 Delphi 2005 negative positive
+Delphi 5 Delphi 2005 negative negative
+Delphi 5 Delphi 6 negative negative
+Delphi 5 Delphi 6 negative positive
+Delphi Highlander Delphi 2005 positive positive
+Delphi Highlander Delphi Highlander positive positive
+Foobar v0.9.4 Foobar v0.10.3 negative positive
+Foobar v0.9.4 Foobar V0.9.4 positive positive
+\xA0
+0002 1 negative negative
+1.5 1.06 positive negative
+\xA0
+0 -5 positive positive
+-5 +2 negative positive
+</TABLE>
+
+Parameters:
+ S1 - First string to compare.
+ S2 - Second string to compare.
+Result:
+ <c>0</c> if S1 is identical to S2
+ \xA0<i>- or -</i><p>
+ <c>a negative value</c> if S1 is less than S2
+ \xA0<i>- or -</i><p>
+ <c>a positive value</c> if S1 is greater than S2
+Donator:
+ Marcel Bestebroer
+--------------------------------------------------------------------------------
+@@AnsiCompareNaturalText
+<GROUP StringManipulation.StringTestRoutines>
+Summary:
+ Compares strings based on the current locale with case insensitivity and using
+ a 'natural order' algorithm.
+Description:
+ AnsiCompareNaturalText implements a case-insensitive, 'natural' comparison
+ between the two supplied strings. It performs identical to the AnsiCompareText
+ function but compares number components numerically, instead of
+ alphabetically.
+
+ Leading spaces are ignored when comparing numbers, but leading zeroes aren't.
+ This gives more sensible order when comparing and sorting fractional numbers.
+
+ The table below shows the behaviour of both AnsiCompareNaturalText and
+ AnsiCompareText:
+<TABLE>
+S1 S2 AnsiCompareNaturalText AnsiCompareText
+------------ ------------ ---------------------- ---------------
+Delphi 5 Delphi 2005 negative positive
+Delphi 5 Delphi 2005 negative negative
+Delphi 5 Delphi 6 negative negative
+Delphi 5 Delphi 6 negative positive
+Delphi Highlander Delphi 2005 positive positive
+Delphi Highlander Delphi Highlander positive positive
+Foobar v0.9.4 Foobar v0.10.3 negative positive
+Foobar v0.9.4 Foobar V0.9.4 zero zero
+\xA0
+0002 1 negative negative
+1.5 1.06 positive negative
+\xA0
+0 -5 positive positive
+-5 +2 negative positive
+</TABLE>
+Parameters:
+ S1 - First string to compare.
+ S2 - Second string to compare.
+Result:
+ <c>0</c> if S1 is identical to S2
+ \xA0<i>- or -</i><p>
+ <c>a negative value</c> if S1 is less than S2
+ \xA0<i>- or -</i><p>
+ <c>a positive value</c> if S1 is greater than S2
+Donator:
+ Marcel Bestebroer
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-21 13:14:34
|
Revision: 2269
http://jcl.svn.sourceforge.net/jcl/?rev=2269&view=rev
Author: jedi_mbe
Date: 2007-12-21 05:14:32 -0800 (Fri, 21 Dec 2007)
Log Message:
-----------
Added AnsiCompareNaturalStr and AnsiCompareNaturalText routines to JclStrings
Modified Paths:
--------------
trunk/jcl/source/common/JclStrings.pas
Modified: trunk/jcl/source/common/JclStrings.pas
===================================================================
--- trunk/jcl/source/common/JclStrings.pas 2007-12-16 19:02:01 UTC (rev 2268)
+++ trunk/jcl/source/common/JclStrings.pas 2007-12-21 13:14:32 UTC (rev 2269)
@@ -574,6 +574,10 @@
end;
{$ENDIF ~CLR}
+
+function AnsiCompareNaturalStr(const S1, S2: string): Integer;
+function AnsiCompareNaturalText(const S1, S2: string): Integer;
+
// Exceptions
type
EJclStringError = EJclError;
@@ -5837,6 +5841,122 @@
end;
{$ENDIF ~CLR}
+function AnsiCompareNatural(const S1, S2: string; insensitive: Boolean): Integer;
+var
+ cur1: PAnsiChar;
+ cur2: PAnsiChar;
+
+ procedure NumberCompare;
+ var
+ isReallyNumber: Boolean;
+ firstDiffBreaks: Boolean;
+ begin
+ Result := 0;
+ isReallyNumber := False;
+ // count leading spaces in S1
+ while cur1^ = ' ' do
+ begin
+ Dec(Result);
+ Inc(cur1);
+ end;
+ // count leading spaces in S2 (canceling them out against the ones in S1)
+ while cur2^ = ' ' do
+ begin
+ Inc(Result);
+ Inc(cur2);
+ end;
+
+ // if spaces match, or both strings are actually followed by a numeric character, continue the checks
+ if (Result = 0) or ((cur1^ in ['+', '-', '0' .. '9']) and (cur2^ in ['+', '-', '0' .. '9'])) then
+ begin
+ // Check signed number
+ if (cur1^ = '-') and (cur2^ <> '-') then
+ Result := 1
+ else
+ if (cur2^ = '-') and (cur1^ <> '-') then
+ Result := -1
+ else
+ Result := 0;
+
+ if cur1^ in ['-', '+'] then
+ Inc(cur1);
+ if cur2^ in ['-', '+'] then
+ Inc(cur2);
+
+ firstDiffBreaks := (cur1^ = '0') or (cur2^ = '0');
+ while (cur1^ in ['0' .. '9']) and (cur2^ in ['0' .. '9']) do
+ begin
+ isReallyNumber := True;
+ if (Result = 0) and (cur1^ < cur2^) then
+ Result := -1
+ else
+ if (Result = 0) and (cur1^ > cur2^) then
+ Result := 1;
+ if firstDiffBreaks and (Result <> 0) then
+ Break;
+ Inc(cur1);
+ Inc(cur2);
+ end;
+
+ if isReallyNumber then
+ begin
+ if not firstDiffBreaks then
+ begin
+ if cur1^ in ['0' .. '9'] then
+ Result := 1
+ else
+ if cur2^ in ['0' .. '9'] then
+ Result := -1;
+ end;
+ end;
+ end;
+ end;
+
+begin
+ cur1 := PAnsiChar(S1);
+ cur2 := PAnsiChar(S2);
+ Result := 0;
+ while (Result = 0) do
+ begin
+ if (cur1^ = #0) and (cur2^ = #0) then
+ Break
+ else
+ if (cur1^ = '-') and (cur2^ in ['+','0' .. '9']) then
+ Result := -1
+ else
+ if (cur2^ = '-') and (cur1^ in ['+','0' .. '9']) then
+ Result := 1
+ else
+ if (cur1^ in ['+', '-', ' ', '0' .. '9']) and (cur2^ in ['+', '-', ' ', '0' .. '9']) then
+ NumberCompare
+ else
+ if (cur1^ = #0) and (cur2^ <> #0) then
+ Result := -1
+ else
+ if (cur1^ <> #0) and (cur1^ = #0) then
+ Result := 1
+ else
+ begin
+ if insensitive then
+ Result := StrLIComp(cur1, cur2, 1)
+ else
+ Result := StrLComp(cur1, cur2, 1);
+ Inc(cur1);
+ Inc(cur2);
+ end;
+ end;
+end;
+
+function AnsiCompareNaturalStr(const S1, S2: string): Integer;
+begin
+ Result := AnsiCompareNatural(S1, S2, False);
+end;
+
+function AnsiCompareNaturalText(const S1, S2: string): Integer;
+begin
+ Result := AnsiCompareNatural(S1, S2, True);
+end;
+
{$IFDEF CLR}
{$IFDEF UNITVERSIONING}
initialization
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-16 19:02:02
|
Revision: 2268
http://jcl.svn.sourceforge.net/jcl/?rev=2268&view=rev
Author: outchy
Date: 2007-12-16 11:02:01 -0800 (Sun, 16 Dec 2007)
Log Message:
-----------
Some cleanup of the repository
Modified Paths:
--------------
trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas
trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr
trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss
trunk/thirdparty/InnoSetup/InnoSetup/ModifiedInnoSetup.txt
trunk/thirdparty/InnoSetup/InnoSetup/license.txt
trunk/thirdparty/svn_cleaner/SvnCleaner.xml
Property Changed:
----------------
trunk/jcl/source/prototypes/
trunk/jcl/source/vcl/
trunk/jcl/source/visclx/
trunk/jcl/source/windows/
trunk/thirdparty/InnoSetup/CompInstall/
trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas
trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr
trunk/thirdparty/InnoSetup/InnoSetup/
trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss
trunk/thirdparty/InnoSetup/InnoSetup/Languages/
trunk/thirdparty/InnoSetup/InnoSetup/ModifiedInnoSetup.txt
trunk/thirdparty/InnoSetup/InnoSetup/WizModernImage-IS.bmp
trunk/thirdparty/InnoSetup/InnoSetup/WizModernImage.bmp
trunk/thirdparty/InnoSetup/InnoSetup/WizModernSmallImage-IS.bmp
trunk/thirdparty/InnoSetup/InnoSetup/WizModernSmallImage.bmp
trunk/thirdparty/InnoSetup/InnoSetup/license.txt
Property changes on: trunk/jcl/source/prototypes
___________________________________________________________________
Name: svn:ignore
- *.~*
*.hpp
*.dcu
__history
+ *.~*
*.hpp
*.dcu
*.o
*.ppu
*.rst
__history
Property changes on: trunk/jcl/source/vcl
___________________________________________________________________
Name: svn:ignore
- *.~*
*.hpp
*.dcu
__history
+ *.~*
*.hpp
*.dcu
*.o
*.ppu
*.rst
__history
Property changes on: trunk/jcl/source/visclx
___________________________________________________________________
Name: svn:ignore
- *.~*
*.hpp
*.dcu
__history
+ *.~*
*.hpp
*.dcu
*.o
*.ppu
*.rst
__history
Property changes on: trunk/jcl/source/windows
___________________________________________________________________
Name: svn:ignore
- *.~*
*.hpp
*.dcu
__history
+ *.~*
*.hpp
*.dcu
*.o
*.ppu
*.rst
__history
Property changes on: trunk/thirdparty/InnoSetup/CompInstall
___________________________________________________________________
Name: bugtraq:url
+ http://homepages.codegear.com/jedi/issuetracker/view.php?id=%BUGID%
Name: bugtraq:message
+ (Mantis #%BUGID%)
Name: bugtraq:logregex
+ [Mm]antis #?(\d+)(,? ?#?(\d+))+
(\d+)
Modified: trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas
===================================================================
--- trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas 2007-12-08 14:57:05 UTC (rev 2267)
+++ trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas 2007-12-16 19:02:01 UTC (rev 2268)
@@ -1,359 +1,359 @@
-unit CompInst;
-
-interface
-
-uses
- Windows, SysUtils, Classes, JclBorlandTools;
-
-function Installations: TJclBorRADToolInstallations;
-
-function compinst_init: Integer; stdcall;
-
-function compinst_isDelphiInstalled(Version: Integer): Integer; stdcall;
-function compinst_isBCBInstalled(Version: Integer): Integer; stdcall;
-function compinst_isBDSInstalled(IDEVersion: Integer): Integer; stdcall;
-
-function compinst_installDelphiDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
-function compinst_installBCBDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
-function compinst_uninstallDelphiDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
-function compinst_uninstallBCBDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
-function compinst_uninstallDelphiDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
-function compinst_uninstallBCBDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
-
-function compinst_installDelphiExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
-function compinst_installBCBExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
-function compinst_uninstallDelphiExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
-function compinst_uninstallBCBExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
-function compinst_uninstallDelphiExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
-function compinst_uninstallBCBExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
-
-function compinst_addDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-function compinst_addBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-function compinst_removeDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-function compinst_removeBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-
-implementation
-
-uses
- JclPeImage, StrUtils;
-
-var
- GlobalInstallations: TJclBorRADToolInstallations;
-
-function GetPackageDescription(const BplFilename: string): string;
-var
- hLib: THandle;
- Info: TJclPePackageInfo;
-begin
- Result := '';
- hLib := LoadLibraryEx(PChar(BplFilename), 0, LOAD_LIBRARY_AS_DATAFILE);
- if hLib <> 0 then
- begin
- Info := TJclPePackageInfo.Create(hLib);
- try
- Result := Trim(Info.Description);
- finally
- Info.Free;
- end;
- FreeLibrary(hLib);
- end;
- if Result = '' then
- Result := ChangeFileExt(ExtractFileName(BplFilename), '');
-end;
-
-procedure SplitPaths(List: TStrings; const Paths: string);
-var
- I, StartI: Integer;
- S: string;
-begin
- StartI := 1;
- for I := 1 to Length(Paths) do
- begin
- if Paths[I] = PathSep then
- begin
- S := Trim(Copy(Paths, StartI, I - StartI));
- if S <> '' then
- List.Add(S);
- StartI := I + 1;
- end;
- end;
- S := Trim(Copy(Paths, StartI, MaxInt));
- if S <> '' then
- List.Add(S);
-end;
-
-function Installations: TJclBorRADToolInstallations;
-begin
- if GlobalInstallations = nil then
- GlobalInstallations := TJclBorRADToolInstallations.Create;
- Result := GlobalInstallations;
-end;
-
-function compinst_init: Integer; stdcall;
-var
- I: Integer;
- Inst: TJclBorRADToolInstallation;
- VStr: string;
-begin
- Result := Installations.Count;
- for I := 0 to Installations.Count - 1 do
- begin
- Inst := Installations[I];
- case Inst.RadToolKind of
- brDelphi:
- begin
- VStr := IntToStr(Inst.VersionNumber);
- SetEnvironmentVariable(PChar('DELPHI' + VStr), PChar(Inst.RootDir));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
- end;
- brCppBuilder:
- begin
- VStr := IntToStr(Inst.VersionNumber);
- SetEnvironmentVariable(PChar('BCB' + VStr), PChar(Inst.RootDir));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
- end;
- brBorlandDevStudio:
- begin
- VStr := IntToStr(9 - 3 + Inst.VersionNumber); // Delphi 9 is BDS 3
- if bpDelphi32 in Inst.Personalities then
- begin
- SetEnvironmentVariable(PChar('DELPHI' + VStr), PChar(Inst.RootDir));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
- SetEnvironmentVariable(PChar('DELPHI' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
- end;
- if bpBCBuilder32 in Inst.Personalities then
- begin
- SetEnvironmentVariable(PChar('BCB' + VStr), PChar(Inst.RootDir));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
- SetEnvironmentVariable(PChar('BCB' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
- end;
- end;
- end;
- end;
-end;
-
-function compinst_IsDelphiInstalled(Version: Integer): Integer; stdcall;
-begin
- Result := Ord(Installations.DelphiVersionInstalled[Version]);
-end;
-
-function compinst_IsBCBInstalled(Version: Integer): Integer; stdcall;
-begin
- Result := Ord(Installations.BCBVersionInstalled[Version]);
-end;
-
-function compinst_IsBDSInstalled(IDEVersion: Integer): Integer; stdcall;
-begin
- Result := Ord(Installations.BCBVersionInstalled[IDEVersion]);
-end;
-
-{ Design Packages }
-
-function InstallDesignPackage(Inst: TJclBorRADToolInstallation; const BplFilename, Description: string): Integer;
-var
- Filename, Descr: string;
- MatchFound: TFilenameCaseMatch;
-begin
- Result := 0;
- if Inst <> nil then
- begin
- Descr := Description;
- if Descr = '' then
- Descr := GetPackageDescription(BplFilename);
- Filename := ExpandFileNameCase(BplFilename, MatchFound); // correct file name
- if Inst.RegisterPackage(Filename, Descr) then
- Result := 1;
- end;
-end;
-
-function UninstallDesignPackage(Inst: TJclBorRADToolInstallation; const BplFilename: string): Integer;
-begin
- Result := 0;
- if Inst <> nil then
- if Inst.UnregisterPackage(BplFilename) then
- Result := 1;
-end;
-
-function UninstallDesignPackagesPrefixed(Inst: TJclBorRADToolInstallation; const BplFilenamePrefix: string): Integer;
-var
- I: Integer;
- Filename: string;
-begin
- Result := 0;
- if Inst <> nil then
- begin
- for I := Inst.IdePackages.Count - 1 downto 0 do
- begin
- FileName := Inst.IdePackages.PackageFileNames[I];
- if AnsiStartsText(BplFilenamePrefix, ExtractFileName(FileName)) then
- begin
- UninstallDesignPackage(Inst, Filename);
- Inc(Result);
- end;
- end;
- end;
-end;
-
-{ Experts }
-
-function InstallExpert(Inst: TJclBorRADToolInstallation; const Filename, Description: string): Integer;
-var
- MatchFound: TFilenameCaseMatch;
-begin
- Result := 0;
- if Inst <> nil then
- begin
- if Inst.RegisterExpert(ExpandFileNameCase(Filename, MatchFound), Description) then
- Result := 1;
- end;
-end;
-
-function UninstallExpert(Inst: TJclBorRADToolInstallation; const Filename: string): Integer;
-begin
- Result := 0;
- if Inst <> nil then
- if Inst.UnregisterExpert(Filename) then
- Result := 1;
-end;
-
-function UninstallExpertsPrefixed(Inst: TJclBorRADToolInstallation; const FilenamePrefix: string): Integer;
-var
- I: Integer;
- Filename: string;
-begin
- Result := 0;
- if Inst <> nil then
- begin
- for I := Inst.IdePackages.ExpertCount - 1 downto 0 do
- begin
- FileName := Inst.IdePackages.ExpertFileNames[I];
- if AnsiStartsText(FilenamePrefix, ExtractFileName(FileName)) then
- begin
- UninstallExpert(Inst, Filename);
- Inc(Result);
- end;
- end;
- end;
-end;
-
-{ Search Paths }
-
-function ChangeSearchPaths(Inst: TJclBorRADToolInstallation; Installing: Boolean; const SearchPaths, DebugPaths, BrowsePaths: string): Integer;
-begin
- Result := 0;
- if Inst <> nil then
- begin
- if Installing then
- begin
- Inst.AddToLibrarySearchPath(SearchPaths);
- Inst.AddToDebugDCUPath(DebugPaths);
- Inst.AddToLibraryBrowsingPath(BrowsePaths);
- end
- else
- begin
- Inst.RemoveFromLibrarySearchPath(SearchPaths);
- Inst.RemoveFromDebugDCUPath(DebugPaths);
- Inst.RemoveFromLibraryBrowsingPath(BrowsePaths);
- end;
- Result := 1;
- end;
-end;
-
-{ Design Packages }
-
-function compinst_installDelphiDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
-begin
- Result := InstallDesignPackage(Installations.DelphiInstallationFromVersion[Version], BplFilename, Description);
-end;
-
-function compinst_installBCBDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
-begin
- Result := InstallDesignPackage(Installations.BCBInstallationFromVersion[Version], BplFilename, Description);
-end;
-
-function compinst_uninstallDelphiDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
-begin
- Result := UninstallDesignPackage(Installations.DelphiInstallationFromVersion[Version], BplFilename);
-end;
-
-function compinst_uninstallBCBDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
-begin
- Result := UninstallDesignPackage(Installations.BCBInstallationFromVersion[Version], BplFilename);
-end;
-
-function compinst_uninstallDelphiDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
-begin
- Result := UninstallDesignPackagesPrefixed(Installations.DelphiInstallationFromVersion[Version], BplFilenamePrefix);
-end;
-
-function compinst_uninstallBCBDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
-begin
- Result := UninstallDesignPackagesPrefixed(Installations.BCBInstallationFromVersion[Version], BplFilenamePrefix);
-end;
-
-{ Experts }
-
-function compinst_installDelphiExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
-begin
- Result := InstallExpert(Installations.DelphiInstallationFromVersion[Version], Filename, Description);
-end;
-
-function compinst_installBCBExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
-begin
- Result := InstallExpert(Installations.BCBInstallationFromVersion[Version], Filename, Description);
-end;
-
-function compinst_uninstallDelphiExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
-begin
- Result := UninstallExpert(Installations.DelphiInstallationFromVersion[Version], Filename);
-end;
-
-function compinst_uninstallBCBExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
-begin
- Result := UninstallExpert(Installations.BCBInstallationFromVersion[Version], Filename);
-end;
-
-function compinst_uninstallDelphiExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
-begin
- Result := UninstallExpertsPrefixed(Installations.DelphiInstallationFromVersion[Version], FilenamePrefix);
-end;
-
-function compinst_uninstallBCBExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
-begin
- Result := UninstallExpertsPrefixed(Installations.BCBInstallationFromVersion[Version], FilenamePrefix);
-end;
-
-{ Search Paths }
-
-function compinst_addDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-begin
- Result := ChangeSearchPaths(Installations.DelphiInstallationFromVersion[Version], True, SearchPaths, DebugPaths, BrowsePaths);
-end;
-
-function compinst_addBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-begin
- Result := ChangeSearchPaths(Installations.BCBInstallationFromVersion[Version], True, SearchPaths, DebugPaths, BrowsePaths);
-end;
-
-function compinst_removeDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-begin
- Result := ChangeSearchPaths(Installations.DelphiInstallationFromVersion[Version], False, SearchPaths, DebugPaths, BrowsePaths);
-end;
-
-function compinst_removeBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
-begin
- Result := ChangeSearchPaths(Installations.BCBInstallationFromVersion[Version], False, SearchPaths, DebugPaths, BrowsePaths);
-end;
-
-initialization
-
-finalization
- Installations.Free;
-
-end.
+unit CompInst;
+
+interface
+
+uses
+ Windows, SysUtils, Classes, JclBorlandTools;
+
+function Installations: TJclBorRADToolInstallations;
+
+function compinst_init: Integer; stdcall;
+
+function compinst_isDelphiInstalled(Version: Integer): Integer; stdcall;
+function compinst_isBCBInstalled(Version: Integer): Integer; stdcall;
+function compinst_isBDSInstalled(IDEVersion: Integer): Integer; stdcall;
+
+function compinst_installDelphiDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
+function compinst_installBCBDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
+function compinst_uninstallDelphiDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
+function compinst_uninstallBCBDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
+function compinst_uninstallDelphiDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
+function compinst_uninstallBCBDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
+
+function compinst_installDelphiExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
+function compinst_installBCBExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
+function compinst_uninstallDelphiExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
+function compinst_uninstallBCBExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
+function compinst_uninstallDelphiExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
+function compinst_uninstallBCBExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
+
+function compinst_addDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+function compinst_addBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+function compinst_removeDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+function compinst_removeBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+
+implementation
+
+uses
+ JclPeImage, StrUtils;
+
+var
+ GlobalInstallations: TJclBorRADToolInstallations;
+
+function GetPackageDescription(const BplFilename: string): string;
+var
+ hLib: THandle;
+ Info: TJclPePackageInfo;
+begin
+ Result := '';
+ hLib := LoadLibraryEx(PChar(BplFilename), 0, LOAD_LIBRARY_AS_DATAFILE);
+ if hLib <> 0 then
+ begin
+ Info := TJclPePackageInfo.Create(hLib);
+ try
+ Result := Trim(Info.Description);
+ finally
+ Info.Free;
+ end;
+ FreeLibrary(hLib);
+ end;
+ if Result = '' then
+ Result := ChangeFileExt(ExtractFileName(BplFilename), '');
+end;
+
+procedure SplitPaths(List: TStrings; const Paths: string);
+var
+ I, StartI: Integer;
+ S: string;
+begin
+ StartI := 1;
+ for I := 1 to Length(Paths) do
+ begin
+ if Paths[I] = PathSep then
+ begin
+ S := Trim(Copy(Paths, StartI, I - StartI));
+ if S <> '' then
+ List.Add(S);
+ StartI := I + 1;
+ end;
+ end;
+ S := Trim(Copy(Paths, StartI, MaxInt));
+ if S <> '' then
+ List.Add(S);
+end;
+
+function Installations: TJclBorRADToolInstallations;
+begin
+ if GlobalInstallations = nil then
+ GlobalInstallations := TJclBorRADToolInstallations.Create;
+ Result := GlobalInstallations;
+end;
+
+function compinst_init: Integer; stdcall;
+var
+ I: Integer;
+ Inst: TJclBorRADToolInstallation;
+ VStr: string;
+begin
+ Result := Installations.Count;
+ for I := 0 to Installations.Count - 1 do
+ begin
+ Inst := Installations[I];
+ case Inst.RadToolKind of
+ brDelphi:
+ begin
+ VStr := IntToStr(Inst.VersionNumber);
+ SetEnvironmentVariable(PChar('DELPHI' + VStr), PChar(Inst.RootDir));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
+ end;
+ brCppBuilder:
+ begin
+ VStr := IntToStr(Inst.VersionNumber);
+ SetEnvironmentVariable(PChar('BCB' + VStr), PChar(Inst.RootDir));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
+ end;
+ brBorlandDevStudio:
+ begin
+ VStr := IntToStr(9 - 3 + Inst.VersionNumber); // Delphi 9 is BDS 3
+ if bpDelphi32 in Inst.Personalities then
+ begin
+ SetEnvironmentVariable(PChar('DELPHI' + VStr), PChar(Inst.RootDir));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
+ SetEnvironmentVariable(PChar('DELPHI' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
+ end;
+ if bpBCBuilder32 in Inst.Personalities then
+ begin
+ SetEnvironmentVariable(PChar('BCB' + VStr), PChar(Inst.RootDir));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'BPL'), PChar(Inst.BPLOutputPath));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'DCP'), PChar(Inst.DCPOutputPath));
+ SetEnvironmentVariable(PChar('BCB' + VStr + 'RegKey'), PChar(Inst.ConfigDataLocation));
+ end;
+ end;
+ end;
+ end;
+end;
+
+function compinst_IsDelphiInstalled(Version: Integer): Integer; stdcall;
+begin
+ Result := Ord(Installations.DelphiVersionInstalled[Version]);
+end;
+
+function compinst_IsBCBInstalled(Version: Integer): Integer; stdcall;
+begin
+ Result := Ord(Installations.BCBVersionInstalled[Version]);
+end;
+
+function compinst_IsBDSInstalled(IDEVersion: Integer): Integer; stdcall;
+begin
+ Result := Ord(Installations.BCBVersionInstalled[IDEVersion]);
+end;
+
+{ Design Packages }
+
+function InstallDesignPackage(Inst: TJclBorRADToolInstallation; const BplFilename, Description: string): Integer;
+var
+ Filename, Descr: string;
+ MatchFound: TFilenameCaseMatch;
+begin
+ Result := 0;
+ if Inst <> nil then
+ begin
+ Descr := Description;
+ if Descr = '' then
+ Descr := GetPackageDescription(BplFilename);
+ Filename := ExpandFileNameCase(BplFilename, MatchFound); // correct file name
+ if Inst.RegisterPackage(Filename, Descr) then
+ Result := 1;
+ end;
+end;
+
+function UninstallDesignPackage(Inst: TJclBorRADToolInstallation; const BplFilename: string): Integer;
+begin
+ Result := 0;
+ if Inst <> nil then
+ if Inst.UnregisterPackage(BplFilename) then
+ Result := 1;
+end;
+
+function UninstallDesignPackagesPrefixed(Inst: TJclBorRADToolInstallation; const BplFilenamePrefix: string): Integer;
+var
+ I: Integer;
+ Filename: string;
+begin
+ Result := 0;
+ if Inst <> nil then
+ begin
+ for I := Inst.IdePackages.Count - 1 downto 0 do
+ begin
+ FileName := Inst.IdePackages.PackageFileNames[I];
+ if AnsiStartsText(BplFilenamePrefix, ExtractFileName(FileName)) then
+ begin
+ UninstallDesignPackage(Inst, Filename);
+ Inc(Result);
+ end;
+ end;
+ end;
+end;
+
+{ Experts }
+
+function InstallExpert(Inst: TJclBorRADToolInstallation; const Filename, Description: string): Integer;
+var
+ MatchFound: TFilenameCaseMatch;
+begin
+ Result := 0;
+ if Inst <> nil then
+ begin
+ if Inst.RegisterExpert(ExpandFileNameCase(Filename, MatchFound), Description) then
+ Result := 1;
+ end;
+end;
+
+function UninstallExpert(Inst: TJclBorRADToolInstallation; const Filename: string): Integer;
+begin
+ Result := 0;
+ if Inst <> nil then
+ if Inst.UnregisterExpert(Filename) then
+ Result := 1;
+end;
+
+function UninstallExpertsPrefixed(Inst: TJclBorRADToolInstallation; const FilenamePrefix: string): Integer;
+var
+ I: Integer;
+ Filename: string;
+begin
+ Result := 0;
+ if Inst <> nil then
+ begin
+ for I := Inst.IdePackages.ExpertCount - 1 downto 0 do
+ begin
+ FileName := Inst.IdePackages.ExpertFileNames[I];
+ if AnsiStartsText(FilenamePrefix, ExtractFileName(FileName)) then
+ begin
+ UninstallExpert(Inst, Filename);
+ Inc(Result);
+ end;
+ end;
+ end;
+end;
+
+{ Search Paths }
+
+function ChangeSearchPaths(Inst: TJclBorRADToolInstallation; Installing: Boolean; const SearchPaths, DebugPaths, BrowsePaths: string): Integer;
+begin
+ Result := 0;
+ if Inst <> nil then
+ begin
+ if Installing then
+ begin
+ Inst.AddToLibrarySearchPath(SearchPaths);
+ Inst.AddToDebugDCUPath(DebugPaths);
+ Inst.AddToLibraryBrowsingPath(BrowsePaths);
+ end
+ else
+ begin
+ Inst.RemoveFromLibrarySearchPath(SearchPaths);
+ Inst.RemoveFromDebugDCUPath(DebugPaths);
+ Inst.RemoveFromLibraryBrowsingPath(BrowsePaths);
+ end;
+ Result := 1;
+ end;
+end;
+
+{ Design Packages }
+
+function compinst_installDelphiDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
+begin
+ Result := InstallDesignPackage(Installations.DelphiInstallationFromVersion[Version], BplFilename, Description);
+end;
+
+function compinst_installBCBDesignPackage(Version: Integer; const BplFilename, Description: PChar): Integer; stdcall;
+begin
+ Result := InstallDesignPackage(Installations.BCBInstallationFromVersion[Version], BplFilename, Description);
+end;
+
+function compinst_uninstallDelphiDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
+begin
+ Result := UninstallDesignPackage(Installations.DelphiInstallationFromVersion[Version], BplFilename);
+end;
+
+function compinst_uninstallBCBDesignPackage(Version: Integer; const BplFilename: PChar): Integer; stdcall;
+begin
+ Result := UninstallDesignPackage(Installations.BCBInstallationFromVersion[Version], BplFilename);
+end;
+
+function compinst_uninstallDelphiDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
+begin
+ Result := UninstallDesignPackagesPrefixed(Installations.DelphiInstallationFromVersion[Version], BplFilenamePrefix);
+end;
+
+function compinst_uninstallBCBDesignPackagesPrefixed(Version: Integer; BplFilenamePrefix: PChar): Integer; stdcall;
+begin
+ Result := UninstallDesignPackagesPrefixed(Installations.BCBInstallationFromVersion[Version], BplFilenamePrefix);
+end;
+
+{ Experts }
+
+function compinst_installDelphiExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
+begin
+ Result := InstallExpert(Installations.DelphiInstallationFromVersion[Version], Filename, Description);
+end;
+
+function compinst_installBCBExpert(Version: Integer; const Filename, Description: PChar): Integer; stdcall;
+begin
+ Result := InstallExpert(Installations.BCBInstallationFromVersion[Version], Filename, Description);
+end;
+
+function compinst_uninstallDelphiExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
+begin
+ Result := UninstallExpert(Installations.DelphiInstallationFromVersion[Version], Filename);
+end;
+
+function compinst_uninstallBCBExpert(Version: Integer; const Filename: PChar): Integer; stdcall;
+begin
+ Result := UninstallExpert(Installations.BCBInstallationFromVersion[Version], Filename);
+end;
+
+function compinst_uninstallDelphiExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
+begin
+ Result := UninstallExpertsPrefixed(Installations.DelphiInstallationFromVersion[Version], FilenamePrefix);
+end;
+
+function compinst_uninstallBCBExpertsPrefixed(Version: Integer; FilenamePrefix: PChar): Integer; stdcall;
+begin
+ Result := UninstallExpertsPrefixed(Installations.BCBInstallationFromVersion[Version], FilenamePrefix);
+end;
+
+{ Search Paths }
+
+function compinst_addDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+begin
+ Result := ChangeSearchPaths(Installations.DelphiInstallationFromVersion[Version], True, SearchPaths, DebugPaths, BrowsePaths);
+end;
+
+function compinst_addBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+begin
+ Result := ChangeSearchPaths(Installations.BCBInstallationFromVersion[Version], True, SearchPaths, DebugPaths, BrowsePaths);
+end;
+
+function compinst_removeDelphiSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+begin
+ Result := ChangeSearchPaths(Installations.DelphiInstallationFromVersion[Version], False, SearchPaths, DebugPaths, BrowsePaths);
+end;
+
+function compinst_removeBCBSearchPaths(Version: Integer; SearchPaths, DebugPaths, BrowsePaths: PChar): Integer; stdcall;
+begin
+ Result := ChangeSearchPaths(Installations.BCBInstallationFromVersion[Version], False, SearchPaths, DebugPaths, BrowsePaths);
+end;
+
+initialization
+
+finalization
+ Installations.Free;
+
+end.
Property changes on: trunk/thirdparty/InnoSetup/CompInstall/CompInst.pas
___________________________________________________________________
Name: svn:keywords
+ URL HeadURL Author LastChangedBy Date LastChangedDate Rev Revision LastChangedRevision Id
Name: svn:eol-style
+ native
Modified: trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr
===================================================================
--- trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr 2007-12-08 14:57:05 UTC (rev 2267)
+++ trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr 2007-12-16 19:02:01 UTC (rev 2268)
@@ -1,39 +1,39 @@
-library CompInstall;
-
-uses
- CompInst in 'CompInst.pas';
-
-{$R *.res}
-
-exports
- compinst_init,
-
- compinst_isDelphiInstalled,
- compinst_isBCBInstalled,
- compinst_isBDSInstalled,
-
- compinst_installDelphiDesignPackage,
- compinst_installBCBDesignPackage,
- compinst_uninstallDelphiDesignPackage,
- compinst_uninstallBCBDesignPackage,
- compinst_uninstallDelphiDesignPackagesPrefixed,
- compinst_uninstallBCBDesignPackagesPrefixed,
-
- compinst_installDelphiExpert,
- compinst_installBCBExpert,
- compinst_uninstallDelphiExpert,
- compinst_uninstallBCBExpert,
- compinst_uninstallDelphiExpertsPrefixed,
- compinst_uninstallBCBExpertsPrefixed,
-
- compinst_addDelphiSearchPaths,
- compinst_addBCBSearchPaths,
- compinst_removeDelphiSearchPaths,
- compinst_removeBCBSearchPaths;
-
-begin
-
-end.
-
-
-
+library CompInstall;
+
+uses
+ CompInst in 'CompInst.pas';
+
+{$R *.res}
+
+exports
+ compinst_init,
+
+ compinst_isDelphiInstalled,
+ compinst_isBCBInstalled,
+ compinst_isBDSInstalled,
+
+ compinst_installDelphiDesignPackage,
+ compinst_installBCBDesignPackage,
+ compinst_uninstallDelphiDesignPackage,
+ compinst_uninstallBCBDesignPackage,
+ compinst_uninstallDelphiDesignPackagesPrefixed,
+ compinst_uninstallBCBDesignPackagesPrefixed,
+
+ compinst_installDelphiExpert,
+ compinst_installBCBExpert,
+ compinst_uninstallDelphiExpert,
+ compinst_uninstallBCBExpert,
+ compinst_uninstallDelphiExpertsPrefixed,
+ compinst_uninstallBCBExpertsPrefixed,
+
+ compinst_addDelphiSearchPaths,
+ compinst_addBCBSearchPaths,
+ compinst_removeDelphiSearchPaths,
+ compinst_removeBCBSearchPaths;
+
+begin
+
+end.
+
+
+
Property changes on: trunk/thirdparty/InnoSetup/CompInstall/CompInstall.dpr
___________________________________________________________________
Name: svn:keywords
+ URL HeadURL Author LastChangedBy Date LastChangedDate Rev Revision LastChangedRevision Id
Name: svn:eol-style
+ native
Property changes on: trunk/thirdparty/InnoSetup/InnoSetup
___________________________________________________________________
Name: bugtraq:url
+ http://homepages.codegear.com/jedi/issuetracker/view.php?id=%BUGID%
Name: bugtraq:message
+ (Mantis #%BUGID%)
Name: bugtraq:logregex
+ [Mm]antis #?(\d+)(,? ?#?(\d+))+
(\d+)
Modified: trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss
===================================================================
--- trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss 2007-12-08 14:57:05 UTC (rev 2267)
+++ trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss 2007-12-16 19:02:01 UTC (rev 2268)
@@ -1,350 +1,350 @@
-; BEGIN BUILTINS.ISS
-//
-// Inno Setup Preprocessor 5
-//
-// Copyright (C) 2001-2002 Alex Yackimoff. All Rights Reserved.
-// http://ispp.sourceforge.net
-//
-// Inno Setup (C) 1997-2005 Jordan Russell. All Rights Reserved.
-// Portions by Martijn Laan.
-//
-// $Id: Builtins.iss,v 1.9 2007/02/20 13:01:59 mlaan Exp $
-//
-#if defined(ISPP_INVOKED) && !defined(_BUILTINS_ISS_)
-//
-#if PREPROCVER < 0x01000000
-# error Inno Setup Preprocessor version is outdated
-#endif
-//
-#define _BUILTINS_ISS_
-//
-// ===========================================================================
-//
-// Default states for options.
-//
-//#pragma parseroption -b+ ; short circuit boolean evaluation: on
-//#pragma parseroption -m- ; short circuit multiplication evaluation (0 * A will not eval A): off
-//#pragma parseroption -p+ ; string literals without escape sequences: on
-//#pragma parseroption -u- ; allow undeclared identifiers: off
-//#pragma option -c+ ; pass script to the compiler: on
-//#pragma option -e- ; emit empty lines to translation: off
-//#pragma option -v- ; verbose mode: off
-//
-// ---------------------------------------------------------------------------
-//
-// Verbose levels:
-// 0 - #include and #file acknowledgements
-// 1 - information about any temp files created by #file
-// 2 - #insert and #append acknowledgements
-// 3 - reserved
-// 4 - #dim, #define and #undef acknowledgements
-// 5 - reserved
-// 6 - conditional inclusion acknowledgements
-// 7 - reserved
-// 8 - show strings emitted with #emit directive
-// 9 - macro and functions successfull call acknowledgements
-//10 - Local macro array allocation acknowledgements
-//
-//#pragma verboselevel 0
-//
-#ifndef __POPT_P__
-# define private CStrings
-# pragma parseroption -p+
-#endif
-//
-#pragma spansymbol "\"
-//
-#define True 1
-#define False 0
-#define Yes True
-#define No False
-//
-#define MaxInt 0x7FFFFFFFL
-#define MinInt 0x80000000L
-//
-#define NULL
-#define void
-//
-// TypeOf constants
-//
-#define TYPE_ERROR 0
-#define TYPE_NULL 1
-#define TYPE_INTEGER 2
-#define TYPE_STRING 3
-#define TYPE_MACRO 4
-#define TYPE_FUNC 5
-#define TYPE_ARRAY 6
-//
-// Helper macro to find out the type of an array element or expression. TypeOf
-// standard function only allows identifier as its parameter. Use this macro
-// to convert an expression to identifier.
-//
-#define TypeOf2(any Expr) TypeOf(Expr)
-//
-// ReadReg constants
-//
-#define HKEY_CLASSES_ROOT 0x80000000UL
-#define HKEY_CURRENT_USER 0x80000001UL
-#define HKEY_LOCAL_MACHINE 0x80000002UL
-#define HKEY_USERS 0x80000003UL
-//
-#define HKCR HKEY_CLASSES_ROOT
-#define HKCU HKEY_CURRENT_USER
-#define HKLM HKEY_LOCAL_MACHINE
-#define HKU HKEY_USERS
-//
-// Exec constants
-//
-#define SW_HIDE 0
-#define SW_SHOWNORMAL 1
-#define SW_NORMAL 1
-#define SW_SHOWMINIMIZED 2
-#define SW_SHOWMAXIMIZED 3
-#define SW_MAXIMIZE 3
-#define SW_SHOWNOACTIVATE 4
-#define SW_SHOW 5
-#define SW_MINIMIZE 6
-#define SW_SHOWMINNOACTIVE 7
-#define SW_SHOWNA 8
-#define SW_RESTORE 9
-#define SW_SHOWDEFAULT 10
-#define SW_MAX 10
-//
-// Find constants
-//
-#define FIND_MATCH 0x00
-#define FIND_BEGINS 0x01
-#define FIND_ENDS 0x02
-#define FIND_CONTAINS 0x03
-#define FIND_CASESENSITIVE 0x04
-#define FIND_SENSITIVE FIND_CASESENSITIVE
-#define FIND_AND 0x00
-#define FIND_OR 0x08
-#define FIND_NOT 0x10
-#define FIND_TRIM 0x20
-//
-// FindFirst constants
-//
-#define faReadOnly 0x00000001
-#define faHidden 0x00000002
-#define faSysFile 0x00000004
-#define faVolumeID 0x00000008
-#define faDirectory 0x00000010
-#define faArchive 0x00000020
-#define faSymLink 0x00000040
-#define faAnyFile 0x0000003F
-//
-// GetStringFileInfo standard names
-//
-#define COMPANY_NAME "CompanyName"
-#define FILE_DESCRIPTION "FileDescription"
-#define FILE_VERSION "FileVersion"
-#define INTERNAL_NAME "InternalName"
-#define LEGAL_COPYRIGHT "LegalCopyright"
-#define ORIGINAL_FILENAME "OriginalFilename"
-#define PRODUCT_NAME "ProductName"
-#define PRODUCT_VERSION "ProductVersion"
-//
-// GetStringFileInfo helpers
-//
-#define GetFileCompany(str FileName) GetStringFileInfo(FileName, COMPANY_NAME)
-#define GetFileCopyright(str FileName) GetStringFileInfo(FileName, LEGAL_COPYRIGHT)
-#define GetFileDescription(str FileName) GetStringFileInfo(FileName, FILE_DESCRIPTION)
-#define GetFileProductVersion(str FileName) GetStringFileInfo(FileName, PRODUCT_VERSION)
-#define GetFileVersionString(str FileName) GetStringFileInfo(FileName, FILE_VERSION)
-//
-// ParseVersion
-//
-// Macro internally calls GetFileVersion function and parses string returned
-// by that function (in form "0.0.0.0"). All four version elements are stored
-// in by-reference parameters Major, Minor, Rev, and Build. Macro returns
-// string returned by GetFileVersion.
-//
-#define DeleteToFirstPeriod(str *S) \
- Local[1] = Copy(S, 1, (Local[0] = Pos(".", S)) - 1), \
- S = Copy(S, Local[0] + 1), \
- Local[1]
-//
-#define ParseVersion(str FileName, *Major, *Minor, *Rev, *Build) \
- Local[1] = Local[0] = GetFileVersion(FileName), \
- Local[1] == "" ? "" : ( \
- Major = Int(DeleteToFirstPeriod(Local[1])), \
- Minor = Int(DeleteToFirstPeriod(Local[1])), \
- Rev = Int(DeleteToFirstPeriod(Local[1])), \
- Build = Int(Local[1]), \
- Local[0])
-//
-// EncodeVer
-//
-// Encodes given four version elements to a 32 bit integer number (8 bits for
-// each element, i.e. elements must be within 0...255 range).
-//
-#define EncodeVer(int Major, int Minor, int Revision = 0, int Build = -1) \
- Major << 24 | (Minor & 0xFF) << 16 | (Revision & 0xFF) << 8 | (Build >= 0 ? Build & 0xFF : 0)
-//
-// DecodeVer
-//
-// Decodes given 32 bit integer encoded version to its string representation,
-// Digits parameter indicates how many elements to show (if the fourth element
-// is 0, it won't be shown anyway).
-//
-#define DecodeVer(int Ver, int Digits = 3) \
- Str(Ver >> 0x18 & 0xFF) + (Digits > 1 ? "." : "") + \
- (Digits > 1 ? \
- Str(Ver >> 0x10 & 0xFF) + (Digits > 2 ? "." : "") : "") + \
- (Digits > 2 ? \
- Str(Ver >> 0x08 & 0xFF) + (Digits > 3 && (Local = Ver & 0xFF) ? "." : "") : "") + \
- (Digits > 3 && Local ? \
- Str(Ver & 0xFF) : "")
-//
-// FindSection
-//
-// Returns index of the line following the header of the section. This macro
-// is intended to be used with #insert directive.
-//
-#define FindSection(str Section = "Files") \
- Find(0, "[" + Section + "]", FIND_MATCH | FIND_TRIM) + 1
-//
-// FindSectionEnd
-//
-// Returns index of the line following last entry of the section. This macro
-// is intended to be used with #insert directive.
-//
-#if VER >= 0x03000000
-# define FindNextSection(int Line) \
- Find(Line, "[", FIND_BEGINS | FIND_TRIM, "]", FIND_ENDS | FIND_AND)
-# define FindSectionEnd(str Section = "Files") \
- FindNextSection(FindSection(Section))
-#else
-# define FindSectionEnd(str Section = "Files") \
- FindSection(Section) + EntryCount(Section)
-#endif
-//
-// FindCode
-//
-// Returns index of the line (of translation) following either [Code] section
-// header, or "program" keyword, if any.
-//
-# define FindCode() \
- Local[1] = FindSection("Code"), \
- Local[0] = Find(Local[1] - 1, "program", FIND_BEGINS, ";", FIND_ENDS | FIND_AND), \
- (Local[0] < 0 ? Local[1] : Local[0] + 1)
-//
-// ExtractFilePath
-//
-// Returns directory portion of the given filename without backslash (unless
-// it is a root directory). If PathName doesn't contain directory portion,
-// the result is an empty string.
-//
-#define ExtractFilePath(str PathName) \
- (Local[0] = \
- !(Local[1] = RPos("\", PathName)) ? \
- "" : \
- Copy(PathName, 1, Local[1] - 1)), \
- Local[0] + \
- ((Local[2] = Len(Local[0])) == 2 && Copy(Local[0], Local[2]) == ":" ? \
- "\" : \
- "")
-#define ExtractFileDir(str PathName) \
- RemoveBackslash(ExtractFilePath(PathName))
-
-#define ExtractFileExt(str PathName) \
- Local[0] = RPos(".", PathName), \
- Copy(PathName, Local[0] + 1)
-//
-// ExtractFileName
-//
-// Returns name portion of the given filename. If PathName ends with
-// a backslash, the result is an empty string.
-//
-#define ExtractFileName(str PathName) \
- !(Local[0] = RPos("\", PathName)) ? \
- PathName : \
- Copy(PathName, Local[0] + 1)
-//
-// ChangeFileExt
-//
-// Changes extension in FileName with NewExt. NewExt must not contain
-// period.
-//
-#define ChangeFileExt(str FileName, str NewExt) \
- !(Local[0] = RPos(".", FileName)) ? \
- FileName + "." + NewExt : \
- Copy(FileName, 1, Local[0]) + NewExt
-//
-// AddBackslash
-//
-// Adds a backslash to the string, if it's not already there.
-//
-#define AddBackslash(str S) \
- Copy(S, Len(S)) == "\" ? S : S + "\"
-//
-// RemoveBackslash
-//
-// Removes trailing backslash from the string unless the string points to
-// a root directory.
-//
-#define RemoveBackslash(str S) \
- Local[0] = Len(S), \
- Local[0] > 0 ? \
- Copy(S, Local[0]) == "\" ? \
- (Local[0] == 3 && Copy(S, 2, 1) == ":" ? \
- S : \
- Copy(S, 1, Local[0] - 1)) : \
- S : \
- ""
-//
-// Delete
-//
-// Deletes specified number of characters beginning with Index from S. S is
-// passed by reference (therefore is modified). Acts like Delete function in
-// Delphi (from System unit).
-//
-#define Delete(str *S, int Index, int Count = MaxInt) \
- S = Copy(S, 1, Index - 1) + Copy(S, Index + Count)
-//
-// Insert
-//
-// Inserts specified Substr at Index'th character into S. S is passed by
-// reference (therefore is modified).
-//
-#define Insert(str *S, int Index, str Substr) \
- Index > Len(S) + 1 ? \
- S : \
- S = Copy(S, 1, Index - 1) + SubStr + Copy(S, Index)
-//
-// YesNo, IsDirSet
-//
-// Returns nonzero value if given string is "yes", "true" or "1". Intended to
-// be used with SetupSetting function. This macro replaces YesNo function
-// available in previous releases.
-//
-#define YesNo(str S) \
- (S = LowerCase(S)) == "yes" || S == "true" || S == "1"
-//
-#define IsDirSet(str SetupDirective) \
- YesNo(SetupSetting(SetupDirective))
-//
-//
-#define Power(int X, int P = 2) \
- !P ? 1 : X * Power(X, P - 1)
-//
-#define Min(int A, int B, int C = MaxInt) \
- A < B ? A < C ? Int(A) : Int(C) : Int(B)
-//
-#define Max(int A, int B, int C = MinInt) \
- A > B ? A > C ? Int(A) : Int(C) : Int(B)
-//
-
-; The following message can be overriden in ISS script.
-; It is not required by ISPP license agreement, but it would be appreciated
-; if you do not remove this note.
-
-[Messages]
-AboutSetupNote=Inno Setup Preprocessor home page:%nhttp://ispp.sourceforge.net/
-[/Messages]
-#ifdef CStrings
-# pragma parseroption -p-
-#endif
-#endif
-; END BUILTINS.ISS
+; BEGIN BUILTINS.ISS
+//
+// Inno Setup Preprocessor 5
+//
+// Copyright (C) 2001-2002 Alex Yackimoff. All Rights Reserved.
+// http://ispp.sourceforge.net
+//
+// Inno Setup (C) 1997-2005 Jordan Russell. All Rights Reserved.
+// Portions by Martijn Laan.
+//
+// $Id: Builtins.iss,v 1.9 2007/02/20 13:01:59 mlaan Exp $
+//
+#if defined(ISPP_INVOKED) && !defined(_BUILTINS_ISS_)
+//
+#if PREPROCVER < 0x01000000
+# error Inno Setup Preprocessor version is outdated
+#endif
+//
+#define _BUILTINS_ISS_
+//
+// ===========================================================================
+//
+// Default states for options.
+//
+//#pragma parseroption -b+ ; short circuit boolean evaluation: on
+//#pragma parseroption -m- ; short circuit multiplication evaluation (0 * A will not eval A): off
+//#pragma parseroption -p+ ; string literals without escape sequences: on
+//#pragma parseroption -u- ; allow undeclared identifiers: off
+//#pragma option -c+ ; pass script to the compiler: on
+//#pragma option -e- ; emit empty lines to translation: off
+//#pragma option -v- ; verbose mode: off
+//
+// ---------------------------------------------------------------------------
+//
+// Verbose levels:
+// 0 - #include and #file acknowledgements
+// 1 - information about any temp files created by #file
+// 2 - #insert and #append acknowledgements
+// 3 - reserved
+// 4 - #dim, #define and #undef acknowledgements
+// 5 - reserved
+// 6 - conditional inclusion acknowledgements
+// 7 - reserved
+// 8 - show strings emitted with #emit directive
+// 9 - macro and functions successfull call acknowledgements
+//10 - Local macro array allocation acknowledgements
+//
+//#pragma verboselevel 0
+//
+#ifndef __POPT_P__
+# define private CStrings
+# pragma parseroption -p+
+#endif
+//
+#pragma spansymbol "\"
+//
+#define True 1
+#define False 0
+#define Yes True
+#define No False
+//
+#define MaxInt 0x7FFFFFFFL
+#define MinInt 0x80000000L
+//
+#define NULL
+#define void
+//
+// TypeOf constants
+//
+#define TYPE_ERROR 0
+#define TYPE_NULL 1
+#define TYPE_INTEGER 2
+#define TYPE_STRING 3
+#define TYPE_MACRO 4
+#define TYPE_FUNC 5
+#define TYPE_ARRAY 6
+//
+// Helper macro to find out the type of an array element or expression. TypeOf
+// standard function only allows identifier as its parameter. Use this macro
+// to convert an expression to identifier.
+//
+#define TypeOf2(any Expr) TypeOf(Expr)
+//
+// ReadReg constants
+//
+#define HKEY_CLASSES_ROOT 0x80000000UL
+#define HKEY_CURRENT_USER 0x80000001UL
+#define HKEY_LOCAL_MACHINE 0x80000002UL
+#define HKEY_USERS 0x80000003UL
+//
+#define HKCR HKEY_CLASSES_ROOT
+#define HKCU HKEY_CURRENT_USER
+#define HKLM HKEY_LOCAL_MACHINE
+#define HKU HKEY_USERS
+//
+// Exec constants
+//
+#define SW_HIDE 0
+#define SW_SHOWNORMAL 1
+#define SW_NORMAL 1
+#define SW_SHOWMINIMIZED 2
+#define SW_SHOWMAXIMIZED 3
+#define SW_MAXIMIZE 3
+#define SW_SHOWNOACTIVATE 4
+#define SW_SHOW 5
+#define SW_MINIMIZE 6
+#define SW_SHOWMINNOACTIVE 7
+#define SW_SHOWNA 8
+#define SW_RESTORE 9
+#define SW_SHOWDEFAULT 10
+#define SW_MAX 10
+//
+// Find constants
+//
+#define FIND_MATCH 0x00
+#define FIND_BEGINS 0x01
+#define FIND_ENDS 0x02
+#define FIND_CONTAINS 0x03
+#define FIND_CASESENSITIVE 0x04
+#define FIND_SENSITIVE FIND_CASESENSITIVE
+#define FIND_AND 0x00
+#define FIND_OR 0x08
+#define FIND_NOT 0x10
+#define FIND_TRIM 0x20
+//
+// FindFirst constants
+//
+#define faReadOnly 0x00000001
+#define faHidden 0x00000002
+#define faSysFile 0x00000004
+#define faVolumeID 0x00000008
+#define faDirectory 0x00000010
+#define faArchive 0x00000020
+#define faSymLink 0x00000040
+#define faAnyFile 0x0000003F
+//
+// GetStringFileInfo standard names
+//
+#define COMPANY_NAME "CompanyName"
+#define FILE_DESCRIPTION "FileDescription"
+#define FILE_VERSION "FileVersion"
+#define INTERNAL_NAME "InternalName"
+#define LEGAL_COPYRIGHT "LegalCopyright"
+#define ORIGINAL_FILENAME "OriginalFilename"
+#define PRODUCT_NAME "ProductName"
+#define PRODUCT_VERSION "ProductVersion"
+//
+// GetStringFileInfo helpers
+//
+#define GetFileCompany(str FileName) GetStringFileInfo(FileName, COMPANY_NAME)
+#define GetFileCopyright(str FileName) GetStringFileInfo(FileName, LEGAL_COPYRIGHT)
+#define GetFileDescription(str FileName) GetStringFileInfo(FileName, FILE_DESCRIPTION)
+#define GetFileProductVersion(str FileName) GetStringFileInfo(FileName, PRODUCT_VERSION)
+#define GetFileVersionString(str FileName) GetStringFileInfo(FileName, FILE_VERSION)
+//
+// ParseVersion
+//
+// Macro internally calls GetFileVersion function and parses string returned
+// by that function (in form "0.0.0.0"). All four version elements are stored
+// in by-reference parameters Major, Minor, Rev, and Build. Macro returns
+// string returned by GetFileVersion.
+//
+#define DeleteToFirstPeriod(str *S) \
+ Local[1] = Copy(S, 1, (Local[0] = Pos(".", S)) - 1), \
+ S = Copy(S, Local[0] + 1), \
+ Local[1]
+//
+#define ParseVersion(str FileName, *Major, *Minor, *Rev, *Build) \
+ Local[1] = Local[0] = GetFileVersion(FileName), \
+ Local[1] == "" ? "" : ( \
+ Major = Int(DeleteToFirstPeriod(Local[1])), \
+ Minor = Int(DeleteToFirstPeriod(Local[1])), \
+ Rev = Int(DeleteToFirstPeriod(Local[1])), \
+ Build = Int(Local[1]), \
+ Local[0])
+//
+// EncodeVer
+//
+// Encodes given four version elements to a 32 bit integer number (8 bits for
+// each element, i.e. elements must be within 0...255 range).
+//
+#define EncodeVer(int Major, int Minor, int Revision = 0, int Build = -1) \
+ Major << 24 | (Minor & 0xFF) << 16 | (Revision & 0xFF) << 8 | (Build >= 0 ? Build & 0xFF : 0)
+//
+// DecodeVer
+//
+// Decodes given 32 bit integer encoded version to its string representation,
+// Digits parameter indicates how many elements to show (if the fourth element
+// is 0, it won't be shown anyway).
+//
+#define DecodeVer(int Ver, int Digits = 3) \
+ Str(Ver >> 0x18 & 0xFF) + (Digits > 1 ? "." : "") + \
+ (Digits > 1 ? \
+ Str(Ver >> 0x10 & 0xFF) + (Digits > 2 ? "." : "") : "") + \
+ (Digits > 2 ? \
+ Str(Ver >> 0x08 & 0xFF) + (Digits > 3 && (Local = Ver & 0xFF) ? "." : "") : "") + \
+ (Digits > 3 && Local ? \
+ Str(Ver & 0xFF) : "")
+//
+// FindSection
+//
+// Returns index of the line following the header of the section. This macro
+// is intended to be used with #insert directive.
+//
+#define FindSection(str Section = "Files") \
+ Find(0, "[" + Section + "]", FIND_MATCH | FIND_TRIM) + 1
+//
+// FindSectionEnd
+//
+// Returns index of the line following last entry of the section. This macro
+// is intended to be used with #insert directive.
+//
+#if VER >= 0x03000000
+# define FindNextSection(int Line) \
+ Find(Line, "[", FIND_BEGINS | FIND_TRIM, "]", FIND_ENDS | FIND_AND)
+# define FindSectionEnd(str Section = "Files") \
+ FindNextSection(FindSection(Section))
+#else
+# define FindSectionEnd(str Section = "Files") \
+ FindSection(Section) + EntryCount(Section)
+#endif
+//
+// FindCode
+//
+// Returns index of the line (of translation) following either [Code] section
+// header, or "program" keyword, if any.
+//
+# define FindCode() \
+ Local[1] = FindSection("Code"), \
+ Local[0] = Find(Local[1] - 1, "program", FIND_BEGINS, ";", FIND_ENDS | FIND_AND), \
+ (Local[0] < 0 ? Local[1] : Local[0] + 1)
+//
+// ExtractFilePath
+//
+// Returns directory portion of the given filename without backslash (unless
+// it is a root directory). If PathName doesn't contain directory portion,
+// the result is an empty string.
+//
+#define ExtractFilePath(str PathName) \
+ (Local[0] = \
+ !(Local[1] = RPos("\", PathName)) ? \
+ "" : \
+ Copy(PathName, 1, Local[1] - 1)), \
+ Local[0] + \
+ ((Local[2] = Len(Local[0])) == 2 && Copy(Local[0], Local[2]) == ":" ? \
+ "\" : \
+ "")
+#define ExtractFileDir(str PathName) \
+ RemoveBackslash(ExtractFilePath(PathName))
+
+#define ExtractFileExt(str PathName) \
+ Local[0] = RPos(".", PathName), \
+ Copy(PathName, Local[0] + 1)
+//
+// ExtractFileName
+//
+// Returns name portion of the given filename. If PathName ends with
+// a backslash, the result is an empty string.
+//
+#define ExtractFileName(str PathName) \
+ !(Local[0] = RPos("\", PathName)) ? \
+ PathName : \
+ Copy(PathName, Local[0] + 1)
+//
+// ChangeFileExt
+//
+// Changes extension in FileName with NewExt. NewExt must not contain
+// period.
+//
+#define ChangeFileExt(str FileName, str NewExt) \
+ !(Local[0] = RPos(".", FileName)) ? \
+ FileName + "." + NewExt : \
+ Copy(FileName, 1, Local[0]) + NewExt
+//
+// AddBackslash
+//
+// Adds a backslash to the string, if it's not already there.
+//
+#define AddBackslash(str S) \
+ Copy(S, Len(S)) == "\" ? S : S + "\"
+//
+// RemoveBackslash
+//
+// Removes trailing backslash from the string unless the string points to
+// a root directory.
+//
+#define RemoveBackslash(str S) \
+ Local[0] = Len(S), \
+ Local[0] > 0 ? \
+ Copy(S, Local[0]) == "\" ? \
+ (Local[0] == 3 && Copy(S, 2, 1) == ":" ? \
+ S : \
+ Copy(S, 1, Local[0] - 1)) : \
+ S : \
+ ""
+//
+// Delete
+//
+// Deletes specified number of characters beginning with Index from S. S is
+// passed by reference (therefore is modified). Acts like Delete function in
+// Delphi (from System unit).
+//
+#define Delete(str *S, int Index, int Count = MaxInt) \
+ S = Copy(S, 1, Index - 1) + Copy(S, Index + Count)
+//
+// Insert
+//
+// Inserts specified Substr at Index'th character into S. S is passed by
+// reference (therefore is modified).
+//
+#define Insert(str *S, int Index, str Substr) \
+ Index > Len(S) + 1 ? \
+ S : \
+ S = Copy(S, 1, Index - 1) + SubStr + Copy(S, Index)
+//
+// YesNo, IsDirSet
+//
+// Returns nonzero value if given string is "yes", "true" or "1". Intended to
+// be used with SetupSetting function. This macro replaces YesNo function
+// available in previous releases.
+//
+#define YesNo(str S) \
+ (S = LowerCase(S)) == "yes" || S == "true" || S == "1"
+//
+#define IsDirSet(str SetupDirective) \
+ YesNo(SetupSetting(SetupDirective))
+//
+//
+#define Power(int X, int P = 2) \
+ !P ? 1 : X * Power(X, P - 1)
+//
+#define Min(int A, int B, int C = MaxInt) \
+ A < B ? A < C ? Int(A) : Int(C) : Int(B)
+//
+#define Max(int A, int B, int C = MinInt) \
+ A > B ? A > C ? Int(A) : Int(C) : Int(B)
+//
+
+; The following message can be overriden in ISS script.
+; It is not required by ISPP license agreement, but it would be appreciated
+; if you do not remove this note.
+
+[Messages]
+AboutSetupNote=Inno Setup Preprocessor home page:%nhttp://ispp.sourceforge.net/
+[/Messages]
+#ifdef CStrings
+# pragma parseroption -p-
+#endif
+#endif
+; END BUILTINS.ISS
Property changes on: trunk/thirdparty/InnoSetup/InnoSetup/Builtins.iss
___________________________________________________________________
Name: svn:eol-style
+ native
Property changes on: trunk/thirdparty/InnoSetup/InnoSetup/Languages
___________________________________________________________________
Name: bugtraq:url
+ http://homepages.codegear.com/jedi/issuetracker/view.php?id=%BUGID%
Name: bugtraq:message
+ (Mantis #%BUGID%)
Name: bugtraq:logregex
+ [Mm]antis #?(\d+)(,? ?#?(\d+))+
(\d+)
Modified: trunk/thirdparty/InnoSetup/InnoSetup/ModifiedInnoSetup.txt
===================================================================
--- trunk/thirdparty/InnoSetup/InnoSetup/ModifiedInnoSetup.txt 2007-12-08 14:57:05 UTC (rev 2267)
+++ trunk/thirdparty/InnoSetup/InnoSetup/ModifiedInnoSetup.txt 2007-12-16 19:02:01 UTC (rev 2268)
@@ -1,149 +1,149 @@
-This is a modified InnoSetup 5.x version
-All modifications are (C) 2007 Andreas Hausladen
-
-
-
-
-New features:
-
-=== [Setup] section ===
---------------------------------------------------------------------------
-Option:
- OptimizedChecks=yes/no
-
-Default:
- no
-
-Description:
- The OptimizedChecks option reduces the number of "Check" function calls by caching
- the last value and parameters of the "Check" function that was executed. The cached
- value will be used if the next "Check" function call matches the previous. If it
- doesn't match, the new "Check" function is called and its value and parameter are
- used for the cache.
- The cache is discarded every time a new block of checks must be evaluated.
-
- Example:
- [Files]
- Source: app\readme.txt; DestDir: {app}; Check: Check1(1);
- Source: app\license.txt; DestDir: {app}; Check: Check1(1);
- Source: app\deploy.txt; DestDir: {app}; Check: Check1(1);
- Source: app\data\data.bin; DestDir: {app}\data; Check: Check1(2);
- Source: app\bin\app.exe; DestDir: {app}\bin; Check: Check1(1);
-
- OptimizedChecks=no
- Check1(1); // readme.txt
- Check1(1); // license.txt
- Check1(1); // deploy.txt
- Check1(2); // data.bin
- Check1(1); // app.exe
- OptimizedChecks=yes
- Check1(1); // readme.txt => Cache is set to "Check1(1)"
- //Check1(1); // license.txt <= uses cached value
- //Check1(1); // deploy.txt <= uses cached value
- Check1(2); // data.bin => different parameter => Cache is set to "Check(2)"
- Check1(1); // app.exe => different parameter => Cache is set to "Check(1)"
-
---------------------------------------------------------------------------
-Option:
- WebSetupUpdateURL=URL
-
-Description
- If this option is set to a URL the compiler will create a setup.webinfo file in the
- output directory that can be copied with the other setup files to a web server.
- When the setup starts it first downloads the setup.webinfo file and checks if the
- version on the web server matches the local copy. It then automatically downloads and
- start the newer setup.
-
- Multiple URLs can be separated by " :: ", e.g. "http://web :: ftp://server".
- This option does not work with DiskSpanning=yes. If the setup becomes too large
- you should use the [Packages] section to split the files.
- Local packages must be copied to the web server with their relative path. They
- are downloaded directly after the new setup.exe was downloaded.
- The command line option /LOCALSETUP forces the setup to not look for a newer
- version.
-
-
-
-=== [Code] section ===
---------------------------------------------------------------------------
-Function:
-=========
- Syntax:
- function ProcessEvents: Boolean;
-
- Description:
- Gives the setup some time to refresh the wizard and returns False if the user has
- canceled the installation. In that case the code should call "Abort" to stop the
- installation after it has done some clean up.
-
---------------------------------------------------------------------------
- Syntax:
- procedure UpdateComponentList;
-
- Description:
- Updates the component list by calling their "Check" functions. The actual
- component selection isn't changed until the component page becomes visible.
-
---------------------------------------------------------------------------
- Syntax:
- procedure DownloadWebFile(const URL, Description, DestFilename, Referer,
- ProxyUserName, ProxyPassword: string; FtpTextMode, FtpPassive: Boolean);
-
- Description:
- Downloads the file from the URL. It shows the WebDownloadProgressGauge if
- the InstallPage is active. Otherwise it disables the WizardForm until the
- download has finished or failed.
- The function raises an exception if the download fails.
-
---------------------------------------------------------------------------
-Event:
-======
- Syntax:
- procedure WebFileDownloadHandler(const Location, Description, DestFilename: String);
-
- Description:
- The WebFileDownloadHandler event is called when the setup must download a "download://location"
- web file. The Location parameter specified the pacakge source without the protocol.
- Description is the package description and DestFilename is the full qualified destination
- filename.
-
---------------------------------------------------------------------------
-Class:
-======
- WizardForm.WebDownloadStatusLabel: TNewStaticText
- WizardForm.WebDownloadFilenameLabel: TNewStaticText
- WizardForm.WebDownloadProgressGauge: TProgressBar
-
-
-
-=== [Packages] section ===
---------------------------------------------------------------------------
-[Packages]
-Name: packagename; Description: "Some setup files"; Source: myfiles.isz
-
-[Files]
-Source: filename; DestDir: {app}; Package: packagename
-
-
-PACKAGES:
-
-Name:
- The Name of the package w...
[truncated message content] |
|
From: <jed...@us...> - 2007-12-08 14:57:07
|
Revision: 2267
http://jcl.svn.sourceforge.net/jcl/?rev=2267&view=rev
Author: jedi_mbe
Date: 2007-12-08 06:57:05 -0800 (Sat, 08 Dec 2007)
Log Message:
-----------
Added docs for TJclEasyStream.WriteCString (see rev. 2266)
Modified Paths:
--------------
trunk/help/Streams.dtx
Modified: trunk/help/Streams.dtx
===================================================================
--- trunk/help/Streams.dtx 2007-12-08 14:50:08 UTC (rev 2266)
+++ trunk/help/Streams.dtx 2007-12-08 14:57:05 UTC (rev 2267)
@@ -902,7 +902,28 @@
Donator:
Heinz Zastrau
--------------------------------------------------------------------------------
-
+@@TJclEasyStream.WriteCString@string
+Description:
+ The WriteCString method writes a C-like string (null-terminated)
+ to this stream.
+Parameters:
+ Value - String value.
+See also:
+ TJclEasyStream.ReadCString
+ TJclEasyStream.WriteBoolean
+ TJclEasyStream.WriteChar
+ TJclEasyStream.WriteCurrency
+ TJclEasyStream.WriteDateTime
+ TJclEasyStream.WriteDouble
+ TJclEasyStream.WriteExtended
+ TJclEasyStream.WriteInt64
+ TJclEasyStream.WriteInteger
+ TJclEasyStream.WriteShortString
+ TJclEasyStream.WriteSingle
+ TJclEasyStream.WriteSizedString
+Donator:
+ Heinz Zastrau
+--------------------------------------------------------------------------------
@@TJclEasyStream.WriteCurrency@Currency
Description:
The WriteCurrency method writes a currency value to this
@@ -1107,6 +1128,9 @@
value to this stream (max 2G characters).
Parameters:
Value - String value.
+Notes:
+ This method is superseded by the WriteCString method, which was added to
+ provide symmetry to the ReadCString method.
See also:
TJclEasyStream.ReadCString
TJclEasyStream.WriteBoolean
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-08 14:50:12
|
Revision: 2266
http://jcl.svn.sourceforge.net/jcl/?rev=2266&view=rev
Author: jedi_mbe
Date: 2007-12-08 06:50:08 -0800 (Sat, 08 Dec 2007)
Log Message:
-----------
Added WriteCString to TJclEasyStream to provide symmetry; WriteStringDelimitedByNull marked deprecated
Modified Paths:
--------------
trunk/jcl/source/common/JclStreams.pas
Modified: trunk/jcl/source/common/JclStreams.pas
===================================================================
--- trunk/jcl/source/common/JclStreams.pas 2007-12-08 14:43:09 UTC (rev 2265)
+++ trunk/jcl/source/common/JclStreams.pas 2007-12-08 14:50:08 UTC (rev 2266)
@@ -312,7 +312,8 @@
procedure WriteExtended(const Value: Extended);
procedure WriteInt64(Value: Int64); overload;
procedure WriteInteger(Value: Integer); overload;
- procedure WriteStringDelimitedByNull(const Value: string);
+ procedure WriteCString(const Value: string);
+ procedure WriteStringDelimitedByNull(const Value: string); {$IFDEF ACCEPT_DEPRECATED}deprecated;{$ENDIF ACCEPT_DEPRECATED}
procedure WriteShortString(const Value: ShortString);
procedure WriteSingle(const Value: Single);
procedure WriteSizedString(const Value: string);
@@ -1568,7 +1569,7 @@
WriteBuffer(Value, SizeOf(Value));
end;
-procedure TJclEasyStream.WriteStringDelimitedByNull(const Value: string);
+procedure TJclEasyStream.WriteCString(const Value: string);
{$IFDEF CLR}
var
I: Integer;
@@ -1583,6 +1584,11 @@
{$ENDIF ~CLR}
end;
+procedure TJclEasyStream.WriteStringDelimitedByNull(const Value: string);
+begin
+ WriteCString(Value);
+end;
+
procedure TJclEasyStream.WriteShortString(const Value: ShortString);
{$IFDEF CLR}
var
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <jed...@us...> - 2007-12-08 14:48:41
|
Revision: 2265
http://jcl.svn.sourceforge.net/jcl/?rev=2265&view=rev
Author: jedi_mbe
Date: 2007-12-08 06:43:09 -0800 (Sat, 08 Dec 2007)
Log Message:
-----------
Minor corrections (removing obsolete topics, correct topic IDs)
Modified Paths:
--------------
trunk/help/Containers.dtx
trunk/help/Streams.dtx
Modified: trunk/help/Containers.dtx
===================================================================
--- trunk/help/Containers.dtx 2007-12-02 17:22:31 UTC (rev 2264)
+++ trunk/help/Containers.dtx 2007-12-08 14:43:09 UTC (rev 2265)
@@ -59,7 +59,7 @@
@@IJclIntfCollection.Add@IInterface
Add AObject at the end of the collection. Return True if the method succeeds.
--------------------------------------------------------------------------------
-@@IJclStrCollection.Add@string
+@@IJclAnsiStrCollection.Add@AnsiString
Add AObject at the end of the collection. Return True if the method succeeds.
--------------------------------------------------------------------------------
@@IJclCollection.AddAll@IJclCollection
@@ -725,10 +725,10 @@
Donator:
Jean-Philippe Bempel
--------------------------------------------------------------------------------
-@@TJclStrCollection
+@@TJclAnsiStrAbstractCollection
Summary:
Abstract class; serves as a common ancestor to classes which
- implement the IJclStrCollection interface.
+ implement the IJclAnsiStrCollection interface.
Donator:
Daniele Teti
--------------------------------------------------------------------------------
Modified: trunk/help/Streams.dtx
===================================================================
--- trunk/help/Streams.dtx 2007-12-02 17:22:31 UTC (rev 2264)
+++ trunk/help/Streams.dtx 2007-12-08 14:43:09 UTC (rev 2265)
@@ -1229,7 +1229,7 @@
Donator:
Heinz Zastrau
--------------------------------------------------------------------------------
-@@!!OVERLOADED_Seek_TJclEventStream
+@@TJclEventStream.Seek@Int64@TSeekOrigin
Description:
Overridden method of TStream.Seek, all calls to this methods
are redirected to data stream and notified to event handler.
@@ -1246,12 +1246,6 @@
Donator:
Heinz Zastrau
--------------------------------------------------------------------------------
-@@TJclEventStream.Seek@Int64@TSeekOrigin
-<COMBINEWITH !!OVERLOADED_Seek_TJclEventStream>
---------------------------------------------------------------------------------
-@@TJclEventStream.Seek@Longint@Word
-<COMBINEWITH !!OVERLOADED_Seek_TJclEventStream>
---------------------------------------------------------------------------------
@@TJclEventStream.SetSize@Int64
Description
Overridden method of TStream.SetSize, all calls to this
@@ -1585,7 +1579,7 @@
Donator:
Heinz Zastrau
--------------------------------------------------------------------------------
-@@!!OVERLOADED_Seek_TJclStreamDecorator
+@@TJclStreamDecorator.Seek@Int64@TSeekOrigin
Summary:
Overridden function of TStream.Seek.
Description:
@@ -1603,12 +1597,6 @@
Donator:
Heinz Zastrau
--------------------------------------------------------------------------------
-@@TJclStreamDecorator.Seek@Int64@TSeekOrigin
-<COMBINEWITH !!OVERLOADED_Seek_TJclStreamDecorator>
---------------------------------------------------------------------------------
-@@TJclStreamDecorator.Seek@Longint@Word
-<COMBINEWITH !!OVERLOADED_Seek_TJclStreamDecorator>
---------------------------------------------------------------------------------
@@TJclStreamDecorator.SetSize@Int64
Summary
Overridden function of TStream.SetSize.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-02 17:22:34
|
Revision: 2264
http://jcl.svn.sourceforge.net/jcl/?rev=2264&view=rev
Author: outchy
Date: 2007-12-02 09:22:31 -0800 (Sun, 02 Dec 2007)
Log Message:
-----------
CLR targets don't have VCL packages
Modified Paths:
--------------
trunk/jcl/install/JclInstall.pas
Modified: trunk/jcl/install/JclInstall.pas
===================================================================
--- trunk/jcl/install/JclInstall.pas 2007-12-02 16:05:57 UTC (rev 2263)
+++ trunk/jcl/install/JclInstall.pas 2007-12-02 17:22:31 UTC (rev 2264)
@@ -1137,9 +1137,9 @@
procedure AddPackageOptions(Parent: TJclOption);
begin
- if RuntimeInstallation and Target.SupportsVCL then
+ if (CLRVersion = '') and RuntimeInstallation and Target.SupportsVCL then
AddOption(joVclPackage, [goChecked], Parent);
- if RuntimeInstallation and Target.SupportsVisualCLX then
+ if (CLRVersion = '') and RuntimeInstallation and Target.SupportsVisualCLX then
AddOption(joClxPackage, [goChecked], Parent);
if (bpBCBuilder32 in Target.Personalities) and RunTimeInstallation and (CLRVersion = '') then
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-12-02 16:05:59
|
Revision: 2263
http://jcl.svn.sourceforge.net/jcl/?rev=2263&view=rev
Author: outchy
Date: 2007-12-02 08:05:57 -0800 (Sun, 02 Dec 2007)
Log Message:
-----------
Removing UTF-8 BOM
Modified Paths:
--------------
trunk/jcl/source/common/JclContainerIntf.pas
Modified: trunk/jcl/source/common/JclContainerIntf.pas
===================================================================
--- trunk/jcl/source/common/JclContainerIntf.pas 2007-12-02 15:46:23 UTC (rev 2262)
+++ trunk/jcl/source/common/JclContainerIntf.pas 2007-12-02 16:05:57 UTC (rev 2263)
@@ -1,4 +1,4 @@
-{**************************************************************************************************}
+{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
@@ -27,7 +27,7 @@
{ }
{**************************************************************************************************}
{ }
-{ Last modified: $Date:: $ }
+{ Last modified: $Date:: $ }
{ Revision: $Rev:: $ }
{ Author: $Author:: $ }
{ }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
49 messages has been excluded from this view by a project administrator.
