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.3 by root, Mon Jan 2 15:59:25 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* Each script will only be loaded once, even in urxvtd, and will be valid
10globally.
11
12* Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
13thus must be encoded as UTF-8.
14 8
15 sub on_sel_grab { 9 sub on_sel_grab {
16 warn "you selected ", $_[0]->selection; 10 warn "you selected ", $_[0]->selection;
17 () 11 ()
18 } 12 }
19 13
20 1 14 # start a @@RXVT_NAME@@ using it:
15
16 @@RXVT_NAME@@ --perl-lib $HOME -pe grab_test
21 17
22=head1 DESCRIPTION 18=head1 DESCRIPTION
19
20Everytime a terminal object gets created, scripts specified via the
21C<perl> resource are loaded and associated with it.
22
23Scripts are compiled in a 'use strict' and 'use utf8' environment, and
24thus must be encoded as UTF-8.
25
26Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
27scripts will be shared (But not enabled) for all terminals.
28
29=head2 General API Considerations
30
31All objects (such as terminals, time watchers etc.) are typical
32reference-to-hash objects. The hash can be used to store anything you
33like. All members starting with an underscore (such as C<_ptr> or
34C<_hook>) are reserved for internal uses and must not be accessed or
35modified).
36
37When objects are destroyed on the C++ side, the perl object hashes are
38emptied, so its best to store related objects such as time watchers and
39the like inside the terminal object so they get destroyed as soon as the
40terminal is destroyed.
23 41
24=head2 Hooks 42=head2 Hooks
25 43
26The following subroutines can be declared in loaded scripts, and will be called 44The following subroutines can be declared in loaded scripts, and will be called
27whenever the relevant event happens. 45whenever the relevant event happens.
120costs! The only time this is acceptable is when the terminal process 138costs! The only time this is acceptable is when the terminal process
121starts up. 139starts up.
122 140
123=item urxvt::warn $string 141=item urxvt::warn $string
124 142
125Calls C<rxvt_warn> witht eh given string which should not include a 143Calls C<rxvt_warn> with the given string which should not include a
126newline. The module also overwrites the C<warn> builtin with a function 144newline. The module also overwrites the C<warn> builtin with a function
127that calls this function. 145that calls this function.
128 146
129Using this function has the advantage that its output ends up in the 147Using this function has the advantage that its output ends up in the
130correct place, e.g. on stderr of the connecting urxvtc client. 148correct place, e.g. on stderr of the connecting urxvtc client.
131
132=item $cellwidth = urxvt::wcswidth $string
133
134Returns the number of screen-cells this string would need. Correctly
135accounts for wide and combining characters.
136 149
137=item $time = urxvt::NOW 150=item $time = urxvt::NOW
138 151
139Returns the "current time" (as per the event loop). 152Returns the "current time" (as per the event loop).
140 153
158 unless $msg =~ /\n$/; 171 unless $msg =~ /\n$/;
159 urxvt::warn ($msg); 172 urxvt::warn ($msg);
160 }; 173 };
161} 174}
162 175
176my @hook_count;
163my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10; 177my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
164 178
165sub verbose { 179sub verbose {
166 my ($level, $msg) = @_; 180 my ($level, $msg) = @_;
167 warn "$msg\n"; #d# 181 warn "$msg\n" if $level <= $verbosity;
168} 182}
169 183
170my @invoke_cb; 184# find on_xxx subs in the package and register them
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}
171 226
172# called by the rxvt core 227# called by the rxvt core
173sub invoke { 228sub invoke {
174 local $term = shift; 229 local $term = shift;
175 my $htype = shift; 230 my $htype = shift;
176 231
177 my $cb = $invoke_cb[$htype]; 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;
178 256
179 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 257 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
180 if $verbosity >= 10; 258 if $verbosity >= 10;
181 259
182 while (my ($k, $v) = each %$cb) { 260 while (my ($k, $v) = each %$cb) {
184 } 262 }
185 263
186 0 264 0
187} 265}
188 266
189# find on_xxx subs in the package and register them
190# as hooks
191sub register_package($) {
192 my ($pkg) = @_;
193
194 for my $hook (0.. $#HOOKNAME) {
195 my $name = $HOOKNAME[$hook];
196
197 my $ref = $pkg->can ("on_" . lc $name)
198 or next;
199
200 $invoke_cb[$hook]{$ref*1} = $ref;
201 set_should_invoke $hook, 1;
202 }
203}
204
205my $script_pkg = "script0000";
206my %script_pkg;
207
208# load a single script into its own package, once only
209sub load_script($) {
210 my ($path) = @_;
211
212 $script_pkg{$path} ||= do {
213 my $pkg = $script_pkg++;
214 verbose 3, "loading script '$path' into package '$pkg'";
215
216 open my $fh, "<:raw", $path
217 or die "$path: $!";
218
219 eval "package $pkg; use strict; use utf8;\n"
220 . "#line 1 \"$path\"\n"
221 . do { local $/; <$fh> }
222 or die "$path: $@";
223
224 register_package $pkg;
225
226 $pkg
227 };
228}
229
230load_script $_ for grep -f $_, <$LIBDIR/perl-ext/*>;
231
232
233=back 267=back
234 268
235=head2 The C<urxvt::term> Class 269=head2 The C<urxvt::term> Class
236 270
237=over 4 271=over 4
272
273=item $value = $term->resource ($name[, $newval])
274
275Returns the current resource value associated with a given name and
276optionally sets a new value. Setting values is most useful in the C<init>
277hook. Unset resources are returned and accepted as C<undef>.
278
279The new value must be properly encoded to a suitable character encoding
280before passing it to this method. Similarly, the returned value may need
281to be converted from the used encoding to text.
282
283Resource names are as defined in F<src/rsinc.h>. Colours can be specified
284as resource names of the form C<< color+<index> >>, e.g. C<color+5>. (will
285likely change).
286
287Please note that resource strings will currently only be freed when the
288terminal is destroyed, so changing options frequently will eat memory.
289
290Here is a a likely non-exhaustive list of resource names, not all of which
291are supported in every build, please see the source to see the actual
292list:
293
294 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
295 borderLess color cursorBlink cursorUnderline cutchars delete_key
296 display_name embed ext_bwidth fade font geometry hold iconName
297 imFont imLocale inputMethod insecure int_bwidth intensityStyles
298 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
299 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
300 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
301 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
302 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
303 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
304 shade term_name title transparent transparent_all tripleclickwords
305 utmpInhibit visualBell
306
307=cut
308
309sub urxvt::term::resource($$;$) {
310 my ($self, $name) = (shift, shift);
311 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
312 goto &urxvt::term::_resource;
313}
238 314
239=item ($row, $col) = $term->selection_mark ([$row, $col]) 315=item ($row, $col) = $term->selection_mark ([$row, $col])
240 316
241=item ($row, $col) = $term->selection_beg ([$row, $col]) 317=item ($row, $col) = $term->selection_beg ([$row, $col])
242 318
264 my ($self, $x, $y, $text) = @_; 340 my ($self, $x, $y, $text) = @_;
265 341
266 my @lines = split /\n/, $text; 342 my @lines = split /\n/, $text;
267 343
268 my $w = 0; 344 my $w = 0;
269 for (map urxvt::wcswidth $_, @lines) { 345 for (map $self->strwidth ($_), @lines) {
270 $w = $_ if $w < $_; 346 $w = $_ if $w < $_;
271 } 347 }
272 348
273 $self->scr_overlay_new ($x, $y, $w, scalar @lines); 349 $self->scr_overlay_new ($x, $y, $w, scalar @lines);
274 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; 350 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
291position. 367position.
292 368
293=item $term->scr_overlay_set ($x, $y, $text) 369=item $term->scr_overlay_set ($x, $y, $text)
294 370
295Write a string at the given position into the overlay. 371Write a string at the given position into the overlay.
372
373=item $cellwidth = $term->strwidth $string
374
375Returns the number of screen-cells this string would need. Correctly
376accounts for wide and combining characters.
377
378=item $octets = $term->locale_encode $string
379
380Convert the given text string into the corresponding locale encoding.
381
382=item $string = $term->locale_decode $octets
383
384Convert the given locale-encoded octets into a perl string.
385
386=item $term->tt_write ($octets)
387
388Write the octets given in C<$data> to the tty (i.e. as program input). To
389pass characters instead of octets, you should convetr you strings first to
390the locale-specific encoding using C<< $term->locale_encode >>.
296 391
297=back 392=back
298 393
299=head2 The C<urxvt::timer> Class 394=head2 The C<urxvt::timer> Class
300 395
391 486
392Stop watching for events on the given filehandle. 487Stop watching for events on the given filehandle.
393 488
394=back 489=back
395 490
491=head1 ENVIRONMENT
492
493=head2 URXVT_PERL_VERBOSITY
494
495This variable controls the verbosity level of the perl extension. Higher
496numbers indicate more verbose output.
497
498=over 4
499
500=item 0 - only fatal messages
501
502=item 3 - script loading and management
503
504=item 10 - all events received
505
506=back
507
396=head1 AUTHOR 508=head1 AUTHOR
397 509
398 Marc Lehmann <pcg@goof.com> 510 Marc Lehmann <pcg@goof.com>
399 http://software.schmorp.de/pkg/rxvt-unicode 511 http://software.schmorp.de/pkg/rxvt-unicode
400 512

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines