kgsueme/kgsueme/chat.pl

use utf8;

package chat;

# waaay cool widget. well... maybe at one point in the future

use Gtk2;
use Gtk2::Pango;

use Glib::Object::Subclass
   Gtk2::VBox,
   signals => {
      command => {
         flags         => [qw/run-last/],
         return_type   => undef,
         param_types   => [Glib::Scalar, Glib::Scalar],
         class_closure => sub { },
      },
      tag_event => {
         flags         => [qw/run-last/],
         return_type   => undef,
                          # tag, event, content
         param_types   => [Glib::String, Gtk2::Gdk::Event, Glib::String],
         class_closure => \&tag_event,
      },
      enter_tag => {
         flags         => [qw/run-last/],
         return_type   => undef,
                          # tag, content
         param_types   => [Glib::String, Glib::String],
         class_closure => sub { },
      },
      leave_tag => {
         flags         => [qw/run-last/],
         return_type   => undef,
                          # tag, content
         param_types   => [Glib::String, Glib::String],
         class_closure => sub { },
      },
   };

sub new {
   my ($self, %arg) = @_;

   $self = $self->Glib::Object::new;
   $self->{$_} = delete $arg{$_} for keys %arg;

   $self;
}

sub INIT_INSTANCE {
   my $self = shift;

   my $tagtable = new Gtk2::TextTagTable;

   {
      my @tags = (
         [default     => { foreground => "black", wrap_mode => "word-char" }],
         [node        => { foreground => "#0000b0", event => 1 }],
         [move        => { foreground => "#0000b0", event => 1 }],
         [user        => { foreground => "#0000b0", event => 1 }],
         [coord       => { foreground => "#0000b0", event => 1 }],
         [score       => { foreground => "#0000b0", event => 1 }],
         [error       => { foreground => "#ff0000", event => 1 }],
         [leader      => { weight => 800, pixels_above_lines => 6 }],
         [header      => { weight => 800, pixels_above_lines => 6 }],
         [undo        => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }],
         [challenge   => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
         [description => { weight => 800, foreground => "blue" }],
         [infoblock   => { weight => 700, foreground => "blue" }],
      );

      for (@tags) {
         my ($k, $v) = @$_;
         my $tag = new Gtk2::TextTag $k;
         if (delete $v->{event}) {
            $tag->signal_connect (event => sub {
               my ($tag, $view, $event, $iter) = @_;

               return 0 if $event->type eq "motion-notify";
               
               my ($a, $b) = ($iter, $iter->copy);
               $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag);
               $b->forward_to_tag_toggle  ($tag) unless $b->ends_tag   ($tag);

               $self->signal_emit (tag_event => $k, $event, $a->get_text ($b));

               1;
            });
         }
         $tag->set (%$v);
         $tagtable->add ($tag);
      }
   }

   $self->{tagtable} = $tagtable;

   $self->signal_connect (destroy => sub {
      remove Glib::Source delete $self->{idle} if $self->{idle};
      %{$_[0]} = ();
   });

   $self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};

   $self->{widget} = new Gtk2::ScrolledWindow;
   $self->{widget}->set_policy ("automatic", "always");
   $self->pack_start ($self->{widget}, 1, 1, 0);

   $self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
   $self->{view}->set (
         wrap_mode      => "word-char",
         cursor_visible => 0,
         editable       => 0,
         tabs           =>
            (new Gtk2::Pango::TabArray 1, 0, left => 125000), # arbitrary... pango is underfeatured
   );

   $self->{view}->signal_connect (motion_notify_event => sub {
      my ($widget, $event) = @_;

      my $window = $widget->get_window ("text");
      if ($event->window == $window) {
         my ($win, $x, $y, $mask) = $window->get_pointer;
         ($x, $y) = $self->{view}->window_to_buffer_coords ("text", $x, $y);
         my ($iter) = $self->{view}->get_iter_at_location ($x, $y);

         my $tag = ($iter->get_tags)[01];
         
         if ($tag) {
            my ($a, $b) = ($iter, $iter->copy);
            $a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag);
            $b->forward_to_tag_toggle  ($tag) unless $b->ends_tag   ($tag);

            $self->tag_enterleave ($tag->get ("name"), $a->get_text ($b));
         } else {
            $self->tag_enterleave ();
         }

         1;
      }
      0;
   });

   $self->{view}->signal_connect (leave_notify_event => sub {
      $self->tag_enterleave ();
      0;
   });

   $self->{view}->add_events (qw(leave_notify_mask));

   $self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);

   $self->{entry}->signal_connect (activate => sub {
      my ($entry) = @_;
      my $text = $entry->get_text;
      $entry->set_text("");

      my ($cmd, $arg);

      if ($text =~ /^\/(\S+)\s*(.*)$/) {
         ($cmd, $arg) = ($1, $2);
      } else {
         ($cmd, $arg) = ("say", $text);
      }

      $self->signal_emit (command => $cmd, $arg);
   });

   #$self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);#d##todo# use this one for gtk-1.050+
   $self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug

   $self->set_end;
}

