1------------------------------------------------------------------------------
2--               GtkAda - Ada95 binding for the Gimp Toolkit                --
3--                                                                          --
4--                     Copyright (C) 2003-2015, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Glib;            use Glib;
25with Gdk.RGBA;        use Gdk.RGBA;
26with Gtk;             use Gtk;
27with Gtk.Enums;       use Gtk.Enums;
28with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
29with Gtk.Text_Tag_Table; use Gtk.Text_Tag_Table;
30with Gtk.Text_Tag;    use Gtk.Text_Tag;
31with Gtk.Text_Iter;   use Gtk.Text_Iter;
32with Gtk.Text_Buffer; use Gtk.Text_Buffer;
33with Gtk.Text_View;   use Gtk.Text_View;
34with Gtk.Text_Mark;   use Gtk.Text_Mark;
35with Gtk.Frame;       use Gtk.Frame;
36with Gtk.Widget;      use Gtk.Widget;
37with Pango.Font;      use Pango.Font;
38
39package body Create_Text_View is
40
41   procedure Insert_With_Tag
42     (Buffer : access Gtk_Text_Buffer_Record'Class;
43      Tag    : String;
44      Text   : String);
45   --  Insert some text with some special highlighting in the buffer.
46   --  Note: in a real application, one would pass a Gtk_Tag instead of a tag
47   --  name, to avoid a lookup in the tags table
48
49   ----------
50   -- Help --
51   ----------
52
53   function Help return String is
54   begin
55      return "A @bGtk_Text_View@B widget is a widget used to display any"
56        & " text graphically. It provides support for changing fonts, colors,"
57        & " background colors, as well as inserting pixmaps in the text."
58        & ASCII.LF
59        & "It is based on the model-view paradigm: the text itself is stored"
60        & " in a non-graphical object, a @bGtk_Text_Buffer@B, which has"
61        & " support for traversing the text through @bGtk_Text_Iter@B objects;"
62        & " This buffer is then associated with one or many @bGtk_Text_View@B"
63        & " which automatically reflect any change in the buffer."
64        & ASCII.LF
65        & "The text is fully editable";
66   end Help;
67
68   ---------------------
69   -- Insert_With_Tag --
70   ---------------------
71
72   procedure Insert_With_Tag
73     (Buffer : access Gtk_Text_Buffer_Record'Class;
74      Tag    : String;
75      Text   : String)
76   is
77      T : Gtk_Text_Tag;
78      Iter, Start_Iter : Gtk_Text_Iter;
79      Table : Gtk_Text_Tag_Table;
80      Result : Boolean;
81      pragma Warnings (Off, Result);
82   begin
83      Get_End_Iter (Buffer, Iter);
84
85      if Tag = "" then
86         Insert (Buffer, Iter, Text & ASCII.LF);
87      else
88         Table := Get_Tag_Table (Buffer);
89         T := Lookup (Table, Tag);
90
91         Insert (Buffer, Iter, Text & ASCII.LF);
92         Start_Iter := Iter;
93         Backward_Chars (Start_Iter, Text'Length + 1, Result);
94         Apply_Tag (Buffer, T, Start_Iter, Iter);
95      end if;
96   end Insert_With_Tag;
97
98   ---------
99   -- Run --
100   ---------
101
102   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
103      Buffer   : Gtk_Text_Buffer;
104      Tags     : Gtk_Text_Tag_Table;
105      Tag      : Gtk_Text_Tag;
106      Color    : Gdk_RGBA;
107      View     : Gtk_Text_View;
108      Scrolled : Gtk_Scrolled_Window;
109      Success  : Boolean;
110
111   begin
112      Gtk_New (Tags);
113
114      --  Create the tags that will be used to change the rendering of the
115      --  text.
116
117      Parse (Color, "red", Success);
118      Gtk_New (Tag, "red_tag");
119      Add (Tags, Tag);
120      Set_Property (Tag, Foreground_Rgba_Property, Color);
121
122      Gtk_New (Tag, "courier_tag");
123      Add (Tags, Tag);
124      Set_Property (Tag, Font_Desc_Property, From_String ("Courier bold"));
125
126      Parse (Color, "green", Success);
127      Gtk_New (Tag, "green_tag");
128      Add (Tags, Tag);
129      Set_Property (Tag, Foreground_Rgba_Property, Color);
130
131      --  Create the buffer and the views as appropriate
132
133      Gtk_New (Buffer, Tags);
134
135      Set_Label (Frame, "Text View");
136      Gtk_New (View, Buffer);
137
138      --  Insert some random text
139
140      for Lien in 1 .. 2 loop
141         for Count in 1 .. 10 loop
142            Insert_With_Tag
143              (Buffer, "", "A normal line with no special highlight");
144         end loop;
145
146         Insert_With_Tag
147           (Buffer, "red_tag", "Some text in red, notice the use of tags");
148         Insert_With_Tag
149           (Buffer, "courier_tag", "The font can also be changed");
150      end loop;
151
152      --  Insert the view in the frame
153
154      Gtk_New (Scrolled);
155      Set_Policy (Scrolled, Policy_Always, Policy_Always);
156      Add (Scrolled, View);
157
158      Show_All (Scrolled);
159      Add (Frame, Scrolled);
160
161      declare
162         Iter, Begin_Result, End_Result : Gtk_Text_Iter;
163         Success : Boolean := False;
164         Mark : Gtk_Text_Mark;
165
166      begin
167         --  Create a mark referencing the first line in courier
168
169         Gtk_New (Mark, "My mark", True);
170         Get_Iter_At_Line (Buffer, Iter, 12);
171         Add_Mark (Buffer, Mark, Iter);
172
173         --  Replace the five first occurrences of the word "placeholder"
174
175         for J in 1 .. 5 loop
176            Get_Iter_At_Offset (Buffer, Iter, Char_Offset => 0);
177
178            --  Use forward search to find the next occurrence
179
180            Forward_Search (Iter, "special", Case_Insensitive,
181                            Match_Start => Begin_Result,
182                            Match_End => End_Result,
183                            Result => Success);
184
185            --  Replace "special" with "particular"
186
187            if Success then
188               Delete (Buffer, Begin_Result, End_Result);
189               Insert (Buffer, Begin_Result, "particular");
190            end if;
191         end loop;
192
193         Forward_Line (Begin_Result, Success);
194
195         --  Delete the next five lines
196
197         for J in 1 .. 5 loop
198            if Success then
199               End_Result := Begin_Result;
200               Forward_To_Line_End (End_Result, Success);
201               Forward_Char (End_Result, Success);
202
203               if Success then
204                  Delete (Buffer, Begin_Result, End_Result);
205               end if;
206            end if;
207         end loop;
208
209         --  See that the mark moved with the deletions
210         --  By modifying and coloring the line where the mark was set at
211
212         Get_Iter_At_Mark (Buffer, Iter, Mark);
213
214         Forward_Search (Iter, "normal", Case_Insensitive,
215                         Match_Start => Begin_Result,
216                         Match_End => End_Result,
217                         Result => Success);
218         Forward_To_Line_End (End_Result, Success);
219
220         if Success then
221            Delete (Buffer, Begin_Result, End_Result);
222            Insert (Buffer, Begin_Result, "green line");
223         end if;
224
225         --  Color the whole modified line in green
226
227         Tag := Lookup (Tags, "green_tag");
228         Get_Iter_At_Mark (Buffer, Begin_Result, Mark);
229         End_Result := Begin_Result;
230         Forward_To_Line_End (End_Result, Success);
231         Apply_Tag (Buffer, Tag, Begin_Result, End_Result);
232
233         --  Remove the mark, we no longer need it
234
235         Delete_Mark (Buffer, Mark);
236      end;
237   end Run;
238
239end Create_Text_View;
240