------------------------------------------------------------------------------
--                                  G P S                                   --
--                                                                          --
--                     Copyright (C) 2005-2013, AdaCore                     --
--                                                                          --
-- This is free software;  you can redistribute it  and/or modify it  under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  This software is distributed in the hope  that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY 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  this  software;   see  file --
-- COPYING3.  If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license.                                                          --
------------------------------------------------------------------------------

with Basic_Types;           use Basic_Types;
with GNATCOLL.Scripts;      use GNATCOLL.Scripts;
with GPS.Editors;           use GPS.Editors;
with GPS.Kernel;            use GPS.Kernel;
with GPS.Kernel.Contexts;   use GPS.Kernel.Contexts;
with GPS.Kernel.Scripts;    use GPS.Kernel.Scripts;
with GPS.Kernel.Modules;    use GPS.Kernel.Modules;
with GPS.Kernel.Modules.UI; use GPS.Kernel.Modules.UI;
with Commands.Interactive;  use Commands, Commands.Interactive;
with GNATCOLL.Utils;        use GNATCOLL.Utils;
with GNATCOLL.VFS;          use GNATCOLL.VFS;
with String_Utils;          use String_Utils;
with Traces;                use Traces;
with GPS.Intl;              use GPS.Intl;
with Refactoring.Performers; use Refactoring.Performers;
with Refactoring.Services;   use Refactoring.Services;

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with Language;               use Language;
with Language.Ada;           use Language.Ada;
with Language.Tree;          use Language.Tree;
with Language.Tree.Database; use Language.Tree.Database;
with Ada_Semantic_Tree;      use Ada_Semantic_Tree;
with Xref;                   use Xref;

