paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 17:59:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

improved Delphi project converter with reading .dof and .cfg file, multiple retries and fixing include filenames in .lpr

Browse Source 
git-svn-id: trunk@8868 -
This commit is contained in:
mattias 2006-03-05 23:55:40 +00:00
parent b3e9e75937
commit 0fdb95d4a6
27 changed files with 1172 additions and 270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -61,8 +61,14 @@ components/codetools/definetemplates.pas svneol=native#text/pascal
components/codetools/eventcodetool.pas svneol=native#text/pascal
components/codetools/examples/finddeclaration.lpi svneol=native#text/plain
components/codetools/examples/finddeclaration.lpr svneol=native#text/plain
components/codetools/examples/fixfilenames.lpi svneol=native#text/plain
components/codetools/examples/fixfilenames.pas svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
components/codetools/examples/methodjumping.pas svneol=native#text/plain
components/codetools/examples/scanexamples/biglettersunit.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
components/codetools/examples/scanexamples/empty.inc svneol=native#text/plain
components/codetools/examples/scanexamples/simpleunit1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/tgeneric2.pas svneol=native#text/plain
components/codetools/expreval.pas svneol=native#text/pascal

78
components/codetools/basiccodetools.pas
View File

@ -47,7 +47,11 @@ function FindNextCompilerDirective(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
function FindNextCompilerDirectiveWithName(const ASource: string;
StartPos: integer; const DirectiveName: string;
NestedComments: boolean; var ParamPos: integer): integer;
NestedComments: boolean; out ParamPos: integer): integer;
function FindNextIncludeDirective(const ASource: string;
StartPos: integer; NestedComments: boolean;
out FilenameStartPos, FileNameEndPos,
CommentStartPos, CommentEndPos: integer): integer;
function FindNextIDEDirective(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
function CleanCodeFromComments(const DirtyCode: string;
@ -1132,7 +1136,7 @@ end;
function FindNextCompilerDirectiveWithName(const ASource: string;
StartPos: integer; const DirectiveName: string;
NestedComments: boolean; var ParamPos: integer): integer;
NestedComments: boolean; out ParamPos: integer): integer;
var
Offset: Integer;
SrcLen: Integer;
@ -2199,6 +2203,76 @@ begin
CaseSensitive);
end;
function FindNextIncludeDirective(const ASource: string; StartPos: integer;
NestedComments: boolean; out FilenameStartPos, FileNameEndPos,
CommentStartPos, CommentEndPos: integer): integer;
var
MaxPos: Integer;
Offset: Integer;
begin
Result:=StartPos;
MaxPos:=length(ASource);
repeat
Result:=FindNextCompilerDirective(ASource,Result,NestedComments);
if (Result<1) or (Result>MaxPos) then exit;
if (ASource[Result]='{') then
Offset:=2
else if ASource[Result]='(' then
Offset:=3
else
Offset:=-1;
if (Offset>0) then begin
if (CompareIdentifiers('i',@ASource[Result+Offset])=0)
or (CompareIdentifiers('include',@ASource[Result+Offset])=0) then begin
CommentEndPos:=FindCommentEnd(ASource,Result,NestedComments);
if ASource[Result]='{' then
dec(CommentEndPos)
else
dec(CommentEndPos,2);
// skip directive name
FilenameStartPos:=Result+Offset;
while (FilenameStartPos<=CommentEndPos)
and (IsIDChar[ASource[FilenameStartPos]]) do
inc(FilenameStartPos);
// skip space after name
while (FilenameStartPos<=CommentEndPos)
and (IsSpaceChar[ASource[FilenameStartPos]]) do
inc(FilenameStartPos);
// find end of filename
FilenameEndPos:=FilenameStartPos;
if (FilenameEndPos<=CommentEndPos) and (ASource[FilenameEndPos]='''')
then begin
// quoted filename
inc(FilenameStartPos);
while (FilenameEndPos<=CommentEndPos) do begin
if (ASource[FilenameEndPos]<>'''') then
inc(FilenameEndPos)
else begin
inc(FilenameEndPos);
break;
end;
end;
end else begin
// normal filename
while (FilenameEndPos<=CommentEndPos)
and (not IsSpaceChar[ASource[FilenameEndPos]])
and (not (ASource[FilenameEndPos] in ['*','}'])) do
inc(FilenameEndPos);
end;
// skip space behind filename
CommentStartPos:=FilenameEndPos;
while (CommentStartPos<=CommentEndPos)
and (IsSpaceChar[ASource[CommentStartPos]]) do inc(CommentStartPos);
// success
exit;
end;
end;
// try next comment
Result:=FindCommentEnd(ASource,Result,NestedComments);
until Result>MaxPos;
end;
function FindNextIDEDirective(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
var

76
components/codetools/codetoolmanager.pas
View File

@ -276,6 +276,8 @@ type
const Filename: string = ''): boolean;
function AddResourceDirective(Code: TCodeBuffer; const Filename: string
): boolean;
function FixIncludeFilenames(Code: TCodeBuffer;
Recursive: boolean): boolean;
// keywords and comments
function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean;
@ -2043,6 +2045,80 @@ begin
end;
end;
function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
Recursive: boolean): boolean;
var
FoundIncludeFiles, MissingIncludeFiles: TStrings;
i: Integer;
AFilename: string;
ToFixIncludeFiles: TStringList;
FixedIncludeFiles: TStringList;
begin
Result:=false;
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=',Recursive);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
FixedIncludeFiles:=nil;
ToFixIncludeFiles:=TStringList.Create;
try
ToFixIncludeFiles.Add(Code.Filename);
while ToFixIncludeFiles.Count>0 do begin
// get next include file
AFilename:=ToFixIncludeFiles[ToFixIncludeFiles.Count-1];
ToFixIncludeFiles.Delete(ToFixIncludeFiles.Count-1);
Code:=LoadFile(AFilename,false,false);
if Code=nil then begin
raise ECodeToolError.Create(FCurCodeTool,
'unable to read file "'+AFilename+'"');
end;
// fix file
FoundIncludeFiles:=nil;
MissingIncludeFiles:=nil;
try
Result:=FCurCodeTool.FixIncludeFilenames(Code,SourceChangeCache,
FoundIncludeFiles,MissingIncludeFiles);
if (MissingIncludeFiles<>nil)
and (MissingIncludeFiles.Count>0) then begin
DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',MissingIncludeFiles.Text);
Result:=false;
exit;
end;
if not Recursive then begin
// check only main file -> stop
exit;
end;
// remember, that the file has been fixed to avoid cycles
if FixedIncludeFiles=nil then
FixedIncludeFiles:=TStringList.Create;
FixedIncludeFiles.Add(Code.Filename);
// add new include files to stack
if FoundIncludeFiles<>nil then begin
for i:=0 to FoundIncludeFiles.Count-1 do begin
AFilename:=FoundIncludeFiles[i];
if ((FixedIncludeFiles=nil)
or (FixedIncludeFiles.IndexOf(AFilename)<0))
and (ToFixIncludeFiles.IndexOf(AFilename)<0) then begin
ToFixIncludeFiles.Add(AFilename);
end;
end;
end;
//DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text);
finally
FoundIncludeFiles.Free;
MissingIncludeFiles.Free;
end;
end;
finally
FixedIncludeFiles.Free;
ToFixIncludeFiles.Free;
end;
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.IsKeyword(Code: TCodeBuffer; const KeyWord: string
): boolean;
begin

4
components/codetools/customcodetool.pas
View File

@ -453,8 +453,8 @@ begin
if NewScanner=FScanner then exit;
LastErrorCheckedForIgnored:=false;
Clear;
FScanner:=NewScanner; begin
if Scanner<>nil then
FScanner:=NewScanner;
if Scanner<>nil then begin
FLastScannerChangeStep:=Scanner.ChangeStep;
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);
end;

67
components/codetools/examples/fixfilenames.lpi Normal file
View File

@ -0,0 +1,67 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<LazDoc Paths=""/>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="5">
<Unit0>
<Filename Value="fixfilenames.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FixFilenames"/>
</Unit0>
<Unit1>
<Filename Value="scanexamples/brokenfilenames.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BrokenFilenames"/>
</Unit1>
<Unit2>
<Filename Value="scanexamples/brokenincfiles.inc"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="scanexamples/empty.inc"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="scanexamples/biglettersunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="BigLettersUnit"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<OtherUnitFiles Value="$(LazarusDir)/components/codetools/units/$(TargetCPU)-$(TargetOS)/"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

81
components/codetools/examples/fixfilenames.pas Normal file
View File

