File Coverage

blib/lib/Gtk2/Ex/MenuBits.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Copyright 2007, 2008, 2009, 2010, 2011, 2012 Kevin Ryde

# This file is part of Gtk2-Ex-WidgetBits.
#
# Gtk2-Ex-WidgetBits 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.
#
# Gtk2-Ex-WidgetBits 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 Gtk2-Ex-WidgetBits.  If not, see .

package Gtk2::Ex::MenuBits;
use 5.008;
use strict;
use warnings;
use Gtk2;
use List::Util qw(max);

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(position_widget_topcentre
                    mnemonic_escape
                    mnemonic_undo);

our $VERSION = 48;

# uncomment this to run the ### lines
#use Smart::Comments;

sub position_widget_topcentre {
  my ($menu, $x, $y, $widget) = @_;
  ### position_widget_topcentre(): "@{[$widget||'undef']}"
  if (ref $widget eq 'REF') { $widget = $$widget; }

  ### widget mapped: $widget && $widget->mapped
  ### widget screen: "@{[$widget && $widget->get_screen]}"
  ### menu   screen: "@{[$menu->get_screen]}"

  if ($widget
      && (! $widget->can('get_screen') # Gtk 2.0.x single-screen
          || $widget->get_screen == $menu->get_screen)
      && $widget->mapped) {
    ### mapped and same screen

    require Gtk2::Ex::WidgetBits;
    if (my ($wx, $wy) = Gtk2::Ex::WidgetBits::get_root_position($widget)) {
      ### have root x,y: "$wx,$wy"

      my $widget_alloc = $widget->allocation;
      my $menu_req = $menu->requisition;

      $x = $wx + max (0, int (($widget_alloc->width - $menu_req->width) / 2));
      $y = $wy +         int (($widget_alloc->height + 1) / 2);  # round up
    }
  }

  ### $x
  ### $y
  return ($x, $y, 1);  # push_in to be visible on screen
}

#------------------------------------------------------------------------------

# gtkfilesel.c has an escape_underscores() doing this (not made public), for
# the same sort of "aribtrary string incorporated into menu label" intended
# here
sub mnemonic_escape {
  my ($str) = @_;
  $str =~ s/_/__/g;
  return $str;
}

sub mnemonic_undo {
  my ($str) = @_;
  $str =~ s/_(.)/$1/g;
  return $str;
}

# maybe ...
# sub _mnemonic_to_markup {
#   my ($str) = @_;
#   $str =~ s{_(.)}
#            {$1 eq '_' ? '_' : "$1"}ge;
#   return $str;
# }

1;
__END__