[ViewVC] Diff of: cvs/rxvt-unicode/src/urxvt.pm

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.200 by sf-exg, Sun Nov 20 10:58:58 2011 UTC vs.
Revision 1.215 by root, Thu Jun 7 16:30:58 2012 UTC

…		…
20	=head1 DESCRIPTION	20	=head1 DESCRIPTION
21		21
22	Every time a terminal object gets created, extension scripts specified via	22	Every time a terminal object gets created, extension scripts specified via
23	the C<perl> resource are loaded and associated with it.	23	the C<perl> resource are loaded and associated with it.
24		24
25	Scripts are compiled in a 'use strict' and 'use utf8' environment, and	25	Scripts are compiled in a 'use strict "vars"' and 'use utf8' environment, and
26	thus must be encoded as UTF-8.	26	thus must be encoded as UTF-8.
27		27
28	Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where	28	Each script will only ever be loaded once, even in @@RXVT_NAME@@d, where
29	scripts will be shared (but not enabled) for all terminals.	29	scripts will be shared (but not enabled) for all terminals.
30		30
…		…
446	=item $octets	446	=item $octets
447		447
448	Either binary data or - more common - a text string encoded in a	448	Either binary data or - more common - a text string encoded in a
449	locale-specific way.	449	locale-specific way.
450		450
		451	=item $keysym
		452
		453	an integer that is a valid X11 keysym code. You can convert a string
		454	into a keysym and viceversa by using C<XStringToKeysym> and
		455	C<XKeysymToString>.
		456
451	=back	457	=back
452		458
453	=head2 Extension Objects	459	=head2 Extension Objects
454		460
455	Every perl extension is a perl class. A separate perl object is created	461	Every perl extension is a perl class. A separate perl object is created
…		…
666	resource in the @@RXVT_NAME@@(1) manpage).	672	resource in the @@RXVT_NAME@@(1) manpage).
667		673
668	The event is simply the action string. This interface is assumed to change	674	The event is simply the action string. This interface is assumed to change
669	slightly in the future.	675	slightly in the future.
670		676
		677	=item on_register_command $term, $keysym, $modifiermask, $string
		678
		679	Called after parsing a keysym resource but before registering the
		680	associated binding. If this hook returns TRUE the binding is not
		681	registered. It can be used to modify a binding by calling
		682	C<register_command>.
		683
671	=item on_resize_all_windows $term, $new_width, $new_height	684	=item on_resize_all_windows $term, $new_width, $new_height
672		685
673	Called just after the new window size has been calculated, but before	686	Called just after the new window size has been calculated, but before
674	windows are actually being resized or hints are being set. If this hook	687	windows are actually being resized or hints are being set. If this hook
675	returns TRUE, setting of the window hints is being skipped.	688	returns TRUE, setting of the window hints is being skipped.
…		…
742	=cut	755	=cut
743		756
744	package urxvt;	757	package urxvt;
745		758
746	use utf8;	759	use utf8;
747	use strict;	760	use strict 'vars';
748	use Carp ();	761	use Carp ();
749	use Scalar::Util ();	762	use Scalar::Util ();
750	use List::Util ();	763	use List::Util ();
751		764
752	our $VERSION = 1;	765	our $VERSION = 1;
753	our $TERM;	766	our $TERM;
754	our @TERM_INIT;	767	our @TERM_INIT; # should go, prevents async I/O etc.
755	our @TERM_EXT;	768	our @TERM_EXT; # should go, prevents async I/O etc.
756	our @HOOKNAME;	769	our @HOOKNAME;
757	our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME;	770	our %HOOKTYPE = map +($HOOKNAME[$_] => $_), 0..$#HOOKNAME;
758	our %OPTION;	771	our %OPTION;
759		772
760	our $LIBDIR;	773	our $LIBDIR;
…		…
930	};	943	};
931	}	944	}
932		945
933	no warnings 'utf8';	946	no warnings 'utf8';
934		947
		948	sub parse_resource {
		949	my ($term, $name, $isarg, $longopt, $flag, $value) = @_;
		950
		951	$term->scan_meta;
		952
		953	my $r = $term->{meta}{resource};
		954	while (my ($pattern, $v) = each %$r) {
		955	$name =~ y/-/./ if $isarg;
		956
		957	if (
		958	$pattern =~ /\.$/
		959	? $pattern eq substr $name, 0, length $pattern
		960	: $pattern eq $name
		961	) {
		962	$name = "$urxvt::RESCLASS.$name";
		963
		964	push @{ $term->{perl_ext_3} }, $v->[0];
		965
		966	if ($v->[1] eq "boolean") {
		967	$term->put_option_db ($name, $flag ? "true" : "false");
		968	return 1;
		969	} else {
		970	$term->put_option_db ($name, $value);
		971	return 1 + 2;
		972	}
		973	}
		974	}
		975
		976	0
		977	}
		978
		979	sub usage {
		980	my ($term, $usage_type) = @_;
		981
		982	$term->scan_meta;
		983
		984	my $r = $term->{meta}{resource};
		985
		986	for my $pattern (sort keys %$r) {
		987	my ($ext, $type, $desc) = @{ $r->{$pattern} };
		988
		989	$desc .= " (-pe $ext)";
		990
		991	if ($usage_type == 1) {
		992	$pattern =~ y/./-/;
		993	$pattern =~ s/-$/-.../g;
		994
		995	if ($type eq "boolean") {
		996	urxvt::log sprintf " -%-30s %s\n", "/+$pattern", $desc;
		997	} else {
		998	urxvt::log sprintf " -%-30s %s\n", "$pattern $type", $desc;
		999	}
		1000	} else {
		1001	$pattern =~ s/\.$/.*/g;
		1002	urxvt::log sprintf " %-31s %s\n", "$pattern:", $type;
		1003	}
		1004	}
		1005	}
		1006