@ -0,0 +1,81 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Demo for automatic fixing the filenames of include directives and uses
section.
}
program FixFilenames;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, DefineTemplates, CodeToolsConfig,
CodeToolManager, CodeCache;
const
ConfigFilename = 'codetools.config';
var
Options: TCodeToolsOptions;
Code: TCodeBuffer;
Filename: String;
begin
// setup the Options
Options:=TCodeToolsOptions.Create;
// To not parse the FPC sources every time, the options are saved to a file.
if FileExists(ConfigFilename) then
Options.LoadFromFile(ConfigFilename);
// setup your paths
Options.FPCPath:='/usr/bin/ppc386';
Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
// optional: ProjectDir and TestPascalFile exists only to easily test some
// things.
Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
Options.TestPascalFile:=Options.ProjectDir+'simpleunit1.pas';
// init the codetools
if not Options.UnitLinkListValid then
writeln('Scanning FPC sources may take a while ...');
CodeToolBoss.Init(Options);
// save the options and the FPC unit links results.
Options.SaveToFile(ConfigFilename);
// load the example unit
Filename:=ExpandFileName('scanexamples/brokenfilenames.pas');
Code:=CodeToolBoss.LoadFile(Filename,false,false);
if Code=nil then
raise Exception.Create('unable to read '+Filename);
// fix the filenames in the include directives
if not CodeToolBoss.FixIncludeFilenames(Code,true) then
raise Exception.Create('unable to fix include filesnames in '+Filename+' '+CodeToolBoss.ErrorMessage);
// fix the unitnames in the uses section
//if not CodeToolBoss.FixUsesSectionsCase(Code) then
// raise Exception.Create('unable to fix unit names in '+Filename+' '+CodeToolBoss.ErrorMessage);
end.

13
components/codetools/examples/scanexamples/biglettersunit.pas Normal file
View File

@ -0,0 +1,13 @@
unit BigLettersUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
implementation
end.

19
components/codetools/examples/scanexamples/brokenfilenames.pas Normal file
View File

@ -0,0 +1,19 @@
unit BrokenFilenames;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
biglettersunit // must be fixed to BigLettersUnit
;
{$I BROKENincfiles.inc}// must be fixed to brokenincfiles.inc
{$I ../ScanExamples/BROKENincfiles.inc}// must be fixed to ../scanExamples/brokenincfiles.inc
implementation
end.

3
components/codetools/examples/scanexamples/brokenincfiles.inc Normal file
View File

@ -0,0 +1,3 @@
{$I Empty.INC} // the file is named empty.inc and will not be found under
// case sensitive file systems.

0
components/codetools/examples/scanexamples/empty.inc Normal file
View File

211
components/codetools/fileprocs.pas
View File

