1-----------------------------------------------------------------------
2--          GtkAda - Ada95 binding for the Gimp Toolkit              --
3--                                                                   --
4--                     Copyright (C) 2003                            --
5--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
6--                                                                   --
7-- This library is free software; you can redistribute it and/or     --
8-- modify it under the terms of the GNU General Public               --
9-- License as published by the Free Software Foundation; either      --
10-- version 2 of the License, or (at your option) any later version.  --
11--                                                                   --
12-- This library 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.                          --
16--                                                                   --
17-- You should have received a copy of the GNU General Public         --
18-- License along with this library; if not, write to the             --
19-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
20-- Boston, MA 02111-1307, USA.                                       --
21--                                                                   --
22-- As a special exception, if other files instantiate generics from  --
23-- this unit, or you link this unit with other files to produce an   --
24-- executable, this  unit  does not  by itself cause  the resulting  --
25-- executable to be covered by the GNU General Public License. This  --
26-- exception does not however invalidate any other reasons why the   --
27-- executable file  might be covered by the  GNU Public License.     --
28-----------------------------------------------------------------------
29
30with Glib;            use Glib;
31with Gdk.Color;       use Gdk.Color;
32with Gtk;             use Gtk;
33with Gtk.Enums;       use Gtk.Enums;
34with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
35with Gtk.Text_Tag_Table; use Gtk.Text_Tag_Table;
36with Gtk.Text_Tag;    use Gtk.Text_Tag;
37with Gtk.Text_Iter;   use Gtk.Text_Iter;
38with Gtk.Text_Buffer; use Gtk.Text_Buffer;
39with Gtk.Text_View;   use Gtk.Text_View;
40with Gtk.Frame;       use Gtk.Frame;
41with Gtk.Widget;      use Gtk.Widget;
42with Pango.Font;      use Pango.Font;
43
44package body Create_Text_View is
45
46   procedure Insert_With_Tag
47     (Buffer : access Gtk_Text_Buffer_Record'Class;
48      Tag    : String;
49      Text   : String);
50   --  Insert some text with some special highlighting in the buffer.
51   --  Note: in a real application, one would pass a Gtk_Tag instead of a tag
52   --  name, to avoid a lookup in the tags table
53
54   ----------
55   -- Help --
56   ----------
57
58   function Help return String is
59   begin
60      return "A @bGtk_Text_View@B widget is a widget used to display any"
61        & " text graphically. It provides support for changing fonts, colors,"
62        & " background colors, as well as inserting pixmaps in the text."
63        & ASCII.LF
64        & "It is based on the model-view paradigm: the text itself is stored"
65        & " in a non-graphical object, a @bGtk_Text_Buffer@B, which has"
66        & " support for traversing the text through @bGtk_Text_Iter@B objects;"
67        & " This buffer is then associated with one or many @bGtk_Text_View@B"
68        & " which automatically reflect any change in the buffer."
69        & ASCII.LF
70        & "The text is fully editable";
71   end Help;
72
73   ---------------------
74   -- Insert_With_Tag --
75   ---------------------
76
77   procedure Insert_With_Tag
78     (Buffer : access Gtk_Text_Buffer_Record'Class;
79      Tag    : String;
80      Text   : String)
81   is
82      T : Gtk_Text_Tag;
83      Iter, Start_Iter : Gtk_Text_Iter;
84      Table : Gtk_Text_Tag_Table;
85      Result : Boolean;
86      pragma Warnings (Off, Result);
87   begin
88      Get_End_Iter (Buffer, Iter);
89
90      if Tag = "" then
91         Insert (Buffer, Iter, Text & ASCII.LF);
92
93      else
94         Table := Get_Tag_Table (Buffer);
95         T := Lookup (Table, Tag);
96
97         Insert (Buffer, Iter, Text & ASCII.LF);
98         Copy (Source => Iter, Dest => Start_Iter);
99         Backward_Chars (Start_Iter, Text'Length + 1, Result);
100         Apply_Tag (Buffer, T, Start_Iter, Iter);
101      end if;
102   end Insert_With_Tag;
103
104   ---------
105   -- Run --
106   ---------
107
108   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
109      Buffer   : Gtk_Text_Buffer;
110      Tags     : Gtk_Text_Tag_Table;
111      Tag      : Gtk_Text_Tag;
112      Color    : Gdk_Color;
113      View     : Gtk_Text_View;
114      Scrolled : Gtk_Scrolled_Window;
115
116   begin
117      Gtk_New (Tags);
118
119      --  Create the tags that will be used to change the rendering of the
120      --  text.
121
122      Color := Parse ("red");
123      Alloc (Get_Default_Colormap, Color);
124
125      Gtk_New (Tag, "red");
126      Add (Tags, Tag);
127      Set_Property (Tag, Foreground_Gdk_Property, Color);
128
129      Gtk_New (Tag, "courier");
130      Add (Tags, Tag);
131      Set_Property (Tag, Font_Desc_Property, From_String ("Courier bold"));
132
133      --  Create the buffer and the views as appropriate
134
135      Gtk_New (Buffer, Tags);
136
137      Set_Label (Frame, "Text View");
138      Gtk_New (View, Buffer);
139
140      --  Insert some random text
141
142      for Lien in 1 .. 50 loop
143         for Count in 1 .. 10 loop
144            Insert_With_Tag
145              (Buffer, "", "A normal line with no special highlight");
146         end loop;
147
148         Insert_With_Tag
149           (Buffer, "red", "Some text in red, notice the use of tags");
150         Insert_With_Tag
151           (Buffer, "courier", "The font can also be changed");
152      end loop;
153
154      --  Insert the view in the frame
155
156      Gtk_New (Scrolled);
157      Set_Policy (Scrolled, Policy_Always, Policy_Always);
158      Add (Scrolled, View);
159
160      Show_All (Scrolled);
161      Add (Frame, Scrolled);
162   end Run;
163
164end Create_Text_View;
165