935	my $verbosity = $ENV{URXVT_PERL_VERBOSITY};	1007	my $verbosity = $ENV{URXVT_PERL_VERBOSITY};
936		1008
937	sub verbose {	1009	sub verbose {
938	my ($level, $msg) = @_;	1010	my ($level, $msg) = @_;
939	warn "$msg\n" if $level <= $verbosity;	1011	warn "$msg\n" if $level <= $verbosity;
…		…
955		1027
956	open my $fh, "<:raw", $path	1028	open my $fh, "<:raw", $path
957	or die "$path: $!";	1029	or die "$path: $!";
958		1030
959	my $source =	1031	my $source =
960	"package $pkg; use strict; use utf8; no warnings 'utf8';\n"	1032	"package $pkg; use strict 'vars'; use utf8; no warnings 'utf8';\n"
961	. "#line 1 \"$path\"\n{\n"	1033	. "#line 1 \"$path\"\n{\n"
962	. (do { local $/; <$fh> })	1034	. (do { local $/; <$fh> })
963	. "\n};\n1";	1035	. "\n};\n1";
964		1036
965	eval $source	1037	eval $source
…		…
975	sub invoke {	1047	sub invoke {
976	local $TERM = shift;	1048	local $TERM = shift;
977	my $htype = shift;	1049	my $htype = shift;
978		1050
979	if ($htype == 0) { # INIT	1051	if ($htype == 0) { # INIT
980	my @dirs = ((split /:/, $TERM->resource ("perl_lib")), "$ENV{HOME}/.urxvt/ext", "$LIBDIR/perl");	1052	my @dirs = $TERM->perl_libdirs;
981		1053
982	my %ext_arg;	1054	my %ext_arg;
983		1055
984	{	1056	{
985	my @init = @TERM_INIT;	1057	my @init = @TERM_INIT;
…		…
988	my @pkg = @TERM_EXT;	1060	my @pkg = @TERM_EXT;
989	@TERM_EXT = ();	1061	@TERM_EXT = ();
990	$TERM->register_package ($_) for @pkg;	1062	$TERM->register_package ($_) for @pkg;
991	}	1063	}
992		1064
		1065	for (
		1066	@{ delete $TERM->{perl_ext_3} },
993	for (grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2) {	1067	grep $_, map { split /,/, $TERM->resource ("perl_ext_$_") } 1, 2
		1068	) {
994	if ($_ eq "default") {	1069	if ($_ eq "default") {
995	$ext_arg{$_} \|\|= [] for qw(selection option-popup selection-popup searchable-scrollback readline);	1070	$ext_arg{$_} \|\|= [] for qw(selection option-popup selection-popup searchable-scrollback readline);
996	} elsif (/^-(.*)$/) {	1071	} elsif (/^-(.*)$/) {
997	delete $ext_arg{$1};	1072	delete $ext_arg{$1};
998	} elsif (/^([^<]+)<(.*)>$/) {	1073	} elsif (/^([^<]+)<(.*)>$/) {
…		…
1146	=head2 The C<urxvt::anyevent> Class	1221	=head2 The C<urxvt::anyevent> Class
1147		1222
1148	The sole purpose of this class is to deliver an interface to the	1223	The sole purpose of this class is to deliver an interface to the
1149	C<AnyEvent> module - any module using it will work inside urxvt without	1224	C<AnyEvent> module - any module using it will work inside urxvt without
1150	further programming. The only exception is that you cannot wait on	1225	further programming. The only exception is that you cannot wait on
1151	condition variables, but non-blocking condvar use is ok. What this means	1226	condition variables, but non-blocking condvar use is ok.
1152	is that you cannot use blocking APIs, but the non-blocking variant should	1227
1153	work.	1228	In practical terms this means is that you cannot use blocking APIs, but
		1229	the non-blocking variant should work.
1154		1230
1155	=cut	1231	=cut
1156		1232
1157	our $VERSION = '5.23';	1233	our $VERSION = '5.23';
1158		1234
…		…
1252	$self->{_pkg}{$pkg} = $proxy;	1328	$self->{_pkg}{$pkg} = $proxy;
1253		1329
1254	for my $name (@HOOKNAME) {	1330	for my $name (@HOOKNAME) {
1255	if (my $ref = $pkg->can ("on_" . lc $name)) {	1331	if (my $ref = $pkg->can ("on_" . lc $name)) {
1256	$proxy->enable ($name => $ref);	1332	$proxy->enable ($name => $ref);
		1333	}
		1334	}
		1335	}
		1336
		1337	sub perl_libdirs {
		1338	map { split /:/ }
		1339	$_[0]->resource ("perl_lib"),
		1340	$ENV{URXVT_PERL_LIB},
		1341	"$ENV{HOME}/.urxvt/ext",
		1342	"$LIBDIR/perl"
		1343	}
		1344
		1345	sub scan_meta {
		1346	my ($self) = @_;
		1347	my @libdirs = perl_libdirs $self;
		1348
		1349	return if $self->{meta_libdirs} eq join "\x00", @libdirs;
		1350
		1351	my %meta;
		1352
		1353	$self->{meta_libdirs} = join "\x00", @libdirs;
		1354	$self->{meta} = \%meta;
		1355
		1356	for my $dir (reverse @libdirs) {
		1357	opendir my $fh, $dir
		1358	or next;
		1359	for my $ext (readdir $fh) {
		1360	$ext ne "."
		1361	and $ext ne ".."
		1362	and open my $fh, "<", "$dir/$ext"
		1363	or next;
		1364
		1365	while (<$fh>) {
		1366	if (/^#:META:X_RESOURCE:(.*)/) {
		1367	my ($pattern, $type, $desc) = split /:/, $1;
		1368	$pattern =~ s/^%(\.\|$)/$ext$1/g; # % in pattern == extension name
		1369	if ($pattern =~ /[^a-zA-Z0-9\-\.]/) {
		1370	warn "$dir/$ext: meta resource '$pattern' contains illegal characters (not alphanumeric nor . nor *)\n";
		1371	} else {
		1372	$meta{resource}{$pattern} = [$ext, $type, $desc];
		1373	}
		1374	} elsif (/^\s*(?:#\|$)/) {
		1375	# skip other comments and empty lines
		1376	} else {
		1377	last; # stop parsing on first non-empty non-comment line
		1378	}
		1379	}
1257	}	1380	}
1258	}	1381	}
1259	}	1382	}
1260		1383
1261	=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]	1384	=item $term = new urxvt::term $envhashref, $rxvtname, [arg...]
…		…
1382		1505
1383	This method should only be called during the C<on_start> hook, as there is	1506	This method should only be called during the C<on_start> hook, as there is
1384	only one resource database per display, and later invocations might return	1507	only one resource database per display, and later invocations might return
1385	the wrong resources.	1508	the wrong resources.
1386		1509
1387	=item $success = $term->parse_keysym ($keysym_spec, $command_string)	1510	=item $value = $term->x_resource_boolean ($pattern)
1388		1511
		1512	Like C<x_resource>, above, but interprets the string value as a boolean
		1513	and returns C<1> for true values, C<0> for false values and C<undef> if
		1514	the resource or option isn't specified.
		1515
		1516	You should always use this method to parse boolean resources.
		1517
		1518	=cut
		1519
		1520	sub x_resource_boolean {
		1521	my $res = &x_resource;
		1522
		1523	$res =~ /^\s(?:true\|yes\|on\|1)\s$/i ? 1 : defined $res && 0
		1524	}
		1525
		1526	=item $success = $term->parse_keysym ($key, $octets)
		1527
1389	Adds a keymap translation exactly as specified via a resource. See the	1528	Adds a key binding exactly as specified via a resource. See the
1390	C<keysym> resource in the @@RXVT_NAME@@(1) manpage.	1529	C<keysym> resource in the @@RXVT_NAME@@(1) manpage.
		1530
		1531	=item $term->register_command ($keysym, $modifiermask, $string)
		1532
		1533	Adds a key binding. This is a lower level api compared to
		1534	C<parse_keysym>, as it expects a parsed key description, and can be
		1535	used only inside either the C<on_init> hook, to add a binding, or the
		1536	C<on_register_command> hook, to modify a parsed binding.
1391		1537
1392	=item $rend = $term->rstyle ([$new_rstyle])	1538	=item $rend = $term->rstyle ([$new_rstyle])
1393		1539
1394	Return and optionally change the current rendition. Text that is output by	1540	Return and optionally change the current rendition. Text that is output by
1395	the terminal application will use this style.	1541	the terminal application will use this style.
…		…
1608		1754
1609	Adds the specified events to the vt event mask. Useful e.g. when you want	1755	Adds the specified events to the vt event mask. Useful e.g. when you want
1610	to receive pointer events all the times:	1756	to receive pointer events all the times:
1611		1757
1612	$term->vt_emask_add (urxvt::PointerMotionMask);	1758	$term->vt_emask_add (urxvt::PointerMotionMask);
		1759
		1760	=item $term->set_urgency ($set)
		1761
		1762	Enable/disable the urgency hint on the toplevel window.
1613		1763
1614	=item $term->focus_in	1764	=item $term->focus_in
1615		1765
1616	=item $term->focus_out	1766	=item $term->focus_out
1617		1767
…		…
1933	=item $term->XMoveResizeWindow ($window, $x, $y, $width, $height)	2083	=item $term->XMoveResizeWindow ($window, $x, $y, $width, $height)
1934		2084
1935	=item ($x, $y, $child_window) = $term->XTranslateCoordinates ($src, $dst, $x, $y)	2085	=item ($x, $y, $child_window) = $term->XTranslateCoordinates ($src, $dst, $x, $y)
1936		2086
1937	=item $term->XChangeInput ($window, $add_events[, $del_events])	2087	=item $term->XChangeInput ($window, $add_events[, $del_events])
		2088
		2089	=item $keysym = $term->XStringToKeysym ($string)
		2090
		2091	=item $string = $term->XKeysymToString ($keysym)
1938		2092
1939	Various X or X-related functions. The C<$term> object only serves as	2093	Various X or X-related functions. The C<$term> object only serves as
1940	the source of the display, otherwise those functions map more-or-less	2094	the source of the display, otherwise those functions map more-or-less
1941	directly onto the X functions of the same name.	2095	directly onto the X functions of the same name.
1942		2096

Diff Legend

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

Comparing rxvt-unicode/src/urxvt.pm (file contents): Revision 1.200 by sf-exg, Sun Nov 20 10:58:58 2011 UTC vs. Revision 1.215 by root, Thu Jun 7 16:30:58 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/urxvt.pm (file contents):
Revision 1.200 by sf-exg, Sun Nov 20 10:58:58 2011 UTC vs.
Revision 1.215 by root, Thu Jun 7 16:30:58 2012 UTC