@ -53,6 +53,13 @@ const
{$ifdef win32}
{$define CaseInsensitiveFilenames}
{$endif}
type
TCTSearchFileCase = (
ctsfcDefault, // e.g. case insensitive on windows
ctsfcLoUpCase, // also search for lower and upper case
ctsfcAllCase // search case insensitive
);
function CompareFilenames(const Filename1, Filename2: string): integer;
function CompareFileExt(const Filename, Ext: string;
@ -73,15 +80,18 @@ function FileIsText(const AFilename: string): boolean;
function TrimFilename(const AFilename: string): string;
function CleanAndExpandFilename(const Filename: string): string;
function CleanAndExpandDirectory(const Filename: string): string;
function CreateRelativePath(const Filename, BaseDirectory: string): string;
function FileIsInPath(const Filename, Path: string): boolean;
function AppendPathDelim(const Path: string): string;
function ChompPathDelim(const Path: string): string;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
function ClearFile(const Filename: string; RaiseOnError: boolean): boolean;
function GetTempFilename(const Path, Prefix: string): string;
function SearchFileInDir(const Filename, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchCase: TCTSearchFileCase): string;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
function FindDiskFilename(const Filename: string): string;
function CompareAnsiStringFilenames(Data1, data2: Pointer): integer;
@ -292,7 +302,7 @@ end;
function FindDiskFilename(const Filename: string): string;
// Searches for the filename case on disk.
// The file must exist.
// if it does not exist, only the found path will be improved
// For example:
// If Filename='file' and there is only a 'File' then 'File' will be returned.
var
@ -303,9 +313,9 @@ var
CurFile: String;
AliasFile: String;
Ambiguous: Boolean;
FileNotFound: Boolean;
begin
Result:=Filename;
if not FileExists(Filename) then exit;
// check every directory and filename
StartPos:=1;
{$IFDEF Win32}
@ -314,9 +324,10 @@ begin
and (Result[2]=':')) then begin
StartPos:=3;
if Result[1] in ['a'..'z'] then
Result[1]:=upcase(Result[1]);
Result[1]:=UpChars[Result[1]];
end;
{$ENDIF}
FileNotFound:=false;
repeat
// skip PathDelim
while (StartPos<=length(Result)) and (Result[StartPos]=PathDelim) do
@ -356,8 +367,10 @@ begin
end;
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
end else
FileNotFound:=true;
SysUtils.FindClose(FileInfo);
if FileNotFound then break;
if (AliasFile<>'') and (not Ambiguous) then begin
// better filename found -> replace
Result:=CurDir+AliasFile+copy(Result,EndPos,length(Result));
@ -470,6 +483,9 @@ end;
function GetFilenameOnDisk(const AFilename: string): string;
begin
Result:=AFilename;
{$IFDEF CaseInsensitiveFilenames}
Result:=FindDiskFilename(Result,true);
{$ENDIF}
end;
function DirPathExists(DirectoryName: string): boolean;
@ -723,6 +739,84 @@ begin
Result:=AppendPathDelim(CleanAndExpandFilename(Filename));
end;
function CreateRelativePath(const Filename, BaseDirectory: string): string;
var
FileNameLength: Integer;
BaseDirLen: Integer;
MinLen: Integer;
SamePos: Integer;
UpDirCount: Integer;
BaseDirPos: Integer;
ResultPos: Integer;
i: Integer;
FileNameRestLen: Integer;
begin
Result:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
// check for different windows file drives
if (CompareText(ExtractFileDrive(Filename),
ExtractFileDrive(BaseDirectory))<>0)
then
exit;
FileNameLength:=length(Filename);
BaseDirLen:=length(BaseDirectory);
// skip matching directories
MinLen:=FileNameLength;
if MinLen>BaseDirLen then MinLen:=BaseDirLen;
SamePos:=1;
while (SamePos<=MinLen) do begin
{$IFDEF win32}
if AnsiStrLIComp(@FileName[SamePos],@BaseDirectory[SamePos],1)=0
{$ELSE}
if FileName[SamePos]=BaseDirectory[SamePos]
{$ENDIF}
then
inc(SamePos)
else
break;
end;
if (SamePos>MinLen)
and (((SamePos<=BaseDirLen) and (BaseDirectory[SamePos]=PathDelim))
or ((SamePos<=FileNameLength) and (Filename[SamePos]=PathDelim))
or (BaseDirLen=FileNameLength))
then begin
// Filename lies in BaseDirectory
// or Filename is parent directory of BaseDirectory
// or Filename is BaseDirectory
end else begin
// difference found -> step back to path delimiter
repeat
dec(SamePos);
if (SamePos<1) then exit;
until (FileName[SamePos]=PathDelim);
end;
if (SamePos=1) and (Filename[1]=PathDelim) then exit;
// calculate needed up directories
UpDirCount:=0;
BaseDirPos:=SamePos+1;
while (BaseDirPos<=BaseDirLen) do begin
if BaseDirectory[BaseDirPos]=PathDelim then inc(UpDirCount);
inc(BaseDirPos);
end;
if BaseDirectory[BaseDirLen]<>PathDelim then inc(UpDirCount);
// create relative filename
FileNameRestLen:=FileNameLength-SamePos;
SetLength(Result,3*UpDirCount+FileNameRestLen);
ResultPos:=1;
for i:=1 to UpDirCount do begin
Result[ResultPos]:='.';
Result[ResultPos+1]:='.';
Result[ResultPos+2]:=PathDelim;
inc(ResultPos,3);
end;
if FileNameRestLen>0 then
Move(Filename[SamePos+1],Result[ResultPos],FileNameRestLen);
end;
{------------------------------------------------------------------------------
function FileIsInPath(const Filename, Path: string): boolean;
------------------------------------------------------------------------------}
@ -759,33 +853,102 @@ begin
Result:=Path;
end;
function SearchFileInDir(const Filename, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
procedure RaiseNotImplemented;
begin
raise Exception.Create('not implemented');
end;
var
Base: String;
ShortFile: String;
FileInfo: TSearchRec;
begin
Base:=AppendPathDelim(BaseDirectory);
ShortFile:=Filename;
if System.Pos(PathDelim,ShortFile)>0 then begin
Base:=Base+ExtractFilePath(ShortFile);
ShortFile:=ExtractFilename(ShortFile);
end;
Base:=TrimFilename(Base);
case SearchCase of
ctsfcDefault:
begin
Result:=Base+ShortFile;
if not FileExistsCached(Result) then Result:='';
end;
ctsfcLoUpCase:
begin
Result:=Base+ShortFile;
if not FileExistsCached(Result) then begin
Result:=lowercase(Result);
if not FileExistsCached(Result) then begin
Result:=uppercase(Result);
if not FileExistsCached(Result) then Result:='';
end;
end;
end;
ctsfcAllCase:
begin
// search file
Result:='';
if SysUtils.FindFirst(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
then
continue;
if CompareText(FileInfo.Name,ShortFile)=0 then begin
if FileInfo.Name=ShortFile then begin
// file found, with correct name
Result:=FileInfo.Name;
break;
end else begin
// alias found, but has not the correct name
Result:=FileInfo.Name;
end;
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
if Result<>'' then Result:=Base+Result;
end;
else
RaiseNotImplemented;
end;
end;
function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
Delimiter: string; SearchCase: TCTSearchFileCase): string;
var
p, StartPos, l: integer;
CurPath, Base: string;
begin
//debugln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
//debugln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
if (Filename='') then begin
Result:=Filename;
exit;
end;
// check if filename absolute
if FilenameIsAbsolute(Filename) then begin
if FileExists(Filename) then begin
Result:=ExpandFilename(Filename);
exit;
end else begin
Result:='';
exit;
end;
if SearchCase=ctsfcDefault then begin
if FileExistsCached(Filename) then begin
Result:=ExpandFilename(Filename);
end else begin
Result:='';
end;
end else
Result:=SearchFileInPath(ExtractFilename(Filename),
ExtractFilePath(BasePath),'',';',SearchCase);
exit;
end;
Base:=ExpandFilename(AppendPathDelim(BasePath));
// search in current directory
if FileExists(Base+Filename) then begin
Result:=Base+Filename;
exit;
end;
Result:=SearchFileInDir(Filename,Base,SearchCase);
if Result<>'' then exit;
// search in search path
StartPos:=1;
l:=length(SearchPath);
@ -796,15 +959,15 @@ begin
if CurPath<>'' then begin
if not FilenameIsAbsolute(CurPath) then
CurPath:=Base+CurPath;
Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
if FileExists(Result) then exit;
CurPath:=ExpandFilename(AppendPathDelim(CurPath));
Result:=SearchFileInDir(Filename,CurPath,SearchCase);
if Result<>'' then exit;
end;
StartPos:=p+1;
end;
Result:='';
end;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
(*

20
components/codetools/linkscanner.pas
View File

@ -250,7 +250,6 @@ type
function IncludeDirective: boolean;
function IncludeFile(const AFilename: string): boolean;
function IncludePathDirective: boolean;
function LoadSourceCaseSensitive(const AFilename: string): pointer;
function SearchIncludeFile(const AFilename: string; var NewCode: Pointer;
var MissingIncludeFile: TMissingIncludeFile): boolean;
function ShortSwitchDirective: boolean;
@ -329,7 +328,8 @@ type
procedure DeleteRange(CleanStartPos,CleanEndPos: integer);
// scanning
procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
procedure Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean;
CheckUpdate: boolean = true; DoScan: boolean = true);
function UpdateNeeded(OnlyInterfaceNeeded,
CheckFilesOnDisk: boolean): boolean;
procedure SetIgnoreErrorAfter(ACursorPos: integer; ACode: Pointer);
@ -337,6 +337,7 @@ type
function IgnoreErrAfterPositionIsInFrontOfLastErrMessage: boolean;
function IgnoreErrorAfterCleanedPos: integer;
function IgnoreErrorAfterValid: boolean;
function LoadSourceCaseLoUp(const AFilename: string): pointer;
function GuessMisplacedIfdefEndif(StartCursorPos: integer;
StartCode: pointer;
@ -1025,7 +1026,8 @@ begin
end;
end;
procedure TLinkScanner.Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean);
procedure TLinkScanner.Scan(TillInterfaceEnd, CheckFilesOnDisk: boolean;
CheckUpdate: boolean; DoScan: boolean);
var
LastTokenType: TLSTokenType;
cm: TCompilerMode;
@ -1035,7 +1037,8 @@ var
CheckForAbort: boolean;
NewSrcLen: Integer;
begin
if not UpdateNeeded(TillInterfaceEnd,CheckFilesOnDisk) then begin
if CheckUpdate and (not UpdateNeeded(TillInterfaceEnd,CheckFilesOnDisk)) then
begin
// input is the same as last time -> output is the same
// -> if there was an error, raise it again
if LastErrorIsValid
@ -1110,6 +1113,7 @@ begin
{$IFDEF CTDEBUG}
DebugLn('TLinkScanner.Scan F ',dbgs(SrcLen));
{$ENDIF}
if not DoScan then exit;
try
try
repeat
@ -2333,7 +2337,7 @@ begin
Result:=true;
end;
function TLinkScanner.LoadSourceCaseSensitive(
function TLinkScanner.LoadSourceCaseLoUp(
const AFilename: string): pointer;
var
Path, FileNameOnly: string;
@ -2375,7 +2379,7 @@ var PathStart, PathEnd: integer;
ExpFilename:=APath+AFilename;
if not FilenameIsAbsolute(ExpFilename) then
ExpFilename:=ExtractFilePath(FMainSourceFilename)+ExpFilename;
NewCode:=LoadSourceCaseSensitive(ExpFilename);
NewCode:=LoadSourceCaseLoUp(ExpFilename);
Result:=NewCode<>nil;
end;
@ -2399,7 +2403,7 @@ begin
end;
// if include filename is absolute then load it directly
if FilenameIsAbsolute(AFilename) then begin
NewCode:=LoadSourceCaseSensitive(AFilename);
NewCode:=LoadSourceCaseLoUp(AFilename);
Result:=(NewCode<>nil);
if not Result then SetMissingIncludeFile;
exit;
@ -2413,7 +2417,7 @@ begin
if FilenameIsAbsolute(FMainSourceFilename) then begin
// main source has absolute filename
ExpFilename:=ExtractFilePath(FMainSourceFilename)+AFilename;
NewCode:=LoadSourceCaseSensitive(ExpFilename);
NewCode:=LoadSourceCaseLoUp(ExpFilename);
Result:=(NewCode<>nil);
if Result then exit;
end else begin

139
components/codetools/stdcodetools.pas
View File

@ -50,7 +50,7 @@ uses
{$ENDIF}
Classes, SysUtils, TypInfo, CodeToolsStrConsts, FileProcs, CodeTree, CodeAtom,
FindDeclarationTool, IdentCompletionTool, PascalReaderTool, PascalParserTool,
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache,
ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache,
AVL_Tree, LFMTrees, SourceChanger,
CustomCodeTool, CodeToolsStructs;
@ -213,6 +213,9 @@ type
const Filename: string = ''): boolean;
function AddResourceDirective(const Filename: string;
SourceChangeCache: TSourceChangeCache): boolean;
function FixIncludeFilenames(Code: TCodeBuffer;
SourceChangeCache: TSourceChangeCache;
out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean;
// search & replace
function ReplaceIdentifiers(IdentList: TStrings;
@ -4298,6 +4301,140 @@ begin
Result:=true;
end;
function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer;
SourceChangeCache: TSourceChangeCache;
out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean;
var
ASource: String;
procedure Add(const AFilename: string; Found: boolean);
var
NewFilename: String;
begin
if Found then begin
if FoundIncludeFiles=nil then
FoundIncludeFiles:=TStringList.Create;
NewFilename:=TrimFilename(AFilename);
if FoundIncludeFiles.IndexOf(NewFilename)<0 then
FoundIncludeFiles.Add(NewFilename);
end else begin
if MissingIncludeFiles=nil then
MissingIncludeFiles:=TStringList.Create;
MissingIncludeFiles.Add(AFilename);
end;
end;
function SearchIncludeFilename(const AFilename: string): string;
var
AFilePath: String;
BaseDir: String;
CurFilename: String;
IncludePath: String;
PathDivider: String;
ACodeBuf: TCodeBuffer;
begin
Result:=TrimFilename(AFilename);
if FilenameIsAbsolute(Result) then begin
Result:=FindDiskFilename(Result);
Add(Result,FileExistsCached(Result));
//DebugLn('SearchIncludeFilename AbsoluteFilename="',Result,'"');
end else begin
BaseDir:=ExtractFilePath(MainFilename);
//DebugLn('SearchIncludeFilename BaseDir="',BaseDir,'"');
if FilenameIsAbsolute(BaseDir) then begin
// unit has normal path -> not virtual
AFilePath:=ExtractFilePath(Result);
if AFilePath<>'' then begin
// search relative to unit
CurFilename:=FindDiskFilename(BaseDir+Result);
Result:=copy(CurFilename,length(BaseDir)+1,length(CurFilename));
if FileExistsCached(CurFilename) then
Add(CurFilename,true)
else
Add(Result,false);
//DebugLn('SearchIncludeFilename relative filename="',CurFilename,'"');
end else begin
// search in path
IncludePath:='';
PathDivider:=':;';
if (Scanner.Values<>nil) then begin
IncludePath:=Scanner.Values.Variables[ExternalMacroStart+'INCPATH'];
if Scanner.Values.IsDefined('DELPHI') then
PathDivider:=':'
end;
CurFilename:=SearchFileInPath(Result,BaseDir,IncludePath,PathDivider,
ctsfcAllCase);
if CurFilename<>'' then begin
// found
Result:=CreateRelativePath(CurFilename,BaseDir);
Add(CurFilename,true);
end else begin
// not found
Add(Result,false);
end;
//DebugLn('SearchIncludeFilename search in include path="',IncludePath,'" Result="',Result,'"');
end;
end else begin
// unit has no path -> virtual unit -> search in virtual files
ACodeBuf:=TCodeBuffer(Scanner.LoadSourceCaseLoUp(Result));
if ACodeBuf<>nil then begin
Result:=ACodeBuf.Filename;
Add(Result,true);
end else begin
Add(Result,false);
end;
end;
end;
end;
procedure FixFilename(StartPos, EndPos: integer);
var
OldFilename: String;
AFilename: String;
begin
OldFilename:=copy(ASource,StartPos,EndPos-StartPos);
//DebugLn('FixFilename ',dbgs(StartPos),' ',dbgs(EndPos),' ',OldFilename);
AFilename:=OldFilename;
if ExtractFileExt(AFilename)='' then begin
// add default extension
if (Scanner.CompilerMode=cmDELPHI) then
AFilename:=AFilename+'.pas'
else
AFilename:=AFilename+'.pp';
end;
AFilename:=SearchIncludeFilename(AFilename);
if OldFilename<>AFilename then begin
DebugLn('FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"');
ASource:=copy(ASource,1,StartPos-1)+AFilename+copy(ASource,EndPos,length(ASource));
end;
end;
var
p: Integer;
NestedComments: Boolean;
FilenameStartPos, FileNameEndPos, CommentStartPos, CommentEndPos: integer;
begin
Result:=false;
FoundIncludeFiles:=nil;
MissingIncludeFiles:=nil;
if (Scanner=nil) or (Scanner.MainCode=nil) then exit;
ASource:=Code.Source;
Scanner.Scan(false,false,false,false);// init scanner, but do not scan
Result:=true;
NestedComments:=Scanner.NestedComments;
p:=1;
repeat
p:=BasicCodeTools.FindNextIncludeDirective(ASource,p,NestedComments,
FilenameStartPos, FileNameEndPos, CommentStartPos, CommentEndPos);
if (p<1) or (p>length(ASource)) then break;
if (CommentStartPos=0) and (CommentEndPos=0) then ;
FixFilename(FilenameStartPos,FilenameEndPos);
p:=FindCommentEnd(ASource,p,NestedComments);
//DebugLn('TStandardCodeTool.FixIncludeFilenames ',dbgs(p));
until false;
end;
function TStandardCodeTool.ReadTilGuessedUnclosedBlock(
MinCleanPos: integer; ReadOnlyOneBlock: boolean): boolean;
// returns true if unclosed block found

252
converter/delphiproject2laz.pas
View File

@ -57,6 +57,13 @@ function ConvertDelphiToLazarusProject(const ProjectFilename: string
function ConvertDelphiToLazarusUnit(const DelphiFilename: string
): TModalResult;
function CreateDelphiToLazarusProject(const LPIFilename: string): TModalResult;
function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
const DPRFilename, MainSourceFilename: string;
out LPRCode: TCodeBuffer): TModalResult;
function FindDPRFilename(const StartFilename: string): string;
function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;
implementation
@ -69,7 +76,6 @@ function ConvertDelphiToLazarusProject(const ProjectFilename: string
It can be aborted and called again.
}
var
DPRCode: TCodeBuffer;
FoundInUnits, MissingInUnits, NormalUnits: TStrings;
NotFoundUnits: String;
LPRCode: TCodeBuffer;
@ -77,122 +83,70 @@ var
i: Integer;
CurUnitInfo: TUnitInfo;
MainUnitInfo: TUnitInfo;
DOFFilename: String;
CFGFilename: String;
LPIFilename: String;
DPRFilename: String;
MainSourceFilename: String;
begin
debugln('ConvertDelphiToLazarusProject ProjectFilename="',ProjectFilename,'"');
IDEMessagesWindow.Clear;
LPIFilename:=ChangeFileExt(ProjectFilename,'.lpi');
if FileExists(LPIFilename) then begin
// there is already a lazarus project -> open it, if not already open
if CompareFilenames(Project1.ProjectInfoFile,LPIFilename)<>0 then
LazarusIDE.DoOpenProjectFile(LPIFilename,[]);
end else begin
// create a new lazarus project
//Result:=LazarusIDE.DoNewProject(ProjectDescriptorEMPTY);
//if Result<>mrOk then exit;
end;
// check Delphi project file
Result:=CheckDelphiProjectExt(ProjectFilename);
if Result<>mrOk then exit;
// create/open lazarus project file
LPIFilename:=ChangeFileExt(ProjectFilename,'.lpi');
Result:=CreateDelphiToLazarusProject(LPIFilename);
if Result<>mrOk then begin
DebugLn('ConvertDelphiToLazarusProject failed to create/open project LPIFilename="',LPIFilename,'"');
exit;
end;
// close Delphi file in editor
debugln('ConvertDelphiToLazarusProject closing in editor dpr ...');
Result:=LazarusIDE.DoCloseEditorFile(ProjectFilename,[cfSaveFirst]);
// create main source file (.lpr) (only copy, no conversion)
DPRFilename:=FindDPRFilename(ProjectFilename);
DebugLn('ConvertDelphiToLazarusProject DPRFilename="',DPRFilename,'"');
MainSourceFilename:=ChangeFileExt(LPIFilename,'.lpr');
Result:=CreateDelphiToLazarusMainSourceFile(Project1,DPRFilename,
MainSourceFilename,LPRCode);
if Result<>mrOk then exit;
// commit source editor changes to codetools
// read config files (they often contain clues about paths, switches and defines)
Result:=ReadDelphiProjectConfigFiles(Project1);
if Result<>mrOk then exit;
// load required packages
Project1.AddPackageDependency('LCL');// Nearly all Delphi projects require it
PkgBoss.AddDefaultDependencies(Project1);
// we have now enough information to parse the .dpr file,
// but not enough to parse the units
// init codetools
if not LazarusIDE.BeginCodeTools then begin
Result:=mrCancel;
exit;
end;
// fix include filenames
if not CodeToolBoss.FixIncludeFilenames(Project1.MainUnitInfo.Source,true)
then begin
LazarusIDE.DoJumpToCodeToolBossError;
exit(mrCancel);
end;
// try to find out as much about search paths as possible before parsing code
// TODO: open lpr
// TODO: fix include paths
// TODO: get all compiler options from .dpr
// TODO: find all project files in .dpr
// TODO: fix all include filenames
{$IFDEF NewDelphiProjConverter}
exit(mrOk);
{$ENDIF}
// load Delphi project file .dpr
debugln('ConvertDelphiToLazarusProject loading dpr ...');
Result:=LoadCodeBuffer(DPRCode,ProjectFilename,
[lbfCheckIfText,lbfUpdateFromDisk]);
// TODO: get all compiler options from .dpr
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
if Result<>mrOk then exit;
// create .lpr file
debugln('ConvertDelphiToLazarusProject creating lpr ...');
Result:=CreateLPRFileForDPRFile(ProjectFilename,false,LPRCode);
if Result<>mrOk then begin
if CodeToolBoss.ErrorMessage<>'' then LazarusIDE.DoJumpToCodeToolBossError;
exit;
end;
// close old project
debugln('ConvertDelphiToLazarusProject closing current project ...');
If Project1<>nil then begin
if LazarusIDE.DoCloseProject=mrAbort then begin
Result:=mrAbort;
exit;
end;
end;
// switch codetools to new project directory
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=
ExpandFilename(ExtractFilePath(LPRCode.Filename));
// create a new project
debugln('ConvertDelphiToLazarusProject creating new project ...');
NewProjectDesc:=TProjectEmptyProgramDescriptor.Create;
Project1:=MainIDEInterface.CreateProjectObject(NewProjectDesc,
ProjectDescriptorApplication);
Project1.BeginUpdate(true);
try
if ProjInspector<>nil then ProjInspector.LazProject:=Project1;
MainUnitInfo:=TUnitInfo.Create(LPRCode);
MainUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename));
MainUnitInfo.IsPartOfProject:=true;
Project1.AddFile(MainUnitInfo,false);
Project1.MainFileID:=0;
Project1.ProjectInfoFile:=ChangeFileExt(LPRCode.Filename,'.lpi');
Project1.CompilerOptions.CompilerPath:='$(CompPath)';
MainIDEInterface.UpdateCaption;
IncreaseCompilerParseStamp;
// TODO: get all compiler options from .dpr
Result:=ExtractOptionsFromDPR(LPRCode,Project1);
if Result<>mrOk then exit;
// TODO: read .dof file
DOFFilename:=FindDelphiDOF(ProjectFilename);
if FileExists(DOFFilename) then begin
Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: read .cfg file
CFGFilename:=FindDelphiCFG(ProjectFilename);
if FileExists(CFGFilename) then begin
Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
if Result<>mrOk then exit;
end;
// TODO: get all needed packages
// add and load default required packages
// TODO: add packages
// WORKAROUND: add LCL
// add lcl pp/pas dirs to source search path
Project1.AddSrcPath('$(LazarusDir)/lcl;'
+'$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)');
Project1.AddPackageDependency('LCL');
Project1.LazCompilerOptions.Win32GraphicApp:=true;
PkgBoss.AddDefaultDependencies(Project1);
finally
Project1.EndUpdate;
NewProjectDesc.Free;
end;
// show program unit
debugln('ConvertDelphiToLazarusProject open lpr in editor ...');
Result:=LazarusIDE.DoOpenEditorFile(LPRCode.Filename,-1,
[ofAddToRecent,ofRegularFile]);
// fix
Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename);
if Result=mrAbort then exit;
// find all project files
@ -215,7 +169,7 @@ begin
if (MissingInUnits<>nil) and (MissingInUnits.Count>0) then begin
NotFoundUnits:=MissingInUnits.Text;
Result:=MessageDlg('Units not found',
'Some units of the delphi project were not found:'#13
'Some units of the delphi project are missing:'#13
+NotFoundUnits,mtWarning,[mbIgnore,mbAbort],0);
if Result<>mrIgnore then exit;
end;
@ -367,5 +321,95 @@ begin
Result:=mrOk;
end;
function CreateDelphiToLazarusProject(const LPIFilename: string): TModalResult;
// If .lpi does not exist, create it
// open new project
begin
DebugLn('CreateDelphiToLazarusProject LPIFilename="',LPIFilename,'"');
if FileExists(LPIFilename) then begin
// there is already a lazarus project -> open it, if not already open
if CompareFilenames(Project1.ProjectInfoFile,LPIFilename)<>0 then begin
DebugLn('CreateDelphiToLazarusProject open "',LPIFilename,'"');
Result:=LazarusIDE.DoOpenProjectFile(LPIFilename,[]);
if Result<>mrOk then exit;
end;
end else begin
// create a new lazarus project
Result:=LazarusIDE.DoNewProject(ProjectDescriptorEmptyProject);
if Result<>mrOk then begin
DebugLn('CreateDelphiToLazarusProject failed to create a new project');
exit;
end;
Project1.ProjectInfoFile:=LPIFilename;
end;
// save to disk (this makes sure, all editor changes are saved too)
DebugLn('CreateDelphiToLazarusProject saving project ...');
Result:=LazarusIDE.DoSaveProject([]);
end;
function CreateDelphiToLazarusMainSourceFile(AProject: TProject;
const DPRFilename, MainSourceFilename: string;
out LPRCode: TCodeBuffer): TModalResult;
// if .lpr does not exists, copy the .dpr file to the .lpr
// adds the .lpr as main unit to the project, if not already done
var
MainUnitInfo: TUnitInfo;
begin
LPRCode:=nil;
Result:=CreateLPRFileForDPRFile(DPRFilename,MainSourceFilename,LPRCode);
if Result<>mrOk then begin
DebugLn('CreateDelphiToLazarusMainSourceFile CreateLPRFileForDPRFile failed DPRFilename="',DPRFilename,'" MainSourceFilename="',MainSourceFilename,'"');
exit;
end;
if AProject.MainUnitInfo=nil then begin
// add .lpr file to project as main unit
DebugLn('CreateDelphiToLazarusMainSourceFile adding .lpr file to project as main unit ',LPRCode.Filename);
MainUnitInfo:=TUnitInfo.Create(LPRCode);
MainUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(LPRCode.Filename));
MainUnitInfo.IsPartOfProject:=true;
AProject.AddFile(MainUnitInfo,false);
AProject.MainFileID:=0;
end else begin
// replace main unit in project
AProject.MainUnitInfo.Source:=LPRCode;
end;
end;
function FindDPRFilename(const StartFilename: string): string;
// searches the corresponding .dpr file
begin
if CompareFileExt(StartFilename,'.dpr',false)=0 then
Result:=StartFilename
else
Result:=ChangeFileExt(StartFilename,'.dpr');
if not FileExists(Result) then
Result:=FindDiskFileCaseInsensitive(StartFilename);
end;
function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult;
var
MainSourceFilename: String;
DOFFilename: String;
CFGFilename: String;
begin
if AProject.MainUnitInfo=nil then exit(mrOk);
MainSourceFilename:=AProject.MainUnitInfo.Filename;
// read .dof file
DOFFilename:=FindDelphiDOF(MainSourceFilename);
if FileExists(DOFFilename) then begin
Result:=ExtractOptionsFromDOF(DOFFilename,Project1);
if Result<>mrOk then exit;
end;
// read .cfg file
CFGFilename:=FindDelphiCFG(MainSourceFilename);
if FileExists(CFGFilename) then begin
Result:=ExtractOptionsFromCFG(CFGFilename,Project1);
if Result<>mrOk then exit;
end;
end;
end.

