mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 19:28:45 +02:00

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 -
188 lines
4.6 KiB
ObjectPascal
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.
|