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.231 by root, Sun Apr 27 20:26:28 2014 UTC vs.
Revision 1.234 by root, Sat May 17 15:25:04 2014 UTC

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 going away in 292The event is simply the action string. This interface is going away in
293preference to the C<< ->register_keysym_action >> method. 293preference to the C<< ->register_keysym_action >> method.
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 a true value the binding
299is not registered. 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
564sub parse_resource { 557sub parse_resource {
565 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 558 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
566 559
567 $name =~ y/-/./ if $isarg; 560 $name =~ y/-/./ if $isarg;
568 561
569 $term->scan_meta; 562 $term->scan_extensions;
570 563
571 my $r = $term->{meta}{resource}; 564 my $r = $term->{meta}{resource};
572 keys %$r; # reset iterator 565 keys %$r; # reset iterator
573 while (my ($pattern, $v) = each %$r) { 566 while (my ($pattern, $v) = each %$r) {
574 if ( 567 if (
594} 587}
595 588
596sub usage { 589sub usage {
597 my ($term, $usage_type) = @_; 590 my ($term, $usage_type) = @_;
598 591
599 $term->scan_meta; 592 $term->scan_extensions;
600 593
601 my $r = $term->{meta}{resource}; 594 my $r = $term->{meta}{resource};
602 595
603 for my $pattern (sort keys %$r) { 596 for my $pattern (sort keys %$r) {
604 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 597 my ($ext, $type, $desc) = @{ $r->{$pattern} };
667 local $TERM = shift; 660 local $TERM = shift;
668 my $htype = shift; 661 my $htype = shift;
669 662
670 if ($htype == HOOK_INIT) { 663 if ($htype == HOOK_INIT) {
671 my @dirs = $TERM->perl_libdirs; 664 my @dirs = $TERM->perl_libdirs;
665
666 $TERM->scan_extensions;
672 667
673 my %ext_arg; 668 my %ext_arg;
674 669
675 { 670 {
676 my @init = @TERM_INIT; 671 my @init = @TERM_INIT;
714 709
715 if (my $cb = $TERM->{_hook}[$htype]) { 710 if (my $cb = $TERM->{_hook}[$htype]) {
716 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 711 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
717 if $verbosity >= 10; 712 if $verbosity >= 10;
718 713
719 for my $pkg ( 714 if ($htype == HOOK_ACTION) {
720 # this hook is only sent to the extension with the name 715 # this hook is only sent to the extension with the name
721 # matching the first arg 716 # matching the first arg
722 $htype == HOOK_KEYBOARD_DISPATCH 717 my $pkg = shift;
723 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 718 $pkg =~ y/-/_/;
724 : keys %$cb 719 $pkg = "urxvt::ext::$pkg";
720
721 $cb = $cb->{$pkg}
722 or return undef; #TODO: maybe warn user?
723
724 $cb = { $pkg => $cb };
725 ) { 725 }
726
727 for my $pkg (keys %$cb) {
726 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 728 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
727 $retval ||= $retval_; 729 $retval ||= $retval_;
728 730
729 if ($@) { 731 if ($@) {
730 $TERM->ungrab; # better to lose the grab than the session 732 $TERM->ungrab; # better to lose the grab than the session
1069 $ENV{URXVT_PERL_LIB}, 1071 $ENV{URXVT_PERL_LIB},
1070 "$ENV{HOME}/.urxvt/ext", 1072 "$ENV{HOME}/.urxvt/ext",
1071 "$LIBDIR/perl" 1073 "$LIBDIR/perl"
1072} 1074}
1073 1075
1074sub scan_meta { 1076# scan for available extensions and collect their metadata
1077sub scan_extensions {
1075 my ($self) = @_; 1078 my ($self) = @_;
1079
1080 return if exists $self->{meta};
1081
1076 my @libdirs = perl_libdirs $self; 1082 my @libdirs = perl_libdirs $self;
1077 1083
1078 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1084 return if $self->{meta_libdirs} eq join "\x00", @libdirs;
1079 1085
1080 my %meta; 1086 my %meta;
1081 1087
1082 $self->{meta_libdirs} = join "\x00", @libdirs; 1088 $self->{meta_libdirs} = join "\x00", @libdirs;
1083 $self->{meta} = \%meta; 1089 $self->{meta} = \%meta;
1084 1090
1091 my %ext;
1092
1093 # first gather extensions
1085 for my $dir (reverse @libdirs) { 1094 for my $dir (reverse @libdirs) {
1086 opendir my $fh, $dir 1095 opendir my $fh, $dir
1087 or next; 1096 or next;
1088 for my $ext (readdir $fh) { 1097 for my $ext (readdir $fh) {
1089 $ext !~ /^\./ 1098 $ext !~ /^\./
1090 and open my $fh, "<", "$dir/$ext" 1099 and open my $fh, "<", "$dir/$ext"
1091 or next; 1100 or next;
1092 1101
1102 my %ext = (dir => $dir);
1103
1093 while (<$fh>) { 1104 while (<$fh>) {
1094 if (/^#:META:X_RESOURCE:(.*)/) { 1105 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1095 my ($pattern, $type, $desc) = split /:/, $1; 1106 my ($pattern, $type, $desc) = split /:/, $1;
1096 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1107 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1097 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1108 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1098 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1109 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1099 } else { 1110 } else {
1100 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1111 $ext{resource}{$pattern} = [$ext, $type, $desc];
1101 } 1112 }
1113 } elsif (/^#:META:BINDING:(.*)/) {
1114 my ($keysym, $action) = split /:/, $1;
1115 $ext{binding}{$keysym} = $action;
1102 } elsif (/^\s*(?:#|$)/) { 1116 } elsif (/^\s*(?:#|$)/) {
1103 # skip other comments and empty lines 1117 # skip other comments and empty lines
1104 } else { 1118 } else {
1105 last; # stop parsing on first non-empty non-comment line 1119 last; # stop parsing on first non-empty non-comment line
1106 } 1120 }
1107 } 1121 }
1122
1123 $meta{$ext} = \%ext;
1108 } 1124 }
1125 }
1126
1127 # and now merge resources and bindings
1128 while (my ($k, $v) = each %ext) {
1129 #TODO: should check for extensions overriding each other
1130 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1131 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1109 } 1132 }
1110} 1133}
1111 1134
1112=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1135=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1113 1136
1259 my $res = &x_resource; 1282 my $res = &x_resource;
1260 1283
1261 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1284 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1262} 1285}
1263 1286
1264=item $success = $term->parse_keysym ($key, $octets) 1287=item $success = $term->bind_action ($key, $octets)
1265 1288
1266Adds a key binding exactly as specified via a resource. See the 1289Adds a key binding exactly as specified via a C<keysym> resource. See the
1267C<keysym> resource in the urxvt(1) manpage. 1290C<keysym> resource in the urxvt(1) manpage.
1268
1269=item $term->register_command ($keysym, $modifiermask, $string)
1270
1271Adds a key binding. This is a lower level api compared to
1272C<parse_keysym>, as it expects a parsed key description, and can be
1273used only inside either the C<on_init> hook, to add a binding, or the
1274C<on_register_command> hook, to modify a parsed binding.
1275 1291
1276=item $rend = $term->rstyle ([$new_rstyle]) 1292=item $rend = $term->rstyle ([$new_rstyle])
1277 1293
1278Return and optionally change the current rendition. Text that is output by 1294Return and optionally change the current rendition. Text that is output by
1279the terminal application will use this style. 1295the terminal application will use this style.
1459=item $term->tt_write ($octets) 1475=item $term->tt_write ($octets)
1460 1476
1461Write the octets given in C<$octets> to the tty (i.e. as program input). To 1477Write the octets given in C<$octets> to the tty (i.e. as program input). To
1462pass characters instead of octets, you should convert your strings first 1478pass characters instead of octets, you should convert your strings first
1463to the locale-specific encoding using C<< $term->locale_encode >>. 1479to the locale-specific encoding using C<< $term->locale_encode >>.
1480
1481=item $term->tt_write_user_input ($octets)
1482
1483Like C<tt_write>, but should be used when writing strings in response to
1484the user pressing a key, to invokes the additional actions requested by
1485the user for that case (C<tt_write> doesn't do that).
1486
1487The typical use case would be inside C<on_action> hooks.
1464 1488
1465=item $term->tt_paste ($octets) 1489=item $term->tt_paste ($octets)
1466 1490
1467Write the octets given in C<$octets> to the tty as a paste, converting NL to 1491Write the octets given in C<$octets> to the tty as a paste, converting NL to
1468CR and bracketing the data with control sequences if bracketed paste mode 1492CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines