Topspeed_JPI/TS-V3/REP16/SNR.MOD

MODULE snr;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1990 PMI
 *  Green Bay WI
 *  All rights reserved
 *  (414) 468-6040
 *
 *)
 
(*
IMPORT EMS;
*)

FROM BigSets IMPORT AppendSet, ExclSet, InitSet, ChSetArray;
FROM Drectory IMPORT FileInfoRec, FindFirstFile, FindNextFile,
     GetDrivePathAndName, GetFileDateAndTime, SetFileDateAndTime;
FROM Editor IMPORT DoCounting, EntryBox, ExitBox, ScrnEdit;
FROM EnvironUtils IMPORT ParsedParam;
FROM ErrorManager IMPORT StraightToDOS;
FROM HandleIO IMPORT OpenFile, CloseHandle;
FROM GenLists IMPORT DisposeList, GenList, GetElmt, ListInsert, ListLength,
     ListDelete, ListReplace, NewList, ScanList, StrCode;
FROM KbdInput IMPORT KeyNumSet, CAPkey, KeyHit, YorN;
FROM ListUtils IMPORT TextFileToList, TextListToFile;
FROM M2Strings IMPORT CompareStr, Copy, Delete, Insert, Length;
FROM PosUtils IMPORT Equal, Present, PresentPos;
FROM ScrnTypes IMPORT DisplayFrame;
FROM SmartScreen IMPORT ClearScreen;
FROM StrConv IMPORT AppendDecoded, StrToCardinal;
FROM StrEdit IMPORT Append, AssignStr, CrunchBlanks, CutTrailingChars,
     DeleteChar, ReplaceStr, SetLength, InsertTabs, ReplaceTabs;
FROM StringIO IMPORT NoError, inp, outp, PrintMessage, ReadStr,
     WriteEol, WriteStr;
FROM UserOps IMPORT FieldExitKeySet;
(*
IMPORT InitJPI;
*)

CONST
  TAB = 11C;

VAR
  DirHandle, SavedMessage: CARDINAL;
  fname, FileSpec, CodeStr, PathName, PromptStr: ARRAY [0..80] OF CHAR;
  MeansDelete, EOFmark, Dumstr: ARRAY [0..0] OF CHAR;
  SearchFor, x, ReplaceWith: ARRAY [0..255] OF CHAR;
  FileInfo: FileInfoRec;
  PatternList, ReplaceList, TheList: GenList;
  PatternCount, spot, ExitCode, CursorRow, LstLngth, StrLngth, LineNum,
      StartingAt, FoundSpot, TypeCode, month, day, year, hours,
      minutes, seconds, ParamCount: CARDINAL;
  DriveLetter, CodeChar: CHAR;
  editing, EditsMade, stripping, preserving, confirming, ChangesMade:
      BOOLEAN;
  DummyFrame: DisplayFrame;
  entabbing, detabbing: BOOLEAN;
  tabInterval: CARDINAL;


PROCEDURE GetStamp( fname: ARRAY OF CHAR );
  VAR
    tmphandle: CARDINAL;
  BEGIN
    PrintMessage( OpenFile( tmphandle, fname ) );
    GetFileDateAndTime( tmphandle, month, day, year, hours,
        minutes, seconds );
    PrintMessage( CloseHandle( tmphandle ) );
  END GetStamp;


PROCEDURE SetStamp( fname: ARRAY OF CHAR );
  VAR
    tmphandle: CARDINAL;
  BEGIN
    PrintMessage( OpenFile( tmphandle, fname ) );
    SetFileDateAndTime( tmphandle, month, day, year, hours,
        minutes, seconds );
    PrintMessage( CloseHandle( tmphandle ) );
  END SetStamp;


