ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/urxvt.pm
(Generate patch)

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.6 by root, Mon Jan 2 18:20:23 2006 UTC vs.
Revision 1.7 by root, Mon Jan 2 19:05:05 2006 UTC

… …
31 31
32=head2 General API Considerations 32=head2 General API Considerations
33 33
34All objects (such as terminals, time watchers etc.) are typical 34All objects (such as terminals, time watchers etc.) are typical
35reference-to-hash objects. The hash can be used to store anything you 35reference-to-hash objects. The hash can be used to store anything you
36like. The only reserved member is C<_ptr>, which must not be changed. 36like. All members starting with an underscore (such as C<_ptr> or
37C<_hook>) are reserved for internal uses and must not be accessed or
38modified).
37 39
38When objects are destroyed on the C++ side, the perl object hashes are 40When objects are destroyed on the C++ side, the perl object hashes are
39emptied, so its best to store related objects such as time watchers and 41emptied, so its best to store related objects such as time watchers and
40the like inside the terminal object so they get destroyed as soon as the 42the like inside the terminal object so they get destroyed as soon as the
41terminal is destroyed. 43terminal is destroyed.
… …
172 unless $msg =~ /\n$/; 174 unless $msg =~ /\n$/;
173 urxvt::warn ($msg); 175 urxvt::warn ($msg);
174 }; 176 };
175} 177}
176 178
177my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10; 179my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
178 180
179sub verbose { 181sub verbose {
180 my ($level, $msg) = @_; 182 my ($level, $msg) = @_;
181 warn "$msg\n"; #d# 183 warn "$msg\n" if $level < $verbosity;
182} 184}
183 185
184my @invoke_cb; 186my %hook_global;
187my @hook_count;
185 188
186# called by the rxvt core 189# called by the rxvt core
187sub invoke { 190sub invoke {
188 local $term = shift; 191 local $term = shift;
189 my $htype = shift; 192 my $htype = shift;
190 193
191 my $cb = $invoke_cb[$htype];
192
193 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 194 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
194 if $verbosity >= 10; 195 if $verbosity >= 10;
195 196
197 for my $cb ($hook_global{_hook}[$htype], $term->{_hook}[$htype]) {
198 $cb or next;
199
196 while (my ($k, $v) = each %$cb) { 200 while (my ($k, $v) = each %$cb) {
197 return 1 if $v->($term, @_); 201 return 1 if $v->($term, @_);
202 }
198 } 203 }
199 204
200 0 205 0
201} 206}
202 207
203# find on_xxx subs in the package and register them 208# find on_xxx subs in the package and register them
204# as hooks 209# as hooks
205sub register_package($) { 210sub register_package($) {
206 my ($pkg) = @_; 211 my ($pkg) = @_;
207 212
208 for my $hook (0.. $#HOOKNAME) { 213 for my $htype (0.. $#HOOKNAME) {
209 my $name = $HOOKNAME[$hook]; 214 my $name = $HOOKNAME[$htype];
210 215
211 my $ref = $pkg->can ("on_" . lc $name) 216 my $ref = $pkg->can ("on_" . lc $name)
212 or next; 217 or next;
213 218
214 $invoke_cb[$hook]{$ref*1} = $ref; 219 $term->{_hook}[$htype]{$ref*1} = $ref;
220 $hook_count[$htype]++
215 set_should_invoke $hook, 1; 221 or set_should_invoke $htype, 1;
216 } 222 }
217} 223}
218 224
219my $script_pkg = "script0000"; 225my $script_pkg = "script0000";
220my %script_pkg; 226my %script_pkg;
221 227
222# load a single script into its own package, once only 228# load a single script into its own package, once only
223sub load_script($) { 229sub script_package($) {
224 my ($path) = @_; 230 my ($path) = @_;
225 231
226 $script_pkg{$path} ||= do { 232 $script_pkg{$path} ||= do {
227 my $pkg = $script_pkg++; 233 my $pkg = $script_pkg++;
228 verbose 3, "loading script '$path' into package '$pkg'"; 234 verbose 3, "loading script '$path' into package '$pkg'";
… …
233 eval "package $pkg; use strict; use utf8;\n" 239 eval "package $pkg; use strict; use utf8;\n"
234 . "#line 1 \"$path\"\n" 240 . "#line 1 \"$path\"\n"
235 . do { local $/; <$fh> } 241 . do { local $/; <$fh> }
236 or die "$path: $@"; 242 or die "$path: $@";
237 243
238 register_package $pkg;
239
240 $pkg 244 $pkg
241 }; 245 }
242} 246}
243 247
244sub load_scripts($) { 248sub load_scripts($) {
245 my ($dir) = @_; 249 my ($dir) = @_;
246 250
247 verbose 3, "loading scripts from '$dir'"; 251 verbose 3, "loading scripts from '$dir'";
248 252
249 load_script $_ 253 register_package script_package $_
250 for grep -f $_, 254 for grep -f $_,
251 <$dir/perl-ext/*>; 255 <$dir/*>;
252} 256}
253 257
254sub on_init { 258sub on_init {
255 my ($term) = @_; 259 my ($term) = @_;
256 260
… …
258 262
259 load_scripts $libdir 263 load_scripts $libdir
260 if defined $libdir; 264 if defined $libdir;
261} 265}
262 266
267sub on_destroy {
268 my ($term) = @_;
269
270 my $hook = $term->{_hook}
271 or return;
272
273 for my $htype (0..$#$hook) {
274 $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
275 or set_should_invoke $htype, 0;
276 }
277}
278
279{
280 local $term = \%hook_global;
281
263register_package __PACKAGE__; 282 register_package __PACKAGE__;
264load_scripts $LIBDIR; 283 load_scripts "$LIBDIR/perl-ext";
284}
265 285
266=back 286=back
267 287
268=head2 The C<urxvt::term> Class 288=head2 The C<urxvt::term> Class
269 289

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines