Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSFIND.PAS

Pascal/Delphi Source File | 1987-12-21 | 13.6 KB | 466 lines

{                            MSFIND.PAS
                               MS 4.0
                Copyright (c) 1985, 87 by Borland International, Inc.         }

{$I msdirect.inc}

unit MsFind;
  {-Find and replace routines}

interface

uses
  Crt,                       {Basic video operations - standard unit}
  Dos,                       {DOS interface - standard unit}
  Errors,                    {Runtime error handler}
  MsVars,                    {Global types and declarations}
  MsScrn1,                   {Fast screen writing routines}
  MsString,                  {String primitives}
  MsPtrOp,                   {Primitive pointer operations}
  EscSeq,                    {Returns text string for extended scan codes}
  MsCmds,                    {Maps keystrokes to commands}
  Int24,                     {DOS critical error handler}
  Message,                   {Message system}
  MsUser,                    {User keyboard input, line editing and error reporting}
  MsMemOp,                   {Text buffer allocation and deallocation}
  MsBack,                    {Background processes}
  MsScrn2,                   {Editor screen updating}
  MsEdit;                    {Basic editing commands}

var
  SearchStr : VarString;     {Used by EditFind, EditFindReplace}
  ReplaceStr : VarString;    {Used by EditFindReplace}
  OptionStr : VarString;     {Used by EditFindReplace}
  Findupper : Boolean;       {Flags controlling search operations}
  Findbackward : Boolean;    {"}
  Findwholeword : Boolean;   {"}
  Preview : Boolean;         {"}
  Global : Boolean;          {"}
  Blockfind : Boolean;       {"}
  FindCount : Integer;       {Number of times to apply find/replace}

function EdScanpattern(Q : PlineDesc; Pattern : VarString;
                       var C : Integer) : PlineDesc;
  {-Scan for pattern, returning plinedesc and column pos if found}

procedure EdGetSearchString(Xp, Yp, Width, Maxlen : Integer;
                            HaveWindow : Boolean;
                            var SearchStr : VarString);
  {-Prompt for and return search string}

procedure EdGetOptions(Xp, Yp, Width, Maxlen : Integer;
                       HaveWindow : Boolean);
  {-Get search options for Find and Replace}

procedure EdGlobalInit;
  {-Position cursor for a global search}

procedure EdBlockInit;
  {-Position cursor for a block search}

function EdSetStartCol(Colno : Integer) : Integer;
  {-Set cursor to appropriate starting position}

procedure EdFind;
  {-Process find pattern command}

  {==========================================================================}

implementation

  function EdScanpattern(Q : PlineDesc; Pattern : VarString;
                         var C : Integer) : PlineDesc;
    {-Scan for pattern, returning plinedesc and column pos if found}
  var
    Lcol, Mcol, Rcol, Plen, Qlen : Integer;
    Leftedge, RightEdge, Done, DidLast : Boolean;

  begin                      {EdScanpattern}

    {Initialize in case we abort out of here}
    EdScanpattern := nil;

    Mcol := 0;
    Plen := Length(Pattern);
    DidLast := False;

    if Findupper then
      EdLongUpcase(Pattern, Plen);

    while EdPtrNotNil(Q) and (Mcol = 0) do begin

      {Allow abort - check once per line}
      EdBreathe;
      if Abortcmd then
        Exit;

      Qlen := EdTextLength(Q)+2;

      {Assure reasonable column position passed in}
      if (C >= 1) and (C <= Qlen) then begin

        {Move text into a buffer which we can uppercase}
        Move(Q^.Txt^[1], WorkBuf[1], Qlen);
        if Findupper then
          EdLongUpcase(WorkBuf, Qlen);

        if EdPtrNotNil(Q^.Fwdlink) then
          {Add an EOL mark to allow searching for that}
          Move(EolMark[1], WorkBuf[Pred(Qlen)], 2);

        if Findwholeword then begin

          {Special case, separate from other for speed}

          repeat

            if Qlen = 0 then
              Mcol := 0
            else if Findbackward then
              Mcol := EdLongPosBack(WorkBuf, C, Pattern)
            else
              Mcol := EdLongPosFwd(WorkBuf, C, Qlen, Pattern);

            if Mcol <> 0 then begin
              {Found a pattern match, see if a word}
              Lcol := Pred(Mcol);
              Leftedge := (Mcol = 1) or (Pos(WorkBuf[Lcol], WordDelimiters) <> 0);
              Rcol := Mcol+Plen;
              RightEdge := (Rcol > Qlen) or (Pos(WorkBuf[Rcol], WordDelimiters) <> 0);
              if not(Leftedge and RightEdge) then begin
                {Pattern match not a whole word}
                if Findbackward then begin
                  C := Rcol-2;
                  Done := (C < Plen);
                end else begin
                  C := Succ(Mcol);
                  Done := (C+Plen > Qlen);
                end;
                Mcol := 0;
              end;
            end else
              {No pattern match, this line is hopeless}
              Done := True;

          until (Mcol <> 0) or Done;

        end else begin

          {Search the line once for the pattern}
          {Mcol holds the position of the match, or 0 if not found}
          if Qlen = 0 then
            Mcol := 0
          else if Findbackward then
            Mcol := EdLongPosBack(WorkBuf, C, Pattern)
          else
            Mcol := EdLongPosFwd(WorkBuf, C, Qlen, Pattern);

        end;

      end;                   {start col in text part of line}

      if (Mcol = 0) then begin

        {No match - try next line}
        if Blockfind then
          if DidLast then
            {Exit with no match}
            Exit;

        {Move to next line}
        if Findbackward then begin
          EdBackPtr(Q);
          C := EdTextLength(Q)+2;
        end else begin
          EdFwdPtr(Q);
          C := 1;
        end;

        {See if last line of block}
        if Blockfind then
          if Findbackward then begin
            if Q = Blockfrom.Line then
              DidLast := True;
          end else begin
            if Q = Blockto.Line then
              DidLast := True;
          end;
      end;
    end;                     {While not(matched)}

    if Mcol <> 0 then begin
      {Return the line pointer and the column}
      if Blockfind then
        if not(EdCursorInBlock(Q, Mcol, False {True} )) then
          {Cursor moved outside of block on last line}
          Exit;
      EdScanpattern := Q;
      C := Mcol;
    end;

  end;                       {EdScanpattern}

  procedure EdGetSearchString(Xp, Yp, Width, Maxlen : Integer;
                              HaveWindow : Boolean;
                              var SearchStr : VarString);
    {-Prompt for and return search string}
  var
    St : VarString;

  begin                      {EdGetSearchString}
    {Set default search string}
    St := SearchStr;
    EdAskforEditor(Xp, Yp, Width, Maxlen, HaveWindow, St);
    if not(Abortcmd) then
      {Save search string for next time}
      SearchStr := St;
  end;                       {EdGetSearchString}

  procedure EdGetOptions(Xp, Yp, Width, Maxlen : Integer;
                         HaveWindow : Boolean);
    {-Get search options for Find and Replace}
  var
    OptSt : VarString;
    I : Integer;

    function EdParseNumber(var OptionStr : VarString; var I : Integer) : Integer;
      {-Parse the option string, returning an Word}
    var
      NumStr : VarString;
      Num : Integer;

    begin                    {EdParseNumber}
      EdClearString(NumStr);
      while (OptionStr[I] in ['0'..'9']) and (I <= Length(OptionStr)) do begin
        NumStr := NumStr+OptionStr[I];
        Inc(I);
      end;
      EdString2integer(NumStr, Num);
      if Goterror then begin
        {Return to default}
        EdParseNumber := 1;
        {Skip rest of input}
        I := Length(OptionStr);
      end else begin
        EdParseNumber := Num;
        {Don't skip any characters}
        Dec(I);
      end;
    end;                     {EdParseNumber}

  begin                      {EdGetOptions}
    if PromptForInput then begin
      OptSt := OptionStr;
      EdAskforEditor(Xp, Yp, Width, Maxlen, HaveWindow, OptSt);
      if Abortcmd then
        Exit;
      OptionStr := OptSt;
    end;

    {Default options}
    Findupper := False;
    Findbackward := False;
    Findwholeword := False;
    Preview := True;
    Global := False;
    Blockfind := False;
    FindCount := 1;

    I := 1;
    while I <= Length(OptionStr) do begin
      case Upcase(OptionStr[I]) of
        'U' : Findupper := True;
        'B' : Findbackward := True;
        'W' : Findwholeword := True;
        'N' : Preview := False;
        'G' : Global := True;
        'L' : Blockfind := True;
        '0'..'9' : FindCount := EdParseNumber(OptionStr, I);
      end;
      Inc(I);
    end;
  end;                       {EdGetOptions}

  procedure EdGlobalInit;
    {-Position cursor for a global search}

  begin                      {EdGlobalInit}
    if Findbackward then
      {Go to end of file}
      EdWindowBottomFile
    else
      {Go to beginning of file}
      EdWindowTopFile;
  end;                       {EdGlobalInit}

  procedure EdBlockInit;
    {-Position cursor for a block search}

  begin                      {EdBlockInit}
    if EdNoBlock then begin
      EdErrormsg(26);
      Exit;
    end;
    if Findbackward then
      EdJumpMarker(Blockto)
    else
      EdJumpMarker(Blockfrom);
  end;                       {EdBlockInit}

  function EdSetStartCol(Colno : Integer) : Integer;
    {-Set cursor to appropriate starting position}
  var
    C : Integer;

  begin                      {EdSetStartCol}
    if Findbackward then
      {Start one column prior to the current cursor}
      C := Pred(Colno)
    else if Global or Blockfind or not(PositionFindAtStart) then
      {Start at current column}
      C := Colno
    else
      {Start one beyond current cursor so repeated finds move on}
      C := Succ(Colno);
    EdSetStartCol := C;
  end;                       {EdSetStartCol}

  procedure EdFind;
    {-Process find pattern command}
  const
    Xmin = 5;
    XSize = 70;
    YSize = 4;
  var
    C, Ymin, Count : Integer;
    P : PlineDesc;
    M : BlockMarker;
    W : WindowPtr;
    Prompt : VarString;
    HaveWindow, CursorState : Boolean;

    procedure RestoreScreen;
      {-Get rid of the prompt window if appropriate}

    begin                    {RestoreScreen}
      if HaveWindow then begin
        {Remove window}
        EdRestoreWindow(W, Xmin, Ymin, XSize, YSize);
        {Restore cursor}
        SolidCursor := CursorState;
        EdSetCursorOff;
        if EdPtrIsNil(CurrMenu) then begin
          EdShowMenuHelp;
          EdUpdateCursor;
        end;
      end;
    end;                     {RestoreScreen}

  begin                      {EdFind}

    AbortEnable := True;

    if PromptForInput and (EditUsercommandInput = 0) then begin
      {Set up a prompt box}
      EdEraseMenuHelp;
      EdUpdateCmdLine;
      HaveWindow := True;
      with Curwin^ do
        Ymin := (Firstlineno+Lastlineno) shr 1;
      if Ymin > 21 then
        Ymin := 21;
      if EdPtrNotNil(CurrMenu) then
        if Ymin < 12 then
          Ymin := 12;
      W := EdSetupWindow(Border, Xmin, Ymin, Pred(Xmin+XSize), Pred(Ymin+YSize), NormalBox);
      CursorState := SolidCursor;
      SolidCursor := False;
    end else
      HaveWindow := False;

    if PromptForInput then begin
      if HaveWindow then begin
        {Display the prompt}
        Prompt := EdGetMessage(323);
        EdFastWrite(Prompt, Ymin, Xmin+(XSize-Length(Prompt)) shr 1, ScreenAttr[MfColor]);
      end;
      EdGetSearchString(Xmin, Succ(Ymin), XSize, XSize-3, HaveWindow, SearchStr);
    end;
    if Abortcmd or EdStringEmpty(SearchStr) then begin
      RestoreScreen;
      Exit;
    end;

    {Last operation was a find}
    LastSearchOp := Find;

    if HaveWindow then begin
      {Redraw border}
      EdDrawBox(Border, Xmin, Ymin, XSize, 4, NormalBox);
      {Draw new prompt}
      Prompt := EdGetMessage(318);
      EdFastWrite(Prompt, Ymin, Xmin+(XSize-Length(Prompt)) shr 1, ScreenAttr[MfColor]);
    end;

    EdGetOptions(Xmin, Ymin+2, XSize, 6, HaveWindow);
    Count := FindCount;

    {Remove the prompt box}
    RestoreScreen;

    if Abortcmd or Goterror then
      Exit;

    if Blockfind then begin
      {Search within marked block only}
      EdBlockInit;
      if Goterror then
        Exit;
    end else if Global then
      EdGlobalInit;

    EdWritePromptLine(EdGetMessage(326));
    ExitMenu := True;

    {Search for the pattern}
    with Curwin^ do
      repeat

        {Set cursor to proper start position to avoid repeated finds}
        C := EdSetStartCol(Colno);

        {Do the work of the search}
        P := EdScanpattern(Curline, SearchStr, C);
        Dec(Count);

        if EdPtrNotNil(P) then begin

          {Move cursor to the position found}
          M.Line := P;
          if Findbackward or PositionFindAtStart then
            M.Col := C
          else
            M.Col := C+Length(SearchStr);
          EdJumpMarker(M);

          if Count <= 0 then
            {Show the found string clearly}
            EdHighlightScreen(C, Pred(C+Length(SearchStr)), ScreenAttr[BordColor], True);

        end else if Abortcmd then
          Exit

        else
          {Pattern not found}
          EdErrormsg(38);

      until (Count <= 0) or EdPtrIsNil(P);

  end;                       {EdFind}

begin
  SearchStr := '';
  ReplaceStr := '';
  OptionStr := '';
end.