<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># ----------------------------------------------------------------------
# Curses::UI::Notebook
#
# Written by George A. Theall, theall@tifaware.com
#
# Copyright (c) 2004, George A. Theall. All rights reserved.
#
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# $Id: Notebook.pm,v 1.2 2004/10/22 21:07:27 mthies2s Exp $
# ----------------------------------------------------------------------

package Curses::UI::Notebook;

use 5;
use strict;
use warnings;
use Curses;
use Curses::UI::Common;
use Curses::UI::Widget;

use vars qw(
    $VERSION
    @ISA
);
$VERSION = '1.0001';
@ISA = qw(
    Curses::UI::Container
);

my %routines = (
    'goto_first_page'   =&gt; sub { my $this = shift; $this-&gt;activate_page($this-&gt;first_page); },
    'goto_last_page'    =&gt; sub { my $this = shift; $this-&gt;activate_page($this-&gt;last_page); },
    'goto_next_page'    =&gt; sub { my $this = shift; $this-&gt;activate_page($this-&gt;next_page); },
    'goto_prev_page'    =&gt; sub { my $this = shift; $this-&gt;activate_page($this-&gt;prev_page); },
);
my %bindings = (
    KEY_HOME()          =&gt; 'goto_first_page',
    "\cA"               =&gt; 'goto_first_page',
    KEY_END()           =&gt; 'goto_last_page',
    "\cE"               =&gt; 'goto_last_page',
    KEY_NPAGE()         =&gt; 'goto_next_page',
    "\cN"               =&gt; 'goto_next_page',
    KEY_PPAGE()         =&gt; 'goto_prev_page',
    "\cP"               =&gt; 'goto_prev_page',
);


sub debug_msg(;$) {
    return unless ($Curses::UI::debug);

    my $caller = (caller(1))[3];
    my $msg = shift || '';
    my $indent = ($msg =~ /^(\s+)/ ? $1 : '');
    $msg =~ s/\n/\nDEBUG: $indent/mg;

    warn 'DEBUG: ' . 
        ($msg ?
            "$msg in $caller" : 
            "$caller() called by " . ((caller(2))[3] || 'main')
        ) .
        "().\n";
}


sub new($;) {
    debug_msg;
    my $class = shift;

    my %userargs = @_;
    keys_to_lowercase(\%userargs);
    # nb: support only arguments listed in @valid_args;
    my @valid_args = (
        'x', 'y', 'width', 'height',
        'pad', 'padleft', 'padright', 'padtop', 'padbottom',
        'ipad', 'ipadleft', 'ipadright', 'ipadtop', 'ipadbottom',
        'wraparound',
        'border', 'sbborder',
        'bg', 'fg',
        'intellidraw',
        'onchange', 'onblur',
        'routines', 'bindings',
        'parent',
    );
    foreach my $arg (keys %userargs) {
        unless (grep($arg eq "-$_", @valid_args)) {
            debug_msg "  deleting invalid arg '$arg'";
            delete $userargs{$arg};
        }
    }
    my %args = (
        -x              =&gt; 0,           # horizontal start position
        -y              =&gt; 0,           # vertical start position
        -width          =&gt; undef,       # width
        -height         =&gt; undef,       # height (nb: including tabs)

        -ipadleft       =&gt; 1,           # left padding
        -ipadright      =&gt; 1,           # right padding

        -wraparound     =&gt; 1,           # enable wraparound when changing pages?

        -border         =&gt; 1,           # border around tabs / active window

	-bg             =&gt; -1,          # default background color
        -fg             =&gt; -1,          # default foreground color

        -intellidraw    =&gt; 1,

        -routines       =&gt; {%routines},
        -bindings       =&gt; {%bindings},

        %userargs,
    );
    foreach (sort keys %args) {
        debug_msg "    \$args{$_} = " . (defined $args{$_} ? $args{$_} : 'n/a');
    }

    # nb: some type of border is currently needed for tab labels.
    return unless ($args{-border} or $args{-sbborder});

    # Create the widget.
    debug_msg '  creating Notebook object';
    my $this = $class-&gt;SUPER::new(%args);
    if ($Curses::UI::ncurses_mouse) {
        $this-&gt;set_mouse_binding(\&amp;mouse_button1, BUTTON1_CLICKED());
    }
    @{$this-&gt;{-pages}} = ();            # names of pages stored as an array.

    return $this;
}


