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

Pascal/Delphi Source File | 1987-12-21 | 18.9 KB | 698 lines

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

{$I msdirect.inc}

unit MsMemOp;
  {-Allocate and deallocate memory for text lines and windows}

interface

uses
  Crt,                       {Basic video}
  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, prompt and error interactions}

var
  ExactAllocation : Boolean; {Set true to allocate buffers of same size as text}

function EdBufferSize(Ncols : Integer) : Integer;
  {-Return a proper buffer size for the number of text columns requested}

procedure EdDesTextDesc(P : PlineDesc);
  {-Destroy text descriptor}

procedure EdPushUndo(var P : PlineDesc);
  {-Save a deleted line on the undo stack if possible}

procedure EdDeleteAllText(W : Pwindesc);
  {-delete the entire text stream of a window}

function EdMaktextdesc(Ncols : Integer) : PlineDesc;
  {-Make new text descriptor record}

function EdSizeline(P : PlineDesc; Ncols : Integer; Init : Boolean) : Boolean;
  {-Expand line size to accommodate Ncols characters}

function EdAllocateWindow(Top, Len, Cr, Cc : Integer; Fn : Filepath) : Pwindesc;
  {-Return a pointer to a window structure}

function EdNewTextStream(W : Pwindesc) : Boolean;
  {-Create a new text stream, returning true if successful}

procedure EdJoinLinePrimitive(P : PlineDesc; LenP : Integer);
  {-Join the line p at column lenP with the line following it}

procedure EdJoinline;
  {-Join two lines and fix up block markers}

procedure EdInsertLinePrimitive(M : BlockMarker; var P : PlineDesc);
  {-Insert a new line after marker m, return pointer to new line}

function EdInsertSpace(P : PlineDesc; Start : Integer; Num : Integer) : Boolean;
  {-Insert num spaces at position start of line p}

procedure EdNewLinePrimitive;
  {-Insert a new line, straighten out indents and markers}

procedure EdWindowCreate(Wno : Byte);
  {-Create new window by splitting window wno in two}

procedure EdPushWindowStack(W : Pwindesc);
  {-Put a window descriptor on the window free list}

procedure EdWindowDelete(Wno : Byte);
  {-Perform delete window command processing}

procedure EdResetWindow(W : Pwindesc);
  {-Reset the window descriptor}

function EdCalcMemory : VarString;
  {-Return the bytes of available heap space, in a string}

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

