lazarus-ccr/components/iphonelazext/lazfilesutils.pas

{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the iPhone Laz Extension                            *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  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.                     *
 *                                                                           *
 *****************************************************************************
}
unit lazfilesutils;

{$mode objfpc}{$H+}

interface

uses
  {$ifdef Unix}BaseUnix,{$endif}
  Classes, SysUtils, FileUtil, Masks,
  LazIDEIntf,ProjectIntf;


function ResolveProjectPath(const path: string; project: TLazProject = nil): string;

function BreakPathsStringToOption(const Paths, Switch: String; const Quotes: string = '"'; project: TLazProject = nil): String;

function RelativeToFullPath(const BasePath, Relative: string): String;
function NeedQuotes(const path: string): Boolean;

function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean;

implementation

{$ifdef Unix}
function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean;
var
  allfiles  : TStringList;
  i         : Integer;
  pth       : string;
  MaskList  : TMaskList;
  curdir    : string;
  linkdir   : string;
  linkname  : string;
begin
  Result:=DirectoryExistsUTF8(SrcDir) and ForceDirectoriesUTF8(DstDir);
  if not Result then Exit;

  //todo: don't use FindAllFiles(), use sub dir search

  allfiles:=FindAllFiles(SrcDir, AllFilesMask, False);
  Result:=Assigned(allfiles);
  if not Result then Exit;

  MaskList := TMaskList.Create(FilterMask);

  curdir:=IncludeTrailingPathDelimiter(SrcDir);
  linkdir:=IncludeTrailingPathDelimiter(DstDir);
  for i:=0 to allfiles.Count-1 do begin
    pth:=allfiles[i];
    if (FilterMask='') or (not MaskList.Matches(pth)) then begin
      linkname:=linkdir+Copy(pth, length(curdir), length(pth));
      writeln('link from: ', pth);
      writeln('       to: ', linkname);
      fpSymlink(PAnsiChar(pth), PAnsiChar(linkname));
    end;
  end;
  allfiles.Free;
end;
{$else}
function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean;
begin
  Result:=false;
end;
{$endif}


function GetNextDir(const Path: string; var index: integer; var Name: string): Boolean;
var
  i : Integer;
begin
  Result:=index<=length(Path);
  if not Result then Exit;

  if Path[index]=PathDelim then inc(index);
  Result:=index<=length(Path);
  if not Result then Exit;

  for i:=index to length(Path) do
    if Path[i]=PathDelim then begin
      Name:=Copy(Path, index, i - index);
      index:=i+1;
      Exit;
    end;
  Name:=Copy(Path, index, length(Path) - index+1);
  index:=length(Path)+1;
end;

function RelativeToFullPath(const BasePath, Relative: string): String;
var
  i  : integer;
  nm : string;
begin
  Result:=ExcludeTrailingPathDelimiter(BasePath);
  i:=1;
  while GetNextDir(Relative, i, nm) do
    if nm = '..' then
      Result:=ExtractFileDir(Result)
    else if nm <> '.' then
      Result:=IncludeTrailingPathDelimiter(Result)+nm;
end;

function NeedQuotes(const path: string): Boolean;
var
  i : integer;
const
  SpaceChars = [#32,#9];
begin
  for i:=1 to length(path) do
    if path[i] in SpaceChars then begin
      Result:=true;
      Exit;
    end;
  Result:=false;
end;

function QuoteStrIfNeeded(const path: string; const quotes: String): String;
begin
  if NeedQuotes(path) then
    Result:=quotes+path+quotes
  else
    Result:=path;
end;

function ResolveProjectPath(const path: string; project: TLazProject): string;
var
  base : string;
begin
  if project=nil then project:=LazarusIDE.ActiveProject;

  if FilenameIsAbsolute(Path) then
    Result:=Path
  else begin
    base:='';
    base:=ExtractFilePath(project.ProjectInfoFile);
    Result:=RelativeToFullPath(base, Path);
  end;
end;

function BreakPathsStringToOption(const Paths, Switch, Quotes: String; project: TLazProject): String;
var
  i, j  : Integer;
  fixed : String;
begin
  Result:='';
  if not Assigned(project) then
    project:=LazarusIDE.ActiveProject;

  if not Assigned(project) then Exit;

  j:=1;
  for i:=1 to length(paths)-1 do
    if Paths[i]=';' then begin
      fixed:=Trim(Copy(paths,j, i-j)  );
      if fixed<>'' then begin
        fixed:=ResolveProjectPath(fixed, project);
        Result:=Result+' ' + Switch + QuoteStrIfNeeded(fixed, quotes);
      end;
      j:=i+1;
    end;

  fixed:=Trim(Copy(paths,j, length(paths)-j+1)  );
  if fixed<>'' then begin
    fixed:=ResolveProjectPath(fixed, project);
    Result:=Result+' ' + Switch + QuoteStrIfNeeded(fixed, quotes);
  end;
end;

end.