{*******************************************************************************
MainUnit: main.pas

contains functions of Tab "Tools"
*******************************************************************************}

{*******************************************************************************
LazUpdater runs SVN Update/Checkout, Make and Strip for FPC and Lazarus.
Copyright (C) 2010  Ingo Steiniger

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 3 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, see <http://www.gnu.org/licenses/>.
*******************************************************************************}


{*******************************************************************************
   Helperfunction: create symlinks of ppcxxx
*******************************************************************************}
function TForm_Main.createSymLinks():Boolean;
var CompFpcVer:String;
    i:Integer;
begin
  Result:=True;
  FUseAsync:=False;
  i:=0;
  SilentOut:=True;
  if DirectoryExists(setPathDelim(Edit_FpcUpdDir.Text)+'compiler') then
  begin
    //***64bit?
    if FileExists(setPathDelim(Edit_FpcUpdDir.Text)+'compiler/ppcx64') then
    begin
      //call compiled version in source directory to get version number
      callProcess(setPathDelim(Edit_FpcUpdDir.Text)+'compiler', setPathDelim(Edit_FpcUpdDir.Text)+'compiler/ppcx64 -iW');
      CompFpcVer:=Output;
      //is it installed already?
      if FileExists(setPathDelim(Edit_FpcInstDir.Text)+'lib/fpc/'+CompFpcVer+'/ppcx64') then
      begin
        //is there a symlink already?
        if FileExists(setPathDelim(Edit_FpcInstDir.Text)+'bin/ppcx64') then
          DeleteFile(setPathDelim(Edit_FpcInstDir.Text)+'bin/ppcx64');
        //create link
        if callProcess(Edit_FpcInstDir.Text, 'ln -s '+setPathDelim(Edit_FpcInstDir.Text)+'lib/fpc/'+CompFpcVer+'/ppcx64 '+setPathDelim(Edit_FpcInstDir.Text)+'bin/ppcx64') = 0 then
          inc(i);
      end;
    end;

    //***32bit?
    if FileExists(setPathDelim(Edit_FpcUpdDir.Text)+'compiler/ppc386') then
    begin
      //call compiled version in source directory to get version number
      callProcess(setPathDelim(Edit_FpcUpdDir.Text)+'compiler', setPathDelim(Edit_FpcUpdDir.Text)+'compiler/ppc386 -iW');
      CompFpcVer:=Output;
      //is it installed already?
      if FileExists(setPathDelim(Edit_FpcInstDir.Text)+'lib/fpc/'+CompFpcVer+'/ppc386') then
      begin
        //is there a symlink already?
        if FileExists(setPathDelim(Edit_FpcInstDir.Text)+'bin/ppc386') then
          DeleteFile(setPathDelim(Edit_FpcInstDir.Text)+'bin/ppc386');
        //create link
        if callProcess(Edit_FpcInstDir.Text, 'ln -s '+setPathDelim(Edit_FpcInstDir.Text)+'lib/fpc/'+CompFpcVer+'/ppc386 '+setPathDelim(Edit_FpcInstDir.Text)+'bin/ppc386') = 0 then
          inc(i);
      end;
    end;

    if i=0 then
    begin
      //no binary found!
      Result:=False;
    end;

  end else
  begin
    Result:=False;
  end;
  SilentOut:=False;
  FUseAsync:=ChBo_Async.Checked;
end;

{*******************************************************************************
   Button FPC.cfg

   - Could be improved by using version info of binary in source directory.
     (like CreateSymLinks() function)
*******************************************************************************}
procedure TForm_Main.Btn_FpcCfgClick(Sender: TObject);
begin
  //showMessage(FindDefaultExecutablePath('fpc'));
  {$ifdef WINDOWS}
  getFpcInfo;
  {$endif WINDOWS}
  Form_Select.Show;
end;

{*******************************************************************************
   Extend environment variable "PATH" for .../fpc/bin
*******************************************************************************}
procedure TForm_Main.Btn_AppPathClick(Sender: TObject);
{$ifdef UNIX}
var sProfPath:String;
    mySL:TStrings;
begin
  if Edit_FpcInstDir.Text<>'' then
  begin
    sProfPath:=setPathDelim(HomeDir)+'.profile';
    mySL:=TStringList.Create;
    if FileExists(sProfPath) then
      mySL.LoadFromFile(sProfPath);
    if mySL.IndexOf('# set PATH for FPC')=-1 then
    begin
      mySL.Append('# set PATH for FPC');
      mySL.Append('if [ -d "'+setPathDelim(Edit_FpcInstDir.Text)+'bin" ] ; then');
      mySL.Append('    PATH="'+setPathDelim(Edit_FpcInstDir.Text)+'bin:$PATH"');
      mySL.Append('fi');
      mySL.SaveToFile(sProfPath);
      MessageDlg(rsThePATHHasBe, mtInformation, [mbOK], 0);
    end else
    begin
      MessageDlg(rsEntryForPATH, mtInformation, [mbOK], 0);
    end;
    mySL.Free;
  end else
  begin
    MessageDlg(rsPleaseCheckT, mtError, [mbOK], 0);
  end;