PROCEDURE GetTabInfo(VAR entabbing, detabbing: BOOLEAN; 
    VAR tabInterval: CARDINAL);
  VAR
    DigitKeySet: KeyNumSet;
    EDNQ : KeyNumSet;
    tmpkey: CARDINAL;
  BEGIN
    InitSet(DigitKeySet);
    AppendSet(DigitKeySet, "{'0'..'9'}");
    InitSet( EDNQ );
    AppendSet( EDNQ, "{'e', 'E', 'd', 'D', 'n', 'N', 'q', 'Q'}" );

    WriteEol( outp, '' );
    WriteStr( outp, 'Entab, Detab or Neither?  ' );
    tmpkey := CAPkey( KeyHit( EDNQ ) );
    entabbing := tmpkey = ORD('E');
    detabbing := tmpkey = ORD('D');
    IF entabbing THEN
      WriteStr( outp, 'entab' );
    ELSIF detabbing THEN
      WriteStr( outp, 'detab' );
    ELSIF ORD('Q') = tmpkey THEN
      StraightToDOS('');
    END;
	IF entabbing OR detabbing THEN
      WriteEol( outp, '' );
      WriteStr( outp, 'Tab interval [0-9]?  ' );
      tmpkey := KeyHit( DigitKeySet );
	  tabInterval := tmpkey - ORD('0');
	ELSE
	  tabInterval := 0;
	END;
  END GetTabInfo;

PROCEDURE yes( TheQuestion: ARRAY OF CHAR ): BOOLEAN;
  VAR
    tmpkey: CARDINAL;
  BEGIN
    WriteEol( outp, '' );
    WriteStr( outp, TheQuestion );
    tmpkey := CAPkey( KeyHit( YorN ) );
    IF ORD('Y') = tmpkey THEN
      WriteStr( outp, 'yes' );
      RETURN TRUE;
    ELSIF ORD('Q') = tmpkey THEN
      StraightToDOS('');
    END;
    WriteStr( outp, 'no' );
    RETURN FALSE;
  END yes;

  PROCEDURE NextParam(): CARDINAL;
    BEGIN
      INC(ParamCount);
      RETURN ParamCount;
    END NextParam;