sub layout($) {
    debug_msg;
    my $this = shift;

    # Don't wast time if we know the screen is too small.
    return if ($Curses::UI::screen_too_small);

    # Origin defaults to (0,0) relative to parent.
    #
    # nb: if origin is negative, treat it as an end-point and
    #     as relative to parent's end-point.
    $this-&gt;{-y} = 0 unless (defined $this-&gt;{-y});
    $this-&gt;{-x} = 0 unless (defined $this-&gt;{-x});

    # Expand -pad/-ipad args.
    $this-&gt;process_padding;

    # Make sure there's enough space for the widget.
    #
    # - get parent's data.
    $this-&gt;{-parentdata} = $this-&gt;{-parent}-&gt;windowparameters;
    my $ph = $this-&gt;{-parentdata}-&gt;{-h};
    my $pw = $this-&gt;{-parentdata}-&gt;{-w};
    # - calculate space available to the widget.
    my $avail_h = $ph - ($this-&gt;{-y} &lt; 0 ? abs($this-&gt;{-y}+1) : $this-&gt;{-y});
    my $avail_w = $pw - ($this-&gt;{-x} &lt; 0 ? abs($this-&gt;{-x}+1) : $this-&gt;{-x});
    debug_msg "  available height / width = $avail_h / $avail_w";
    # - size of widget defaults to available space.
    my $h = (defined $this-&gt;{-height} ? $this-&gt;{-height} : $avail_h);
    my $w = (defined $this-&gt;{-width}  ? $this-&gt;{-width}  : $avail_w);
    debug_msg "  size of widget = $h / $w";
    # - calculate required size given borders, padding, etc.
    my $req_h = ($this-&gt;{-border} ? 3 : 0) +
              ($this-&gt;{-sbborder} ? 3 : 0) +
              $this-&gt;{-padtop} +
              $this-&gt;{-padbottom};
    my $req_w = ($this-&gt;{-border} ? 2 : 0) +
              ($this-&gt;{-sbborder} ? 2 : 0) +
              $this-&gt;{-padleft} +
              $this-&gt;{-padright};
    debug_msg "  required size of widget = $req_h / $req_w";
    # - make sure widget fits given what's required and available.
    if (
        $h &lt; $req_h or $h &gt; $avail_h or
        $w &lt; $req_w or $w &gt; $avail_w
    ) {
        debug_msg "  screen is too small!";
        $Curses::UI::screen_too_small++;
        return $this;
    }

    # Update some widget parameters.
    #
    # - height and width.
    $this-&gt;{-h}  = $h;
    $this-&gt;{-w}  = $w;
    # - starting point.
    # nb: keep in mind if origin is negative, (x,y) is an end-point
    #     relative to parent's end-point.
    $this-&gt;{-realy} = $this-&gt;{-y} + ($this-&gt;{-y} &gt;= 0 ? 0 : $ph - $h + 1);
    $this-&gt;{-realx} = $this-&gt;{-x} + ($this-&gt;{-x} &gt;= 0 ? 0 : $pw - $w + 1);

    # Create widget border, if desired.
    if (
        $this-&gt;{-border} or
        $this-&gt;{-sbborder}
    ) {
        $this-&gt;{-bh} = $h - $this-&gt;{-padtop}  - $this-&gt;{-padbottom};
        $this-&gt;{-bw} = $w - $this-&gt;{-padleft} - $this-&gt;{-padright};
        $this-&gt;{-by} = $this-&gt;{-realy} + $this-&gt;{-padtop};
        $this-&gt;{-bx} = $this-&gt;{-realx} + $this-&gt;{-padleft};
        my @args = (
            $this-&gt;{-bh},
            $this-&gt;{-bw},
            $this-&gt;{-by},
            $this-&gt;{-bx},
        );
        debug_msg "  creating borderscr with args " . join(",", @args);
        unless (
            $this-&gt;{-borderscr} = $this-&gt;{-parent}-&gt;{-canvasscr}-&gt;derwin(@args)
        ) {
            debug_msg "  screen is too small for border widget!";
            $Curses::UI::screen_too_small++;
            return $this;
        }
    }

    # Create widget window itself.
    $this-&gt;{-sh}  = $this-&gt;{-bh} -
                  $this-&gt;{-ipadtop} -
                  $this-&gt;{-ipadbottom} -
                  ($this-&gt;{-border} ? 4 : 0) -
                  ($this-&gt;{-sbborder} ? 4 : 0);
    $this-&gt;{-sw}  = $this-&gt;{-bw} -
                  $this-&gt;{-ipadleft} -
                  $this-&gt;{-ipadright} -
                  ($this-&gt;{-border} ? 2 : 0) -
                  ($this-&gt;{-sbborder} ? 2 : 0);
    $this-&gt;{-sy}  = $this-&gt;{-by} +
                  $this-&gt;{-ipadtop} +
                  ($this-&gt;{-border} ? 3 : 0) +
                  ($this-&gt;{-sbborder} ? 3 : 0);
    $this-&gt;{-sx}  = $this-&gt;{-bx} +
                  $this-&gt;{-ipadleft} +
                  ($this-&gt;{-border} ? 1 : 0) +
                  ($this-&gt;{-sbborder} ? 1 : 0);
    my @args = (
        $this-&gt;{-sh},
        $this-&gt;{-sw},
        $this-&gt;{-sy},
        $this-&gt;{-sx},
    );
    debug_msg "  creating canvasscr with args " . join(",", @args);
    $this-&gt;{-canvasscr} = $this-&gt;{-parent}-&gt;{-canvasscr}-&gt;derwin(@args);
    unless (defined $this-&gt;{-canvasscr})
    {
        debug_msg "  screen is too small for window widget!";
        $Curses::UI::screen_too_small++;
        return $this;
    }

    unless (defined $this-&gt;{-borderscr}) {
        $this-&gt;{-bh} = $this-&gt;{-sh};
        $this-&gt;{-bw} = $this-&gt;{-sw};
        $this-&gt;{-by} = $this-&gt;{-sy};
        $this-&gt;{-bx} = $this-&gt;{-sx};
    }
    return $this;
}


