-- PROGRAM/CODE BODY NAME:	PAGER2
-- AUTHOR:			Richard Conn
-- VERSION:			1.1
-- DATE:			6/12/89
-- REVISION HISTORY -
-- Version	Date	Author		Comments
--    1.0	8/28/87	Richard Conn	Initial
--    1.1       6/12/89 Richard Conn    CLI interface added
-- KEYWORDS -
--	pager, pager2, paged files, page, unpage
-- CALLING SYNTAX -
--	From the command line: pager2
--	From the command line: pager2 verb arguments
-- EXTERNAL ROUTINES -
--	Package CLI
--	Package TEXT_IO
-- DESCRIPTION -
--	PAGER2 assembles, extracts elements from, and lists paged files.
-- Paged files are text files which contain one or more component files
-- prefixed by a banner like:
--
--	::::::::::
--	filename
--	::::::::::
--
-- or
--
--	--::::::::::
--	--filename
--	--::::::::::
--
--	PAGER2 will manipulate paged files whose components
-- are prefixed with either banner, but it assembles paged files with only
-- the second banner (beginning with the Ada comment characters).
 
--===========================================================================
-------------------------- PACKAGE LINE_DEFINITION --------------------------
--===========================================================================
 
-- The following package defines an object of type LINE
package LINE_DEFINITION is
 
    -- The maximum length of a line
    MAX_LINE_LENGTH : constant NATURAL := 200;
 
    -- Type definition for LINE
    type LINE is record
	CONTENT : STRING(1 .. MAX_LINE_LENGTH);
	LAST    : NATURAL;
    end record;
    type LINE_LIST_ELEMENT;
    type LINE_LIST        is access LINE_LIST_ELEMENT;
    type LINE_LIST_ELEMENT is record
	CONTENT : LINE;
	NEXT    : LINE_LIST;
    end record;
 
    -- Banners
    COMMENT_BANNER  : constant STRING  := "--::::::::::";
    BANNER          : constant STRING  := "::::::::::";
 
    -- Convert strings to LINEs and back
    function CONVERT(FROM : in STRING) return LINE;
    function CONVERT(FROM : in LINE) return STRING;

    -- Convert a LINE to lower-case characters
    procedure TOLOWER(ITEM : in out LINE);
    function TOLOWER(ITEM : in LINE) return LINE;
 
end LINE_DEFINITION;
 
package body LINE_DEFINITION is
 
    -- Convert strings to LINEs
    function CONVERT(FROM : in STRING) return LINE is
	TO : LINE_DEFINITION.LINE;
    begin
	TO.CONTENT(TO.CONTENT'FIRST .. TO.CONTENT'FIRST + FROM'LENGTH - 1) :=
	  FROM;
	TO.LAST := FROM'LENGTH;
	return TO;
    end CONVERT;
 
    function CONVERT(FROM : in LINE) return STRING is
    begin
	return FROM.CONTENT(FROM.CONTENT'FIRST .. FROM.LAST);
    end CONVERT;
 
    procedure TOLOWER(ITEM : in out LINE) is
    begin
	for I in ITEM.CONTENT'FIRST .. ITEM.LAST loop
	    if ITEM.CONTENT(I) in 'A' .. 'Z' then
		ITEM.CONTENT(I) :=
                  CHARACTER'VAL(CHARACTER'POS(ITEM.CONTENT(I)) -
		  CHARACTER'POS('A') + CHARACTER'POS('a'));
	    end if;
	end loop;
    end TOLOWER;

    function TOLOWER(ITEM : in LINE) return LINE is
        MYLINE : LINE;
    begin
        MYLINE := ITEM;
        TOLOWER(MYLINE);
        return MYLINE;
    end TOLOWER;
 
end LINE_DEFINITION;
 
--===========================================================================
-------------------------- PACKAGE INPUT_FILE -------------------------------
--===========================================================================
 
-- The following package manipulates an object called an INPUT_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be read from an INPUT_FILE.
with LINE_DEFINITION;
package INPUT_FILE is
 
    -- Open the input file
    -- Exceptions which may be raised: FILE_NOT_FOUND, FILE_ALREADY_OPEN
    procedure OPEN(FILE_NAME : in STRING);
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
 
    -- Close the input file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE;
 
    -- Read a line from the input file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE);
 
    -- Return TRUE if the input file is empty (no more lines remain)
    -- Exceptions which may be raised: FILE_NOT_OPEN
    function END_OF_FILE return BOOLEAN;
 
    -- Exceptional conditions
    FILE_NOT_FOUND        : exception;
    FILE_ALREADY_OPEN     : exception;
    FILE_NOT_OPEN         : exception;
    READ_PAST_END_OF_FILE : exception;
 
