Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: ac29b4a64b
Fetching contributors…

Cannot retrieve contributors at this time

505 lines (421 sloc) 16.752 kb
! Copyright (C) 2011
! Free Software Foundation, Inc.
! This file is part of the gtk-fortran GTK+ Fortran Interface library.
! This 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, or (at your option)
! any later version.
! This software 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.
! Under Section 7 of GPL version 3, you are granted additional
! permissions described in the GCC Runtime Library Exception, version
! 3.1, as published by the Free Software Foundation.
! You should have received a copy of the GNU General Public License along with
! this program; see the files COPYING3 and COPYING.RUNTIME respectively.
! If not, see <http://www.gnu.org/licenses/>.
!
! Contributed by James Tappin
! Last modification: 12-1-2011
!!$T Template file for gtk-hl-menu.f90.
!!$T Make edits to this file, and keep them identical between the
!!$T GTK2 & GTK3 branches.
!!$T Lines to appear only in specific versions should be prefixed by
!!$T !!$<lib><op><ver>!
!!$T Where <lib> is GTK or GLIB, <op> is one of < > <= >=
!!$T and <ver> is the version boundary, e.g. !!$GTK<=2.24! to include
!!$T the line in GTK+ version 2.24 and higher.
!!$T The mk_gtk_hl.pl script should be used to generate the source file.
!*
! Pulldown Menu
module gtk_hl_menu
! Implements the GtkMenuBar menu system.
!/
use gtk_sup
use gtk_hl_misc
use iso_c_binding
use iso_fortran_env, only: error_unit
! autogenerated use's
use gtk, only: gtk_check_menu_item_new,&
& gtk_check_menu_item_new_with_label,&
& gtk_check_menu_item_set_active, gtk_menu_bar_new,&
& gtk_menu_bar_set_pack_direction, gtk_menu_item_new,&
& gtk_menu_item_new_with_label, gtk_menu_item_set_submenu,&
& gtk_menu_new, gtk_menu_shell_append, gtk_menu_shell_insert,&
& gtk_radio_menu_item_get_group, gtk_radio_menu_item_new,&
& gtk_radio_menu_item_new_with_label, gtk_check_menu_item_get_active, &
& gtk_separator_menu_item_new, gtk_tearoff_menu_item_new,&
& gtk_widget_add_accelerator, gtk_widget_set_sensitive,&
& gtk_label_new, gtk_label_set_markup, gtk_container_add, &
& gtk_widget_set_tooltip_text, GTK_PACK_DIRECTION_LTR, &
& TRUE, FALSE, g_signal_connect
use g, only: g_slist_length, g_slist_nth, g_slist_nth_data
use gtk_hl_accelerator
implicit none
contains
!+
function hl_gtk_menu_new(orientation, bar) result(menu)
type(c_ptr) :: menu
integer(kind=c_int), intent(in), optional :: orientation, bar
! Menu initializer (mainly for consistency)
!
! ORIENTATION: integer: optional: Whether to lay out the top level
! horizontally or vertically.
! BAR: boolean: optional: Set this to FALSE to create a GtkMenu rather than
! a GtkMenuBar (useful in creating context menus).
!-
integer(kind=c_int) :: orient
logical :: isbar
if (present(orientation)) then
orient= orientation
else
orient = GTK_PACK_DIRECTION_LTR
end if
if (present(bar)) then
isbar = c_f_logical(bar)
else
isbar = .true.
end if
if (isbar) then
menu = gtk_menu_bar_new()
call gtk_menu_bar_set_pack_direction (menu, orient)
else
menu = gtk_menu_new()
end if
end function hl_gtk_menu_new
!+
function hl_gtk_menu_submenu_new(menu, label, tooltip, pos, is_markup, &
& sensitive) result(submenu)
type(c_ptr) :: submenu
type(c_ptr) :: menu
character(kind=c_char), dimension(*), intent(in) :: label
character(kind=c_char), dimension(*), intent(in), optional :: tooltip
integer(kind=c_int), intent(in), optional :: pos
integer(kind=c_int), intent(in), optional :: is_markup, sensitive
! Make a submenu node
!
! MENU: c_ptr: required: The parent of the submenu
! LABEL: string: required: The label of the submenu
! TOOLTIP: string: optional: A tooltip for the submenu.
! POS: integer: optional: The position at which to insert the item
! (omit to append)
! IS_MARKUP: boolean: optional: Set this to TRUE if the label contains
! Pango markup.
! SENSITIVE: boolean: optional: Set to FALSE to make the widget start in an
! insensitive state.
!-
type(c_ptr) :: item, label_w
logical :: markup
if (present(is_markup)) then
markup=c_f_logical(is_markup)
else
markup=.false.
end if
! Create a menu item
if (markup) then
item = gtk_menu_item_new()
label_w = gtk_label_new(label)
call gtk_label_set_markup(label_w, label)
call gtk_container_add(item, label_w)
else
item = gtk_menu_item_new_with_label(label)
end if
! Create a submenu and attach it to the item
submenu = gtk_menu_new()
call gtk_menu_item_set_submenu(item, submenu)
! Insert it to the parent
if (present(pos)) then
call gtk_menu_shell_insert(menu, item, pos)
else
call gtk_menu_shell_append(menu, item)
end if
if (present(sensitive)) call gtk_widget_set_sensitive(item, sensitive)
if (present(tooltip)) call gtk_widget_set_tooltip_text(item, tooltip)
end function hl_gtk_menu_submenu_new
!+
function hl_gtk_menu_item_new(menu, label, activate, data, tooltip, &
& pos, tearoff, sensitive, accel_key, accel_mods, accel_group, &
& accel_flags, is_markup) result(item)
type(c_ptr) :: item
type(c_ptr) :: menu
character(kind=c_char), dimension(*), intent(in), optional :: label
type(c_funptr), optional :: activate
type(c_ptr), optional :: data
character(kind=c_char), dimension(*), intent(in), optional :: tooltip
integer(kind=c_int), intent(in), optional :: pos
integer(kind=c_int), intent(in), optional :: tearoff, sensitive
character(kind=c_char), dimension(*), optional, intent(in) :: accel_key
integer(kind=c_int), optional, intent(in) :: accel_mods, accel_flags
type(c_ptr), optional, intent(in) :: accel_group
integer(kind=c_int), intent(in), optional :: is_markup
! Make a menu item or separator
!
! MENU: c_ptr: required: The parent menu.
! LABEL: string: optional: The label for the menu, if absent then insert
! a separator.
! ACTIVATE: c_funptr: optional: The callback function for the
! activate signal
! DATA: c_ptr: optional: Data to pass to the callback.
! TOOLTIP: string: optional: A tooltip for the menu item.
! POS: integer: optional: The position at which to insert the item
! (omit to append)
! TEAROFF: boolean: optional: Set to TRUE to make a tearoff point.
! SENSITIVE: boolean: optional: Set to FALSE to make the widget start in an
! insensitive state.
! ACCEL_KEY: string: optional: Set to the character value or code of a
! key to use as an accelerator.
! ACCEL_MODS: c_int: optional: Set to the modifiers for the accelerator.
! (If not given then GTK_CONTROL_MASK is assumed).
! ACCEL_GROUP: c_ptr: optional: The accelerator group to which the
! accelerator is attached, must have been added to the top-level
! window.
! ACCEL_FLAGS: c_int: optional: Flags for the accelerator, if not present
! then GTK_ACCEL_VISIBLE, is used (to hide the accelerator,
! use ACCEL_FLAGS=0).
! IS_MARKUP: boolean: optional: Set this to TRUE if the label contains
! Pango markup.
!-
integer(kind=c_int) :: istear
logical :: markup
type(c_ptr) :: label_w
if (present(tearoff)) then
istear = tearoff
else
istear = FALSE
end if
if (present(is_markup)) then
markup=c_f_logical(is_markup)
else
markup=.false.
end if
! Create the menu item
if (present(label)) then
if (markup) then
item=gtk_menu_item_new()
label_w=gtk_label_new(label)
call gtk_label_set_markup(label_w, label)
call gtk_container_add(item,label_w)
else
item = gtk_menu_item_new_with_label(label)
end if
else if (istear == TRUE) then
item = gtk_tearoff_menu_item_new()
else
item = gtk_separator_menu_item_new()
end if
! Insert it to the parent
if (present(pos)) then
call gtk_menu_shell_insert(menu, item, pos)
else
call gtk_menu_shell_append(menu, item)
end if
! If present, connect the callback
if (present(activate)) then
if (.not. present(label)) then
write(error_unit, *) &
& "HL_GTK_MENU_ITEM: Cannot connect a callback to a separator"
return
end if
if (present(data)) then
call g_signal_connect(item, "activate"//c_null_char, activate, data)
else
call g_signal_connect(item, "activate"//c_null_char, activate)
end if
! An accelerator
if (present(accel_key) .and. present(accel_group)) &
& call hl_gtk_widget_add_accelerator(item, "activate"//c_null_char, &
& accel_group, accel_key, accel_mods, accel_flags)
end if
! Attach a tooltip
if (present(tooltip)) call gtk_widget_set_tooltip_text(item, tooltip)
! sensitive?
if (present(sensitive)) call gtk_widget_set_sensitive(item, sensitive)
end function hl_gtk_menu_item_new
!+
function hl_gtk_check_menu_item_new(menu, label, toggled, data, &
& tooltip, pos, initial_state, sensitive, is_markup) result(item)
type(c_ptr) :: item
type(c_ptr) :: menu
character(kind=c_char), dimension(*), intent(in) :: label
type(c_funptr), optional :: toggled
type(c_ptr), optional :: data
character(kind=c_char), dimension(*), intent(in), optional :: tooltip
integer(kind=c_int), optional, intent(in) :: pos
integer(kind=c_int), optional, intent(in) :: initial_state
integer(kind=c_int), optional, intent(in) :: sensitive, is_markup
! Make a check button menu item.
!
! MENU: c_ptr: required: The parent menu.
! LABEL: string: required: The label for the menu.
! TOGGLED: c_funptr: optional: The callback function for the
! "toggled" signal
! DATA: c_ptr: optional: Data to pass to the callback.
! TOOLTIP: string: optional: A tooltip for the menu item.
! POS: integer: optional: The position at which to insert the item
! (omit to append)
! INITIAL_STATE: boolean: optional: Whether the item is initially selected.
! SENSITIVE: boolean: optional: Set to FALSE to make the widget start in an
! insensitive state.
! IS_MARKUP: boolean: optional: Set this to TRUE if the label contains
! Pango markup.
!-
type(c_ptr) :: label_w
logical :: markup
if (present(is_markup)) then
markup = c_f_logical(is_markup)
else
markup = .false.
end if
! Create the menu item
if (markup) then
item = gtk_check_menu_item_new()
label_w=gtk_label_new(c_null_char)
call gtk_label_set_markup(label_w, label)
call gtk_container_add(item, label_w)
else
item = gtk_check_menu_item_new_with_label(label)
end if
! Insert it to the parent
if (present(pos)) then
call gtk_menu_shell_insert(menu, item, pos)
else
call gtk_menu_shell_append(menu, item)
end if
! Set the state
if (present(initial_state)) &
& call gtk_check_menu_item_set_active(item, initial_state)
! If present, connect the callback
if (present(toggled)) then
if (present(data)) then
call g_signal_connect(item, "toggled"//c_null_char, toggled, data)
else
call g_signal_connect(item, "toggled"//c_null_char, toggled)
end if
end if
! Attach a tooltip
if (present(tooltip)) call gtk_widget_set_tooltip_text(item, tooltip)
! sensitive?
if (present(sensitive)) call gtk_widget_set_sensitive(item, sensitive)
end function hl_gtk_check_menu_item_new
!+
function hl_gtk_radio_menu_item_new(group, menu, label, toggled, data, &
& tooltip, pos, sensitive, is_markup) result(item)
type(c_ptr) :: item
type(c_ptr), intent(inout) :: group
type(c_ptr), intent(in) :: menu
character(kind=c_char), dimension(*), intent(in) :: label
type(c_funptr), optional :: toggled
type(c_ptr), optional :: data
character(kind=c_char), dimension(*), intent(in), optional :: tooltip
integer(kind=c_int), optional, intent(in) :: pos
integer(kind=c_int), optional, intent(in) :: sensitive, is_markup
! Make a radio button menu item
!
! GROUP: c_ptr: required: The group for the radio item (C_NULL_PTR for a
! new group).
! MENU: c_ptr: required: The parent menu.
! LABEL: string: required: The label for the menu.
! TOGGLED: c_funptr: optional: The callback function for the
! "toggled" signal
! DATA: c_ptr: optional: Data to pass to the callback.
! TOOLTIP: string: optional: A tooltip for the menu item.
! POS: integer: optional: The position at which to insert the item
! (omit to append)
! SENSITIVE: boolean: optional: Set to FALSE to make the widget start in an
! insensitive state.
! IS_MARKUP: boolean: optional: Set this to TRUE if the label contains
! Pango markup.
!-
type(c_ptr) :: label_w
logical :: markup
if (present(is_markup)) then
markup = c_f_logical(is_markup)
else
markup = .false.
end if
! Create the menu item
if (markup) then
item = gtk_radio_menu_item_new(group)
label_w=gtk_label_new(c_null_char)
call gtk_label_set_markup(label_w, label)
call gtk_container_add(item, label_w)
else
item = gtk_radio_menu_item_new_with_label(group, label)
end if
group = gtk_radio_menu_item_get_group(item)
! Insert it to the parent
if (present(pos)) then
call gtk_menu_shell_insert(menu, item, pos)
else
call gtk_menu_shell_append(menu, item)
end if
! If present, connect the callback
if (present(toggled)) then
if (present(data)) then
call g_signal_connect(item, "toggled"//c_null_char, toggled, data)
else
call g_signal_connect(item, "toggled"//c_null_char, toggled)
end if
end if
! Attach a tooltip
if (present(tooltip)) call gtk_widget_set_tooltip_text(item, tooltip)
! sensitive?
if (present(sensitive)) call gtk_widget_set_sensitive(item, sensitive)
end function hl_gtk_radio_menu_item_new
!+
subroutine hl_gtk_radio_menu_group_set_select(group, index)
type(c_ptr), intent(in) :: group
integer(kind=c_int), intent(in) :: index
! Set the indexth button of a radio menu group
!
! GROUP: c_ptr: required: The group of the last button added to
! the radio menu
! INDEX: integer: required: The index of the button to set
! (starting from the first as 0).
!-
integer(kind=c_int) :: nbuts
type(c_ptr) :: datan
nbuts = g_slist_length(group)
! Note that GROUP actually points to the last button added and to the
! group of the next to last & so on
datan= g_slist_nth_data(group, nbuts-index-1_c_int)
call gtk_check_menu_item_set_active(datan, TRUE)
end subroutine hl_gtk_radio_menu_group_set_select
!+
function hl_gtk_radio_menu_group_get_select(group) result(index)
integer(kind=c_int) :: index
type(c_ptr) :: group
! Find the selected button in a radio group in a menu.
!
! GROUP: c_ptr: required: The group of the last button added to
! the radio menu
!-
integer(kind=c_int) :: nbuts, i
type(c_ptr) :: but
nbuts = g_slist_length(group)
index=-1
do i = 1, nbuts
but = g_slist_nth_data(group, nbuts-i)
if (.not. c_associated(but)) exit
if (gtk_check_menu_item_get_active(but)==TRUE) then
index = i-1
return
end if
end do
end function hl_gtk_radio_menu_group_get_select
!+
subroutine hl_gtk_menu_item_set_label_markup(item, label)
type(c_ptr) :: item
character(kind=c_char), dimension(*), intent(in) :: label
! Set a markup label on a menu item
!
! ITEM: c_ptr: required: The menu item to relabel
! LABEL: string: required: The string (with Pango markup) to apply.
!
! Normally if the label does not need Pango markup, then
! gtk_menu_item_set_label can be used.
!-
call hl_gtk_bin_set_label_markup(item, label)
end subroutine hl_gtk_menu_item_set_label_markup
end module gtk_hl_menu
Jump to Line
Something went wrong with that request. Please try again.