1061 lines
31 KiB
ObjectPascal
1061 lines
31 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclUsesWizard.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is TOndrej (tondrej att t-online dott de). }
|
|
{ Portions created by TOndrej are Copyright (C) of TOndrej. }
|
|
{ }
|
|
{ Contributors: }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Unit owner: Robert Marquardt }
|
|
{ Last modified: $Date: 2006/01/08 17:16:57 $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclUsesWizard;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Windows, Classes, Messages, Forms, Controls, StdCtrls, ComCtrls,
|
|
ExtCtrls,
|
|
ToolsAPI,
|
|
JclOtaUtils, JclOptionsFrame;
|
|
|
|
type
|
|
TWizardAction = (waSkip, waAddToImpl, waAddToIntf, waMoveToIntf);
|
|
PErrorInfo = ^TErrorInfo;
|
|
TErrorInfo = record
|
|
// parsed from compiler message
|
|
UnitName: array [0..MAX_PATH - 1] of Char;
|
|
LineNumber: Integer;
|
|
Identifier: array [0..MAX_PATH - 1] of Char;
|
|
// resolved by wizard
|
|
UsesName: array [0..MAX_PATH - 1] of Char; // unit name to be added to uses clause
|
|
end;
|
|
|
|
TJCLUsesWizard = class(TJclOTAExpert)
|
|
private
|
|
FActive: Boolean;
|
|
FApplicationIdle: TIdleEvent;
|
|
FConfirmChanges: Boolean;
|
|
FErrors: TList;
|
|
FIdentifierLists: TStrings;
|
|
FIniFile: string;
|
|
FNotifierIndex: Integer;
|
|
FFrameJclOptions: TFrameJclOptions;
|
|
procedure SetIniFile(const Value: string);
|
|
procedure AppIdle(Sender: TObject; var Done: Boolean);
|
|
procedure ClearErrors;
|
|
function DoConfirmChanges(ChangeList: TStrings): TModalResult;
|
|
procedure InitializeIdentifierLists;
|
|
procedure ProcessCompilerMessages(Messages: TStrings);
|
|
procedure ProcessUses;
|
|
procedure ResolveUsesName(Error: PErrorInfo);
|
|
procedure SetActive(Value: Boolean);
|
|
procedure SetConfirmChanges(Value: Boolean);
|
|
public
|
|
Value: Integer;
|
|
constructor Create; reintroduce;
|
|
destructor Destroy; override;
|
|
function LoadFromRegistry: Boolean;
|
|
procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
|
|
procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
|
|
property Active: Boolean read FActive write SetActive;
|
|
property ConfirmChanges: Boolean read FConfirmChanges write SetConfirmChanges;
|
|
property IniFile: string read FIniFile write SetIniFile;
|
|
end;
|
|
|
|
TJCLUsesWizardNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50)
|
|
private
|
|
FWizard: TJclUsesWizard;
|
|
public
|
|
{ IOTAIDENotifier }
|
|
procedure AfterCompile(Succeeded: Boolean); overload;
|
|
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
|
|
procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
|
|
{ IOTAIDENotifier50 }
|
|
procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
|
|
procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
|
|
public
|
|
constructor Create(AWizard: TJclUsesWizard); reintroduce;
|
|
property Wizard: TJclUsesWizard read FWizard;
|
|
end;
|
|
|
|
// design package entry point
|
|
procedure Register;
|
|
|
|
// expert DLL entry point
|
|
function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
|
|
RegisterProc: TWizardRegisterProc;
|
|
var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IniFiles,
|
|
JclFileUtils, JclParseUses, JclRegistry, JclUsesDialog,
|
|
JclOtaConsts, JclOtaResources;
|
|
|
|
function FindClassForm(const AClassName: string): TForm;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
with Screen do
|
|
for I := 0 to FormCount - 1 do
|
|
if Forms[I].ClassNameIs(AClassName) then
|
|
begin
|
|
Result := Forms[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function GetActiveProject: IOTAProject;
|
|
var
|
|
ProjectGroup: IOTAProjectGroup;
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
|
|
with BorlandIDEServices as IOTAModuleServices do
|
|
begin
|
|
ProjectGroup := nil;
|
|
for I := 0 to ModuleCount - 1 do
|
|
if Supports(Modules[I], IOTAProjectGroup, ProjectGroup) then
|
|
Break;
|
|
|
|
if Assigned(ProjectGroup) then
|
|
Result := ProjectGroup.ActiveProject
|
|
else
|
|
for I := 0 to ModuleCount - 1 do
|
|
if Supports(Modules[I], IOTAProject, Result) then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function GetLineNumber(S1, S2: PChar): Integer;
|
|
var
|
|
P: PChar;
|
|
begin
|
|
if S2 < S1 then
|
|
Result := 0
|
|
else
|
|
begin
|
|
Result := 1;
|
|
P := StrPos(S1, #13#10);
|
|
while (P <> nil) and (P <= S2) do
|
|
begin
|
|
Inc(Result);
|
|
|
|
P := StrPos(P + 2, #13#10);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
//=== { TLine } ==============================================================
|
|
|
|
// TLine 'guessed' from coreide60.bpl
|
|
|
|
type
|
|
TLine = class(TObject)
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
function GetLineText: string; virtual;
|
|
end;
|
|
|
|
{ TLine stubs }
|
|
|
|
constructor TLine.Create;
|
|
begin
|
|
end;
|
|
|
|
destructor TLine.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLine.GetLineText: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
// the message treeview is custom drawn; hence this hack
|
|
|
|
procedure GetCompilerMessages(List: TStrings);
|
|
var
|
|
MessageViewForm: TForm;
|
|
I: Integer;
|
|
TreeView: TTreeView;
|
|
Node: TTreeNode;
|
|
Line: TLine;
|
|
begin
|
|
// if TMsgWindow exists all messages are sent to it
|
|
MessageViewForm := FindClassForm('TMsgWindow');
|
|
if MessageViewForm = nil then // otherwise TMessageViewForm is used
|
|
MessageViewForm := FindClassForm('TMessageViewForm');
|
|
|
|
if Assigned(MessageViewForm) then
|
|
begin
|
|
TreeView := nil;
|
|
with MessageViewForm do
|
|
for I := 0 to ControlCount - 1 do
|
|
if Controls[I].ClassNameIs('TTreeMessageView') then
|
|
begin
|
|
TreeView := Controls[I] as TTreeView;
|
|
Break;
|
|
end;
|
|
|
|
if Assigned(TreeView) then
|
|
begin
|
|
with TreeView do
|
|
begin
|
|
Node := Items.GetFirstNode;
|
|
while Node <> nil do
|
|
begin
|
|
Line := TLine(Node.Data);
|
|
|
|
if Assigned(Line) then
|
|
List.Add(Line.GetLineText);
|
|
|
|
Node := Node.GetNext;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ReadEditorBuffer(Buffer: IOTAEditBuffer): string;
|
|
const
|
|
BufSize = 1024;
|
|
var
|
|
Reader: IOTAEditReader;
|
|
Stream: TStringStream;
|
|
ReaderPos, Read: Integer;
|
|
Buf: array [0..BufSize] of Char;
|
|
begin
|
|
Result := '';
|
|
if Buffer = nil then
|
|
Exit;
|
|
|
|
Reader := Buffer.CreateReader;
|
|
Stream := TStringStream.Create('');
|
|
try
|
|
ReaderPos := 0;
|
|
repeat
|
|
Read := Reader.GetText(ReaderPos, @Buf, BufSize);
|
|
Inc(ReaderPos, Read);
|
|
if (Read < 0) or (Read > BufSize) then
|
|
raise EJclExpertException.CreateTrace(RsEErrorReadingBuffer);
|
|
Buf[Read] := #0;
|
|
Stream.WriteString(Buf);
|
|
until Read < BufSize;
|
|
|
|
Result := Stream.DataString;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function ReadString(S: PChar; Len: Integer): string;
|
|
begin
|
|
SetString(Result, S, Len);
|
|
end;
|
|
|
|
//=== { TJCLUsesWizardNotifier } =============================================
|
|
|
|
// TJCLUsesWizardNotifier private: IOTAIDENotifier
|
|
|
|
procedure TJCLUsesWizardNotifier.AfterCompile(Succeeded: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TJCLUsesWizardNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TJCLUsesWizardNotifier.FileNotification(NotifyCode: TOTAFileNotification;
|
|
const FileName: string; var Cancel: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
//=== { TJCLUsesWizardNotifier } =============================================
|
|
|
|
// TJCLUsesWizardNotifier private: IOTAIDENotifier50
|
|
|
|
procedure TJCLUsesWizardNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean);
|
|
var
|
|
Messages: TStrings;
|
|
begin
|
|
try
|
|
if IsCodeInsight or Succeeded then
|
|
Exit;
|
|
|
|
Messages := TStringList.Create;
|
|
try
|
|
GetCompilerMessages(Messages);
|
|
if Assigned(Wizard) then
|
|
Wizard.ProcessCompilerMessages(Messages);
|
|
finally
|
|
Messages.Free;
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJCLUsesWizardNotifier.BeforeCompile(const Project: IOTAProject;
|
|
IsCodeInsight: Boolean; var Cancel: Boolean);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
constructor TJCLUsesWizardNotifier.Create(AWizard: TJclUsesWizard);
|
|
begin
|
|
inherited Create;
|
|
|
|
FWizard := AWizard;
|
|
end;
|
|
|
|
//=== { TJCLUsesWizard } =====================================================
|
|
|
|
// private
|
|
|
|
procedure TJCLUsesWizard.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc);
|
|
begin
|
|
inherited AddConfigurationPages(AddPageFunc);
|
|
FFrameJclOptions := TFrameJclOptions.Create(nil);
|
|
FFrameJclOptions.Active := Active;
|
|
FFrameJclOptions.ConfirmChanges := ConfirmChanges;
|
|
FFrameJclOptions.ConfigFileName := IniFile;
|
|
AddPageFunc(FFrameJclOptions, RsUsesSheet, Self);
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.ConfigurationClosed(AControl: TControl;
|
|
SaveChanges: Boolean);
|
|
begin
|
|
if Assigned(AControl) and (AControl = FFrameJclOptions) then
|
|
begin
|
|
if SaveChanges then
|
|
begin
|
|
Active := FFrameJclOptions.Active;
|
|
ConfirmChanges := FFrameJclOptions.ConfirmChanges;
|
|
IniFile := FFrameJclOptions.ConfigFileName;
|
|
end;
|
|
FreeAndNil(FFrameJclOptions);
|
|
end
|
|
else
|
|
inherited ConfigurationClosed(AControl, SaveChanges);
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.AppIdle(Sender: TObject; var Done: Boolean);
|
|
begin
|
|
Application.OnIdle := FApplicationIdle;
|
|
FApplicationIdle := nil;
|
|
|
|
if FErrors.Count = 0 then
|
|
Exit;
|
|
|
|
ProcessUses;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.ClearErrors;
|
|
var
|
|
I: Integer;
|
|
P: PErrorInfo;
|
|
begin
|
|
for I := 0 to FErrors.Count - 1 do
|
|
begin
|
|
P := FErrors[I];
|
|
FreeMem(P);
|
|
end;
|
|
FErrors.Clear;
|
|
end;
|
|
|
|
function TJCLUsesWizard.DoConfirmChanges(ChangeList: TStrings): TModalResult;
|
|
var
|
|
Dialog: TFormUsesConfirm;
|
|
begin
|
|
Dialog := TFormUsesConfirm.Create(nil, ChangeList, FErrors);
|
|
try
|
|
Result := Dialog.ShowModal;
|
|
finally
|
|
Dialog.Free;
|
|
end;
|
|
end;
|
|
|
|
// load identifier lists
|
|
// each line represents one JCL unit in the following format:
|
|
// <unit_name>=<identifier0>,<identifier1>,...
|
|
|
|
procedure TJCLUsesWizard.InitializeIdentifierLists;
|
|
var
|
|
IniFile: TIniFile;
|
|
I: Integer;
|
|
IdentListFileName: string;
|
|
IdentList: TStrings;
|
|
begin
|
|
FIdentifierLists.Clear;
|
|
|
|
IniFile := TIniFile.Create(FIniFile);
|
|
try
|
|
IdentList := TStringList.Create;
|
|
try
|
|
IniFile.ReadSection(SIniIdentifierLists, FIdentifierLists);
|
|
for I := 0 to FIdentifierLists.Count - 1 do
|
|
begin
|
|
IdentListFileName := IniFile.ReadString(SIniIdentifierLists, FIdentifierLists[I],
|
|
ChangeFileExt(FIdentifierLists[I], '.txt'));
|
|
if ExtractFilePath(IdentListFileName) = '' then
|
|
IdentListFileName := ExtractFilePath(FIniFile) + IdentListFileName;
|
|
|
|
IdentList.LoadFromFile(IdentListFileName);
|
|
FIdentifierLists[I] := FIdentifierLists[I] + '=' + IdentList.CommaText;
|
|
end;
|
|
finally
|
|
IdentList.Free;
|
|
end;
|
|
finally
|
|
IniFile.Free;
|
|
end;
|
|
end;
|
|
|
|
// load localized strings for the undeclared identifier error
|
|
|
|
procedure TJCLUsesWizard.ProcessCompilerMessages(Messages: TStrings);
|
|
const
|
|
SIdentFormatSpec = '%s';
|
|
var
|
|
I: Integer;
|
|
Error: PErrorInfo;
|
|
SError: string;
|
|
SUndeclaredIdent: string;
|
|
|
|
procedure LoadDcc32Strings;
|
|
const
|
|
{$IFDEF COMPILER6}
|
|
SErrorID = 4147; // 'Error'
|
|
SUndeclaredIdentID = 47; // 'Undeclared identifier: ''%s'''
|
|
{$ELSE}
|
|
SErrorID = 4200;
|
|
SUndeclaredIdentID = 2;
|
|
{$ENDIF COMPILER6}
|
|
var
|
|
Dcc32FileName: string;
|
|
Dcc32: HMODULE;
|
|
ResString: TResStringRec;
|
|
S: string;
|
|
begin
|
|
SError := '';
|
|
SUndeclaredIdent := '';
|
|
|
|
Dcc32FileName := 'dcc32.exe';
|
|
|
|
// try to retrieve and prepend Delphi bin path
|
|
S := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey;
|
|
{$IFDEF COMPILER6_UP}
|
|
if RegKeyExists(HKEY_CURRENT_USER, S) then
|
|
Dcc32FileName := PathAddSeparator(RegReadString(HKEY_CURRENT_USER, S, 'RootDir')) + 'Bin\' + Dcc32FileName
|
|
else
|
|
{$ENDIF COMPILER6_UP}
|
|
if RegKeyExists(HKEY_LOCAL_MACHINE, S) then
|
|
Dcc32FileName := PathAddSeparator(RegReadString(HKEY_LOCAL_MACHINE, S, 'RootDir')) + 'Bin\' + Dcc32FileName;
|
|
|
|
// try to load localized resources first
|
|
Dcc32 := LoadResourceModule(PChar(Dcc32FileName));
|
|
if Dcc32 = 0 then // if not found try the executable
|
|
Dcc32 := LoadLibraryEx(PChar(Dcc32FileName), 0, LOAD_LIBRARY_AS_DATAFILE);
|
|
if Dcc32 = 0 then
|
|
Exit;
|
|
|
|
try
|
|
ResString.Module := @Dcc32;
|
|
ResString.Identifier := SErrorID;
|
|
SError := LoadResString(@ResString);
|
|
|
|
ResString.Identifier := SUndeclaredIdentID;
|
|
SUndeclaredIdent := LoadResString(@ResString);
|
|
finally
|
|
FreeLibrary(Dcc32);
|
|
end;
|
|
end;
|
|
|
|
// example error message: [Error] Unit1.pas(37): Undeclared identifier: 'GetWindowsFolder'
|
|
|
|
function ParseMessage(const Msg: string; var Error: PErrorInfo): Boolean;
|
|
var
|
|
P, P1, P2: PChar;
|
|
UnitName: string;
|
|
LineNumber: Integer;
|
|
Identifier: string;
|
|
begin
|
|
Result := False;
|
|
Error := nil;
|
|
P := PChar(Msg);
|
|
|
|
// check opening bracket
|
|
if P^ <> '[' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// check severity
|
|
if StrLComp(P, PChar(SError), Length(SError)) <> 0 then
|
|
Exit;
|
|
Inc(P, Length(SError));
|
|
|
|
// check closing bracket
|
|
if P^ <> ']' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// check space
|
|
if P^ <> ' ' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// read unit name
|
|
UnitName := '';
|
|
while P^ <> '(' do
|
|
begin
|
|
if P^ = #0 then
|
|
Break;
|
|
|
|
UnitName := UnitName + P^;
|
|
|
|
Inc(P);
|
|
end;
|
|
if UnitName = '' then
|
|
Exit;
|
|
if P^ <> '(' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// read line number
|
|
LineNumber := 0;
|
|
while P^ <> ')' do
|
|
begin
|
|
if P^ = #0 then
|
|
Break;
|
|
|
|
LineNumber := LineNumber * 10 + Ord(P^) - Ord('0');
|
|
|
|
Inc(P);
|
|
end;
|
|
if LineNumber = 0 then
|
|
Exit;
|
|
if P^ <> ')' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// check colon
|
|
if P^ <> ':' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// check space
|
|
if P^ <> ' ' then
|
|
Exit;
|
|
Inc(P);
|
|
|
|
// check text
|
|
Identifier := '';
|
|
P1 := PChar(SUndeclaredIdent);
|
|
|
|
// check text up to '%s'
|
|
P2 := StrPos(P1, SIdentFormatSpec);
|
|
if P2 = nil then
|
|
Exit;
|
|
if StrLComp(P, P1, P2 - P1) <> 0 then
|
|
Exit;
|
|
|
|
P1 := P + (P2 - P1);
|
|
|
|
// check text after '%s'
|
|
Inc(P2, Length(SIdentFormatSpec));
|
|
P := StrEnd(P);
|
|
Dec(P, StrLen(P2));
|
|
|
|
if StrComp(P, P2) <> 0 then
|
|
Exit;
|
|
|
|
// copy identifier
|
|
while P1 < P do
|
|
begin
|
|
Identifier := Identifier + P1^;
|
|
Inc(P1);
|
|
end;
|
|
if Identifier = '' then
|
|
Exit;
|
|
|
|
// match
|
|
Error := AllocMem(SizeOf(TErrorInfo));
|
|
try
|
|
StrLCopy(Error^.UnitName, PChar(UnitName), Length(Error^.UnitName));
|
|
Error^.LineNumber := LineNumber;
|
|
StrLCopy(Error^.Identifier, PChar(Identifier), Length(Error^.Identifier));
|
|
|
|
Result := True;
|
|
except
|
|
FreeMem(Error);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ClearErrors;
|
|
if not Assigned(Messages) then
|
|
Exit;
|
|
|
|
LoadDcc32Strings;
|
|
for I := 0 to Messages.Count - 1 do
|
|
if ParseMessage(Messages[I], Error) then
|
|
FErrors.Add(Error);
|
|
|
|
for I := 0 to FErrors.Count - 1 do
|
|
ResolveUsesName(FErrors[I]);
|
|
|
|
for I := FErrors.Count - 1 downto 0 do
|
|
begin
|
|
Error := FErrors[I];
|
|
if Error^.UsesName = '' then
|
|
begin
|
|
FreeMem(Error);
|
|
FErrors.Delete(I);
|
|
end;
|
|
end;
|
|
|
|
Application.ProcessMessages;
|
|
|
|
FApplicationIdle := Application.OnIdle;
|
|
Application.OnIdle := AppIdle;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.ProcessUses;
|
|
var
|
|
GoalSource: string;
|
|
Goal: TCustomGoal;
|
|
I: Integer;
|
|
ChangeList: TStrings;
|
|
IntfLength, ImplLength: Integer;
|
|
Writer: IOTAEditWriter;
|
|
Project: IOTAProject;
|
|
begin
|
|
GoalSource := '';
|
|
with BorlandIDEServices as IOTAEditorServices do
|
|
if Assigned(TopBuffer) then
|
|
GoalSource := ReadEditorBuffer(TopBuffer)
|
|
else
|
|
Exit;
|
|
|
|
Goal := CreateGoal(PChar(GoalSource));
|
|
if not Assigned(Goal) then
|
|
Exit;
|
|
|
|
try
|
|
if Goal is TProgramGoal then
|
|
with TProgramGoal(Goal) do
|
|
begin
|
|
IntfLength := Length(UsesList.Text);
|
|
ChangeList := TStringList.Create;
|
|
try
|
|
for I := 0 to FErrors.Count - 1 do
|
|
with PErrorInfo(FErrors[I])^ do
|
|
if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
|
|
ChangeList.AddObject(UsesName, TObject(waAddToIntf));
|
|
|
|
if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
|
|
begin
|
|
for I := ChangeList.Count - 1 downto 0 do
|
|
case TWizardAction(ChangeList.Objects[I]) of
|
|
waAddToImpl, waAddToIntf:
|
|
if UsesList.Count = 0 then
|
|
UsesList.Add(ChangeList[I])
|
|
else
|
|
UsesList.Insert(0, ChangeList[I]);
|
|
end;
|
|
|
|
with BorlandIDEServices as IOTAEditorServices do
|
|
if Assigned(TopBuffer) then
|
|
begin
|
|
Writer := TopBuffer.CreateUndoableWriter;
|
|
try
|
|
Writer.CopyTo(Length(TextBeforeUses));
|
|
Writer.DeleteTo(Length(TextBeforeUses) + IntfLength);
|
|
Writer.Insert(PChar(UsesList.Text));
|
|
Writer.CopyTo(Length(GoalSource));
|
|
finally
|
|
Writer := nil;
|
|
end;
|
|
end;
|
|
|
|
// attempt to recompile
|
|
Project := GetActiveProject;
|
|
if Assigned(Project) and Assigned(Project.ProjectBuilder) then
|
|
Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
|
|
end;
|
|
finally
|
|
ChangeList.Free;
|
|
end;
|
|
end
|
|
else
|
|
if Goal is TLibraryGoal then
|
|
with TLibraryGoal(Goal) do
|
|
begin
|
|
IntfLength := Length(UsesList.Text);
|
|
ChangeList := TStringList.Create;
|
|
try
|
|
for I := 0 to FErrors.Count - 1 do
|
|
with PErrorInfo(FErrors[I])^ do
|
|
if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
|
|
ChangeList.AddObject(UsesName, TObject(waAddToIntf));
|
|
|
|
if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
|
|
begin
|
|
for I := ChangeList.Count - 1 downto 0 do
|
|
case TWizardAction(ChangeList.Objects[I]) of
|
|
waAddToImpl, waAddToIntf:
|
|
if UsesList.Count = 0 then
|
|
UsesList.Add(ChangeList[I])
|
|
else
|
|
UsesList.Insert(0, ChangeList[I]);
|
|
end;
|
|
|
|
with BorlandIDEServices as IOTAEditorServices do
|
|
if Assigned(TopBuffer) then
|
|
begin
|
|
Writer := TopBuffer.CreateUndoableWriter;
|
|
try
|
|
Writer.CopyTo(Length(TextBeforeUses));
|
|
Writer.DeleteTo(Length(TextBeforeUses) + IntfLength);
|
|
Writer.Insert(PChar(UsesList.Text));
|
|
Writer.CopyTo(Length(GoalSource));
|
|
finally
|
|
Writer := nil;
|
|
end;
|
|
end;
|
|
|
|
// attempt to recompile
|
|
Project := GetActiveProject;
|
|
if Assigned(Project) and Assigned(Project.ProjectBuilder) then
|
|
Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
|
|
end;
|
|
finally
|
|
ChangeList.Free;
|
|
end;
|
|
end
|
|
else
|
|
if Goal is TUnitGoal then
|
|
with TUnitGoal(Goal) do
|
|
begin
|
|
IntfLength := Length(UsesIntf.Text);
|
|
ImplLength := Length(UsesImpl.Text);
|
|
ChangeList := TStringList.Create;
|
|
try
|
|
for I := 0 to FErrors.Count - 1 do
|
|
with PErrorInfo(FErrors[I])^ do
|
|
if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then
|
|
begin
|
|
if LineNumber < GetLineNumber(PChar(GoalSource), PChar(GoalSource) + Length(TextBeforeIntf) +
|
|
IntfLength + Length(TextAfterIntf)) then // error in interface section
|
|
begin
|
|
if UsesImpl.IndexOf(UsesName) = -1 then
|
|
ChangeList.AddObject(UsesName, TObject(waAddToIntf))
|
|
else
|
|
ChangeList.AddObject(UsesName, TObject(waMoveToIntf));
|
|
end
|
|
else // error in implementation section
|
|
ChangeList.AddObject(UsesName, TObject(waAddToImpl));
|
|
end;
|
|
|
|
if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then
|
|
begin
|
|
for I := ChangeList.Count - 1 downto 0 do
|
|
case TWizardAction(ChangeList.Objects[I]) of
|
|
waAddToImpl:
|
|
if UsesImpl.Count = 0 then
|
|
UsesImpl.Add(ChangeList[I])
|
|
else
|
|
UsesImpl.Insert(0, ChangeList[I]);
|
|
waAddToIntf:
|
|
if UsesIntf.Count = 0 then
|
|
UsesIntf.Add(ChangeList[I])
|
|
else
|
|
UsesIntf.Insert(0, ChangeList[I]);
|
|
waMoveToIntf:
|
|
begin
|
|
if UsesIntf.Count = 0 then
|
|
UsesIntf.Add(ChangeList[I])
|
|
else
|
|
UsesIntf.Insert(0, ChangeList[I]);
|
|
UsesImpl.Remove(UsesImpl.IndexOf(ChangeList[I]));
|
|
end;
|
|
else
|
|
ChangeList.Delete(I);
|
|
end;
|
|
|
|
if ChangeList.Count = 0 then
|
|
Exit;
|
|
|
|
with BorlandIDEServices as IOTAEditorServices do
|
|
if Assigned(TopBuffer) then
|
|
begin
|
|
Writer := TopBuffer.CreateUndoableWriter;
|
|
try
|
|
Writer.CopyTo(Length(TextBeforeIntf));
|
|
Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength);
|
|
Writer.Insert(PChar(UsesIntf.Text));
|
|
Writer.CopyTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf));
|
|
Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf) + ImplLength);
|
|
Writer.Insert(PChar(UsesImpl.Text));
|
|
Writer.CopyTo(Length(GoalSource));
|
|
finally
|
|
Writer := nil;
|
|
end;
|
|
end;
|
|
|
|
// attempt to recompile
|
|
Project := GetActiveProject;
|
|
if Assigned(Project) and Assigned(Project.ProjectBuilder) then
|
|
Project.ProjectBuilder.BuildProject(cmOTAMake, True, True);
|
|
end;
|
|
finally
|
|
ChangeList.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
Goal.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.ResolveUsesName(Error: PErrorInfo);
|
|
var
|
|
I: Integer;
|
|
Identifiers: TStrings;
|
|
IdentifierIndex: Integer;
|
|
begin
|
|
if FIdentifierLists.Count = 0 then
|
|
InitializeIdentifierLists;
|
|
|
|
Identifiers := TStringList.Create;
|
|
try
|
|
with FIdentifierLists do
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
Identifiers.CommaText := Values[Names[I]];
|
|
with Error^ do
|
|
begin
|
|
IdentifierIndex := Identifiers.IndexOf(Identifier);
|
|
if IdentifierIndex <> -1 then
|
|
begin
|
|
StrLCopy(UsesName, PChar(Names[I]), Length(UsesName));
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Identifiers.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.SetActive(Value: Boolean);
|
|
begin
|
|
if Value <> FActive then
|
|
begin
|
|
if Value then
|
|
begin
|
|
with BorlandIDEServices as IOTAServices do
|
|
FNotifierIndex := AddNotifier(TJCLUsesWizardNotifier.Create(Self));
|
|
|
|
FActive := FNotifierIndex <> -1;
|
|
end
|
|
else
|
|
begin
|
|
if FNotifierIndex <> -1 then
|
|
with BorlandIDEServices as IOTAServices do
|
|
RemoveNotifier(FNotifierIndex);
|
|
|
|
FNotifierIndex := -1;
|
|
FActive := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.SetConfirmChanges(Value: Boolean);
|
|
begin
|
|
if Value <> FConfirmChanges then
|
|
begin
|
|
FConfirmChanges := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TJCLUsesWizard.SetIniFile(const Value: string);
|
|
begin
|
|
FIniFile := Value;
|
|
end;
|
|
|
|
//=== { TJCLUsesWizard } =====================================================
|
|
|
|
// public
|
|
|
|
constructor TJCLUsesWizard.Create;
|
|
begin
|
|
inherited Create(JclUsesExpertName);
|
|
FIdentifierLists := TStringList.Create;
|
|
FErrors := TList.Create;
|
|
FActive := False;
|
|
FConfirmChanges := False;
|
|
FNotifierIndex := -1;
|
|
|
|
LoadFromRegistry;
|
|
end;
|
|
|
|
destructor TJCLUsesWizard.Destroy;
|
|
begin
|
|
SetActive(False);
|
|
ClearErrors;
|
|
FErrors.Free;
|
|
FIdentifierLists.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJCLUsesWizard.LoadFromRegistry: Boolean;
|
|
var
|
|
S: string;
|
|
Root: DelphiHKEY;
|
|
begin
|
|
S := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey + '\' + JediIDESubKey + JclUsesExpertName;
|
|
Root := HKEY_CURRENT_USER;
|
|
Result := RegKeyExists(Root, S);
|
|
if not Result then
|
|
begin
|
|
Root := HKEY_LOCAL_MACHINE;
|
|
Result := RegKeyExists(Root, S);
|
|
end;
|
|
SetActive(RegReadBoolDef(Root, S, SRegWizardActive, False));
|
|
FConfirmChanges := RegReadBoolDef(Root, S, SRegWizardConfirm, True);
|
|
FIniFile := RegReadStringDef(Root, S, SRegWizardIniFile, '');
|
|
end;
|
|
|
|
// create and register wizard instance
|
|
|
|
procedure Register;
|
|
begin
|
|
try
|
|
RegisterPackageWizard(TJCLUsesWizard.Create);
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
JCLWizardIndex: Integer = -1;
|
|
|
|
procedure JclWizardTerminate;
|
|
var
|
|
OTAWizardServices: IOTAWizardServices;
|
|
begin
|
|
try
|
|
if JCLWizardIndex <> -1 then
|
|
begin
|
|
Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices);
|
|
if not Assigned(OTAWizardServices) then
|
|
raise EJclExpertException.CreateTrace(RsENoWizardServices);
|
|
|
|
OTAWizardServices.RemoveWizard(JCLWizardIndex);
|
|
end;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
|
|
RegisterProc: TWizardRegisterProc;
|
|
var TerminateProc: TWizardTerminateProc): Boolean stdcall;
|
|
var
|
|
OTAWizardServices: IOTAWizardServices;
|
|
begin
|
|
try
|
|
TerminateProc := JclWizardTerminate;
|
|
|
|
Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices);
|
|
if not Assigned(OTAWizardServices) then
|
|
raise EJclExpertException.CreateTrace(RsENoWizardServices);
|
|
|
|
JCLWizardIndex := OTAWizardServices.AddWizard(TJCLUsesWizard.Create);
|
|
|
|
Result := True;
|
|
except
|
|
on ExceptionObj: TObject do
|
|
begin
|
|
JclExpertShowExceptionDialog(ExceptionObj);
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JCLUsesWizard.pas,v $
|
|
// Revision 1.9 2006/01/08 17:16:57 outchy
|
|
// Settings reworked.
|
|
// Common window for expert configurations
|
|
//
|
|
// Revision 1.8 2005/12/26 18:03:41 outchy
|
|
// Enhanced bds support (including C#1 and D8)
|
|
// Introduction of dll experts
|
|
// Project types in templates
|
|
//
|
|
// Revision 1.7 2005/12/16 23:46:25 outchy
|
|
// Added expert stack form.
|
|
// Added code to display call stack on expert exception.
|
|
// Fixed package extension for D2006.
|
|
//
|
|
// Revision 1.6 2005/10/26 03:29:44 rrossmair
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and $Log: JCLUsesWizard.pas,v $
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.9 2006/01/08 17:16:57 outchy
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Settings reworked.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Common window for expert configurations
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.8 2005/12/26 18:03:41 outchy
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Enhanced bds support (including C#1 and D8)
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Introduction of dll experts
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Project types in templates
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.7 2005/12/16 23:46:25 outchy
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added expert stack form.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added code to display call stack on expert exception.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Fixed package extension for D2006.
|
|
// - improved header information, added $Date: 2006/01/08 17:16:57 $ and CVS tags.
|
|
//
|
|
|
|
end.
|