File Coverage

blib/lib/Gtk2/Ex/MenuView.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

# Copyright 2008, 2009, 2010, 2011 Kevin Ryde

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

package Gtk2::Ex::MenuView;
use 5.008;
use strict;
use warnings;
use Carp;
use Gtk2 1.200; # for GDK_PRIORITY_REDRAW, and bug fixes probably

use Glib::Ex::SignalIds;
use Glib::Ex::SourceIds;
use Glib::Ex::SignalBits;
use Gtk2::Ex::MenuView::Menu;

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

our $VERSION = 4;

use constant _submenu_class => 'Gtk2::Ex::MenuView::Menu';

BEGIN {
  Glib::Type->register_enum ('Gtk2::Ex::MenuView::WantActivate',
                             no   => 0,
                             leaf => 1,
                             all  => 2);
  Glib::Type->register_enum ('Gtk2::Ex::MenuView::WantVisible',
                             no       => 0,
                             show     => 1,
                             show_all => 2);
}

use Glib::Object::Subclass
  _submenu_class(),
  signals => { 'item-create-or-update'
               => { param_types   => ['Gtk2::MenuItem',
                                      'Gtk2::TreeModel',
                                      'Gtk2::TreePath',
                                      'Gtk2::TreeIter'],
                    return_type   => 'Gtk2::MenuItem',
                    flags         => ['action','run-last'],
                    accumulator   => \&Glib::Ex::SignalBits::accumulator_first_defined,
                  },
               'separator-create-or-update'
               => { param_types   => ['Gtk2::MenuItem',
                                      'Gtk2::TreeModel',
                                      'Gtk2::TreePath',
                                      'Gtk2::TreeIter'],
                    return_type   => 'Gtk2::MenuItem',
                    flags         => ['action'],
                    accumulator   => \&Glib::Ex::SignalBits::accumulator_first_defined,
                  },
               activate
               => { param_types => ['Gtk2::MenuItem',
                                    'Gtk2::TreeModel',
                                    'Gtk2::TreePath',
                                    'Gtk2::TreeIter'],
                    return_type => undef },
             },
  properties => [ Glib::ParamSpec->object
                  ('model',
                   'Model',
                   'TreeModel to display.',
                   'Gtk2::TreeModel',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->enum
                  ('want-activate',
                   'Want activate',
                   'Whether to connect and generate a unified activate signal.',
                   'Gtk2::Ex::MenuView::WantActivate',
                   'leaf',
                   Glib::G_PARAM_READWRITE),

                  Glib::ParamSpec->enum
                  ('want-visible',
                   'Want visible',
                   'Whether to automatically make items visible.',
                   'Gtk2::Ex::MenuView::WantVisible',
                   'show_all',
                   Glib::G_PARAM_READWRITE),

                ];


# TODO:
#
# dirty 0, 1=item, 2=separator
#
# current_item_at_indices ...
# $menu->get_model_items
# $menu->model_items_array

# $menuview->menu_at_path
# $menuview->model_items
# $menuview->foreach_model_item
# item_get_indices

# mnemonics
# accel key from model example
# circular protection pay attention to model changes ?

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

# sub INIT_INSTANCE {
#    my ($self) = @_;
# }

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($pname eq 'model') {
    my $model = $newval;
    Scalar::Util::weaken (my $weak_self = $self);
    my $ref_weak_self = \$weak_self;
    $self->{'model_ids'} = $model && Glib::Ex::SignalIds->new
      ($model,
       $model->signal_connect (row_changed => \&_do_row_changed,
                               $ref_weak_self),
       $model->signal_connect (row_deleted => \&_do_row_deleted,
                               $ref_weak_self),
       $model->signal_connect (row_inserted => \&_do_row_inserted,
                               $ref_weak_self),
       $model->signal_connect (rows_reordered => \&_do_rows_reordered,
                               $ref_weak_self),
       $model->signal_connect
       (row_has_child_toggled => \&_do_row_has_child_toggled, $ref_weak_self));
    _dirty_all_menus ($self);
  }
}