BEGIN
  ParamCount := 0;
  EOFmark[0] := CHR(26);
  MeansDelete[0] := CHR(255);
  AppendSet( YorN, "{'q', 'Q'}" );
  IF NOT ParsedParam( NextParam(), FileSpec ) THEN
    WriteStr( outp, "FileSpec:  " );
    ReadStr( inp, FileSpec );
    IF Length( FileSpec ) = 0 THEN
      RETURN;
    END;
  END;
  IF ParsedParam( NextParam(), CodeStr ) THEN
    CodeChar := CodeStr[0];
  ELSE
    WriteStr( outp, 'CodeChar:  ' );
    ReadStr( inp, CodeStr );
    CrunchBlanks( CodeStr );
    IF Length( CodeStr ) = 0 THEN
      CodeChar := '#';
      WriteEol( outp, 'Assumed #' );
    ELSE
      CodeChar := CodeStr[0];
    END;
  END;

  NewList(PatternList);
  NewList(ReplaceList);
  SetLength( SearchFor, 0 );
  IF ParsedParam( NextParam(), x ) THEN
    AppendDecoded( SearchFor, CodeChar, x );
  ELSE
    WriteStr( outp, 'SearchFor:  ' );
    ReadStr( inp, x );
    IF Length( x ) = 0 THEN
      RETURN;
    ELSE
      AppendDecoded( SearchFor, CodeChar, x );
    END;
  END;

  IF SearchFor[0] = '@' THEN
    (*They've given us a file name.*)
    Delete( SearchFor, 0, 1 );
    NewList( PatternList );
    PrintMessage( TextFileToList( SearchFor, PatternList ) );
    PatternCount := 1;
    WHILE PatternCount <= ListLength(PatternList) DO
      SetLength( ReplaceWith, 0 );
      GetElmt( PatternList, PatternCount, SearchFor, TypeCode );
      IF PresentPos( '=', SearchFor, spot ) THEN
        Copy( SearchFor, spot + 1, Length(SearchFor) - spot - 1, x );
        AppendDecoded( ReplaceWith, CodeChar, x );
        Delete( SearchFor, spot, Length(SearchFor) - spot );
        ListReplace( SearchFor, StrCode, PatternList,
            PatternCount );
        ListInsert( ReplaceWith, StrCode, ReplaceList,
            ListLength(ReplaceList) + 1 );
        INC( PatternCount );
      ELSE
        ListDelete( PatternList, PatternCount, 1 );
      END;
    END;
  ELSE
    SetLength( ReplaceWith, 0 );
    IF ParsedParam( NextParam(), x ) THEN
      AppendDecoded( ReplaceWith, CodeChar, x );
    ELSE
      WriteStr( outp, 'ReplaceWith:  ' );
      ReadStr( inp, x );
      IF Length( x ) = 0 THEN
        RETURN;
      ELSE
        AppendDecoded( ReplaceWith, CodeChar, x );
      END;
    END;
    ListInsert( SearchFor, StrCode, PatternList, 1 );
    ListInsert( ReplaceWith, StrCode, ReplaceList, 1 );
  END;
  IF NOT ParsedParam( NextParam(), Dumstr ) THEN
    confirming := yes( 'Confirm replacements?  ');
  ELSE
    confirming := Dumstr[0] = 'Y';
  END;

  IF NOT ParsedParam( NextParam(), Dumstr ) THEN

    EntryBox := 0;
    ExitBox := 0;
    DoCounting := FALSE;

    editing := yes( 'Invoke editor?  ');
  ELSE
    editing := Dumstr[0] = 'Y';
  END;

  IF NOT ParsedParam( NextParam(), Dumstr ) THEN
    stripping := yes( 'Strip trailing blanks and EOFs?  ');
  ELSE
    stripping := Dumstr[0] = 'Y';
  END;

  IF NOT ParsedParam( NextParam(), Dumstr ) THEN
    preserving := yes( 'Preserve file date/time stamps?  ');
  ELSE
    preserving := Dumstr[0] = 'Y';
  END;

  IF NOT ParsedParam( NextParam(), Dumstr ) THEN
    GetTabInfo(entabbing, detabbing, tabInterval);
  ELSE
    entabbing := Dumstr[0] = 'E';
    detabbing := Dumstr[0] = 'D';
	IF entabbing OR detabbing THEN
	  IF NOT StrToCardinal(Dumstr, 1, tabInterval) THEN
	    tabInterval := 8;
	  END;
	ELSE
	  tabInterval := 0;
	END;
  END;

  IF (NOT Present( EOFmark, SearchFor )) AND (NOT Present(
      EOFmark, ReplaceWith )) THEN
    WriteEol( outp, '' );
    WriteStr( outp, 'Searching for "');
    WriteStr( outp, SearchFor );
    WriteStr( outp, '" and replacing it with "' );
    WriteStr( outp, ReplaceWith );
    WriteStr( outp, '" in "');
    WriteStr( outp, FileSpec );
    WriteEol( outp, '".' );
  END;

  DirHandle := 0FFFFH;
  SavedMessage := FindFirstFile( FileSpec, DirHandle, FileInfo );
  PrintMessage( SavedMessage );
  GetDrivePathAndName( FileSpec, DriveLetter, PathName, fname );

  ExclSet( FieldExitKeySet, 328 );
  ExclSet( FieldExitKeySet, 331 );
  ExclSet( FieldExitKeySet, 333 );
  ExclSet( FieldExitKeySet, 336 );
    (*Arrow keys are now removed from FieldExitKeySet.*)

  WHILE SavedMessage = NoError DO
    AssignStr( FileInfo.name, fname );
    IF (CompareStr( '.', fname ) # 0)
       AND (CompareStr('..', fname )#0) THEN
      ChangesMade := FALSE;
      IF Length(PathName) > 0 THEN
        Insert( PathName, fname, 0 );
      END;
      Insert( ':', fname, 0 );
      Insert( DriveLetter, fname, 0 );
      NewList( TheList );

      IF TextFileToList( fname, TheList ) # NoError THEN
        WriteStr( outp, 'Could not open ' );
        WriteEol( outp, fname );
      ELSE
        IF preserving THEN
          GetStamp( fname );
        END;
        LstLngth := ListLength( TheList );
        WriteEol( outp, '' );
        WriteEol( outp,
'===============================================================================');
        WriteEol( outp, fname );

        PatternCount := 1;
        WHILE PatternCount <= ListLength(PatternList) DO
          GetElmt( PatternList, PatternCount, SearchFor, TypeCode );
          GetElmt( ReplaceList, PatternCount, ReplaceWith, TypeCode );
          StartingAt := 1;
          LOOP
            LineNum := ScanList( SearchFor, TheList, StartingAt,
                LstLngth, FoundSpot );
            IF LineNum = 0 THEN
              EXIT;
            ELSE
              GetElmt( TheList, LineNum, x, TypeCode );
              IF confirming THEN
                WriteEol( outp, '' );
                WriteEol( outp, '-------------------------------------------' );
                WriteEol( outp, x );
                WriteStr( outp, 'Replace "' );
                WriteStr( outp, SearchFor );
                WriteStr( outp, '" ' );
                AssignStr( '   with "', PromptStr );
                Append( PromptStr, ReplaceWith );
                Append( PromptStr, '"? ' );
                IF yes(PromptStr) THEN
                  IF Equal( ReplaceWith, MeansDelete ) THEN
                    ListDelete( TheList, LineNum, 1 );
                    DEC( LineNum );
                  ELSE
                    ReplaceStr( SearchFor, ReplaceWith, x );
                    ListReplace( x, StrCode, TheList, LineNum );
                  END;
                  ChangesMade := TRUE;
                ELSIF editing AND yes('Edit? ') THEN
                  CursorRow := 1;
                  INC( FoundSpot );

                  IF 0 # ScrnEdit( 1,1, 80,25, TheList, LineNum,
                      FoundSpot, CursorRow, EditsMade, FALSE,
                      DummyFrame ) THEN
                  END;

                  ClearScreen();
                  ChangesMade := EditsMade AND yes('Save? ');
                END;
              ELSE
                IF Equal( ReplaceWith, MeansDelete ) THEN
                  ListDelete( TheList, LineNum, 1 );
                  DEC( LineNum );
                ELSE
                  ReplaceStr( SearchFor, ReplaceWith, x );
                  ListReplace( x, StrCode, TheList, LineNum );
                END;
                WriteStr( outp, "|");
                ChangesMade := TRUE;
              END;
              IF LineNum = LstLngth THEN
                EXIT;
              ELSE
                StartingAt := LineNum + 1;
              END;
            END;
          END;
          INC( PatternCount );
        END;

        IF stripping OR entabbing OR detabbing THEN
          LineNum := 1;
          WHILE LineNum <= LstLngth DO
            GetElmt( TheList, LineNum, x, TypeCode );
			IF entabbing THEN
			  IF Present(' ', x) THEN
                ChangesMade := TRUE;
				InsertTabs(x, tabInterval, TRUE); (* TRUE for LeadingOnly *)
                ListReplace( x, StrCode, TheList, LineNum );
			  END;
			END;
			IF detabbing THEN
			  IF Present(TAB, x) THEN
                ChangesMade := TRUE;
				ReplaceTabs(x, tabInterval);
                ListReplace( x, StrCode, TheList, LineNum );
			  END;
			END;
            StrLngth := Length(x);
            IF stripping AND (StrLngth > 0) AND (x[ StrLngth - 1 ] = ' ') THEN
              ChangesMade := TRUE;
              WriteStr( outp, ".");
              CutTrailingChars( ' ', x );
              ListReplace( x, StrCode, TheList, LineNum );
              INC( LineNum );
            ELSIF stripping AND Present( EOFmark, x ) THEN
              ChangesMade := TRUE;
              WriteStr( outp, ",");
              DeleteChar( EOFmark[0], x );
              IF x[0] # 0C THEN
                ListReplace( x, StrCode, TheList, LineNum );
                INC( LineNum );
              ELSE
                ListDelete( TheList, LineNum, 1 );
                DEC( LstLngth );
              END;
            ELSE
              INC( LineNum );
            END;
          END;
        END;

        IF ChangesMade THEN
          PrintMessage( TextListToFile( TheList, fname ) );
          IF preserving THEN
            SetStamp( fname );
          END;
        END;
      END;
      DisposeList( TheList );
    END;
    SavedMessage := FindNextFile( DirHandle, FileInfo );
  END;
  WriteEol( outp, '' );
  WriteStr( outp, 'Done.' );
  WriteStr( outp, CHR(7) );
END snr.