------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                        G N A T P P . O U T P U T                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2011, AdaCore                      --
--                                                                          --
-- GNATPP 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 2,  or (at your option) any later ver- --
-- sion.  GNATPP is  distributed in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY 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 COPYING. If not, --
-- write to the Free Software Foundation,  51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- GNATPP is maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;   use Ada.Characters.Handling;
with Ada.Sequential_IO;

with Ada.Text_IO;
with Ada.Wide_Text_IO;          use Ada.Wide_Text_IO;

with GNAT.OS_Lib;               use GNAT.OS_Lib;

with Hostparm;

with ASIS_UL.Common;
with ASIS_UL.Options;           use ASIS_UL.Options;
with ASIS_UL.Output;            use ASIS_UL.Output;

with GNATPP.Common;             use GNATPP.Common;
with GNATPP.Options;            use GNATPP.Options;
with GNATPP.State;              use GNATPP.State;

package body GNATPP.Output is

   Out_Suffix : String_Access;
   --  The suffix of the file to put the pretty-printed source in

   Backup_Suffix : String_Access;
   --  The suffix of the file to put the back-up copy of the argument source
   --  in case if we rewrite it with the pretty-printed source.

   package Char_Sequential_IO is new Ada.Sequential_IO (Character);
   --  Used by the Correct_EOL text filter

   Filter_Tmp_FD     : GNAT.OS_Lib.File_Descriptor;
   Filter_Tmp_Name   : GNAT.OS_Lib.Temp_File_Name;
   Filter_Tmp_Seq_FD : Char_Sequential_IO.File_Type;
   --  Temporary file where Correct_EOL writes the copy of the result source
   --  with the corrected line ends. The only reason to use the file stuff from
   --  GNAT.OS_lib is to get the temporary file name.

--   Trailing_Spaces_Filter_Tmp_FD : Ada.Wide_Text_IO.File_Type;
   Trailing_Spaces_Filter_Tmp_FD : Ada.Text_IO.File_Type;
   --  Temporary file used when removing trailing spaces

   Result_FD         : Ada.Text_IO.File_Type;
   --  The same as Result_Out_File, but viewed by Ada.Text_IO, not
   --  Ada.Wide_Text_IO;

   Tmp_Line_Buf      : String      (1 .. Line_Len_Limit);
