* Non-Options, multiple identical options support

git-svn-id: trunk@32288 -

packages/fcl-base/src/custapp.pp

@@ -18,22 +18,19 @@ unit CustApp;
 
 Interface
 
-uses SysUtils,Classes,singleinstance;
+uses SysUtils,Classes;
 
 Type
+  TStringArray = Array of string;
   TExceptionEvent = Procedure (Sender : TObject; E : Exception) Of Object;
   TEventLogTypes = Set of TEventType;
 
-  TCustomApplication = Class;
-  TCustomSingleInstance = Class;
-
   { TCustomApplication }
 
   TCustomApplication = Class(TComponent)
   Private
     FEventLogFilter: TEventLogTypes;
     FOnException: TExceptionEvent;
-    FSingleInstance: TCustomSingleInstance;
     FTerminated : Boolean;
     FHelpFile,
     FTitle : String;
@@ -45,6 +42,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 +59,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 +70,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);
@@ -90,15 +91,6 @@ Type
     Property CaseSensitiveOptions : Boolean Read FCaseSensitiveOptions Write FCaseSensitiveOptions;
     Property StopOnException : Boolean Read FStopOnException Write FStopOnException;
     Property EventLogFilter : TEventLogTypes Read FEventLogFilter Write FEventLogFilter;
-    Property SingleInstance: TCustomSingleInstance read FSingleInstance;
-  end;
-
-  TCustomSingleInstance = class(TBaseSingleInstance)
-  private
-    FEnabled: Boolean;
-  public
-    //you must set Enabled before CustomApplication.Initialize
-    property Enabled: Boolean read FEnabled write FEnabled;
   end;
 
 var CustomApplication : TCustomApplication = nil;
@@ -241,10 +233,7 @@ end;
 
 procedure TCustomApplication.DoRun;
 begin
-  if FSingleInstance.IsServer then
-    FSingleInstance.ServerCheckMessages;
-
-  // Override in descendent classes.
+  // Do nothing. Override in descendent classes.
 end;
 
 procedure TCustomApplication.DoLog(EventType: TEventType; const Msg: String);
@@ -266,7 +255,6 @@ begin
   FOptionChar:='-';
   FCaseSensitiveOptions:=True;
   FStopOnException:=False;
-  FSingleInstance := TCustomSingleInstance.Create(Self);
 end;
 
 destructor TCustomApplication.Destroy;
@@ -293,18 +281,6 @@ end;
 procedure TCustomApplication.Initialize;
 begin
   FTerminated:=False;
-  if FSingleInstance.Enabled then
-  begin
-    case FSingleInstance.Start of
-      siClient:
-      begin
-        FSingleInstance.ClientPostParams;
-        FTerminated:=True;
-      end;
-      siNotResponding:
-        FTerminated:=True;
-    end;
-  end;
 end;
 
 procedure TCustomApplication.Run;
@@ -335,37 +311,96 @@ begin
   Result:=GetoptionValue(#255,S);
 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 C: Char; const S: String
   ): 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 +413,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 +425,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);
@@ -471,11 +509,11 @@ Var
   end;
 
   Procedure AddToResult(Const Msg : string);
-
+  
   begin
     If (Result<>'') then
       Result:=Result+sLineBreak;
-    Result:=Result+Msg;
+    Result:=Result+Msg;  
   end;
 
 begin
@@ -645,4 +683,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.