ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/superchat.pl
Revision: 1.2
Committed: Fri May 21 03:18:15 2004 UTC (20 years ago) by pcg
Content type: text/plain
Branch: MAIN
Changes since 1.1: +130 -29 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 package superchat;
2
3 # waaay cool widget. well... maybe at one point in the future
4
5 use Gtk2;
6
7 use Glib::Object::Subclass
8 Gtk2::VBox,
9 signals => {
10 command => {
11 flags => [qw/run-first/],
12 return_type => undef, # void return
13 param_types => [Glib::Scalar, Glib::Scalar],
14 },
15 };
16
17 sub INIT_INSTANCE {
18 my $self = shift;
19
20 my $tagtable = new Gtk2::TextTagTable;
21
22 {
23 my @tags = (
24 [default => { foreground => "black" }],
25 [node => { foreground => "#0000b0", event => 1 }],
26 [move => { foreground => "#0000b0", event => 1 }],
27 [user => { foreground => "#0000b0", event => 1 }],
28 [coord => { foreground => "#0000b0", event => 1 }],
29 [error => { foreground => "#ff0000", event => 1 }],
30 [header => { weight => 800, pixels_above_lines => 6 }],
31 [challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
32 [description => { weight => 800, foreground => "blue" }],
33 [infoblock => { weight => 700, foreground => "blue" }],
34 );
35
36 for (@tags) {
37 my ($k, $v) = @$_;
38 my $tag = new Gtk2::TextTag $k;
39 if (delete $v->{event}) {
40 ###
41 }
42 $tag->set (%$v);
43 $tagtable->add ($tag);
44 }
45 }
46
47 $self->{tagtable} = $tagtable;
48
49 $self->signal_connect (destroy => sub {
50 remove Glib::Source delete $self->{idle} if $self->{idle};
51 %{$_[0]} = ();
52 });
53
54 $self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};
55
56 $self->{widget} = new Gtk2::ScrolledWindow;
57 $self->{widget}->set_policy("never", "always");
58 $self->pack_start ($self->{widget}, 1, 1, 0);
59
60 $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
61 $self->{view}->set_wrap_mode ("word");
62 $self->{view}->set_cursor_visible (0);
63
64 $self->{view}->set_editable (0);
65
66 $self->{view}->signal_connect (motion_notify_event => sub {
67 my ($widget, $event) = @_;
68
69 my $window = $widget->get_window ("text");
70 if ($event->window == $window) {
71 my ($win, $x, $y, $mask) = $window->get_pointer;
72 # warn "TAG EVENT @_ ($window, $win, $x, $y, $mask)\n";
73 #gtk_text_view_window_to_buffer_coords (text_view,
74 # GTK_TEXT_WINDOW_TEXT,
75 # text_view->drag_start_x,
76 # text_view->drag_start_y,
77 # &buffer_x,
78 # &buffer_y);
79 #
80 # gtk_text_layout_get_iter_at_pixel (text_view->layout,
81 # &iter,
82 # buffer_x, buffer_y);
83 #
84 # gtk_text_view_start_selection_dnd (text_view, &iter, event);
85 # return TRUE;
86 }
87 0;
88 });
89
90 $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);
91
92 $self->{entry}->signal_connect (activate => sub {
93 my ($entry) = @_;
94 my $text = $entry->get_text;
95 $entry->set_text("");
96
97 my ($cmd, $arg);
98
99 if ($text =~ /^\/(\S+)\s*(.*)$/) {
100 ($cmd, $arg) = ($1, $2);
101 } else {
102 ($cmd, $arg) = ("say", $text);
103 }
104
105 $self->signal_emit (command => $cmd, $arg);
106 });
107
108 $self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);
109
110 $self->set_end;
111 }
112
113 sub do_command {
114 my ($self, $cmd, $arg, %arg) = @_;
115 }
116
117 sub set_end {
118 my ($self) = @_;
119
120 # this is probably also a hack...
121 $self->{idle} ||= add Glib::Idle sub {
122 $self->{view}->scroll_to_iter ($self->{buffer}->get_end_iter, 0, 0, 0, 0)
123 if $self->{view};
124 delete $self->{idle};
125 };
126 }
127
128 sub at_end {
129 my ($self) = @_;
130
131 # this is, maybe, a bad hack :/
132 my $adj = $self->{widget}->get_vadjustment;
133 $adj->value + $adj->page_size >= $adj->upper - 0.5;
134 }
135
136 sub append_text {
137 my ($self, $text) = @_;
138
139 my $at_end = $self->at_end;
140 $self->_append_text ($self->{end}, $text);
141 $self->set_end if $at_end;
142 }
143
144 sub _append_text {
145 my ($self, $mark, $text) = @_;
146
147 $text = "<default>$text</default>";
148
149 my @tag;
150 # pseudo-simplistic-xml-parser
151 for (;;) {
152 $text =~ /\G<([^>]+)>/gc or last;
153 my $tag = $1;
154 if ($tag =~ s/^\///) {
155 pop @tag;
156 } else {
157 push @tag, $tag;
158 }
159
160 $text =~ /\G([^<]*)/gc or last;
161 $self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
162 if length $1;
163 }
164 }
165
166 sub set_text {
167 my ($self, $text) = @_;
168
169 my $at_end = $self->at_end;
170
171 $self->{buffer}->set_text ("");
172 $self->append_text ($text);
173
174 $self->set_end if $at_end;
175 }
176
177 sub new_eventtag {
178 my ($self, $cb) = @_;
179
180 my $tag = new Gtk2::TextTag;
181 $tag->signal_connect (event => $cb);
182 $self->{tagtable}->add ($tag);
183
184 $tag
185 }
186
187 # create a new "subbuffer"
188 sub new_inlay {
189 my ($self) = @_;
190
191 my $end = $self->{buffer}->get_end_iter;
192
193 my $self = bless {
194 buffer => $self->{buffer},
195 parent => $self,
196 }, superchat::inlay;
197
198 $self->{l} = $self->{buffer}->create_mark (undef, $end, 1);
199 $self->{buffer}->insert ($end, "\x{200d}");
200 $self->{r} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);
201
202 Scalar::Util::weaken $self->{buffer};
203 Scalar::Util::weaken $self->{parent};
204 $self;
205 }
206
207 sub new_switchable_inlay {
208 my ($self, $header, $cb, $visible) = @_;
209
210 my $inlay;
211
212 my $setvisible = sub {
213 if ($inlay->{visible}) {
214 $inlay->{cb}->($inlay);
215 } else {
216 $inlay->clear;
217 }
218 };
219
220 my $tag = $self->new_eventtag (sub {
221 my ($tag, $view, $event, $iter) = @_;
222
223 if ($event->type eq "button-press") {
224 $inlay->{visible} = !$inlay->{visible};
225 $setvisible->();
226 }
227
228 1;
229 });
230
231 $tag->set (background => "#e0e0ff");
232
233 $self->{buffer}->insert ($self->{buffer}->get_end_iter, "\n");
234 $self->{buffer}->insert_with_tags ($self->{buffer}->get_end_iter, util::xmlto "$header \x{21f3}", $tag);
235
236 $inlay = $self->new_inlay;
237
238 $inlay->{visible} = $visible;
239 $inlay->{tag} = $tag;
240 $inlay->{cb} = $cb;
241
242 $setvisible->();
243
244 $inlay;
245 }
246
247 package superchat::inlay;
248
249 sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
250 sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }
251
252 sub clear {
253 my ($self) = @_;
254 $self->{buffer}->delete ($self->liter, $self->riter);
255 }
256
257 sub append_text {
258 my ($self, $text) = @_;
259
260 $self->{parent}->_append_text ($self->{r}, $text);
261 }
262
263 sub DESTROY {
264 my ($self) = @_;
265
266 $self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag};
267 }
268
269 1;
270