File: create_mdi.adb

package info (click to toggle)
libgtkada 2.24.4dfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 12,208 kB
  • ctags: 1,676
  • sloc: ada: 119,686; ansic: 4,719; sh: 3,003; makefile: 690; xml: 338; perl: 70
file content (390 lines) | stat: -rw-r--r-- 13,913 bytes parent folder | download
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
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
-----------------------------------------------------------------------
--          GtkAda - Ada95 binding for the Gimp Toolkit              --
--                                                                   --
--                     Copyright (C) 2003                            --
--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
--                     Copyright (C) 2004-2013, 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 Gdk.Bitmap;         use Gdk.Bitmap;
with Gdk.Color;          use Gdk.Color;
with Gdk.Pixmap;         use Gdk.Pixmap;
with Glib.Xml_Int;       use Glib.Xml_Int;
with Gtk;                use Gtk;
with Gtk.Accel_Group;    use Gtk.Accel_Group;
with Gtk.Box;            use Gtk.Box;
with Gtk.Frame;          use Gtk.Frame;
with Gtk.Label;          use Gtk.Label;
with Gtk.Menu;           use Gtk.Menu;
with Gtk.Menu_Tool_Button; use Gtk.Menu_Tool_Button;
with Gtk.Widget;         use Gtk.Widget;
with Gtkada.MDI;         use Gtkada.MDI;
with Gtk.Toolbar;        use Gtk.Toolbar;
with Gtkada.Handlers;    use Gtkada.Handlers;
with Gtk.Toggle_Tool_Button;  use Gtk.Toggle_Tool_Button;
with Gtk.Tool_Button;    use Gtk.Tool_Button;
with Gtk.Enums;          use Gtk.Enums;
with Gtk.Window;         use Gtk.Window;
with Gtk.Image;          use Gtk.Image;

