From 2d5915e5e0cacb5fce00ef9d54a0b9c20d01c8ed Mon Sep 17 00:00:00 2001 From: lazarus Date: Sun, 8 Jul 2001 22:33:56 +0000 Subject: [PATCH] MG: added rapid testing project git-svn-id: trunk@318 - --- ide/compiler.pp | 24 ++++- ide/environmentopts.pp | 45 ++++++++- ide/main.pp | 205 ++++++++++++++++++++++++++++++----------- ide/project.pp | 6 +- 4 files changed, 220 insertions(+), 60 deletions(-) diff --git a/ide/compiler.pp b/ide/compiler.pp index 4d85292199..3def3d0616 100644 --- a/ide/compiler.pp +++ b/ide/compiler.pp @@ -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 (123,45) : (456) : in line (123) +Fatal: } 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 diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index 4e9856a4d1..ca08b48afd 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -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( diff --git a/ide/main.pp b/ide/main.pp index 742b9817c7..e2009e573e 100644 --- a/ide/main.pp +++ b/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 diff --git a/ide/project.pp b/ide/project.pp index fcf0504b9f..8a9b04c44c 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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