sub tag_enterleave {
   my ($self, $tag, $content) = @_;

   my $cur = $self->{current_tag};

   if ($cur->[0] != $tag || $cur->[1] ne $content) {
      $self->signal_emit (leave_tag => @$cur) if $cur->[0];
      $self->{current_tag} = $cur = [$tag, $content];
      $self->signal_emit (enter_tag => @$cur) if $cur->[0];
   }
}

sub tag_event {
   my ($self, $tag, $event, $content) = @_;

   return unless $self->{app};

   if ($tag eq "user" && $event->type eq "button-release") {
      if ($event->button == 1) {
         $content =~ /^([^\x20\xa0]+)/ or return;
         $self->{app}->open_user (name => $1);
      }
   }
}

sub set_end {
   my ($self) = @_;

   # we do it both. the first scroll avoids flickering,
   # the second ensures that we scroll -- gtk+ often ignores
   # the first scroll_to_mark ...
   $self->{view}->scroll_to_mark ($self->{end}, 0, 0, 0, 0);
   $self->{idle} ||= add Glib::Idle sub {
      $self->{view}->scroll_to_mark ($self->{end}, 0, 0, 0, 0);
      delete $self->{idle};
      0;
   };
}

sub at_end {
   my ($self) = @_;

   # this is, maybe, a bad hack :/
   my $adj = $self->{widget}->get_vadjustment;
   $adj->value + $adj->page_size >= $adj->upper - 0.5;
}

sub append_text {
   my ($self, $text) = @_;

   $self->_append_text ($self->{end}, $text);
}

sub _append_text {
   my ($self, $mark, $text) = @_;

   my $at_end = $self->at_end;

   $text = "<default>$text</default>";

   my @tag;
   # pseudo-simplistic-xml-parser
   for (;;) {
      $text =~ /\G<([^>]+)>/gc or last;
      my $tag = $1;
      if ($tag =~ s/^\///) {
         pop @tag;
      } else {
         push @tag, $tag;
      }

      $text =~ /\G([^<]*)/gc or last;
      $self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
         if length $1;
   }

   $self->set_end if $at_end;
}

sub set_text {
   my ($self, $text) = @_;

   my $at_end = $self->at_end;
           
   $self->{buffer}->set_text ("");
   $self->append_text ($text);

   $self->set_end if $at_end;
}

sub new_eventtag {
   my ($self, $cb) = @_;

   my $tag = new Gtk2::TextTag;
   $tag->signal_connect (event => $cb);
   $self->{tagtable}->add ($tag);

   $tag
}

# create a new "subbuffer"
sub new_inlay {
   my ($self) = @_;

   my $end = $self->{buffer}->get_end_iter;

   my $self = bless {
      buffer  => $self->{buffer},
      parent  => $self,
   }, superchat::inlay;

   # $USELESSNAME is a Gtk-perl < 1.042 workaround
   $self->{l} = $self->{buffer}->create_mark (++$USELESSNAME, $end, 1);
   $self->{buffer}->insert ($end, "\x{200d}");
   $self->{r} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);

   Scalar::Util::weaken $self->{buffer};
   Scalar::Util::weaken $self->{parent};
   $self;
}

