Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/FIRSTED.ZIP/EDFINDS.PAS

Pascal/Delphi Source File | 1987-12-21 | 19KB | 649 lines

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

{$I eddirect.inc}

unit EdFinds;
  {-Find and replace routines for FirstEd}

interface

uses
  crt,                       {Basic video operations - standard unit}
  Dos,                       {DOS calls - standard unit}
  Errors,                    {Runtime error handler}
  EdVars,                    {Global types and declarations}
  EdScrn1,                   {Fast screen writing routines}
  EdString,                  {String primitives}
  EdPtrOp,                   {Primitive pointer operations}
  EdCmds,                    {Maps keystrokes to commands}
  int24,                     {DOS critical error handler}
  Message,                   {Message system}
  EdUser,                    {User keyboard input, line editing and error reporting}
  EdMemOp,                   {Text buffer allocation and deallocation}
  EdBack,                    {Background processes}
  EdScrn2,                   {Editor screen updating}
  EdEdit;                    {Basic editing commands}

procedure EdFind;
  {-Process find pattern command}

procedure EdFindReplace;
  {-Process find pattern in text and replace command}

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

implementation

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;       {"}

  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}

  {*** xp has succ(promptlen), yp ignored}
  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, 1, Width, MaxLen, HaveWindow, St);
    if not(Abortcmd) then
      {Save search string for next time}
      SearchStr := St;
  end;                       {EdGetSearchString}

  {*** xp has succ(promptlen), yp ignored}
  procedure EdGetOptions(Xp, Yp, Width, MaxLen : Integer; HaveWindow : Boolean);
    {-Get search options for Find and Replace}
  var
    OptSt : VarString;
    I : Integer;

  begin                      {EdGetOptions}
    if PromptForInput then begin
      OptSt := OptionStr;
      EdAskforEditor(Xp, 1, Width, MaxLen, HaveWindow, OptSt);
      if Abortcmd then
        Exit;
      OptionStr := OptSt;
    end;
    FindUpper := False;
    FindBackward := False;
    FindWholeWord := False;
    Preview := True;
    Global := False;
    Blockfind := False;
    for I := 1 to Length(OptionStr) do
      case Upcase(OptionStr[I]) of
        'U' : FindUpper := True;
        'B' : FindBackward := True;
        'W' : FindWholeWord := True;
        'N' : Preview := False;
        'G' : Global := True;
        'L' : Blockfind := True;
      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}
  var
    C : Integer;
    P : PlineDesc;
    M : BlockMarker;
    Prompt : VarString;
    HaveWindow : Boolean;

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

    begin                    {RestoreScreen}
      if HaveWindow then
        EdUpdateCursor;
    end;                     {RestoreScreen}

  begin                      {EdFind}

    AbortEnable := True;

    {Don't update screen if keystrokes waiting}
    HaveWindow := PromptForInput and (EditUsercommandInput = 0);

    if PromptForInput then begin
      Prompt := EdGetMessage(323);
      if HaveWindow then
        EdWritePromptLine(Prompt);
      EdGetSearchString(Succ(Length(Prompt)), 1,
                        DefNoCols-Length(Prompt),
                        DefNoCols-Length(Prompt),
                        HaveWindow, SearchStr);
    end;
    if Abortcmd or EdStringEmpty(SearchStr) then begin
      RestoreScreen;
      Exit;
    end;

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

    Prompt := EdGetMessage(318);
    if HaveWindow then
      EdWritePromptLine(Prompt);
    EdGetOptions(Succ(Length(Prompt)), 1, 10, 6, HaveWindow);

    {Remove the prompt box}
    RestoreScreen;

    if Abortcmd 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));

    {Search for the pattern}
    with CurWin^ do begin

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

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

    end;

    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);
      {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);

  end;                       {EdFind}

  {***}
  procedure EdFindReplace;
    {-Process find pattern in text and replace command}
  label
    ExitPoint;
  var
    Ch : Char;
    HaveWindow, NoReplace, NotFound, ShowUpdates : Boolean;
    Fcol, Flength, Rlength : Integer;
    P : PlineDesc;
    M : BlockMarker;
    CmdPrompt, Prompt : VarString;

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

    begin                    {RestoreScreen}
      if HaveWindow then
        EdUpdateCursor;
    end;                     {RestoreScreen}

    {***}
    procedure EdReplacestring(StartCol : Integer);
      {-Perform string replacement}
    var
      EndOfSearch, EndOfReplace : Integer;
      LenDiff : Integer;

    begin                    {EdReplacestring}
      with CurWin^ do begin

        Modified := True;
        EndOfSearch := StartCol+Length(SearchStr);
        EndOfReplace := StartCol+Length(ReplaceStr);
        LenDiff := Length(ReplaceStr)-Length(SearchStr);

        if LenDiff < 0 then begin
          {Line getting shorter}
          with CurLine^ do begin
            Move(Txt^[EndOfSearch], Txt^[EndOfReplace], Succ(Bufflen-EndOfSearch));
            FillChar(Txt^[Succ(Bufflen)+LenDiff], -LenDiff, Blank);
          end;
          {Fix up markers}
          EdFixBlockInsertedSpace(CurLine, StartCol, LenDiff);
          EdCheckNoMarker;
          EdFixMarkInsertedSpace(CurLine, StartCol, LenDiff);

        end else if LenDiff > 0 then begin
          {Line getting longer}
          if not EdSizeline(CurLine, CurLine^.Bufflen+LenDiff, True) then begin
            EdErrormsg(35);
            {Stop searching}
            Global := False;
            Exit;
          end;
          with CurLine^ do
            Move(Txt^[EndOfSearch], Txt^[EndOfReplace], Succ(Bufflen-EndOfReplace));
          {Fix up markers}
          EdFixBlockInsertedSpace(CurLine, StartCol, LenDiff);
          EdFixMarkInsertedSpace(CurLine, StartCol, LenDiff);

        end;

        Move(ReplaceStr[1], CurLine^.Txt^[StartCol], Length(ReplaceStr));
      end;
    end;                     {EdReplacestring}

  begin                      {EdFindReplace}

    AbortEnable := True;
    LastSearchOp := None;

    HaveWindow := PromptForInput and (EditUsercommandInput = 0);

    if PromptForInput then begin
      Prompt := EdGetMessage(323);
      if HaveWindow then
        {Display the prompt}
        EdWritePromptLine(Prompt);
      EdGetSearchString(Succ(Length(Prompt)), 1,
                        DefNoCols-Length(Prompt),
                        DefNoCols-Length(Prompt),
                        HaveWindow, SearchStr);
    end;

    if Abortcmd or EdStringEmpty(SearchStr) then begin
      RestoreScreen;
      Exit;
    end;

    if PromptForInput then begin
      Prompt := EdGetMessage(338);
      if HaveWindow then
        {Display the prompt}
        EdWritePromptLine(Prompt);
      EdGetSearchString(Succ(Length(Prompt)), 1,
                        DefNoCols-Length(Prompt),
                        DefNoCols-Length(Prompt),
                        HaveWindow, ReplaceStr);
    end;
    if Abortcmd then begin
      RestoreScreen;
      Exit;
    end;

    {Save length for use in replace operations}
    Rlength := Length(ReplaceStr);

    {Set up command prompt}
    CmdPrompt := EdGetMessage(339);
    LastSearchOp := Replace;

    Flength := Length(SearchStr);

    {Ask for options}
    Prompt := EdGetMessage(337);
    if HaveWindow then
      {Draw new prompt}
      EdWritePromptLine(Prompt);
    EdGetOptions(Succ(Length(Prompt)), 1, 10, 6, HaveWindow);

    {Get rid of prompt box}
    RestoreScreen;

    if Abortcmd then
      Exit;

    if Blockfind then begin
      EdBlockInit;
      if GotError then
        Exit;
      Global := True;
    end else if Global then
      EdGlobalInit;

    {Search for the pattern}
    NotFound := True;
    ShowUpdates := True;
    {Set cursor to proper start position to avoid repeated finds}
    Fcol := EdSetStartCol(CurWin^.ColNo);

    with CurWin^ do
      repeat

        if ShowUpdates then begin
          EdWritePromptLine(EdGetMessage(326));
          {Update entire screen at least once}
          EdUpdateScreen;
          {Show further updates only if previewing}
          ShowUpdates := Preview;
        end else
          {Update only the command line}
          EdWritePromptLine(EdGetMessage(327));

        {Find the next match}
        P := EdScanpattern(CurLine, SearchStr, Fcol);

        if Abortcmd then
          goto ExitPoint;

        if EdPtrIsNil(P) then

          {No match, force exit}
          Global := False

        else begin

          {Found at least one occurrence of the pattern}
          NotFound := False;

          {Move cursor to the position found}
          M.Line := P;
          if PositionFindAtStart or FindBackward then
            M.Col := Fcol
          else
            M.Col := Fcol+Flength;
          EdJumpMarker(M);

          {Assume the replacement will be done}
          NoReplace := False;

          {Optional preview before replacement}
          if Preview then begin
            EdWritePromptLine('');
            {Show the found string clearly}
            EdHighlightScreen(Fcol, Pred(Fcol+Flength), ScreenAttr[BordColor], False);
            {Prompt for action}
            EdDisplayPromptWindow(CmdPrompt+EdGetMessage(329), 1, [^Y, ^N, ^A, ^Q], Ch);
            if Abortcmd then
              goto ExitPoint;
            case Ch of
              ^Y :
                EdReplacestring(Fcol);

              ^N :
                {Flag that replacement was not done}
                NoReplace := True;

              ^A :
                begin
                  {Modify string and do the rest without asking}
                  EdReplacestring(Fcol);
                  Preview := False;
                end;

              ^Q :
                begin
                  Global := False;
                  NoReplace := True;
                end;
            end;

          end else
            {Modify without asking}
            EdReplacestring(Fcol);

          if Global then begin
            if FindBackward then begin
              Dec(ColNo);
              if (ColNo < Flength) then
                {No hope of further matches on this line}
                if EdPtrIsNil(CurLine^.Backlink) then
                  {Force exit}
                  Global := False
                else begin
                  EdUpLine;
                  EdRightLine;
                end;
            end else begin
              {Advance over the replace string to prevent left recursive search/replace}
              if NoReplace and (Rlength = 0) then
                {Don't get stuck in place}
                ColNo := Succ(Fcol)
              else
                ColNo := Fcol+Rlength;
              if (ColNo+Flength > CurLine^.Bufflen) then
                {No hope of further matches on this line}
                if EdPtrIsNil(CurLine^.FwdLink) then begin
                  {Force exit}
                  Global := False;
                  EdRightLine;
                end else begin
                  EdDownLine;
                  ColNo := 1;
                end;
            end;
            if Blockfind then
              if not(EdCursorInBlock(CurLine, ColNo, True)) then
                {Cursor moved outside of block - force exit}
                Global := False;
            {Set "find" column for next pass}
            Fcol := ColNo;
          end else begin
            {Move the cursor past the last string found}
            if not(FindBackward or PositionFindAtStart) then begin
              if NoReplace then
                ColNo := Fcol+Flength
              else
                ColNo := Fcol+Rlength;
            end;
          end;
        end;

      until not Global;

    if NotFound then
      {Pattern not found}
      EdErrormsg(38);

ExitPoint:
    EdRealign;

  end;                       {EdFindReplace}

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