mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-28 21:20:46 +02:00
MG: added rapid testing project
git-svn-id: trunk@318 -
This commit is contained in:
lazarus
parent
2e508d37c4
commit
2d5915e5e0
@ -45,7 +45,8 @@ type
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Compile(AProject: TProject): TModalResult;
|
||||
function Compile(AProject: TProject;
|
||||
const DefaultFilename: string): TModalResult;
|
||||
function GetSourcePosition(const Line: string; var Filename:string;
|
||||
var CaretXY: TPoint; var MsgType: TErrorType): boolean;
|
||||
property OnOutputString : TOnOutputString
|
||||
@ -106,7 +107,8 @@ end;
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TCompiler Compile }
|
||||
{------------------------------------------------------------------------------}
|
||||
function TCompiler.Compile(AProject: TProject): TModalResult;
|
||||
function TCompiler.Compile(AProject: TProject;
|
||||
const DefaultFilename: string): TModalResult;
|
||||
const
|
||||
BufSize = 1024;
|
||||
var
|
||||
@ -114,7 +116,7 @@ var
|
||||
I, Count, LineStart : longint;
|
||||
OutputLine, Buf : String;
|
||||
WriteMessage, ABort : Boolean;
|
||||
OldCurDir, ProjectDir: string;
|
||||
OldCurDir, ProjectDir, ProjectFilename: string;
|
||||
TheProcess : TProcess;
|
||||
|
||||
procedure ProcessOutputLine;
|
||||
@ -152,7 +154,9 @@ begin
|
||||
Result:=mrCancel;
|
||||
if AProject.MainUnit<0 then exit;
|
||||
OldCurDir:=GetCurrentDir;
|
||||
ProjectDir:=ExtractFilePath(AProject.ProjectFile);
|
||||
ProjectFilename:=AProject.Units[AProject.MainUnit].Filename;
|
||||
if ProjectFilename='' then ProjectFilename:=DefaultFilename;
|
||||
ProjectDir:=ExtractFilePath(ProjectFilename);
|
||||
if not SetCurrentDir(ProjectDir) then exit;
|
||||
try
|
||||
FOutputList.Clear;
|
||||
@ -188,7 +192,7 @@ begin
|
||||
end;
|
||||
{$ENDIF linux}
|
||||
CmdLine := CmdLine + ' '+ AProject.CompilerOptions.MakeOptionsString;
|
||||
CmdLine := CmdLine + ' '+ AProject.Units[AProject.MainUnit].Filename;
|
||||
CmdLine := CmdLine + ' '+ ProjectFilename;
|
||||
if Assigned(FOnCmdLineCreate) then begin
|
||||
Abort:=false;
|
||||
FOnCmdLineCreate(CmdLine,Abort);
|
||||
@ -257,10 +261,17 @@ function TCompiler.GetSourcePosition(const Line: string; var Filename:string;
|
||||
{ This assumes the line has one of the following formats
|
||||
<filename>(123,45) <ErrorType>: <some text>
|
||||
<filename>(456) <ErrorType>: <some text> in line (123)
|
||||
Fatal: <some text>
|
||||
}
|
||||
var StartPos, EndPos: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if copy(Line,1,7)='Fatal: ' then begin
|
||||
Result:=true;
|
||||
Filename:='';
|
||||
MsgType:=etFatal;
|
||||
exit;
|
||||
end;
|
||||
StartPos:=1;
|
||||
// find filename
|
||||
EndPos:=StartPos;
|
||||
@ -311,6 +322,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2001/07/08 22:33:56 lazarus
|
||||
MG: added rapid testing project
|
||||
|
||||
Revision 1.13 2001/05/29 08:16:26 lazarus
|
||||
MG: bugfixes + starting programs
|
||||
|
||||
|
||||
@ -74,6 +74,7 @@ type
|
||||
FLazarusDirectory: string;
|
||||
FCompilerFilename: string;
|
||||
FFPCSourceDirectory: string;
|
||||
FTestBuildDirectory: string;
|
||||
|
||||
// recent files and directories
|
||||
FRecentOpenFiles: TStringList;
|
||||
@ -141,6 +142,8 @@ type
|
||||
read FCompilerFilename write FCompilerFilename;
|
||||
property FPCSourceDirectory: string
|
||||
read FFPCSourceDirectory write FFPCSourceDirectory;
|
||||
property TestBuildDirectory: string
|
||||
read FTestBuildDirectory write FTestBuildDirectory;
|
||||
|
||||
// recent files and directories
|
||||
property RecentOpenFiles: TStringList
|
||||
@ -251,6 +254,8 @@ type
|
||||
CompilerPathComboBox: TComboBox;
|
||||
FPCSourceDirLabel: TLabel;
|
||||
FPCSourceDirComboBox: TComboBox;
|
||||
TestBuildDirLabel: TLabel;
|
||||
TestBuildDirComboBox: TComboBox;
|
||||
|
||||
// buttons at bottom
|
||||
OkButton: TButton;
|
||||
@ -321,9 +326,10 @@ begin
|
||||
FObjectInspectorOptions:=TOIOptions.Create;
|
||||
|
||||
// files
|
||||
FLazarusDirectory:='';
|
||||
FLazarusDirectory:=ExtractFilePath(ParamStr(0));
|
||||
FCompilerFilename:='';
|
||||
FFPCSourceDirectory:='';
|
||||
FTestBuildDirectory:={$ifdef win32}'c:/temp'{$else}'/tmp'{$endif};
|
||||
|
||||
// recent files and directories
|
||||
FRecentOpenFiles:=TStringList.Create;
|
||||
@ -481,6 +487,8 @@ begin
|
||||
'EnvironmentOptions/CompilerFilename/Value',FCompilerFilename);
|
||||
FFPCSourceDirectory:=XMLConfig.GetValue(
|
||||
'EnvironmentOptions/FPCSourceDirectory/Value',FFPCSourceDirectory);
|
||||
FTestBuildDirectory:=XMLConfig.GetValue(
|
||||
'EnvironmentOptions/TestBuildDirectory/Value',FTestBuildDirectory);
|
||||
|
||||
// backup
|
||||
LoadBackupInfo(FBackupInfoProjectFiles
|
||||
@ -602,6 +610,8 @@ begin
|
||||
'EnvironmentOptions/CompilerFilename/Value',FCompilerFilename);
|
||||
XMLConfig.SetValue(
|
||||
'EnvironmentOptions/FPCSourceDirectory/Value',FFPCSourceDirectory);
|
||||
XMLConfig.SetValue(
|
||||
'EnvironmentOptions/TestBuildDirectory/Value',FTestBuildDirectory);
|
||||
|
||||
// backup
|
||||
SaveBackupInfo(FBackupInfoProjectFiles
|
||||
@ -1485,6 +1495,37 @@ begin
|
||||
end;
|
||||
Show;
|
||||
end;
|
||||
|
||||
TestBuildDirLabel:=TLabel.Create(Self);
|
||||
with TestBuildDirLabel do begin
|
||||
Name:='TestBuildDirLabel';
|
||||
Parent:=NoteBook.Page[1];
|
||||
Left:=LazarusDirLabel.Left;
|
||||
Top:=FPCSourceDirComboBox.Top+FPCSourceDirComboBox.Height;
|
||||
Width:=LazarusDirLabel.Width;
|
||||
Height:=23;
|
||||
Caption:='Directory for building test projects';
|
||||
Show;
|
||||
end;
|
||||
|
||||
TestBuildDirComboBox:=TComboBox.Create(Self);
|
||||
with TestBuildDirComboBox do begin
|
||||
Name:='TestBuildDirComboBox';
|
||||
Parent:=NoteBook.Page[1];
|
||||
Left:=LazarusDirLabel.Left;
|
||||
Top:=TestBuildDirLabel.Top+TestBuildDirLabel.Height+2;
|
||||
Width:=LazarusDirLabel.Width;
|
||||
Height:=25;
|
||||
with Items do begin
|
||||
BeginUpdate;
|
||||
Add('/tmp');
|
||||
Add('/var/tmp');
|
||||
Add('c:/tmp');
|
||||
Add('c:/windows/temp');
|
||||
EndUpdate;
|
||||
end;
|
||||
Show;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEnvironmentOptionsDialog.BakTypeRadioGroupClick(Sender: TObject);
|
||||
@ -1609,6 +1650,7 @@ begin
|
||||
SetComboBoxText(LazarusDirComboBox,LazarusDirectory);
|
||||
SetComboBoxText(CompilerPathComboBox,CompilerFilename);
|
||||
SetComboBoxText(FPCSourceDirComboBox,FPCSourceDirectory);
|
||||
SetComboBoxText(TestBuildDirComboBox,TestBuildDirectory);
|
||||
|
||||
// recent files and directories
|
||||
SetComboBoxText(MaxRecentOpenFilesComboBox,IntToStr(MaxRecentOpenFiles));
|
||||
@ -1689,6 +1731,7 @@ begin
|
||||
LazarusDirectory:=LazarusDirComboBox.Text;
|
||||
CompilerFilename:=CompilerPathComboBox.Text;
|
||||
FPCSourceDirectory:=FPCSourceDirComboBox.Text;
|
||||
TestBuildDirectory:=TestBuildDirComboBox.Text;
|
||||
|
||||
// recent files and directories
|
||||
MaxRecentOpenFiles:=StrToIntDef(
|
||||
|
||||
205
ide/main.pp
205
ide/main.pp
@ -216,7 +216,8 @@ type
|
||||
|
||||
// files/units
|
||||
function DoNewEditorUnit(NewUnitType:TNewUnitType):TModalResult;
|
||||
function DoSaveEditorUnit(PageIndex:integer; SaveAs:boolean):TModalResult;
|
||||
function DoSaveEditorUnit(PageIndex:integer;
|
||||
SaveAs, SaveToTestDir:boolean):TModalResult;
|
||||
function DoCloseEditorUnit(PageIndex:integer;
|
||||
SaveFirst: boolean):TModalResult;
|
||||
function DoOpenEditorFile(AFileName:string;
|
||||
@ -229,7 +230,7 @@ type
|
||||
// project(s)
|
||||
property Project: TProject read fProject write fProject;
|
||||
function DoNewProject(NewProjectType:TProjectType):TModalResult;
|
||||
function DoSaveProject(SaveAs:boolean):TModalResult;
|
||||
function DoSaveProject(SaveAs,SaveToTestDir:boolean):TModalResult;
|
||||
function DoCloseProject:TModalResult;
|
||||
function DoOpenProjectFile(AFileName:string):TModalResult;
|
||||
function DoAddActiveUnitToProject: TModalResult;
|
||||
@ -239,8 +240,9 @@ type
|
||||
function SomethingOfProjectIsModified: boolean;
|
||||
function DoCreateProjectForProgram(ProgramFilename,
|
||||
ProgramSource: string): TModalResult;
|
||||
function DoSaveProjectToTestDirectory: TModalResult;
|
||||
|
||||
// helpful methods
|
||||
// useful methods
|
||||
procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
|
||||
var ActiveUnitInfo:TUnitInfo);
|
||||
procedure GetUnitWithPageIndex(PageIndex:integer;
|
||||
@ -260,6 +262,7 @@ type
|
||||
function DoJumpToCompilerMessage(Index:integer;
|
||||
FocusEditor: boolean): boolean;
|
||||
procedure DoShowMessagesView;
|
||||
function GetTestProjectFilename: string;
|
||||
|
||||
procedure LoadMainMenu;
|
||||
procedure LoadSpeedbuttons;
|
||||
@ -619,7 +622,7 @@ writeln('[TMainIDE.FormCloseQuery]');
|
||||
if SomethingOfProjectIsModified then begin
|
||||
if Application.MessageBox('Save changes to project?','Project changed',
|
||||
MB_OKCANCEL)=mrOk then begin
|
||||
CanClose:=DoSaveProject(false)<>mrAbort;
|
||||
CanClose:=DoSaveProject(false,false)<>mrAbort;
|
||||
if CanClose=false then exit;
|
||||
end;
|
||||
end;
|
||||
@ -1219,13 +1222,13 @@ end;
|
||||
procedure TMainIDE.mnuSaveClicked(Sender : TObject);
|
||||
begin
|
||||
if SourceNoteBook.NoteBook=nil then exit;
|
||||
DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,false);
|
||||
DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,false,false);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuSaveAsClicked(Sender : TObject);
|
||||
begin
|
||||
if SourceNoteBook.NoteBook=nil then exit;
|
||||
DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,true);
|
||||
DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,true,false);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuSaveAllClicked(Sender : TObject);
|
||||
@ -1475,12 +1478,12 @@ end;
|
||||
|
||||
Procedure TMainIDE.mnuSaveProjectClicked(Sender : TObject);
|
||||
Begin
|
||||
DoSaveProject(false);
|
||||
DoSaveProject(false,false);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuSaveProjectAsClicked(Sender : TObject);
|
||||
begin
|
||||
DoSaveProject(true);
|
||||
DoSaveProject(true,false);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.mnuAddToProjectClicked(Sender : TObject);
|
||||
@ -1691,7 +1694,7 @@ writeln('TMainIDE.DoNewUnit end');
|
||||
end;
|
||||
|
||||
function TMainIDE.DoSaveEditorUnit(PageIndex:integer;
|
||||
SaveAs:boolean):TModalResult;
|
||||
SaveAs, SaveToTestDir:boolean):TModalResult;
|
||||
var ActiveSrcEdit:TSourceEditor;
|
||||
ActiveUnitInfo:TUnitInfo;
|
||||
SaveDialog:TSaveDialog;
|
||||
@ -1700,7 +1703,7 @@ var ActiveSrcEdit:TSourceEditor;
|
||||
MemStream,BinCompStream,TxtCompStream:TMemoryStream;
|
||||
Driver: TAbstractObjectWriter;
|
||||
Writer:TWriter;
|
||||
AText,ACaption,CompResourceCode,s: string;
|
||||
AText,ACaption,CompResourceCode,s,TestFilename: string;
|
||||
ResourceCode: TSourceLog;
|
||||
FileStream:TFileStream;
|
||||
begin
|
||||
@ -1712,14 +1715,15 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
end;
|
||||
GetUnitWithPageIndex(PageIndex,ActiveSrcEdit,ActiveUnitInfo);
|
||||
if ActiveUnitInfo=nil then exit;
|
||||
if (Project.MainUnit>=0) and (Project.Units[Project.MainUnit]=ActiveUnitInfo)
|
||||
if (not SaveToTestDir) and (Project.MainUnit>=0)
|
||||
and (Project.Units[Project.MainUnit]=ActiveUnitInfo)
|
||||
and (ActiveUnitInfo.Filename='') then begin
|
||||
Result:=DoSaveProject(false);
|
||||
Result:=DoSaveProject(false,SaveToTestDir);
|
||||
exit;
|
||||
end;
|
||||
|
||||
ActiveUnitInfo.ReadOnly:=ActiveSrcEdit.ReadOnly;
|
||||
if ActiveUnitInfo.ReadOnly then begin
|
||||
if (ActiveUnitInfo.ReadOnly) and (not SaveToTestDir) then begin
|
||||
Result:=mrOk;
|
||||
exit;
|
||||
end;
|
||||
@ -1757,7 +1761,7 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
|
||||
SaveAllParts:=false;
|
||||
if ActiveUnitInfo.Filename='' then SaveAs:=true;
|
||||
if SaveAs then begin
|
||||
if SaveAs and (not SaveToTestDir) then begin
|
||||
// let user choose a filename
|
||||
SaveDialog:=TSaveDialog.Create(Application);
|
||||
try
|
||||
@ -1804,16 +1808,47 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
SaveDialog.Free;
|
||||
end;
|
||||
end;
|
||||
if ActiveUnitInfo.Modified or SaveAllParts then begin
|
||||
// save source
|
||||
Result:=ActiveUnitInfo.WriteUnitSource;
|
||||
if Result=mrAbort then exit;
|
||||
TestFilename:='';
|
||||
if not SaveToTestDir then begin
|
||||
if ActiveUnitInfo.Modified or SaveAllParts then begin
|
||||
// save source
|
||||
Result:=ActiveUnitInfo.WriteUnitSource;
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
end else begin
|
||||
// save source to test directory
|
||||
s:=EnvironmentOptions.TestBuildDirectory;
|
||||
if s='' then exit;
|
||||
if s[length(s)]<>OSDirSeparator then s:=s+OSDirSeparator;
|
||||
if ActiveUnitInfo.UnitName<>'' then begin
|
||||
TestFilename:=s+lowercase(ActiveUnitInfo.UnitName)+'.pp';
|
||||
end else if (Project.MainUnit>=0)
|
||||
and (Project.Units[Project.MainUnit]=ActiveUnitInfo) then begin
|
||||
TestFilename:=GetTestProjectFilename;
|
||||
end;
|
||||
if TestFilename<>'' then begin
|
||||
MemStream:=TMemoryStream.Create;
|
||||
try
|
||||
MemStream.Write(ActiveUnitInfo.Source.Source[1],
|
||||
length(ActiveUnitInfo.Source.Source));
|
||||
MemStream.Position:=0;
|
||||
Result:=DoSaveStreamToFile(MemStream,TestFilename,false);
|
||||
if Result<>mrOk then exit;
|
||||
finally
|
||||
MemStream.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ToDo: save resources only if modified
|
||||
|
||||
if ActiveUnitInfo.HasResources then begin
|
||||
LFMFilename:=ChangeFileExt(ActiveUnitInfo.Filename,'.lfm');
|
||||
if not SaveToTestDir then
|
||||
LFMFilename:=ChangeFileExt(ActiveUnitInfo.Filename,'.lfm')
|
||||
else begin
|
||||
LFMFilename:=ChangeFileExt(TestFilename,'.lfm');
|
||||
ResourceFilename:=ChangeFileExt(TestFilename,ResourceFileExt);
|
||||
end;
|
||||
|
||||
// save lrs - lazarus resource file and lfm - lazarus form text file
|
||||
|
||||
@ -1876,7 +1911,7 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
TxtCompStream.Position:=0;
|
||||
// save lfm file
|
||||
Result:=DoSaveStreamToFile(TxtCompStream,LFMFilename
|
||||
,ActiveUnitInfo.IsPartOfProject);
|
||||
,(ActiveUnitInfo.IsPartOfProject) and (not SaveToTestDir));
|
||||
if Result<>mrOk then exit;
|
||||
finally
|
||||
TxtCompStream.Free;
|
||||
@ -1895,8 +1930,10 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
BinCompStream.Free;
|
||||
end;
|
||||
// save resource file
|
||||
Result:=DoBackupFile(ResourceFileName,ActiveUnitInfo.IsPartOfProject);
|
||||
if Result=mrAbort then exit;
|
||||
if not SaveToTestDir then begin
|
||||
Result:=DoBackupFile(ResourceFileName,ActiveUnitInfo.IsPartOfProject);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
repeat
|
||||
try
|
||||
FileStream:=TFileStream.Create(ResourceFileName,fmCreate);
|
||||
@ -1918,8 +1955,10 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex);
|
||||
finally
|
||||
ResourceCode.Free;
|
||||
end;
|
||||
ActiveUnitInfo.Modified:=false;
|
||||
ActiveSrcEdit.Modified:=false;
|
||||
if not SaveToTestDir then begin
|
||||
ActiveUnitInfo.Modified:=false;
|
||||
ActiveSrcEdit.Modified:=false;
|
||||
end;
|
||||
writeln('TMainIDE.DoSaveEditorUnit END');
|
||||
Result:=mrOk;
|
||||
end;
|
||||
@ -1952,7 +1991,7 @@ writeln('TMainIDE.DoCloseEditorUnit A PageIndex=',PageIndex);
|
||||
ACaption:='Source mofified';
|
||||
if Application.MessageBox(PChar(AText),PChar(ACaption),MB_YESNO)=mrYes then
|
||||
begin
|
||||
Result:=DoSaveEditorUnit(PageIndex,false);
|
||||
Result:=DoSaveEditorUnit(PageIndex,false,false);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
@ -2330,7 +2369,7 @@ writeln('TMainIDE.DoNewProject 1');
|
||||
if SomethingOfProjectIsModified then begin
|
||||
if Application.MessageBox('Save changes to project?','Project changed'
|
||||
,MB_YESNO)=mrYES then begin
|
||||
if DoSaveProject(false)=mrAbort then begin
|
||||
if DoSaveProject(false,false)=mrAbort then begin
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
end;
|
||||
@ -2377,12 +2416,13 @@ writeln('TMainIDE.DoNewProject end ');
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
function TMainIDE.DoSaveProject(SaveAs:boolean):TModalResult;
|
||||
function TMainIDE.DoSaveProject(SaveAs, SaveToTestDir:boolean):TModalResult;
|
||||
var MainUnitSrcEdit, ASrcEdit: TSourceEditor;
|
||||
MainUnitInfo, AnUnitInfo: TUnitInfo;
|
||||
SaveDialog: TSaveDialog;
|
||||
NewFilename, NewProgramFilename, NewPageName, AText, ACaption, Ext: string;
|
||||
i, BookmarkID, BookmarkX, BookmarkY :integer;
|
||||
MemStream: TMemoryStream;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
if ToolStatus<>itNone then begin
|
||||
@ -2394,7 +2434,8 @@ writeln('TMainIDE.DoSaveProject A');
|
||||
for i:=0 to Project.UnitCount-1 do begin
|
||||
if (Project.Units[i].Loaded) and (Project.Units[i].Filename='')
|
||||
and (Project.MainUnit<>i) then begin
|
||||
Result:=DoSaveEditorUnit(Project.Units[i].EditorIndex,false);
|
||||
Result:=DoSaveEditorUnit(Project.Units[i].EditorIndex,false,
|
||||
SaveToTestDir);
|
||||
if (Result=mrAbort) or (Result=mrCancel) then exit;
|
||||
end;
|
||||
end;
|
||||
@ -2427,7 +2468,8 @@ writeln('TMainIDE.DoSaveProject A');
|
||||
AnUnitInfo.TopLine:=ASrcEdit.EditorComponent.TopLine;
|
||||
AnUnitInfo.CursorPos:=ASrcEdit.EditorComponent.CaretXY;
|
||||
for BookmarkID:=0 to 9 do begin
|
||||
if (ASrcEdit.EditorComponent.GetBookMark(BookmarkID,BookmarkX,BookmarkY))
|
||||
if (ASrcEdit.EditorComponent.GetBookMark(
|
||||
BookmarkID,BookmarkX,BookmarkY))
|
||||
and (Project.Bookmarks.IndexOfID(BookmarkID)<0) then begin
|
||||
Project.Bookmarks.Add(TProjectBookmark.Create(BookmarkX,BookmarkX,
|
||||
AnUnitInfo.EditorIndex,BookmarkID));
|
||||
@ -2437,7 +2479,7 @@ writeln('TMainIDE.DoSaveProject A');
|
||||
end;
|
||||
|
||||
SaveAs:=SaveAs or (Project.ProjectFile='');
|
||||
if SaveAs then begin
|
||||
if SaveAs and (not SaveToTestDir) then begin
|
||||
// let user choose a filename
|
||||
SaveDialog:=TSaveDialog.Create(Application);
|
||||
try
|
||||
@ -2508,33 +2550,49 @@ writeln('TMainIDE.DoSaveProject A');
|
||||
SaveDialog.Free;
|
||||
end;
|
||||
end;
|
||||
Result:=Project.WriteProject;
|
||||
if Result=mrAbort then exit;
|
||||
if not SaveToTestDir then begin
|
||||
Result:=Project.WriteProject;
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
// save source
|
||||
if MainUnitInfo<>nil then begin
|
||||
if MainUnitInfo.Loaded then begin
|
||||
Result:=DoSaveEditorUnit(MainUnitInfo.EditorIndex,false);
|
||||
Result:=DoSaveEditorUnit(MainUnitInfo.EditorIndex,false,SaveToTestDir);
|
||||
if Result=mrAbort then exit;
|
||||
end else begin
|
||||
Result:=MainUnitInfo.WriteUnitSource;
|
||||
if not SaveToTestDir then
|
||||
Result:=MainUnitInfo.WriteUnitSource
|
||||
else begin
|
||||
MemStream:=TMemoryStream.Create;
|
||||
try
|
||||
MemStream.Write(MainUnitInfo.Source.Source[1],
|
||||
length(MainUnitInfo.Source.Source));
|
||||
MemStream.Position:=0;
|
||||
Result:=DoSaveStreamToFile(MemStream,GetTestProjectFilename,false);
|
||||
finally
|
||||
MemStream.Free;
|
||||
end;
|
||||
end;
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
end;
|
||||
EnvironmentOptions.LastSavedProjectFile:=Project.ProjectInfoFile;
|
||||
EnvironmentOptions.Save(false);
|
||||
if Result=mrOk then begin
|
||||
if MainUnitInfo<>nil then MainUnitInfo.Modified:=false;
|
||||
if MainUnitSrcEdit<>nil then MainUnitSrcEdit.Modified:=false;
|
||||
if not SaveToTestDir then begin
|
||||
EnvironmentOptions.LastSavedProjectFile:=Project.ProjectInfoFile;
|
||||
EnvironmentOptions.Save(false);
|
||||
if (Result=mrOk) then begin
|
||||
if MainUnitInfo<>nil then MainUnitInfo.Modified:=false;
|
||||
if MainUnitSrcEdit<>nil then MainUnitSrcEdit.Modified:=false;
|
||||
end;
|
||||
UpdateMainUnitSrcEdit;
|
||||
UpdateCaption;
|
||||
end;
|
||||
UpdateMainUnitSrcEdit;
|
||||
UpdateCaption;
|
||||
|
||||
// save editor files
|
||||
if (SourceNoteBook.Notebook<>nil) then begin
|
||||
for i:=0 to SourceNoteBook.Notebook.Pages.Count-1 do begin
|
||||
if (Project.MainUnit<0)
|
||||
or (Project.Units[Project.MainUnit].EditorIndex<>i) then begin
|
||||
Result:=DoSaveEditorUnit(i,false);
|
||||
Result:=DoSaveEditorUnit(i,false,SaveToTestDir);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
end;
|
||||
@ -2587,7 +2645,7 @@ writeln('TMainIDE.DoOpenProjectFile A "'+AFileName+'"');
|
||||
if SomethingOfProjectIsModified then begin
|
||||
if Application.MessageBox('Save changes to project?','Project changed'
|
||||
,MB_OKCANCEL)=mrOK then begin
|
||||
if DoSaveProject(false)=mrAbort then begin
|
||||
if DoSaveProject(false,false)=mrAbort then begin
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
end;
|
||||
@ -2667,7 +2725,7 @@ writeln('[TMainIDE.DoCreateProjectForProgram] 1');
|
||||
if SomethingOfProjectIsModified then begin
|
||||
if Application.MessageBox('Save changes to project?','Project changed'
|
||||
,MB_OKCANCEL)=mrOK then begin
|
||||
if DoSaveProject(false)=mrAbort then begin
|
||||
if DoSaveProject(false,false)=mrAbort then begin
|
||||
Result:=mrAbort;
|
||||
exit;
|
||||
end;
|
||||
@ -2814,6 +2872,7 @@ end;
|
||||
|
||||
function TMainIDE.DoBuildProject: TModalResult;
|
||||
var ActiveSrcEdit: TSourceEditor;
|
||||
DefaultFilename: string;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
if ToolStatus<>itNone then begin
|
||||
@ -2823,7 +2882,16 @@ begin
|
||||
try
|
||||
if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
|
||||
then exit;
|
||||
DoSaveAll;
|
||||
if Project.ProjectFile<>'' then
|
||||
Result:=DoSaveAll
|
||||
else
|
||||
Result:=DoSaveProjectToTestDirectory;
|
||||
if Result<>mrOk then exit;
|
||||
if Project.ProjectFile<>'' then
|
||||
DefaultFilename:=''
|
||||
else
|
||||
DefaultFilename:=GetTestProjectFilename;
|
||||
|
||||
Assert(False, 'Trace:Build Project Clicked');
|
||||
if Project=nil then Begin
|
||||
Application.MessageBox('Create a project first!','Error',mb_ok);
|
||||
@ -2840,7 +2908,7 @@ begin
|
||||
SourceNotebook.Height := Max(50,Min(SourceNotebook.Height,
|
||||
MessagesView.Top-SourceNotebook.Top));
|
||||
Compiler1.OnOutputString:=@MessagesView.Add;
|
||||
Result:=Compiler1.Compile(Project);
|
||||
Result:=Compiler1.Compile(Project,DefaultFilename);
|
||||
if Result=mrOk then begin
|
||||
MessagesView.MessageView.Items.Add(
|
||||
'Project "'+Project.Title+'" successfully built. :)');
|
||||
@ -2852,6 +2920,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.DoSaveProjectToTestDirectory: TModalResult;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
if (EnvironmentOptions.TestBuildDirectory='')
|
||||
or (not DirectoryExists(EnvironmentOptions.TestBuildDirectory)) then begin
|
||||
Result:=DoSaveAll;
|
||||
exit;
|
||||
end;
|
||||
Result:=DoSaveProject(false,true);
|
||||
end;
|
||||
|
||||
function TMainIDE.DoRunProject: TModalResult;
|
||||
// quick hack to start programs
|
||||
// ToDo:
|
||||
@ -2873,9 +2952,11 @@ writeln('[TMainIDE.DoRunProject] A');
|
||||
if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
|
||||
then exit;
|
||||
|
||||
Ext:=ExtractFileExt(Project.ProjectFile);
|
||||
ProgramFilename := LowerCase(copy(Project.ProjectFile,1,
|
||||
length(Project.ProjectFile)-length(Ext)));
|
||||
ProgramFilename:=Project.ProjectFile;
|
||||
if ProgramFilename='' then ProgramFilename:=GetTestProjectFilename;
|
||||
Ext:=ExtractFileExt(ProgramFilename);
|
||||
ProgramFilename := LowerCase(copy(ProgramFilename,1,
|
||||
length(ProgramFilename)-length(Ext)));
|
||||
{$ifdef win32}
|
||||
ProgramFilename:=ProgramFilename+'.exe';
|
||||
{$endif}
|
||||
@ -2909,7 +2990,7 @@ end;
|
||||
function TMainIDE.DoSaveAll: TModalResult;
|
||||
begin
|
||||
writeln('TMainIDE.DoSaveAll');
|
||||
Result:=DoSaveProject(false);
|
||||
Result:=DoSaveProject(false,false);
|
||||
// ToDo: save package, cvs settings, ...
|
||||
end;
|
||||
|
||||
@ -3192,7 +3273,8 @@ begin
|
||||
if MacroName='save' then begin
|
||||
Handled:=true;
|
||||
if SourceNoteBook.NoteBook<>nil then
|
||||
Abort:=(DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,false)<>mrOk);
|
||||
Abort:=(DoSaveEditorUnit(SourceNoteBook.NoteBook.PageIndex,false,false)
|
||||
<>mrOk);
|
||||
s:='';
|
||||
end else if MacroName='saveall' then begin
|
||||
Handled:=true;
|
||||
@ -3322,6 +3404,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.GetTestProjectFilename: string;
|
||||
var SrcNameStart,SrcNameEnd: integer;
|
||||
Src, TestDir: string;
|
||||
begin
|
||||
Result:='';
|
||||
if (Project.MainUnit<0) then exit;
|
||||
TestDir:=EnvironmentOptions.TestBuildDirectory;
|
||||
if (TestDir='') then exit;
|
||||
if TestDir[length(TestDir)]<>OSDirSeparator then
|
||||
TestDir:=TestDir+OSDirSeparator;
|
||||
Src:=Project.Units[Project.MainUnit].Source.Source;
|
||||
Result:=FindSourceType(Src,SrcNameStart,SrcNameEnd);
|
||||
if (Result='') or (SrcNameStart=SrcNameEnd) or (SrcNameStart>length(Src)) then
|
||||
exit;
|
||||
Result:=TestDir+copy(Src,SrcNameStart,SrcNameEnd-SrcNameStart)+'.lpr';
|
||||
end;
|
||||
|
||||
procedure TMainIDE.OnDesignerGetSelectedComponentClass(Sender: TObject;
|
||||
var RegisteredComponent: TRegisteredComponent);
|
||||
begin
|
||||
@ -3495,8 +3594,8 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.108 2001/07/08 07:09:34 lazarus
|
||||
MG: save project now also saves editor files
|
||||
Revision 1.109 2001/07/08 22:33:56 lazarus
|
||||
MG: added rapid testing project
|
||||
|
||||
Revision 1.105 2001/07/01 15:55:43 lazarus
|
||||
MG: JumpToCompilerMessage now centered in source editor
|
||||
|
||||
@ -1261,6 +1261,7 @@ var s:string;
|
||||
begin
|
||||
Result:=GetResourceFilename(AnUnitInfo,1);
|
||||
if Result='' then begin
|
||||
if AnUnitInfo.Filename='' then exit;
|
||||
Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt);
|
||||
exit;
|
||||
end;
|
||||
@ -1272,7 +1273,7 @@ begin
|
||||
end;
|
||||
if Result<>'' then
|
||||
SearchIncludeFile(AnUnitInfo,Result);
|
||||
if Result='' then
|
||||
if (Result='') and (AnUnitInfo.Filename<>'') then
|
||||
Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt);
|
||||
end;
|
||||
|
||||
@ -1416,6 +1417,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2001/07/08 22:33:56 lazarus
|
||||
MG: added rapid testing project
|
||||
|
||||
Revision 1.25 2001/06/27 21:43:23 lazarus
|
||||
MG: added project bookmark support
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user