File: create_about.adb

package info (click to toggle)
libgtkada 18-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 28,348 kB
  • sloc: ada: 61,514; xml: 7,709; python: 4,310; sh: 2,822; ansic: 1,598; makefile: 240; objc: 160; perl: 70
file content (126 lines) | stat: -rw-r--r-- 5,413 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
------------------------------------------------------------------------------
--               GtkAda - Ada95 binding for the Gimp Toolkit                --
--                                                                          --
--                     Copyright (C) 2006-2018, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  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 MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Text_IO;          use Ada.Text_IO;
with GNAT.Strings;         use GNAT.Strings;
with Gtk.About_Dialog;     use Gtk.About_Dialog;
with Gtk.Dialog;           use Gtk.Dialog;
with Gtk.Frame;            use Gtk.Frame;
with Gtk.Window;           use Gtk.Window;
with Gtk.Widget;           use Gtk.Widget;

package body Create_About is

   function On_Activate_Link
      (About : access Gtk_About_Dialog_Record'Class;
       URI   : String) return Boolean;
   --  Called when a link is clicked

   ----------------------
   -- On_Activate_Link --
   ----------------------

   function On_Activate_Link
      (About : access Gtk_About_Dialog_Record'Class;
       URI   : String) return Boolean
   is
      pragma Unreferenced (About);
   begin
      Put_Line ("Url clicked: " & URI);
      return True;
   end On_Activate_Link;

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

   function Help return String is
   begin
      return "The @bGtk_About_Dialog@B is used to display information about"
        & " your application, like its name, version, developers, website";
   end Help;

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

   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
      Dialog : Gtk_About_Dialog;
   begin
      Set_Label (Frame, "About dialog");

      Gtk_New (Dialog);
      Set_Transient_For (Dialog, Gtk_Window (Get_Toplevel (Frame)));
      Set_Destroy_With_Parent (Dialog, True);
      Set_Modal (Dialog, True);

      Dialog.On_Activate_Link (On_Activate_Link'Access);

      --  In real applications, you will need to free the allocate strings
      Set_Artists (Dialog, (1 => new String'("Artist1 <artist1@foo.com>"),
                            2 => new String'("Artist2 <artist2@foo.com>")));
      Set_Authors (Dialog, (1 => new String'("Author1 <author1@foo.com>"),
                            2 => new String'("Author2 <author2@foo.com>")));
      Set_Documenters
        (Dialog, (1 => new String'("Documenter1"),
                   2 => new String'("Documenter2 <doc@foo.com>")));
      Set_Comments  (Dialog, "Comment about the application");
      Set_Copyright (Dialog, "Copyright (c) 2006, AdaCore");
      Set_License
        (Dialog,
         "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 3 of the License, or (at your option) any later version."
         & ASCII.LF
         & "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.");
      Set_Wrap_License (Dialog, True);
      Set_Program_Name (Dialog, "Testgtk");
      Set_Version (Dialog, "2.8.17");
      Set_Website (Dialog, "http://www.adacore.com");
      Set_Website_Label (Dialog, "AdaCore");

      --  Just checking that this works correctly
      declare
         Artists : String_List := Get_Artists (Dialog);
      begin
         for A in Artists'Range loop
            Put_Line ("Artist: " & Artists (A).all);
            Free (Artists (A));
         end loop;
      end;

      --  In real application, you might not want to call Run here, just
      --     Present (Dialog)
      --  so that it doesn't block the rest of your application
      if Run (Dialog) /= Gtk_Response_Close then
         --  Dialog was destroyed by user, not closed through Close button
         null;
      end if;
      Destroy (Dialog);
   end Run;

end Create_About;