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.244 by sf-exg, Mon Oct 13 12:17:48 2014 UTC

43 43
44Or by adding them to the resource for extensions loaded by default: 44Or by adding them to the resource for extensions loaded by default:
45 45
46 URxvt.perl-ext-common: default,selection-autotransform 46 URxvt.perl-ext-common: default,selection-autotransform
47 47
48Extensions that add command line parameters or resources on their own are 48Extensions may add additional resources and C<actions>, i.e., methods
49loaded automatically when used. 49which can be bound to a key and invoked by the user. An extension can
50define the resources it support and also default bindings for one or
51more actions it provides using so called META comments, described
52below. Similarly to builtin resources, extension resources can also be
53specified on the command line as long options (with C<.> replaced by
54C<->), in which case the corresponding extension is loaded
55automatically. For this to work the extension B<must> define META
56comments for its resources.
50 57
51=head1 API DOCUMENTATION 58=head1 API DOCUMENTATION
52 59
53=head2 General API Considerations 60=head2 General API Considerations
54 61
106C<urxvt::term> class on this object. 113C<urxvt::term> class on this object.
107 114
108Additional methods only supported for extension objects are described in 115Additional methods only supported for extension objects are described in
109the C<urxvt::extension> section below. 116the C<urxvt::extension> section below.
110 117
118=head2 META comments
119
120rxvt-unicode recognizes special comments in extensions that define
121different types of metadata:
122
123=over 4
124
125=item #:META:RESOURCE:name:type:desc
126
127The RESOURCE comment defines a resource used by the extension, where
128C<name> is the resource name, C<type> is the resource type, C<boolean>
129or C<string>, and C<desc> is the resource description.
130
131=item #:META:BINDING:sym:action
132
133The BINDING comment defines a default binding for an action provided
134by the extension, where C<sym> is the key combination that triggers
135the action, whose format is defined in the description of the
136B<keysym> resource in the urxvt(1) manpage, and C<action> is the name
137of the action method.
138
139=back
140
111=head2 Hooks 141=head2 Hooks
112 142
113The following subroutines can be declared in extension files, and will be 143The following subroutines can be declared in extension files, and will be
114called whenever the relevant event happens. 144called whenever the relevant event happens.
115 145
281 311
282=item on_refresh_end $term 312=item on_refresh_end $term
283 313
284Called just after the screen gets redrawn. See C<on_refresh_begin>. 314Called just after the screen gets redrawn. See C<on_refresh_begin>.
285 315
316=item on_action $term, $string
317
318Called whenever an action is invoked for the corresponding extension
319(e.g. via a C<extension:string> builtin action bound to a key, see
320description of the B<keysym> resource in the urxvt(1) manpage). The
321event is simply the action string. Note that an action event is always
322associated to a single extension.
323
286=item on_user_command $term, $string *DEPRECATED* 324=item on_user_command $term, $string *DEPRECATED*
287 325
288Called whenever a user-configured event is being activated (e.g. via 326Called 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> 327a C<perl:string> action bound to a key, see description of the B<keysym>
290resource in the urxvt(1) manpage). 328resource in the urxvt(1) manpage).
291 329
292The event is simply the action string. This interface is going away in 330The event is simply the action string. This interface is going away in
293preference to the C<< ->register_keysym_action >> method. 331preference 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 a true value the binding
299is not registered. It can be used to modify a binding by calling
300C<register_command>.
301 332
302=item on_resize_all_windows $term, $new_width, $new_height 333=item on_resize_all_windows $term, $new_width, $new_height
303 334
304Called just after the new window size has been calculated, but before 335Called just after the new window size has been calculated, but before
305windows are actually being resized or hints are being set. If this hook 336windows are actually being resized or hints are being set. If this hook
562no warnings 'utf8'; 593no warnings 'utf8';
563 594
564sub parse_resource { 595sub parse_resource {
565 my ($term, $name, $isarg, $longopt, $flag, $value) = @_; 596 my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
566 597
567 $name =~ y/-/./ if $isarg;
568
569 $term->scan_meta; 598 $term->scan_extensions;
570 599
571 my $r = $term->{meta}{resource}; 600 my $r = $term->{meta}{resource};
572 keys %$r; # reset iterator 601 keys %$r; # reset iterator
573 while (my ($pattern, $v) = each %$r) { 602 while (my ($k, $v) = each %$r) {
574 if ( 603 my $pattern = $k;
604 $pattern =~ y/./-/ if $isarg;
605 my $prefix = $name;
606 my $suffix;
575 $pattern =~ /\.$/ 607 if ($pattern =~ /\-$/) {
576 ? $pattern eq substr $name, 0, length $pattern 608 $prefix = substr $name, 0, length $pattern;
577 : $pattern eq $name 609 $suffix = substr $name, length $pattern;
578 ) { 610 }
611 if ($pattern eq $prefix) {
579 $name = "$urxvt::RESCLASS.$name"; 612 $name = "$urxvt::RESCLASS.$k$suffix";
580 613
581 push @{ $term->{perl_ext_3} }, $v->[0]; 614 push @{ $term->{perl_ext_3} }, $v->[0];
582 615
583 if ($v->[1] eq "boolean") { 616 if ($v->[1] eq "boolean") {
584 $term->put_option_db ($name, $flag ? "true" : "false"); 617 $term->put_option_db ($name, $flag ? "true" : "false");
594} 627}
595 628
596sub usage { 629sub usage {
597 my ($term, $usage_type) = @_; 630 my ($term, $usage_type) = @_;
598 631
599 $term->scan_meta; 632 $term->scan_extensions;
600 633
601 my $r = $term->{meta}{resource}; 634 my $r = $term->{meta}{resource};
602 635
603 for my $pattern (sort keys %$r) { 636 for my $pattern (sort keys %$r) {
604 my ($ext, $type, $desc) = @{ $r->{$pattern} }; 637 my ($ext, $type, $desc) = @{ $r->{$pattern} };
668 my $htype = shift; 701 my $htype = shift;
669 702
670 if ($htype == HOOK_INIT) { 703 if ($htype == HOOK_INIT) {
671 my @dirs = $TERM->perl_libdirs; 704 my @dirs = $TERM->perl_libdirs;
672 705
706 $TERM->scan_extensions;
707
673 my %ext_arg; 708 my %ext_arg;
674 709
675 { 710 {
676 my @init = @TERM_INIT; 711 my @init = @TERM_INIT;
677 @TERM_INIT = (); 712 @TERM_INIT = ();
680 @TERM_EXT = (); 715 @TERM_EXT = ();
681 $TERM->register_package ($_) for @pkg; 716 $TERM->register_package ($_) for @pkg;
682 } 717 }
683 718
684 for ( 719 for (
720 (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2),
685 @{ delete $TERM->{perl_ext_3} }, 721 @{ delete $TERM->{perl_ext_3} }
686 grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
687 ) { 722 ) {
688 if ($_ eq "default") { 723 if ($_ eq "default") {
689 $ext_arg{$_} ||= [] for qw(selection option-popup selection-popup searchable-scrollback readline); 724
725 $ext_arg{$_} = []
726 for
727 qw(selection option-popup selection-popup readline),
728 map $_->[0], values %{ $TERM->{meta}{binding} };
729
730 for ($TERM->_keysym_resources) {
731 next if /^(?:string|command|builtin|builtin-string|perl)/;
732 next unless /^([A-Za-z0-9_\-]+):/;
733
734 my $ext = $1;
735
736 $ext_arg{$ext} = [];
737 }
738
690 } elsif (/^-(.*)$/) { 739 } elsif (/^-(.*)$/) {
691 delete $ext_arg{$1}; 740 delete $ext_arg{$1};
741
692 } elsif (/^([^<]+)<(.*)>$/) { 742 } elsif (/^([^<]+)<(.*)>$/) {
693 push @{ $ext_arg{$1} }, $2; 743 push @{ $ext_arg{$1} }, $2;
744
694 } else { 745 } else {
695 $ext_arg{$_} ||= []; 746 $ext_arg{$_} ||= [];
747 }
748 }
749
750 # now register default key bindings
751 for my $ext (sort keys %ext_arg) {
752 while (my ($k, $v) = each %{ $TERM->{meta}{ext}{$ext}{binding} }) {
753 $TERM->bind_action ($k, "$v->[0]:$v->[1]");
696 } 754 }
697 } 755 }
698 756
699 for my $ext (sort keys %ext_arg) { 757 for my $ext (sort keys %ext_arg) {
700 my @files = grep -f $_, map "$_/$ext", @dirs; 758 my @files = grep -f $_, map "$_/$ext", @dirs;
714 772
715 if (my $cb = $TERM->{_hook}[$htype]) { 773 if (my $cb = $TERM->{_hook}[$htype]) {
716 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")" 774 verbose 10, "$HOOKNAME[$htype] (" . (join ", ", $TERM, @_) . ")"
717 if $verbosity >= 10; 775 if $verbosity >= 10;
718 776
719 for my $pkg ( 777 if ($htype == HOOK_ACTION) {
720 # this hook is only sent to the extension with the name 778 # this hook is only sent to the extension with the name
721 # matching the first arg 779 # matching the first arg
722 $htype == HOOK_KEYBOARD_DISPATCH 780 my $pkg = shift;
723 ? exists $cb->{"urxvt::ext::$_[0]"} ? "urxvt::ext::" . shift : return undef 781 $pkg =~ y/-/_/;
724 : keys %$cb 782 $pkg = "urxvt::ext::$pkg";
783
784 $cb = $cb->{$pkg}
785 or return undef; #TODO: maybe warn user?
786
787 $cb = { $pkg => $cb };
725 ) { 788 }
789
790 for my $pkg (keys %$cb) {
726 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) }; 791 my $retval_ = eval { $cb->{$pkg}->($TERM->{_pkg}{$pkg} || $TERM, @_) };
727 $retval ||= $retval_; 792 $retval ||= $retval_;
728 793
729 if ($@) { 794 if ($@) {
730 $TERM->ungrab; # better to lose the grab than the session 795 $TERM->ungrab; # better to lose the grab than the session
1069 $ENV{URXVT_PERL_LIB}, 1134 $ENV{URXVT_PERL_LIB},
1070 "$ENV{HOME}/.urxvt/ext", 1135 "$ENV{HOME}/.urxvt/ext",
1071 "$LIBDIR/perl" 1136 "$LIBDIR/perl"
1072} 1137}
1073 1138
1074sub scan_meta { 1139# scan for available extensions and collect their metadata
1140sub scan_extensions {
1075 my ($self) = @_; 1141 my ($self) = @_;
1142
1143 return if exists $self->{meta};
1144
1076 my @libdirs = perl_libdirs $self; 1145 my @libdirs = perl_libdirs $self;
1077 1146
1078 return if $self->{meta_libdirs} eq join "\x00", @libdirs; 1147# return if $self->{meta_libdirs} eq join "\x00", @libdirs;#d#
1079 1148
1080 my %meta;
1081
1082 $self->{meta_libdirs} = join "\x00", @libdirs; 1149# $self->{meta_libdirs} = join "\x00", @libdirs;#d#
1083 $self->{meta} = \%meta; 1150 $self->{meta} = \my %meta;
1084 1151
1152 # first gather extensions
1085 for my $dir (reverse @libdirs) { 1153 for my $dir (reverse @libdirs) {
1086 opendir my $fh, $dir 1154 opendir my $fh, $dir
1087 or next; 1155 or next;
1088 for my $ext (readdir $fh) { 1156 for my $ext (readdir $fh) {
1089 $ext !~ /^\./ 1157 $ext !~ /^\./
1090 and open my $fh, "<", "$dir/$ext" 1158 and open my $fh, "<", "$dir/$ext"
1091 or next; 1159 or next;
1092 1160
1161 my %ext = (dir => $dir);
1162
1093 while (<$fh>) { 1163 while (<$fh>) {
1094 if (/^#:META:X_RESOURCE:(.*)/) { 1164 if (/^#:META:(?:X_)?RESOURCE:(.*)/) {
1095 my ($pattern, $type, $desc) = split /:/, $1; 1165 my ($pattern, $type, $desc) = split /:/, $1;
1096 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name 1166 $pattern =~ s/^%(\.|$)/$ext$1/g; # % in pattern == extension name
1097 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) { 1167 if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
1098 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n"; 1168 warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
1099 } else { 1169 } else {
1100 $meta{resource}{$pattern} = [$ext, $type, $desc]; 1170 $ext{resource}{$pattern} = [$ext, $type, $desc];
1101 } 1171 }
1172 } elsif (/^#:META:BINDING:(.*)/) {
1173 my ($keysym, $action) = split /:/, $1;
1174 $ext{binding}{$keysym} = [$ext, $action];
1102 } elsif (/^\s*(?:#|$)/) { 1175 } elsif (/^\s*(?:#|$)/) {
1103 # skip other comments and empty lines 1176 # skip other comments and empty lines
1104 } else { 1177 } else {
1105 last; # stop parsing on first non-empty non-comment line 1178 last; # stop parsing on first non-empty non-comment line
1106 } 1179 }
1107 } 1180 }
1181
1182 $meta{ext}{$ext} = \%ext;
1108 } 1183 }
1184 }
1185
1186 # and now merge resources and bindings
1187 while (my ($k, $v) = each %{ $meta{ext} }) {
1188 #TODO: should check for extensions overriding each other
1189 %{ $meta{resource} } = (%{ $meta{resource} }, %{ $v->{resource} });
1190 %{ $meta{binding} } = (%{ $meta{binding} }, %{ $v->{binding} });
1109 } 1191 }
1110} 1192}
1111 1193
1112=item $term = new urxvt::term $envhashref, $rxvtname, [arg...] 1194=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
1113 1195
1229Returns the X-Resource for the given pattern, excluding the program or 1311Returns the X-Resource for the given pattern, excluding the program or
1230class name, i.e. C<< $term->x_resource ("boldFont") >> should return the 1312class name, i.e. C<< $term->x_resource ("boldFont") >> should return the
1231same value as used by this instance of rxvt-unicode. Returns C<undef> if no 1313same value as used by this instance of rxvt-unicode. Returns C<undef> if no
1232resource with that pattern exists. 1314resource with that pattern exists.
1233 1315
1234Extensions that define extra resource or command line arguments also need 1316Extensions that define extra resources also need to call this method
1235to call this method to access their values. 1317to access their values.
1236 1318
1237If the method is called on an extension object (basically, from an 1319If the method is called on an extension object (basically, from an
1238extension), then the special prefix C<%.> will be replaced by the name of 1320extension), then the special prefix C<%.> will be replaced by the name of
1239the extension and a dot, and the lone string C<%> will be replaced by the 1321the extension and a dot, and the lone string C<%> will be replaced by the
1240extension name itself. This makes it possible to code extensions so you 1322extension name itself. This makes it possible to code extensions so you
1241can rename them and get a new set of commandline switches and resources 1323can rename them and get a new set of resources without having to change
1242without having to change the actual code. 1324the actual code.
1243 1325
1244This method should only be called during the C<on_start> hook, as there is 1326This method should only be called during the C<on_start> hook, as there is
1245only one resource database per display, and later invocations might return 1327only one resource database per display, and later invocations might return
1246the wrong resources. 1328the wrong resources.
1247 1329
1259 my $res = &x_resource; 1341 my $res = &x_resource;
1260 1342
1261 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0 1343 $res =~ /^\s*(?:true|yes|on|1)\s*$/i ? 1 : defined $res && 0
1262} 1344}
1263 1345
1264=item $success = $term->parse_keysym ($key, $octets) 1346=item $success = $term->bind_action ($key, $octets)
1265 1347
1266Adds a key binding exactly as specified via a resource. See the 1348Adds a key binding exactly as specified via a C<keysym> resource. See the
1267C<keysym> resource in the urxvt(1) manpage. 1349C<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 1350
1276=item $rend = $term->rstyle ([$new_rstyle]) 1351=item $rend = $term->rstyle ([$new_rstyle])
1277 1352
1278Return and optionally change the current rendition. Text that is output by 1353Return and optionally change the current rendition. Text that is output by
1279the terminal application will use this style. 1354the terminal application will use this style.
1459=item $term->tt_write ($octets) 1534=item $term->tt_write ($octets)
1460 1535
1461Write the octets given in C<$octets> to the tty (i.e. as program input). To 1536Write 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 1537pass characters instead of octets, you should convert your strings first
1463to the locale-specific encoding using C<< $term->locale_encode >>. 1538to the locale-specific encoding using C<< $term->locale_encode >>.
1539
1540=item $term->tt_write_user_input ($octets)
1541
1542Like C<tt_write>, but should be used when writing strings in response to
1543the user pressing a key, to invoke the additional actions requested by
1544the user for that case (C<tt_write> doesn't do that).
1545
1546The typical use case would be inside C<on_action> hooks.
1464 1547
1465=item $term->tt_paste ($octets) 1548=item $term->tt_paste ($octets)
1466 1549
1467Write the octets given in C<$octets> to the tty as a paste, converting NL to 1550Write 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 1551CR and bracketing the data with control sequences if bracketed paste mode

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines