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

… …
205 205
206It is called before lines are scrolled out (so rows 0 .. min ($lines - 1, 206It is called before lines are scrolled out (so rows 0 .. min ($lines - 1,
207$nrow - 1) represent the lines to be scrolled out). C<$saved> is the total 207$nrow - 1) represent the lines to be scrolled out). C<$saved> is the total
208number of lines that will be in the scrollback buffer. 208number of lines that will be in the scrollback buffer.
209 209
210=item on_tty_activity $term *NYI*
211
212Called whenever the program(s) running in the urxvt window send output.
213
214=item on_osc_seq $term, $string 210=item on_osc_seq $term, $string
215 211
216Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC = 212Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC =
217operating system command) is processed. Cursor position and other state 213operating system command) is processed. Cursor position and other state
218information is up-to-date when this happens. For interoperability, the 214information is up-to-date when this happens. For interoperability, the
… …
336newline. The module also overwrites the C<warn> builtin with a function 332newline. The module also overwrites the C<warn> builtin with a function
337that calls this function. 333that calls this function.
338 334
339Using 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
340correct 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.
341 343
342=item $time = urxvt::NOW 344=item $time = urxvt::NOW
343 345
344Returns the "current time" (as per the event loop). 346Returns the "current time" (as per the event loop).
345 347
… …
429 $msg .= "\n" 431 $msg .= "\n"
430 unless $msg =~ /\n$/; 432 unless $msg =~ /\n$/;
431 urxvt::warn ($msg); 433 urxvt::warn ($msg);
432 }; 434 };
433 435
436 delete $ENV{IFS};
437 delete $ENV{CDPATH};
438 delete $ENV{BASH_ENV};
434 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin"; 439 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin";
435 delete $ENV{CDPATH};
436} 440}
437 441
438my @hook_count; 442my @hook_count;
439my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 443my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
440 444
441sub verbose { 445sub verbose {
442 my ($level, $msg) = @_; 446 my ($level, $msg) = @_;
443 warn "$msg\n" if $level <= $verbosity; 447 warn "$msg\n" if $level <= $verbosity;
444}
445
446# find on_xxx subs in the package and register them
447# as hooks
448sub register_package($) {
449 my ($pkg) = @_;
450
451 for my $htype (0.. $#HOOKNAME) {
452 my $name = $HOOKNAME[$htype];
453
454 my $ref = $pkg->can ("on_" . lc $name)
455 or next;
456
457 $TERM->{_hook}[$htype]{$pkg} = $ref;
458 $hook_count[$htype]++
459 or set_should_invoke $htype, 1;
460 }
461} 448}
462 449
463my $extension_pkg = "extension0000"; 450my $extension_pkg = "extension0000";
464my %extension_pkg; 451my %extension_pkg;
465 452
… …
495 my $htype = shift; 482 my $htype = shift;
496 483
497 if ($htype == 0) { # INIT 484 if ($htype == 0) { # INIT
498 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); 485 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
499 486
500 my %want_ext; 487 my %ext_arg;
501 488
502 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 489 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
503 if ($_ eq "default") { 490 if ($_ eq "default") {
504 $want_ext{$_}++ for qw(selection option-popup selection-popup); 491 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup);
505 } elsif (/^-(.*)$/) { 492 } elsif (/^-(.*)$/) {
506 delete $want_ext{$1}; 493 delete $ext_arg{$1};
494 } elsif (/^([^<]+)<(.*)>$/) {
495 push @{ $ext_arg{$1} }, $2;
507 } else { 496 } else {
508 $want_ext{$_}++; 497 $ext_arg{$_} ||= [];
509 } 498 }
510 } 499 }
511 500
512 for my $ext (keys %want_ext) { 501 while (my ($ext, $argv) = each %ext_arg) {
513 my @files = grep -f $_, map "$_/$ext", @dirs; 502 my @files = grep -f $_, map "$_/$ext", @dirs;
514 503
515 if (@files) { 504 if (@files) {
516 register_package extension_package $files[0]; 505 $TERM->register_package (extension_package $files[0], $argv);
517 } else { 506 } else {
518 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";
519 } 508 }
520 } 509 }
521 510
… …
530 if $verbosity >= 10; 519 if $verbosity >= 10;
531 520
532 keys %$cb; 521 keys %$cb;
533 522
534 while (my ($pkg, $cb) = each %$cb) { 523 while (my ($pkg, $cb) = each %$cb) {
535 eval { 524 $retval = eval { $cb->($TERM->{_pkg}{$pkg}, @_) }
536 $retval = $cb->(
537 $TERM->{_pkg}{$pkg} ||= do {
538 my $proxy = bless { }, $pkg;
539 Scalar::Util::weaken ($proxy->{term} = $TERM);
540 $proxy
541 },
542 @_,
543 ) and last; 525 and last;
544 }; 526
545 if ($@) { 527 if ($@) {
546 $TERM->ungrab; # better to lose the grab than the session 528 $TERM->ungrab; # better to lose the grab than the session
547 warn $@; 529 warn $@;
548 } 530 }
549 } 531 }
… …
670package urxvt::term; 652package urxvt::term;
671 653
672=head2 The C<urxvt::term> Class 654=head2 The C<urxvt::term> Class
673 655
674=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}
675 681
676=item $term->destroy 682=item $term->destroy
677 683
678Destroy the terminal object (close the window, free resources etc.). 684Destroy the terminal object (close the window, free resources etc.).
679 685
… …
913 919
914=item $lines_in_scrollback = $term->nsaved 920=item $lines_in_scrollback = $term->nsaved
915 921
916Return various integers describing terminal characteristics. 922Return various integers describing terminal characteristics.
917 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
918=item $modifiermask = $term->ModLevel3Mask 932=item $modifiermask = $term->ModLevel3Mask
919 933
920=item $modifiermask = $term->ModMetaMask 934=item $modifiermask = $term->ModMetaMask
921 935
922=item $modifiermask = $term->ModNumLockMask 936=item $modifiermask = $term->ModNumLockMask
… …
1098 $offset / $self->{ncol} + $self->{beg}, 1112 $offset / $self->{ncol} + $self->{beg},
1099 $offset % $self->{ncol} 1113 $offset % $self->{ncol}
1100 ) 1114 )
1101} 1115}
1102 1116
1103=item ($row, $col) = $line->coord_of ($offset)
1104=item $text = $term->special_encode $string 1117=item $text = $term->special_encode $string
1105 1118
1106Converts a perl string into the special encoding used by rxvt-unicode, 1119Converts a perl string into the special encoding used by rxvt-unicode,
1107where one character corresponds to one screen cell. See 1120where one character corresponds to one screen cell. See
1108C<< $term->ROW_t >> for details. 1121C<< $term->ROW_t >> for details.
… …
1110=item $string = $term->special_decode $text 1123=item $string = $term->special_decode $text
1111 1124
1112Converts rxvt-unicodes text reprsentation into a perl string. See 1125Converts rxvt-unicodes text reprsentation into a perl string. See
1113C<< $term->ROW_t >> for details. 1126C<< $term->ROW_t >> for details.
1114 1127
1128=item $success = $term->grab_button ($button, $modifiermask)
1129
1130Registers a synchronous button grab. See the XGrabButton manpage.
1131
1132=item $success = $term->grab ($eventtime[, $sync])
1133
1134Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or
1135synchronous (C<$sync> is true). Also remembers the grab timestampe.
1136
1137=item $term->allow_events_async
1138
1139Calls XAllowEvents with AsyncBoth for the most recent grab.
1140
1141=item $term->allow_events_sync
1142
1143Calls XAllowEvents with SyncBoth for the most recent grab.
1144
1145=item $term->allow_events_replay
1146
1147Calls XAllowEvents with both ReplayPointer and ReplayKeyboard for the most
1148recent grab.
1149
1150=item $term->ungrab
1151
1152Calls XUngrab for the most recent grab. Is called automatically on
1153evaluation errors, as it is better to lose the grab in the error case as
1154the session.
1155
1115=back 1156=back
1116 1157
1117=cut 1158=cut
1118 1159
1119package urxvt::popup; 1160package urxvt::popup;
… …
1137} 1178}
1138 1179
1139sub add_separator { 1180sub add_separator {
1140 my ($self, $sep) = @_; 1181 my ($self, $sep) = @_;
1141 1182
1142 $sep ||= "═"; 1183 $sep ||= "=";
1143 1184
1144 $self->add_item ({ 1185 $self->add_item ({
1145 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" },
1146 text => "", 1187 text => "",
1147 render => sub { $sep x $urxvt::TERM->ncol }, 1188 render => sub { $sep x $self->{term}->ncol },
1148 activate => sub { }, 1189 activate => sub { },
1149 }); 1190 });
1150} 1191}
1151 1192
1152sub add_title { 1193sub add_title {
… …
1160} 1201}
1161 1202
1162sub add_button { 1203sub add_button {
1163 my ($self, $text, $cb) = @_; 1204 my ($self, $text, $cb) = @_;
1164 1205
1165 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb}); 1206 $self->add_item ({ type => "button", text => $text, activate => $cb});
1166} 1207}
1167 1208
1168sub add_toggle { 1209sub add_toggle {
1169 my ($self, $text, $cb, $value) = @_; 1210 my ($self, $text, $cb, $value) = @_;
1170 1211
… …
1182sub show { 1223sub show {
1183 my ($self) = @_; 1224 my ($self) = @_;
1184 1225
1185 local $urxvt::popup::self = $self; 1226 local $urxvt::popup::self = $self;
1186 1227
1228 local $ENV{LC_ALL} = $self->{term}->locale;
1229
1187 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,
1188 "--transient-for" => $self->{term}->parent, 1231 "--transient-for" => $self->{term}->parent,
1232 "-display" => $self->{term}->display_id,
1189 "-pe" => "urxvt-popup") 1233 "-pe" => "urxvt-popup")
1190 or die "unable to create popup window\n"; 1234 or die "unable to create popup window\n";
1191} 1235}
1192 1236
1193sub DESTROY { 1237sub DESTROY {

Diff Legend

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