sub _freshen_item {
  my ($self, $menu, $menu_path, $i) = @_;
  ### _freshen_item() number: $i
  my $model = $self->{'model'} || return;

  if (delete $menu->{'all_dirty'}) {
    ### all_dirty, make dirty array
    my $menu_iter = ($menu_path->get_depth
                     ? $model->get_iter($menu_path) || do {
                       ###   no iter for menu_path
                       return;
                     }
                     : undef);
    my $len = $model->iter_n_children ($menu_iter);
    $menu->{'dirty'} ||= [];
    @{$menu->{'dirty'}} = ((Gtk2::Ex::MenuView::Menu::_DIRTY_ITEM()
                            | Gtk2::Ex::MenuView::Menu::_DIRTY_SEPARATOR())
                           x $len);
  }

  ### dirty_bits: $menu->{'dirty'}->[$i]
  my $dirty_bits = delete $menu->{'dirty'}->[$i] || do {
    ### not dirty, no freshen needed
    return;
  };
  # still dirty if recursive freshens such as item_at_indices() look, but
  # cleared when this _freshen_item() returns
  local $menu->{'dirty'}->[$i] = $dirty_bits;

  my $item_path = $menu_path->copy;
  $item_path->append_index ($i);

  my $item_iter = $model->get_iter($item_path) || do {
    ###   no iter for item_path
    return;
  };

  my $key = $item_path->to_string;
  ### in progress: $self->{'item_update_in_progress'}
  my $in_progress = $self->{'item_update_in_progress'} || {};
  if ($in_progress->{$key}) {
    ### croak for recursion
    croak "Recursive item create or update for path=$key";
  }
  local $self->{'item_update_in_progress'} = { %$in_progress, $key => 1 };
  ### flag in_progress to: $self->{'item_update_in_progress'}

  my $children = ($menu->{'children'} ||= []);
  my $item = $children->[$i];
  my $leaf = ! $model->iter_has_child ($item_iter);

  my ($old_separator, $submenu);
  if ($item) {
    $old_separator = $item->{'Gtk2::Ex::MenuView.separator'};
    $submenu = $item->get_submenu;
  }

  if ($dirty_bits & Gtk2::Ex::MenuView::Menu::_DIRTY_ITEM()) {
    my $old_item = $item;
    $item = $self->signal_emit ('item-create-or-update',
                                $old_item,
                                $model,
                                $item_path,
                                $item_iter);
    ### _item_create: $item

    unless ($item && $old_item && $item == $old_item) {
      if ($old_item) {
        $menu->_remove_item ($old_item);
        delete $children->[$i]; # so _item_index_to_menu_pos() doesn't see it
        undef $old_separator;   # destroyed by _remove_item()
      }
      if ($item) {
        if ((my $want_activate = $self->get('want-activate')) ne 'no') {
          # Connect to both leaf and non-leaf rows and filter in the handler,
          # since a row might gain or lose a submenu at any time.  There won't
          # be many non-leafs so not much is wasted by this.
          $item->signal_connect (activate => \&_do_item_activate);
        }
        if ((my $want_visible = $self->get('want-visible')) ne 'no') {
          $item->$want_visible; # 'show' or 'show_all'
        }
        $menu->insert ($item, _item_index_to_menu_pos($menu,$i));
        $children->[$i] = $item;
      }
    }
  }

  if ($item) {
    if ($leaf) {
      undef $submenu;
    } else {
      if (! $submenu) {
        ### create submenu
        $submenu = $self->_submenu_class->new;
        $submenu->{'all_dirty'} = 1;
      }
    }
    $item->set_submenu ($submenu);
  }

  if ($item
      && ($dirty_bits & Gtk2::Ex::MenuView::Menu::_DIRTY_SEPARATOR())) {
    my $item_iter = $model->get_iter($item_path) || return;
    my $separator = $self->signal_emit ('separator-create-or-update',
                                        $old_separator,
                                        $model,
                                        $item_path,
                                        $item_iter);
    unless ($old_separator && $separator && $old_separator == $separator) {
      if ($old_separator) {
        $menu->remove ($old_separator);
        $old_separator->destroy;
      }
      if ($separator) {
        my $pos = _item_index_to_menu_pos ($menu, $i);
        $item->{'Gtk2::Ex::MenuView.separator'} = $separator;
        $menu->insert ($separator, $pos);
      } else {
        delete $item->{'Gtk2::Ex::MenuView.separator'};
      }
    }
  }

  ### freshen return 1
  return 1;
}

# 'activate' signal handler on each item child
sub _do_item_activate {
  my ($item) = @_;
  ### MenuView activate: $item

  # shouldn't normally get a signal when not within a menu, but allow for
  # perhaps the model changing without signals yet processed
  my ($menuview,$model,$path,$iter) = Gtk2::Ex::MenuView->item_get_mmpi($item)
    or do {
      ###   no model row for activated item
      return;
    };
  if ($menuview->get('want-activate') eq 'leaf'
      && $model->iter_has_child ($iter)) {
    ###   no activate on leaf
    return;
  }
  $menuview->signal_emit ('activate', $item, $model, $path, $iter);
}

sub _item_index_to_menu_pos {
  my ($menu, $i) = @_;
  ### _item_index_to_menu_pos(): $i
  ###   menu: "@{[$menu->get_children]}"
  my $children = $menu->{'children'} || return -1;
  ###   children: "@{[grep {defined} @$children]}"
  my $pos = -1;
  OUTER: for ( ; $i < @$children; $i++) {
    if (my $after = $children->[$i]) {
      $after = $after->{'Gtk2::Ex::MenuView.separator'} || $after;

      foreach my $child ($menu->get_children) {
        $pos++;
        if ($child == $after) { last OUTER; }
      }
      ### oops, not found in menu: "$after"
      ### assert: 0
      return -1;
    }
  }
  ### _item_index_to_menu_pos(): "$i -> $pos"
  return $pos;
}

