The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#
# Text Widget/Hypertext
#
# Usually, tags modify the appearance of text in the view, e.g. making it 
# bold or colored or underlined. But tags are not restricted to appearance. 
# They can also affect the behavior of mouse and key presses, as this demo 
# shows.
#

package hypertext;

use strict;
use Glib qw(TRUE FALSE);
use Gtk2;
use Gtk2::Gdk::Keysyms;
use Gtk2::Pango;


my $window = undef;

# Inserts a piece of text into the buffer, giving it the usual
# appearance of a hyperlink in a web browser: blue and underlined.
# Additionally, attaches some data on the tag, to make it recognizable
# as a link. 
#
sub insert_link {
  my ($buffer, $iter, $text, $page) = @_;
  
  my $tag = $buffer->create_tag (undef, 
				 foreground => "blue", 
				 underline => 'single');
  $tag->{page} = $page;
  $buffer->insert_with_tags ($iter, $text, $tag);
}

# Fills the buffer with text and interspersed links. In any real
# hypertext app, this method would parse a file to identify the links.
#
sub show_page {
  my ($buffer, $page) = @_;

  $buffer->set_text ("");
  my $iter = $buffer->get_iter_at_offset (0);
  if ($page == 1)
    {
      $buffer->insert ($iter, "Some text to show that simple ");
      insert_link ($buffer, $iter, "hypertext", 3);
      $buffer->insert ($iter, " can easily be realized with ");
      insert_link ($buffer, $iter, "tags", 2);
      $buffer->insert ($iter, ".");
    }
  elsif ($page == 2)
    {
      $buffer->insert ($iter, 
	       "A tag is an attribute that can be applied to some range of text. "
	     . "For example, a tag might be called \"bold\" and make the text inside "
	     . "the tag bold. However, the tag concept is more general than that; "
	     . "tags don't have to affect appearance. They can instead affect the "
	     . "behavior of mouse and key presses, \"lock\" a range of text so the "
	     . "user can't edit it, or countless other things.\n");
      insert_link ($buffer, $iter, "Go back", 1);
    }
  elsif ($page == 3) 
    {
      my $tag = $buffer->create_tag (undef, weight => PANGO_WEIGHT_BOLD);
      $buffer->insert_with_tags ($iter, "hypertext:\n", $tag);
      $buffer->insert ($iter, 
		       "machine-readable text that is not sequential but is organized "
		     . "so that related items of information are connected.\n");
      insert_link ($buffer, $iter, "Go back", 1);
    }
}

# Looks at all tags covering the position of iter in the text view, 
# and if one of them is a link, follow it by showing the page identified
# by the data attached to it.
#
sub follow_if_link {
  my ($text_view, $iter) = @_;

  foreach my $tag ($iter->get_tags) {
      my $page = $tag->{page};

      if ($page != 0) {
	  show_page ($text_view->get_buffer, $page);
	  last;
      }
  }
}

# Links can be activated by pressing Enter.
#
sub key_press_event {
  my ($text_view, $event) = @_;

  if ($event->keyval == $Gtk2::Gdk::Keysyms{Return} ||
      $event->keyval == $Gtk2::Gdk::Keysyms{KP_Enter})
    {
        my $buffer = $text_view->get_buffer;
        my $iter = $buffer->get_iter_at_mark ($buffer->get_insert);
        follow_if_link ($text_view, $iter);
    }

  return FALSE;
}

# Links can also be activated by clicking.
#
sub event_after {
  my ($text_view, $event) = @_;

  return FALSE unless $event->type eq 'button-release'; 
  return FALSE unless $event->button == 1;

  my $buffer = $text_view->get_buffer;

  # we shouldn't follow a link if the user has selected something
  my ($start, $end) = $buffer->get_selection_bounds;
  return FALSE if defined $end
                  and $start->get_offset != $end->get_offset;

  my ($x, $y) = $text_view->window_to_buffer_coords ('widget', #GTK_TEXT_WINDOW_WIDGET,
                                                     $event->x, $event->y);

  my $iter = $text_view->get_iter_at_location ($x, $y);

  follow_if_link ($text_view, $iter);

  return FALSE;
}

my $hovering_over_link = FALSE;
my $hand_cursor = undef;
my $regular_cursor = undef;

# Looks at all tags covering the position (x, y) in the text view, 
# and if one of them is a link, change the cursor to the "hands" cursor
# typically used by web browsers.
#
sub set_cursor_if_appropriate {
  my ($text_view, $x, $y) = @_;
  my $hovering = FALSE;

  my $buffer = $text_view->get_buffer;

  my $iter = $text_view->get_iter_at_location ($x, $y);
  
  foreach my $tag ($iter->get_tags) {
      if ($tag->{page}) {
          $hovering = TRUE;
          last;
      }
  }

  if ($hovering != $hovering_over_link)
    {
      $hovering_over_link = $hovering;

      $text_view->get_window ('text')->set_cursor
      		($hovering_over_link ? $hand_cursor : $regular_cursor);
    }
}

# Update the cursor image if the pointer moved. 
#
sub motion_notify_event {
  my ($text_view, $event) = @_;

  my ($x, $y) = $text_view->window_to_buffer_coords ( 
                                         'widget', #GTK_TEXT_WINDOW_WIDGET,
                                         $event->x, $event->y);

  set_cursor_if_appropriate ($text_view, $x, $y);

  $text_view->window->get_pointer;
  return FALSE;
}

# Also update the cursor image if the window becomes visible
# (e.g. when a window covering it got iconified).
#
sub visibility_notify_event {
  my ($text_view, $event) = @_;

  my (undef, $wx, $wy, undef) = $text_view->window->get_pointer;
  
  my ($bx, $by) = $text_view->window_to_buffer_coords ( 
                                         'widget', #GTK_TEXT_WINDOW_WIDGET,
                                         $wx, $wy);

  set_cursor_if_appropriate ($text_view, $bx, $by);

  return FALSE;
}

sub do {
  my $do_widget = shift;

  if (!$window) {
      $hand_cursor = Gtk2::Gdk::Cursor->new ('hand2');
      $regular_cursor = Gtk2::Gdk::Cursor->new ('xterm');
      
      $window = Gtk2::Window->new;
      $window->set_screen ($do_widget->get_screen)
        if Gtk2->CHECK_VERSION (2, 2, 0);
      $window->set_default_size (450, 450);
      
      $window->signal_connect (destroy => sub {$window = undef});

      $window->set_title ("Hypertext");
      $window->set_border_width (0);

      my $view = Gtk2::TextView->new;
      $view->set_wrap_mode ('word');
      $view->signal_connect (key_press_event => \&key_press_event);
      $view->signal_connect (event_after => \&event_after);
      $view->signal_connect (motion_notify_event => \&motion_notify_event);
      $view->signal_connect (visibility_notify_event => \&visibility_notify_event);

      my $buffer = $view->get_buffer;
      
      my $sw = Gtk2::ScrolledWindow->new;
      $sw->set_policy ('automatic', 'automatic');
      $window->add ($sw);
      $sw->add ($view);

      show_page ($buffer, 1);

      $sw->show_all;
  }

  if (!$window->visible) {
      $window->show;
  } else {
      $window->destroy;
      $window = undef;
  }

  return $window;
}

1;