------------------------------------------------------------------------------
--                                  G P S                                   --
--                                                                          --
--                     Copyright (C) 2001-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 Ada.Unchecked_Deallocation;
with GNATCOLL.Scripts;              use GNATCOLL.Scripts;
with GNATCOLL.Traces;               use GNATCOLL.Traces;
with GNATCOLL.Utils;
with GNATCOLL.Xref;
with GNAT.Strings;                  use GNAT.Strings;

with Cairo;                         use Cairo;

with Gdk.Event;                     use Gdk.Event;

with Glib;                          use Glib;
with Glib.Object;                   use Glib.Object;

with Gtk.Box;                       use Gtk.Box;
with Gtk.Button;                    use Gtk.Button;
with Gtk.Check_Button;              use Gtk.Check_Button;
with Gtk.Dialog;                    use Gtk.Dialog;
with Gtk.Enums;                     use Gtk.Enums;
with Gtk.Frame;                     use Gtk.Frame;
with Gtk.Menu;                      use Gtk.Menu;
with Gtk.Radio_Button;              use Gtk.Radio_Button;
with Gtk.Stock;                     use Gtk.Stock;
with Gtk.Vbutton_Box;               use Gtk.Vbutton_Box;
with Gtk.Widget;                    use Gtk.Widget;

with Gtkada.Canvas;                 use Gtkada.Canvas;
with Gtkada.Handlers;               use Gtkada.Handlers;
with Gtkada.MDI;                    use Gtkada.MDI;

with Pango.Layout;                  use Pango.Layout;

with Basic_Types;

with Browsers.Canvas;               use Browsers.Canvas;
with Commands.Generic_Asynchronous; use Commands;
with Commands.Interactive;          use Commands.Interactive;
with GPS.Intl;                      use GPS.Intl;
with GPS.Kernel.Console;            use GPS.Kernel.Console;
with GPS.Kernel.Contexts;           use GPS.Kernel.Contexts;
with GPS.Kernel.MDI;                use GPS.Kernel.MDI;
with GPS.Kernel.Messages;           use GPS.Kernel.Messages;
with GPS.Kernel.Messages.Markup;    use GPS.Kernel.Messages.Markup;
with GPS.Kernel.Messages.Simple;    use GPS.Kernel.Messages.Simple;
with GPS.Kernel.Modules;            use GPS.Kernel.Modules;
with GPS.Kernel.Modules.UI;         use GPS.Kernel.Modules.UI;
with GPS.Kernel.Project;            use GPS.Kernel.Project;
with GPS.Kernel.Preferences;        use GPS.Kernel.Preferences;
with GPS.Kernel.Scripts;            use GPS.Kernel.Scripts;
with GPS.Kernel.Standard_Hooks;     use GPS.Kernel.Standard_Hooks;
with GPS.Kernel.Styles;             use GPS.Kernel.Styles;
with GPS.Kernel.Task_Manager;       use GPS.Kernel.Task_Manager;
with GPS.Kernel.Xref;               use GPS.Kernel.Xref;
with GPS.Styles;                    use GPS.Styles;
with GPS.Styles.UI;                 use GPS.Styles.UI;
with GPS.Kernel;                    use GPS.Kernel;
with Histories;                     use Histories;
with String_Utils;                  use String_Utils;
with XML_Utils;                     use XML_Utils;
with Std_Dialogs;                   use Std_Dialogs;
with Traces;
with GNATCOLL.VFS;                  use GNATCOLL.VFS;
with Generic_List;
with Xref;                          use Xref;

package body Browsers.Call_Graph is
   use type GNATCOLL.Xref.Visible_Column;

   References_Command_Class_Name : constant String := "ReferencesCommand";
   --  Name of the class for shell commands associated with this package

   Call_Graph_Message_Flags : constant Message_Flags :=
     (Editor_Side => True,
      Locations   => True);
   --  Visibility of call graph's messages in the system at whole

   type Callgraph_Module_Record is new Module_ID_Record with null record;
   Call_Graph_Module_Id : Module_ID;
   Call_Graph_Module_Name : constant String := "Call_Graph";

   overriding procedure Default_Context_Factory
     (Module  : access Callgraph_Module_Record;
      Context : in out Selection_Context;
      Child   : Glib.Object.GObject);
   --  See inherited documentation

   Automatically_Check_To_Dependencies : constant Boolean := True;
   --  If True, then every time an item is added to the call graph we check,
   --  and if no to dependency exists, the right arrow is not displayed.

   Locations_At_A_Time : constant := 20;
   --  Number of locations that will be inserted in the locations view in
   --  each idle processing.

   Include_Implicit_Cst : aliased constant String := "include_implicit";
   Synchronous_Cst      : aliased constant String := "synchronous";
   Show_Kind_Cst        : aliased constant String := "show_kind";
   In_File_Cst          : aliased constant String := "in_file";
   Dispatching_Calls_Cst : aliased constant String := "dispatching_calls";
   Kind_In_Cst          : aliased constant String := "kind_in";
   References_Cmd_Parameters : constant Cst_Argument_List :=
     (1 => Include_Implicit_Cst'Access,
      2 => Synchronous_Cst'Access,
      3 => Show_Kind_Cst'Access,
      4 => In_File_Cst'Access,
      5 => Kind_In_Cst'Access);

   type Filters_Buttons is array (Natural range <>) of Gtk_Check_Button;
   type Filters_Buttons_Access is access Filters_Buttons;
   type References_Filter_Dialog_Record is new Gtk_Dialog_Record with record
      Filters : Filters_Buttons_Access;
   end record;
   type References_Filter_Dialog is access all
     References_Filter_Dialog_Record'Class;

   procedure Unchecked_Free is new Ada.Unchecked_Deallocation
     (Filters_Buttons, Filters_Buttons_Access);

   function All_Refs_Category
     (Kernel             : access Kernel_Handle_Record'Class;
      Entity             : General_Entity;
      Local_Only         : Boolean;
      Local_File         : GNATCOLL.VFS.Virtual_File;
      All_From_Same_File : Boolean) return String;
   --  Return the category title when doing a find all refs on a given entity.
   --  If All_From_Same_File is true, we will in fact list all entities
   --  imported form the same file as Entity.
   --  If Local_Only is true, then the references are only in the current file

   type Callback_Data_Access is access all Callback_Data'Class;
   type Add_To_List_User_Data
     is new Commands_User_Data_Record with
      record
         Data : Callback_Data_Access;

         Use_Parent_For_Key : Boolean := True;
         --  If this is True, then Parent should be used as the key for entries
         --  in the list. Otherwise, Entity will be used.
      end record;
   type Add_To_List_User_Data_Access is access all Add_To_List_User_Data'Class;
   overriding function On_Entity_Found
     (D                   : access Add_To_List_User_Data;
      Entity              : General_Entity;
      Parent              : General_Entity;
      Ref                 : General_Entity_Reference;
      Through_Dispatching : Boolean;
      Is_Renaming         : Boolean) return Boolean;
   --  See inherited documentation.
   --  Add a new entity to the returned value in D.Data.

   ------------------------
   -- Call graph browser --
   ------------------------

   type Call_Graph_Browser_Record is new
     Browsers.Canvas.General_Browser_Record with null record;

   type Call_Graph_Browser is access all Call_Graph_Browser_Record'Class;

   -------------
   -- Filters --
   -------------

   type Custom_Filter is record
      Db : General_Xref_Database;

      Ref_Kinds : GNAT.Strings.String_List_Access;
      --  The reference kinds' name that should be displayed, or none for all.
      --  Any null value is ignored in this array.

      Filter : Reference_Kind_Filter;
      --  One of the predefined filters
   end record;
   function Is_Valid
     (Self : Custom_Filter; Ref : General_Entity_Reference) return Boolean;
   procedure Free (Self : in out Custom_Filter);

   --------------
   -- Commands --
   --------------

   type Subprogram_Entity_Filter is new Action_Filter_Record with record
      Kernel : Kernel_Handle;
   end record;
   overriding function Filter_Matches_Primitive
     (Filter  : access Subprogram_Entity_Filter;
      Context : Selection_Context) return Boolean;

   type Entity_Calls_Command is new Interactive_Command with null record;
   overriding function Execute
     (Command : access Entity_Calls_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Entity_Calls_All_Command is new Interactive_Command with null record;
   overriding function Execute
     (Command : access Entity_Calls_All_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Entity_Called_By_Command is new Interactive_Command with null record;
   overriding function Execute
     (Command : access Entity_Called_By_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Find_All_Refs_Command is new Interactive_Command with record
      Locals_Only     : Boolean := False;
      Recurse_Project : Boolean := True;
      Writes_Only     : Boolean := False;
      Reads_Only      : Boolean := False;
   end record;
   overriding function Execute
     (Command : access Find_All_Refs_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Find_Specific_Refs_Command
     is new Interactive_Command with null record;
   overriding function Execute
     (Command : access Find_Specific_Refs_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Edit_Body_Command is new Interactive_Command with record
      Kernel : Kernel_Handle;
   end record;
   overriding function Execute
     (Command : access Edit_Body_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   type Edit_Spec_Command is new Interactive_Command with record
      Kernel : Kernel_Handle;
   end record;
   overriding function Execute
     (Command : access Edit_Spec_Command;
      Context : Interactive_Command_Context) return Command_Return_Type;

   procedure Do_Nothing (R : in out General_Entity_Reference) is null;
   package Entity_Ref_List is new Generic_List
     (General_Entity_Reference, Free => Do_Nothing);
   use Entity_Ref_List;

   type References_Command is new Root_Command with record
      Kernel        : Kernel_Handle;
      Iter          : Entity_Reference_Iterator;
      Filter        : Custom_Filter;
      Locations     : Entity_Ref_List.List;
      Show_Ref_Kind : Boolean;
   end record;
   type References_Command_Access is access all References_Command'Class;
   overriding function Execute
     (Command : access References_Command) return Command_Return_Type;
   overriding procedure Free (Command : in out References_Command);

   ------------------
   -- Entity items --
   ------------------

   type Entity_Item_Record is new Browsers.Canvas.Arrow_Item_Record
   with record
      Entity : General_Entity;
      Refs   : Xref_List;
   end record;
   type Entity_Item is access all Entity_Item_Record'Class;

   procedure Gtk_New
     (Item                     : out Entity_Item;
      Browser                  : access General_Browser_Record'Class;
      Entity                   : General_Entity;
      May_Have_To_Dependencies : Boolean);
   --  Create a new entity item.
   --  If May_Have_To_Dependencies is False, the right arrow will not be
   --  displayed in the items.

   procedure Initialize
     (Item                     : access Entity_Item_Record'Class;
      Browser                  : access General_Browser_Record'Class;
      Entity                   : General_Entity;
      May_Have_To_Dependencies : Boolean);
   --  Internal initialization function

   overriding procedure Destroy (Item : in out Entity_Item_Record);
   --  Free the memory occupied by the item. This is called automatically when
   --  the item is removed from the canvas.

   overriding procedure Contextual_Factory
     (Item    : access Entity_Item_Record;
      Context : in out Selection_Context;
      Browser : access Browsers.Canvas.General_Browser_Record'Class;
      Event   : Gdk.Event.Gdk_Event;
      Menu    : Gtk.Menu.Gtk_Menu);
   --  Return the context to use for this item

   overriding procedure Resize_And_Draw
     (Item                        : access Entity_Item_Record;
      Cr                          : in out Cairo.Cairo_Context;
      Width, Height               : Glib.Gint;
      Width_Offset, Height_Offset : Glib.Gint;
      Xoffset, Yoffset            : in out Glib.Gint;
      Layout                  : access Pango.Layout.Pango_Layout_Record'Class);
   --  See doc for inherited subprogram

   function Build
     (Kernel      : access Kernel_Handle_Record'Class;
      Parent_Item : access Entity_Item_Record'Class;
      Location    : General_Location) return Active_Area_Cb;
   --  Build a callback for links in callgraph items

   type Show_Location_Callback is new Active_Area_Callback with record
      Kernel   : Kernel_Handle;
      Parent   : Entity_Item;
      Location : General_Location;
   end record;
   type Show_Location_Callback_Access
     is access all Show_Location_Callback'Class;
   overriding function Call (Callback : Show_Location_Callback;
                             Event    : Gdk.Event.Gdk_Event) return Boolean;
   --  See inherited doc

   --------------------
   -- Renaming links --
   --------------------

   type Renaming_Link_Record is new Browsers.Canvas.Browser_Link_Record
     with null record;
   --  The type of link used between an entity and the entities that rename
   --  it.
   --  A renaming link should always be created from the renaming entity to the
   --  renamed entity.

   overriding procedure Draw_Link
     (Canvas      : access Gtkada.Canvas.Interactive_Canvas_Record'Class;
      Link        : access Renaming_Link_Record;
      Cr          : Cairo_Context;
      Edge_Number : Glib.Gint;
      Show_Annotation : Boolean := True);
   --  Override the default drawing procedure for links

   ----------
   -- Misc --
   ----------

   type Entity_Idle_Data is record
      Kernel             : Kernel_Handle;
      Iter               : Entity_Reference_Iterator_Access;
      Entity             : General_Entity;
      Filter             : Custom_Filter;
      Iter_Started       : Boolean;
      Show_Caller        : Boolean;
      Category           : String_Access;
      Include_Overriding : Boolean;
   end record;

   type Examine_Ancestors_Data is new Commands_User_Data_Record with record
      Browser        : Call_Graph_Browser;
      Item           : Entity_Item;
      Link_From_Item : Boolean;
   end record;
   type Examine_Ancestors_Data_Access
     is access all Examine_Ancestors_Data'Class;
   overriding procedure Destroy
     (Data : in out Examine_Ancestors_Data; Cancelled : Boolean);
   overriding function On_Entity_Found
     (Data                : access Examine_Ancestors_Data;
      Entity              : General_Entity;
      Parent              : General_Entity;
      Ref                 : General_Entity_Reference;
      Through_Dispatching : Boolean;
      Is_Renaming         : Boolean) return Boolean;
   --  See inherited documentation

   procedure Examine_Entity_Call_Graph
     (Kernel  : access Kernel_Handle_Record'Class;
      Entity  : General_Entity;
      Refresh : Boolean := True);
   --  Display the call graph for the node.
   --  If Refresh is True, refresh the canvas layout.

   procedure Examine_Ancestors_Call_Graph
     (Kernel : access Kernel_Handle_Record'Class;
      Entity : General_Entity);
   --  Display the list of subprograms that call Entity

   function Find_Entity
     (In_Browser : access General_Browser_Record'Class;
      Entity     : General_Entity) return Canvas_Item;
   --  Return the child that shows Item_Name in the browser, or null if
   --  Item_Name is not already displayed in the canvas.
   --  ??? Should also have line and column information

   function Open_Call_Graph_Browser
     (Kernel : access Kernel_Handle_Record'Class) return Gtkada.MDI.MDI_Child;
   --  Find, or create a new, call graph editor

   function Create_Call_Graph_Browser
     (Kernel : access Kernel_Handle_Record'Class) return MDI_Child;
   --  Create a new call graph browser

   procedure Parse_All_Refs
     (Kernel             : access Kernel_Handle_Record'Class;
      Entity             : General_Entity;
      Locals_Only        : Boolean;
      Local_File         : GNATCOLL.VFS.Virtual_File;
      All_From_Same_File : Boolean;
      Show_Caller        : Boolean;
      Filter             : in out Custom_Filter;
      Include_Overriding : Boolean := False);
   --  Internal implementation of find_all_references.
   --  If All_From_Same_File is True, then all entities imported from the same
   --  file as Entity and referenced in Local_File, as Entity are
   --  displayed.
   --  This procedure will free Filter.

   procedure Find_All_References_Internal
     (Kernel             : access Kernel_Handle_Record'Class;
      Info               : General_Entity;
      Category_Title     : String;
      Show_Caller        : Boolean;
      Filter             : in out Custom_Filter;
      Include_Overriding : Boolean := False);
   --  Internal implementation for Find_All_References_From_Contextual,
   --  Find_All_Writes_From_Contextual and Find_All_Reads_From_Contextual.
   --  Starts a background search for all references.
   --  This procedure will free Filter.

   procedure Find_Next_Reference
     (Data    : in out Entity_Idle_Data;
      Command : Command_Access;
      Result  : out Command_Return_Type);
   --  Find the next reference to the entity in D

   function Add_Entity_If_Not_Present
     (Browser : access Call_Graph_Browser_Record'Class;
      Entity  : General_Entity) return Entity_Item;
   --  Add a new entity to the browser, if not already there

   procedure Add_Entity_And_Link
     (Browser             : Call_Graph_Browser;
      Item                : Entity_Item;
      Link_From_Item      : Boolean;
      Entity              : General_Entity;
      Ref                 : General_Entity_Reference;
      Is_Renaming         : Boolean;
      Through_Dispatching : Boolean);
   --  Add Entity, and possibly a link to Cb.Item to Cb.Browser

   procedure Destroy_Idle (Data : in out Entity_Idle_Data);
   --  Called when the idle loop is destroyed

   package Xref_Commands is new Commands.Generic_Asynchronous
     (Entity_Idle_Data, Destroy_Idle);

   procedure On_Call_Graph
     (Widget : access GObject_Record'Class; Kernel : Kernel_Handle);
   --  Create a callgraph for the entity described in the current kernel
   --  context (if any)

   procedure On_Find_All_References
     (Widget : access GObject_Record'Class; Kernel : Kernel_Handle);
   --  Find all the references of the current entity

   function Load_Desktop
     (MDI  : MDI_Window;
      Node : Node_Ptr;
      User : Kernel_Handle) return MDI_Child;
   function Save_Desktop
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      User   : Kernel_Handle) return Node_Ptr;
   --  Support functions for the MDI

   procedure Print_Ref
     (Kernel       : access Kernel_Handle_Record'Class;
      Ref          : General_Entity_Reference;
      Name         : String;
      Category     : String;
      Show_Caller  : Boolean;
      Sort_In_File : Boolean);
   --  Display a reference in the locations tree, after looking for the
   --  directory containing File.
   --  Category corresponds to the purpose of the print. All references
   --  corresponding to the same category will be printed as a group.
   --  If Show_Caller is true, the full name of the caller will also be
   --  displayed.
   --  If Sort_In_File is true, then the new entry is inserted before the first
   --  entry with a higher line number

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

   procedure References_Command_Handler
     (Data    : in out Callback_Data'Class;
      Command : String);
   --  Handle shell commands related of ReferencesCommand class

   procedure Put_Locations_In_Return
     (Command       : access References_Command'Class;
      Data          : in out Callback_Data'Class;
      Show_Ref_Kind : Boolean);
   --  Put on the result of Data the list of entities found in the command

   procedure Examine_Ancestors_Call_Graph
     (Item : access Arrow_Item_Record'Class);
   procedure Examine_Entity_Call_Graph
     (Item : access Arrow_Item_Record'Class);
   --  Callbacks for the title bar buttons

   procedure Unselect_All_Filters (Dialog : access Gtk_Widget_Record'Class);
   procedure Select_All_Filters (Dialog : access Gtk_Widget_Record'Class);
   --  Select or unselect all filters in "Find references..."

   ----------
   -- Free --
   ----------

   procedure Free (Self : in out Custom_Filter) is
   begin
      GNAT.Strings.Free (Self.Ref_Kinds);  --  also frees All_Refs
   end Free;

   -----------------------
   -- All_Refs_Category --
   -----------------------

   function All_Refs_Category
     (Kernel             : access Kernel_Handle_Record'Class;
      Entity             : General_Entity;
      Local_Only         : Boolean;
      Local_File         : GNATCOLL.VFS.Virtual_File;
      All_From_Same_File : Boolean) return String
   is
      Decl : constant General_Location :=
        Kernel.Databases.Get_Declaration (Entity).Loc;
   begin
      if All_From_Same_File then
         return -"Entities imported from "
           & Krunch (+Decl.File.Base_Name)
           & (-" into ")
           & Krunch (+Local_File.Base_Name);

      elsif Local_Only then
         return -"Local references for "
           & Kernel.Databases.Get_Name (Entity)
           & " ("  & Krunch (+Decl.File.Base_Name)
           & ":" & Image (Decl.Line) & ") " & (-"in ")
           & Krunch (+Local_File.Base_Name);

      else
         return -"References for "
           & Kernel.Databases.Get_Name (Entity)
           & " ("  & Krunch (+Decl.File.Base_Name)
           & ":" & Image (Decl.Line) & ")";
      end if;
   end All_Refs_Category;

   -------------
   -- Gtk_New --
   -------------

   procedure Gtk_New
     (Item                     : out Entity_Item;
      Browser                  : access General_Browser_Record'Class;
      Entity                   : General_Entity;
      May_Have_To_Dependencies : Boolean) is
   begin
      Item := new Entity_Item_Record;
      Initialize (Item, Browser, Entity, May_Have_To_Dependencies);
   end Gtk_New;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize
     (Item                     : access Entity_Item_Record'Class;
      Browser                  : access General_Browser_Record'Class;
      Entity                   : General_Entity;
      May_Have_To_Dependencies : Boolean)
   is
      Kernel : constant Kernel_Handle := Get_Kernel (Browser);
      Decl   : constant General_Location :=
        Kernel.Databases.Get_Declaration (Entity).Loc;
      Name   : constant String := Kernel.Databases.Get_Name (Entity);
   begin
      Item.Entity := Entity;
      Ref (Item.Entity);
      Initialize (Item, Browser, Name,
                  Examine_Ancestors_Call_Graph'Access,
                  Examine_Entity_Call_Graph'Access);
      Set_Children_Shown (Item, not May_Have_To_Dependencies);

      if not Kernel.Databases.Is_Predefined_Entity (Entity) then
         Add_Line
           (Item.Refs,
            "(Decl) @"
            & Decl.File.Display_Base_Name
            & ':' & Image (Decl.Line) & '@',
            Callback =>
              (1 => Build (Get_Kernel (Get_Browser (Item)), Item, Decl)));
      else
         Add_Line (Item.Refs, "<Unresolved>");
      end if;
   end Initialize;

   -------------
   -- Destroy --
   -------------

   overriding procedure Destroy (Item : in out Entity_Item_Record) is
      Item2    : constant Entity_Item := Item'Unrestricted_Access;
      Iter     : Item_Iterator := Start (Get_Canvas (Get_Browser (Item2)));
      It       : Canvas_Item;
      Line     : Positive;
      Text     : String_Access;
      Callback : Active_Area_Cb;
      Cb       : Show_Location_Callback_Access;
      Removed  : Boolean;
   begin
      if not In_Destruction_Is_Set (Get_Browser (Item2)) then
         --  Remove all references to the current item in other items, to keep
         --  the browser's contents as simple as possible.

         --  We have to iterate over all items, since the item being destroyed
         --  is no longer linked to anything at this point.

         loop
            It := Get (Iter);
            exit when It = null;

            Removed := False;

            --  Skip first line, which is the declaration location
            Line := 2;
            loop
               Get_Line (Entity_Item (It).Refs, Line, 1, Callback, Text);
               exit when Text = null;

               if Callback /= null then
                  Cb := Show_Location_Callback_Access (Callback);
                  if Cb.Parent = Item2 then
                     Remove_Line (Entity_Item (It).Refs, Line);
                     Removed := True;
                  else
                     Line := Line + 1;
                  end if;
               else
                  Line := Line + 1;
               end if;
            end loop;

            if Removed then
               Refresh (Entity_Item (It));
            end if;

            Next (Iter);
         end loop;
      end if;

      Unref (Item.Entity);
      Free (Item.Refs);
      Destroy (Arrow_Item_Record (Item));
   end Destroy;

   -------------------------------
   -- Create_Call_Graph_Browser --
   -------------------------------

   function Create_Call_Graph_Browser
     (Kernel : access Kernel_Handle_Record'Class) return MDI_Child
   is
      Browser : Call_Graph_Browser;
      Child   : GPS_MDI_Child;
   begin
      Browser := new Call_Graph_Browser_Record;
      Initialize (Browser, Kernel, Create_Toolbar => False);

      Register_Contextual_Menu
        (Kernel          => Kernel,
         Event_On_Widget => Browser,
         Object          => Browser,
         ID              => Call_Graph_Module_Id,
         Context_Func    => Default_Browser_Context_Factory'Access);

      Gtk_New (Child, Browser,
               Focus_Widget   => Gtk_Widget (Get_Canvas (Browser)),
               Default_Width  => Gint (Default_Widget_Width.Get_Pref),
               Default_Height => Gint (Default_Widget_Height.Get_Pref),
               Group          => Group_Graphs,
               Module         => Call_Graph_Module_Id);
      Set_Title (Child, -"Call graph Browser");
      Put (Get_MDI (Kernel), Child);

      return MDI_Child (Child);
   end Create_Call_Graph_Browser;

   -----------------------------
   -- Open_Call_Graph_Browser --
   -----------------------------

   function Open_Call_Graph_Browser
     (Kernel : access Kernel_Handle_Record'Class)
      return Gtkada.MDI.MDI_Child
   is
      Child : MDI_Child;
   begin
      Child := Find_MDI_Child_By_Tag
        (Get_MDI (Kernel), Call_Graph_Browser_Record'Tag);

      if Child /= null then
         Raise_Child (Child);
      else
         Child := Create_Call_Graph_Browser (Kernel);
         Set_Focus_Child (Child);
      end if;

      Add_Navigation_Location (Kernel, -"Call graph Browser");

      return Child;
   end Open_Call_Graph_Browser;

   -----------------
   -- Find_Entity --
   -----------------

   function Find_Entity
     (In_Browser : access General_Browser_Record'Class;
      Entity     : General_Entity) return Canvas_Item
   is
      Found : Canvas_Item := null;
      Iter  : Item_Iterator := Start (Get_Canvas (In_Browser));
   begin
      loop
         Found := Get (Iter);

         exit when Found = null
           or else Entity_Item (Found).Entity = Entity;
         Next (Iter);
      end loop;
      return Found;
   end Find_Entity;

   -------------------------------
   -- Add_Entity_If_Not_Present --
   -------------------------------

   function Add_Entity_If_Not_Present
     (Browser : access Call_Graph_Browser_Record'Class;
      Entity  : General_Entity) return Entity_Item
   is
      Kernel : constant Kernel_Handle := Get_Kernel (Browser);
      Child                    : Entity_Item;
      May_Have_To_Dependencies : Boolean := True;
      Iter                     : Calls_Iterator;

   begin
      Child := Entity_Item (Find_Entity (Browser, Entity));
      if Child = null then
         if Automatically_Check_To_Dependencies then
            Iter := Kernel.Databases.Get_All_Called_Entities (Entity);

            if not At_End (Iter) then
               May_Have_To_Dependencies := False;

               while not At_End (Iter) loop
                  if Kernel.Databases.Is_Subprogram (Get (Iter)) then
                     May_Have_To_Dependencies := True;
                     exit;
                  end if;
                  Next (Iter);
               end loop;

               Destroy (Iter);
            end if;
         end if;

         Gtk_New (Child, Browser, Entity, May_Have_To_Dependencies);
         Put (Get_Canvas (Browser), Child);
         Refresh (Child);
      end if;

      return Child;
   end Add_Entity_If_Not_Present;

   -------------------------------
   -- Examine_Entity_Call_Graph --
   -------------------------------

   procedure Examine_Entity_Call_Graph
     (Kernel  : access Kernel_Handle_Record'Class;
      Entity  : General_Entity;
      Refresh : Boolean := True)
   is
      Child_Browser : constant MDI_Child := Open_Call_Graph_Browser (Kernel);
      Browser       : constant Call_Graph_Browser :=
                        Call_Graph_Browser (Get_Widget (Child_Browser));
      Item          : constant Entity_Item :=
                        Add_Entity_If_Not_Present (Browser, Entity);
      Canvas        : Interactive_Canvas;
      Cr            : Cairo_Context;

   begin
      if not Children_Shown (Item) then
         Set_Children_Shown (Item, True);
         Cr := Create (Item);
         Redraw_Title_Bar (Item, Cr);
         Destroy (Cr);

         declare
            Data : constant Examine_Ancestors_Data_Access :=
              new Examine_Ancestors_Data'
                (Commands_User_Data_Record with
                 Browser        => Browser,
                 Item           => Item,
                 Link_From_Item => True);

         begin
            Examine_Entity_Call_Graph
              (Kernel            => Kernel,
               Entity            => Entity,
               User_Data         => Data,
               Dispatching_Calls => True,
               Get_All_Refs      => True);

            --  Data is no longer valid now, since it has been destroyed
         end;

         --  Refresh all linked items, since we have added references in them
         Refresh_Linked_Items (Item, Refresh_Children => True);
      end if;

      if Refresh then
         --  We need to do a layout, so that the newly added item is put at a
         --  correct place.
         Layout (Browser, Force => False);
         Canvas := Get_Canvas (Browser);
         Refresh_Canvas (Canvas);
         Align_Item (Canvas, Item, 0.4, 0.4);
      end if;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end Examine_Entity_Call_Graph;

   -------------
   -- Destroy --
   -------------

   overriding procedure Destroy
     (Data : in out Examine_Ancestors_Data; Cancelled : Boolean)
   is
      pragma Unmodified (Data);
   begin
      if not Cancelled then
         --  Refresh the item, since we might have added links to it
         Refresh (Data.Item);

         if not Data.Link_From_Item then
            Layout (Data.Browser, Force => False);
         end if;

         Refresh_Canvas (Get_Canvas (Data.Browser));
         Show_Item (Get_Canvas (Data.Browser), Data.Item);
      end if;
   end Destroy;

   -------------------------
   -- Add_Entity_And_Link --
   -------------------------

   procedure Add_Entity_And_Link
     (Browser             : Call_Graph_Browser;
      Item                : Entity_Item;
      Link_From_Item      : Boolean;
      Entity              : General_Entity;
      Ref                 : General_Entity_Reference;
      Is_Renaming         : Boolean;
      Through_Dispatching : Boolean)
   is
      Child            : Entity_Item;
      Link             : Browser_Link;
      Loc              : General_Location;
      Line             : Natural;
      Text             : String_Access;
      New_Cb, Callback : Active_Area_Cb;
      Changing         : Entity_Item;

      Descr_Dispatching : aliased String := "(dispatch)";
      Descr_Others      : aliased String := "";
      Descr            : String_Access := Descr_Others'Unchecked_Access;
   begin
      Child := Add_Entity_If_Not_Present (Browser, Entity);

      if Through_Dispatching then
         Descr := Descr_Dispatching'Unchecked_Access;
      end if;

      if Link_From_Item then
         if not Has_Link (Get_Canvas (Browser), Item, Child) then
            if Is_Renaming then
               Link := new Renaming_Link_Record;
               Add_Link (Get_Canvas (Browser), Link => Link,
                         Src => Item, Dest => Child, Arrow => Both_Arrow);
            else
               Link := new Browser_Link_Record;
               Add_Link (Get_Canvas (Browser), Link => Link,
                         Src => Item, Dest => Child);
            end if;
         end if;
      else
         if not Has_Link (Get_Canvas (Browser), Child, Item) then
            if Is_Renaming then
               Link := new Renaming_Link_Record;
               Add_Link (Get_Canvas (Browser), Link => Link,
                         Src => Child, Dest => Item, Arrow => Both_Arrow);
            else
               Link := new Browser_Link_Record;
               Add_Link (Get_Canvas (Browser), Link => Link,
                         Src => Child, Dest => Item);
            end if;
         end if;
      end if;

      Loc := Get_Location (Ref);

      --  Always skip the first line, which is the declaration location
      Line := 2;

      if Link_From_Item then
         Changing := Child;
         Child    := Item;
      else
         Changing := Item;
      end if;

      New_Cb := Build (Get_Kernel (Browser), Child, Loc);

      loop
         Get_Line (Changing.Refs, Line, 1, Callback, Text);
         exit when Text = null;

         if Show_Location_Callback_Access (Callback).Parent = Child then
            Expand_Line
              (Changing.Refs, Line,
               " @" & Image (Loc.Line)
               & ':' & Image (Integer (Loc.Column)) & '@' & Descr.all,
               (1 => New_Cb),
               Check_Duplicates => True);
            return;
         end if;

         Line := Line + 1;
      end loop;

      Add_Line
        (Changing.Refs,
         Get_Kernel (Browser).Databases.Qualified_Name (Child.Entity)
         & ": @"
         & Image (Loc.Line) & ':'
         & Image (Integer (Loc.Column)) & '@' & Descr.all,
         Callback => (1 => New_Cb));
   end Add_Entity_And_Link;

   ---------------------
   -- On_Entity_Found --
   ---------------------

   overriding function On_Entity_Found
     (Data                : access Examine_Ancestors_Data;
      Entity              : General_Entity;
      Parent              : General_Entity;
      Ref                 : General_Entity_Reference;
      Through_Dispatching : Boolean;
      Is_Renaming         : Boolean) return Boolean
   is
   begin
      if Data.Link_From_Item then
         Add_Entity_And_Link
           (Data.Browser, Data.Item, Data.Link_From_Item,
            Entity, Ref, Is_Renaming, Through_Dispatching);
      else
         Add_Entity_And_Link
           (Data.Browser, Data.Item, Data.Link_From_Item,
            Parent, Ref, Is_Renaming, Through_Dispatching);
      end if;

      return True;
   end On_Entity_Found;

   ----------------------------------
   -- Examine_Ancestors_Call_Graph --
   ----------------------------------

   procedure Examine_Ancestors_Call_Graph
     (Kernel : access Kernel_Handle_Record'Class;
      Entity : General_Entity)
   is
      Child_Browser : constant MDI_Child := Open_Call_Graph_Browser (Kernel);
      Data          : Examine_Ancestors_Data_Access;
      Cr            : Cairo_Context;
   begin
      Data := new Examine_Ancestors_Data'
        (Commands_User_Data_Record with
         Browser        => Call_Graph_Browser (Get_Widget (Child_Browser)),
         Item           => null,
         Link_From_Item => False);
      Data.Item := Add_Entity_If_Not_Present (Data.Browser, Entity);
      Set_Parents_Shown (Data.Item, True);
      Cr := Create (Surface (Data.Item));
      Redraw_Title_Bar (Data.Item, Cr);
      Destroy (Cr);

      Examine_Ancestors_Call_Graph
        (Kernel            => Kernel,
         Entity            => Entity,
         User_Data         => Data,
         Background_Mode   => True,
         Dispatching_Calls => True,
         Watch             => Gtk_Widget (Data.Browser));

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
         Pop_State (Kernel_Handle (Kernel));
   end Examine_Ancestors_Call_Graph;

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

   overriding function Execute
     (Command : access Edit_Body_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      Location : General_Location;
   begin
      Location := Command.Kernel.Databases.Get_Body
        (Get_Entity (Context.Context));

      Add_Navigation_Location
        (Get_Kernel (Context.Context), -"Call graph Browser");

      if Location /= No_Location then
         Open_File_Editor
           (Get_Kernel (Context.Context),
            Filename => Location.File,
            Line     => Location.Line,
            Column   => Location.Column);
      else
         --  If the body wasn't found then display the specs
         Open_File_Editor
           (Get_Kernel (Context.Context),
            File_Information (Context.Context),
            Line   => Line_Information (Context.Context),
            Column => Entity_Column_Information (Context.Context));
      end if;
      return Commands.Success;
   end Execute;

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

   overriding function Execute
     (Command : access Edit_Spec_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      Entity : constant General_Entity := Get_Entity (Context.Context);
      Loc    : General_Location;
   begin
      if Entity = No_General_Entity then
         Insert (Get_Kernel (Context.Context),
                 (-"Couldn't find cross-reference information for ")
                 & '"' & Entity_Name_Information (Context.Context) & '"');
      else
         Add_Navigation_Location
           (Get_Kernel (Context.Context), -"Call graph Browser");

         Loc := Command.Kernel.Databases.Get_Declaration (Entity).Loc;

         Open_File_Editor
           (Get_Kernel (Context.Context),
            Loc.File,
            Line   => Loc.Line,
            Column => Loc.Column);
      end if;
      return Commands.Success;
   end Execute;

   ----------
   -- Free --
   ----------

   overriding procedure Free (Command : in out References_Command) is
   begin
      Destroy (Command.Iter);
      Free (Command.Locations);
   end Free;

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

   overriding function Execute
     (Command : access References_Command) return Command_Return_Type
   is
      Ref : General_Entity_Reference;
   begin
      for J in 1 .. 15 loop
         exit when At_End (Command.Iter);

         Ref := Get (Command.Iter);

         if Ref /= No_General_Entity_Reference
           and then Is_Valid (Command.Filter, Ref)
         then
            Append (Command.Locations, Ref);
         end if;

         Next (Command.Iter);
      end loop;

      Set_Progress
        (Command,
         (Activity => Unknown,
          Current  => Get_Current_Progress (Command.Iter),
          Total    => Get_Total_Progress (Command.Iter)));

      if At_End (Command.Iter) then
         Set_Progress
           (Command,
            (Activity => Unknown,
             Current  => Get_Total_Progress (Command.Iter),
             Total    => Get_Total_Progress (Command.Iter)));

         return Success;
      else
         return Execute_Again;
      end if;
   end Execute;

   ------------------
   -- Destroy_Idle --
   ------------------

   procedure Destroy_Idle (Data : in out Entity_Idle_Data) is
   begin
      Free (Data.Filter);
      Destroy (Data.Iter);
      Unref (Data.Entity);
      Free (Data.Category);
      Pop_State (Data.Kernel);
   end Destroy_Idle;

   ---------------
   -- Print_Ref --
   ---------------

   procedure Print_Ref
     (Kernel       : access Kernel_Handle_Record'Class;
      Ref          : General_Entity_Reference;
      Name         : String;
      Category     : String;
      Show_Caller  : Boolean;
      Sort_In_File : Boolean)
   is
      pragma Unreferenced (Sort_In_File);
      use Basic_Types;

      Loc     : constant General_Location := Get_Location (Ref);
      Col     : Basic_Types.Visible_Column_Type := Loc.Column;
      Line    : constant Integer      := Loc.Line;
      File    : constant Virtual_File := Loc.File;
      Message : Markup_Message_Access;

   begin
      if Col <= 0 then
         Col := 1;
      end if;

      if Show_Caller and then Get_Caller (Ref) /= No_General_Entity then
         Message :=
           Create_Markup_Message
             (Get_Messages_Container (Kernel),
              Category,
              File,
              Line,
              Col,
              "<b>" & Name & "</b> ["
              & Get_Display_Kind (Ref) & "] in: "
              & Kernel.Databases.Qualified_Name (Get_Caller (Ref)),
              0,
              Call_Graph_Message_Flags);

      else
         Message :=
           Create_Markup_Message
             (Get_Messages_Container (Kernel),
              Category,
              File,
              Line,
              Col,
              "<b>" & Name & "</b> [" & Get_Display_Kind (Ref) & "]",
              0,
              Call_Graph_Message_Flags);
      end if;

      Message.Set_Highlighting
        (Get_Or_Create_Style_Copy
           (Kernel_Handle (Kernel),
            Get_Name (Search_Results_Style) & '/' & Category,
            Search_Results_Style),
         Name'Length);
   end Print_Ref;

   -------------------------
   -- Find_Next_Reference --
   -------------------------

   procedure Find_Next_Reference
     (Data    : in out Entity_Idle_Data;
      Command : Command_Access;
      Result  : out Command_Return_Type)
   is
      Count : Integer := 0;
      Ref   : General_Entity_Reference;
      Name  : constant String := Data.Kernel.Databases.Get_Name (Data.Entity);
   begin
      Result := Execute_Again;

      if not Data.Iter_Started then
         Data.Kernel.Databases.Find_All_References
           (Iter               => Data.Iter.all,
            Entity             => Data.Entity,
            Include_Overriding => Data.Include_Overriding,
            Include_Overridden => Data.Include_Overriding);

         Data.Iter_Started := True;
         Set_Progress
           (Command,
            (Running,
             Get_Current_Progress (Data.Iter.all),
             Get_Total_Progress (Data.Iter.all)));
         return;
      end if;

      while Count < Locations_At_A_Time loop
         if At_End (Data.Iter.all) then
            Result := Success;
            exit;

         else
            Ref := Get (Data.Iter.all);

            --  Not done parsing all the files yet
            if Ref = No_General_Entity_Reference then
               Next (Data.Iter.all);
               exit;

            elsif Is_Valid (Data.Filter, Ref) then
               Print_Ref
                 (Data.Kernel,
                  Ref,
                  Name,
                  Data.Category.all,
                  Show_Caller  => Data.Show_Caller,
                  Sort_In_File => False);
            end if;

            Count := Count + 1;
         end if;

         Next (Data.Iter.all);
      end loop;

      Set_Progress
        (Command,
         (Running,
          Get_Current_Progress (Data.Iter.all),
          Get_Total_Progress (Data.Iter.all)));
   end Find_Next_Reference;

   ----------------------------------
   -- Find_All_References_Internal --
   ----------------------------------

   procedure Find_All_References_Internal
     (Kernel             : access Kernel_Handle_Record'Class;
      Info               : General_Entity;
      Category_Title     : String;
      Show_Caller        : Boolean;
      Filter             : in out Custom_Filter;
      Include_Overriding : Boolean := False)
   is
      Data : Entity_Idle_Data;
      C    : Xref_Commands.Generic_Asynchronous_Command_Access;

   begin
      if Info /= No_General_Entity then
         begin
            Get_Messages_Container (Kernel).Remove_Category
              (Category_Title, Call_Graph_Message_Flags);

            Ref (Info);
            Data := (Kernel             => Kernel_Handle (Kernel),
                     Iter               => new Entity_Reference_Iterator,
                     Filter             => Filter,
                     Category           => new String'(Category_Title),
                     Iter_Started       => False,
                     Show_Caller        => Show_Caller,
                     Include_Overriding => Include_Overriding,
                     Entity             => Info);

            Xref_Commands.Create  --  Will destroy Data when done
              (C, -"Find all refs", Data, Find_Next_Reference'Access);
            Launch_Background_Command
              (Kernel, Command_Access (C), True, True, "xrefs");

         exception
            when E : others =>
               Trace (Traces.Exception_Handle, E);
               Destroy (Data.Iter);
         end;
      else
         Free (Filter);
      end if;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end Find_All_References_Internal;

   ----------------------------------
   -- Examine_Ancestors_Call_Graph --
   ----------------------------------

   procedure Examine_Ancestors_Call_Graph
     (Item : access Arrow_Item_Record'Class) is
   begin
      Examine_Ancestors_Call_Graph
        (Get_Kernel (Get_Browser (Item)), Entity_Item (Item).Entity);
   end Examine_Ancestors_Call_Graph;

   -------------------------------
   -- Examine_Entity_Call_Graph --
   -------------------------------

   procedure Examine_Entity_Call_Graph
     (Item : access Arrow_Item_Record'Class) is
   begin
      Examine_Entity_Call_Graph
        (Get_Kernel (Get_Browser (Item)), Entity_Item (Item).Entity);
   end Examine_Entity_Call_Graph;

   ------------------------
   -- Contextual_Factory --
   ------------------------

   overriding procedure Contextual_Factory
     (Item    : access Entity_Item_Record;
      Context : in out Selection_Context;
      Browser : access Browsers.Canvas.General_Browser_Record'Class;
      Event   : Gdk.Event.Gdk_Event;
      Menu    : Gtk.Menu.Gtk_Menu)
   is
      pragma Unreferenced (Event, Menu);
      Loc : General_Location;
   begin
      if not
        Get_Kernel (Browser).Databases.Is_Predefined_Entity (Item.Entity)
      then
         Loc :=
           Get_Kernel (Browser).Databases.Get_Declaration (Item.Entity).Loc;
         Set_File_Information
           (Context,
            Files => (1 => Loc.File),
            Line  => Loc.Line);
      end if;

      Set_Entity_Information (Context, Entity => Item.Entity);

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end Contextual_Factory;

   -------------------
   -- On_Call_Graph --
   -------------------

   procedure On_Call_Graph
     (Widget : access GObject_Record'Class; Kernel : Kernel_Handle)
   is
      Ignore : MDI_Child;
      pragma Unreferenced (Widget, Ignore);

      Context     : constant Selection_Context := Get_Current_Context (Kernel);
      Node_Entity : General_Entity;
   begin
      Ignore := Open_Call_Graph_Browser (Kernel);

      if Context /= No_Context then
         Node_Entity := Get_Entity (Context);
         if Node_Entity /= No_General_Entity then
            Examine_Entity_Call_Graph (Kernel, Node_Entity);
         end if;
      end if;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end On_Call_Graph;

   ----------------------------
   -- On_Find_All_References --
   ----------------------------

   procedure On_Find_All_References
     (Widget : access GObject_Record'Class; Kernel : Kernel_Handle)
   is
      pragma Unreferenced (Widget);
      Context : constant Selection_Context := Get_Current_Context (Kernel);
      Entity  : General_Entity;
      Filter  : Custom_Filter;

   begin
      if Context /= No_Context then
         Entity := Get_Entity (Context);
         if Entity /= No_General_Entity then
            Filter := Custom_Filter'
               (Db        => Kernel.Databases,
                Ref_Kinds => null,
                Filter    => Is_Read_Or_Write_Reference'Access);

            Find_All_References_Internal
              (Kernel,
               Entity,
               Category_Title   => All_Refs_Category
                 (Entity             => Entity,
                  Kernel             => Kernel,
                  Local_Only         => False,
                  Local_File         => GNATCOLL.VFS.No_File,
                  All_From_Same_File => False),
               Filter           => Filter,
               Show_Caller      => False);
         end if;

      else
         Console.Insert
           (Kernel, -"Cannot find references: no entity selected",
            Mode => Error);
      end if;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end On_Find_All_References;

   -----------------------------
   -- Default_Context_Factory --
   -----------------------------

   overriding procedure Default_Context_Factory
     (Module  : access Callgraph_Module_Record;
      Context : in out Selection_Context;
      Child   : Glib.Object.GObject)
   is
      pragma Unreferenced (Module);
      Browser : constant Call_Graph_Browser := Call_Graph_Browser (Child);
      Iter    : constant Item_Iterator :=
        Start (Get_Canvas (Browser), Selected_Only => True);
   begin
      --  If there is no selection, or more than one item, nothing we can do
      if Get (Iter) /= null
        and then Get (Next (Iter)) = null
      then
         Contextual_Factory
           (Context => Context,
            Item    => Browser_Item (Get (Iter)),
            Browser => Browser,
            Event   => null,
            Menu    => null);
      end if;
   end Default_Context_Factory;

   ---------------------
   -- On_Entity_Found --
   ---------------------

   overriding function On_Entity_Found
     (D                   : access Add_To_List_User_Data;
      Entity              : General_Entity;
      Parent              : General_Entity;
      Ref                 : General_Entity_Reference;
      Through_Dispatching : Boolean;
      Is_Renaming         : Boolean) return Boolean
   is
      pragma Unreferenced (Through_Dispatching);
      Loc : General_Location;
   begin
      if not Is_Renaming then
         Loc := Get_Location (Ref);
         Set_Return_Value
           (D.Data.all,
            Create_File_Location
              (Get_Script (D.Data.all),
               Create_File (Get_Script (D.Data.all), Loc.File),
               Loc.Line,
               Loc.Column));
      else
         Set_Return_Value (D.Data.all, -"<renaming>");
      end if;

      if D.Use_Parent_For_Key then
         Set_Return_Value_Key
           (D.Data.all,
            Create_Entity (Get_Script (D.Data.all), Parent), Append => True);
      else
         Set_Return_Value_Key
           (D.Data.all,
            Create_Entity (Get_Script (D.Data.all), Entity), Append => True);
      end if;
      return True;
   end On_Entity_Found;

   --------------------------------
   -- Call_Graph_Command_Handler --
   --------------------------------

   procedure Call_Graph_Command_Handler
     (Data    : in out Callback_Data'Class;
      Command : String)
   is
      Kernel    : constant Kernel_Handle := Get_Kernel (Data);
      Entity    : constant General_Entity := Get_Data (Data, 1);
      Filter    : Custom_Filter;
      User_Data : Add_To_List_User_Data_Access;
   begin
      if Command = "find_all_refs" then
         Name_Parameters (Data, References_Cmd_Parameters);

         Filter := Custom_Filter'
           (Db        => Kernel.Databases,
            Ref_Kinds => null,
            Filter    => Is_Read_Or_Implicit_Reference'Access);

         if Nth_Arg (Data, 2, False) then
            Filter.Filter := Is_Read_Or_Write_Or_Implicit_Reference'Access;
         end if;

         Find_All_References_Internal
           (Kernel, Entity,
            Category_Title   => All_Refs_Category
              (Entity             => Entity,
               Kernel             => Kernel,
               Local_Only         => False,
               Local_File         => GNATCOLL.VFS.No_File,
               All_From_Same_File => False),
            Show_Caller      => False,
            Filter           => Filter);

      elsif Command = "references" then
         Name_Parameters (Data, References_Cmd_Parameters);

         declare
            Ref_Command : References_Command_Access := new References_Command;
            References_Command_Class : constant Class_Type := New_Class
              (Get_Kernel (Data),
               References_Command_Class_Name,
               New_Class (Get_Kernel (Data), "Command"));

            Implicit         : constant Boolean := Nth_Arg (Data, 2, False);
            Synchronous      : constant Boolean := Nth_Arg (Data, 3, True);
            Show_Ref_Type    : constant Boolean := Nth_Arg (Data, 4, False);
            Inst_In_File     : constant Class_Instance :=
              Nth_Arg (Data, 5, Get_File_Class (Get_Kernel (Data)),
                       Allow_Null => True);
            Only_If_Kind     : constant String := Nth_Arg (Data, 6, "");
            In_File          : Virtual_File := No_File;
            Instance         : Class_Instance;
            Launched_Command : Scheduled_Command_Access;
         begin
            Ref_Command.Kernel := Kernel;
            Ref_Command.Show_Ref_Kind := Show_Ref_Type;
            Ref_Command.Filter :=
              (Db        => Kernel.Databases,
               Ref_Kinds => null,
               Filter    => null);

            if Inst_In_File /= No_Class_Instance then
               In_File := Get_Data (Inst_In_File);
            end if;

            if Only_If_Kind = "" then
               if Implicit then
                  Ref_Command.Filter.Filter :=
                    Is_Real_Or_Implicit_Reference'Access;
               else
                  Ref_Command.Filter.Filter := Is_Real_Reference'Access;
               end if;
            else
               Ref_Command.Filter.Ref_Kinds :=
                 GNATCOLL.Utils.Split (Only_If_Kind, ',');
            end if;

            Kernel.Databases.Find_All_References
              (Iter                  => Ref_Command.Iter,
               Entity                => Entity,
               In_File               => In_File,
               File_Has_No_LI_Report => null);
            --  ??? Should we give access to In_Scope

            if Synchronous then
               --  Synchronous, return directly the result

               Launch_Synchronous (Ref_Command);
               Put_Locations_In_Return (Ref_Command, Data, Show_Ref_Type);
               Unref (Command_Access (Ref_Command));

            else
               --  Not synchronous, return a command

               Launched_Command := Launch_Background_Command
                 (Kernel          => Kernel,
                  Command         => Ref_Command,
                  Active          => False,
                  Show_Bar        => False,
                  Destroy_On_Exit => True);

               Set_Progress
                 (Ref_Command,
                  (Activity => Unknown,
                   Current  => Get_Current_Progress (Ref_Command.Iter),
                   Total    => Get_Total_Progress (Ref_Command.Iter)));

               Instance := Get_Instance
                 (Launched_Command,
                  Get_Script (Data),
                  References_Command_Class);

               Set_Return_Value (Data, Instance);
            end if;
         end;

      elsif Command = "calls" then
         Name_Parameters (Data, (1 => Dispatching_Calls_Cst'Access));

         --  The following unchecked_access is safe since
         --  Examine_Entity_Call_Graph is called synchronously
         User_Data := new Add_To_List_User_Data;
         User_Data.Data := Data'Unchecked_Access;
         User_Data.Use_Parent_For_Key := False;
         Examine_Entity_Call_Graph
           (Kernel            => Kernel,
            User_Data         => User_Data,
            Entity            => Entity,
            Dispatching_Calls => Nth_Arg (Data, 2, False),
            Get_All_Refs      => True);

      elsif Command = "called_by" then
         Name_Parameters (Data, (1 => Dispatching_Calls_Cst'Access));

         --  The following unchecked_access is safe since
         --  Examine_Ancestors_Call_Graph is called synchronously
         User_Data := new Add_To_List_User_Data;
         User_Data.Data := Data'Unchecked_Access;
         Examine_Ancestors_Call_Graph
           (Kernel          => Kernel,
            User_Data       => User_Data,
            Entity          => Entity,
            Dispatching_Calls => Nth_Arg (Data, 2, False),
            Background_Mode => False);

      elsif Command = "called_by_browser" then
         Examine_Ancestors_Call_Graph (Kernel, Entity);
      end if;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
   end Call_Graph_Command_Handler;

   --------------------------------
   -- References_Command_Handler --
   --------------------------------

   procedure References_Command_Handler
     (Data    : in out Callback_Data'Class;
      Command : String)
   is
      ReferencesCommand_Class : constant Class_Type := New_Class
        (Get_Kernel (Data), References_Command_Class_Name);
      Inst         : constant Class_Instance :=
                                  Nth_Arg (Data, 1, ReferencesCommand_Class);
      Data_Command : constant References_Command_Access :=
                               References_Command_Access
                                 (Get_Command
                                    (GPS.Kernel.Task_Manager.Get_Data (Inst)));
   begin
      if Command = "get_result" then
         Put_Locations_In_Return
           (Data_Command, Data, Show_Ref_Kind => Data_Command.Show_Ref_Kind);
      end if;
   end References_Command_Handler;

   -----------------------------
   -- Put_Locations_In_Return --
   -----------------------------

   procedure Put_Locations_In_Return
     (Command       : access References_Command'Class;
      Data          : in out Callback_Data'Class;
      Show_Ref_Kind : Boolean)
   is
      Inst : Class_Instance;
   begin
      if not Show_Ref_Kind then
         Set_Return_Value_As_List (Data);
      end if;

      declare
         Node  : Entity_Ref_List.List_Node := First (Command.Locations);
         Ref   : General_Entity_Reference;
         Loc   : General_Location;
      begin
         while Node /= Entity_Ref_List.Null_Node loop
            Ref := Entity_Ref_List.Data (Node);

            Loc := Get_Location (Ref);
            Inst := Create_File_Location
              (Script => Get_Script (Data),
               File   => Create_File
                 (Script => Get_Script (Data),
                  File   => Loc.File),
               Line   => Loc.Line,
               Column => Loc.Column);

            if Show_Ref_Kind then
               Set_Return_Value (Data, Get_Display_Kind (Ref));
               Set_Return_Value_Key (Data, Inst);
            else
               Set_Return_Value (Data, Inst);
            end if;

            Node := Next (Node);
         end loop;
      end;
   end Put_Locations_In_Return;

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

   overriding function Filter_Matches_Primitive
     (Filter  : access Subprogram_Entity_Filter;
      Context : Selection_Context) return Boolean
   is
      Entity : General_Entity;
   begin
      if Has_Entity_Name_Information (Context) then
         Entity := Get_Entity (Context);
         return Entity /= No_General_Entity
           and then Filter.Kernel.Databases.Is_Subprogram (Entity);
      else
         return False;
      end if;
   end Filter_Matches_Primitive;

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

   overriding function Execute
     (Command : access Entity_Calls_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      pragma Unreferenced (Command);
      Node_Entity : General_Entity;
   begin
      Push_State (Get_Kernel (Context.Context), Busy);
      Node_Entity := Get_Entity (Context.Context);

      if Node_Entity /= No_General_Entity then
         --  ??? Should check that Decl.Kind is a subprogram
         Examine_Entity_Call_Graph (Get_Kernel (Context.Context), Node_Entity);
      else
         Insert (Get_Kernel (Context.Context),
                 -"No call graph available for "
                 & Entity_Name_Information (Context.Context));
      end if;

      Pop_State (Get_Kernel (Context.Context));
      return Commands.Success;

   exception
      when E : others =>
         Insert (Get_Kernel (Context.Context),
                 -"Internal error when creating the call graph for "
                 & Entity_Name_Information (Context.Context),
                 Mode => Error);
         Trace (Traces.Exception_Handle, E);
         Pop_State (Get_Kernel (Context.Context));
      return Commands.Failure;
   end Execute;

   overriding function Execute
     (Command : access Entity_Calls_All_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      pragma Unreferenced (Command);
      Key         : constant Histories.History_Key := "Call_Graph_Limit";
      Kernel      : constant Kernel_Handle := Get_Kernel (Context.Context);
      Node_Entity : General_Entity;
      History     : constant Histories.History := Get_History (Kernel);
      Max_Items   : Natural := 1000;

   begin
      if Histories.Get_History (History.all, Key) = null then
         Histories.Add_To_History (History.all, Key, "1000");
      end if;

      declare
         Str  : constant String :=
           Simple_Entry_Dialog
             (Get_Main_Window (Kernel),
              -"Complete Call Graph",
              -("Computing complete call graph may take a long time." &
                ASCII.LF & "Enter maximum number of items to display: "),
              Win_Pos_Mouse, History, Key);
      begin
         if Str /= "" and then Str (Str'First) /= ASCII.NUL then
            Max_Items := Integer'Value (Str);
         else
            return Commands.Failure;
         end if;
      exception
         when others =>
            return Commands.Failure;
      end;

      Push_State (Get_Kernel (Context.Context), Busy);
      Node_Entity := Get_Entity (Context.Context);

      if Node_Entity /= No_General_Entity then
         --  ??? Should check that Decl.Kind is a subprogram

         declare
            Browser : constant Call_Graph_Browser := Call_Graph_Browser
                        (Get_Widget (Open_Call_Graph_Browser (Kernel)));
            Canvas  : constant Interactive_Canvas := Get_Canvas (Browser);
            Item    : Entity_Item;
            Iter    : Item_Iterator;
            Count   : Integer := 1;
            Lock    : Database_Lock := Kernel.Databases.Freeze;

         begin
            Parse_All_LI_Information (Kernel, Get_Project (Kernel), False);
            --  ??? for some reason, calling Freeze (Db) here generates
            --  incomplete call graphs
            --  Freeze (Db);

            Examine_Entity_Call_Graph (Kernel, Node_Entity, Refresh => False);

            Main_Loop : loop
               Iter := Start (Canvas);

               loop
                  Item := Entity_Item (Get (Iter));

                  exit Main_Loop when Item = null;

                  if not Children_Shown (Item) then
                     Examine_Entity_Call_Graph
                       (Kernel, Item.Entity, Refresh => False);
                     --  Iter may no longer be valid, so start again
                     exit;
                  end if;

                  Next (Iter);
               end loop;

               Count := Count + 1;
               exit Main_Loop when Count > Max_Items;
            end loop Main_Loop;

            --  ??? See comment about Freeze above
            --  Thaw (Db);
            Kernel.Databases.Thaw (Lock);

            Layout (Browser, Force => True);
            Refresh_Canvas (Canvas);

         exception
            when E : others =>
               Kernel.Databases.Thaw (Lock);
               Insert (Get_Kernel (Context.Context),
                       -"Internal error when creating the call graph for "
                       & Entity_Name_Information (Context.Context),
                       Mode => Error);
               Trace (Traces.Exception_Handle, E);
               Pop_State (Get_Kernel (Context.Context));
               return Commands.Failure;
         end;

      else
         Insert (Get_Kernel (Context.Context),
                 -"No call graph available for "
                 & Entity_Name_Information (Context.Context));
      end if;

      Pop_State (Get_Kernel (Context.Context));
      return Commands.Success;

   exception
      when E : others =>
         Trace (Traces.Exception_Handle, E);
         Pop_State (Get_Kernel (Context.Context));
      return Commands.Failure;
   end Execute;

   overriding function Execute
     (Command : access Entity_Called_By_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      pragma Unreferenced (Command);
      Info : General_Entity;
   begin
      Push_State (Get_Kernel (Context.Context), Busy);
      Info := Get_Entity (Context.Context);

      if Info /= No_General_Entity then
         Examine_Ancestors_Call_Graph (Get_Kernel (Context.Context), Info);
      else
         Insert (Get_Kernel (Context.Context),
                 -"No information found for the file "
                 & Display_Full_Name
                   (File_Information (Context.Context)),
                 Mode => Error);
      end if;

      Pop_State (Get_Kernel (Context.Context));
      return Commands.Success;

   exception
      when E : others =>
         Insert (Get_Kernel (Context.Context),
                 -"Internal error when creating the call graph for "
                 & Entity_Name_Information (Context.Context),
                 Mode => Error);
         Trace (Traces.Exception_Handle, E);
         Pop_State (Get_Kernel (Context.Context));
      return Commands.Failure;
   end Execute;

   --------------------
   -- Parse_All_Refs --
   --------------------

   procedure Parse_All_Refs
     (Kernel             : access Kernel_Handle_Record'Class;
      Entity             : General_Entity;
      Locals_Only        : Boolean;
      Local_File         : Virtual_File;
      All_From_Same_File : Boolean;
      Show_Caller        : Boolean;
      Filter             : in out Custom_Filter;
      Include_Overriding : Boolean := False)
   is
      Title       : constant String := All_Refs_Category
        (Entity             => Entity,
         Kernel             => Kernel,
         Local_Only         => Locals_Only,
         Local_File         => Local_File,
         All_From_Same_File => All_From_Same_File);
      Decl : constant General_Location :=
        Kernel.Databases.Get_Declaration (Entity).Loc;
      Decl2 : General_Location;
      Entity_Decl : constant Virtual_File := Decl.File;
      Iter        : Entity_Reference_Iterator;
      Iter2       : Entities_In_File_Cursor;
      Entity2     : General_Entity;
      Message     : Simple_Message_Access;

   begin
      Push_State (Kernel_Handle (Kernel), Busy);

      if All_From_Same_File then
         Get_Messages_Container (Kernel).Remove_Category
           (Title, Call_Graph_Message_Flags);

         Iter2 := Kernel.Databases.Entities_In_File (Local_File);
         while not At_End (Iter2) loop
            Entity2 := Get (Iter2);

            Decl2 := Kernel.Databases.Get_Declaration (Entity2).Loc;

            if Decl2.File = Entity_Decl then
               if Show_Caller then
                  Kernel.Databases.Find_All_References
                    (Iter               => Iter,
                     Entity             => Entity2,
                     In_File            => Local_File,
                     Include_Overriding => Include_Overriding,
                     Include_Overridden => Include_Overriding);

                  declare
                     Name2 : constant String :=
                       Kernel.Databases.Get_Name (Entity2);
                     Loc   : General_Location;
                  begin
                     while not At_End (Iter) loop
                        Loc := Get_Location (Get (Iter));

                        if Get (Iter) /= No_General_Entity_Reference
                          and then Loc.File = Local_File
                          and then Is_Valid (Filter, Ref => Get (Iter))
                        then
                           Print_Ref (Kernel,
                                      Get (Iter),
                                      Name2,
                                      Title,
                                      Show_Caller => Show_Caller,
                                      Sort_In_File => True);
                        end if;
                        Next (Iter);
                     end loop;
                  end;

                  Destroy (Iter);

               else
                  declare
                     Name2 : constant String :=
                       Kernel.Databases.Get_Name (Entity2);
                  begin
                     Message :=
                       Create_Simple_Message
                         (Get_Messages_Container (Kernel),
                          Title,
                          Decl2.File,
                          Decl2.Line,
                          Decl2.Column,
                          Name2,
                          0,
                          Call_Graph_Message_Flags);
                     Message.Set_Highlighting
                       (Get_Or_Create_Style_Copy
                          (Kernel_Handle (Kernel),
                           Get_Name (Search_Results_Style) & '/' & Title,
                           Search_Results_Style),
                        Name2'Length);
                  end;
               end if;
            end if;

            Next (Iter2);
         end loop;

         Free (Filter);

      elsif Locals_Only then
         --  Print the declaration of the entity, but only if it is in the
         --  current file, as expected by users.

         Get_Messages_Container (Kernel).Remove_Category
           (Title, Call_Graph_Message_Flags);

         Kernel.Databases.Find_All_References
           (Iter          => Iter,
            Entity        => Entity,
            In_File       => Local_File,
            Include_Overridden => Include_Overriding,
            Include_Overriding => Include_Overriding);

         declare
            Name : constant String := Kernel.Databases.Get_Name (Entity);
         begin
            while not At_End (Iter) loop
               if Get (Iter) /= No_General_Entity_Reference
                 and then Is_Valid (Filter, Get (Iter))
               then
                  Print_Ref (Kernel,
                             Get (Iter),
                             Name,
                             Title,
                             Show_Caller => Show_Caller,
                             Sort_In_File => True);
               end if;
               Next (Iter);
            end loop;
         end;

         Destroy (Iter);
         Free (Filter);

      else
         Find_All_References_Internal   --  will destroy filter
           (Kernel,
            Entity,
            Category_Title     => Title,
            Show_Caller        => Show_Caller,
            Filter             => Filter,
            Include_Overriding => Include_Overriding);
      end if;

      Pop_State (Kernel_Handle (Kernel));
   end Parse_All_Refs;

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

   overriding function Execute
     (Command : access Find_All_Refs_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      Kernel   : constant Kernel_Handle := Get_Kernel (Context.Context);
      Entity   : constant General_Entity := Get_Entity (Context.Context);
      Filter   : Custom_Filter;
      File     : constant Virtual_File := File_Information (Context.Context);
   begin
      Filter := (Db        => Kernel.Databases,
                 Ref_Kinds => null,
                 Filter    => null);

      if Command.Reads_Only then
         Filter.Filter := Is_Read_Reference'Access;
      elsif Command.Writes_Only then
         Filter.Filter := Is_Write_Reference'Access;
      else
         Filter.Filter := Is_Read_Or_Write_Reference'Access;
      end if;

      Parse_All_Refs
        (Kernel             => Kernel,
         Entity             => Entity,
         Locals_Only        => Command.Locals_Only,
         Local_File         => File,
         All_From_Same_File => False,
         Filter             => Filter,
         Show_Caller        => False);
      return Commands.Success;
   end Execute;

   ------------------------
   -- Select_All_Filters --
   ------------------------

   procedure Select_All_Filters (Dialog : access Gtk_Widget_Record'Class) is
      D : constant References_Filter_Dialog :=
        References_Filter_Dialog (Dialog);
   begin
      for F in D.Filters'Range loop
         Set_Active (D.Filters (F), True);
      end loop;
   end Select_All_Filters;

   --------------------------
   -- Unselect_All_Filters --
   --------------------------

   procedure Unselect_All_Filters (Dialog : access Gtk_Widget_Record'Class) is
      D : constant References_Filter_Dialog :=
        References_Filter_Dialog (Dialog);
   begin
      for F in D.Filters'Range loop
         Set_Active (D.Filters (F), False);
      end loop;
   end Unselect_All_Filters;

   --------------
   -- Is_Valid --
   --------------

   function Is_Valid
     (Self : Custom_Filter; Ref : General_Entity_Reference) return Boolean is
   begin
      if Self.Filter /= null
        and then not Self.Filter (Self.Db, Ref)
      then
         return False;
      end if;

      if Self.Ref_Kinds /= null then
         declare
            Kind : constant String := Get_Display_Kind (Ref);
         begin
            for R in Self.Ref_Kinds'Range loop
               if Self.Ref_Kinds (R) /= null
                 and then Kind = Self.Ref_Kinds (R).all
               then
                  return True;
               end if;
            end loop;
         end;

         return False;
      else
         return True;
      end if;
   end Is_Valid;

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

   overriding function Execute
     (Command : access Find_Specific_Refs_Command;
      Context : Interactive_Command_Context) return Command_Return_Type
   is
      Kernel             : constant Kernel_Handle :=
                             Get_Kernel (Context.Context);
      Dialog             : References_Filter_Dialog;
      Box                : Gtk_Box;
      Col                : array (1 .. 2) of Gtk_Box;
      Filter_Box         : Gtk_Vbutton_Box;
      Index              : Integer := Col'First;
      Project_And_Recursive,
      File_Only          : Gtk_Radio_Button;
      Show_Caller        : Gtk_Check_Button;
      From_Same_File     : Gtk_Radio_Button;
      Include_Overriding : Gtk_Check_Button;
      Frame              : Gtk_Frame;
      Ignore             : Gtk_Widget;
      Entity             : constant General_Entity :=
                             Get_Entity (Context.Context);
      Current_File       : constant Virtual_File :=
                             File_Information (Context.Context);
      Button             : Gtk_Button;
      pragma Unreferenced (Command, Ignore);

      All_Refs : GNAT.Strings.String_List :=
        Kernel.Databases.All_Real_Reference_Kinds;

   begin
      Dialog := new References_Filter_Dialog_Record;
      Dialog.Filters := new Filters_Buttons (All_Refs'Range);

      Initialize (Dialog,
                  Title  => -"Find References Options",
                  Parent => Get_Main_Window (Kernel),
                  Flags  => Modal);

      --  Context choice

      Gtk_New (Frame, -"Context");
      Pack_Start (Get_Vbox (Dialog), Frame);
      Gtk_New_Vbox (Box, Homogeneous => True);
      Add (Frame, Box);

      Gtk_New (Project_And_Recursive, Widget_SList.Null_List,
               -"In all projects");
      Pack_Start (Box, Project_And_Recursive);
      Create_New_Boolean_Key_If_Necessary
        (Get_History (Kernel).all, "Find_Prefs_Project_Recursive", True);
      Associate (Get_History (Kernel).all, "Find_Prefs_Project_Recursive",
                 Project_And_Recursive);

      Gtk_New (File_Only, Get_Group (Project_And_Recursive),
               -"In current file");
      Pack_Start (Box, File_Only);
      Create_New_Boolean_Key_If_Necessary
        (Get_History (Kernel).all, "Find_Prefs_File_Only", False);
      Associate (Get_History (Kernel).all, "Find_Prefs_File_Only", File_Only);

      Gtk_New
        (From_Same_File, Get_Group (Project_And_Recursive),
         -"All entities imported from same file");
      Pack_Start (Box, From_Same_File);
      Create_New_Boolean_Key_If_Necessary
        (Get_History (Kernel).all, "Find_Prefs_From_Same_File", False);
      Associate (Get_History (Kernel).all, "Find_Prefs_From_Same_File",
                 From_Same_File);

      --  Filter choice

      Gtk_New (Frame, -"Filter");
      Pack_Start (Get_Vbox (Dialog), Frame);
      Gtk_New_Hbox (Box, Homogeneous => False);
      Add (Frame, Box);

      for C in Col'Range loop
         Gtk_New_Vbox (Col (C), Homogeneous => True);
         Pack_Start (Box, Col (C), Expand => True);
      end loop;

      for F in Dialog.Filters'Range loop
         Gtk_New (Dialog.Filters (F), All_Refs (F).all);
         Pack_Start (Col (Index), Dialog.Filters (F));
         Create_New_Boolean_Key_If_Necessary
           (Get_History (Kernel).all,
            History_Key ("Find_Prefs_Filter_" & F'Img), True);
         Associate (Get_History (Kernel).all,
                    History_Key ("Find_Prefs_Filter_" & F'Img),
                    Dialog.Filters (F));
         Index := Index + 1;
         if Index > Col'Last then
            Index := Col'First;
         end if;
      end loop;

      Gtk_New (Filter_Box);
      Set_Layout (Filter_Box, Buttonbox_Spread);
      Pack_Start (Box, Filter_Box, Padding => 5);

      Gtk_New (Button, -"Select all");
      Pack_Start (Filter_Box, Button);
      Widget_Callback.Object_Connect
        (Button, Signal_Clicked, Select_All_Filters'Access, Dialog);

      Gtk_New (Button, -"Unselect all");
      Pack_Start (Filter_Box, Button);
      Widget_Callback.Object_Connect
        (Button, Signal_Clicked, Unselect_All_Filters'Access, Dialog);

      --  Extra info choice

      Gtk_New (Frame, -"Advanced Search");
      Pack_Start (Get_Vbox (Dialog), Frame);
      Gtk_New_Vbox (Box, Homogeneous => True);
      Add (Frame, Box);

      Gtk_New (Show_Caller, -"Show context");
      Pack_Start (Box, Show_Caller);
      Create_New_Boolean_Key_If_Necessary
        (Get_History (Kernel).all, "Find_Prefs_Show_Caller", False);
      Associate (Get_History (Kernel).all, "Find_Prefs_Show_Caller",
                 Show_Caller);

      Gtk_New
        (Include_Overriding, -"Include overriding and overriden operations");
      Pack_Start (Box, Include_Overriding);
      Create_New_Boolean_Key_If_Necessary
        (Get_History (Kernel).all, "Find_Prefs_Include_Overriding", False);
      Associate (Get_History (Kernel).all, "Find_Prefs_Include_Overriding",
                 Include_Overriding);

      Ignore := Add_Button (Dialog, Stock_Ok, Gtk_Response_OK);
      Ignore := Add_Button (Dialog, Stock_Cancel, Gtk_Response_Cancel);

      Show_All (Dialog);

      if Run (Dialog) = Gtk_Response_OK then
         for F in Dialog.Filters'Range loop
            if not Get_Active (Dialog.Filters (F)) then
               Free (All_Refs (F));
            end if;
         end loop;

         declare
            Filter : Custom_Filter :=
              (Db        => Kernel.Databases,
               Ref_Kinds => new GNAT.Strings.String_List'(All_Refs),
               Filter    => null);
         begin
            Parse_All_Refs  --  will destroy filter
              (Kernel             => Kernel,
               Entity             => Entity,
               Locals_Only        => Get_Active (File_Only),
               Local_File         => Current_File,
               All_From_Same_File => Get_Active (From_Same_File),
               Filter             => Filter,
               Show_Caller        => Get_Active (Show_Caller),
               Include_Overriding => Get_Active (Include_Overriding));
         end;

         Unchecked_Free (Dialog.Filters);
         Destroy (Dialog);

         return Commands.Success;
      else
         Unchecked_Free (Dialog.Filters);
         GNATCOLL.Utils.Free (All_Refs);
         Destroy (Dialog);
         return Commands.Failure;
      end if;
   end Execute;

   ---------------------
   -- Register_Module --
   ---------------------

   procedure Register_Module
     (Kernel : access GPS.Kernel.Kernel_Handle_Record'Class)
   is
      Tools    : constant String := '/' & (-"Tools") & '/' & (-"Browsers");
      Navigate : constant String := "/_" & (-"Navigate");
      Find_All : constant String := -"Find _All References";
      Command  : Interactive_Command_Access;

      Filter   : Action_Filter;

      ReferencesCommand_Class : constant Class_Type := New_Class
        (Kernel, "ReferencesCommand", New_Class (Kernel, "Command"));

   begin
      Call_Graph_Module_Id := new Callgraph_Module_Record;
      Register_Module
        (Module      => Call_Graph_Module_Id,
         Kernel      => Kernel,
         Module_Name => Call_Graph_Module_Name,
         Priority    => GPS.Kernel.Modules.Default_Priority);
      Register_Desktop_Functions (Save_Desktop'Access, Load_Desktop'Access);

      Filter := new Subprogram_Entity_Filter;
      Subprogram_Entity_Filter (Filter.all).Kernel := Kernel_Handle (Kernel);
      Register_Filter (Kernel, Filter, "Entity is subprogram");

      Command := new Entity_Calls_Command;
      Register_Contextual_Menu
        (Kernel, "Entity calls in browser",
         Label  => "Browsers/%e calls",
         Filter => Filter,
         Action => Command);

      Command := new Entity_Calls_All_Command;
      Register_Contextual_Menu
        (Kernel, "Entity calls (recursively) in browser",
         Label  => "Browsers/%e calls (recursively)",
         Filter => Filter,
         Action => Command);

      Command := new Entity_Called_By_Command;
      Register_Contextual_Menu
        (Kernel, "Entity called by in browser",
         Label  => "Browsers/%e is called by",
         Filter => Filter,
         Action => Command);

      Register_Contextual_Submenu
        (Kernel, "References",
         Ref_Item   => "Goto file spec<->body",
         Add_Before => False);

      Command := new Find_All_Refs_Command;
      Register_Contextual_Menu
        (Kernel, "Find all references",
         Label      => "References/Find all references to %e",
         Action     => Command,
         Ref_Item   => "Entity called by in browser",
         Add_Before => False);

      Command := new Find_Specific_Refs_Command;
      Register_Contextual_Menu
        (Kernel, "Find references...",
         Label      => "References/Find references to %e...",
         Action     => Command);

      Command := new Find_All_Refs_Command;
      Find_All_Refs_Command (Command.all).Locals_Only := True;
      Register_Contextual_Menu
        (Kernel, "Find all local references",
         Label  => "References/Find all local references to %e",
         Action => Command);

      Command := new Edit_Spec_Command;
      Edit_Spec_Command (Command.all).Kernel := Kernel_Handle (Kernel);
      Register_Contextual_Menu
        (Kernel, "Go to spec",
         Action => Command,
         Filter => Create (Module => Call_Graph_Module_Name)
                     and Lookup_Filter (Kernel, "Entity"));

      Command := new Edit_Body_Command;
      Edit_Body_Command (Command.all).Kernel := Kernel_Handle (Kernel);
      Register_Contextual_Menu
        (Kernel, "Go to body",
         Action => Command,
         Filter => Create (Module => Call_Graph_Module_Name)
                     and Lookup_Filter (Kernel, "Entity"));

      Register_Menu
        (Kernel, '/' & (-"Tools") & '/', (-"_Browsers"),
         Callback   => null,
         Ref_Item   => -"Views",
         Add_Before => False);
      Register_Menu
        (Kernel, Tools, -"_Call Graph", "", On_Call_Graph'Access);
      Register_Menu
        (Kernel, Navigate, Find_All, "", On_Find_All_References'Access,
         Ref_Item => -"Find Previous", Add_Before => False);

      Register_Command
        (Kernel, "find_all_refs",
         Class        => Get_Entity_Class (Kernel),
         Maximum_Args => 1,
         Handler      => Call_Graph_Command_Handler'Access);
      Register_Command
        (Kernel, "references",
         Class        => Get_Entity_Class (Kernel),
         Maximum_Args => 5,
         Handler      => Call_Graph_Command_Handler'Access);
      Register_Command
        (Kernel, "calls",
         Class   => Get_Entity_Class (Kernel),
         Maximum_Args => 1,
         Handler => Call_Graph_Command_Handler'Access);
      Register_Command
        (Kernel, "called_by",
         Class   => Get_Entity_Class (Kernel),
         Maximum_Args => 1,
         Handler => Call_Graph_Command_Handler'Access);
      Register_Command
        (Kernel, "called_by_browser",
         Class   => Get_Entity_Class (Kernel),
         Handler => Call_Graph_Command_Handler'Access);

      Browsers.Canvas.Register_Actions (Kernel);

      Register_Command
        (Kernel, "get_result",
         Class   => ReferencesCommand_Class,
         Handler => References_Command_Handler'Access);
   end Register_Module;

   ------------------
   -- Load_Desktop --
   ------------------

   function Load_Desktop
     (MDI  : MDI_Window;
      Node : Node_Ptr;
      User : Kernel_Handle) return MDI_Child
   is
      pragma Unreferenced (MDI);
   begin
      if Node.Tag.all = "Call_Graph" then
         return Create_Call_Graph_Browser (User);
      end if;

      return null;
   end Load_Desktop;

   ------------------
   -- Save_Desktop --
   ------------------

   function Save_Desktop
     (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
      User   : Kernel_Handle) return Node_Ptr
   is
      pragma Unreferenced (User);
      N : Node_Ptr;
   begin
      if Widget.all in Call_Graph_Browser_Record'Class then
         N := new Node;
         N.Tag := new String'("Call_Graph");
         return N;
      end if;

      return null;
   end Save_Desktop;

   ---------------
   -- Draw_Link --
   ---------------

   overriding procedure Draw_Link
     (Canvas      : access Gtkada.Canvas.Interactive_Canvas_Record'Class;
      Link        : access Renaming_Link_Record;
      Cr          : Cairo_Context;
      Edge_Number : Glib.Gint;
      Show_Annotation : Boolean := True)
   is
   begin
      Cairo.Save (Cr);
      Cairo.Set_Dash (Cr, (1 .. 2 => 2.0), 0.0);
      Cairo.Set_Line_Cap (Cr, Cairo_Line_Cap_Butt);
      Cairo.Set_Line_Join (Cr, Cairo_Line_Join_Miter);

      Draw_Link
        (Canvas, Browser_Link_Record (Link.all)'Access,
         Cr, Edge_Number, Show_Annotation);

      Cairo.Restore (Cr);
   end Draw_Link;

   -----------
   -- Build --
   -----------

   function Build
     (Kernel      : access Kernel_Handle_Record'Class;
      Parent_Item : access Entity_Item_Record'Class;
      Location    : General_Location) return Active_Area_Cb is
   begin
      return new Show_Location_Callback'
        (Active_Area_Callback with
         Kernel   => Kernel_Handle (Kernel),
         Parent   => Entity_Item (Parent_Item),
         Location => Location);
   end Build;

   ----------
   -- Call --
   ----------

   overriding function Call (Callback : Show_Location_Callback;
                             Event    : Gdk.Event.Gdk_Event) return Boolean
   is
      pragma Unreferenced (Event);
   begin
      Add_Navigation_Location (Callback.Kernel, -"Call graph Browser");

      Open_File_Editor
        (Callback.Kernel,
         Filename => Callback.Location.File,
         Line     => Callback.Location.Line,
         Column   => Callback.Location.Column);
      return True;
   end Call;

   ---------------------
   -- Resize_And_Draw --
   ---------------------

   overriding procedure Resize_And_Draw
     (Item                        : access Entity_Item_Record;
      Cr                          : in out Cairo_Context;
      Width, Height               : Glib.Gint;
      Width_Offset, Height_Offset : Glib.Gint;
      Xoffset, Yoffset            : in out Glib.Gint;
      Layout                  : access Pango.Layout.Pango_Layout_Record'Class)
   is
      Ref_W1, Ref_W2, Ref_H, Y : Gint;
   begin
      Get_Pixel_Size
        (Get_Browser (Item), Item.Refs, Ref_W1, Ref_W2, Ref_H,  Layout);

      Resize_And_Draw
        (Arrow_Item_Record (Item.all)'Access, Cr,
         Gint'Max (Ref_W1 + Ref_W2 + 2 * Margin, Width),
         Height + Ref_H,
         Width_Offset, Height_Offset, Xoffset, Yoffset, Layout);

      Y := Yoffset + 1;
      Display_Lines (Item, Cr, Item.Refs, Margin + Xoffset, Y, Ref_W1, Layout);
   end Resize_And_Draw;

end Browsers.Call_Graph;
