{$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,R-,S-,V+,X+}
{$M 16384,0,655360}
Program MarkDoc;
{ Document marker program - processes the -M+ output from SPELCHEK. }
Uses Dos, Crt;

Const
  WorkExt = '.$$$';
  BakExt = '.BAK';
  BufSize = 16384;
  DefaultMark = '#';

Var
  StdIn : Text;
  InFile, WorkFile : File;
  Mark : String;
  DocOpen : Boolean;
  InBuf : Array[1..BufSize] Of Char;

Procedure FlushToPosition(n : LongInt);
Var
  ReadLen : LongInt;
Begin
  While (FilePos(InFile) < n) And Not Eof(InFile) Do Begin
    ReadLen := n - FilePos(InFile);
    If ReadLen > BufSize Then ReadLen := BufSize;
    BlockRead(InFile, InBuf, ReadLen);
    BlockWrite(WorkFile, InBuf, ReadLen);
  End;
End;

Function FileExists(Name : PathStr) : Boolean;
Var
  f : File;
Begin
  {$I-}
  Assign(f, Name);
  Reset(f);
  If IoResult = 0 Then Begin
    FileExists := True;
    Close(f);
  End Else FileExists := False;
  {$I+}
End;

Procedure CloseDocument(Name : PathStr);
Var
  f : File;
  d : DirStr;
  n : NameStr;
  e : ExtStr;
  BakName : PathStr;
Begin
  FlushToPosition(FileSize(InFile));
  Close(InFile);
  Close(WorkFile);
  DocOpen := False;
  FSplit(Name, d, n, e);
  BakName := d + n + BakExt;
  If FileExists(BakName) Then Begin
    Assign(f, BakName);
    Erase(f);
    WriteLn('Erased backup file ', BakName);
  End;
  Rename(InFile, BakName);
  WriteLn('Original file saved in ', BakName);
  Rename(WorkFile, Name);
  WriteLn('Words marked in ', Name);
End;

Procedure ReadStdIn;
Var
  num : LongInt;
  p : PathStr;
  d : DirStr;
  n : NameStr;
  e : ExtStr;
  s : String;
  OutName : PathStr;
Begin
  DocOpen := False;
  Repeat
    ReadLn(StdIn, num, s);
    Delete(s, 1, 1);
    If (num = 0) And (s <> '') Then Begin
      If DocOpen Then CloseDocument(p);
      p := s;
      FSplit(p, d, n, e);
      OutName := d + n + WorkExt;
      Assign(InFile, s);
      Reset(InFile, 1);
      Assign(WorkFile, OutName);
      ReWrite(WorkFile, 1);
      DocOpen := True;
    End Else Begin
      FlushToPosition(Pred(num));
      BlockWrite(WorkFile, Mark[1], Length(Mark));
    End;
  Until Eof(StdIn);
  If DocOpen Then CloseDocument(p);
End;

Begin
  If ParamCount > 0 Then Mark := ParamStr(1) Else Mark := DefaultMark;
  DocOpen := False;
  Assign(StdIn, '');
  Reset(StdIn);
  ReadStdIn;
  Close(StdIn);
  WriteLn('Done!');
End.