Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/filecomp.ada

Text File | 1988-05-03 | 91.6 KB | 2,588 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package File_Compare_Utilities
-- Version      : 2.0 (SUEP207)
-- Author       : Geoffrey O. Mendal
--              : Stanford University
--              : Computer Systems Laboratory
--              : Stanford, CA  94305
--              : [phone] or 723-1175
-- DDN Address  : [e-mail]
-- Copyright    : (c) 1985, 1986, 1987 Geoffrey O. Mendal
-- Date created : Sat 28 Dec 85
-- Release date : Sun 29 Dec 85
-- Last update  : MENDAL Sun 20 Sep 87
-- Machine/System Compiled/Run on : DG MV10000, ROLM ADE
--                                  VAX 11/780, DEC ACS
--                                  RATIONAL R1000
--                                  Sequent DYNIX, VADS
--                                  Sun/3 UNIX, VADS
-- Dependent Units : package TEXT_IO
--                   package CALENDAR
--                   package TOD_Utilities
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  COMPARE
----------------:  FILE COMPARE
--
-- Abstract     :  This generic package contains routines to
----------------:  compare two ASCII files.  It produces as
----------------:  output a side-by-side listing of both files,
----------------:  showing their differences in a very readable
----------------:  format, and also produces an update deck which
----------------:  can be used to provide a mapping between the
----------------:  two files.  This update deck is meant to be
----------------:  input for a revision control package, called
----------------:  Context_Directed_Update_Utilities.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION              AUTHOR     HISTORY
-- 12/29/85     1.0 (SAEC285)     Mendal     Initial Release
-- 01/24/86     1.1 (FRAN246)     Mendal     Bug fixes, enhancements
-- 04/19/86     1.2 (SAPR196)     Mendal     Enhancements
-- 09/20/87     2.0 (SUEP207)     Mendal     Major interface enhancements
--                                                           -*
------------------ 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--------------------------------

-- File_Compare_Utilities is an ASCII file comparison package.  It
-- takes two files as input and produces a list file and context
-- directed update deck as output.  Several options are available
-- which control what output is to be produced and how the files
-- should be compared.  The context directed update deck provides
-- a mapping from the "old" file to the "new" one, and can be used
-- as input to the Context_Directed_Update_Utilities package to
-- derive the "new" file given the "old" file and the CDUPDATE deck.
-- Hence, this package can be used as a means of revision control.

-- The package body performs its own garbage collection, which increases
-- the speed of the algorithm.  Doing so, however, requires that the
-- package maintain a global free list.  Hence, use of this package
-- in concurrent environments is discouraged.  The package reads in
-- a maximum number of lines for each file.  This number is controlled
-- by means of a lookahead value which constrains the algorithm in
-- finding synchronization points in both files.  One may notice on the
-- side-by-side listings and CDUPDATE decks that a maximum number of
-- lines in a group (equal, insertion, deletion) is less than that
-- of the true number in a group.  This is due to the constrained
-- lookahead value.  A user may alter this lookahead value, but
-- is strongly discouraged from doing so (see below for details).

-- This package has been formally annotated using the ANNA specification
-- language.  For more information, contact the author at the above
-- address.

with TEXT_IO;  -- Predefined I/O package.