end;
{$else UNIX}
var Reg:TRegistry;
    RegPath:String;
begin
//  MessageDlg('I`m sorry. This feature isn`t implemented yet.', mtInformation, [mbOK], 0);
  if Edit_FpcInstDir.Text<>'' then
  begin
    getFpcInfo;
    Reg:=TRegistry.Create;
    Reg.OpenKey('\Environment', False);
    if not Reg.ValueExists('PATH') then
    begin
      Reg.WriteString('PATH', setPathDelim(Edit_FpcInstDir.Text)+'bin'+PathDelim+LUFpcInfo.CPU+'-'+LUFpcInfo.OS);
      MessageDlg(rsThePATHHasBe, mtInformation, [mbOK], 0);
    end else
    begin
      RegPath:=LowerCase(Reg.ReadString('PATH')); //lowercase for comparison
      if Pos(LowerCase(setPathDelim(Edit_FpcInstDir.Text)+'bin'+PathDelim+LUFpcInfo.CPU+'-'+LUFpcInfo.OS), Regpath)=0 then
      begin
        RegPath:=Reg.ReadString('PATH'); //read again current PATH
        Reg.WriteString('PATH', RegPath+';'+setPathDelim(Edit_FpcInstDir.Text)+'bin'+PathDelim+LUFpcInfo.CPU+'-'+LUFpcInfo.OS);
        MessageDlg(rsThePATHHasBe, mtInformation, [mbOK], 0);
      end else
      begin
        MessageDlg(rsEntryForPATH, mtInformation, [mbOK], 0);
      end;
    end;
    Reg.Free;
  end else
  begin
    MessageDlg(rsPleaseCheckT, mtError, [mbOK], 0);
  end;
end;
{$endif UNIX }

{*******************************************************************************
  Button create link for ppcxxx-binary in bin
*******************************************************************************}
procedure TForm_Main.Btn_ppclnkClick(Sender: TObject);
begin
{$ifdef WINDOWS}
  MessageDlg(rsThisIsNotNec, mtInformation, [mbOK], 0);
{$else WINDOWS}
  if DirectoryExists(Edit_FpcInstDir.Text) then
  begin
    if not createSymLinks then
    begin
      MessageDlg(Format(rsNoSymlinksWe, [#10]), mtError, [mbOK], 0);
    end else
    begin
      MessageDlg(rsSymlinksWere, mtInformation, [mbOK], 0);
    end;
  end else
  begin
    MessageDlg(rsPleaseCheckT, mtError, [mbOK], 0);
  end;
{$endif WINDOWS}
end;

{*******************************************************************************
   change binaries path
*******************************************************************************}
//LazBuild
procedure TForm_Main.Edit_BinLazBuildChange(Sender: TObject);
begin
  if (Edit_BinLazBuild.Text='') or (FileExists(Edit_BinLazBuild.Text) and not DirectoryExists(Edit_BinLazBuild.Text)) then
    Edit_BinLazBuild.Font.Color:=clBlack
  else
    Edit_BinLazBuild.Font.Color:=clRed;
  setBinaries;
end;

//FPC
procedure TForm_Main.Edit_BinFPCChange(Sender: TObject);
begin
  if (Edit_BinFPC.Text='') or (FileExists(Edit_BinFPC.Text) and not DirectoryExists(Edit_BinFPC.Text)) then
    Edit_BinFPC.Font.Color:=clBlack
  else
    Edit_BinFPC.Font.Color:=clRed;
  setBinaries;
end;

//Make
procedure TForm_Main.Edit_BinMakeChange(Sender: TObject);
begin
  if (Edit_BinMake.Text='') or (FileExists(Edit_BinMake.Text) and not DirectoryExists(Edit_BinMake.Text)) then
    Edit_BinMake.Font.Color:=clBlack
  else
    Edit_BinMake.Font.Color:=clRed;
  setBinaries;
end;

//SVN
procedure TForm_Main.Edit_BinSVNChange(Sender: TObject);
begin
  if (Edit_BinSVN.Text='') or (FileExists(Edit_BinSVN.Text) and not DirectoryExists(Edit_BinSVN.Text)) then
    Edit_BinSVN.Font.Color:=clBlack
  else
    Edit_BinSVN.Font.Color:=clRed;
  setBinaries;
end;

procedure TForm_Main.Edit_FpcInstDirChange(Sender: TObject);
begin
  LUFpcInstDir:=Edit_FpcInstDir.Text;
end;