searchfile.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

                  Inc(FBufferSearchPos);
                BLine[LPos] := #0;
                Inc(LPos);
                Break;
              end
              else
                if not (FCurlyCommentActive or FStarCommentActive) then
                  UseChar := True;
          end
          else
            UseChar := True;
        '{':
          if FNoComments and not FStarCommentActive then
            FCurlyCommentActive := True
          else
            if not (FCurlyCommentActive or FStarCommentActive) then
              UseChar := True;
        '}':
          if FNoComments and not FStarCommentActive then
            FCurlyCommentActive := False
          else
            if not (FCurlyCommentActive or FStarCommentActive) then
              UseChar := true;
      else
        if not (FCurlyCommentActive or FStarCommentActive) then
          UseChar := True;
      end;
      if UseChar then
      begin
        if not (soCaseSensitive in SearchOptions) then
          BLine[LPos] := LoCase(FSearchBuffer[i])
        else
          BLine[LPos] := FSearchBuffer[i];
        Inc(LPos);
        if LPos >= 1023 then //! StH: 1023 somehow related to the 1024 StrAlloc of BLine? What for?
          Exit; { Binary not text file }
      end;
    end;
    if FSearchBuffer[i] <> #0 then Inc(FLineNo);
    BLine[LPos] := #0;
    if BLine[0] <> #0 then PatternMatch;
    LPos := 0;
    if FBufferSearchPos < i then FBufferSearchPos := i;
  end;
end;

procedure TSearcher.SetBufSize(New: Integer);
begin
  if (FSearchBuffer = nil) and (New <> FBufSize) then
    FBufSize := New;
end;

(*
function TSearcher.GetLineCount: Integer;
begin
  if FMode = mmModule then
    Result := EditIntF.LinesInBuffer
  else
    Result := -1;
end;
*)

procedure TSearcher.SetPattern(const Source: string);
var
  PatternCharIndex: Integer;
  SourceCharIndex: Integer;

  procedure Store(Ch: Char);
  begin
    Assert(PatternCharIndex < GrepPatternSize, 'Buffer overrun!');
    if not (soCaseSensitive in SearchOptions) then
      FPattern[PatternCharIndex] := LoCase(Ch)
    else
      FPattern[PatternCharIndex] := Ch;
    Inc(PatternCharIndex);
  end;

  procedure cclass;
  resourcestring
    SClassNotTerminated = 'Class at %d did not terminate properly';
  var
    cstart: Integer;
  begin
    cstart := SourceCharIndex;
    Inc(SourceCharIndex);
    if Source[SourceCharIndex] = '^' then
      Store(Char(opNCLASS))
    else
      Store(Char(opCLASS));

    { changed: 10/22 1998 by dg, more info: see bottom }
    while (SourceCharIndex <= Length(Source)) and (Source[SourceCharIndex] <> ']') do
    begin
      if (Source[SourceCharIndex] = '-') and
        (SourceCharIndex - cstart > 1) and
        (Source[SourceCharIndex + 1] <> ']') and
        (SourceCharIndex < Length(Source)) then
      begin
        Dec(PatternCharIndex, 2);
        Store(Char(opRANGE));
        Store(Source[SourceCharIndex - 1]);
        Store(Source[SourceCharIndex + 1]);
        Inc(SourceCharIndex, 2);
      end
      else
      begin
        Store(Source[SourceCharIndex]);
        Inc(SourceCharIndex);
      end;
    end;

    if (Source[SourceCharIndex] <> ']') or (SourceCharIndex > Length(Source)) then
      raise Exception.CreateFmt(SClassNotTerminated, [cstart]);

    Inc(SourceCharIndex); { To push past close bracket }
  end;

resourcestring
  SPatternTooLong = 'Grep pattern too long. (> 500 characters)';
  SInvalidGrepSearchCriteria = 'Character immediately following: at %d is not a valid grep search criteria';
  SSenselessEscape = 'Escape character ("\") without a following character does not make sense';