package body Create_MDI is

   package Desktops is new Gtkada.MDI.Desktop (Integer);

   function Create_Child (Index : Natural) return MDI_Child;
   procedure On_Opaque  (Button : access Gtk_Widget_Record'Class);
   procedure On_Snapshot  (Button : access Gtk_Widget_Record'Class);
   procedure Do_Configure (MDI : access MDI_Window_Record'Class);

   procedure On_Save_Desktop (Button : access Gtk_Widget_Record'Class);
   procedure Load_Desktop;
   --  Load the desktop (and all known perspectives) from an external
   --  XML file. Or create that file from the current desktop.

   function Load_From_Desktop
      (MDI  : MDI_Window;
       Node : Glib.Xml_Int.Node_Ptr;
       User : Integer) return MDI_Child;
   --  This function recreates a MDI_Child from its XML description as
   --  given in a desktop.xml file (see the documentation for package
   --  Desktop).

   function Save_To_Desktop
      (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
       User   : Integer) return Glib.Xml_Int.Node_Ptr;
   --  This is the opposite of Load_From_Desktop, and saves an existing
   --  window into an XML node (with all information needed so that
   --  Load_From_Desktop can recreate it later).

   procedure Setup
      (Frame : access Gtk_Frame_Record'Class; Independent : Boolean);
   --  Create the demo, either in "Independent Perspectives" mode or not.

   type My_Window_Record is new Gtk_Box_Record with record
      Index : Natural;
   end record;
   type My_Window is access all My_Window_Record'Class;
   --  The type of windows this example is using. In practive, you would
   --  likely put trees, editors, and other kinds of complex windows.

   MDI    : MDI_Window;
   Opaque : Boolean := False;

   My_Window_Name : constant String := "my_window_";

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

   function Help return String is
   begin
      return "A Gtkada specific widget." & ASCII.LF
        & "This is based on the GtkAda multi panned widget. You should"
        & " try the corresponding demo to find out about other capabilities"
        & " like splitting windows or using fixed sizes." & ASCII.LF
        & "In the MDI, windows can be dragged around to be reorganized."
        & " The MDI also supports the notion of perspectives: when you"
        & " select another perspective, some of the windows (the ones in the"
        & " central area) will be preserved. All other windows will only"
        & " remain visible if they also are in the other perspective."
        & " This example loads the perspectives from an XML file, and you"
        & " can then switch between perspectives by using the menu"
        & " <b>Perspectives</b>. By default, the MDI includes a central area"
        & " whose content is preserved when you switch perspectives. For"
        & " instance, this could be used in an IDE so that the editors are"
        & " the same in the development and debugging perspectives. However,"
        & " it can sometimes be confusing to users, so you can force"
        & " the perspectives to be <b>independent</b>. In such a case, no"
        & " window is preserved when switching perspectives."
        & ASCII.LF
        & "The MDI also provides the notion of desktop (the current layout"
        & " of your windows in all the perspectives). Such a desktop can be"
        & " saved to the disk, and restored when the application is"
        & " restarted (not shown in this demo). This is actually how"
        & " the default perspectives themselves can be defined initially"
        & " when you package your application."
        & ASCII.LF
        & "Windows can be @bfloated@B, ie put outside of the MDI, by"
        & " the user. This provides a convenient use for many users who"
        & " prefer having multiple windows. It is also a convenient way"
        & " to use multiple screens. You can either float a window"
        & " programmatically (and provide a menu to the user to do so),"
        & " or the user can drag a window outside of the MDI to float it"
        & ASCII.LF
        & "A contextual menu exists in the notebook tabs to close windows,"
        & " or change the location of tabs.";
   end Help;

   ------------------
   -- Do_Configure --
   ------------------

   procedure Do_Configure (MDI : access MDI_Window_Record'Class) is
      Bg_Color, Title_Color, Focus_Color : Gdk_Color;
   begin
      Bg_Color := Parse ("#8A8A8A");
      Alloc (Get_Colormap (MDI), Bg_Color);

      Title_Color := Parse ("#7D7D7D");
      Alloc (Get_Colormap (MDI), Title_Color);

      Focus_Color := Parse ("#5894FA");
      Alloc (Get_Colormap (MDI), Focus_Color);

      Configure (MDI,
                 Background_Color  => Bg_Color,
                 Title_Bar_Color   => Title_Color,
                 Focus_Title_Color => Focus_Color,
                 Opaque_Resize     => Opaque,
                 Show_Tabs_Policy  => Automatic,
                 Tabs_Position     => Gtk.Enums.Pos_Bottom,
                 Draw_Title_Bars   => Always);
   end Do_Configure;

   ---------------
   -- On_Opaque --
   ---------------

   procedure On_Opaque  (Button : access Gtk_Widget_Record'Class) is
      pragma Unreferenced (Button);
   begin
      Opaque := not Opaque;
      Do_Configure (MDI);
   end On_Opaque;

   -----------------
   -- On_Snapshot --
   -----------------

   Iterator : Child_Iterator;

   procedure On_Snapshot (Button : access Gtk_Widget_Record'Class) is
      pragma Unreferenced (Button);
      Child : MDI_Child;
      Pixmap : Gdk_Pixmap;
      Window : Gtk_Window;
      Image  : Gtk_Image;
   begin
      Child := Get (Iterator);

      if Child = null then
         Iterator := First_Child (MDI);
         Child := Get (Iterator);
      else
         Next (Iterator);
      end if;

      Pixmap := Get_Snapshot (Child, null);

      Gtk_New (Window);
      Set_Default_Size (Window, 800, 600);

      Gtk_New (Image, Pixmap, Null_Bitmap);
      Add (Window, Image);
      Show_All (Window);
   end On_Snapshot;

   ---------------------
   -- On_Save_Desktop --
   ---------------------

   procedure On_Save_Desktop (Button : access Gtk_Widget_Record'Class) is
      pragma Unreferenced (Button);

      Perspectives, Central : Node_Ptr;
   begin
      Desktops.Save_Desktop (MDI, 0, Perspectives, Central);

      --  These could also be saved in the same XML file. We keep this
      --  example simpler by avoiding the extra XML manipulation this requires

      if Independent_Perspectives (MDI) then
         Print (Perspectives, "perspectives_indep.xml");
      else
         Print (Perspectives, "perspectives.xml");
         Print (Central, "central.xml");
      end if;
   end On_Save_Desktop;

   ------------------
   -- Load_Desktop --
   ------------------

   procedure Load_Desktop is
      Perspectives, Central : Node_Ptr;
      Success : Boolean;
      pragma Unreferenced (Success);
   begin
      if Independent_Perspectives (MDI) then
         Perspectives := Parse ("perspectives_indep.xml");
      else
         Perspectives := Parse ("perspectives.xml");
         Central      := Parse ("central.xml");
      end if;

      Success := Desktops.Restore_Desktop (MDI, Perspectives, Central, 0);
   end Load_Desktop;

   ------------------
   -- Create_Child --
   ------------------

   function Create_Child (Index : Natural) return MDI_Child is
      Child : MDI_Child;
      Box   : My_Window;
      Label : Gtk_Label;
   begin
      Box := new My_Window_Record;
      Box.Index := Index;
      Initialize_Vbox (Box);

      Gtk_New (Child, Box, Flags => All_Buttons, Group => Group_Default);

      Gtk_New (Label, "This is the" & Integer'Image (Index) & " window");
      Pack_Start (Box, Label);

      Set_Title (Child, "Window" & Integer'Image (Index));

      Show_All (Child);
      return Child;
   end Create_Child;

   ---------------------
   -- Save_To_Desktop --
   ---------------------

   function Save_To_Desktop
      (Widget : access Gtk.Widget.Gtk_Widget_Record'Class;
       User   : Integer) return Glib.Xml_Int.Node_Ptr
   is
      pragma Unreferenced (User);
      Box : constant My_Window := My_Window (Widget);
      Index : constant String := Box.Index'Img;
      N   : Node_Ptr;
   begin
      --  We store the index directly in the XML tag, so that all windows
      --  appear to be different.
      N := new Node;
      N.Tag := new String'
         (My_Window_Name & Index (Index'First + 1 .. Index'Last));
      return N;
   end Save_To_Desktop;

   -----------------------
   -- Load_From_Desktop --
   -----------------------

   function Load_From_Desktop
      (MDI  : MDI_Window;
       Node : Glib.Xml_Int.Node_Ptr;
       User : Integer) return MDI_Child
   is
      pragma Unreferenced (User);
      Child : MDI_Child;
      Index : constant Integer := Integer'Value
        (Node.Tag (Node.Tag'First + My_Window_Name'Length .. Node.Tag'Last));
   begin
      Child := Create_Child (Index);
      Put (MDI, Child, Position_Automatic);
      return Child;
   end Load_From_Desktop;

   -----------
   -- Setup --
   -----------

   procedure Setup
      (Frame : access Gtk_Frame_Record'Class; Independent : Boolean)
   is
      Bar    : Gtk_Toolbar;
      Box    : Gtk_Box;
      Toggle : Gtk_Toggle_Tool_Button;
      Button : Gtk_Tool_Button;
      Group  : Gtk_Accel_Group;

      Menu   : Gtk_Menu;
      Menu_Button : Gtk_Menu_Tool_Button;

      Success : Boolean;
      pragma Unreferenced (Success);
   begin
      Gtk_New_Vbox (Box, Homogeneous => False);
      Add (Frame, Box);

      Gtk_New (Bar);
      Pack_Start (Box, Bar, Expand => False);

      Gtk_New (Group);
      Gtk_New (MDI, Group => Group, Independent_Perspectives => Independent);
      Do_Configure (MDI);
      Pack_End (Box, MDI, Expand => True);

      Menu := Desktops.Create_Menu (MDI, User => 1);  --  User irrelevant here

      Gtk_New (Toggle);
      Set_Label (Toggle, "Opaque Resizing");
      Insert (Bar, Toggle);
      Widget_Callback.Connect (Toggle, "toggled", On_Opaque'Access);

      Gtk_New (Button, Label => "Save Desktop");
      Insert (Bar, Button);
      Widget_Callback.Connect (Button, "clicked", On_Save_Desktop'Access);

      Gtk_New (Menu_Button, Label => "Menu");
      Set_Menu (Menu_Button, Menu);
      Insert (Bar, Menu_Button);

      Gtk_New (Button, Label => "Snapshot");
      Insert (Bar, Button);
      Widget_Callback.Connect (Button, "clicked", On_Snapshot'Access);
      --  Pressing "snapshot will cycle through the MDI children and take
      --  a pixmap of the MDI children.

      --  Load the desktop from external XML files

      Desktops.Register_Desktop_Functions
         (Save_To_Desktop'Access, Load_From_Desktop'Access);

      Load_Desktop;
      --  Put (MDI, Create_Child (1), Position_Automatic);
      --  Put (MDI, Create_Child (2), Position_Automatic);
      --  Put (MDI, Create_Child (3), Position_Automatic);

      Show_All (Frame);
   end Setup;

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

   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
   begin
      Setup (Frame, Independent => False);
   end Run;

   ---------------------
   -- Run_Independent --
   ---------------------

   procedure Run_Independent
      (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
   begin
      Setup (Frame, Independent => True);
   end Run_Independent;
end Create_MDI;