fpc/utils/fpcreslipo/paramparser.pp
michael 174de3eab1 Merged revisions 9693-10480 via svnmerge from
svn+ssh://svn.freepascal.org/FPC/svn/fpc/branches/resources

........
  r9694 | michael | 2008-01-09 21:31:18 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * Initial check-in
........
  r9695 | michael | 2008-01-09 21:35:58 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * New version from Giulio Bernardi
........
  r9697 | michael | 2008-01-09 21:41:54 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * Patch from Giulio Bernardi with resource support
........
  r9698 | michael | 2008-01-09 21:46:33 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * Patch from Giulio Bernardi to add more resource testing
........
  r9699 | michael | 2008-01-09 21:57:26 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * New tool from Giulio Bernardi
........
  r9700 | michael | 2008-01-09 21:58:23 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * New tool from Giulio Bernardi
........
  r9701 | michael | 2008-01-09 22:01:54 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * Added fcl-res
........
  r9702 | michael | 2008-01-09 22:01:58 +0100 (Wed, 09 Jan 2008) | 1 line
  
  * Added fcl-res
........
  r9703 | michael | 2008-01-10 08:54:26 +0100 (Thu, 10 Jan 2008) | 1 line
  
  * Fixed double code
........
  r9704 | jonas | 2008-01-10 10:59:20 +0100 (Thu, 10 Jan 2008) | 2 lines
  
    - removed duplicate code
........
  r9705 | jonas | 2008-01-10 11:25:21 +0100 (Thu, 10 Jan 2008) | 2 lines
  
    + added missing fcl-res dependencies
........
  r9706 | jonas | 2008-01-10 11:58:30 +0100 (Thu, 10 Jan 2008) | 2 lines
  
    + dependencies for fpintres and fpextres
........
  r9707 | yury | 2008-01-10 12:47:51 +0100 (Thu, 10 Jan 2008) | 3 lines
  
  * Fixed compilation of resource, which is included in a unit located in different folder than main source.
  * .res files must be copied to units output folder, otherwise .res files will not be found when only compiled units path is available and compiler does not know anything about sources folder.
  * Improved resource related error messages.
........
  r9708 | michael | 2008-01-10 12:52:13 +0100 (Thu, 10 Jan 2008) | 1 line
  
  * Removed double source after end.
........
  r9709 | michael | 2008-01-10 12:52:48 +0100 (Thu, 10 Jan 2008) | 1 line
  
  * No longer needed
........
  r9710 | tom_at_work | 2008-01-10 22:09:08 +0100 (Thu, 10 Jan 2008) | 1 line
  
  * properly align FPC_RESLOCATION so that linking does not fail on some architectures (e.g. ppc64)
........
  r9711 | tom_at_work | 2008-01-10 23:53:12 +0100 (Thu, 10 Jan 2008) | 1 line
  
  * fix splitting of 64 bit load/stores from/to unaligned memory locations into multiple load/stores, which in some cases generated wrong code
........
  r9712 | michael | 2008-01-11 11:00:08 +0100 (Fri, 11 Jan 2008) | 1 line
  
  * Fixed bug in BSS section on 64-bit platforms
........
  r9720 | giulio | 2008-01-12 10:02:04 +0100 (Sat, 12 Jan 2008) | 1 line
  
  Updated fcl-res documentation: occurrences of reslib changed to fcl-res.
........
  r9740 | giulio | 2008-01-13 19:36:44 +0100 (Sun, 13 Jan 2008) | 3 lines
  
   - Don't try to compile resources on systems with a non windows-like resource support.
   - Don't add the .or file to the list of object files if resource compiling failed.
........
  r10201 | giulio | 2008-02-04 11:35:44 +0100 (Mon, 04 Feb 2008) | 5 lines
  
  * resource compiling supported on OS/2 via wrc
  * CompileResourceFiles and CollectResourceFiles don't do target-specific checks anymore
  * refactored a bit
........
  r10389 | giulio | 2008-02-25 21:32:52 +0100 (Mon, 25 Feb 2008) | 2 lines
  
  Deleted test file which was committed by mistake
........
  r10472 | giulio | 2008-03-10 12:22:18 +0100 (Mon, 10 Mar 2008) | 2 lines
  
  changed define FPC_HAS_RESOURCES to FPC_HAS_WINLIKERESOURCES
........

git-svn-id: trunk@10481 -
2008-03-12 21:33:48 +00:00

188 lines
4.6 KiB
ObjectPascal

