// Deprecated, in new programs use dgetopt
{$mode objfpc}
{$modeswitch advancedrecords}
unit doptions;

interface

uses
  dexception,
  dtypes,
  dstrnum;

type
POptions = ^TOptions;

TOptionType = (OT_BOOL, OT_STR, OT_INT);

POption = ^TOption;
TOption = record
  _Type: TOptionType;
  ShortName: Char;
  LongName: String;
  Description: String;
  Defined: Boolean;
  DefinedValue: String;
  DefaultValue: String;
  procedure Init(C: Char);
  function Value: String;
end;

TArrayOfString = array of String;

TOptions = object
private
  FOptions: array of TOption;
  FFreeArgsCount: Integer;
  FFreeArgs: TArrayOfString;
public
  procedure Init;
  //   FreeArgsCount: count of free args, -1 for infinity
  procedure Init(const ShortSet: String; FreeArgsCount: Integer = 0);
  procedure Done;
  procedure SetFormat(const ShortSet: String; FreeArgsCount: Integer = 0);
  function Has(C: Char; const Desc: String = ''): Boolean;
  function Arg(C: Char; const Desc: String; out V: String; Def: PAnsiChar = nil): Boolean;
  function Arg(C: Char; const Desc: String; Def: PAnsiChar = nil): String;
  function Int(C: Char; const Desc: String; Def: Integer): Integer;
  // Read options from ParamCount, ParamStr
  //   returns position of first unread paramstr
  function ReadParamStr(Start: Integer = 1): Integer;
  function FindLongOption(const Name: String): POption;
  function FindShortOption(Name: Char): POption;
  function FreeArgs: TArrayOfString;
end;

// for global use
// auto created (see initialization/finalization sections)
var
  Options: TOptions;

implementation

procedure TOption.Init(C: Char);
begin
  _Type := OT_BOOL;
  ShortName := c;
  LongName := '';
  Description := '';
  Defined := False;
  DefinedValue := '';
  DefaultValue := '';
end;

function TOption.Value: String;
begin
  if Defined then
      Result := DefinedValue
  else
      Result := DefaultValue;
end;

procedure TOptions.Init;
begin
end;

procedure TOptions.Init(const ShortSet: String; FreeArgsCount: Integer = 0);
begin
  SetFormat(ShortSet, FreeArgsCount);
end;

procedure TOptions.Done;
begin
end;

procedure TOptions.SetFormat(const ShortSet: String; FreeArgsCount: Integer = 0);
var
  I: Integer;
begin
  I := 1;
  while I <= Length(ShortSet) do begin
    SetLength(FOptions, Length(FOptions) + 1);
    FOptions[High(FOptions)].Init(ShortSet[I]);
    if (I < Length(ShortSet)) and (ShortSet[I + 1] = ':') then begin
        FOptions[High(FOptions)]._Type := OT_STR;
        Inc(I);
    end;
    Inc(I);
  end;
  FFreeArgsCount := FreeArgsCount;
end;

function TOptions.Has(C: Char; const Desc: String): Boolean;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if C = FOptions[I].ShortName then begin
          Result := FOptions[I].Defined;
          Exit;
      end;
  RaiseException('exception ''not defined option C''');
end;

function TOptions.Arg(C: Char; const Desc: String; out V: String; Def: PAnsiChar = nil): Boolean;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if C = FOptions[I].ShortName then begin
          if (Def <> nil) and not FOptions[I].Defined then begin
            V := Def;
		    Exit(True);
          end else begin
            V := FOptions[I].Value;
			Exit(False);
          end;
      end;
  if Def <> nil then
      V := Def;
  Exit(False);
end;

function TOptions.Arg(C: Char; const Desc: String; Def: PAnsiChar): String;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if C = FOptions[I].ShortName then begin
          if (Def <> nil) and not FOptions[I].Defined then
            Result := Def
          else
            Result := FOptions[I].Value;
          Exit;
      end;
  if Def <> nil then
      Exit(Def);
  RaiseException('exception ''not defined option C''');
end;

function TOptions.Int(C: Char; const Desc: String; Def: Integer): Integer;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if C = FOptions[I].ShortName then begin
          if not FOptions[I].Defined then
            Result := Def
          else
            Result := StrToInt(FOptions[I].Value);
          Exit;
      end;
  Exit(Def);
end;

function TOptions.ReadParamStr(Start: Integer = 1): Integer;
var
  I: Integer;
  S: String;
  O: POption;
begin
  I := Start;
  while I <= ParamCount do begin
      S := ParamStr(I);
      if S[1] <> '-' then
          Break;
      if S[2] = '-' then begin // long argument
          O := FindLongOption(Copy(S, 3, Length(S) - 2));
      end else begin // short argument
          O := FindShortOption(S[2]);
      end;

      O^.Defined := True;
      if O^._Type <> OT_BOOL then begin
          if (I = ParamCount) then
              RaiseException('exception ''need argument for option S''');
          O^.DefinedValue := ParamStr(I + 1);
          Inc(I);
      end;
      Inc(I);
  end;
  Result := I;

  SetLength(FFreeArgs, 0);
  if I > 0 then
    while I <= ParamCount do begin
      SetLength(FFreeArgs, Length(FFreeArgs) + 1);
      FFreeArgs[High(FFreeArgs)] := ParamStr(I);
      Inc(I);
    end;

  if (FFreeArgsCount <> -1) and (FFreeArgsCount <> Length(FFreeArgs)) then begin
      RaiseException(TString('exception ''') + IntToStr(Length(FFreeArgs)) + ' free arguments specified, must be ' + IntToStr(FFreeArgsCount) + '''');
  end;
end;

function TOptions.FindLongOption(const Name: String): POption;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if FOptions[I].LongName = Name then begin
          Result := @FOptions[I];
          Exit;
      end;
  RaiseException('exception ''unknown option --Name''');
end;

function TOptions.FindShortOption(Name: Char): POption;
var
  I: Integer;
begin
  for I := 0 to High(FOptions) do
      if FOptions[I].ShortName = Name then begin
          Result := @FOptions[I];
          Exit;
      end;
  RaiseException('exception ''unknown option -C''');
end;

function TOptions.FreeArgs: TArrayOfString;
begin
  Result := FFreeArgs;
end;

initialization
  Options.Init;
finalization
  Options.Done;
end.
