unit uCtags;
{$INCLUDE 'FarCtags.inc'}

interface

uses
  Windows, SysUtils, Classes, Generics.Collections, Generics.Defaults;

type
  ECtagsError = class(EInOutError);

  ECtagsError_CtagsNotFound = class(ECtagsError);

  ECtagsError_ExecutionFailed = class(ECtagsError)
  private
    fResultCode: DWORD;
  public
    constructor Create(ResultCode: DWORD; const Msg: string);
    property ResultCode: DWORD read fResultCode;
  end;

  TCtagsItem = class;

  TCtags = class
  private
    fExeFileName: string;
    fList: TObjectList<TCtagsItem>;
    function GetCount: integer;
    function GetItem(Index: integer): TCtagsItem;
    function ExtractToken(var Source: PChar; out Token: string): boolean;
    function StringToCtagsItem(const Source: string; out Item: TCtagsItem): boolean;
  protected
    property List: TObjectList<TCtagsItem> read fList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromFile(const FileName: string);
    property ExeFileName: string read fExeFileName write fExeFileName;
    property Count: integer read GetCount;
    property Items[Index: integer]: TCtagsItem read GetItem; default;
  end;

  TCtagsItem = class
  private
    fName: string;
    fKind: string;
    fLine: integer;
  protected
  public
    property Name: string read fName write fName;
    property Line: integer read fLine write fLine;
    property Kind: string read fKind write fKind;
  end;

implementation

uses
  uSystem;

{ TCtags }

constructor TCtags.Create;
begin
  inherited;
  fExeFileName := 'ctags.exe';
  fList := TObjectList<TCtagsItem>.Create(True);
end;

destructor TCtags.Destroy;
begin
  FreeAndNil(fList);
  inherited;
end;

function TCtags.ExtractToken(var Source: PChar; out Token: string): boolean;
var
  Start: PChar;
  Len: integer;
begin
  if (Source = nil) or (Source^ = #0) then begin
    Result := False;
  end
  else begin
    Start := Source;
    Len := 0;
    while (Source^ <> #0) and (Source^ <> #9) do begin
      Inc(Source);
      Inc(Len);
    end;
    if Len = 0 then
      Token := ''
    else
      SetString(Token, Start, Len);
    if Source^ = #9 then
      Inc(Source);
    Result := True;
  end;
end;

function TCtags.GetCount: integer;
begin
  Result := List.Count;
end;

function TCtags.GetItem(Index: integer): TCtagsItem;
begin
  Result := List[Index];
end;

procedure TCtags.LoadFromFile(const FileName: string);
var
  Exe, Cmd: string;
  WorkDir: string;
  OriginalWorkDir: string;
  Tags: TStringList;
  Errors: TStringList;
  ResultCode: DWORD;
  i: integer;
  Item: TCtagsItem;
begin
  Tags := TStringList.Create;
  try
    Errors := TStringList.Create;
    try
      Exe := ExpandFileName(ExeFileName);
      if FileExists(Exe) then begin
        OriginalWorkDir := GetCurrentDir;
        WorkDir := ExcludeTrailingPathDelimiter(ExtractFilePath(Exe));
      end
      else begin
        Exe := ExeFileName;
        OriginalWorkDir := '';
        WorkDir := '';
      end;
      Cmd := AnsiQuotedStr(Exe, '"')
           + ' -f - --fields=K -n --format=2 '
           + AnsiQuotedStr(ExpandFileName(FileName), '"')
           ;
      try
        if WorkDir <> '' then
          SetCurrentDir(WorkDir);
        if not GetConsoleOutput(Cmd, TStringList(nil), Tags, Errors, ResultCode, SW_HIDE) then
          raise ECtagsError_CtagsNotFound.Create('ctags.exe not found: ' + ExeFileName);
        if ResultCode <> 0 then
          raise ECtagsError_ExecutionFailed.Create(ResultCode, Trim(Errors.Text))
      finally
        if OriginalWorkDir <> '' then
          SetCurrentDir(OriginalWorkDir);
      end;
      List.Clear;
      for i := 0 to Pred(Tags.Count) do
        if StringToCtagsItem(Tags[i], Item) then
          List.Add(Item);
      List.Sort(
        TComparer<TCtagsItem>.Construct(
          function (const L, R: TCtagsItem): integer
          begin
            Result := AnsiCompareText(L.Name, R.Name);
            if Result = 0 then
              Result := L.Line - R.Line;
          end
        )
      );
    finally
      FreeAndNil(Errors);
    end;
  finally
    FreeAndNil(Tags);
  end;
end;

function TCtags.StringToCtagsItem(const Source: string; out Item: TCtagsItem): boolean;
var
  P: PChar;
  sName, sFile, sLine, sKind, sExtra: string;
  n: integer;
  Line: integer;
begin
  Result := False;
  if Source = '' then
    exit;
  P := @(Source[1]);
  if not (
         ExtractToken(P, sName)
     and ExtractToken(P, sFile)
     and ExtractToken(P, sLine)
     and ExtractToken(P, sKind)
  )
  then
    exit;
  if ExtractToken(P, sExtra) then
    exit;
  if sName = '' then
    exit;
  if sKind = '' then
    exit;
  n := Length(sLine);
  if n <= 2 then
    exit;
  if Copy(sLine, Length(sLine)-1, 2) <> ';"' then
    exit;
  Line := StrToIntDef(Copy(sLine, 1, n-2), -1);
  if Line < 0 then
    Exit;
  Item := TCtagsItem.Create;
  Item.Name := sName;
  Item.Line := Line;
  Item.Kind := sKind;
  Result := True;
end;

{ ECtagsError_ExecutionFailed }

constructor ECtagsError_ExecutionFailed.Create(ResultCode: DWORD; const Msg: string);
begin
  inherited Create(Msg);
  fResultCode := ResultCode;
end;

{ TCtagsItem }

end.
