[ViewVC] Diff of: cvs/rxvt-unicode/src/perl/tabbed

Comparing rxvt-unicode/src/perl/tabbed (file contents):
Revision 1.9 by root, Fri Jan 20 16:13:33 2006 UTC vs.
Revision 1.24 by root, Sun Jun 15 14:07:58 2008 UTC

…		…
4	my ($self) = @_;	4	my ($self) = @_;
5		5
6	my $ncol = $self->ncol;	6	my $ncol = $self->ncol;
7		7
8	my $text = " " x $ncol;	8	my $text = " " x $ncol;
9	my $rend = [(urxvt::DEFAULT_RSTYLE \| urxvt::RS_RVid) x $ncol];	9	my $rend = [($self->{rs_tabbar}) x $ncol];
10		10
11	my @ofs;	11	my @ofs;
12		12
13	substr $text, 0, 7, "[NEW] \|";	13	substr $text, 0, 7, "[NEW] \|";
14	@$rend[0 .. 5] = (urxvt::OVERLAY_RSTYLE) x 6;	14	@$rend[0 .. 5] = ($self->{rs_tab}) x 6;
15	push @ofs, [0, 6, sub { $_[0]->new_tab }];	15	push @ofs, [0, 6, sub { $_[0]->new_tab }];
16		16
17	my $ofs = 7;	17	my $ofs = 7;
18	my $idx = 0;	18	my $idx = 0;
19		19
…		…
25		25
26	my $txt = "$act$idx$act";	26	my $txt = "$act$idx$act";
27	my $len = length $txt;	27	my $len = length $txt;
28		28
29	substr $text, $ofs, $len + 1, "$txt\|";	29	substr $text, $ofs, $len + 1, "$txt\|";
30	@$rend[$ofs .. $ofs + $len - 1] = (urxvt::OVERLAY_RSTYLE) x $len	30	@$rend[$ofs .. $ofs + $len - 1] = ($self->{rs_tab}) x $len
31	if $tab == $self->{cur};	31	if $tab == $self->{cur};
32		32
33	push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current ($tab) } ];	33	push @ofs, [ $ofs, $ofs + $len, sub { $_[0]->make_current ($tab) } ];
34		34
35	$ofs += $len + 1;	35	$ofs += $len + 1;
…		…
42		42
43	$self->want_refresh;	43	$self->want_refresh;
44	}	44	}
45		45
46	sub new_tab {	46	sub new_tab {
47	my ($self) = @_;	47	my ($self, @argv) = @_;
48		48
49	my $offset = $self->fheight;	49	my $offset = $self->fheight;
50		50
51	# save a backlink to us, make sure tabbed is inactive	51	# save a backlink to us, make sure tabbed is inactive
52	push @urxvt::TERM_INIT, sub {	52	push @urxvt::TERM_INIT, sub {
…		…
55		55
56	$term->resource ($_->[0] => $_->[1])	56	$term->resource ($_->[0] => $_->[1])
57	for @{ $self->{resource} \|\| [] };	57	for @{ $self->{resource} \|\| [] };
58		58
59	$term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbed");	59	$term->resource (perl_ext_2 => $term->resource ("perl_ext_2") . ",-tabbed");
60
61	};	60	};
62		61
63	push @urxvt::TERM_EXT, urxvt::ext::tabbed::tab::;	62	push @urxvt::TERM_EXT, urxvt::ext::tabbed::tab::;
64		63
65	my $term = new urxvt::term	64	my $term = new urxvt::term
66	$self->env, $urxvt::RXVTNAME,	65	$self->env, $urxvt::RXVTNAME,
67	-embed => $self->parent,	66	-embed => $self->parent,
		67	@argv,
68	;	68	;
69	}	69	}
70		70
71	sub configure {	71	sub configure {
72	my ($self) = @_;	72	my ($self) = @_;
73		73
74	my $tab = $self->{cur};	74	my $tab = $self->{cur};
75		75
		76	# this is an extremely dirty way to force a configurenotify, but who cares
		77	$tab->XMoveResizeWindow (
		78	$tab->parent,
		79	0, $self->{tabheight} + 1,
		80	$self->width, $self->height - $self->{tabheight}
		81	);
76	$tab->XMoveResizeWindow (	82	$tab->XMoveResizeWindow (
77	$tab->parent,	83	$tab->parent,
78	0, $self->{tabheight},	84	0, $self->{tabheight},
79	$self->width, $self->height - $self->{tabheight}	85	$self->width, $self->height - $self->{tabheight}
80	);	86	);
		87	}
		88
		89	sub on_resize_all_windows {
		90	my ($self, $width, $height) = @_;
		91
		92	1
		93	}
		94
		95	sub copy_properties {
		96	my ($self) = @_;
		97	my $tab = $self->{cur};
81		98
82	my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS");	99	my $wm_normal_hints = $self->XInternAtom ("WM_NORMAL_HINTS");
83		100
		101	my $current = delete $self->{current_properties};
		102
		103	# pass 1: copy over properties different or nonexisting
84	for my $atom ($tab->XListProperties ($tab->parent)) {	104	for my $atom ($tab->XListProperties ($tab->parent)) {
85	my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom);	105	my ($type, $format, $items) = $self->XGetWindowProperty ($tab->parent, $atom);
86		106
		107	# fix up size hints
87	if ($atom == $wm_normal_hints) {	108	if ($atom == $wm_normal_hints) {
88	my (@hints) = unpack "l!*", $items;	109	my (@hints) = unpack "l!*", $items;
89		110
90	$hints[$_] += $self->{tabheight} for (4, 6, 16);	111	$hints[$_] += $self->{tabheight} for (4, 6, 16);
91		112
92	$items = pack "l!*", @hints;	113	$items = pack "l!*", @hints;
93	}	114	}
		115
		116	my $cur = delete $current->{$atom};
		117
		118	# update if changed, we assume empty items and zero type and format will not happen
94	$self->XChangeWindowProperty ($self->parent, $atom, $type, $format, $items);	119	$self->XChangeProperty ($self->parent, $atom, $type, $format, $items)
95	}	120	if $cur->[0] != $type or $cur->[1] != $format or $cur->[2] ne $items;
96		121
97	$self->refresh;	122	$self->{current_properties}{$atom} = [$type, $format, $items];
		123	}
		124
		125	# pass 2, delete all extraneous properties
		126	$self->XDeleteProperty ($self->parent, $_) for keys %$current;
98	}	127	}
99		128
100	sub make_current {	129	sub make_current {
101	my ($self, $tab) = @_;	130	my ($self, $tab) = @_;
102		131
…		…
107	}	136	}
108		137
109	$self->{cur} = $tab;	138	$self->{cur} = $tab;
110		139
111	$self->configure;	140	$self->configure;
112	$tab->focus_in;	141	$self->copy_properties;
		142
		143	$tab->focus_out; # just in case, should be a nop
		144	$tab->focus_in if $self->focus;
		145
