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

Pascal/Delphi Source File | 1987-12-21 | 25KB | 885 lines

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

{$I eddirect.inc}

unit EdFile;
  {-Perform FirstEd file operations}

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 input, line editing and error reporting}
  EdMemOp,                   {Text buffer allocation and deallocation}
  EdBack,                    {Background processes}
  EdScrn2,                   {Editor screen updating}
  EdEdit;                    {Basic editing commands}

function EdExistFile(Fname : Filepath) : Boolean;
  {-return true if file exists, false if non-existent or a device}

procedure EdGetDefaultExtension;
  {-Get a new default file extension}

procedure EdShutWindow(ExitEditor : Boolean);
  {-Shut the current window, set Rundown true if last one and ExitEditor true}

procedure EdFileWrite(Fname : Filepath; Quitting : Boolean);
  {-Save current text stream to specified file}

procedure EdLogDrive(NewPath : Filepath);
  {-Select a new drive or directory}

procedure EdAbandonFile(ExitEditor : Boolean);
  {-Close file without saving}

function EdGetFileName(Prompt, DefExt : VarString; Attr : Byte; var LastFname : Filepath) : Filepath;
  {-Return a file name to use}

procedure EdReadtextfile(Fname : Filepath; ReadingBlock : Boolean);
  {-Read text file into current window}

procedure EdReadFile(Fname : Filepath);
  {-Check and open a text file for editing}

procedure EdPromptWriteBlock;
  {-Prompt for and write a block to a file}

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

implementation

