line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
# Curses::UI::Notebook |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Written by George A. Theall, theall@tifaware.com |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Copyright (c) 2004, George A. Theall. All rights reserved. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# This module is free software; you can redistribute it and/or modify |
9
|
|
|
|
|
|
|
# it under the same terms as Perl itself. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# $Id: Notebook.pm,v 1.2 2004/10/22 21:07:27 mthies2s Exp $ |
12
|
|
|
|
|
|
|
# ---------------------------------------------------------------------- |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package Curses::UI::Notebook; |
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
1471
|
use 5; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
57
|
|
17
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
18
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
19
|
1
|
|
|
1
|
|
6
|
use Curses; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3214
|
|
20
|
1
|
|
|
1
|
|
9
|
use Curses::UI::Common; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
107
|
|
21
|
1
|
|
|
1
|
|
6
|
use Curses::UI::Widget; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
65
|
|
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
|
|
5159
|
use vars qw( |
24
|
|
|
|
|
|
|
$VERSION |
25
|
|
|
|
|
|
|
@ISA |
26
|
1
|
|
|
1
|
|
5
|
); |
|
1
|
|
|
|
|
2
|
|
27
|
|
|
|
|
|
|
$VERSION = '1.0001'; |
28
|
|
|
|
|
|
|
@ISA = qw( |
29
|
|
|
|
|
|
|
Curses::UI::Container |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my %routines = ( |
33
|
|
|
|
|
|
|
'goto_first_page' => sub { my $this = shift; $this->activate_page($this->first_page); }, |
34
|
|
|
|
|
|
|
'goto_last_page' => sub { my $this = shift; $this->activate_page($this->last_page); }, |
35
|
|
|
|
|
|
|
'goto_next_page' => sub { my $this = shift; $this->activate_page($this->next_page); }, |
36
|
|
|
|
|
|
|
'goto_prev_page' => sub { my $this = shift; $this->activate_page($this->prev_page); }, |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
my %bindings = ( |
39
|
|
|
|
|
|
|
KEY_HOME() => 'goto_first_page', |
40
|
|
|
|
|
|
|
"\cA" => 'goto_first_page', |
41
|
|
|
|
|
|
|
KEY_END() => 'goto_last_page', |
42
|
|
|
|
|
|
|
"\cE" => 'goto_last_page', |
43
|
|
|
|
|
|
|
KEY_NPAGE() => 'goto_next_page', |
44
|
|
|
|
|
|
|
"\cN" => 'goto_next_page', |
45
|
|
|
|
|
|
|
KEY_PPAGE() => 'goto_prev_page', |
46
|
|
|
|
|
|
|
"\cP" => 'goto_prev_page', |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub debug_msg(;$) { |
51
|
166
|
50
|
|
166
|
0
|
351
|
return unless ($Curses::UI::debug); |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
0
|
my $caller = (caller(1))[3]; |
54
|
0
|
|
0
|
|
|
0
|
my $msg = shift || ''; |
55
|
0
|
0
|
|
|
|
0
|
my $indent = ($msg =~ /^(\s+)/ ? $1 : ''); |
56
|
0
|
|
|
|
|
0
|
$msg =~ s/\n/\nDEBUG: $indent/mg; |
57
|
|
|
|
|
|
|
|
58
|
0
|
0
|
0
|
|
|
0
|
warn 'DEBUG: ' . |
59
|
|
|
|
|
|
|
($msg ? |
60
|
|
|
|
|
|
|
"$msg in $caller" : |
61
|
|
|
|
|
|
|
"$caller() called by " . ((caller(2))[3] || 'main') |
62
|
|
|
|
|
|
|
) . |
63
|
|
|
|
|
|
|
"().\n"; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub new($;) { |
68
|
2
|
|
|
2
|
1
|
6
|
debug_msg; |
69
|
2
|
|
|
|
|
3
|
my $class = shift; |
70
|
|
|
|
|
|
|
|
71
|
2
|
|
|
|
|
5
|
my %userargs = @_; |
72
|
2
|
|
|
|
|
7
|
keys_to_lowercase(\%userargs); |
73
|
|
|
|
|
|
|
# nb: support only arguments listed in @valid_args; |
74
|
2
|
|
|
|
|
11
|
my @valid_args = ( |
75
|
|
|
|
|
|
|
'x', 'y', 'width', 'height', |
76
|
|
|
|
|
|
|
'pad', 'padleft', 'padright', 'padtop', 'padbottom', |
77
|
|
|
|
|
|
|
'ipad', 'ipadleft', 'ipadright', 'ipadtop', 'ipadbottom', |
78
|
|
|
|
|
|
|
'wraparound', |
79
|
|
|
|
|
|
|
'border', 'sbborder', |
80
|
|
|
|
|
|
|
'bg', 'fg', |
81
|
|
|
|
|
|
|
'intellidraw', |
82
|
|
|
|
|
|
|
'onchange', 'onblur', |
83
|
|
|
|
|
|
|
'routines', 'bindings', |
84
|
|
|
|
|
|
|
'parent', |
85
|
|
|
|
|
|
|
); |
86
|
2
|
|
|
|
|
6
|
foreach my $arg (keys %userargs) { |
87
|
5
|
50
|
|
|
|
39
|
unless (grep($arg eq "-$_", @valid_args)) { |
88
|
0
|
|
|
|
|
0
|
debug_msg " deleting invalid arg '$arg'"; |
89
|
0
|
|
|
|
|
0
|
delete $userargs{$arg}; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
2
|
|
|
|
|
38
|
my %args = ( |
93
|
|
|
|
|
|
|
-x => 0, # horizontal start position |
94
|
|
|
|
|
|
|
-y => 0, # vertical start position |
95
|
|
|
|
|
|
|
-width => undef, # width |
96
|
|
|
|
|
|
|
-height => undef, # height (nb: including tabs) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
-ipadleft => 1, # left padding |
99
|
|
|
|
|
|
|
-ipadright => 1, # right padding |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
-wraparound => 1, # enable wraparound when changing pages? |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
-border => 1, # border around tabs / active window |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
-bg => -1, # default background color |
106
|
|
|
|
|
|
|
-fg => -1, # default foreground color |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
-intellidraw => 1, |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
-routines => {%routines}, |
111
|
|
|
|
|
|
|
-bindings => {%bindings}, |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
%userargs, |
114
|
|
|
|
|
|
|
); |
115
|
2
|
|
|
|
|
22
|
foreach (sort keys %args) { |
116
|
29
|
100
|
|
|
|
86
|
debug_msg " \$args{$_} = " . (defined $args{$_} ? $args{$_} : 'n/a'); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# nb: some type of border is currently needed for tab labels. |
120
|
2
|
50
|
66
|
|
|
13
|
return unless ($args{-border} or $args{-sbborder}); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# Create the widget. |
123
|
2
|
|
|
|
|
12
|
debug_msg ' creating Notebook object'; |
124
|
2
|
|
|
|
|
16
|
my $this = $class->SUPER::new(%args); |
125
|
2
|
50
|
|
|
|
11
|
if ($Curses::UI::ncurses_mouse) { |
126
|
2
|
|
|
|
|
7
|
$this->set_mouse_binding(\&mouse_button1, BUTTON1_CLICKED()); |
127
|
|
|
|
|
|
|
} |
128
|
2
|
|
|
|
|
3
|
@{$this->{-pages}} = (); # names of pages stored as an array. |
|
2
|
|
|
|
|
7
|
|
129
|
|
|
|
|
|
|
|
130
|
2
|
|
|
|
|
12
|
return $this; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub layout($) { |
135
|
2
|
|
|
2
|
1
|
5
|
debug_msg; |
136
|
2
|
|
|
|
|
3
|
my $this = shift; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Don't wast time if we know the screen is too small. |
139
|
2
|
50
|
|
|
|
5
|
return if ($Curses::UI::screen_too_small); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Origin defaults to (0,0) relative to parent. |
142
|
|
|
|
|
|
|
# |
143
|
|
|
|
|
|
|
# nb: if origin is negative, treat it as an end-point and |
144
|
|
|
|
|
|
|
# as relative to parent's end-point. |
145
|
2
|
50
|
|
|
|
15
|
$this->{-y} = 0 unless (defined $this->{-y}); |
146
|
2
|
50
|
|
|
|
7
|
$this->{-x} = 0 unless (defined $this->{-x}); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Expand -pad/-ipad args. |
149
|
2
|
|
|
|
|
6
|
$this->process_padding; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# Make sure there's enough space for the widget. |
152
|
|
|
|
|
|
|
# |
153
|
|
|
|
|
|
|
# - get parent's data. |
154
|
2
|
|
|
|
|
11
|
$this->{-parentdata} = $this->{-parent}->windowparameters; |
155
|
2
|
|
|
|
|
9
|
my $ph = $this->{-parentdata}->{-h}; |
156
|
2
|
|
|
|
|
4
|
my $pw = $this->{-parentdata}->{-w}; |
157
|
|
|
|
|
|
|
# - calculate space available to the widget. |
158
|
2
|
50
|
|
|
|
8
|
my $avail_h = $ph - ($this->{-y} < 0 ? abs($this->{-y}+1) : $this->{-y}); |
159
|
2
|
50
|
|
|
|
6
|
my $avail_w = $pw - ($this->{-x} < 0 ? abs($this->{-x}+1) : $this->{-x}); |
160
|
2
|
|
|
|
|
6
|
debug_msg " available height / width = $avail_h / $avail_w"; |
161
|
|
|
|
|
|
|
# - size of widget defaults to available space. |
162
|
2
|
50
|
|
|
|
6
|
my $h = (defined $this->{-height} ? $this->{-height} : $avail_h); |
163
|
2
|
50
|
|
|
|
7
|
my $w = (defined $this->{-width} ? $this->{-width} : $avail_w); |
164
|
2
|
|
|
|
|
6
|
debug_msg " size of widget = $h / $w"; |
165
|
|
|
|
|
|
|
# - calculate required size given borders, padding, etc. |
166
|
2
|
100
|
|
|
|
14
|
my $req_h = ($this->{-border} ? 3 : 0) + |
|
|
100
|
|
|
|
|
|
167
|
|
|
|
|
|
|
($this->{-sbborder} ? 3 : 0) + |
168
|
|
|
|
|
|
|
$this->{-padtop} + |
169
|
|
|
|
|
|
|
$this->{-padbottom}; |
170
|
2
|
100
|
|
|
|
18
|
my $req_w = ($this->{-border} ? 2 : 0) + |
|
|
100
|
|
|
|
|
|
171
|
|
|
|
|
|
|
($this->{-sbborder} ? 2 : 0) + |
172
|
|
|
|
|
|
|
$this->{-padleft} + |
173
|
|
|
|
|
|
|
$this->{-padright}; |
174
|
2
|
|
|
|
|
7
|
debug_msg " required size of widget = $req_h / $req_w"; |
175
|
|
|
|
|
|
|
# - make sure widget fits given what's required and available. |
176
|
2
|
50
|
33
|
|
|
48
|
if ( |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
177
|
|
|
|
|
|
|
$h < $req_h or $h > $avail_h or |
178
|
|
|
|
|
|
|
$w < $req_w or $w > $avail_w |
179
|
|
|
|
|
|
|
) { |
180
|
0
|
|
|
|
|
0
|
debug_msg " screen is too small!"; |
181
|
0
|
|
|
|
|
0
|
$Curses::UI::screen_too_small++; |
182
|
0
|
|
|
|
|
0
|
return $this; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Update some widget parameters. |
186
|
|
|
|
|
|
|
# |
187
|
|
|
|
|
|
|
# - height and width. |
188
|
2
|
|
|
|
|
6
|
$this->{-h} = $h; |
189
|
2
|
|
|
|
|
3
|
$this->{-w} = $w; |
190
|
|
|
|
|
|
|
# - starting point. |
191
|
|
|
|
|
|
|
# nb: keep in mind if origin is negative, (x,y) is an end-point |
192
|
|
|
|
|
|
|
# relative to parent's end-point. |
193
|
2
|
50
|
|
|
|
9
|
$this->{-realy} = $this->{-y} + ($this->{-y} >= 0 ? 0 : $ph - $h + 1); |
194
|
2
|
50
|
|
|
|
8
|
$this->{-realx} = $this->{-x} + ($this->{-x} >= 0 ? 0 : $pw - $w + 1); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# Create widget border, if desired. |
197
|
2
|
50
|
66
|
|
|
19
|
if ( |
198
|
|
|
|
|
|
|
$this->{-border} or |
199
|
|
|
|
|
|
|
$this->{-sbborder} |
200
|
|
|
|
|
|
|
) { |
201
|
2
|
|
|
|
|
8
|
$this->{-bh} = $h - $this->{-padtop} - $this->{-padbottom}; |
202
|
2
|
|
|
|
|
7
|
$this->{-bw} = $w - $this->{-padleft} - $this->{-padright}; |
203
|
2
|
|
|
|
|
7
|
$this->{-by} = $this->{-realy} + $this->{-padtop}; |
204
|
2
|
|
|
|
|
7
|
$this->{-bx} = $this->{-realx} + $this->{-padleft}; |
205
|
2
|
|
|
|
|
10
|
my @args = ( |
206
|
|
|
|
|
|
|
$this->{-bh}, |
207
|
|
|
|
|
|
|
$this->{-bw}, |
208
|
|
|
|
|
|
|
$this->{-by}, |
209
|
|
|
|
|
|
|
$this->{-bx}, |
210
|
|
|
|
|
|
|
); |
211
|
2
|
|
|
|
|
11
|
debug_msg " creating borderscr with args " . join(",", @args); |
212
|
2
|
50
|
|
|
|
19
|
unless ( |
213
|
|
|
|
|
|
|
$this->{-borderscr} = $this->{-parent}->{-canvasscr}->derwin(@args) |
214
|
|
|
|
|
|
|
) { |
215
|
0
|
|
|
|
|
0
|
debug_msg " screen is too small for border widget!"; |
216
|
0
|
|
|
|
|
0
|
$Curses::UI::screen_too_small++; |
217
|
0
|
|
|
|
|
0
|
return $this; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Create widget window itself. |
222
|
2
|
100
|
|
|
|
52
|
$this->{-sh} = $this->{-bh} - |
|
|
100
|
|
|
|
|
|
223
|
|
|
|
|
|
|
$this->{-ipadtop} - |
224
|
|
|
|
|
|
|
$this->{-ipadbottom} - |
225
|
|
|
|
|
|
|
($this->{-border} ? 4 : 0) - |
226
|
|
|
|
|
|
|
($this->{-sbborder} ? 4 : 0); |
227
|
2
|
100
|
|
|
|
12
|
$this->{-sw} = $this->{-bw} - |
|
|
100
|
|
|
|
|
|
228
|
|
|
|
|
|
|
$this->{-ipadleft} - |
229
|
|
|
|
|
|
|
$this->{-ipadright} - |
230
|
|
|
|
|
|
|
($this->{-border} ? 2 : 0) - |
231
|
|
|
|
|
|
|
($this->{-sbborder} ? 2 : 0); |
232
|
2
|
100
|
|
|
|
12
|
$this->{-sy} = $this->{-by} + |
|
|
100
|
|
|
|
|
|
233
|
|
|
|
|
|
|
$this->{-ipadtop} + |
234
|
|
|
|
|
|
|
($this->{-border} ? 3 : 0) + |
235
|
|
|
|
|
|
|
($this->{-sbborder} ? 3 : 0); |
236
|
2
|
100
|
|
|
|
22
|
$this->{-sx} = $this->{-bx} + |
|
|
100
|
|
|
|
|
|
237
|
|
|
|
|
|
|
$this->{-ipadleft} + |
238
|
|
|
|
|
|
|
($this->{-border} ? 1 : 0) + |
239
|
|
|
|
|
|
|
($this->{-sbborder} ? 1 : 0); |
240
|
2
|
|
|
|
|
9
|
my @args = ( |
241
|
|
|
|
|
|
|
$this->{-sh}, |
242
|
|
|
|
|
|
|
$this->{-sw}, |
243
|
|
|
|
|
|
|
$this->{-sy}, |
244
|
|
|
|
|
|
|
$this->{-sx}, |
245
|
|
|
|
|
|
|
); |
246
|
2
|
|
|
|
|
11
|
debug_msg " creating canvasscr with args " . join(",", @args); |
247
|
2
|
|
|
|
|
10
|
$this->{-canvasscr} = $this->{-parent}->{-canvasscr}->derwin(@args); |
248
|
2
|
50
|
|
|
|
26
|
unless (defined $this->{-canvasscr}) |
249
|
|
|
|
|
|
|
{ |
250
|
0
|
|
|
|
|
0
|
debug_msg " screen is too small for window widget!"; |
251
|
0
|
|
|
|
|
0
|
$Curses::UI::screen_too_small++; |
252
|
0
|
|
|
|
|
0
|
return $this; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
2
|
50
|
|
|
|
6
|
unless (defined $this->{-borderscr}) { |
256
|
0
|
|
|
|
|
0
|
$this->{-bh} = $this->{-sh}; |
257
|
0
|
|
|
|
|
0
|
$this->{-bw} = $this->{-sw}; |
258
|
0
|
|
|
|
|
0
|
$this->{-by} = $this->{-sy}; |
259
|
0
|
|
|
|
|
0
|
$this->{-bx} = $this->{-sx}; |
260
|
|
|
|
|
|
|
} |
261
|
2
|
|
|
|
|
8
|
return $this; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub draw($;$) { |
266
|
0
|
|
|
0
|
1
|
0
|
debug_msg; |
267
|
0
|
|
|
|
|
0
|
my $this = shift; |
268
|
0
|
|
0
|
|
|
0
|
my $no_doupdate = shift || 0; |
269
|
0
|
|
|
|
|
0
|
debug_msg " \$no_doupdate = $no_doupdate"; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# Return immediately if this object is hidden or if |
272
|
|
|
|
|
|
|
# the screen is currently too small. |
273
|
0
|
0
|
|
|
|
0
|
return if $this->hidden; |
274
|
0
|
0
|
|
|
|
0
|
return if $Curses::UI::screen_too_small; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# Identify various pages of interest. |
277
|
0
|
|
|
|
|
0
|
my $first_page = $this->first_page; |
278
|
0
|
|
|
|
|
0
|
my $next_page = $this->next_page; |
279
|
0
|
|
|
|
|
0
|
my $last_page = $this->last_page; |
280
|
0
|
|
|
|
|
0
|
my $active_page = $this->active_page; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# Identify page window. |
283
|
0
|
|
|
|
|
0
|
my $page_win = $this->{-borderscr}; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# Hide cursor. |
286
|
0
|
|
|
|
|
0
|
eval { curs_set(0) }; # not available on every system. |
|
0
|
|
|
|
|
0
|
|
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Enable colors if desired. |
289
|
0
|
0
|
|
|
|
0
|
if ($Curses::UI::color_support) { |
290
|
0
|
|
|
|
|
0
|
debug_msg " enabling color support"; |
291
|
0
|
|
|
|
|
0
|
my $co = $Curses::UI::color_object; |
292
|
0
|
|
|
|
|
0
|
my $pair = $co->get_color_pair( |
293
|
|
|
|
|
|
|
$this->{-fg}, |
294
|
|
|
|
|
|
|
$this->{-bg} |
295
|
|
|
|
|
|
|
); |
296
|
0
|
|
|
|
|
0
|
$page_win->attron(COLOR_PAIR($pair)); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
0
|
my $ch_hbar = $this->{-border} ? ACS_HLINE : '-'; |
300
|
0
|
0
|
|
|
|
0
|
my $ch_vbar = $this->{-border} ? ACS_VLINE : '|'; |
301
|
0
|
0
|
|
|
|
0
|
my $ch_tl = $this->{-border} ? ACS_ULCORNER : '+'; |
302
|
0
|
0
|
|
|
|
0
|
my $ch_tr = $this->{-border} ? ACS_URCORNER : '+'; |
303
|
0
|
0
|
|
|
|
0
|
my $ch_bl = $this->{-border} ? ACS_LLCORNER : '+'; |
304
|
0
|
0
|
|
|
|
0
|
my $ch_br = $this->{-border} ? ACS_LRCORNER : '+'; |
305
|
0
|
0
|
|
|
|
0
|
my $ch_ttee = $this->{-border} ? ACS_TTEE : '+'; |
306
|
0
|
0
|
|
|
|
0
|
my $ch_btee = $this->{-border} ? ACS_BTEE : '+'; |
307
|
0
|
0
|
|
|
|
0
|
my $ch_ltee = $this->{-border} ? ACS_LTEE : '+'; |
308
|
0
|
0
|
|
|
|
0
|
my $ch_rtee = $this->{-border} ? ACS_RTEE : '+'; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# Draw tabs along with a border if desired. |
311
|
0
|
|
|
|
|
0
|
my($x, $y) = (0, 0); |
312
|
0
|
0
|
0
|
|
|
0
|
$y = 1 if ($this->{-border} or $this->{-sbborder}); |
313
|
0
|
|
|
|
|
0
|
foreach my $page (@{$this->{-pages}}) { |
|
0
|
|
|
|
|
0
|
|
314
|
0
|
|
|
|
|
0
|
debug_msg " drawing tab for page '$page'"; |
315
|
|
|
|
|
|
|
|
316
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-border} or $this->{-sbborder}) { |
317
|
0
|
|
|
|
|
0
|
debug_msg " adding left border at x=$x"; |
318
|
0
|
0
|
|
|
|
0
|
$page_win->addch(0, $x, ($page eq $first_page ? $ch_tl : $ch_ttee)); |
319
|
0
|
|
|
|
|
0
|
$page_win->addch(1, $x, $ch_vbar); |
320
|
0
|
0
|
|
|
|
0
|
$page_win->addch(2, $x, |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
321
|
|
|
|
|
|
|
($page eq $first_page ? |
322
|
|
|
|
|
|
|
($page eq $active_page ? |
323
|
|
|
|
|
|
|
$ch_vbar : |
324
|
|
|
|
|
|
|
$ch_ltee |
325
|
|
|
|
|
|
|
) : |
326
|
|
|
|
|
|
|
($page eq $active_page ? |
327
|
|
|
|
|
|
|
$ch_br : |
328
|
|
|
|
|
|
|
($page eq $next_page ? |
329
|
|
|
|
|
|
|
$ch_bl : |
330
|
|
|
|
|
|
|
$ch_btee |
331
|
|
|
|
|
|
|
) |
332
|
|
|
|
|
|
|
) |
333
|
|
|
|
|
|
|
) |
334
|
|
|
|
|
|
|
); |
335
|
0
|
|
|
|
|
0
|
++$x; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
0
|
0
|
|
|
|
0
|
debug_msg " adding $this->{-ipadleft} space" . ($this->{-ipadright} == 1 ? "" : "s") . " of padding at x=$x"; |
339
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-border} or $this->{-sbborder}) { |
340
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < $this->{-ipadleft}; $i++) { |
341
|
0
|
|
|
|
|
0
|
$page_win->addch(0, $x, $ch_hbar); |
342
|
|
|
|
|
|
|
# |
343
|
0
|
0
|
|
|
|
0
|
$page_win->addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar)); |
344
|
0
|
|
|
|
|
0
|
++$x; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
else { |
348
|
0
|
|
|
|
|
0
|
$x += $this->{-ipadleft}; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
0
|
|
|
|
|
0
|
debug_msg " writing page name at x=$x"; |
352
|
0
|
0
|
|
|
|
0
|
$page_win->attron(A_REVERSE) if ($page eq $active_page); |
353
|
0
|
|
|
|
|
0
|
$page_win->addstr($y, $x, $page); |
354
|
0
|
0
|
|
|
|
0
|
$page_win->attroff(A_REVERSE) if ($page eq $active_page); |
355
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-border} or $this->{-sbborder}) { |
356
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < length($page); $i++) { |
357
|
0
|
|
|
|
|
0
|
$page_win->addch(0, $x, $ch_hbar); |
358
|
|
|
|
|
|
|
# |
359
|
0
|
0
|
|
|
|
0
|
$page_win->addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar)); |
360
|
0
|
|
|
|
|
0
|
++$x; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
else { |
364
|
0
|
|
|
|
|
0
|
$x += length($page); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
0
|
0
|
|
|
|
0
|
debug_msg " adding $this->{-ipadright} space" . ($this->{-ipadright} == 1 ? "" : "s") . " of padding at x=$x"; |
368
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-border} or $this->{-sbborder}) { |
369
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < $this->{-ipadright}; $i++) { |
370
|
0
|
|
|
|
|
0
|
$page_win->addch(0, $x, $ch_hbar); |
371
|
|
|
|
|
|
|
# |
372
|
0
|
0
|
|
|
|
0
|
$page_win->addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar)); |
373
|
0
|
|
|
|
|
0
|
++$x; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
else { |
377
|
0
|
|
|
|
|
0
|
$x += $this->{-ipadright}; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
0
|
0
|
0
|
|
|
0
|
if (($this->{-border} or $this->{-sbborder}) and $page eq $last_page) { |
|
|
|
0
|
|
|
|
|
381
|
0
|
|
|
|
|
0
|
debug_msg " adding right border at x=$x"; |
382
|
0
|
|
|
|
|
0
|
$page_win->addch(0, $x, $ch_tr); |
383
|
0
|
|
|
|
|
0
|
$page_win->addch(1, $x, $ch_vbar); |
384
|
0
|
0
|
|
|
|
0
|
$page_win->addch(2, $x, ($page eq $active_page ? $ch_bl : $ch_btee)); |
385
|
0
|
|
|
|
|
0
|
++$x; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
} |
388
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-border} or $this->{-sbborder}) { |
389
|
0
|
|
|
|
|
0
|
do { |
390
|
0
|
|
|
|
|
0
|
$page_win->addch(2, $x, $ch_hbar); |
391
|
|
|
|
|
|
|
} while (++$x < $this->{-bw}-1); |
392
|
0
|
|
|
|
|
0
|
$page_win->addch(2, $x, $ch_tr); |
393
|
|
|
|
|
|
|
|
394
|
0
|
|
|
|
|
0
|
for ($y = 3; $y < $this->{-bh}-1; $y++) { |
395
|
0
|
|
|
|
|
0
|
$page_win->addch($y, $this->{-x}, $ch_vbar); |
396
|
0
|
|
|
|
|
0
|
$page_win->addch($y, $x, $ch_vbar); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
0
|
$page_win->addch($y, $this->{-x}, $ch_bl); |
400
|
0
|
|
|
|
|
0
|
for ($x = $this->{-x}+1; $x < $this->{-bw}-1; $x++) { |
401
|
0
|
|
|
|
|
0
|
$page_win->addch($y, $x, $ch_hbar); |
402
|
|
|
|
|
|
|
} |
403
|
0
|
|
|
|
|
0
|
$page_win->addch($y, $x, $ch_br); |
404
|
|
|
|
|
|
|
} |
405
|
0
|
|
|
|
|
0
|
$page_win->noutrefresh; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# Draw active window. |
408
|
0
|
|
|
|
|
0
|
$this->getobj($active_page)->draw($no_doupdate); |
409
|
|
|
|
|
|
|
|
410
|
0
|
0
|
|
|
|
0
|
doupdate unless ($no_doupdate); |
411
|
0
|
|
|
|
|
0
|
return $this; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# NB: we can't simply inherit intellidraw from Curses::UI::Widget |
416
|
|
|
|
|
|
|
# since notebooks themselves contain window objects. |
417
|
|
|
|
|
|
|
sub intellidraw(;$) { |
418
|
0
|
|
|
0
|
1
|
0
|
debug_msg; |
419
|
0
|
|
|
|
|
0
|
my $this = shift; |
420
|
|
|
|
|
|
|
|
421
|
0
|
0
|
0
|
|
|
0
|
if ($this->{-intellidraw} and !$this->hidden) { |
422
|
|
|
|
|
|
|
# Check if parent window has modal focus or is on top of focus path. |
423
|
0
|
|
|
|
|
0
|
my $parent = $this->parentwindow; |
424
|
0
|
|
|
|
|
0
|
debug_msg " parent window = " . $parent; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
0
|
my @path = $this->root->focus_path; |
427
|
0
|
|
|
|
|
0
|
debug_msg " focus_path " . join(" & ", @path); |
428
|
|
|
|
|
|
|
# Ignore anything above our object. |
429
|
0
|
|
|
|
|
0
|
while (grep($_ eq $this, @path)) { |
430
|
0
|
|
|
|
|
0
|
$_ = pop(@path); |
431
|
0
|
|
|
|
|
0
|
debug_msg " skipping $_ to find ourselves"; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
# Now find next window. |
434
|
0
|
|
0
|
|
|
0
|
while (@path > 1 and !$path[-1]->isa('Curses::UI::Window')) { |
435
|
0
|
|
|
|
|
0
|
$_ = pop(@path); |
436
|
0
|
|
|
|
|
0
|
debug_msg " skipping $_ to find previous window"; |
437
|
|
|
|
|
|
|
} |
438
|
0
|
0
|
|
|
|
0
|
debug_msg " next window = " . (@path ? $path[-1] : 'n/a'); |
439
|
|
|
|
|
|
|
|
440
|
0
|
0
|
0
|
|
|
0
|
$this->draw if ( |
|
|
|
0
|
|
|
|
|
441
|
|
|
|
|
|
|
$parent->{-has_modal_focus} or |
442
|
|
|
|
|
|
|
(@path and $parent eq $path[-1]) |
443
|
|
|
|
|
|
|
); |
444
|
|
|
|
|
|
|
} |
445
|
0
|
|
|
|
|
0
|
return $this; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub add_page($$;) { |
450
|
8
|
|
|
8
|
1
|
3543
|
debug_msg; |
451
|
8
|
|
|
|
|
11
|
my $this = shift; |
452
|
8
|
50
|
|
|
|
16
|
my $page = shift or return; |
453
|
8
|
|
|
|
|
33
|
debug_msg " adding '$page' page"; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# Make sure page is not yet part of the notebook. |
456
|
8
|
50
|
|
|
|
32
|
$this->root->fatalerror("The notebook already has a page named '$page'!") |
457
|
|
|
|
|
|
|
if (defined $this->{-id2object}->{$page}); |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# Make sure the page does not cause the 'tabs' window to overflow. |
460
|
8
|
|
|
|
|
9
|
my $len = 0; |
461
|
8
|
|
|
|
|
9
|
foreach my $page (@{$this->{-pages}}, $page) { |
|
8
|
|
|
|
|
23
|
|
462
|
17
|
|
50
|
|
|
159
|
$len += length($page) + |
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
463
|
|
|
|
|
|
|
($this->{-ipadleft} || 0) + ($this->{-ipadright} || 0) + |
464
|
|
|
|
|
|
|
($this->{-border} || 0) + ($this->{-sbborder} || 0); |
465
|
|
|
|
|
|
|
} |
466
|
8
|
|
|
|
|
16
|
++$len; # nb: needed for final border char. |
467
|
8
|
|
|
|
|
49
|
debug_msg " $len spaces are needed for tab labels"; |
468
|
8
|
100
|
|
|
|
29
|
if ($len > $this->{-bw}) { |
469
|
1
|
|
|
|
|
7
|
debug_msg " screen is too small - width is $this->{-bw}"; |
470
|
1
|
|
|
|
|
2
|
$Curses::UI::screen_too_small++; |
471
|
1
|
|
|
|
|
3
|
return; |
472
|
|
|
|
|
|
|
}; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# Create a window for this page using same layout as widget's canvasscr. |
475
|
7
|
|
|
|
|
15
|
my %userargs = @_; |
476
|
7
|
|
|
|
|
26
|
keys_to_lowercase(\%userargs); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# grab callback arguments |
479
|
7
|
|
|
|
|
13
|
foreach my $cbkey (qw/-on_activate -on_delete/) { |
480
|
14
|
100
|
|
|
|
43
|
$this->{callback}{$page}{$cbkey} = delete $userargs{$cbkey} |
481
|
|
|
|
|
|
|
if defined $userargs{$cbkey}; |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
$this->add( |
485
|
7
|
|
|
|
|
105
|
$page, 'Window', |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
-padtop => $this->{-padtop}, |
488
|
|
|
|
|
|
|
-padbottom => $this->{-padbottom}, |
489
|
|
|
|
|
|
|
-padleft => $this->{-padleft}, |
490
|
|
|
|
|
|
|
-padright => $this->{-padright}, |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
-ipadtop => $this->{-ipadtop}, |
493
|
|
|
|
|
|
|
-ipadbottom => $this->{-ipadbottom}, |
494
|
|
|
|
|
|
|
-ipadleft => $this->{-ipadleft}, |
495
|
|
|
|
|
|
|
-ipadright => $this->{-ipadright}, |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
-fg => $this->{-fg}, # nb: no color support in |
498
|
|
|
|
|
|
|
-bg => $this->{-bg}, # Curses::UI::Window yet! |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
%userargs, |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
-height => $this->{-sh}, |
503
|
|
|
|
|
|
|
-width => $this->{-sw}, |
504
|
|
|
|
|
|
|
-y => 0, # nb: x,y are relative to canvasscr! |
505
|
|
|
|
|
|
|
-x => 0, |
506
|
|
|
|
|
|
|
); |
507
|
|
|
|
|
|
|
|
508
|
7
|
|
|
|
|
14
|
push(@{$this->{-pages}}, $page); |
|
7
|
|
|
|
|
17
|
|
509
|
7
|
100
|
|
|
|
9
|
if (@{$this->{-pages}} == 1) { |
|
7
|
|
|
|
|
18
|
|
510
|
3
|
|
|
|
|
53
|
$this->{-active_page} = $page; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
else { |
513
|
|
|
|
|
|
|
# Adding the window object alters the draw- and focusorder so |
514
|
|
|
|
|
|
|
# we need to adjust them manually. |
515
|
4
|
|
|
|
|
15
|
my $active_page = $this->active_page; |
516
|
4
|
|
|
|
|
15
|
$this->set_draworder($active_page); |
517
|
4
|
|
|
|
|
14
|
$this->set_focusorder($active_page); |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
7
|
|
|
|
|
25
|
return $this->getobj($page); |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
sub delete_page($$) { |
525
|
4
|
|
|
4
|
1
|
1372
|
debug_msg; |
526
|
4
|
|
|
|
|
4
|
my $this = shift; |
527
|
4
|
50
|
|
|
|
11
|
my $page = shift or return; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# Make sure page is part of the notebook. |
530
|
4
|
50
|
|
|
|
14
|
$this->root->fatalerror("The notebook widget does not have a page named '$page'!") |
531
|
|
|
|
|
|
|
unless (defined $this->{-id2object}->{$page}); |
532
|
|
|
|
|
|
|
|
533
|
4
|
|
|
|
|
11
|
debug_msg " deleting '$page' page"; |
534
|
|
|
|
|
|
|
|
535
|
4
|
100
|
|
|
|
13
|
if (defined $this->{callback}{$page}{-on_delete}) { |
536
|
1
|
|
|
|
|
5
|
debug_msg " calling delete callback for $page"; |
537
|
1
|
|
|
|
|
5
|
$this->{callback}{$page}{-on_delete}->($this,$page); |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
4
|
|
|
|
|
11
|
my $active_page = $this->active_page; |
541
|
4
|
|
|
|
|
6
|
@{$this->{-pages}} = grep($page ne $_, @{$this->{-pages}}); |
|
4
|
|
|
|
|
12
|
|
|
4
|
|
|
|
|
13
|
|
542
|
4
|
100
|
|
|
|
16
|
$this->activate_page($this->first_page) if ($page eq $active_page); |
543
|
4
|
|
|
|
|
25
|
$this->SUPER::DESTROY($page); |
544
|
|
|
|
|
|
|
|
545
|
4
|
|
|
|
|
8
|
return; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub active_page($) { |
550
|
25
|
|
|
25
|
1
|
1618
|
debug_msg; |
551
|
25
|
|
|
|
|
27
|
my $this = shift; |
552
|
25
|
100
|
|
|
|
21
|
return unless (@{$this->{-pages}}); |
|
25
|
|
|
|
|
99
|
|
553
|
|
|
|
|
|
|
|
554
|
23
|
50
|
|
|
|
62
|
my $page = defined $this->{-active_page} ? |
555
|
|
|
|
|
|
|
$this->{-active_page} : |
556
|
|
|
|
|
|
|
($this->{-active_page} = ''); |
557
|
23
|
|
|
|
|
50
|
debug_msg " active page = '$page'"; |
558
|
23
|
|
|
|
|
49
|
return $page; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub first_page($) { |
563
|
5
|
|
|
5
|
1
|
9
|
debug_msg; |
564
|
5
|
|
|
|
|
8
|
my $this = shift; |
565
|
5
|
100
|
|
|
|
5
|
return unless (@{$this->{-pages}}); |
|
5
|
|
|
|
|
17
|
|
566
|
|
|
|
|
|
|
|
567
|
3
|
|
|
|
|
4
|
my $page = ${$this->{-pages}}[0]; |
|
3
|
|
|
|
|
6
|
|
568
|
3
|
|
|
|
|
8
|
debug_msg " first page = '$page'"; |
569
|
3
|
|
|
|
|
7
|
return $page; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub last_page($) { |
574
|
1
|
|
|
1
|
1
|
3
|
debug_msg; |
575
|
1
|
|
|
|
|
2
|
my $this = shift; |
576
|
1
|
50
|
|
|
|
2
|
return unless (@{$this->{-pages}}); |
|
1
|
|
|
|
|
5
|
|
577
|
|
|
|
|
|
|
|
578
|
1
|
|
|
|
|
3
|
my $page = ${$this->{-pages}}[$#{$this->{-pages}}]; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
3
|
|
579
|
1
|
|
|
|
|
4
|
debug_msg " last page = '$page'"; |
580
|
1
|
|
|
|
|
4
|
return $page; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub prev_page($) { |
585
|
2
|
|
|
2
|
1
|
5
|
debug_msg; |
586
|
2
|
|
|
|
|
2
|
my $this = shift; |
587
|
2
|
50
|
|
|
|
3
|
return unless (@{$this->{-pages}}); |
|
2
|
|
|
|
|
7
|
|
588
|
|
|
|
|
|
|
|
589
|
2
|
|
|
|
|
5
|
my $active_page = $this->active_page; |
590
|
2
|
|
|
|
|
4
|
my $i = scalar(@{$this->{-pages}}); |
|
2
|
|
|
|
|
4
|
|
591
|
2
|
|
|
|
|
7
|
while (--$i >= 0) { |
592
|
6
|
100
|
|
|
|
7
|
last if ($active_page eq ${$this->{-pages}}[$i]); |
|
6
|
|
|
|
|
29
|
|
593
|
|
|
|
|
|
|
} |
594
|
2
|
50
|
|
|
|
6
|
return if ($i < 0); |
595
|
1
|
|
|
|
|
5
|
$i = $i > 0 ? |
596
|
|
|
|
|
|
|
$i-1 : |
597
|
|
|
|
|
|
|
$this->{-wraparound} ? |
598
|
2
|
100
|
|
|
|
10
|
$#{$this->{-pages}} : |
|
|
50
|
|
|
|
|
|
599
|
|
|
|
|
|
|
0; |
600
|
2
|
|
|
|
|
3
|
my $page = ${$this->{-pages}}[$i]; |
|
2
|
|
|
|
|
5
|
|
601
|
2
|
|
|
|
|
7
|
debug_msg " prev page = '$page'"; |
602
|
2
|
|
|
|
|
8
|
return $page; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
sub next_page($) { |
607
|
4
|
|
|
4
|
1
|
10
|
debug_msg; |
608
|
4
|
|
|
|
|
13
|
my $this = shift; |
609
|
4
|
50
|
|
|
|
4
|
return unless (@{$this->{-pages}}); |
|
4
|
|
|
|
|
15
|
|
610
|
|
|
|
|
|
|
|
611
|
4
|
|
|
|
|
9
|
my $active_page = $this->active_page; |
612
|
4
|
|
|
|
|
6
|
my $i = scalar(@{$this->{-pages}}); |
|
4
|
|
|
|
|
8
|
|
613
|
4
|
|
|
|
|
10
|
while (--$i >= 0) { |
614
|
6
|
100
|
|
|
|
6
|
last if ($active_page eq ${$this->{-pages}}[$i]); |
|
6
|
|
|
|
|
20
|
|
615
|
|
|
|
|
|
|
} |
616
|
4
|
50
|
|
|
|
8
|
return if ($i < 0); |
617
|
4
|
|
|
|
|
28
|
$i = $i < $#{$this->{-pages}} ? |
|
1
|
|
|
|
|
4
|
|
618
|
|
|
|
|
|
|
$i+1 : |
619
|
|
|
|
|
|
|
$this->{-wraparound} ? |
620
|
|
|
|
|
|
|
0 : |
621
|
4
|
100
|
|
|
|
4
|
$#{$this->{-pages}}; |
|
|
100
|
|
|
|
|
|
622
|
4
|
|
|
|
|
8
|
my $page = ${$this->{-pages}}[$i]; |
|
4
|
|
|
|
|
9
|
|
623
|
4
|
|
|
|
|
18
|
debug_msg " next page = '$page'"; |
624
|
4
|
|
|
|
|
14
|
return $page; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub activate_page($$) { |
629
|
7
|
|
|
7
|
1
|
877
|
debug_msg; |
630
|
7
|
|
|
|
|
8
|
my $this = shift; |
631
|
7
|
100
|
|
|
|
19
|
my $page = shift or return; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# Make sure page is part of the notebook. |
634
|
5
|
50
|
|
|
|
20
|
$this->root->fatalerror("The notebook widget does not have a page named '$page'!") |
635
|
|
|
|
|
|
|
unless (defined $this->{-id2object}->{$page}); |
636
|
|
|
|
|
|
|
|
637
|
5
|
|
|
|
|
11
|
my $active_page = $this->active_page; |
638
|
5
|
|
|
|
|
14
|
debug_msg " old active page = '$active_page'"; |
639
|
|
|
|
|
|
|
|
640
|
5
|
100
|
|
|
|
22
|
if (defined $this->{callback}{$page}{-on_activate}) { |
641
|
1
|
|
|
|
|
5
|
debug_msg " calling activate callback for $page"; |
642
|
1
|
|
|
|
|
6
|
$this->{callback}{$page}{-on_activate}->($this,$page); |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
5
|
100
|
|
|
|
15
|
if ($active_page ne $page) { |
646
|
4
|
|
|
|
|
8
|
$active_page = $this->{-active_page} = $page; |
647
|
4
|
|
|
|
|
10
|
debug_msg " new active page = '$active_page'"; |
648
|
4
|
|
|
|
|
13
|
$this->set_draworder($active_page); |
649
|
4
|
|
|
|
|
11
|
$this->set_focusorder($active_page); |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# Redraw the notebook widget only if in curses mode. |
652
|
4
|
50
|
|
|
|
16
|
$this->intellidraw unless isendwin; |
653
|
|
|
|
|
|
|
} |
654
|
5
|
|
|
|
|
242
|
return $active_page; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub mouse_button1($$$$) { |
659
|
0
|
|
|
0
|
1
|
|
debug_msg; |
660
|
0
|
|
|
|
|
|
my $this = shift; |
661
|
0
|
|
|
|
|
|
my $event = shift; |
662
|
0
|
|
|
|
|
|
my $x = shift; |
663
|
0
|
|
|
|
|
|
my $y = shift; |
664
|
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
|
my $ev_x = $event->{-x}; |
666
|
0
|
|
|
|
|
|
my $ev_y = $event->{-y}; |
667
|
0
|
|
|
|
|
|
debug_msg " mouse click at ($ev_x,$ev_y)"; |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
# Focus window if it isn't already in focus. |
670
|
0
|
0
|
0
|
|
|
|
$this->focus if (not $this->{-focus} and $this->focusable); |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
# If click was in the 'tabs' window. |
673
|
0
|
0
|
|
|
|
|
if ($ev_y <= ($this->{-border} + $this->{-sbborder} ? 3 : 1)) { |
|
|
0
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# Figure out which page was clicked. |
675
|
0
|
|
|
|
|
|
my $len = 0; |
676
|
0
|
|
|
|
|
|
foreach my $page (@{$this->{-pages}}) { |
|
0
|
|
|
|
|
|
|
677
|
0
|
|
0
|
|
|
|
$len += length($page) + |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
678
|
|
|
|
|
|
|
($this->{-ipadleft} || 0) + ($this->{-ipadright} || 0) + |
679
|
|
|
|
|
|
|
($this->{-border} || 0) + ($this->{-sbborder} || 0); |
680
|
0
|
0
|
|
|
|
|
if ($ev_x < $len) { |
681
|
0
|
|
|
|
|
|
debug_msg " user clicked on tab for '$page'"; |
682
|
0
|
|
|
|
|
|
return $this->activate_page($page); |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
} |
685
|
0
|
|
|
|
|
|
debug_msg " user didn't click on a tab label; ignored"; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
else { |
688
|
0
|
|
|
|
|
|
my $active_page = $this->active_page; |
689
|
0
|
|
|
|
|
|
debug_msg " user clicked on window of active page"; |
690
|
0
|
|
|
|
|
|
$this->getobj($active_page)->mouse_button1($event, $x, $y); |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
1; |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=pod |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=head1 NAME |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Curses::UI::Notebook - Create and manipulate notebook widgets. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head1 CLASS HIERARCHY |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
Curses::UI::Widget |
707
|
|
|
|
|
|
|
| |
708
|
|
|
|
|
|
|
+----Curses::UI::Container |
709
|
|
|
|
|
|
|
| |
710
|
|
|
|
|
|
|
+----Curses::UI::Notebook |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=head1 SYNOPSIS |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
use Curses::UI; |
716
|
|
|
|
|
|
|
my $cui = new Curses::UI; |
717
|
|
|
|
|
|
|
my $win = $cui->add(undef, 'Window'); |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
my $notebook = $win->add(undef, 'Notebook'); |
720
|
|
|
|
|
|
|
my $page1 = $notebook->add_page('page 1'); |
721
|
|
|
|
|
|
|
$page1->add( |
722
|
|
|
|
|
|
|
undef, 'Label', |
723
|
|
|
|
|
|
|
-x => 15, |
724
|
|
|
|
|
|
|
-y => 6, |
725
|
|
|
|
|
|
|
-text => "Page #1.", |
726
|
|
|
|
|
|
|
); |
727
|
|
|
|
|
|
|
my $page2 = $notebook->add_page('page 2'); |
728
|
|
|
|
|
|
|
$page2->add( |
729
|
|
|
|
|
|
|
undef, 'Label', |
730
|
|
|
|
|
|
|
-x => 15, |
731
|
|
|
|
|
|
|
-y => 6, |
732
|
|
|
|
|
|
|
-text => "Page #2.", |
733
|
|
|
|
|
|
|
); |
734
|
|
|
|
|
|
|
my $page3 = $notebook->add_page('page 3', -on_activate => \&sub ); |
735
|
|
|
|
|
|
|
$page3->add( |
736
|
|
|
|
|
|
|
undef, 'Label', |
737
|
|
|
|
|
|
|
-x => 15, |
738
|
|
|
|
|
|
|
-y => 6, |
739
|
|
|
|
|
|
|
-text => "Page #3.", |
740
|
|
|
|
|
|
|
); |
741
|
|
|
|
|
|
|
$notebook->focus; |
742
|
|
|
|
|
|
|
$cui->mainloop; |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head1 DESCRIPTION |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
This package implements a I similar to that found in |
748
|
|
|
|
|
|
|
Motif. A I holds several windows, or I, only one of |
749
|
|
|
|
|
|
|
which is visible at any given time; tabs at the top of the widget list |
750
|
|
|
|
|
|
|
the pages that are available. In this way, a great deal of information |
751
|
|
|
|
|
|
|
can be fit into a relatively small screen area. [Windows users might |
752
|
|
|
|
|
|
|
recognize this as a I.] |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=head1 STANDARD OPTIONS |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
B<-x>, B<-y>, B<-width>, B<-height>, |
758
|
|
|
|
|
|
|
B<-pad>, B<-padleft>, B<-padright>, B<-padtop>, B<-padbottom>, |
759
|
|
|
|
|
|
|
B<-ipad>, B<-ipadleft>, B<-ipadright>, B<-ipadtop>, B<-ipadbottom>, |
760
|
|
|
|
|
|
|
B<-border>, B<-sbborder>, |
761
|
|
|
|
|
|
|
B<-bg>, B<-fg>, |
762
|
|
|
|
|
|
|
B<-intellidraw>, |
763
|
|
|
|
|
|
|
B<-onchange>, B<-onblur>. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
See L for a discussion of each of |
766
|
|
|
|
|
|
|
these options. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
Note that B<-border> is enabled and both B<-ipadleft> and B<-ipadright> |
769
|
|
|
|
|
|
|
are set to C<1> by default when creating notebook objects. |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=head1 WIDGET-SPECIFIC OPTIONS |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=over 4 |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=item * B<-bindings> < HASHREF > |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
The keys in this hash reference are keystrokes and the values are |
779
|
|
|
|
|
|
|
routines to which they should be bound. In the event a key is empty, |
780
|
|
|
|
|
|
|
the corresponding routine will become the default routine that |
781
|
|
|
|
|
|
|
B applies to unmatched keystrokes it receives. |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
By default, the following mappings are used: |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
KEY ROUTINE |
786
|
|
|
|
|
|
|
------------------ ---------- |
787
|
|
|
|
|
|
|
KEY_HOME, Ctrl-A first_page |
788
|
|
|
|
|
|
|
KEY_END, Ctrl-E last_page |
789
|
|
|
|
|
|
|
KEY_NPAGE, Ctrl-N next_page |
790
|
|
|
|
|
|
|
KEY_PPAGE, Ctrl-P prev_page |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=item * B<-routines> < HASHREF > |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
The keys in this hash reference are routines and the values are either |
795
|
|
|
|
|
|
|
scalar values or code references. B maps keystrokes |
796
|
|
|
|
|
|
|
to routines and then to either a scalar value, which it returns, or a |
797
|
|
|
|
|
|
|
code reference, which it executes. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
By default, the following mappings are used: |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
ROUTINE ACTION |
802
|
|
|
|
|
|
|
---------- ------------------------- |
803
|
|
|
|
|
|
|
first_page make first page active |
804
|
|
|
|
|
|
|
last_page make last page active |
805
|
|
|
|
|
|
|
next_page make next page active |
806
|
|
|
|
|
|
|
prev_page make previous page active |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item * B<-wraparound> < BOOLEAN > |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
If BOOLEAN has a true value, wraparound is enabled. This means that |
811
|
|
|
|
|
|
|
advancing to the next page will cycle from the last back to the first |
812
|
|
|
|
|
|
|
page and similarly, advancing to the previous page will cycle from the |
813
|
|
|
|
|
|
|
first back to the last page. |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
By default, it is true. |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=back |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head1 METHODS |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=over 4 |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=item * B ( OPTIONS ) |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
Constructs a new notebook object using options in the hash OPTIONS. |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=item * B ( ) |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
Lays out the notebook object, makes sure it fits on the available |
831
|
|
|
|
|
|
|
screen, and creates the curses windows for the border / tab labels as |
832
|
|
|
|
|
|
|
well as the effective drawing area. |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=item * B ( BOOLEAN ) |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Draws the notebook object along with the active page's window. If BOOLEAN |
837
|
|
|
|
|
|
|
is true, the screen is not updated after drawing. |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
By default, BOOLEAN is true so the screen is updated. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=item * B ( ) |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=item * B ( ) |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=item * B ( CODEREF ) |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=item * B ( CODEREF ) |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
See L for explanations of these |
850
|
|
|
|
|
|
|
methods. |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=item * B ( PAGE [ , -on_activate => sub_ref ] [, -on_delete => ] ) |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
Adds the specified page to the notebook object and creates an associated |
855
|
|
|
|
|
|
|
window object. Returns the window object or undef on failure. |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
Note: the add fails if the page would otherwise cause the tab window to |
858
|
|
|
|
|
|
|
overflow or is already part of the notebook object. |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
The C<-on_activate> parameter specifies an optional call-back that |
861
|
|
|
|
|
|
|
will be invoked when the page is activated. This call-back will be |
862
|
|
|
|
|
|
|
called with the notebook widget and page name as parameter. |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
Likewise for C<-on_delete> call-back. This one is invoked when the |
865
|
|
|
|
|
|
|
page is deleted. |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item * B ( PAGE ) |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
Deletes the specified page from the notebook object and destroys its |
870
|
|
|
|
|
|
|
associated window object. If the page was active, the first page is |
871
|
|
|
|
|
|
|
made active. |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=item * B ( ) |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
Returns the currently active page in the notebook object. |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item * B ( ) |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Returns the first page in the notebook object. |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item * B ( ) |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
Returns the last page in the notebook object. |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item * B ( ) |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Returns the previous page in the notebook object. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=item * B ( ) |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
Returns the next page in the notebook object. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=item * B ( PAGE ) |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Makes the specified page in the notebook object active and returns it, |
896
|
|
|
|
|
|
|
redrawing the notebook object in the process. |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item * B ( ) |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
Processes mouse button #1 clicks. If the user left-clicks on one of the |
901
|
|
|
|
|
|
|
tabs, B is called with the corresponding page to make it |
902
|
|
|
|
|
|
|
active; otherwise, the click is passed along to the active window. |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=back |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=head1 SEE ALSO |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
L, |
910
|
|
|
|
|
|
|
L, |
911
|
|
|
|
|
|
|
L |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head1 AUTHOR |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
George A. Theall, Etheall@tifaware.comE |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
Copyright (c) 2004, George A. Theall. All rights reserved. |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
This script is free software; you can redistribute it and/or modify |
924
|
|
|
|
|
|
|
it under the same terms as Perl itself. |