Gtk2-Ex-WYSIWYG
view release on metacpan or search on metacpan
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
$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);
}
});
# What if this insert just bridged two paragraphs?!
$self->_normalise_paragraph($start, $iter);
$self->_set_active_from_text;
$self->_commit_record_undo if $commit;
$self->_set_buttons_from_active;
return 0;
}
###########
# _on_delete - unless we're in the middle of an undo action, record the
# pending change. Don't just record the delete - pre-remove
# any tags applied over the range so an undo doesn't plonk plain
# text back
###########
sub _on_delete {
my $self = shift;
return 0 if $self->{Undoing};
my ($buf, $s, $e) = @_;
++$self->{DeleteCommit} if $self->_start_record_undo;
my $p = $s->copy;
while (1) {
last if $p->compare($e) != -1;
for my $tag ($p->get_tags) {
next if not $self->_is_my_tag($tag);
my $t = $p->copy;
$t = $e->copy if (not $t->forward_to_tag_toggle($tag) or
$t->compare($e) == 1);
$self->_remove_tag($tag, $p, $t);
}
last if not $p->forward_to_tag_toggle(undef);
}
$self->_record_undo(UNDO_DELETE_TEXT, $s->get_offset, $e->get_offset,
$buf->get_text($s, $e, 0));
0;
}
#########
# _after_delete - unless we're in the middle of an undo action, ensure
# paragraph tags are consistent, and make sure the buttons
# reflect the current active state. Also commit the undo
# recording if we have one.
#########
sub _after_delete {
my $self = shift;
return 0 if $self->{Undoing};
my ($buf, $s, $e) = @_;
$self->_normalise_paragraph($s, $e);
$self->_set_active_from_text;
$self->_set_buttons_from_active;
if ($self->{DeleteCommit}) {
$self->_commit_record_undo;
--$self->{DeleteCommit};
}
return 0;
}
sub _on_visibility_notify {
my $self = shift;
$self->_set_cursor;
return 0;
}
sub _on_motion_notify {
my $self = shift;
my ($view, $ev) = @_;
my ($x, $y) = $view->window_to_buffer_coords('widget', $ev->get_coords);
$self->_set_cursor($x, $y);
$view->window->get_pointer;
return 0;
}
sub _on_unfocus_text {
my $self = shift;
$self->{Cursor}{Current} = 'Text';
$self->{Text}->get_window('text')->set_cursor($self->{Cursor}{Text});
$self->_tooltip_hide();
$self->{CurrentLink} = undef;
0;
}
###########
# _on_toggle_change - a toggle button has been toggled - reflect the change
###########
sub _on_toggle_change {
my $self = shift;
return 0 if $self->{Lock}{Buttons}; # Programmatic button change in progress
my ($name) = @_;
my $commit = $self->_start_record_undo;
my $tname = $BUTTONS{$name}{Tag};
my ($s, $e) = $self->_get_current_bounds_for_tag($tname);
if ($self->{Buttons}{$name}->get_active) {
# Switching on
my $tag = $self->_create_tag($self->_full_tag_name($tname),
%{$TAGS{$tname}{Look}});
$self->_apply_tag_cascade($tag, $s, $e);
$self->_normalise_paragraph($s, $e)
if ($tname eq 'asis' or $tname eq 'pre') and not $s->equal($e);
$self->_set_active_from_text if not $s->equal($e);
$self->{Active}{$tag->get_property('name')} = undef;
$self->_set_buttons_from_active;
} else {
# Switching off
my $tag = $self->_full_tag_name($tname);
$self->_remove_tag_cascade($tag, $s, $e);
$self->_set_active_from_text if not $s->equal($e);
delete($self->{Active}{$tag});
$self->_set_buttons_from_active;
}
$self->_commit_record_undo if $commit;
return 0;
}
###########
# _on_multi_toggle_change - a toggle button has been toggled, and it is a
# 'multi' tag (ie, makes tagname_X tags rather than
# just one tagname tag). Uses the ToggleOn and
# ToggleOff tag definitions.
###########
sub _on_multi_toggle_change {
my $self = shift;
return 0 if $self->{Lock}{Buttons};
my ($bname) = @_;
my $commit = $self->_start_record_undo;
my $tname = $BUTTONS{$bname}{Tag};
my ($s, $e) = $self->_get_current_bounds_for_tag($tname);
if ($self->{Buttons}{$bname}->get_active) {
die "Multi tag without toggle on code '$tname'!"
if not exists $TAGS{$tname}{ToggleOn};
$TAGS{$tname}{ToggleOn}->($self, $bname, $s, $e);
} else {
die "Multi tag without toggle off code '$tname'!"
if not exists $TAGS{$tname}{ToggleOff};
$TAGS{$tname}{ToggleOff}->($self, $bname, $s, $e);
}
$self->_commit_record_undo if $commit;
return 0;
}
sub _on_button_click {
my $self = shift;
return 0 if $self->{Lock}{Buttons};
my ($bname) = @_;
my $tname = $BUTTONS{$bname}{Tag};
die "No code for tag '$tname'!" if not exists $TAGS{$tname}{Activate};
my $commit = $self->_start_record_undo;
$TAGS{$tname}{Activate}->($self, $bname,
$self->_get_current_bounds_for_tag($tname));
$self->_commit_record_undo if $commit;
return 0;
}
sub _on_menu_change {
my $self = shift;
my ($bname, $wid, $display, $tname) = @_;
return 0 if $self->{Lock}{Buttons};
return 0 if $self->{Buttons}{$bname}->get_inconsistant; # make no changes!
my $commit = $self->_start_record_undo;
my ($s, $e);
my $buf = $self->{Text}->get_buffer;
for my $tag (@{$BUTTONS{$bname}{Tags}}) {
next if not exists $TAGS{$tag->[0]};
($s, $e) = $self->_get_current_bounds_for_tag($tag->[0])
if not defined $s;
last if $s->equal($e);
$self->_remove_tag_cascade($self->_full_tag_name($tag->[0]), $s, $e);
}
my $ftname = $self->_full_tag_name($tname);
my $tag = $self->_create_tag($ftname, %{$TAGS{$tname}{Look}})
if $display ne $BUTTONS{$bname}{Default};
if ($s->equal($e)) {
for my $tag (@{$BUTTONS{$bname}{Tags}}) {
delete($self->{Active}{$self->_full_tag_name($tag->[0])});
}
$self->{Active}{$ftname} = undef;
$self->_set_buttons_from_active;
} else {
$self->_apply_tag_cascade($tag, $s, $e)
if $display ne $BUTTONS{$bname}{Default};
# Update subscript and superscript over this range!
# Maybe meld this into apply_tag_cascade?
if ($tname =~ /^h[1-5]\z/) {
$self->_update_superscript($s, $e, undef, $TAGS{$tname}{Look}{scale});
$self->_update_subscript($s, $e, undef, $TAGS{$tname}{Look}{scale});
} elsif ($tname eq 'h0') {
$self->_update_superscript($s, $e, undef, 1);
$self->_update_subscript($s, $e, undef, 1);
}
$self->{Active}{$ftname} = undef;
$self->_set_buttons_from_active;
}
$self->_commit_record_undo if $commit;
return 0;
}
sub _on_font_change {
my $self = shift;
my ($bname, $wid, $display, $tname) = @_;
return 0 if $self->{Lock}{Buttons};
return 0 if $self->{Buttons}{$bname}->get_inconsistant; # make no changes!
my $commit = $self->_start_record_undo;
my $buf = $self->{Text}->get_buffer;
my ($s, $e) = $self->_get_current_bounds_for_tag('font');
# Remove any current font from that range
{
my @rem;
my $tt = $buf->get_tag_table;
$tt->foreach(sub {
push @rem, $_[0] if
$self->_short_tag_name($_[0]) eq 'font';
});
for my $rem (@rem) {
$self->_remove_tag($rem, $s, $e);
}
}
my $ftname = $self->_full_tag_name('font', $tname);
my $tag = $self->_create_tag($ftname, family => $tname)
if $display ne $BUTTONS{$bname}{Default};
if ($s->equal($e)) {
for my $tag (@{$BUTTONS{$bname}{Tags}}) {
delete($self->{Active}{$self->_full_tag_name('font', $tag)});
}
} elsif ($display ne $BUTTONS{$bname}{Default}) {
$self->_apply_tag_cascade($tag, $s, $e);
}
$self->{Active}{$ftname} = undef;
$self->_set_buttons_from_active;
$self->_commit_record_undo if $commit;
return 0;
}
sub _on_size_change {
my $self = shift;
return 0 if $self->{Lock}{Buttons};
my ($name, $wid, $size) = @_;
return 0 if $size !~ /\d/ or not $size;
my $commit = $self->_start_record_undo;
my $buf = $self->{Text}->get_buffer;
my $tname = $BUTTONS{$name}{Tag};
my ($s, $e) = $self->_get_current_bounds_for_tag($tname);
my $nosel = $s->equal($e);
if (not $nosel) {
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
$self->_remove_tag_cascade($tag, $s, $e)
if $self->_short_tag_name($tag) eq $tname;
});
# Update super/subscript tags for this range!
$self->_update_subscript($s, $e, $size);
$self->_update_superscript($s, $e, $size);
}
my $tag = $self->_create_tag($self->_full_tag_name($tname, $size),
size => $size * 1024);
if ($nosel) {
for my $k (keys %{$self->{Active}}) {
delete($self->{Active}{$k})
if $self->_short_tag_name($k) eq $BUTTONS{$name}{Tag};
}
$self->{Active}{$tag->get_property('name')} = undef;
} else {
$self->_apply_tag_cascade($tag, $s, $e);
$self->_set_active_from_text;
}
$self->_set_buttons_from_active;
$self->_commit_record_undo if $commit;
return 0;
}
# Callbacks for specific buttons
sub _sup_sub_scan {
my $self = shift;
my ($s, $e, $type, $force) = @_;
my ($sz, $sc);
for my $tag ($s->get_tags) {
next if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
if ($name eq 'superscript' or $name eq 'subscript') {
$self->_remove_tag_cascade($tag, $s, $e);
next;
}
if (not defined $sz and $name eq 'size') {
($sz) = $self->_tag_args($tag, 1);
} elsif (not defined $sc and $name =~ /^h[1-5]\z/) {
$sc = $TAGS{$name}{Look}{scale};
}
}
$sz = $BUTTONS{Size}{Default} if not defined $sz;
$sc = 1 if not $sc;
my $n = $s->copy;
$n->forward_to_tag_toggle(undef);
$n = $e->copy if $n->compare($e) == 1;
$self->_apply_tag_cascade($self->_create_sub_super_tag($type, $sz, $sc),
$s, $n);
return $n;
}
sub _create_sub_super_tag {
my $self = shift;
my ($type, $size, $scale) = @_;
my $rise = ($type eq 'superscript' ? 0.75 : -0.25);
$rise = int($size * $scale * $rise * 1024);
$self->_create_tag($self->_full_tag_name($type, $size, $scale),
scale => 0.5, rise => $rise);
}
sub _superscript_on {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
my $p = $s->copy;
while (1) {
$p = $self->_sup_sub_scan($p, $e, 'superscript');
last if $p->compare($e) != -1;
}
$self->_set_active_from_text;
$self->_set_buttons_from_active;
}
sub _superscript_off {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if (not $self->_is_my_tag($tag) or
$self->_short_tag_name($tag) ne 'superscript');
$self->_remove_tag_cascade($tag, $s, $e);
});
$self->_set_active_from_text;
$self->_set_buttons_from_active;
}
sub _update_superscript {
my $self = shift;
my ($s, $e, $force_size, $force_scale) = @_;
$s = $s->copy;
my $buf = $self->{Text}->get_buffer;
while (1) {
last if $s->compare($e) != -1;
my ($size, $scale, $curr, $csize, $cscale) =
($BUTTONS{Size}{Default}, 1, undef, undef, undef);
for my $tag ($s->get_tags) {
next if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
if ($name eq 'size') {
($size) = $self->_tag_args($tag, 1);
} elsif ($name =~ /^h[1-5]\z/) {
$scale = $TAGS{$name}{Look}{scale};
} elsif ($name eq 'superscript') {
$curr = $tag;
($csize, $cscale) = $self->_tag_args($tag, 2);
}
}
$scale = 1 if not $scale;
$size = $force_size if defined $force_size;
$scale = $force_scale if defined $force_scale;
my $t = $s->copy;
$t = $e->copy if not $t->forward_to_tag_toggle(undef);
if (defined($curr) and ($csize != $size or $cscale != $scale)) {
$self->_remove_tag($curr, $s, $t);
$self->_apply_tag($self->_create_sub_super_tag('superscript',
$size, $scale), $s, $t);
}
$s = $t;
}
}
sub _subscript_on {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
my $p = $s->copy;
while (1) {
$p = $self->_sup_sub_scan($p, $e, 'subscript');
last if $p->compare($e) != -1;
}
$self->_set_active_from_text;
$self->_set_buttons_from_active;
}
sub _subscript_off {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if (not $self->_is_my_tag($tag) or
$self->_short_tag_name($tag) ne 'subscript');
$self->_remove_tag_cascade($tag, $s, $e);
});
$self->_set_active_from_text;
$self->_set_buttons_from_active;
}
sub _update_subscript {
my $self = shift;
my ($s, $e, $force_size, $force_scale) = @_;
$s = $s->copy;
my $buf = $self->{Text}->get_buffer;
while (1) {
last if $s->compare($e) != -1;
my ($size, $scale, $curr, $csize, $cscale) =
($BUTTONS{Size}{Default}, 1, undef, undef, undef);
for my $tag ($s->get_tags) {
next if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
if ($name eq 'size') {
($size) = $self->_tag_args($tag, 1);
} elsif ($name =~ /^h[1-5]\z/) {
$scale = $TAGS{$name}{Look}{scale};
} elsif ($name eq 'subscript') {
$curr = $tag;
($csize, $cscale) = $self->_tag_args($tag, 2);
}
}
$scale = 1 if not $scale;
$size = $force_size if defined $force_size;
$scale = $force_scale if defined $force_scale;
my $t = $s->copy;
$t = $e->copy if not $t->forward_to_tag_toggle(undef);
if (defined($curr) and ($csize != $size or $cscale != $scale)) {
$self->_remove_tag($curr, $s, $t);
$self->_apply_tag($self->_create_sub_super_tag('subscript',
$size, $scale), $s, $t);
}
$s = $t;
}
}
sub _indent_up {
my $self = shift;
my ($s, $e) = @_;
my ($ps, $pe) = $self->_get_current_bounds_for_tag('indent');
my $buf = $self->{Text}->get_buffer;
while (1) {
last if $ps->compare($pe) != -1;
my $curr;
for my $tag ($ps->get_tags) {
next if not $self->_is_my_tag($tag);
my ($name, $val) = $self->_tag_name_args($tag, 1);
next if $name ne 'indent';
$curr = $val;
last;
}
my $t = $ps->copy;
$ps = $pe if not $ps->forward_to_tag_toggle(undef);
if (defined($curr)) {
$self->_remove_tag($self->_full_tag_name('indent', $curr), $t, $ps);
++$curr;
} else {
$curr = 0;
}
$self->_apply_tag($self->_create_tag($self->_full_tag_name('indent',
$curr),
'left-margin' => 32 * ($curr + 1)),
$t, $ps);
}
return 0;
}
sub _indent_down {
my $self = shift;
my ($s, $e) = @_;
my ($ps, $pe) = $self->_get_current_bounds_for_tag('indent');
my $buf = $self->{Text}->get_buffer;
while (1) {
last if $ps->compare($pe) != -1;
my $curr;
for my $tag ($ps->get_tags) {
next if not $self->_is_my_tag($tag);
my ($name, $val) = $self->_tag_name_args($tag, 1);
next if $name ne 'indent';
$curr = $val;
last;
}
my $t = $ps->copy;
$ps = $pe if not $ps->forward_to_tag_toggle(undef);
next if not defined $curr;
$self->_remove_tag($self->_full_tag_name('indent', $curr), $t, $ps);
next if not $curr;
--$curr;
$self->_apply_tag($self->_create_tag($self->_full_tag_name('indent',
$curr),
'left-margin' => 32 * ($curr + 1)),
$t, $ps);
}
return 0;
}
sub _link_on {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
my $txt = $buf->get_text($s, $e, 0);
my $target = $txt;
($txt, $target) = $self->_get_link_target($txt, $target);
return 0 if not defined $txt; # What about length?!
my $tag = $self->_create_link($target);
if ($s->equal($e)) { # No selection
my $here = $buf->get_iter_at_mark($buf->get_insert);
my $s = $here->get_offset;
$buf->insert($here, $txt);
$s = $buf->get_iter_at_offset($s);
$e = $s->copy;
$e->forward_chars(length($txt));
$self->_apply_tag_cascade($tag, $s, $e);
} else {
my $off = $s->get_offset;
$buf->delete($s, $e); ## GET TAGS OVER THIS RANGE
$s = $buf->get_iter_at_offset($off);
$buf->insert($s, $txt); ## APPLY TAGS OVER THIS RANGE
$s = $buf->get_iter_at_offset($off);
$e = $s->copy;
$e->forward_chars(length($txt));
$self->_apply_tag_cascade($tag, $s, $e);
$buf->select_range($s, $e);
}
}
sub _create_link {
my $self = shift;
my ($target) = @_;
$self->{LinkID} = 0 if not exists $self->{LinkID};
my $tag = $self->_create_tag($self->_full_tag_name('link',
$self->{LinkID}++),
%{$TAGS{link}{Look}});
$tag->{Target} = $target;
return $tag;
}
sub _link_off {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
$buf->get_tag_table->foreach(sub {
my ($tag) = @_;
$self->_remove_tag_cascade($tag, $s, $e)
if ($self->_is_my_tag($tag) and
$self->_short_tag_name($tag) eq 'link');
}) if not $s->equal($e);
}
sub _get_link_target {
my $self = shift;
my ($txt, $target) = @_;
my $win = $self;
while (1) {
last if $win->isa('Gtk2::Window');
$win = $win->get_parent;
last if not defined $win;
}
my $dlg = Gtk2::Dialog->new("Insert link...", $win,
[qw(modal destroy-with-parent)]);
my $cancel = $dlg->add_button('gtk-cancel' => 'cancel');
my $ok = $dlg->add_button('gtk-ok' => 'ok');
my $tbl = Gtk2::Table->new(3, 2, 0);
my $label = Gtk2::Label->new("Define your link text and destination");
$tbl->attach($label, 0, 2, 0, 1, [qw(fill expand)], [], 4, 4);
my ($etxt, $elnk);
for my $dat ([\$etxt, 'Text:', $txt, 1],
[\$elnk, 'Link:', $target, 2]) {
my ($er, $lb, $tx, $i) = @$dat;
my $lab = Gtk2::Label->new($lb);
$tbl->attach($lab, 0, 1, $i, $i + 1, [], [qw(fill)], 4, 4);
$$er = Gtk2::Entry->new;
$$er->set_text($tx);
$$er->signal_connect(activate =>
sub {$ok->clicked if $ok->sensitive; 0});
$$er->signal_connect(changed =>
sub {
$ok->set_sensitive(length($etxt->get_text) and
length($elnk->get_text));
0;
});
$tbl->attach($$er, 1, 2, $i, $i + 1, [], [qw(fill expand)], 4, 4);
}
$ok->set_sensitive(0) if not length($txt) or not length($target);
(length($txt) ? $elnk : $etxt)->grab_focus;
$tbl->show_all;
eval {$dlg->get_content_area->add($tbl)};
$dlg->vbox->add($tbl) if $@;
$dlg->set_default_response('ok');
my $res = $dlg->run;
if ($res ne 'ok') {
$dlg->destroy;
return;
}
$txt = $etxt->get_text;
$target = $elnk->get_text;
$dlg->destroy;
return ($txt, $target);
}
sub _increase_size {
my $self = shift;
if (not $self->{Buttons}{Size}->get_inconsistant) {
$self->{Buttons}{Size}->up_value;
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
$size = $self->{Buttons}{Size}->next_value_up($size);
$self->_apply_tag($self->_create_tag($self->_full_tag_name('size', $size),
size => $size * 1024), $t, $s);
}
$self->_set_active_from_text;
$self->_set_buttons_from_active;
return 0;
}
sub _decrease_size {
my $self = shift;
if (not $self->{Buttons}{Size}->get_inconsistant) {
$self->{Buttons}{Size}->down_value;
return 0;
}
# Selection, and with differing sizes
my ($s, $e) = $self->_get_current_bounds_for_tag('size');
my $buf = $self->{Text}->get_buffer;
while (1) {
last if $s->compare($e) != -1;
my $size = $BUTTONS{Size}{Default};
for my $tag ($s->get_tags) {
next if not $self->_is_my_tag($tag);
my ($name, $val) = $self->_tag_name_args($tag, 1);
next if $name ne 'size';
$size = $val;
last;
}
my $t = $s->copy;
$s = $e if not $s->forward_to_tag_toggle(undef);
$self->_remove_tag($self->_full_tag_name('size', $size), $t, $s);
$size = $self->{Buttons}{Size}->next_value_down($size);
$self->_apply_tag($self->_create_tag($self->_full_tag_name('size', $size),
size => $size * 1024), $t, $s);
}
$self->_set_active_from_text;
$self->_set_buttons_from_active;
return 0;
}
sub _clear_font_formatting {
my $self = shift;
my ($s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
if ($s->equal($e)) {
# remove all non-paragraph tags
for my $tname (keys %{$self->{Active}}) {
my $rname = $self->_short_tag_name($tname);
next if not exists $TAGS{$rname} or $TAGS{$rname}{Class} eq 'paragraph';
delete($self->{Active}{$tname});
}
$self->_set_active_from_text if not $s->equal($buf->get_end_iter);
} else {
$buf->get_tag_table->foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
return
if (not exists $TAGS{$name} or
$TAGS{$name}{Class} eq 'paragraph');
$self->_remove_tag_cascade($tag, $s, $e);
});
$self->_set_active_from_text;
}
$self->_set_buttons_from_active;
}
# Undo and Redo
sub _start_record_undo {
my $self = shift;
return 0 if $self->{Undoing} or defined $self->{Record};
$self->{Record} = [];
return 1;
}
sub _record_undo {
my $self = shift;
return if $self->{Undoing} or not defined $self->{Record};
my ($act, $start, $end, @dat) = @_;
push @{$self->{Record}}, [$act, $start, $end, @dat];
}
sub _commit_record_undo {
my $self = shift;
return 0 if $self->{Undoing};
if (defined($self->{Record}) and scalar(@{$self->{Record}})) {
push @{$self->{UndoStack}}, $self->{Record};
my $max = $self->{Properties}{undo_stack};
shift @{$self->{UndoStack}} if ($max and
scalar(@{$self->{UndoStack}}) > $max);
$self->{RedoStack} = []; ###
}
$self->{Record} = undef;
}
sub _rollback_record_undo {
my $self = shift;
$self->{Record} = undef;
}
# Tag handling
sub _create_tag {
my $self = shift;
my ($name, %opts) = @_;
$opts{justification} = 'left'
if (exists $opts{justification} and $opts{justification} eq 'fill' and
$self->get_property('map-fill-to-left'));
my $tag = $self->{Text}->get_buffer->get_tag_table->lookup($name);
$tag = $self->{Text}->get_buffer->create_tag($name, %opts)
if not defined $tag;
$tag->{WYSIWYG} = undef; # Use this later to store data?
return $tag;
}
sub _apply_tag_cascade {
my $self = shift;
my ($tag, $start, $end) = @_;
my $buf = $self->{Text}->get_buffer;
$tag = $self->{Text}->get_buffer->get_tag_table->lookup($tag)
if not ref($tag);
return if not defined $tag;
my $regname = $self->_short_tag_name($tag);
my $tdef = $TAGS{$regname};
if ($regname eq 'asis') {
# Remove all non-paragraph tags
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
return if (not exists $TAGS{$name} or
$TAGS{$name}{Class} eq 'paragraph');
$self->_remove_tag($tag, $start, $end);
});
$self->_apply_tag($tag, $start, $end);
return 1;
}
if ($tdef->{Multi} or defined($tdef->{Group})) {
$buf->get_tag_table->
foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
$self->_remove_tag($tag, $start, $end)
if (($tdef->{Multi} and $name eq $regname) or
grep {$_ eq $name} @{$tdef->{Group}});
});
}
if ($tdef->{Class} eq 'paragraph') {
$self->_apply_tag($tag, $start, $end);
return 1;
}
# Only apply this tag to places where the asis tag is not
my $s = $start->copy;
my $aname = $self->_full_tag_name('asis');
# my $asis = $buf->get_tag_table->lookup($aname);
my $asis = $self->_create_tag($aname, %{$TAGS{asis}{Look}});
die("Gtk2::Ex::WYSIWYG tag naming conflict for $aname - " .
"tag name already in use!") if not $self->_is_my_tag($asis);
while (1) {
my $asishere = 0;
for my $tag ($s->get_tags) {
next if $tag ne $asis;
$asishere = 1;
last;
}
$s->forward_to_tag_toggle($asis) if $asishere;
return 1 if $s->compare($end) != -1;
my $e = $s->copy;
$e->forward_to_tag_toggle($asis);
$e = $end->copy if $e->compare($end) == 1;
# s to e is asis free
$self->_apply_tag($tag, $start, $end);
last if $e->equal($end);
$s = $e;
}
return 1;
}
sub _apply_tag {
my $self = shift;
my ($tag, $start, $end) = @_;
$tag = $self->{Text}->get_buffer->get_tag_table->lookup($tag)
if not ref $tag;
$self->{Text}->get_buffer->apply_tag($tag, $start, $end) if defined $tag;
}
sub _remove_tag_cascade {
my $self = shift;
my ($tag, $start, $end) = @_;
# ONLY REMOVE THE TAG FROM THE AREAS IT IS APPLIED!
my $buf = $self->{Text}->get_buffer;
$self->_remove_tag($tag, $start, $end);
$tag = $tag->get_property('name') if ref($tag);
delete($self->{Active}{$tag});
return 1;
}
sub _remove_tag {
my $self = shift;
my ($tag, $s, $e) = @_;
my $buf = $self->{Text}->get_buffer;
$tag = $buf->get_tag_table->lookup($tag) if not ref($tag);
return if not defined $tag;
my $t = $s->copy;
SEARCH: while (1) {
last if $t->compare($e) != -1;
for my $ctag ($t->get_tags) {
next if $ctag ne $tag;
my $u = $t->copy;
$t = $e->copy if (not $t->forward_to_tag_toggle($tag) or
$t->compare($e) == 1);
$buf->remove_tag($tag, $u, $t);
next SEARCH;
}
last if not $t->forward_to_tag_toggle($tag);
}
}
# Given a tag name, ensure it is a tag controlled by this package.
# Of course, if someone tries hard enough, this can be fooled
sub _is_my_tag {
my $self = shift;
my ($tag) = @_;
return 0 if not defined $tag or not exists $tag->{WYSIWYG};
return 1;
}
sub _full_tag_name {
my $self = shift;
my ($name, @args) = @_;
return $name->get_property('name') if ref($name);
my $full = "gtkwysiwyg:$name";
$full .= ":" . join(":", @args) if scalar(@args);
return $full;
}
sub _short_tag_name {
my $self = shift;
my ($tag) = @_;
$tag = $tag->get_property('name') if ref $tag;
return undef if index($tag, 'gtkwysiwyg:') != 0;
my $end = index($tag, ':', 11);
return substr($tag, 11) if $end == -1;
return substr($tag, 11, $end - 11);
}
sub _tag_args {
lib/Gtk2/Ex/WYSIWYG.pm view on Meta::CPAN
return 0;
}
sub _get_current_menu_state {
my $self = shift;
my ($bname) = @_;
for my $tdef (@{$BUTTONS{$bname}{Tags}}) {
my ($tagname, $display) = @$tdef;
next if not exists $self->{Active}{$self->_full_tag_name($tagname)};
return $display;
}
return $BUTTONS{$bname}{Default};
}
sub _get_current_font_state {
my $self = shift;
my ($bname) = @_;
for my $fname (@{$BUTTONS{$bname}{Tags}}) {
next if not exists $self->{Active}{$self->_full_tag_name('font',
$fname)};
return $fname;
}
return $BUTTONS{$bname}{Default};
}
sub _get_current_size {
my $self = shift;
my ($bname) = @_;
my $tname = $BUTTONS{$bname}{Tag};
for my $k (keys %{$self->{Active}}) {
my ($name, $size) = $self->_tag_name_args($k);
next if $name ne $tname;
return $size;
}
return $BUTTONS{$bname}{Default};
}
# Paragraph normalisation
sub _normalise_paragraph {
my $self = shift;
my ($s, $e) = @_;
my ($ps, $pe) = $self->_get_paragraph_bounds($s, $e);
my $buf = $self->{Text}->get_buffer;
my @apply;
for my $tag ($ps->get_tags) {
next if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
push @apply, $tag if (exists($TAGS{$name}) and
$TAGS{$name}{Class} eq 'paragraph');
}
$buf->get_tag_table->foreach(sub {
my ($tag) = @_;
return if not $self->_is_my_tag($tag);
my $name = $self->_short_tag_name($tag);
$self->_remove_tag($tag, $ps, $pe)
if (exists $TAGS{$name} and
$TAGS{$name}{Class} eq 'paragraph');
});
for my $tag (@apply) {
$self->_apply_tag_cascade($tag, $ps, $pe);
}
}
# Bounds fetching
sub _get_current_bounds_for_tag {
my $self = shift;
my ($tname) = @_;
if ($TAGS{$tname}{Class} eq 'paragraph') {
return $self->_get_current_paragraph_bounds;
} else {
my $buf = $self->{Text}->get_buffer;
my ($s, $e) = $buf->get_selection_bounds;
if (not defined($s)) {
$s = $buf->get_iter_at_mark($buf->get_insert);
$e = $s->copy;
}
return ($s, $e);
}
}
sub _get_current_paragraph_bounds {
my $self = shift;
my $buf = $self->{Text}->get_buffer;
my ($s, $e) = $buf->get_selection_bounds;
if (not defined($s)) {
$s = $buf->get_iter_at_mark($buf->get_insert);
$e = $s->copy;
}
return $self->_get_paragraph_bounds($s, $e);
}
sub _get_paragraph_bounds {
my $self = shift;
my ($s, $e) = @_;
my ($ps, $pe);
if ($self->_iter_in_real_paragraph($s)) {
($ps, $pe) = $self->_get_real_paragraph_bounds_for_iter($s);
} else {
($ps, $pe) = $self->_get_inter_paragraph_bounds_for_iter($s);
}
return ($ps, $pe) if ($s->equal($e) or $e->compare($pe) == -1);
if ($self->_iter_in_real_paragraph($e)) {
(my $t, $pe) = $self->_get_real_paragraph_bounds_for_iter($e);
} else {
(my $t, $pe) = $self->_get_real_paragraph_bounds_for_iter($e);
}
return ($ps, $pe);
}
sub _iter_in_real_paragraph {
## ASIS AND PRE TAGS!
## newlines inside pre/asis tags do not count as 'paragraph breakers'
## In fact, _ANYTHING_ inside pre/asis tags count as a single 'non-space'
## item
## A\n\nB -> paragraphs are A and B
## A<p>\n\n</p>B -> all one paragraph
## A\n\n<p>\n\n\n\n</p>\n\nB => paragraphs are A, <p>\n\n\n\n</p> and B
my $self = shift;
my ($i) = @_;
( run in 2.273 seconds using v1.01-cache-2.11-cpan-df04353d9ac )