paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 09:59:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improve source conversion. Edits in uses section are first collected to lists.

Browse Source 
git-svn-id: trunk@23784 -
This commit is contained in:
juha 2010-02-25 02:19:24 +00:00
parent e930e50b5e
commit 9f7ad44770
2 changed files with 318 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

177
converter/convcodetool.pas
View File

@ -6,17 +6,18 @@ interface
uses uses
// LCL+FCL // LCL+FCL
Classes, SysUtils, FileProcs, Forms, Controls, DialogProcs, Classes, SysUtils, FileProcs, Forms, Controls, DialogProcs, Dialogs,
// TypInfo, CodeToolsStrConsts, AVL_Tree, LFMTrees, // IDE
LazarusIDEStrConsts, LazIDEIntf,
// codetools // codetools
CodeToolManager, StdCodeTools, CodeTree, CodeAtom, //IdentCompletionTool, CodeToolManager, StdCodeTools, CodeTree, CodeAtom,
FindDeclarationTool, PascalReaderTool, PascalParserTool, FindDeclarationTool, PascalReaderTool, PascalParserTool,
CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner,
CodeCache, SourceChanger, CustomCodeTool, CodeToolsStructs, EventCodeTool; CodeCache, SourceChanger, CustomCodeTool, CodeToolsStructs, EventCodeTool;
type type
{ TConvCodeTool } { TConvDelphiCodeTool }
TConvDelphiCodeTool = class // (TStandardCodeTool) TConvDelphiCodeTool = class // (TStandardCodeTool)
private private
@ -26,36 +27,58 @@ type
fScanner: TLinkScanner; fScanner: TLinkScanner;
fAsk: Boolean; fAsk: Boolean;
fAddLRSCode: boolean; fAddLRSCode: boolean;
fMakeLowerCaseRes: boolean; fLowerCaseRes: boolean;
// List of units to remove.
fUnitsToRemove: TStringList;
// Units to rename. Map of unit name -> real unit name.
fUnitsToRename: TStringToStringTree;
// List of units to add.
fUnitsToAdd: TStringList;
// List of units to be commented.
fUnitsToComment: TStringList;
function AddModeDelphiDirective: boolean; function AddModeDelphiDirective: boolean;
function ConvertUsedUnits: boolean;
function RemoveDFMResourceDirective: boolean; function RemoveDFMResourceDirective: boolean;
function LowerCaseMainResourceDirective: boolean; function LowerCaseMainResourceDirective: boolean;
function AddLRSIncludeDirective: boolean; function AddLRSIncludeDirective: boolean;
function RemoveUnits: boolean;
function RenameUnits: boolean;
function AddUnits: boolean;
function CommentOutUnits: boolean;
// function ConvertUsedUnits: boolean;
function HandleCodetoolError: TModalResult;
public public
constructor Create(Code: TCodeBuffer; Ask, MakeLowerCaseRes, AddLRSCode: boolean); constructor Create(Code: TCodeBuffer);
destructor Destroy; override; destructor Destroy; override;
function Convert: TModalResult; function Convert: TModalResult;
public
property Ask: Boolean read fAsk write fAsk;
property AddLRSCode: boolean read fAddLRSCode write fAddLRSCode;
property LowerCaseRes: boolean read fLowerCaseRes write fLowerCaseRes;
property UnitsToRemove: TStringList read fUnitsToRemove write fUnitsToRemove;
property UnitsToRename: TStringToStringTree read fUnitsToRename write fUnitsToRename;
property UnitsToAdd: TStringList read fUnitsToAdd write fUnitsToAdd;
property UnitsToComment: TStringList read fUnitsToComment write fUnitsToComment;
end; end;
implementation implementation
{ TConvDelphiCodeTool } { TConvDelphiCodeTool }
constructor TConvDelphiCodeTool.Create(Code: TCodeBuffer; constructor TConvDelphiCodeTool.Create(Code: TCodeBuffer);
Ask, MakeLowerCaseRes, AddLRSCode: boolean);
begin begin
fCode:=Code; fCode:=Code;
fAsk:=Ask; // Default values for vars.
fMakeLowerCaseRes:=MakeLowerCaseRes; fAsk:=true;
fAddLRSCode:=AddLRSCode; fLowerCaseRes:=false;
fAddLRSCode:=false;
fUnitsToComment:=nil;
fUnitsToRename:=nil;
// Initialize codetools. (Copied from TCodeToolManager.) // Initialize codetools. (Copied from TCodeToolManager.)
if not CodeToolBoss.InitCurCodeTool(Code) then exit; if not CodeToolBoss.InitCurCodeTool(Code) then exit;
try try
fCodeTool:=CodeToolBoss.CurCodeTool; fCodeTool:=CodeToolBoss.CurCodeTool;
fSrcCache:=CodeToolBoss.SourceChangeCache; fSrcCache:=CodeToolBoss.SourceChangeCache;
if fSrcCache=nil then exit; // if fSrcCache=nil then exit;
fScanner:=fCodeTool.Scanner; fScanner:=fCodeTool.Scanner;
fSrcCache.MainScanner:=fScanner; fSrcCache.MainScanner:=fScanner;
except except
@ -69,7 +92,33 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TConvDelphiCodeTool.HandleCodetoolError: TModalResult;
// returns mrOk or mrAbort
const
CodetoolsFoundError='The codetools found an error in unit %s:%s%s%s';
var
ErrMsg: String;
begin
ErrMsg:=CodeToolBoss.ErrorMessage;
LazarusIDE.DoJumpToCodeToolBossError;
if fAsk then begin
Result:=QuestionDlg(lisCCOErrorCaption,
Format(CodetoolsFoundError, [ExtractFileName(fCode.Filename), #13, ErrMsg, #13]),
mtWarning, [mrIgnore, lisIgnoreAndContinue, mrAbort], 0);
if Result=mrIgnore then Result:=mrOK;
end else begin
Result:=mrOK;
end;
end;
function TConvDelphiCodeTool.Convert: TModalResult; function TConvDelphiCodeTool.Convert: TModalResult;
// add {$mode delphi} directive
// remove windows unit and add LResources, LCLIntf
// remove {$R *.dfm} or {$R *.xfm} directive
// Change {$R *.RES} to {$R *.res} if needed
// add initialization
// add {$i unit.lrs} directive
// TODO: fix delphi ambiguousities like incomplete proc implementation headers
begin begin
Result:=mrCancel; Result:=mrCancel;
try try
@ -84,11 +133,18 @@ begin
finally finally
fSrcCache.EndUpdate; fSrcCache.EndUpdate;
end; end;
if not ConvertUsedUnits then exit; if not RemoveUnits then exit;
if not RenameUnits then exit;
if not AddUnits then exit;
if not CommentOutUnits then exit;
if not fCodeTool.FixUsedUnitCase(fSrcCache) then exit;
if not fSrcCache.Apply then exit; if not fSrcCache.Apply then exit;
Result:=mrOK; Result:=mrOK;
except except
Result:=JumpToCodetoolErrorAndAskToAbort(fAsk); on e: Exception do begin
CodeToolBoss.HandleException(e);
Result:=HandleCodetoolError;
end;
end; end;
end; end;
@ -108,9 +164,8 @@ begin
ReadNextAtom; // name ReadNextAtom; // name
ReadNextAtom; // semicolon ReadNextAtom; // semicolon
InsertPos:=CurPos.EndPos; InsertPos:=CurPos.EndPos;
fSrcCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos, fSrcCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,'{$MODE Delphi}');
'{$MODE Delphi}'); // if not fSrcCache.Apply then exit;
if not fSrcCache.Apply then exit;
end; end;
// changing mode requires rescan // changing mode requires rescan
BuildTree(false); BuildTree(false);
@ -118,40 +173,6 @@ begin
Result:=true; Result:=true;
end; end;
function TConvDelphiCodeTool.ConvertUsedUnits: boolean;
// replace unit 'Windows' with 'LCLIntf' and add 'LResources'
// rename 'in' filenames to case sensitive filename
var
NamePos, InPos: TAtomPosition;
begin
Result:=false;
if fCodeTool.FindUnitInAllUsesSections('WINDOWS',NamePos,InPos)
and (InPos.StartPos<1) then begin
if not fSrcCache.Replace(gtNone,gtNone,
NamePos.StartPos,NamePos.EndPos,'LCLIntf') then
begin
exit;
end;
if not fSrcCache.Apply then exit;
end;
if fAddLRSCode then
begin
if not fCodeTool.AddUnitToMainUsesSection('LResources','',fSrcCache) then
begin
exit;
end;
end;
if not fCodeTool.RemoveUnitFromAllUsesSections('VARIANTS',fSrcCache) then
begin
exit;
end;
if not fCodeTool.FixUsedUnitCase(fSrcCache) then
begin
exit;
end;
Result:=true;
end;
function TConvDelphiCodeTool.RemoveDFMResourceDirective: boolean; function TConvDelphiCodeTool.RemoveDFMResourceDirective: boolean;
// remove {$R *.dfm} or {$R *.xfm} directive // remove {$R *.dfm} or {$R *.xfm} directive
var var
@ -189,7 +210,7 @@ var
ACleanPos: Integer; ACleanPos: Integer;
s: String; s: String;
begin begin
if fMakeLowerCaseRes then begin if fLowerCaseRes then begin
Result:=false; Result:=false;
// find $R directive // find $R directive
ACleanPos:=1; ACleanPos:=1;
@ -257,6 +278,54 @@ begin
Result:=true; Result:=true;
end; end;
function TConvDelphiCodeTool.RemoveUnits: boolean;
// Remove units
var
i: Integer;
begin
Result:=false;
if Assigned(fUnitsToRemove) then begin
for i := 0 to fUnitsToRemove.Count-1 do
if not fCodeTool.RemoveUnitFromAllUsesSections(fUnitsToRemove[i], fSrcCache) then
exit;
end;
Result:=true;
end;
function TConvDelphiCodeTool.RenameUnits: boolean;
// Rename units
begin
Result:=false;
if Assigned(fUnitsToRename) then
if not fCodeTool.ReplaceUsedUnits(fUnitsToRename, fSrcCache) then
exit;
Result:=true;
end;
function TConvDelphiCodeTool.AddUnits: boolean;
// Add units
var
i: Integer;
begin
Result:=false;
if Assigned(fUnitsToAdd) then
for i := 0 to fUnitsToAdd.Count-1 do
if not fCodeTool.AddUnitToMainUsesSection(fUnitsToAdd[i],'',fSrcCache) then
exit;
Result:=true;
end;
function TConvDelphiCodeTool.CommentOutUnits: boolean;
// Comment out missing units
begin
Result:=false;
if Assigned(fUnitsToComment) and (fUnitsToComment.Count>0) then
if not fCodeTool.CommentUnitsInUsesSections(fUnitsToComment, fSrcCache) then
exit;
// IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
Result:=true;
end;
end. end.