begin
  //! Warning: this does not properly protect against pattern overruns
  // A better solution needs to be found for this, possibly by sacrificing
  // a bit of performance for a test in the pattern storage code where a
  // new Assert has been introduced.
  if Length(Source) > 500 then
    raise Exception.Create(SPatternTooLong);

  try
    SourceCharIndex := 1;
    PatternCharIndex := 0;
    while SourceCharIndex <= Length(Source) do
    begin
      if not (soRegEx in SearchOptions) then
      begin
        Store(Char(opCHAR));
        Store(Source[SourceCharIndex]);
        Inc(SourceCharIndex);
      end
      else
      begin
(*
      if (Source[SourceCharIndex]='*') or (Source[SourceCharIndex]='+') or (Source[SourceCharIndex]='-') then
      if (SourceCharIndex=1) or
         ((PatternCharIndex>1) and (  (PBuf[lp-1]=char(opBOL)) or
                        (PBuf[PatternCharIndex-1]=char(opEOL)) or
                        (PBuf[PatternCharIndex-1]=char(opSTAR)) or
                        (PBuf[PatternCharIndex-1]=char(opPLUS)) or
                        (PBuf[PatternCharIndex-1]=char(opMINUS)))) then
         begin
         Store(Char(opENDPAT));
         Raise Exception.Create('Bad pattern at character '+intToStr(SourceCharIndex));
         end;
*)
        case Source[SourceCharIndex] of
          '^':
            begin
              Store(Char(opBOL));
              Inc(SourceCharIndex);
            end;

          '$':
            begin
              Store(Char(opEOL));
              Inc(SourceCharIndex);
            end;

          '.':
            begin
              Store(Char(opANY));
              Inc(SourceCharIndex);
            end;

          '[':
            cclass;

          ':':
            begin
              if SourceCharIndex < Length(Source) then
              begin
                case UpCase(Source[SourceCharIndex + 1]) of
                  'A': Store(Char(opALPHA));
                  'D': Store(Char(opDIGIT));
                  'N': Store(Char(opNALPHA));
                  ' ': Store(Char(opPUNCT));
                else
                  Store(Char(opENDPAT));
                  //! ????? Store followed by Exception?
                  raise Exception.CreateFmt(SInvalidGrepSearchCriteria, [SourceCharIndex]);
                end;
                Inc(SourceCharIndex, 2);
              end
              else
              begin
                Store(Char(opCHAR));
                Store(Source[SourceCharIndex]);
                Inc(SourceCharIndex);
              end;
            end;

          '\':
            begin { changed: 10/22 1998 by dg, more info: see bottom }
              if SourceCharIndex >= Length(Source) then
                raise Exception.Create(SSenselessEscape);

              Store(Char(opCHAR));
              Store(Source[SourceCharIndex + 1]);
              Inc(SourceCharIndex, 2);
            end;
        else
          Store(Char(opCHAR));
          Store(Source[SourceCharIndex]);
          Inc(SourceCharIndex);
        end; // case
      end;
    end;
  finally
    Store(Char(opENDPAT));
    Store(#0);
  end;
end;

procedure TSearcher.PatternMatch;
var
  l, p: Integer; // line and pattern pointers
//e: Integer;     // End for STAR and PLUS match
  op: Char; // Pattern operation
//n: Integer;     // Class Counter
//are: String;    // Start of STAR match
  linepos: Integer;

  procedure IsFound;
  var
    S: Integer;
    E: Integer;
  begin
    { TODO -oStefan -cIssue : Note that this algorithm will identify  "GX_GExperts" as a word for "GExperts" }
    if soWholeWord in SearchOptions then
    begin
      S := linepos - 2;
      E := l;
      if (S > 0) and IsCharAlpha(BLine[S]) then
        Exit;
      if (BLine[E] <> #0) and IsCharAlpha(BLine[E]) then
        Exit;
    end;
    if Assigned(FOnFound) then
      FOnFound(Self, FLineNo, BLine, linepos, l);
  end;

begin
  if FPattern[0] = Char(opENDPAT) then
    Exit;
  linepos := 0;

  { Don't bother pattern matching if first search is opCHAR, just go to first match directly }
  { Results in about a 5% to 10% speed increase }
  if (FPattern[0] = Char(opCHAR)) and not (soCaseSensitive in SearchOptions) then
    while (FPattern[1] <> BLine[linepos]) and (BLine[linepos] <> #0) do
      Inc(Linepos);

  while BLine[linepos] <> #0 do
  begin
    l := linepos;
    p := 0;
    op := FPattern[p];
    while op <> Char(opENDPAT) do
    begin
      case Ord(op) of
        opCHAR:
          begin
            if not (Bline[l] = FPattern[p + 1]) then
              Break;
            Inc(p, 2);
          end;

        opBOL:
          begin
            Inc(p);
          end;

        opEOL:
          begin
            if BLine[l] in [#0, #10, #13] then
              Inc(p)
            else
              Break;
          end;

        opANY:
          begin
            if BLine[l] in [#0, #10, #13] then
              Break;
            Inc(p);
          end;

        opCLASS:
          begin
            Inc(p);
            { Compare letters to find a match }
            while (FPattern[p] > LastPatternChar) and (FPattern[p] <> Bline[l]) do
              Inc(p);
            { Was a match found? }
            if FPattern[p] <= LastPatternChar then
              Break;
            { move pattern pointer to next opcode }
            while FPattern[p] > LastPatternChar do
              Inc(p);
          end;

        opNCLASS:
          begin
            Inc(p);
            { Compare letters to find a match }
            while (FPattern[p] > LastPatternChar) and (FPattern[p] <> Bline[l]) do
              Inc(p);
            if FPattern[p] > LastPatternChar then
              Break;
          end;

        opALPHA:
          begin
            if not IsCharAlpha(BLine[l]) then
              Break;
            Inc(p);
          end;

        opDIGIT:
          begin
            if not (BLine[l] in ['0'..'9']) then
              Break;
            Inc(p);
          end;

        opNALPHA:
          begin
            //! StH: Is the second part of the clause correct?
            // This appears to be a test for alphanumerics - if it is, then
            // the clause is incorrect and should be
            //        if IsCharAlphaNumeric(BLine[l]) then
            if IsCharAlpha(BLine[l]) or ((BLine[l] < '0') or (BLine[l] > '9')) then
              Inc(p)
            else
              Break;
          end;

        opPUNCT:
          begin
            if (BLine[l] = ' ') or (BLine[l] > #64) then
              Break;
            Inc(p);
          end;

        opRANGE:
          begin
            if (BLine[l] < FPattern[p + 1]) or (BLine[l] > FPattern[p + 2]) then
              Break;
            Inc(p, 3);
          end;
      else
        Inc(p);
      end; { case }

      if (op = Char(opBOL)) and not (BLine[l] in [#9, #32]) then
        Exit; { Means that we did not match at start }

      op := FPattern[p];
      Inc(l);
    end; { while op <> opENDPAT }
    Inc(LinePos);
    if op = Char(opENDPAT) then
      IsFound;
  end; { while BLine[LinePos] <> #0 }
end;

{
change notes:

changed made by dg ([e-mail]) @ 22/10 1998:

1) '\'-behaviour: changed to standard grep style
new meaning: any character following '\' is treated as a normal character (= is being quoted).
Only exception: inside classes (see next remark).
examples:
 search for a '[': -> searchstring = '\[',
 search for a '\' -> searchstring = '\\',
 search for '\\' -> searchstring = '\\\\'.

2) removed '\'-treatment in classes ([...]) because it didn't work anyway and excape-functionality inside
of classes is very seldomly useful.
btw.: other grep implementations dont's treat '\' as escape-character in classes, too :-)
}

end.