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.6 by root, Mon Jan 2 18:20:23 2006 UTC vs.
Revision 1.8 by root, Mon Jan 2 20:35:39 2006 UTC

… …
16 16
17 1 17 1
18 18
19=head1 DESCRIPTION 19=head1 DESCRIPTION
20 20
21On startup, @@RXVT_NAME@@ will scan F<@@RXVT_LIBDIR@@/urxvt/perl-ext/> 21Everytime a terminal object gets created, scripts specified via the
22for files and will load them. Everytime a terminal object gets created, 22C<perl> resource are associated with it.
23the directory specified by the C<perl-lib> resource will be additionally
24scanned.
25 23
26Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where 24Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
27scripts will be shared for all terminals. 25scripts 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 26
32=head2 General API Considerations 27=head2 General API Considerations
33 28
34All objects (such as terminals, time watchers etc.) are typical 29All objects (such as terminals, time watchers etc.) are typical
35reference-to-hash objects. The hash can be used to store anything you 30reference-to-hash objects. The hash can be used to store anything you
36like. The only reserved member is C<_ptr>, which must not be changed. 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).
37 34
38When objects are destroyed on the C++ side, the perl object hashes are 35When objects are destroyed on the C++ side, the perl object hashes are
39emptied, so its best to store related objects such as time watchers and 36emptied, so its best to store related objects such as time watchers and
40the like inside the terminal object so they get destroyed as soon as the 37the like inside the terminal object so they get destroyed as soon as the
41terminal is destroyed. 38terminal is destroyed.
… …
172 unless $msg =~ /\n$/; 169 unless $msg =~ /\n$/;
173 urxvt::warn ($msg); 170 urxvt::warn ($msg);
174 }; 171 };
175} 172}
176 173
174my @hook_count;
177my $verbosity = $ENV{URXVT_PERL_VERBOSITY} || 10; 175my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
178 176
179sub verbose { 177sub verbose {
180 my ($level, $msg) = @_; 178 my ($level, $msg) = @_;
181 warn "$msg\n"; #d# 179 warn "$msg\n" if $level <= $verbosity;
182} 180}
183 181
184my @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}
185 224
186# called by the rxvt core 225# called by the rxvt core
187sub invoke { 226sub invoke {
188 local $term = shift; 227 local $term = shift;
189 my $htype = shift; 228 my $htype = shift;
190 229
191 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;
192 254
193 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")" 255 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $term, @_) . ")"
194 if $verbosity >= 10; 256 if $verbosity >= 10;
195 257
196 while (my ($k, $v) = each %$cb) { 258 while (my ($k, $v) = each %$cb) {
197 return 1 if $v->($term, @_); 259 return 1 if $v->($term, @_);
198 } 260 }
199 261
200 0 262 0
201} 263}
202
203# find on_xxx subs in the package and register them
204# as hooks
205sub register_package($) {
206 my ($pkg) = @_;
207
208 for my $hook (0.. $#HOOKNAME) {
209 my $name = $HOOKNAME[$hook];
210
211 my $ref = $pkg->can ("on_" . lc $name)
212 or next;
213
214 $invoke_cb[$hook]{$ref*1} = $ref;
215 set_should_invoke $hook, 1;
216 }
217}
218
219my $script_pkg = "script0000";
220my %script_pkg;
221
222# load a single script into its own package, once only
223sub load_script($) {
224 my ($path) = @_;
225
226 $script_pkg{$path} ||= do {
227 my $pkg = $script_pkg++;
228 verbose 3, "loading script '$path' into package '$pkg'";
229
230 open my $fh, "<:raw", $path
231 or die "$path: $!";
232
233 eval "package $pkg; use strict; use utf8;\n"
234 . "#line 1 \"$path\"\n"
235 . do { local $/; <$fh> }
236 or die "$path: $@";
237
238 register_package $pkg;
239
240 $pkg
241 };
242}
243
244sub load_scripts($) {
245 my ($dir) = @_;
246
247 verbose 3, "loading scripts from '$dir'";
248
249 load_script $_
250 for grep -f $_,
251 <$dir/perl-ext/*>;
252}
253
254sub on_init {
255 my ($term) = @_;
256
257 my $libdir = $term->resource ("perl_lib");
258
259 load_scripts $libdir
260 if defined $libdir;
261}
262
263register_package __PACKAGE__;
264load_scripts $LIBDIR;
265 264
266=back 265=back
267 266
268=head2 The C<urxvt::term> Class 267=head2 The C<urxvt::term> Class
269 268
… …
292 291
293 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 292 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
294 borderLess color cursorBlink cursorUnderline cutchars delete_key 293 borderLess color cursorBlink cursorUnderline cutchars delete_key
295 display_name embed ext_bwidth fade font geometry hold iconName 294 display_name embed ext_bwidth fade font geometry hold iconName
296 imFont imLocale inputMethod insecure int_bwidth intensityStyles 295 imFont imLocale inputMethod insecure int_bwidth intensityStyles
297 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 296 italicFont jumpScroll lineSpace loginShell mapAlert menu meta8 modifier
298 modifier mouseWheelScrollPage name pastableTabs path perl perl_eval 297 mouseWheelScrollPage name pastableTabs path perl_eval perl_ext
299 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd 298 perl_lib pointerBlank pointerBlankDelay preeditType print_pipe pty_fd
300 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating 299 reverseVideo saveLines scrollBar scrollBar_align scrollBar_floating
301 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput 300 scrollBar_right scrollBar_thickness scrollTtyKeypress scrollTtyOutput
302 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle 301 scrollWithBuffer scrollstyle secondaryScreen secondaryScroll selectstyle
303 shade term_name title transparent transparent_all tripleclickwords 302 shade term_name title transparent transparent_all tripleclickwords

Diff Legend

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