end INPUT_FILE;
 
with TEXT_IO;
package body INPUT_FILE is
 
    -- The file descriptor for the input file
    FD : TEXT_IO.FILE_TYPE;
 
    -- Open the input file
    procedure OPEN(FILE_NAME : in STRING) is
    begin
	TEXT_IO.OPEN(FD, TEXT_IO.IN_FILE, FILE_NAME);
    exception
	when TEXT_IO.NAME_ERROR =>
	    raise FILE_NOT_FOUND;
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_ALREADY_OPEN;
    end OPEN;
 
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
	OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;
 
    -- Close the input file
    procedure CLOSE is
    begin
	TEXT_IO.CLOSE(FD);
    exception
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_NOT_OPEN;
    end CLOSE;
 
    -- Read a line from the input file
    procedure READ(TO : out LINE_DEFINITION.LINE) is
    begin
	TEXT_IO.GET_LINE(FD, TO.CONTENT, TO.LAST);
    exception
	when TEXT_IO.END_ERROR =>
	    raise READ_PAST_END_OF_FILE;
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_NOT_OPEN;
    end READ;
 
    -- Return TRUE if the input file is empty (no more lines remain)
    function END_OF_FILE return BOOLEAN is
    begin
	return TEXT_IO.END_OF_FILE(FD);
    exception
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_NOT_OPEN;
    end END_OF_FILE;
 
end INPUT_FILE;
 
--===========================================================================
-------------------------- PACKAGE OUTPUT_FILE ------------------------------
--===========================================================================
 
-- The following package manipulates an object called an OUTPUT_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be written to an OUTPUT_FILE.
with LINE_DEFINITION;
package OUTPUT_FILE is
 
    -- Open the output file
    -- Exceptions which may be raised: CANNOT_CREATE_FILE, FILE_ALREADY_OPEN
    procedure OPEN(FILE_NAME : in STRING);
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
 
    -- Close the output file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE;
 
    -- Write a line to the output file
    -- Exceptions which may be raised: FILE_NOT_OPEN, DISK_FULL
    procedure WRITE(FROM : in LINE_DEFINITION.LINE);
    procedure WRITE(FROM : in STRING);
 
    -- Exceptional conditions
    CANNOT_CREATE_FILE : exception;
    FILE_ALREADY_OPEN  : exception;
    FILE_NOT_OPEN      : exception;
    DISK_FULL          : exception;
 
end OUTPUT_FILE;
 
with TEXT_IO;
package body OUTPUT_FILE is
 
    -- File descriptor for the output file
    FD : TEXT_IO.FILE_TYPE;
 
    -- Open the output file
    procedure OPEN(FILE_NAME : in STRING) is
	INLINE : STRING(1 .. 80);
	LAST   : NATURAL;
    begin
	TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE, FILE_NAME);
    exception
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_ALREADY_OPEN;
	when TEXT_IO.USE_ERROR =>
	    raise CANNOT_CREATE_FILE;
	when TEXT_IO.NAME_ERROR =>
	    TEXT_IO.PUT_LINE(" Cannot create " & FILE_NAME);
	    loop
		begin
		    TEXT_IO.PUT(" Enter New File Name: ");
		    TEXT_IO.GET_LINE(INLINE, LAST);
		    TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE,
		      INLINE(INLINE'FIRST .. LAST));
		    exit;
		exception
		    when TEXT_IO.NAME_ERROR =>
			TEXT_IO.PUT_LINE(" Cannot create " &
			  INLINE(INLINE'FIRST .. LAST));
		    when others =>
			raise ;
		end;
	    end loop;
    end OPEN;
 
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
	OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;
 
    -- Close the output file
    procedure CLOSE is
    begin
	TEXT_IO.CLOSE(FD);
    exception
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_NOT_OPEN;
    end CLOSE;
 
    -- Write a line to the output file
    procedure WRITE(FROM : in LINE_DEFINITION.LINE) is
    begin
	TEXT_IO.PUT_LINE(FD, LINE_DEFINITION.CONVERT(FROM));
    exception
	when TEXT_IO.STATUS_ERROR =>
	    raise FILE_NOT_OPEN;
	when others =>
	    raise DISK_FULL;
    end WRITE;
 
    procedure WRITE(FROM : in STRING) is
    begin
	WRITE(LINE_DEFINITION.CONVERT(FROM));
    end WRITE;
 
end OUTPUT_FILE;
 
--===========================================================================
-------------------------- PACKAGE INCLUDE_FILE -----------------------------
--===========================================================================
 
-- The following package manipulates an object called an INCLUDE_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be read from an INCLUDE_FILE.  An INCLUDE_FILE contains
-- the following types of LINE objects:
--	blank lines
--	comment lines ('-' is the first character in the line)
--	file names (a string of non-blank characters which does not
--		begin with the character '-' or '@')
--	include file names (a string of non-blank characters which
--		begins with the character '@', where the '@' is used to
--		prefix the file name within the include file and is not
--		a part of the file name of the actual disk file)
-- Include files may be nested several levels (defined by the constant
-- NESTING_DEPTH).
with LINE_DEFINITION;
package INCLUDE_FILE is
 
    -- Maximum number of levels include files may be nested
    NESTING_DEPTH     : constant NATURAL   := 40;
 
    -- Character which begins an include file name
    INCLUDE_CHARACTER : constant CHARACTER := '@';
 
    -- Character which begins a comment line
    COMMENT_CHARACTER : constant CHARACTER := '-';
 
    -- Open the include file (the LINE input string contains the leading '@')
    -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
    procedure OPEN(FILE_NAME : in STRING);
 
    -- Read a LINE containing a file name from the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE);
 
    -- Abort processing the include file (close all open files)
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure STOP;
 
    -- Exceptional conditions
    FILE_NOT_FOUND         : exception;
    NESTING_LEVEL_EXCEEDED : exception;
    FILE_NOT_OPEN          : exception;
    READ_PAST_END_OF_FILE  : exception;
    INCLUDE_FILE_EMPTY     : exception;
 
end INCLUDE_FILE;
 
with TEXT_IO;
package body INCLUDE_FILE is
 
    -- File Descriptor for main include file
    FD              : array(1 .. NESTING_DEPTH) of TEXT_IO.FILE_TYPE;
    CURRENT_LEVEL   : NATURAL := 0;
    NEXT_LINE       : LINE_DEFINITION.LINE;    -- next line to return by READ
    NEXT_LINE_READY : BOOLEAN := FALSE;        -- indicates next line is
                                               -- available
 
    -- Open the include file (the LINE input string contains the leading '@')
    -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
	if CURRENT_LEVEL = NESTING_DEPTH then
	    raise NESTING_LEVEL_EXCEEDED;
	else
	    CURRENT_LEVEL := CURRENT_LEVEL + 1;
	    TEXT_IO.OPEN(FD(CURRENT_LEVEL), TEXT_IO.IN_FILE,
	      FILE_NAME.CONTENT(2..FILE_NAME.LAST));
	end if;
    exception
	when TEXT_IO.NAME_ERROR =>
	    TEXT_IO.PUT_LINE("Include File " &
	      LINE_DEFINITION.CONVERT(FILE_NAME) &
              " not Found");
	    raise FILE_NOT_FOUND;
	when others =>
	    TEXT_IO.PUT_LINE("Unexpected error with Include File " &
	      LINE_DEFINITION.CONVERT(FILE_NAME));
	    raise FILE_NOT_FOUND;
    end OPEN;
 
    procedure OPEN(FILE_NAME : in STRING) is
    begin
	OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;
 
    -- Close the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE is
    begin
	TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
	CURRENT_LEVEL := CURRENT_LEVEL - 1;
	if CURRENT_LEVEL = 0 then
	    raise INCLUDE_FILE_EMPTY;
	end if;
    end CLOSE;
 
    -- Abort processing the include file
    procedure STOP is
    begin
	while CURRENT_LEVEL > 0 loop
	    TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
	    CURRENT_LEVEL := CURRENT_LEVEL - 1;
	end loop;
    end STOP;
 
    -- Read a LINE containing a file name from the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE) is
	INLINE : LINE_DEFINITION.LINE;
    begin
	loop
	    begin
		TEXT_IO.GET_LINE(FD(CURRENT_LEVEL), INLINE.CONTENT,
		  INLINE.LAST);
		if INLINE.LAST > 0 and INLINE.CONTENT(1) =
		  INCLUDE_CHARACTER then
		    OPEN(INLINE);
		elsif (INLINE.LAST > 0 and INLINE.CONTENT(1) = COMMENT_CHARACTER) or
		  (INLINE.LAST = 0) then
		    null;    -- skip comment lines and empty lines
		else
		    exit;
		end if;
	    exception
		when TEXT_IO.END_ERROR =>
		    CLOSE;
	    end;
	end loop;
	TO := INLINE;
    end READ;
 
end INCLUDE_FILE;
 