sub _dirty_all_menus {
  my ($self) = @_;
  ### _dirty_all_menus

  my $menu = $self;
  my @pending;
  do {
    _dirty_menu($menu);
    push @pending, map { my $submenu = $_->get_submenu;
                         ($submenu ? ($submenu) : ()) }
      @{$menu->{'children'}};
  } while ($menu = pop @pending);
}
# sub _menushellbits_menu_and_submenus {
#   my ($menu) = @_;
#   my @pending;
#   my @ret;
#   do {
#     push @ret, $menu;
#     push @pending, grep {defined} map {$_->get_submenu} $menu->get_children;
#   } while ($menu = pop @pending);
#   return @ret;
# }


#------------------------------------------------------------------------------
# dirtiness etc

sub _idle_freshen {
  my ($menu) = @_;
  if ($menu->mapped) {
    my $self = $menu->_get_menuview;
    Scalar::Util::weaken (my $weak_self = $self);
    $self->{'idle'} ||= Glib::Ex::SourceIds->new
      (Glib::Idle->add (\&_do_idle, \$weak_self,
                        Gtk2::GTK_PRIORITY_RESIZE - 1)); # just before resize
  }
}
sub _do_idle {
  my ($ref_weak_self) = @_;
  ### _do_idle
  my $self = $$ref_weak_self || return;
  delete $self->{'idle'};

  my $menu = $self;
  my @pending;
  do {
    if ($menu->mapped) {
      $menu->_freshen;
    }
    push @pending, map {$_->get_submenu || ()} @{$menu->{'children'}};
  } while ($menu = pop @pending);

  return 0; # Glib::SOURCE_REMOVE
}

# mark $menu as all dirty
sub _dirty_menu {
  my ($menu) = @_;
  delete $menu->{'dirty'};
  $menu->{'all_dirty'} ||= do {
    _idle_freshen ($menu);
    1;
  }
}

# mark $menu item number $i as dirty
sub _dirty_add {
  my ($self, $menu, $i, $dirty_bits) = @_;
  ### _dirty_add(): $i, "$menu", $dirty_bits

  if (! $menu->{'all_dirty'}) {
    my $dirty = ($menu->{'dirty'} ||= []);
    $dirty->[$i] |= do {
      _idle_freshen ($self);
      $dirty_bits;  # item
    };
  }
}

sub _dirty_item_and_following_separator {
  my ($self, $menu, $path) = @_;

  my $i = ($path->get_indices)[-1];
  _dirty_add ($self, $menu, $i,
              Gtk2::Ex::MenuView::Menu::_DIRTY_ITEM());

  if (my $model = $self->{'model'}) {
    $path = $path->copy;
    $path->next;
    if ($model->get_iter($path)) {
      _dirty_add ($self, $menu, $i+1,
                  Gtk2::Ex::MenuView::Menu::_DIRTY_SEPARATOR());
    }
  }
}

# return item at $path if it currently exists, or undef if not
sub _current_item_at_path  {
  my ($self, $path) = @_;
  my @indices = $path->get_indices
    or return undef;  # empty path
  my $item;
  my $menu = $self;
  for (;;) {
    $item = $menu->{'children'}->[shift @indices] || return undef;
    @indices || last;
    $menu = $item->get_submenu || return undef;
  }
  return $item;
}

# return menu containing the item at $path, if that menu currently exists
# (the item itself doesn't have to), or undef if no such menu
sub _current_menu_at_path {
  my ($self, $path) = @_;
  if ($path->get_depth == 0) { return $self; }
  my $item = $self->_current_item_at_path($path) || return undef;
  return $item->get_submenu;
}

# return menu containing the item at $path, if that menu currently exists
# (the item itself doesn't have to), or undef if no such menu
sub _current_menu_containing_path {
  my ($self, $path) = @_;
  if ($path->get_depth == 1) { return $self; }
  $path = $path->copy;
  $path->up;
  return $self->_current_menu_at_path($path);
}

#------------------------------------------------------------------------------
# model changes

# 'row-has-child-toggled' callback from model
#
# Called only for rows, not when the toplevel goes between empty and
# non-empty.  FIXME: Not yet documented that an item updates with subrow
# emptiness like this.
#
sub _do_row_has_child_toggled {
  my ($model, $path, $iter, $ref_weak_self) = @_;
  ### MenuView row-has-child-toggled: $path->to_string
  my $self = $$ref_weak_self || return;

  my $item = $self->_current_item_at_path($path) || return;
  if ($model->iter_has_child($iter)) {
    $item->set_submenu (undef);
  }
  # update display for rows or no-rows and create submenu if became
  # non-empty
  _dirty_add ($self, $item->get_parent, ($path->get_indices)[-1],
              Gtk2::Ex::MenuView::Menu::_DIRTY_ITEM());
}

