File Coverage

blib/lib/Curses/UI/Notebook.pm
Criterion Covered Total %
statement 200 341 58.6
branch 87 204 42.6
condition 13 76 17.1
subroutine 18 21 85.7
pod 13 14 92.8
total 331 656 50.4


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.