------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                        G N A T P P . O U T P U T                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2006, 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 Gnatvsn;
with Hostparm;

with Asis.Implementation;       use Asis.Implementation;

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

package body GNATPP.Output is

   Current_SF : SF_Id;
   --  The Id of the currently reformatted source

   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.

   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_Line_Len : Natural range 0 .. Line_Len_Limit;
   --  Buffer to read ome 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
      Tmp_Output : constant File_Access := Current_Output;
   begin
      Set_Output (Standard_Error);

      Put ("usage: gnatpp [options] {filename} {-file filename} ");
      Put ("[gcc_switches]");
      New_Line;
      Put (" options (in alphabetic order):");
      New_Line;

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

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

      Put (" -c(0|1|2|3|4) - comments layout");
      New_Line;
      Put ("   0 - do not format comments");
      New_Line;
      Put ("   1 - GNAT style comment line indentation (set as default)");
      New_Line;
      Put ("   2 - standard comment line indentation");
      New_Line;
      Put ("   3 - GNAT style comment beginning");
      New_Line;
      Put ("   4 - reformat comment blocks");
      New_Line;

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

      Put (" -D<file> - set <file> as the dictionary file defining casing ");
      Put ("exceptions");
      New_Line;

      Put (" -D-      - do not use RM95-defined casing for predefined names,");
      Put (" use casing ");
      New_Line;
      Put ("            defined by -n parameter and dictionary file(s) ");
      Put ("instead");
      New_Line;

      Put (" -e  - do not set missed end/exit labels");
      New_Line;

      Put (" -ff - put Form Feed after a pragma Page");
      New_Line;

      Put (" -gnatec<path> - the same as GNAT -gnatec option");
      New_Line;

      Put (" -innn - indentation level, nnn from 1 .. 9, ");
      Put ("the default value is 3");
      New_Line;

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

      Put (" -I-     - the same as gcc -I- option");
      New_Line;

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

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

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

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

      Put (" -N - no tabulation in comments");
      New_Line;

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

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

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

      Put (" -q  - quiet mode");
      New_Line;

      Put (" --no-separate-is - try not to place 'IS' on a separate line in");
      New_Line;
      Put ("                    a subprogram body");
      New_Line;

      Put (" -v  - verbose mode");
      New_Line;

      Put (" -dd - progress indicator verbose mode");
      New_Line;

      Put (" -w  - warnings ON");
      New_Line;
      New_Line;

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

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

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

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

      New_Line;
      Put (" gcc_switches  '-cargs switches' where 'switches' is ");
      Put ("a list of of switches");
      New_Line;
      Put ("               that are valid switches for gcc");
      New_Line;

      Set_Output (Tmp_Output.all);
   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: can not 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: can not delete the line end ");
         Put (Standard_Error, "filter temp file");
         New_Line (Standard_Error);
      end if;

   end Correct_EOL;

   -----------
   -- Error --
   -----------

   procedure Error (Diagnosis : Wide_String) is
   begin

      if Warnings_ON then
         Put_Line
           (Standard_Error,
            To_Wide_String (Short_Source_Name (Current_SF)) & ':' &
            To_Wide_String (Image (Current_Line)) & ':' &
            To_Wide_String (Image (Line_Pos)) & ": " & Diagnosis);
      end if;

   end Error;

   ----------------
   -- 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;

   ---------------------------
   -- Report_Total_Failures --
   ---------------------------

   procedure Report_Total_Failures is
      Faulire_Kinds  : Natural := 0;
      Total_Failures : Natural := 0;

      Total_Sources : constant SF_Id   := Last_Source;
   begin

      if Quiet_Mode
        or else
         not Multiple_File_Mode
        or else
         (Illegal_Sources   = 0 and then
          Tool_Failures     = 0 and then
          Out_File_Problems = 0)
      then
         return;
      end if;

      if Illegal_Sources > 0 then
         Put_Line
           (Standard_Error,
            "gnatpp:"                             &
             To_Wide_String (Illegal_Sources'Img) &
             " illegal sources out of"            &
             To_Wide_String (Total_Sources'Img)   &
             " argument sources");

         if Verbose_Mode then

            for J in First_SF_Id .. Total_Sources loop

               if Source_Status (J) = Not_A_Legal_Source then
                  Put_Line
                    (Standard_Error,
                     To_Wide_String (Source_Name (J)));
               end if;

            end loop;

            New_Line (Standard_Error);
         end if;

         Faulire_Kinds  := Faulire_Kinds + 1;
         Total_Failures := Total_Failures + Illegal_Sources;
      end if;

      if Tool_Failures > 0 then
         Put_Line
           (Standard_Error,
            "gnatpp:"                           &
             To_Wide_String (Tool_Failures'Img) &
             " gnatpp failures out of"          &
             To_Wide_String (Total_Sources'Img) &
             " argument sources");

         if Verbose_Mode then

            for J in First_SF_Id .. Total_Sources loop

               if Source_Status (J) = Error_Detected then
                  Put_Line
                    (Standard_Error,
                     To_Wide_String (Source_Name (J)));
               end if;

            end loop;

            New_Line (Standard_Error);
         end if;

         Faulire_Kinds  := Faulire_Kinds + 1;
         Total_Failures := Total_Failures + Tool_Failures;
      end if;

      if Out_File_Problems > 0 then
         Put_Line
           (Standard_Error,
            "gnatpp:"                               &
             To_Wide_String (Out_File_Problems'Img) &
             " out file problems out of"            &
             To_Wide_String (Total_Sources'Img)     &
             " argument sources");

         if Verbose_Mode then

            for J in First_SF_Id .. Total_Sources loop

               if Source_Status (J) = Out_File_Problem then
                  Put_Line
                    (Standard_Error,
                     To_Wide_String (Source_Name (J)));
               end if;

            end loop;

            New_Line (Standard_Error);
         end if;

         Faulire_Kinds  := Faulire_Kinds + 1;
         Total_Failures := Total_Failures + Out_File_Problems;
      end if;

      if Faulire_Kinds > 1 then
         Put_Line
           (Standard_Error,
            "gnatpp:"                            &
             To_Wide_String (Total_Failures'Img) &
             " total failures out of"            &
             To_Wide_String (Total_Sources'Img)  &
             " argument sources");
      end if;

   end Report_Total_Failures;

   -------------------------------------
   -- Report_Unhandled_ASIS_Exception --
   -------------------------------------

   procedure Report_Unhandled_ASIS_Exception (Ex : Exception_Occurrence) is
   begin
      Put (Standard_Error, "ASIS exception (");
      Put (Standard_Error,
           To_Wide_String (Ada.Exceptions.Exception_Name (Ex)));
      Put (Standard_Error, ") is raised");
      New_Line (Standard_Error);

      Put (Standard_Error, "ASIS Error Status is ");
      Put (Standard_Error, To_Wide_String (Asis.Implementation.Status'Img));
      New_Line (Standard_Error);

      Put (Standard_Error, "ASIS Diagnosis is ");
      New_Line (Standard_Error);
      Put (Standard_Error, Diagnosis);
      New_Line (Standard_Error);

      Asis.Implementation.Set_Status;
   end Report_Unhandled_ASIS_Exception;

   --------------------------------
   -- Report_Unhandled_Exception --
   --------------------------------

   procedure Report_Unhandled_Exception (Ex : Exception_Occurrence) is
   begin
      Put (Standard_Error,
           To_Wide_String (Ada.Exceptions.Exception_Information (Ex)));
   end Report_Unhandled_Exception;

   --------------------
   -- Set_Current_SF --
   --------------------

   procedure Set_Current_SF (SF : SF_Id) is
   begin
      Current_SF := SF;
   end Set_Current_SF;

   ---------------------
   -- 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;

   ------------------
   -- Version_Info --
   ------------------

   procedure Version_Info is
      Tmp_Output : constant File_Access := Current_Output;
   begin
      Set_Output (Standard_Error);

      Put ("GNATPP (built with ");
      Put (Asis.Implementation.ASIS_Implementor_Version);
      Put (")");
      New_Line;

      Put ("Copyright 2003-");
      Put (To_Wide_String (Gnatvsn.Current_Year));
      Put (", AdaCore.");
      New_Line;

      Set_Output (Tmp_Output.all);
   end Version_Info;

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