paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 23:24:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Non-Options, multiple identical options support (corrected)

Browse Source 
git-svn-id: trunk@32291 -
This commit is contained in:
michael 2015-11-11 16:39:30 +00:00
parent 8046826e4e
commit bc1248ceb7
1 changed files with 123 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
packages/fcl-base/src/custapp.pp
View File

@ -21,6 +21,7 @@ Interface
uses SysUtils,Classes,singleinstance;
Type
TStringArray = Array of string;
TExceptionEvent = Procedure (Sender : TObject; E : Exception) Of Object;
TEventLogTypes = Set of TEventType;
@ -45,6 +46,7 @@ Type
Function GetLocation : String;
function GetTitle: string;
Protected
function GetOptionAtIndex(AIndex: Integer; IsLong: Boolean): String;
procedure SetTitle(const AValue: string); Virtual;
Function GetConsoleApplication : boolean; Virtual;
Procedure DoRun; Virtual;
@ -61,9 +63,10 @@ Type
procedure ShowException(E: Exception);virtual;
procedure Terminate; virtual;
// Extra methods.
function FindOptionIndex(Const S : String; Var Longopt : Boolean) : Integer;
function FindOptionIndex(Const S : String; Var Longopt : Boolean; StartAt : Integer = -1) : Integer;
Function GetOptionValue(Const S : String) : String;
Function GetOptionValue(Const C: Char; Const S : String) : String;
Function GetOptionValues(Const C: Char; Const S : String) : TStringArray;
Function HasOption(Const S : String) : Boolean;
Function HasOption(Const C : Char; Const S : String) : Boolean;
Function CheckOptions(Const ShortOptions : String; Const Longopts : TStrings; Opts,NonOpts : TStrings; AllErrors : Boolean = False) : String;
@ -71,6 +74,8 @@ Type
Function CheckOptions(Const ShortOptions : String; Const Longopts : TStrings; AllErrors : Boolean = False) : String;
Function CheckOptions(Const ShortOptions : String; Const LongOpts : Array of string; AllErrors : Boolean = False) : String;
Function CheckOptions(Const ShortOptions : String; Const LongOpts : String; AllErrors : Boolean = False) : String;
Function GetNonOptions(Const ShortOptions : String; Const Longopts : Array of string) : TStringArray;
Procedure GetNonOptions(Const ShortOptions : String; Const Longopts : Array of string; NonOptions : TStrings);
Procedure GetEnvironmentList(List : TStrings;NamesOnly : Boolean);
Procedure GetEnvironmentList(List : TStrings);
Procedure Log(EventType : TEventType; const Msg : String);
@ -330,6 +335,34 @@ begin
FTerminated:=True;
end;
function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;
Var
P : Integer;
O : String;
begin
Result:='';
If (AIndex=-1) then
Exit;
If IsLong then
begin // Long options have form --option=value
O:=Params[AIndex];
P:=Pos('=',O);
If (P=0) then
P:=Length(O);
Delete(O,1,P);
Result:=O;
end
else
begin // short options have form '-o value'
If (AIndex<ParamCount) then
if (Copy(Params[AIndex+1],1,1)<>'-') then
Result:=Params[AIndex+1];
end;
end;
function TCustomApplication.GetOptionValue(const S: String): String;
begin
Result:=GetoptionValue(#255,S);
@ -340,32 +373,64 @@ function TCustomApplication.GetOptionValue(const C: Char; const S: String
Var
B : Boolean;
I,P : integer;
O : String;
I : integer;
begin
Result:='';
I:=FindOptionIndex(C,B);
If (I=-1) then
I:=FindoptionIndex(S,B);
If (I<>-1) then
begin
If B then
begin // Long options have form --option=value
O:=Params[I];
P:=Pos('=',O);
If (P=0) then
P:=Length(O);
Delete(O,1,P);
Result:=O;
end
else
begin // short options have form '-o value'
If (I<ParamCount) then
if (Copy(Params[I+1],1,1)<>'-') then
Result:=Params[I+1];
I:=FindOptionIndex(S,B);
If I<>-1 then
Result:=GetOptionAtIndex(I,B);
end;
function TCustomApplication.GetOptionValues(const C: Char; const S: String): TStringArray;
Var
I,Cnt : Integer;
B : Boolean;
begin
SetLength(Result,ParamCount);
Cnt:=0;
Repeat
I:=FindOptionIndex(C,B,I);
If I<>-1 then
begin
Inc(Cnt);
Dec(I);
end;
end;
Until I=-1;
Repeat
I:=FindOptionIndex(S,B,I);
If I<>-1 then
begin
Inc(Cnt);
Dec(I);
end;
Until I=-1;
SetLength(Result,Cnt);
Cnt:=0;
I:=-1;
Repeat
I:=FindOptionIndex(C,B,I);
If (I<>-1) then
begin
Result[Cnt]:=GetOptionAtIndex(I,False);
Inc(Cnt);
Dec(i);
end;
Until (I=-1);
I:=-1;
Repeat
I:=FindOptionIndex(S,B,I);
If I<>-1 then
begin
Result[Cnt]:=GetOptionAtIndex(I,True);
Inc(Cnt);
Dec(i);
end;
Until (I=-1);
end;
function TCustomApplication.HasOption(const S: String): Boolean;
@ -378,7 +443,7 @@ begin
end;
function TCustomApplication.FindOptionIndex(const S: String;
var Longopt: Boolean): Integer;
var Longopt: Boolean; StartAt : Integer = -1): Integer;
Var
SO,O : String;
@ -390,11 +455,14 @@ begin
else
SO:=S;
Result:=-1;
I:=ParamCount;
I:=StartAt;
if (I=-1) then
I:=ParamCount;
While (Result=-1) and (I>0) do
begin
O:=Params[i];
If (Length(O)>0) and (O[1]=FOptionChar) then
// - must be seen as an option value
If (Length(O)>1) and (O[1]=FOptionChar) then
begin
Delete(O,1,1);
LongOpt:=(Length(O)>0) and (O[1]=FOptionChar);
@ -645,4 +713,35 @@ begin
end;
end;
function TCustomApplication.GetNonOptions(const ShortOptions: String;
const Longopts: array of string): TStringArray;
Var
NO : TStrings;
I : Integer;
begin
No:=TStringList.Create;
try
GetNonOptions(ShortOptions,LongOpts,No);
SetLength(Result,NO.Count);
For I:=0 to NO.Count-1 do
Result[I]:=NO[i];
finally
NO.Free;
end;
end;
procedure TCustomApplication.GetNonOptions(const ShortOptions: String;
const Longopts: array of string; NonOptions: TStrings);
Var
S : String;
begin
S:=CheckOptions(ShortOptions,LongOpts,Nil,NonOptions,true);
if (S<>'') then
Raise EListError.Create(S);
end;
end.