////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit provides wrapper class to embed Lazarus FPC compiler into your   //
// application and to create plugin DLLs, which can expand application        //
// features. Uses FpcupDeluxe compiler package.                               //
// See https://wiki.freepascal.org/fpcupdeluxe                                //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20241009 - Creation, uses _crw_dcc32.pas - A.K.                            //
// 20241103 - Stable version by A.K.                                          //
////////////////////////////////////////////////////////////////////////////////

unit _crw_fpcup; // fpcupdeluxe wrapper

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_fpu, _crw_ef, _crw_str, _crw_fio, _crw_proc, _crw_gloss,
 _crw_sect, _crw_task, _crw_utf8, _crw_rtc, _crw_apputils, _crw_apptools,
 _crw_crwapi, _crw_plugin_wrapper;

 ///////////////////////////////////////////////////////////////////////////////
 // Use Fpcup.ParseFpcupMessage function to parse Fpcup output hints,         //
 // warnings, errors and fatals. For example:                                 //
 //  Fpcup.RunCompile('proj.lpr');                                            //
 //  for i:=0 to Fpcup.Hints.Count-1 do                                       //
 //  with Fpcup.ParseFpcupMessage(Fpcup.Hints[i]) do                          //
 //  writeln('Hint File:',FileName,' Line:',LineNum,' Token:',Token);         //
 ///////////////////////////////////////////////////////////////////////////////
type
 TParseFpcupStatus  = (cmsNone,cmsHint,cmsWarning,cmsError,cmsFatal,
                       cmsLinking,cmsCompiled,cmsExitCode);
 TParseFpcupMessage = packed record
  Status   : TParseFpcupStatus;
  LineNum  : Integer;
  ColNum   : Integer;
  Compiled : Integer;
  ExitCode : Integer;
  FileName : PureString;
  Token    : PureString;
 end;

 ///////////////////////////////////////////////////////////////////////////////
 // TFpcupWrapper provides access to Fpcup command line compiler to use       //
 // this compiler as embeded in your applications.                            //
 // StdOut                      After compilation this text contains hooked   //
 //                             compiler messages.                            //
 // Hints                       After compilation this text contains hooked   //
 //                             compiler hints.                               //
 // Warnings                    After compilation this text contains hooked   //
 //                             compiler warnings.                            //
 // Errors                      After compilation this text contains hooked   //
 //                             compiler errors.                              //
 // Fatals                      After compilation this text contains hooked   //
 //                             compiler fatals.                              //
 // CanCompile(Proj)            Check compiler integrity & project existance  //
 // RunCompile(Proj,Parser)     Start compile project file Proj, use Parser.  //
 //                             Return immediately, check status in polling.  //
 //                             That is asynchronous mode suitable for CLI.   //
 // GuiCompile(Proj,Timeout)    Compile project file Proj, wait for timeout.  //
 //                             Use Application.ProcessMessages loop inside.  //
 //                             That is synchronous mode suitable for GUI.    //
 ///////////////////////////////////////////////////////////////////////////////

