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.48 by root, Sat Jan 7 21:43:17 2006 UTC vs.
Revision 1.62 by root, Mon Jan 9 02:06:43 2006 UTC

37 37
38 @@RXVT_NAME@@ -pe <extensionname> 38 @@RXVT_NAME@@ -pe <extensionname>
39 39
40=over 4 40=over 4
41 41
42=item selection 42=item selection (enabled by default)
43 43
44Intelligent selection. This extension tries to be more intelligent when 44Intelligent selection. This extension tries to be more intelligent when
45the user extends selections (double-click). Right now, it tries to select 45the user extends selections (double-click). Right now, it tries to select
46urls and complete shell-quoted arguments, which is very convenient, too, 46urls and complete shell-quoted arguments, which is very convenient, too,
47if your F<ls> supports C<--quoting-style=shell>. 47if your F<ls> supports C<--quoting-style=shell>.
55Rot-13 the selection when activated. Used via keyboard trigger: 55Rot-13 the selection when activated. Used via keyboard trigger:
56 56
57 URxvt.keysym.C-M-r: perl:selection:rot13 57 URxvt.keysym.C-M-r: perl:selection:rot13
58 58
59=back 59=back
60
61=item option-popup (enabled by default)
62
63Binds a popup menu to Ctrl-Button2 that lets you toggle (some) options at
64runtime.
65
66=item selection-popup (enabled by default)
67
68Binds a popup menu to Ctrl-Button3 that lets you convert the selection
69text into various other formats/action.
60 70
61=item digital-clock 71=item digital-clock
62 72
63Displays a digital clock using the built-in overlay. 73Displays a digital clock using the built-in overlay.
64 74
195 205
196It 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,
197$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
198number of lines that will be in the scrollback buffer. 208number of lines that will be in the scrollback buffer.
199 209
200=item on_tty_activity $term *NYI*
201
202Called whenever the program(s) running in the urxvt window send output.
203
204=item on_osc_seq $term, $string 210=item on_osc_seq $term, $string
205 211
206Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC = 212Called whenever the B<ESC ] 777 ; string ST> command sequence (OSC =
207operating system command) is processed. Cursor position and other state 213operating system command) is processed. Cursor position and other state
208information is up-to-date when this happens. For interoperability, the 214information is up-to-date when this happens. For interoperability, the
327that calls this function. 333that calls this function.
328 334
329Using 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
330correct place, e.g. on stderr of the connecting urxvtc client. 336correct place, e.g. on stderr of the connecting urxvtc client.
331 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.
343
332=item $time = urxvt::NOW 344=item $time = urxvt::NOW
333 345
334Returns the "current time" (as per the event loop). 346Returns the "current time" (as per the event loop).
335 347
336=item urxvt::CurrentTime 348=item urxvt::CurrentTime
337 349
338=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask, 350=item urxvt::ShiftMask, LockMask, ControlMask, Mod1Mask, Mod2Mask,
339Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask, 351Mod3Mask, Mod4Mask, Mod5Mask, Button1Mask, Button2Mask, Button3Mask,
340Button4Mask, Button5Mask, AnyModifier 352Button4Mask, Button5Mask, AnyModifier
341 353
342Various constants for use in X events. 354Various constants for use in X calls and event processing.
343 355
344=back 356=back
345 357
346=head2 RENDITION 358=head2 RENDITION
347 359
402use utf8; 414use utf8;
403use strict; 415use strict;
404use Scalar::Util (); 416use Scalar::Util ();
405use List::Util (); 417use List::Util ();
406 418
419our $VERSION = 1;
407our $TERM; 420our $TERM;
408our @HOOKNAME; 421our @HOOKNAME;
422our %OPTION;
409our $LIBDIR; 423our $LIBDIR;
410 424
411BEGIN { 425BEGIN {
412 urxvt->bootstrap; 426 urxvt->bootstrap;
413 427
416 my $msg = join "", @_; 430 my $msg = join "", @_;
417 $msg .= "\n" 431 $msg .= "\n"
418 unless $msg =~ /\n$/; 432 unless $msg =~ /\n$/;
419 urxvt::warn ($msg); 433 urxvt::warn ($msg);
420 }; 434 };
435
436 delete $ENV{IFS};
437 delete $ENV{CDPATH};
438 delete $ENV{BASH_ENV};
439 $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/opt/bin:/opt/sbin";
421} 440}
422 441
423my @hook_count; 442my @hook_count;
424my $verbosity = $ENV{URXVT_PERL_VERBOSITY}; 443my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
425 444
458 verbose 3, "loading extension '$path' into package '$pkg'"; 477 verbose 3, "loading extension '$path' into package '$pkg'";
459 478
460 open my $fh, "<:raw", $path 479 open my $fh, "<:raw", $path
461 or die "$path: $!"; 480 or die "$path: $!";
462 481
463 my $source = "package $pkg; use strict; use utf8;\n" 482 my $source = untaint "package $pkg; use strict; use utf8;\n"
464 . "use base urxvt::term::proxy::;\n" 483 . "use base urxvt::term::proxy::;\n"
465 . "#line 1 \"$path\"\n{\n" 484 . "#line 1 \"$path\"\n{\n"
466 . (do { local $/; <$fh> }) 485 . (do { local $/; <$fh> })
467 . "\n};\n1"; 486 . "\n};\n1";
468 487
479 local $TERM = shift; 498 local $TERM = shift;
480 my $htype = shift; 499 my $htype = shift;
481 500
482 if ($htype == 0) { # INIT 501 if ($htype == 0) { # INIT
483 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl"); 502 my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$LIBDIR/perl");
503
504 my %want_ext;
484 505
485 for my $ext (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) { 506 for (map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {
507 if ($_ eq "default") {
508 $want_ext{$_}++ for qw(selection option-popup selection-popup);
509 } elsif (/^-(.*)$/) {
510 delete $want_ext{$1};
511 } else {
512 $want_ext{$_}++;
513 }
514 }
515
516 for my $ext (keys %want_ext) {
486 my @files = grep -f $_, map "$_/$ext", @dirs; 517 my @files = grep -f $_, map "$_/$ext", @dirs;
487 518
488 if (@files) { 519 if (@files) {
489 register_package extension_package $files[0]; 520 register_package extension_package $files[0];
490 } else { 521 } else {
491 warn "perl extension '$ext' not found in perl library search path\n"; 522 warn "perl extension '$ext' not found in perl library search path\n";
492 } 523 }
493 } 524 }
525
526 eval "#line 1 \"--perl-eval resource/argument\"\n" . $TERM->resource ("perl_eval");
527 warn $@ if $@;
494 } 528 }
495 529
496 $retval = undef; 530 $retval = undef;
497 531
498 if (my $cb = $TERM->{_hook}[$htype]) { 532 if (my $cb = $TERM->{_hook}[$htype]) {
510 $proxy 544 $proxy
511 }, 545 },
512 @_, 546 @_,
513 ) and last; 547 ) and last;
514 }; 548 };
515 warn $@ if $@;#d# 549 if ($@) {
550 $TERM->ungrab; # better to lose the grab than the session
551 warn $@;
552 }
516 } 553 }
517 } 554 }
518 555
519 if ($htype == 1) { # DESTROY 556 if ($htype == 1) { # DESTROY
520 # remove hooks if unused 557 # remove hooks if unused
533 } 570 }
534 571
535 $retval 572 $retval
536} 573}
537 574
575# urxvt::term::proxy
576
538sub urxvt::term::proxy::AUTOLOAD { 577sub urxvt::term::proxy::AUTOLOAD {
539 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/ 578 $urxvt::term::proxy::AUTOLOAD =~ /:([^:]+)$/
540 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable"; 579 or die "FATAL: \$AUTOLOAD '$urxvt::term::proxy::AUTOLOAD' unparsable";
541 580
542 eval qq{ 581 eval qq{
548 } or die "FATAL: unable to compile method forwarder: $@"; 587 } or die "FATAL: unable to compile method forwarder: $@";
549 588
550 goto &$urxvt::term::proxy::AUTOLOAD; 589 goto &$urxvt::term::proxy::AUTOLOAD;
551} 590}
552 591
592sub urxvt::term::proxy::DESTROY {
593 # nop
594}
595
596# urxvt::destroy_hook
597
553sub urxvt::destroy_hook::DESTROY { 598sub urxvt::destroy_hook::DESTROY {
554 ${$_[0]}->(); 599 ${$_[0]}->();
555} 600}
556 601
557sub urxvt::destroy_hook(&) { 602sub urxvt::destroy_hook(&) {
558 bless \shift, urxvt::destroy_hook:: 603 bless \shift, urxvt::destroy_hook::
559} 604}
560 605
606package urxvt::anyevent;
607
608=head2 The C<urxvt::anyevent> Class
609
610The sole purpose of this class is to deliver an interface to the
611C<AnyEvent> module - any module using it will work inside urxvt without
612further work. The only exception is that you cannot wait on condition
613variables, but non-blocking condvar use is ok. What this means is that you
614cannot use blocking APIs, but the non-blocking variant should work.
615
616=cut
617
618our $VERSION = 1;
619
620$INC{"urxvt/anyevent.pm"} = 1; # mark us as there
621push @AnyEvent::REGISTRY, [urxvt => urxvt::anyevent::];
622
623sub timer {
624 my ($class, %arg) = @_;
625
626 my $cb = $arg{cb};
627
628 urxvt::timer
629 ->new
630 ->start (urxvt::NOW + $arg{after})
631 ->cb (sub {
632 $_[0]->stop; # need to cancel manually
633 $cb->();
634 })
635}
636
637sub io {
638 my ($class, %arg) = @_;
639
640 my $cb = $arg{cb};
641
642 bless [$arg{fh}, urxvt::iow
643 ->new
644 ->fd (fileno $arg{fh})
645 ->events (($arg{poll} =~ /r/ ? 1 : 0)
646 | ($arg{poll} =~ /w/ ? 2 : 0))
647 ->start
648 ->cb (sub {
649 $cb->(($_[1] & 1 ? 'r' : '')
650 . ($_[1] & 2 ? 'w' : ''));
651 })],
652 urxvt::anyevent::
653}
654
655sub DESTROY {
656 $_[0][1]->stop;
657}
658
659sub condvar {
660 bless \my $flag, urxvt::anyevent::condvar::
661}
662
663sub urxvt::anyevent::condvar::broadcast {
664 ${$_[0]}++;
665}
666
667sub urxvt::anyevent::condvar::wait {
668 unless (${$_[0]}) {
669 require Carp;
670 Carp::croak ("AnyEvent->condvar blocking wait unsupported in urxvt, use a non-blocking API");
671 }
672}
673
674package urxvt::term;
675
561=head2 The C<urxvt::term> Class 676=head2 The C<urxvt::term> Class
562 677
563=over 4 678=over 4
564 679
565=item $term->destroy 680=item $term->destroy
566 681
567Destroy the terminal object (close the window, free resources etc.). 682Destroy the terminal object (close the window, free resources etc.).
683
684=item $isset = $term->option ($optval[, $set])
685
686Returns true if the option specified by C<$optval> is enabled, and
687optionally change it. All option values are stored by name in the hash
688C<%urxvt::OPTION>. Options not enabled in this binary are not in the hash.
689
690Here is a a likely non-exhaustive list of option names, please see the
691source file F</src/optinc.h> to see the actual list:
692
693 borderLess console cursorBlink cursorUnderline hold iconic insecure
694 intensityStyles jumpScroll loginShell mapAlert meta8 mouseWheelScrollPage
695 pastableTabs pointerBlank reverseVideo scrollBar scrollBar_floating
696 scrollBar_right scrollTtyKeypress scrollTtyOutput scrollWithBuffer
697 secondaryScreen secondaryScroll skipBuiltinGlyphs transparent
698 tripleclickwords utmpInhibit visualBell
568 699
569=item $value = $term->resource ($name[, $newval]) 700=item $value = $term->resource ($name[, $newval])
570 701
571Returns the current resource value associated with a given name and 702Returns the current resource value associated with a given name and
572optionally sets a new value. Setting values is most useful in the C<init> 703optionally sets a new value. Setting values is most useful in the C<init>
582 713
583Please note that resource strings will currently only be freed when the 714Please note that resource strings will currently only be freed when the
584terminal is destroyed, so changing options frequently will eat memory. 715terminal is destroyed, so changing options frequently will eat memory.
585 716
586Here is a a likely non-exhaustive list of resource names, not all of which 717Here is a a likely non-exhaustive list of resource names, not all of which
587are supported in every build, please see the source to see the actual 718are supported in every build, please see the source file F</src/rsinc.h>
588list: 719to see the actual list:
589 720
590 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont 721 answerbackstring backgroundPixmap backspace_key boldFont boldItalicFont
591 borderLess color cursorBlink cursorUnderline cutchars delete_key 722 borderLess color cursorBlink cursorUnderline cutchars delete_key
592 display_name embed ext_bwidth fade font geometry hold iconName 723 display_name embed ext_bwidth fade font geometry hold iconName
593 imFont imLocale inputMethod insecure int_bwidth intensityStyles 724 imFont imLocale inputMethod insecure int_bwidth intensityStyles
600 shade term_name title transparent transparent_all tripleclickwords 731 shade term_name title transparent transparent_all tripleclickwords
601 utmpInhibit visualBell 732 utmpInhibit visualBell
602 733
603=cut 734=cut
604 735
605sub urxvt::term::resource($$;$) { 736sub resource($$;$) {
606 my ($self, $name) = (shift, shift); 737 my ($self, $name) = (shift, shift);
607 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0); 738 unshift @_, $self, $name, ($name =~ s/\s*\+\s*(\d+)$// ? $1 : 0);
608 &urxvt::term::_resource 739 &urxvt::term::_resource
609} 740}
610 741
697C<$event> I<must> be the event causing the menu to pop up (a button event, 828C<$event> I<must> be the event causing the menu to pop up (a button event,
698currently). 829currently).
699 830
700=cut 831=cut
701 832
702sub urxvt::term::popup { 833sub popup {
703 my ($self, $event) = @_; 834 my ($self, $event) = @_;
704 835
705 $self->grab ($event->{time}, 1) 836 $self->grab ($event->{time}, 1)
706 or return; 837 or return;
707 838
897 1028
898=back 1029=back
899 1030
900=cut 1031=cut
901 1032
902sub urxvt::term::line { 1033sub line {
903 my ($self, $row) = @_; 1034 my ($self, $row) = @_;
904 1035
905 my $maxrow = $self->nrow - 1; 1036 my $maxrow = $self->nrow - 1;
906 1037
907 my ($beg, $end) = ($row, $row); 1038 my ($beg, $end) = ($row, $row);
971 $offset / $self->{ncol} + $self->{beg}, 1102 $offset / $self->{ncol} + $self->{beg},
972 $offset % $self->{ncol} 1103 $offset % $self->{ncol}
973 ) 1104 )
974} 1105}
975 1106
976=item ($row, $col) = $line->coord_of ($offset)
977=item $text = $term->special_encode $string 1107=item $text = $term->special_encode $string
978 1108
979Converts a perl string into the special encoding used by rxvt-unicode, 1109Converts a perl string into the special encoding used by rxvt-unicode,
980where one character corresponds to one screen cell. See 1110where one character corresponds to one screen cell. See
981C<< $term->ROW_t >> for details. 1111C<< $term->ROW_t >> for details.
983=item $string = $term->special_decode $text 1113=item $string = $term->special_decode $text
984 1114
985Converts rxvt-unicodes text reprsentation into a perl string. See 1115Converts rxvt-unicodes text reprsentation into a perl string. See
986C<< $term->ROW_t >> for details. 1116C<< $term->ROW_t >> for details.
987 1117
1118=item $success = $term->grab_button ($button, $modifiermask)
1119
1120Registers a synchronous button grab. See XGrabButton.
1121
1122=item $success = $term->grab ($eventtime[, $sync])
1123
1124Calls XGrabPointer and XGrabKeyboard in asynchronous (default) or
1125synchronous (C<$sync> is true). Also remembers the grab timestampe.
1126
1127=item $term->allow_events_async
1128
1129Calls XAllowEvents with AsyncBoth for the most recent grab.
1130
1131=item $term->allow_events_sync
1132
1133Calls XAllowEvents with SyncBoth for the most recent grab.
1134
1135=item $term->allow_events_replay
1136
1137Calls XAllowEvents with both ReplayPointer and ReplayKeyboard for the most
1138recent grab.
1139
1140=item $term->ungrab
1141
1142Calls XUngrab for the most recent grab. Is called automatically on
1143evaluation errors, as it is better to lose the grab in the error case as
1144the session.
1145
988=back 1146=back
989 1147
1148=cut
1149
1150package urxvt::popup;
1151
990=head2 The C<urxvt::popup> Class 1152=head2 The C<urxvt::popup> Class
991 1153
992=over 4 1154=over 4
993 1155
994=cut 1156=cut
995
996package urxvt::popup;
997 1157
998sub add_item { 1158sub add_item {
999 my ($self, $item) = @_; 1159 my ($self, $item) = @_;
1000 1160
1161 $item->{rend}{normal} = "\x1b[0;30;47m" unless exists $item->{rend}{normal};
1162 $item->{rend}{hover} = "\x1b[0;30;46m" unless exists $item->{rend}{hover};
1163 $item->{rend}{active} = "\x1b[m" unless exists $item->{rend}{active};
1164
1165 $item->{render} ||= sub { $_[0]{text} };
1166
1001 push @{ $self->{item} }, $item; 1167 push @{ $self->{item} }, $item;
1168}
1169
1170sub add_separator {
1171 my ($self, $sep) = @_;
1172
1173 $sep ||= "═";
1174
1175 $self->add_item ({
1176 rend => { normal => "\x1b[0;30;47m", hover => "\x1b[0;30;47m", active => "\x1b[0;30;47m" },
1177 text => "",
1178 render => sub { $sep x $urxvt::TERM->ncol },
1179 activate => sub { },
1180 });
1181}
1182
1183sub add_title {
1184 my ($self, $title) = @_;
1185
1186 $self->add_item ({
1187 rend => { normal => "\x1b[38;5;11;44m", hover => "\x1b[38;5;11;44m", active => "\x1b[38;5;11;44m" },
1188 text => $title,
1189 activate => sub { },
1190 });
1002} 1191}
1003 1192
1004sub add_button { 1193sub add_button {
1005 my ($self, $text, $cb) = @_; 1194 my ($self, $text, $cb) = @_;
1006 1195
1007 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb, 1196 $self->add_item ({ type => "button", text => "[ $text ]", activate => $cb});
1008 render => sub { $_[0]{text} },
1009 });
1010} 1197}
1011 1198
1012sub add_toggle { 1199sub add_toggle {
1013 my ($self, $text, $cb, $value) = @_; 1200 my ($self, $text, $cb, $value) = @_;
1014 1201
1015 $self->add_item ({ type => "button", text => " $text", value => $value, 1202 my $item; $item = {
1203 type => "button",
1204 text => " $text",
1205 value => $value,
1016 render => sub { ($_[0]{value} ? "" : " ") . substr $_[0]{text}, 1 }, 1206 render => sub { ($_[0]{value} ? "* " : " ") . $text },
1017 activate => sub { $cb->($_[0]{value} = !$_[0]{value}); }, 1207 activate => sub { $cb->($_[0]{value} = !$_[0]{value}); },
1018 }); 1208 };
1209
1210 $self->add_item ($item);
1019} 1211}
1020 1212
1021sub show { 1213sub show {
1022 my ($self) = @_; 1214 my ($self) = @_;
1023 1215
1030} 1222}
1031 1223
1032sub DESTROY { 1224sub DESTROY {
1033 my ($self) = @_; 1225 my ($self) = @_;
1034 1226
1227 delete $self->{term}{_destroy}{$self};
1035 $self->{term}->ungrab; 1228 $self->{term}->ungrab;
1036} 1229}
1037 1230
1038=head2 The C<urxvt::timer> Class 1231=head2 The C<urxvt::timer> Class
1039 1232
1143This variable controls the verbosity level of the perl extension. Higher 1336This variable controls the verbosity level of the perl extension. Higher
1144numbers indicate more verbose output. 1337numbers indicate more verbose output.
1145 1338
1146=over 4 1339=over 4
1147 1340
1148=item =0 - only fatal messages 1341=item == 0 - fatal messages
1149 1342
1150=item =3 - script loading and management 1343=item >= 3 - script loading and management
1151 1344
1152=item =10 - all events received 1345=item >=10 - all events received
1153 1346
1154=back 1347=back
1155 1348
1156=head1 AUTHOR 1349=head1 AUTHOR
1157 1350

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines