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

git-svn-id: trunk@32291 -

packages/fcl-base/src/custapp.pp

@@ -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.