From ae450142cfc1898b2fdeec8563c2ecaa85f30a62 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 21 Mar 2006 12:21:53 +0000 Subject: [PATCH] improved delphi conversion, include paths and error handling git-svn-id: trunk@8969 - --- components/codetools/codetoolmanager.pas | 52 +++- components/codetools/definetemplates.pas | 2 +- components/codetools/pascalparsertool.pas | 4 + components/codetools/stdcodetools.pas | 60 ++-- converter/delphiproject2laz.pas | 322 +++++++++++++--------- converter/delphiunit2laz.pas | 39 ++- ide/dialogprocs.pas | 5 +- ide/main.pp | 46 +++- ide/project.pp | 135 +++++---- ideintf/lazideintf.pas | 1 + lcl/include/application.inc | 1 + 11 files changed, 438 insertions(+), 229 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index ad4fbd9681..b81a5dffc6 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -291,7 +291,7 @@ type function AddResourceDirective(Code: TCodeBuffer; const Filename: string ): boolean; function FixIncludeFilenames(Code: TCodeBuffer; - Recursive: boolean): boolean; + Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean; // keywords and comments function IsKeyword(Code: TCodeBuffer; const KeyWord: string): boolean; @@ -565,6 +565,10 @@ type var CodeToolBoss: TCodeToolManager; +function CreateDefinesForFPCMode(const Name: string; + CompilerMode: TCompilerMode): TDefineTemplate; + + implementation @@ -601,6 +605,23 @@ begin DebugLn(BackTraceStrFunc(Frames[FrameNumber])); end; +function CreateDefinesForFPCMode(const Name: string; CompilerMode: TCompilerMode + ): TDefineTemplate; +var + cm: TCompilerMode; + NewMode: String; +begin + Result:=TDefineTemplate.Create(Name,'set FPC compiler mode', + '','',da_Block); + for cm:=Low(TCompilerMode) to High(TCompilerMode) do begin + Result.AddChild(TDefineTemplate.Create(CompilerModeVars[cm], + CompilerModeVars[cm],CompilerModeVars[cm],'',da_Undefine)); + end; + NewMode:=CompilerModeVars[CompilerMode]; + Result.AddChild(TDefineTemplate.Create(NewMode, + NewMode,NewMode,'1',da_Define)); +end; + { TCodeToolManager } @@ -2182,9 +2203,22 @@ begin end; function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer; - Recursive: boolean): boolean; + Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean; + + procedure CreateErrorForMissingIncludeFile; + var + CodePos: PCodeXYPosition; + begin + ClearError; + CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[0]); + fErrorCode:=CodePos^.Code; + fErrorLine:=CodePos^.Y; + fErrorColumn:=CodePos^.X; + FErrorMsg:='missing include file'; + end; + var - FoundIncludeFiles, MissingIncludeFiles: TStrings; + FoundIncludeFiles: TStrings; i: Integer; AFilename: string; ToFixIncludeFiles: TStringList; @@ -2194,6 +2228,7 @@ begin {$IFDEF CTDEBUG} DebugLn('TCodeToolManager.FixIncludeFilenames A ',Code.Filename,' Recursive=',Recursive); {$ENDIF} + MissingIncludeFilesCodeXYPos:=nil; if not InitCurCodeTool(Code) then exit; try FixedIncludeFiles:=nil; @@ -2211,14 +2246,14 @@ begin 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); + FoundIncludeFiles,MissingIncludeFilesCodeXYPos); + if (MissingIncludeFilesCodeXYPos<>nil) + and (MissingIncludeFilesCodeXYPos.Count>0) then begin + DebugLn('TCodeToolManager.FixIncludeFilenames Missing: ',dbgs(MissingIncludeFilesCodeXYPos.Count)); Result:=false; + CreateErrorForMissingIncludeFile; exit; end; if not Recursive then begin @@ -2243,7 +2278,6 @@ begin //DebugLn('TCodeToolManager.FixIncludeFilenames FixedIncludeFiles=',FixedIncludeFiles.Text,' ToFixIncludeFiles=',ToFixIncludeFiles.Text); finally FoundIncludeFiles.Free; - MissingIncludeFiles.Free; end; end; finally diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 140dc94ff1..fd253f86b5 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -462,7 +462,7 @@ procedure SplitLazarusCPUOSWidgetCombo(const Combination: string; // functions to quickly setup some defines function CreateDefinesInDirectories(const SourcePaths, FlagName: string - ): TDefineTemplate; + ): TDefineTemplate; implementation diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index abd53b1c98..1a01d91e38 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -1265,6 +1265,10 @@ function TPascalParserTool.ReadTilProcedureHeadEnd( procedure Intf.Method = ImplementingMethodName; function CommitUrlCacheEntry; // only Delphi procedure MacProcName(c: char; ...); external; + + Delphi mode: + Function TPOSControler.Logout; // missing function type + proc specifiers without parameters: stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 00eb3c4a02..7222ce3c13 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -213,7 +213,8 @@ type SourceChangeCache: TSourceChangeCache): boolean; function FixIncludeFilenames(Code: TCodeBuffer; SourceChangeCache: TSourceChangeCache; - out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean; + out FoundIncludeFiles: TStrings; + var MissingIncludeFilesCodeXYPos: TFPList): boolean; // search & replace function ReplaceIdentifiers(IdentList: TStrings; @@ -4324,13 +4325,33 @@ end; function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer; SourceChangeCache: TSourceChangeCache; - out FoundIncludeFiles, MissingIncludeFiles: TStrings): boolean; + out FoundIncludeFiles: TStrings; + var MissingIncludeFilesCodeXYPos: TFPList): boolean; var ASource: String; - procedure Add(const AFilename: string; Found: boolean); + {procedure WriteMissingIncludeFilesCodeXYPos; + var + CodePos: PCodeXYPosition; + i: Integer; + begin + if MissingIncludeFilesCodeXYPos<>nil then begin + for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin + CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]); + DebugLn('TStandardCodeTool.FixMissingUnits ',dbgs(CodePos)); + DebugLn('TStandardCodeTool.FixMissingUnits ',CodePos^.Code.Filename); + debugln(CodePos^.Code.Filename + +'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')' + +' missing include file'); + end; + end; + end;} + + procedure Add(FilenameSrcPos: integer; const AFilename: string; + Found: boolean); var NewFilename: String; + p: PCodeXYPosition; begin if Found then begin if FoundIncludeFiles=nil then @@ -4339,13 +4360,19 @@ var if FoundIncludeFiles.IndexOf(NewFilename)<0 then FoundIncludeFiles.Add(NewFilename); end else begin - if MissingIncludeFiles=nil then - MissingIncludeFiles:=TStringList.Create; - MissingIncludeFiles.Add(AFilename); + if MissingIncludeFilesCodeXYPos=nil then + MissingIncludeFilesCodeXYPos:=TFPList.Create; + New(p); + p^.Code:=Code; + Code.AbsoluteToLineCol(FilenameSrcPos,p^.y,p^.x); + MissingIncludeFilesCodeXYPos.Add(p); + ///DebugLn('TStandardCodeTool.FixIncludeFilenames.Add "',p^.Code.Filename,'" ',dbgs(p),' X=',dbgs(p^.X),' Y=',dbgs(p^.Y)); + //WriteMissingIncludeFilesCodeXYPos; end; end; - function SearchIncludeFilename(const AFilename: string): string; + function SearchIncludeFilename(FilenameSrcPos: integer; + const AFilename: string): string; var AFilePath: String; BaseDir: String; @@ -4357,7 +4384,7 @@ var Result:=TrimFilename(AFilename); if FilenameIsAbsolute(Result) then begin Result:=FindDiskFilename(Result); - Add(Result,FileExistsCached(Result)); + Add(FilenameSrcPos,Result,FileExistsCached(Result)); //DebugLn('SearchIncludeFilename AbsoluteFilename="',Result,'"'); end else begin BaseDir:=ExtractFilePath(MainFilename); @@ -4370,9 +4397,9 @@ var CurFilename:=FindDiskFilename(BaseDir+Result); Result:=copy(CurFilename,length(BaseDir)+1,length(CurFilename)); if FileExistsCached(CurFilename) then - Add(CurFilename,true) + Add(FilenameSrcPos,CurFilename,true) else - Add(Result,false); + Add(FilenameSrcPos,Result,false); //DebugLn('SearchIncludeFilename relative filename="',CurFilename,'"'); end else begin // search in path @@ -4388,10 +4415,10 @@ var if CurFilename<>'' then begin // found Result:=CreateRelativePath(CurFilename,BaseDir); - Add(CurFilename,true); + Add(FilenameSrcPos,CurFilename,true); end else begin // not found - Add(Result,false); + Add(FilenameSrcPos,Result,false); end; //DebugLn('SearchIncludeFilename search in include path="',IncludePath,'" Result="',Result,'"'); end; @@ -4400,9 +4427,9 @@ var ACodeBuf:=TCodeBuffer(Scanner.LoadSourceCaseLoUp(Result)); if ACodeBuf<>nil then begin Result:=ACodeBuf.Filename; - Add(Result,true); + Add(FilenameSrcPos,Result,true); end else begin - Add(Result,false); + Add(FilenameSrcPos,Result,false); end; end; end; @@ -4423,7 +4450,7 @@ var else AFilename:=AFilename+'.pp'; end; - AFilename:=SearchIncludeFilename(AFilename); + AFilename:=SearchIncludeFilename(StartPos,AFilename); if OldFilename<>AFilename then begin DebugLn('FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"'); SourceChangeCache.ReplaceEx(gtNone,gtNone,0,0,Code,StartPos,EndPos,AFilename); @@ -4437,7 +4464,6 @@ var begin Result:=false; FoundIncludeFiles:=nil; - MissingIncludeFiles:=nil; if (Scanner=nil) or (Scanner.MainCode=nil) then exit; ASource:=Code.Source; Scanner.Scan(lsrInit,false); @@ -4455,6 +4481,8 @@ begin p:=FindCommentEnd(ASource,p,NestedComments); //DebugLn('TStandardCodeTool.FixIncludeFilenames ',dbgs(p)); until false; + //WriteMissingIncludeFilesCodeXYPos; + Result:=SourceChangeCache.Apply; end; diff --git a/converter/delphiproject2laz.pas b/converter/delphiproject2laz.pas index 7224bdc9b3..08d2b82012 100644 --- a/converter/delphiproject2laz.pas +++ b/converter/delphiproject2laz.pas @@ -46,12 +46,16 @@ interface uses Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, FileProcs, FileUtil, - ExprEval, DefineTemplates, CodeCache, CodeToolManager, + ExprEval, DefineTemplates, CodeCache, CodeToolManager, CodeToolsStructs, + LinkScanner, SrcEditorIntf, MsgIntf, MainIntf, LazIDEIntf, ProjectIntf, IDEProcs, DelphiUnit2Laz, Project, DialogProcs, CheckLFMDlg, EditorOptions, ProjectInspector, CompilerOptions, BasePkgManager, PkgManager; - + +const + SettingDelphiModeTemplName = 'Setting Delphi Mode'; + function ConvertDelphiToLazarusProject(const ProjectFilename: string ): TModalResult; function FindAllDelphiProjectUnits(AProject: TProject): TModalResult; @@ -60,7 +64,8 @@ type TConvertDelphiToLazarusUnitFlag = ( cdtlufRenameLowercase, // rename the unit lowercase cdtlufIsSubProc, // this is part of a big conversion -> add Abort button to all questions - cdtlufCheckLFM // check and fix LFM + cdtlufCheckLFM, // check and fix LFM + cdtlufDoNotSetDelphiMode // do not set delphi mode for project directories ); TConvertDelphiToLazarusUnitFlags = set of TConvertDelphiToLazarusUnitFlag; @@ -76,6 +81,8 @@ function CreateDelphiToLazarusMainSourceFile(AProject: TProject; function FindDPRFilename(const StartFilename: string): string; function ReadDelphiProjectConfigFiles(AProject: TProject): TModalResult; procedure CleanUpProjectSearchPaths(AProject: TProject); +procedure SetCompilerModeForProjectSrcDirs(AProject: TProject); +procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject); implementation @@ -131,34 +138,41 @@ begin // we have now enough information to parse the .dpr file, // but not enough to parse the units + + // set Delphi mode for all project source directories + SetCompilerModeForProjectSrcDirs(Project1); + try - // init codetools - if not LazarusIDE.BeginCodeTools then begin - DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools'); - Result:=mrCancel; - exit; + // init codetools + if not LazarusIDE.BeginCodeTools then begin + DebugLn('ConvertDelphiToLazarusProject failed BeginCodeTools'); + Result:=mrCancel; + exit; + end; + + // fix .lpr + ConvertUnitFlags:=[cdtlufIsSubProc,cdtlufDoNotSetDelphiMode]; + Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags); + if Result=mrAbort then begin + DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename); + exit; + end; + + // get all options from .lpr (the former .dpr) + Result:=ExtractOptionsFromDPR(LPRCode,Project1); + if Result<>mrOk then exit; + + // find and convert all project files + Result:=FindAllDelphiProjectUnits(Project1); + if Result<>mrOk then exit; + + // convert all project files + Result:=ConvertAllDelphiProjectUnits(Project1,[cdtlufIsSubProc,cdtlufCheckLFM]); + if Result<>mrOk then exit; + finally + UnsetCompilerModeForProjectSrcDirs(Project1); end; - // fix .lpr - ConvertUnitFlags:=[cdtlufIsSubProc]; - Result:=ConvertDelphiToLazarusUnit(LPRCode.Filename,ConvertUnitFlags); - if Result=mrAbort then begin - DebugLn('ConvertDelphiToLazarusProject failed converting unit ',LPRCode.Filename); - exit; - end; - - // get all options from .lpr (the former .dpr) - Result:=ExtractOptionsFromDPR(LPRCode,Project1); - if Result<>mrOk then exit; - - // find and convert all project files - Result:=FindAllDelphiProjectUnits(Project1); - if Result<>mrOk then exit; - - // convert all project files - Result:=ConvertAllDelphiProjectUnits(Project1,[cdtlufIsSubProc]); - if Result<>mrOk then exit; - debugln('ConvertDelphiToLazarusProject Done'); Result:=mrOk; end; @@ -170,7 +184,7 @@ var NotFoundUnits: String; i: Integer; CurUnitInfo: TUnitInfo; - NewUnitPath: String; + NewSearchPath: String; CurFilename: string; p: LongInt; OffendingUnit: TUnitInfo; @@ -201,64 +215,79 @@ begin if Result<>mrIgnore then exit; end; - // add all units to the project - debugln('ConvertDelphiToLazarusProject adding all project units to project ...'); - - for i:=0 to FoundInUnits.Count-1 do begin - CurFilename:=FoundInUnits[i]; - p:=System.Pos(' in ',CurFilename); - if p>0 then - CurFilename:=copy(CurFilename,p+4,length(CurFilename)); - if CurFilename='' then continue; - if not FilenameIsAbsolute(CurFilename) then - CurFilename:=AppendPathDelim(Project1.ProjectDirectory)+CurFilename; - CurFilename:=TrimFilename(CurFilename); - if not FileExists(CurFilename) then begin - DebugLn('ConvertDelphiToLazarusProject file not found: "',CurFilename,'"'); - continue; - end; - CurUnitInfo:=Project1.UnitInfoWithFilename(CurFilename); - if CurUnitInfo<>nil then begin - CurUnitInfo.IsPartOfProject:=true; - end else begin - if FilenameIsPascalUnit(CurFilename) then begin - // check unitname - OffendingUnit:=Project1.UnitWithUnitname( - ExtractFileNameOnly(CurFilename)); - if OffendingUnit<>nil then begin - Result:=QuestionDlg('Unitname exists twice', - 'There are two units with the same unitname:'#13 - +OffendingUnit.Filename+#13 - +CurFilename+#13, - mtWarning,[mrYes,'Remove first',mrNo,'Remove second', - mrIgnore,'Keep both',mrAbort],0); - case Result of - mrYes: OffendingUnit.IsPartOfProject:=false; - mrNo: continue; - mrIgnore: ; - else - Result:=mrAbort; - exit; + try + // add all units to the project + debugln('ConvertDelphiToLazarusProject adding all project units to project ...'); + + for i:=0 to FoundInUnits.Count-1 do begin + CurFilename:=FoundInUnits[i]; + p:=System.Pos(' in ',CurFilename); + if p>0 then + CurFilename:=copy(CurFilename,p+4,length(CurFilename)); + if CurFilename='' then continue; + if not FilenameIsAbsolute(CurFilename) then + CurFilename:=AppendPathDelim(Project1.ProjectDirectory)+CurFilename; + CurFilename:=TrimFilename(CurFilename); + if not FileExists(CurFilename) then begin + DebugLn('ConvertDelphiToLazarusProject file not found: "',CurFilename,'"'); + continue; + end; + CurUnitInfo:=Project1.UnitInfoWithFilename(CurFilename); + if CurUnitInfo<>nil then begin + CurUnitInfo.IsPartOfProject:=true; + end else begin + if FilenameIsPascalUnit(CurFilename) then begin + // check unitname + OffendingUnit:=Project1.UnitWithUnitname( + ExtractFileNameOnly(CurFilename)); + if OffendingUnit<>nil then begin + Result:=QuestionDlg('Unitname exists twice', + 'There are two units with the same unitname:'#13 + +OffendingUnit.Filename+#13 + +CurFilename+#13, + mtWarning,[mrYes,'Remove first',mrNo,'Remove second', + mrIgnore,'Keep both',mrAbort],0); + case Result of + mrYes: OffendingUnit.IsPartOfProject:=false; + mrNo: continue; + mrIgnore: ; + else + Result:=mrAbort; + exit; + end; end; end; + + // add new unit to project + CurUnitInfo:=TUnitInfo.Create(nil); + CurUnitInfo.Filename:=CurFilename; + CurUnitInfo.IsPartOfProject:=true; + Project1.AddFile(CurUnitInfo,false); end; - - // add new unit to project - CurUnitInfo:=TUnitInfo.Create(nil); - CurUnitInfo.Filename:=CurFilename; - CurUnitInfo.IsPartOfProject:=true; - Project1.AddFile(CurUnitInfo,false); end; - end; - // set search paths to find all project units - NewUnitPath:=MergeSearchPaths(Project1.CompilerOptions.OtherUnitFiles, + + finally + // set unit paths to find all project units + NewSearchPath:=MergeSearchPaths(Project1.CompilerOptions.OtherUnitFiles, Project1.SourceDirectories.CreateSearchPathFromAllFiles); - NewUnitPath:=RemoveSearchPaths(NewUnitPath, - '.;'+VirtualDirectory+';'+VirtualTempDir - +';'+Project1.ProjectDirectory); - Project1.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath( - RemoveNonExistingPaths(NewUnitPath,Project1.ProjectDirectory)); - DebugLn('ConvertDelphiToLazarusProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"'); + NewSearchPath:=RemoveSearchPaths(NewSearchPath, + '.;'+VirtualDirectory+';'+VirtualTempDir + +';'+Project1.ProjectDirectory); + Project1.CompilerOptions.OtherUnitFiles:=MinimizeSearchPath( + RemoveNonExistingPaths(NewSearchPath,Project1.ProjectDirectory)); + // set include path + NewSearchPath:=MergeSearchPaths(Project1.CompilerOptions.IncludeFiles, + Project1.SourceDirectories.CreateSearchPathFromAllFiles); + NewSearchPath:=RemoveSearchPaths(NewSearchPath, + '.;'+VirtualDirectory+';'+VirtualTempDir + +';'+Project1.ProjectDirectory); + Project1.CompilerOptions.IncludeFiles:=MinimizeSearchPath( + RemoveNonExistingPaths(NewSearchPath,Project1.ProjectDirectory)); + // clear caches + Project1.DefineTemplates.SourceDirectoriesChanged; + CodeToolBoss.DefineTree.ClearCache; + DebugLn('ConvertDelphiToLazarusProject UnitPath="',Project1.CompilerOptions.OtherUnitFiles,'"'); + end; // save project debugln('ConvertDelphiToLazarusProject Saving project ...'); @@ -279,34 +308,47 @@ end; function ConvertAllDelphiProjectUnits(AProject: TProject; Flags: TConvertDelphiToLazarusUnitFlags): TModalResult; -var - i: Integer; - CurUnitInfo: TUnitInfo; -begin - // convert all units - i:=0; - while imrOk then exit; + // now the units can be parsed + if cdtlufCheckLFM in Flags then begin + // fix the .lfm files + Result:=Convert(Flags); + if Result<>mrOk then exit; end; - - Result:=mrOk; end; function ConvertDelphiToLazarusUnit(const DelphiFilename: string; @@ -320,7 +362,7 @@ var LFMFilename: String; begin // check file and directory - DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename); + DebugLn('ConvertDelphiToLazarusUnit A ',DelphiFilename,' FixLFM=',dbgs(cdtlufCheckLFM in Flags)); Result:=CheckFileIsWritable(DelphiFilename,[mbAbort]); if Result<>mrOk then exit; @@ -350,7 +392,7 @@ begin // convert .dfm file to .lfm file (without context type checking) if HasDFMFile then begin - DebugLn('ConvertDelphiToLazarusUnit Convert dfm format to lfm "',LFMFilename,'"'); + DebugLn('ConvertDelphiToLazarusUnit Rename dfm to lfm "',LFMFilename,'"'); Result:=ConvertDFMFileToLFMFile(LFMFilename); if Result<>mrOk then exit; end; @@ -395,30 +437,31 @@ begin cdtlufIsSubProc in Flags,Result) then exit; - - // check the LFM file and the pascal unit - DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file'); - Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile); - if Result<>mrOk then exit; - if HasDFMFile and (LFMCode=nil) then - DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode'); - if (LFMCode<>nil) - and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk) - then begin - LazarusIDE.DoJumpToCompilerMessage(-1,true); - exit(mrAbort); - end; - - if LFMCode<>nil then begin - // save LFM file - DebugLn('ConvertDelphiToLazarusUnit Save LFM'); - Result:=MainIDEInterface.DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false); + if cdtlufCheckLFM in Flags then begin + // check the LFM file and the pascal unit + DebugLn('ConvertDelphiToLazarusUnit Check new .lfm and .pas file'); + Result:=LoadUnitAndLFMFile(LazarusUnitFilename,UnitCode,LFMCode,HasDFMFile); if Result<>mrOk then exit; + if HasDFMFile and (LFMCode=nil) then + DebugLn('WARNING: ConvertDelphiToLazarusUnit unable to load LFMCode'); + if (LFMCode<>nil) + and (CheckLFMBuffer(UnitCode,LFMCode,@IDEMessagesWindow.AddMsg,true,true)<>mrOk) + then begin + LazarusIDE.DoJumpToCompilerMessage(-1,true); + exit(mrAbort); + end; - // convert lfm to lrs - DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs'); - Result:=ConvertLFMtoLRSfile(LFMCode.Filename); - if Result<>mrOk then exit; + if LFMCode<>nil then begin + // save LFM file + DebugLn('ConvertDelphiToLazarusUnit Save LFM'); + Result:=MainIDEInterface.DoSaveCodeBufferToFile(LFMCode,LFMCode.Filename,false); + if Result<>mrOk then exit; + + // convert lfm to lrs + DebugLn('ConvertDelphiToLazarusUnit Convert lfm to lrs'); + Result:=ConvertLFMtoLRSfile(LFMCode.Filename); + if Result<>mrOk then exit; + end; end; Result:=mrOk; @@ -535,5 +578,24 @@ begin CleanProjectSearchPath(AProject.CompilerOptions.SrcPath); end; +procedure SetCompilerModeForProjectSrcDirs(AProject: TProject); +begin + if AProject.DefineTemplates.CustomDefines.FindChildByName( + SettingDelphiModeTemplName)<>nil + then exit; + AProject.DefineTemplates.CustomDefines.ReplaceChild( + CreateDefinesForFPCMode(SettingDelphiModeTemplName,cmDELPHI)); + CodeToolBoss.DefineTree.ClearCache; +end; + +procedure UnsetCompilerModeForProjectSrcDirs(AProject: TProject); +begin + if AProject.DefineTemplates.CustomDefines.FindChildByName( + SettingDelphiModeTemplName)=nil + then exit; + AProject.DefineTemplates.CustomDefines.DeleteChild(SettingDelphiModeTemplName); + CodeToolBoss.DefineTree.ClearCache; +end; + end. diff --git a/converter/delphiunit2laz.pas b/converter/delphiunit2laz.pas index 4cf1ac6401..5619f4ced6 100644 --- a/converter/delphiunit2laz.pas +++ b/converter/delphiunit2laz.pas @@ -42,7 +42,7 @@ uses Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, FileUtil, IniFiles, // Components - SynEdit, CodeCache, CodeToolManager, DefineTemplates, + SynEdit, CodeAtom, CodeCache, CodeToolManager, DefineTemplates, // IDEIntf LazIDEIntf, MsgIntf, // IDE @@ -319,6 +319,8 @@ var i: Integer; Msg: String; CurDir: String; + CodePos: PCodeXYPosition; + MissingIncludeFilesCodeXYPos: TFPList; begin Result:=LoadCodeBuffer(LazUnitCode,LazarusUnitFilename, [lbfCheckIfText,lbfUpdateFromDisk]); @@ -326,10 +328,28 @@ begin // fix include filenames DebugLn('FixMissingUnits fixing include directives ...'); - if not CodeToolBoss.FixIncludeFilenames(LazUnitCode,true) - then begin - Result:=JumpToCodetoolErrorAndAskToAbort(IsSubProc); - exit; + MissingIncludeFilesCodeXYPos:=nil; + try + if not CodeToolBoss.FixIncludeFilenames(LazUnitCode,true, + MissingIncludeFilesCodeXYPos) + then begin + DebugLn('FixMissingUnits Error="',CodeToolBoss.ErrorMessage,'"'); + if MissingIncludeFilesCodeXYPos<>nil then begin + for i:=0 to MissingIncludeFilesCodeXYPos.Count-1 do begin + CodePos:=PCodeXYPosition(MissingIncludeFilesCodeXYPos[i]); + Msg:=CodePos^.Code.Filename + +'('+IntToStr(CodePos^.y)+','+IntToStr(CodePos^.x)+')' + +' missing include file'; + DebugLn('FixMissingUnits "',Msg,'"'); + IDEMessagesWindow.AddMsg(Msg,'',-1); + end; + end; + DebugLn('FixMissingUnits 2 Error="',CodeToolBoss.ErrorMessage,'"'); + Result:=JumpToCodetoolErrorAndAskToAbort(IsSubProc); + exit; + end; + finally + CodeToolBoss.FreeListOfPCodeXYPosition(MissingIncludeFilesCodeXYPos); end; MissingUnits:=nil; @@ -545,7 +565,7 @@ begin AProject.CompilerOptions.DebugPath:= MergeSearchPaths(AProject.CompilerOptions.DebugPath,SearchPath); end; - + // debug source dirs DebugSourceDirs:=ReadSearchPath('Directories','DebugSourceDirs'); if DebugSourceDirs<>'' then begin @@ -642,8 +662,9 @@ begin // can mean, that the relative path is 'folder' ProjectDir:=AProject.ProjectDirectory; - ShortProjectDir:='\'+ExtractFileName(ChompPathDelim(ProjectDir))+'\'; + ShortProjectDir:=PathDelim+ExtractFileName(ChompPathDelim(ProjectDir))+PathDelim; p:=System.Pos(ShortProjectDir,Filename); + //DebugLn('ConvertDelphiAbsoluteToRelativeFile ShortProjectDir="',ShortProjectDir,'" ',Filename,' ',dbgs(p)); if (p>0) then begin Result:=copy(Filename,p+length(ShortProjectDir),length(Filename)); exit; @@ -664,6 +685,7 @@ begin // check for $(Delphi) makro p:=System.Pos('$(DELPHI)',Result); + //DebugLn('ExpandDelphiFilename Result="',Result,'" ',dbgs(p)); if p>0 then begin // Delphi features are provided by FPC and Lazarus // -> ignore @@ -696,12 +718,14 @@ var j: Integer; begin Result:=''; + //DebugLn('ExpandDelphiSearchPath SearchPath="',SearchPath,'"'); 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); + DebugLn(Paths.Text); // remove doubles for i:=Paths.Count-1 downto 0 do begin CurPath:=Paths[i]; @@ -719,6 +743,7 @@ begin if i>0 then Result:=Result+';'; Result:=Result+Paths[i]; end; + //DebugLn('ExpandDelphiSearchPath Result="',Result,'"'); finally Paths.Free; end; diff --git a/ide/dialogprocs.pas b/ide/dialogprocs.pas index ede6b816e1..52772d7b70 100644 --- a/ide/dialogprocs.pas +++ b/ide/dialogprocs.pas @@ -365,12 +365,15 @@ end; function JumpToCodetoolErrorAndAskToAbort(Ask: boolean): TModalResult; // returns mrCancel or mrAbort +var + ErrMsg: String; begin + ErrMsg:=CodeToolBoss.ErrorMessage; LazarusIDE.DoJumpToCodeToolBossError; if Ask then begin Result:=QuestionDlg('Error', 'The codetools found an error:'#13 - +CodeToolBoss.ErrorMessage+#13, + +ErrMsg+#13, mtWarning,[mrIgnore,'Ignore and continue',mrAbort],0); if Result=mrIgnore then Result:=mrCancel; end else begin diff --git a/ide/main.pp b/ide/main.pp index 0427bb424c..6fa77345f7 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -5644,16 +5644,20 @@ begin // if SaveFirst then save the source if (cfSaveFirst in Flags) and (not ActiveUnitInfo.ReadOnly) and ((ActiveSrcEdit.Modified) or (ActiveUnitInfo.Modified)) then begin - if ActiveUnitInfo.Filename<>'' then - AText:=Format(lisFileHasChangedSave, ['"', ActiveUnitInfo.Filename, '"']) - else if ActiveUnitInfo.UnitName<>'' then - AText:=Format(lisUnitHasChangedSave, ['"', ActiveUnitInfo.Unitname, '"']) - else - AText:=Format(lisSourceOfPageHasChangedSave, ['"', - ActiveSrcEdit.PageName, '"']); - ACaption:=lisSourceModified; - Result:=Messagedlg(ACaption, AText, - mtConfirmation, [mbYes, mbNo, mbAbort], 0); + if not (cfQuiet in Flags) then begin + // ask user + if ActiveUnitInfo.Filename<>'' then + AText:=Format(lisFileHasChangedSave, ['"', ActiveUnitInfo.Filename, '"']) + else if ActiveUnitInfo.UnitName<>'' then + AText:=Format(lisUnitHasChangedSave, ['"', ActiveUnitInfo.Unitname, '"']) + else + AText:=Format(lisSourceOfPageHasChangedSave, ['"', + ActiveSrcEdit.PageName, '"']); + ACaption:=lisSourceModified; + Result:=Messagedlg(ACaption, AText, + mtConfirmation, [mbYes, mbNo, mbAbort], 0); + end else + Result:=mrYes; if Result=mrYes then begin Result:=DoSaveEditorFile(PageIndex,[sfCheckAmbiguousFiles]); end; @@ -8127,16 +8131,32 @@ end; function TMainIDE.DoConvertDelphiUnit(const DelphiFilename: string ): TModalResult; +var + OldChange: Boolean; begin InputHistories.LastConvertDelphiUnit:=DelphiFilename; - Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename,[]); + OldChange:=FOpenEditorsOnCodeToolChange; + FOpenEditorsOnCodeToolChange:=true; + try + Result:=DelphiProject2Laz.ConvertDelphiToLazarusUnit(DelphiFilename,[]); + finally + FOpenEditorsOnCodeToolChange:=OldChange; + end; end; function TMainIDE.DoConvertDelphiProject(const DelphiFilename: string ): TModalResult; +var + OldChange: Boolean; begin InputHistories.LastConvertDelphiProject:=DelphiFilename; - Result:=DelphiProject2Laz.ConvertDelphiToLazarusProject(DelphiFilename); + OldChange:=FOpenEditorsOnCodeToolChange; + FOpenEditorsOnCodeToolChange:=true; + try + Result:=DelphiProject2Laz.ConvertDelphiToLazarusProject(DelphiFilename); + finally + FOpenEditorsOnCodeToolChange:=OldChange; + end; end; {------------------------------------------------------------------------------- @@ -10696,10 +10716,10 @@ begin // jump to error in source editor if CodeToolBoss.ErrorCode<>nil then begin - SourceNotebook.AddJumpPointClicked(Self); ErrorCaret:=Point(CodeToolBoss.ErrorColumn,CodeToolBoss.ErrorLine); ErrorFilename:=CodeToolBoss.ErrorCode.Filename; ErrorTopLine:=CodeToolBoss.ErrorTopLine; + SourceNotebook.AddJumpPointClicked(Self); OpenFlags:=[ofOnlyIfExists,ofUseCache]; if CodeToolBoss.ErrorCode.IsVirtual then Include(OpenFlags,ofVirtualFile); diff --git a/ide/project.pp b/ide/project.pp index 7c61d7cc63..99c6a92bc2 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -316,7 +316,8 @@ type TProjectDefineTemplates = class private FActive: boolean; - FCustomDefines: TDefineTemplate; + FSrcDirectories: TDefineTemplate; + FSrcDirIfDef: TDefineTemplate; FFlags: TProjectDefineTemplatesFlags; FMain: TDefineTemplate; FOutputDir: TDefineTemplate; @@ -331,8 +332,9 @@ type FLastCustomOptions: string; procedure SetActive(const AValue: boolean); procedure UpdateMain; + procedure UpdateSrcDirIfDef; procedure UpdateDefinesForOutputDirectory; - procedure UpdateDefinesForSourceDirectories; + procedure UpdateSourceDirectories; procedure UpdateDefinesForCustomDefines; public constructor Create(OwnerProject: TProject); @@ -343,17 +345,18 @@ type procedure CompilerFlagsChanged; procedure AllChanged; procedure ProjectIDChanged; - procedure SourceDirectoriesChanged; - procedure OutputDirectoryChanged; - procedure CustomDefinesChanged; + procedure SourceDirectoriesChanged;// a source directory was added/deleted + procedure CustomDefinesChanged;// the defines of the source dirs changed + procedure OutputDirectoryChanged;// the path or the defines of the output dir changed procedure UpdateGlobalValues; public property Owner: TProject read FOwnerProject; property Project: TProject read FOwnerProject; property Main: TDefineTemplate read FMain; + property SrcDirectories: TDefineTemplate read FSrcDirectories; property OutputDir: TDefineTemplate read FOutputDir; property OutPutSrcPath: TDefineTemplate read FOutPutSrcPath; - property CustomDefines: TDefineTemplate read FCustomDefines; + property CustomDefines: TDefineTemplate read FSrcDirIfDef; property Active: boolean read FActive write SetActive; end; @@ -3797,6 +3800,64 @@ begin end else FMain.Name:=Project.IDAsWord; // ClearCache is here unnessary, because it is only a block + + +end; + +procedure TProjectDefineTemplates.UpdateSrcDirIfDef; +var + NewValue: String; + Changed: Boolean; + UnitPathDefTempl: TDefineTemplate; + IncPathDefTempl: TDefineTemplate; + SrcPathDefTempl: TDefineTemplate; +begin + // The options are enclosed by an + // IFDEF #ProjectSrcMark template. + // Each source directory defines this variable, so that the settings can be + // activated for each source directory by a simple DEFINE. + if (FMain=nil) then UpdateMain; + if FSrcDirectories=nil then begin + FSrcDirectories:=TDefineTemplate.Create('Source Directories', + 'Source Directories','','', + da_Block); + FMain.AddChild(FSrcDirectories); + end; + if FSrcDirIfDef=nil then begin + FSrcDirIfDef:=TDefineTemplate.Create('Source Directory Additions', + 'Additional defines for project source directories', + '#ProjectSrcMark'+Project.IDAsWord,'', + da_IfDef); + FMain.AddChild(FSrcDirIfDef); + + // create unit path template for this directory + UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath, + '#UnitPath','$(#UnitPath);$ProjectUnitPath('+Project.IDAsString+')', + da_Define); + FSrcDirIfDef.AddChild(UnitPathDefTempl); + + // create include path template for this directory + IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path', + '#IncPath','$(#IncPath);$ProjectIncPath('+Project.IDAsString+')', + da_Define); + FSrcDirIfDef.AddChild(IncPathDefTempl); + + // create src path template for this directory + SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path', + '#SrcPath','$(#SrcPath);$ProjectSrcPath('+Project.IDAsString+')', + da_Define); + FSrcDirIfDef.AddChild(SrcPathDefTempl); + + Changed:=true; + end else begin + NewValue:='#ProjectSrcMark'+Project.IDAsWord; + if FSrcDirIfDef.Value<>NewValue then begin + FSrcDirIfDef.Value:='#ProjectSrcMark'+Project.IDAsWord; + Changed:=true; + end; + end; + if Changed then + CodeToolBoss.DefineTree.ClearCache; end; procedure TProjectDefineTemplates.UpdateDefinesForOutputDirectory; @@ -3832,16 +3893,13 @@ begin end; end; -procedure TProjectDefineTemplates.UpdateDefinesForSourceDirectories; +procedure TProjectDefineTemplates.UpdateSourceDirectories; var NewSourceDirs: TStringList; i: Integer; SrcDirDefTempl: TDefineTemplate; - UnitPathDefTempl: TDefineTemplate; - IncPathDefTempl: TDefineTemplate; IDHasChanged: Boolean; SrcDirMarkDefTempl: TDefineTemplate; - SrcPathDefTempl: TDefineTemplate; begin //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories ',Project.IDAsString,' Active=',dbgs(Active),' TimeStamp=',dbgs(fLastSourceDirStamp),' Project.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp)); if (not Project.NeedsDefineTemplates) or (not Active) then exit; @@ -3883,7 +3941,8 @@ begin // build source directory define templates fLastSourceDirectories.Assign(NewSourceDirs); - if (FMain=nil) and (fLastSourceDirectories.Count>0) then UpdateMain; + if (FSrcDirIfDef=nil) and (fLastSourceDirectories.Count>0) then + UpdateSrcDirIfDef; for i:=0 to fLastSourceDirectories.Count-1 do begin // create directory template SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1), @@ -3896,28 +3955,10 @@ begin da_Define); SrcDirDefTempl.AddChild(SrcDirMarkDefTempl); - // create unit path template for this directory - UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath, - '#UnitPath','$(#UnitPath);$ProjectUnitPath('+Project.IDAsString+')', - da_Define); - SrcDirDefTempl.AddChild(UnitPathDefTempl); - - // create include path template for this directory - IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path', - '#IncPath','$(#IncPath);$ProjectIncPath('+Project.IDAsString+')', - da_Define); - SrcDirDefTempl.AddChild(IncPathDefTempl); - - // create src path template for this directory - SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path', - '#SrcPath','$(#SrcPath);$ProjectSrcPath('+Project.IDAsString+')', - da_Define); - SrcDirDefTempl.AddChild(SrcPathDefTempl); - SrcDirDefTempl.SetDefineOwner(Project,false); SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false); // add directory - FMain.AddChild(SrcDirDefTempl); + FSrcDirectories.AddChild(SrcDirDefTempl); end; CodeToolBoss.DefineTree.ClearCache; @@ -3942,30 +3983,16 @@ begin 'Custom Options',FLastCustomOptions,false,Project); if OptionsDefTempl=nil then begin // no custom options -> delete old template - if FCustomDefines<>nil then begin - FCustomDefines.UnBind; - FCustomDefines.Free; - FCustomDefines:=nil; + if FSrcDirIfDef<>nil then begin + FSrcDirIfDef.UnBind; + FSrcDirIfDef.Free; + FSrcDirIfDef:=nil; end; exit; end; - // create custom options - // The custom options are enclosed by an - // IFDEF #ProjectSrcMark template. - // Each source directory defines this variable, so that the settings can be - // activated for each source directory by a simple DEFINE. - if (FMain=nil) then UpdateMain; - if FCustomDefines=nil then begin - FCustomDefines:=TDefineTemplate.Create('Source Directory Additions', - 'Additional defines for project source directories', - '#ProjectSrcMark'+Project.IDAsWord,'', - da_IfDef); - FMain.AddChild(FCustomDefines); - end else begin - FCustomDefines.Value:='#ProjectSrcMark'+Project.IDAsWord; - end; - FCustomDefines.ReplaceChild(OptionsDefTempl); + UpdateSrcDirIfDef; + FSrcDirIfDef.ReplaceChild(OptionsDefTempl); CodeToolBoss.DefineTree.ClearCache; end; @@ -3990,6 +4017,10 @@ begin CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain); FMain:=nil; FProjectDir:=nil; + FSrcDirIfDef:=nil; + FSrcDirectories:=nil; + FOutPutSrcPath:=nil; + FOutputDir:=nil; FFlags:=FFlags+[ptfFlagsChanged]; end; end; @@ -4042,7 +4073,7 @@ begin Exclude(FFlags,ptfIDChanged); UpdateMain; UpdateDefinesForOutputDirectory; - UpdateDefinesForSourceDirectories; + UpdateSourceDirectories; UpdateDefinesForCustomDefines; end; @@ -4053,7 +4084,7 @@ begin exit; end; Exclude(FFlags,ptfSourceDirsChanged); - UpdateDefinesForSourceDirectories; + UpdateSourceDirectories; CodeToolBoss.DefineTree.ClearCache; end; diff --git a/ideintf/lazideintf.pas b/ideintf/lazideintf.pas index b70bbbeae5..ff22c22d93 100644 --- a/ideintf/lazideintf.pas +++ b/ideintf/lazideintf.pas @@ -71,6 +71,7 @@ type // close file flags TCloseFlag = ( cfSaveFirst, // check if modified and save + cfQuiet, cfProjectClosing ); TCloseFlags = set of TCloseFlag; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 1d8aa72756..38a6681bf5 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -1011,6 +1011,7 @@ end; control is passed to event processor. ------------------------------------------------------------------------------} procedure TApplication.RunLoop; + procedure RunMessage; begin HandleMessage;