type
 TFpcupWrapper=class;
 TFpcupStateCode=(scStandBy,scRunning,scSucceed,scFailed);
 TFpcupLineParser=procedure(F:TFpcupWrapper; const Line:LongString);
 EFpcupFailure = class(EEchoException);
 TFpcupWrapper = class(TMasterObject)
 private
  myLazBuildTid      : Integer;
  myLazBuildCmd      : LongString;
  myLazBuildLpr      : LongString;
  myLazBuildBuf      : LongString;
  myLazBuildLinking  : LongString;
  myLazBuildExitCode : Integer;
  myCompilerExitCode : Integer;
  myLineParser       : TFpcupLineParser;
  myStdOut           : TText;
  myHints            : TText;
  myWarnings         : TText;
  myErrors           : TText;
  myFatals           : TText;
  function    GetLazBuildTid:Integer;
  function    GetLazBuildCmd:LongString;
  function    GetLazBuildLpr:LongString;
  function    GetLazBuildLinking:LongString;
  function    GetLazBuildBusy:Boolean;
  function    GetLazBuildState:TFpcupStateCode;
  function    FreeLazBuildTid:Boolean;
  procedure   ClearLazBuildLists;
  function    GetStdOut:TText;
  function    GetHints:TText;
  function    GetWarnings:TText;
  function    GetErrors:TText;
  function    GetFatals:TText;
  function    GetLazBuildExitCode:Integer;
  function    GetCompilerExitCode:Integer;
 protected
  procedure   ErrorFound(E:Exception; const Note:LongString=''); override;
 public
  constructor Create(const aLazBuild:LongString='');
  destructor  Destroy; override;
 public
  property    LazBuildTid      : Integer         read GetLazBuildTid;
  property    LazBuildCmd      : LongString      read GetLazBuildCmd;
  property    LazBuildLpr      : LongString      read GetLazBuildLpr;
  property    LazBuildLinking  : LongString      read GetLazBuildLinking;
  property    LazBuildBusy     : Boolean         read GetLazBuildBusy;
  property    LazBuildState    : TFpcupStateCode read GetLazBuildState;
  property    LazBuildExitCode : Integer         read GetLazBuildExitCode;
  property    CompilerExitCode : Integer         read GetCompilerExitCode;
  property    StdOut           : TText           read GetStdOut;
  property    Hints            : TText           read GetHints;
  property    Warnings         : TText           read GetWarnings;
  property    Errors           : TText           read GetErrors;
  property    Fatals           : TText           read GetFatals;
 public       // Preferred compiler for synchronous GUI mode.
  function    GuiCompile(const aProject:LongString; Timeout:Integer=0):Boolean;
 public       // Preferred compiler for asynchronous polling mode.
  function    RunCompile(const aProject:LongString; aParser:TFpcupLineParser=nil):Boolean;
 public       // Internally use routines.
  function    CanCompile(aProject:LongString=''):Boolean;
  function    ReportLazBuild:LongString;
  procedure   ResetLazBuild;
  procedure   StartPolling;
  procedure   StopPolling;
  procedure   DoPolling;
  procedure   DoReading;
 public       // User utilities.
  function    LazHelp(const HelpFile,Topic:LongString):Boolean;
  function    LazarusCmdLine:LongString;
  function    LazarusInstalled:Boolean;
 public
  class var StdIoPipeSizeKb:Integer;
  class function fwStateName(State:TFpcupStateCode):LongString;
 public       // Configuration routines.
  class function DefaultLazClone:LongString;
  class function IniFileLazClone:LongString;
  class function DefaultLazBuild:LongString;
  class function IniFileLazBuild:LongString;
  class function DefaultLazHelp:LongString;
  class function IniFileLazHelp:LongString;
  class function DefaultLazIndex:LongString;
  class function IniFileLazIndex:LongString;
  class function DefaultCrwLibIndex:LongString;
  class function IniFileCrwLibIndex:LongString;
 public       // Internally use routines.
  class function  NewFpcupWrapperFromIniFile:TFpcupWrapper;
  class function  NewFpcupWrapper(const aFpcupDir:LongString=''):TFpcupWrapper;
  class function  ParseFpcupMessage(const aMessage:LongString):TParseFpcupMessage;
 end;

procedure Kill(var TheObject:TFpcupWrapper); overload;

procedure DefaultFpcupLineParser(F:TFpcupWrapper; const Line:LongString);

 ///////////////////////////////////////////////////////////////////////////////
 // Use Fpcup object to compile your Lazarus projects easy.                   //
 // Example: Fpcup.RunCompile('plugin1.lpr');                                 //
 ///////////////////////////////////////////////////////////////////////////////

 ///////////////////////////////////////////////////////////////////////////////
 // The only one instance of Fpcup.                                           //
 ///////////////////////////////////////////////////////////////////////////////
function  Fpcup:TFpcupWrapper;

procedure Timer_FpcupPolling;

implementation

 //////////////////////////////////
 // TFpcupWrapper implementation //
 //////////////////////////////////