{
FPCResLipo - Free Pascal External Resource Thinner
Part of the Free Pascal distribution
Copyright (C) 2008 by Giulio Bernardi
Handles the parsing of parameters
See the file COPYING, 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 paramparser;
{$MODE OBJFPC} {$H+}
interface
uses
Classes, SysUtils, externaltypes;
type
EParametersException = class(Exception);
EOutputFileAlreadySetException = class(EParametersException);
EUnknownParameterException = class(EParametersException);
EArgumentMissingException = class(EParametersException);
EUnknownEndianessException = class(EParametersException);
type
{ TParameters }
TParameters = class
private
fHelp : boolean;
fVersion : boolean;
fVerbose : boolean;
fInputFiles : TStringList;
fOutputFile : string;
fEndianess : byte;
procedure ParseOutputFile(aList : TStringList; var index : integer; const parname : string);
procedure ParseEndianess(aList : TStringList; var index : integer; const parname : string);
function DoOptionalArgument(aList : TStringList; const i : integer) : string;
function DoMandatoryArgument(aList : TStringList; const i : integer) : string;
function IsParameter(const s : string) : boolean;
function ParamsToStrList : TStringList;
protected
public
constructor Create;
destructor Destroy; override;
procedure Parse;
property Help : boolean read fHelp;
property Version : boolean read fVersion;
property Verbose : boolean read fVerbose;
property InputFiles : TStringList read fInputFiles;
property OutputFile : string read fOutputFile write fOutputFile;
property Endianess : byte read fEndianess write fEndianess;
end;
implementation
uses
msghandler;
{ TParameters }
procedure TParameters.ParseOutputFile(aList: TStringList; var index: integer;
const parname : string);
begin
if fOutputFile<>'' then
raise EOutputFileAlreadySetException.Create('');
inc(index);
fOutputFile:=DoMandatoryArgument(aList,index);
if fOutputFile='' then
raise EArgumentMissingException.Create(parname);
end;
procedure TParameters.ParseEndianess(aList: TStringList; var index: integer;
const parname: string);
var tmp : string;
begin
inc(index);
tmp:=LowerCase(DoMandatoryArgument(aList,index));
if tmp='' then
raise EArgumentMissingException.Create(parname);
if tmp='big' then fEndianess:=EXT_ENDIAN_BIG
else if tmp='little' then fEndianess:=EXT_ENDIAN_LITTLE
else raise EUnknownEndianessException.Create(tmp);
end;
function TParameters.DoOptionalArgument(aList: TStringList; const i: integer
): string;
begin
Result:='';
if aList.Count>i then
begin
if not IsParameter(aList[i]) then
Result:=aList[i];
end;
end;
function TParameters.DoMandatoryArgument(aList: TStringList; const i: integer
): string;
begin
Result:='';
if aList.count>i then
Result:=aList[i];
end;
function TParameters.IsParameter(const s: string): boolean;
begin
Result:=false;
if length(s)<=1 then exit;
if copy(s,1,1)='-' then Result:=true;
end;
function TParameters.ParamsToStrList: TStringList;
var i : integer;
begin
Result:=TStringList.Create;
try
for i:=1 to ParamCount do
Result.Add(ParamStr(i));
except
Result.Free;
raise;
end;
end;
procedure TParameters.Parse;
var fList : TStringList;
tmp : string;
i : integer;
begin
fList:=ParamsToStrList;
try
i:=0;
while i<fList.Count do
begin
tmp:=fList[i];
Messages.DoVerbose(Format('parsing parameter ''%s''',[tmp]));
if IsParameter(tmp) then
begin
if ((tmp='--help') or (tmp='-h') or (tmp='-?')) then
fHelp:=true
else if ((tmp='--version') or (tmp='-V')) then
fVersion:=true
else if ((tmp='--verbose') or (tmp='-v')) then
fVerbose:=true
else if ((tmp='-o') or (tmp='--output')) then
ParseOutputFile(fList,i,tmp)
else if ((tmp='-e') or (tmp='--endian')) then
ParseEndianess(fList,i,tmp)
else
raise EUnknownParameterException.Create(tmp);
end
else
fInputFiles.Add(tmp); //assume it is an input file
inc(i);
end;
finally
fList.Free;
end;
end;
constructor TParameters.Create;
begin
fHelp:=false;
fVersion:=false;
fVerbose:=false;
fInputFiles:=TStringList.Create;
fOutputFile:='';
fEndianess:=EXT_ENDIAN_BIG;
end;
destructor TParameters.Destroy;
begin
fInputFiles.Free;
end;
end.