113	$tab->XMapWindow ($tab->parent);	146	$tab->XMapWindow ($tab->parent);
		147	delete $tab->{activity};
114	$self->refresh;	148	$self->refresh;
115	delete $tab->{activity};
116		149
117	()	150	()
		151	}
		152
		153	sub on_focus_in {
		154	my ($self, $event) = @_;
		155
		156	$self->{cur}->focus_in;
		157
		158	()
		159	}
		160
		161	sub on_focus_out {
		162	my ($self, $event) = @_;
		163
		164	$self->{cur}->focus_out;
		165
		166	()
		167	}
		168
		169	sub on_key_press {
		170	my ($self, $event) = @_;
		171
		172	$self->{cur}->key_press ($event->{state}, $event->{keycode}, $event->{time});
		173
		174	1
		175	}
		176
		177	sub on_key_release {
		178	my ($self, $event) = @_;
		179
		180	$self->{cur}->key_release ($event->{state}, $event->{keycode}, $event->{time});
		181
		182	1
118	}	183	}
119		184
120	sub on_button_press {	185	sub on_button_press {
121	1	186	1
122	}	187	}
…		…
140	}	205	}
141		206
142	sub on_init {	207	sub on_init {
143	my ($self) = @_;	208	my ($self) = @_;
144		209
145	for (qw(name perl_ext_1 perl_ext_2)) {	210	for (qw(name chdir perl_ext_1 perl_ext_2)) {
146	my $val = $self->resource ($_);	211	my $val = $self->resource ($_);
147		212
148	push @{ $self->{resource} }, [$_ => $val]	213	push @{ $self->{resource} }, [$_ => $val]
149	if defined $val;	214	if defined $val;
150	}	215	}
151		216
152	$self->resource (int_bwidth => 0);	217	$self->resource (int_bwidth => 0);
153	$self->resource (name => "URxvt.tab");	218	$self->resource (name => "URxvt.tabbed");
154	$self->resource (pty_fd => -1);	219	$self->resource (pty_fd => -1);
155		220
156	$self->option ($urxvt::OPTION{scrollBar}, 0);	221	$self->option ($urxvt::OPTION{scrollBar}, 0);
157		222
		223	my $fg = $self->x_resource ("tabbar-fg");
		224	my $bg = $self->x_resource ("tabbar-bg");
		225	my $tabfg = $self->x_resource ("tab-fg");
		226	my $tabbg = $self->x_resource ("tab-bg");
		227
		228	defined $fg or $fg = 3;
		229	defined $bg or $bg = 0;
		230	defined $tabfg or $tabfg = 0;
		231	defined $tabbg or $tabbg = 1;
		232
		233	$self->{rs_tabbar} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $fg + 2, $bg + 2);
		234	$self->{rs_tab} = urxvt::SET_COLOR (urxvt::DEFAULT_RSTYLE, $tabfg + 2, $tabbg + 2);
		235
158	()	236	()
159	}	237	}
160		238
161	sub on_start {	239	sub on_start {
162	my ($self) = @_;	240	my ($self) = @_;
163		241
164	$self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace;	242	$self->{tabheight} = $self->int_bwidth + $self->fheight + $self->lineSpace;
165		243
		244	$self->cmd_parse ("\033[?25l");
		245
		246	my @argv = $self->argv;
		247
		248	do {
		249	shift @argv;
		250	} while @argv && $argv[0] ne "-e";
		251
166	$self->new_tab;	252	$self->new_tab (@argv);
167		253
168	()	254	()
169	}	255	}
170		256
171	sub on_configure_notify {	257	sub on_configure_notify {
172	my ($self, $event) = @_;	258	my ($self, $event) = @_;
173		259
174	$self->configure;	260	$self->configure;
		261	$self->refresh;
175		262
176	()	263	()
177	}	264	}
178		265
179	sub on_wm_delete_window {	266	sub on_wm_delete_window {
…		…
184	1	271	1
185	}	272	}
186		273
187	sub tab_start {	274	sub tab_start {
188	my ($self, $tab) = @_;	275	my ($self, $tab) = @_;
		276
		277	$tab->XChangeInput ($tab->parent, urxvt::PropertyChangeMask);
189		278
190	push @{ $self->{tabs} }, $tab;	279	push @{ $self->{tabs} }, $tab;
191		280
192	# $tab->{name} \|\|= scalar @{ $self->{tabs} };	281	# $tab->{name} \|\|= scalar @{ $self->{tabs} };
193	$self->make_current ($tab);	282	$self->make_current ($tab);
…		…
216	}	305	}
217		306
218	sub tab_key_press {	307	sub tab_key_press {
219	my ($self, $tab, $event, $keysym, $str) = @_;	308	my ($self, $tab, $event, $keysym, $str) = @_;
220		309
221	if ($event->{state} & urxvt::ShiftMask	310	if ($event->{state} & urxvt::ShiftMask) {
222	&& ($keysym == 0xff51 \|\| $keysym == 0xff53)) {	311	if ($keysym == 0xff51 \|\| $keysym == 0xff53) {
223	my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} };	312	my ($idx) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} };
224		313
225	--$idx if $keysym == 0xff51;	314	--$idx if $keysym == 0xff51;
226	++$idx if $keysym == 0xff53;	315	++$idx if $keysym == 0xff53;
227		316
228	$self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]);	317	$self->make_current ($self->{tabs}[$idx % @{ $self->{tabs}}]);
229	$self->refresh;	318
		319	return 1;
		320	} elsif ($keysym == 0xff54) {
		321	$self->new_tab;
		322
		323	return 1;
230		324	}
		325	}
		326	elsif ($event->{state} & urxvt::ControlMask) {
		327	if ($keysym == 0xff51 \|\| $keysym == 0xff53) {
		328	my ($idx1) = grep $self->{tabs}[$_] == $tab, 0 .. $#{ $self->{tabs} };
		329	my $idx2 = ($idx1 + ($keysym == 0xff51 ? -1 : +1)) % @{ $self->{tabs} };
		330
		331	($self->{tabs}[$idx1], $self->{tabs}[$idx2]) =
		332	($self->{tabs}[$idx2], $self->{tabs}[$idx1]);
		333
		334	$self->make_current ($self->{tabs}[$idx2]);
		335
231	return 1;	336	return 1;
		337	}
232	}	338	}
		339
		340	()
		341	}
		342
		343	sub tab_property_notify {
		344	my ($self, $tab, $event) = @_;
		345
		346	$self->copy_properties
		347	if $event->{window} == $tab->parent;
233		348
234	()	349	()
235	}	350	}
236		351
237	sub tab_activity {	352	sub tab_activity {
…		…
244		359
245	# helper extension implementing the subwindows of a tabbed terminal.	360	# helper extension implementing the subwindows of a tabbed terminal.
246	# simply proxies all interesting calls back to the tabbed class.	361	# simply proxies all interesting calls back to the tabbed class.
247		362
248	{	363	{
249	for my $hook qw(start destroy key_press) {	364	for my $hook qw(start destroy key_press property_notify) {
250	eval qq{	365	eval qq{
251	sub on_$hook {	366	sub on_$hook {
252	my \$parent = \$_[0]{term}{parent}	367	my \$parent = \$_[0]{term}{parent}
253	or return;	368	or return;
254	\$parent->tab_$hook (\@_)	369	\$parent->tab_$hook (\@_)

Diff Legend

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

Comparing rxvt-unicode/src/perl/tabbed (file contents): Revision 1.9 by root, Fri Jan 20 16:13:33 2006 UTC vs. Revision 1.24 by root, Sun Jun 15 14:07:58 2008 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/tabbed (file contents):
Revision 1.9 by root, Fri Jan 20 16:13:33 2006 UTC vs.
Revision 1.24 by root, Sun Jun 15 14:07:58 2008 UTC