Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/tools/cbreak.src

Text File | 1988-05-03 | 27.7 KB | 765 lines

with TEXT_IO;
procedure CCC is
  package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
  use TEXT_IO;
  use INTEGER_IO;

  type HELP_TYPE is array (1..20) of STRING(1..70);

  --  ############## S Y S T E M    D E P E N D E N C Y ##################
  DEFAULT_INPUT_PREFIX_TERMINATOR : constant CHARACTER := ']';        --##
  DEFAULT_EXTENSION : constant STRING := ".TXT;";               --##
  --  ####################################################################

  PRE_FLAG : constant STRING :=
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::";
  FILE_SEPARATION_FLAG  : constant STRING := "--";
  POST_FLAG : constant STRING :=
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::";

  MAXIMUM_NAME_SIZE             : constant NATURAL := 140;
  MAXIMUM_LINE_SIZE             : constant NATURAL := 250;

  SOURCE_FILE           : TEXT_IO.FILE_TYPE;
  SOURCE_FILE_NAME      : STRING(1..MAXIMUM_NAME_SIZE);
  SOURCE_FILE_NAME_LAST : INTEGER := 0;

  OUTPUT_FILE            : TEXT_IO.FILE_TYPE;
  OUTPUT_FILE_NAME       : STRING(1..MAXIMUM_NAME_SIZE);
  OUTPUT_FILE_NAME_LAST  : INTEGER := 0;

  LINE                  : STRING(1..MAXIMUM_LINE_SIZE);
  LINE_LAST             : INTEGER := 0;

  FORMAT_ERROR          : exception;

  TARGET_FILE           : TEXT_IO.FILE_TYPE;
  TARGET_FILE_NAME      : STRING(1..MAXIMUM_NAME_SIZE);
  TARGET_FILE_NAME_LAST : INTEGER := 0;

  INPUT_FILE            : TEXT_IO.FILE_TYPE;
  INPUT_FILE_NAME       : STRING(1..MAXIMUM_NAME_SIZE);
  INPUT_FILE_NAME_LAST  : INTEGER := 0;

  FILE_OF_FILE_NAMES    : TEXT_IO.FILE_TYPE;

  BASIC_FILE_NAME_FIRST : INTEGER := 1;
  BASIC_FILE_NAME_LAST  : INTEGER := 0;

  STATEMENTS            : NATURAL := 0;
  LINE_COUNT            : NATURAL := 0;
  COMMENTS              : NATURAL := 0;

  TOTAL_STATEMENTS      : NATURAL := 0;
  TOTAL_LINE_COUNT      : NATURAL := 0;
  TOTAL_COMMENTS        : NATURAL := 0;


  --  ############## S Y S T E M    D E P E N D E N C Y ##################
  procedure PROCESS_OUTPUT_FILE_NAME(OUTPUT_FILE_NAME : in out STRING;
                                OUTPUT_FILE_NAME_LAST : in out NATURAL) is
  --  This procedure can embody a lot of intelligence about the two systems
  --  It could determine if a default extension needs to be added
  --  or if there is information about the file in the name (-SPEC) that
  --  ought to be put in an extension in the new system (or vice versa)
  --  or it may replace characters in one system (_) which the other rejects
  --  This is therefore doubly system dependent
  --  The present version just checks for existing extension signaled by '.'
    DEFAULT_EXTENSION : constant STRING := ".TXT;";
  begin
    --  Add default extension if there is not an extension in the file name
    for I in 1..OUTPUT_FILE_NAME_LAST  loop
      if OUTPUT_FILE_NAME(I) = '.'  then
        return;
      end if;
    end loop;
    OUTPUT_FILE_NAME(1..OUTPUT_FILE_NAME_LAST+DEFAULT_EXTENSION'LENGTH) :=
        OUTPUT_FILE_NAME(1..OUTPUT_FILE_NAME_LAST) & DEFAULT_EXTENSION;
    OUTPUT_FILE_NAME_LAST := OUTPUT_FILE_NAME_LAST + DEFAULT_EXTENSION'LENGTH;
    return;
  end PROCESS_OUTPUT_FILE_NAME;
  --  ####################################################################

  ----------------------------------------------------------------------------

  procedure EAT_LEADING_BLANKS(NAME : in out STRING; LAST: in out NATURAL) is
  begin
    while LAST >= 1  and NAME(1) = ' '  loop
      NAME(1..LAST-1) := NAME(2..LAST);
      LAST := LAST - 1;
    end loop;
  end EAT_LEADING_BLANKS;

  procedure TERMINATE_NAME_AT_THE_BLANK(NAME : in out STRING;
                                        LAST : in out NATURAL) is
  begin
    for I in 2..LAST  loop
      if NAME(I) = ' '  then
        LAST := I - 1;
        exit;
      end if;
    end loop;
  end TERMINATE_NAME_AT_THE_BLANK;

  procedure GET_FILE_NAME(INPUT_FILE_NAME : in out STRING;
                     INPUT_FILE_NAME_LAST : in out NATURAL;
                                     HELP : in     HELP_TYPE) is
  begin
    PUT("File name =>");
    loop    --  until a valid name, absorbing commments, file-of-files, '?'
      if IS_OPEN(FILE_OF_FILE_NAMES)  then    --  Check input file is used
        if END_OF_FILE(FILE_OF_FILE_NAMES)  then
          CLOSE(FILE_OF_FILE_NAMES);          --  Have come to the end of a
          SET_INPUT(STANDARD_INPUT);          --  file-of-files and want to
        end if;                               --  return to keyboard input
      end if;
      GET_LINE(INPUT_FILE_NAME, INPUT_FILE_NAME_LAST);

      EAT_LEADING_BLANKS(INPUT_FILE_NAME, INPUT_FILE_NAME_LAST);
      TERMINATE_NAME_AT_THE_BLANK(INPUT_FILE_NAME, INPUT_FILE_NAME_LAST);

      if INPUT_FILE_NAME_LAST = 1  and
        INPUT_FILE_NAME(1) = '?'  then               --  Query for help
        for I in HELP'FIRST..HELP'LAST  loop
          PUT_LINE(HELP(I));
        end loop;
        PUT(""""); PUT(DEFAULT_EXTENSION);
        PUT_LINE(""" is the current default extension");
        PUT("File name =>");

      elsif INPUT_FILE_NAME_LAST >= 2  and
         INPUT_FILE_NAME(1..2) = "--"  then          --  Skip comment lines
        null;

      elsif INPUT_FILE_NAME_LAST >= 2 and
            INPUT_FILE_NAME(1) = '@'  then           --  File of file names
      TRY_FILE_OF_FILES:
        begin
          OPEN(FILE_OF_FILE_NAMES, IN_FILE,
            INPUT_FILE_NAME(2..INPUT_FILE_NAME_LAST));
          SET_INPUT(FILE_OF_FILE_NAMES);
        exception
          when NAME_ERROR  =>
            PUT("NAME_ERROR in name given for file-of-files, give full name");

        end TRY_FILE_OF_FILES;
        NEW_LINE;
        PUT("File name =>");

      elsif INPUT_FILE_NAME_LAST = 0  then           --  Use a blank line to
        NEW_LINE;                                    --  quit the program
        exit;

      else                                           --  Regular file name
        exit;
      end if;
    end loop;
  exception
  when END_ERROR  =>
    SET_INPUT(STANDARD_INPUT);
  end GET_FILE_NAME;

  procedure OPEN_INPUT_FILE_NAME_MAYBE_ADD_EXTENSION
               (INPUT_FILE : in out FILE_TYPE;
           INPUT_FILE_NAME : in out STRING;
      INPUT_FILE_NAME_LAST : in out NATURAL) is
  begin
    OPEN(INPUT_FILE, IN_FILE,
      INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
  exception
    when NAME_ERROR  =>
      INPUT_FILE_NAME_LAST := INPUT_FILE_NAME_LAST +
                              DEFAULT_EXTENSION'LAST;
      INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST) :=
      INPUT_FILE_NAME(1..
              INPUT_FILE_NAME_LAST - DEFAULT_EXTENSION'LAST) &
          DEFAULT_EXTENSION;
      OPEN(INPUT_FILE, IN_FILE,
          INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
  end OPEN_INPUT_FILE_NAME_MAYBE_ADD_EXTENSION;

----------------------------------------------------------------------------

  procedure COPY_FILE_AND_COUNT is
    NEXT_CHAR    : NATURAL := 1;
    C            : CHARACTER := ' ';
    LEVEL        : INTEGER := 0;
    HALF_COMMENT : BOOLEAN := FALSE;


    procedure FETCH (CH : out CHARACTER) is
    begin
        if NEXT_CHAR > LINE_LAST  then
            loop
                if END_OF_PAGE(INPUT_FILE)  then
                  SKIP_PAGE(INPUT_FILE);
                  NEW_PAGE(TARGET_FILE);
                end if;
                TEXT_IO.GET_LINE(INPUT_FILE, LINE, LINE_LAST);
                TEXT_IO.PUT_LINE(TARGET_FILE, LINE(1..LINE_LAST));
                LINE_COUNT := LINE_COUNT + 1;
                NEXT_CHAR := 1;
                exit when NEXT_CHAR <= LINE_LAST;
            end loop;
        end if;
        CH := LINE (NEXT_CHAR);
        NEXT_CHAR := NEXT_CHAR + 1;
    exception
      when END_ERROR  =>
        LINE_LAST := 0;
        CH := ' ';
        raise;
    end FETCH;


    procedure QUOTES is
    --  If a quote appears, run out the line until closed
    begin
      --  Check for string brackets of either kind, " or %
      if C = '"' or C = '%' then
        --  Treat them in parallel, one must lead off
        if C = '"' then
          loop
            FETCH (C);
            --  Loop until the close comes
            --  If there is a doubled character it just starts again
            exit when C = '"';
            if NEXT_CHAR = (LINE_LAST + 1)  then
              --  The quote has gone over a line boundry
              PUT_LINE(LINE(1..LINE_LAST));
              PUT(""" missing on line ");
              PUT(LINE_COUNT);
              NEW_LINE;
              exit;  --  anyway
            end if;
          end loop;
        --  The '%' is handled exactly the same way as '"'
        elsif C = '%' then
          loop
            FETCH (C);
            exit when C = '%';
            if NEXT_CHAR = (LINE_LAST + 1)  then
              --  The quote has gone over a line boundry
              PUT_LINE(LINE(1..LINE_LAST));
              PUT("% missing on line ");
              PUT(LINE_COUNT);
              NEW_LINE;
              exit;  --  anyway
            end if;
          end loop;
        end if;
      end if;
    end QUOTES;

    procedure COMMENT_CHECK is
    begin
      --  Check for comments and skip to the end of line
      if C = '-' then
        if HALF_COMMENT and (NEXT_CHAR /= 2)  then
          --  The last character was a '_', therefore HALF_COMMENT is TRUE
          --  And this is not the first character of a line with a '-' left
          --  Then just skip the rest of the line and go to the next
          NEXT_CHAR := LINE_LAST + 1;    --  So FETCH will go to next line
          COMMENTS := COMMENTS + 1;
          HALF_COMMENT := FALSE;
        else
          --  This '-' is the first and may signal the begining of a comment
          HALF_COMMENT := TRUE;
        end if;
      else
        HALF_COMMENT := FALSE;
        end if;
      end COMMENT_CHECK;

    begin
      STATEMENTS := 0;
      LINE_COUNT := 0;
      COMMENTS   := 0;

      --Scan the file character at a time
      loop
        FETCH (C);

        --  Check for one of the characters which introduce code constructs
        --  like string or character literal or formal parameter list
        --  within which a ';' does not terminate a "Ada statement"
        if C = '(' or C = '"' or C = '%' or C = ''' then

          --If there is a quote this superceeds everything until ended
          QUOTES;

          --Elsif look for parentheses and count the levels until they close
          --  Check for opening parentheses
          --  ';' within is most likely in a formal parameter list
          if C = '(' then
            --  Count the number of levels of parentheses
            LEVEL := LEVEL + 1;
            --  Read ahead until the whole construct is closed, LEVEL = 0
            while LEVEL > 0 loop
              FETCH (C);
              QUOTES;
              COMMENT_CHECK;
              if C = '(' then
                --  Increase the level if another '(' is found
                LEVEL := LEVEL + 1;
              elsif C = ')' then
                --  Decrease the level if a ')' is found
                LEVEL := LEVEL - 1;
              end if;
            end loop;

          --Check for the ; being a character literal in '
          --  Character literals are just three characters long including '
          elsif C = ''' then
            FETCH (C);
            FETCH (C);
          end if;
        end if;

          COMMENT_CHECK;

        --Now the rest is regular so we look for ;
        --  Any ';' that can be found at this point after all exclusions
        --  must be a valid "Ada statement" terminator
        --  (We could check back to see if it follows a reasonable place)
        if C = ';' then
            --Then it must be an Ada statement terminator
            STATEMENTS := STATEMENTS + 1;
        end if;

      end loop;

  end COPY_FILE_AND_COUNT;

------------------------------------------------------------------------------

procedure CHECK_FILE_NAMES is

  --type HELP_TYPE is array (1..20) of STRING(1..70);

  HELP : HELP_TYPE :=  (
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "This procedure checks the validity of a series of file names          ",
    "so that such a list may confidently be submitted to other programs    ",
    "It just asks for the file names in order or a '@' followed by a file  ",
    "containing the names of files (maybe with leading blanks),            ",
    "terminated by a blank, or comments preceded by the Ada -- comment flag",
    "The @ file may NOT NOW contain '@' and the names of other @ files     ",
    "The list or the program is terminated by an empty line                ",
    "A default extension will automatically be tried if the name fails     " );


begin
  PUT_LINE("CHECK_FILE_NAMES: (or '@' and a file of file names, ? for help)");

  loop                  --  on the processing of the series of files
    GET_FILE_NAME(INPUT_FILE_NAME, INPUT_FILE_NAME_LAST, HELP);

    exit when INPUT_FILE_NAME_LAST = 0;                --  Finished

  PROCESS_REGULAR_FILE_NAME:
    begin
      OPEN_INPUT_FILE_NAME_MAYBE_ADD_EXTENSION(INPUT_FILE,
          INPUT_FILE_NAME, INPUT_FILE_NAME_LAST);

    PROCESS_OPEN_FILE:
      begin
        CLOSE(INPUT_FILE);
        if not IS_OPEN(FILE_OF_FILE_NAMES)  then
          PUT("            ");
        end if;
        PUT(INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
        PUT_LINE(" found");
      end PROCESS_OPEN_FILE;

    exception
      when NAME_ERROR  =>
        PUT("########  NAME_ERROR in checking file name " &
            INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
        NEW_LINE;
      when STATUS_ERROR  =>
        PUT("########  STATUS_ERROR in checking file name " &
            INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
        NEW_LINE;
      when USE_ERROR  =>
        PUT("########  USE_ERROR in checking file name " &
            INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
        NEW_LINE;
    end PROCESS_REGULAR_FILE_NAME;

  end loop;

  PUT_LINE("Quit");

exception
  when others  =>
    PUT_LINE("Unexpected exception raised in CHECK_FILE_NAMES");
    CLOSE(INPUT_FILE);
end CHECK_FILE_NAMES;

procedure COMBINE_FILES is
  --type HELP_TYPE is array (1..20) of STRING(1..70);

  HELP : HELP_TYPE := (
    "This procedure reads file names from STANDARD_INPUT and copies those  ",
    "files onto another separated by two rows of commented colons and the  ",
    "basic name of the file, so that they may be automatically separated   ",
    "The file name may be preceded by a directory name which is stripped   ",
    "to make the basic name, and the procedure will affix a default        ",
    "extension to the input name if the input named file does not exist    ",
    "The directory format and default extension are system dependent       ",
    "                                                                      ",
    "USAGE:                                                                ",
    "A target file name is requested,                                      ",
    "Target file for combined text file <RETURN> =>                        ",
    "then the files to be combined together                                ",
    "File to be appended =>DBA4:[WHITAKER]COMBINE                          ",
    "A default extension will be added if required e.g. COMBINE.TXT;       ",
    "or the files may be referenced in a file of files preceded by '@'     ",
    "and copy that file preceded by the header                             ",
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::",
    "--COMBINE                                                             ",
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::",
    "                                                                      ");

begin
  PUT_LINE("COMBINE_FILES : (or '@' and a file of file names, ? for help)");

  loop                  --  To create a target file
    PUT("Target file for combined text file <RETURN> =>");
    GET_LINE(TARGET_FILE_NAME, TARGET_FILE_NAME_LAST);
    if TARGET_FILE_NAME_LAST = 1  and
      TARGET_FILE_NAME(1) = '?'  then               --  Query for help
      for I in HELP'FIRST..HELP'LAST  loop
        PUT_LINE(HELP(I));
      end loop;
    else
    CREATE_TARGET_OR_RAISE_EXCEPTION:
      begin
        CREATE(TARGET_FILE, OUT_FILE,
               TARGET_FILE_NAME(1..TARGET_FILE_NAME_LAST));
      exception                 --  Checking for the prior existance of the file

        when NAME_ERROR  =>
          PUT("########  NAME_ERROR in creating file name " &
              INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
              NEW_LINE;
        when STATUS_ERROR  =>
          PUT("########  STATUS_ERROR in creating file name " &
              INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
              NEW_LINE;
        when USE_ERROR  =>
          PUT("########  USE_ERROR in creating file name " &
              INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
              NEW_LINE;
      end CREATE_TARGET_OR_RAISE_EXCEPTION;
    end if;
    if IS_OPEN(TARGET_FILE)  then
      exit;
    end if;
  end loop;

  PUT_LINE("Files to be combined:");

  loop                  --  on the processing of the series of files

    GET_FILE_NAME(INPUT_FILE_NAME, INPUT_FILE_NAME_LAST, HELP);

    exit when INPUT_FILE_NAME_LAST = 0;                --  Finished

    --  Count off the prefix from the basic file name
    BASIC_FILE_NAME_FIRST := 1;
    for I in 1..INPUT_FILE_NAME_LAST-1  loop
      if INPUT_FILE_NAME(I) = DEFAULT_INPUT_PREFIX_TERMINATOR  then
        BASIC_FILE_NAME_FIRST := I + 1;
        exit;
      end if;
    end loop;

    BASIC_FILE_NAME_LAST := INPUT_FILE_NAME_LAST;
    --  Count back to the last ';' over any version number (for VAX/VMS)  #####
    for I in reverse BASIC_FILE_NAME_FIRST..INPUT_FILE_NAME_LAST  loop
      if INPUT_FILE_NAME(I) = ';'  then
        BASIC_FILE_NAME_LAST := I - 1;
        exit;
      end if;
    end loop;

    --  Check if the ending is the default extension, remove for basic name
--    if BASIC_FILE_NAME_LAST > DEFAULT_EXTENSION'LAST  and then
    if BASIC_FILE_NAME_LAST > DEFAULT_EXTENSION'LAST  then
if
       INPUT_FILE_NAME(BASIC_FILE_NAME_LAST - DEFAULT_EXTENSION'LAST..
                       BASIC_FILE_NAME_LAST) = DEFAULT_EXTENSION  then
      BASIC_FILE_NAME_LAST := BASIC_FILE_NAME_LAST - DEFAULT_EXTENSION'LAST;
    end if;
end if;

    OPEN_INPUT_FILE_NAME_MAYBE_ADD_EXTENSION(INPUT_FILE,
        INPUT_FILE_NAME, INPUT_FILE_NAME_LAST);

    if IS_OPEN(INPUT_FILE)  then      --  If we were successful opening file
      PUT_LINE(INPUT_FILE_NAME(1..INPUT_FILE_NAME_LAST));
      --  Put out the interfile flags
      PUT(TARGET_FILE, PRE_FLAG); NEW_LINE(TARGET_FILE);
      PUT(TARGET_FILE, FILE_SEPARATION_FLAG);
      PUT_LINE(TARGET_FILE,
               INPUT_FILE_NAME(BASIC_FILE_NAME_FIRST..BASIC_FILE_NAME_LAST));
      PUT(TARGET_FILE, POST_FLAG); NEW_LINE(TARGET_FILE);

    TRANSFER_FILE:
      --  Assuming that it is a text file of reasonable lines
      begin
          COPY_FILE_AND_COUNT;
      exception
        when END_ERROR  =>
          null;
      end TRANSFER_FILE;

      CLOSE(INPUT_FILE);
      PUT("STATEMENTS = "); PUT(STATEMENTS);
      PUT("   LINE_COUNT = "); PUT(LINE_COUNT);
      PUT("   COMMENTS = "); PUT(COMMENTS);
      NEW_LINE;
      NEW_LINE;
      TOTAL_STATEMENTS := TOTAL_STATEMENTS + STATEMENTS;
      TOTAL_LINE_COUNT := TOTAL_LINE_COUNT + LINE_COUNT;
      TOTAL_COMMENTS   := TOTAL_COMMENTS   + COMMENTS;

    end if;

  end loop;

  CLOSE(TARGET_FILE);
  if (STATEMENTS = TOTAL_STATEMENTS) and (LINE_COUNT = TOTAL_LINE_COUNT)  then
    null;
  else
    NEW_LINE; NEW_LINE;
    PUT_LINE("TOTALS");
    NEW_LINE;
    PUT("STATEMENTS = "); PUT(TOTAL_STATEMENTS);
    PUT("   LINE_COUNT = "); PUT(TOTAL_LINE_COUNT);
    PUT("   COMMENTS = "); PUT(TOTAL_COMMENTS);
    NEW_LINE;
    NEW_LINE;
  end if;

exception
  when others  =>
    PUT_LINE("Unexpected exception raised in COMBINE");
    CLOSE(TARGET_FILE);
end COMBINE_FILES;

procedure BREAK_DOWN_FILE is

  --type HELP_TYPE is array (1..20) of STRING(1..70);

  HELP : HELP_TYPE := (
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "                                                                      ",
    "This procedure takes a file made up of several files separated by     ",
    "a header and breaks it down into the constituent files                ",
    "Presumably the combined file was constructed for transport or         ",
    "archiving by a COMBINE_FILES program                                  ",
    "The separating flag encloses the basic name of the file to be created ",
    "The program will add a system dependent extension if there is no      ",
    "extension in the basic file name                                      ",
    "This version takes a full line of colons flag or the UNIX 10 colons   ");

  PRE_FLAG : constant STRING :=
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::";
  FILE_SEPARATION_FLAG  : constant STRING := "--";
  POST_FLAG : constant STRING :=
    "--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::";



begin

  loop

  PUT_LINE("BREAK DOWN A FILE : (or '@' and a file of file names, ? for help)");


  loop                  --  To open a source file
    PUT_LINE("Source file to break down into individual files:");
    GET_FILE_NAME(SOURCE_FILE_NAME, SOURCE_FILE_NAME_LAST, HELP);

    exit when SOURCE_FILE_NAME_LAST = 0;                --  Finished

    OPEN_SOURCE_OR_RAISE_EXCEPTION:
      begin
        OPEN(SOURCE_FILE, IN_FILE, SOURCE_FILE_NAME(1..SOURCE_FILE_NAME_LAST));
      exception                 --  Checking for the existance of the file
        when NAME_ERROR  =>
          PUT("########  NAME_ERROR in opening file name " &
              SOURCE_FILE_NAME(1..SOURCE_FILE_NAME_LAST));
          NEW_LINE;
        when STATUS_ERROR  =>
          PUT("########  STATUS_ERROR in opening file name " &
              SOURCE_FILE_NAME(1..SOURCE_FILE_NAME_LAST));
          NEW_LINE;
        when USE_ERROR  =>
          PUT("########  USE_ERROR in opening file name " &
              SOURCE_FILE_NAME(1..SOURCE_FILE_NAME_LAST));
          NEW_LINE;
      end OPEN_SOURCE_OR_RAISE_EXCEPTION;
    if IS_OPEN(SOURCE_FILE)  then
      exit;
    end if;
  end loop;

  exit when SOURCE_FILE_NAME_LAST = 0;

  loop
    if END_OF_FILE(SOURCE_FILE)  then
      raise FORMAT_ERROR;
    end if;
    GET_LINE(SOURCE_FILE, LINE, LINE_LAST);
    if LINE_LAST >= 10 and PRE_FLAG'LENGTH >= 10  then
      if LINE(3..10) = PRE_FLAG(3..10)   then    --  Accomadates mine or UNIX
        exit;
      end if;
    end if;
  end loop;

  loop

  GET_OUTPUT_FILE_NAME:
    begin
      GET_LINE(SOURCE_FILE, LINE, LINE_LAST);
      if LINE(1..FILE_SEPARATION_FLAG'LAST) = FILE_SEPARATION_FLAG  then
        OUTPUT_FILE_NAME_LAST := LINE_LAST - FILE_SEPARATION_FLAG'LAST;
        OUTPUT_FILE_NAME(1..OUTPUT_FILE_NAME_LAST) :=
            LINE(FILE_SEPARATION_FLAG'LAST+1..LINE_LAST);
        GET_LINE(SOURCE_FILE, LINE, LINE_LAST);
        if LINE_LAST >= 10 and PRE_FLAG'LENGTH >= 10  then
          if LINE(3..10) /= POST_FLAG(3..10)  then  --  UNIX
            raise FORMAT_ERROR;
          end if;
        end if;
      else
        raise FORMAT_ERROR;
      end if;
    end GET_OUTPUT_FILE_NAME;

    EAT_LEADING_BLANKS(OUTPUT_FILE_NAME, OUTPUT_FILE_NAME_LAST);
    TERMINATE_NAME_AT_THE_BLANK(OUTPUT_FILE_NAME, OUTPUT_FILE_NAME_LAST);

    PROCESS_OUTPUT_FILE_NAME(OUTPUT_FILE_NAME, OUTPUT_FILE_NAME_LAST);

    CREATE(OUTPUT_FILE, OUT_FILE,
           OUTPUT_FILE_NAME(1..OUTPUT_FILE_NAME_LAST));
    PUT("Creating file ");
    PUT(OUTPUT_FILE_NAME(1..OUTPUT_FILE_NAME_LAST));

    if IS_OPEN(OUTPUT_FILE)  then      --  If we were successful opening file

    TRANSFER_FILE:
      --  Assuming that it is a text file of reasonable lines
      loop
        if END_OF_FILE(SOURCE_FILE)  then
          exit;
        end if;
        GET_LINE(SOURCE_FILE, LINE, LINE_LAST);
        if LINE_LAST >= 10 and PRE_FLAG'LENGTH >= 10  then
          if LINE(3..10) = PRE_FLAG(3..10)   then    --  Accomadates UNIX
            exit;
          end if;
        end if;
        PUT_LINE(OUTPUT_FILE, LINE(1..LINE_LAST));
      end loop TRANSFER_FILE;

      CLOSE(OUTPUT_FILE);
      PUT("      --  Finished");
      NEW_LINE;

    end if;

    if END_OF_FILE(SOURCE_FILE)  then
      exit;
    end if;

  end loop;

  CLOSE(SOURCE_FILE);
  end loop;

  PUT_LINE("Quit");

exception
  when FORMAT_ERROR  =>
    PUT_LINE("FORMAT_ERROR raised in BREAK_DOWN_FILE");
    CLOSE(SOURCE_FILE);
    CLOSE(OUTPUT_FILE);
  when others  =>
    PUT_LINE("Unexpected exception raised in BREAK_DOWN_FILE");
    CLOSE(SOURCE_FILE);
    CLOSE(OUTPUT_FILE);
end BREAK_DOWN_FILE;

  function UPPER_CASE(S : STRING) return STRING is
    UP : STRING(1..S'LAST);

    function UPPER_CASE(C : CHARACTER) return CHARACTER is
    begin
      if C in 'a'..'z'  then
        return CHARACTER'VAL(CHARACTER'POS(C) - 32);
      else
        return C;
      end if;
    end UPPER_CASE;

  begin
    for I in 1..S'LAST  loop
      UP(I) := UPPER_CASE(S(I));
    end loop;
    return UP;
  end UPPER_CASE;

begin

  GET_COMMAND:
  declare
    RESPONSE : STRING(1..MAXIMUM_LINE_SIZE);
    RESPONSE_LAST : NATURAL := 0;
  begin
    PUT_LINE("Do you want to Check file names, Combine, Break, or Quit?  =>");
    GET_LINE(RESPONSE, RESPONSE_LAST);
    if UPPER_CASE(RESPONSE(1..2)) = "CH"  then
      CHECK_FILE_NAMES;
    elsif UPPER_CASE(RESPONSE(1..2)) = "CO"  then
      COMBINE_FILES;
    elsif UPPER_CASE(RESPONSE(1..1)) = "B"  then
      BREAK_DOWN_FILE;
    elsif UPPER_CASE(RESPONSE(1..1)) = "Q"  then
      null;
    end if;
  end GET_COMMAND;

end CCC;