# 'row-changed' callback from model
sub _do_row_changed {
  my ($model, $path, $iter, $ref_weak_self) = @_;
  ### MenuView row changed: $path->to_string
  my $self = $$ref_weak_self || return;

  my $menu = $self->_current_menu_containing_path($path) || do {
    ###   no menu for it currently
    return;
  };
  _dirty_item_and_following_separator ($self, $menu, $path);
}

# 'row-deleted' callback from model
sub _do_row_deleted {
  my ($model, $path, $ref_weak_self) = @_;
  ### MenuView row deleted: $path->to_string
  my $self = $$ref_weak_self || return;

  my $menu = $self->_current_menu_containing_path($path) || do {
    ###   no menu for this yet
    return;
  };

  my $i = ($path->get_indices)[-1];
  _splice_maybe ($menu->{'dirty'}, $i,1);  # delete
  if (my $item = _splice_maybe ($menu->{'children'}, $i,1)) {
    $menu->_remove_item ($item);
  }

  # update following row for its separator, if there's a following row
  if ($model->get_iter($path)) {
    _dirty_add ($self, $menu, $i,
                Gtk2::Ex::MenuView::Menu::_DIRTY_SEPARATOR());
  }
}

# 'row-inserted' callback from model
sub _do_row_inserted {
  my ($model, $path, $iter, $ref_weak_self) = @_;
  ### MenuView row inserted: $path->to_string
  my $self = $$ref_weak_self || return;

  my $menu = $self->_current_menu_containing_path($path) || do {
    ###   no menu for this yet
    return;
  };
  my $i = ($path->get_indices)[-1];

  # shift up arrays if necessary
  _splice_maybe ($menu->{'children'}, $i,0, undef);  # insert
  _splice_maybe ($menu->{'dirty'},    $i,0, 1);      # insert

  _dirty_item_and_following_separator ($self, $menu, $path);
}

# 'rows-reordered' callback from model
sub _do_rows_reordered {
  my ($model, $path, $iter, $aref, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  ### MenuView rows reordered

  my $menu = $self->_current_menu_at_path($path) || do {
    ###   no menu for this yet
    return;
  };
  my $children = $menu->{'children'} || return;
  my @new_children;
  my $pos = _item_index_to_menu_pos ($menu, 0);
  foreach my $newpos (0 .. $#$aref) {
    my $oldpos = $aref->[$newpos];
    if (my $item = $children->[$oldpos]) {
      $new_children[$newpos] = $item;

      # ENHANCE-ME: defer this to _freshen(), with a 'dirty_reorder' or
      # if 'all_dirty' reinserting coped with reorder
      if (my $separator = $item->{'Gtk2::Ex::MenuView.separator'}) {
        $menu->reorder_child ($separator, $pos++);
      }
      ### reorder_child item to: $pos
      $menu->reorder_child ($item, $pos++);
    }
  }
  @$children = @new_children;

  # ENHANCE-ME: could reorder the dirty flags and just update separators
  # with different preceding
  _dirty_menu ($menu);
}

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

sub item_at_path {
  my ($self, $path) = @_;
  return $self->item_at_indices ($path->get_indices);
}

sub item_at_indices {
  my $self = shift;
  ### item_at_indices(): @_
  $self->{'model'} || return undef;

  my $menu = $self;
  my $menu_path = Gtk2::TreePath->new;  # of $menu
  my $item;
  while (@_) {
    my $i = shift;
    $self->_freshen_item ($menu, $menu_path, $i);
    (($item = $menu->{'children'}->[$i])
     && ($menu = $item->get_submenu))
      or last;
    $menu_path->append_index($i);
  }
  return $item;
}

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

# _splice_maybe($aref,$offset,$len, $repl...)
# A splice() of @$aref, but only if $aref is not undef and $offset is not
# past its end.
sub _splice_maybe {
  if (my $aref = shift) {
    if ((my $pos = shift) <= $#$aref) {
      splice @$aref, $pos, @_;   # $len and values
    }
  }
}

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

# sub insert {
#   my ($self, $child, $pos) = @_;
#   if ($pos >= 0 && $pos < $self->{'model_pos'}) {
#     $self->{'model_pos'}--;
#   }
#   $self->SUPER::insert ($child, $pos);
# }
# sub prepend {
#   my ($self, $child) = @_;
#   $self->{'model_pos'}--;
#   $self->SUPER::prepend ($child);
# }

1;
__END__