| … | |
… | |
| 3 | package chat; |
3 | package chat; |
| 4 | |
4 | |
| 5 | # waaay cool widget. well... maybe at one point in the future |
5 | # waaay cool widget. well... maybe at one point in the future |
| 6 | |
6 | |
| 7 | use Gtk2; |
7 | use Gtk2; |
|
|
8 | use Gtk2::Pango; |
| 8 | |
9 | |
| 9 | use Glib::Object::Subclass |
10 | use Glib::Object::Subclass |
| 10 | Gtk2::VBox, |
11 | Gtk2::VBox, |
| 11 | signals => { |
12 | signals => { |
| 12 | command => { |
13 | command => { |
| 13 | flags => [qw/run-first/], |
14 | flags => [qw/run-first/], |
| 14 | return_type => undef, # void return |
15 | return_type => undef, |
| 15 | param_types => [Glib::Scalar, Glib::Scalar], |
16 | param_types => [Glib::Scalar, Glib::Scalar], |
|
|
17 | class_closure => sub { }, |
|
|
18 | }, |
|
|
19 | tag_event => { |
|
|
20 | flags => [qw/run-first/], |
|
|
21 | return_type => undef, |
|
|
22 | # tag, event, content |
|
|
23 | param_types => [Glib::String, Gtk2::Gdk::Event, Glib::String], |
|
|
24 | class_closure => sub { }, |
|
|
25 | }, |
|
|
26 | enter_tag => { |
|
|
27 | flags => [qw/run-first/], |
|
|
28 | return_type => undef, |
|
|
29 | # tag, content |
|
|
30 | param_types => [Glib::String, Glib::String], |
|
|
31 | class_closure => sub { }, |
|
|
32 | }, |
|
|
33 | leave_tag => { |
|
|
34 | flags => [qw/run-first/], |
|
|
35 | return_type => undef, |
|
|
36 | # tag |
|
|
37 | param_types => [Glib::String, Glib::String], |
|
|
38 | class_closure => sub { }, |
| 16 | }, |
39 | }, |
| 17 | }; |
40 | }; |
| 18 | |
41 | |
| 19 | sub INIT_INSTANCE { |
42 | sub INIT_INSTANCE { |
| 20 | my $self = shift; |
43 | my $self = shift; |
| 21 | |
44 | |
| 22 | my $tagtable = new Gtk2::TextTagTable; |
45 | my $tagtable = new Gtk2::TextTagTable; |
| 23 | |
46 | |
| 24 | { |
47 | { |
| 25 | my @tags = ( |
48 | my @tags = ( |
| 26 | [default => { foreground => "black" }], |
49 | [default => { foreground => "black", wrap_mode => "word-char" }], |
| 27 | [node => { foreground => "#0000b0", event => 1 }], |
50 | [node => { foreground => "#0000b0", event => 1 }], |
| 28 | [move => { foreground => "#0000b0", event => 1 }], |
51 | [move => { foreground => "#0000b0", event => 1 }], |
| 29 | #[user => { foreground => "#0000b0", wrap_mode => "none", event => 1 }], |
|
|
| 30 | [user => { foreground => "#0000b0", event => 1 }], |
52 | [user => { foreground => "#0000b0", event => 1 }], |
| 31 | [coord => { foreground => "#0000b0", event => 1 }], |
53 | [coord => { foreground => "#0000b0", event => 1 }], |
| 32 | [score => { foreground => "#0000b0", event => 1 }], |
54 | [score => { foreground => "#0000b0", event => 1 }], |
| 33 | [error => { foreground => "#ff0000", event => 1 }], |
55 | [error => { foreground => "#ff0000", event => 1 }], |
| 34 | [leader => { weight => 800, pixels_above_lines => 6 }], |
56 | [leader => { weight => 800, pixels_above_lines => 6 }], |
| … | |
… | |
| 41 | |
63 | |
| 42 | for (@tags) { |
64 | for (@tags) { |
| 43 | my ($k, $v) = @$_; |
65 | my ($k, $v) = @$_; |
| 44 | my $tag = new Gtk2::TextTag $k; |
66 | my $tag = new Gtk2::TextTag $k; |
| 45 | if (delete $v->{event}) { |
67 | if (delete $v->{event}) { |
|
|
68 | $tag->signal_connect (event => sub { |
|
|
69 | my ($tag, $view, $event, $iter) = @_; |
|
|
70 | my ($a, $b) = ($iter, $iter->copy); |
|
|
71 | $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag); |
|
|
72 | $b->forward_to_tag_toggle ($tag) unless $b->ends_tag ($tag); |
|
|
73 | |
|
|
74 | $self->signal_emit (tag_event => $k, $event, $a->get_text ($b)); |
| 46 | ### |
75 | }); |
| 47 | } |
76 | } |
| 48 | $tag->set (%$v); |
77 | $tag->set (%$v); |
| 49 | $tagtable->add ($tag); |
78 | $tagtable->add ($tag); |
| 50 | } |
79 | } |
| 51 | } |
80 | } |
| … | |
… | |
| 62 | $self->{widget} = new Gtk2::ScrolledWindow; |
91 | $self->{widget} = new Gtk2::ScrolledWindow; |
| 63 | $self->{widget}->set_policy ("automatic", "always"); |
92 | $self->{widget}->set_policy ("automatic", "always"); |
| 64 | $self->pack_start ($self->{widget}, 1, 1, 0); |
93 | $self->pack_start ($self->{widget}, 1, 1, 0); |
| 65 | |
94 | |
| 66 | $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer}); |
95 | $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer}); |
| 67 | $self->{view}->set_wrap_mode ("word-char"); |
|
|
| 68 | $self->{view}->set_cursor_visible (0); |
|
|
| 69 | |
|
|
| 70 | $self->{view}->set_editable (0); |
96 | $self->{view}->set ( |
|
|
97 | wrap_mode => "word-char", |
|
|
98 | cursor_visible => 0, |
|
|
99 | editable => 0, |
|
|
100 | tabs => |
|
|
101 | (new Gtk2::Pango::TabArray 1, 0, left => 125000), # arbitrary... pango is underfeatured |
|
|
102 | ); |
| 71 | |
103 | |
| 72 | $self->{view}->signal_connect (motion_notify_event => sub { |
104 | $self->{view}->signal_connect (motion_notify_event => sub { |
| 73 | my ($widget, $event) = @_; |
105 | my ($widget, $event) = @_; |
| 74 | |
106 | |
| 75 | my $window = $widget->get_window ("text"); |
107 | my $window = $widget->get_window ("text"); |
| 76 | if ($event->window == $window) { |
108 | if ($event->window == $window) { |
| 77 | my ($win, $x, $y, $mask) = $window->get_pointer; |
109 | my ($win, $x, $y, $mask) = $window->get_pointer; |
| 78 | # warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n"; |
110 | ($x, $y) = $self->{view}->window_to_buffer_coords ("text", $x, $y); |
| 79 | #gtk_text_view_window_to_buffer_coords (text_view, |
111 | my ($iter) = $self->{view}->get_iter_at_location ($x, $y); |
| 80 | # GTK_TEXT_WINDOW_TEXT, |
112 | |
| 81 | # text_view->drag_start_x, |
113 | my $tag = ($iter->get_tags)[01]; |
| 82 | # text_view->drag_start_y, |
114 | |
| 83 | # &buffer_x, |
115 | if ($tag) { |
| 84 | # &buffer_y); |
116 | my ($a, $b) = ($iter, $iter->copy); |
| 85 | # |
117 | $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag); |
| 86 | # gtk_text_layout_get_iter_at_pixel (text_view->layout, |
118 | $b->forward_to_tag_toggle ($tag) unless $b->ends_tag ($tag); |
| 87 | # &iter, |
119 | |
| 88 | # buffer_x, buffer_y); |
120 | $self->tag_enterleave ($tag->get ("name"), $a->get_text ($b)); |
| 89 | # |
121 | } else { |
| 90 | # gtk_text_view_start_selection_dnd (text_view, &iter, event); |
122 | $self->tag_enterleave (); |
| 91 | # return TRUE; |
123 | } |
|
|
124 | |
|
|
125 | 1; |
| 92 | } |
126 | } |
| 93 | 0; |
127 | 0; |
| 94 | }); |
128 | }); |
|
|
129 | |
|
|
130 | $self->{view}->signal_connect (leave_notify_event => sub { |
|
|
131 | $self->tag_enterleave (); |
|
|
132 | 0; |
|
|
133 | }); |
|
|
134 | |
|
|
135 | $self->{view}->add_events (qw(leave_notify_mask)); |
| 95 | |
136 | |
| 96 | $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0); |
137 | $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0); |
| 97 | |
138 | |
| 98 | $self->{entry}->signal_connect (activate => sub { |
139 | $self->{entry}->signal_connect (activate => sub { |
| 99 | my ($entry) = @_; |
140 | my ($entry) = @_; |
| … | |
… | |
| 115 | $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug |
156 | $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug |
| 116 | |
157 | |
| 117 | $self->set_end; |
158 | $self->set_end; |
| 118 | } |
159 | } |
| 119 | |
160 | |
| 120 | sub do_command { |
161 | sub tag_enterleave { |
| 121 | my ($self, $cmd, $arg, %arg) = @_; |
162 | my ($self, $tag, $content) = @_; |
|
|
163 | |
|
|
164 | my $cur = $self->{current_tag}; |
|
|
165 | |
|
|
166 | if ($cur->[0] != $tag || $cur->[1] ne $content) { |
|
|
167 | $self->signal_emit (leave_tag => @$cur) if $cur->[0]; |
|
|
168 | $self->{current_tag} = $cur = [$tag, $content]; |
|
|
169 | $self->signal_emit (enter_tag => @$cur) if $cur->[0]; |
|
|
170 | } |
| 122 | } |
171 | } |
| 123 | |
172 | |
| 124 | sub set_end { |
173 | sub set_end { |
| 125 | my ($self) = @_; |
174 | my ($self) = @_; |
| 126 | |
175 | |