sub draw($;$) {
    debug_msg;
    my $this = shift;
    my $no_doupdate = shift || 0;
    debug_msg "  \$no_doupdate = $no_doupdate";

    # Return immediately if this object is hidden or if
    # the screen is currently too small.
    return if $this-&gt;hidden;
    return if $Curses::UI::screen_too_small;

    # Identify various pages of interest.
    my $first_page = $this-&gt;first_page;
    my $next_page = $this-&gt;next_page;
    my $last_page = $this-&gt;last_page;
    my $active_page = $this-&gt;active_page;

    # Identify page window.
    my $page_win = $this-&gt;{-borderscr};

    # Hide cursor.
    eval { curs_set(0) }; # not available on every system.

    # Enable colors if desired.
    if ($Curses::UI::color_support) {
        debug_msg "  enabling color support";
        my $co = $Curses::UI::color_object;
        my $pair = $co-&gt;get_color_pair(
            $this-&gt;{-fg},
            $this-&gt;{-bg}
        );
        $page_win-&gt;attron(COLOR_PAIR($pair));
    }

    my $ch_hbar = $this-&gt;{-border} ? ACS_HLINE : '-';
    my $ch_vbar = $this-&gt;{-border} ? ACS_VLINE : '|';
    my $ch_tl   = $this-&gt;{-border} ? ACS_ULCORNER : '+';
    my $ch_tr   = $this-&gt;{-border} ? ACS_URCORNER : '+';
    my $ch_bl   = $this-&gt;{-border} ? ACS_LLCORNER : '+';
    my $ch_br   = $this-&gt;{-border} ? ACS_LRCORNER : '+';
    my $ch_ttee = $this-&gt;{-border} ? ACS_TTEE : '+';
    my $ch_btee = $this-&gt;{-border} ? ACS_BTEE : '+';
    my $ch_ltee = $this-&gt;{-border} ? ACS_LTEE : '+';
    my $ch_rtee = $this-&gt;{-border} ? ACS_RTEE : '+';

    # Draw tabs along with a border if desired.
    my($x, $y) = (0, 0);
    $y = 1 if ($this-&gt;{-border} or $this-&gt;{-sbborder});
    foreach my $page (@{$this-&gt;{-pages}}) {
        debug_msg "  drawing tab for page '$page'";

        if ($this-&gt;{-border} or $this-&gt;{-sbborder}) {
            debug_msg "    adding left border at x=$x";
            $page_win-&gt;addch(0, $x, ($page eq $first_page ? $ch_tl : $ch_ttee));
            $page_win-&gt;addch(1, $x, $ch_vbar);
            $page_win-&gt;addch(2, $x,
                ($page eq $first_page ?
                    ($page eq $active_page ?
                        $ch_vbar :
                        $ch_ltee
                    ) :
                    ($page eq $active_page ?
                        $ch_br :
                        ($page eq $next_page ?
                            $ch_bl :
                            $ch_btee
                        )
                    )
                )
            );
            ++$x;
        }

        debug_msg "    adding $this-&gt;{-ipadleft} space" . ($this-&gt;{-ipadright} == 1 ? "" : "s") . " of padding at x=$x";
        if ($this-&gt;{-border} or $this-&gt;{-sbborder}) {
            for (my $i = 0; $i &lt; $this-&gt;{-ipadleft}; $i++) {
                $page_win-&gt;addch(0, $x, $ch_hbar);
                #
                $page_win-&gt;addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar));
                ++$x;
            }
        }
        else {
            $x += $this-&gt;{-ipadleft};
        }

        debug_msg "    writing page name at x=$x";
        $page_win-&gt;attron(A_REVERSE) if ($page eq $active_page);
        $page_win-&gt;addstr($y, $x, $page);
        $page_win-&gt;attroff(A_REVERSE) if ($page eq $active_page);
        if ($this-&gt;{-border} or $this-&gt;{-sbborder}) {
            for (my $i = 0; $i &lt; length($page); $i++) {
                $page_win-&gt;addch(0, $x, $ch_hbar);
                #
                $page_win-&gt;addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar));
                ++$x;
            }
        }
        else {
            $x += length($page);
        }

        debug_msg "    adding $this-&gt;{-ipadright} space" . ($this-&gt;{-ipadright} == 1 ? "" : "s") . " of padding at x=$x";
        if ($this-&gt;{-border} or $this-&gt;{-sbborder}) {
            for (my $i = 0; $i &lt; $this-&gt;{-ipadright}; $i++) {
                $page_win-&gt;addch(0, $x, $ch_hbar);
                #
                $page_win-&gt;addch(2, $x, ($page eq $active_page ? ' ' : $ch_hbar));
                ++$x;
            }
        }
        else {
            $x += $this-&gt;{-ipadright};
        }

        if (($this-&gt;{-border} or $this-&gt;{-sbborder}) and $page eq $last_page) {
            debug_msg "    adding right border at x=$x";
            $page_win-&gt;addch(0, $x, $ch_tr);
            $page_win-&gt;addch(1, $x, $ch_vbar);
            $page_win-&gt;addch(2, $x, ($page eq $active_page ? $ch_bl : $ch_btee));
            ++$x;
        }
    }
    if ($this-&gt;{-border} or $this-&gt;{-sbborder}) {
        do {
            $page_win-&gt;addch(2, $x, $ch_hbar);
        } while (++$x &lt; $this-&gt;{-bw}-1);
        $page_win-&gt;addch(2, $x, $ch_tr);

        for ($y = 3; $y &lt; $this-&gt;{-bh}-1; $y++) {
            $page_win-&gt;addch($y, $this-&gt;{-x}, $ch_vbar);
            $page_win-&gt;addch($y, $x, $ch_vbar);
        }

        $page_win-&gt;addch($y, $this-&gt;{-x}, $ch_bl);
        for ($x = $this-&gt;{-x}+1; $x &lt; $this-&gt;{-bw}-1; $x++) {
            $page_win-&gt;addch($y, $x, $ch_hbar);
        }
        $page_win-&gt;addch($y, $x, $ch_br);
    }
    $page_win-&gt;noutrefresh;

    # Draw active window.
    $this-&gt;getobj($active_page)-&gt;draw($no_doupdate);

    doupdate unless ($no_doupdate);
    return $this;
}


