{ CMDLINE.PAS -- Command line parameters parsing }
unit cmdline;
{$I DEFINE.PAS}
interface

{use following method:

  function ProcessCommadLine(Options : POptionsArray; OptionCount : Integer) : Boolean;

  where Options is predefined constats array (see TOptionsArray) of
  allowed command line parameters and OptionCount their count;

  Returns false if encountered undefined parameter or it has wrong value
}
const
  MaxOptions = 100;

{oiXXXX predefined Options Indexes (such options should be defined
  by any application that wants to use cmdline) }
  oiHelp = 1;
  oiBootLog = 2;

type
  TOptionType = (otBool, otInt, otString, otFilename);
{$IFNDEF WINDOWS}
  ShortString = string;
{$ENDIF}
  TOptionName = string[4];
  POptionRec = ^TOptionRec;
  TOptionRec = record
    OptionName : TOptionName;
      {if option char = ' ', then it is nonoption
        command parameter, such beasts must appear in command line
        in predefined order, and they don't start with '-' or '/';
        if more such parameters appear, then is number of ' ' optionrecords
        it is an error
      }
    OptionDesc:PChar; { Description of the option's function }
    Flag:longint;
      { otBool, then can assign to Flag binary mask that will be used
        to update CMDLineFlags variable }
    Present: boolean;
      { was the option present in the command line? }
    case Option : TOptionType of
      otBool : (OnOff : Boolean);
      otInt : (Value : Longint);
      otString : (Param : ShortString);
      otFilename : (Filename : ShortString);
  end;

  POptionsArray = ^TOptionsArray;
  TOptionsArray = Array [1..MaxOptions] of TOptionRec;
const
  CMDLineFlags:longint = 0;{combined from otBool options that have assinged Flag}
  CMDLineOptions:POptionsArray = nil;
  { Set by last call to ProcessCommandLine }
  CMDLineOptionCount:integer = 0;
  { Set by last call to ProcessCommandLine }
  DefCMDLineOptions:POptionsArray = nil;
  { Copy of the original Options array passed to ProcessCommandLine,
    before it is changed (i.e. contains default values) }


{
  GetOptionRec -- return a pointer to the options record in the
  passed Options array that corresponds to the specified option
  character.  Returns Nil if the option character is not in
  the passed Options array.
}
function GetOptionRec
      (
        Options : POptionsArray;
        OptionCount : Integer;
        OptionName : TOptionName
      ) : POptionRec;

{
  ProcessCommandLine -- process the command line according to the
  parameters list passed in the Options array.  Returns True if
  successful, or False if an error occurred in processing.
}
function ProcessCommandLine
      (
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;

procedure PrintOptionsHelp;{of last options passed to ProcessCommandLine}

implementation

{
  GetOptionRec -- return a pointer to the options record in the
  passed Options array that corresponds to the specified option
  character.  Returns Nil if the option character is not in
  the passed Options array.
}
function GetOptionRec
      (
        Options : POptionsArray;
        OptionCount : Integer;
        OptionName : TOptionName
      ) : POptionRec;
var
  i : Integer;
{$IFNDEF WINDOWS}
  Result:POptionRec;
{$ENDIF}
begin
  Result := Nil;
  for i := 1 to OptionCount do begin
    if (pos(Options^[i].OptionName, OptionName) = 1) then begin
      Result := @Options^[i].OptionName;
      Break;
    end;
  end;
{$IFNDEF WINDOWS}
  GetOptionRec := Result;
{$ENDIF}
end;

{
  ProcessBool

  Extract the on/off state for a parameter.  If the passed Param
  is a blank string, it is assumed to be On (+).  Otherwise the
  routine expects the string to start with + or -, and sets the
  OnOff variable accordingly.
}
function ProcessBool
      (
        Param : String;
        var OnOff : Boolean
      ) : Boolean;
{$IFNDEF WINDOWS}
var
  Result:boolean;
{$ENDIF}
label ex;
begin
  Result := True;

  if (Length (Param) = 0) then begin
    OnOff := True;
    goto ex;
  end;

  case Param[1] of
    '+' : OnOff := True;
    '-' : OnOff := False;

    else begin
      WriteLn ('Error:  + or - expected');
      Result := False;
    end;
  end;
ex:
{$IFNDEF WINDOWS}
  ProcessBool := Result;
{$ENDIF}
end;

{
  ProcessInt

  Extract an integer from the passed command line parameter.
}
function ProcessInt
      (
        Param : String;
        var Value : longint
      ) : Boolean;
label ex;
var code:integer;
{$IFNDEF WINDOWS}
var
  Result:boolean;
{$ENDIF}
begin
  if (Length (Param) = 0) then begin
    Result := False;
    WriteLn ('Error:  integer expected');
    goto ex;
  end;

  Result := True;
  val(Param, Value, code);
  if code <> 0 then begin
    WriteLn ('Error:  integer expected');
    Result := False;
  end;
ex:
{$IFNDEF WINDOWS}
  ProcessInt := Result;
{$ENDIF}
end;

{
  ProcessString

  Copy the passed string to the Option variable.  No error checking
  is performed, and a blank string is considered a valid parameter.
}
function ProcessString
      (
        Param : String;
        var Option : ShortString
      ) : Boolean;
begin
  Option := Param;
{$IFNDEF WINDOWS}
  ProcessString := true;
{$ELSE}
  Result := True;
{$ENDIF}
end;

{
  ProcessFilename

  Extract a file name from the passed command line parameter.
  Currently, this function just calls ProcessString to copy the
  string parameter to the Filename.  It could, in the future,
  check to see if the string represents a valid file name, or it
  could be used to expand a short filename to a full path/file.
}
function ProcessFilename
      (
        Param : String;
        var Filename : ShortString
      ) : Boolean;
begin
{$IFNDEF WINDOWS}
  ProcessFileName := ProcessString (Param, Filename);
{$ELSE}
  Result := ProcessString (Param, Filename);
{$ENDIF}
end;

{var
  CurNonOptPar:integer;}

{
  CheckParam

  Check the passed Param, representing one command-line argument, against
  the list of options.  If the option character is valid, then process
  the option based on its type (Boolean, Integer, String, or Filename).

  Returns True if option processed and stored correctly, False otherwise.
}
function CheckParam
      (
        Param : String;
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;
var
  Rec : POptionRec;
  Option : String;
{label ex;}
{$IFNDEF WINDOWS}
var Result:Boolean;
{$ENDIF}

  function CheckNonOption:boolean;
  var
    i:integer;
    {nonOpts:integer;}
  begin
    CheckNonOption := false;
    {nonOpts := 0;}
    for i := 1 to OptionCount do begin
      if (Options^[i].OptionName = ' ') and (not Options^[i].Present) then begin
        {if nonOpts < CurNonOptPar then
          continue;
        inc(nonOpts);}
        Options^[i].Param := Param; Options^[i].Present := true;
        {CurNonOptPar := nonOpts;}
        CheckNonOption := true;
        Break;
      end;
    end;
  end;

begin
  Result := False;
  if (Param[1] in ['-', '/']) then begin
    if (Length (Param) < 2) then begin
      WriteLn ('Invalid option');
    end
    else begin
      Rec := GetOptionRec (Options, OptionCount, copy(Param,2,255){Param[2]});
      if (Rec <> Nil) then begin
        Rec^.Present := true;
        Option := Copy (Param, 3, Length (Param) - 2);
        case Rec^.Option of
          otBool :
            Result := ProcessBool (Option, Rec^.OnOff);
          otInt :
            Result := ProcessInt (Option, Rec^.Value);
          otString :
            Result := ProcessString (Option, Rec^.Param);
          otFilename :
            Result := ProcessFilename (Option, Rec^.Filename);
          else
            WriteLn ('Invalid option specification: ', Param[2]);
        end;
      end else begin
        WriteLn ('Invalid option character: ', Param[2]);
      end;
    end;
  end
  else begin
    if not CheckNonOption then
    begin
      {WriteLn ('Error: options must start with - or /:' + Param);
      ignore it}
      Result := true;
    end else
      Result := true;
  end;
{$IFNDEF WINDOWS}
  CheckParam := Result;
{$ENDIF}
end;

{
  ProcessCommandLine

  Given a list of option characters and parameter types, check each
  command line argument against the list and set the values in the
  options structure accordingly.

  Returns True if all parameters processed and stored successfully.
}
function ProcessCommandLine
      (
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;

var
  ParamNo : Integer;
  i:integer;

{$IFNDEF WINDOWS}
var
  Result:boolean;
{$ENDIF}
begin
  Result := True;
  {CurNonOptPar:= 0;}

  if DefCMDLineOptions <> nil then begin
    FreeMem(DefCMDLineOptions, CMDLineOptionCount*sizeof(TOptionRec));
    DefCmdLineOptions := nil;
  end;

  if (Options <> nil) and (OptionCount > 0) then begin
    GetMem(DefCMDLineOptions, OptionCount * sizeof(TOptionRec));
    if DefCMDLineOptions = nil then
      RunError(8);
    Move(Options^, DefCMDLineOptions^, OptionCount * sizeof(TOptionRec));
  end;

  for i := 1 to OptionCount do begin
    Options^[i].Present := false;
  end;

  for ParamNo := 1 to ParamCount do begin
    if (Not CheckParam (ParamStr (ParamNo), Options, OptionCount)) then begin
      Result := False;
      break;
    end;
  end;

  CMDLineOptions := Options;
  CMDLineOptionCount := OptionCount;
  for i := 1 to OptionCount do begin
    with Options^[i] do begin
      if (Option = otBool) and (Flag <> 0) then begin
        if OnOff then
          CMDLineFlags := CMDLineFlags or Flag
        else
          CMDLineFlags := CMDLineFlags and (not Flag);
      end;
    end;
  end;
{$IFNDEF WINDOWS}
  ProcessCommandLine := Result;
{$ENDIF}
end;

procedure PrintOptionsHelp;
var
  i:integer;
  d:PChar;
  s:string;
  Options:POptionsArray;
  OptionCount:integer;
const
  e:array[0..0]of char = (#0);

begin
  Options := DefCMDLineOptions;
  OptionCount := CMDLineOptionCount;
  if (Options = nil) or (OptionCount = 0) then begin
    writeln('No options defined.');
    exit;
  end;
  writeln('Possible command line options:');
  writeln;
  for i := 1 to OptionCount do begin
    with Options^[i] do begin
      d := OptionDesc;
      if d = nil then
        d := e;
      write('  ', OptionName, '[');
      case Option of
        otBool: begin
          if OnOff then
            s := '+'
          else
            s := '-';
        end;
        otInt: begin
          str(Value, s);
        end;
        otString: begin
          s := Param;
        end;
        otFileName: begin
          s := FileName;
        end;
      end;
    end;
    writeln(s, ']  ', d);
  end;
end;

{v2.18 ghs}
var
  SavedExitProc:pointer;
{$S-}
procedure DoneUnit;far;
begin
  ExitProc := SavedExitProc;
  {anything here}
  if DefCMDLineOptions <> nil then begin
    FreeMem(DefCMDLineOptions, CMDLineOptionCount*sizeof(TOptionRec));
    DefCmdLineOptions := nil;
  end;
end;

procedure InitUnit;
begin
  SavedExitProc := ExitProc;
  ExitProc := @DoneUnit;
  {anything here}
end;

begin
  InitUnit;
{/v2.18}
(*
  Example definition of Options array:
const
  DBCOptionCount = 3;

  cpFileName = 0;{command line paramterer}

  DBCOptions: array[1..DBCOptionCount] of TOptionRec = (
    (OptionName:' '; OptionDesc:nil;Flag:0;Present:false;Option: otString; Param: ''),
    (OptionName:'TALK'; OptionDesc:nil;Flag:0;Present:false;Option: otBool; OnOff:false),
    (OptionName:'DEVI'; OptionDesc:nil;Flag:0;Present:false;Option: otString; Param: 'SCREEN')
  );
*)
end.

