mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 11:09:38 +02:00
313 lines
9.1 KiB
ObjectPascal
313 lines
9.1 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
/***************************************************************************
|
|
compiler.pp - Lazarus IDE unit
|
|
-------------------------------------
|
|
TCompiler is responsible for configuration and running
|
|
the Free Pascal Compiler.
|
|
|
|
|
|
Initial Revision : Sun Mar 28 23:15:32 CST 1999
|
|
|
|
|
|
***************************************************************************/
|
|
|
|
/***************************************************************************
|
|
* *
|
|
* This program is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
***************************************************************************/
|
|
}
|
|
unit Compiler;
|
|
|
|
{$mode objfpc}
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
|
|
IDEProcs, OutputFilter;
|
|
|
|
type
|
|
TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
|
|
of object;
|
|
|
|
TCompiler = class(TObject)
|
|
private
|
|
FOnCmdLineCreate : TOnCmdLineCreate;
|
|
FOutputFilter: TOutputFilter;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Compile(AProject: TProject; BuildAll: boolean;
|
|
const DefaultFilename: string): TModalResult;
|
|
property OnCommandLineCreate: TOnCmdLineCreate
|
|
read FOnCmdLineCreate write FOnCmdLineCreate;
|
|
property OutputFilter: TOutputFilter
|
|
read FOutputFilter write FOutputFilter;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
{ TCompiler }
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TCompiler Constructor }
|
|
{------------------------------------------------------------------------------}
|
|
constructor TCompiler.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TCompiler Destructor }
|
|
{------------------------------------------------------------------------------}
|
|
destructor TCompiler.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TCompiler Compile }
|
|
{------------------------------------------------------------------------------}
|
|
function TCompiler.Compile(AProject: TProject; BuildAll: boolean;
|
|
const DefaultFilename: string): TModalResult;
|
|
var
|
|
CmdLine : String;
|
|
Abort : Boolean;
|
|
OldCurDir, ProjectDir, ProjectFilename: string;
|
|
TheProcess : TProcess;
|
|
begin
|
|
Result:=mrCancel;
|
|
if AProject.MainUnit<0 then exit;
|
|
OldCurDir:=GetCurrentDir;
|
|
if AProject.IsVirtual then
|
|
ProjectFilename:=DefaultFilename
|
|
else
|
|
ProjectFilename:=AProject.Units[AProject.MainUnit].Filename;
|
|
if ProjectFilename='' then exit;
|
|
ProjectDir:=ExtractFilePath(ProjectFilename);
|
|
if not SetCurrentDir(ProjectDir) then exit;
|
|
try
|
|
CmdLine := AProject.CompilerOptions.CompilerPath;
|
|
|
|
if Assigned(FOnCmdLineCreate) then begin
|
|
Abort:=false;
|
|
FOnCmdLineCreate(CmdLine,Abort);
|
|
if Abort then begin
|
|
Result:=mrAbort;
|
|
exit;
|
|
end;
|
|
end;
|
|
try
|
|
CheckIfFileIsExecutable(CmdLine);
|
|
except
|
|
on E: Exception do begin
|
|
if OutputFilter<>nil then
|
|
OutputFilter.ReadLine('Error: invalid compiler: '+E.Message,true);
|
|
if CmdLine='' then begin
|
|
if OutputFilter<>nil then
|
|
OutputFilter.ReadLine('Hint: you can set the compiler path in '
|
|
+'Environment->General Options->Files->Compiler Path',true);
|
|
end;
|
|
exit;
|
|
end;
|
|
end;
|
|
if BuildAll then
|
|
CmdLine := CmdLine+' -B';
|
|
CmdLine := CmdLine
|
|
+ ' '+ AProject.CompilerOptions.MakeOptionsString(ProjectFilename)
|
|
+ ' '+ ProjectFilename;
|
|
if Assigned(FOnCmdLineCreate) then begin
|
|
Abort:=false;
|
|
FOnCmdLineCreate(CmdLine,Abort);
|
|
if Abort then begin
|
|
Result:=mrAbort;
|
|
exit;
|
|
end;
|
|
end;
|
|
Writeln('[TCompiler.Compile] CmdLine="',CmdLine,'"');
|
|
|
|
try
|
|
TheProcess := TProcess.Create(nil);
|
|
TheProcess.CommandLine := CmdLine;
|
|
TheProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
|
|
TheProcess.ShowWindow := swoNone;
|
|
Result:=mrOk;
|
|
try
|
|
TheProcess.CurrentDirectory:=ProjectDir;
|
|
|
|
if OutputFilter<>nil then begin
|
|
OutputFilter.PrgSourceFilename:=ProjectFilename;
|
|
OutputFilter.Options:=[ofoSearchForFPCMessages,ofoExceptionOnError];
|
|
OutputFilter.Project:=AProject;
|
|
OutputFilter.Execute(TheProcess);
|
|
end else begin
|
|
TheProcess.Execute;
|
|
end;
|
|
finally
|
|
TheProcess.WaitOnExit;
|
|
TheProcess.Free;
|
|
end;
|
|
except
|
|
on e: EOutputFilterError do begin
|
|
Result:=mrCancel;
|
|
exit;
|
|
end;
|
|
on e: Exception do begin
|
|
writeln('[TCompiler.Compile] exception "',E.Message,'"');
|
|
if OutputFilter<>nil then
|
|
OutputFilter.ReadLine(E.Message,true);
|
|
Result:=mrCancel;
|
|
exit;
|
|
end;
|
|
end;
|
|
finally
|
|
SetCurrentDir(OldCurDir);
|
|
end;
|
|
writeln('[TCompiler.Compile] end');
|
|
end;
|
|
|
|
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.29 2002/03/28 00:11:04 lazarus
|
|
MG: removed unused
|
|
|
|
Revision 1.28 2002/01/23 20:07:20 lazarus
|
|
MG: added outputfilter
|
|
|
|
Revision 1.27 2002/01/15 08:49:56 lazarus
|
|
MG: fixed zombie compilers
|
|
|
|
Revision 1.26 2002/01/13 12:46:17 lazarus
|
|
MG: fixed linker options, compiler options dialog
|
|
|
|
Revision 1.25 2001/12/16 22:24:54 lazarus
|
|
MG: changes for new compiler 20011216
|
|
|
|
Revision 1.24 2001/12/10 08:19:52 lazarus
|
|
MG: added hint for unset compiler path
|
|
|
|
Revision 1.23 2001/12/10 07:47:00 lazarus
|
|
MG: minor fixes
|
|
|
|
Revision 1.22 2001/11/21 13:09:49 lazarus
|
|
MG: moved executable check to ideprocs.pp
|
|
|
|
Revision 1.20 2001/11/09 20:48:36 lazarus
|
|
Minor fixes
|
|
Shane
|
|
|
|
Revision 1.19 2001/11/09 18:39:11 lazarus
|
|
MG: turned back to stable ground (use old process.pp)
|
|
|
|
Revision 1.18 2001/11/07 16:14:11 lazarus
|
|
MG: fixes for the new compiler
|
|
|
|
Revision 1.17 2001/11/06 15:47:31 lazarus
|
|
MG: added build all
|
|
|
|
Revision 1.16 2001/11/05 18:18:13 lazarus
|
|
added popupmenu+arrows to notebooks, added target filename
|
|
|
|
Revision 1.15 2001/10/23 09:13:50 lazarus
|
|
MG: fixed TestProject
|
|
|
|
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
|
|
|
|
Revision 1.12 2001/04/04 12:20:34 lazarus
|
|
MG: added add to/remove from project, small bugfixes
|
|
|
|
Revision 1.11 2001/03/31 13:35:22 lazarus
|
|
MG: added non-visual-component code to IDE and LCL
|
|
|
|
Revision 1.10 2001/03/29 12:38:58 lazarus
|
|
MG: new environment opts, ptApplication bugfixes
|
|
|
|
Revision 1.9 2001/03/26 14:52:30 lazarus
|
|
MG: TSourceLog + compiling bugfixes
|
|
|
|
Revision 1.8 2001/03/12 09:34:51 lazarus
|
|
MG: added transfermacros, renamed dlgmessage.pp to msgview.pp
|
|
|
|
Revision 1.7 2001/02/06 13:38:57 lazarus
|
|
Fixes from Mattias for EditorOPtions
|
|
Fixes to COmpiler that should allow people to compile if their path is set up.
|
|
Changes to code completion.
|
|
Shane
|
|
|
|
Revision 1.6 2001/02/04 18:24:41 lazarus
|
|
Code cleanup
|
|
Shane
|
|
|
|
Revision 1.5 2001/01/31 06:26:23 lazarus
|
|
Removed global unit. CAW
|
|
|
|
Revision 1.4 2001/01/13 06:11:06 lazarus
|
|
Minor fixes
|
|
Shane
|
|
|
|
Revision 1.2 2000/12/20 20:04:30 lazarus
|
|
Made PRoject Build compile the active unit. This way we can actually play with it by compiling units.
|
|
|
|
Revision 1.1 2000/07/13 10:27:46 michael
|
|
+ Initial import
|
|
|
|
Revision 1.13 2000/07/09 20:18:55 lazarus
|
|
MWE:
|
|
+ added new controlselection
|
|
+ some fixes
|
|
~ some cleanup
|
|
|
|
Revision 1.12 2000/05/10 02:34:43 lazarus
|
|
Changed writelns to Asserts except for ERROR and WARNING messages. CAW
|
|
|
|
Revision 1.11 2000/05/01 06:11:59 lazarus
|
|
Changed to get compiler options from the Compiler Options dialog. This
|
|
now makes the Compiler Options dialog fully functional. CAW
|
|
|
|
Revision 1.10 2000/04/18 20:06:39 lazarus
|
|
Added some functions to Compiler.pp
|
|
|
|
Revision 1.9 2000/04/17 06:47:40 lazarus
|
|
Started implementing the ability to compile. CAW
|
|
|
|
Revision 1.8 1999/07/04 03:29:57 lazarus
|
|
Code Cleaning
|
|
|
|
Revision 1.7 1999/05/24 21:20:12 lazarus
|
|
*** empty log message ***
|
|
|
|
Revision 1.6 1999/05/17 22:22:34 lazarus
|
|
*** empty log message ***
|
|
|
|
Revision 1.5 1999/05/14 18:44:04 lazarus
|
|
*** empty log message ***
|
|
|
|
Revision 1.4 1999/05/14 14:53:00 michael
|
|
+ Removed objpas from uses clause
|
|
|
|
Revision 1.3 1999/04/20 02:56:42 lazarus
|
|
*** empty log message ***
|
|
|
|
Revision 1.2 1999/04/18 05:42:05 lazarus
|
|
*** empty log message ***
|
|
|
|
Revision 1.1 1999/04/14 07:31:44 michael
|
|
+ Initial implementation
|
|
|
|
}
|