logfilter/UFilter.pas

{
    This file is part of logfilter.

    Copyright (C) 2015 Andreas Schneider

    logfilter is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    logfilter is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with logfilter.  If not, see <http://www.gnu.org/licenses/>.
}
unit UFilter;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

{.$define debugmatches}

interface

uses
  Classes, SysUtils, fgl, RegExpr;

type
  { THighlightFilter }

  THighlightFilter = class
    Expression: TRegExpr;
    FGColor: Byte;
    BGColor: Byte;
    Group: Byte;
    constructor Create(AString: String);
    constructor Create(AExpression: String; AFG, ABG, AGroup: Byte);
    destructor Destroy; override;
  class var
    FilterExpression: TRegExpr;
    ParamExpression: TRegExpr;
  end;
  TFilterList = specialize TFPGObjectList<THighlightFilter>;

  { TGroupRange }

  TGroupRange = record
    StartIdx: Integer;
    EndIdx: Integer;
  end;
  TGroupRanges = array of TGroupRange;

  { TLineFilter }

  TLineFilter = class
    constructor Create(AExpression: String);
    destructor Destroy; override;
  protected
    FExpression: TRegExpr;
    FFollowUp: TRegExpr; //Used to evaluate lines belonging this the first match.
    FFilters: TFilterList;
    function DoMatch(AExpression: TRegExpr; ALine: String;
      var GroupRanges: TGroupRanges): Boolean;
  public
    function Matches(ALine: String; var GroupRanges: TGroupRanges): Boolean;
    procedure SetFollowUp(AExpression: String);
    function FollowUpMatch(ALine: String; var GroupRanges: TGroupRanges): Boolean;
    property Filters: TFilterList read FFilters;
  end;
  TLineFilters = specialize TFPGObjectList<TLineFilter>;

  { THighlight }

  THighlight = record
    FGColor: Byte;
    BGColor: Byte;
    Start: Integer;
    Length: Integer;
    class operator =(A, B: THighlight): Boolean;
  end;
  THighlights = specialize TFPGList<THighlight>;

function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer;

implementation

{ THighlightFilter }

constructor THighlightFilter.Create(AString: String);
begin
  FGColor := $FF;
  BGColor := $FF;
  Group := $FF;
  if FilterExpression.Exec(AString) then
  begin
    Expression := TRegExpr.Create(Copy(AString, 1, FilterExpression.MatchPos[0] - 1));
    if ParamExpression.Exec(FilterExpression.Match[0]) then
      repeat
        if ParamExpression.Match[1] = 'FG' then
          FGColor := StrToInt(ParamExpression.Match[2])
        else if ParamExpression.Match[1] = 'BG' then
          BGColor := StrToInt(ParamExpression.Match[2])
        else if ParamExpression.Match[1] = 'Grp' then
          Group := StrToInt(ParamExpression.Match[2]);
      until not ParamExpression.ExecNext;
  end else
    Expression := TRegExpr.Create(AString);
end;

constructor THighlightFilter.Create(AExpression: String; AFG, ABG, AGroup: Byte
  );
begin
  FGColor := AFG;
  BGColor := ABG;
  Group := AGroup;
  Expression := TRegExpr.Create(AExpression);
end;

destructor THighlightFilter.Destroy;
begin
  Expression.Free;
  inherited Destroy;
end;

{ TLineFilter }

constructor TLineFilter.Create(AExpression: String);
begin
  FExpression := TRegExpr.Create(AExpression);
  FFilters := TFilterList.Create;
  FFollowUp := nil;
end;

destructor TLineFilter.Destroy;
begin
  FExpression.Free;
  FFilters.Free;
  FFollowUp.Free;
  inherited Destroy;
end;

function TLineFilter.DoMatch(AExpression: TRegExpr; ALine: String;
  var GroupRanges: TGroupRanges): Boolean;
var
  i: Integer;
begin
  Result := AExpression.Exec(ALine);
  if Result then
  begin
    {$ifdef debugmatches}writeln('  Match: ', AExpression.Match[0]);{$endif}
    SetLength(GroupRanges, AExpression.SubExprMatchCount + 1);
    for i := 0 to AExpression.SubExprMatchCount do
    begin
      {$ifdef debugmatches}writeln('    [', i, ']: ', AExpression.Match[i]);{$endif}
      GroupRanges[i].StartIdx := AExpression.MatchPos[i];
      GroupRanges[i].EndIdx := GroupRanges[i].StartIdx + AExpression.MatchLen[i];
    end;
  end;
end;

function TLineFilter.Matches(ALine: String; var GroupRanges: TGroupRanges
  ): Boolean;
begin
  Result := DoMatch(FExpression, ALine, GroupRanges);
end;

procedure TLineFilter.SetFollowUp(AExpression: String);
begin
  if FFollowUp = nil then
    FFollowUp := TRegExpr.Create(AExpression)
  else
    FFollowUp.Expression := AExpression;
end;

{
  If a FollowUp-Expression is set, we evaluate that and return the result.
  If no expression is set, we simply treat that as having not matched.
}
function TLineFilter.FollowUpMatch(ALine: String; var GroupRanges: TGroupRanges
  ): Boolean;
begin
  if FFollowUp <> nil then
    Result := DoMatch(FFollowUp, ALine, GroupRanges)
  else
    Result := False;
end;

{ THighlight }

class operator THighlight. = (A, B: THighlight): Boolean;
begin
  Result := (A.Start = B.Start) and (A.Length = B.Length);
end;

function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer;
begin
  if AHL1.Start = AHL2.Start then
  begin
    Result := AHL1.Length - AHL2.Length;
  end else
    Result := AHL1.Start - AHL2.Start;
end;

initialization
  THighlightFilter.FilterExpression := TRegExpr.Create('( (FG|BG|Grp)(\d+))*$');
  THighlightFilter.ParamExpression := TRegExpr.Create('(FG|BG|Grp)(\d+)');
finalization
  THighlightFilter.FilterExpression.Free;
  THighlightFilter.ParamExpression.Free;
end.