constructor TFpcupWrapper.Create(const aLazBuild:LongString='');
begin
 inherited Create;
 myLazBuildTid:=0;
 myLineParser:=DefaultFpcupLineParser;
 myLazBuildCmd:=UnifyFileAlias(aLazBuild,ua_RealPath);
 myLazBuildExitCode:=0; myCompilerExitCode:=0;
 myLazBuildLpr:=''; myLazBuildBuf:=''; myLazBuildLinking:='';
 myStdOut:=NewText;
 myStdOut.Master:=@myStdOut;
 myHints:=NewText;
 myHints.Master:=@myHints;
 myWarnings:=NewText;
 myWarnings.Master:=@myWarnings;
 myErrors:=NewText;
 myErrors.Master:=@myErrors;
 myFatals:=NewText;
 myFatals.Master:=@myFatals;
 Exceptions:=false;
 ErrorReportProc:=DefaultObjectErrorReportProc;
end;

destructor  TFpcupWrapper.Destroy;
begin
 FreeLazBuildTid;
 myLazBuildCmd:='';
 myLazBuildLpr:='';
 myLazBuildBuf:='';
 myLazBuildLinking:='';
 Kill(myStdOut);
 Kill(myHints);
 Kill(myWarnings);
 Kill(myErrors);
 Kill(myFatals);
 inherited Destroy;
end;

function TFpcupWrapper.FreeLazBuildTid:Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  if (myLazBuildTid<>0) then begin
   Result:=task_free(myLazBuildTid);
   myLazBuildTid:=0;
  end;
  myLazBuildBuf:='';
 end;
end;

procedure TFpcupWrapper.ClearLazBuildLists;
begin
 if Assigned(Self) then begin
  StdOut.Count:=0;
  Hints.Count:=0;
  Warnings.Count:=0;
  Errors.Count:=0;
  Fatals.Count:=0;
 end;
end;

procedure TFpcupWrapper.ResetLazBuild;
begin
 if Assigned(Self) then begin
  StopPolling;
  FreeLazBuildTid;
  ClearLazBuildLists;
  myLazBuildExitCode:=0;
  myCompilerExitCode:=0;
  myLazBuildLinking:='';
  myLazBuildLpr:='';
  myLazBuildBuf:='';
 end;
end;

function TFpcupWrapper.GetLazBuildTid:Integer;
begin
 if Assigned(Self)
 then Result:=myLazBuildTid
 else Result:=0;
end;

function TFpcupWrapper.GetLazBuildCmd:LongString;
begin
 if Assigned(Self)
 then Result:=myLazBuildCmd
 else Result:='';
end;

function TFpcupWrapper.GetLazBuildLpr:LongString;
begin
 if Assigned(Self)
 then Result:=myLazBuildLpr
 else Result:='';
end;

function TFpcupWrapper.GetLazBuildLinking:LongString;
begin
 if Assigned(Self)
 then Result:=myLazBuildLinking
 else Result:='';
end;

function TFpcupWrapper.GetLazBuildExitCode:Integer;
begin
 if Assigned(Self)
 then Result:=myLazBuildExitCode
 else Result:=0;
end;

function TFpcupWrapper.GetCompilerExitCode:Integer;
begin
 if Assigned(Self)
 then Result:=myCompilerExitCode
 else Result:=0;
end;

function TFpcupWrapper.GetLazBuildBusy:Boolean;
begin
 if Assigned(Self)
 then Result:=(myLazBuildTid<>0) and task_wait(myLazBuildTid,0)
 else Result:=false;
end;

function TFpcupWrapper.GetStdOut:TText;
begin
 if Assigned(Self) then Result:=myStdOut else Result:=nil;
end;

function TFpcupWrapper.GetHints:TText;
begin
 if Assigned(Self) then Result:=myHints else Result:=nil;
end;

function TFpcupWrapper.GetWarnings:TText;
begin
 if Assigned(Self) then Result:=myWarnings else Result:=nil;
end;

function TFpcupWrapper.GetErrors:TText;
begin
 if Assigned(Self) then Result:=myErrors else Result:=nil;
end;

function TFpcupWrapper.GetFatals:TText;
begin
 if Assigned(Self) then Result:=myFatals else Result:=nil;
end;

procedure TFpcupWrapper.ErrorFound(E:Exception; const Note:LongString);
begin
 if Exceptions then begin
  if E is Exception
  then RAISE EFpcupFailure.Create(E.Message)
  else RAISE EFpcupFailure.Create(Note);
 end else ErrorReport(E,Note);