--   Tmp_Wide_Line_Buf : Wide_String (1 .. Line_Len_Limit);
   Tmp_Line_Len      : Natural range 0 .. Line_Len_Limit;
   --  Buffer to read one line of the result file. Note that we use
   --  GNATPP.Options.Line_Len_Limit, so in any case this buffer will have
   --  enough room for a line read from the result file.

   ----------------
   -- Brief_Help --
   ----------------

   procedure Brief_Help is
   begin
      pragma Style_Checks (Off);
      Info ("usage: gnatpp [options] {filename} {-file filename} " &
            "[-cargs gcc_switches]");
      Info (" options (in alphabetic order):");

      Info (" -A(0|1|2|3|4|5) - set alignment, all the alignments are set " &
           "ON by default");
      Info ("   0 - set the default for all the alignments OFF");
      Info ("   1 - align colons in declarations");
      Info ("   2 - align assignments in declarations");
      Info ("   3 - align assignments in assignment statements");
      Info ("   4 - align arrow delimiters in associations");
      Info ("   5 - align 'AT' keywords in component clauses");

      Info (" -a(L|U|M) - set attribute casing");
      Info ("   L - lower case");
      Info ("   U - upper case");
      Info ("   M - mixed case (set as default)");

      Info (" -c(0|1|2|3|4|5) - comments layout");
      Info ("   0 - do not format comments");
      Info ("   1 - GNAT style comment line indentation (set as default)");
      Info ("   2 - standard comment line indentation");
      Info ("   3 - GNAT style comment beginning");
      Info ("   4 - reformat comment blocks");
      Info ("   5 - do not change comments with a special character " &
            "just after --");

      Info (" -clnnn - indentation level for continuation lines, " &
            "nnn from 1 .. 9");

      Info (" -D<file> - set <file> as the dictionary file defining casing " &
            "exceptions");
      Info (" -D-      - do not use RM95-defined casing for predefined " &
            "names, use casing ");
      Info ("            defined by -n parameter and dictionary file(s) " &
            "instead");

      Info (" -e  - do not set missed end/exit labels");
      Info (" -ff - put Form Feed after a pragma Page");
      Info (" -gnatec<path> - the same as GNAT -gnatec option");
      Info (" -innn - indentation level, nnn from 1 .. 9, " &
            "the default value is 3");

      Info (" -I<dir> - the same as gcc -I option");

      Info (" -I-     - the same as gcc -I- option");

      Info (" -k(L|U) - set keyword casing");
      Info ("   L - lower case (set as default)");
      Info ("   U - upper case");

      Info (" -l(1|2|3) - set construct layout");
      Info ("   1 - GNAT style layout (set as default)");
      Info ("   2 - compact layout");
      Info ("   3 - uncompact layout");

      Info (" -Mnnn - set maximum line length, nnn from 32 .. 256, " &
            "the default value is 79");

      Info (" -n(D|U|L|M) - set name casing (for both defining and usage " &
            "occurrences)");
      Info ("   D - as declared (set as default)");
      Info ("   U - all in upper case");
      Info ("   L - all in lower case");
      Info ("   M - mixed");

      Info (" -ne(D|U|L|M) - set enumeration literal casing (for both defining and usage");
      Info ("                occurrences), parameters have the same meaning as for -n option");
      Info ("                if not set, -n is used to define enumeration literal casing");

      Info (" -N - no tabulation in comments");

      Info (" -p(L|U|M) - set pragma casing");
      Info ("   L - lower case");
      Info ("   U - upper case");
      Info ("   M - mixed case (set as default)");

      Info (" --RTS=<dir> - the same as gcc --RTS option");

      Info (" -Tnnn - do not use additional indentation level for case " &
            "alternatives");
      Info ("   and variants if their number is nnn or more " &
            "(the default value is 10)");

      Info (" -q  - quiet mode");

      Info (" --no-separate-is        - try not to place 'IS' on a separate " &
            " line in");
      Info ("                           a subprogram body");
      Info (" --separate-label        - use separate line for " &
            "statement label");
      Info (" --separate-loop-then    - use a separate line for LOOP and " &
            "THEN keywords");

      Info (" --no-separate-loop-then - do not use a separate line for LOOP " &
            "and THEN");
      Info ("                           keywords, uncompatible with " &
            "--separate-loop-then");

      Info (" --use-on-new-line       - use separate lines for USE clauses ");
      Info ("                           in a context clause");

      Info (" --separate-stmt-name    - use separate line for " &
            "statement name ");
      Info ("                           with no extra indentation for " &
            "statement itself");

      Info (" --RM-style-spacing      - use Ada RM style for spacing before " &
            "'(' and ':'");

      Info (" --par_threshold=nnn     - if the number of parameter specifications is greater");
      Info ("                           than nnn, each specification starts from a new line");

      Info (" --call_threshold=nnn    - if the number of parameter associations in a call is");
      Info ("                           greater than nnn and there is at least one named");
      Info ("                           association, each association starts from a new line");

      Info (" -v  - verbose mode");

      Info (" -dd - progress indicator verbose mode");

      Info (" -w  - warnings ON");
      Info ("");

      Info ("Output file control:");
      Info (" -pipe - send the output into Stdout");
      Info (" -o output_file - write the output into output_file. Give up " &
            "if output_file");
      Info ("                  already exists");
      Info (" -of output_file - write the output into output_file, " &
            "overriding the existing ");
      Info ("                   file");
      Info (" -r   - replace the argument source with the pretty-printed" &
            " source and copy the");
      Info ("        argument source into filename" & NPP_Suffix &
            ". Give up if filename" &  NPP_Suffix);
      Info ("        already exists");
      Info (" -rf  - replace the argument source with the pretty-printed " &
            "source and copy the");
      Info ("        argument source into filename" & NPP_Suffix &
            ", overriding the existing file");

      Info (" -rnb - replace the argument source with the pretty-printed " &
            "source and do not");
      Info ("        create the back-up copy of the argument source");
      Info ("");

      Info (" filename - the name of the Ada source file to be reformatted. ");
      Info ("            Wildcards are allowed");
      Info (" -files=filemane - the name of the text file containing a list");
      Info ("                   of Ada source files to reformat");
      Info (" --eol=text_format - sets the format of the gnatpp output " &
        "file(s),");
      Info ("                    can not be used together with -pipe option");
      Info ("       text_format can be - 'unix' or 'lf'   - lines end with " &
        "LF character");
      Info ("                          - 'dos'  or 'crlf' - lines end with " &
        "CRLF characters");

      Info (" -W(h|u|s|e|8|b) - sets the wide character encoding of the " &
        "result file");
      Info ("    h - Hex ESC encoding");
      Info ("    u - Upper half encoding");
      Info ("    s - Shift-JIS encoding");
      Info ("    e - EUC Encoding");
      Info ("    8 - UTF-8 encoding");
      Info ("    b - Brackets encoding (this is the default)");
      Info ("");

      Info (" gcc_switches - switches to be passed to gcc called by " &
            ASIS_UL.Common.Tool_Name.all);

      pragma Style_Checks (On);
   end Brief_Help;

   -----------------
   -- Correct_EOL --
   -----------------

   procedure Correct_EOL is
      Success : Boolean;
   begin

      GNAT.OS_Lib.Create_Temp_File
        (FD   => Filter_Tmp_FD,
         Name => Filter_Tmp_Name);

      GNAT.OS_Lib.Close (Filter_Tmp_FD);

      Char_Sequential_IO.Open
        (File => Filter_Tmp_Seq_FD,
         Mode => Char_Sequential_IO.Out_File,
         Name => Filter_Tmp_Name);

      Ada.Text_IO.Open
        (File => Result_FD,
         Mode => Ada.Text_IO.In_File,
         Name => Res_File_Name.all);

      while not Ada.Text_IO.End_Of_File (Result_FD) loop

         Ada.Text_IO.Get_Line
           (File => Result_FD,
            Item => Tmp_Line_Buf,
            Last => Tmp_Line_Len);

         for J in 1 .. Tmp_Line_Len loop
            Char_Sequential_IO.Write
              (File => Filter_Tmp_Seq_FD,
               Item => Tmp_Line_Buf (J));
         end loop;

         case Out_File_Format is
            when Default =>
               pragma Assert (False);
               null;
            when CRLF =>
               Char_Sequential_IO.Write
                 (File => Filter_Tmp_Seq_FD,
                  Item => ASCII.CR);
               Char_Sequential_IO.Write
                 (File => Filter_Tmp_Seq_FD,
                  Item => ASCII.LF);
            when LF =>
               Char_Sequential_IO.Write
                 (File => Filter_Tmp_Seq_FD,
                  Item => ASCII.LF);
         end case;

      end loop;

      Char_Sequential_IO.Close (File => Filter_Tmp_Seq_FD);

      Ada.Text_IO.Close (File => Result_FD);

      if Hostparm.OpenVMS then
         Copy_File
           (Name     => Filter_Tmp_Name,
            Pathname => Res_File_Name.all,
            Success  => Success,
            Mode     => Overwrite,
            Preserve => None);

      else
         Copy_File
           (Name     => Filter_Tmp_Name,
            Pathname => Res_File_Name.all,
            Success  => Success,
            Mode     => Overwrite);
      end if;

      if not Success then
         Put (Standard_Error, "gnatpp: cannot convert the line ends for ");
         Put (Standard_Error, To_Wide_String (Res_File_Name.all));
         New_Line (Standard_Error);
      end if;

      GNAT.OS_Lib.Delete_File (Filter_Tmp_Name, Success);

      if not Success then
         Put (Standard_Error, "gnatpp: cannot delete the line end ");
         Put (Standard_Error, "filter temp file");
         New_Line (Standard_Error);
      end if;

   end Correct_EOL;

   -----------------------------
   -- Correct_Trailing_Spaces --
   -----------------------------

   procedure Correct_Trailing_Spaces is
      Success : Boolean;
   begin
      GNAT.OS_Lib.Create_Temp_File
        (FD   => Filter_Tmp_FD,
         Name => Filter_Tmp_Name);

      GNAT.OS_Lib.Close (Filter_Tmp_FD);

      Ada.Text_IO.Open
        (File => Trailing_Spaces_Filter_Tmp_FD,
         Mode => Ada.Text_IO.Out_File,
         Name => Filter_Tmp_Name);

      Ada.Text_IO.Open
        (File => Result_FD,
         Mode => Ada.Text_IO.In_File,
         Name => Res_File_Name.all);

      while not Ada.Text_IO.End_Of_File (Result_FD) loop

         Ada.Text_IO.Get_Line
           (File => Result_FD,
            Item => Tmp_Line_Buf,
            Last => Tmp_Line_Len);

         for J in reverse 1 .. Tmp_Line_Len loop
            if Tmp_Line_Buf (J) /= ' ' then
               Tmp_Line_Len := J;
               exit;
            end if;
         end loop;

         Ada.Text_IO.Put_Line
           (File => Trailing_Spaces_Filter_Tmp_FD,
            Item => Tmp_Line_Buf (1 .. Tmp_Line_Len));
      end loop;

      Ada.Text_IO.Close (File => Trailing_Spaces_Filter_Tmp_FD);

      Ada.Text_IO.Close (File => Result_FD);

      if Hostparm.OpenVMS then
         Copy_File
           (Name     => Filter_Tmp_Name,
            Pathname => Res_File_Name.all,
            Success  => Success,
            Mode     => Overwrite,
            Preserve => None);

      else
         Copy_File
           (Name     => Filter_Tmp_Name,
            Pathname => Res_File_Name.all,
            Success  => Success,
            Mode     => Overwrite);
      end if;

      if not Success then
         Put (Standard_Error, "gnatpp: cannot delete trailing spaces for ");
         Put (Standard_Error, To_Wide_String (Res_File_Name.all));
         New_Line (Standard_Error);
      end if;

      GNAT.OS_Lib.Delete_File (Filter_Tmp_Name, Success);

      if not Success then
         Put (Standard_Error, "gnatpp: cannot delete the trailing spaces ");
         Put (Standard_Error, "filter temp file");
         New_Line (Standard_Error);
      end if;

   end Correct_Trailing_Spaces;

   ----------------
   -- NPP_Suffix --
   ----------------

   function NPP_Suffix return String is
   begin

      if Hostparm.OpenVMS then
         return "$NPP";
      else
         return ".npp";
      end if;

   end NPP_Suffix;

   ---------------
   -- PP_Suffix --
   ---------------

   function PP_Suffix  return String is
   begin

      if Hostparm.OpenVMS then
         return "$PP";
      else
         return ".pp";
      end if;

   end PP_Suffix;

   ---------------------
   -- Set_Form_String --
   ---------------------

   procedure Set_Form_String is
   begin

      case Output_Encoding is
         when Hex_ESC =>
            Free (Form_String);
            Form_String := new String'("WCEM=h");
         when Upper_Half =>
            Free (Form_String);
            Form_String := new String'("WCEM=u");
         when Shift_JIS =>
            Free (Form_String);
            Form_String := new String'("WCEM=s");
         when EUC =>
            Free (Form_String);
            Form_String := new String'("WCEM=e");
         when UTF_8 =>
            Free (Form_String);
            Form_String := new String'("WCEM=8");
         when Brackets =>
            Free (Form_String);
            Form_String := new String'("WCEM=b");
         when Default =>
            null;
      end case;

   end Set_Form_String;

   ----------------
   -- Set_Output --
   ----------------

   procedure Set_Output (SF : SF_Id; Success : out Boolean) is
   begin

      Success := True;

