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.5 by root, Mon Jan 2 17:20:00 2006 UTC vs.
Revision 1.12 by root, Mon Jan 2 22:23:26 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* 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.
… …
106 124
107=item on_refresh_end $term 125=item on_refresh_end $term
108 126
109Called just after the screen gets redrawn. See C<on_refresh_begin>. 127Called just after the screen gets redrawn. See C<on_refresh_begin>.
110 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).
134
111=back 135=back
112 136
113=head2 Functions in the C<urxvt> Package 137=head2 Functions in the C<urxvt> Package
114 138
115=over 4 139=over 4
… …
120costs! The only time this is acceptable is when the terminal process 144costs! The only time this is acceptable is when the terminal process
121starts up. 145starts up.
122 146
123=item urxvt::warn $string 147=item urxvt::warn $string
124 148
125Calls C<rxvt_warn> witht eh given string which should not include a 149Calls C<rxvt_warn> with the given string which should not include a
126newline. The module also overwrites the C<warn> builtin with a function 150newline. The module also overwrites the C<warn> builtin with a function
127that calls this function. 151that calls this function.
128 152
129Using this function has the advantage that its output ends up in the 153Using this function has the advantage that its output ends up in the
130correct place, e.g. on stderr of the connecting urxvtc client. 154correct 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 155
137=item $time = urxvt::NOW 156=item $time = urxvt::NOW
138 157
139Returns the "current time" (as per the event loop). 158Returns the "current time" (as per the event loop).
140 159
… …
158 unless $msg =~ /\n$/; 177 unless $msg =~ /\n$/;
159 urxvt::warn ($msg); 178 urxvt::warn ($msg);
160 }; 179 };
161} 180}
162 181
182my @hook_count;
163my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10; 183my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
164 184
165sub verbose { 185sub verbose {
166 my ($level, $msg) = @_; 186 my ($level, $msg) = @_;
167 warn "$msg\n"; #d# 187 warn "$msg\n" if $level <= $verbosity;
168} 188}
169 189
170my @invoke_cb; 190# find on_xxx subs in the package and register them
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}
171 232
172# called by the rxvt core 233# called by the rxvt core
173sub invoke { 234sub invoke {
174 local $term = shift; 235 local $term = shift;
175 my $htype = shift; 236 my $htype = shift;
176 237
177 my $cb = $invoke_cb[$htype]; 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;
178 262
179 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 263 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
180 if $verbosity >= 10; 264 if $verbosity >= 10;
181 265
182 while (my ($k, $v) = each %$cb) { 266 while (my ($k, $v) = each %$cb) {
183 return 1 if $v->($term, @_); 267 return 1 if $v->($term, @_);
184 } 268 }
185 269
186 0 270 0
187} 271}
188
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 272
232=back 273=back
233 274
234=head2 The C<urxvt::term> Class 275=head2 The C<urxvt::term> Class
235 276
… …
258 299
259 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 300 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
260 borderLess color cursorBlink cursorUnderline cutchars delete_key 301 borderLess color cursorBlink cursorUnderline cutchars delete_key
261 display_name embed ext_bwidth fade font geometry hold iconName 302 display_name embed ext_bwidth fade font geometry hold iconName
262 imFont imLocale inputMethod insecure int_bwidth intensityStyles 303 imFont imLocale inputMethod insecure int_bwidth intensityStyles
263 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 304 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
264 modifier mouseWheelScrollPage name pastableTabs path pointerBlank 305 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
265 pointerBlankDelay preeditType print_pipe pty_fd reverseVideo saveLines 306 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
266 scrollBar scrollBar_align scrollBar_floating scrollBar_right 307 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
267 scrollBar_thickness scrollTtyKeypress scrollTtyOutput scrollWithBuffer 308 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
268 scrollstyle secondaryScreen secondaryScroll selectstyle shade term_name 309 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
269 title transparent transparent_all tripleclickwords utmpInhibit 310 shade term_name title transparent transparent_all tripleclickwords
270 visualBell 311 utmpInhibit visualBell
271 312
272=cut 313=cut
273 314
274sub urxvt::term::resource($$;$) { 315sub urxvt::term::resource($$;$) {
275 my ($self, $name) = (shift, shift); 316 my ($self, $name) = (shift, shift);
… …
305 my ($self, $x, $y, $text) = @_; 346 my ($self, $x, $y, $text) = @_;
306 347
307 my @lines = split /\n/, $text; 348 my @lines = split /\n/, $text;
308 349
309 my $w = 0; 350 my $w = 0;
310 for (map urxvt::wcswidth $_, @lines) { 351 for (map $self->strwidth ($_), @lines) {
311 $w = $_ if $w < $_; 352 $w = $_ if $w < $_;
312 } 353 }
313 354
314 $self->scr_overlay_new ($x, $y, $w, scalar @lines); 355 $self->scr_overlay_new ($x, $y, $w, scalar @lines);
315 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; 356 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
… …
332position. 373position.
333 374
334=item $term->scr_overlay_set ($x, $y, $text) 375=item $term->scr_overlay_set ($x, $y, $text)
335 376
336Write a string at the given position into the overlay. 377Write a string at the given position into the overlay.
378
379=item $cellwidth = $term->strwidth $string
380
381Returns the number of screen-cells this string would need. Correctly
382accounts for wide and combining characters.
383
384=item $octets = $term->locale_encode $string
385
386Convert the given text string into the corresponding locale encoding.
387
388=item $string = $term->locale_decode $octets
389
390Convert the given locale-encoded octets into a perl string.
391
392=item $term->tt_write ($octets)
393
394Write the octets given in C<$data> to the tty (i.e. as program input). To
395pass characters instead of octets, you should convert your strings first
396to the locale-specific encoding using C<< $term->locale_encode >>.
397
398=item $nsaved = $term->nsaved
399
400Returns the number of lines in the scrollback buffer.
401
402=item $view_start = $term->view_start ([$newvalue])
403
404Returns the negative row number of the topmost line. Minimum value is
405C<0>, which displays the normal terminal contents. Larger values scroll
406this many lines into the scrollback buffer.
407
408=item $text = $term->ROW_t ($row_number[, $new_text])
409
410Returns the text of the entire row with number C<$row_number>. Row C<0>
411is the topmost terminal line, row C<< $term->$ncol-1 >> is the bottommost
412terminal line. The scrollback buffer starts at line C<-1> and extends to
413line C<< -$term->nsaved >>.
414
415If C<$new_text> is specified, it will completely replace the current line.
416
417C<$text> is in a special encoding: tabs and wide characters that use more
418than one cell when displayed are padded with urxvt::NOCHAR characters
419(C<chr 65535>). Characters with combining characters and other characters
420that do not fit into the normal tetx encoding will be replaced with
421characters in the private use area.
422
423You have to obey this encoding when changing text. The advantage is
424that C<substr> and similar functions work on screen cells and not on
425characters.
426
427The methods C<< $term->special_encode >> and C<< $term->special_decode >>
428can be used to convert normal strings into this encoding and vice versa.
429
430=item $rend = $term->ROW_r ($row_number[, $new_rend])
431
432Like C<< $term->ROW_t >>
433
434=item $text = $term->special_encode $string
435
436Converts a perl string into the special encoding used by rxvt-unicode,
437where one character corresponds to one screen cell. See
438C<< $term->ROW_t >> for details.
439
440=item $string = $term->special_decode $text
441
442Converts rxvt-unicodes text reprsentation into a perl string. See
443C<< $term->ROW_t >> for details.
337 444
338=back 445=back
339 446
340=head2 The C<urxvt::timer> Class 447=head2 The C<urxvt::timer> Class
341 448

Diff Legend

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