end;

function TFpcupWrapper.GetLazBuildState:TFpcupStateCode;
var tid:Integer;
begin
 Result:=scStandby;
 if Assigned(Self) then begin
  tid:=myLazBuildTid;
  if (tid=0) and (myLazBuildLpr='') then Exit;
  if (task_pid(tid)=0) then Exit(scStandby);
  if task_wait(myLazBuildTid,0) then Exit(scRunning);
  if (task_rxcount(tid)>0) then DoReading;
  if (myLazBuildExitCode<>0) then Exit(scFailed);
  if (myCompilerExitCode<>0) then Exit(scFailed);
  if (Errors.Count+Fatals.Count>0) then Exit(scFailed);
  Result:=scSucceed;
 end;
end;

function TFpcupWrapper.CanCompile(aProject:LongString=''):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  // проверить сценарий компилятора
  if IsEmptyStr(LazBuildCmd) then RAISE EFpcupFailure.Create(SectFpcupDeluxe+' LazBuild not specified.');
  if not FileExists(LazBuildCmd) then RAISE EFpcupFailure.Create(LazBuildCmd+' is not found.');
  if not FileIsExecutable(LazBuildCmd) then RAISE EFpcupFailure.Create(LazBuildCmd+' is not executable.');
  // проверить файл проекта
  if IsNonEmptyStr(aProject) then begin
   aProject:=UnifyFileAlias(aProject);
   if not FileExists(aProject)
   then RAISE EFpcupFailure.Create(Format('File "%s" not found.',[aProject]));
   if not SameText(ExtractFileExt(aProject),'.lpr')
   then RAISE EFpcupFailure.Create(Format('Invalid extension in "%s".',[aProject]));
  end;
  Result:=true;
 except
  on E:Exception do ErrorFound(E,'CanCompile');
 end;
end;

function TFpcupWrapper.RunCompile(const aProject:LongString; aParser:TFpcupLineParser=nil):Boolean;
var CmdLine:LongString; PipeSizeKb:Integer;
begin
 Result:=False;
 if Assigned(Self) then
 try
  if (LazBuildState in [scRunning])
  then RAISE EFpcupFailure.Create(RusEng('Компилятор уже занят.','Compiler is already busy.'));
  // Check compiler & project exists
  if not CanCompile(aProject)
  then RAISE EFpcupFailure.Create(Format('Could not compile "%s".',[aProject]));
  if not Assigned(aParser) then aParser:=DefaultFpcupLineParser;
  myLineParser:=aParser;
  // Prepare variables
  FreeLazBuildTid; ResetLazBuild;
  myLazBuildLpr:=UnifyFileAlias(aProject,ua_RealPath);
  CmdLine:=Format('%s %s',[LazBuildCmd,myLazBuildLpr]);
  // Запуск компилятора
  myLazBuildTid:=task_init(CmdLine);
  PipeSizeKb:=EnsureRange(StdIoPipeSizeKb,16,KiloByte*16);
  task_ctrl(myLazBuildTid,'StdInpPipeSize='+IntToStr(KiloByte*PipeSizeKb));
  task_ctrl(myLazBuildTid,'StdOutPipeSize='+IntToStr(KiloByte*PipeSizeKb));
  task_ctrl(myLazBuildTid,'Display='+IntToStr(SW_SHOWMINNOACTIVE));
  Result:=task_run(myLazBuildTid);
  if Result then begin
   StartPolling;
  end else begin
   StopPolling; FreeLazBuildTid; ResetLazBuild;
   RAISE EFpcupFailure.Create('Could not start compiler.');
  end;
 except
  on E:Exception do ErrorFound(E,'Compile');
 end;
end;

class function TFpcupWrapper.fwStateName(State:TFpcupStateCode):LongString;
begin
 case State of
  scStandby   : Result:=RusEng('Ожидание','Standby');
  scRunning   : Result:=RusEng('Работает','Running');
  scSucceed   : Result:=RusEng('Успешно','Succeed');
  scFailed    : Result:=RusEng('Ошибка','Failed');
  else          Result:=RusEng('Сбой','Fatal');
 end;