312
converter/convertdelphi.pas
View File

@ -33,10 +33,11 @@ interface
uses uses
// LCL+FCL // LCL+FCL
Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, LResources, Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, LResources,
FileUtil, IniFiles, contnrs, FileUtil, contnrs, IniFiles,
// codetools // codetools
CodeToolManager, DefineTemplates, CodeAtom, CodeCache, LinkScanner, CodeToolManager, DefineTemplates, CodeAtom, CodeCache, LinkScanner,
FileProcs, CodeToolsStructs,
// IDEIntf // IDEIntf
ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf, ComponentReg, IDEMsgIntf, MainIntf, LazIDEIntf, PackageIntf, ProjectIntf,
// IDE // IDE
@ -75,6 +76,17 @@ type
// Actual code for unit and form file. // Actual code for unit and form file.
fUnitCode, fLfmCode: TCodeBuffer; fUnitCode, fLfmCode: TCodeBuffer;
fFlags: TConvertUnitFlags; fFlags: TConvertUnitFlags;
// Units not found in project dir or packages.
fMissingUnits: TStrings;
// Units to remove.
fUnitsToRemove: TStringList;
// Units to rename. Map of unit name -> real unit name.
fUnitsToRename: TStringToStringTree;
// Units to add.
fUnitsToAdd: TStringList;
// Units collected to be commented later.
fUnitsToComment: TStringList;
fSettings: TConvertSettings; fSettings: TConvertSettings;
function GetDfmFileName: string; function GetDfmFileName: string;
function CopyAndLoadFile: TModalResult; function CopyAndLoadFile: TModalResult;
@ -82,9 +94,10 @@ type
function ConvertFormFile: TModalResult; function ConvertFormFile: TModalResult;
function ConvertDfmToLfm(const LfmFilename: string): TModalResult; function ConvertDfmToLfm(const LfmFilename: string): TModalResult;
function MissingUnitToMsg(MissingUnit: string): string; function MissingUnitToMsg(MissingUnit: string): string;
function CommentAutomatically(MissingUnits: TStrings): integer; function CommentAutomatically: integer;
function AskUnitPathFromUser(MissingUnits: TStrings): TModalResult; function AskUnitPathFromUser: TModalResult;
function FixMissingUnits(ShowAbort: boolean): TModalResult; function FixIncludeFiles: TModalResult;
function FixMissingUnits: TModalResult;
protected protected
public public
constructor Create(AOwnerConverter: TConvertDelphiPBase; const AFilename: string; constructor Create(AOwnerConverter: TConvertDelphiPBase; const AFilename: string;
@ -114,9 +127,13 @@ type
fDelphiPFilename: string; // .dpr or .dpk file name fDelphiPFilename: string; // .dpr or .dpk file name
fLazPSuffix: string; // '.lpi' or '.lpk' fLazPSuffix: string; // '.lpi' or '.lpk'
fDelphiPSuffix: string; // '.dpr' or '.dpk' fDelphiPSuffix: string; // '.dpr' or '.dpk'
fCachedUnitNames: THashedStringList; // Units found in user defined paths.
fSettings: TConvertSettings; fCachedUnitNames: TStringToStringTree;
// Map of case incorrect unit name -> real unit name.
fCachedRealUnitNames: TStringToStringTree;
// Missing units that are commented automatically in all units.
fAllMissingUnits: TStringList; fAllMissingUnits: TStringList;
fSettings: TConvertSettings;
function ConvertSub: TModalResult; function ConvertSub: TModalResult;
procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions); procedure CleanUpCompilerOptionsSearchPaths(Options: TBaseCompilerOptions);
procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate); procedure SetCompilerModeForDefineTempl(DefTempl: TDefineTemplate);
@ -125,10 +142,14 @@ type
function ReadDelphiConfigFiles: TModalResult; function ReadDelphiConfigFiles: TModalResult;
function ExtractOptionsFromDOF(const DOFFilename: string): TModalResult; function ExtractOptionsFromDOF(const DOFFilename: string): TModalResult;
function ExtractOptionsFromCFG(const CFGFilename: string): TModalResult; function ExtractOptionsFromCFG(const CFGFilename: string): TModalResult;
function LocateMissingUnits(MissingUnits: TStrings): integer; function DoMissingUnits(MissingUnits: TStrings): integer;
function DoCaseErrorUnits(MissingUnits: TStrings;
UnitsToRename: TStringToStringTree): integer;
procedure CacheUnitsInPath(const APath, ABasePath: string); procedure CacheUnitsInPath(const APath, ABasePath: string);
procedure CacheUnitsInPath(const APath: string); procedure CacheUnitsInPath(const APath: string);
function GetCachedUnitPath(const AUnitName: string): string; function GetCachedUnitPath(const AUnitName: string): string;
function NeedsRenameUnit(const AUnitName: string;
out RealUnitName: string): Boolean;
protected protected
function CreateInstance: TModalResult; virtual; abstract; function CreateInstance: TModalResult; virtual; abstract;
function CreateMainSourceFile: TModalResult; virtual; function CreateMainSourceFile: TModalResult; virtual;
@ -534,69 +555,88 @@ var
LrsFilename: string; // Resource file name. LrsFilename: string; // Resource file name.
ConvTool: TConvDelphiCodeTool; ConvTool: TConvDelphiCodeTool;
begin begin
fLfmCode:=nil; fUnitsToRemove:=TStringList.Create;
LrsFilename:=''; fUnitsToRename:=TStringToStringTree.Create(false);
// rename files (.pas,.dfm) lowercase. TODO: rename files in project fUnitsToAdd:=TStringList.Create;
LfmFilename:=fSettings.DelphiToLazFilename(fOrigUnitFilename, '.lfm', fUnitsToComment:=TStringList.Create;
cdtlufRenameLowercase in fFlags); ConvTool:=TConvDelphiCodeTool.Create(fUnitCode);
// Get DFM file name and close it in editor. try
DfmFilename:=GetDfmFileName; fLfmCode:=nil;
if DfmFilename<>'' then begin LrsFilename:='';
Result:=LazarusIDE.DoCloseEditorFile(DfmFilename,[cfSaveFirst]); // rename files (.pas,.dfm) lowercase. TODO: rename files in project
if Result<>mrOk then exit; LfmFilename:=fSettings.DelphiToLazFilename(fOrigUnitFilename, '.lfm',
if FileExistsUTF8(LfmFilename) then begin cdtlufRenameLowercase in fFlags);
if (FileAgeUTF8(LfmFilename)>=FileAgeUTF8(DfmFilename)) then begin // Get DFM file name and close it in editor.
// .lfm is not older than .dfm -> keep .lfm (it could be the same file) DfmFilename:=GetDfmFileName;
end else begin if DfmFilename<>'' then begin
// .lfm is older than .dfm -> remove .lfm Result:=LazarusIDE.DoCloseEditorFile(DfmFilename,[cfSaveFirst]);
DeleteFileUTF8(LfmFilename); if Result<>mrOk then exit;
if FileExistsUTF8(LfmFilename) then begin
if (FileAgeUTF8(LfmFilename)>=FileAgeUTF8(DfmFilename)) then begin
// .lfm is not older than .dfm -> keep .lfm (it could be the same file)
end else begin
// .lfm is older than .dfm -> remove .lfm
DeleteFileUTF8(LfmFilename);
end;
end;
if not FileExistsUTF8(LfmFilename) then begin
// TODO: update project
Result:=fSettings.RenameFile(DfmFilename,LfmFilename);
if Result<>mrOK then exit;
end; end;
end; end;
if not FileExistsUTF8(LfmFilename) then begin // convert .dfm file to .lfm file (without context type checking)
// TODO: update project if FileExistsUTF8(LfmFilename) then begin
Result:=fSettings.RenameFile(DfmFilename,LfmFilename); IDEMessagesWindow.AddMsg('Converting DFM to LFM file '+LfmFilename,'',-1);
if Result<>mrOK then exit; Result:=ConvertDfmToLfm(LfmFilename);
if Result<>mrOk then exit;
// create empty .lrs file
LrsFilename:=ChangeFileExt(fLazUnitFilename,'.lrs');
IDEMessagesWindow.AddMsg('Creating resource file '+LrsFilename,'',-1);
Result:=CreateEmptyFile(LrsFilename,[mbAbort,mbRetry]);
if Result<>mrOk then exit;
// Read form file code in.
Result:=LoadCodeBuffer(fLfmCode,LfmFilename,
[lbfCheckIfText,lbfUpdateFromDisk],true);
if Result<>mrOk then exit;
end; end;
end;
// convert .dfm file to .lfm file (without context type checking)
if FileExistsUTF8(LfmFilename) then begin
IDEMessagesWindow.AddMsg('Converting DFM to LFM file '+LfmFilename,'',-1);
Result:=ConvertDfmToLfm(LfmFilename);
if Result<>mrOk then exit;
// create empty .lrs file
LrsFilename:=ChangeFileExt(fLazUnitFilename,'.lrs');
IDEMessagesWindow.AddMsg('Creating resource file '+LrsFilename,'',-1);
Result:=CreateEmptyFile(LrsFilename,[mbAbort,mbRetry]);
if Result<>mrOk then exit;
// Read form file code in.
Result:=LoadCodeBuffer(fLfmCode,LfmFilename,
[lbfCheckIfText,lbfUpdateFromDisk],true);
if Result<>mrOk then exit;
end;
// check LCL path only for projects/packages. // check LCL path only for projects/packages.
if Assigned(fOwnerConverter) then begin if Assigned(fOwnerConverter) then begin
Result:=CheckFilenameForLCLPaths(fLazUnitFilename); Result:=CheckFilenameForLCLPaths(fLazUnitFilename);
if Result<>mrOk then exit;
end;
// Fix include file names.
Result:=FixIncludeFiles;
if Result<>mrOk then exit; if Result<>mrOk then exit;
end; // Fix or comment missing units, show error messages.
// add {$mode delphi} directive Result:=FixMissingUnits;
// remove windows unit and add LResources, LCLIntf if Result<>mrOk then exit;
// remove {$R *.dfm} or {$R *.xfm} directive
// Change {$R *.RES} to {$R *.res} if needed // Some units to remove, rename and add.
// add initialization fUnitsToRename['WINDOWS']:='LCLIntf';
// add {$i unit.lrs} directive if LrsFilename<>'' then
// TODO: fix delphi ambiguousities like incomplete proc implementation headers fUnitsToAdd.Append('LResources');
ConvTool:=TConvDelphiCodeTool.Create(fUnitCode, Assigned(fOwnerConverter), fUnitsToRemove.Append('VARIANTS');
FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res')),
LrsFilename<>''); // Do the actual code conversion.
try ConvTool.Ask:=Assigned(fOwnerConverter);
ConvTool.LowerCaseRes:=FileExistsUTF8(ChangeFileExt(fLazUnitFilename, '.res'));
ConvTool.AddLRSCode:=LrsFilename<>'';
ConvTool.UnitsToRemove:=fUnitsToRemove;
ConvTool.UnitsToRename:=fUnitsToRename;
ConvTool.UnitsToAdd:=fUnitsToAdd;
ConvTool.UnitsToComment:=fUnitsToComment;
Result:=ConvTool.Convert; Result:=ConvTool.Convert;
if Result=mrAbort then exit; // if Result=mrAbort then exit;
finally finally
ConvTool.Free; ConvTool.Free;
fUnitsToComment.Free;
fUnitsToAdd.Free;
fUnitsToRename.Free;
fUnitsToRemove.Free;
end; end;
// Fix or comment missing units, FixMissingUnits shows error messages.
Result:=FixMissingUnits(true);
end; end;
function TConvertDelphiUnit.ConvertFormFile: TModalResult; function TConvertDelphiUnit.ConvertFormFile: TModalResult;
@ -700,33 +740,24 @@ begin
+'Can''t find unit '+MissingUnit; +'Can''t find unit '+MissingUnit;
end; end;
function TConvertDelphiUnit.CommentAutomatically(MissingUnits: TStrings): integer; function TConvertDelphiUnit.CommentAutomatically: integer;
// Comment automatically unit names that were commented in other files. // Comment automatically unit names that were commented in other files.
// Return the number of missing units still left. // Return the number of missing units still left.
var var
AutoUnits: TStringList;
i, x: Integer; i, x: Integer;
s: string; s: string;
begin begin
AutoUnits:=TStringList.Create; for i:=fMissingUnits.Count-1 downto 0 do begin
try s:=fMissingUnits[i];
for i:=MissingUnits.Count-1 downto 0 do begin if fOwnerConverter.fAllMissingUnits.Find(s, x) then begin
s:=MissingUnits[i]; fUnitsToComment.Append(s);
if fOwnerConverter.fAllMissingUnits.Find(s, x) then begin fMissingUnits.Delete(i);
AutoUnits.Append(s);
MissingUnits.Delete(i);
end;
end; end;
if AutoUnits.Count>0 then
if not CodeToolBoss.CommentUnitsInUsesSections(fUnitCode,AutoUnits) then
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
Result:=MissingUnits.Count;
finally
AutoUnits.Free;
end; end;
Result:=fMissingUnits.Count;
end; end;
function TConvertDelphiUnit.AskUnitPathFromUser(MissingUnits: TStrings): TModalResult; function TConvertDelphiUnit.AskUnitPathFromUser: TModalResult;
var var
TryAgain: Boolean; TryAgain: Boolean;
UnitDirDialog: TSelectDirectoryDialog; UnitDirDialog: TSelectDirectoryDialog;
@ -735,16 +766,14 @@ begin
// ask user what to do // ask user what to do
repeat repeat
TryAgain:=False; TryAgain:=False;
Result:=AskMissingUnits(MissingUnits, ExtractFileName(fLazUnitFilename)); Result:=AskMissingUnits(fMissingUnits, ExtractFileName(fLazUnitFilename));
case Result of case Result of
// mrOK means: comment out. // mrOK means: comment out.
mrOK: begin mrOK: begin
// These units will be commented automatically in this project/package. // These units will be commented automatically in this project/package.
if Assigned(fOwnerConverter) then if Assigned(fOwnerConverter) then
fOwnerConverter.fAllMissingUnits.AddStrings(MissingUnits); fOwnerConverter.fAllMissingUnits.AddStrings(fMissingUnits);
// comment missing units fUnitsToComment.AddStrings(fMissingUnits);
if not CodeToolBoss.CommentUnitsInUsesSections(fUnitCode,MissingUnits) then
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
end; end;
// mrYes means: Search for unit path. // mrYes means: Search for unit path.
mrYes: begin mrYes: begin
@ -753,11 +782,13 @@ begin
UnitDirDialog.InitialDir:=fSettings.MainPath; UnitDirDialog.InitialDir:=fSettings.MainPath;
UnitDirDialog.Title:='All sub-directories will be scanned for unit files'; UnitDirDialog.Title:='All sub-directories will be scanned for unit files';
if UnitDirDialog.Execute and Assigned(fOwnerConverter) then begin if UnitDirDialog.Execute and Assigned(fOwnerConverter) then begin
PrevMiss:=MissingUnits.Count; PrevMiss:=fMissingUnits.Count;
// Add the new path to project if missing units are found. // Add the new path to project if missing units are found.
fOwnerConverter.CacheUnitsInPath(UnitDirDialog.Filename); fOwnerConverter.CacheUnitsInPath(UnitDirDialog.Filename);
TryAgain:=fOwnerConverter.LocateMissingUnits(MissingUnits)>0; TryAgain:=fOwnerConverter.DoMissingUnits(fMissingUnits)>0;
if TryAgain and (PrevMiss<>MissingUnits.Count) then if TryAgain then
TryAgain:=fOwnerConverter.DoCaseErrorUnits(fMissingUnits, fUnitsToRename)>0;
if TryAgain and (PrevMiss<>fMissingUnits.Count) then
ShowMessage('Some units were found but not all.'); ShowMessage('Some units were found but not all.');
end; end;
finally finally
@ -771,20 +802,18 @@ begin
until not TryAgain; until not TryAgain;
end; end;
function TConvertDelphiUnit.FixMissingUnits(ShowAbort: boolean): TModalResult; function TConvertDelphiUnit.FixIncludeFiles: TModalResult;
// fix include filenames
var var
CTResult: Boolean;
i: Integer;
Msg: string;
MissingUnits: TStrings;
CodePos: PCodeXYPosition;
MissingIncludeFilesCodeXYPos: TFPList; MissingIncludeFilesCodeXYPos: TFPList;
CodePos: PCodeXYPosition;
Msg: string;
i: Integer;
begin begin
// fix include filenames Result:=mrOk;
MissingIncludeFilesCodeXYPos:=nil; MissingIncludeFilesCodeXYPos:=nil;
try try
if not CodeToolBoss.FixIncludeFilenames(fUnitCode,true, if not CodeToolBoss.FixIncludeFilenames(fUnitCode,true,MissingIncludeFilesCodeXYPos)
MissingIncludeFilesCodeXYPos)
then begin then begin
if MissingIncludeFilesCodeXYPos<>nil then begin if MissingIncludeFilesCodeXYPos<>nil then begin
for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin
@ -792,44 +821,59 @@ begin
Msg:=CodePos^.Code.Filename Msg:=CodePos^.Code.Filename
+'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')' +'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')'
+' missing include file'; +' missing include file';
IDEMessagesWindow.AddMsg(Msg,'',-1); IDEMessagesWindow.AddMsg(Msg, '', -1);
end; end;
end; end;
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1); IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"', '', -1);
exit; exit;
end; end;
finally finally
CodeToolBoss.FreeListOfPCodeXYPosition(MissingIncludeFilesCodeXYPos); CodeToolBoss.FreeListOfPCodeXYPosition(MissingIncludeFilesCodeXYPos);
end; end;
end;
function TConvertDelphiUnit.FixMissingUnits: TModalResult;
var
CTResult: Boolean;
i: Integer;
begin
Result:=mrOk; Result:=mrOk;
MissingUnits:=nil; fMissingUnits:=nil; // Will be created in CodeToolBoss.FindMissingUnits.
try try
// find missing units // find missing units
CTResult:=CodeToolBoss.FindMissingUnits(fUnitCode,MissingUnits,true); CTResult:=CodeToolBoss.FindMissingUnits(fUnitCode,fMissingUnits,true);
if not CTResult then begin if not CTResult then begin
IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1); IDEMessagesWindow.AddMsg('Error="'+CodeToolBoss.ErrorMessage+'"','',-1);
exit; exit;
end; end;
// no missing units -> good // no missing units -> good
if (MissingUnits=nil) or (MissingUnits.Count=0) then exit; if (fMissingUnits=nil) or (fMissingUnits.Count=0) then exit;
// Remove Windows unit from missing list. It will be changed later.
for i:=fMissingUnits.Count-1 downto 0 do begin
if UpperCase(fMissingUnits[i])='WINDOWS' then begin
fMissingUnits.Delete(i);
break;
end;
end;
if fMissingUnits.Count=0 then exit;
if Assigned(fOwnerConverter) then begin if Assigned(fOwnerConverter) then begin
// Try to find from subdirectories above project path first. // Try to find from subdirectories scanned earlier.
if fOwnerConverter.LocateMissingUnits(MissingUnits)=0 then exit; if fOwnerConverter.DoMissingUnits(fMissingUnits)=0 then exit;
// Comment out automatically units that were commented in other files. // Comment out automatically units that were commented in other files.
if CommentAutomatically(MissingUnits)=0 then exit; if CommentAutomatically=0 then exit;
end; end;
// Interactive dialog for searching unit. // Interactive dialog for searching unit.
Result:=AskUnitPathFromUser(MissingUnits); Result:=AskUnitPathFromUser;
if Result<>mrOK then exit; if Result<>mrOK then exit;
// add error messages, so the user can click on them // add error messages, so the user can click on them
for i:=0 to MissingUnits.Count-1 do for i:=0 to fMissingUnits.Count-1 do
IDEMessagesWindow.AddMsg(MissingUnitToMsg(MissingUnits[i]),'',-1); IDEMessagesWindow.AddMsg(MissingUnitToMsg(fMissingUnits[i]),'',-1);
finally finally
MissingUnits.Free; fMissingUnits.Free;
end; end;
end; end;
@ -851,7 +895,8 @@ end;
constructor TConvertDelphiPBase.Create(const AFilename, ADescription: string); constructor TConvertDelphiPBase.Create(const AFilename, ADescription: string);
begin begin
fOrigPFilename:=AFilename; fOrigPFilename:=AFilename;
fCachedUnitNames:=THashedStringList.Create; fCachedUnitNames:=TStringToStringTree.Create(true);
fCachedRealUnitNames:=TStringToStringTree.Create(true);
fSettings:=TConvertSettings.Create('Convert Delphi '+ADescription); fSettings:=TConvertSettings.Create('Convert Delphi '+ADescription);
fSettings.MainFilename:=fOrigPFilename; fSettings.MainFilename:=fOrigPFilename;
fAllMissingUnits:=TStringList.Create; fAllMissingUnits:=TStringList.Create;
@ -863,6 +908,7 @@ end;
destructor TConvertDelphiPBase.Destroy; destructor TConvertDelphiPBase.Destroy;
begin begin
fAllMissingUnits.Free; fAllMissingUnits.Free;
fCachedRealUnitNames.Free;
fCachedUnitNames.Free; fCachedUnitNames.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -1139,9 +1185,9 @@ begin
Options.SrcPath:=CleanProjectSearchPath(Options.SrcPath); Options.SrcPath:=CleanProjectSearchPath(Options.SrcPath);
end; end;
function TConvertDelphiPBase.LocateMissingUnits(MissingUnits: TStrings): integer; function TConvertDelphiPBase.DoMissingUnits(MissingUnits: TStrings): integer;
// Locate unit names in earlier cached list and remove them from MissingUnits. // Locate unit names in earlier cached list and remove them from MissingUnits.
// Return the number of missing units still left. // Return the number of units still missing.
var var
i: Integer; i: Integer;
sUnitPath: string; sUnitPath: string;
@ -1149,7 +1195,7 @@ begin
for i:=MissingUnits.Count-1 downto 0 do begin for i:=MissingUnits.Count-1 downto 0 do begin
sUnitPath:=GetCachedUnitPath(MissingUnits[i]); sUnitPath:=GetCachedUnitPath(MissingUnits[i]);
if sUnitPath<>'' then begin if sUnitPath<>'' then begin
// Add unit path to project's settings. // Found: add unit path to project's settings.
with CompOpts do with CompOpts do
OtherUnitFiles:=MergeSearchPaths(OtherUnitFiles,sUnitPath); OtherUnitFiles:=MergeSearchPaths(OtherUnitFiles,sUnitPath);
// No more missing, delete from list. // No more missing, delete from list.
@ -1159,8 +1205,29 @@ begin
Result:=MissingUnits.Count; Result:=MissingUnits.Count;
end; end;
function TConvertDelphiPBase.DoCaseErrorUnits(MissingUnits: TStrings;
UnitsToRename: TStringToStringTree): integer;
// Locate existing unit names with different case add them to UnitsToRename.
// Return the number of units still missing.
var
i: Integer;
sUnitPath, mUnit, RealUnitName: string;
begin
for i:=MissingUnits.Count-1 downto 0 do begin
mUnit:=MissingUnits[i];
sUnitPath:=GetCachedUnitPath(mUnit);
Assert(sUnitPath='', 'sUnitPath should be empty');
if NeedsRenameUnit(mUnit, RealUnitName) then begin
// Add to rename unit list, delete from missing unit list.
UnitsToRename[mUnit]:=RealUnitName;
MissingUnits.Delete(i);
end;
end;
Result:=MissingUnits.Count;
end;
procedure TConvertDelphiPBase.CacheUnitsInPath(const APath, ABasePath: string); procedure TConvertDelphiPBase.CacheUnitsInPath(const APath, ABasePath: string);
// Search all pascal units in APath and save them in fCachedUnitNames // Search all pascal units in APath and store them in fCachedUnitNames
// with a path relative to ABasePath. // with a path relative to ABasePath.
var var
PasFileList: TStringList; PasFileList: TStringList;
@ -1173,8 +1240,12 @@ begin
RelPath:=FileUtil.CreateRelativePath(PasFile, ABasePath); RelPath:=FileUtil.CreateRelativePath(PasFile, ABasePath);
SubPath:=ExtractFilePath(RelPath); SubPath:=ExtractFilePath(RelPath);
sUnitName:=ExtractFileNameOnly(RelPath); sUnitName:=ExtractFileNameOnly(RelPath);
if (SubPath<>'') and (sUnitName<>'') then if (SubPath<>'') and (sUnitName<>'') then begin
fCachedUnitNames.Values[UpperCase(sUnitName)]:=SubPath; // Map path by unit name.
fCachedUnitNames[sUnitName]:=SubPath;
// Map real unit name by uppercase unit name.
fCachedRealUnitNames[UpperCase(sUnitName)]:=sUnitName;
end;
end; end;
end; end;
@ -1186,7 +1257,14 @@ end;
function TConvertDelphiPBase.GetCachedUnitPath(const AUnitName: string): string; function TConvertDelphiPBase.GetCachedUnitPath(const AUnitName: string): string;
begin begin
Result:=fCachedUnitNames.Values[UpperCase(AUnitName)]; Result:=fCachedUnitNames[AUnitName];
end;
function TConvertDelphiPBase.NeedsRenameUnit(const AUnitName: string;
out RealUnitName: string): Boolean;
begin
RealUnitName:=fCachedRealUnitNames[UpperCase(AUnitName)];
Result := (RealUnitName<>'') and (RealUnitName<>AUnitName);
end; end;
function TConvertDelphiPBase.CreateMainSourceFile: TModalResult; function TConvertDelphiPBase.CreateMainSourceFile: TModalResult;
@ -1407,7 +1485,7 @@ begin
Result:=Converter.CheckFailed(Result); Result:=Converter.CheckFailed(Result);
if Result<>mrOK then Break; if Result<>mrOK then Break;
Result:=Converter.ConvertUnitFile; Result:=Converter.ConvertUnitFile;
Result:=Converter.CheckFailed(Result); // Result:=Converter.CheckFailed(Result);
if Result<>mrOK then Break; if Result<>mrOK then Break;
end; end;
end; end;