xgnatugn.adb

理解和实践操作系统的一本好书

------------------------------------------------------------------------------
--                                                                          --
--                          GNAT SYSTEM UTILITIES                           --
--                                                                          --
--                             X G N A T U G N                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2003-2007, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
------------------------------------------------------------------------------

--  This utility is used to process the source of gnat_ugn.texi to make a
--  version suitable for running through standard Texinfo processor. It is
--  invoked as follows:

--  xgnatugn <target> <in-file> <word-list> [ <out-file> [ <warnings> ] ]

--  1. <target> is the target type of the manual, which is one of:

--     unw       Unix and Windows platforms
--     vms       OpenVMS

--  2. <in-file> is the file name of the Texinfo file to be
--  preprocessed.

--  3. <word-list> is the name of the word list file. This file is used for
--  rewriting the VMS edition. Each line contains a word mapping: The source
--  word in the first column, the target word in the second column. The
--  columns are separated by a '^' character. When preprocessing for VMS, the
--  first word is replaced with the second. (Words consist of letters,
--  digits, and the four characters "?-_~". A sequence of multiple words can
--  be replaced if they are listed in the first column, separated by a single
--  space character. If multiple words are to be replaced, there must be a
--  replacement for each prefix.)

--  4. <out-file> (optional) is the name of the output file. It defaults to
--  gnat_ugn_unw.texi or gnat_ugn_vms.texi, depending on the target.

--  5. <warnings> (optional, and allowed only if <out-file> is explicit)
--  can be any string. If present, it indicates that warning messages are
--  to be output to Standard_Error. If absent, no warning messages are
--  generated.

--  The following steps are performed:

--     In VMS mode

--       Any occurrences of ^alpha^beta^ are replaced by beta. The sequence
--       must fit on a single line, and there can only be one occurrence on a
--       line.

--       Any occurrences of a word in the Ug_Words list are replaced by the
--       appropriate vms equivalents. Note that replacements do not occur
--       within ^alpha^beta^ sequences.

--       Any occurence of [filename].extension, where extension one of the
--       following:

--           "o", "ads", "adb", "ali", "ada", "atb", "ats", "adc", "c"

--       replaced by the appropriate VMS names (all upper case with .o
--       replaced .OBJ). Note that replacements do not occur within
--       ^alpha^beta^ sequences.

--     In UNW mode

--       Any occurrences of ^alpha^beta^ are replaced by alpha. The sequence
--       must fit on a single line.

--     In both modes

--       The sequence ^^^ is replaced by a single ^. This escape sequence
--       must be used if the literal character ^ is to appear in the
--       output. A line containing this escape sequence may not also contain
--       a ^alpha^beta^ sequence.

--       Process @ifset and @ifclear for the target flags (unw, vms);
--       this is because we have menu problems if we let makeinfo handle
--       these ifset/ifclear pairs.
--       Note: @ifset/@ifclear commands for the edition flags (FSFEDITION,
--       PROEDITION, GPLEDITION) are passed through unchanged

with Ada.Command_Line;           use Ada.Command_Line;
with Ada.Strings;                use Ada.Strings;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
with Ada.Strings.Maps;           use Ada.Strings.Maps;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Text_IO;                use Ada.Text_IO;

with GNAT.Spitbol;               use GNAT.Spitbol;
with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString;