sub new_switchable_inlay {
   my ($self, $header, $cb, $visible) = @_;

   my $inlay;

   my $tag = $self->new_eventtag (sub {
      my ($tag, $view, $event, $iter) = @_;

      if ($event->type eq "button-press") {
         $inlay->set_visible (!$inlay->{visible});
         return 1;
      }

      0;
   });

   $tag->set (background => "#e0e0ff");

   $inlay = $self->new_inlay;

   $inlay->{visible} = $visible;
   $inlay->{header}  = $header;
   $inlay->{tag}     = $tag;
   $inlay->{cb}      = $cb;

   Scalar::Util::weaken $inlay->{tag};

   $inlay->refresh;

   $inlay;
}

package superchat::inlay;

sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }

sub clear {
   my ($self) = @_;
   $self->{buffer}->delete ($self->liter, $self->riter);
}

sub append_text {
   my ($self, $text) = @_;

   $self->{parent}->_append_text ($self->{r}, $text);
}

sub append_widget {
   my ($self, $widget) = @_;

   $widget->show_all;

   my $anchor = $self->{buffer}->create_child_anchor ($self->riter);
   $self->{parent}{view}->add_child_at_anchor ($widget, $anchor);

   $widget;
}

sub append_optionmenu {
   my ($self, $ref, @entry) = @_;

   $self->append_widget (gtk::optionmenu $ref, @entry);
}

sub append_button {
   my ($self, $label, $cb) = @_;

   $self->append_widget (gtk::button $label, $cb);
}

sub visible { $_[0]{visible} }

sub set_visible {
   my ($self, $visible) = @_;

   return if $self->{visible} == $visible;
   $self->{visible} = $visible;

   $self->refresh;
}

sub refresh {
   my ($self) = @_;

   $self->clear;

   my $arrow = $self->{visible} ? "⊟" : "⊞";

   $self->{buffer}->insert ($self->riter, "\n");
   $self->{buffer}->insert_with_tags ($self->riter, util::xmlto "$arrow $self->{header}", $self->{tag});

   return unless $self->{visible};

   $self->{cb}->($self);
}

sub destroy {
   my ($self) = @_;

   return if !$self->{l} || !$self->{buffer} || $self->{l}->get_deleted;

   $self->clear if $self->{buffer};

   delete $self->{parent};
   delete $self->{buffer};
   delete $self->{l};
   delete $self->{r};
}

sub DESTROY {
   my $self = shift;

   $self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag} && $self->{parent};
   #&destroy;
}

1;

