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.11 by root, Mon Jan 2 21:41:51 2006 UTC

1=head1 NAME 1=head1 NAME
2 2
3rxvtperl - rxvt-unicode's embedded perl interpreter 3@@RXVT_NAME@@perl - 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
… …
126code is run after this hook, and takes precedence. 123code is run after this hook, and takes precedence.
127 124
128=item on_refresh_end $term 125=item on_refresh_end $term
129 126
130Called just after the screen gets redrawn. See C<on_refresh_begin>. 127Called just after the screen gets redrawn. See C<on_refresh_begin>.
128
129=item on_keyboard_command $term, $string
130
131Called whenever the user presses a key combination that has a
132C<perl:string> action bound to it (see description of the B<keysym>
133resource in the @@RXVT_NAME@@(1) manpage).
131 134
132=back 135=back
133 136
134=head2 Functions in the C<urxvt> Package 137=head2 Functions in the C<urxvt> Package
135 138
… …
174 unless $msg =~ /\n$/; 177 unless $msg =~ /\n$/;
175 urxvt::warn ($msg); 178 urxvt::warn ($msg);
176 }; 179 };
177} 180}
178 181
182my @hook_count;
179my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 183my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
180 184
181sub verbose { 185sub verbose {
182 my ($level, $msg) = @_; 186 my ($level, $msg) = @_;
183 warn "$msg\n" if $level < $verbosity; 187 warn "$msg\n" if $level <= $verbosity;
184} 188}
185 189
186my %hook_global; 190# find on_xxx subs in the package and register them
187my @hook_count; 191# as hooks
192sub register_package($) {
193 my ($pkg) = @_;
194
195 for my $htype (0.. $#HOOKNAME) {
196 my $name = $HOOKNAME[$htype];
197
198 my $ref = $pkg->can ("on_" . lc $name)
199 or next;
200
201 $term->{_hook}[$htype]{$ref*1} = $ref;
202 $hook_count[$htype]++
203 or set_should_invoke $htype, 1;
204 }
205}
206
207my $script_pkg = "script0000";
208my %script_pkg;
209
210# load a single script into its own package, once only
211sub script_package($) {
212 my ($path) = @_;
213
214 $script_pkg{$path} ||= do {
215 my $pkg = "urxvt::" . ($script_pkg++);
216
217 verbose 3, "loading script '$path' into package '$pkg'";
218
219 open my $fh, "<:raw", $path
220 or die "$path: $!";
221
222 my $source = "package $pkg; use strict; use utf8;\n"
223 . "#line 1 \"$path\"\n{\n"
224 . (do { local $/; <$fh> })
225 . "\n};\n1";
226
227 eval $source or die "$path: $@";
228
229 $pkg
230 }
231}
188 232
189# called by the rxvt core 233# called by the rxvt core
190sub invoke { 234sub invoke {
191 local $term = shift; 235 local $term = shift;
192 my $htype = shift; 236 my $htype = shift;
193 237
238 if ($htype == 0) { # INIT
239 my @dirs = ((split /:/, $term->resource ("perl_lib")), "$LIBDIR/perl");
240
241 for my $ext (split /:/, $term->resource ("perl_ext")) {
242 my @files = grep -f $_, map "$_/$ext", @dirs;
243
244 if (@files) {
245 register_package script_package $files[0];
246 } else {
247 warn "perl extension '$ext' not found in perl library search path\n";
248 }
249 }
250
251 } elsif ($htype == 1) { # DESTROY
252 if (my $hook = $term->{_hook}) {
253 for my $htype (0..$#$hook) {
254 $hook_count[$htype] -= scalar keys %{ $hook->[$htype] || {} }
255 or set_should_invoke $htype, 0;
256 }
257 }
258 }
259
260 my $cb = $term->{_hook}[$htype]
261 or return;
262
194 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 263 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
195 if $verbosity >= 10; 264 if $verbosity >= 10;
196 265
197 for my $cb ($hook_global{_hook}[$htype], $term->{_hook}[$htype]) {
198 $cb or next;
199
200 while (my ($k, $v) = each %$cb) { 266 while (my ($k, $v) = each %$cb) {
201 return 1 if $v->($term, @_); 267 return 1 if $v->($term, @_);
202 }
203 } 268 }
204 269
205 0 270 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} 271}
285 272
286=back 273=back
287 274
288=head2 The C<urxvt::term> Class 275=head2 The C<urxvt::term> Class
… …
312 299
313 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 300 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
314 borderLess color cursorBlink cursorUnderline cutchars delete_key 301 borderLess color cursorBlink cursorUnderline cutchars delete_key
315 display_name embed ext_bwidth fade font geometry hold iconName 302 display_name embed ext_bwidth fade font geometry hold iconName
316 imFont imLocale inputMethod insecure int_bwidth intensityStyles 303 imFont imLocale inputMethod insecure int_bwidth intensityStyles
317 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 304 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
318 modifier mouseWheelScrollPage name pastableTabs path perl perl_eval 305 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
319 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd 306 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
320 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating 307 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
321 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput 308 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
322 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle 309 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
323 shade term_name title transparent transparent_all tripleclickwords 310 shade term_name title transparent transparent_all tripleclickwords

Diff Legend

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