#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 -init;
use Glib qw(FALSE TRUE);
use Gtk2::Gdk::Keysyms;
use Gtk2::Pango;

my $window = Gtk2::Window->new;
$window->signal_connect( destroy => sub { Gtk2->main_quit; } );
$window->set_default_size( 500, 400 );

# Create a textbuffer to contain that string
my $textbuffer = Gtk2::TextBuffer->new();
$textbuffer->set_text('');
create_tags($textbuffer);
insert_text($textbuffer);

# Create a textview using that textbuffer
my $textview = Gtk2::TextView->new_with_buffer($textbuffer);
$textview->set_left_margin (5);
$textview->set_right_margin (5);

attach_widgets ($textview);

#$textview->set_default_direction ('ltr');

# Add the textview to a scrolledwindow
my $scrolledwindow = Gtk2::ScrolledWindow->new( undef, undef );
$scrolledwindow->add($textview);

# And finally add that scrolledwindow to a window

$window->add($scrolledwindow);

$window->show_all;

Gtk2->main;

sub insert_text {
   my $buffer = shift;

   my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file( 'integral.jpg' );
   my $scaled = $pixbuf->scale_simple( 32, 32, 'bilinear' );
   $pixbuf = $scaled;

# get start of buffer; each insertion will revalidate the
# iterator to point to just after the inserted text.

   my $iter = $buffer->get_iter_at_offset(0);

   $buffer->insert_with_tags_by_name( $iter, chr(960), "big" );
   $buffer->insert_with_tags_by_name( $iter, chr(945), "big" );
   $buffer->insert_with_tags_by_name( $iter, '=' , "big" );
   $buffer->insert_with_tags_by_name( $iter, chr(946), "big" );

   $buffer->insert( $iter,
      "The text widget can display text with all kinds of nifty attrib
+utes. It also supports multiple views of the same buffer; this demo i
+s showing the same buffer in two places.\n\n"
   );

   $buffer->insert_with_tags_by_name( $iter, "Font styles. ", "heading
+" );

   $buffer->insert( $iter, "For example, you can have " );
   $buffer->insert_with_tags_by_name( $iter, "italic", "italic" );
   $buffer->insert( $iter, ", " );
   $buffer->insert_with_tags_by_name( $iter, "bold", "bold" );
   $buffer->insert( $iter, ", or " );
   $buffer->insert_with_tags_by_name( $iter, "monospace (typewriter)",
      "monospace" );
   $buffer->insert( $iter, ", or " );
   $buffer->insert_with_tags_by_name( $iter, "big", "big" );
   $buffer->insert( $iter, " text. " );
   $buffer->insert( $iter,
      "It's best not to hardcode specific text sizes; you can use rela
+tive sizes as with CSS, such as "
   );
   $buffer->insert_with_tags_by_name( $iter, "xx-small", "xx-small" );
   $buffer->insert( $iter, " or " );
   $buffer->insert_with_tags_by_name( $iter, "x-large", "x-large" );
   $buffer->insert( $iter,
      " to ensure that your program properly adapts if the user change
+s the default font size.\n\n"
   );

   $buffer->insert_with_tags_by_name( $iter, "Colors. ", "heading" );

   $buffer->insert( $iter, "Colors such as " );
   $buffer->insert_with_tags_by_name( $iter, "a blue foreground",
      "blue_foreground" );
   $buffer->insert( $iter, " or " );
   $buffer->insert_with_tags_by_name( $iter, "a red background",
      "red_background" );
   $buffer->insert( $iter, " or even " );
   $buffer->insert_with_tags_by_name( $iter, "a stippled red backgroun
+d",
      "red_background", "background_stipple" );

   $buffer->insert( $iter, " or " );
   $buffer->insert_with_tags_by_name( $iter,
      "a stippled blue foreground on solid red background",
      "blue_foreground", "red_background", "foreground_stipple" );
   $buffer->insert( $iter, " (select that to read it) can be used.\n\n
+" );

   $buffer->insert_with_tags_by_name( $iter,
      "Underline, strikethrough, and rise. ", "heading" );

   $buffer->insert_with_tags_by_name( $iter, "Strikethrough", "striket
+hrough" );
   $buffer->insert( $iter, ", " );
   $buffer->insert_with_tags_by_name( $iter, "underline", "underline" 
+);
   $buffer->insert( $iter, ", " );
   $buffer->insert_with_tags_by_name( $iter, "double underline",
      "double_underline" );
   $buffer->insert( $iter, ", " );
  
   $buffer->insert_with_tags_by_name( $iter, "superscript", "superscri
+pt" );
   $buffer->insert( $iter, ", and " );
   $buffer->insert_with_tags_by_name( $iter, "subscript", "subscript" 
+);
   $buffer->insert( $iter, " are all supported.\n\n" );

   $buffer->insert_with_tags_by_name( $iter, "Images. ", "heading" );

   $buffer->insert( $iter, "The buffer can have images in it: " );
   $buffer->insert_pixbuf( $iter, $pixbuf );
   $buffer->insert_pixbuf( $iter, $pixbuf );
   $buffer->insert_pixbuf( $iter, $pixbuf );
   $buffer->insert( $iter, " for example.\n\n" );

   $buffer->insert_with_tags_by_name( $iter, "Spacing. ", "heading" );

   $buffer->insert( $iter,
      "You can adjust the amount of space before each line.\n" );

   $buffer->insert_with_tags_by_name( $iter,
      "This line has a whole lot of space before it.\n",
      "big_gap_before_line", "wide_margins" );
   $buffer->insert_with_tags_by_name(
      $iter,
      "You can also adjust the amount of space after each line; this l
+ine has a whole lot of space after it.\n",
      "big_gap_after_line",
      "wide_margins"
   );

   $buffer->insert_with_tags_by_name(
      $iter,
      "You can also adjust the amount of space between wrapped lines; 
+this line has extra space between each wrapped line in the same parag
+raph. To show off wrapping, some filler text: the quick brown fox jum
+ped over the lazy dog. Blah blah blah blah blah blah blah blah blah.\
+n",
      "double_spaced_line",
      "wide_margins"
   );

   $buffer->insert( $iter,
      "Also note that those lines have extra-wide margins.\n\n" );

   $buffer->insert_with_tags_by_name( $iter, "Editability. ", "heading
+" );

   $buffer->insert_with_tags_by_name(
      $iter,
      "This line is 'locked down' and can't be edited by the user - ju
+st try it! You can't delete this line.\n\n",
      "not_editable"
   );

   $buffer->insert_with_tags_by_name( $iter, "Wrapping. ", "heading" )
+;

   $buffer->insert( $iter,
      "This line (and most of the others in this buffer) is word-wrapp
+ed, using the proper Unicode algorithm. Word wrap should work in all 
+scripts and languages that GTK+ supports. Let's make this a long para
+graph to demonstrate: blah blah blah blah blah blah blah blah blah bl
+ah blah blah blah blah blah blah blah blah blah\n\n"
   );

   $buffer->insert_with_tags_by_name(
      $iter,
      "This line has character-based wrapping, and can wrap between an
+y two character glyphs. Let's make this a long paragraph to demonstra
+te: blah blah blah blah blah blah blah blah blah blah blah blah blah 
+blah blah blah blah blah blah\n\n",
      "char_wrap"
   );

   $buffer->insert_with_tags_by_name(
      $iter,
      "This line has all wrapping turned off, so it makes the horizont
+al scrollbar appear.\n\n\n",
      "no_wrap"
   );

   $buffer->insert_with_tags_by_name( $iter, "Justification. ", "headi
+ng" );

   $buffer->insert_with_tags_by_name( $iter,
      "\nThis line has center justification.\n", "center" );

   $buffer->insert_with_tags_by_name( $iter,
      "This line has right justification.\n",
      "right_justify" );

   $buffer->insert_with_tags_by_name(
      $iter,
      "\nThis line has big wide margins. Text text text text text text
+ text text text text text text text text text text text text text tex
+t text text text text text text text text text text text text text te
+xt text text.\n",
      "wide_margins"
   );

   $buffer->insert_with_tags_by_name( $iter, "Internationalization. ",
      "heading" );

   $buffer->insert( $iter,
      "You can put all sorts of Unicode text in the buffer.\n\nGerman 
+(S\x{fc}ddeutschland) Gr\x{fc}\x{df} Gott\nGreek (\x{395}\x{3bb}\x{3b
+b}\x{3b7}\x{3bd}\x{3b9}\x{3ba}\x{3ac}) \x{393}\x{3b5}\x{3b9}\x{3ac} \
+x{3c3}\x{3b1}\x{3c2}\nHebrew    \x{5e9}\x{5dc}\x{5d5}\x{5dd}\nJapanes
+e (\x{65e5}\x{672c}\x{8a9e})\n\nThe widget properly handles bidirecti
+onal text, word wrapping, DOS/UNIX/Unicode paragraph separators, grap
+heme boundaries, and so on using the Pango internationalization frame
+work.\n"
   );

   $buffer->insert( $iter,
      "Here's a word-wrapped quote in a right-to-left language:\n" );
   $buffer->insert_with_tags_by_name(
      $iter,
      "\x{648}\x{642}\x{62f} \x{628}\x{62f}\x{623} \x{62b}\x{644}\x{62
+7}\x{62b} \x{645}\x{646} \x{623}\x{643}\x{62b}\x{631} \x{627}\x{644}\
+x{645}\x{624}\x{633}\x{633}\x{627}\x{62a} \x{62a}\x{642}\x{62f}\x{645
+}\x{627} \x{641}\x{64a} \x{634}\x{628}\x{643}\x{629} \x{627}\x{643}\x
+{633}\x{64a}\x{648}\x{646} \x{628}\x{631}\x{627}\x{645}\x{62c}\x{647}
+\x{627} \x{643}\x{645}\x{646}\x{638}\x{645}\x{627}\x{62a} \x{644}\x{6
+27} \x{62a}\x{633}\x{639}\x{649} \x{644}\x{644}\x{631}\x{628}\x{62d}\
+x{60c} \x{62b}\x{645} \x{62a}\x{62d}\x{648}\x{644}\x{62a} \x{641}\x{6
+4a} \x{627}\x{644}\x{633}\x{646}\x{648}\x{627}\x{62a} \x{627}\x{644}\
+x{62e}\x{645}\x{633} \x{627}\x{644}\x{645}\x{627}\x{636}\x{64a}\x{629
+} \x{625}\x{644}\x{649} \x{645}\x{624}\x{633}\x{633}\x{627}\x{62a} \x
+{645}\x{627}\x{644}\x{64a}\x{629} \x{645}\x{646}\x{638}\x{645}\x{629}
+\x{60c} \x{648}\x{628}\x{627}\x{62a}\x{62a} \x{62c}\x{632}\x{621}\x{6
+27} \x{645}\x{646} \x{627}\x{644}\x{646}\x{638}\x{627}\x{645} \x{627}
+\x{644}\x{645}\x{627}\x{644}\x{64a} \x{641}\x{64a} \x{628}\x{644}\x{6
+2f}\x{627}\x{646}\x{647}\x{627}\x{60c} \x{648}\x{644}\x{643}\x{646}\x
+{647}\x{627} \x{62a}\x{62a}\x{62e}\x{635}\x{635} \x{641}\x{64a} \x{62
+e}\x{62f}\x{645}\x{629} \x{642}\x{637}\x{627}\x{639} \x{627}\x{644}\x
+{645}\x{634}\x{631}\x{648}\x{639}\x{627}\x{62a} \x{627}\x{644}\x{635}
+\x{63a}\x{64a}\x{631}\x{629}. \x{648}\x{623}\x{62d}\x{62f} \x{623}\x{
+643}\x{62b}\x{631} \x{647}\x{630}\x{647} \x{627}\x{644}\x{645}\x{624}
+\x{633}\x{633}\x{627}\x{62a} \x{646}\x{62c}\x{627}\x{62d}\x{627} \x{6
+47}\x{648} \x{bb}\x{628}\x{627}\x{646}\x{643}\x{648}\x{633}\x{648}\x{
+644}\x{ab} \x{641}\x{64a} \x{628}\x{648}\x{644}\x{64a}\x{641}\x{64a}\
+x{627}.\n\n",
      "rtl_quote"
   );

   $buffer->insert( $iter,
      "You can put widgets in the buffer: Here's a button: " );
   my $anchor = $buffer->create_child_anchor( $iter );
   $buffer->insert( $iter, " and a menu: " );
   $anchor = $buffer->create_child_anchor( $iter );
   $buffer->insert( $iter, " and a scale: " );
   $anchor = $buffer->create_child_anchor( $iter );
   $buffer->insert( $iter, " and an animation: " );
   $anchor = $buffer->create_child_anchor( $iter );
   $buffer->insert( $iter, " finally a text entry: " );
   $anchor = $buffer->create_child_anchor( $iter );
   $buffer->insert( $iter, ".\n" );

   $buffer->insert( $iter,
      "\n\nThis demo doesn't demonstrate all the GtkTextBuffer feature
+s; it leaves out, for example: invisible/hidden text (doesn't work in
+ GTK 2, but planned), tab stops, application-drawn areas on the sides
+ of the widget for displaying breakpoints and such..."
   );

# Apply word_wrap tag to whole buffer
   $buffer->apply_tag_by_name( "word_wrap", $buffer->get_bounds );
}

######################################################################
+############
sub create_tags {
   my $buffer = shift;

# Create a bunch of tags. Note that it's also possible to
# create tags with gtk_text_tag_new() then add them to the
# tag table for the buffer, gtk_text_buffer_create_tag() is
# just a convenience function. Also note that you don't have
# to give tags a name; pass NULL for the name to create an
# anonymous tag.
#
# In any real app, another useful optimization would be to create
# a GtkTextTagTable in advance, and reuse the same tag table for
# all the buffers with the same tag set, instead of creating
# new copies of the same tags for every buffer.
#
# Tags are assigned default priorities in order of addition to the
# tag table. That is, tags created later that affect the same text
# property affected by an earlier tag will override the earlier
# tag.  You can modify tag priorities with
# gtk_text_tag_set_priority().

   $buffer->create_tag(
      "heading",
      weight => PANGO_WEIGHT_BOLD,
      size   => 15 * PANGO_SCALE,
   );

   $buffer->create_tag( "italic", style  => 'italic' );
   $buffer->create_tag( "bold",   weight => PANGO_WEIGHT_BOLD );
   $buffer->create_tag( "big",    size   => 50 * PANGO_SCALE );

# points times the PANGO_SCALE factor

   $buffer->create_tag( "xx-small",        scale      => PANGO_SCALE_X
+X_SMALL );
   $buffer->create_tag( "x-large",         scale      => PANGO_SCALE_X
+_LARGE );
   $buffer->create_tag( "monospace",       family     => "monospace" )
+;
   $buffer->create_tag( "blue_foreground", foreground => "blue" );
   $buffer->create_tag( "red_background",  background => "red" );

my $gray50_bits = pack 'CC', 0x02, 0x01;
   my $stipple =
    Gtk2::Gdk::Bitmap->create_from_data( undef, $gray50_bits, 2,2 );

   $buffer->create_tag( "background_stipple", background_stipple => $s
+tipple );
   $buffer->create_tag( "foreground_stipple", foreground_stipple => $s
+tipple );

   $buffer->create_tag( "big_gap_before_line", pixels_above_lines => 3
+0 );
   $buffer->create_tag( "big_gap_after_line",  pixels_below_lines => 3
+0 );
   $buffer->create_tag( "double_spaced_line",  pixels_inside_wrap => 1
+0 );
   $buffer->create_tag( "not_editable",        editable           => F
+ALSE );
   $buffer->create_tag( "word_wrap",           wrap_mode          => '
+word' );
   $buffer->create_tag( "char_wrap",           wrap_mode          => '
+char' );
   $buffer->create_tag( "no_wrap",             wrap_mode          => '
+none' );
   $buffer->create_tag( "center",              justification      => '
+center' );
   $buffer->create_tag( "right_justify",       justification      => '
+right' );
   $buffer->create_tag( "wide_margins", left_margin => 50, right_margi
+n => 50 );
   $buffer->create_tag( "strikethrough",    strikethrough => TRUE );
   $buffer->create_tag( "underline",        underline     => 'single' 
+);
   $buffer->create_tag( "double_underline", underline     => 'double' 
+);

   $buffer->create_tag(
      "superscript",
      rise => 10 * PANGO_SCALE,    # 10 pixels
      size => 8 * PANGO_SCALE,     # 8 points
   );

   $buffer->create_tag(
      "subscript",
      rise => -10 * PANGO_SCALE,    # 10 pixels
      size => 8 * PANGO_SCALE,      # 8 points
   );

   $buffer->create_tag(
      "rtl_quote",
      wrap_mode    => 'word',
      direction    => 'rtl',
      indent       => 30,
      left_margin  => 20,
      right_margin => 20,
   );
}
######################################################################
+#########
sub attach_widgets {
  my $text_view = shift;
  
  my $buffer = $text_view->get_buffer;

  my $iter = $buffer->get_start_iter;

  my $i = 0;
  while (find_anchor ($iter)) {
      my $widget;
      
      my $anchor = $iter->get_child_anchor;

      if ($i == 0) {
          $widget = Gtk2::Button->new ("Click Me");

          $widget->signal_connect (clicked => \&easter_egg_callback);

      } elsif ($i == 1) {
      if (Gtk2->CHECK_VERSION (2, 4, 0)) {
             $widget = Gtk2::ComboBox->new_text;
             $widget->append_text ("Option 1");
             $widget->append_text ("Option 2");
             $widget->append_text ("Option 3");

          } else {
             # ComboBox is not available, use OptionMenu instead
             my $menu = Gtk2::Menu->new;
             $menu->append (Gtk2::MenuItem->new ("Option 1"));
             $menu->append (Gtk2::MenuItem->new ("Option 2"));
             $menu->append (Gtk2::MenuItem->new ("Option 3"));

             $widget = Gtk2::OptionMenu->new;
             $widget->set_menu ($menu);
          }

      } elsif ($i == 2) {
          $widget = Gtk2::HScale->new (undef);
          $widget->set_range (0, 100);
          $widget->set_size_request (70, -1);

      } elsif ($i == 3) {
      my $filename = 'floppybuddy.gif';
      $widget = Gtk2::Image->new_from_file ($filename);

      } elsif ($i == 4) {
          $widget = Gtk2::Entry->new;

      } else {
      die "shouldn't get here";
      }

      $text_view->add_child_at_anchor ($widget, $anchor);

      $widget->show_all;

      ++$i;
  }
}
##############################################################
sub find_anchor {
  my $iter = shift;
  while ($iter->forward_char) {
    return TRUE if $iter->get_child_anchor;
  }
  return FALSE;
}
#############################################################
sub recursive_attach_view {
  my ($depth, $view, $anchor) = @_;
  
  return if $depth > 4;
  
  my $child_view = Gtk2::TextView->new_with_buffer ($view->get_buffer)
+;

  # Event box is to add a black border around each child view
  my $event_box = Gtk2::EventBox->new;
  my $color = Gtk2::Gdk::Color->parse ("black");
  $event_box->modify_bg ('normal', $color);

  my $align = Gtk2::Alignment->new (0.5, 0.5, 1.0, 1.0);
  $align->set_border_width (1);
  
  $event_box->add ($align);
  $align->add ($child_view);
  
  $view->add_child_at_anchor ($event_box, $anchor);

  recursive_attach_view ($depth + 1, $child_view, $anchor);
}


##############################################################
sub easter_egg_callback {
  my $button = shift;
  
  my $tvee_window;
  
  if ($tvee_window) {
      $tvee_window->present;
      return;
  }
  
  my $buffer = Gtk2::TextBuffer->new (undef);

  my $iter = $buffer->get_start_iter;

  $buffer->insert ($iter, "This buffer is shared by a set of nested te
+xt views.\n Nested view:\n");
  my $anchor = $buffer->create_child_anchor ($iter);
  $buffer->insert ($iter, "\nDon't do this in real applications, pleas
+e.\n");

  my $view = Gtk2::TextView->new_with_buffer ($buffer);
  
  recursive_attach_view (0, $view, $anchor);
  
  $tvee_window = Gtk2::Window->new ('toplevel');
  my $sw = Gtk2::ScrolledWindow->new (undef, undef);
  $sw->set_policy ('automatic', 'automatic');

  $tvee_window->add ($sw);
  $sw->add ($view);

  $tvee_window->signal_connect (destroy => sub {$tvee_window = undef; 
+1});

  $tvee_window->set_default_size (300, 400);
  
  $tvee_window->show_all;
}
[download]