1. ----------------------------------------------------------------------- 
  2. --                   Gate - GtkAda Components                        -- 
  3. --                                                                   -- 
  4. --   Copyright (C) 1999-2000 E. Briot, J. Brobecker and A. Charlet   -- 
  5. --                Copyright (C) 2000-2003 ACT-Europe                 -- 
  6. --                                                                   -- 
  7. -- GATE is free software;  you can redistribute it and/or modify  it -- 
  8. -- under the terms of the GNU General Public License as published by -- 
  9. -- the Free Software Foundation; either version 2 of the License, or -- 
  10. -- (at your option) any later version.                               -- 
  11. --                                                                   -- 
  12. -- This program is  distributed in the hope that it will be  useful, -- 
  13. -- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of -- 
  14. -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU -- 
  15. -- General Public License for more details. You should have received -- 
  16. -- a copy of the GNU General Public License along with this library; -- 
  17. -- if not,  write to the  Free Software Foundation, Inc.,  59 Temple -- 
  18. -- Place - Suite 330, Boston, MA 02111-1307, USA.                    -- 
  19. ----------------------------------------------------------------------- 
  20.  
  21. --  This package provides the low level Gate API to generate code for the GUI 
  22. --  builder. 
  23. --  See package Gtk.Glade for the high level routines. 
  24. --  <group>Glib, the general-purpose library</group> 
  25.  
  26. with Ada.Text_IO; use Ada.Text_IO; 
  27. with Glib.XML; 
  28. pragma Elaborate_All (Glib.XML); 
  29.  
  30. package Glib.Glade is 
  31.  
  32.    Gettext : Boolean := True; 
  33.    --  Indicates whether the project currently being parsed supports Gettext 
  34.  
  35.    type XML_Data is record 
  36.       Created : Boolean := False; 
  37.       --  True if the corresponding object has been created 
  38.  
  39.       Has_Container : Boolean := False; 
  40.       --  True if object has a container 
  41.  
  42.       Initialized : Boolean := False; 
  43.       --  True if object has been initialized, in other words, no further 
  44.       --  action is required on this widget. 
  45.  
  46.       Has_Accel_Group : Boolean := False; 
  47.       --  True if object has created an accelerator group 
  48.  
  49.       Has_Radio_Group : Boolean := False; 
  50.       --  True if object has created a radio button/menu_item group 
  51.  
  52.       Has_Tooltip : Boolean := False; 
  53.       --  True if object has created a tooltip group 
  54.    end record; 
  55.    --  Extra Data added to each node of the XML tree when parsing a 
  56.    --  Glade file. This node summarizes the characteristics of the widget 
  57.    --  bound to that node. 
  58.  
  59.    package Glib_XML is new Glib.XML (XML_Data); 
  60.    use Glib_XML; 
  61.  
  62.    procedure Add_Package (S : String); 
  63.    --  Add package S in the list of packages if S isn't already present. 
  64.    --  This is used to generate the proper list of "with"ed packages. 
  65.    --  Note that S is assumed to be a child of Gtk, e.g for Gtk.Table, 
  66.    --  call Add_Package ("Table"). 
  67.  
  68.    function Adjust (S : String) return String; 
  69.    --  Replace non "compilable" characters (e.g ASCII.LF). 
  70.    --  Return a printable and "compilable" Ada string. 
  71.  
  72.    function Find_Parent (N : Node_Ptr; Class : String) return Node_Ptr; 
  73.    --  Find a node in the ancestors of N with a given class. 
  74.  
  75.    function Find_Top_Widget (N : Node_Ptr) return Node_Ptr; 
  76.    --  Find a node in the ancestors of N that represents a root widget. 
  77.  
  78.    function Find_Child (N : Node_Ptr; Tag : String) return Node_Ptr; 
  79.    --  Find a node in the children of N with a given Tag. 
  80.  
  81.    function To_Ada (S : String; Separator : Character := '_') return String; 
  82.    --  Convert S by adding a separator before each upper case character. 
  83.    --  Also put in upper case each character following a separator. 
  84.  
  85.    function To_Float (S : String) return String; 
  86.    --  Convert S to an Ada Float by adding a trailing ".0" when needed. 
  87.  
  88.    function Get_Part 
  89.      (S : String; Part : Positive; Separator : Character := ':') return String; 
  90.    --  Get the Part-th part of S delimited by Separator. 
  91.  
  92.    procedure Gen_Set 
  93.      (N             : Node_Ptr; 
  94.       Name          : String; 
  95.       File          : File_Type; 
  96.       Prefix        : String  := ""; 
  97.       Postfix       : String  := ""; 
  98.       Is_Float      : Boolean := False; 
  99.       Property_Name : String := ""); 
  100.    --  Generate a Set_<Name> call in File. 
  101.    --  Name is surrounded by Prefix and Postfix. 
  102.    --  If Is_Float is true, call To_Float on the field <Name>. 
  103.    --  Property_Name is the name of the property to look for in N; 
  104.    --  if Property_Name is empty, use Name instead. 
  105.  
  106.    procedure Gen_Set 
  107.      (N : Node_Ptr; Name, Field : String; File : File_Type); 
  108.    --  Generate a Set_<Name> (Field) call in File. 
  109.  
  110.    procedure Gen_Set 
  111.      (N : Node_Ptr; Name, Field1, Field2, Field3, Field4 : String; 
  112.       File : File_Type; Is_Float : Boolean := False); 
  113.    --  Generate a Set_<Name> (Field1) call in File if Field2 is a null string. 
  114.    --  Or Set_<Name> (Field1, Field2) if Field3 is a null 
  115.    --  string, or Set_<Name> (Field1, Field2, Field3) if Field4 is null, or 
  116.    --  Set_<Name> (Field1, Field2, Field3, Field4) otherwise. 
  117.    --  If Is_Float is true, call To_Float on each non null field. 
  118.  
  119.    procedure Gen_New 
  120.      (N : Node_Ptr; Class : String; 
  121.       Param1, Param2, New_Name : String := ""; 
  122.       File : File_Type; 
  123.       Prefix   : String := ""; 
  124.       Postfix  : String := ""); 
  125.    --  Output a call to <Class>.Gtk_New in File. 
  126.    --  N is the node containing the widget to create. 
  127.    --  If Param<n> is not null, it represents a parameter of Gtk_New. 
  128.    --  New_Name if not null is a name appended to Gtk_New_, 
  129.    --  e.g Gtk_New_Vbox if New_Name = Vbox. 
  130.    --  Param1 is surrounded by Prefix and Postfix. 
  131.  
  132.    procedure Gen_New 
  133.      (N        : Node_Ptr; 
  134.       Class, Param1, Param2, Param3, Param4, Param5 : String; 
  135.       File     : File_Type; 
  136.       Prefix   : String := ""; 
  137.       Postfix  : String := ""); 
  138.    --  Output a call to <Class>.Gtk_New in File. 
  139.    --  N is the node containing the widget to create. 
  140.    --  Each Param<n> represents a parameter of Gtk_New, except Param5 
  141.    --  which is omitted if null. 
  142.    --  Param1 is surrounded by Prefix and Postfix. 
  143.  
  144.    procedure Gen_Child (N, Child : Node_Ptr; File : File_Type); 
  145.    --  Output an assignment in File of the form: 
  146.    --  <Name> := Get_<Child-2> (<Parent>); 
  147.    --  where Name is the name of the widget represented by N, 
  148.    --        Child-2 is the second part of Child.Value, the delimiter being ':' 
  149.    --         (e.g Child-2 = Vbox if Child.Value = Dialog:vbox) 
  150.    --        Parent is the first parent of N whose class is the first part of 
  151.    --         Child.Value (e.g Dialog if Child.Value = Dialog:vbox) 
  152.  
  153.    procedure Gen_Call_Child (N, Child, Parent : Node_Ptr; 
  154.      Class, Call : String; 
  155.      Param1, Param2, Param3 : String := ""; 
  156.      File : File_Type); 
  157.    --  If N has a field "name", Output a call to Call in File of the form: 
  158.    --    <Call> (Parent (N), N) 
  159.    --  if Child is null, or 
  160.    --    <Call> (<Parent>, N) 
  161.    --  where Parent (N) is the name of N.Parent and <Parent> is the name of the 
  162.    --  first parent of N whose class is <Class> 
  163.    --  Param<n> when non null, represents a field of Child (Child must not be 
  164.    --  null) and is added to the parameters of <Call> 
  165.  
  166.    procedure Gen_Packages (File : File_Type); 
  167.    --  Output to file all the packages that have been referenced in previous 
  168.    --  calls to the Gen_* procedures. The output has the form: 
  169.    -- 
  170.    --  with Gtk.xxx; use Gtk.xxx; 
  171.    --  with Gtk.yyy; use Gtk.yyy; 
  172.  
  173.    procedure Reset_Packages; 
  174.    --  Reset the global table of packages. 
  175.  
  176.    procedure Reset_Tree (N : Node_Ptr; Check_Next : Boolean := True); 
  177.    --  Reset the value of the flags for each node contained in N. 
  178.    --  Check_Next indicates whether the linked list of brothers of N should 
  179.    --  also be reset (the children are always reset recursively). 
  180.  
  181.    procedure Gen_Signal 
  182.      (N            : Node_Ptr; 
  183.       File         : File_Type; 
  184.       Widget_Class : String := ""; 
  185.       The_Object   : String := ""); 
  186.    --  Output to file calls to connect if N contains any signal. 
  187.    --  Also register the class of the widget that uses signals. 
  188.    --  Widget_Class if not null specifies the class of the widget contained in 
  189.    --  N. If null, the class will be retrieved from the "class" field of N. 
  190.    --  This is useful when a downcast is needed. 
  191.    --  If The_Object is specified, connect the signat to this object instead 
  192.    --  of reading it from N. 
  193.  
  194.    function Gen_Signal_Instantiations (Project : String; File : File_Type) 
  195.      return Natural; 
  196.    --  Output to file all the instantiations of Gtk.Signal that have been 
  197.    --  referenced in previous calls to Gen_Signal. 
  198.    --  Return the number of instantiations generated. 
  199.    --  The instantiations are all generated in a package called 
  200.    --  Callbacks_<Project> 
  201.  
  202.    function Gettext_Support (N : Node_Ptr) return Boolean; 
  203.    --  Return True if the project's parameter "gettext_support" is True. 
  204.  
  205.    function To_Package_Name (S : String) return String; 
  206.    --  Transform the name of a given Gtk+ widget into the corresponding GtkAda 
  207.    --  package, by applying if needed GtkAda special exceptions in the naming 
  208.    --  rules (e.g GtkEntry -> Gtk.GEntry, GtkHScale -> Gtk.Scale). 
  209.  
  210.    ---------------------------------------- 
  211.    -- Field accessors, utility functions -- 
  212.    ---------------------------------------- 
  213.  
  214.    function Get_Property 
  215.      (N        : Node_Ptr; 
  216.       Property : String) return String_Ptr; 
  217.    --  Return the value of the property Property if it exists in the direct 
  218.    --  children of N. 
  219.  
  220.    function Get_Class (N : Node_Ptr) return String; 
  221.    --  Return the class of N if N is a widget. Otherwise return "". 
  222.  
  223.    function Get_Name (N : Node_Ptr) return String; 
  224.    --  Return the name of N. 
  225.  
  226.    function Get_Property 
  227.      (N        : Node_Ptr; 
  228.       Property : String; 
  229.       Default  : String := "") return String; 
  230.    --  Return the propertu Property in N, or Default if the property was not 
  231.    --  found. 
  232. end Glib.Glade;