# NB: we can't simply inherit intellidraw from Curses::UI::Widget 
#     since notebooks themselves contain window objects.
sub intellidraw(;$) {
    debug_msg;
    my $this = shift;

    if ($this-&gt;{-intellidraw} and !$this-&gt;hidden) {
        # Check if parent window has modal focus or is on top of focus path.
        my $parent = $this-&gt;parentwindow;
        debug_msg "  parent window = " . $parent;

        my @path = $this-&gt;root-&gt;focus_path;
        debug_msg "  focus_path " . join(" &amp; ", @path);
        # Ignore anything above our object.
        while (grep($_ eq $this, @path)) {
            $_ = pop(@path);
            debug_msg "  skipping $_ to find ourselves";
        }
        # Now find next window.
        while (@path &gt; 1 and !$path[-1]-&gt;isa('Curses::UI::Window')) {
            $_ = pop(@path);
            debug_msg "  skipping $_ to find previous window";
        }
        debug_msg "  next window = " . (@path ? $path[-1] : 'n/a');

        $this-&gt;draw if (
            $parent-&gt;{-has_modal_focus} or 
            (@path and $parent eq $path[-1])
        );
    }
    return $this;
}


sub add_page($$;) {
    debug_msg;
    my $this = shift;
    my $page = shift or return;
    debug_msg "  adding '$page' page";

    # Make sure page is not yet part of the notebook.
    $this-&gt;root-&gt;fatalerror("The notebook already has a page named '$page'!")
        if (defined $this-&gt;{-id2object}-&gt;{$page});

    # Make sure the page does not cause the 'tabs' window to overflow.
    my $len = 0;
    foreach my $page (@{$this-&gt;{-pages}}, $page) {
        $len += length($page) +
            ($this-&gt;{-ipadleft} || 0) + ($this-&gt;{-ipadright} || 0) +
            ($this-&gt;{-border} || 0) + ($this-&gt;{-sbborder} || 0);
    }
    ++$len;                             # nb: needed for final border char.
    debug_msg "  $len spaces are needed for tab labels";
    if ($len &gt; $this-&gt;{-bw}) {
        debug_msg "  screen is too small - width is $this-&gt;{-bw}";
        $Curses::UI::screen_too_small++;
        return;
    };

    # Create a window for this page using same layout as widget's canvasscr.
    my %userargs = @_;
    keys_to_lowercase(\%userargs);

    # grab callback arguments
    foreach my $cbkey (qw/-on_activate -on_delete/) {
	$this-&gt;{callback}{$page}{$cbkey} = delete $userargs{$cbkey}
	  if defined $userargs{$cbkey};
    }

    $this-&gt;add(
        $page, 'Window',

        -padtop     =&gt; $this-&gt;{-padtop},
        -padbottom  =&gt; $this-&gt;{-padbottom},
        -padleft    =&gt; $this-&gt;{-padleft},
        -padright   =&gt; $this-&gt;{-padright},

        -ipadtop    =&gt; $this-&gt;{-ipadtop},
        -ipadbottom =&gt; $this-&gt;{-ipadbottom},
        -ipadleft   =&gt; $this-&gt;{-ipadleft},
        -ipadright  =&gt; $this-&gt;{-ipadright},

        -fg         =&gt; $this-&gt;{-fg},    # nb: no color support in
        -bg         =&gt; $this-&gt;{-bg},    #     Curses::UI::Window yet!

        %userargs,

        -height   =&gt; $this-&gt;{-sh},
        -width    =&gt; $this-&gt;{-sw},
        -y        =&gt; 0,                 # nb: x,y are relative to canvasscr!
        -x        =&gt; 0,
    );

    push(@{$this-&gt;{-pages}}, $page);
    if (@{$this-&gt;{-pages}} == 1) {
        $this-&gt;{-active_page} = $page;
    }
    else {
        # Adding the window object alters the draw- and focusorder so
        # we need to adjust them manually.
        my $active_page = $this-&gt;active_page;
        $this-&gt;set_draworder($active_page);
        $this-&gt;set_focusorder($active_page);
    }

    return $this-&gt;getobj($page);
}