282
converter/delphiunit2laz.pas
View File

@ -40,7 +40,7 @@ interface
uses
// FCL+LCL
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics,
Dialogs, Buttons, StdCtrls, FileUtil,
Dialogs, Buttons, StdCtrls, FileUtil, IniFiles,
// Components
SynEdit, CodeCache, CodeToolManager, DefineTemplates,
// IDE
@ -72,16 +72,24 @@ function LoadUnitAndLFMFile(const UnitFileName: string;
var UnitCode, LFMCode: TCodeBuffer; LFMMustExist: boolean): TModalResult;
function ConvertLFMtoLRSfile(const LFMFilename: string): TModalResult;
function CheckDelphiProjectExt(const Filename: string): TModalResult;
function CreateLPRFileForDPRFile(const DelphiProjectFilename: string;
AddLRSCode: boolean; var LPRCode: TCodeBuffer): TModalResult;
function CreateLPRFileForDPRFile(const DPRFilename, LPRFilename: string;
out LPRCode: TCodeBuffer): TModalResult;
function ExtractOptionsFromDPR(DPRCode: TCodeBuffer;
AProject: TProject): TModalResult;
function FindDelphiDOF(const DelphiFilename: string): string;
function ExtractOptionsFromDOF(const DOFFilename: string;
AProject: TProject): TModalResult;
AProject: TProject): TModalResult;
function FindDelphiCFG(const DelphiFilename: string): string;
function ExtractOptionsFromCFG(const CFGFilename: string;
AProject: TProject): TModalResult;
AProject: TProject): TModalResult;
function ConvertDelphiAbsoluteToRelativeFile(const Filename: string;
AProject: TProject): string;
function ExpandDelphiFilename(const Filename: string; AProject: TProject): string;
function ExpandDelphiSearchPath(const SearchPath: string;
AProject: TProject): string;
implementation
@ -356,25 +364,15 @@ begin
Result:=mrOk;
end;
function CreateLPRFileForDPRFile(const DelphiProjectFilename: string;
AddLRSCode: boolean; var LPRCode: TCodeBuffer): TModalResult;
var
LPRFilename: String;
CTResult: Boolean;
function CreateLPRFileForDPRFile(const DPRFilename, LPRFilename: string;
out LPRCode: TCodeBuffer): TModalResult;
begin
LPRFilename:=ChangeFileExt(DelphiProjectFilename,'.lpr');
Result:=CopyFileWithErrorDialogs(DelphiProjectFilename,LPRFilename,[]);
if Result<>mrOk then exit;
if not FileExists(LPRFilename) then begin
Result:=CopyFileWithErrorDialogs(DPRFilename,LPRFilename,[]);
if Result<>mrOk then exit;
end;
Result:=LoadCodeBuffer(LPRCode,LPRFilename,
[lbfCheckIfText,lbfUpdateFromDisk]);
if Result<>mrOk then exit;
CTResult:=CodeToolBoss.ConvertDelphiToLazarusSource(LPRCode,AddLRSCode);
debugln('CreateLPRFileForDPRFile: ',LPRCode.Source);
if not CTResult then begin
Result:=mrCancel;
exit;
end;
Result:=mrOk;
end;
function ExtractOptionsFromDPR(DPRCode: TCodeBuffer; AProject: TProject
@ -396,8 +394,112 @@ end;
function ExtractOptionsFromDOF(const DOFFilename: string; AProject: TProject
): TModalResult;
// parse .dof file and put options into AProject
var
IniFile: TIniFile;
function ReadDirectory(const Section, Ident: string): string;
begin
Result:=IniFile.ReadString(Section,Ident,'');
DebugLn('.dof ReadDirectory Section=',Section,' Ident=',Ident,' Result="',Result,'"');
Result:=ExpandDelphiFilename(Result,AProject);
end;
function ReadSearchPath(const Section, Ident: string): string;
var
SearchPath: String;
begin
SearchPath:=IniFile.ReadString(Section,Ident,'');
DebugLn('.dof ReadSearchPath Section=',Section,' Ident=',Ident,' SearchPath="',SearchPath,'"');
Result:=ExpandDelphiSearchPath(SearchPath,AProject);
end;
procedure AddPackageDependency(const DelphiPkgName, DelphiPkgNames,
LazarusPkgName: string);
begin
if DelphiPkgName='' then exit;
if System.Pos(';'+lowercase(DelphiPkgName)+';',
';'+lowercase(DelphiPkgNames)+';')>0 then begin
DebugLn('AddPackageDependency adding package dependency ',LazarusPkgName);
AProject.AddPackageDependency(LazarusPkgName);
end;
end;
procedure ReadDelphiPackages;
var
DelphiPackages: String;
Pkgs: TStringList;
i: Integer;
Pkg: string;
begin
DelphiPackages:=IniFile.ReadString('Directories','Packages','');
//DebugLn('ReadDelphiPackages DelphiPackages=',DelphiPackages);
Pkgs:=SplitString(DelphiPackages,';');
if Pkgs=nil then exit;
for i:=0 to Pkgs.Count-1 do begin
Pkg:=Pkgs[i];
DebugLn('ReadDelphiPackages Pkg=',Pkg);
AddPackageDependency(Pkg,'rtl,dbrtl','FCL');
AddPackageDependency(Pkg,'vcl;vcldb;vcldbx','LCL');
end;
end;
var
OutputDir: String;
SearchPath: String;
DebugSourceDirs: String;
begin
// TODO parse .dof file and put options into AProject
if not FileExists(DOFFilename) then exit(mrOk);
try
IniFile:=TIniFile.Create(DOFFilename);
try
// output directory
OutputDir:=ReadDirectory('Directories','OutputDir');
if (OutputDir<>'') then begin
DebugLn('ExtractOptionsFromDOF setting unit output directory to "',OutputDir,'"');
AProject.CompilerOptions.UnitOutputDirectory:=OutputDir;
end;
// search path
SearchPath:=ReadSearchPath('Directories','SearchPath');
if (SearchPath<>'') then begin
DebugLn('ExtractOptionsFromDOF Adding to search paths: "',SearchPath,'"');
AProject.CompilerOptions.IncludeFiles:=
MergeSearchPaths(AProject.CompilerOptions.IncludeFiles,SearchPath);
AProject.CompilerOptions.Libraries:=
MergeSearchPaths(AProject.CompilerOptions.Libraries,SearchPath);
AProject.CompilerOptions.OtherUnitFiles:=
MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles,SearchPath);
AProject.CompilerOptions.ObjectPath:=
MergeSearchPaths(AProject.CompilerOptions.ObjectPath,SearchPath);
AProject.CompilerOptions.DebugPath:=
MergeSearchPaths(AProject.CompilerOptions.DebugPath,SearchPath);
end;
// debug source dirs
DebugSourceDirs:=ReadSearchPath('Directories','DebugSourceDirs');
if DebugSourceDirs<>'' then begin
DebugLn('ExtractOptionsFromDOF Adding to debug paths: "',DebugSourceDirs,'"');
AProject.CompilerOptions.DebugPath:=
MergeSearchPaths(AProject.CompilerOptions.DebugPath,DebugSourceDirs);
end;
// packages
ReadDelphiPackages;
if IniFile.ReadString('Linker','ConsoleApp','')='0' then begin
// does not need a windows console
DebugLn('ExtractOptionsFromDOF ConsoleApp=0');
AProject.LazCompilerOptions.Win32GraphicApp:=true;
end;
finally
IniFile.Free;
end;
except
on E: Exception do begin
DebugLn('ExtractOptionsFromDOF failed reading "'+DOFFilename+'" '+E.Message);
end;
end;
Result:=mrOk;
end;
@ -413,11 +515,145 @@ end;
function ExtractOptionsFromCFG(const CFGFilename: string; AProject: TProject
): TModalResult;
var
sl: TStringList;
i: Integer;
Line: string;
UnitPath: String;
IncludePath: String;
begin
// TODO parse .cfg file and put options into AProject
if not FileExists(CFGFilename) then exit(mrOk);
try
sl:=TStringList.Create;
try
sl.LoadFromFile(CFGFilename);
for i:=0 to sl.Count-1 do begin
Line:=sl[i];
if Line='' then continue;
if (Line[1]<>'-') or (length(Line)<2) then continue;
if Line[2]='U' then begin
UnitPath:=ExpandDelphiSearchPath(copy(Line,4,length(Line)-4),AProject);
if UnitPath<>'' then begin
DebugLn('ExtractOptionsFromCFG adding unitpath "',UnitPath,'"');
AProject.CompilerOptions.OtherUnitFiles:=
MergeSearchPaths(AProject.CompilerOptions.OtherUnitFiles,UnitPath);
end;
end else if Line[2]='I' then begin
IncludePath:=ExpandDelphiSearchPath(copy(Line,4,length(Line)-4),AProject);
if IncludePath<>'' then begin
DebugLn('ExtractOptionsFromCFG adding IncludePath "',IncludePath,'"');
AProject.CompilerOptions.IncludeFiles:=
MergeSearchPaths(AProject.CompilerOptions.IncludeFiles,IncludePath);
end;
end;
end;
finally
sl.Free;
end;
except
on E: Exception do begin
DebugLn('ExtractOptionsFromDOF failed reading "'+CFGFilename+'" '+E.Message);
end;
end;
Result:=mrOk;
end;
function ConvertDelphiAbsoluteToRelativeFile(const Filename: string;
AProject: TProject): string;
var
ProjectDir: String;
ShortProjectDir: String;
p: LongInt;
begin
// often projects use paths near to their project directory
// For example:
// A project /somewhere/MyProjects/project1.dpr
// and a path C:\Delphi\MyProject\folder
// can mean, that the relative path is 'folder'
ProjectDir:=AProject.ProjectDirectory;
ShortProjectDir:='\'+ExtractFileName(ChompPathDelim(ProjectDir))+'\';
p:=System.Pos(ShortProjectDir,Filename);
if (p>0) then begin
Result:=copy(Filename,p+length(ShortProjectDir),length(Filename));
exit;
end;
// ignore all other absolute paths
Result:='';
end;
function ExpandDelphiFilename(const Filename: string; AProject: TProject
): string;
var
p: LongInt;
begin
Result:=Filename;
if Result='' then exit;
Result:=TrimFilename(SetDirSeparators(Result));
// check for $(Delphi) makro
p:=System.Pos('$(DELPHI)',Result);
if p>0 then begin
// Delphi features are provided by FPC and Lazarus
// -> ignore
Result:='';
end;
// check for other makros
p:=System.Pos('$(',Result);
if p>0 then begin
// path makros are not supported
// -> ignore
Result:='';
end;
if FilenameIsWinAbsolute(Result) then begin
// absolute filenames are not portable
Result:=ConvertDelphiAbsoluteToRelativeFile(Result,AProject);
end;
// change PathDelim
Result:=TrimFilename(SetDirSeparators(Result));
end;
function ExpandDelphiSearchPath(const SearchPath: string;
AProject: TProject): string;
var
Paths: TStringList;
i: Integer;
CurPath: String;
j: Integer;
begin
Result:='';
Paths:=SplitString(SearchPath,';');
if Paths=nil then exit;
try
// expand Delphi paths
for i:=0 to Paths.Count-1 do
Paths[i]:=ExpandDelphiFilename(Paths[i],AProject);
// remove doubles
for i:=Paths.Count-1 downto 0 do begin
CurPath:=Paths[i];
if (CurPath='') then
Paths.Delete(i)
else begin
j:=i-1;
while (j>=0) and (CompareText(CurPath,Paths[i])<>0) do dec(j);
if j>=0 then
Paths.Delete(i);
end;
end;
Result:='';
for i:=0 to Paths.Count-1 do begin
if i>0 then Result:=Result+';';
Result:=Result+Paths[i];
end;
finally
Paths.Free;
end;
end;
initialization
{$I delphiunit2laz.lrs}

