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

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

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

{$I eddirect.inc}

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

interface

uses
  crt,                       {Basic video}
  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, 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}

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}

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);
        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
      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 font descriptor byte in size of text buffer}
      Bufflen := Pred(Len);

      {Fill line with blanks and initialize flags}
      FillChar(Txt^, Len, Blank);
      Flags := 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 and font descriptor}
      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 its 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;

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

      SaveCol := ColNo;
      InsCount := 0;
      P := CurLine;

      {Move to beginning of new line}
      EdFwdPtr(CurLine);
      ColNo := 1;

      if AI then begin
        {Autoindent mode}

        if AI then
          {Get leading spaces from previous line}
          Ind := EdLineIndent(P)
        else
          Ind := 1;

        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);
    {-Perform delete window command processing}
  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}

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

  begin                      {EdCalcMemory}
    Str(MemAvail, 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.