unit uutlConsoleHelper;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit implementiert Helper Klassen für Consolen Ein- und Ausgaben,
                sowie Menüführung und Autovervollständigung }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fgl, uutlMCF, uutlCommon, uutlGenerics, syncobjs;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlParameterStringFlag = (psfBrackets);
  TutlParameterStringFlags = set of TutlParameterStringFlag;
  TutlMenuItem = class;
  TutlMenuParameter = class
  private
    fParent: TutlMenuItem;
    fOptional: Boolean;
    fName, fDescription, fValue: String;
  public
    property Parent:      TutlMenuItem read fParent;
    property Optional:    Boolean      read fOptional;
    property Value:       String       read fValue;
    property Name:        String       read fName;
    property Description: String       read fDescription;

    procedure WriteConfig(const aMCF: TutlMCFSection); virtual;
    procedure ReadConfig(const aMCF: TutlMCFSection); virtual;

    procedure GetAutoCompleteStrings(const aStrings: TStrings); virtual; abstract;
    function SetValue(const aValue: String): Boolean; virtual;
    function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; virtual;

    constructor Create(const aOptional: Boolean; const aName, aDescription: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMenuParameterListBase = specialize TFPGObjectList<TutlMenuParameter>;
  TutlMenuParameterList = class(TutlMenuParameterListBase)
  public
    function HasParameter(const aName: String): Boolean;
    function FindParameter(const aName: String): TutlMenuParameter;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMenuParameterStack = class(TutlMenuParameterList)
  public
    procedure Push(const aValue: TutlMenuParameter);
    function Seek: TutlMenuParameter;
    function Pop: TutlMenuParameter;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlParameterType = (ptString = 0, ptInteger, ptBoolean, ptHex, ptPreset);
  TutlParameterTypeH = specialize TutlEnumHelper<TutlParameterType>;
  TutlMenuParameterSingle = class(TutlMenuParameter)
  private
    fType: TutlParameterType;
  public
    property ParamType: TutlParameterType read fType;

    procedure WriteConfig(const aMCF: TutlMCFSection); override;
    procedure ReadConfig(const aMCF: TutlMCFSection); override;

    procedure GetAutoCompleteStrings(const aStrings: TStrings); override;
    function SetValue(const aValue: String): Boolean; override;
    function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; override;

    constructor Create(const aOptional: Boolean; const aName, aDescription: String; const aType: TutlParameterType);
    destructor Destroy; override;
  end;
  TutlMenuParameterSingleList = specialize TFPGObjectList<TutlMenuParameterSingle>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMenuParameterGroup = class(TutlMenuParameter)
  private
    fParameters: TutlMenuParameterSingleList;
    function GetCount: Integer;
    function GetParameter(const aIndex: Integer): TutlMenuParameterSingle;
  public
    property Count: Integer read GetCount;
    property Parameter[const aIndex: Integer]: TutlMenuParameterSingle read GetParameter; default;

    procedure WriteConfig(const aMCF: TutlMCFSection); override;
    procedure ReadConfig(const aMCF: TutlMCFSection); override;

    procedure GetAutoCompleteStrings(const aStrings: TStrings); override;
    function SetValue(const aValue: String): Boolean; override;
    function GetString(const aOptions: TutlParameterStringFlags = [psfBrackets]): String; override;

    function AddParameter(const aName, aDescription: String;
      const aType: TutlParameterType): TutlMenuParameterSingle; overload;
    function AddParameter(const aParameter: TutlMenuParameterSingle): TutlMenuParameterSingle; overload;
    procedure DelParameter(const aIndex: Integer);

    constructor Create(const aOptional: Boolean; const aName, aDescription: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlCallback = procedure(aSender: TObject) of object;
  TutlMenuItemList = specialize TFPGObjectList<TutlMenuItem>;
  TutlMenuItem = class(TObject)
  private
    fCommand: String;
    fDescription: String;
    fCallback: TutlCallback;
    fExecutable: Boolean;
    fParent: TutlMenuItem;
    fHelpItem: TutlMenuItem;

    function GetCount: Integer;
    function GetItems(const aIndex: Integer): TutlMenuItem;
    function GetMenuPath: String;
    function GetParamCount: Integer;
    function GetParameters(const aIndex: Integer): TutlMenuParameter;
    function GetParameterString: String;
    procedure SetCallback(aValue: TutlCallback);
  protected
    fItems: TutlMenuItemList;
    fParameters: TutlMenuParameterList;

    procedure WriteConfig(const aMCF: TutlMCFSection); virtual;
    procedure ReadConfig(const aMCF: TutlMCFSection); virtual;
  public
    property Command:         String        read fCommand     write fCommand;
    property Description:     String        read fDescription write fDescription;
    property Callback:        TutlCallback     read fCallback    write SetCallback;
    property Executable:      Boolean       read fExecutable;
    property MenuPath:        String        read GetMenuPath;
    property ParameterString: String        read GetParameterString;
    property ParamCount:      Integer       read GetParamCount;
    property Count:           Integer       read GetCount;
    property Parent:          TutlMenuItem  read fParent;
    property Items[const aIndex: Integer]: TutlMenuItem read GetItems; default;
    property Parameters[const aIndex: Integer]: TutlMenuParameter read GetParameters;

    procedure GetAutoCompleteStrings(const aList: TStrings; const aParameter: TutlMenuParameterList); virtual;
    function GetString: String;
    function AddItem(const aCmd, aDesc: String; const aCallback: TutlCallback): TutlMenuItem; overload;
    function AddItem(const aItem: TutlMenuItem): TutlMenuItem; overload;
    procedure DelItem(const aIndex: Integer);
    function AddParameter(const aParameter: TutlMenuParameter): TutlMenuParameter;
    procedure DelParameter(const aIndex: Integer);

    procedure LoadFromStream(const aStream: TStream);
    procedure SaveToStream(const aStream: TStream);

    constructor Create(const aParent: TutlMenuItem; const aCmd, aDesc: String; const aCallback: TutlCallback);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlParseResult = (prUnknownCommand, prInvalidParam, prInvalidParamCount, prSuccess, prIncompleteCmd);
  TutlHelpOption = (hoNone, hoAll, hoDetail);
  TutlCommandMenu = class(TutlMenuItem)
  private
    fInvalidParam: String;
    fUnknownCmd: String;
    fLastCmd: String;
    fCurrentParamCount: Integer;
    function GetCmdParameter: TutlMenuParameterList;
  protected
    fCmdParameter: TutlMenuParameterStack;
    fCmdStack: TutlStringStack;
    fCurrentMenu: TutlMenuItem;
    procedure SplitCmdString(const aText: String; const aChar: Char);
    function ParseCommand: TutlParseResult;
  public
    property CmdParameter: TutlMenuParameterList read GetCmdParameter;
    property LastCmd:      String                read fLastCmd;

    procedure ExecuteCommand(const aCmd: String); virtual;

    procedure DisplayHelp(const aRefMenu: TutlMenuItem = nil; const aOption: TutlHelpOption = hoNone);
    procedure DisplayIncompleteCommand;
    procedure DisplayUnknownCommand(const aCmd: String = '');
    procedure DisplayInvalidParamCount(const aParamCount: Integer = -1);
    procedure DisplayInvalidParam(const aParam: String = '');

    constructor Create(const aHelp: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlInputEvent = procedure(aSender: TObject; const aInput: String) of Object;
  TutlAutoCompleteEvent = function(aSender: TObject; const aInput: String; const aDisplayPossibilities: Boolean): String of Object;
  TutlCommandPrompt = class(TObject)
  private
    fCurrent: String;
    fInput: String;
    fPrefix: String;
    fHistoryBackup: String;
    fCurID: Integer;
    fStartIndex: Integer;
    fHistoryID: Integer;
    fHistoryEnabled: Boolean;
    fRunning: Boolean;
    fHiddenChar: Char;
    fConsoleCS: TCriticalSection;
    fHistory: TStringList;

    fOnInput: TutlInputEvent;
    fOnAutoComplete: TutlAutoCompleteEvent;

    function GetCurrent: String;
    procedure SetCurrent(aValue: String);
    procedure SetHiddenChar(aValue: Char);
    procedure SetPrefix(aValue: String);

    procedure CursorToStart;
    procedure CursorToEnd;
    procedure DelInput(const aAll: Boolean = false);
    procedure RestoreInput;
    procedure CursorRight;
    procedure CursorLeft;
    procedure DelChar(const aBeforeCursor: Boolean = false);
    procedure WriteChar(const c: Char);

    function ReadLnEx: String;
    function AutoComplete(const aInput: String; const aDisplayPossibilities: Boolean): String;
    procedure AddHistory(const aInput: String);

    procedure DoInput;
  public
    property Prefix:         String      read fPrefix         write SetPrefix;
    property Current:        String      read GetCurrent      write SetCurrent;
    property HistoryEnabled: Boolean     read fHistoryEnabled write fHistoryEnabled;
    property HiddenChar:     Char        read fHiddenChar     write SetHiddenChar;
    property OnInput:        TutlInputEvent        read fOnInput        write fOnInput;
    property OnAutoComplete: TutlAutoCompleteEvent read fOnAutoComplete write fOnAutoComplete;

    procedure Start;
    procedure Stop;
    procedure Reset;
    procedure Clear;    //löscht nur die Ausgabe und hält die Eingabe intern
    procedure Restore;  //stellt die Ausgabe wieder her

    constructor Create(const aConsoleCS: TCriticalSection);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlConsoleMenu = class(TutlCommandMenu)
  private
    fExitMenu: TutlMenuItem;
    fCommandPrompt: TutlCommandPrompt;
    fIsAsking: Boolean;
    fInputBackup: String;

    fOnAnswer: TutlInputEvent;

    procedure CommandInput(aSender: TObject; const aCmd: String);
    function AutoComplete(aSender: TObject; const aCmd: String;
      const aDisplayPossibilities: Boolean): String;

    procedure DoAnswer(const aInput: String);
  public
    property CommandPrompt: TutlCommandPrompt read fCommandPrompt;
    property OnAnswer: TutlInputEvent read fOnAnswer;

    procedure ExecuteCommand(const aCmd: String); override;
    procedure StartMenu;
    procedure ExitMenu;
    procedure Ask(const aQuestion: String; const aHidden: Boolean = false; const aOnAnswer: TutlInputEvent = nil);

    constructor Create(const aHelp: String; const aConsoleCS: TCriticalSection);
    destructor Destroy; override;
  end;

implementation

uses
  strutils,
  uutlLogger,
  uutlKeyCodes,
  {$IFDEF WINDOWS}
    windows
  {$ELSE}
    crt
  {$ENDIF};

const
  COMMAND_PROMPT_PREFIX = '> ';

{$IFDEF WINDOWS}
var
   ScanCode : char;
   SpecialKey : boolean;
   DoingNumChars: Boolean;
   DoingNumCode: Byte;

Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte; keycode:longint): byte;
  { Several remappings of scancodes are necessary to comply with what
    we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
    are excluded }
var
  AltKey, CtrlKey, ShiftKey: boolean;
const
  {
    Keypad key scancodes:

      Ctrl Norm

      $77  $47 - Home
      $8D  $48 - Up arrow
      $84  $49 - PgUp
      $8E  $4A - -
      $73  $4B - Left Arrow
      $8F  $4C - 5
      $74  $4D - Right arrow
      $4E  $4E - +
      $75  $4F - End
      $91  $50 - Down arrow
      $76  $51 - PgDn
      $92  $52 - Ins
      $93  $53 - Del
  }
  CtrlKeypadKeys: array[$47..$53] of byte =
    ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);

begin
  AltKey := ((CtrlKeyState AND
            (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
  CtrlKey := ((CtrlKeyState AND
            (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
  ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);

  if AltKey then
   begin
    case ScanCode of
    // Digits, -, =
    $02..$0D: inc(ScanCode, $76);
    // Function keys
    $3B..$44: inc(Scancode, $2D);
    $57..$58: inc(Scancode, $34);
    // Extended cursor block keys
    $47..$49, $4B, $4D, $4F..$53:
              inc(Scancode, $50);
    // Other keys
    $1C:      Scancode := $A6;   // Enter
    $35:      Scancode := $A4;   // / (keypad and normal!)
    end
   end
  else if CtrlKey then
    case Scancode of
    // Tab key
    $0F:      Scancode := $94;
    // Function keys
    $3B..$44: inc(Scancode, $23);
    $57..$58: inc(Scancode, $32);
    // Keypad keys
    $35:      Scancode := $95;   // \
    $37:      Scancode := $96;   // *
    $47..$53: Scancode := CtrlKeypadKeys[Scancode];
    //Enter on Numpad
    $1C:
    begin
      Scancode := $0A;
      SpecialKey := False;
    end;
    end
  else if ShiftKey then
    case Scancode of
    // Function keys
    $3B..$44: inc(Scancode, $19);
    $57..$58: inc(Scancode, $30);
    //Enter on Numpad
    $1C:
    begin
      Scancode := $0D;
      SpecialKey := False;
    end;
    end
  else
    case Scancode of
      // Function keys
      $57..$58: inc(Scancode, $2E); // F11 and F12
      //Enter on NumPad
      $1C:
        begin
          Scancode := $0D;
          SpecialKey := False;
        end;
  end;
  RemapScanCode := ScanCode;
end;


function KeyPressed : boolean;
var
  nevents,nread : dword;
  buf : TINPUTRECORD;
  AltKey: Boolean;
  c : longint;
begin
  KeyPressed := FALSE;
  if ScanCode <> #0 then
    KeyPressed := TRUE
  else
   begin
     GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents{%H-});
     while nevents>0 do
       begin
          ReadConsoleInputA(TextRec(input).Handle,buf{%H-},1,nread{%H-});
          if buf.EventType = KEY_EVENT then
            if buf.Event.KeyEvent.bKeyDown then
              begin
                 { Alt key is VK_MENU }
                 { Capslock key is VK_CAPITAL }

                 AltKey := ((Buf.Event.KeyEvent.dwControlKeyState AND
                            (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
                 if not(Buf.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU, VK_CONTROL,
                                                      VK_CAPITAL, VK_NUMLOCK,
                                                      VK_SCROLL]) then
                   begin
                      keypressed:=true;

                      if (ord(buf.Event.KeyEvent.AsciiChar) = 0) or
                         (buf.Event.KeyEvent.dwControlKeyState and (LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
                        begin
                           SpecialKey := TRUE;
                           ScanCode := Chr(RemapScanCode(Buf.Event.KeyEvent.wVirtualScanCode, Buf.Event.KeyEvent.dwControlKeyState,
                                           Buf.Event.KeyEvent.wVirtualKeyCode));
                        end
                      else
                        begin
                           { Map shift-tab }
                           if (buf.Event.KeyEvent.AsciiChar=#9) and
                              (buf.Event.KeyEvent.dwControlKeyState and SHIFT_PRESSED > 0) then
                            begin
                              SpecialKey := TRUE;
                              ScanCode := #15;
                            end
                           else
                            begin
                              SpecialKey := FALSE;
                              ScanCode := Chr(Ord(buf.Event.KeyEvent.AsciiChar));
                            end;
                        end;

                      if AltKey then
                        begin
                           case Buf.Event.KeyEvent.wVirtualScanCode of
                             71 : c:=7;
                             72 : c:=8;
                             73 : c:=9;
                             75 : c:=4;
                             76 : c:=5;
                             77 : c:=6;
                             79 : c:=1;
                             80 : c:=2;
                             81 : c:=3;
                             82 : c:=0;
                           else
                             break;
                           end;
                           DoingNumChars := true;
                           DoingNumCode := Byte((DoingNumCode * 10) + c);
                           Keypressed := false;
                           Specialkey := false;
                           ScanCode := #0;
                        end
                      else
                        break;
                   end;
              end
             else
              begin
                if (Buf.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) then
               if DoingNumChars then
                 if DoingNumCode > 0 then
                   begin
                      ScanCode := Chr(DoingNumCode);
                      Keypressed := true;

                      DoingNumChars := false;
                      DoingNumCode := 0;
                      break
                   end; { if }
              end;
          { if we got a key then we can exit }
          if keypressed then
            exit;
          GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
       end;
   end;
end;

function ReadKey: char;
begin
  while (not KeyPressed) do
    Sleep(1);
  if SpecialKey then begin
    ReadKey := #0;
    SpecialKey := FALSE;
  end else begin
    ReadKey := ScanCode;
    ScanCode := #0;
  end;
end;
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameter.WriteConfig(const aMCF: TutlMCFSection);
begin
  with aMCF do begin
    SetString('classname',   self.ClassName);
    SetBool  ('optional',    fOptional);
    SetString('name',        fName);
    SetString('description', fDescription);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameter.ReadConfig(const aMCF: TutlMCFSection);
begin
  with aMCF do begin
    fOptional    := GetBool  ('optional',    true);
    fName        := GetString('name',        fName);
    fDescription := GetString('description', fDescription);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameter.SetValue(const aValue: String): Boolean;
begin
  fValue := aValue;
  result := true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameter.GetString(const aOptions: TutlParameterStringFlags
  ): String;
begin
  if fOptional then
    result := '(' + fName + ')'
  else
    result := '[' + fName + ']'
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMenuParameter.Create(const aOptional: Boolean; const aName, aDescription: String);
begin
  inherited Create;
  fOptional    := aOptional;
  fName        := aName;
  fDescription := aDescription;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMenuParameter.Destroy;
begin
  inherited Destroy;
end;


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameterList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterList.HasParameter(const aName: String): Boolean;
begin
  result := Assigned(FindParameter(aName));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterList.FindParameter(const aName: String): TutlMenuParameter;
var
  i: Integer;
begin
  for i := 0 to Count-1 do begin
    result := Items[i];
    if (result.Name = aName) then
      exit;
  end;
  result := nil
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameterStack///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterStack.Push(const aValue: TutlMenuParameter);
begin
  Add(aValue);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterStack.Seek: TutlMenuParameter;
begin
  if (Count > 0) then
    result := Items[Count-1]
  else
    result := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterStack.Pop: TutlMenuParameter;
begin
  if (Count > 0) then begin
    result := Items[Count-1];
    Delete(Count-1);
  end else
    result := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterSingle.WriteConfig(const aMCF: TutlMCFSection);
begin
  inherited WriteConfig(aMCF);
  aMCF.SetString('type', TutlParameterTypeH.ToString(fType));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterSingle.ReadConfig(const aMCF: TutlMCFSection);
begin
  inherited ReadConfig(aMCF);
  fType := TutlParameterTypeH.ToEnum(aMCF.GetString('type', TutlParameterTypeH.ToString(ptPreset)));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameterSingle//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterSingle.GetAutoCompleteStrings(const aStrings: TStrings);
begin
  case fType of
    ptBoolean: begin
      aStrings.Add('true');
      aStrings.Add('false');
    end;
    ptInteger: begin
      aStrings.Add('[integer]');
    end;
    ptHex: begin
      aStrings.Add('[hex]');
    end;
    ptString: begin
      aStrings.Add('[string]');
    end;
    ptPreset: begin
      aStrings.Add(fName);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterSingle.SetValue(const aValue: String): Boolean;
const
  BOOL_ARR: array[0..7] of String = ('y', 'n', 't', 'f', 'yes', 'no', 'true', 'false');

  function IsInArr: Boolean;
  var
    i: Integer;
    s: String;
  begin
    s := LowerCase(aValue);
    result := true;
    for i := 0 to high(BOOL_ARR) do
      if (BOOL_ARR[i] = s) then
        exit;
    result := false;
  end;

var
  i: Integer;
  c: QWord;
begin
  result := false;
  case fType of
    ptBoolean:
      if IsInArr then
        result := true;
    ptInteger:
      result := TryStrToInt(aValue, i);
    ptHex:
      result := AnsiStartsStr('0x', aValue) and TryStrToQWord('$' + AnsiRightStr(aValue, Length(aValue)-2), c);
    ptPreset:
      result := (aValue = fName);
    ptString:
      result := true;
  end;
  if result then
    result := inherited SetValue(aValue);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameterSingle//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterSingle.GetString(const aOptions: TutlParameterStringFlags): String;
begin
  result := fName;
  case fType of
    ptBoolean:
      result := result+':b';
    ptHex:
      result := result+':h';
    ptInteger:
      result := result+':i';
    ptString:
      result := result+':s';
    ptPreset:
      result := '''' + result + '''';
  end;
  if (psfBrackets in aOptions) then begin
    if fOptional then
      result := '(' + result + ')'
    else
      result := '[' + result + ']';
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMenuParameterSingle.Create(const aOptional: Boolean;
  const aName, aDescription: String; const aType: TutlParameterType);
begin
  inherited Create(aOptional, aName, aDescription);
  fType := aType;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMenuParameterSingle.Destroy;
begin
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuParameterGroup///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.GetCount: Integer;
begin
  result := fParameters.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.GetParameter(const aIndex: Integer): TutlMenuParameterSingle;
begin
  if (aIndex >= 0) and (aIndex < fParameters.Count) then
    result := fParameters[aIndex]
  else
    raise Exception.Create(format('TMenuParameterGroup.GetParameter - index out of bounds (%d)', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterGroup.WriteConfig(const aMCF: TutlMCFSection);
var
  i: Integer;
begin
  inherited WriteConfig(aMCF);
  with aMCF.Sections['parameters'] do begin
    SetInt('count', fParameters.Count);
    for i := 0 to fParameters.Count-1 do
      fParameters[i].WriteConfig(Sections[IntToStr(i)]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterGroup.ReadConfig(const aMCF: TutlMCFSection);
var
  c, i: Integer;
begin
  inherited ReadConfig(aMCF);
  with aMCF.Sections['parameters'] do begin
    c := GetInt('count', 0);
    for i := 0 to c-1 do
      AddParameter('', '', ptPreset).ReadConfig(Sections[IntToStr(i)]);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterGroup.GetAutoCompleteStrings(const aStrings: TStrings);
var
  i: Integer;
begin
  for i := 0 to fParameters.Count-1 do
    fParameters[i].GetAutoCompleteStrings(aStrings);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.SetValue(const aValue: String): Boolean;
var
  i: Integer;
begin
  for i := 0 to fParameters.Count-1 do
    if fParameters[i].SetValue(aValue) then begin
      result := inherited SetValue(aValue);
      break;
    end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.GetString(const aOptions: TutlParameterStringFlags): String;
var
  i: Integer;
  s: String;
begin
  result := '';
  for i := 0 to fParameters.Count-1 do begin
    if result <> '' then
      result := result + '|';
    s := fParameters[i].GetString;
    s := copy(s, 2, Length(s)-2);
    result := result + s;
  end;
  result := fName + ':' + result;
  if (psfBrackets in aOptions) then begin
    if (fOptional) then
      result := '(' + result + ')'
    else
      result := '[' + result + ']';
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.AddParameter(const aName, aDescription: String; const aType: TutlParameterType): TutlMenuParameterSingle;
begin
  result := TutlMenuParameterSingle.Create(false, aName, aDescription, aType);
  fParameters.Add(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuParameterGroup.AddParameter(const aParameter: TutlMenuParameterSingle): TutlMenuParameterSingle;
begin
  result := aParameter;
  fParameters.Add(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuParameterGroup.DelParameter(const aIndex: Integer);
begin
  if (aIndex >= 0) and (aIndex < fParameters.Count) then
    fParameters.Delete(aIndex)
  else
    raise Exception.Create(format('TMenuParameterGroup.DelParameter - index out of bounds (%d)', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMenuParameterGroup.Create(const aOptional: Boolean; const aName, aDescription: String);
begin
  inherited Create(aOptional, aName, aDescription);
  fParameters := TutlMenuParameterSingleList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMenuParameterGroup.Destroy;
begin
  FreeAndNil(fParameters);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMenuItem/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetCount: Integer;
begin
  result := fItems.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetItems(const aIndex: Integer): TutlMenuItem;
begin
  if (aIndex >= 0) and (aIndex < fItems.Count) then
    result := fItems[aIndex]
  else
    raise Exception.Create(format('TMenuItem.GetItems - index out of bounds (%d)', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetMenuPath: String;
var
  m: TutlMenuItem;
begin
  result := '';
  m := self;
  while Assigned(m) do begin
    if Length(result) > 0 then
      result := ' ' + result;
    result := m.GetString + result; //m.Command + result;
    if (m <> m.Parent) then
      m := m.Parent
    else
     m := nil;
  end;
  result := Trim(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetParamCount: Integer;
begin
  result := fParameters.Count;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetParameters(const aIndex: Integer): TutlMenuParameter;
begin
  if (aIndex >= 0) and (aIndex < fParameters.Count) then
    result := fParameters[aIndex]
  else
    raise Exception.Create(format('TMenuItem.GetParameters - index out of bounds', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetParameterString: String;
var
  i: Integer;
begin
  result := '';
  for i := 0 to fParameters.Count-1 do begin
    if result <> '' then
      result := result + ' ';
    result := result + fParameters[i].GetString;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.SetCallback(aValue: TutlCallback);
begin
  if fCallback = aValue then
    exit;
  fCallback   := aValue;
  fExecutable := Assigned(fCallback);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.WriteConfig(const aMCF: TutlMCFSection);
var
  i: Integer;
begin
  with aMCF do begin
    SetString('command',     fCommand);
    SetString('description', fDescription);
    SetBool  ('executable',  fExecutable);
    with Sections['parameters'] do begin
      SetInt('count', fParameters.Count);
      for i := 0 to fParameters.Count-1 do
        fParameters[i].WriteConfig(Sections[IntToStr(i)]);
    end;
    with Sections['menus'] do begin
      SetInt('count', fItems.Count);
      for i := 0 to fItems.Count-1 do
        fItems[i].WriteConfig(Sections[IntToStr(i)]);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.ReadConfig(const aMCF: TutlMCFSection);
var
  c, i: Integer;
  s: String;
  p: TutlMenuParameter;
begin
  fItems.Clear;
  fParameters.Clear;
  with aMCF do begin
    fCommand     := GetString('command',     '');
    fDescription := GetString('description', '');
    fExecutable  := GetBool  ('executable',  false);
    with Sections['parameters'] do begin
      c := GetInt('count', 0);
      for i := 0 to c-1 do begin
        s := Sections[IntToStr(i)].GetString('classname', '');
        p := nil;
        if (s = TutlMenuParameterSingle.ClassName) then
          p := TutlMenuParameterSingle.Create(true, '', '', ptPreset)
        else if (s = TutlMenuParameterGroup.ClassName) then
          p := TutlMenuParameterGroup.Create(true, '', '');
        if Assigned(p) then begin
          fParameters.Add(p);
          p.ReadConfig(Sections[IntToStr(i)]);
        end;
      end;
    end;
    with Sections['menus'] do begin
      c := GetInt('count', 0);
      for i := 0 to c-1 do
        AddItem('', '', nil).ReadConfig(Sections[IntToStr(i)]);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.GetAutoCompleteStrings(const aList: TStrings; const aParameter: TutlMenuParameterList);
var
  hasAllParam: Boolean;
  i: Integer;
  p: TutlMenuParameter;
begin
  hasAllParam := true;
  for i := 0 to fParameters.Count-1 do begin
    p := fParameters[i];
    if not p.Optional then begin
      if not aParameter.HasParameter(p.Name) then begin
        p.GetAutoCompleteStrings(aList);
        hasAllParam := false;
        break;
      end;
    end else begin
      if not aParameter.HasParameter(p.Name) then
        p.GetAutoCompleteStrings(aList);
    end;
  end;
  if hasAllParam then begin
    for i := 0 to fItems.Count-1 do
      aList.Add(fItems[i].Command);
    if Command <> 'help' then
      aList.Add('help');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.GetString: String;
var
  s: String;
begin
  result := Command;
  s := ParameterString;
  if (Command <> '') and (s <> '') then
    result := result + ' ';
  result := result + s;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.AddItem(const aCmd, aDesc: String; const aCallback: TutlCallback): TutlMenuItem;
begin
  result := TutlMenuItem.Create(self, aCmd, aDesc, aCallback);
  fItems.Add(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.AddItem(const aItem: TutlMenuItem): TutlMenuItem;
begin
  result := aItem;
  fItems.Add(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.DelItem(const aIndex: Integer);
begin
  if (aIndex >= 0) and (aIndex < fItems.Count) then
    fItems.Delete(aIndex)
  else
    raise Exception.Create(format('TMenuItem.DelItem - index out of bounds (%d)', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlMenuItem.AddParameter(const aParameter: TutlMenuParameter): TutlMenuParameter;
begin
  result := aParameter;
  result.fParent := self;
  fParameters.Add(result);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.DelParameter(const aIndex: Integer);
begin
  if (aIndex >= 0) and (aIndex < fParameters.Count) then
    fParameters.Delete(aIndex)
  else
    raise Exception.Create(format('TMenuItem.DelParameter - index out of bounds (%d)', [aIndex]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlMenuItem.Create(const aParent: TutlMenuItem; const aCmd, aDesc: String; const aCallback: TutlCallback);
begin
  inherited Create;
  fParent      := aParent;
  fCommand     := aCmd;
  fDescription := aDesc;
  fCallback    := aCallback;
  fExecutable  := Assigned(fCallback);
  fItems       := TutlMenuItemList.Create(true);
  fParameters  := TutlMenuParameterList.Create(true);

  if aCmd <> 'help' then begin
    fHelpItem := TutlMenuItem.Create(self, 'help', 'shows the help. use ''all'' to display the menu tree. use ''detail'' to display command details', nil);
    with fHelpItem.AddParameter(TutlMenuParameterGroup.Create(true, 'mode', 'specify how to display the help menu')) as TutlMenuParameterGroup do begin
      AddParameter('all', 'displays the complete menu tree', ptPreset);
      AddParameter('detail', 'displays detailed information', ptPreset);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlMenuItem.Destroy;
begin
  FreeAndNil(fItems);
  FreeAndNil(fParameters);
  FreeAndNil(fHelpItem);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCommandMenu//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCommandMenu.GetCmdParameter: TutlMenuParameterList;
begin
  result := fCmdParameter;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.SplitCmdString(const aText: String; const aChar: Char);
var
  i: Integer;
  Buffer: String;
  Quote: Boolean;
begin
  fCmdStack.Clear;
  Buffer := '';
  Quote  := false;
  for i := 1 to Length(aText) do begin
    if (aText[i] = aChar) and not Quote then begin
      Buffer := Trim(Buffer);
      fCmdStack.Add(Buffer);
      Buffer := '';
    end else if (aText[i] = '"') then
      Quote := not Quote
    else
      Buffer := Buffer + aText[i];
  end;
  if Buffer <> '' then begin
    Buffer := Trim(Buffer);
    fCmdStack.Add(Buffer);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCommandMenu.ParseCommand: TutlParseResult;

  procedure RestoreParameterStack(const aMenu: TutlMenuItem);
  var
    p: TutlMenuParameter;
  begin
    p := fCmdParameter.Seek;
    while Assigned(p) and (p.Parent = aMenu) do begin
      fCmdStack.Push(p.Value);
      fCmdParameter.Pop;
      p := fCmdParameter.Seek;
    end;
  end;

  function BackTrack(const aMenu: TutlMenuItem): TutlParseResult;
  var
    s, cmd: String;
    OptionalParamCount: Integer;
    i, c: Integer;
    m: TutlMenuItem;
    p: TutlMenuParameter;
  begin
  //Stack is empty
    if (fCmdStack.Count = 0) then begin
      if Assigned(aMenu.Callback) or (aMenu = fHelpItem) then
        result := prSuccess
      else
        result := prIncompleteCmd;
      fCurrentMenu := aMenu;
      exit;
    end;
    s := fCmdStack.Pop;
    cmd := LowerCase(s);

  //find command
    m := nil;
    for i := 0 to aMenu.Count-1 do
      if (LowerCase(aMenu[i].Command) = cmd) then begin
        m := aMenu[i];
        break;
      end;
    if not Assigned(m) and (cmd = 'help') then begin
      m := fHelpItem;
      m.fParent := aMenu;
    end;

    if Assigned(m) then begin
    //count optional parameters
      c := 0;
      for i := 0 to m.ParamCount-1 do
        if (m.Parameters[i].Optional) then
          inc(c);
      OptionalParamCount := (1 shl c) - 1;

    //backtrack optional parameters
      while (OptionalParamCount >= 0) do begin
        result := prSuccess;
        fCurrentParamCount := 0;
        c := 0;
        for i := 0 to m.ParamCount-1 do begin
          p := m.Parameters[i];
          if not p.Optional or (((OptionalParamCount shr c) and 1) = 1) then begin
            if (fCmdStack.Count <= 0) then begin
              result := prInvalidParamCount;
              RestoreParameterStack(m);
              fCurrentMenu := m;
              break;
            end else if (LowerCase(fCmdStack.Seek) = 'help') then begin
              break;
            end else if not (p.SetValue(fCmdStack.Seek)) then begin
              result := prInvalidParam;
              RestoreParameterStack(m);
              fCurrentMenu := m;
              break;
            end else begin
              inc(fCurrentParamCount);
              fCmdParameter.Push(p);
              fCmdStack.Pop;
            end;
            if p.Optional then
              inc(c);
          end;
        end;

        if (result = prSuccess) then begin
          result := BackTrack(m);
          if result = prUnknownCommand then
            fCurrentMenu := aMenu;
        end;
        if result <> prSuccess then
          dec(OptionalParamCount)
        else
          OptionalParamCount := -1;
      end;
    end else begin
      fCmdStack.Push(s);
      fUnknownCmd := s;
      result := prUnknownCommand;
    end;
  end;

begin
  fCmdParameter.Clear;
  fCurrentParamCount := 0;
  fInvalidParam      := '';
  fUnknownCmd        := '';
  fCurrentMenu       := nil;
  result             := BackTrack(self);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.ExecuteCommand(const aCmd: String);
var
  r: TutlParseResult;
  p: TutlMenuParameter;
begin
  fLastCmd := aCmd;
  SplitCmdString(aCmd, ' ');
  r := ParseCommand;
  case r of
    prSuccess:
      if (fCurrentMenu = fHelpItem) then begin
        p := nil;
        if (fCmdParameter.Count > 0) and (fCmdParameter[fCmdParameter.Count-1].Parent = fHelpItem) then
          p := fCmdParameter[fCmdParameter.Count-1];
        if not Assigned(p) then
          DisplayHelp(fHelpItem.Parent)
        else if (p.Value = 'all') then
          DisplayHelp(fHelpItem.Parent, hoAll)
        else if (p.Value = 'detail') then
          DisplayHelp(fHelpItem.Parent, hoDetail)
        else
          DisplayHelp(fHelpItem.Parent);
      end else
        fCurrentMenu.Callback(self);
    prInvalidParam:
      DisplayInvalidParam(fInvalidParam);
    prInvalidParamCount:
      DisplayInvalidParamCount(fCurrentParamCount);
    prIncompleteCmd:
      DisplayIncompleteCommand;
    prUnknownCommand:
      DisplayUnknownCommand(fUnknownCmd);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.DisplayHelp(const aRefMenu: TutlMenuItem; const aOption: TutlHelpOption);
var
  maxLength: Integer;

  function AddStr(const aOld, aNew, aPostfix: String): String;
  begin
    result := aOld;
    if (aOld <> '') and (aNew <> '') then
      result := result + aPostfix;
    result := result + aNew;
  end;

  function GetMaxLength(const aItem: TutlMenuItem): Integer;
  var
    i, l: Integer;
    m: TutlMenuItem;
  begin
    result := 0;
    for i := 0 to aItem.Count-1 do begin
      m := aItem[i];
      l := Length(m.GetString);
      if l > result then
        result := l;
      if (aOption = hoAll) then begin
        l := GetMaxLength(m) + 2;
        if l > result then
          result := l;
      end;
    end;
  end;

  function FillStr(const aStr: String; const aChar: Char; const aLength: Integer): String;
  begin
    result := aStr + StringOfChar(aChar, aLength-Length(aStr));
  end;

  procedure AddHelpText(var aMsg: String; const aPrefix: String; const aItem: TutlMenuItem);
  begin
    if (aMsg <> '') then
      aMsg := aMsg + sLineBreak;
    aMsg := aMsg + FillStr(aPrefix + aItem.GetString, ' ', maxLength) + ' ' + aItem.Description;
  end;

  procedure AddHelpItems(var aMsg: String; const aPrefix: String; const aItem: TutlMenuItem; const aDisplayHelpItem: Boolean = false);
  var
    i: Integer;
    m: TutlMenuItem;
  begin
    for i := 0 to aItem.Count-1 do begin
      m := aItem[i];
      AddHelpText(aMsg, aPrefix, m);
      if (aOption = hoAll) then
        AddHelpItems(aMsg, aPrefix+'  ', m);
    end;
    if aDisplayHelpItem then
      AddHelpText(aMsg, aPrefix, fHelpItem);
  end;

  procedure DisplayGroupParameters(var aMsg: String; const aParamGroup: TutlMenuParameterGroup);
  var
    i, maxLen, l: Integer;
    p: TutlMenuParameter;
  begin
    maxLen := 0;
    for i := 0 to aParamGroup.Count-1 do begin
      l := Length(aParamGroup[i].GetString([]));
      if l > maxLen then
        maxLen := l;
    end;
    inc(maxLen, 3);

    for i := 0 to aParamGroup.Count-1 do begin
      p := aParamGroup[i];
      aMsg := aMsg + sLineBreak + '    ' +
        FillStr(p.GetString([]), ' ', maxLen) +
        p.Description;
    end;
  end;

  procedure DisplayParameters(var aMsg: String);
  var
    i, maxLen, l: Integer;
    p: TutlMenuParameter;
  begin
    maxLen := 0;
    for i := 0 to aRefMenu.ParamCount-1 do begin
      l := Length(aRefMenu.Parameters[i].GetString);
      if (l > maxLen) then
        maxLen := l;
    end;
    inc(maxLen, 3);

    aMsg := aMsg + sLineBreak + 'Parameters:';
    if (aRefMenu.ParamCount > 0) then begin
      for i := 0 to aRefMenu.ParamCount-1 do begin
        p := aRefMenu.Parameters[i];
        aMsg := aMsg + sLineBreak + '  ' + FillStr(p.GetString, ' ', maxLen);
        if p.Optional then
          aMsg := aMsg + '(optional) '
        else
          aMsg := aMsg + '           ';
        aMsg := aMsg + p.Description;
        if (p is TutlMenuParameterGroup) then
          DisplayGroupParameters(aMsg, p as TutlMenuParameterGroup);
      end;
    end else
      aMsg := aMsg + sLineBreak + '  [no Parameters]';
  end;

var
  menu: TutlMenuItem;
  msg: String;
begin
  if Assigned(aRefMenu) then
    menu := aRefMenu
  else
    menu := self;

  msg := AddStr(menu.MenuPath, menu.ParameterString, ' ');
  msg := AddStr(msg, menu.Description, ' - ');
  fHelpItem.fParent := nil;
  if (aOption = hoDetail) then
    msg := msg + sLineBreak + 'Submenus / Commands:';
  maxLength := max(GetMaxLength(menu), Length(fHelpItem.GetString)) + 2;
  if (msg = '') then
    msg := sLineBreak;
  AddHelpItems(msg, '  ', menu, true);
  if (aRefMenu is TutlConsoleMenu) then
    AddHelpText(msg, '  ', (self as TutlConsoleMenu).fExitMenu);
  if (aOption = hoDetail) then
    DisplayParameters(msg);
  utlLogger.Log(Self, msg, []);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.DisplayIncompleteCommand;

  function GetMenuPath: String;
  var
    s: String;
  begin
    s := '';
    if Assigned(fCurrentMenu) then
      s := fCurrentMenu.MenuPath;
    if (s <> '') then
      result := s+' '
    else
      result := '';
  end;

begin
  utlLogger.Error(Self, 'incomplete command! type "%shelp" to get further information.', [GetMenuPath]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.DisplayUnknownCommand(const aCmd: String);

  function GetMenuPath: String;
  var
    s: String;
  begin
    s := '';
    if Assigned(fCurrentMenu) then
      s := fCurrentMenu.MenuPath;
    if (s <> '') then
      result := s+' '
    else
      result := '';
  end;

  function GetCommand: String;
  begin
    if (aCmd <> '') then
      result := ' "'+aCmd+'"'
    else
      result := '';
  end;

begin
  utlLogger.Error(Self, 'unknown command%s! type "%shelp" to get further information.', [GetCommand, GetMenuPath]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.DisplayInvalidParamCount(const aParamCount: Integer);

  function GetMenuPath: String;
  var
    s: String;
  begin
    s := '';
    if Assigned(fCurrentMenu) then
      s := fCurrentMenu.MenuPath;
    if (s <> '') then
      result := s+' '
    else
      result := '';
  end;

  function GetParamCount: String;
  var
    i, c: Integer;
  begin
    result := ' (';
    if (aParamCount >= 0) then begin
      result := result + IntToStr(aParamCount);
    end;
    if Assigned(fCurrentMenu) then begin
      c := 0;
      for i := 0 to fCurrentMenu.ParamCount-1 do
        if not fCurrentMenu.Parameters[i].Optional then
          inc(c);
      result := result + ', expected '+IntToStr(c);
    end;
    result := result + ')';
    if (result = ' ()') then
      result := '';
  end;

begin
  utlLogger.Log(Self, 'invalid parameter count%s! type "%shelp" to get further information.', [GetParamCount, GetMenuPath]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandMenu.DisplayInvalidParam(const aParam: String);

  function GetMenuPath: String;
  var
    s: String;
  begin
    s := '';
    if Assigned(fCurrentMenu) then
      s := fCurrentMenu.MenuPath;
    if (s <> '') then
      result := s+' '
    else
      result := '';
  end;

  function GetParam: String;
  begin
    if (aParam <> '') then
      result := ' "'+aParam+'"'
    else
      result := '';
  end;

begin
  utlLogger.Log(Self, 'invalid parameter%s! type "%shelp" to get further information.', [GetParam, GetMenuPath]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.LoadFromStream(const aStream: TStream);
var
  mcf: TutlMCFFile;
begin
  mcf := TutlMCFFile.Create(nil);
  try
    mcf.LoadFromStream(aStream);
    ReadConfig(mcf);
  finally
    mcf.Free;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMenuItem.SaveToStream(const aStream: TStream);
var
  mcf: TutlMCFFile;
begin
  mcf := TutlMCFFile.Create(nil);
  try
    WriteConfig(mcf);
    mcf.SaveToStream(aStream);
  finally
    mcf.Free;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCommandMenu.Create(const aHelp: String);
begin
  inherited Create(nil, '', aHelp, nil);
  fCmdStack     := TutlStringStack.Create;
  fCmdParameter := TutlMenuParameterStack.Create(False);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlCommandMenu.Destroy;
begin
  FreeAndNil(fCmdStack);
  FreeAndNil(fCmdParameter);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCommandPrompt/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.SetPrefix(aValue: String);
begin
  if fPrefix = aValue then
    exit;
  DelInput(true);
  delete(fCurrent, 1, Length(fPrefix));
  if fHistoryID >= 0 then
    delete(fHistoryBackup, 1, Length(fPrefix));
  fPrefix := aValue;
  fStartIndex := Length(fPrefix)+1;
  fCurrent := fPrefix + fCurrent;
  if fHistoryID >= 0 then
    fHistoryBackup := fPrefix + fHistoryBackup;
  RestoreInput;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCommandPrompt.GetCurrent: String;
begin
  if fHistoryID = -1 then
    result := copy(fCurrent, fStartIndex, MaxInt)
  else
    result := copy(fHistoryBackup, fStartIndex, MaxInt);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.SetCurrent(aValue: String);
begin
  DelInput;
  fCurrent := fPrefix + aValue;
  fHistoryID := -1;
  RestoreInput;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.SetHiddenChar(aValue: Char);
begin
  if fHiddenChar = aValue then
    exit;
  DelInput(true);
  fHiddenChar := aValue;
  RestoreInput;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.CursorToStart;
begin
  Write(StringOfChar(#8, fCurID-fStartIndex));
  fCurID := fStartIndex;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.CursorToEnd;
begin
  Write(Copy(fCurrent, fCurID, MaxInt));
  fCurID := Length(fCurrent)+1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.DelInput(const aAll: Boolean);
var
  l: Integer;
begin
  if not aAll then
    l := fCurID - fStartIndex
  else
    l := fCurID - 1;
  Write(StringOfChar(#08, l));
  Write(StringOfChar(' ', l));
  Write(StringOfChar(#08, l));
  dec(fCurID, l);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.RestoreInput;
begin
  if (fHiddenChar <> #0) then begin
    while fCurID < fStartIndex do begin
      Write(fCurrent[fCurID]);
      inc(fCurID);
    end;
    Write(StringOfChar(fHiddenChar, Length(fCurrent) - fCurID + 1))
  end else
    Write(Copy(fCurrent, fCurID, MaxInt));
  fCurID := Length(fCurrent)+1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.CursorRight;
begin
  if fCurID <= Length(fCurrent) then begin
    if (fHiddenChar <> #0) then
      Write(fHiddenChar)
    else
      Write(fCurrent[fCurID]);
    inc(fCurID);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.CursorLeft;
begin
  if fCurID > fStartIndex then begin
    Write(#8);
    dec(fCurID, 1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.DelChar(const aBeforeCursor: Boolean);
begin
  if not aBeforeCursor and (fCurID <= Length(fCurrent)) then begin
    Delete(fCurrent, fCurID, 1);
    Write(copy(fCurrent, fCurID, MaxInt), ' ');
    Write(StringOfChar(#8, Length(fCurrent)-fCurID+2));
  end else if aBeforeCursor and (fCurID > fStartIndex) then begin
    Delete(fCurrent, fCurID-1, 1);
    Write(#8, copy(fCurrent, fCurID-1, MaxInt), ' ');
    Write(StringOfChar(#8, Length(fCurrent)-fCurID+3));
    dec(fCurID);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.WriteChar(const c: Char);
begin
  if (fCurID <= Length(fCurrent)) then begin
    Write('#', copy(fCurrent, fCurID, MaxInt));
    Write(StringOfChar(#8, Length(fCurrent)-fCurID+2));
  end;
  Insert(c, fCurrent, fCurID);
  inc(fCurID, 1);
  if (fHiddenChar <> #0) then
    Write(fHiddenChar)
  else
    Write(c);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCommandPrompt.ReadLnEx: String;
var
  c: Byte;
  key: Char;
  CtrlKey: Boolean;
  s: String;
  tabPressed: Boolean;
begin
  fHistoryID  := -1;
  CtrlKey     := false;
  tabPressed  := false;

  fConsoleCS.Enter;
  try
    DelInput(true);
    RestoreInput;
  finally
    fConsoleCS.Leave;
  end;

  while fRunning do begin
    key := ReadKey;
    c   := Ord(key) and $FF;
    fConsoleCS.Enter;
    try
      if (CtrlKey) then begin
        CtrlKey := false;
        case c of
          72: begin //KEY_UP
            if (fHistoryID+1 < fHistory.Count) then begin
              if (fHistoryID = -1) then
                fHistoryBackup := fCurrent;
              CursorToEnd;
              DelInput;
              inc(fHistoryID);
              fCurrent := fPrefix + fHistory[fHistoryID];
              RestoreInput;
            end;
          end;
          80: begin //KEY_DOWN
            if (fHistoryID >= 0) then begin
              CursorToEnd;
              DelInput;
              dec(fHistoryID);
              if (fHistoryID >= 0) then
                fCurrent := fPrefix + fHistory[fHistoryID]
              else
                fCurrent := fHistoryBackup;
              RestoreInput;
            end;
          end;
          75: begin //KEY_LEFT
            CursorLeft;
          end;
          77: begin //KEY_RIGHT
            CursorRight;
          end;
          82: begin //KEY_INSERT
          end;
          83: begin //KEY_DELETE
            DelChar(false);
          end;
          71: begin //KEY_HOME
            CursorToStart;
          end;
          79: begin //KEY_END
            CursorToEnd;
          end;
          73: begin //KEY_PGUP
          end;
          81: begin //KEY_PGDOWN
          end;
        end;
      end else begin
        if (tabPressed) then
          tabPressed := (c = VK_TAB);
        case c of
          VK_UNKNOWN: begin
            CtrlKey := true;
          end;
          VK_BACK: begin
            DelChar(true);
          end;
          VK_TAB: begin
            CursorToEnd;
            DelInput;
            s := fCurrent;
            fCurrent := fPrefix +
              AutoComplete(copy(fCurrent, fStartIndex, MaxInt), tabPressed);
            RestoreInput;
            if s <> fCurrent then
              tabPressed := false
            else
              tabPressed := not tabPressed;
          end;
          VK_RETURN: begin //RETURN
            break;
          end;
          VK_ESCAPE: begin
            Reset;
          end;
        else
          WriteChar(Chr(c));
        end;
      end;
    finally
      fConsoleCS.Leave;
    end;
  end;

  fConsoleCS.Enter;
  try
    WriteLn;
  finally
    fConsoleCS.Leave;
  end;
  result := copy(fCurrent, Length(fPrefix)+1, MaxInt);
  Reset;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCommandPrompt.AutoComplete(const aInput: String; const aDisplayPossibilities: Boolean): String;
begin
  result := aInput;
  if Assigned(fOnAutoComplete) then
    result := fOnAutoComplete(self, aInput, aDisplayPossibilities);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.AddHistory(const aInput: String);
begin
  if fHistoryEnabled and (fHiddenChar = #0) and
     ((fHistory.Count <= 0) or (fHistory[0] <> aInput)) then
    fHistory.Insert(0, aInput);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.DoInput;
begin
  if Assigned(fOnInput) then
    fOnInput(self, fInput);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.Start;
begin
  Reset;
  fRunning := true;
  while fRunning do begin
    fInput := ReadLnEx;
    AddHistory(fInput);
    DoInput;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.Stop;
begin
  fRunning := false;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.Reset;
begin
  CursorToEnd;
  DelInput(true);
  fCurrent := fPrefix;
  fCurID := 1;
  Restore;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.Clear;
begin
  fConsoleCS.Enter;
  try
    DelInput(true);
  finally
    fConsoleCS.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlCommandPrompt.Restore;
begin
  fConsoleCS.Enter;
  try
    RestoreInput;
  finally
    fConsoleCS.Leave;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlCommandPrompt.Create(const aConsoleCS: syncobjs.TCriticalSection);
begin
  inherited Create;
  fConsoleCS      := aConsoleCS;
  fPrefix         := COMMAND_PROMPT_PREFIX;
  fHistory        := TStringList.Create;
  fHistoryEnabled := true;
  fStartIndex     := Length(fPrefix)+1;
end;

destructor TutlCommandPrompt.Destroy;
begin
  FreeAndNil(fHistory);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlConsoleMenu//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlConsoleMenu.CommandInput(aSender: TObject; const aCmd: String);
begin
  if fIsAsking then begin
    fIsAsking                     := false;
    fCommandPrompt.Current        := fInputBackup;
    fCommandPrompt.Prefix         := COMMAND_PROMPT_PREFIX;
    fCommandPrompt.OnAutoComplete := @AutoComplete;
    fCommandPrompt.HiddenChar     := #0;
    fCommandPrompt.HistoryEnabled := true;
    DoAnswer(aCmd);
  end else begin
    utlLogger.Debug(Self, 'CMD: ' + aCmd, []);
    ExecuteCommand(aCmd);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlConsoleMenu.AutoComplete(aSender: TObject; const aCmd: String;
  const aDisplayPossibilities: Boolean): String;
var
  r: TutlParseResult;
  s, cmd: String;
  c: Char;
  cmdList: TStringList;
  i, CharIndex, MaxLength: Integer;

  function TestParam(const aParam: String): Boolean;
  var
    i: Integer;
    c: QWord;
  begin
    if aParam = '[integer]' then
      result := TryStrToInt(s, i)
    else if aParam = '[hex]' then
      result := AnsiStartsStr('0x', s) and TryStrToQWord('$' + copy(s, 3, MaxInt), c)
    else
      result := true;
  end;

  function NextChar: Char;
  var
    i: Integer;
    c: String;
  begin
    result := #0;
    try
      for i := 0 to cmdList.Count-1 do begin
        c := cmdList[i];
        if (Length(c) > 0) and (c[1] <> '[') then begin
          if (Length(c) >= CharIndex) then begin
            if (result = #0) then
              result := c[CharIndex]
            else if (result <> c[CharIndex]) then begin
              result := #0;
              exit;
            end;
          end;
        end;
      end;
    finally
      inc(CharIndex);
    end;
  end;

  function GetMaxLength: Integer;
  var
    i, l: Integer;
  begin
    result := 0;
    for i := 0 to cmdList.Count-1 do begin
      l := Length(cmdList[i]);
      if l > result then
        result := l;
    end;
  end;

begin
  SplitCmdString(aCmd, ' ');
  s := '';
  if (Length(aCmd) > 0) and (aCmd[Length(aCmd)] <> ' ') then begin
    s := fCmdStack[fCmdStack.Count-1];
    fCmdStack.Delete(fCmdStack.Count-1);
  end;
  r := ParseCommand;
  result := aCmd;
  if (r in [prSuccess, prIncompleteCmd, prInvalidParamCount]) and Assigned(fCurrentMenu) then begin
    cmdList := TStringList.Create;
    try
      fCurrentMenu.GetAutoCompleteStrings(cmdList, fCmdParameter);
      if (s <> '') then begin
        for i := cmdList.Count-1 downto 0 do begin
          cmd := cmdList[i];
          if (Length(cmd) > 0) and (cmd[1] = '[') then begin
            if not TestParam(cmd) then
              cmdList.Delete(i);
          end else if not AnsiStartsStr(s, cmd) then
            cmdList.Delete(i);
        end;
      end;

      CharIndex := Length(s)+1;
      c := NextChar;
      while c <> #0 do begin
        result := result + c;
        c := NextChar;
      end;
      if (cmdList.Count = 1) then
        result := result + ' ';

      if aDisplayPossibilities then begin
        WriteLn('');
        s := '';
        MaxLength := GetMaxLength+5;
        for i := 0 to cmdList.Count-1 do begin
          cmd := cmdList[i];
          s := s + cmd + StringOfChar(' ', MaxLength-Length(cmd));
          if ((i+1) mod 5) = 0 then begin
            writeln(s);
            s := '';
          end;
        end;
        if (s <> '') then
          WriteLn(s);
        if (cmdList.Count = 0) then
          WriteLn('[no possible commands]');
      end;
    finally
      cmdList.Free;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlConsoleMenu.DoAnswer(const aInput: String);
begin
  if Assigned(fOnAnswer) then
    fOnAnswer(self, aInput);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlConsoleMenu.ExecuteCommand(const aCmd: String);
begin
  if (LowerCase(AnsiLeftStr(trim(aCmd), 4)) = 'exit') then
    ExitMenu
  else
    inherited ExecuteCommand(aCmd);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlConsoleMenu.StartMenu;
begin
  fCommandPrompt.Start;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlConsoleMenu.ExitMenu;
begin
  fCommandPrompt.Stop;
end;

procedure TutlConsoleMenu.Ask(const aQuestion: String; const aHidden: Boolean; const aOnAnswer: TutlInputEvent);
begin
  if Assigned(aOnAnswer) then
    fOnAnswer := aOnAnswer;
  fIsAsking := true;
  fInputBackup := fCommandPrompt.Current;
  if aHidden then
    fCommandPrompt.HiddenChar := '*'
  else
    fCommandPrompt.HiddenChar := #0;
  fCommandPrompt.HistoryEnabled := false;
  fCommandPrompt.OnAutoComplete := nil;
  fCommandPrompt.Prefix         := aQuestion;
  fCommandPrompt.Current        := '';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlConsoleMenu.Create(const aHelp: String; const aConsoleCS: syncobjs.TCriticalSection);
begin
  inherited Create(aHelp);
  fExitMenu      := TutlMenuItem.Create(self, 'exit', 'exit programm', nil);
  fCommandPrompt := TutlCommandPrompt.Create(aConsoleCS);
  fCommandPrompt.OnAutoComplete := @AutoComplete;
  fCommandPrompt.OnInput        := @CommandInput;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlConsoleMenu.Destroy;
begin
  FreeAndNil(fCommandPrompt);
  FreeAndNil(fExitMenu);
  inherited Destroy;
end;

end.