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.61 by root, Mon Jan 9 01:36:56 2006 UTC vs.
Revision 1.68 by root, Mon Jan 9 20:00:31 2006 UTC

… …
332newline. The module also overwrites the C<warn> builtin with a function 332newline. The module also overwrites the C<warn> builtin with a function
333that calls this function. 333that calls this function.
334 334
335Using this function has the advantage that its output ends up in the 335Using this function has the advantage that its output ends up in the
336correct place, e.g. on stderr of the connecting urxvtc client. 336correct place, e.g. on stderr of the connecting urxvtc client.
337
338=item $is_safe = urxvt::safe
339
340Returns true when it is safe to do potentially unsafe things, such as
341evaluating perl code specified by the user. This is true when urxvt was
342started setuid or setgid.
337 343
338=item $time = urxvt::NOW 344=item $time = urxvt::NOW
339 345
340Returns the "current time" (as per the event loop). 346Returns the "current time" (as per the event loop).
341 347
… …
439sub verbose { 445sub verbose {
440 my ($level, $msg) = @_; 446 my ($level, $msg) = @_;
441 warn "$msg\n" if $level <= $verbosity; 447 warn "$msg\n" if $level <= $verbosity;
442} 448}
443 449
444# find on_xxx subs in the package and register them
445# as hooks
446sub register_package($) {
447 my ($pkg) = @_;
448
449 for my $htype (0.. $#HOOKNAME) {
450 my $name = $HOOKNAME[$htype];
451
452 my $ref = $pkg->can ("on_" . lc $name)
453 or next;
454
455 $TERM->{_hook}[$htype]{$pkg} = $ref;
456 $hook_count[$htype]++
457 or set_should_invoke $htype, 1;
458 }
459}
460
461my $extension_pkg = "extension0000"; 450my $extension_pkg = "extension0000";
462my %extension_pkg; 451my %extension_pkg;
463 452
464# load a single script into its own package, once only 453# load a single script into its own package, once only
465sub extension_package($) { 454sub extension_package($) {
… …
493 my $htype = shift; 482 my $htype = shift;
494 483
495 if ($htype == 0) { # INIT 484 if ($htype == 0) { # INIT
496 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); 485 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
497 486
498 my %want_ext; 487 my %ext_arg;
499 488
500 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 489 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
501 if ($_ eq "default") { 490 if ($_ eq "default") {
502 $want_ext{$_}++ for qw(selection option-popup selection-popup); 491 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup);
503 } elsif (/^-(.*)$/) { 492 } elsif (/^-(.*)$/) {
504 delete $want_ext{$1}; 493 delete $ext_arg{$1};
494 } elsif (/^([^<]+)<(.*)>$/) {
495 push @{ $ext_arg{$1} }, $2;
505 } else { 496 } else {
506 $want_ext{$_}++; 497 $ext_arg{$_} ||= [];
507 } 498 }
508 } 499 }
509 500
510 for my $ext (keys %want_ext) { 501 while (my ($ext, $argv) = each %ext_arg) {
511 my @files = grep -f $_, map "$_/$ext", @dirs; 502 my @files = grep -f $_, map "$_/$ext", @dirs;
512 503
513 if (@files) { 504 if (@files) {
514 register_package extension_package $files[0]; 505 $TERM->register_package (extension_package $files[0], $argv);
515 } else { 506 } else {
516 warn "perl extension '$ext' not found in perl library search path\n"; 507 warn "perl extension '$ext' not found in perl library search path\n";
517 } 508 }
518 } 509 }
519 510
… …
528 if $verbosity >= 10; 519 if $verbosity >= 10;
529 520
530 keys %$cb; 521 keys %$cb;
531 522
532 while (my ($pkg, $cb) = each %$cb) { 523 while (my ($pkg, $cb) = each %$cb) {
533 eval { 524 $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) }
534 $retval = $cb->(
535 $TERM->{_pkg}{$pkg} ||= do {
536 my $proxy = bless { }, $pkg;
537 Scalar::Util::weaken ($proxy->{term} = $TERM);
538 $proxy
539 },
540 @_,
541 ) and last; 525 and last;
542 }; 526
543 if ($@) { 527 if ($@) {
544 $TERM->ungrab; # better to lose the grab than the session 528 $TERM->ungrab; # better to lose the grab than the session
545 warn $@; 529 warn $@;
546 } 530 }
547 } 531 }
… …
668package urxvt::term; 652package urxvt::term;
669 653
670=head2 The C<urxvt::term> Class 654=head2 The C<urxvt::term> Class
671 655
672=over 4 656=over 4
657
658=cut
659
660# find on_xxx subs in the package and register them
661# as hooks
662sub register_package {
663 my ($self, $pkg, $argv) = @_;
664
665 my $proxy = bless { argv => $argv }, $pkg;
666 Scalar::Util::weaken ($proxy->{term} = $TERM);
667
668 $self->{_pkg}{$pkg} = $proxy;
669
670 for my $htype (0.. $#HOOKNAME) {
671 my $name = $HOOKNAME[$htype];
672
673 my $ref = $pkg->can ("on_" . lc $name)
674 or next;
675
676 $self->{_hook}[$htype]{$pkg} = $ref;
677 $hook_count[$htype]++
678 or urxvt::set_should_invoke $htype, 1;
679 }
680}
673 681
674=item $term->destroy 682=item $term->destroy
675 683
676Destroy the terminal object (close the window, free resources etc.). 684Destroy the terminal object (close the window, free resources etc.).
677 685
… …
911 919
912=item $lines_in_scrollback = $term->nsaved 920=item $lines_in_scrollback = $term->nsaved
913 921
914Return various integers describing terminal characteristics. 922Return various integers describing terminal characteristics.
915 923
924=item $lc_ctype = $term->locale
925
926Returns the LC_CTYPE category string used by this rxvt-unicode.
927
928=item $x_display = $term->display_id
929
930Return the DISPLAY used by rxvt-unicode.
931
916=item $modifiermask = $term->ModLevel3Mask 932=item $modifiermask = $term->ModLevel3Mask
917 933
918=item $modifiermask = $term->ModMetaMask 934=item $modifiermask = $term->ModMetaMask
919 935
920=item $modifiermask = $term->ModNumLockMask 936=item $modifiermask = $term->ModNumLockMask
… …
1109Converts rxvt-unicodes text reprsentation into a perl string. See 1125Converts rxvt-unicodes text reprsentation into a perl string. See
1110C<< $term->ROW_t >> for details. 1126C<< $term->ROW_t >> for details.
1111 1127
1112=item $success = $term->grab_button ($button, $modifiermask) 1128=item $success = $term->grab_button ($button, $modifiermask)
1113 1129
1114Registers a synchronous button grab. See XGrabButton. 1130Registers a synchronous button grab. See the XGrabButton manpage.
1115 1131
1116=item $success = $term->grab ($eventtime[, $sync]) 1132=item $success = $term->grab ($eventtime[, $sync])
1117 1133
1118Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or 1134Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or
1119synchronous (C<$sync> is true). Also remembers the grab timestampe. 1135synchronous (C<$sync> is true). Also remembers the grab timestampe.
… …
1162} 1178}
1163 1179
1164sub add_separator { 1180sub add_separator {
1165 my ($self, $sep) = @_; 1181 my ($self, $sep) = @_;
1166 1182
1167 $sep ||= "═"; 1183 $sep ||= "=";
1168 1184
1169 $self->add_item ({ 1185 $self->add_item ({
1170 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" }, 1186 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" },
1171 text => "", 1187 text => "",
1172 render => sub { $sep x $urxvt::TERM->ncol }, 1188 render => sub { $sep x $self->{term}->ncol },
1173 activate => sub { }, 1189 activate => sub { },
1174 }); 1190 });
1175} 1191}
1176 1192
1177sub add_title { 1193sub add_title {
… …
1185} 1201}
1186 1202
1187sub add_button { 1203sub add_button {
1188 my ($self, $text, $cb) = @_; 1204 my ($self, $text, $cb) = @_;
1189 1205
1190 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb}); 1206 $self->add_item ({ type => "button", text => $text, activate => $cb});
1191} 1207}
1192 1208
1193sub add_toggle { 1209sub add_toggle {
1194 my ($self, $text, $cb, $value) = @_; 1210 my ($self, $text, $cb, $value) = @_;
1195 1211
… …
1207sub show { 1223sub show {
1208 my ($self) = @_; 1224 my ($self) = @_;
1209 1225
1210 local $urxvt::popup::self = $self; 1226 local $urxvt::popup::self = $self;
1211 1227
1228 local $ENV{LC_ALL} = $self->{term}->locale;
1229
1212 urxvt->new ("--perl-lib" => "", "--perl-ext-common" => "", "-pty-fd" => -1, "-sl" => 0, "-b" => 0, 1230 urxvt->new ("--perl-lib" => "", "--perl-ext-common" => "", "-pty-fd" => -1, "-sl" => 0, "-b" => 0,
1213 "--transient-for" => $self->{term}->parent, 1231 "--transient-for" => $self->{term}->parent,
1232 "-display" => $self->{term}->display_id,
1214 "-pe" => "urxvt-popup") 1233 "-pe" => "urxvt-popup")
1215 or die "unable to create popup window\n"; 1234 or die "unable to create popup window\n";
1216} 1235}
1217 1236
1218sub DESTROY { 1237sub DESTROY {

Diff Legend

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