Revision:	1.15
Committed:	Fri Jun 11 21:03:26 2004 UTC (19 years, 11 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.14:	+6 -3 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.4	use utf8;
2
3	pcg	1.1	package chat;
4
5	root	1.4	# waaay cool widget. well... maybe at one point in the future
6
7	pcg	1.1	use Gtk2;
8	root	1.12	use Gtk2::Pango;
9	pcg	1.1
10			use Glib::Object::Subclass
11			Gtk2::VBox,
12			signals => {
13			command => {
14	root	1.13	flags => [qw/run-last/],
15	root	1.12	return_type => undef,
16			param_types => [Glib::Scalar, Glib::Scalar],
17			class_closure => sub { },
18			},
19			tag_event => {
20	root	1.13	flags => [qw/run-last/],
21	root	1.12	return_type => undef,
22			# tag, event, content
23			param_types => [Glib::String, Gtk2::Gdk::Event, Glib::String],
24	root	1.13	class_closure => \&tag_event,
25	root	1.12	},
26			enter_tag => {
27	root	1.13	flags => [qw/run-last/],
28	root	1.12	return_type => undef,
29			# tag, content
30			param_types => [Glib::String, Glib::String],
31			class_closure => sub { },
32			},
33			leave_tag => {
34	root	1.13	flags => [qw/run-last/],
35	root	1.12	return_type => undef,
36	root	1.13	# tag, content
37	root	1.12	param_types => [Glib::String, Glib::String],
38			class_closure => sub { },
39	pcg	1.1	},
40			};
41
42	root	1.13	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
51	root	1.4	sub INIT_INSTANCE {
52			my $self = shift;
53	pcg	1.1
54	root	1.4	my $tagtable = new Gtk2::TextTagTable;
55
56			{
57			my @tags = (
58	root	1.12	[default => { foreground => "black", wrap_mode => "word-char" }],
59	root	1.4	[node => { foreground => "#0000b0", event => 1 }],
60			[move => { foreground => "#0000b0", event => 1 }],
61	root	1.11	[user => { foreground => "#0000b0", event => 1 }],
62	root	1.4	[coord => { foreground => "#0000b0", event => 1 }],
63			[score => { foreground => "#0000b0", event => 1 }],
64			[error => { foreground => "#ff0000", event => 1 }],
65	root	1.9	[leader => { weight => 800, pixels_above_lines => 6 }],
66	root	1.4	[header => { weight => 800, pixels_above_lines => 6 }],
67			[undo => { foreground => "#ffff00", background => "#ff0000", weight => 800, pixels_above_lines => 6 }],
68			[challenge => { weight => 800, pixels_above_lines => 6, background => "#ffffb0" }],
69			[description => { weight => 800, foreground => "blue" }],
70			[infoblock => { weight => 700, foreground => "blue" }],
71			);
72
73			for (@tags) {
74			my ($k, $v) = @$_;
75			my $tag = new Gtk2::TextTag $k;
76			if (delete $v->{event}) {
77	root	1.12	$tag->signal_connect (event => sub {
78			my ($tag, $view, $event, $iter) = @_;
79	root	1.13
80			return 0 if $event->type eq "motion-notify";
81
82	root	1.12	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	root	1.13
88			1;
89	root	1.12	});
90	root	1.4	}
91			$tag->set (%$v);
92			$tagtable->add ($tag);
93	pcg	1.1	}
94			}
95
96	root	1.4	$self->{tagtable} = $tagtable;
97	pcg	1.1
98	pcg	1.3	$self->signal_connect (destroy => sub {
99			remove Glib::Source delete $self->{idle} if $self->{idle};
100			%{$_[0]} = ();
101			});
102
103	root	1.4	$self->{buffer} = new Gtk2::TextBuffer $self->{tagtable};
104	pcg	1.1
105			$self->{widget} = new Gtk2::ScrolledWindow;
106	root	1.11	$self->{widget}->set_policy ("automatic", "always");
107	pcg	1.1	$self->pack_start ($self->{widget}, 1, 1, 0);
108
109			$self->{widget}->add ($self->{view} = new_with_buffer Gtk2::TextView $self->{buffer});
110	root	1.12	$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			);
117	pcg	1.1
118			$self->{view}->signal_connect (motion_notify_event => sub {
119			my ($widget, $event) = @_;
120
121			my $window = $widget->get_window ("text");
122			if ($event->window == $window) {
123			my ($win, $x, $y, $mask) = $window->get_pointer;
124	root	1.12	($x, $y) = $self->{view}->window_to_buffer_coords ("text", $x, $y);
125			my ($iter) = $self->{view}->get_iter_at_location ($x, $y);
126
127			my $tag = ($iter->get_tags)[01];
128
129			if ($tag) {
130			my ($a, $b) = ($iter, $iter->copy);
131			$a->backward_to_tag_toggle ($tag) unless $a->begins_tag ($tag);
132			$b->forward_to_tag_toggle ($tag) unless $b->ends_tag ($tag);
133
134			$self->tag_enterleave ($tag->get ("name"), $a->get_text ($b));
135			} else {
136			$self->tag_enterleave ();
137			}
138
139			1;
140	pcg	1.1	}
141			0;
142			});
143
144	root	1.12	$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));
150
151	pcg	1.1	$self->pack_start (($self->{entry} = new Gtk2::Entry), 0, 1, 0);
152
153	root	1.4	$self->{entry}->signal_connect (activate => sub {
154	pcg	1.1	my ($entry) = @_;
155			my $text = $entry->get_text;
156			$entry->set_text("");
157
158			my ($cmd, $arg);
159
160			if ($text =~ /^\/(\S+)\s(.)$/) {
161			($cmd, $arg) = ($1, $2);
162			} else {
163	pcg	1.2	($cmd, $arg) = ("say", $text);
164	pcg	1.1	}
165
166			$self->signal_emit (command => $cmd, $arg);
167			});
168
169	root	1.4	#$self->{end} = $self->{buffer}->create_mark (undef, $self->{buffer}->get_end_iter, 0);#d##todo# use this one for gtk-1.050+
170			$self->{end} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_end_iter, 0); # workaround for gtk-perl bug
171	pcg	1.1
172			$self->set_end;
173			}
174
175	root	1.12	sub tag_enterleave {
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	root	1.13	}
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	root	1.14	$content =~ /^([^\x20\xa0]+)/ or return;
195	root	1.13	$self->{app}->open_user (name => $1);
196			}
197	root	1.12	}
198	pcg	1.1	}
199
200			sub set_end {
201			my ($self) = @_;
202
203	root	1.15	# we do it both. the first scroll avoids flickering,
204			# the second ensures that we scroll -- gtk+ often ignores
205			# the first scroll_to_mark ...
206			$self->{view}->scroll_to_mark ($self->{end}, 0, 0, 0, 0);
207	pcg	1.1	$self->{idle} \|\|= add Glib::Idle sub {
208	root	1.15	$self->{view}->scroll_to_mark ($self->{end}, 0, 0, 0, 0);
209	pcg	1.1	delete $self->{idle};
210	root	1.15	0;
211	pcg	1.1	};
212			}
213
214			sub at_end {
215			my ($self) = @_;
216
217			# this is, maybe, a bad hack :/
218			my $adj = $self->{widget}->get_vadjustment;
219			$adj->value + $adj->page_size >= $adj->upper - 0.5;
220			}
221
222			sub append_text {
223			my ($self, $text) = @_;
224
225	root	1.4	$self->_append_text ($self->{end}, $text);
226			}
227
228			sub _append_text {
229			my ($self, $mark, $text) = @_;
230
231	pcg	1.1	my $at_end = $self->at_end;
232
233			$text = "<default>$text</default>";
234
235	root	1.4	my @tag;
236	pcg	1.1	# pseudo-simplistic-xml-parser
237			for (;;) {
238			$text =~ /\G<([^>]+)>/gc or last;
239			my $tag = $1;
240			if ($tag =~ s/^\///) {
241			pop @tag;
242			} else {
243			push @tag, $tag;
244			}
245
246			$text =~ /\G([^<]*)/gc or last;
247	root	1.4	$self->{buffer}->insert_with_tags_by_name ($self->{buffer}->get_iter_at_mark ($mark), util::xmlto $1, @tag)
248	pcg	1.1	if length $1;
249			}
250
251			$self->set_end if $at_end;
252			}
253
254			sub set_text {
255			my ($self, $text) = @_;
256
257			my $at_end = $self->at_end;
258
259			$self->{buffer}->set_text ("");
260			$self->append_text ($text);
261
262			$self->set_end if $at_end;
263	root	1.4	}
264
265			sub new_eventtag {
266			my ($self, $cb) = @_;
267
268			my $tag = new Gtk2::TextTag;
269			$tag->signal_connect (event => $cb);
270			$self->{tagtable}->add ($tag);
271
272			$tag
273			}
274
275			# create a new "subbuffer"
276			sub new_inlay {
277			my ($self) = @_;
278
279			my $end = $self->{buffer}->get_end_iter;
280
281			my $self = bless {
282			buffer => $self->{buffer},
283			parent => $self,
284			}, superchat::inlay;
285
286			# $USELESSNAME is a Gtk-perl < 1.042 workaround
287			$self->{l} = $self->{buffer}->create_mark (++$USELESSNAME, $end, 1);
288			$self->{buffer}->insert ($end, "\x{200d}");
289			$self->{r} = $self->{buffer}->create_mark (++$USELESSNAME, $self->{buffer}->get_iter_at_mark ($self->{l}), 0);
290
291			Scalar::Util::weaken $self->{buffer};
292			Scalar::Util::weaken $self->{parent};
293			$self;
294			}
295
296			sub new_switchable_inlay {
297			my ($self, $header, $cb, $visible) = @_;
298
299			my $inlay;
300
301			my $tag = $self->new_eventtag (sub {
302			my ($tag, $view, $event, $iter) = @_;
303
304			if ($event->type eq "button-press") {
305			$inlay->set_visible (!$inlay->{visible});
306			return 1;
307			}
308
309			0;
310			});
311
312			$tag->set (background => "#e0e0ff");
313
314			$inlay = $self->new_inlay;
315
316			$inlay->{visible} = $visible;
317			$inlay->{header} = $header;
318			$inlay->{tag} = $tag;
319			$inlay->{cb} = $cb;
320
321			Scalar::Util::weaken $inlay->{tag};
322
323			$inlay->refresh;
324
325			$inlay;
326			}
327
328			package superchat::inlay;
329
330			sub liter { $_[0]{buffer}->get_iter_at_mark ($_[0]{l}) }
331			sub riter { $_[0]{buffer}->get_iter_at_mark ($_[0]{r}) }
332
333			sub clear {
334			my ($self) = @_;
335			$self->{buffer}->delete ($self->liter, $self->riter);
336			}
337
338			sub append_text {
339			my ($self, $text) = @_;
340
341			$self->{parent}->_append_text ($self->{r}, $text);
342			}
343
344			sub append_widget {
345			my ($self, $widget) = @_;
346
347			$widget->show_all;
348
349			my $anchor = $self->{buffer}->create_child_anchor ($self->riter);
350			$self->{parent}{view}->add_child_at_anchor ($widget, $anchor);
351	root	1.10
352			$widget;
353	root	1.4	}
354
355			sub append_optionmenu {
356			my ($self, $ref, @entry) = @_;
357
358	root	1.10	$self->append_widget (gtk::optionmenu $ref, @entry);
359	root	1.4	}
360
361			sub append_button {
362			my ($self, $label, $cb) = @_;
363
364	root	1.10	$self->append_widget (gtk::button $label, $cb);
365	root	1.4	}
366
367			sub visible { $_[0]{visible} }
368
369			sub set_visible {
370			my ($self, $visible) = @_;
371
372			return if $self->{visible} == $visible;
373			$self->{visible} = $visible;
374
375			$self->refresh;
376			}
377
378			sub refresh {
379			my ($self) = @_;
380
381			$self->clear;
382
383			my $arrow = $self->{visible} ? "⊟" : "⊞";
384
385			$self->{buffer}->insert ($self->riter, "\n");
386			$self->{buffer}->insert_with_tags ($self->riter, util::xmlto "$arrow $self->{header}", $self->{tag});
387
388			return unless $self->{visible};
389
390			$self->{cb}->($self);
391			}
392
393			sub destroy {
394			my ($self) = @_;
395
396			return if !$self->{l} \|\| !$self->{buffer} \|\| $self->{l}->get_deleted;
397
398			$self->clear if $self->{buffer};
399
400			delete $self->{parent};
401			delete $self->{buffer};
402			delete $self->{l};
403			delete $self->{r};
404			}
405
406			sub DESTROY {
407			my $self = shift;
408
409			$self->{parent}{tagtable}->remove (delete $self->{tag}) if $self->{tag} && $self->{parent};
410			#&destroy;
411	pcg	1.1	}
412
413			1;
414