{
Copyright (C) 1998-99 Free Software Foundation, Inc.

Author: Frank Heckenbach <frank@pascal.gnu.de>

Pascal interface to the regex functions.

This Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation, version 2.

This Library 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
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with this Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.
}

unit RegEx;

interface

uses GPC;

type
  RegExType = record
    RegEx, RegMatch : Pointer; { only used internally }
    From,                      { only used internally }
    SubExpressions : Integer;  { can be read after NewRegEx }
    Error : CString;           { should be checked after NewRegEx, nil if OK. }
  end;

{ Create a regular expression. }
procedure NewRegEx (var RegEx : RegExType; const Expression : String; Extended, CaseInsensitive, NoSubExpressions, NewLines : Boolean); asmname '_p_newregex';

{ Get rid of a regular expression. MUST be called after NewRegEx before the
  RegEx variable becomes invalid (i.e., goes out of scope or is Dispose'd). }
procedure DisposeRegEx (var RegEx : RegExType); asmname '_p_dispose_regex';

{ Match a regular expression against a string. }
function  MatchRegEx (var RegEx : RegExType; const s : String; NotBeginningOfLine, NotEndOfLine : Boolean) : Boolean; asmname '_p_matchregex';

{ Match a regular expression against a string starting from a specified position. }
function  MatchRegExFrom (var RegEx : RegExType; const s : String; NotBeginningOfLine, NotEndOfLine : Boolean; From : Integer) : Boolean; asmname '_p_matchregexfrom';

{ Find out where the regular expression matched. If n = 0, the position of
  the whole match is returned, otherwise the position of the n'th
  parenthesized subexpression. MatchPosition, MatchLength will contain the
  position (counted from 1) and length of the match, or 0 if it didn't match.
  (Note: MatchLength can also be 0 for a successful empty match, so check
  MatchPosition for 0 to find out if it matched.) }
procedure GetMatchRegEx (var RegEx : RegExType; n : Integer; var MatchPosition, MatchLength : Integer); asmname '_p_getmatch_regex';

{ Checks if the string s contains any (sub)expression references ('&' for the
  whole matched expression (if OnlySub is not set) or '\1' .. '\9' for the
  n'th parenthesized subexpression) to the regular expression RegEx or quoted
  characters. Returns 0 if it does not and the number of references and quoted
  characters if it does. If an invalid reference (i.e. a number bigger than
  the number of subexpressions in RegEx) is found, it returns the negative
  value of the (first) invalid reference. }
function  FindSubExpressionReferences (var RegEx : RegExType; const s : String; OnlySub : Boolean) : Integer; asmname '_p_find_subexpressionreferences_regex';

{ Replaces (sub)expression references in ReplaceStr by the actual
  (sub)expressions and unquotes quoted characters, after matching RegEx
  against s successfully with MatchRegEx or MatchRegExFrom. }
function  ReplaceSubExpressionReferences (var RegEx : RegExType; const s, ReplaceStr : String) : TString; asmname '_p_replace_subexpressionreferences_regex';

implementation

{$B-}

{$L rx}
{$L regexc.c}
procedure CNewRegEx       (var RegEx : RegExType; Expression : CString; ExpressionLength : Integer; Extended, CaseInsensitive, NoSubExpressions, NewLines : Boolean); asmname '_p_new_regex';
function  CMatchRegExFrom (var RegEx : RegExType; Str : CString; StrLength : Integer; NotBeginningOfLine, NotEndOfLine : Boolean; From : Integer) : Boolean; asmname '_p_match_regex_from';

procedure NewRegEx (var RegEx : RegExType; const Expression : String; Extended, CaseInsensitive, NoSubExpressions, NewLines : Boolean);
begin
  CNewRegEx (RegEx, Expression, Length (Expression), Extended, CaseInsensitive, NoSubExpressions, NewLines)
end;

function MatchRegEx (var RegEx : RegExType; const s : String; NotBeginningOfLine, NotEndOfLine : Boolean) : Boolean;
begin
  MatchRegEx := CMatchRegExFrom (RegEx, s, Length (s), NotBeginningOfLine, NotEndOfLine, 1)
end;

function MatchRegExFrom (var RegEx : RegExType; const s : String; NotBeginningOfLine, NotEndOfLine : Boolean; From : Integer) : Boolean;
begin
  MatchRegExFrom := CMatchRegExFrom (RegEx, s, Length (s), (From <> 1) or NotBeginningOfLine, NotEndOfLine, From)
end;

function FindSubExpressionReferences (var RegEx : RegExType; const s : String; OnlySub : Boolean) : Integer;
var i, c : Integer;
begin
  c := 0;
  i := 1;
  while i <= Length (s) do
    begin
      case s [i] of
        '&' : if not OnlySub then Inc (c);
        '\' : if (i < Length (s)) and (s [i + 1] in ['1' .. '9']) and
                (Ord (s [i + 1]) - Ord ('0') > RegEx.SubExpressions)
                then return - (Ord (s [i + 1]) - Ord ('0'))
                else
                  begin
                    Inc (c);
                    Inc (i)
                  end
      end;
      Inc (i)
    end;
  FindSubExpressionReferences := c
end;

function ReplaceSubExpressionReferences (var RegEx : RegExType; const s, ReplaceStr : String) = Result : TString;
var i : Integer;

  procedure DoReplace (l, n : Integer);
  var MatchPosition, MatchLength : Integer;
  begin
    GetMatchRegEx (RegEx, n, MatchPosition, MatchLength);
    Delete (Result, i, l);
    if (MatchPosition > 0) (*@@rx-1.5 bug*)and(MatchPosition + MatchLength - 1 <= Length (s)) then
      begin
        Insert (Copy (s, MatchPosition, MatchLength), Result, i);
        Inc (i, MatchLength)
      end;
     Dec (i)
  end;

begin
  Result := ReplaceStr;
  i := 1;
  while i <= Length (Result) do
    begin
      case Result [i] of
        '&' : DoReplace (1, 0);
        '\' : if (i < Length (Result)) and (Result [i + 1] in ['1' .. '9'])
                then DoReplace (2, Ord (Result [i + 1]) - Ord ('0'))
                else Delete (Result, i, 1)
      end;
      Inc (i)
    end
end;

end.
