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.228 by sf-exg, Tue Oct 29 14:12:58 2013 UTC vs.
Revision 1.241 by sf-exg, Fri Oct 10 14:38:02 2014 UTC

281 281
282=item on_refresh_end $term 282=item on_refresh_end $term
283 283
284Called just after the screen gets redrawn. See C<on_refresh_begin>. 284Called just after the screen gets redrawn. See C<on_refresh_begin>.
285 285
286=item on_user_command $term, $string 286=item on_user_command $term, $string *DEPRECATED*
287 287
288Called whenever a user-configured event is being activated (e.g. via 288Called whenever a user-configured event is being activated (e.g. via
289a C<perl:string> action bound to a key, see description of the B<keysym> 289a C<perl:string> action bound to a key, see description of the B<keysym>
290resource in the urxvt(1) manpage). 290resource in the urxvt(1) manpage).
291 291
292The event is simply the action string. This interface is assumed to change 292The event is simply the action string. This interface is going away in
293slightly in the future. 293preference to the C<on_action> hook.
294
295=item on_register_command $term, $keysym, $modifiermask, $string
296
297Called after parsing a keysym resource but before registering the
298associated binding. If this hook returns TRUE the binding is not
299registered. It can be used to modify a binding by calling
300C<register_command>.
301 294
302=item on_resize_all_windows $term, $new_width, $new_height 295=item on_resize_all_windows $term, $new_width, $new_height
303 296
304Called just after the new window size has been calculated, but before 297Called just after the new window size has been calculated, but before
305windows are actually being resized or hints are being set. If this hook 298windows are actually being resized or hints are being set. If this hook
306returns TRUE, setting of the window hints is being skipped. 299returns a true value, setting of the window hints is being skipped.
307 300
308=item on_x_event $term, $event 301=item on_x_event $term, $event
309 302
310Called on every X event received on the vt window (and possibly other 303Called on every X event received on the vt window (and possibly other
311windows). Should only be used as a last resort. Most event structure 304windows). Should only be used as a last resort. Most event structure
350manpage), with the additional members C<row> and C<col>, which are the 343manpage), with the additional members C<row> and C<col>, which are the
351(real, not screen-based) row and column under the mouse cursor. 344(real, not screen-based) row and column under the mouse cursor.
352 345
353C<on_key_press> additionally receives the string rxvt-unicode would 346C<on_key_press> additionally receives the string rxvt-unicode would
354output, if any, in locale-specific encoding. 347output, if any, in locale-specific encoding.
355
356subwindow.
357 348
358=item on_client_message $term, $event 349=item on_client_message $term, $event
359 350
360=item on_wm_protocols $term, $event 351=item on_wm_protocols $term, $event
361 352
564no warnings 'utf8'; 555no warnings 'utf8';
565 556
566sub parse_resource { 557sub parse_resource {
567 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
568 559
569 $name =~ y/-/./ if $isarg;
570
571 $term->scan_meta; 560 $term->scan_extensions;
572 561
573 my $r = $term->{meta}{resource}; 562 my $r = $term->{meta}{resource};
574 keys %$r; # reset iterator 563 keys %$r; # reset iterator
575 while (my ($pattern, $v) = each %$r) { 564 while (my ($k, $v) = each %$r) {
576 if ( 565 my $pattern = $k;
566 $pattern =~ y/./-/ if $isarg;
567 my $prefix = $name;
568 my $suffix;
577 $pattern =~ /\.$/ 569 if ($pattern =~ /\-$/) {
578 ? $pattern eq substr $name, 0, length $pattern 570 $prefix = substr $name, 0, length $pattern;
579 : $pattern eq $name 571 $suffix = substr $name, length $pattern;
580 ) { 572 }
573 if ($pattern eq $prefix) {
581 $name = "$urxvt::RESCLASS.$name"; 574 $name = "$urxvt::RESCLASS.$k$suffix";
582 575
583 push @{ $term->{perl_ext_3} }, $v->[0]; 576 push @{ $term->{perl_ext_3} }, $v->[0];
584 577
585 if ($v->[1] eq "boolean") { 578 if ($v->[1] eq "boolean") {
586 $term->put_option_db ($name, $flag ? "true" : "false"); 579 $term->put_option_db ($name, $flag ? "true" : "false");
596} 589}
597 590
598sub usage { 591sub usage {
599 my ($term, $usage_type) = @_; 592 my ($term, $usage_type) = @_;
600 593
601 $term->scan_meta; 594 $term->scan_extensions;
602 595
603 my $r = $term->{meta}{resource}; 596 my $r = $term->{meta}{resource};
604 597
605 for my $pattern (sort keys %$r) { 598 for my $pattern (sort keys %$r) {
606 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 599 my ($ext, $type, $desc) = @{ $r->{$pattern} };
667# called by the rxvt core 660# called by the rxvt core
668sub invoke { 661sub invoke {
669 local $TERM = shift; 662 local $TERM = shift;
670 my $htype = shift; 663 my $htype = shift;
671 664
672 if ($htype == 0) { # INIT 665 if ($htype == HOOK_INIT) {
673 my @dirs = $TERM->perl_libdirs; 666 my @dirs = $TERM->perl_libdirs;
667
668 $TERM->scan_extensions;
674 669
675 my %ext_arg; 670 my %ext_arg;
676 671
677 { 672 {
678 my @init = @TERM_INIT; 673 my @init = @TERM_INIT;
682 @TERM_EXT = (); 677 @TERM_EXT = ();
683 $TERM->register_package ($_) for @pkg; 678 $TERM->register_package ($_) for @pkg;
684 } 679 }
685 680
686 for ( 681 for (
687 @{ delete $TERM->{perl_ext_3} },
688 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2 682 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
689 ) { 683 ) {
690 if ($_ eq "default") { 684 if ($_ eq "default") {
691 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 685
686 $ext_arg{$_} = []
687 for
688 qw(selection option-popup selection-popup readline),
689 @{ delete $TERM->{perl_ext_3} },
690 map $_->[0], values %{ $TERM->{meta}{binding} };
691
692 for ($TERM->_keysym_resources) {
693 next if /^(?:string|command|builtin|builtin-string|perl)/;
694 next unless /^([A-Za-z0-9_\-]+):/;
695
696 my $ext = $1;
697
698 $ext_arg{$ext} = [];
699 }
700
692 } elsif (/^-(.*)$/) { 701 } elsif (/^-(.*)$/) {
693 delete $ext_arg{$1}; 702 delete $ext_arg{$1};
703
694 } elsif (/^([^<]+)<(.*)>$/) { 704 } elsif (/^([^<]+)<(.*)>$/) {
695 push @{ $ext_arg{$1} }, $2; 705 push @{ $ext_arg{$1} }, $2;
706
696 } else { 707 } else {
697 $ext_arg{$_} ||= []; 708 $ext_arg{$_} ||= [];
709 }
710 }
711
712 # now register default key bindings
713 for my $ext (sort keys %ext_arg) {
714 while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) {
715 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
698 } 716 }
699 } 717 }
700 718
701 for my $ext (sort keys %ext_arg) { 719 for my $ext (sort keys %ext_arg) {
702 my @files = grep -f $_, map "$_/$ext", @dirs; 720 my @files = grep -f $_, map "$_/$ext", @dirs;
716 734
717 if (my $cb = $TERM->{_hook}[$htype]) { 735 if (my $cb = $TERM->{_hook}[$htype]) {
718 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 736 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
719 if $verbosity >= 10; 737 if $verbosity >= 10;
720 738
739 if ($htype == HOOK_ACTION) {
740 # this hook is only sent to the extension with the name
741 # matching the first arg
742 my $pkg = shift;
743 $pkg =~ y/-/_/;
744 $pkg = "urxvt::ext::$pkg";
745
746 $cb = $cb->{$pkg}
747 or return undef; #TODO: maybe warn user?
748
749 $cb = { $pkg => $cb };
750 }
751
721 for my $pkg (keys %$cb) { 752 for my $pkg (keys %$cb) {
722 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 753 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
723 $retval ||= $retval_; 754 $retval ||= $retval_;
724 755
725 if ($@) { 756 if ($@) {
730 761
731 verbose 11, "$HOOKNAME[$htype] returning <$retval>" 762 verbose 11, "$HOOKNAME[$htype] returning <$retval>"
732 if $verbosity >= 11; 763 if $verbosity >= 11;
733 } 764 }
734 765
735 if ($htype == 1) { # DESTROY 766 if ($htype == HOOK_DESTROY) {
736 # clear package objects 767 # clear package objects
737 %$_ = () for values %{ $TERM->{_pkg} }; 768 %$_ = () for values %{ $TERM->{_pkg} };
738 769
739 # clear package 770 # clear package
740 %$TERM = (); 771 %$TERM = ();
827} 858}
828 859
829=item $self->enable ($hook_name => $cb[, $hook_name => $cb..]) 860=item $self->enable ($hook_name => $cb[, $hook_name => $cb..])
830 861
831Dynamically enable the given hooks (named without the C<on_> prefix) for 862Dynamically enable the given hooks (named without the C<on_> prefix) for
832this extension, replacing any previous hook. This is useful when you want 863this extension, replacing any hook previously installed via C<enable> in
833to overwrite time-critical hooks only temporarily. 864this extension.
865
866This is useful when you want to overwrite time-critical hooks only
867temporarily.
834 868
835To install additional callbacks for the same hook, you can use the C<on> 869To install additional callbacks for the same hook, you can use the C<on>
836method of the C<urxvt::term> class. 870method of the C<urxvt::term> class.
837 871
838=item $self->disable ($hook_name[, $hook_name..]) 872=item $self->disable ($hook_name[, $hook_name..])
1062 $ENV{URXVT_PERL_LIB}, 1096 $ENV{URXVT_PERL_LIB},
1063 "$ENV{HOME}/.urxvt/ext", 1097 "$ENV{HOME}/.urxvt/ext",
1064 "$LIBDIR/perl" 1098 "$LIBDIR/perl"
1065} 1099}
1066 1100
1067sub scan_meta { 1101# scan for available extensions and collect their metadata
1102sub scan_extensions {
1068 my ($self) = @_; 1103 my ($self) = @_;
1104
1105 return if exists $self->{meta};
1106
1069 my @libdirs = perl_libdirs $self; 1107 my @libdirs = perl_libdirs $self;
1070 1108
1071 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1109# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1072 1110
1073 my %meta;
1074
1075 $self->{meta_libdirs} = join "\x00", @libdirs; 1111# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1076 $self->{meta} = \%meta; 1112 $self->{meta} = \my %meta;
1077 1113
1114 # first gather extensions
1078 for my $dir (reverse @libdirs) { 1115 for my $dir (reverse @libdirs) {
1079 opendir my $fh, $dir 1116 opendir my $fh, $dir
1080 or next; 1117 or next;
1081 for my $ext (readdir $fh) { 1118 for my $ext (readdir $fh) {
1082 $ext !~ /^\./ 1119 $ext !~ /^\./
1083 and open my $fh, "<", "$dir/$ext" 1120 and open my $fh, "<", "$dir/$ext"
1084 or next; 1121 or next;
1085 1122
1123 my %ext = (dir => $dir);
1124
1086 while (<$fh>) { 1125 while (<$fh>) {
1087 if (/^#:META:X_RESOURCE:(.*)/) { 1126 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1088 my ($pattern, $type, $desc) = split /:/, $1; 1127 my ($pattern, $type, $desc) = split /:/, $1;
1089 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1128 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1090 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1129 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1091 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1130 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1092 } else { 1131 } else {
1093 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1132 $ext{resource}{$pattern} = [$ext, $type, $desc];
1094 } 1133 }
1134 } elsif (/^#:META:BINDING:(.*)/) {
1135 my ($keysym, $action) = split /:/, $1;
1136 $ext{binding}{$keysym} = [$ext, $action];
1095 } elsif (/^\s*(?:#|$)/) { 1137 } elsif (/^\s*(?:#|$)/) {
1096 # skip other comments and empty lines 1138 # skip other comments and empty lines
1097 } else { 1139 } else {
1098 last; # stop parsing on first non-empty non-comment line 1140 last; # stop parsing on first non-empty non-comment line
1099 } 1141 }
1100 } 1142 }
1143
1144 $meta{ext}{$ext} = \%ext;
1101 } 1145 }
1146 }
1147
1148 # and now merge resources and bindings
1149 while (my ($k, $v) = each %{ $meta{ext} }) {
1150 #TODO: should check for extensions overriding each other
1151 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1152 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1102 } 1153 }
1103} 1154}
1104 1155
1105=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1156=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1106 1157
1252 my $res = &x_resource; 1303 my $res = &x_resource;
1253 1304
1254 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1305 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1255} 1306}
1256 1307
1257=item $success = $term->parse_keysym ($key, $octets) 1308=item $success = $term->bind_action ($key, $octets)
1258 1309
1259Adds a key binding exactly as specified via a resource. See the 1310Adds a key binding exactly as specified via a C<keysym> resource. See the
1260C<keysym> resource in the urxvt(1) manpage. 1311C<keysym> resource in the urxvt(1) manpage.
1261
1262=item $term->register_command ($keysym, $modifiermask, $string)
1263
1264Adds a key binding. This is a lower level api compared to
1265C<parse_keysym>, as it expects a parsed key description, and can be
1266used only inside either the C<on_init> hook, to add a binding, or the
1267C<on_register_command> hook, to modify a parsed binding.
1268 1312
1269=item $rend = $term->rstyle ([$new_rstyle]) 1313=item $rend = $term->rstyle ([$new_rstyle])
1270 1314
1271Return and optionally change the current rendition. Text that is output by 1315Return and optionally change the current rendition. Text that is output by
1272the terminal application will use this style. 1316the terminal application will use this style.
1452=item $term->tt_write ($octets) 1496=item $term->tt_write ($octets)
1453 1497
1454Write the octets given in C<$octets> to the tty (i.e. as program input). To 1498Write the octets given in C<$octets> to the tty (i.e. as program input). To
1455pass characters instead of octets, you should convert your strings first 1499pass characters instead of octets, you should convert your strings first
1456to the locale-specific encoding using C<< $term->locale_encode >>. 1500to the locale-specific encoding using C<< $term->locale_encode >>.
1501
1502=item $term->tt_write_user_input ($octets)
1503
1504Like C<tt_write>, but should be used when writing strings in response to
1505the user pressing a key, to invoke the additional actions requested by
1506the user for that case (C<tt_write> doesn't do that).
1507
1508The typical use case would be inside C<on_action> hooks.
1457 1509
1458=item $term->tt_paste ($octets) 1510=item $term->tt_paste ($octets)
1459 1511
1460Write the octets given in C<$octets> to the tty as a paste, converting NL to 1512Write the octets given in C<$octets> to the tty as a paste, converting NL to
1461CR and bracketing the data with control sequences if bracketed paste mode 1513CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines