mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-07 01:06:02 +02:00
added TLazProject.ProjectInfoFile, fixed saving editor files if deleted
git-svn-id: trunk@7204 -
This commit is contained in:
parent
31d368a4d8
commit
dc21f3484c
@ -32,7 +32,7 @@ unit FPCUnitLazIDEIntf;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazIDEIntf, ProjectIntf, testcaseopts;
|
||||
Classes, SysUtils, LazIDEIntf, ProjectIntf, Controls, Forms,testcaseopts;
|
||||
|
||||
type
|
||||
{ TFPCUnitApplicationDescriptor }
|
||||
@ -42,8 +42,8 @@ type
|
||||
constructor Create; override;
|
||||
function GetLocalizedName: string; override;
|
||||
function GetLocalizedDescription: string; override;
|
||||
procedure InitProject(AProject: TLazProject); override;
|
||||
procedure CreateStartFiles(AProject: TLazProject); override;
|
||||
Function InitProject(AProject: TLazProject) : TModalResult; override;
|
||||
Function CreateStartFiles(AProject: TLazProject): TModalResult; override;
|
||||
end;
|
||||
|
||||
{ TFileDescPascalUnitFPCUnitTestCase }
|
||||
@ -109,7 +109,7 @@ begin
|
||||
+'automatically maintained by Lazarus.';
|
||||
end;
|
||||
|
||||
procedure TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject);
|
||||
Function TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject) : TModalResult;
|
||||
var
|
||||
le: string;
|
||||
NewSource: String;
|
||||
@ -146,12 +146,14 @@ begin
|
||||
|
||||
// compiler options
|
||||
AProject.LazCompilerOptions.UseLineInfoUnit:=true;
|
||||
Result:=mrOK;
|
||||
end;
|
||||
|
||||
procedure TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject);
|
||||
Function TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject) :TModalResult;
|
||||
begin
|
||||
LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
|
||||
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
|
||||
Result:=mrOK;
|
||||
end;
|
||||
|
||||
{ TFileDescPascalUnitFPCUnitTestCase }
|
||||
|
13
ide/main.pp
13
ide/main.pp
@ -859,12 +859,12 @@ begin
|
||||
writeln(PrimaryConfPathOptLong,' <path>');
|
||||
writeln('or ',PrimaryConfPathOptShort,' <path>');
|
||||
writeln(BreakString(lisprimaryConfigDirectoryWhereLazarusStoresItsConfig,
|
||||
75, 22), GetPrimaryConfigPath);
|
||||
75, 22), LazConf.GetPrimaryConfigPath);
|
||||
writeln('');
|
||||
writeln(SecondaryConfPathOptLong,' <path>');
|
||||
writeln('or ',SecondaryConfPathOptShort,' <path>');
|
||||
writeln(BreakString(lissecondaryConfigDirectoryWhereLazarusSearchesFor,
|
||||
75, 22), GetSecondaryConfigPath);
|
||||
75, 22), LazConf.GetSecondaryConfigPath);
|
||||
writeln('');
|
||||
writeln(DebugLogOpt,' <file>');
|
||||
writeln(BreakString(lisFileWhereDebugOutputIsWritten, 75, 22));
|
||||
@ -4896,6 +4896,7 @@ begin
|
||||
end;
|
||||
|
||||
// if nothing modified then a simple Save can be skipped
|
||||
//writeln('TMainIDE.DoSaveEditorFile A ',ActiveUnitInfo.Filename,' ',ActiveUnitInfo.NeedsSaveToDisk);
|
||||
if ([sfSaveToTestDir,sfSaveAs]*Flags=[])
|
||||
and (not ActiveUnitInfo.NeedsSaveToDisk) then begin
|
||||
Result:=mrOk;
|
||||
@ -4922,7 +4923,7 @@ begin
|
||||
|
||||
// save source
|
||||
if not (sfSaveToTestDir in Flags) then begin
|
||||
if ActiveUnitInfo.Modified then begin
|
||||
if ActiveUnitInfo.Modified or ActiveUnitInfo.NeedsSaveToDisk then begin
|
||||
// save source to file
|
||||
Result:=ActiveUnitInfo.WriteUnitSource;
|
||||
if Result=mrAbort then exit;
|
||||
@ -5712,8 +5713,9 @@ begin
|
||||
SaveSourceEditorChangesToCodeCache(-1);
|
||||
SkipSavingMainSource:=false;
|
||||
|
||||
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.DoSaveProject A SaveAs=',sfSaveAs in Flags,' SaveToTestDir=',sfSaveToTestDir in Flags);
|
||||
writeln('TMainIDE.DoSaveProject A SaveAs=',sfSaveAs in Flags,' SaveToTestDir=',sfSaveToTestDir in Flags,' ProjectInfoFile=',Project1.ProjectInfoFile);
|
||||
{$ENDIF}
|
||||
|
||||
// check that all new units are saved first to get valid filenames
|
||||
@ -11559,6 +11561,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.867 2005/05/26 20:17:49 mattias
|
||||
added TLazProject.ProjectInfoFile, fixed saving editor files if deleted
|
||||
|
||||
Revision 1.866 2005/05/26 15:54:02 mattias
|
||||
changed OI SHow Hints option to resource string, added TProjectDescriptor.DoInitDescriptor
|
||||
|
||||
|
@ -229,6 +229,10 @@ type
|
||||
|
||||
procedure FindInFilesPerDialog(AProject: TProject); virtual; abstract;
|
||||
procedure FindInFiles(AProject: TProject; const FindText: string); virtual; abstract;
|
||||
|
||||
function GetPrimaryConfigPath: String; override;
|
||||
function GetSecondaryConfigPath: String; override;
|
||||
procedure CopySecondaryConfigFile(const AFilename: String); override;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -383,6 +387,21 @@ begin
|
||||
MainIDEInterface:=nil;
|
||||
end;
|
||||
|
||||
function TMainIDEInterface.GetPrimaryConfigPath: String;
|
||||
begin
|
||||
Result:=LazConf.GetPrimaryConfigPath;
|
||||
end;
|
||||
|
||||
function TMainIDEInterface.GetSecondaryConfigPath: String;
|
||||
begin
|
||||
Result:=LazConf.GetSecondaryConfigPath;
|
||||
end;
|
||||
|
||||
procedure TMainIDEInterface.CopySecondaryConfigFile(const AFilename: String);
|
||||
begin
|
||||
LazConf.CopySecondaryConfigFile(AFilename);
|
||||
end;
|
||||
|
||||
{ TFileDescPascalUnitWithForm }
|
||||
|
||||
constructor TFileDescPascalUnitWithForm.Create;
|
||||
|
@ -399,7 +399,6 @@ type
|
||||
function GetFirstUnitWithEditorIndex: TUnitInfo;
|
||||
function GetMainFilename: String;
|
||||
function GetMainUnitInfo: TUnitInfo;
|
||||
function GetProjectInfoFile: string;
|
||||
function GetTargetFilename: string;
|
||||
function GetUnits(Index: integer): TUnitInfo;
|
||||
function JumpHistoryCheckPosition(
|
||||
@ -413,7 +412,6 @@ type
|
||||
procedure SetAutoOpenDesignerFormsDisabled(const AValue: boolean);
|
||||
procedure SetCompilerOptions(const AValue: TProjectCompilerOptions);
|
||||
procedure SetModified(const AValue: boolean);
|
||||
procedure SetProjectInfoFile(const NewFilename: string);
|
||||
procedure SetTargetFilename(const NewTargetFilename: string);
|
||||
procedure SetUnits(Index:integer; AUnitInfo: TUnitInfo);
|
||||
procedure SetMainUnitID(const AValue: Integer);
|
||||
@ -425,6 +423,8 @@ type
|
||||
function GetFiles(Index: integer): TLazProjectFile; override;
|
||||
procedure SetFiles(Index: integer; const AValue: TLazProjectFile); override;
|
||||
procedure SetFlags(const AValue: TProjectFlags); override;
|
||||
function GetProjectInfoFile: string; override;
|
||||
procedure SetProjectInfoFile(const NewFilename: string); override;
|
||||
protected
|
||||
// special unit lists
|
||||
procedure AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList);
|
||||
@ -1796,7 +1796,7 @@ function TProject.NewUniqueUnitName(const AnUnitName: string):string;
|
||||
begin
|
||||
Result:=true;
|
||||
ExpName:=ExpandedUnitName(AnUnitName);
|
||||
if ExtractFileNameOnly(fProjectInfoFile)=Expname then exit;
|
||||
if ExtractFileNameOnly(fProjectInfoFile)=ExpName then exit;
|
||||
for i:=0 to UnitCount-1 do
|
||||
if (Units[i].IsPartOfProject)
|
||||
and (ExpandedUnitName(Units[i].FileName)=ExpName) then
|
||||
@ -2034,7 +2034,8 @@ end;
|
||||
|
||||
function TProject.IsVirtual: boolean;
|
||||
begin
|
||||
Result:=(MainUnitID>=0) and MainUnitInfo.IsVirtual;
|
||||
Result:=((MainUnitID>=0) and MainUnitInfo.IsVirtual)
|
||||
or (ProjectInfoFile='') or (not FilenameIsAbsolute(ProjectInfoFile));
|
||||
end;
|
||||
|
||||
function TProject.IndexOf(AUnitInfo: TUnitInfo):integer;
|
||||
@ -2240,6 +2241,7 @@ procedure TProject.SetProjectInfoFile(const NewFilename:string);
|
||||
var
|
||||
NewProjectInfoFile: String;
|
||||
OldProjectInfoFile: String;
|
||||
DefaultTitle: String;
|
||||
begin
|
||||
NewProjectInfoFile:=TrimFilename(NewFilename);
|
||||
if NewProjectInfoFile='' then exit;
|
||||
@ -2247,9 +2249,10 @@ begin
|
||||
if fProjectInfoFile=NewProjectInfoFile then exit;
|
||||
OldProjectInfoFile:=fProjectInfoFile;
|
||||
fProjectInfoFile:=NewProjectInfoFile;
|
||||
if (AnsiCompareText(Title,ExtractFileNameOnly(OldProjectInfoFile))=0)
|
||||
DefaultTitle:=ExtractFileNameOnly(OldProjectInfoFile);
|
||||
if (CompareText(Title,DefaultTitle)=0)
|
||||
or (OldProjectInfoFile='') or (Title='') then begin
|
||||
Title:=ExtractFileNameOnly(NewProjectInfoFile);
|
||||
Title:=DefaultTitle;
|
||||
end;
|
||||
UpdateProjectDirectory;
|
||||
Modified:=true;
|
||||
@ -3172,6 +3175,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.184 2005/05/26 20:17:49 mattias
|
||||
added TLazProject.ProjectInfoFile, fixed saving editor files if deleted
|
||||
|
||||
Revision 1.183 2005/05/26 15:54:02 mattias
|
||||
changed OI SHow Hints option to resource string, added TProjectDescriptor.DoInitDescriptor
|
||||
|
||||
|
@ -73,8 +73,12 @@ type
|
||||
Flags: TOpenFlags): TModalResult; virtual; abstract;
|
||||
function DoOpenFileAndJumpToIdentifier(const AFilename, AnIdentifier: string;
|
||||
PageIndex: integer; Flags: TOpenFlags): TModalResult; virtual; abstract;
|
||||
function GetPrimaryConfigPath: String; virtual; abstract;
|
||||
function GetSecondaryConfigPath: String; virtual; abstract;
|
||||
procedure CopySecondaryConfigFile(const AFilename: String); virtual; abstract;
|
||||
public
|
||||
property ActiveProject: TLazProject read GetActiveProject;
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
|
@ -430,14 +430,12 @@ type
|
||||
private
|
||||
FDefaultExt: string;
|
||||
FFlags: TProjectFlags;
|
||||
FInitialized: boolean;
|
||||
FName: string;
|
||||
FReferenceCount: integer;
|
||||
FVisibleInNewDialog: boolean;
|
||||
protected
|
||||
procedure SetName(const AValue: string); virtual;
|
||||
procedure SetFlags(const AValue: TProjectFlags); virtual;
|
||||
procedure SetInitialized;
|
||||
function DoInitDescriptor: TModalResult; virtual;// put here option dialogs
|
||||
public
|
||||
constructor Create; virtual;
|
||||
@ -453,7 +451,6 @@ type
|
||||
property VisibleInNewDialog: boolean read FVisibleInNewDialog write FVisibleInNewDialog;
|
||||
property Flags: TProjectFlags read FFlags write SetFlags;
|
||||
property DefaultExt: string read FDefaultExt write FDefaultExt;
|
||||
property Initialized: boolean read FInitialized;
|
||||
end;
|
||||
TProjectDescriptorClass = class of TProjectDescriptor;
|
||||
|
||||
@ -488,6 +485,8 @@ type
|
||||
procedure SetFiles(Index: integer; const AValue: TLazProjectFile); virtual; abstract;
|
||||
procedure SetTitle(const AValue: String); virtual;
|
||||
procedure SetFlags(const AValue: TProjectFlags); virtual;
|
||||
function GetProjectInfoFile: string; virtual; abstract;
|
||||
procedure SetProjectInfoFile(const NewFilename: string); virtual; abstract;
|
||||
public
|
||||
constructor Create(ProjectDescription: TProjectDescriptor); virtual;
|
||||
function CreateProjectFile(const Filename: string
|
||||
@ -507,6 +506,8 @@ type
|
||||
property Flags: TProjectFlags read FFlags write SetFlags;
|
||||
property LazCompilerOptions: TLazCompilerOptions read FLazCompilerOptions
|
||||
write SetLazCompilerOptions;
|
||||
property ProjectInfoFile: string
|
||||
read GetProjectInfoFile write SetProjectInfoFile;
|
||||
end;
|
||||
TLazProjectClass = class of TLazProject;
|
||||
|
||||
@ -841,11 +842,6 @@ begin
|
||||
FFlags:=AValue;
|
||||
end;
|
||||
|
||||
procedure TProjectDescriptor.SetInitialized;
|
||||
begin
|
||||
FInitialized:=true;
|
||||
end;
|
||||
|
||||
function TProjectDescriptor.DoInitDescriptor: TModalResult;
|
||||
begin
|
||||
Result:=mrOk;
|
||||
@ -891,11 +887,7 @@ end;
|
||||
|
||||
function TProjectDescriptor.InitDescriptor: TModalResult;
|
||||
begin
|
||||
if not Initialized then begin
|
||||
Result:=DoInitDescriptor;
|
||||
SetInitialized;
|
||||
end else
|
||||
Result:=mrOk;
|
||||
Result:=DoInitDescriptor;
|
||||
end;
|
||||
|
||||
function TProjectDescriptor.InitProject(AProject: TLazProject): TModalResult;
|
||||
|
Loading…
Reference in New Issue
Block a user