implementation

  function EdBufferSize(Ncols : Integer) : Integer;
    {-Return a proper buffer size for the number of text columns requested}

  begin                      {EdBufferSize}
    if ExactAllocation then
      EdBufferSize := Succ(Ncols)
    else
      EdBufferSize := Succ(Ncols shr 3) shl 3;
  end;                       {EdBufferSize}

  procedure EdDesTextDesc(P : PlineDesc);
    {-Destroy text descriptor}

  begin                      {EdDesTextdesc}
    {Free text line first}
    FreeMem(P^.Txt, Succ(P^.Bufflen));
    {Now the linedesc itself}
    FreeMem(P, SizeOf(Linedesc));
  end;                       {EdDesTextdesc}

  procedure EdPushUndo(var P : PlineDesc);
    {-Save a deleted line on the undo stack if possible}
  var
    Q : PlineDesc;
    M : Integer;

  begin                      {EdPushUndo}

    {Make sure the undo stack hasn't overflowed}
    if UndoLimit <> 0 then
      while (UndoCount >= UndoLimit) do begin
        {If we need to delete a line at the rear}
        Dec(UndoCount);
        Q := UndoEnd^.Backlink;
        EdDesTextDesc(UndoEnd);
        UndoEnd := Q;
        if EdPtrIsNil(UndoEnd) then begin
          UndoCount := 0;
          EdSetPtrNil(UndoStack);
        end else
          EdSetPtrNil(UndoEnd^.Fwdlink);
      end;

    {Reset text markers}
    if EdFlagSet(P, InMark) then
      for M := 0 to MaxMarker do
        with Marker[M] do
          if Line = P then
            EdSetPtrNil(Line);

    {Push line onto undo stack}
    if UndoLimit = 0 then
      {If undo is not enabled, destroy line}
      EdDesTextDesc(P)
    else if EdPtrIsNil(UndoStack) then begin
      {No lines on the undo stack}
      UndoStack := P;
      UndoEnd := P;
      EdSetPtrNil(P^.Fwdlink);
      EdSetPtrNil(P^.Backlink);
      UndoCount := 1;
    end else begin
      {Just push the line}
      EdSetPtrNil(P^.Backlink);
      P^.Fwdlink := UndoStack;
      if EdPtrNotNil(P^.Fwdlink) then
        P^.Fwdlink^.Backlink := P;
      UndoStack := P;
      Inc(UndoCount);
    end;
  end;                       {EdPushUndo}

  procedure EdDeleteAllText(W : Pwindesc);
    {-Delete the entire text stream of a window}
  var
    P, Q : PlineDesc;
    M : Integer;

  begin                      {EdDeleteAllText}
    with W^ do begin

      {Find top of the text stream}
      P := TopLine;
      while EdPtrNotNil(P^.Backlink) do
        EdBackPtr(P);

      {Delete each line in the stream}
      while EdPtrNotNil(P) do begin
        Q := P;
        EdFwdPtr(P);

        if (Q = Blockfrom.Line) or (Q = Blockto.Line) then begin
          {Reset block markers if destroyed}
          EdSetPtrNil(Blockfrom.Line);
          EdSetPtrNil(Blockto.Line);
          Blockhide := True;
        end;

        if EdFlagSet(Q, InMark) then
          {Reset text markers if destroyed}
          for M := 0 to MaxMarker do
            with Marker[M] do
              if Line = Q then
                EdSetPtrNil(Line);

        {Deallocate heap space}
        EdDesTextDesc(Q);
      end;

      {Indicate that top line points to no text}
      EdSetPtrNil(TopLine);

    end;
  end;                       {EdDeleteAllText}

  function EdMaktextdesc(Ncols : Integer) : PlineDesc;
    {-Make new text descriptor record}
  var
    Len : Integer;
    P : PlineDesc;

  begin                      {EdMaktextdesc}

    if Ncols > Maxlinelength then begin
      {Line too long}
      EdErrormsg(41);
      EdMaktextdesc := nil;
      Exit;
    end;

    {Calculate appropriate length of text buffer}
    Len := EdBufferSize(Ncols);

    if not(EdMemAvail(Len+SizeOf(Linedesc), FreeListSpace)) then begin
      {Heap space not available}
      EdErrormsg(35);
      EdMaktextdesc := nil;
      Exit;
    end;

    {Get linedesc first}
    GetMem(P, SizeOf(Linedesc));

    with P^ do begin
      {Now get the text buffer}
      GetMem(Txt, Len);

      {Don't include leading junk byte in size of text buffer}
      Bufflen := Pred(Len);

      {Fill line with blanks}
      FillChar(Txt^, Len, Blank);

      {We don't yet know anything about its font}
      Flags := NewAttr;
      Font := 0;
    end;

    EdMaktextdesc := P;

  end;                       {EdMaktextdesc}

  function EdSizeline(P : PlineDesc; Ncols : Integer; Init : Boolean) : Boolean;
    {-Expand line size to accommodate Ncols characters}
  var
    Q : PtextLine;
    Len, PbuffLen : Integer;

  begin                      {EdSizeline}

    PbuffLen := P^.Bufflen;

    if PbuffLen > Ncols then begin
      {Get out quickly -- line is long enough}
      EdSizeline := True;
      Exit;
    end;

    if Ncols > Maxlinelength then begin
      {Line too long}
      EdErrormsg(41);
      EdSizeline := False;
      Exit;
    end;

    {Calculate appropriate length of text buffer}
    Len := EdBufferSize(Ncols);

    if not(EdMemAvail(Len, FreeListSpace)) then begin
      EdErrormsg(35);
      EdSizeline := False;
      Exit;
    end;

    {Get a new larger text buffer}
    GetMem(Q, Len);
    if Init then begin
      {Copy text buffer}
      Move(P^.Txt^, Q^, Succ(PbuffLen));
      {Blank out rest of line}
      FillChar(Q^[Succ(PbuffLen)], Pred(Len-PbuffLen), Blank);
    end;
    {Get rid of old line buffer}
    FreeMem(P^.Txt, Succ(PbuffLen));
    {Attach new text buffer to line descriptor}
    P^.Txt := Q;
    {Don't include length byte in size}
    P^.Bufflen := Pred(Len);

    EdSizeline := True;
  end;                       {EdSizeline}

  function EdNewTextStream(W : Pwindesc) : Boolean;
    {-Create a new text stream, returning true if successful}

  begin                      {EdNewTextStream}

    EdNewTextStream := False;
    with W^ do begin
      TopLine := EdMaktextdesc(1);
      if EdPtrIsNil(TopLine) then
        Exit;
      Curline := TopLine;
      Lineno := 1;
      Colno := 1;
      EdSetPtrNil(TopLine^.Fwdlink);
      EdSetPtrNil(TopLine^.Backlink);
      Stream := EdNewstream;
    end;
    EdNewTextStream := True;
  end;                       {EdNewTextStream}

  function EdAllocateWindow(Top, Len, Cr, Cc : Integer; Fn : Filepath) : Pwindesc;
    {-Return a pointer to a window structure}
  var
    W : Pwindesc;

  begin                      {EdAllocateWindow}
    {Pop a window off the free list}
    W := WinStack;
    if EdNewTextStream(W) then begin
      EdFwdPtr(WinStack);
      {Initialize window settings}
      EdInitWindowSettings(W);
      with W^ do begin
        EdSetPtrNil(Fwdlink);
        EdSetPtrNil(Backlink);
        Filename := Fn;
        Firstlineno := Top;
        Lastlineno := Pred(Top+Len);
        Lineno := Cr;
        Colno := Cc;
      end;
      EdSetTextNo(W);
      EdAllocateWindow := W;
    end else
      EdAllocateWindow := nil;
  end;                       {EdAllocateWindow}

  procedure EdJoinLinePrimitive(P : PlineDesc; LenP : Integer);
    {-Join the line p at column lenP with the line following it}
  var
    LenQ, M : Integer;
    Q : PlineDesc;

  begin                      {EdJoinLinePrimitive}

    Q := P^.Fwdlink;
    if EdPtrIsNil(Q) then
      Exit;

    {Get length of the next line}
    LenQ := EdTextLength(Q);

    {Size up this line to hold the next}
    if not(EdSizeline(P, LenP+LenQ, True)) then
      Exit;

    {Fix up text markers}
    if EdFlagSet(Q, InMark) then
      for M := 0 to MaxMarker do
        with Marker[M] do
          if Line = Q then begin
            Col := Col+LenP;
            Line := P;
            EdSetFlag(P, InMark);
          end;

    {Move the text of the next into this one}
    if LenQ > 0 then
      Move(Q^.Txt^[1], P^.Txt^[Succ(LenP)], LenQ);

    {Disconnect the next line}
    P^.Fwdlink := Q^.Fwdlink;
    if EdPtrNotNil(P^.Fwdlink) then
      P^.Fwdlink^.Backlink := P;

    {Deallocate next line's space}
    EdDesTextDesc(Q);

  end;                       {EdJoinlineprimitive}

  procedure EdJoinline;
    {-Join two lines and fix up block markers}
  var
    P, Q : PlineDesc;
    C : Integer;

  begin                      {EdJoinline}
    with Curwin^ do begin

      P := Curline;
      Q := Curline^.Fwdlink;
      C := Pred(Colno);

      if EdPtrNotNil(Q) then begin

        {Fix up block markers}
        if Q = Blockfrom.Line then begin
          Blockfrom.Col := Blockfrom.Col+C;
          Blockfrom.Line := P;
          if not(Blockhide) then
            EdSetFlag(P, InBlock);
        end;
        if Q = Blockto.Line then begin
          Blockto.Col := Blockto.Col+C;
          Blockto.Line := P;
        end;

        {Correct any windows whose topline, curline or lineno relate to q}
        EdFixUpWindowSpan(Q);

        {Attach the next line to this one}
        EdJoinLinePrimitive(P, C);

      end;
    end;
  end;                       {EdJoinline}

  procedure EdInsertLinePrimitive(M : BlockMarker; var P : PlineDesc);
    {-Insert a new line after marker m, return pointer to new line}
  var
    Llen, Len : Integer;

  begin                      {EdInsertLinePrimitive}
    with M do begin

      {Number of characters to copy from current line to new line}
      Llen := EdTextLength(Line);
      if Llen < Pred(Col) then
        Len := 0
      else
        Len := Llen-Pred(Col);

      {Get a new buffer big enough to hold what's needed}
      P := EdMaktextdesc(Len);
      if EdPtrIsNil(P) then
        Exit;

      {Attach the new buffer after the specified line}
      EdLinkbuffer(Line, P);

      {Now split the text}
      if Len > 0 then begin
        Move(Line^.Txt^[Col], P^.Txt^[1], Len);
        FillChar(Line^.Txt^[Col], Len, Blank)
      end;

      {Fix up text markers}
      if EdFlagSet(Line, InMark) then
        EdFixMarkInsertedLine(Line, P, Col, Col);

    end;
  end;                       {EdInsertLinePrimitive}

  function EdInsertSpace(P : PlineDesc; Start : Integer; Num : Integer) : Boolean;
    {-Insert num spaces at position start of line p}
  var
    Len, NewLen : Integer;

  begin                      {EdInsertSpace}

    Len := EdTextLength(P);
    if Start > Len then
      NewLen := Succ(Start+Num)
    else
      NewLen := Succ(Len+Num);

    {Size up the line}
    if not(EdSizeline(P, NewLen, True)) then begin
      EdInsertSpace := False;
      Exit;
    end;

    {Move the text over and fill with blanks}
    with P^ do begin
      if Start <= Len then
        Move(Txt^[Start], Txt^[Start+Num], Succ(Len-Start));
      FillChar(Txt^[Start], Num, Blank);
    end;

    {Fix up markers}
    EdFixMarkInsertedSpace(P, Start, Num);
    EdFixBlockInsertedSpace(P, Start, Num);

    EdInsertSpace := True;

  end;                       {EdInsertSpace}

  procedure EdNewLinePrimitive;
    {-Insert a new line, straighten out indents and markers}
  var
    P : PlineDesc;
    Ind, InsCount, SaveCol : Integer;
    M : BlockMarker;

  begin                      {EdNewLinePrimitive}
    with Curwin^ do begin

      M.Line := Curline;
      M.Col := Colno;

      {Pagination must start over}
      EdResetPageLine(Curwin);

      {Insert new line after current}
      EdInsertLinePrimitive(M, P);
      if EdPtrIsNil(P) then
        Exit;

      {Clone attribute flags from current line to new}
      if AT then
        EdCloneAttrFlags(M.Line, P, M.Col);

      SaveCol := Colno;
      InsCount := 0;
      P := Curline;

      {Move to beginning of new line}
      EdFwdPtr(Curline);
      Colno := 1;

      if AI or WW then begin
        {Autoindent mode or WordWrap with left margin support}

        if AI then
          {Get leading spaces from previous line}
          Ind := EdLineIndent(P)
        else
          Ind := 1;
        if WW and (Ind <= Wmargin) then begin
          Ind := Wmargin;
          if SaveCol < Wmargin then
            Ind := Ind-(Wmargin-SaveCol);
        end;

        if Ind > 1 then begin

          {Insert spaces at start of curline}
          InsCount := Pred(Ind);
          if not(EdInsertSpace(Curline, 1, InsCount)) then
            Exit;
          Colno := Ind;

        end;
      end;

      {Fix up block markers}
      EdFixBlockInsertedLine(P, Curline, SaveCol, Pred(SaveCol-InsCount));

      Modified := True;

      {Guarantee a complete screen update}
      Intrflag := NoInterr;

    end;
  end;                       {EdNewLinePrimitive}

  procedure EdWindowCreate(Wno : Byte);
    {-Create new window by splitting window wno in two}
  var
    W, V : Pwindesc;
    CurrentSize, Size : Byte;

  begin                      {EdWindowCreate}

    {Get a pointer to the window to divide and compute the sizes}
    W := EdFindWindesc(Wno);
    with W^ do
      CurrentSize := Succ(Lastlineno-Firstlineno);
    Size := CurrentSize shr 1;

    if (Size <= MinWindowLines) then begin
      {New window too small}
      EdErrormsg(22);
      Exit;
    end;

    if (CurrentSize-Size) <= MinWindowLines then begin
      {Not enough space left to fit on screen}
      EdErrormsg(120);
      Exit;
    end;

    {Make a new window structure}
    V := EdAllocateWindow(Succ(W^.Lastlineno-Size), Size, Line1, Col1, NoFile);

    if EdPtrIsNil(V) then
      {No memory for another window, error already displayed}
      Exit;

    {Compress existing window}
    W^.Lastlineno := W^.Lastlineno-Size;

    {We may be positioned outside the window's area now}
    EdBackupCurline(W);

    {New window is linked AFTER wno in the display list}
    V^.Backlink := W;
    V^.Fwdlink := W^.Fwdlink;
    W^.Fwdlink^.Backlink := V;
    W^.Fwdlink := V;

  end;                       {EdWindowCreate}

  procedure EdPushWindowStack(W : Pwindesc);
    {-Put a window descriptor on the window free list}

  begin                      {EdPushWindowStack}
    W^.Fwdlink^.Backlink := W^.Backlink;
    W^.Backlink^.Fwdlink := W^.Fwdlink;
    W^.Fwdlink := WinStack;
    WinStack := W;
  end;                       {EdPushWindowStack}

  procedure EdWindowDelete(Wno : Byte);
    {-Remove window from memory}
  var
    W : Pwindesc;

  begin                      {EdWindowDelete}

    {Find window descriptor}
    W := EdFindWindesc(Wno);

    if W = Window1 then begin

      {Window below gets the lines}
      EdFwdPtr(Window1);
      if Curwin = W then
        Curwin := Window1;
      Window1^.Firstlineno := W^.Firstlineno;
      EdSetTextNo(Window1);

    end else begin

      {Window above gets the lines}
      if Curwin = W then
        Curwin := W^.Backlink;
      W^.Backlink^.Lastlineno := W^.Lastlineno;

    end;

    {If no other object references the text stream, it may be deleted}
    if not(EdLinkedWindow(W)) then
      EdDeleteAllText(W);

    {Push window onto free list}
    EdPushWindowStack(W);

  end;                       {EdWindowDelete}

  procedure EdResetWindow(W : Pwindesc);
    {-Reset the window descriptor}

  begin                      {EdResetWindow}
    EdInitWindowSettings(W);
    with W^ do begin
      {Reset top line buffer for the current window}
      if EdPtrNotNil(TopLine) then
        EdDesTextDesc(TopLine);
      TopLine := EdMaktextdesc(1);
      if EdPtrNotNil(TopLine) then begin
        EdSetPtrNil(TopLine^.Fwdlink);
        EdSetPtrNil(TopLine^.Backlink);
      end;
    end;
    EdSetTextNo(W);
    EdResetWindowPrimitive(W);
  end;                       {EdResetWindow}

  function EdCalcMemory : VarString;
    {-Return the bytes of available heap space, in a string}
  var
    M : LongInt;
    S : VarString;

  begin                      {EdCalcMemory}
    M := MemAvail;
    Str(M, S);
    EdCalcMemory := Blank+S+EdGetMessage(328);
  end;                       {EdCalcMemory}

begin
  {Use ExactAllocation only during file reads}
  ExactAllocation := False;

  {Allocate current line buffer}
  CurlineBuf := EdMaktextdesc(Maxlinelength);
  Curlinecol := 1;
end.