--      if Output_Mode not in Replace .. Replace_No_Backup then
--         Free (Res_File_Name);
--      end if;

      case Output_Mode is
         when Pipe =>
            null;
         when Create_File .. Force_Create_File  =>
            --  Can be only if we have only one argument source
            --  All the checks and settings are made in
            --  GNATPP.Environment.Check_Parameters
            null;

         when Replace .. Replace_No_Backup =>

            if Output_Mode = Replace and then
               Is_Regular_File (Source_Name (SF) & Backup_Suffix.all)
            then
               Put (Standard_Error, "gnatpp: file ");
               Put (Standard_Error, To_Wide_String (Res_File_Name.all));
               Put (Standard_Error, " exists. Use '-rf' option to override");
               New_Line (Standard_Error);
               Success := False;
            end if;

            if Success and then Output_Mode /= Replace_No_Backup then

               if Verbose_Mode then
                  Put (Standard_Error, "gnatpp: creating the back-up copy ");
                  Put (Standard_Error, "of the original source ");
                  Put (Standard_Error, To_Wide_String (Source_Name (SF)));
                  New_Line (Standard_Error);
               end if;

               if Hostparm.OpenVMS then
                  Copy_File
                    (Name     => Source_Name (SF),
                     Pathname => Source_Name (SF) & Backup_Suffix.all,
                     Success  => Success,
                     Mode     => Overwrite,
                     Preserve => None);

               else
                  Copy_File
                    (Name     => Source_Name (SF),
                     Pathname => Source_Name (SF) & Backup_Suffix.all,
                     Success  => Success,
                     Mode     => Overwrite);
               end if;

               if not Success then
                  Put (Standard_Error, "gnatpp: can not create ");
                  Put (Standard_Error, "the back-up copy for ");
                  Put (Standard_Error, To_Wide_String (Source_Name (SF)));
                  New_Line (Standard_Error);
               end if;

            end if;

         when Default =>
            Res_File_Name := new String'(Source_Name (SF) & Out_Suffix.all);
            Out_File_Exists := Is_Regular_File (Res_File_Name.all);
      end case;

      if Success
        and then
         Output_Mode /= Pipe
        and then
         Output_Mode not in Create_File .. Force_Create_File
      then

         if Out_File_Exists then
            Open (File => Result_Out_File,
                  Mode => Out_File,
                  Name => Res_File_Name.all,
                  Form => Form_String.all);
         else
            Create (File => Result_Out_File,
                    Mode => Out_File,
                    Name => Res_File_Name.all,
                    Form => Form_String.all);
         end if;

      end if;

      if Output_Mode = Pipe then
         Set_Output (Ada.Wide_Text_IO.Standard_Output);
      elsif Success then
         Set_Output (Result_Out_File);
      end if;

   exception
      when Status_Error =>
         Put (Standard_Error, "gnatpp: can not write in ");

         if Res_File_Name /= null then
            Put (Standard_Error, To_Wide_String (Res_File_Name.all));
         end if;

         New_Line (Standard_Error);

         Put (Standard_Error, "the file is probably in use");
         New_Line (Standard_Error);

         Success := False;

         --  ??? Source file status

      when Name_Error | Use_Error =>
         Put (Standard_Error, "gnatpp: can not write in ");

         if Res_File_Name /= null then
            Put (Standard_Error, To_Wide_String (Res_File_Name.all));
         end if;

         New_Line (Standard_Error);
         Put (Standard_Error, "check the file name");
         New_Line (Standard_Error);

         Success := False;

         --  ??? Source file status

      when Ex : others =>
         Report_Unhandled_Exception (Ex);

         Success := False;

         --  ??? Source file status

   end Set_Output;

   --------------
   -- XML_Help --
   --------------

   procedure XML_Help is
   begin
      pragma Style_Checks (Off);

      Info ("<switches lines=""4"">");
      Info ("");
      Info ("   <title line=""1"" ></title>");
      Info ("   <title line=""2"" >Layout</title>");
      Info ("   <title line=""3"" >Output file format</title>");
      Info ("   <title line=""4"" >General</title>");
      Info ("");
      Info ("   <popup label=""Spacing"" line =""1"" lines=""3"">");
      Info ("");
      Info ("      <spin label=""Indentation"" switch=""-i"" min=""1"" max=""9"" default=""3"">");
      Info ("         <tip> number of speces for each indentation level </tip>");
      Info ("      </spin>");
      Info ("");
      Info ("      <spin label=""Continuation lines"" switch=""-cl"" min=""1"" max=""9"" default=""2""");
      Info ("            tip=""indentation level for a continuation line"" />");
      Info ("      <spin label=""Maximum line length"" switch=""-M"" min=""20"" max=""256""");
      Info ("            default=""79"" />");
      Info ("   </popup>");
      Info ("");
      Info ("   <popup label=""Casing"" line=""1"" lines=""6"">");
      Info ("      <combo label=""Name"" switch=""-n"" line=""1"" noswitch=""D""");
      Info ("             tip=""identifier casing"" >");
      Info ("         <combo-entry label=""As declared"" value=""D"" />");
      Info ("         <combo-entry label=""Lower case"" value=""L"" />");
      Info ("         <combo-entry label=""Upper case"" value=""U"" />");
      Info ("         <combo-entry label=""Mixed case"" value=""M"" />");
      Info ("      </combo>");
      Info ("");
      Info ("      <combo label=""Enumeration literal"" switch=""-ne"" line=""1"" noswitch=""D"">");
      Info ("         <combo-entry label=""As declared"" value=""D"" />");
      Info ("         <combo-entry label=""Lower case"" value=""L"" />");
      Info ("         <combo-entry label=""Upper case"" value=""U"" />");
      Info ("         <combo-entry label=""Mixed case"" value=""M"" />");
      Info ("      </combo>");
      Info ("");
      Info ("      <field label=""Keep casing"" line=""2"" switch=""-D"" as-file=""true""");
      Info ("             tip=""specifies the dictionary with the names to keep casing unchanged"" />");
      Info ("");
      Info ("      <check label=""Do not use default dictionaries"" switch=""-D-"" line=""3""");
      Info ("             tip=""Do not keep casing defined for Ada predefined names and names from GNAT library"" />");
      Info ("");
      Info ("      <combo label=""Keyword"" switch=""-k"" line=""4"" noswitch=""L"" nodigit=""L"" >");
      Info ("         <combo-entry label=""Lower case"" value=""L"" />");
      Info ("         <combo-entry label=""Upper case"" value=""U"" />");
      Info ("      </combo>");
      Info ("");
      Info ("      <combo label=""Attribute"" switch=""-a"" line=""5"" noswitch=""M"" nodigit=""M"" >");
      Info ("         <combo-entry label=""Mixed case"" value=""M"" />");
      Info ("         <combo-entry label=""Lower case"" value=""L"" />");
      Info ("         <combo-entry label=""Upper case"" value=""U"" />");
      Info ("      </combo>");
      Info ("      <combo label=""Pragma"" switch=""-p"" line=""6"" noswitch=""M"" nodigit=""M"" >");
      Info ("         <combo-entry label=""Mixed case"" value=""M"" />");
      Info ("         <combo-entry label=""Lower case"" value=""L"" />");
      Info ("         <combo-entry label=""Upper case"" value=""U"" />");
      Info ("      </combo>");
      Info ("");
      Info ("   </popup>");
      Info ("");
      Info ("   <popup label=""Alignment"" line =""1"" lines=""6"">");
      Info ("");
      Info ("          <check label=""Default for all alignments OFF""");
      Info ("                 tip=""all the alignments are off except of those that are selected explicitly""");
      Info ("                 switch=""-A0"" line=""1"" />");
      Info ("          <check label=""Colons in declarations"" switch=""-A1"" line=""2"" />");
      Info ("          <check label=""Assignments in declarations"" switch=""-A2"" line=""3"" />");
      Info ("          <check label=""Assignments in statements"" switch=""-A3"" line=""4"" />");
      Info ("          <check label=""Arrow delimiters in associations"" switch=""-A4"" line=""5"" />");
      Info ("          <check label=""AT keywords in component clauses"" switch=""-A5"" line=""6"" />");
      Info ("   </popup>");
      Info ("");
      Info ("   <combo label=""Construct"" switch=""-l"" line=""2"" noswitch=""1"" nodigit=""1"" >");
      Info ("      <combo-entry label=""GNAT style"" value=""1"" />");
      Info ("      <combo-entry label=""Compact"" value=""2"" />");
      Info ("      <combo-entry label=""Uncompact"" value=""3"" />");
      Info ("   </combo>");
      Info ("   <combo label=""Comment"" switch=""-c"" line=""2"" noswitch=""1"" nodigit=""1"" >");
      Info ("      <combo-entry label=""Unchanged"" value=""0"" />");
      Info ("      <combo-entry label=""GNAT style line indentation"" value=""1"" />");
      Info ("      <combo-entry label=""Standard line indentation"" value=""2"" />");
      Info ("   </combo>");
      Info ("   <check label=""GNAT style beginning"" switch=""-c3"" line=""2"" />");
      Info ("   <check label=""Reformat blocks"" switch=""-c4"" line=""2"" />");
      Info ("   <check label=""Leave special comments unchanged"" switch=""-c5"" line=""2"" />");
      Info ("   <check label=""No TAB character in comments"" switch=""-N"" line=""2"" />");
      Info ("");
      Info ("   <combo label=""Result file format"" switch=""--eol="" line=""3"" noswitch=""default"">");
      Info ("      <combo-entry label=""default"" value=""default"" />");
      Info ("      <combo-entry label=""UNIX"" value=""unix"" />");
      Info ("      <combo-entry label=""DOS"" value=""dos"" />");
      Info ("   </combo>");
      Info ("");
      Info ("   <combo label=""Wide character encoding"" switch=""-W"" line=""3"" noswitch=""b"" nodigit=""b"">");
      Info ("      <combo-entry label=""Hex ESC encoding"" value=""h"" />");
      Info ("      <combo-entry label=""Upper half encoding"" value=""u"" />");
      Info ("      <combo-entry label=""Shift-JIS encoding"" value=""s"" />");
      Info ("      <combo-entry label=""EUC Encoding"" value=""e"" />");
      Info ("      <combo-entry label=""UTF-8 encoding"" value=""8"" />");
      Info ("      <combo-entry label=""Brackets encoding"" value=""b"" />");
      Info ("   </combo>");
      Info ("");
      Info ("   <check label=""Do not set missing end/exit labels"" switch=""-e"" line=""4"" />");
      Info ("   <check label=""Put Form Feed after a pragma Page"" switch=""-ff"" line=""4"" />");
      Info ("   <check label=""Do not place IS on a separate  line"" switch=""--no-separate-is"" line=""4"" />");
      Info ("   <check label=""Use separate line for label(s)"" switch=""--separate-label"" line=""4"" />");
      Info ("   <check label=""Use separate line for LOOP and THEN"" switch=""--separate-loop-then"" line=""4"" />");
      Info ("   <check label=""Do not use separate line for LOOP and THEN"" switch=""--no-separate-loop-then"" line=""4"" />");
      Info ("   <check label=""Use separate lines for USE clauses""");
      Info ("          tip=""Use separate lines for USE clauses in a context clause""");
      Info ("          switch=""--use-on-new-line"" line=""4"" />");
      Info ("   <check label=""Use separate line for statement name""");
      Info ("          tip=""Use separate line for statement name with no extra indentation for statement itself""");
      Info ("          switch=""--separate-stmt-name"" line=""4"" />");
      Info ("</switches>");

      pragma Style_Checks (On);
   end XML_Help;

begin
   Out_Suffix    := new String'(PP_Suffix);
   Backup_Suffix := new String'(NPP_Suffix);
end GNATPP.Output;
