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.8 by root, Mon Jan 2 20:35:39 2006 UTC

… …
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* Put your scripts into F<@@RXVT_LIBDIR@@/urxvt/perl-ext/>, they will be loaded automatically.
8
9* Each script will only be loaded once, even in urxvtd, and will be valid
10globally.
11 8
12* Scripts are evaluated in a 'use strict' and 'use utf8' environment, and 9* Scripts are evaluated in a 'use strict' and 'use utf8' environment, and
13thus must be encoded as UTF-8. 10thus must be encoded as UTF-8.
14 11
15 sub on_sel_grab { 12 sub on_sel_grab {
… …
19 16
20 1 17 1
21 18
22=head1 DESCRIPTION 19=head1 DESCRIPTION
23 20
21Everytime a terminal object gets created, scripts specified via the
22C<perl> resource are associated with it.
23
24Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
25scripts will be shared (But not enabled) for all terminals.
26
27=head2 General API Considerations
28
29All objects (such as terminals, time watchers etc.) are typical
30reference-to-hash objects. The hash can be used to store anything you
31like. All members starting with an underscore (such as C<_ptr> or
32C<_hook>) are reserved for internal uses and must not be accessed or
33modified).
34
35When objects are destroyed on the C++ side, the perl object hashes are
36emptied, so its best to store related objects such as time watchers and
37the like inside the terminal object so they get destroyed as soon as the
38terminal is destroyed.
39
24=head2 Hooks 40=head2 Hooks
25 41
26The following subroutines can be declared in loaded scripts, and will be called 42The following subroutines can be declared in loaded scripts, and will be called
27whenever the relevant event happens. 43whenever the relevant event happens.
28 44
… …
120costs! The only time this is acceptable is when the terminal process 136costs! The only time this is acceptable is when the terminal process
121starts up. 137starts up.
122 138
123=item urxvt::warn $string 139=item urxvt::warn $string
124 140
125Calls C<rxvt_warn> witht eh given string which should not include a 141Calls C<rxvt_warn> with the given string which should not include a
126newline. The module also overwrites the C<warn> builtin with a function 142newline. The module also overwrites the C<warn> builtin with a function
127that calls this function. 143that calls this function.
128 144
129Using this function has the advantage that its output ends up in the 145Using this function has the advantage that its output ends up in the
130correct place, e.g. on stderr of the connecting urxvtc client. 146correct 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 147
137=item $time = urxvt::NOW 148=item $time = urxvt::NOW
138 149
139Returns the "current time" (as per the event loop). 150Returns the "current time" (as per the event loop).
140 151
… …
158 unless $msg =~ /\n$/; 169 unless $msg =~ /\n$/;
159 urxvt::warn ($msg); 170 urxvt::warn ($msg);
160 }; 171 };
161} 172}
162 173
174my @hook_count;
163my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10; 175my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
164 176
165sub verbose { 177sub verbose {
166 my ($level, $msg) = @_; 178 my ($level, $msg) = @_;
167 warn "$msg\n"; #d# 179 warn "$msg\n" if $level <= $verbosity;
168} 180}
169 181
170my @invoke_cb; 182# find on_xxx subs in the package and register them
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}
171 224
172# called by the rxvt core 225# called by the rxvt core
173sub invoke { 226sub invoke {
174 local $term = shift; 227 local $term = shift;
175 my $htype = shift; 228 my $htype = shift;
176 229
177 my $cb = $invoke_cb[$htype]; 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;
178 254
179 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 255 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
180 if $verbosity >= 10; 256 if $verbosity >= 10;
181 257
182 while (my ($k, $v) = each %$cb) { 258 while (my ($k, $v) = each %$cb) {
183 return 1 if $v->($term, @_); 259 return 1 if $v->($term, @_);
184 } 260 }
185 261
186 0 262 0
187} 263}
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 264
232=back 265=back
233 266
234=head2 The C<urxvt::term> Class 267=head2 The C<urxvt::term> Class
235 268
… …
258 291
259 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 292 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
260 borderLess color cursorBlink cursorUnderline cutchars delete_key 293 borderLess color cursorBlink cursorUnderline cutchars delete_key
261 display_name embed ext_bwidth fade font geometry hold iconName 294 display_name embed ext_bwidth fade font geometry hold iconName
262 imFont imLocale inputMethod insecure int_bwidth intensityStyles 295 imFont imLocale inputMethod insecure int_bwidth intensityStyles
263 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 296 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
264 modifier mouseWheelScrollPage name pastableTabs path pointerBlank 297 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
265 pointerBlankDelay preeditType print_pipe pty_fd reverseVideo saveLines 298 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
266 scrollBar scrollBar_align scrollBar_floating scrollBar_right 299 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
267 scrollBar_thickness scrollTtyKeypress scrollTtyOutput scrollWithBuffer 300 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
268 scrollstyle secondaryScreen secondaryScroll selectstyle shade term_name 301 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
269 title transparent transparent_all tripleclickwords utmpInhibit 302 shade term_name title transparent transparent_all tripleclickwords
270 visualBell 303 utmpInhibit visualBell
271 304
272=cut 305=cut
273 306
274sub urxvt::term::resource($$;$) { 307sub urxvt::term::resource($$;$) {
275 my ($self, $name) = (shift, shift); 308 my ($self, $name) = (shift, shift);
… …
305 my ($self, $x, $y, $text) = @_; 338 my ($self, $x, $y, $text) = @_;
306 339
307 my @lines = split /\n/, $text; 340 my @lines = split /\n/, $text;
308 341
309 my $w = 0; 342 my $w = 0;
310 for (map urxvt::wcswidth $_, @lines) { 343 for (map $self->strwidth ($_), @lines) {
311 $w = $_ if $w < $_; 344 $w = $_ if $w < $_;
312 } 345 }
313 346
314 $self->scr_overlay_new ($x, $y, $w, scalar @lines); 347 $self->scr_overlay_new ($x, $y, $w, scalar @lines);
315 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines; 348 $self->scr_overlay_set (0, $_, $lines[$_]) for 0.. $#lines;
… …
332position. 365position.
333 366
334=item $term->scr_overlay_set ($x, $y, $text) 367=item $term->scr_overlay_set ($x, $y, $text)
335 368
336Write a string at the given position into the overlay. 369Write a string at the given position into the overlay.
370
371=item $cellwidth = $term->strwidth $string
372
373Returns the number of screen-cells this string would need. Correctly
374accounts for wide and combining characters.
375
376=item $octets = $term->locale_encode $string
377
378Convert the given text string into the corresponding locale encoding.
379
380=item $string = $term->locale_decode $octets
381
382Convert the given locale-encoded octets into a perl string.
383
384=item $term->tt_write ($octets)
385
386Write the octets given in C<$data> to the tty (i.e. as program input). To
387pass characters instead of octets, you should convetr you strings first to
388the locale-specific encoding using C<< $term->locale_encode >>.
337 389
338=back 390=back
339 391
340=head2 The C<urxvt::timer> Class 392=head2 The C<urxvt::timer> Class
341 393

Diff Legend

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