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

Pascal/Delphi Source File | 1987-12-21 | 15.3 KB | 556 lines

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

{$I msdirect.inc}

unit MsBlok;
  {-Block move, copy and delete}

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}


procedure EdBlockMove;
  {-Process move block command}

procedure EdBlockCopy;
  {-Process copy block command}

procedure EdBlockDelete;
  {-Process delete block command}

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

implementation

  procedure EdBlockCleanup;
    {-Reset markers and generally clean up when done with a block operation}

  begin                      {EdBlockCleanup}
    Curwin^.Modified := True;
    EdJumpMarker(Blockfrom);
    EdRealign;
    EdOffblock;
    Blockhide := False;
  end;                       {EdBlockCleanup}

  procedure EdBlockMove;
    {-Process move block command}
  var
    WindFrom : Pwindesc;
    F, T, C : BlockMarker;
    Cline, Fright, Tright, Cright : PlineDesc;
    M, ColFrom, ColTo, Colpos, NewColFrom, NewColTo : Integer;

  begin                      {EdBlockMove}

    {A block must be defined and unhidden}
    if EdNoBlock then
      Exit;

    {Don't allow the cursor within the block}
    if EdCursorInBlock(Curwin^.Curline, Curwin^.Colno, False) then
      Exit;

    {Provide some temporary margin for the move, which overall conserves memory}
    FreeListSpace := FreeListPerm-(Maxlinelength shl 2);

    {Reset pagination on current window}
    EdResetPageLine(Curwin);

    if (Blockfrom.Line = Blockto.Line) and (Curwin^.Curline = Blockfrom.Line) then begin

      {Move within a single line is special case}

      {Temporary variables}
      ColFrom := Blockfrom.Col;
      ColTo := Blockto.Col;
      Colpos := Curwin^.Colno;
      Cline := Curwin^.Curline;

      with Cline^ do begin

        if Colpos >= Bufflen then
          {Size up line}
          if not(EdSizeline(Cline, Succ(Colpos), True)) then begin
            {Insufficient memory - should be impossible to reach here}
            FreeListSpace := FreeListPerm;
            Exit;
          end;

        {Initialize buffer}
        Move(Txt^[1], WorkBuf[1], Bufflen);

        if Colpos < ColFrom then begin

          {Cursor to left of marked block}
          Move(Txt^[ColFrom], WorkBuf[Colpos], ColTo-ColFrom);
          Move(Txt^[Colpos], WorkBuf[Colpos+ColTo-ColFrom], ColFrom-Colpos);
          NewColFrom := Colpos;
          NewColTo := Colpos+ColTo-ColFrom;

        end else begin

          {Cursor to right of marked block}
          Move(Txt^[ColTo], WorkBuf[ColFrom], Colpos-ColTo);
          Move(Txt^[ColFrom], WorkBuf[ColFrom+Colpos-ColTo], ColTo-ColFrom);
          NewColFrom := ColFrom+Colpos-ColTo;
          NewColTo := Colpos;

        end;

        {Copy buffer to current}
        Move(WorkBuf[1], Txt^[1], Bufflen);

      end;

      {Save new block pointers}
      Blockfrom.Col := NewColFrom;
      Blockto.Col := NewColTo;

      {Fix up text markers}
      if EdFlagSet(Cline, InMark) then
        for M := 0 to MaxMarker do
          with Marker[M] do
            if Line = Cline then
              if Colpos < ColFrom then begin
                if (Col >= Colpos) and (Col < ColFrom) then
                  Col := Col+ColTo-ColFrom
                else if (Col >= ColFrom) and (Col < ColTo) then
                  Col := Col-ColFrom+Colpos;
              end else begin
                if (Col >= ColFrom) and (Col < ColTo) then
                  Col := Col+Colpos-ColTo
                else if (Col >= ColTo) and (Col < Colpos) then
                  Col := Col+ColFrom-ColTo;
              end;

    end else begin

      {Move from one line to another}

      {Store temporary markers}
      F := Blockfrom;
      T := Blockto;
      with C, Curwin^ do begin
        Line := Curline;
        Col := Colno;
      end;

      {Determine whether all of any window topline or curline is in marked block}
      WindFrom := EdFindWindow(Blockfrom.Line);
      WindFrom^.Modified := True;
      EdFixBaseLine(WindFrom);

      {Reset pagination progress for window from which move occurred}
      EdResetPageLine(WindFrom);

      {Insert line breaks at the three markers}
      {ORDER is IMPORTANT}
      if C.Line = T.Line then
        EdInsertLinePrimitive(C, Cright);
      EdInsertLinePrimitive(T, Tright);
      EdInsertLinePrimitive(F, Fright);
      if C.Line <> T.Line then
        EdInsertLinePrimitive(C, Cright);

      {Splice}
      if T.Line = F.Line then begin
        {Block contained within single line}
        Fright^.Fwdlink := Cright;
        EdJoinLinePrimitive(Fright, T.Col-F.Col);
      end else begin
        {Multiline block}
        T.Line^.Fwdlink := Cright;
        EdJoinLinePrimitive(T.Line, Pred(T.Col));
      end;

      if T.Line = C.Line then begin
        {Cursor on same line as end of block}
        Tright^.Fwdlink := Fright;
        EdJoinLinePrimitive(Tright, C.Col-T.Col);
      end else begin
        C.Line^.Fwdlink := Fright;
        EdJoinLinePrimitive(C.Line, Pred(C.Col));
      end;

      if F.Line = C.Line then begin
        {Cursor on same line as begin of block}
        T.Line^.Fwdlink := Tright;
        EdJoinLinePrimitive(T.Line, Pred(T.Col+F.Col-C.Col));
      end else begin
        F.Line^.Fwdlink := Tright;
        EdJoinLinePrimitive(F.Line, Pred(F.Col));
      end;

      {Set block markers again}
      if T.Line = C.Line then begin
        Blockfrom.Line := F.Line;
        Blockfrom.Col := F.Col+C.Col-T.Col;
      end else
        Blockfrom := C;

      if F.Line = T.Line then begin
        Blockto.Line := C.Line;
        Blockto.Col := C.Col+T.Col-F.Col;
      end else
        Blockto := T;

    end;

    EdBlockCleanup;

  end;                       {EdBlockMove}

  procedure EdBlockCopy;
    {-Process copy block command}
  var
    C : BlockMarker;
    Cline, Cright, P, Q, B, F, T : PlineDesc;
    M, Colpos, ColFrom, ColTo, Blen : Integer;
    Done : Boolean;

  begin                      {EdBlockCopy}

    {A block must be defined and visible}
    if EdNoBlock then
      Exit;

    {Don't allow cursor within block}
    if EdCursorInBlock(Curwin^.Curline, Curwin^.Colno, True) then
      Exit;

    Cline := Curwin^.Curline;
    Colpos := Curwin^.Colno;
    with C do begin
      Line := Cline;
      Col := Colpos;
    end;
    ColFrom := Blockfrom.Col;
    ColTo := Blockto.Col;
    F := Blockfrom.Line;
    T := Blockto.Line;

    {Reset pagination progress}
    EdResetPageLine(Curwin);

    if (F = T) and (Cline = F) then begin

      {Copy within a single line is special case}
      with Cline^ do begin

        {Size up current line}
        if Colpos > Bufflen then
          Blen := Colpos
        else
          Blen := Bufflen;

        if not(EdSizeline(Cline, Succ(Blen+ColTo-ColFrom), True)) then begin
          {Insufficient memory}
          EdErrormsg(35);
          Exit;
        end;

        {Initialize buffer}
        Move(Txt^[1], WorkBuf[1], Bufflen);

        {Copy the appropriate text}
        Move(Txt^[ColFrom], WorkBuf[Colpos], ColTo-ColFrom);
        if Blen <> Colpos then
          Move(Txt^[Colpos], WorkBuf[Colpos+ColTo-ColFrom], Succ(Blen-Colpos));

        {Copy buffer to current}
        Move(WorkBuf[1], Txt^[1], Bufflen);

      end;

      {Save new block markers}
      Blockfrom.Col := Colpos;
      Blockto.Col := Colpos+ColTo-ColFrom;

      {Fix up text markers}
      if EdFlagSet(Cline, InMark) then
        for M := 0 to MaxMarker do
          with Marker[M] do
            if Line = Cline then
              if (Col >= Colpos) then
                Col := Col+ColTo-ColFrom;

    end else begin

      {Reduce available memory so we have something left to link with}
      FreeListSpace := FreeListPerm+(Maxlinelength shl 1);

      {Break at the cursor position}
      EdInsertLinePrimitive(C, Cright);
      if Goterror then begin
        FreeListSpace := FreeListPerm;
        Exit;
      end;

      {P will track the source text}
      if Cline = F then
        P := Cright
      else
        P := F;

      {Q will track the destination text}
      Q := Cline;

      Done := False;

      repeat

        if (P = F) then begin

          if (P = T) then begin

            {Current source line contains begin and end of block}
            Blen := ColTo-ColFrom;
            B := EdMaktextdesc(Blen);
            if EdPtrNotNil(B) then begin
              {Copy text into buffer}
              Move(P^.Txt^[ColFrom], B^.Txt^[1], Blen);
              {Force exit for last line of block}
              Done := True;
            end;

          end else begin

            {First line of block}
            Blen := Succ(P^.Bufflen-ColFrom);
            B := EdMaktextdesc(Blen);
            if EdPtrNotNil(B) then begin
              {Copy text into buffer}
              Move(P^.Txt^[ColFrom], B^.Txt^[1], Blen);
              EdFwdPtr(P);
            end;

          end;

        end else if (P = T) then begin

          {Last line of block}
          Blen := Pred(ColTo);
          B := EdMaktextdesc(Blen);
          if EdPtrNotNil(B) then begin
            {Copy text into buffer}
            if Blen > 0 then
              Move(P^.Txt^[1], B^.Txt^[1], Blen);
            {Force exit}
            Done := True;
          end;

        end else begin

          {Middle of block}
          Blen := P^.Bufflen;
          B := EdMaktextdesc(Blen);
          if EdPtrNotNil(B) then begin
            {Copy text into buffer}
            Move(P^.Txt^[1], B^.Txt^[1], Blen);
            EdFwdPtr(P);
          end;

        end;

        if EdPtrIsNil(B) then begin

          {Out of memory error already reported}
          {Move b back to previous success and go on to the relink step}
          B := Q;
          Blen := Succ(EdTextLength(B));
          {Correct blockto marker for as far as we got}
          Blockto.Col := Blen;
          Done := True;
          Goterror := False;

        end else begin

          {Insert buffer between current q and cright}
          Q^.Fwdlink := B;
          B^.Backlink := Q;
          B^.Fwdlink := Cright;
          Cright^.Backlink := B;

          {Move q forward to b so that next line is inserted after b}
          Q := B;

        end;

      until Done;            {Loop through all lines of block}

      {Get free list space back so we have room to link up}
      FreeListSpace := FreeListPerm;

      {Join at begin and end}

      {Join right part of original current line to last buffer}
      EdJoinLinePrimitive(B, Blen);
      if Goterror then begin
        EdBlockCleanup;
        Exit;
      end;

      {Join first buffer to left part of current line}
      EdJoinLinePrimitive(Cline, Pred(Colpos));
      if Goterror then begin
        EdBlockCleanup;
        Exit;
      end;

      {Set block markers}
      if F = T then begin
        {Original block contained in a single line}
        Blockto.Line := Cline;
        Blockto.Col := Colpos+Blen;
      end else
        Blockto.Line := B;
      Blockfrom.Line := Cline;
      Blockfrom.Col := Colpos;

    end;

    EdBlockCleanup;

  end;                       {EdBlockCopy}

  procedure EdBlockDelete;
    {-Process delete block command}
  var
    WindFrom : Pwindesc;
    P, Q, Tright, Fright : PlineDesc;
    C : BlockMarker;
    M, ColFrom, ColTo, Blen : Integer;

  begin                      {EdBlockDelete}

    {A block must be defined and not hidden}
    if EdNoBlock then
      Exit;

    ColFrom := Blockfrom.Col;
    ColTo := Blockto.Col;
    WindFrom := EdFindWindow(Blockfrom.Line);

    {Don't delete from a background window when zoomed}
    if Zoomed and (WindFrom <> Curwin) then
      Exit;

    {Reset pagination progress}
    EdResetPageLine(WindFrom);

    {Determine whether all of any window topline or curline is in marked block}
    EdFixBaseLine(WindFrom);

    {Special case when block is within a single line}
    if (Blockfrom.Line = Blockto.Line) then begin

      P := Blockfrom.Line;
      Blen := EdTextLength(P);

      with P^ do begin

        {Initialize buffer}
        Move(Txt^[1], WorkBuf[1], Bufflen);

        {Remove characters and right pad with blanks}
        if ColTo <= Blen then
          Move(Txt^[ColTo], WorkBuf[ColFrom], Succ(Blen-ColTo));
        FillChar(WorkBuf[ColFrom+Succ(Blen-ColTo)], (ColTo-ColFrom), Blank);

        {Copy buffer to current}
        Move(WorkBuf[1], Txt^[1], Bufflen);

      end;

      {Correct cursor}
      if Curwin^.Curline = Blockfrom.Line then
        Curwin^.Colno := Blockfrom.Col;

      {Fix up text markers}
      if EdFlagSet(P, InMark) then
        for M := 0 to MaxMarker do
          with Marker[M] do
            if Line = P then
              if (Col >= ColTo) then
                Col := Col-ColTo+ColFrom
              else if (Col >= ColFrom) then
                EdSetPtrNil(Line);

    end else begin

      {Store temporary marker}
      with C do begin
        Line := Curwin^.Curline;
        Col := Curwin^.Colno;
      end;

      {Provide some memory margin to get started deleting}
      FreeListSpace := FreeListPerm-(Maxlinelength shl 1);

      {Insert line breaks before and after block}
      EdInsertLinePrimitive(Blockfrom, Fright);
      if Goterror then begin
        FreeListSpace := FreeListPerm;
        Exit;
      end;
      EdInsertLinePrimitive(Blockto, Tright);
      if Goterror then begin
        FreeListSpace := FreeListPerm;
        Exit;
      end;

      {Now scan and delete all lines in the block}
      P := Fright;
      repeat

        {Get the forward link now. push to undo destroys it}
        Q := P^.Fwdlink;

        {Put line on undo stack if possible}
        EdPushUndo(P);

        P := Q;

      until P = Tright;

      {Splice blockfrom to tright}
      Blockfrom.Line^.Fwdlink := Tright;
      EdJoinLinePrimitive(Blockfrom.Line, Pred(Blockfrom.Col));

      FreeListSpace := FreeListPerm;
      EdRealign;
      EdJumpMarker(C);

    end;

    WindFrom^.Modified := True;
    {Indicate that markers are gone}
    EdSetPtrNil(Blockto.Line);
    EdOffblock;
    Blockhide := True;

  end;                       {EdBlockDelete}


end.