end;

function TFpcupWrapper.ReportLazBuild:LongString;
const sep=',  '; var i:Integer;
begin
 Result:='';
 if Assigned(Self) then begin
  Result:=RusEng('Отчёт компиляции:','Compiler report:')+EOL
         +RusEng('#################','################')+EOL
         +RusEng(' Проект: ',' Source: ')+LazBuildLpr+EOL;
  if (LazBuildLinking<>'') then Result:=Result
         +RusEng(' Сборка: ',' Linked: ')+LazBuildLinking+EOL;
  Result:=Result
         +RusEng(' Статус: ',' Status: ')+utf8_uppercase(fwStateName(LazBuildState))+sep
         +RusEng(' КодКомпиляции: ',' CompilerExitCode: ')+IntToStr(Fpcup.CompilerExitCode)+sep
         +RusEng(' КодСценария: ',' ScriptExitCode: ')+IntToStr(Fpcup.LazBuildExitCode)+sep
         +RusEng(' Ошибок: ',' Errors: ')+IntToStr(Fpcup.Errors.Count)+sep
         +RusEng(' Сбоев: ',' Fatals: ')+IntToStr(Fpcup.Errors.Count)+sep
         +RusEng(' Предупреждений: ',' Warnings: ')+IntToStr(Fpcup.Warnings.Count)+sep
         +RusEng(' Советов: ',' Hints: ')+IntToStr(Fpcup.Hints.Count)+EOL;
  if (Errors.Count+Fatals.Count>0) then begin
   Result:=Result+RusEng(' Список ошибок и сбоев:',' List of Errors and Fatals:')+EOL;
   Result:=Result+RusEng(' ----------------------',' --------------------------')+EOL;
   for i:=0 to Errors.Count-1 do Result:=Result+'  '+Errors[i]+EOL;
   for i:=0 to Fatals.Count-1 do Result:=Result+'  '+Fatals[i]+EOL;
  end;
 end;
end;

function TFpcupWrapper.LazHelp(const HelpFile,Topic:LongString):Boolean;
var exe,cmd:LongString;
begin
 Result:=false;
 try
  exe:=IniFileLazHelp;
  cmd:=Trim(QArg(exe)+' '+QArg(HelpFile));
  if FileExists(exe)
  then Result:=(SendToMainConsole('@silent @run -sw7 '+cmd+EOL)>0)
  else Echo(RusEng('Не найден: ','Not found: ')+exe);
 except
  on E:Exception do BugReport(E,Self,'LazHelp');
 end;
end;

function TFpcupWrapper.LazarusCmdLine:LongString;
var Buff,Lnk,Exec:LongString;
begin
 Result:='';
 try
  Lnk:='';
  if SysGlossary.ReadIniPath(SysIniFile,SectFpcupDeluxe,'FpcupLnk',HomeDir,Lnk) then begin
   Lnk:=UnifyFileAlias(AdaptLnkFileName(Lnk));
   Buff:=ReadShellLinkAsText(Lnk);
   Exec:=CookieScan(Buff,'Exec');
   Result:=Trim(Exec);
  end;
 except
  on E:Exception do BugReport(E,Self,'LazarusCmdLine');
 end;
end;

function TFpcupWrapper.LazarusInstalled:Boolean;
var exe:LongString;
begin
 Result:=False;
 exe:=ExtractPhrase(1,LazarusCmdLine,JustSpaces);
 if (exe<>'') and FileExists(exe) and FileIsExecutable(exe)
 then Result:=True;
end;

procedure TFpcupWrapper.StartPolling;
begin
 if Assigned(Self) then begin
  Tick55Actions.Add(Timer_FpcupPolling);
 end;
end;

procedure TFpcupWrapper.StopPolling;
begin
 if Assigned(Self) then begin
  if (myLazBuildTid<>0) then DoReading;
  Tick55Actions.Remove(Timer_FpcupPolling);
 end;
end;

