Testgtk source code
This code is part of testgtk, a demo application packaged with GtkAda. Testgtk demonstrates the various widgets of GtkAda
-----------------------------------------------------------------------
-- 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. --
-- --
--
--
--
--
--
--
--
-----------------------------------------------------------------------
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;