IDE: clean up, lazbuild: auto create lrs files bug #11063

git-svn-id: trunk@14921 -
This commit is contained in:
mattias 2008-04-21 16:28:13 +00:00
parent be047c5015
commit f8b5714a8f
20 changed files with 79 additions and 68 deletions

View File

@ -68,6 +68,8 @@ type
): TModalResult; virtual; abstract; ): TModalResult; virtual; abstract;
function BackupFile(const Filename: string): TModalResult; virtual; abstract; function BackupFile(const Filename: string): TModalResult; virtual; abstract;
function UpdateProjectAutomaticFiles: TModalResult; virtual; abstract;
end; end;
var var

View File

@ -41,10 +41,9 @@ unit BuildLazDialog;
interface interface
uses uses
Classes, SysUtils, Math, LCLProc, Forms, Controls, LCLType, LCLIntf, Classes, SysUtils, LCLProc, Forms, Controls, LCLType, LCLIntf,
Graphics, GraphType, StdCtrls, ExtCtrls, Buttons, FileUtil, Dialogs, Graphics, GraphType, StdCtrls, ExtCtrls, Buttons, FileUtil, Dialogs,
LResources, Laz_XMLCfg, InterfaceBase, ImgList, Themes, ComCtrls, LResources, Laz_XMLCfg, InterfaceBase, Themes, ComCtrls,
IDEExternToolIntf,
LazarusIDEStrConsts, TransferMacros, LazConf, IDEProcs, DialogProcs, LazarusIDEStrConsts, TransferMacros, LazConf, IDEProcs, DialogProcs,
IDEWindowIntf, InputHistory, ExtToolDialog, ExtToolEditDlg, IDEWindowIntf, InputHistory, ExtToolDialog, ExtToolEditDlg,
{$IFDEF win32} {$IFDEF win32}
@ -240,7 +239,7 @@ type
private private
FAdvanced: Boolean; FAdvanced: Boolean;
FOptions: TBuildLazarusOptions; FOptions: TBuildLazarusOptions;
function GetMakeModeAtX(const X: Integer; var MakeMode: TMakeMode): boolean; function GetMakeModeAtX(const X: Integer; out MakeMode: TMakeMode): boolean;
function MakeModeToInt(MakeMode: TMakeMode): integer; function MakeModeToInt(MakeMode: TMakeMode): integer;
function IntToMakeMode(i: integer): TMakeMode; function IntToMakeMode(i: integer): TMakeMode;
procedure SetAdvanced(AValue: boolean); procedure SetAdvanced(AValue: boolean);
@ -979,11 +978,12 @@ begin
end; end;
function TConfigureBuildLazarusDlg.GetMakeModeAtX(const X: Integer; function TConfigureBuildLazarusDlg.GetMakeModeAtX(const X: Integer;
var MakeMode: TMakeMode): boolean; out MakeMode: TMakeMode): boolean;
var var
i: integer; i: integer;
begin begin
Result:=True; Result:=True;
MakeMode:=mmNone;
i := X div ButtonSize; i := X div ButtonSize;
case i of case i of
0: MakeMode:=mmNone; 0: MakeMode:=mmNone;

View File

