unit ATStringProc_WordJump;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  ATStringProc;

function SFindWordOffset(const S: atString; AOffset: integer; ANext, ABigJump: boolean;
  const AWordChars: atString): integer;
procedure SFindWordBounds(const S: atString; AOffset: integer; out AOffset1, AOffset2: integer;
  const AWordChars: atString);

implementation

const
  //no EOL here, we jump only inside line
  cCharsSp: atString = ' '#9;
  //no chars '@' (email) and '$' (used in php)
  cCharsSymb: atString = '!"#%&''()[]{}<>*+-/=,.:;?\^`|~‚„…‹›‘’“”–—¦«»­±';


type
  TCharGr = (cgSp, cgSymb, cgWord);

function SCharGr(ch: atChar; const AWordChars: atString): TCharGr;
begin
  if (AWordChars<>'') and (Pos(ch, AWordChars)>0) then Result:= cgWord else
   if Pos(ch, cCharsSp)>0 then Result:= cgSp else
    if Pos(ch, cCharsSymb)>0 then Result:= cgSymb else
     Result:= cgWord;
end;

function SFindWordOffset(const S: atString; AOffset: integer; ANext,
  ABigJump: boolean; const AWordChars: atString): integer;
var
  n: integer;
  //------------
  procedure Next;
  var gr: TCharGr;
  begin
    if not ((n>=0) and (n<Length(s))) then Exit;
    gr:= SCharGr(s[n+1], AWordChars);
    repeat Inc(n)
    until
      (n>=Length(s)) or (SCharGr(s[n+1], AWordChars)<>gr);
  end;
  //------------
  procedure Home;
  var gr: TCharGr;
  begin
    if not ((n>0) and (n<Length(s))) then Exit;
    gr:= SCharGr(s[n+1], AWordChars);
    while (n>0) and (SCharGr(s[n], AWordChars)=gr) do
      Dec(n);
  end;
  //------------
begin
  n:= AOffset;
  if ANext then
  begin
    Next;
    if ABigJump then
      if (n<Length(s)) and (SCharGr(s[n+1], AWordChars)= cgSp) then
        Next;
  end
  else
  begin
    //if we at word middle, jump to word start
    if (n>0) and (n<Length(s)) and (SCharGr(s[n], AWordChars)=SCharGr(s[n+1], AWordChars)) then
      Home
    else
    begin
      //jump lefter, then jump to prev word start
      if (n>0) then
        begin Dec(n); Home end;
      if ABigJump then
        if (n>0) and (SCharGr(s[n+1], AWordChars)= cgSp) then
          begin Dec(n); Home end;
    end
  end;
  Result:= n;
end;

procedure SFindWordBounds(const S: atString; AOffset: integer; out AOffset1,
  AOffset2: integer; const AWordChars: atString);
begin
  AOffset1:= AOffset;
  AOffset2:= AOffset;

  if (AOffset>=0) and (AOffset<Length(S)) and
    IsCharWord(S[AOffset+1], AWordChars) then
  begin
    //jump left only if at middle of word
    if (AOffset>0) and IsCharWord(S[AOffset], AWordChars) then
      AOffset1:= SFindWordOffset(S, AOffset, false, false, AWordChars);
    //jump right always
    AOffset2:= SFindWordOffset(S, AOffset, true, false, AWordChars);
  end;
end;

end.