sub delete_page($$) {
    debug_msg;
    my $this = shift;
    my $page = shift or return;

    # Make sure page is part of the notebook.
    $this-&gt;root-&gt;fatalerror("The notebook widget does not have a page named '$page'!")
        unless (defined $this-&gt;{-id2object}-&gt;{$page});

    debug_msg "  deleting '$page' page";

    if (defined $this-&gt;{callback}{$page}{-on_delete}) {
	debug_msg "  calling delete callback for $page";
	$this-&gt;{callback}{$page}{-on_delete}-&gt;($this,$page);
    }

    my $active_page = $this-&gt;active_page;
    @{$this-&gt;{-pages}} = grep($page ne $_, @{$this-&gt;{-pages}});
    $this-&gt;activate_page($this-&gt;first_page) if ($page eq $active_page);
    $this-&gt;SUPER::DESTROY($page);

    return;
}


sub active_page($) {
    debug_msg;
    my $this = shift;
    return unless (@{$this-&gt;{-pages}});

    my $page = defined $this-&gt;{-active_page} ?
        $this-&gt;{-active_page} :
        ($this-&gt;{-active_page} = '');
    debug_msg "  active page = '$page'";
    return $page;
}


sub first_page($) {
    debug_msg;
    my $this = shift;
    return unless (@{$this-&gt;{-pages}});

    my $page = ${$this-&gt;{-pages}}[0];
    debug_msg "  first page = '$page'";
    return $page;
}