@ -135,6 +135,9 @@ type
): TModalResult; override; ): TModalResult; override;
function BackupFile(const Filename: string): TModalResult; override; function BackupFile(const Filename: string): TModalResult; override;
function UpdateLRSFromLFM(const LRSFilename: string): TModalResult;
function UpdateProjectAutomaticFiles: TModalResult; override;
// methods for building // methods for building
procedure SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string; procedure SetBuildTarget(const TargetOS, TargetCPU, LCLWidgetType: string;
DoNotScanFPCSrc: boolean = false); DoNotScanFPCSrc: boolean = false);
@ -972,6 +975,43 @@ begin
until Result<>mrRetry; until Result<>mrRetry;
end; end;
function TBuildManager.UpdateLRSFromLFM(const LRSFilename: string
): TModalResult;
var
LFMFilename: String;
begin
Result:=mrOk;
// check if there is a .lrs file
if LRSFilename='' then exit;
if not FilenameIsAbsolute(LRSFilename) then exit;
LFMFilename:=ChangeFileExt(LRSFilename,'.lfm');
if LRSFilename=LFMFilename then exit;
// check if there is a .lfm file
if not FileExists(LFMFilename) then exit;
// check if .lrs file is newer than .lfm file
if FileExists(LRSFilename) and (FileAge(LFMFilename)<=FileAge(LRSFilename))
then exit;
debugln('TBuildManager.UpdateLRSFromLFM ',LRSFilename,' LFMAge=',dbgs(FileAge(LFMFilename)),' LRSAge=',dbgs(FileAge(LRSFilename)));
// the .lrs file does not exist, or is older than the .lfm file
// -> update .lrs file
Result:=ConvertLFMToLRSFileInteractive(LFMFilename,LRSFilename);
end;
function TBuildManager.UpdateProjectAutomaticFiles: TModalResult;
var
AnUnitInfo: TUnitInfo;
begin
AnUnitInfo:=Project1.FirstPartOfProject;
while AnUnitInfo<>nil do begin
if AnUnitInfo.HasResources then begin
Result:=UpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
if Result=mrIgnore then Result:=mrOk;
if Result<>mrOk then exit;
end;
AnUnitInfo:=AnUnitInfo.NextPartOfProject;
end;
end;
function TBuildManager.MacroFuncMakeExe(const Filename: string; function TBuildManager.MacroFuncMakeExe(const Filename: string;
const Data: PtrInt; var Abort: boolean): string; const Data: PtrInt; var Abort: boolean): string;
var var

View File

@ -456,7 +456,7 @@ procedure FindNextEqualLine(
const Text1: string; const Start1: TLineExtends; const Text1: string; const Start1: TLineExtends;
const Text2: string; const Start2: TLineExtends; const Text2: string; const Start2: TLineExtends;
Flags: TTextDiffFlags; Flags: TTextDiffFlags;
var EqualLine1, EqualLine2: TLineExtends out EqualLine1, EqualLine2: TLineExtends
); );
var var
Max1, Max2, Cur1, Cur2: TLineExtends; Max1, Max2, Cur1, Cur2: TLineExtends;

View File

@ -3236,6 +3236,8 @@ begin
end; end;
if NewIndex < 0 then if NewIndex < 0 then
begin begin
Token:='';
Attri:=nil;
ColorPreview.GetHighlighterAttriAtRowCol(XY, Token, Attri); ColorPreview.GetHighlighterAttriAtRowCol(XY, Token, Attri);
if Attri = Nil then if Attri = Nil then
Attri := PreviewSyn.WhitespaceAttribute; Attri := PreviewSyn.WhitespaceAttribute;

View File

