File: create_sources.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 (307 lines) | stat: -rw-r--r-- 10,735 bytes parent folder | download | duplicates (2)
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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
-----------------------------------------------------------------------
--          GtkAda - Ada95 binding for the Gimp Toolkit              --
--                                                                   --
--                  Copyright 2006 AdaCore                           --
--                                                                   --
-- This library 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 library 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.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

with Ada.Calendar;        use Ada.Calendar;
with Glib.Main;           use Glib, Glib.Main;
with Gtk.Box;             use Gtk.Box;
with Gtk.Enums;           use Gtk.Enums;
with Gtk.Frame;           use Gtk.Frame;
with Gtk.Label;           use Gtk.Label;
with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
with Gtk.Text_Buffer;     use Gtk.Text_Buffer;
with Gtk.Text_Iter;       use Gtk.Text_Iter;
with Gtk.Text_View;       use Gtk.Text_View;
with Gtk.Widget;          use Gtk.Widget;
with Gtkada.Handlers;     use Gtkada.Handlers;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System;
with GNAT.OS_Lib;         use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Ada.Text_IO; use Ada.Text_IO;

package body Create_Sources is

   Buffer : Gtk_Text_Buffer;
   Id     : G_Source_Id := 0;

   File_Monitor : G_Source_Type := Null_Source_Type;
   --  A particular kind of G_Source that monitors changes to a file.

   type String_Access is access String;

   type Source_User_Data is record
      File_Name      : String_Access;
      Last_Check     : Time;
      File_Timestamp : OS_Time := Invalid_Time;
   end record;
   type Source_User_Data_Access is access Source_User_Data;
   --  The user data stored in our monitor.
   --  We use it to avoid checking the file system too often

   function Convert is new Ada.Unchecked_Conversion
     (System.Address, Source_User_Data_Access);

   procedure On_Destroy (Box : access Gtk_Widget_Record'Class);
   --  Called when this demo is closed.

   -------------
   -- Monitor --
   -------------
   --  This defines a new source type that monitors file events.

   procedure Create_Monitor (File_Name : String);
   --  Create a new input source that monitors changes in a file.

   function Prepare (Source : G_Source; Timeout : access Gint) return Gboolean;
   function Check   (Source : G_Source) return Gboolean;
   procedure Finalize (Source : G_Source);
   --  See the documentation in glib-main.ads for these primitive operations
   --  of G_Source

   pragma Convention (C, Prepare);
   pragma Convention (C, Check);
   pragma Convention (C, Finalize);

   --------------
   -- G_Source --
   --------------
   --  This is the implementation of a specific source of the type Monitor,
   --  which refreshes the graphical buffer to show the new file contents

   package String_Sources is new Generic_Sources (String);

   function Refresh_File (Filename : String) return Boolean;
   --  Refresh the contents of the file that the source was monitoring

   ----------
   -- Help --
   ----------

   function Help return String is
   begin
      return "The main even loop of gtk+ is highly configurable. It monitors"
        & " various event sources, including the windowing system, pipes,"
        & " running processes, timeouts... and will call user-defined"
        & " callbacks whenever some event happens." & ASCII.LF
        & "It is possible for you to define your own source of events, as"
        & " demonstrated here." & ASCII.LF
        & "This demo monitors a file on the disk (""sources"" in the testgtk/"
        & " directory. Open a text editor, create that file if necessary,"
        & " add some data to it, and save. You will see immediately the new"
        & " contents of the file." & ASCII.LF
        & "While it certainly isn't the most efficient way to do that (having"
        & " a timeout that checks periodically might be more appropriate),"
        & " this demo shows how you can create your own event source. On"
        & " linux systems, the kernel is able to notify users whenever some"
        & " part of the file system changes. You could connect to dbus, on"
        & " which the kernel sends this info, and use this as an event source"
        & " in your application.";
   end Help;

   ------------------
   -- Refresh_File --
   ------------------

   function Refresh_File (Filename : String) return Boolean is
      Start, Last : Gtk_Text_Iter;
      File : File_Type;
      Contents : String (1 .. 1024);
      L       : Natural;
   begin
      Get_Start_Iter (Buffer, Start);
      Get_End_Iter   (Buffer, Last);
      Delete (Buffer, Start, Last);

      Open (File, In_File, Get_Current_Dir & Filename);
      Insert_At_Cursor
        (Buffer, "File name is: " & Filename & ASCII.LF);

      loop
         Get_Line (File, Contents, L);
         exit when L = 0;

         Get_End_Iter (Buffer, Last);
         Insert (Buffer, Last, Contents (Contents'First .. L));
      end loop;

      Close (File);
      return True;

   exception
      when End_Error =>
         Close (File);
         return True;
      when Name_Error =>
         return True;
   end Refresh_File;

   -------------
   -- Prepare --
   -------------

   function Prepare (Source : G_Source; Timeout : access Gint) return Gboolean
   is
      Data : constant Source_User_Data_Access :=
        Convert (Get_User_Data (Source));
      T    : OS_Time;
   begin
      --  Note: we always set the timeout to something suitable. If we don't,
      --  its default value of -1 will be used, which means that gtk+ will wait
      --  until one even is available somewhere (most likely a graphical
      --  event), and as a result Prepare will only be called after an event
      --  has been processed, which isn't what we want

      Timeout.all := 500;

      --  The timeout above ensures that we are not called less than every
      --  500 ms. However, to spare system resources, which should ensure that
      --  we do not check the file system too often

      if Clock - Data.Last_Check > 0.4 then
         Data.Last_Check := Clock;

         --  Check whether the file has been modified
         T := File_Time_Stamp (Data.File_Name.all);
         if T /= Data.File_Timestamp then
            Data.File_Timestamp := T;
            return 1;
         else
            return 0;
         end if;

      else
         return 0;
      end if;
   end Prepare;

   -----------
   -- Check --
   -----------

   function Check (Source : G_Source) return Gboolean is
      pragma Unreferenced (Source);
   begin
      return 0;
   end Check;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Source : G_Source) is
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
        (Source_User_Data, Source_User_Data_Access);
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
        (String, String_Access);
      Data : Source_User_Data_Access :=
        Convert (Get_User_Data (Source));
   begin
      Unchecked_Free (Data.File_Name);
      Unchecked_Free (Data);
   end Finalize;

   --------------------
   -- Create_Monitor --
   --------------------

   procedure Create_Monitor (File_Name : String) is
      Source : G_Source;
      Data   : Source_User_Data_Access;
   begin
      if File_Monitor = Null_Source_Type then
         File_Monitor := G_Source_Type_New
           (Prepare  => Prepare'Access,
            Check    => Check'Access,
            Finalize => Finalize'Access);
      end if;

      Data := new Source_User_Data'
        (Last_Check     => Clock,
         File_Name      => new String'(File_Name),
         File_Timestamp => Invalid_Time);
      Source := Source_New (File_Monitor, Data.all'Address);

      String_Sources.Set_Callback
        (Source, Refresh_File'Access, File_Name);

      --  Start executing Source
      Id := Attach (Source, null);
   end Create_Monitor;

   ----------------
   -- On_Destroy --
   ----------------

   procedure On_Destroy (Box : access Gtk_Widget_Record'Class) is
      pragma Unreferenced (Box);
   begin
      if Id /= 0 then
         Remove (Id);
         Id := 0;
         Buffer := null;
      end if;
   end On_Destroy;

   ---------
   -- Run --
   ---------

   procedure Run (F : access Gtk.Frame.Gtk_Frame_Record'Class) is
      Label  : Gtk_Label;
      View   : Gtk_Text_View;
      Box    : Gtk_Box;
      Scrolled : Gtk_Scrolled_Window;
   begin
      Gtk_New_Vbox (Box, Homogeneous => False);
      Set_Label (F, "New event source for main loop");
      Add (F, Box);

      Gtk_New
        (Label, "Edit and save the file ""sources"" in the current directory");
      Pack_Start (Box, Label, Expand => False);

      Gtk_New (Label, "and let this demo monitor its contents");
      Pack_Start (Box, Label, Expand => False);

      Gtk_New (Scrolled);
      Set_Policy (Scrolled, Policy_Automatic, Policy_Automatic);
      Pack_Start (Box, Scrolled, Expand => True, Fill => True);

      Gtk_New (Buffer);
      Gtk_New (View, Buffer);

      Add (Scrolled, View);

      Create_Monitor ("sources");
      Widget_Callback.Connect (Box, "destroy", On_Destroy'Access);

      Show_All (Box);
   end Run;

end Create_Sources;