Gtk2-Ex-WYSIWYG
view release on metacpan or search on metacpan
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
Gtk2::Table::,
signals => {},
properties => [Glib::ParamSpec->uint('undo_stack',
'Undo Stack Size',
('The maximum size of the undo '.
'stack. Zero implies no limit'),
0, ~0, 0,
[qw/readable writable/]),
Glib::ParamSpec->boolean('flat_toolbar',
'Flat Toolbar',
('Whether the toolbar should be '.
'flat (true) or double-height '.
'(false)'),
0, [qw/readable writable/]),
Glib::ParamSpec->boolean('debug',
'Show Debug Button',
('Show or hide the Debug button'),
0, [qw/readable writable/]),
Glib::ParamSpec->boolean('map-fill-to-left',
'Map fill justification to left',
('Map the fill justification tag '.
'to the left justification tag '.
'for older version of Gtk2 that '.
'don\'t support it'),
0, [qw/readable writable/]),
Glib::ParamSpec->boolean('check-spelling',
'Check spelling',
('Use Gtk2::Spell to allow spell '.
'checking. You must have '.
'Gtk2::Spell installed!'),
0, [qw/readable writable/])];
use constant UNDO_REMOVE_TAG => 0;
use constant UNDO_APPLY_TAG => 1;
use constant UNDO_INSERT_TEXT => 2;
use constant UNDO_DELETE_TEXT => 3;
=head1 NAME
Gtk2::Ex::WYSIWYG - A WYSIWYG editor ready to drop into a GUI.
=head1 VERSION
Version 0.02
=cut
our $VERSION = 0.02;
=head1 DESCRIPTION
This module is a subclass of L<Gtk2::Table> containing both a text view
and a 'toolbar' to allow a user to edit and format text. It can serialise
to a plain text block and a tag stack, or to incomplete HTML (the output is
not a complete HTML document, but can be included inside one). It can also
'deserialise' from this same data to easily allow content from one WYSIWYG to
be transfered to another - the more efficient of these is the text/tag stack,
however the HTML form can be more easily stored.
An undo/redo stack is also included, as well as a modification to the text
view's popup menu to allow the user to set the wrap mode with ease.
It should be noted that WYSIWYG emulates paragraphs by using \n\s*\n as a
paragraph separator. The leading newline in the sequence will belong to the
leading paragraph, and the rest to 'interparagraph space'. This has some
implications - interparagraph space honours vertical space (ie, extra newlines
will be rendered when exporting to HTML) but not horizontal space - any spaces
you put inside interparagraph space will be ignored, as will any font
formatting you apply.
It also means that should two paragraphs be joined by a user edit (either by
inserting non-whitespace or by deleteing whitespace) any paragraph-level
formatting applied to the paragraph that used to be before the interparagraph
space will be applied to any affected paragraphs after it.
See the TAGS section below for supported tags.
There are currently three 'sub-packages' contained within Gtk2::Ex::WYSIWYG as
well - Gtk2::Ex::WYSIWYG::HTML (for parsing and generating HTML from the view),
Gtk2::Ex::WYSIWYG::FormatMenu (a Gtk2::ComboBox replacement that shows
formatting in the option menu but not in the main widget) and
Gtk2::Ex::WYSIWYG::SizeMenu (a beefed up Gtk2::ComboBoxEntry with a few extra
features, specifically designed for the font size setting).
=head1 HIERARCHY
Glib::Object
+----Glib::InitiallyUnowned
+----Gtk2::Object
+----Gtk2::Widget
+----Gtk2::Container
+----Gtk2::Table
+---Gtk2::Ex::WYSIWYG
=head1 METHODS
=cut
#' emacs formatting....
my %TAGS; # Tag definitions. See end of file for BEGIN filler
my %BUTTONS; # Button definitions. See end of file for BEGIN filler
# 'Public' methods
=head2 Gtk2::Ex::WYSIWYG->new()
Returns a new WYSIWYG instance. There are a few properties you can set, see
the PROPERTIES section below.
=cut
sub INIT_INSTANCE {
my $self = shift;
$self->_init_tooltips;
$self->_init_font_list if not defined $BUTTONS{Font}{Tags};
$self->{FontSet} = 1;
$self->{SizeSet} = 1;
$self->{Active} = {};
$self->{UndoStack} = [];
$self->{RedoStack} = [];
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Gtk2::Ex::WYSIWYG
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Gtk2-Ex-WYSIWYG>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Gtk2-Ex-WYSIWYG>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Gtk2-Ex-WYSIWYG>
=item * Search CPAN
L<http://search.cpan.org/dist/Gtk2-Ex-WYSIWYG/>
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2010 Matthew Braid.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
############################################################################
# Builder functions - used to create class and instance widgets as necessary
############################################################################
#########
# Create the tooltips - both the 'standard' tooltips widget for hovering
# over buttons and a 'fake' one for hovering over links
#########
BEGIN {
my ($TT, $TT_L); # Fake tooltips and label for same
my $TOOLTIPS; # 'Real' tooltips widget for buttons
sub _init_tooltips {
my $self = shift;
return if defined $TOOLTIPS;
$TOOLTIPS = Gtk2::Tooltips->new; # Class wide. Would be nice if there was a
# way of determining if a tooltip widget
# was already created and use that
$TT = Gtk2::Window->new('popup'); # The 'fake' link tooltip window
$TT_L = Gtk2::Label->new;
$TT_L->set_padding(4, 4);
$TT->set_resizable(0);
$TT->set_decorated(0);
$TT->set_position('mouse'); # We modify this on popup
# Would be good to get the current theme colour - on ubuntu this works, but
# using blackbox on freebsd results in a colour that is 'too yellow'
$TT->modify_bg('normal',
Gtk2::Gdk::Color->new(245 << 8, 245 << 8, 181 << 8));
my $frame = Gtk2::Frame->new;
$frame->set_shadow_type('etched-in');
$frame->add($TT_L);
$TT->add($frame);
}
sub _tooltip_text {
my $self = shift;
my ($txt) = @_;
$TT_L->set_text($txt);
}
sub _tooltip_show {
my $self = shift;
my ($x, $y) = @_;
$TT->show_all;
my ($thisx, $thisy) = $TT->window->get_origin;
$TT->move($thisx + 20, $thisy + 20);
}
sub _tooltip_hide { $TT->hide }
##########
# _build_buttons - on an instance creation, build the buttons for the toolbar
# at the top. Uses the %BUTTONS and %TAGS hashes (see below)
# In this begin block to access $TOOLTIPS
##########
sub _build_buttons {
my $self = shift;
for my $bname (keys %BUTTONS) {
return if defined($self->{Buttons}{$bname});
if ($BUTTONS{$bname}{Type} eq 'toggle') {
$self->{Buttons}{$bname} = Gtk2::ToggleButton->new;
$self->{Buttons}{$bname}->set_active(1)
if $BUTTONS{$bname}{On};
$TOOLTIPS->set_tip($self->{Buttons}{$bname},
$BUTTONS{$bname}{TipText});
if ($TAGS{$BUTTONS{$bname}{Tag}}{Multi}) {
$self->{Buttons}{$bname}->
signal_connect('toggled',
sub {$self->_on_multi_toggle_change($bname)});
} else {
$self->{Buttons}{$bname}->
signal_connect('toggled', sub {$self->_on_toggle_change($bname)});
}
} elsif ($BUTTONS{$bname}{Type} eq 'button') {
$self->{Buttons}{$bname} = Gtk2::Button->new;
$TOOLTIPS->set_tip($self->{Buttons}{$bname},
$BUTTONS{$bname}{TipText});
$self->{Buttons}{$bname}->
signal_connect('clicked', sub {$self->_on_button_click($bname)});
} elsif ($BUTTONS{$bname}{Type} eq 'menu') {
$self->{Buttons}{$bname} = Gtk2::Ex::WYSIWYG::FormatMenu->new;
$self->{Buttons}{$bname}->set_tool_tip($TOOLTIPS);
$self->{Buttons}{$bname}->
signal_connect(format_selected =>
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
$frame->set_label_align(0.5, 0.5);
$frame->set_shadow_type('etched-in');
$lab = $frame->get_label_widget;
$lab->set_markup('<small>Undo</small>');
$self->{Toolbar}->pack_start($frame, 0, 0, 2);
$vbox = Gtk2::VBox->new(0, 0);
$hb2 = Gtk2::HBox->new(0, 0);
$frame->add($hb2);
$hb2->pack_start($vbox, 1, 1, 2);
$hb2 = Gtk2::HBox->new(0, 0);
$hb2->pack_start($self->{Buttons}{Undo}, 0, 0, 0);
$vbox->pack_start($hb2, 1, 1, 2);
$hb2 = Gtk2::HBox->new(0, 0);
$hb2->pack_start($self->{Buttons}{Redo}, 0, 0, 0);
$vbox->pack_start($hb2, 1, 1, 2);
$self->{Toolbar}->pack_start($self->{Buttons}{DUMP}, 0, 0, 0)
if $self->get_property('debug') and defined($self->{Buttons}{DUMP});
$self->{Toolbar}->show_all;
$self->attach($self->{Toolbar}, 0, 1, 0, 1,
[qw(fill expand)], [qw(fill)], 0, 0);
}
#########
# _build_text - create the text view and initialise it. Also creates cursors
# and connects signals as required
#########
sub _build_text {
my $self = shift;
my $txt = Gtk2::TextView->new;
my $scr = Gtk2::ScrolledWindow->new;
$scr->set_shadow_type('in');
$scr->set_policy('automatic', 'automatic');
$scr->add($txt);
$scr->show_all;
$self->attach($scr, 0, 1, 1, 2, [qw(fill expand)], [qw(fill expand)], 0, 0);
$self->{Text} = $txt;
if ($self->get_property('check-spelling')) {
eval {require Gtk2::Spell};
if ($@) {
warn("Gtk2::Spell does not appear to be installed!");
} else {
$self->{GtkSpell} = Gtk2::Spell->new_attach($self->{Text});
$self->{GtkSpell}->recheck_all;
}
}
my $buf = $txt->get_buffer;
$buf->signal_connect('mark-set' => sub {$self->_on_cursor_move(@_)});
$buf->signal_connect_after('insert-text' => sub {$self->_on_insert(@_)});
$buf->signal_connect('delete-range' => sub {$self->_on_delete(@_)});
$buf->signal_connect_after('delete-range' => sub {$self->_after_delete(@_)});
$buf->signal_connect('apply-tag' => sub {$self->_on_apply_tag(@_)});
$buf->signal_connect('remove-tag' => sub {$self->_on_remove_tag(@_)});
$self->{Cursor}{Current} = 'Text';
$self->{Cursor}{Text} = Gtk2::Gdk::Cursor->new('xterm');
$self->{Cursor}{Link} = Gtk2::Gdk::Cursor->new('hand2');
$self->{Text}->signal_connect(motion_notify_event =>
sub {$self->_on_motion_notify(@_)});
$self->{Text}->signal_connect('focus-out-event' =>
sub {$self->_on_unfocus_text});
$self->{Text}->signal_connect('populate-popup',
sub {$self->_on_popup(@_)});
}
##########
# _init_font_list - examines the pango context and sets available fonts,
# the default font and the default size
##########
sub _init_font_list {
my $self = shift;
my $c = $self->get_pango_context;
$BUTTONS{Font}{Default} = $c->get_font_description->get_family;
$BUTTONS{Font}{Tags} = [];
for my $name (sort {$a cmp $b} map {$_->get_name} $c->list_families) {
push @{$BUTTONS{Font}{Tags}}, $name;
}
$BUTTONS{Size}{Default} = int($c->get_font_description->get_size / 1024);
Gtk2::Ex::WYSIWYG::HTML->set_fonts(@{$BUTTONS{Font}{Tags}});
Gtk2::Ex::WYSIWYG::HTML->set_default_size($BUTTONS{Size}{Default});
}
############################################################################
# Signal Handlers
############################################################################
##########
# _on_apply_tag - to facilitate undo and redo, record tag applications.
##########
sub _on_apply_tag {
my $self = shift;
my ($buf, $tag, $s, $e) = @_;
$self->_record_undo(UNDO_APPLY_TAG, $s->get_offset, $e->get_offset, $tag)
if $self->_is_my_tag($tag);
return 0;
}
##########
# _on_remove_tag - to facilitate undo and redo, record tags removals.
# NOTE: the signal handler recieves a start and end range exactly matching
# what was used in the $buf->remove_tag(...) call, which may be wrong
# if the range includes bits where the tag wasn't applied in the first
# place. All tag removals in code should therefore be done with the
# _remove_tag or _remove_tag_cascade functions within this package
##########
sub _on_remove_tag {
my $self = shift;
my ($buf, $tag, $s, $e) = @_;
$self->_record_undo(UNDO_REMOVE_TAG, $s->get_offset, $e->get_offset, $tag)
if $self->_is_my_tag($tag);
return 0;
}
##########
# _on_popup - modify the default popup window to include a Wrap menu
##########
sub _on_popup {
my $self = shift;
my ($txt, $menu) = @_;
my $currmode = $txt->get_wrap_mode;
my $mt = Gtk2::MenuItem->new('Wrap');
my $sub = Gtk2::Menu->new;
$mt->set_submenu($sub);
my $grp = undef;
for my $it (['None', 'none'], ['Character', 'char'],
['Word', 'word'], ['Word, then character', 'word-char']) {
my $mi = Gtk2::RadioMenuItem->new($grp, $it->[0]);
$grp = $mi if not defined $grp;
$mi->set_active($currmode eq $it->[1]);
$mi->signal_connect(activate => sub {$txt->set_wrap_mode($it->[1])
if $_[0]->get_active; 0});
$sub->append($mi);
}
$mt->show_all;
$menu->append($mt);
$menu->reorder_child($mt, 7);
return 0;
}
#########
# _on_cursor_move - if the cursor has moved, update the buttons to reflect the
# new edit mode
#########
sub _on_cursor_move {
my $self = shift;
my ($buf, $iter, $mark) = @_;
return 0 if $mark->get_name ne 'insert';
my ($s, $e) = $buf->get_bounds;
return 0 if $s->equal($e);
$self->_set_active_from_text;
$self->_set_buttons_from_active;
return 0;
}
#########
# _on_insert - make sure that inserted text has the correct tags applied.
# Do nothing if we're in the middle of an undo action
# Remember to record this action if we need to for an undo
#########
sub _on_insert {
my $self = shift;
my ($buf, $iter, $str) = @_;
return 0 if $self->{Undoing}; # Don't interfere!
my $commit = $self->_start_record_undo;
my $start = $iter->copy;
$start->backward_chars(length $str);
$self->_record_undo(UNDO_INSERT_TEXT, $start->get_offset, $iter->get_offset,
$str);
# Ensure correct tags applied to text inserted
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
if (exists $self->{Active}{$tag->get_property('name')}) {
$self->_apply_tag_cascade($tag, $start, $iter);
} else {
$self->_remove_tag_cascade($tag, $start, $iter);
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
my $self = shift;
$self->{Label}->set_ellipsize(@_);
}
sub get_ellipsize {
my $self = shift;
$self->{Label}->get_ellipsize(@_);
}
sub _show_menu {
my $self = shift;
return 0 if not scalar(@{$self->{Options}});
my $menu = Gtk2::Menu->new;
my $match = $self->{Label}->get_text;
my $sel = undef;
my $i = 0;
for my $opt (@{$self->{Options}}) {
my ($label, $dat, $style) = @$opt;
if ($label eq $match) {
$sel = $i;
} elsif (not defined $sel and defined $self->{Default} and
$label eq $self->{Default}) {
$sel = $i;
}
++$i;
my $item = Gtk2::MenuItem->new_with_label('');
if (defined($style)) {
my @slist;
for my $attr (keys %$style) {
if ($attr eq 'scale') {
my $s = $self->get_pango_context->get_font_description->
get_size;
$s = int($s * $style->{$attr});
push @slist, "size=\"$s\"";
} elsif ($attr eq 'family') {
push @slist, "font_family=\"$style->{$attr}\"";
} else {
push @slist, "$attr=\"$style->{$attr}\"";
}
}
my $lab = $item->get_child;
if (scalar(@slist)) {
my $vis = $label;
$vis =~ s/</</g;
$lab->set_markup("<span " . join(" ", @slist) . ">$vis</span>");
} else {
$lab->set_text($label);
}
} else {
$item->get_child->set_text($label);
}
$item->signal_connect(activate => sub {
$self->_item_selected($label, $dat);
});
$item->show;
$menu->append($item);
}
$sel = 0 if not defined $sel;
$menu->set_active($sel);
# Popup the menu
$menu->popup(undef, undef, undef, undef, $self, undef);
$menu->popup(undef, undef, '_menu_pos', $self, $self, undef);
my ($mx, $my) = $menu->get_size_request;
my ($bx, $by) = $self->get_size_request;
$menu->set_size_request($bx, -1) if $mx < $bx;
my $active = $menu->get_active;
($active) = $menu->get_children if not defined $active;
$menu->select_item($active);
return 0;
}
# !!! _menu_pos assumes that the menu _HAS ALREADY BEEN POPPED UP!_
# This is so allocation details are set already.
sub _menu_pos {
my ($menu, $evx, $evy, $self) = @_;
my ($px, $py) = $self->get_pointer;
my ($x, $y, $w, $h) = $self->allocation->values;
my ($rx, $ry) = $self->window->get_origin;
my $active = $menu->get_active;
($active) = $menu->get_children if not defined $active;
my ($ix, $iy, $iw, $ih) = $active->allocation->values;
return ($rx + $x, $evy - $iy - ($ih / 2));
}
sub _item_selected {
my $self = shift;
my ($disp, $dat) = @_;
$self->{Label}->set_text($disp);
$self->{TT}->set_tip($self, $disp) if defined $self->{TT};
$self->signal_emit(format_selected => $disp, $dat);
return 0;
}
}
BEGIN {
package Gtk2::Ex::WYSIWYG::SizeMenu;
use strict;
use Gtk2;
use Gtk2::Pango;
use Glib::Object::Subclass
Gtk2::ComboBoxEntry::,
signals => {size_selected => {param_types => ['Glib::UInt']}};
my @DEFAULT_SIZES = qw(8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72);
sub INIT_INSTANCE {
my $self = shift;
my $model = Gtk2::ListStore->new('Glib::String');
for my $val (@DEFAULT_SIZES) {
$model->set($model->append, 0, $val);
}
$self->set_model($model);
$self->set_text_column(0);
my $ent = $self->get_child; # -> validation!
$ent->set_max_length(4); # 1 to 1024pt
$ent->set_width_chars(4);
$self->signal_connect(changed => sub {$self->_changed(@_)});
}
sub set_inconsistant {
my $self = shift;
$self->get_child->set_text('');
( run in 1.622 second using v1.01-cache-2.11-cpan-364913b4093 )