function Task_Readln(tid:Integer; var Line,Buff:LongString):Boolean;
const MaxLeng=KiloByte*16;
var p:Integer;
begin
 Line:='';
 Task_Readln:=False;
 if (Task_Pid(tid)<>0) then begin
  if (Length(Buff)<MaxLeng) and (Task_RxCount(tid)>0)
  then Buff:=Buff+Task_Recv(tid,MaxLeng-Length(Buff));
  p:=PosEol(Buff,1,0);
  if (p>0) then begin
   Task_Readln:=True;
   if (p>1) then Line:=Copy(Buff,1,p-1);
   Buff:=Copy(Buff,PosEol(Buff,p,1),MaxInt);
  end else begin
   if (Length(Buff)>=MaxLeng) then begin
    Echo('Received line is too long!');
    Buff:='';
   end;
  end;
 end;
end;

function OnPollingLines(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var Fpcup:TFpcupWrapper;
begin
 Result:=true;
 if Assigned(Custom) then begin
  Fpcup:=TFpcupWrapper(Custom);
  if Assigned(Fpcup.myLineParser) then begin
   Fpcup.myLineParser(Fpcup,Line);
  end else begin
   Fpcup.StdOut.AddLn(Line);
   Echo(Line);
  end;
 end;
end;

procedure TFpcupWrapper.DoReading;
var tid,len,n:Integer; line:LongString;
begin
 if Assigned(Self) then
 try
  tid:=myLazBuildTid;
  if (tid=0) then Exit;
  len:=task_rxcount(tid);
  if (len>0) then begin
   line:=''; n:=0;
   while task_readln(tid,Line,myLazBuildBuf) do begin
    OnPollingLines(n,line,Self);
    Inc(n);
   end;
  end;
  if not task_wait(tid,0) then myLazBuildExitCode:=task_result(tid);
 except
  on E:Exception do BugReport(E,nil,'DoReading');
 end;
end;

procedure TFpcupWrapper.DoPolling;
var tid,pid:Integer;
begin
 if Assigned(Self) then begin
  tid:=myLazBuildTid; if (tid=0) then Exit;
  pid:=task_pid(tid); if (pid<>0) then DoReading else Exit;
  if task_wait(tid,0) then Exit else StopPolling;
 end;
end;

procedure Timer_FpcupPolling;
begin
 Fpcup.DoPolling;
end;

function CheckStatus(const Line,Key:LongString; s:TParseFpcupStatus;
                      var R:TParseFpcupMessage;  var p:Integer):Boolean;
begin
 Result:=false;
 if (R.Status=cmsNone) then begin
  p:=Pos(Key,Line);
  if p=0 then Exit;
  Result:=true;
  R.Status:=s;
 end;
end;

class function TFpcupWrapper.ParseFpcupMessage(const aMessage:LongString):TParseFpcupMessage;
var p,i:Integer; lincol:LongString;
begin
 Result:=Default(TParseFpcupMessage); p:=0;
 if CheckStatus(aMessage, ' Fatal: ',           cmsFatal,    Result, p)
 or CheckStatus(aMessage, ' Error: ',           cmsError,    Result, p)
 or CheckStatus(aMessage, ' Warning: ',         cmsWarning,  Result, p)
 or CheckStatus(aMessage, ' Hint: ',            cmsHint,     Result, p)
 or CheckStatus(aMessage, ' Linking ',          cmsLinking,  Result, p)
 or CheckStatus(aMessage, ' lines compiled',    cmsCompiled, Result, p)
 or CheckStatus(aMessage, 'CompilerExitCode: ', cmsExitCode, Result, p)
 or CheckStatus(aMessage, ' stopped with exit code ', cmsExitCode, Result, p)
 then with Result do
 try
  case Status of
   cmsFatal,cmsError,cmsWarning,cmsHint: begin
    i:=p-1;
    while (i>1) and (StrFetch(aMessage,i)<>'(') do Dec(i);
    if (i>1) then begin
     FileName:=Copy(aMessage,1,i-1);
     LinCol:=Copy(aMessage,i+1,p-i-2);
     LineNum:=StrToIntDef(ExtractWord(1,LinCol,ScanSpaces),0);
     ColNum:=StrToIntDef(ExtractWord(2,LinCol,ScanSpaces),0);
    end;
    Token:=Trim(Copy(aMessage,p,Length(aMessage)-p+1));
   end;
   cmsLinking: begin
    FileName:=Trim(SkipWords(2,aMessage,ScanSpaces));
    Token:=Trim(Copy(aMessage,p,Length(aMessage)-p+1));
   end;
   cmsCompiled: begin
    Token:=Trim(SkipWords(1,aMessage,ScanSpaces));
    Compiled:=StrToIntDef(ExtractWord(1,Token,ScanSpaces),0);
   end;
   cmsExitCode: begin
    Token:=Trim(Copy(aMessage,p,Length(aMessage)-p+1));
    ExitCode:=StrToIntDef(ExtractWord(2,Token,ScanSpaces),-1);
    if (ExitCode=-1) then
    ExitCode:=StrToIntDef(ExtractWord(5,Token,ScanSpaces),-1);
   end;
  end;
 except
  on E:Exception do begin
   Status:=cmsFatal;
   FileName:=''; LineNum:=0; ColNum:=0;
   Token:='Fpcup output parser error.';
  end;
 end;
end;

function TFpcupWrapper.GuiCompile(const aProject:LongString; Timeout:Integer=0):Boolean;
 function CompileStatus(f:Boolean):LongString;
 begin
  if (TimeOut>0) then begin
   if f
   then Result:=RusEng('КОМПИЛЯЦИЯ ПРОШЛА УСПЕШНО.','COMPILATION WAS SUCCEEDED.')
   else Result:=RusEng('КОМПИЛЯЦИЯ ПРОШЛА НЕУДАЧНО.','COMPILATION WAS FAILED.');
  end else begin
   if f
   then Result:=RusEng('КОМПИЛЯЦИЯ ЗАПУЩЕНА УСПЕШНО.','COMPILATION STARTED SUCCEED.')
   else Result:=RusEng('КОМПИЛЯЦИЯ СЕЙЧАС НЕДОСТУПНА.','COMPILATION NOT AVAILABLE NOW.');
  end;
 end;
var Success:Boolean; Problems:Integer; Deadline:Double; sc:TFpcupStateCode;
begin
 Result:=false;
 try
  if FileExists(aProject) then begin
   if IsSameText(ExtractFileExt(aProject),'.lpr') then begin
    Success:=RunCompile(aProject);
    if Success and (TimeOut>0) then begin
     Deadline:=msecnow+TimeOut;
     while (msecnow<=Deadline) do begin
      if LazBuildBusy
      then SafeApplicationProcessMessages
      else Break;
     end;
     SafeApplicationProcessMessages;
     sc:=LazBuildState;
     Success:=(sc=scSucceed);
    end;
    Echo(CompileStatus(Success));
    Problems:=ord(not Success);
    if (Problems>0)
    then SendToMainConsole('@silent @view activate '+GetMainConsoleCaption+EOL);
    Result:=(Problems=0);
   end else Echo(RusEng('Проект должен иметь расширение .lpr!',
                        'Project must to have extension .lpr!'));
  end else Echo(Format(RusEng('Не найден проект: "%s".',
                              'Not found project: "%s".'),[aProject]));
 except
  on E:Exception do BugReport(E,nil,'SafeCompileLazarusProject');
 end;
end;

class function TFpcupWrapper.NewFpcupWrapper(const aFpcupDir:LongString=''):TFpcupWrapper;
begin
 Result:=nil;
 try
  Result:=TFpcupWrapper.Create(aFpcupDir);
 except
  on E:Exception do BugReport(E,nil,'NewFpcupWrapper');
 end;
end;

procedure Kill(var TheObject:TFpcupWrapper); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end; 
end;

procedure DefaultFpcupLineParser(F:TFpcupWrapper; const Line:LongString);
var Parse:TParseFpcupMessage;
begin
 Echo(Line);
 if (Line<>'') then
 if Assigned(F) then begin
  F.StdOut.AddLn(Line);
  Parse:=F.ParseFpcupMessage(Line);
  case Parse.Status of
   cmsHint     : F.Hints.AddLn(Line);
   cmsWarning  : F.Warnings.AddLn(Line);
   cmsError    : F.Errors.AddLn(Line);
   cmsFatal    : F.Fatals.Addln(Line);
   cmsLinking  : F.myLazBuildLinking:=Parse.FileName;
   cmsExitCode : F.myCompilerExitCode:=Parse.ExitCode;
  end;
 end;
end;

class function TFpcupWrapper.DefaultLazClone:LongString;
begin
 Result:=AddPathDelim(HomeDir)+AdaptExeFileName('resource\crwlazclone.cmd');
 Result:=UnifyFileAlias(Result);
end;

class function TFpcupWrapper.IniFileLazClone:LongString;
var s:LongString;
begin
 s:='';
 if ReadIniFilePath(SysIniFile,SectFpcupDeluxe,'LazClone',HomeDir,s)
 then s:=UnifyFileAlias(AdaptExeFileName(s),ua_RealPath) else s:=DefaultLazClone;
 Result:=s;
end;

class function TFpcupWrapper.DefaultLazBuild:LongString;
begin
 Result:=AddPathDelim(HomeDir)+AdaptExeFileName('resource\crwlazbuild.cmd');
 Result:=UnifyFileAlias(Result);
end;

class function TFpcupWrapper.IniFileLazBuild:LongString;
var s:LongString;
begin
 s:='';
 if ReadIniFilePath(SysIniFile,SectFpcupDeluxe,'LazBuild',HomeDir,s)
 then s:=UnifyFileAlias(AdaptExeFileName(s),ua_RealPath) else s:=DefaultLazBuild;
 Result:=s;
end;

class function TFpcupWrapper.DefaultLazHelp:LongString;
begin
 Result:=AddPathDelim(HomeDir)+AdaptExeFileName('resource\crwlazhelp.cmd');
 Result:=UnifyFileAlias(Result);
end;

class function TFpcupWrapper.IniFileLazHelp:LongString;
var s:LongString;
begin
 s:='';
 if ReadIniFilePath(SysIniFile,SectFpcupDeluxe,'LazHelp',HomeDir,s)
 then s:=UnifyFileAlias(AdaptExeFileName(s),ua_RealPath) else s:=DefaultLazHelp;
 Result:=s;
end;

class function TFpcupWrapper.DefaultLazIndex:LongString;
begin
 Result:='toc.chm';
end;

class function TFpcupWrapper.IniFileLazIndex:LongString;
var s:LongString;
begin
 s:='';
 if ReadIniFileAlpha(SysIniFile,SectFpcupDeluxe,'LazIndex',s,efConfigNC)
 then Result:=LowerCase(Trim(s))
 else Result:=DefaultLazIndex;
end;

class function TFpcupWrapper.DefaultCrwLibIndex:LongString;
begin
 Result:=AddPathDelim(HomeDir)+AdaptFileName('..\crwlib\crwlib.chm');
 Result:=UnifyFileAlias(Result);
end;

class function TFpcupWrapper.IniFileCrwLibIndex:LongString;
var s:LongString;
begin
 s:='';
 if ReadIniFilePath(SysIniFile,SectFpcupDeluxe,'CrwLibIndex',HomeDir,s)
 then s:=UnifyFileAlias(AdaptFileName(s),ua_RealPath) else s:=DefaultCrwLibIndex;
 Result:=s;
end;

class function TFpcupWrapper.NewFpcupWrapperFromIniFile:TFpcupWrapper;
begin
 Result:=NewFpcupWrapper(IniFileLazBuild);
end;

const
 TheFpcup : TFpcupWrapper = nil;

function  Fpcup:TFpcupWrapper;
begin
 if not Assigned(TheFpcup) then begin
  TheFpcup:=TFpcupWrapper.NewFpcupWrapperFromIniFile;
  TheFpcup.Master:=@TheFpcup;
 end;
 Result:=TheFpcup;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_fpcup;
begin
 TFpcupWrapper.StdIoPipeSizeKb:=64;
end;

procedure Free_crw_fpcup;
begin
 Kill(TheFpcup);
end;

initialization

 Init_crw_fpcup;

finalization

 Free_crw_fpcup;

end.

//////////////
// END OF FILE
//////////////

