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.7 by root, Mon Jan 2 19:05:05 2006 UTC vs.
Revision 1.8 by root, Mon Jan 2 20:35:39 2006 UTC

… …
16 16
17 1 17 1
18 18
19=head1 DESCRIPTION 19=head1 DESCRIPTION
20 20
21On startup, @@RXVT_NAME@@ will scan F<@@RXVT_LIBDIR@@/urxvt/perl-ext/> 21Everytime a terminal object gets created, scripts specified via the
22for files and will load them. Everytime a terminal object gets created, 22C<perl> resource are associated with it.
23the directory specified by the C<perl-lib> resource will be additionally
24scanned.
25 23
26Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where 24Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
27scripts will be shared for all terminals. 25scripts will be shared (But not enabled) for all terminals.
28
29Hooks in scripts specified by C<perl-lib> will only be called for the
30terminals created with that specific option value.
31 26
32=head2 General API Considerations 27=head2 General API Considerations
33 28
34All objects (such as terminals, time watchers etc.) are typical 29All objects (such as terminals, time watchers etc.) are typical
35reference-to-hash objects. The hash can be used to store anything you 30reference-to-hash objects. The hash can be used to store anything you
… …
174 unless $msg =~ /\n$/; 169 unless $msg =~ /\n$/;
175 urxvt::warn ($msg); 170 urxvt::warn ($msg);
176 }; 171 };
177} 172}
178 173
174my @hook_count;
179my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 175my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
180 176
181sub verbose { 177sub verbose {
182 my ($level, $msg) = @_; 178 my ($level, $msg) = @_;
183 warn "$msg\n" if $level < $verbosity; 179 warn "$msg\n" if $level <= $verbosity;
184} 180}
185 181
186my %hook_global; 182# find on_xxx subs in the package and register them
187my @hook_count; 183# as hooks
184sub register_package($) {
185 my ($pkg) = @_;
186
187 for my $htype (0.. $#HOOKNAME) {
188 my $name = $HOOKNAME[$htype];
189
190 my $ref = $pkg->can ("on_" . lc $name)
191 or next;
192
193 $term->{_hook}[$htype]{$ref*1} = $ref;
194 $hook_count[$htype]++
195 or set_should_invoke $htype, 1;
196 }
197}
198
199my $script_pkg = "script0000";
200my %script_pkg;
201
202# load a single script into its own package, once only
203sub script_package($) {
204 my ($path) = @_;
205
206 $script_pkg{$path} ||= do {
207 my $pkg = "urxvt::" . ($script_pkg++);
208
209 verbose 3, "loading script '$path' into package '$pkg'";
210
211 open my $fh, "<:raw", $path
212 or die "$path: $!";
213
214 my $source = "package $pkg; use strict; use utf8;\n"
215 . "#line 1 \"$path\"\n{\n"
216 . (do { local $/; <$fh> })
217 . "\n};\n1";
218
219 eval $source or die "$path: $@";
220
221 $pkg
222 }
223}
188 224
189# called by the rxvt core 225# called by the rxvt core
190sub invoke { 226sub invoke {
191 local $term = shift; 227 local $term = shift;
192 my $htype = shift; 228 my $htype = shift;
193 229
230 if ($htype == 0) { # INIT
231 my @dirs = ((split /:/, $term->resource ("perl_lib")), $LIBDIR);
232
233 for my $ext (split /:/, $term->resource ("perl_ext")) {
234 my @files = grep -f $_, map "$_/$ext", @dirs;
235
236 if (@files) {
237 register_package script_package $files[0];
238 } else {
239 warn "perl extension '$ext' not found in perl library search path\n";
240 }
241 }
242
243 } elsif ($htype == 1) { # DESTROY
244 if (my $hook = $term->{_hook}) {
245 for my $htype (0..$#$hook) {
246 $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
247 or set_should_invoke $htype, 0;
248 }
249 }
250 }
251
252 my $cb = $term->{_hook}[$htype]
253 or return;
254
194 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 255 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
195 if $verbosity >= 10; 256 if $verbosity >= 10;
196 257
197 for my $cb ($hook_global{_hook}[$htype], $term->{_hook}[$htype]) {
198 $cb or next;
199
200 while (my ($k, $v) = each %$cb) { 258 while (my ($k, $v) = each %$cb) {
201 return 1 if $v->($term, @_); 259 return 1 if $v->($term, @_);
202 }
203 } 260 }
204 261
205 0 262 0
206}
207
208# find on_xxx subs in the package and register them
209# as hooks
210sub register_package($) {
211 my ($pkg) = @_;
212
213 for my $htype (0.. $#HOOKNAME) {
214 my $name = $HOOKNAME[$htype];
215
216 my $ref = $pkg->can ("on_" . lc $name)
217 or next;
218
219 $term->{_hook}[$htype]{$ref*1} = $ref;
220 $hook_count[$htype]++
221 or set_should_invoke $htype, 1;
222 }
223}
224
225my $script_pkg = "script0000";
226my %script_pkg;
227
228# load a single script into its own package, once only
229sub script_package($) {
230 my ($path) = @_;
231
232 $script_pkg{$path} ||= do {
233 my $pkg = $script_pkg++;
234 verbose 3, "loading script '$path' into package '$pkg'";
235
236 open my $fh, "<:raw", $path
237 or die "$path: $!";
238
239 eval "package $pkg; use strict; use utf8;\n"
240 . "#line 1 \"$path\"\n"
241 . do { local $/; <$fh> }
242 or die "$path: $@";
243
244 $pkg
245 }
246}
247
248sub load_scripts($) {
249 my ($dir) = @_;
250
251 verbose 3, "loading scripts from '$dir'";
252
253 register_package script_package $_
254 for grep -f $_,
255 <$dir/*>;
256}
257
258sub on_init {
259 my ($term) = @_;
260
261 my $libdir = $term->resource ("perl_lib");
262
263 load_scripts $libdir
264 if defined $libdir;
265}
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
282 register_package __PACKAGE__;
283 load_scripts "$LIBDIR/perl-ext";
284} 263}
285 264
286=back 265=back
287 266
288=head2 The C<urxvt::term> Class 267=head2 The C<urxvt::term> Class
… …
312 291
313 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 292 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
314 borderLess color cursorBlink cursorUnderline cutchars delete_key 293 borderLess color cursorBlink cursorUnderline cutchars delete_key
315 display_name embed ext_bwidth fade font geometry hold iconName 294 display_name embed ext_bwidth fade font geometry hold iconName
316 imFont imLocale inputMethod insecure int_bwidth intensityStyles 295 imFont imLocale inputMethod insecure int_bwidth intensityStyles
317 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 296 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
318 modifier mouseWheelScrollPage name pastableTabs path perl perl_eval 297 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
319 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd 298 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
320 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating 299 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
321 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput 300 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
322 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle 301 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
323 shade term_name title transparent transparent_all tripleclickwords 302 shade term_name title transparent transparent_all tripleclickwords

Diff Legend

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