Skip to content
Newer
Older
100644 189 lines (164 sloc) 7.06 KB
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
1 ! Copyright (C) 2011
2 ! Free Software Foundation, Inc.
3
4 ! This file is part of the gtk-fortran GTK+ Fortran Interface library.
5
6 ! This is free software; you can redistribute it and/or modify
7 ! it under the terms of the GNU General Public License as published by
8 ! the Free Software Foundation; either version 3, or (at your option)
9 ! any later version.
10
11 ! This software is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15
16 ! Under Section 7 of GPL version 3, you are granted additional
17 ! permissions described in the GCC Runtime Library Exception, version
18 ! 3.1, as published by the Free Software Foundation.
19
20 ! You should have received a copy of the GNU General Public License along with
21 ! this program; see the files COPYING3 and COPYING.RUNTIME respectively.
22 ! If not, see <http://www.gnu.org/licenses/>.
23 !
24 ! Contributed by James Tappin
25 ! Last modification: 11-21-2011
26
27 ! --------------------------------------------------------
28 ! gtk-hl-dialog.f90
d92a293 @jtappin Merge branch 'gtk2_24_glib2_32' of https://github.com/jerryd/gtk-fortran
jtappin authored Aug 19, 2012
29 ! Generated: Sun Aug 19 21:39:00 2012 GMT
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
30 ! Please do not edit this file directly,
31 ! Edit gtk-hl-dialog-tmpl.f90, and use ./mk_gtk_hl.pl to regenerate.
585e643 @jtappin Update syntax for conditional lines in high-level templates.
jtappin authored Jul 30, 2012
32 ! Generated for GTK+ version: 2.24.0.
452dabf @jtappin Resync high-level routines to other branches.
jtappin authored Jul 30, 2012
33 ! Generated for GLIB version: 2.32.0.
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
34 ! --------------------------------------------------------
35
36
37 module gtk_hl_dialog
38 !*
39 ! Dialogue
40 ! The message dialogue provided is here because, the built-in message
41 ! dialogue GtkMessageDialog cannot be created without calling variadic
42 ! functions which are not compatible with Fortran, therefore this is
43 ! based around the plain GtkDialog family.
44 !/
45
46 use gtk_sup
47 use iso_c_binding
48 ! autogenerated use's
49 use gtk, only: gtk_box_pack_start, gtk_dialog_add_button,&
50 & gtk_dialog_get_content_area, gtk_dialog_new, gtk_dialog_run,&
585e643 @jtappin Update syntax for conditional lines in high-level templates.
jtappin authored Jul 30, 2012
51 & gtk_image_new, gtk_image_new_from_stock,&
52 & gtk_label_new, gtk_label_set_markup, &
53 & gtk_hbox_new, gtk_vbox_new,&
54 !!$GTK>=3.0! & gtk_box_new,&
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
55 & gtk_widget_destroy, gtk_widget_show, gtk_widget_show_all,&
56 & gtk_window_set_destroy_with_parent, gtk_window_set_modal,&
57 & gtk_window_set_title, gtk_window_set_transient_for, &
58 & GTK_BUTTONS_YES_NO, GTK_MESSAGE_QUESTION, GTK_MESSAGE_OTHER,&
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
59 & GTK_MESSAGE_ERROR, GTK_ICON_SIZE_DIALOG, GTK_MESSAGE_WARNING, &
60 & GTK_MESSAGE_INFO, GTK_BUTTONS_NONE, GTK_BUTTONS_OK,&
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
61 & GTK_RESPONSE_OK, GTK_BUTTONS_CLOSE, GTK_RESPONSE_CLOSE,&
62 & GTK_BUTTONS_CANCEL, GTK_RESPONSE_CANCEL, GTK_RESPONSE_YES,&
63 & GTK_RESPONSE_NO, GTK_BUTTONS_OK_CANCEL, GTK_RESPONSE_NONE,&
585e643 @jtappin Update syntax for conditional lines in high-level templates.
jtappin authored Jul 30, 2012
64 !!$GTK>=3.0! & GTK_ORIENTATION_HORIZONTAL, GTK_ORIENTATION_VERTICAL, &
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
65 & TRUE, FALSE
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
66
67 implicit none
68
69 contains
70
71 !+
72 function hl_gtk_message_dialog_show(message, button_set, title, type, &
73 & parent) result(resp)
74
75 integer(kind=c_int) :: resp
76 character(len=*), dimension(:), intent(in) :: message
77 integer(kind=c_int), intent(in) :: button_set
78 character(kind=c_char), dimension(*), intent(in), optional :: title
79 integer(kind=c_int), intent(in), optional :: type
80 type(c_ptr), intent(in), optional :: parent
81
82 ! A DIY version of the message dialogue, needed because both creators
83 ! for the built in one are variadic and so not callable from Fortran.
84 !
85 ! MESSAGE: string(n): required: The message to display. Since this is
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
86 ! a string array, the C_NULL_CHAR terminations are provided
87 ! internally
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
88 ! BUTTON_SET: integer: required: The set of buttons to display
89 ! TITLE: string: optional: Title for the window.
90 ! TYPE: c_int: optional: Message type (a GTK_MESSAGE_ value)
91 ! PARENT: c_ptr: optional: An optional parent for the dialogue.
92 !
93 ! The return value is the response code, not the widget.
94 !-
95
96 type(c_ptr) :: dialog, content, junk, hb, vb
97 integer :: i
98 integer(kind=c_int) :: itype
99
100 ! Create the dialog window and make it modal.
101
102 dialog=gtk_dialog_new()
103 call gtk_window_set_modal(dialog, TRUE)
104 if (present(title)) call gtk_window_set_title(dialog, title)
105
106 if (present(parent)) then
107 call gtk_window_set_transient_for(dialog, parent)
108 call gtk_window_set_destroy_with_parent(dialog, TRUE)
109 end if
110
111 ! Get the content area and put the message in it.
112 content = gtk_dialog_get_content_area(dialog)
113 if (present(type)) then
114 itype = type
115 else if (button_set == GTK_BUTTONS_YES_NO) then
116 itype = GTK_MESSAGE_QUESTION
117 else
118 itype = GTK_MESSAGE_OTHER
119 end if
120
121 if (itype /= GTK_MESSAGE_OTHER) then
122 hb = gtk_hbox_new(FALSE, 0)
585e643 @jtappin Update syntax for conditional lines in high-level templates.
jtappin authored Jul 30, 2012
123 !!$GTK>=3.0! hb = gtk_box_new(GTK_ORIENTATION_HORIZONTAL, 0)
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
124 call gtk_box_pack_start(content, hb, TRUE, TRUE, 0)
125 select case (itype)
126 case (GTK_MESSAGE_ERROR)
127 junk = gtk_image_new_from_stock(GTK_STOCK_DIALOG_ERROR, &
128 & GTK_ICON_SIZE_DIALOG)
129 case (GTK_MESSAGE_WARNING)
130 junk = gtk_image_new_from_stock(GTK_STOCK_DIALOG_WARNING, &
131 & GTK_ICON_SIZE_DIALOG)
132 case (GTK_MESSAGE_INFO)
133 junk = gtk_image_new_from_stock(GTK_STOCK_DIALOG_INFO, &
134 & GTK_ICON_SIZE_DIALOG)
135 case (GTK_MESSAGE_QUESTION)
136 junk = gtk_image_new_from_stock(GTK_STOCK_DIALOG_QUESTION, &
137 & GTK_ICON_SIZE_DIALOG)
138 case default
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
139 junk=C_NULL_PTR
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
140 end select
141 if (c_associated(junk)) call gtk_box_pack_start(hb, junk, TRUE, TRUE, 0)
142 vb = gtk_vbox_new(FALSE, 0)
585e643 @jtappin Update syntax for conditional lines in high-level templates.
jtappin authored Jul 30, 2012
143 !!$GTK>=3.0! vb = gtk_box_new(GTK_ORIENTATION_VERTICAL, 0)
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
144 call gtk_box_pack_start(hb, vb, TRUE, TRUE, 0)
145 else
146 vb = content
147 end if
148
149 do i = 1, size(message)
150 if (i == 1) then
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
151 junk = gtk_label_new(c_null_char)
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
152 call gtk_label_set_markup(junk, '<b><big>'//trim(message(i))// &
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
153 & '</big></b>'//c_null_char)
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
154 else
e6eb552 @jtappin * Add scrolled window to HL_CONTAINER, and a markup friendly set labe…
jtappin authored May 16, 2012
155 junk = gtk_label_new(trim(message(i))//c_null_char)
5dc9ac0 @jtappin * Split high-level code into submodules
jtappin authored Nov 25, 2011
156 end if
157 call gtk_box_pack_start(vb, junk, TRUE, TRUE, 0)
158 end do
159
160 select case (button_set)
161 case (GTK_BUTTONS_NONE)
162 case (GTK_BUTTONS_OK)
163 junk = gtk_dialog_add_button(dialog, GTK_STOCK_OK, GTK_RESPONSE_OK)
164 case (GTK_BUTTONS_CLOSE)
165 junk = gtk_dialog_add_button(dialog, GTK_STOCK_CLOSE, &
166 & GTK_RESPONSE_CLOSE)
167 case (GTK_BUTTONS_CANCEL)
168 junk = gtk_dialog_add_button(dialog, GTK_STOCK_CANCEL, &
169 & GTK_RESPONSE_CANCEL)
170 case (GTK_BUTTONS_YES_NO)
171 junk = gtk_dialog_add_button(dialog, GTK_STOCK_YES, GTK_RESPONSE_YES)
172 junk = gtk_dialog_add_button(dialog, GTK_STOCK_NO, GTK_RESPONSE_NO)
173 case (GTK_BUTTONS_OK_CANCEL)
174 junk = gtk_dialog_add_button(dialog, GTK_STOCK_OK, GTK_RESPONSE_OK)
175 junk = gtk_dialog_add_button(dialog, GTK_STOCK_CANCEL, &
176 & GTK_RESPONSE_CANCEL)
177 case default
178 call gtk_widget_destroy(dialog)
179 resp = GTK_RESPONSE_NONE
180 return
181 end select
182
183 call gtk_widget_show_all (dialog)
184 resp = gtk_dialog_run(dialog)
185 call gtk_widget_destroy(dialog)
186
187 end function hl_gtk_message_dialog_show
188 end module gtk_hl_dialog
Something went wrong with that request. Please try again.