generic
  Maximum_File_Name_Length : in     POSITIVE := 100;
  Maximum_Line_Length      : in     POSITIVE := 256;

  -- The above values are used to specify the maximum length
  -- of strings.  Such strings are used in the package body.

  with procedure Get_A_Line (
                   File   : in     TEXT_IO.FILE_TYPE;
                   Line   :    out STRING;
                   Length :    out NATURAL) is TEXT_IO.GET_LINE;
  -- | where TEXT_IO.IS_OPEN (File),
  -- |       TEXT_IO.MODE (File) = TEXT_IO.OUT_FILE,
  -- |       raise TEXT_IO.END_ERROR => FALSE,
  -- |       Line'FIRST = 1 and Line'LAST = Maxmimum_Line_Length,
  -- |       out (0 <= Length <= Maxmimum_Line_Length)
  -- |       out (for all I : NATURAL range 1 .. Length =>
  -- |         Line (I)'DEFINED);
  -- Anna doesn't allow subprogram annotations on generic formals, hence
  -- the reason for "-- |" instead of "--|".

  -- The above subprogram allows a user to override the line
  -- entry method of TEXT_IO.GET_LINE and instead write a routine
  -- that returns a string resulting from a user-defined "line".
  -- For all user-defined actual subprograms, the bounds of
  -- the returned "Line" string value must be exactly that of
  -- (1 .. Maximum_Line_Length), else CONSTRAINT_ERROR will be
  -- propagated to this package, and this package will then
  -- propagate Line_Length_Error to the caller.  A user should
  -- return the true last character of "Line" by means of the
  -- "Length" parameter, that is, it will be assumed that
  -- Line (1 .. Length) contains the line to be compared.
package File_Compare_Utilities is
  function Version return STRING;  -- Returns the version number.

  -- The following type can be used to specify the case of CDUPDATE
  -- deck commands in the CDUPDATE deck file.

  type Type_Set is (Upper_Case, Lower_Case, Mixed_Case);

  -- The following type can be used to retrieve statistics generated
  -- by the Compare subprograms.

  type Statistics_Type is
    record
      Files_Equal         : BOOLEAN := FALSE;  -- TRUE if files are equal, FALSE otherwise
      Number_Old_Lines,                    -- Number of lines in the old file
      Number_New_Lines,                    -- Number of lines in the new file
      Total_Equal_Lines,                   -- Number of equal lines found
      Total_Insertions,                    -- Number of insertions found
      Total_Deletions,                     -- Number of deletions found
      Total_Minor_Changes : NATURAL := 0;  -- Number of minor changes found
    end record;

  -- The following type can be used to specify options to the Compare
  -- subprograms.  Note that a default options record is provided below.

  type Options_Type is
    record
      Produce_Listing,                         -- Print a side-by-side listing
                                               -- of both files
      Summarize,                               -- Summarizes equal lines,
                                               -- insertions, and deletions
                                               -- in the listing (groups them)
      Wide_Listing,                            -- Line printer style listing
      Produce_Deck,                            -- Generate a CDUPDATE deck
      Verbose_Deck,                            -- Spell out everything in full
      Produce_Statistics,                      -- Generate statistics
      Check_Minor_Changes,                     -- Check for minor changes in lines
      Case_Sensitive       : BOOLEAN := TRUE;  -- Distinguish between upper and
                                               -- lower case
      Deck_Command_Case    : Type_Set := Mixed_Case;  -- Case of deck commands
      Lookahead            : POSITIVE := 500;  -- Synchronization point constraint
      Minimum_Group        : POSITIVE range 3 .. POSITIVE'LAST := 3;
                                       -- Minimum number of lines on which
    end record;                        -- Summarize has an effect

  Default_Options : Options_Type;

  -- Notes on the Options:
  --   (1) Summarize will cause just the first and last lines in a
  --       group of equal lines, insertions, or deletions to be printed.
  --       In addition, a special notation will be made on the listing
  --       stating the total number of lines in the group.  This is
  --       useful for summarizing the differences in the files.
  --       Otherwise, each and every line is printed in full on the
  --       listing.  The user can control how many lines determine
  --       a "group", and hence has some control in producing summarized
  --       output.  (See the Minimum_Group option for details.)
  --   (2) Wide_Listing will cause the list file to print correctly
  --       for a line printer (132 column printer).  If this option
  --       is set to FALSE, the listing will print correctly for
  --       a terminal screen (80 column screen) or printer that
  --       can only print a maximum of 80 columns per line.
  --   (3) Verbose_Deck causes Delete commands to appear
  --       explicitly in the CDUPDATE deck.  Such commands are not
  --       really required.  The Context Directed Update utility will
  --       delete any lines not explicitly accounted for in a
  --       CDUPDATE deck.  Hence, Delete commands are an aid for the
  --       programmer.  This option can be set to FALSE so as to save
  --       space (albeit not much) in the CDUPDATE deck.  With this
  --       option set to FALSE, commands are also abbreviated to
  --       their fullest, "noise word" parameters are eliminated,
  --       some extra spacing is condensed between parameters,
  --       and no comment commands are produced.
  --   (4) Check_Minor_Changes causes the algorithm to check each
  --       line for minor changes.  By setting this value to FALSE,
  --       the speed of the algorithm can be increased at the expense
  --       of a more brute force comparison approach.
  --   (5) Case_Sensitive causes lines to be compared with regard
  --       for upper and lower case.  If a case insensitive comparison
  --       is desired, this option should be set to FALSE.  If this
  --       option is set to FALSE and a minor change is found, an
  --       Edit command in the CDUPDATE deck will still be generated
  --       with case sensitive parameters.
  --   (6) If the Produce_Listing and/or Produce_Deck options are set
  --       to FALSE, a user need not provide their file names to the
  --       Compare subprograms.  Instead, a user can provide null
  --       values.  (The strings/files will be ignored in such cases anyway.)
  --   (7) If the Produce_Statistics option is set to FALSE, then
  --       the result returned by the Compare subprograms is
  --       undeterminate; do not rely on the values of this record
  --       in such cases.
  --   (8) The Lookahead value provided to the Compare subprograms
  --       establishes the maximum number of lines to read in for
  --       EACH file.  A larger lookahead will of course make finding
  --       synchronization points easier, but will also consume more
  --       memory.  Hence, users are cautioned in altering this
  --       Lookahead value.  It is possible that STORAGE_ERROR will
  --       be propagated to the caller if too large a Lookahead is
  --       provided.  Providing a smaller Lookahead may solve this
  --       problem.
  --   (9) The Minimum_Group value determines the minimum number
  --       of lines in a group (insertions, deletions, or equal lines)
  --       on which the Summarize option will have an effect.  This
  --       option only has an effect of Summarize is set to TRUE.

  Line_Length_Error,
  File_Name_Length_Error,
  Old_File_Open_Error,
  New_File_Open_Error,
  List_File_Create_Error,
  Deck_File_Create_Error  : exception;

  -- Notes on the exceptions:
  --   (1) The Line_Length_Error exception is propagated
  --       when a user-defined Get_A_Line subprogram returns a
  --       Line string whose bounds are not exactly that specified
  --       by (1 .. Maximum_Line_Length).
  --   (2) The "Open_Error" exceptions are propagated when the
  --       subprograms perform TEXT_IO.OPEN on the old and
  --       new files as TEXT_IO.IN_FILE but a TEXT_IO exception
  --       was raised.  The most probable error is that the file
  --       doesn't exist or access to it is not allowed.  These exceptions
  --       are also propagated if the file arguments do not designate
  --       legal files.
  --   (3) The "Create_Error" exceptions are propagated when the
  --       subprograms perform TEXT_IO.CREATE on the list and deck
  --       files as TEXT_IO.OUT_FILE but a TEXT_IO exception was
  --       raised.  These exceptions are also propagated if the file
  --       arguments do not designate legal files.
  --   (4) Once the files have been successfully opened and created,
  --       no more exception trapping is performed.  If a TEXT_IO
  --       operation fails, the TEXT_IO exception will be propagated
  --       immediately to the caller.
  --   (5) The File_Name_Length_Error exception is propagated when a
  --       subprogram is called, and the length of any file name
  --       is greater than that of Maximum_File_Name_Length.

  -- The following characters are used as codes in the listing
  -- and CDUPDATE deck files.  The subtype allows for only non-
  -- blank printable characters.

  subtype Code_Character_Type is CHARACTER range '!' .. '~';

  Equal_Lines_Code  : Code_Character_Type := '=';
  Minor_Change_Code : Code_Character_Type := '*';
  Insertion_Code    : Code_Character_Type := '+';
  Deletion_Code     : Code_Character_Type := '-';
  Command_Code      : Code_Character_Type := '/';

  function "=" (L, R : in TEXT_IO.FILE_MODE) return BOOLEAN
    renames TEXT_IO."=";

  --: function Can_Open_File (F : in STRING) return BOOLEAN;
  --: function Can_Create_File (F : in STRING) return BOOLEAN;

  -- The following subprogram takes an old, new, list, and deck file
  -- as input, and (depending on the options set) returns
  -- statistics, a side-by-side listing, and a CDUPDATE deck.
  -- The old and new files must already be opened for input, and the list and
  -- deck files must already be opened for output.  No files will be closed.

  procedure Compare (
    Old_File,
    New_File,
    List_File,
    Deck_File  : in     TEXT_IO.FILE_TYPE;
    Statistics :    out Statistics_Type;
    Options    : in     Options_Type := Default_Options);
  --| where not TEXT_IO.IS_OPEN (Old_File) or else
  --|         TEXT_IO.MODE (Old_File) /= TEXT_IO.IN_FILE =>
  --|         raise Old_File_Open_Error,
  --|       not TEXT_IO.IS_OPEN (New_File) or else
  --|         TEXT_IO.MODE (New_File) /= TEXT_IO.IN_FILE =>
  --|         raise New_File_Open_Error,
  --|       not TEXT_IO.IS_OPEN (List_File) or else
  --|         TEXT_IO.MODE (List_File) /= TEXT_IO.OUT_FILE =>
  --|         raise List_File_Create_Error,
  --|       not TEXT_IO.IS_OPEN (Deck_File) or else
  --|         TEXT_IO.MODE (Deck_File) /= TEXT_IO.OUT_FILE =>
  --|         raise Deck_File_Create_Error,
  --|       raise Old_File_Open_Error | New_File_Open_Error |
  --|         List_File_Create_Error | Deck_File_Create_Error =>
  --|         Statistics = in Statistics,
  --|       raise File_Name_Length_Error => FALSE,
  --|       out (Statistics'DEFINED and
  --|         TEXT_IO.END_OF_FILE (Old_File) and
  --|         TEXT_IO.END_OF_FILE (New_File) and
  --|         TEXT_IO.IS_OPEN (List_File) and
  --|         TEXT_IO.IS_OPEN (Deck_File));

  -- The following overloading should be used when no statistics
  -- are required.  Note that if the Produce_Statistics and
  -- Produce_Listing options are both set to TRUE, statistics
  -- will still be printed on the listing.

  procedure Compare (
    Old_File,
    New_File,
    List_File,
    Deck_File  : in     TEXT_IO.FILE_TYPE;
    Options    : in     Options_Type := Default_Options);
  --| where not TEXT_IO.IS_OPEN (Old_File) or else
  --|         TEXT_IO.MODE (Old_File) /= TEXT_IO.IN_FILE =>
  --|         raise Old_File_Open_Error,
  --|       not TEXT_IO.IS_OPEN (New_File) or else
  --|         TEXT_IO.MODE (New_File) /= TEXT_IO.IN_FILE =>
  --|         raise New_File_Open_Error,
  --|       not TEXT_IO.IS_OPEN (List_File) or else
  --|         TEXT_IO.MODE (List_File) /= TEXT_IO.OUT_FILE =>
  --|         raise List_File_Create_Error,
  --|       not TEXT_IO.IS_OPEN (Deck_File) or else
  --|         TEXT_IO.MODE (Deck_File) /= TEXT_IO.OUT_FILE =>
  --|         raise Deck_File_Create_Error,
  --|       raise File_Name_Length_Error => FALSE,
  --|       out (TEXT_IO.END_OF_FILE (Old_File) and
  --|         TEXT_IO.END_OF_FILE (New_File) and
  --|         TEXT_IO.IS_OPEN (List_File) and
  --|         TEXT_IO.IS_OPEN (Deck_File));

  -- The following subprogram performs only a quick comparison
  -- of the old and new files.  Only a boolean result is returned.
  -- TRUE is returned if the files are equal, otherwise FALSE
  -- is returned.  This subprogram uses a different and more
  -- efficient algorithm in comparing the files, since it does not
  -- have to generate a side-by-side listing nor a CDUPDATE deck.
  -- The user should not depend on the state of the files upon return.
  -- The algorithm does not always read to the end of file for both files.

  function Quick_Compare (
    Old_File,
    New_File       : in     TEXT_IO.FILE_TYPE;
    Case_Sensitive : in     BOOLEAN := TRUE) return BOOLEAN;
  --| where not TEXT_IO.IS_OPEN (Old_File) or else
  --|         TEXT_IO.MODE (Old_File) /= TEXT_IO.IN_FILE =>
  --|         raise Old_File_Open_Error,
  --|       not TEXT_IO.IS_OPEN (New_File) or else
  --|         TEXT_IO.MODE (New_File) /= TEXT_IO.IN_FILE =>
  --|         raise New_File_Open_Error,
  --|       raise File_Name_Length_Error => FALSE;
  ----------------------------------------------------------------------------

  -- The following three subprograms behave similar to the above three,
  -- except that the file names are passed as strings.

  -- The following subprogram takes an old, new, list, and deck file
  -- name as input, and (depending on the options set), returns
  -- statistics, a side-by-side listing, and a CDUPDATE deck.
  -- The old and new file names will be opened, and the list and
  -- deck files will be created (if the list and/or deck files already
  -- exist, they will be overwritten).  All files will be closed
  -- upon normal termination.

  procedure Compare (
    Old_File_Name,
    New_File_Name,
    List_File_Name,
    Deck_File_Name  : in     STRING;
    Statistics      :    out Statistics_Type;
    Options         : in     Options_Type := Default_Options);
  --| where Old_File_Name > Maximum_File_Length or
  --|         New_File_Name > Maximum_File_Length or
  --|         List_File_Name > Maximum_File_Length or
  --|         Deck_File_Name > Maximum_File_Length =>
  --|         raise File_Name_Length_Error,
  --|       not Can_Open_File (Old_File_Name) =>
  --|         raise Old_File_Open_Error,
  --|       not Can_Open_File (New_File_Name) =>
  --|         raise New_File_Open_Error,
  --|       not Can_Create_File (List_File_Name) and
  --|           Options.Produce_Listing =>
  --|         raise List_File_Create_Error,
  --|       not Can_Create_File (Deck_File_Name) and
  --|           Options.Produce_Deck =>
  --|         raise Deck_File_Create_Error,
  --|       raise File_Name_Length_Error | Old_File_Open_Error |
  --|         New_File_Open_Error | List_File_Create_Error |
  --|         Deck_File_Create_Error => Statistics = in Statistics,
  --|       out Statistics'DEFINED;

  -- The following overloading should be used when no statistics
  -- are required.  Note that if the Produce_Statistics and
  -- Produce_Listing options are both set to TRUE, statistics
  -- will still be printed on the listing.

  procedure Compare (
    Old_File_Name,
    New_File_Name,
    List_File_Name,
    Deck_File_Name  : in     STRING;
    Options         : in     Options_Type := Default_Options);
  --| where Old_File_Name > Maximum_File_Length or
  --|         New_File_Name > Maximum_File_Length or
  --|         List_File_Name > Maximum_File_Length or
  --|         Deck_File_Name > Maximum_File_Length =>
  --|         raise File_Name_Length_Error,
  --|       not Can_Open_File (Old_File_Name) =>
  --|         raise Old_File_Open_Error,
  --|       not Can_Open_File (New_File_Name) =>
  --|         raise New_File_Open_Error,
  --|       not Can_Create_File (List_File_Name) and
  --|           Options.Produce_Listing =>
  --|         raise List_File_Create_Error,
  --|       not Can_Create_File (Deck_File_Name) and
  --|           Options.Produce_Deck =>
  --|         raise Deck_File_Create_Error;

  -- The following subprogram performs only a quick comparison
  -- of the old and new files.  Only a boolean result is returned.
  -- TRUE is returned if the files are equal, otherwise FALSE
  -- is returned.  This subprogram uses a different and more
  -- efficient algorithm in comparing the files, since it does not
  -- have to generate a side-by-side listing nor a CDUPDATE deck.

  function Quick_Compare (
    Old_File_Name,
    New_File_Name  : in     STRING;
    Case_Sensitive : in     BOOLEAN := TRUE) return BOOLEAN;
  --| where not Can_Open_File (Old_File_Name) =>
  --|         raise Old_File_Open_Error,
  --|       not Can_Open_File (New_File_Name) =>
  --|         raise New_File_Open_Error,
  --|       raise File_Name_Length_Error => FALSE;
end File_Compare_Utilities;
------------------------------------------------------------------------
-- Example uses:

-- Example #1: Compare two files for equality
-- with File_Compare_Utilities, TEXT_IO;
-- procedure Main is
--   package Compare_Utilities is new File_Compare_Utilities;
-- begin
--   TEXT_IO.PUT ("Files F1 and F2 are ");
--
--   if not Compare_Utilities.Quick_Compare ("F1", "F2") then
--     TEXT_IO.PUT ("not ");
--   end if;
--
--   TEXT_IO.PUT_LINE ("equal.");
-- end Main;
-- ---------------------------------------------------------------------
-- Example #2: Compare two files and generate all possible output
-- with File_Compare_Utilities;
-- procedure Main is
--   Statistics : File_Compare_Utilities.Statistics_Type;
--   package Compare_Utilities is new File_Compare_Utilities;
-- begin
--   Compare_Utilities.Compare ("Main.Bak", "Main.Ada",
--     "Listing", "Cdupdate_Deck", Statistics);
-- end Main;
-- ---------------------------------------------------------------------
-- Example #3: Compare two files, alter the maximum line length,
--             and modify the character code objects, and options.
-- with File_Compare_Utilities;
-- procedure Main is
--   package Compare_Utilities is new File_Compare_Utilities (
--                                      Maximum_Line_Length => 80);
-- begin
--   Compare_Utilities.Equal_Lines_Code := 'E';
--   Compare_Utilities.Command_Code := '#';
--   Compare_Utilities.Default_Options.Produce_Deck := FALSE;
--   Compare_Utilities.Default_Options.Wide_Listing := FALSE;
--   Compare_Utilities.Default_Options.Lookahead := 50;
--   Compare_Utilities.Compare ("F1", "F2", "L", "");
-- end Main;
-- ---------------------------------------------------------------------
-- Example #4: Compare two files, using a user-defined Get_A_Line
--             subprogram.  File objects are passed in.
-- with File_Compare_Utilities, TEXT_IO;
-- procedure Main is
--   New_File, Old_File, List_File, Deck_File : TEXT_IO.FILE_TYPE;
--   procedure My_Get_Line (
--     F : in     TEXT_IO.FILE_TYPE;
--     S :    out STRING;
--     N :    out NATURAL);
--   package Compare_Utilities is new File_Compare_Utilities (
--                                      Get_A_Line => My_Get_Line);
--   procedure My_Get_Line (
--     F : in     TEXT_IO.FILE_TYPE;
--     S :    out STRING;
--     N :    out NATURAL) is
--     Str : STRING (1 .. 500) := (others => ASCII.NUL);
--     Len : NATURAL;
--   begin
--     -- read in a line, stripping off the first five characters
--     TEXT_IO.GET_LINE (F, Str, Len);
--     Str (1 .. Len - 5) := Str (6 .. Len);
--     S := Str (1 .. 256);
--     if Len > 261 then
--       N := 256;
--     else
--       N := Len - 5;
--     end if;
--   end My_Get_Line;
-- begin
--   TEXT_IO.OPEN (Old_File, TEXT_IO.IN_FILE, "F1");
--   TEXT_IO.OPEN (New_File, TEXT_IO.IN_FILE, "F2");
--   TEXT_IO.CREATE (List_File, TEXT_IO.OUT_FILE, "L");
--   TEXT_IO.CREATE (Deck_File, TEXT_IO.OUT_FILE, "D");
--
--   Compare_Utilities.Compare (Old_File, New_File, List_File, Deck_File);
--
--   TEXT_IO.CLOSE (Old_File);
--   TEXT_IO.CLOSE (New_File);
--   TEXT_IO.CLOSE (List_File);
--   TEXT_IO.CLOSE (Deck_File);
-- end Main;

with CALENDAR,       -- predefined time of day package
     TOD_Utilities;  -- GOM time of day utility package

package body File_Compare_Utilities is
  -- Global constants used throughout the package body follow.
  -- They eliminate magic numbers and frequently used character
  -- literals, making the code more readable and reliable.

  List_Line_Num_Max_Length  : constant POSITIVE  :=   4;
  Small_Margin              : constant POSITIVE  :=  31;
  Large_Margin              : constant POSITIVE  :=  57;
  Squote                    : constant CHARACTER := ''';
  Dquote                    : constant CHARACTER := '"';
  Blank                     : constant CHARACTER := ' ';
  Version_Number            : constant STRING    := "2.0 (SUEP207)";
  Authors_List              : constant STRING    :=
    "Geoff Mendal, Stanford University (CSL)";
  Uc_Lc_Offset              : constant POSITIVE  :=
    CHARACTER'POS (ASCII.LC_A) - CHARACTER'POS ('A');

  subtype Set_of_Upper_Case_Letters is CHARACTER range 'A' .. 'Z';
  subtype Set_of_Lower_Case_Letters is CHARACTER range
    ASCII.LC_A .. ASCII.LC_Z;

  subtype File_Name_Type is STRING (1 .. Maximum_File_Name_Length);

  type Files_Type is  -- a composite of information on files used
    record
      Old_File_Name,
      New_File_Name,
      List_File_Name,
      Deck_File_Name    : File_Name_Type := (others => Blank);
      Old_File_Length,
      New_File_Length,
      List_File_Length,
      Deck_File_Length  : NATURAL := 0;
    end record;

  subtype Line_Type is STRING (1 .. Maximum_Line_Length);  -- a line of data

  type Data_Line_Type is  -- a composite of a line of data and its length
    record
      Line   : Line_Type;
      Length : NATURAL;
    end record;

  type Data_Type;

  type Data_Ptr_Type is access Data_Type;

  type Data_Type is  -- an element of a linked list of lines in a file
    record
      Data_Line   : Data_Line_Type;
      Line_Number : NATURAL;
      Next_Line   : Data_Ptr_Type;
    end record;

  type Dispose_Record_Type is  -- a composite of garbage collection info
    record
      Old_File,
      New_File  : NATURAL;
    end record;

  type Minor_Change_Found_Type is (No_Minor_Change_Found,
    Insertion_Found, Deletion_Found, Replacement_Found,
    Transposition_Found);

  Free_List_Head,
  Free_List_Tail  : Data_Ptr_Type := null;  -- global free list pointers
  Old_Delimiter,
  New_Delimiter   : CHARACTER;  -- used for parameters on /EDIT commands
  Text_Max_Length : POSITIVE;  -- used for wide/compressed list file output

  package Int_IO is new TEXT_IO.INTEGER_IO (NATURAL);

  --: function Can_Open_File (F : in STRING) return BOOLEAN is
  --:   File : TEXT_IO.FILE_TYPE;
  --: begin
  --:   TEXT_IO.OPEN (File, TEXT_IO.IN_FILE, F);
  --:   TEXT_IO.CLOSE (File);
  --:   return TRUE;
  --: exception
  --:   when others =>
  --:     return FALSE;
  --: end Can_Open_File;

  --: function Can_Create_File (F : in STRING) return BOOLEAN is
  --:   File : TEXT_IO.FILE_TYPE;
  --: begin
  --:   TEXT_IO.CREATE (File, TEXT_IO.OUT_FILE, F);
  --:   TEXT_IO.DELETE (File);
  --:   return TRUE;
  --: exception
  --:   when others =>
  --:     return FALSE;
  --: end Can_Create_File;

  function Version return STRING is
  begin
    return Version_Number;
  end Version;

  -- The following function converts a string into either
  -- upper case, lower case, or mixed case.  It assumes that
  -- strings are passed into it in mixed case.

  function Case_Conversion (
    Str        : in STRING;
    Convert_To : in Type_Set) return STRING is

    Str_Copy : STRING (Str'RANGE) := Str;
  begin
    case Convert_To is
      when Mixed_Case => null;
      when Upper_Case =>
        for I in Str'RANGE loop
          if Str (I) in Set_of_Lower_Case_Letters then
            Str_Copy (I) := CHARACTER'VAL (CHARACTER'POS (Str (I)) - Uc_Lc_Offset);
          end if;
        end loop;
      when Lower_Case =>
        for I in Str'RANGE loop
          if Str (I) in Set_of_Upper_Case_Letters then
            Str_Copy (I) := CHARACTER'VAL (CHARACTER'POS (Str (I)) + Uc_Lc_Offset);
          end if;
        end loop;
    end case;

    return Str_Copy;
  end Case_Conversion;
  ----------------------------------------------------------------------

  -- The following procedure outputs header info to the list and
  -- deck files.

  procedure Headings (
    Options        : in     Options_Type;
    List_File,
    Deck_File      : in     TEXT_IO.FILE_TYPE;
    Files          : in out Files_Type) is

    TOD : STRING (1 ..
      TOD_Utilities.External_TOD_Representation_Type'LAST + 3) :=
      (others => Blank);
    TOD_Length : POSITIVE;

    -- The following inner procedure is used to truncate file
    -- names which are too long to fit on the output files.
    -- Such truncation is only used for output purposes and
    -- has no side effects.  Note that truncation is taken from
    -- the beginning of the string, not the end as is normal.

    procedure Set_Printable_File_Length (
      File_Name   : in out File_Name_Type;
      File_Length : in out NATURAL) is
    begin
      for I in File_Name'RANGE loop
        if File_Name (I) not in Code_Character_Type then
          File_Name (I) := Blank;
        end if;
      end loop;

      if File_Length > Text_Max_Length then
        File_Name (File_Name'FIRST .. File_Name'FIRST + Text_Max_Length - 1) :=
          "..." & File_Name (File_Name'FIRST + File_Length - Text_Max_Length + 3 ..
                             File_Name'FIRST + File_Length - 1);
        File_Length := Text_Max_Length;
      end if;
    end Set_Printable_File_Length;

    -- The following inner procedure removes extra blanks in
    -- the time-of-day string returned by GOM's time-of-day
    -- conversion utility.

    procedure Compress (
      Str               : in out STRING;
      Compressed_Length :    out POSITIVE) is

      Str_Copy : STRING (Str'RANGE) := (others => Blank);
      Str_Ptr,
      Str_Ptr_Copy : POSITIVE := Str'FIRST;
    begin
      while (Str_Ptr <= Str'LAST) and then
            (Str (Str_Ptr) = Blank) loop
        Str_Ptr := Str_Ptr + 1;
      end loop;

      while (Str_Ptr <= Str'LAST - 2) loop
        if    (Str (Str_Ptr)     = Blank) and
              (Str (Str_Ptr + 1) = Blank) and
              (Str (Str_Ptr + 2) = Blank) then
          Str_Ptr := Str_Ptr + 2;
        elsif (Str (Str_Ptr)     = Blank) and
              (Str (Str_Ptr + 1) = Blank) then
          Str_Ptr      := Str_Ptr + 2;
          Str_Ptr_Copy := Str_Ptr_Copy + 1;
        elsif (Str (Str_Ptr)     = Blank) then
          Str_Ptr      := Str_Ptr + 1;
          Str_Ptr_Copy := Str_Ptr_Copy + 1;
        else
          Str_Copy (Str_Ptr_Copy) := Str (Str_Ptr);
          Str_Ptr := Str_Ptr + 1;
          Str_Ptr_Copy := Str_Ptr_Copy + 1;
        end if;
      end loop;

      if (Str'FIRST + Str'LAST - 1 >= 3) and then
         ((Str (Str'LAST - 2) /= Blank) and
          (Str (Str'LAST - 1) =  Blank) and
          (Str (Str'LAST)     /= Blank)) then
        Str_Ptr_Copy := Str_Ptr_Copy + 1;
      end if;

      if (Str'FIRST + Str'LAST - 1) >= 2 and then
         (Str (Str'LAST - 1) /= Blank) then
        Str_Copy (Str_Ptr_Copy) := Str (Str'LAST - 1);
        Str_Ptr_Copy := Str_Ptr_Copy + 1;
      end if;

      if (Str'FIRST + Str'LAST - 1 >= 1) and then
         (Str (Str'FIRST) /= Blank) then
        Str_Copy (Str_Ptr_Copy) := Str (Str'LAST);
        Str_Ptr_Copy := Str_Ptr_Copy + 1;
      end if;

      Str := Str_Copy;
      Compressed_Length := Str_Ptr_Copy - Str'FIRST;
    end Compress;
  begin  -- Headings
    Set_Printable_File_Length (Files.Old_File_Name,
      Files.Old_File_Length);
    Set_Printable_File_Length (Files.New_File_Name,
      Files.New_File_Length);
    Set_Printable_File_Length (Files.List_File_Name,
      Files.List_File_Length);
    Set_Printable_File_Length (Files.Deck_File_Name,
      Files.Deck_File_Length);

    TOD (1 .. TOD_Utilities.External_TOD_Representation_Type'LAST) :=
      TOD_Utilities.Convert_Internal_TOD_to_External_TOD (
        CALENDAR.CLOCK, TOD_Utilities.Mixed_Case);
    TOD (29 .. TOD'LAST) := "at " & TOD (29 .. 38);
    Compress (TOD, TOD_Length);
    TOD (TOD_Length - 1) := CHARACTER'VAL (
      CHARACTER'POS (TOD (TOD_Length - 1)) + Uc_Lc_Offset);

    if Options.Produce_Deck then
      if not Options.Verbose_Deck then
        TEXT_IO.PUT_LINE (Deck_File, Command_Code &
          Case_Conversion ("B", Options.Deck_Command_Case));
      else
        TEXT_IO.PUT_LINE (Deck_File, Command_Code &
          Case_Conversion ("Begin", Options.Deck_Command_Case));
        TEXT_IO.PUT_LINE (Deck_File, Command_Code & "-- CDUPDATE deck " &
          "generated by FILE COMPARE on " & TOD (1 .. TOD_Length));
        TEXT_IO.PUT_LINE (Deck_File, Command_Code & "-- FILE COMPARE -- " &
          "Version " & Version);
        TEXT_IO.PUT_LINE (Deck_File, Command_Code & "-- Written by " &
          Authors_List);
        TEXT_IO.PUT_LINE (Deck_File, Command_Code & "-- This deck " &
          "provides a mapping from " &
          Files.Old_File_Name (1 .. Files.Old_File_Length) & " to " &
          Files.New_File_Name (1 .. Files.New_File_Length));
        TEXT_IO.PUT (Deck_File, Command_Code &
          "-- This comparison is being performed with");

        if not Options.Case_Sensitive then
          TEXT_IO.PUT (Deck_File, "out");
        end if;

        TEXT_IO.PUT_LINE (Deck_File, " respect for case sensitivity");
      end if;
    end if;

    if Options.Produce_Listing then
      if Options.Wide_Listing then
        TEXT_IO.PUT (List_File, "                          ");
      end if;

      TEXT_IO.PUT_LINE (List_File,
        "            F I L E   C O M P A R E   P R O G R A M   " &
        "L I S T I N G");
      TEXT_IO.NEW_LINE (List_File);
      TEXT_IO.PUT_LINE (List_File, "FILE COMPARE -- Version " &
        Version);
      TEXT_IO.PUT_LINE (List_File, "Written by " & Authors_List);
      TEXT_IO.NEW_LINE (List_File);
      TEXT_IO.PUT_LINE (List_File, "Comparison generated on " &
        TOD (1 .. TOD_Length));
      TEXT_IO.NEW_LINE (List_File);
      TEXT_IO.PUT (List_File, "This comparison is being performed with");

      if not Options.Case_Sensitive then
        TEXT_IO.PUT (List_File, "out");
      end if;

      TEXT_IO.PUT_LINE (List_File, " respect for case sensitivity");
      TEXT_IO.NEW_LINE (List_File, 2);

      TEXT_IO.PUT (List_File, "C Line " &
        Files.Old_File_Name (1 .. Files.Old_File_Length));

      for I in 1 .. (Text_Max_Length - Files.Old_File_Length) loop
        TEXT_IO.PUT (List_File, Blank);
      end loop;

      TEXT_IO.PUT (List_File, " | " &
        Files.New_File_Name (1 .. Files.New_File_Length));

      for I in 1 .. (Text_Max_Length - Files.New_File_Length) loop
        TEXT_IO.PUT (List_File, Blank);
      end loop;

      TEXT_IO.PUT_LINE (List_File, " Line C");

      if Options.Wide_Listing then
        TEXT_IO.PUT_LINE (List_File,
          "-----------------------------------------------------------------+" &
          "-----------------------------------------------------------------");
      else
        TEXT_IO.PUT_LINE (List_File,
          "---------------------------------------+" &
          "---------------------------------------");
      end if;
    end if;
  end Headings;
  ----------------------------------------------------------------------

  -- The following procedure is the hub of all input operations.
  -- It makes use of this package's own garbage collection too.

  procedure Read_File (
    Max_Lines_to_Read : in     NATURAL;
    A_File            : in     TEXT_IO.FILE_TYPE;
    Line_Number       : in out POSITIVE;
    File_Head_Ptr     : in out Data_Ptr_Type) is

    Curr_Ptr,
    Tail_Ptr     : Data_Ptr_Type := File_Head_Ptr;
    Number_Lines : NATURAL := 1;
  begin
    -- Position the tail pointer at the end of the linked list
    -- for the file.

    if Tail_Ptr /= null then
      while Tail_Ptr.Next_Line /= null loop
        Tail_Ptr := Tail_Ptr.Next_Line;
      end loop;
    end if;

    -- Read in data

    while (not TEXT_IO.END_OF_FILE (A_File)) and
          (Number_Lines <= Max_Lines_to_Read) loop
      if Free_List_Head = null then
        Curr_Ptr := new Data_Type;
      else
        Curr_Ptr := Free_List_Head;
        Free_List_Head := Free_List_Head.Next_Line;
      end if;

      begin
        Get_A_Line (A_File, Curr_Ptr.Data_Line.Line,
          Curr_Ptr.Data_Line.Length);
      exception
        when CONSTRAINT_ERROR =>
          raise Line_Length_Error;
      end;

      -- Blank the remainder of the string, even though it
      -- is never referenced.

      for I in Curr_Ptr.Data_Line.Length + 1 ..
               Curr_Ptr.Data_Line.Line'LAST loop
        Curr_Ptr.Data_Line.Line (I) := Blank;
      end loop;

      Number_Lines := Number_Lines + 1;

      -- Hook up the line in the linked list

      if Tail_Ptr = null then
        File_Head_Ptr := Curr_Ptr;
      else
        Tail_Ptr.Next_Line := Curr_Ptr;
      end if;

      Curr_Ptr.Line_Number := Line_Number;
      Line_Number := Line_Number + 1;
      Tail_Ptr := Curr_Ptr;
      Curr_Ptr.Next_Line := null;
    end loop;

    if Free_List_Head = null then
      Free_List_Tail := null;
    end if;
  end Read_File;
  ----------------------------------------------------------------------

  -- The following procedure prints lines on the list file.  The first
  -- and last lines are passed, and this procedure iterates over all
  -- lines from first to last inclusive.

  procedure Print_Listing (
    Change_Code : in     CHARACTER;
    First_Old,
    Last_Old,
    First_New,
    Last_New    : in     Data_Ptr_Type;
    List_File   : in     TEXT_IO.FILE_TYPE) is

    Curr            : POSITIVE;
    Bool1,
    Bool2           : BOOLEAN;
    First_Old_Copy  : Data_Ptr_Type := First_Old;
    First_New_Copy  : Data_Ptr_Type := First_New;
  begin
    loop
      if First_Old_Copy = null then
        TEXT_IO.PUT (List_File, Change_Code & "      ");
      else
        TEXT_IO.PUT (List_File, Change_Code & Blank);
        Int_IO.PUT (List_File, First_Old_Copy.Line_Number,
          List_Line_Num_Max_Length);
        TEXT_IO.PUT (List_File, Blank);
      end if;

      Curr := 1;

      loop
        if First_Old_Copy = null then
          for I in 1 .. Text_Max_Length loop
            TEXT_IO.PUT (List_File, Blank);
          end loop;
        else
          for I in 1 .. Text_Max_Length loop
            if Curr + I - 1 > First_Old_Copy.Data_Line.Length then
              TEXT_IO.PUT (List_File, Blank);
            else
              TEXT_IO.PUT (List_File,
                First_Old_Copy.Data_Line.Line (Curr+I-1));
            end if;
          end loop;
        end if;

        TEXT_IO.PUT (List_File, " | ");

        if First_New_Copy /= null then
          for I in 1 .. Text_Max_Length loop
            if Curr + I - 1 > First_New_Copy.Data_Line.Length then
              TEXT_IO.PUT (List_File, Blank);
            else
              TEXT_IO.PUT (List_File,
                First_New_Copy.Data_Line.Line (Curr+I-1));
            end if;
          end loop;
        end if;

        Curr := Curr + Text_Max_Length;

        if First_Old_Copy = null then
          Bool1 := FALSE;
        else
          Bool1 := (Curr <= First_Old_Copy.Data_Line.Length);
        end if;

        if First_New_Copy = null then
          Bool2 := FALSE;
        else
          Bool2 := (Curr <= First_New_Copy.Data_Line.Length);
        end if;

        if Bool1 or Bool2 then
          TEXT_IO.NEW_LINE (List_File);
          TEXT_IO.PUT (List_File, "       ");
        end if;

        if First_Old_Copy = null then
          Bool1 := TRUE;
        else
          Bool1 := (Curr > First_Old_Copy.Data_Line.Length);
        end if;

        if First_New_Copy = null then
          Bool2 := TRUE;
        else
          Bool2 := (Curr > First_New_Copy.Data_Line.Length);
        end if;

        exit when Bool1 and Bool2;
      end loop;

      if First_New_Copy = null then
        for I in 1 .. Text_Max_Length loop
          TEXT_IO.PUT (List_File, Blank);
        end loop;

        TEXT_IO.PUT_LINE (List_File, "      " & Change_Code);
      else
        TEXT_IO.PUT (List_File, Blank);
        Int_IO.PUT (List_File, First_New_Copy.Line_Number,
          List_Line_Num_Max_Length);
        TEXT_IO.PUT_LINE (List_File, Blank & Change_Code);
      end if;

      exit when (First_Old_Copy = Last_Old) and
                (First_New_Copy = Last_New);

      if First_Old_Copy /= Last_Old then
        First_Old_Copy := First_Old_Copy.Next_Line;
      end if;

      if First_New_Copy /= Last_New then
        First_New_Copy := First_New_Copy.Next_Line;
      end if;
    end loop;
  end Print_Listing;
  ----------------------------------------------------------------------

  -- The following procedure converts lines of data to upper case.

  procedure Convert_to_Upper_Case (Line : in out Data_Line_Type) is
  begin
    for I in 1 .. Line.Length loop
      if Line.Line (I) in Set_of_Lower_Case_Letters then
        Line.Line (I) := CHARACTER'VAL (CHARACTER'POS (Line.Line (I)) -
          Uc_Lc_Offset);
      end if;
    end loop;
  end Convert_to_Upper_Case;
  ----------------------------------------------------------------------

  -- The following procedure maintains garbage collection for the package.

  procedure Dispose_Lines (
    First_Old,
    Last_Old,
    First_New,
    Last_New       : in     Data_Ptr_Type;
    Dispose_Record :    out Dispose_Record_Type) is

    procedure Do_Dispose (
      First_Ptr,
      Last_Ptr         : in     Data_Ptr_Type;
      Lines_to_Dispose :    out NATURAL) is

      Curr_Ptr         : Data_Ptr_Type;
    begin
      if First_Ptr = null then
        Lines_to_Dispose := 0;
      else
        Lines_to_Dispose := (Last_Ptr.Line_Number -
                             First_Ptr.Line_Number) + 1;

        if Free_List_Head = null then
          Free_List_Head := First_Ptr;
          Free_List_Tail := Last_Ptr;
        else
          Free_List_Tail.Next_Line := First_Ptr;
          Free_List_Tail := Last_Ptr;
        end if;

        Free_List_Tail.Next_Line := null;
      end if;
    end Do_Dispose;
  begin
    Do_Dispose (First_Old, Last_Old, Dispose_Record.Old_File);
    Do_Dispose (First_New, Last_New, Dispose_Record.New_File);
  end Dispose_Lines;
  ----------------------------------------------------------------------

  -- The following procedure prints statistics on the list file.

  procedure Print_Statistics (
    Statistics : in     Statistics_Type;
    Files      : in     Files_Type;
    List_File  : in     TEXT_IO.FILE_TYPE) is
  begin
    TEXT_IO.NEW_LINE (List_File);
    TEXT_IO.PUT_LINE (List_File, "FILE COMPARE statistics:");
    TEXT_IO.NEW_LINE (List_File);

    if Statistics.Number_Old_Lines = 0 then
      TEXT_IO.PUT_LINE (List_File, "Old file " &
        Files.Old_File_Name (1 .. Files.Old_File_Length) &
        " has no lines.");
    elsif Statistics.Number_Old_Lines = 1 then
      TEXT_IO.PUT_LINE (List_File, "Old file " &
        Files.Old_File_Name (1 .. Files.Old_File_Length) &
        " has 1 line.");
    else
      TEXT_IO.PUT_LINE (List_File, "Old file " &
        Files.Old_File_Name (1 .. Files.Old_File_Length) &
        " has" & NATURAL'IMAGE (Statistics.Number_Old_Lines) & " lines.");
    end if;

    if Statistics.Number_New_Lines = 0 then
      TEXT_IO.PUT_LINE (List_File, "New file " &
        Files.New_File_Name (1 .. Files.New_File_Length) &
        " has no lines.");
    elsif Statistics.Number_New_Lines = 1 then
      TEXT_IO.PUT_LINE (List_File, "New file " &
        Files.New_File_Name (1 .. Files.New_File_Length) &
        " has 1 line.");
    else
      TEXT_IO.PUT_LINE (List_File, "New file " &
        Files.New_File_Name (1 .. Files.New_File_Length) &
        " has" & NATURAL'IMAGE (Statistics.Number_New_Lines) & " lines.");
    end if;

    if Statistics.Files_Equal then
      TEXT_IO.PUT_LINE (List_File, "Files are equal.");
    else
      if Statistics.Total_Equal_Lines = 0 then
        TEXT_IO.PUT_LINE (List_File, "There were no equal lines.");
      elsif Statistics.Total_Equal_Lines = 1 then
        TEXT_IO.PUT_LINE (List_File, "There was 1 equal line.");
      else
        TEXT_IO.PUT_LINE (List_File, "There were" &
          NATURAL'IMAGE (Statistics.Total_Equal_Lines) & " equal lines.");
      end if;

      if Statistics.Total_Minor_Changes = 0 then
        TEXT_IO.PUT_LINE (List_File,
          "There were no lines with minor changes.");
      elsif Statistics.Total_Minor_Changes = 1 then
        TEXT_IO.PUT_LINE (List_File,
          "There was 1 line with minor changes.");
      else
        TEXT_IO.PUT_LINE (List_File, "There were" &
          NATURAL'IMAGE (Statistics.Total_Minor_Changes) &
          " lines with minor changes.");
      end if;

      if Statistics.Total_Insertions = 0 then
        TEXT_IO.PUT_LINE (List_File, "There were no lines inserted.");
      elsif Statistics.Total_Insertions = 1 then
        TEXT_IO.PUT_LINE (List_File, "There was 1 line inserted.");
      else
        TEXT_IO.PUT_LINE (List_File, "There were" &
          NATURAL'IMAGE (Statistics.Total_Insertions) & " lines inserted.");
      end if;

      if Statistics.Total_Deletions = 0 then
        TEXT_IO.PUT_LINE (List_File, "There were no lines deleted.");
      elsif Statistics.Total_Deletions = 1 then
        TEXT_IO.PUT_LINE (List_File, "There was 1 line deleted.");
      else
        TEXT_IO.PUT_LINE (List_File, "There were" &
          NATURAL'IMAGE (Statistics.Total_Deletions) & " lines deleted.");
      end if;
    end if;
  end Print_Statistics;
  ----------------------------------------------------------------------

  -- The following function performs a generic equality comparison of
  -- data lines.  It takes into account the option of a case
  -- insensitive compare operation.

  function Lines_Are_Equal (
    Line1,
    Line2          : in     Data_Line_Type;
    Case_Sensitive : in     BOOLEAN) return BOOLEAN is

    Line1_Copy : Data_Line_Type := Line1;
    Line2_Copy : Data_Line_Type := Line2;
  begin
    if not Case_Sensitive then
      Convert_to_Upper_Case (Line1_Copy);
      Convert_to_Upper_Case (Line2_Copy);
    end if;

    return Line1_Copy.Line (1 .. Line1_Copy.Length) =
           Line2_Copy.Line (1 .. Line2_Copy.Length);
  end Lines_Are_Equal;

  -- The following procedure analyzes the files, looking for
  -- equal lines (synchronization points).  If the current lines
  -- are not equal, it simply terminates.  Otherwise it keeps
  -- looking until it finds lines that differ.

  procedure Analyze_Equal (
    Options            : in     Options_Type;
    List_File,
    Deck_File          : in     TEXT_IO.FILE_TYPE;
    Old_File_Head_Ptr,
    New_File_Head_Ptr  : in out Data_Ptr_Type;
    Tot_Equal_Lines    : in out NATURAL;
    Found              :    out BOOLEAN;
    Dispose_Record     :    out Dispose_Record_Type) is

    First_Old,
    First_New,
    Last_Old,
    Last_New             : Data_Ptr_Type;
    Local_Dispose_Record : Dispose_Record_Type := (0, 0);

    -- The following inner procedure outputs a group of equal
    -- lines to the list file.

    procedure Print_Summary_Equal (
      First_Old,
      Last_Old,
      First_New,
      Last_New   : in     Data_Ptr_Type) is
    begin
      Print_Listing (Equal_Lines_Code, First_Old, First_Old, First_New,
        First_New, List_File);

      if (First_Old.Line_Number + 1) < Last_Old.Line_Number then
        TEXT_IO.PUT (List_File, Equal_Lines_Code & Blank);

        for I in 1 .. Text_Max_Length - 2 loop
          TEXT_IO.PUT (List_File, Equal_Lines_Code);
        end loop;

        Int_IO.PUT (List_File,
          (Last_Old.Line_Number - First_Old.Line_Number - 1),
          List_Line_Num_Max_Length);
        TEXT_IO.PUT (List_File, " equal line");

        if (Last_Old.Line_Number - First_Old.Line_Number - 1) = 1 then
          TEXT_IO.PUT (List_File, Blank);
        else
          TEXT_IO.PUT (List_File, 's');
        end if;

        TEXT_IO.PUT (List_File, Blank);

        for I in 1 .. Text_Max_Length - 2 loop
          TEXT_IO.PUT (List_File, Equal_Lines_Code);
        end loop;

        TEXT_IO.PUT_LINE (List_File, Blank & Equal_Lines_Code);
      end if;

      if First_Old /= Last_Old then
        Print_Listing (Equal_Lines_Code, Last_Old, Last_Old, Last_New,
          Last_New, List_File);
      end if;
    end Print_Summary_Equal;

    -- The following inner procedure outputs a Copy command
    -- to the deck file.

    procedure Cdupdate_Equal (
      First_Old,
      Last_Old   : in     Data_Ptr_Type) is
    begin
      if Options.Verbose_Deck then
        TEXT_IO.PUT (Deck_File, Command_Code &
          Case_Conversion("Copy   ", Options.Deck_Command_Case));
      else
        TEXT_IO.PUT (Deck_File, Command_Code &
          Case_Conversion("C ", Options.Deck_Command_Case));
      end if;

      Int_IO.PUT (Deck_File,
        First_Old.Line_Number, List_Line_Num_Max_Length);

      if First_Old /= Last_Old then
        if Options.Verbose_Deck then
          TEXT_IO.PUT (Deck_File, " .. ");
        else
          TEXT_IO.PUT (Deck_File, Blank);
        end if;

        Int_IO.PUT (Deck_File,
          Last_Old.Line_Number, List_Line_Num_Max_Length);
      end if;

      TEXT_IO.NEW_LINE (Deck_File);
    end Cdupdate_Equal;
  begin  -- Analyze_Equal
    if not Lines_Are_Equal (Old_File_Head_Ptr.Data_Line,
             New_File_Head_Ptr.Data_Line, Options.Case_Sensitive) then
      Found := FALSE;  -- current lines are different
    else
      Found := TRUE;  -- current lines equal, keep looking below

      First_Old := Old_File_Head_Ptr;
      First_New := New_File_Head_Ptr;

      loop  -- iterate until lines differ
        Last_Old := Old_File_Head_Ptr;
        Last_New := New_File_Head_Ptr;

        Old_File_Head_Ptr := Old_File_Head_Ptr.Next_Line;
        New_File_Head_Ptr := New_File_Head_Ptr.Next_Line;

        exit when ((Old_File_Head_Ptr = null) or
                   (New_File_Head_Ptr = null)) or else
                  (not Lines_Are_Equal (Old_File_Head_Ptr.Data_Line,
                    New_File_Head_Ptr.Data_Line, Options.Case_Sensitive));
      end loop;

      if Options.Produce_Statistics then
        Tot_Equal_Lines := Tot_Equal_Lines +
          (Last_New.Line_Number - First_New.Line_Number + 1);
      end if;

      if Options.Produce_Listing then
        if Options.Summarize and
           (Last_New.Line_Number - First_New.Line_Number + 1 >=
            Options.Minimum_Group) then
          Print_Summary_Equal (First_Old, Last_Old, First_New,
            Last_New);
        else
          Print_Listing (Equal_Lines_Code, First_Old, Last_Old, First_New,
            Last_New, List_File);
        end if;
      end if;

      if Options.Produce_Deck then
        Cdupdate_Equal (First_Old, Last_Old);
      end if;

      Dispose_Lines (First_Old, Last_Old, First_New, Last_New,
        Local_Dispose_Record);
    end if;

    Dispose_Record := Local_Dispose_Record;
  end Analyze_Equal;
  ----------------------------------------------------------------------

  -- The following procedure finds a minor change in the current
  -- lines, and returns the position and type of minor change
  -- found.  If no minor change is found, the position 0 is returned.

  -- The minor change algorithms were originally written by Spencer
  -- Peterson, in Pascal pseudo-code.  The author has adopted and
  -- slightly modified these algorithms.

  procedure Minor_Change (
    Case_Sensitive : in     BOOLEAN;
    Str1,
    Str2           : in     Data_Line_Type;
    Pos            :    out NATURAL;
    Result         :    out Minor_Change_Found_Type) is

    Local_Result : Minor_Change_Found_Type;
    Str1_Copy    : Data_Line_Type := Str1;
    Str2_Copy    : Data_Line_Type := Str2;

    -- The following inner procedure finds a one character difference
    -- in the current lines.

    procedure Find_One_Char (
      Str1,
      Str2  : in     Data_Line_Type;
      Pos   :    out NATURAL;
      Found :    out BOOLEAN) is

      Count1,
      Count2,
      Diff_Count : NATURAL;
    begin
      Count1 := 1;
      Count2 := 1;
      Diff_Count := 0;
      Pos := 0;

      while (Diff_Count < 2) and (Count1 <= Str1.Length) loop
        if Str1.Line (Count1) /= Str2.Line (Count2) then
          if Diff_Count = 1 then
            Diff_Count := 2;
            Pos := 0;
          else
            Pos := Count2;
            Count2 := Count2 + 1;
            Diff_Count := 1;
          end if;
        else
          Count1 := Count1 + 1;
          Count2 := Count2 + 1;
        end if;
      end loop;

      if Diff_Count = 0 then
        Diff_Count := 1;
        Pos := Str2.Length;
      end if;

      Found := Diff_Count = 1;
    end Find_One_Char;

    -- The following inner procedure finds a one-character insertion
    -- in the current lines.

    procedure One_Char_Insert (
      Str1,
      Str2   : in     Data_Line_Type;
      Pos    :    out NATURAL;
      Result :    out Minor_Change_Found_Type) is

      Local_Pos : NATURAL;
      Found     : BOOLEAN;
    begin
      Find_One_Char (Str1, Str2, Local_Pos, Found);
      Pos := Local_Pos;

      if not Found then
        Result := No_Minor_Change_Found;
      else
        Old_Delimiter := Squote;

        if Str2.Line (Local_Pos) = Squote then
          New_Delimiter := Dquote;
        else
          New_Delimiter := Squote;
        end if;

        Result := Insertion_Found;
      end if;
    end One_Char_Insert;

    -- The following inner procedure finds a one-character deletion
    -- in the current lines.

    procedure One_Char_Delete (
      Str1,
      Str2   : in     Data_Line_Type;
      Pos    :    out NATURAL;
      Result :    out Minor_Change_Found_Type) is

      Local_Pos    : NATURAL;
      Found        : BOOLEAN;
    begin
      Find_One_Char (Str2, Str1, Local_Pos, Found);
      Pos := Local_Pos;

      if not Found then
        Result := No_Minor_Change_Found;
      else
        New_Delimiter := Squote;

        if Str1.Line (Local_Pos) = Squote then
          Old_Delimiter := Dquote;
        else
          Old_Delimiter := Squote;
        end if;

        Result := Deletion_Found;
      end if;
    end One_Char_Delete;

    -- The following inner procedure finds a one character replacement
    -- in the current lines.

    procedure One_Char_Replace (
      Str1,
      Str2   : in     Data_Line_Type;
      Pos    :    out NATURAL;
      Result :    out Minor_Change_Found_Type) is

      Count,
      Diff_Count,
      Local_Pos   : NATURAL;
    begin
      Count := 1;
      Diff_Count := 0;
      Local_Pos := 0;

      while (Diff_Count < 2) and (Count <= Str1.Length) loop
        if Str1.Line (Count) /= Str2.Line (Count) then
          Diff_Count := Diff_Count + 1;
          Local_Pos := Count;
        end if;

        Count := Count + 1;
      end loop;

      Pos := Local_Pos;

      if Diff_Count /= 1 then
        Result := No_Minor_Change_Found;
      else
        if Str1.Line (Local_Pos) = Squote then
          Old_Delimiter := Dquote;
        else
          Old_Delimiter := Squote;
        end if;

        if Str2.Line (Local_Pos) = Squote then
          New_Delimiter := Dquote;
        else
          New_Delimiter := Squote;
        end if;

        Result := Replacement_Found;
      end if;
    end One_Char_Replace;

    -- The following inner procedure finds a two-character
    -- transposition in the current lines.  Since only two
    -- delimiters for the Edit command are supported (single
    -- quote and double quote), a special case is needed to see
    -- if these two characters are being transposed.

    procedure Two_Char_Transpose (
      Str1,
      Str2   : in     Data_Line_Type;
      Pos    :    out NATURAL;
      Result :    out Minor_Change_Found_Type) is

      I,
      Diff_Count,
      Local_Pos   : NATURAL := 0;
      Found,
      Mismatched : BOOLEAN;

      -- The following inner function checks for the delimiter
      -- special-case transposition.

      function Both_Quotes_Found (
        Line : in     Data_Line_Type;
        Pos  : in     NATURAL) return BOOLEAN is

        Found_Squote,
        Found_Dquote  : BOOLEAN;
      begin
        Found_Squote := FALSE;
        Found_Dquote := FALSE;

        for I in Pos .. Pos + 1 loop
          if Line.Line (I) = Squote then
            Found_Squote := TRUE;
          elsif Line.Line (I) = Dquote then
            Found_Dquote := TRUE;
          end if;
        end loop;

        return (Found_Squote and Found_Dquote);
      end Both_Quotes_Found;
    begin  -- Two_Char_Transpose
      Found := FALSE;
      Mismatched := FALSE;
      I := 1;

      while I < Str1.Length loop
        if Str1.Line (I) /= Str2.Line (I) then
          if Found then
            Mismatched := TRUE;
            exit;
          elsif (Str1.Line (I) = Str2.Line (I+1)) and
                (Str1.Line (I+1) = Str2.Line (I)) then
            Local_Pos := I;
            Found := TRUE;
            I := I + 1;
          else
            Mismatched := TRUE;
            exit;
          end if;
        end if;

        I := I + 1;
      end loop;

      Pos := Local_Pos;

      if ((not Found) or Mismatched) or else
         (Both_Quotes_Found (Str1, Local_Pos) or
          Both_Quotes_Found (Str2, Local_Pos)) then
        Result := No_Minor_Change_Found;
      else
        if (Str1.Line (Local_Pos) = Squote) or
           (Str1.Line (Local_Pos+1) = Squote) then
          Old_Delimiter := Dquote;
        else
          Old_Delimiter := Squote;
        end if;

        if (Str2.Line (Local_Pos) = Squote) or
           (Str2.Line (Local_Pos+1) = Squote) then
          New_Delimiter := Dquote;
        else
          New_Delimiter := Squote;
        end if;

        Result := Transposition_Found;
      end if;
    end Two_Char_Transpose;
  begin  -- Minor_Change
    if Case_Sensitive then
      Convert_to_Upper_Case (Str1_Copy);
      Convert_to_Upper_Case (Str2_Copy);
    end if;

    -- Find a minor change.  Try all appropriate possibilities.

    if abs (Str1_Copy.Length - Str2_Copy.Length) > 1 then
      Result := No_Minor_Change_Found;
      Pos := 0;
    elsif Str1_Copy.Length < Str2_Copy.Length then
      One_Char_Insert (Str1_Copy, Str2_Copy, Pos, Result);
    elsif Str1_Copy.Length > Str2_Copy.Length then
      One_Char_Delete (Str1_Copy, Str2_Copy, Pos, Result);
    else
      One_Char_Replace (Str1_Copy, Str2_Copy, Pos, Local_Result);

      if Local_Result = No_Minor_Change_Found then
        Two_Char_Transpose (Str1_Copy, Str2_Copy, Pos, Result);
      else
        Result := Local_Result;
      end if;
    end if;
  end Minor_Change;
  ----------------------------------------------------------------------

  -- The following function simply returns TRUE if the current lines
  -- contain a minor change, and FALSE otherwise.  It is used as an
  -- iteration terminator for other analysis routines.

  function Find_Minor_Change_Only (
    Old_Line,
    New_Line  : in Data_Line_Type;
    Options   : in Options_Type) return BOOLEAN is

    Dummy_Pos : NATURAL;
    Result    : Minor_Change_Found_Type;
  begin
    if not Options.Check_Minor_Changes then
      return FALSE;
    else
      Minor_Change (Options.Case_Sensitive, Old_line, New_Line, Dummy_Pos,
        Result);

      return Result /= No_Minor_Change_Found;
    end if;
  end Find_Minor_Change_Only;
  ----------------------------------------------------------------------

  -- The following procedure analyzes and processes all minor change
  -- requests.

  procedure Analyze_Minor_Change (
    Options            : in     Options_Type;
    List_File,
    Deck_File          : in     TEXT_IO.FILE_TYPE;
    Old_File_Head_Ptr,
    New_File_Head_Ptr  : in out Data_Ptr_Type;
    Tot_Minor_Changes  : in out NATURAL;
    Found              :    out BOOLEAN;
    Dispose_Record     :    out Dispose_Record_Type) is

    Pos                  : NATURAL;
    Minor_Change_Found   : Minor_Change_Found_Type;
    Curr_Old,
    Curr_New             : Data_Ptr_Type;
    Local_Found          : BOOLEAN;
    Local_Dispose_Record : Dispose_Record_Type := (0, 0);

    -- The following inner procedure emits an Edit command on the
    -- deck file.

    procedure Cdupdate_Minor_Change (
      Old_File_Head_Ptr,
      New_File_Head_Ptr  : in     Data_Ptr_Type;
      Minor_Change_Found : in     Minor_Change_Found_Type;
      Pos                : in     NATURAL) is

      procedure Print_Chars_in_Quotes (
        Str                : in     Data_Line_Type;
        Pos,
        Num_Chars_to_Print : in     NATURAL) is
      begin
        for I in 1 .. Num_Chars_to_Print loop
          TEXT_IO.PUT (Deck_File, Str.Line (I+Pos-1));
        end loop;
      end Print_Chars_in_Quotes;
    begin
      if Options.Verbose_Deck then
        TEXT_IO.PUT (Deck_File, Command_Code &
          Case_Conversion("Edit   ", Options.Deck_Command_Case));
      else
        TEXT_IO.PUT (Deck_File, Command_Code &
          Case_Conversion("Ed ", Options.Deck_Command_Case));
      end if;

      Int_IO.PUT (Deck_File,
        Old_File_Head_Ptr.Line_Number, List_Line_Num_Max_Length);

      if Options.Verbose_Deck then
        TEXT_IO.PUT (Deck_File,
          Case_Conversion(" At ", Options.Deck_Command_Case));
      else
        TEXT_IO.PUT (Deck_File, Blank);
      end if;

      Int_IO.PUT (Deck_File, Pos, 3);
      TEXT_IO.PUT (Deck_File, Blank & Old_Delimiter);

      case Minor_Change_Found is
        when Deletion_Found | Replacement_Found =>
          Print_Chars_in_Quotes (Old_File_Head_Ptr.Data_Line, Pos, 1);
        when Transposition_Found =>
          Print_Chars_in_Quotes (Old_File_Head_Ptr.Data_Line, Pos, 2);
        when others =>
          null;
      end case;

      if Options.Verbose_Deck then
        TEXT_IO.PUT (Deck_File, Old_Delimiter &
          Case_Conversion(" Becomes ", Options.Deck_Command_Case) & New_Delimiter);
      else
        TEXT_IO.PUT (Deck_File, Old_Delimiter & Blank & New_Delimiter);
      end if;

      case Minor_Change_Found is
        when Insertion_Found | Replacement_Found =>
          Print_Chars_in_Quotes (New_File_Head_Ptr.Data_Line, Pos, 1);
        when Transposition_Found =>
          Print_Chars_in_Quotes (New_File_Head_Ptr.Data_Line, Pos, 2);
        when others => null;
      end case;

      TEXT_IO.PUT (Deck_File, New_Delimiter);
      TEXT_IO.NEW_LINE (Deck_File);
    end Cdupdate_Minor_Change;
  begin  -- Analyze_Minor_Change
    -- Determine if a minor change exists

    if not Options.Check_Minor_Changes then
      Local_Found := FALSE;
    else
      Minor_Change (Options.Case_Sensitive, Old_File_Head_Ptr.Data_Line,
        New_File_Head_Ptr.Data_Line, Pos, Minor_Change_Found);

      Local_Found := (Minor_Change_Found /= No_Minor_Change_Found);
    end if;

    Found := Local_Found;

    -- If a minor change has been located, process it below.

    if Local_Found then
      if Options.Produce_Statistics then
        Tot_Minor_Changes := Tot_Minor_Changes + 1;
      end if;

      if Options.Produce_Listing then
        Print_Listing (Minor_Change_Code, Old_File_Head_Ptr, Old_File_Head_Ptr,
          New_File_Head_Ptr, New_File_Head_Ptr, List_File);
      end if;

      if Options.Produce_Deck then
        Cdupdate_Minor_Change (Old_File_Head_Ptr, New_File_Head_Ptr,
          Minor_Change_Found, Pos);
      end if;

      Curr_Old := Old_File_Head_Ptr;
      Curr_New := New_File_Head_Ptr;

      Old_File_Head_Ptr := Old_File_Head_Ptr.Next_Line;
      New_File_Head_Ptr := New_File_Head_Ptr.Next_Line;

      Dispose_Lines (Curr_Old, Curr_Old, Curr_New, Curr_New,
        Local_Dispose_Record);
    end if;

    Dispose_Record := Local_Dispose_Record;
  end Analyze_Minor_Change;
  ----------------------------------------------------------------------

  -- The following procedure analyzes and processes all insertion
  -- requests.

  procedure Analyze_Insertion (
    At_Tail_of_Old,
    At_Tail_of_New    : in     BOOLEAN;
    Options           : in     Options_Type;
    List_File,
    Deck_File         : in     TEXT_IO.FILE_TYPE;
    Old_File_Head_Ptr : in     Data_Ptr_Type;
    New_File_Head_Ptr : in out Data_Ptr_Type;
    Tot_Insertions    : in out NATURAL;
    Found             :    out BOOLEAN;
    Dispose_Record    : in out Dispose_Record_Type) is

    First_New,
    Last_New,
    Next_New             : Data_Ptr_Type;
    Local_Dispose_Record : Dispose_Record_Type := (0, 0);

    -- The following inner procedure outputs a group of insertions
    -- to the list file.

    procedure Print_Summary_Insertion (
      First_New,
      Last_New   : in     Data_Ptr_Type) is
    begin
      Print_Listing (Insertion_Code, null, null, First_New, First_New,
        List_File);

      if (First_New.Line_Number + 1) < Last_New.Line_Number then
        TEXT_IO.PUT (List_File, Insertion_Code & Blank);

        for I in 1 .. Text_Max_Length - 2 loop
          TEXT_IO.PUT (List_File, Insertion_Code);
        end loop;

        Int_IO.PUT (List_File,
          (Last_New.Line_Number - First_New.Line_Number - 1),
          List_Line_Num_Max_Length);
        TEXT_IO.PUT (List_File, " inserted line");

        if (Last_New.Line_Number - First_New.Line_Number - 1) = 1 then
          TEXT_IO.PUT (List_File, Blank);
        else
          TEXT_IO.PUT (List_File, 's');
        end if;

        TEXT_IO.PUT (List_File, Blank);

        for I in 1 .. Text_Max_Length - 5 loop
          TEXT_IO.PUT (List_File, Insertion_Code);
        end loop;

        TEXT_IO.PUT_LINE (List_File, Blank & Insertion_Code);
      end if;

      if First_New /= Last_New then
        Print_Listing (Insertion_Code, null, null, Last_New, Last_New,
          List_File);
      end if;
    end Print_Summary_Insertion;

    -- The following inner procedure emits insertion lines to the
    -- deck file.  If an insertion line begins with the same character
    -- as Command_Code, then an extra Command_Code character is
    -- emitted at the beginning (so that the CDUPDATE utility can
    -- distinguish it from a normal command).

    procedure Cdupdate_Insertion (
      First_New,
      Last_New   : in     Data_Ptr_Type) is

      Local_First_New : Data_Ptr_Type := First_New;
    begin
      loop
        if (Local_First_New.Data_Line.Length /= 0) and then
           (Local_First_New.Data_Line.Line (1) = Command_Code) then
          TEXT_IO.PUT (Deck_File, Command_Code);
        end if;

        TEXT_IO.PUT_LINE (Deck_File,
          Local_First_New.Data_Line.Line (1 ..
          Local_First_New.Data_Line.Length));

        if Local_First_New = Last_New then
          exit;
        end if;

        Local_First_New := Local_First_New.Next_Line;
      end loop;
    end Cdupdate_Insertion;
  begin  -- Analyze_Insertion
    -- Two cases: if the old file is exhausted, then an insertion
    -- definitely exists; else analysis must be performed.

    if Old_File_Head_Ptr = null then
      Found := TRUE;

      First_New := New_File_Head_Ptr;
      Last_New := New_File_Head_Ptr;
      New_File_Head_Ptr := null;

      while Last_New.Next_Line /= null loop
        Last_New := Last_New.Next_Line;
      end loop;

      if Options.Produce_Statistics then
        Tot_Insertions := Tot_Insertions +
          (Last_New.Line_Number - First_New.Line_Number + 1);
      end if;

      if Options.Produce_Listing then
        if Options.Summarize and
           (Last_New.Line_Number - First_New.Line_Number + 1 >=
            Options.Minimum_Group) then
          Print_Summary_Insertion (First_New, Last_New);
        else
          Print_Listing (Insertion_Code, null, null, First_New, Last_New,
            List_File);
        end if;
      end if;

      if Options.Produce_Deck then
        Cdupdate_Insertion (First_New, Last_New);
      end if;

      Dispose_Lines (null, null, First_New, Last_New, Local_Dispose_Record);
    else
      First_New := New_File_Head_Ptr;
      Last_New  := New_File_Head_Ptr;
      Next_New  := Last_New.Next_Line;

      while Next_New /= null loop
        if Lines_Are_Equal (Old_File_Head_Ptr.Data_Line,
             Next_New.Data_Line, Options.Case_Sensitive) or
           Find_Minor_Change_Only (Old_File_Head_Ptr.Data_Line,
             Next_New.Data_Line, Options) then
          exit;
        end if;

        Last_New := Next_New;
        Next_New := Next_New.Next_Line;
      end loop;

      if ((Next_New = null) and (not At_Tail_of_Old)) or
         ((Next_New = null) and (At_Tail_of_New)) then
        Found := FALSE;
      else
        Found := TRUE;

        New_File_Head_Ptr := Next_New;

        if Options.Produce_Statistics then
          Tot_Insertions := Tot_Insertions +
            (Last_New.Line_Number - First_New.Line_Number + 1);
        end if;

        if Options.Produce_Listing then
          if Options.Summarize and
             (Last_New.Line_Number - First_New.Line_Number + 1 >=
              Options.Minimum_Group) then
            Print_Summary_Insertion (First_New, Last_New);
          else
            Print_Listing (Insertion_Code, null, null, First_New, Last_New,
              List_File);
          end if;
        end if;

        if Options.Produce_Deck then
          Cdupdate_Insertion (First_New, Last_New);
        end if;

        Dispose_Lines (null, null, First_New, Last_New, Local_Dispose_Record);
      end if;
    end if;

    Dispose_Record := Local_Dispose_Record;
  end Analyze_Insertion;
  ----------------------------------------------------------------------

  -- The following procedure analyzes and processes all deletion
  -- requests.  This routine is only called when the current line
  -- is definitely known to be a deletion.

  procedure Analyze_Deletion (
    Options           : in     Options_Type;
    List_File,
    Deck_File         : in     TEXT_IO.FILE_TYPE;
    Old_File_Head_Ptr : in out Data_Ptr_Type;
    New_File_Head_Ptr : in     Data_Ptr_Type;
    Tot_Deletions     : in out NATURAL;
    Dispose_Record    :    out Dispose_Record_Type) is

    First_Old,
    Last_Old,
    Prev_Old,
    Curr_New             : Data_Ptr_Type;
    Local_Dispose_Record : Dispose_Record_Type := (0, 0);

    -- The following inner procedure outputs a group of deleted lines
    -- to the list file.

    procedure Print_Summary_Deletion (
      First_Old,
      Last_Old   : in     Data_Ptr_Type) is
    begin
      Print_Listing (Deletion_Code, First_Old, First_Old, null, null,
        List_File);

      if (First_Old.Line_Number + 1) < Last_Old.Line_Number then
        TEXT_IO.PUT (List_File, Deletion_Code & Blank);

        for I in 1 .. Text_Max_Length - 2 loop
          TEXT_IO.PUT (List_File, Deletion_Code);
        end loop;

        Int_IO.PUT (List_File,
          (Last_Old.Line_Number - First_Old.Line_Number - 1),
          List_Line_Num_Max_Length);
        TEXT_IO.PUT (List_File, " deleted line");

        if (Last_Old.Line_Number - First_Old.Line_Number - 1) = 1 then
          TEXT_IO.PUT (List_File, Blank);
        else
          TEXT_IO.PUT (List_File, 's');
        end if;

        TEXT_IO.PUT (List_File, Blank & Deletion_Code);

        for I in 1 .. Text_Max_Length - 5 loop
          TEXT_IO.PUT (List_File, Deletion_Code);
        end loop;

        TEXT_IO.PUT_LINE (List_File, Blank & Deletion_Code);
      end if;

      if First_Old /= Last_Old then
        Print_Listing (Deletion_Code, Last_Old, Last_Old, null, null,
          List_File);
      end if;
    end Print_Summary_Deletion;

    -- The following inner procedure emits a Delete command to
    -- the deck file.  This procedure is only called when the
    -- Verbose_Deck option is requested.

    procedure Cdupdate_Deletion (
      First_Old,
      Last_Old   : in     Data_Ptr_Type) is
    begin
      TEXT_IO.PUT (Deck_File, Command_Code &
        Case_Conversion("Delete ", Options.Deck_Command_Case));
      Int_IO.PUT (Deck_File,
        First_Old.Line_Number, List_Line_Num_Max_Length);

      if First_Old /= Last_Old then
        TEXT_IO.PUT (Deck_File, " .. ");
        Int_IO.PUT (Deck_File,
          Last_Old.Line_Number, List_Line_Num_Max_Length);
      end if;

      TEXT_IO.NEW_LINE (Deck_File);
    end Cdupdate_Deletion;
  begin  -- Analyze_Deletion
    if New_File_Head_Ptr = null then
      First_Old := Old_File_Head_Ptr;
      Last_Old := Old_File_Head_Ptr;
      Old_File_Head_Ptr := null;

      while Last_Old.Next_Line /= null loop
        Last_Old := Last_Old.Next_Line;
      end loop;

      if Options.Produce_Statistics then
        Tot_Deletions := Tot_Deletions +
          (Last_Old.Line_Number - First_Old.Line_Number + 1);
      end if;

      if Options.Produce_Listing then
        if Options.Summarize and
           (Last_Old.Line_Number - First_Old.Line_Number + 1 >=
            Options.Minimum_Group) then
          Print_Summary_Deletion (First_Old, Last_Old);
        else
          Print_Listing (Deletion_Code, First_Old, Last_Old, null, null,
            List_File);
        end if;
      end if;

      if Options.Produce_Deck and Options.Verbose_Deck then
        Cdupdate_Deletion (First_Old, Last_Old);
      end if;

      Dispose_Lines (First_Old, Last_Old, null, null, Local_Dispose_Record);
    else
      First_Old := Old_File_Head_Ptr;
      Last_Old  := Old_File_Head_Ptr;
      Prev_Old  := Old_File_Head_Ptr;
      Curr_New  := New_File_Head_Ptr;

      Outer_While_Loop :  -- used to distinguish between the inner loop below
      while (Curr_New /= null) loop
        if Lines_Are_Equal (Last_Old.Data_Line, Curr_New.Data_Line,
             Options.Case_Sensitive) or
           Find_Minor_Change_Only (Last_Old.Data_Line,
             Curr_New.Data_Line, Options) then
           exit;
        end if;

        while Last_Old.Next_Line /= null loop
          Prev_Old := Last_Old;
          Last_Old := Last_Old.Next_Line;

          if Lines_Are_Equal (Last_Old.Data_Line, Curr_New.Data_Line,
               Options.Case_Sensitive) or
             Find_Minor_Change_Only (Last_Old.Data_Line,
               Curr_New.Data_Line, Options) then
            exit Outer_While_Loop;
          end if;
        end loop;

        Curr_New := Curr_New.Next_Line;
        Last_Old := Old_File_Head_Ptr;
        Prev_Old := Old_File_Head_Ptr;
      end loop Outer_While_Loop;

      if Curr_New /= null then
        Old_File_Head_Ptr := Last_Old;
        Last_Old := Prev_Old;
      else
        Old_File_Head_Ptr := null;

        while Last_Old.Next_Line /= null loop
          Last_Old := Last_Old.Next_Line;
        end loop;
      end if;

      if Options.Produce_Statistics then
        Tot_Deletions := Tot_Deletions +
          (Last_Old.Line_Number - First_Old.Line_Number + 1);
      end if;

      if Options.Produce_Listing then
        if Options.Summarize and
           (Last_Old.Line_Number - First_Old.Line_Number + 1 >=
            Options.Minimum_Group) then
          Print_Summary_Deletion (First_Old, Last_Old);
        else
          Print_Listing (Deletion_Code, First_Old, Last_Old, null, null,
            List_File);
        end if;
      end if;

      if Options.Produce_Deck and Options.Verbose_Deck then
        Cdupdate_Deletion (First_Old, Last_Old);
      end if;

      Dispose_Lines (First_Old, Last_Old, null, null, Local_Dispose_Record);
    end if;

    Dispose_Record := Local_Dispose_Record;
  end Analyze_Deletion;

  -- The following procedure assigns file names to strings used
  -- internally in this package body.  This complicated assignment
  -- is required due to the nature of strings in Ada (length bounds
  -- checks).

  procedure Assign (
    In_File  : in     STRING;
    Out_File : in out STRING;
    Length   :    out NATURAL) is

    In_Last  : INTEGER := In_File'LAST;
  begin
    if In_File'LENGTH > Out_File'LENGTH then
      Out_File := In_File (In_File'FIRST .. In_File'FIRST +
        Out_File'LENGTH - 1);
      Length := Out_File'LENGTH;
    else
      Out_File (1 .. In_File'LENGTH) := In_File;
      Length := In_File'LENGTH;
    end if;
  end Assign;
  ----------------------------------------------------------------------

  -- The following procedure acts as a supervisor for comparing two
  -- files.  It controls the complete iteration.

  procedure Compare_File (
    Options    : in     Options_Type;
    Old_File,
    New_File,
    List_File,
    Deck_File  : in     TEXT_IO.FILE_TYPE;
    Files      : in out Files_Type;
    Statistics :    out Statistics_Type) is

    Old_File_Head_Ptr,
    New_File_Head_Ptr  : Data_Ptr_Type := null;
    Dispose_Record     : Dispose_Record_Type :=
      (Options.Lookahead, Options.Lookahead);
    Stats              : Statistics_Type := (TRUE, 1, 1, 0, 0, 0, 0);

    -- The following inner procedure acts as a driver for analysis
    -- of the current lines.

    procedure Analyze_Lines (
      Options            : in     Options_Type;
      Old_File_Head_Ptr,
      New_File_Head_Ptr  : in out Data_Ptr_Type;
      Statistics         : in out Statistics_Type;
      Dispose_Record     : in out Dispose_Record_Type) is

      Found : BOOLEAN;
    begin
      if Old_File_Head_Ptr = null then
        Analyze_Insertion (TEXT_IO.END_OF_FILE (Old_File),
          TEXT_IO.END_OF_FILE (New_File), Options, List_File,
          Deck_File, Old_File_Head_Ptr, New_File_Head_Ptr,
          Statistics.Total_Insertions, Found, Dispose_Record);
      elsif New_File_Head_Ptr = null then
        Analyze_Deletion (Options, List_File, Deck_File, Old_File_Head_Ptr,
          New_File_Head_Ptr, Statistics.Total_Deletions, Dispose_Record);
      else
        Analyze_Equal (Options, List_File, Deck_File, Old_File_Head_Ptr,
          New_File_Head_Ptr, Statistics.Total_Equal_Lines, Found,
          Dispose_Record);

        if not Found then
          Analyze_Minor_Change (Options, List_File, Deck_File,
            Old_File_Head_Ptr, New_File_Head_Ptr,
            Statistics.Total_Minor_Changes, Found, Dispose_Record);

          if not Found then
            Analyze_Insertion (TEXT_IO.END_OF_FILE (Old_File),
              TEXT_IO.END_OF_FILE (New_File), Options, List_File,
              Deck_File, Old_File_Head_Ptr, New_File_Head_Ptr,
              Statistics.Total_Insertions, Found, Dispose_Record);

            if not Found then
              Analyze_Deletion (Options, List_File, Deck_File,
                Old_File_Head_Ptr, New_File_Head_Ptr,
                Statistics.Total_Deletions, Dispose_Record);
            end if;
          end if;
        end if;
      end if;
    end Analyze_Lines;
  begin  -- Compare_File
    Headings (Options, List_File, Deck_File, Files);

    Read_File (Dispose_Record.Old_File, Old_File,
      Stats.Number_Old_Lines, Old_File_Head_Ptr);

    Read_File (Dispose_Record.New_File, New_File,
      Stats.Number_New_Lines, New_File_Head_Ptr);

    while (Old_File_Head_Ptr /= null) or
          (New_File_Head_Ptr /= null) loop
      Analyze_Lines (Options, Old_File_Head_Ptr, New_File_Head_Ptr,
        Stats, Dispose_Record);

      Read_File (Dispose_Record.Old_File, Old_File,
        Stats.Number_Old_Lines, Old_File_Head_Ptr);

      Read_File (Dispose_Record.New_File, New_File,
        Stats.Number_New_Lines, New_File_Head_Ptr);
    end loop;

    if Options.Produce_Deck then
      if Options.Verbose_Deck then
        TEXT_IO.PUT_LINE (Deck_File, Command_Code &
          Case_Conversion ("End", Options.Deck_Command_Case));
      else
        TEXT_IO.PUT_LINE (Deck_File, Command_Code &
          Case_Conversion ("En", Options.Deck_Command_Case));
      end if;
    end if;

    if not Options.Produce_Statistics then
      Stats.Number_Old_Lines := 0;
      Stats.Number_New_Lines := 0;
    else
      Stats.Files_Equal := (Stats.Total_Minor_Changes +
        Stats.Total_Insertions + Stats.Total_Deletions) = 0;
      Stats.Number_Old_Lines := Stats.Number_Old_Lines - 1;
      Stats.Number_New_Lines := Stats.Number_New_Lines - 1;

      if Options.Produce_Listing then
        Print_Statistics (Stats, Files, List_File);
      end if;
    end if;

    Statistics := Stats;
  end Compare_File;
  ----------------------------------------------------------------------

  -- The following procedure acts as a supervisor for the quick
  -- compare operation.

  procedure Quick_Compare_File (
    Case_Sensitive : in     BOOLEAN;
    Old_File,
    New_File       : in     TEXT_IO.FILE_TYPE;
    Files_Equal    :    out BOOLEAN) is

    Old_Line,
    New_Line    : Line_Type;
    Old_Length,
    New_Length  : NATURAL;
  begin
    while (not TEXT_IO.END_OF_FILE (Old_File)) and
          (not TEXT_IO.END_OF_FILE (New_File)) loop
      begin
        Get_A_Line (Old_File, Old_Line, Old_Length);
        Get_A_Line (New_File, New_Line, New_Length);
      exception
        when CONSTRAINT_ERROR =>
          raise Line_Length_Error;
      end;

      if (TEXT_IO.END_OF_FILE (Old_File) or
          TEXT_IO.END_OF_FILE (New_File)) or else
         (not Lines_Are_Equal ((Old_Line, Old_Length),
                (New_Line, New_Length), Case_Sensitive)) then
        exit;
      end if;
    end loop;

    Files_Equal := (TEXT_IO.END_OF_FILE (Old_File) and
                    TEXT_IO.END_OF_FILE (New_File)) and then
                   Lines_Are_Equal ((Old_Line, Old_Length),
                     (New_Line, New_Length), Case_Sensitive);
  end Quick_Compare_File;
  ----------------------------------------------------------------------

  -- The following procedure is visible to all users, and is used
  -- for normal compare operations, where a statistics record is
  -- requested.

  procedure Compare (
    Old_File,
    New_File,
    List_File,
    Deck_File  : in     TEXT_IO.FILE_TYPE;
    Statistics :    out Statistics_Type;
    Options    : in     Options_Type := Default_Options) is

    Files : Files_Type;
  begin
    if (not TEXT_IO.IS_OPEN (Old_File)) or else
       (TEXT_IO.MODE (Old_File) /= TEXT_IO.IN_FILE) then
      raise Old_File_Open_Error;
    end if;

    if (not TEXT_IO.IS_OPEN (New_File)) or else
       (TEXT_IO.MODE (New_File) /= TEXT_IO.IN_FILE) then
      raise New_File_Open_Error;
    end if;

    if Options.Produce_Listing and then
       ((not TEXT_IO.IS_OPEN (List_File)) or else
        (TEXT_IO.MODE (List_File) /= TEXT_IO.OUT_FILE)) then
      raise List_File_Create_Error;
    end if;

    if Options.Produce_Deck and then
       ((not TEXT_IO.IS_OPEN (Deck_File)) or else
        (TEXT_IO.MODE (Deck_File) /= TEXT_IO.OUT_FILE)) then
      raise Deck_File_Create_Error;
    end if;

    Assign (TEXT_IO.NAME (Old_File), Files.Old_File_Name,
      Files.Old_File_Length);
    Assign (TEXT_IO.NAME (New_File), Files.New_File_Name,
      Files.New_File_Length);

    if not Options.Produce_Listing then
      Files.List_File_Name := (others => Blank);
      Files.List_File_Length := 0;
    else
      Assign (TEXT_IO.NAME (List_File), Files.List_File_Name,
        Files.List_File_Length);
    end if;

    if not Options.Produce_Deck then
      Files.Deck_File_Name := (others => Blank);
      Files.Deck_File_Length := 0;
    else
      Assign (TEXT_IO.NAME (Deck_File), Files.Deck_File_Name,
        Files.Deck_File_Length);
    end if;

    if Options.Wide_Listing then
      Text_Max_Length := Large_Margin;
    else
      Text_Max_Length := Small_Margin;
    end if;

    Compare_File (Options, Old_File, New_File, List_File,
      Deck_File, Files, Statistics);
  end Compare;
  ----------------------------------------------------------------------

  -- The following procedure is visible to all users, and is used for
  -- normal compare operations where a statistics record is not
  -- required.  Statistics may still be printed on the list file,
  -- if the user selects that option.

  procedure Compare (
    Old_File,
    New_File,
    List_File,
    Deck_File  : in     TEXT_IO.FILE_TYPE;
    Options    : in     Options_Type := Default_Options) is

    Dummy_Statistics : Statistics_Type;
  begin
    Compare (Old_File, New_File, List_File, Deck_File, Dummy_Statistics,
      Options);
  end Compare;
  ----------------------------------------------------------------------

  -- The following function is visible to all users, and is used for
  -- quick compare operations.

  function Quick_Compare (
    Old_File,
    New_File        : in     TEXT_IO.FILE_TYPE;
    Case_Sensitive  : in     BOOLEAN := TRUE) return BOOLEAN is

    Files   : Files_Type;
    Result  : BOOLEAN;
  begin
    if (not TEXT_IO.IS_OPEN (Old_File)) or else
       (TEXT_IO.MODE (Old_File) /= TEXT_IO.IN_FILE) then
      raise Old_File_Open_Error;
    end if;

    if (not TEXT_IO.IS_OPEN (New_File)) or else
       (TEXT_IO.MODE (New_File) /= TEXT_IO.IN_FILE) then
      raise New_File_Open_Error;
    end if;

    Quick_Compare_File (Case_Sensitive, Old_File, New_File, Result);

    return Result;
  end Quick_Compare;
  ----------------------------------------------------------------------

  -- The following procedure is visible to all users, and is used
  -- for normal compare operations, where a statistics record is
  -- requested.

  procedure Compare (
    Old_File_Name,
    New_File_Name,
    List_File_Name,
    Deck_File_Name  : in     STRING;
    Statistics      :    out Statistics_Type;
    Options         : in     Options_Type := Default_Options) is

    Old_File,
    New_File,
    List_File,
    Deck_File  : TEXT_IO.FILE_TYPE;
  begin
    if (Old_File_Name'LENGTH  > Maximum_File_Name_Length) or
       (New_File_Name'LENGTH  > Maximum_File_Name_Length) or
       (List_File_Name'LENGTH > Maximum_File_Name_Length) or
       (Deck_File_Name'LENGTH > Maximum_File_Name_Length) then
      raise File_Name_Length_Error;
    end if;

    begin
      TEXT_IO.OPEN (Old_File, TEXT_IO.IN_FILE, Old_File_Name);
    exception
      when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
        raise Old_File_Open_Error;
    end;

    begin
      TEXT_IO.OPEN (New_File, TEXT_IO.IN_FILE, New_File_Name);
    exception
      when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
        raise New_File_Open_Error;
    end;

    if Options.Produce_Listing then
      begin
        TEXT_IO.CREATE (List_File, TEXT_IO.OUT_FILE, List_File_Name);
      exception
        when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
          raise List_File_Create_Error;
      end;
    end if;

    if Options.Produce_Deck then
      begin
        TEXT_IO.CREATE (Deck_File, TEXT_IO.OUT_FILE, Deck_File_Name);
      exception
        when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
          raise Deck_File_Create_Error;
      end;
    end if;

    Compare (Old_File, New_File, List_File, Deck_File, Statistics,
      Options);

    TEXT_IO.CLOSE (Old_File);
    TEXT_IO.CLOSE (New_File);

    if Options.Produce_Listing then
      TEXT_IO.CLOSE (List_File);
    end if;

    if Options.Produce_Deck then
      TEXT_IO.CLOSE (Deck_File);
    end if;
  end Compare;
  ----------------------------------------------------------------------

  -- The following procedure is visible to all users, and is used for
  -- normal compare operations where a statistics record is not
  -- required.  Statistics may still be printed on the list file,
  -- if the user selects that option.

  procedure Compare (
    Old_File_Name,
    New_File_Name,
    List_File_Name,
    Deck_File_Name  : in     STRING;
    Options         : in     Options_Type := Default_Options) is

    Dummy_Statistics : Statistics_Type;
  begin
    Compare (Old_File_Name, New_File_Name, List_File_Name, Deck_File_Name,
      Dummy_Statistics, Options);
  end Compare;
  ----------------------------------------------------------------------

  -- The following function is visible to all users, and is used for
  -- quick compare operations.

  function Quick_Compare (
    Old_File_Name,
    New_File_Name   : in     STRING;
    Case_Sensitive  : in     BOOLEAN := TRUE) return BOOLEAN is

    Old_File,
    New_File  : TEXT_IO.FILE_TYPE;
    Result    : BOOLEAN;
  begin
    begin
      TEXT_IO.OPEN (Old_File, TEXT_IO.IN_FILE, Old_File_Name);
    exception
      when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
        raise Old_File_Open_Error;
    end;

    begin
      TEXT_IO.OPEN (New_File, TEXT_IO.IN_FILE, New_File_Name);
    exception
      when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR =>
        raise New_File_Open_Error;
    end;

    Result := Quick_Compare (Old_File, New_File, Case_Sensitive);

    TEXT_IO.CLOSE (Old_File);
    TEXT_IO.CLOSE (New_File);

    return Result;
  end Quick_Compare;
end File_Compare_Utilities;