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.10 by root, Mon Jan 2 20:47:52 2006 UTC

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

Diff Legend

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