Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/paged/page.ada

Text File | 1988-05-03 | 5.9 KB | 160 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : PAGE
-- Version      : 1.0
-- Author       : Richard Conn
--              : Texas Instruments, Ada Technology Branch
--              : PO Box 801, MS 8007
--              : McKinney, TX  75069
-- DDN Address  : RCONN at SIMTEL20
-- Copyright    : (c) 1985 Richard Conn
-- Date created : 15 Feb 85
-- Release date : 15 Feb 85
-- Last update  : 15 Feb 85
-- Machine/System Compiled/Run on : DG MV 10000, ROLM ADE
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : Text file concatenation, text formatter
--
-- Abstract     :
----------------: PAGE creates a text file containing several
-- other text files separated by the lines:
--              ::::::::::
--              filename
--              ::::::::::
-- where 'filename' is the name of the file which follows.
-- It accepts as input the name of an output file (file to be
-- generated) and the names of the input files, where striking
-- a RETURN to the input file name prompt terminates the input
-- of the list of names.
--
--      UNPAGE is the complement of PAGE, which extracts the component
-- files from the combined file.
--
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION AUTHOR                  HISTORY
-- 2/15/85      1.0     Richard Conn            Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
--
--  PAGE, Version 1.0
--  by Richard Conn, TI Ada Technology Branch
--  Date: 14 Feb 1985
--
--  PAGE accepts a number of file names and generates a paged file
--  containing each of the indicated files prefixed by the form:
--     ::::::::::
--     filename
--     ::::::::::
--
with TEXT_IO,
     GENERIC_LIST;
procedure PAGE is
    VERSION : constant STRING := "PAGE, Version 1.0";

--
--  A doubly-linked list of file names
--
    FILE_NAME_LENGTH : constant := 80;
    type FILE_NAME_STRING is
        record
            NAME   : STRING (1 .. FILE_NAME_LENGTH);
            LENGTH : NATURAL;
        end record;
    package FN_LIST is new GENERIC_LIST (FILE_NAME_STRING);

--
--  Variables
--
    OUTPUT_FILE     : TEXT_IO.FILE_TYPE;
    FILE_NAME_ENTRY : FILE_NAME_STRING;
    FILE_NAME       : STRING (1 .. FILE_NAME_LENGTH);
    LENGTH          : NATURAL;

--
-- Append indicated file to end of output file
--
    procedure APPEND_FILE (FILE_NAME : STRING) is
        INPUT_FILE : TEXT_IO.FILE_TYPE;
        INLINE     : STRING (1 .. 1024);
        LENGTH     : NATURAL;
    begin
        TEXT_IO.OPEN (INPUT_FILE, TEXT_IO.IN_FILE, FILE_NAME);
        TEXT_IO.PUT_LINE (OUTPUT_FILE, "::::::::::");
        TEXT_IO.PUT_LINE (OUTPUT_FILE, FILE_NAME);
        TEXT_IO.PUT_LINE (OUTPUT_FILE, "::::::::::");
        while not TEXT_IO.END_OF_FILE (INPUT_FILE) loop
            TEXT_IO.GET_LINE (INPUT_FILE, INLINE, LENGTH);
            TEXT_IO.PUT_LINE (OUTPUT_FILE, INLINE (1 .. LENGTH));
        end loop;
        TEXT_IO.CLOSE (INPUT_FILE);
    end APPEND_FILE;


--
--  Mainline
--
begin
    TEXT_IO.PUT_LINE (VERSION);
    TEXT_IO.PUT ("Output File Name > ");
    TEXT_IO.GET_LINE (FILE_NAME, LENGTH);
    TEXT_IO.CREATE (OUTPUT_FILE, TEXT_IO.OUT_FILE, FILE_NAME (1 .. LENGTH));
    FN_LIST.INITIALIZE_LIST;
    loop
        TEXT_IO.PUT (" Input File Name > ");
        TEXT_IO.GET_LINE (FILE_NAME, LENGTH);
        exit when LENGTH = 0;
        FILE_NAME_ENTRY.NAME := FILE_NAME;
        FILE_NAME_ENTRY.LENGTH := LENGTH;
        FN_LIST.APPEND_ELEMENT (FILE_NAME_ENTRY);
    end loop;
    TEXT_IO.NEW_LINE;
    FN_LIST.SET_FIRST;
    loop
        FILE_NAME_ENTRY := FN_LIST.RETURN_CURRENT_ELEMENT;
        APPEND_FILE (FILE_NAME_ENTRY.NAME (1 .. FILE_NAME_ENTRY.LENGTH));
        TEXT_IO.PUT_LINE (FILE_NAME_ENTRY.NAME (1 .. FILE_NAME_ENTRY.LENGTH));
        exit when not FN_LIST.CURRENT_NEXT;
    end loop;
    TEXT_IO.CLOSE (OUTPUT_FILE);
exception
    when others =>
        TEXT_IO.PUT_LINE ("Unknown EXCEPTION Trapped");
end PAGE;