| … | |
… | |
| 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-last/], |
| 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-last/], |
|
|
21 | return_type => undef, |
|
|
22 | # tag, event, content |
|
|
23 | param_types => [Glib::String, Gtk2::Gdk::Event, Glib::String], |
|
|
24 | class_closure => \&tag_event, |
|
|
25 | }, |
|
|
26 | enter_tag => { |
|
|
27 | flags => [qw/run-last/], |
|
|
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-last/], |
|
|
35 | return_type => undef, |
|
|
36 | # tag, content |
|
|
37 | param_types => [Glib::String, Glib::String], |
|
|
38 | class_closure => sub { }, |
| 16 | }, |
39 | }, |
| 17 | }; |
40 | }; |
| 18 | |
41 | |
|
|
42 | sub new { |
|
|
43 | my ($self, %arg) = @_; |
|
|
44 | |
|
|
45 | $self = $self->Glib::Object::new; |
|
|
46 | $self->{$_} = delete $arg{$_} for keys %arg; |
|
|
47 | |
|
|
48 | $self; |
|
|
49 | } |
|
|
50 | |
| 19 | sub INIT_INSTANCE { |
51 | sub INIT_INSTANCE { |
| 20 | my $self = shift; |
52 | my $self = shift; |
| 21 | |
53 | |
| 22 | my $tagtable = new Gtk2::TextTagTable; |
54 | my $tagtable = new Gtk2::TextTagTable; |
| 23 | |
55 | |
| 24 | { |
56 | { |
| 25 | my @tags = ( |
57 | my @tags = ( |
| 26 | [default => { foreground => "black" }], |
58 | [default => { foreground => "black", wrap_mode => "word-char" }], |
| 27 | [node => { foreground => "#0000b0", event => 1 }], |
59 | [node => { foreground => "#0000b0", event => 1 }], |
| 28 | [move => { foreground => "#0000b0", event => 1 }], |
60 | [move => { foreground => "#0000b0", event => 1 }], |
| 29 | [user => { foreground => "#0000b0", wrap_mode => "none", event => 1 }], |
61 | [user => { foreground => "#0000b0", event => 1 }], |
| 30 | [coord => { foreground => "#0000b0", event => 1 }], |
62 | [coord => { foreground => "#0000b0", event => 1 }], |
| 31 | [score => { foreground => "#0000b0", event => 1 }], |
63 | [score => { foreground => "#0000b0", event => 1 }], |
| 32 | [error => { foreground => "#ff0000", event => 1 }], |
64 | [error => { foreground => "#ff0000", event => 1 }], |
| 33 | [leader => { weight => 800 }], |
65 | [leader => { weight => 800, pixels_above_lines => 6 }], |
| 34 | [header => { weight => 800, pixels_above_lines => 6 }], |
66 | [header => { weight => 800, pixels_above_lines => 6 }], |
| 35 | [undo => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }], |
67 | [undo => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }], |
| 36 | [challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }], |
68 | [challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }], |
| 37 | [description => { weight => 800, foreground => "blue" }], |
69 | [description => { weight => 800, foreground => "blue" }], |
| 38 | [infoblock => { weight => 700, foreground => "blue" }], |
70 | [infoblock => { weight => 700, foreground => "blue" }], |
| … | |
… | |
| 40 | |
72 | |
| 41 | for (@tags) { |
73 | for (@tags) { |
| 42 | my ($k, $v) = @$_; |
74 | my ($k, $v) = @$_; |
| 43 | my $tag = new Gtk2::TextTag $k; |
75 | my $tag = new Gtk2::TextTag $k; |
| 44 | if (delete $v->{event}) { |
76 | if (delete $v->{event}) { |
|
|
77 | $tag->signal_connect (event => sub { |
|
|
78 | my ($tag, $view, $event, $iter) = @_; |
|
|
79 | |
|
|
80 | return 0 if $event->type eq "motion-notify"; |
| 45 | ### |
81 | |
|
|
82 | my ($a, $b) = ($iter, $iter->copy); |
|
|
83 | $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag); |
|
|
84 | $b->forward_to_tag_toggle ($tag) unless $b->ends_tag ($tag); |
|
|
85 | |
|
|
86 | $self->signal_emit (tag_event => $k, $event, $a->get_text ($b)); |
|
|
87 | |
|
|
88 | 1; |
|
|
89 | }); |
| 46 | } |
90 | } |
| 47 | $tag->set (%$v); |
91 | $tag->set (%$v); |
| 48 | $tagtable->add ($tag); |
92 | $tagtable->add ($tag); |
| 49 | } |
93 | } |
| 50 | } |
94 | } |
| … | |
… | |
| 57 | }); |
101 | }); |
| 58 | |
102 | |
| 59 | $self->{buffer} = new Gtk2::TextBuffer $self->{tagtable}; |
103 | $self->{buffer} = new Gtk2::TextBuffer $self->{tagtable}; |
| 60 | |
104 | |
| 61 | $self->{widget} = new Gtk2::ScrolledWindow; |
105 | $self->{widget} = new Gtk2::ScrolledWindow; |
| 62 | $self->{widget}->set_policy("never", "always"); |
106 | $self->{widget}->set_policy ("automatic", "always"); |
| 63 | $self->pack_start ($self->{widget}, 1, 1, 0); |
107 | $self->pack_start ($self->{widget}, 1, 1, 0); |
| 64 | |
108 | |
| 65 | $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer}); |
109 | $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer}); |
| 66 | $self->{view}->set_wrap_mode ("word-char"); |
|
|
| 67 | $self->{view}->set_cursor_visible (0); |
|
|
| 68 | |
|
|
| 69 | $self->{view}->set_editable (0); |
110 | $self->{view}->set ( |
|
|
111 | wrap_mode => "word-char", |
|
|
112 | cursor_visible => 0, |
|
|
113 | editable => 0, |
|
|
114 | tabs => |
|
|
115 | (new Gtk2::Pango::TabArray 1, 0, left => 125000), # arbitrary... pango is underfeatured |
|
|
116 | ); |
| 70 | |
117 | |
| 71 | $self->{view}->signal_connect (motion_notify_event => sub { |
118 | $self->{view}->signal_connect (motion_notify_event => sub { |
| 72 | my ($widget, $event) = @_; |
119 | my ($widget, $event) = @_; |
| 73 | |
120 | |
| 74 | my $window = $widget->get_window ("text"); |
121 | my $window = $widget->get_window ("text"); |
| 75 | if ($event->window == $window) { |
122 | if ($event->window == $window) { |
| 76 | my ($win, $x, $y, $mask) = $window->get_pointer; |
123 | my ($win, $x, $y, $mask) = $window->get_pointer; |
| 77 | # warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n"; |
124 | ($x, $y) = $self->{view}->window_to_buffer_coords ("text", $x, $y); |
| 78 | #gtk_text_view_window_to_buffer_coords (text_view, |
125 | my ($iter) = $self->{view}->get_iter_at_location ($x, $y); |
| 79 | # GTK_TEXT_WINDOW_TEXT, |
126 | |
| 80 | # text_view->drag_start_x, |
127 | my $tag = ($iter->get_tags)[01]; |
| 81 | # text_view->drag_start_y, |
128 | |
| 82 | # &buffer_x, |
129 | if ($tag) { |
| 83 | # &buffer_y); |
130 | my ($a, $b) = ($iter, $iter->copy); |
| 84 | # |
131 | $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag); |
| 85 | # gtk_text_layout_get_iter_at_pixel (text_view->layout, |
132 | $b->forward_to_tag_toggle ($tag) unless $b->ends_tag ($tag); |
| 86 | # &iter, |
133 | |
| 87 | # buffer_x, buffer_y); |
134 | $self->tag_enterleave ($tag->get ("name"), $a->get_text ($b)); |
| 88 | # |
135 | } else { |
| 89 | # gtk_text_view_start_selection_dnd (text_view, &iter, event); |
136 | $self->tag_enterleave (); |
| 90 | # return TRUE; |
137 | } |
|
|
138 | |
|
|
139 | 1; |
| 91 | } |
140 | } |
| 92 | 0; |
141 | 0; |
| 93 | }); |
142 | }); |
|
|
143 | |
|
|
144 | $self->{view}->signal_connect (leave_notify_event => sub { |
|
|
145 | $self->tag_enterleave (); |
|
|
146 | 0; |
|
|
147 | }); |
|
|
148 | |
|
|
149 | $self->{view}->add_events (qw(leave_notify_mask)); |
| 94 | |
150 | |
| 95 | $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0); |
151 | $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0); |
| 96 | |
152 | |
| 97 | $self->{entry}->signal_connect (activate => sub { |
153 | $self->{entry}->signal_connect (activate => sub { |
| 98 | my ($entry) = @_; |
154 | my ($entry) = @_; |
| … | |
… | |
| 114 | $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug |
170 | $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug |
| 115 | |
171 | |
| 116 | $self->set_end; |
172 | $self->set_end; |
| 117 | } |
173 | } |
| 118 | |
174 | |
| 119 | sub do_command { |
175 | sub tag_enterleave { |
| 120 | my ($self, $cmd, $arg, %arg) = @_; |
176 | my ($self, $tag, $content) = @_; |
|
|
177 | |
|
|
178 | my $cur = $self->{current_tag}; |
|
|
179 | |
|
|
180 | if ($cur->[0] != $tag || $cur->[1] ne $content) { |
|
|
181 | $self->signal_emit (leave_tag => @$cur) if $cur->[0]; |
|
|
182 | $self->{current_tag} = $cur = [$tag, $content]; |
|
|
183 | $self->signal_emit (enter_tag => @$cur) if $cur->[0]; |
|
|
184 | } |
|
|
185 | } |
|
|
186 | |
|
|
187 | sub tag_event { |
|
|
188 | my ($self, $tag, $event, $content) = @_; |
|
|
189 | |
|
|
190 | return unless $self->{app}; |
|
|
191 | |
|
|
192 | if ($tag eq "user" && $event->type eq "button-release") { |
|
|
193 | if ($event->button == 1) { |
|
|
194 | $content =~ /^([^\x20\xa0]+)/ or return; |
|
|
195 | $self->{app}->open_user (name => $1); |
|
|
196 | } |
|
|
197 | } |
| 121 | } |
198 | } |
| 122 | |
199 | |
| 123 | sub set_end { |
200 | sub set_end { |
| 124 | my ($self) = @_; |
201 | my ($self) = @_; |
| 125 | |
202 | |
| … | |
… | |
| 266 | |
343 | |
| 267 | $widget->show_all; |
344 | $widget->show_all; |
| 268 | |
345 | |
| 269 | my $anchor = $self->{buffer}->create_child_anchor ($self->riter); |
346 | my $anchor = $self->{buffer}->create_child_anchor ($self->riter); |
| 270 | $self->{parent}{view}->add_child_at_anchor ($widget, $anchor); |
347 | $self->{parent}{view}->add_child_at_anchor ($widget, $anchor); |
|
|
348 | |
|
|
349 | $widget; |
| 271 | } |
350 | } |
| 272 | |
351 | |
| 273 | sub append_optionmenu { |
352 | sub append_optionmenu { |
| 274 | my ($self, $ref, @entry) = @_; |
353 | my ($self, $ref, @entry) = @_; |
| 275 | |
354 | |
| 276 | my @vals; |
355 | $self->append_widget (gtk::optionmenu $ref, @entry); |
| 277 | |
|
|
| 278 | my $widget = new Gtk2::OptionMenu; |
|
|
| 279 | $widget->set (menu => my $menu = new Gtk2::Menu); |
|
|
| 280 | |
|
|
| 281 | my $idx = 0; |
|
|
| 282 | |
|
|
| 283 | while (@entry >= 2) { |
|
|
| 284 | my $value = shift @entry; |
|
|
| 285 | my $label = shift @entry; |
|
|
| 286 | |
|
|
| 287 | $menu->append (new Gtk2::MenuItem $label); |
|
|
| 288 | push @vals, $value; |
|
|
| 289 | |
|
|
| 290 | if ($value eq $$ref && $idx >= 0) { |
|
|
| 291 | $widget->set_history ($idx); |
|
|
| 292 | $idx = -1e6; |
|
|
| 293 | } |
|
|
| 294 | $idx++; |
|
|
| 295 | } |
|
|
| 296 | |
|
|
| 297 | my $cb = shift @entry; |
|
|
| 298 | |
|
|
| 299 | $widget->signal_connect (changed => sub { |
|
|
| 300 | my $new = $vals[$_[0]->get_history]; |
|
|
| 301 | |
|
|
| 302 | if ($new ne $$ref) { |
|
|
| 303 | $$ref = $new; |
|
|
| 304 | $cb->($new) if $cb; |
|
|
| 305 | } |
|
|
| 306 | }); |
|
|
| 307 | |
|
|
| 308 | $self->append_widget ($widget); |
|
|
| 309 | |
|
|
| 310 | $widget; |
|
|
| 311 | } |
|
|
| 312 | |
|
|
| 313 | sub append_entry { |
|
|
| 314 | my ($self, $ref, $width, $cb) = @_; |
|
|
| 315 | |
|
|
| 316 | my $widget = new Gtk2::Entry; |
|
|
| 317 | $widget->set (text => $$ref, width_chars => $width); |
|
|
| 318 | eval { $widget->set (xalign => 1) }; # workaround für 2.2 |
|
|
| 319 | $widget->signal_connect (changed => sub { |
|
|
| 320 | $$ref = $_[0]->get_text; |
|
|
| 321 | $cb->($$ref) if $cb; |
|
|
| 322 | }); |
|
|
| 323 | |
|
|
| 324 | $self->append_widget ($widget); |
|
|
| 325 | $widget; |
|
|
| 326 | } |
356 | } |
| 327 | |
357 | |
| 328 | sub append_button { |
358 | sub append_button { |
| 329 | my ($self, $label, $cb) = @_; |
359 | my ($self, $label, $cb) = @_; |
| 330 | |
360 | |
| 331 | my $widget = new_with_label Gtk2::Button $label; |
361 | $self->append_widget (gtk::button $label, $cb); |
| 332 | $widget->signal_connect (clicked => sub { $cb->() if $cb }); |
|
|
| 333 | |
|
|
| 334 | $self->append_widget ($widget); |
|
|
| 335 | $widget; |
|
|
| 336 | } |
362 | } |
| 337 | |
363 | |
| 338 | sub visible { $_[0]{visible} } |
364 | sub visible { $_[0]{visible} } |
| 339 | |
365 | |
| 340 | sub set_visible { |
366 | sub set_visible { |