const
  EofWrite : string[1] = ^Z; {Written at end of file}
  EofMark : string[1] = ^Z;  {Indicates end of file}
  BakFileExt : ExtString = 'BAK'; {Extension given to backup files}

  function EdIsDevice(Fname : Filepath) : Boolean;
    {-return true if fname is a DOS device}
  var
    F : file;
    Handle : Word absolute F;
    regs : registers;

  begin                      {EdIsDevice}
    Assign(F, Fname);
    Reset(F);
    if EdINT24Result <> 0 then
      {Probably a file}
      EdIsDevice := False
    else
      with regs do begin
        ax := $4400;
        Bx := Handle;
        intr($21, regs);
        EdIsDevice := (Dx and $80 <> 0);
      end;
    Close(F);
  end;                       {EdIsDevice}

  function EdExistFile(Fname : Filepath) : Boolean;
    {-return true if file exists, false if non-existent or a device}
  var
    F : file;
    I : Word;

  begin                      {EdExistFile}
    if EdIsDevice(Fname) then
      {Return false so we don't try to back up devices or get their file size}
      EdExistFile := False
    else begin
      Assign(F, Fname);
      Reset(F);
      EdExistFile := (EdINT24Result = 0);
      Close(F);
      {Clear IOresult}
      I := EdINT24Result;
    end;
  end;                       {EdExistfile}

  function EdFileerror : Boolean;
    {-Report error during file operation}
  var
    Code : Word;

  begin                      {EdFileerror}
    Code := EdINT24Result;
    if hi(Code) <> 0 then
      EdErrormsg(128)
    else if Code <> 0 then
      EdErrormsg(Code);
    EdFileerror := (Code <> 0);
  end;                       {EdFileerror}

  procedure EdBlockWrite(var F : file; var Buf; Num : Word);
    {-Write a block and check for errors}
  var
    BytesWritten : Word;

  begin                      {EdBlockWrite}
    BlockWrite(F, Buf, Num, BytesWritten);
    if EdFileerror then
      Exit;
    if BytesWritten <> Num then
      EdErrormsg(240);
  end;                       {EdBlockWrite}

  procedure EdBlockRead(var F : file; var Buf; Num : Word; var BytesRead);
    {-Read a block and check for errors}
  var
    BR : Word absolute BytesRead;

  begin                      {EdBlockRead}
    BlockRead(F, Buf, Num, BR);
    if EdFileerror then
      ;
  end;                       {EdBlockRead}

  procedure EdGetDefaultExtension;
    {-Get a new default file extension}
  var
    DefExt : string[4];
    Done : Boolean;
    I : Word;

  begin                      {EdGetDefaultExtension}
    repeat
      Done := True;
      DefExt := DefExtension;
      EdAskfor(EdGetMessage(377), 10, 20, 6, DefExt);
      if not(Abortcmd) then
        {Do some error checking}
        if Pos('*', DefExt)+Pos('?', DefExt) <> 0 then begin
          EdErrormsg(49);
          Done := False;
        end else begin
          if Copy(DefExt, 1, 1) = Period then
            Delete(DefExt, 1, 1);
          for I := 1 to Length(DefExt) do
            DefExt[I] := Upcase(DefExt[I]);
          DefExtension := DefExt;
        end;
    until Done;
  end;                       {EdGetDefaultExtension}

  {***}
  procedure EdReadtextfile(Fname : Filepath; ReadingBlock : Boolean);
    {-Read text file into current window}
  var
    InFile : file;
    TopSave, CurSave : PlineDesc;
    EdError, EndOfFile, GotEol : Boolean;
    colSave, BufOfs, BufPos, BufCnt, EolPos, EofPos : Integer;

    function EdInsertbuffer(Ncols : Integer) : Boolean;
      {-Insert buffer into text stream - after current line}
    var
      P : PlineDesc;
      Len : Integer;

    begin                    {EdInsertbuffer}
      with CurWin^ do begin

        {Calculate appropriate buffer size}
        Len := EdBufferSize(Ncols);

        if not(EdMemAvail(Len+SizeOf(LineDesc), FreeListSpace)) then begin
          {Margin for stack not available}
          EdErrormsg(35);
          EdInsertbuffer := False;
          Exit;
        end;

        {Make new text buffer}
        GetMem(P, SizeOf(LineDesc));

        with P^ do begin
          GetMem(Txt, Len);
          {Don't include font descriptor byte in size of text buffer}
          Bufflen := Pred(Len);

          {Initialize flags}
          Flags := 0;
        end;

        {Link new buffer into stream}
        EdLinkbuffer(CurLine, P);

        {Advance cursor to next line}
        CurLine := P;

        EdInsertbuffer := True;
      end;
    end;                     {EdInsertbuffer}

  begin                      {EdReadtextfile}

    if Abortcmd or EdStringEmpty(Fname) then
      Exit;

    EdWritePromptLine(EdGetMessage(325));

    Assign(InFile, Fname);
    Reset(InFile, 1);
    if EdFileerror then
      Exit;

    with CurWin^ do begin

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

      {Start inserting text at current cursor}
      EdInsertLine;
      if GotError then begin
        Close(InFile);
        Exit;
      end;

      {Save line position, which will be starting line of newly read text}
      TopSave := TopLine;
      CurSave := CurLine;
      colSave := ColNo;

      EdError := False;
      BufOfs := 0;
      ExactAllocation := True;

      if ReadingBlock then
        Modified := True
      else begin
        {A new file}
        Modified := False;
        Clineno := 1;
      end;

      repeat

        {Check keyboard for abort}
        EdBreathe;
        EdError := EdError or Abortcmd;

        if not(EdError) then begin
          {Get a new buffer full of characters}
          EdBlockRead(InFile, WorkBuf[Succ(BufOfs)], Bufsize-BufOfs, BufCnt);
          Inc(BufCnt, BufOfs);
          {Bufcnt now holds count of characters in buffer}

          EdError := EdError or GotError;

          {Adjust bufcnt for first ^Z found in buffer}
          if BufCnt <> 0 then begin
            EofPos := EdLongPosFwd(WorkBuf, 1, BufCnt, EofMark);
            if EofPos <> 0 then
              BufCnt := Pred(EofPos);
          end;
        end;

        {End of file if no active characters in buffer}
        EndOfFile := EdError or (BufCnt <= 0);

        if not(EndOfFile) then begin

          {Scan the buffer, breaking it into <CR><LF> delimited lines}
          BufOfs := 0;
          BufPos := 1;

          repeat

            {Find next EOL in the buffer}
            EolPos := EdLongPosFwd(WorkBuf, BufPos, BufCnt, EolMark);

            if (EolPos = 0) and (BufPos+MaxLineLength >= Bufsize) then begin

              {Eolmark not found in buffer}

              {Partial line, continue line into next buffer}
              BufOfs := Succ(BufCnt-BufPos);
              Move(WorkBuf[BufPos], WorkBuf[1], BufOfs);
              {Force loop exit}
              BufPos := Succ(BufCnt);

            end else begin

              {Eolmark found or linebreak forced}

              if (EolPos = 0) or ((EolPos-BufPos) >= MaxLineLength) then begin
                {Linebreak forced without finding a <CR><LF>}
                {Always leave at least one blank at end of line}
                EolPos := Pred(BufPos+MaxLineLength);
                if EolPos > BufCnt then
                  EolPos := Succ(BufCnt);
                GotEol := False;
              end else
                GotEol := True;

              if EolPos > BufPos then begin
                {Nonempty line, store it}
                if EdInsertbuffer(Succ(EolPos-BufPos)) then
                  with CurLine^ do begin
                    Move(WorkBuf[BufPos], Txt^[1], EolPos-BufPos);
                    FillChar(Txt^[Succ(EolPos-BufPos)], Bufflen-EolPos+BufPos, Blank);
                  end
                else begin
                  EdError := True;
                  GotError := False;
                  Modified := True;
                end;
              end else begin
                {Empty line}
                if EdInsertbuffer(1) then
                  with CurLine^ do
                    {Initialize buffer with blanks}
                    FillChar(Txt^[1], Bufflen, Blank)
                else begin
                  EdError := True;
                  GotError := False;
                  Modified := True;
                end;
              end;

              if GotEol then
                {Skip over <CR><LF>}
                BufPos := EolPos+Length(EolMark)
              else
                {Start immediately after break}
                BufPos := EolPos;

            end;             {Eolmark found}
          until EdError or (BufPos > BufCnt);
        end;                 {Not endoffile}
      until EdError or EndOfFile;

      Close(InFile);

      {Restore stack margin}
      FreeListSpace := FreeListPerm;

      if ReadingBlock then begin
        {Set block markers around what we read in}
        EdRightLine;
        if GotEol then begin
          EdDownLine;
          ColNo := 1;
        end else
          EdJoinline;
        with Blockto do begin
          Line := CurLine;
          Col := ColNo;
        end;
        with Blockfrom do begin
          Line := CurSave;
          Col := colSave;
        end;
        {Turn off old block marks}
        EdOffblock;
        {Prepare to display new ones}
        Blockhide := False;
      end;

      if CurLine <> CurSave then begin
        {Restore original line position}
        TopLine := TopSave;
        CurLine := CurSave;
        ColNo := colSave;
        {Rejoin the left half of the line we split}
        EdJoinline;
      end;

      ExactAllocation := False;

      EdRealign;
      UpdateScreen := True;
      EdBufferCurrentLine;

    end;                     {With Curwin^}

    EdZapPromptLine;
  end;                       {EdReadtextfile}

  procedure EdMakeBakFile(Fname : Filepath);
    {-Create a backup file based on fname}
  var
    I : Integer;
    Bname : Filepath;
    F : file;

  begin                      {EdMakeBakFile}

    if not(MakeBackups) then
      Exit;

    {Build backup name}
    if EdFileHasExtension(Fname, I) then
      Bname := Copy(Fname, 1, I)+BakFileExt
    else
      Bname := Fname+Period+BakFileExt;

    {Erase existing backup}
    if EdExistFile(Bname) then begin
      Assign(F, Bname);
      Erase(F);
      if EdINT24Result <> 0 then begin
        EdErrormsg(103);
        Exit;
      end;
    end;

    {Rename existing file to backup}
    Assign(F, Fname);
    Rename(F, Bname);
    if EdINT24Result <> 0 then
      EdErrormsg(104);
  end;                       {EdMakebakfile}

  {*** ExitEditor ignored}
  procedure EdShutWindow(ExitEditor : Boolean);
    {-Shut the current window, set Rundown true if last one and ExitEditor true}

  begin                      {EdShutWindow}
    {See if there is another window open}
    if WindowCount <= 1 then
      {Exit the editor}
      EdFlagExit
    else begin
      {Delete current window and return in other one}
      EdWindowUp;
      EdWindowDelete(Succ(EdWindowNumber));
    end;
    if WindowCount > 0 then
      Dec(WindowCount);
  end;                       {EdShutWindow}

  procedure EdFileWrite(Fname : Filepath; Quitting : Boolean);
    {-Save current text stream to specified file}
  var
    OutFile : file;
    P : PlineDesc;
    W : PwinDesc;
    Len, BufPos, BufSiz : Integer;

  begin                      {EdFileWrite}
    AbortEnable := True;
    EdWait;

    if EdExistFile(Fname) then begin
      {Create a .BAK file}
      EdMakeBakFile(Fname);
      if GotError then
        Exit;
    end;

    Assign(OutFile, Fname);
    Rewrite(OutFile, 1);
    if EdFileerror then
      Exit;

    {Find top of stream}
    P := EdTopofStream(CurWin);

    BufPos := 0;
    BufSiz := Bufsize-Length(EolMark);

    with CurWin^ do
      repeat

        {Check for abort}
        if not(Quitting) then
          {if leaving the editor, let DOS buffer keystrokes}
          EdBreathe;

        Len := EdTextLength(P);

        if BufPos+Len > BufSiz then begin
          {Flush write buffer}
          EdBlockWrite(OutFile, WorkBuf[1], BufPos);
          BufPos := 0;
        end;

        if Len <> 0 then begin
          Move(P^.Txt^[1], WorkBuf[Succ(BufPos)], Len);
          Inc(BufPos, Len);
        end;

        EdFwdPtr(P);
        if EdPtrNotNil(P) then begin
          {Add end of line marker}
          Move(EolMark[1], WorkBuf[Succ(BufPos)], Length(EolMark));
          Inc(BufPos, Length(EolMark));
        end;

      until Abortcmd or GotError or EdPtrIsNil(P);

    if EdPtrIsNil(P) and (BufPos <> 0) then
      {Flush the final chunk}
      EdBlockWrite(OutFile, WorkBuf[1], BufPos);

    if EdPtrIsNil(P) and not(EdIsDevice(Fname)) then begin
      {Write EOF marker}
      if not(EdStringEmpty(EofWrite)) then
        EdBlockWrite(OutFile, EofWrite[1], Length(EofWrite));

      if not(GotError) then begin
        {Indicate that window and any linked to it are now saved completely}
        W := CurWin;
        repeat
          if W^.Stream = CurWin^.Stream then
            W^.Modified := False;
          EdFwdPtr(W);
        until W = CurWin;
      end;

    end;

    Close(OutFile);
    if EdFileerror then
      ;
  end;                       {EdFileWrite}

  procedure EdLogDrive(NewPath : Filepath);
    {-Select a new drive or directory}

  begin                      {EdLogdrive}
    if Abortcmd or EdStringEmpty(NewPath) then
      Exit;
    if (Length(NewPath) > 1)
    and (NewPath[Length(NewPath)] = '\')
    and (NewPath[Pred(Length(NewPath))] <> ':') then
      {Remove trailing backslash}
      Delete(NewPath, Length(NewPath), 1);
    ChDir(NewPath);
    if EdINT24Result <> 0 then
      {Invalid directory}
      EdErrormsg(122);
  end;                       {EdLogdrive}

  {***}
  function CheckCurwinModified : boolean;
    {-See if current window is modified, and if so, prompt to save it}
  var
    SaveFirst : Boolean;

  begin                        {CheckCurwinModified}
    CheckCurwinModified := false;
    with Curwin^ do
      if Modified then
        {Prompt user to avoid loss of edits}
        if EdLinkedWindow(Curwin) then
          {Assure other modified flags are set, but abandon this window}
          EdCloneModifiedFlags
        else begin
          {See if user wants to save it before quitting window}
          SaveFirst := EdYesNo(Blank+EdEndOfPath(Filename)+EdGetMessage(306));
          if Abortcmd then
            Exit;
          if SaveFirst then
            EdFileWrite(Filename, False);
        end;
    CheckCurwinModified := true;
  end;                         {CheckCurwinModified}

  procedure EdAbandonFile(ExitEditor : Boolean);
    {-Close file without saving}

  begin                      {EdAbandonFile}
    if WindowCount >= 1 then
      {If current window is modified, prompt to save it}
      if not CheckCurwinModified then
        {Exit if AbortCmd or <Esc> was entered}
        exit;

    {Clearing the text stream from memory takes a little while}
    EdWait;
    EdShutWindow(ExitEditor);
  end;                       {EdAbandonFile}

  {***}
  function EdGetFileName(Prompt, DefExt : VarString; Attr : Byte;
                         var LastFname : Filepath) : Filepath;
    {-Return a file name to use}
  var
    Fname : Filepath;

  begin                      {EdGetFileName}
    EdGetFileName := '';

    {Initialize default value}
    Abortcmd := False;
    Fname := LastFname;
    EdAskfor(Prompt, 1, 1, 66, Fname);
    if Abortcmd or EdStringEmpty(Fname) then
      Exit;
    EdCleanFileName(Fname);
    if Attr = 0 then
      EdDefaultExtension(DefExt, Fname);
    {Store response for later use}
    LastFname := Fname;

    EdGetFileName := Fname;
  end;                       {EdGetfilename}

  {***}
  procedure EdReadFile(Fname : Filepath);
    {-Check and open a text file for editing}
  var
    Code : Word;
    F : file;

    function EdWindowLinked(Fname : Filepath) : Boolean;
      {-Return true if and when window has been linked to another window}
    var
      IsLinked : Boolean;
      Wthis, Wnext : Integer;
      W : PwinDesc;

      procedure EdWindowLink(Wto : Byte; Wfrom : Byte);
        {-Link one window to another}
      var
        Pto, Pfrom : PwinDesc;

      begin                  {EdWindowLink}

        Pto := EdFindWindesc(Wto);
        Pfrom := EdFindWindesc(Wfrom);

        with Pfrom^ do begin

          {Clean out source window's text if no other windows point to it}
          if not(EdLinkedWindow(Pfrom)) then
            EdDeleteAllText(Pfrom);

          {Match streams}
          Stream := Pto^.Stream;

          {Now equate the two}
          Filename := Pto^.Filename;
          TopLine := Pto^.TopLine;
          CurLine := Pto^.TopLine;
          Lmargin := Pto^.Lmargin;
          Wmargin := Pto^.Wmargin;
          Rmargin := Pto^.Rmargin;
          Modified := Pto^.Modified;
          LeftEdge := Pto^.LeftEdge;
          LineNo := 1;
          ColNo := 1;
        end;

      end;                   {EdWindowLink}

    begin                    {EdWindowLinked}
      IsLinked := False;
      {If more than one window, then see if we should link to other window}
      if (Fname <> NoFile) and (WindowCount > 0) then begin
        {Get number of this window}
        Wthis := EdWindowNumber;
        Wnext := Wthis;
        W := CurWin;
        repeat
          EdFwdPtr(W);
          Inc(Wnext);
          if Fname = W^.Filename then begin
            IsLinked := True;
            EdWindowLink(Wnext, Wthis);
          end;
        until IsLinked or (W = CurWin);
      end;
      EdWindowLinked := IsLinked;
    end;                     {EdWindowLinked}

  begin                      {EdReadfile}

    if Abortcmd then begin
      GotError := True;
      Exit;
    end;

    if EdStringEmpty(Fname) then
      {Support editing of as yet unnamed files}
      Fname := NoFile
    else if EdIsDevice(Fname) then begin
      {Can't read from a device}
      EdErrormsg(34);
      Exit;
    end;

    {Link text stream to existing window if appropriate}
    if not(EdWindowLinked(Fname)) then begin

      if Fname <> NoFile then begin
        {Try to open existing file}
        Assign(F, Fname);
        Reset(F);
        Code := EdINT24Result;
        if hi(Code) <> 0 then begin
          {Drive not ready}
          EdErrormsg(128);
          Exit;
        end;
      end else
        Code := 1;

      CurWin^.Filename := Fname;

      if Code <> 0 then begin

        if Fname <> NoFile then begin
          {File was not found. See if illegal name, or just new file}
          Rewrite(F);
          if EdINT24Result <> 0 then begin
            {Illegal file name}
            EdErrormsg(5);
            Exit;
          end;
          Close(F);
          Erase(F);
        end;

        {New file}
        EdZapPromptLine;
        EdAppPromptLine(EdGetMessage(301));
        CurWin^.Modified := False;
        IntrFlag := NoInterr;
        EdUpdateScreen;
        EdInterruptibleDelay(1500);

      end else begin

        {Update the screen while the file is read}
        IntrFlag := NoInterr;
        EdUpdateScreen;
        {Read in existing file}
        Close(F);
        EdReadtextfile(Fname, False);

      end;

    end;
    EdZapPromptLine;
    UpdateScreen := True;
    UpdateCursor := True;

  end;                       {EdReadfile}

  procedure EdPromptWriteBlock;
    {-Prompt for and write a block to a file}
  var
    Fname : Filepath;
    Exists : Boolean;

    {***}
    procedure EdWriteBlock(Fname : Filepath);
      {-Write marked block to file}
    var
      OutFile : file;
      Stop, Start, Len : Integer;
      P : PlineDesc;
      BufPos, BufSiz : Integer;

    begin                    {EdWriteBlock}

      {Append wait signal to command line}
      EdWait;

      Assign(OutFile, Fname);
      Rewrite(OutFile, 1);
      if EdFileerror then
        Exit;

      P := Blockfrom.Line;

      BufPos := 0;
      BufSiz := Bufsize-Length(EolMark);

      repeat

        {Enable typeahead and abort during writing}
        EdBreathe;

        if P = Blockfrom.Line then
          Start := Blockfrom.Col
        else
          Start := 1;

        if P = Blockto.Line then
          Stop := Pred(Blockto.Col)
        else
          Stop := EdTextLength(P);

        Len := Succ(Stop-Start);

        if BufPos+Len > BufSiz then begin
          {Flush write buffer}
          EdBlockWrite(OutFile, WorkBuf[1], BufPos);
          BufPos := 0;
        end;

        if Len > 0 then begin
          Move(P^.Txt^[Start], WorkBuf[Succ(BufPos)], Len);
          Inc(BufPos, Len);
        end;

        if P = Blockto.Line then
          EdSetPtrNil(P)
        else begin
          EdFwdPtr(P);
          Move(EolMark[1], WorkBuf[Succ(BufPos)], Length(EolMark));
          Inc(BufPos, Length(EolMark));
        end;

      until Abortcmd or GotError or EdPtrIsNil(P);

      if EdPtrIsNil(P) and (BufPos <> 0) then
        {Flush the final chunk}
        EdBlockWrite(OutFile, WorkBuf[1], BufPos);

      if EdPtrIsNil(P) and not(EdIsDevice(Fname)) then
        {Write EOF marker}
        if not(EdStringEmpty(EofWrite)) then
          EdBlockWrite(OutFile, EofWrite[1], Length(EofWrite));

      Close(OutFile);
      if EdFileerror then
        ;

    end;                     {EdWriteBlock}

  begin                      {EdPromptWriteBlock}
    {Make sure a block is marked}
    if EdNoBlock then begin
      EdErrormsg(26);
      Exit;
    end;

    {Get a file name to write to}
    Fname := EdGetFileName(EdGetMessage(310), DefExtension, 0, LastBlockWrite);
    if Abortcmd or EdStringEmpty(Fname) then
      Exit;

    {See if file already exists}
    Exists := EdExistFile(Fname);
    if GotError then
      Exit;

    if Exists then
      {Prompt to overwrite}
      if not(EdYesNo(EdGetMessage(319))) then
        Exit;

    {Write the block}
    EdWriteBlock(Fname);

  end;                       {EdPromptWriteBlock}

end.