procedure Xgnatugn is

   procedure Usage;
   --  Print usage information. Invoked if an invalid command line is
   --  encountered.

   Output_File : File_Type;
   --  The preprocessed output is written to this file

   type Input_File is record
      Name : VString;
      Data : File_Type;
      Line : Natural := 0;
   end record;
   --  Records information on an input file. Name and Line are used
   --  in error messages, Line is updated automatically by Get_Line.

   function Get_Line (Input : access Input_File) return String;
   --  Returns a line from Input and performs the necessary
   --  line-oriented checks (length, character set, trailing spaces).

   Number_Of_Warnings : Natural := 0;
   Number_Of_Errors   : Natural := 0;
   Warnings_Enabled   : Boolean;

   procedure Error
     (Input        : Input_File;
      At_Character : Natural;
      Message      : String);
   procedure Error
     (Input        : Input_File;
      Message      : String);
   --  Prints a message reporting an error on line Input.Line. If
   --  At_Character is not 0, indicate the exact character at which
   --  the error occurs.

   procedure Warning
     (Input        : Input_File;
      At_Character : Natural;
      Message      : String);
   procedure Warning
     (Input        : Input_File;
      Message      : String);
   --  Like Error, but just print a warning message

   Dictionary_File : aliased Input_File;
   procedure Read_Dictionary_File;
   --  Dictionary_File is opened using the name given on the command
   --  line. It contains the replacements for the Ug_Words list.
   --  Read_Dictionary_File reads Dictionary_File and fills the
   --  Ug_Words table.

   Source_File : aliased Input_File;
   procedure Process_Source_File;
   --  Source_File is opened using the name given on the command line.
   --  It contains the Texinfo source code. Process_Source_File
   --  performs the necessary replacements.

   type Flag_Type is (UNW, VMS, FSFEDITION, PROEDITION, GPLEDITION);
   --  The flags permitted in @ifset or @ifclear commands:
   --
   --  Targets for preprocessing
   --    UNW (Unix and Windows) or VMS
   --
   --  Editions of the manual
   --    FSFEDITION, PROEDITION, or GPLEDITION
   --
   --  Conditional commands for target are processed by xgnatugn
   --
   --  Conditional commands for edition are passed through unchanged

   subtype Target_Type is Flag_Type range UNW .. VMS;
   subtype Edition_Type is Flag_Type range FSFEDITION .. GPLEDITION;

   Target : Target_Type;
   --  The Target variable is initialized using the command line

   Valid_Characters : constant Character_Set :=
                        To_Set (Span => (' ',  '~'));
   --  This array controls which characters are permitted in the input
   --  file (after line breaks have been removed). Valid characters
   --  are all printable ASCII characters and the space character.

   Word_Characters : constant Character_Set :=
                       (To_Set (Ranges =>
                                  (('0', '9'), ('a', 'z'), ('A', 'Z')))
                        or To_Set ("?-_~"));
   --  The characters which are permitted in words. Other (valid)
   --  characters are assumed to be delimiters between words. Note that
   --  this set has to include all characters of the source words of the
   --  Ug_Words dictionary.

   Reject_Trailing_Spaces : constant Boolean := True;
   --  Controls whether Xgnatug rejects superfluous space characters
   --  at the end of lines.

   Maximum_Line_Length     : constant Positive := 79;
   Fatal_Line_Length_Limit : constant Positive := 5000;
   Fatal_Line_Length       : exception;
   --  If Maximum_Line_Length is exceeded in an input file, an error
   --  message is printed. If Fatal_Line_Length is exceeded,
   --  execution terminates with a Fatal_Line_Length exception.

   VMS_Escape_Character : constant Character := '^';
   --  The character used to mark VMS alternatives (^alpha^beta^)

   Extensions : GNAT.Spitbol.Table_VString.Table (20);
   procedure Initialize_Extensions;
   --  This table records extensions and their replacement for
   --  rewriting filenames in the VMS version of the manual.

   function Is_Extension (Extension : String) return Boolean;
   function Get_Replacement_Extension (Extension : String) return String;
   --  These functions query the replacement table. Is_Extension
   --  checks if the given string is a known extension.
   --  Get_Replacement returns the replacement extension.

   Ug_Words : GNAT.Spitbol.Table_VString.Table (200);
   function Is_Known_Word (Word : String) return Boolean;
   function Get_Replacement_Word (Word : String) return String;
   --  The Ug_Words table lists replacement words for the VMS version
   --  of the manual. Is_Known_Word and Get_Replacement_Word query
   --  this table. The table is filled using Read_Dictionary_File.

   function Rewrite_Source_Line (Line : String) return String;
   --  This subprogram takes a line and rewrites it according to Target.
   --  It relies on information in Source_File to generate error messages.

   type Conditional is (Set, Clear);
   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type);
   procedure Pop_Conditional  (Cond : Conditional);
   --  These subprograms deal with conditional processing (@ifset/@ifclear).
   --  They rely on information in Source_File to generate error messages.

   function Currently_Excluding return Boolean;
   --  Returns true if conditional processing directives imply that the
   --  current line should not be included in the output.

   function VMS_Context_Determined return Boolean;
   --  Returns true if, in the current conditional preprocessing context, we
   --  always have a VMS or a non-VMS version, regardless of the value of
   --  Target.

   function In_VMS_Section return Boolean;
   --  Returns True if in an "@ifset vms" section

   procedure Check_No_Pending_Conditional;
   --  Checks that all preprocessing directives have been properly matched by
   --  their @end counterpart. If this is not the case, print an error
   --  message.

   --  The following definitions implement a stack to track the conditional
   --  preprocessing context.

   type Conditional_Context is record
      Starting_Line : Positive;
      Cond          : Conditional;
      Flag          : Flag_Type;
      Excluding     : Boolean;
   end record;

   Conditional_Stack_Depth : constant := 3;

   Conditional_Stack :
     array (1 .. Conditional_Stack_Depth) of Conditional_Context;

   Conditional_TOS : Natural := 0;
   --  Pointer to the Top Of Stack for Conditional_Stack

   -----------
   -- Usage --
   -----------

   procedure Usage is
   begin
      Put_Line (Standard_Error,
            "usage: xgnatugn TARGET SOURCE DICTIONARY [OUTFILE [WARNINGS]]");
      New_Line;
      Put_Line (Standard_Error, "TARGET is one of:");

      for T in Target_Type'Range loop
         Put_Line (Standard_Error, "  " & Target_Type'Image (T));
      end loop;

      New_Line;
      Put_Line (Standard_Error, "SOURCE is the source file to process.");
      New_Line;
      Put_Line (Standard_Error, "DICTIONARY is the name of a file "
                & "that contains word replacements");
      Put_Line (Standard_Error, "for the VMS version.");
      New_Line;
      Put_Line (Standard_Error,
                "OUT-FILE, if present, is the output file to be created;");
      Put_Line (Standard_Error,
                "If OUT-FILE is absent, the output file is either " &
                "gnat_ugn_unw.texi, ");
      Put_Line (Standard_Error,
                "or gnat_ugn_vms.texi, depending on TARGET.");
      New_Line;
      Put_Line (Standard_Error,
                "WARNINGS, if present, is any string;");
      Put_Line (Standard_Error,
                "it will result in warning messages (e.g., line too long))");
      Put_Line (Standard_Error,
                "being output to Standard_Error.");
   end Usage;

   --------------
   -- Get_Line --
   --------------

   function Get_Line (Input : access Input_File) return String is
      Line_Buffer : String (1 .. Fatal_Line_Length_Limit);
      Last        : Natural;

   begin
      Input.Line := Input.Line + 1;
      Get_Line (Input.Data, Line_Buffer, Last);

      if Last = Line_Buffer'Last then
         Error (Input.all, "line exceeds fatal line length limit");
         raise Fatal_Line_Length;
      end if;

      declare
         Line : String renames Line_Buffer (Line_Buffer'First .. Last);

      begin
         for J in Line'Range loop
            if not Is_In (Line (J), Valid_Characters) then
               Error (Input.all, J, "invalid character");
               exit;
            end if;
         end loop;

         if Line'Length > Maximum_Line_Length then
            Warning (Input.all, Maximum_Line_Length + 1, "line too long");
         end if;

         if Reject_Trailing_Spaces
           and then Line'Length > 0
           and then Line (Line'Last) = ' '
         then
            Error (Input.all, Line'Last, "trailing space character");
         end if;

         return Trim (Line, Right);
      end;