package body Refactoring.Parameters is
   Me : constant Debug_Handle := Create ("Refactor.Params");

   Location_Cst               : aliased constant String := "location";

   type Is_Subprogram_Filter is new Action_Filter_Record with null record;
   overriding function Filter_Matches_Primitive
     (Filter  : access Is_Subprogram_Filter;
      Context : Selection_Context) return Boolean;
   --  Filter that checks that the user has clicked on a subprogram entity

   type Name_Parameters_Command is new Interactive_Command with null record;
   overriding function Execute
     (Command : access Name_Parameters_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;
   --  Called for "Name Parameters" menu

   procedure Entity_Command_Handler
     (Data : in out Callback_Data'Class; Command : String);
   --  Handles shell commands

   function Name_Parameters
     (Context : not null access Factory_Context_Record'Class;
      Kernel : access Kernel_Handle_Record'Class;
      Entity : General_Entity;
      File   : GNATCOLL.VFS.Virtual_File;
      Line   : Integer;
      Column : Visible_Column_Type) return Command_Return_Type;
   --  Name the parameters for the call to Entity at the given location

   ------------------------------
   -- Filter_Matches_Primitive --
   ------------------------------

   overriding function Filter_Matches_Primitive
     (Filter  : access Is_Subprogram_Filter;
      Context : Selection_Context) return Boolean
   is
      pragma Unreferenced (Filter);
      Entity : constant General_Entity := Get_Entity (Context);
   begin
      return Entity /= No_General_Entity
        and then Get_Kernel (Context).Databases.Is_Subprogram (Entity);
   end Filter_Matches_Primitive;

   ---------------------
   -- Name_Parameters --
   ---------------------

   function Name_Parameters
     (Context : not null access Factory_Context_Record'Class;
      Kernel : access Kernel_Handle_Record'Class;
      Entity : General_Entity;
      File   : GNATCOLL.VFS.Virtual_File;
      Line   : Integer;
      Column : Visible_Column_Type) return Command_Return_Type
   is
      --  File needs to be open for get_chars to work, unfortunately
      View  : constant Editor_View'Class :=
        Context.Buffer_Factory.Get (File).Open;
      pragma Unreferenced (View);

      Chars : constant String := Get_Text
        (Kernel, File, Line, Column, 1_000);
      First, Last : Integer := Chars'First;
      Nest_Count  : Integer := 1;
      Result : Unbounded_String;

      Params : constant Parameter_Array :=
        Kernel.Databases.Parameters (Entity);
      Iter   : Integer := Params'First;

      procedure Add_Parameter_Name;
      --  Add the name of the parameter in Result, skipping any space currently
      --  pointed to by First.
      --  First should point to '(' or ',' in the string Chars. Any character
      --  preceding First and not yet copied to Result is copied first

      function Is_Dotted_Notation return Boolean;
      --  When using the dotted notation, we need to skip the first parameter.
      --  Since there is no explicit indication in the ALI file, we need to
      --  check what's before the "." just before the name (if there is a dot).
      --  If it is a tagged object and we have a primitive operation, we are
      --  using the dotted notation

      ------------------------
      -- Add_Parameter_Name --
      ------------------------

      procedure Add_Parameter_Name is
         Tmp : Natural;
      begin
         First := First + 1;
         Skip_Blanks (Chars, First);

         --  Do we have a named parameter already ?
         Tmp := First;
         Skip_Word   (Chars, Tmp);
         Skip_Blanks (Chars, Tmp);
         if Tmp + 1 <= Chars'Last and then Chars (Tmp .. Tmp + 1) = "=>" then
            --  No need to replace any more: There won't be any unnamed
            --  parameter afterward
            Iter := Integer'Last;

         else
            Result := Result & Chars (Last .. First - 1);
            Last := First;

            if Chars (First - 1) /= '(' then
               First := First - 1;
            end if;

            Append (Result,
                    Kernel.Databases.Get_Name (Params (Iter).Parameter)
                    & " => ");

            Iter := Iter + 1;
         end if;
      end Add_Parameter_Name;

      ------------------------
      -- Is_Dotted_Notation --
      ------------------------

      function Is_Dotted_Notation return Boolean is
         S_File : constant Structured_File_Access := Get_Or_Create
           (Db   => Kernel.Get_Construct_Database,
            File => File);

         Offset : constant String_Index_Type :=
           To_String_Index (S_File, Line, Column);

         Expression : Parsed_Expression :=
           Parse_Expression_Backward
             (Buffer       => Get_Buffer (S_File),
              Start_Offset => Offset);

         Entity_Before : General_Entity;
         Entity_Token : Token_Record;

         Tok_Line   : Integer;
         Tok_Column : Visible_Column_Type;
      begin
         --  We expect to have something like [id] [.] [call]. Otherwise, we're
         --  not on a prefixed notation

         if Token_List.Length (Expression.Tokens) < 3 then
            Free (Expression);
            return False;
         end if;

         Token_List.Remove_Nodes
           (Expression.Tokens,
            Token_List.Prev
              (Expression.Tokens, Token_List.Last (Expression.Tokens)));

         Entity_Token := Token_List.Data (Token_List.Last (Expression.Tokens));

         if Entity_Token.Tok_Type /= Tok_Dot then
            Free (Expression);
            return False;
         end if;

         Token_List.Remove_Nodes
           (Expression.Tokens,
            Token_List.Prev
              (Expression.Tokens, Token_List.Last (Expression.Tokens)));

         Entity_Token := Token_List.Data (Token_List.Last (Expression.Tokens));

         if Entity_Token.Tok_Type /= Tok_Identifier then
            Free (Expression);
            return False;
         end if;

         if Kernel.Databases.Is_Primitive_Of (Entity) /= No_General_Entity then
            To_Line_Column
              (S_File, Entity_Token.Token_First, Tok_Line, Tok_Column);

            Entity_Before := Kernel.Databases.Get_Entity
              (Name => Get_Name (Expression, Entity_Token),
               Loc  => (File   => File,
                        Line   => Tok_Line,
                        Column => Tok_Column));

            --  The following will not handle correctly where the primitive
            --  operation is declared inside a subprogram, and we use the fully
            --  qualified name to access it. That should be pretty rare though,
            --  since primitive operations can only be overridden in such a
            --  context, and users are not likely to use full qualification.
            --  But we want to handle the case of factories (ie subprograms)
            --  that return an access type and we use the dotted notation to
            --  call a primitive op on the result.

            if Entity_Before /= No_General_Entity
              and then
                (Kernel.Databases.Has_Methods (Entity_Before)

                 --  A subprogram that returns a primitive
                 or else Kernel.Databases.Is_Subprogram (Entity_Before))
            then
               Free (Expression);
               return True;
            end if;
         end if;

         Free (Expression);
         return False;
      end Is_Dotted_Notation;

   begin
      Skip_Word   (Chars, First);
      Skip_Blanks (Chars, First);
      if First > Chars'Last
        or else Chars (First) /= '('
      then
         Trace (Me, "Doesn't appear to be a subprogram call");
         return Failure;
      end if;

      if Params'Length = 0 then
         Trace (Me, "No parameter for this subprogram");
         return Failure;
      end if;

      if Is_Dotted_Notation then
         Trace (Me, "Rename parameters: detected dotted notation");
         Iter := Iter + 1;
         if Params'Length = 1 then
            return Success;
         end if;
      end if;

      --  Now add all parameter names, but not if the name is already specified
      --  by the user

      Add_Parameter_Name;

      while Iter <= Params'Last and then First <= Chars'Last loop
         if Chars (First) = '(' then
            Nest_Count := Nest_Count + 1;
         elsif Chars (First) = ')' then
            Nest_Count := Nest_Count - 1;
            exit when Nest_Count = 0;
         elsif Chars (First) = ',' and then Nest_Count = 1 then
            Add_Parameter_Name;
         end if;

         First  := First + 1;
      end loop;

      Result := Result & Chars (Last .. First);
      if Insert_Text
        (Context, In_File => File, Line => Line, Column => Column,
         Text            => To_String (Result),
         Indent          => False,
         Replaced_Length => First - Chars'First + 1)
      then
         return Success;
      else
         return Failure;
      end if;
   end Name_Parameters;

   -------------
   -- Execute --
   -------------

   overriding function Execute
     (Command : access Name_Parameters_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      pragma Unreferenced (Command);
   begin
      return Name_Parameters
        (Kernel  => Get_Kernel (Context.Context),
         Context => Get_Kernel (Context.Context).Refactoring_Context,
         Entity => Get_Entity (Context.Context),
         File   => File_Information (Context.Context),
         Line   => Line_Information (Context.Context),
         Column => Column_Information (Context.Context));
   end Execute;

   ----------------------------
   -- Entity_Command_Handler --
   ----------------------------

   procedure Entity_Command_Handler
     (Data : in out Callback_Data'Class; Command : String) is
   begin
      if Command = "name_parameters" then
         Name_Parameters (Data, (1 => Location_Cst'Access));
         declare
            Entity   : constant General_Entity := Get_Data (Data, 1);
            Location : constant File_Location_Info := Get_Data (Data, 2);
            File     : constant Virtual_File := Get_Data (Get_File (Location));
         begin
            if Name_Parameters
              (Kernel => Get_Kernel (Data),
               Context => Get_Kernel (Data).Refactoring_Context,
               Entity => Entity,
               File   => File,
               Line   => Get_Line (Location),
               Column => Get_Column (Location)) /= Success
            then
               Set_Error_Msg (Data, -"Couldn't name parameters");
            end if;
         end;
      end if;
   end Entity_Command_Handler;

   --------------------------
   -- Register_Refactoring --
   --------------------------

   procedure Register_Refactoring
     (Kernel : access GPS.Kernel.Kernel_Handle_Record'Class)
   is
      C : constant Interactive_Command_Access := new Name_Parameters_Command;
      Filter : Action_Filter;
   begin
      Filter := new Is_Subprogram_Filter;
      Register_Contextual_Menu
        (Kernel,
         Name  => "Refactoring name parameters",
         Label => "Refactoring/Name parameters",
         Filter => Filter and Create (Language => "Ada"),
         Action => C);
      Register_Command
        (Kernel, "name_parameters", 1, 1, Entity_Command_Handler'Access,
         Get_Entity_Class (Kernel));
   end Register_Refactoring;

end Refactoring.Parameters;