5
designer/designerprocs.pas
View File

@ -33,7 +33,8 @@ unit DesignerProcs;
interface
uses
Classes, SysUtils, Types, LCLIntf, Forms, Controls, LCLType, Graphics;
Classes, SysUtils, Types, LCLIntf, Forms, Controls, LCLType, Graphics,
FormEditingIntf;
type
TDesignerDCFlag = (ddcDCOriginValid, ddcFormOriginValid,
@ -75,7 +76,7 @@ type
end;
const
NonVisualCompIconWidth = 23;
NonVisualCompIconWidth = ComponentPaletteBtnWidth-2;
NonVisualCompBorder = 2;
NonVisualCompWidth = NonVisualCompIconWidth+2*NonVisualCompBorder;

2
ide/editoroptions.pp
View File

@ -892,7 +892,7 @@ begin
TheType := lshXML;
DefaultCommentType := DefaultCommentTypes[TheType];
SynClass := LazSyntaxHighlighterClasses[TheType];
SetBothFilextensions('xml;xsd;xsl;xslt;dtd');
SetBothFilextensions('xml;xsd;xsl;xslt;dtd;lpi;lps');
SampleSource :=
'<?xml version="1.0"?>'#13 + '<!DOCTYPE root ['#13 +
' ]>'#13 + '<!-- Comment -->'#13 + '<root version="&test;">'#13 +

75
ide/ideprocs.pp
View File

@ -627,81 +627,8 @@ begin
end;
function CreateRelativePath(const Filename, BaseDirectory: string): string;
var
FileNameLength: Integer;
BaseDirLen: Integer;
MinLen: Integer;
SamePos: Integer;
UpDirCount: Integer;
BaseDirPos: Integer;
ResultPos: Integer;
i: Integer;
FileNameRestLen: Integer;
begin
Result:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
// check for different windows file drives
if (CompareText(ExtractFileDrive(Filename),
ExtractFileDrive(BaseDirectory))<>0)
then
exit;
FileNameLength:=length(Filename);
BaseDirLen:=length(BaseDirectory);
// skip matching directories
MinLen:=FileNameLength;
if MinLen>BaseDirLen then MinLen:=BaseDirLen;
SamePos:=1;
while (SamePos<=MinLen) do begin
{$IFDEF win32}
if AnsiStrLIComp(@FileName[SamePos],@BaseDirectory[SamePos],1)=0
{$ELSE}
if FileName[SamePos]=BaseDirectory[SamePos]
{$ENDIF}
then
inc(SamePos)
else
break;
end;
if (SamePos>MinLen)
and (((SamePos<=BaseDirLen) and (BaseDirectory[SamePos]=PathDelim))
or ((SamePos<=FileNameLength) and (Filename[SamePos]=PathDelim))
or (BaseDirLen=FileNameLength))
then begin
// Filename lies in BaseDirectory
// or Filename is parent directory of BaseDirectory
// or Filename is BaseDirectory
end else begin
// difference found -> step back to path delimiter
repeat
dec(SamePos);
if (SamePos<1) then exit;
until (FileName[SamePos]=PathDelim);
end;
if (SamePos=1) and (Filename[1]=PathDelim) then exit;
// calculate needed up directories
UpDirCount:=0;
BaseDirPos:=SamePos+1;
while (BaseDirPos<=BaseDirLen) do begin
if BaseDirectory[BaseDirPos]=PathDelim then inc(UpDirCount);
inc(BaseDirPos);
end;
if BaseDirectory[BaseDirLen]<>PathDelim then inc(UpDirCount);
// create relative filename
FileNameRestLen:=FileNameLength-SamePos;
SetLength(Result,3*UpDirCount+FileNameRestLen);
ResultPos:=1;
for i:=1 to UpDirCount do begin
Result[ResultPos]:='.';
Result[ResultPos+1]:='.';
Result[ResultPos+2]:=PathDelim;
inc(ResultPos,3);
end;
if FileNameRestLen>0 then
Move(Filename[SamePos+1],Result[ResultPos],FileNameRestLen);
Result:=FileProcs.CreateRelativePath(Filename,BaseDirectory);
end;
function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string

49
ide/main.pp
View File

@ -559,6 +559,7 @@ type
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags);
procedure OnProjectGetTestDirectory(TheProject: TProject;
out TestDir: string);
procedure OnProjectChangeInfoFile(TheProject: TProject);
// methods for 'save project'
procedure GetMainUnit(var MainUnitInfo: TUnitInfo;
@ -4830,6 +4831,7 @@ begin
Result.OnLoadProjectInfo:=@OnLoadProjectInfoFromXMLConfig;
Result.OnSaveProjectInfo:=@OnSaveProjectInfoToXMLConfig;
Result.OnGetTestDirectory:=@OnProjectGetTestDirectory;
Result.OnChangeProjectInfoFile:=@OnProjectChangeInfoFile;
end;
procedure TMainIDE.OnLoadProjectInfoFromXMLConfig(TheProject: TProject;
@ -4853,6 +4855,16 @@ begin
TestDir:=GetTestBuildDir;
end;
procedure TMainIDE.OnProjectChangeInfoFile(TheProject: TProject);
begin
if TheProject<>Project1 then exit;
if TheProject.IsVirtual then
CodeToolBoss.SetGlobalValue(ExternalMacroStart+'ProjPath',VirtualDirectory)
else
CodeToolBoss.SetGlobalValue(ExternalMacroStart+'ProjPath',
Project1.ProjectDirectory)
end;
procedure TMainIDE.GetMainUnit(var MainUnitInfo: TUnitInfo;
var MainUnitSrcEdit: TSourceEditor; UpdateModified: boolean);
begin
@ -5048,13 +5060,6 @@ begin
EnvironmentOptions.AddToRecentProjectFiles(NewFilename);
SetRecentProjectFilesMenu;
// set new project directory
if OldProjectPath<>Project1.ProjectDirectory then begin
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=
Project1.ProjectDirectory;
CodeToolBoss.DefineTree.ClearCache;
end;
// change main source
if (Project1.MainUnitID>=0) then begin
GetMainUnit(MainUnitInfo,MainUnitSrcEdit,true);
@ -6567,6 +6572,7 @@ begin
DoUpdateProjectAutomaticFiles;
DebugLn('TMainIDE.DoSaveProject End');
Result:=mrOk;
end;
function TMainIDE.DoCloseProject: TModalResult;
@ -6888,7 +6894,6 @@ begin
MainUnitInfo:=Project1.MainUnitInfo;
MainUnitInfo.Source:=ProgramBuf;
Project1.ProjectInfoFile:=ChangeFileExt(ProgramBuf.Filename,'.lpi');
Project1.CompilerOptions.CompilerPath:='$(CompPath)';
UpdateCaption;
IncreaseCompilerParseStamp;
@ -10306,7 +10311,8 @@ var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
begin
Result:=BeginCodeTool(nil,ActiveSrcEdit,ActiveUnitInfo,[]);
Result:=BeginCodeTool(nil,ActiveSrcEdit,ActiveUnitInfo,
[ctfSourceEditorNotNeeded]);
end;
procedure TMainIDE.OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
@ -10470,22 +10476,35 @@ function TMainIDE.BeginCodeTool(ADesigner: TDesigner;
Flags: TCodeToolsFlags): boolean;
begin
Result:=false;
if (SourceNoteBook.NoteBook=nil)
or (ToolStatus in [itCodeTools,itCodeToolAborting]) then begin
// check global stati
if (ToolStatus in [itCodeTools,itCodeToolAborting]) then begin
debugln('TMainIDE.BeginCodeTool impossible ',dbgs(ord(ToolStatus)));
exit;
end;
if (SourceNoteBook.NoteBook=nil) and (ctfSourceEditorNotNeeded in Flags) then
exit;
// check source editor
if ctfSwitchToFormSource in Flags then
DoSwitchToFormSrc(ADesigner,ActiveSrcEdit,ActiveUnitInfo)
else if ADesigner<>nil then
GetDesignerUnit(ADesigner,ActiveSrcEdit,ActiveUnitInfo)
else
GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then exit;
if (ctfSourceEditorNotNeeded in Flags)
and ((ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)) then exit;
// init codetools
SaveSourceEditorChangesToCodeCache(-1);
CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
CodeToolBoss.TabWidth:=ActiveSrcEdit.EditorComponent.TabWidth;
CodeToolBoss.IndentSize:=ActiveSrcEdit.EditorComponent.BlockIndent;
if ActiveSrcEdit<>nil then begin
CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
CodeToolBoss.TabWidth:=ActiveSrcEdit.EditorComponent.TabWidth;
CodeToolBoss.IndentSize:=ActiveSrcEdit.EditorComponent.BlockIndent;
end else begin
CodeToolBoss.VisibleEditorLines:=25;
CodeToolBoss.TabWidth:=EditorOpts.TabWidth;
CodeToolBoss.IndentSize:=EditorOpts.BlockIndent;
end;
if ctfActivateAbortMode in Flags then
ActivateCodeToolAbortableMode;

3
ide/mainintf.pas
View File

@ -106,7 +106,8 @@ type
TCodeToolsFlag = (
ctfSwitchToFormSource, // bring source notebook to front and show source of
// current designed form
ctfActivateAbortMode // activate the CodeToolBoss.Abortable mode
ctfActivateAbortMode, // activate the CodeToolBoss.Abortable mode
ctfSourceEditorNotNeeded // do not check, if the source editor has a file open
);
TCodeToolsFlags = set of TCodeToolsFlag;

7
ide/newdialog.pas
View File

@ -74,8 +74,8 @@ type
function LocalizedName: string; override;
function Description: string; override;
function IndexOfCategory(const CategoryName: string): integer; override;
function FindCategoryByName(const CategoryName: string): TNewIDEItemCategory;
override;
function FindCategoryByName(const CategoryName: string
): TNewIDEItemCategory; override;
public
property Count: integer Read GetCount;
property Items[Index: integer]: TNewIDEItemTemplate Read GetItems; default;
@ -210,10 +210,12 @@ begin
for CategoryID := 0 to NewIDEItems.Count - 1 do
begin
Category := NewIDEItems[CategoryID];
if not Category.VisibleInNewDialog then continue;
NewParentNode := ItemsTreeView.Items.AddObject(nil, Category.Name, Category);
for TemplateID := 0 to Category.Count - 1 do
begin
Template := Category[TemplateID];
DebugLn('TNewOtherDialog.FillItemsTree ',Template.Name,' ',dbgs(Template.VisibleInNewDialog));
if Template.VisibleInNewDialog then
ItemsTreeView.Items.AddChildObject(NewParentNode, Template.Name,
Template);
@ -291,6 +293,7 @@ end;
constructor TNewLazIDEItemCategory.Create(const AName: string);
begin
inherited Create(AName);
FItems := TList.Create;
FName := AName;
//debugln('TNewLazIDEItemCategory.Create ',Name);

17
ide/newprojectdlg.pp
View File

@ -91,12 +91,15 @@ end;
function TNewProjectDialog.GetProjectDescriptor: TProjectDescriptor;
var
i: LongInt;
s: string;
begin
Result:=ProjectDescriptorApplication;
i:=ListBox.ItemIndex;
if (i>=0) and (i<ProjectDescriptors.Count) then
Result:=ProjectDescriptors[i]
else
Result:=ProjectDescriptorApplication;
if (i<0) then exit;
s:=ListBox.Items[i];
for i:=0 to ProjectDescriptors.Count-1 do
if ProjectDescriptors[i].GetLocalizedName=s then
exit(ProjectDescriptors[i]);
end;
procedure TNewProjectDialog.FillHelpLabel;
@ -124,8 +127,10 @@ begin
Anchors := [akTop,akLeft,akRight,akBottom];
with Items do begin
BeginUpdate;
for i:=0 to ProjectDescriptors.Count-1 do
Add(ProjectDescriptors[i].GetLocalizedName);
for i:=0 to ProjectDescriptors.Count-1 do begin
if ProjectDescriptors[i].VisibleInNewDialog then
Add(ProjectDescriptors[i].GetLocalizedName);
end;
EndUpdate;
end;
ItemIndex:=0;

11
ide/project.pp
View File

@ -69,6 +69,7 @@ type
XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags) of object;
TOnProjectGetTestDirectory = procedure(TheProject: TProject;
out TestDir: string) of object;
TOnChangeProjectInfoFile = procedure(TheProject: TProject) of object;
TUnitInfoList = (
uilPartOfProject,
@ -458,6 +459,7 @@ type
FMainProject: boolean;
fMainUnitID: Integer;
FOnBeginUpdate: TNotifyEvent;
FOnChangeProjectInfoFile: TOnChangeProjectInfoFile;
FOnEndUpdate: TEndUpdateProjectEvent;
fOnFileBackup: TOnFileBackup;
FOnGetTestDirectory: TOnProjectGetTestDirectory;
@ -685,6 +687,8 @@ type
write FOnLoadProjectInfo;
property OnGetTestDirectory: TOnProjectGetTestDirectory
read FOnGetTestDirectory write FOnGetTestDirectory;
property OnChangeProjectInfoFile: TOnChangeProjectInfoFile read FOnChangeProjectInfoFile
write FOnChangeProjectInfoFile;
property ProjectDirectory: string read fProjectDirectory;
property ProjectInfoFile: string
read GetProjectInfoFile write SetProjectInfoFile;
@ -2720,6 +2724,8 @@ begin
end;
UpdateProjectDirectory;
UpdateSessionFilename;
if Assigned(OnChangeProjectInfoFile) then
OnChangeProjectInfoFile(Self);
FDefineTemplates.SourceDirectoriesChanged;
Modified:=true;
EndUpdate;
@ -4245,8 +4251,9 @@ end;
function TProjectManualProgramDescriptor.CreateStartFiles(AProject: TLazProject
): TModalResult;
begin
Result:=LazarusIDE.DoOpenEditorFile(AProject.MainFile.Filename,-1,
[ofProjectLoading,ofRegularFile]);
if AProject.MainFile<>nil then
Result:=LazarusIDE.DoOpenEditorFile(AProject.MainFile.Filename,-1,
[ofProjectLoading,ofRegularFile]);
end;
{ TProjectEmptyProgramDescriptor }

7
ide/projectdefs.pas
View File

@ -1088,9 +1088,16 @@ begin
end;
constructor TLazProjectDescriptors.Create;
var
EmptyProjectDesc: TProjectDescriptor;
begin
ProjectDescriptors:=Self;
FItems:=TList.Create;
EmptyProjectDesc:=TProjectDescriptor.Create;
EmptyProjectDesc.Name:='Empty';
EmptyProjectDesc.VisibleInNewDialog:=false;
RegisterDescriptor(EmptyProjectDesc);
//DebugLn('TLazProjectDescriptors.Create ',dbgs(EmptyProjectDesc.VisibleInNewDialog));
end;
destructor TLazProjectDescriptors.Destroy;

2
ide/uniteditor.pp
View File

@ -886,9 +886,9 @@ begin
SrcEditMenuShowLineNumbers.ShowAlwaysCheckable:=true;
SrcEditMenuShowUnitInfo:=RegisterIDEMenuCommand(SubPath,'ShowUnitInfo',
uemShowUnitInfo);
SrcEditMenuSectionHighlighter:=RegisterIDEMenuSection(SubPath,'Highlighter');
SrcEditMenuEditorProperties:=RegisterIDEMenuCommand(SubPath,
'EditorProperties',uemEditorProperties);
SrcEditMenuSectionHighlighter:=RegisterIDEMenuSection(SubPath,'Highlighter');
end;
{ TSourceEditor }

6
ideintf/newitemintf.pas
View File

@ -39,6 +39,8 @@ type
{ TNewIDEItemCategory }
TNewIDEItemCategory = class
private
FVisibleInNewDialog: boolean;
protected
FName: string;
function GetCount: integer; virtual; abstract;
@ -55,6 +57,7 @@ type
property Count: integer read GetCount;
property Items[Index: integer]: TNewIDEItemTemplate read GetItems; default;
property Name: string read FName;
property VisibleInNewDialog: boolean read FVisibleInNewDialog write FVisibleInNewDialog;
end;
@ -145,9 +148,8 @@ end;
{ TNewIDEItemCategory }
constructor TNewIDEItemCategory.Create(const AName: string);
//fpc 1.0 doesn't support virtual abstract constructors,
//so we just make it virtual
begin
FVisibleInNewDialog:=true;
end;
{ TNewIDEItemTemplate }

7
ideintf/projectintf.pas
View File

@ -37,6 +37,7 @@ const
ProjDescNameProgram = 'Program';
ProjDescNameLibrary = 'Library';
ProjDescNameCustomProgram = 'Custom Program';
ProjDescNameEmpty = 'Empty';
type
{ TLazCompilerOptions }
@ -587,6 +588,7 @@ function ProjectDescriptorApplication: TProjectDescriptor;
function ProjectDescriptorProgram: TProjectDescriptor;
function ProjectDescriptorLibrary: TProjectDescriptor;
function ProjectDescriptorCustomProgram: TProjectDescriptor;
function ProjectDescriptorEmptyProject: TProjectDescriptor;
const
DefaultProjectFlags = [pfSaveClosedUnits,
@ -710,6 +712,11 @@ begin
Result:=ProjectDescriptors.FindByName(ProjDescNameCustomProgram);
end;
function ProjectDescriptorEmptyProject: TProjectDescriptor;
begin
Result:=ProjectDescriptors.FindByName(ProjDescNameEmpty);
end;
function ProjectFlagsToStr(Flags: TProjectFlags): string;
var f: TProjectFlag;
begin