gcc/ada/xgnatugn.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                          GNAT SYSTEM UTILITIES                           --
   4 --                                                                          --
   5 --                             X G N A T U G N                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 ------------------------------------------------------------------------------
  22
  23 --  This utility is used to process the source of gnat_ugn.texi to make a
  24 --  version suitable for running through standard Texinfo processor. It is
  25 --  invoked as follows:
  26
  27 --  xgnatugn <target> <in-file> <word-list> [ <out-file> [ <warnings> ] ]
  28
  29 --  1. <target> is the target type of the manual, which is one of:
  30
  31 --     unw       Unix and Windows platforms
  32 --     vms       OpenVMS
  33
  34 --  2. <in-file> is the file name of the Texinfo file to be
  35 --  preprocessed.
  36
  37 --  3. <word-list> is the name of the word list file. This file is used for
  38 --  rewriting the VMS edition. Each line contains a word mapping: The source
  39 --  word in the first column, the target word in the second column. The
  40 --  columns are separated by a '^' character. When preprocessing for VMS, the
  41 --  first word is replaced with the second. (Words consist of letters,
  42 --  digits, and the four characters "?-_~". A sequence of multiple words can
  43 --  be replaced if they are listed in the first column, separated by a single
  44 --  space character. If multiple words are to be replaced, there must be a
  45 --  replacement for each prefix.)
  46
  47 --  4. <out-file> (optional) is the name of the output file. It defaults to
  48 --  gnat_ugn_unw.texi or gnat_ugn_vms.texi, depending on the target.
  49
  50 --  5. <warnings> (optional, and allowed only if <out-file> is explicit)
  51 --  can be any string. If present, it indicates that warning messages are
  52 --  to be output to Standard_Error. If absent, no warning messages are
  53 --  generated.
  54
  55 --  The following steps are performed:
  56
  57 --     In VMS mode
  58
  59 --       Any occurrences of ^alpha^beta^ are replaced by beta. The sequence
  60 --       must fit on a single line, and there can only be one occurrence on a
  61 --       line.
  62
  63 --       Any occurrences of a word in the Ug_Words list are replaced by the
  64 --       appropriate vms equivalents. Note that replacements do not occur
  65 --       within ^alpha^beta^ sequences.
  66
  67 --       Any occurrence of [filename].extension, where extension one of the
  68 --       following:
  69
  70 --           "o", "ads", "adb", "ali", "ada", "atb", "ats", "adc", "c"
  71
  72 --       replaced by the appropriate VMS names (all upper case with .o
  73 --       replaced .OBJ). Note that replacements do not occur within
  74 --       ^alpha^beta^ sequences.
  75
  76 --     In UNW mode
  77
  78 --       Any occurrences of ^alpha^beta^ are replaced by alpha. The sequence
  79 --       must fit on a single line.
  80
  81 --     In both modes
  82
  83 --       The sequence ^^^ is replaced by a single ^. This escape sequence
  84 --       must be used if the literal character ^ is to appear in the
  85 --       output. A line containing this escape sequence may not also contain
  86 --       a ^alpha^beta^ sequence.
  87
  88 with Ada.Command_Line;           use Ada.Command_Line;
  89 with Ada.Strings;                use Ada.Strings;
  90 with Ada.Strings.Fixed;          use Ada.Strings.Fixed;
  91 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
  92 with Ada.Strings.Maps;           use Ada.Strings.Maps;
  93 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  94 with Ada.Streams.Stream_IO;      use Ada.Streams.Stream_IO;
  95 with Ada.Text_IO;                use Ada.Text_IO;
  96
  97 with GNAT.Spitbol;               use GNAT.Spitbol;
  98 with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString;
  99
 100 procedure Xgnatugn is
 101
 102    procedure Usage;
 103    --  Print usage information. Invoked if an invalid command line is
 104    --  encountered.
 105
 106    subtype Sfile is Ada.Streams.Stream_IO.File_Type;
 107
 108    Output_File : Sfile;
 109    --  The preprocessed output is written to this file
 110
 111    type Input_File is record
 112       Name : VString;
 113       Data : Ada.Text_IO.File_Type;
 114       Line : Natural := 0;
 115    end record;
 116    --  Records information on an input file. Name and Line are used
 117    --  in error messages, Line is updated automatically by Get_Line.
 118
 119    function Get_Line (Input : access Input_File) return String;
 120    --  Returns a line from Input and performs the necessary
 121    --  line-oriented checks (length, character set, trailing spaces).
 122
 123    procedure Put_Line (F : Sfile; S : String);
 124    --  Local version of Put_Line ensures Unix style line endings
 125
 126    First_Time         : Boolean := True;
 127    Number_Of_Warnings : Natural := 0;
 128    Number_Of_Errors   : Natural := 0;
 129    Warnings_Enabled   : Boolean;
 130
 131    procedure Error
 132      (Input        : Input_File;
 133       At_Character : Natural;
 134       Message      : String);
 135    procedure Error
 136      (Input        : Input_File;
 137       Message      : String);
 138    --  Prints a message reporting an error on line Input.Line. If
 139    --  At_Character is not 0, indicate the exact character at which
 140    --  the error occurs.
 141
 142    procedure Warning
 143      (Input        : Input_File;
 144       At_Character : Natural;
 145       Message      : String);
 146
 147    Dictionary_File : aliased Input_File;
 148    procedure Read_Dictionary_File;
 149    --  Dictionary_File is opened using the name given on the command
 150    --  line. It contains the replacements for the Ug_Words list.
 151    --  Read_Dictionary_File reads Dictionary_File and fills the
 152    --  Ug_Words table.
 153
 154    Source_File : aliased Input_File;
 155    procedure Process_Source_File;
 156    --  Source_File is opened using the name given on the command line.
 157    --  It contains the Texinfo source code. Process_Source_File
 158    --  performs the necessary replacements.
 159
 160    type Flag_Type is (UNW, VMS, FSFEDITION, PROEDITION, GPLEDITION);
 161    --  The flags permitted in @ifset or @ifclear commands:
 162    --
 163    --  Targets for preprocessing
 164    --    UNW (Unix and Windows) or VMS
 165    --
 166    --  Editions of the manual
 167    --    FSFEDITION, PROEDITION, or GPLEDITION
 168    --
 169    --  Conditional commands for target are processed by xgnatugn
 170    --
 171    --  Conditional commands for edition are passed through unchanged
 172
 173    subtype Target_Type is Flag_Type range UNW .. VMS;
 174
 175    Target : Target_Type;
 176    --  The Target variable is initialized using the command line
 177
 178    Valid_Characters : constant Character_Set := To_Set (Span => (' ',  '~'));
 179    --  This array controls which characters are permitted in the input
 180    --  file (after line breaks have been removed). Valid characters
 181    --  are all printable ASCII characters and the space character.
 182
 183    Word_Characters : constant Character_Set :=
 184                        (To_Set (Ranges =>
 185                                   (('0', '9'), ('a', 'z'), ('A', 'Z')))
 186                          or To_Set ("?-_~"));
 187    --  The characters which are permitted in words. Other (valid)
 188    --  characters are assumed to be delimiters between words. Note that
 189    --  this set has to include all characters of the source words of the
 190    --  Ug_Words dictionary.
 191
 192    Reject_Trailing_Spaces : constant Boolean := True;
 193    --  Controls whether Xgnatug rejects superfluous space characters
 194    --  at the end of lines.
 195
 196    Maximum_Line_Length     : constant Positive := 79;
 197    Fatal_Line_Length_Limit : constant Positive := 5000;
 198    Fatal_Line_Length       : exception;
 199    --  If Maximum_Line_Length is exceeded in an input file, an error
 200    --  message is printed. If Fatal_Line_Length is exceeded,
 201    --  execution terminates with a Fatal_Line_Length exception.
 202
 203    VMS_Escape_Character : constant Character := '^';
 204    --  The character used to mark VMS alternatives (^alpha^beta^)
 205
 206    Extensions : GNAT.Spitbol.Table_VString.Table (20);
 207    procedure Initialize_Extensions;
 208    --  This table records extensions and their replacement for
 209    --  rewriting filenames in the VMS version of the manual.
 210
 211    function Is_Extension (Extension : String) return Boolean;
 212    function Get_Replacement_Extension (Extension : String) return String;
 213    --  These functions query the replacement table. Is_Extension
 214    --  checks if the given string is a known extension.
 215    --  Get_Replacement returns the replacement extension.
 216
 217    Ug_Words : GNAT.Spitbol.Table_VString.Table (200);
 218    function Is_Known_Word (Word : String) return Boolean;
 219    function Get_Replacement_Word (Word : String) return String;
 220    --  The Ug_Words table lists replacement words for the VMS version
 221    --  of the manual. Is_Known_Word and Get_Replacement_Word query
 222    --  this table. The table is filled using Read_Dictionary_File.
 223
 224    function Rewrite_Source_Line (Line : String) return String;
 225    --  This subprogram takes a line and rewrites it according to Target.
 226    --  It relies on information in Source_File to generate error messages.
 227
 228    -----------
 229    -- Usage --
 230    -----------
 231
 232    procedure Usage is
 233    begin
 234       Put_Line (Standard_Error,
 235             "usage: xgnatugn TARGET SOURCE DICTIONARY [OUTFILE [WARNINGS]]");
 236       New_Line;
 237       Put_Line (Standard_Error, "TARGET is one of:");
 238
 239       for T in Target_Type'Range loop
 240          Put_Line (Standard_Error, "  " & Target_Type'Image (T));
 241       end loop;
 242
 243       New_Line;
 244       Put_Line (Standard_Error, "SOURCE is the source file to process.");
 245       New_Line;
 246       Put_Line (Standard_Error, "DICTIONARY is the name of a file "
 247                 & "that contains word replacements");
 248       Put_Line (Standard_Error, "for the VMS version.");
 249       New_Line;
 250       Put_Line (Standard_Error,
 251                 "OUT-FILE, if present, is the output file to be created;");
 252       Put_Line (Standard_Error,
 253                 "If OUT-FILE is absent, the output file is either " &
 254                 "gnat_ugn_unw.texi, ");
 255       Put_Line (Standard_Error,
 256                 "or gnat_ugn_vms.texi, depending on TARGET.");
 257       New_Line;
 258       Put_Line (Standard_Error,
 259                 "WARNINGS, if present, is any string;");
 260       Put_Line (Standard_Error,
 261                 "it will result in warning messages (e.g., line too long))");
 262       Put_Line (Standard_Error,
 263                 "being output to Standard_Error.");
 264    end Usage;
 265
 266    --------------
 267    -- Get_Line --
 268    --------------
 269
 270    function Get_Line (Input : access Input_File) return String is
 271       Line_Buffer : String (1 .. Fatal_Line_Length_Limit);
 272       Last        : Natural;
 273
 274    begin
 275       Input.Line := Input.Line + 1;
 276       Get_Line (Input.Data, Line_Buffer, Last);
 277
 278       if Last = Line_Buffer'Last then
 279          Error (Input.all, "line exceeds fatal line length limit");
 280          raise Fatal_Line_Length;
 281       end if;
 282
 283       declare
 284          Line : String renames Line_Buffer (Line_Buffer'First .. Last);
 285
 286       begin
 287          for J in Line'Range loop
 288             if not Is_In (Line (J), Valid_Characters) then
 289                Error (Input.all, J, "invalid character");
 290                exit;
 291             end if;
 292          end loop;
 293
 294          if Line'Length > Maximum_Line_Length then
 295             Warning (Input.all, Maximum_Line_Length + 1, "line too long");
 296          end if;
 297
 298          if Reject_Trailing_Spaces
 299            and then Line'Length > 0
 300            and then Line (Line'Last) = ' '
 301          then
 302             Error (Input.all, Line'Last, "trailing space character");
 303          end if;
 304
 305          return Trim (Line, Right);
 306       end;
 307    end Get_Line;
 308
 309    --------------
 310    -- Put_Line --
 311    --------------
 312
 313    procedure Put_Line (F : Sfile; S : String) is
 314    begin
 315       String'Write (Stream (F), S);
 316       Character'Write (Stream (F), ASCII.LF);
 317    end Put_Line;
 318
 319    -----------
 320    -- Error --
 321    -----------
 322
 323    procedure Error
 324      (Input   : Input_File;
 325       Message : String)
 326    is
 327    begin
 328       Error (Input, 0, Message);
 329    end Error;
 330
 331    procedure Error
 332      (Input        : Input_File;
 333       At_Character : Natural;
 334       Message      : String)
 335    is
 336       Line_Image         : constant String := Integer'Image (Input.Line);
 337       At_Character_Image : constant String := Integer'Image (At_Character);
 338       --  These variables are required because we have to drop the leading
 339       --  space character.
 340
 341    begin
 342       Number_Of_Errors := Number_Of_Errors + 1;
 343
 344       if At_Character > 0 then
 345          Put_Line (Standard_Error,
 346                    S (Input.Name) & ':'
 347                    & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
 348                    & At_Character_Image (At_Character_Image'First + 1
 349                                          .. At_Character_Image'Last)
 350                    & ": "
 351                    & Message);
 352       else
 353          Put_Line (Standard_Error,
 354                    S (Input.Name) & ':'
 355                    & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
 356                    & ": "
 357                    & Message);
 358       end if;
 359    end Error;
 360
 361    -------------
 362    -- Warning --
 363    -------------
 364
 365    procedure Warning
 366      (Input        : Input_File;
 367       At_Character : Natural;
 368       Message      : String)
 369    is
 370       Line_Image         : constant String := Integer'Image (Input.Line);
 371       At_Character_Image : constant String := Integer'Image (At_Character);
 372       --  These variables are required because we have to drop the leading
 373       --  space character.
 374
 375    begin
 376       if not Warnings_Enabled then
 377          return;
 378       end if;
 379
 380       Number_Of_Warnings := Number_Of_Warnings + 1;
 381
 382       if At_Character > 0 then
 383          Put_Line (Standard_Error,
 384                    S (Input.Name) & ':'
 385                    & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
 386                    & At_Character_Image (At_Character_Image'First + 1
 387                                          .. At_Character_Image'Last)
 388                    & ": warning: "
 389                    & Message);
 390       else
 391          Put_Line (Standard_Error,
 392                    S (Input.Name) & ':'
 393                    & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
 394                    & ": warning: "
 395                    & Message);
 396       end if;
 397    end Warning;
 398
 399    --------------------------
 400    -- Read_Dictionary_File --
 401    --------------------------
 402
 403    procedure Read_Dictionary_File is
 404    begin
 405       while not End_Of_File (Dictionary_File.Data) loop
 406          declare
 407             Line  : constant String :=
 408                       Get_Line (Dictionary_File'Access);
 409             Split : constant Natural :=
 410                       Index (Line, (1 => VMS_Escape_Character));
 411
 412          begin
 413             if Line'Length = 0 then
 414                Error (Dictionary_File, "empty line in dictionary file");
 415
 416             elsif Line (Line'First) = ' ' then
 417                Error (Dictionary_File, 1, "line starts with space character");
 418
 419             elsif Split = 0 then
 420                Error (Dictionary_File, "line does not contain "
 421                       & VMS_Escape_Character & " character");
 422             else
 423                declare
 424                   Source : constant String :=
 425                              Trim (Line (1 .. Split - 1), Both);
 426                   Target : constant String :=
 427                              Trim (Line (Split + 1 .. Line'Last), Both);
 428
 429                   Two_Spaces : constant Natural := Index (Source, "  ");
 430
 431                   Non_Word_Character : constant Natural :=
 432                                          Index (Source,
 433                                                 Word_Characters or
 434                                                   To_Set (" ."),
 435                                                 Outside);
 436
 437                begin
 438                   if Two_Spaces /= 0 then
 439                      Error (Dictionary_File, Two_Spaces,
 440                             "multiple space characters in source word");
 441                   end if;
 442
 443                   if Non_Word_Character /= 0 then
 444                      Error (Dictionary_File, Non_Word_Character,
 445                             "illegal character in source word");
 446                   end if;
 447
 448                   if Source'Length = 0 then
 449                      Error (Dictionary_File, "source is empty");
 450
 451                   elsif Target'Length = 0 then
 452                      Error (Dictionary_File, "target is empty");
 453
 454                   else
 455                      Set (Ug_Words, Source, V (Target));
 456
 457                      --  Ensure that if Source is a sequence of words
 458                      --  "WORD1 WORD2 ...", we already have a mapping for
 459                      --  "WORD1".
 460
 461                      for J in Source'Range loop
 462                         if Source (J) = ' ' then
 463                            declare
 464                               Prefix : String renames
 465                                          Source (Source'First .. J - 1);
 466                            begin
 467                               if not Is_Known_Word (Prefix) then
 468                                  Error (Dictionary_File,
 469                                         "prefix '" & Prefix
 470                                         & "' not known at this point");
 471                               end if;
 472                            end;
 473                         end if;
 474                      end loop;
 475                   end if;
 476                end;
 477             end if;
 478          end;
 479       end loop;
 480    end Read_Dictionary_File;
 481
 482    -------------------------
 483    -- Rewrite_Source_Line --
 484    -------------------------
 485
 486    function Rewrite_Source_Line (Line : String) return String is
 487
 488       --  We use a simple lexer to split the line into tokens:
 489
 490       --    Word             consisting entirely of Word_Characters
 491       --    VMS_Alternative  ^alpha^beta^ replacement (but not ^^^)
 492       --    Space            a space character
 493       --    Other            everything else (sequence of non-word characters)
 494       --    VMS_Error        incomplete VMS alternative
 495       --    End_Of_Line      no more characters on this line
 496
 497       --   A sequence of three VMS_Escape_Characters is automatically
 498       --   collapsed to an Other token.
 499
 500       type Token_Span is record
 501          First, Last : Positive;
 502       end record;
 503       --  The character range covered by a token in Line
 504
 505       type Token_Kind is (End_Of_Line, Word, Other,
 506                           VMS_Alternative, VMS_Error);
 507       type Token_Record (Kind : Token_Kind := End_Of_Line) is record
 508          First : Positive;
 509          case Kind is
 510             when Word | Other =>
 511                Span : Token_Span;
 512             when VMS_Alternative =>
 513                Non_VMS, VMS : Token_Span;
 514             when VMS_Error | End_Of_Line =>
 515                null;
 516          end case;
 517       end record;
 518
 519       Input_Position : Positive := Line'First;
 520       Token : Token_Record;
 521       --  The position of the next character to be processed by Next_Token
 522
 523       procedure Next_Token;
 524       --  Returns the next token in Line, starting at Input_Position
 525
 526       Rewritten_Line : VString;
 527       --  Collects the line as it is rewritten
 528
 529       procedure Rewrite_Word;
 530       --  The current token is assumed to be a Word. When processing the VMS
 531       --  version of the manual, additional tokens are gathered to check if
 532       --  we have a file name or a sequence of known words.
 533
 534       procedure Maybe_Rewrite_Extension;
 535       --  The current token is assumed to be Other. When processing the VMS
 536       --  version of the manual and the token represents a single dot ".",
 537       --  the following word is rewritten according to the rules for
 538       --  extensions.
 539
 540       VMS_Token_Seen : Boolean := False;
 541       --  This is set to true if a VMS_Alternative has been encountered, or a
 542       --  ^^^ token.
 543
 544       ----------------
 545       -- Next_Token --
 546       ----------------
 547
 548       procedure Next_Token is
 549          Remaining_Line : String renames Line (Input_Position .. Line'Last);
 550          Last_Character : Natural;
 551
 552       begin
 553          if Remaining_Line'Length = 0 then
 554             Token := (End_Of_Line, Remaining_Line'First);
 555             return;
 556          end if;
 557
 558          --  ^alpha^beta^, the VMS_Alternative case
 559
 560          if Remaining_Line (Remaining_Line'First) = VMS_Escape_Character then
 561             declare
 562                VMS_Second_Character, VMS_Third_Character : Natural;
 563
 564             begin
 565                if VMS_Token_Seen then
 566                   Error (Source_File, Remaining_Line'First,
 567                          "multiple " & VMS_Escape_Character
 568                          & " characters on a single line");
 569                else
 570                   VMS_Token_Seen := True;
 571                end if;
 572
 573                --  Find the second and third escape character. If one of
 574                --  them is not present, generate an error token.
 575
 576                VMS_Second_Character :=
 577                  Index (Remaining_Line (Remaining_Line'First + 1
 578                                            .. Remaining_Line'Last),
 579                         (1 => VMS_Escape_Character));
 580
 581                if VMS_Second_Character = 0 then
 582                   Input_Position := Remaining_Line'Last + 1;
 583                   Token := (VMS_Error, Remaining_Line'First);
 584                   return;
 585                end if;
 586
 587                VMS_Third_Character :=
 588                  Index (Remaining_Line (VMS_Second_Character + 1
 589                                            .. Remaining_Line'Last),
 590                         (1 => VMS_Escape_Character));
 591
 592                if VMS_Third_Character = 0 then
 593                   Input_Position := Remaining_Line'Last + 1;
 594                   Token := (VMS_Error, Remaining_Line'First);
 595                   return;
 596                end if;
 597
 598                --  Consume all the characters we are about to include in
 599                --  the token.
 600
 601                Input_Position := VMS_Third_Character + 1;
 602
 603                --  Check if we are in a ^^^ situation, and return an Other
 604                --  token in this case.
 605
 606                if Remaining_Line'First + 1 = VMS_Second_Character
 607                  and then Remaining_Line'First + 2 = VMS_Third_Character
 608                then
 609                   Token := (Other, Remaining_Line'First,
 610                             (Remaining_Line'First, Remaining_Line'First));
 611                   return;
 612                end if;
 613
 614                Token := (VMS_Alternative, Remaining_Line'First,
 615                          (Remaining_Line'First + 1, VMS_Second_Character - 1),
 616                          (VMS_Second_Character + 1, VMS_Third_Character - 1));
 617                return;
 618             end;
 619          end if;
 620
 621          --  The Word case. Search for characters not in Word_Characters.
 622          --  We have found a word if the first non-word character is not
 623          --  the first character in Remaining_Line, i.e. if Remaining_Line
 624          --  starts with a word character.
 625
 626          Last_Character := Index (Remaining_Line, Word_Characters, Outside);
 627          if Last_Character /= Remaining_Line'First then
 628
 629             --  If we haven't found a character which is not in
 630             --  Word_Characters, all remaining characters are part of the
 631             --  current Word token.
 632
 633             if Last_Character = 0 then
 634                Last_Character := Remaining_Line'Last + 1;
 635             end if;
 636
 637             Input_Position := Last_Character;
 638             Token := (Word, Remaining_Line'First,
 639                       (Remaining_Line'First, Last_Character - 1));
 640             return;
 641          end if;
 642
 643          --  Remaining characters are in the Other category. To speed
 644          --  up processing, we collect them together if there are several
 645          --  of them.
 646
 647          Input_Position := Last_Character + 1;
 648          Token := (Other,
 649                    Remaining_Line'First,
 650                    (Remaining_Line'First, Last_Character));
 651       end Next_Token;
 652
 653       ------------------
 654       -- Rewrite_Word --
 655       ------------------
 656
 657       procedure Rewrite_Word is
 658          First_Word : String
 659                         renames Line (Token.Span.First .. Token.Span.Last);
 660
 661       begin
 662          --  We do not perform any error checking below, so we can just skip
 663          --  all processing for the non-VMS version.
 664
 665          if Target /= VMS then
 666             Append (Rewritten_Line, First_Word);
 667             Next_Token;
 668             return;
 669          end if;
 670
 671          if Is_Known_Word (First_Word) then
 672
 673             --  If we have a word from the dictionary, we look for the
 674             --  longest possible sequence we can rewrite.
 675
 676             declare
 677                Seq        : Token_Span := Token.Span;
 678                Lost_Space : Boolean := False;
 679
 680             begin
 681                Next_Token;
 682                loop
 683                   if Token.Kind = Other
 684                     and then Line (Token.Span.First .. Token.Span.Last) = " "
 685                   then
 686                      Next_Token;
 687
 688                      if Token.Kind /= Word
 689                        or else not Is_Known_Word (Line (Seq.First
 690                                                         .. Token.Span.Last))
 691                      then
 692                         --  When we reach this point, the following conditions
 693                         --  are true:
 694
 695                         --    Seq is a known word
 696
 697                         --    The previous token was a space character
 698
 699                         --    Seq extended to the current token is not a
 700                         --    known word.
 701
 702                         Lost_Space := True;
 703                         exit;
 704
 705                      else
 706                         --  Extend Seq to cover the current (known) word
 707
 708                         Seq.Last := Token.Span.Last;
 709                         Next_Token;
 710                      end if;
 711
 712                   else
 713                      --  When we reach this point, the following conditions
 714                      --  are true:
 715
 716                      --    Seq is a known word
 717
 718                      --    The previous token was a word
 719
 720                      --    The current token is not a space character.
 721
 722                      exit;
 723                   end if;
 724                end loop;
 725
 726                --  Rewrite Seq, and add the lost space if necessary
 727
 728                Append (Rewritten_Line,
 729                        Get_Replacement_Word (Line (Seq.First .. Seq.Last)));
 730                if Lost_Space then
 731                   Append (Rewritten_Line, ' ');
 732                end if;
 733
 734                --  The unknown token will be processed during the
 735                --  next iteration of the main loop.
 736                return;
 737             end;
 738          end if;
 739
 740          Next_Token;
 741
 742          if Token.Kind = Other
 743            and then Line (Token.Span.First .. Token.Span.Last) = "."
 744          then
 745             --  Deal with extensions
 746
 747             Next_Token;
 748             if Token.Kind = Word
 749               and then
 750                 Is_Extension (Line (Token.Span.First .. Token.Span.Last))
 751             then
 752                --  We have discovered a file extension. Convert the file
 753                --  name to upper case.
 754
 755                Append (Rewritten_Line,
 756                        Translate (First_Word, Upper_Case_Map) & '.');
 757                Append (Rewritten_Line,
 758                        Get_Replacement_Extension
 759                        (Line (Token.Span.First .. Token.Span.Last)));
 760                Next_Token;
 761             else
 762                --  We already have: Word ".", followed by an unknown token
 763
 764                Append (Rewritten_Line, First_Word & '.');
 765
 766                --  The unknown token will be processed during the next
 767                --  iteration of the main loop.
 768             end if;
 769
 770          else
 771             --  We have an unknown Word, followed by an unknown token.
 772             --  The unknown token will be processed by the outer loop.
 773
 774             Append (Rewritten_Line, First_Word);
 775          end if;
 776       end Rewrite_Word;
 777
 778       -----------------------------
 779       -- Maybe_Rewrite_Extension --
 780       -----------------------------
 781
 782       procedure Maybe_Rewrite_Extension is
 783       begin
 784          --  Again, we need no special processing in the non-VMS case
 785
 786          if Target = VMS
 787            and then Line (Token.Span.First .. Token.Span.Last) = "."
 788          then
 789             --  This extension is not preceded by a word, otherwise
 790             --  Rewrite_Word would have handled it.
 791
 792             Next_Token;
 793
 794             if Token.Kind = Word
 795               and then Is_Extension (Line (Token.Span.First
 796                                            .. Token.Span.Last))
 797             then
 798                Append (Rewritten_Line, '.' & Get_Replacement_Extension
 799                        (Line (Token.Span.First .. Token.Span.Last)));
 800                Next_Token;
 801             else
 802                Append (Rewritten_Line, '.');
 803             end if;
 804
 805          else
 806             Append (Rewritten_Line, Line (Token.Span.First
 807                                           .. Token.Span.Last));
 808             Next_Token;
 809          end if;
 810       end Maybe_Rewrite_Extension;
 811
 812    --  Start of processing for Process_Source_Line
 813
 814    begin
 815       --  The following parser recognizes the following special token
 816       --  sequences:
 817
 818       --     Word "." Word    rewrite as file name if second word is extension
 819       --     Word " " Word    rewrite as a single word using Ug_Words table
 820
 821       Next_Token;
 822       loop
 823          case Token.Kind is
 824             when End_Of_Line =>
 825                exit;
 826
 827             when Word  =>
 828                Rewrite_Word;
 829
 830             when Other =>
 831                Maybe_Rewrite_Extension;
 832
 833             when VMS_Alternative =>
 834                if Target = VMS then
 835                   Append (Rewritten_Line, Line (Token.VMS.First
 836                                                 .. Token.VMS.Last));
 837                else
 838                   Append (Rewritten_Line, Line (Token.Non_VMS.First
 839                                                 .. Token.Non_VMS.Last));
 840                end if;
 841
 842                Next_Token;
 843
 844             when VMS_Error =>
 845                Error (Source_File, Token.First, "invalid VMS alternative");
 846                Next_Token;
 847          end case;
 848       end loop;
 849
 850       return S (Rewritten_Line);
 851    end Rewrite_Source_Line;
 852
 853    -------------------------
 854    -- Process_Source_File --
 855    -------------------------
 856
 857    procedure Process_Source_File is
 858    begin
 859       while not End_Of_File (Source_File.Data) loop
 860          declare
 861             Line      : constant String := Get_Line (Source_File'Access);
 862
 863             Rewritten : constant String := Rewrite_Source_Line (Line);
 864             --  We unconditionally rewrite the line so that we can check the
 865             --  syntax of all lines, and not only those which are actually
 866             --  included in the output.
 867
 868          begin
 869             if First_Time
 870               and then Line'Length > 3 and then Line (1 .. 3) = "@if"
 871             then
 872                Put_Line (Output_File, "@set " & Argument (1));
 873                First_Time := False;
 874             end if;
 875
 876             Put_Line (Output_File, Rewritten);
 877          end;
 878       end loop;
 879    end Process_Source_File;
 880
 881    ---------------------------
 882    -- Initialize_Extensions --
 883    ---------------------------
 884
 885    procedure Initialize_Extensions is
 886
 887       procedure Add (Extension : String);
 888       --  Adds an extension which is replaced with itself (in upper case)
 889
 890       procedure Add (Extension, Replacement : String);
 891       --  Adds an extension with a custom replacement
 892
 893       ---------
 894       -- Add --
 895       ---------
 896
 897       procedure Add (Extension : String) is
 898       begin
 899          Add (Extension, Translate (Extension, Upper_Case_Map));
 900       end Add;
 901
 902       procedure Add (Extension, Replacement : String) is
 903       begin
 904          Set (Extensions, Extension, V (Replacement));
 905       end Add;
 906
 907    --  Start of processing for Initialize_Extensions
 908
 909    begin
 910       --  To avoid performance degradation, increase the constant in the
 911       --  definition of Extensions above if you add more extensions here.
 912
 913       Add ("o", "OBJ");
 914       Add ("ads");
 915       Add ("adb");
 916       Add ("ali");
 917       Add ("ada");
 918       Add ("atb");
 919       Add ("ats");
 920       Add ("adc");
 921       Add ("c");
 922    end Initialize_Extensions;
 923
 924    ------------------
 925    -- Is_Extension --
 926    ------------------
 927
 928    function Is_Extension (Extension : String) return Boolean is
 929    begin
 930       return Present (Extensions, Extension);
 931    end Is_Extension;
 932
 933    -------------------------------
 934    -- Get_Replacement_Extension --
 935    -------------------------------
 936
 937    function Get_Replacement_Extension (Extension : String) return String is
 938    begin
 939       return S (Get (Extensions, Extension));
 940    end Get_Replacement_Extension;
 941
 942    -------------------
 943    -- Is_Known_Word --
 944    -------------------
 945
 946    function Is_Known_Word (Word : String) return Boolean is
 947    begin
 948       return Present (Ug_Words, Word);
 949    end Is_Known_Word;
 950
 951    --------------------------
 952    -- Get_Replacement_Word --
 953    --------------------------
 954
 955    function Get_Replacement_Word (Word : String) return String is
 956    begin
 957       return S (Get (Ug_Words, Word));
 958    end Get_Replacement_Word;
 959
 960 --  Start of processing for Xgnatugn
 961
 962    Valid_Command_Line : Boolean;
 963    Output_File_Name   : VString;
 964
 965 begin
 966    Initialize_Extensions;
 967    Valid_Command_Line := Argument_Count in 3 .. 5;
 968
 969    --  First argument: Target
 970
 971    if Valid_Command_Line then
 972       begin
 973          Target := Flag_Type'Value (Argument (1));
 974
 975          if not Target'Valid then
 976             Valid_Command_Line := False;
 977          end if;
 978
 979       exception
 980          when Constraint_Error =>
 981             Valid_Command_Line := False;
 982       end;
 983    end if;
 984
 985    --  Second argument: Source_File
 986
 987    if Valid_Command_Line then
 988       begin
 989          Source_File.Name := V (Argument (2));
 990          Open (Source_File.Data, In_File, Argument (2));
 991
 992       exception
 993          when Ada.Text_IO.Name_Error =>
 994             Valid_Command_Line := False;
 995       end;
 996    end if;
 997
 998    --  Third argument: Dictionary_File
 999
1000    if Valid_Command_Line then
1001       begin
1002          Dictionary_File.Name := V (Argument (3));
1003          Open (Dictionary_File.Data, In_File, Argument (3));
1004
1005       exception
1006          when Ada.Text_IO.Name_Error =>
1007             Valid_Command_Line := False;
1008       end;
1009    end if;
1010
1011    --  Fourth argument: Output_File
1012
1013    if Valid_Command_Line then
1014       if Argument_Count in 4 .. 5 then
1015          Output_File_Name := V (Argument (4));
1016       else
1017          case Target is
1018             when UNW =>
1019                Output_File_Name := V ("gnat_ugn_unw.texi");
1020             when VMS =>
1021                Output_File_Name := V ("gnat_ugn_vms.texi");
1022          end case;
1023       end if;
1024
1025       Warnings_Enabled := Argument_Count = 5;
1026
1027       begin
1028          Create (Output_File, Out_File, S (Output_File_Name));
1029
1030       exception
1031          when Ada.Text_IO.Name_Error | Ada.Text_IO.Use_Error =>
1032             Valid_Command_Line := False;
1033       end;
1034    end if;
1035
1036    if not Valid_Command_Line then
1037       Usage;
1038       Set_Exit_Status (Failure);
1039
1040    else
1041       Read_Dictionary_File;
1042       Close (Dictionary_File.Data);
1043
1044       --  Main processing starts here
1045
1046       Process_Source_File;
1047       Close (Output_File);
1048       Close (Source_File.Data);
1049
1050       New_Line (Standard_Error);
1051
1052       if Number_Of_Warnings = 0 then
1053          Put_Line (Standard_Error, " NO Warnings");
1054
1055       else
1056          Put (Standard_Error, Integer'Image (Number_Of_Warnings));
1057          Put (Standard_Error, " Warning");
1058
1059          if Number_Of_Warnings > 1 then
1060             Put (Standard_Error, "s");
1061          end if;
1062
1063          New_Line (Standard_Error);
1064       end if;
1065
1066       if Number_Of_Errors = 0 then
1067          Put_Line (Standard_Error, " NO Errors");
1068
1069       else
1070          Put (Standard_Error, Integer'Image (Number_Of_Errors));
1071          Put (Standard_Error, " Error");
1072
1073          if Number_Of_Errors > 1 then
1074             Put (Standard_Error, "s");
1075          end if;
1076
1077          New_Line (Standard_Error);
1078       end if;
1079
1080       if Number_Of_Errors /= 0  then
1081          Set_Exit_Status (Failure);
1082       else
1083          Set_Exit_Status (Success);
1084       end if;
1085    end if;
1086 end Xgnatugn;