@ -667,7 +667,7 @@ function CheckExecutable(const OldFilename, NewFilename: string;
function CheckDirPathExists(const Dir, function CheckDirPathExists(const Dir,
ErrorCaption, ErrorMsg: string): TModalResult; ErrorCaption, ErrorMsg: string): TModalResult;
function SimpleDirectoryCheck(const OldDir, NewDir, function SimpleDirectoryCheck(const OldDir, NewDir,
NotFoundErrMsg: string; var StopChecking: boolean): boolean; NotFoundErrMsg: string; out StopChecking: boolean): boolean;
procedure SetComboBoxText(AComboBox:TComboBox; const AText:AnsiString); procedure SetComboBoxText(AComboBox:TComboBox; const AText:AnsiString);
procedure SetComboBoxText(AComboBox:TComboBox; const AText:AnsiString; procedure SetComboBoxText(AComboBox:TComboBox; const AText:AnsiString;
@ -749,7 +749,7 @@ begin
end; end;
function SimpleDirectoryCheck(const OldDir, NewDir, function SimpleDirectoryCheck(const OldDir, NewDir,
NotFoundErrMsg: string; var StopChecking: boolean): boolean; NotFoundErrMsg: string; out StopChecking: boolean): boolean;
var var
SubResult: TModalResult; SubResult: TModalResult;
begin begin

View File

@ -40,7 +40,7 @@ uses
MemCheck, MemCheck,
{$ENDIF} {$ENDIF}
Classes, SysUtils, Process, LCLType, LCLProc, Controls, Forms, Buttons, Classes, SysUtils, Process, LCLType, LCLProc, Controls, Forms, Buttons,
StdCtrls, ComCtrls, Dialogs, LResources, Laz_XMLCfg, AsyncProcess, StdCtrls, ComCtrls, Dialogs, LResources,
LazConfigStorage, FileUtil, LazConfigStorage, FileUtil,
IDEExternToolIntf, IDEImagesIntf, IDEExternToolIntf, IDEImagesIntf,
ExtToolEditDlg, IDECommands, KeyMapping, TransferMacros, IDEProcs, ExtToolEditDlg, IDECommands, KeyMapping, TransferMacros, IDEProcs,

View File

@ -43,9 +43,9 @@ uses
MemCheck, MemCheck,
{$ENDIF} {$ENDIF}
Classes, SysUtils, LCLType, Controls, Forms, Buttons, StdCtrls, ComCtrls, Classes, SysUtils, LCLType, Controls, Forms, Buttons, StdCtrls, ComCtrls,
Dialogs, LResources, LazConfigStorage, Laz_XMLCfg, Dialogs, LResources,
IDEExternToolIntf, IDEExternToolIntf,
KeyMapping, TransferMacros, IDEProcs, LazarusIDEStrConsts, ExtCtrls; KeyMapping, TransferMacros, LazarusIDEStrConsts, ExtCtrls;
type type
{ TExternalToolOptions } { TExternalToolOptions }

View File

@ -104,7 +104,7 @@ function FileIsTextCached(const AFilename: string): boolean;
// cmd line // cmd line
procedure SplitCmdLine(const CmdLine: string; procedure SplitCmdLine(const CmdLine: string;
var ProgramFilename, Params: string); out ProgramFilename, Params: string);
function PrepareCmdLineOption(const Option: string): string; function PrepareCmdLineOption(const Option: string): string;
function AddCmdLineParameter(const CmdLine, AddParameter: string): string; function AddCmdLineParameter(const CmdLine, AddParameter: string): string;
@ -1025,7 +1025,7 @@ begin
end; end;
procedure SplitCmdLine(const CmdLine: string; procedure SplitCmdLine(const CmdLine: string;
var ProgramFilename, Params: string); out ProgramFilename, Params: string);
var p, s, l: integer; var p, s, l: integer;
quote: char; quote: char;
begin begin

View File

@ -30,7 +30,7 @@ unit IDETranslations;
interface interface
uses uses
Classes, SysUtils, GetText, LCLProc, LCLStrConsts, Translations, Classes, SysUtils, GetText, LCLProc, Translations,
IDEProcs, FileUtil, IDEProcs, FileUtil,
avl_tree, LazarusIDEStrConsts; avl_tree, LazarusIDEStrConsts;
{ IDE Language (Human, not computer) } { IDE Language (Human, not computer) }
@ -193,7 +193,7 @@ var
s: string; s: string;
NextLineStartPos: integer; NextLineStartPos: integer;
procedure ReadLine(var Line: string); procedure ReadLine(out Line: string);
var var
p: LongInt; p: LongInt;
begin begin

View File

@ -177,14 +177,14 @@ function KeyAndShiftStateToEditorKeyString(const Key: TIDEShortCut): String;
function ShowKeyMappingEditForm(Index: integer; function ShowKeyMappingEditForm(Index: integer;
AKeyCommandRelationList: TKeyCommandRelationList): TModalResult; AKeyCommandRelationList: TKeyCommandRelationList): TModalResult;
function FindKeymapConflicts(Keymap: TKeyCommandRelationList; function FindKeymapConflicts(Keymap: TKeyCommandRelationList;
Protocol: TStrings; var Index1, Index2: integer): integer; Protocol: TStrings; out Index1, Index2: integer): integer;
function EditorCommandToDescriptionString(cmd: word): String; function EditorCommandToDescriptionString(cmd: word): String;
function EditorCommandLocalizedName(cmd: word; function EditorCommandLocalizedName(cmd: word;
const DefaultName: string): string; const DefaultName: string): string;
function EditorKeyStringToVKCode(const s: string): word; function EditorKeyStringToVKCode(const s: string): word;
procedure GetDefaultKeyForCommand(Command: word; procedure GetDefaultKeyForCommand(Command: word;
var TheKeyA, TheKeyB: TIDEShortCut); out TheKeyA, TheKeyB: TIDEShortCut);
procedure GetDefaultKeyForClassicScheme(Command: word; procedure GetDefaultKeyForClassicScheme(Command: word;
var TheKeyA, TheKeyB: TIDEShortCut); var TheKeyA, TheKeyB: TIDEShortCut);
procedure GetDefaultKeyForMacOSXScheme(Command: word; procedure GetDefaultKeyForMacOSXScheme(Command: word;
@ -242,7 +242,7 @@ begin
end; end;
procedure GetDefaultKeyForCommand(Command: word; procedure GetDefaultKeyForCommand(Command: word;
var TheKeyA, TheKeyB: TIDEShortCut); out TheKeyA, TheKeyB: TIDEShortCut);
procedure SetResult(NewKeyA: word; NewShiftA: TShiftState; procedure SetResult(NewKeyA: word; NewShiftA: TShiftState;
NewKeyB: word; NewShiftB: TShiftState); NewKeyB: word; NewShiftB: TShiftState);
@ -1545,7 +1545,7 @@ begin
end; end;
function FindKeymapConflicts(Keymap: TKeyCommandRelationList; function FindKeymapConflicts(Keymap: TKeyCommandRelationList;
Protocol: TStrings; var Index1,Index2:integer):integer; Protocol: TStrings; out Index1,Index2:integer):integer;
// 0 = ok, no errors // 0 = ok, no errors
// >0 number of errors found // >0 number of errors found
var var
@ -1592,6 +1592,8 @@ var
begin begin
Result:=0; Result:=0;
Index1:=0;
Index2:=0;
for a:=0 to Keymap.Count-1 do begin for a:=0 to Keymap.Count-1 do begin
Key1:=Keymap[a]; Key1:=Keymap[a];
for b:=a+1 to Keymap.Count-1 do begin for b:=a+1 to Keymap.Count-1 do begin

View File

@ -459,6 +459,9 @@ begin
end; end;
end; end;
// update all lrs files
MainBuildBoss.UpdateProjectAutomaticFiles;
WorkingDir:=Project1.ProjectDirectory; WorkingDir:=Project1.ProjectDirectory;
SrcFilename:=CreateRelativePath(Project1.MainUnitInfo.Filename,WorkingDir); SrcFilename:=CreateRelativePath(Project1.MainUnitInfo.Filename,WorkingDir);

View File

@ -646,7 +646,6 @@ type
procedure SaveSrcEditorProjectSpecificSettings(AnUnitInfo: TUnitInfo); procedure SaveSrcEditorProjectSpecificSettings(AnUnitInfo: TUnitInfo);
procedure SaveSourceEditorProjectSpecificSettings; procedure SaveSourceEditorProjectSpecificSettings;
function DoShowSaveProjectAsDialog: TModalResult; function DoShowSaveProjectAsDialog: TModalResult;
function DoUpdateLRSFromLFM(const LRSFilename: string): TModalResult;
// methods for open project, create project from source // methods for open project, create project from source
function DoCompleteLoadingProjectInfo: TModalResult; function DoCompleteLoadingProjectInfo: TModalResult;
@ -718,7 +717,6 @@ type
function DoRemoveFromProjectDialog: TModalResult; function DoRemoveFromProjectDialog: TModalResult;
function DoWarnAmbiguousFiles: TModalResult; function DoWarnAmbiguousFiles: TModalResult;
procedure DoUpdateProjectResourceInfo; procedure DoUpdateProjectResourceInfo;
function DoUpdateProjectAutomaticFiles: TModalResult;
function DoSaveForBuild: TModalResult; override; function DoSaveForBuild: TModalResult; override;
function DoCheckIfProjectNeedsCompilation(AProject: TProject; function DoCheckIfProjectNeedsCompilation(AProject: TProject;
const CompilerFilename, CompilerParams, SrcFilename: string; const CompilerFilename, CompilerParams, SrcFilename: string;
@ -5475,7 +5473,7 @@ begin
end; end;
NewComponent:=AnUnitInfo.Component; NewComponent:=AnUnitInfo.Component;
// create the designer // create the designer (if not already done)
if ([ofProjectLoading,ofLoadHiddenResource]*OpenFlags=[]) then if ([ofProjectLoading,ofLoadHiddenResource]*OpenFlags=[]) then
FormEditor1.ClearSelection; FormEditor1.ClearSelection;
FormEditor1.CreateComponentInterface(NewComponent,true); FormEditor1.CreateComponentInterface(NewComponent,true);
@ -6460,27 +6458,6 @@ begin
Result:=mrOk; Result:=mrOk;
end; end;
function TMainIDE.DoUpdateLRSFromLFM(const LRSFilename: string): TModalResult;
var
LFMFilename: String;
begin
Result:=mrOk;
// check if there is a .lrs file
if LRSFilename='' then exit;
if not FilenameIsAbsolute(LRSFilename) then exit;
LFMFilename:=ChangeFileExt(LRSFilename,'.lfm');
if LRSFilename=LFMFilename then exit;
// check if there is a .lfm file
if not FileExists(LFMFilename) then exit;
// check if .lrs file is newer than .lfm file
if FileExists(LRSFilename) and (FileAge(LFMFilename)<=FileAge(LRSFilename))
then exit;
debugln('TMainIDE.DoUpdateLRSFromLFM ',LRSFilename,' ',dbgs(FileAge(LFMFilename)),' ',dbgs(FileAge(LRSFilename)));
// the .lrs file does not exist, or is older than the .lfm file
// -> update .lrs file
Result:=ConvertLFMToLRSFileInteractive(LFMFilename,LRSFilename);
end;
function TMainIDE.DoCompleteLoadingProjectInfo: TModalResult; function TMainIDE.DoCompleteLoadingProjectInfo: TModalResult;
begin begin
UpdateCaption; UpdateCaption;
@ -8012,7 +7989,7 @@ begin
end; end;
// update all lrs files // update all lrs files
DoUpdateProjectAutomaticFiles; MainBuildBoss.UpdateProjectAutomaticFiles;
// everything went well => clear all modified flags // everything went well => clear all modified flags
Project1.ClearModifieds(true); Project1.ClearModifieds(true);
@ -8595,21 +8572,6 @@ begin
end; end;
end; end;
function TMainIDE.DoUpdateProjectAutomaticFiles: TModalResult;
var
AnUnitInfo: TUnitInfo;
begin
AnUnitInfo:=Project1.FirstPartOfProject;
while AnUnitInfo<>nil do begin
if AnUnitInfo.HasResources then begin
Result:=DoUpdateLRSFromLFM(AnUnitInfo.ResourceFileName);
if Result=mrIgnore then Result:=mrOk;
if Result<>mrOk then exit;
end;
AnUnitInfo:=AnUnitInfo.NextPartOfProject;
end;
end;
function TMainIDE.DoSaveForBuild: TModalResult; function TMainIDE.DoSaveForBuild: TModalResult;
begin begin
Result:=mrCancel; Result:=mrCancel;

View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LCLProc, BuildLazDialog, CodeToolsStructs, TextTools, Classes, SysUtils, LCLProc, BuildLazDialog, CodeToolsStructs, TextTools,
Laz_XMLCfg, LazConf, LazarusIDEStrConsts, Laz_XMLCfg, LazConf,
IDEProcs; IDEProcs;
type type

View File

@ -27,7 +27,7 @@ unit OutputFilter;
interface interface
uses uses
Classes, Math, SysUtils, Forms, Controls, CompilerOptions, Project, Process, Classes, Math, SysUtils, Forms, Controls, CompilerOptions, Process,
AsyncProcess, LCLProc, DynQueue, FileUtil, AsyncProcess, LCLProc, DynQueue, FileUtil,
IDEMsgIntf, IDEExternToolIntf, IDEMsgIntf, IDEExternToolIntf,
IDEProcs, LazConf; IDEProcs, LazConf;

View File

@ -39,8 +39,7 @@ interface
uses uses
Classes, SysUtils, Laz_XMLCfg, Classes, SysUtils, Laz_XMLCfg,
Forms, SynRegExpr, FileUtil, LCLProc, Forms, SynRegExpr, FileUtil, LCLProc,
NewItemIntf, ProjectIntf, ProjectIntf, PublishModule;
LazarusIDEStrConsts, PublishModule;
type type
TOnLoadSaveFilename = procedure(var Filename:string; Load:boolean) of object; TOnLoadSaveFilename = procedure(var Filename:string; Load:boolean) of object;

View File

@ -35,7 +35,7 @@ interface
uses uses
Classes, SysUtils, Process, LCLProc, Controls, Forms, Classes, SysUtils, Process, LCLProc, Controls, Forms,
CodeToolManager, CodeCache, CodeAtom, LazConf, SourceChanger, LResources; CodeToolManager, CodeCache, CodeAtom, LazConf, LResources;
type type
{ TProjectXPManifest } { TProjectXPManifest }

View File

@ -325,7 +325,7 @@ end;
procedure TPackageLinks.UpdateGlobalLinks; procedure TPackageLinks.UpdateGlobalLinks;
function ParseFilename(const Filename: string; function ParseFilename(const Filename: string;
var PkgName: string; var PkgVersion: TPkgVersion): boolean; out PkgName: string; PkgVersion: TPkgVersion): boolean;
// checks if filename has the form // checks if filename has the form
// <identifier>-<version>.lpl // <identifier>-<version>.lpl
var var
@ -335,6 +335,7 @@ procedure TPackageLinks.UpdateGlobalLinks;
ints: array[1..4] of integer; ints: array[1..4] of integer;
begin begin
Result:=false; Result:=false;
PkgName:='';
if CompareFileExt(Filename,'.lpl',false)<>0 then exit; if CompareFileExt(Filename,'.lpl',false)<>0 then exit;
StartPos:=1; StartPos:=1;
// parse identifier // parse identifier

View File

@ -2160,6 +2160,7 @@ function TLazPackageGraph.FindFPCConflictUnit(APackage: TLazPackage;
begin begin
Result:=false; Result:=false;
if AnUnitName='' then exit; if AnUnitName='' then exit;
Filename:='';
OnFindFPCUnit(AnUnitName,Directory,Filename); OnFindFPCUnit(AnUnitName,Directory,Filename);
Result:=Filename<>''; Result:=Filename<>'';
end; end;
@ -3219,7 +3220,7 @@ end;
procedure TLazPackageGraph.CalculateTopologicalLevels; procedure TLazPackageGraph.CalculateTopologicalLevels;
procedure GetTopologicalOrder(CurDependency: TPkgDependency; procedure GetTopologicalOrder(CurDependency: TPkgDependency;
var MaxChildLevel: integer); out MaxChildLevel: integer);
var var
RequiredPackage: TLazPackage; RequiredPackage: TLazPackage;
CurMaxChildLevel: integer; CurMaxChildLevel: integer;
@ -3317,7 +3318,6 @@ begin
CurLvl:=Dependency.RequiredPackage.TopologicalLevel CurLvl:=Dependency.RequiredPackage.TopologicalLevel
else else
CurLvl:=0; CurLvl:=0;
//debugln('BBB1 BucketStarts[',dbgs(CurLvl),']=',dbgs(BucketStarts[CurLvl]),' ',Dependency.AsString);
if Dependencies[BucketStarts[CurLvl]]<>nil then if Dependencies[BucketStarts[CurLvl]]<>nil then
RaiseException(''); RaiseException('');
Dependencies[BucketStarts[CurLvl]]:=Dependency; Dependencies[BucketStarts[CurLvl]]:=Dependency;

View File

@ -45,7 +45,7 @@ uses
SynHighlighterLFM, SynHighlighterMulti, SynHighlighterUNIXShellScript, SynHighlighterLFM, SynHighlighterMulti, SynHighlighterUNIXShellScript,
SynHighlighterCss, SynHighlighterPHP, SynHighlighterTeX, SynHighlighterCss, SynHighlighterPHP, SynHighlighterTeX,
SynHighlighterSQL, SynHighlighterPython, SynHighlighterVB, SynHighlighterAny, SynHighlighterSQL, SynHighlighterPython, SynHighlighterVB, SynHighlighterAny,
LazarusPackageIntf, LazarusIDEStrConsts; LazarusPackageIntf;
procedure Register; procedure Register;