sub last_page($) {
    debug_msg;
    my $this = shift;
    return unless (@{$this-&gt;{-pages}});

    my $page = ${$this-&gt;{-pages}}[$#{$this-&gt;{-pages}}];
    debug_msg "  last page = '$page'";
    return $page;
}


sub prev_page($) {
    debug_msg;
    my $this = shift;
    return unless (@{$this-&gt;{-pages}});

    my $active_page = $this-&gt;active_page;
    my $i = scalar(@{$this-&gt;{-pages}});
    while (--$i &gt;= 0) {
        last if ($active_page eq ${$this-&gt;{-pages}}[$i]);
    }
    return if ($i &lt; 0);
    $i = $i &gt; 0 ?
        $i-1 :
        $this-&gt;{-wraparound} ?
            $#{$this-&gt;{-pages}} :
            0;
    my $page = ${$this-&gt;{-pages}}[$i];
    debug_msg "  prev page = '$page'";
    return $page;
}


sub next_page($) {
    debug_msg;
    my $this = shift;
    return unless (@{$this-&gt;{-pages}});

    my $active_page = $this-&gt;active_page;
    my $i = scalar(@{$this-&gt;{-pages}});
    while (--$i &gt;= 0) {
        last if ($active_page eq ${$this-&gt;{-pages}}[$i]);
    }
    return if ($i &lt; 0);
    $i = $i &lt; $#{$this-&gt;{-pages}} ?
        $i+1 :
        $this-&gt;{-wraparound} ?
            0 :
            $#{$this-&gt;{-pages}};
    my $page = ${$this-&gt;{-pages}}[$i];
    debug_msg "  next page = '$page'";
    return $page;
}


sub activate_page($$) {
    debug_msg;
    my $this = shift;
    my $page = shift or return;

    # Make sure page is part of the notebook.
    $this-&gt;root-&gt;fatalerror("The notebook widget does not have a page named '$page'!")
        unless (defined $this-&gt;{-id2object}-&gt;{$page});

    my $active_page = $this-&gt;active_page;
    debug_msg "  old active page = '$active_page'";

    if (defined $this-&gt;{callback}{$page}{-on_activate}) {
	debug_msg "  calling activate callback for $page";
	$this-&gt;{callback}{$page}{-on_activate}-&gt;($this,$page);
    }

    if ($active_page ne $page) {
        $active_page = $this-&gt;{-active_page} = $page;
        debug_msg "  new active page = '$active_page'";
        $this-&gt;set_draworder($active_page);
        $this-&gt;set_focusorder($active_page);

        # Redraw the notebook widget only if in curses mode.
        $this-&gt;intellidraw unless isendwin;
    }
    return $active_page;
}


sub mouse_button1($$$$) {
    debug_msg;
    my $this = shift;
    my $event = shift;
    my $x = shift;
    my $y = shift;

    my $ev_x = $event-&gt;{-x};
    my $ev_y = $event-&gt;{-y};
    debug_msg "  mouse click at ($ev_x,$ev_y)";

    # Focus window if it isn't already in focus.
    $this-&gt;focus if (not $this-&gt;{-focus} and $this-&gt;focusable);

    # If click was in the 'tabs' window.
    if ($ev_y &lt;= ($this-&gt;{-border} + $this-&gt;{-sbborder} ? 3 : 1)) {
        # Figure out which page was clicked.
        my $len = 0;
        foreach my $page (@{$this-&gt;{-pages}}) {
            $len += length($page) +
                ($this-&gt;{-ipadleft} || 0) + ($this-&gt;{-ipadright} || 0) +
                ($this-&gt;{-border} || 0) + ($this-&gt;{-sbborder} || 0);
            if ($ev_x &lt; $len) {
                debug_msg "  user clicked on tab for '$page'";
                return $this-&gt;activate_page($page);
            }
        }
        debug_msg "  user didn't click on a tab label; ignored";
    }
    else {
        my $active_page = $this-&gt;active_page;
        debug_msg "  user clicked on window of active page";
        $this-&gt;getobj($active_page)-&gt;mouse_button1($event, $x, $y);
    }
}

1;


=pod

=head1 NAME

Curses::UI::Notebook - Create and manipulate notebook widgets.


=head1 CLASS HIERARCHY

 Curses::UI::Widget
    |
    +----Curses::UI::Container
            |
            +----Curses::UI::Notebook


=head1 SYNOPSIS

    use Curses::UI;
    my $cui = new Curses::UI;
    my $win = $cui-&gt;add(undef, 'Window');

    my $notebook = $win-&gt;add(undef, 'Notebook');
    my $page1 = $notebook-&gt;add_page('page 1');
    $page1-&gt;add(
        undef, 'Label',
        -x    =&gt; 15,
        -y    =&gt; 6,
        -text =&gt; "Page #1.",
    );
    my $page2 = $notebook-&gt;add_page('page 2');
    $page2-&gt;add(
        undef, 'Label',
        -x    =&gt; 15,
        -y    =&gt; 6,
        -text =&gt; "Page #2.",
    );
    my $page3 = $notebook-&gt;add_page('page 3', -on_activate =&gt; \&amp;sub );
    $page3-&gt;add(
        undef, 'Label',
        -x    =&gt; 15,
        -y    =&gt; 6,
        -text =&gt; "Page #3.",
    );
    $notebook-&gt;focus;
    $cui-&gt;mainloop;


=head1 DESCRIPTION

This package implements a I&lt;notebook widget&gt; similar to that found in
Motif.  A I&lt;notebook&gt; holds several windows, or I&lt;pages&gt;, only one of
which is visible at any given time; tabs at the top of the widget list
the pages that are available.  In this way, a great deal of information
can be fit into a relatively small screen area.  [Windows users might
recognize this as a I&lt;tabbed dialog&gt;.]


=head1 STANDARD OPTIONS

B&lt;-x&gt;, B&lt;-y&gt;, B&lt;-width&gt;, B&lt;-height&gt;,
B&lt;-pad&gt;, B&lt;-padleft&gt;, B&lt;-padright&gt;, B&lt;-padtop&gt;, B&lt;-padbottom&gt;,
B&lt;-ipad&gt;, B&lt;-ipadleft&gt;, B&lt;-ipadright&gt;, B&lt;-ipadtop&gt;, B&lt;-ipadbottom&gt;,
B&lt;-border&gt;, B&lt;-sbborder&gt;,
B&lt;-bg&gt;, B&lt;-fg&gt;,
B&lt;-intellidraw&gt;,
B&lt;-onchange&gt;, B&lt;-onblur&gt;.

See L&lt;Curses::UI::Widget|Curses::UI||Widget&gt; for a discussion of each of
these options. 

Note that B&lt;-border&gt; is enabled and both B&lt;-ipadleft&gt; and B&lt;-ipadright&gt;
are set to C&lt;1&gt; by default when creating notebook objects. 


=head1 WIDGET-SPECIFIC OPTIONS

=over 4

=item * B&lt;-bindings&gt; &lt; HASHREF &gt;

The keys in this hash reference are keystrokes and the values are
routines to which they should be bound.  In the event a key is empty,
the corresponding routine will become the default routine that
B&lt;process_bindings&gt; applies to unmatched keystrokes it receives.

By default, the following mappings are used:

    KEY                 ROUTINE
    ------------------  ----------
    KEY_HOME, Ctrl-A    first_page
    KEY_END, Ctrl-E     last_page
    KEY_NPAGE, Ctrl-N   next_page
    KEY_PPAGE, Ctrl-P   prev_page

=item * B&lt;-routines&gt; &lt; HASHREF &gt;

The keys in this hash reference are routines and the values are either
scalar values or code references.  B&lt;process_bindings&gt; maps keystrokes
to routines and then to either a scalar value, which it returns, or a
code reference, which it executes.

By default, the following mappings are used:

    ROUTINE         ACTION
    ----------      -------------------------
    first_page      make first page active
    last_page       make last page active
    next_page       make next page active
    prev_page       make previous page active

=item * B&lt;-wraparound&gt; &lt; BOOLEAN &gt;

If BOOLEAN has a true value, wraparound is enabled.  This means that
advancing to the next page will cycle from the last back to the first
page and similarly, advancing to the previous page will cycle from the
first back to the last page.

By default, it is true.

=back


=head1 METHODS

=over 4

=item * B&lt;new&gt; ( OPTIONS )

Constructs a new notebook object using options in the hash OPTIONS.

=item * B&lt;layout&gt; ( )

Lays out the notebook object, makes sure it fits on the available
screen, and creates the curses windows for the border / tab labels as
well as the effective drawing area.

=item * B&lt;draw&gt; ( BOOLEAN )

Draws the notebook object along with the active page's window. If BOOLEAN
is true, the screen is not updated after drawing.

By default, BOOLEAN is true so the screen is updated.

=item * B&lt;intellidraw&gt; ( )

=item * B&lt;focus&gt; ( )

=item * B&lt;onFocus&gt; ( CODEREF )

=item * B&lt;onBlur&gt; ( CODEREF )

See L&lt;Curses::UI::Widget|Curses::UI::Widget&gt; for explanations of these
methods.

=item * B&lt;add_page&gt; ( PAGE [ , -on_activate =&gt; sub_ref ] [, -on_delete =&gt; ] )

Adds the specified page to the notebook object and creates an associated
window object.  Returns the window object or undef on failure.

Note: the add fails if the page would otherwise cause the tab window to
overflow or is already part of the notebook object.

The C&lt;-on_activate&gt; parameter specifies an optional call-back that
will be invoked when the page is activated. This call-back will be
called with the notebook widget and page name as parameter.

Likewise for C&lt;-on_delete&gt; call-back. This one is invoked when the
page is deleted.

=item * B&lt;delete_page&gt; ( PAGE )

Deletes the specified page from the notebook object and destroys its
associated window object.  If the page was active, the first page is
made active.

=item * B&lt;active_page&gt; ( )

Returns the currently active page in the notebook object.

=item * B&lt;first_page&gt; ( )

Returns the first page in the notebook object.

=item * B&lt;last_page&gt; ( )

Returns the last page in the notebook object.

=item * B&lt;prev_page&gt; ( )

Returns the previous page in the notebook object.

=item * B&lt;next_page&gt; ( )

Returns the next page in the notebook object.

=item * B&lt;activate_page&gt; ( PAGE )

Makes the specified page in the notebook object active and returns it,
redrawing the notebook object in the process.

=item * B&lt;mouse_button1&gt; ( )

Processes mouse button #1 clicks.  If the user left-clicks on one of the
tabs, B&lt;activate_page&gt; is called with the corresponding page to make it
active; otherwise, the click is passed along to the active window.

=back


=head1 SEE ALSO

L&lt;Curses::UI|Curses::UI&gt;,
L&lt;Curses::UI::Container|Curses::UI::Container&gt;,
L&lt;Curses::UI::Widget|Curses::UI::Widget&gt;


=head1 AUTHOR

George A. Theall, E&lt;lt&gt;theall@tifaware.comE&lt;gt&gt;


=head1 COPYRIGHT AND LICENSE

Copyright (c) 2004, George A. Theall. All rights reserved.

This script is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
</pre></body></html>