File: dgate.adb

package info (click to toggle)
libgtkada2 2.8.1-6lenny3
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 13,496 kB
  • ctags: 3,886
  • sloc: ada: 103,189; ansic: 45,411; perl: 5,500; sh: 2,812; makefile: 1,169; xml: 19
file content (150 lines) | stat: -rw-r--r-- 4,759 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
-----------------------------------------------------------------------
--                   DGate - GtkAda Components                       --
--                                                                   --
--                    Copyright (C) 1999-2000                        --
--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
--                                                                   --
-- Dynagate is free software;  you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published --
-- by the Free Software Foundation; either version 2 of the License, --
-- or (at your option) any later version.                            --
--                                                                   --
-- This program is  distributed in the hope that it will be  useful, --
-- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of --
-- MERCHANTABILITY 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 along with this library; --
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
-----------------------------------------------------------------------

--  Parse a Glade's XML project file, declare the required callbacks and
--  create the widgets associated with the project file.
--  DGate can very easily be used in conjunction with GLADE to test during
--  the development.

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
with Glib.Glade;
with Gtk; use Gtk;
with Glade; use Glade;
with Glade.XML; use Glade.XML;
with Gtk.Main;
with DGate_Callbacks;
with System;
with Unchecked_Conversion;
with GNAT.OS_Lib;
with GNAT.Command_Line; use GNAT.Command_Line;

procedure DGate is

   use Glib;
   use Glib.Glade;
   use Glib.Glade.Glib_XML;

   package My_Timeout is new Gtk.Main.Timeout (Integer);

   type String_Access is access all String;
   for String_Access'Size use Standard'Address_Size;

   N        : Node_Ptr;
   Id       : Gtk.Main.Timeout_Handler_Id;
   Timeout  : Guint32 := 0;
   Filename : String_Ptr;
   XML      : Glade_XML;

   function To_Address is new Unchecked_Conversion
     (String_Access, System.Address);

   procedure Register_Signals (N : Node_Ptr);
   --  Call Set_Signal for each signal declared in the N tree.

   procedure Usage;

   procedure Register_Signals (N : Node_Ptr) is
      P       : Node_Ptr;
      Name    : String_Ptr;
      Handler : String_Ptr;
      S       : String_Access;

   begin
      if N.Tag.all = "signal" then
         Name := Get_Field (N, "name");
         Handler := Get_Field (N, "handler");

         if Name /= null then
            S := new String '(Name.all & ':' & Handler.all);
            Signal_Connect
              (XML, Handler.all, DGate_Callbacks.Generic_Callback'Address,
               To_Address (S));
            return;
         end if;
      end if;

      if N.Child /= null then
         Register_Signals (N.Child);
         P := N.Child.Next;

         while P /= null loop
            Register_Signals (P);
            P := P.Next;
         end loop;
      end if;
   end Register_Signals;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Usage: dgate project-file");
   end Usage;

begin
   if Argument_Count = 0 then
      Usage;
   else
      loop
         case Getopt ("timeout:") is
            when ASCII.NUL => exit;

            when 't' =>
               if Full_Switch = "timeout" then
                  Timeout := Guint32'Value (Parameter);
               else
                  raise Program_Error;
               end if;

            when others =>
               raise Program_Error;         -- cannot occur!
         end case;
      end loop;

      Filename := new String '(Get_Argument);

      if not GNAT.OS_Lib.Is_Regular_File (Filename.all) then
         Put_Line (Filename.all & " is not a regular file");
         return;
      end if;

      Gtk.Main.Init;
      Glade.Init;
      N := Parse (Filename.all);
      Gtk_New (XML, Filename.all);
      Register_Signals (N);

      if Timeout > 0 then
         --  Let the application run for timeout milliseconds and then quit

         Id := My_Timeout.Add (Timeout, DGate_Callbacks.Quit'Access, 0);
      end if;

      Gtk.Main.Main;
   end if;

exception
   when Invalid_Switch | Invalid_Parameter =>
      Usage;
   when others =>
      Put_Line
        ("DGATE: Internal error. Please send a bug report with the XML");
      Put_Line ("file " & Filename.all & " and the GtkAda version to " &
        "gtkada@ada.eu.org");
end DGate;