/usr/local/share/perl5/Curses/UI/
/usr/local/share/perl5/Curses/UI
NameSizeModeActions
Dialog/-0755rm
Language/-0755rm
Buttonbox.pm174890444editdlrm
Calendar.pm216020444editdlrm
Checkbox.pm77030444editdlrm
Color.pm55750444editdlrm
Common.pm173320444editdlrm
Container.pm189430444editdlrm
Label.pm101650444editdlrm
Language.pm36650444editdlrm
Listbox.pm266870444editdlrm
Menubar.pm220270444editdlrm
Notebook.pm278500444editdlrm
PasswordEntry.pm24980444editdlrm
Popupmenu.pm134170444editdlrm
Progressbar.pm71680444editdlrm
Radiobuttonbox.pm28880444editdlrm
Searchable.pm115010444editdlrm
TextEditor.pm452180444editdlrm
TextEntry.pm29600444editdlrm
TextViewer.pm22030444editdlrm
Tutorial.pod52890444editdlrm
Widget.pm533960444editdlrm
Window.pm43570444editdlrm
Edit: /usr/local/share/perl5/Curses/UI/Menubar.pm (22027B)
# ---------------------------------------------------------------------- # Curses::UI::Menubar # Curses::UI::MenuListbox # # (c) 2001-2002 by Maurice Makaay. All rights reserved. # This file is part of Curses::UI. Curses::UI is free software. # You can redistribute it and/or modify it under the same terms # as perl itself. # # Currently maintained by Marcus Thiesen # e-mail: marcus@cpan.thiesenweb.de # ---------------------------------------------------------------------- # TODO: fix dox # ---------------------------------------------------------------------- # MenuListbox package # ---------------------------------------------------------------------- package Curses::UI::MenuListbox; use strict; use Curses; use Curses::UI::Common; use Curses::UI::Container; use Curses::UI::Window; use Curses::UI::Listbox; use Curses::UI::Widget; use vars qw( $VERSION @ISA ); $VERSION = '1.10'; @ISA = qw( Curses::UI::Listbox Curses::UI::Common Curses::UI::Window ); sub new() { my $class = shift; my %userargs = @_; keys_to_lowercase(\%userargs); my %args = ( -menu => {}, # The menu contents -is_topmenu => 0, # First pulldown or not? -menubar => undef, # Ref to menubar object -prevobject => undef, # Ref to "parent" object (the real parent # is the rootwindow, but we need to know # which menulistbox or menubar is parent). -bg => -1, -fg => -1, -bbg => -1, -bfg => -1, %userargs, -vscrollbar => 1, # Always use a vscrollbar -border => 1, # Always show a border -wraparound => 1, # Use listbox wraparound -returnaction => undef, # Is set by other MenuListboxes ); # First determine the longest label. my $longest = 0; foreach my $item (@{$args{-menu}}) { my $l = $item->{-label}; $args{-parent}->root->fatalerror( "Missing argument: -label for the MenuListbox" ) unless defined $l; $longest = length($l) if length($l) > $longest; } # Increase $longest for some whitespace on the # right side of the labels. $longest++; # Now create the values and labels for the listbox. my @values = (); my %labels = (); my $has_submenu = 0; foreach my $item (@{$args{-menu}}) { my $l = $item->{-label}; if (defined($item->{-submenu})) { $l = sprintf("%-${longest}s >>", $l); $has_submenu++; } push @values, $l; } # If there are submenu's, make the $longest variable higher. $longest += 4 if $has_submenu; $args{-values} = \@values; # Determine the needed width and hight for the listbox. my $w = width_by_windowscrwidth($longest, %args); my $h = height_by_windowscrheight(@values, %args); $args{-width} = $w; $args{-height} = $h; # Check if the menu does fit on the right. If not, try to # shift it to the left as far as needed. if ($args{-x} + $w > $ENV{COLS}) { $args{-x} = $ENV{COLS} - $w; $args{-x} = 0 if $args{-x} < 0; } my $this = $class->SUPER::new(%args); $this->root->fatalerror( "Missing or illegal argument: -menubar" ) unless defined $args{-menubar} and $args{-menubar}->isa('Curses::UI::Menubar'); # Clear 'loose-focus' binding, so loosing focus through # the key does not work. $this->clear_binding('loose-focus'); # Create binding routines. $this->set_routine('cursor-left', \&cursor_left); $this->set_routine('cursor-right', \&cursor_right); $this->set_routine('option-select',\&option_select); $this->set_routine('escape', \&escape_key); # Create bindings. $this->set_binding('escape', CUI_ESCAPE); $this->set_binding('cursor-left', KEY_LEFT(), 'h'); $this->set_binding('cursor-right', KEY_RIGHT(), 'l'); if ($Curses::UI::ncurses_mouse) { $this->set_mouse_binding(\&mouse_button1, BUTTON1_CLICKED()); } return $this; } sub escape_key() { my $this = shift; $this->{-prevobject}->{-returnaction} = 'COLLAPSE'; $this->loose_focus; } sub active_item() { my $this = shift; $this->{-menu}->[$this->{-ypos}]; } sub cursor_left() { my $this = shift; $this->{-prevobject}->{-returnaction} = 'CURSOR_LEFT'; $this->loose_focus; } sub cursor_right() { my $this = shift; # Get the current menu-item. my $item = $this->active_item; # This item has a submenu. Open it. if (defined $item->{-submenu}) { # Compute the (x,y)-position of the new menu. my $x = $this->{-x} + $this->borderwidth; my $y = $this->{-y} + $this->{-ypos}; # Create the submenu. my $id = "__submenu_$this"; my $submenu = $this->root->add( $id, 'MenuListbox', -prevobject => $this, -menubar => $this->{-menubar}, -x => $x, -y => $y, -menu => $this->{-menu}->[$this->{-ypos}]->{-submenu}, -bg => $this->{-bg}, -fg => $this->{-fg}, -bbg => $this->{-bbg}, -bfg => $this->{-bfg}, ); # Show the submenu and wait for it to return. $this->{-returnaction} = undef; $submenu->modalfocus; $this->root->delete($id); $this->root->draw; # Data set by the previous modal focused menulistbox. my $return = $this->{-returnaction}; my $event = $this->{-mouse_event}; if (defined $return) { # COLLAPSE:. Collapse further, unless # $this = . if ($return =~ /^COLLAPSE\:?(.*)$/) { if ($this ne $1) { $this->{-prevobject}->{-returnaction} = $return; $this->{-prevobject}->{-mouse_event} = $event; return $this->loose_focus; } else { $this->focus; return $this->event_mouse($event); } } elsif ($return eq 'COLLAPSE') { return $this->escape_key; } } # This item has no submenu. Return CURSOR_RIGHT # if this is a topmenu. } elsif ($this->{-is_topmenu}) { $this->{-prevobject}->{-returnaction} = 'CURSOR_RIGHT'; $this->loose_focus; } return $this; } sub option_select() { my $this = shift; # Get the current menu-item. my $item = $this->active_item; # Submenu selected? Then expand it. if (defined $item->{-submenu}) { return $this->cursor_right; } # Let the menubar handle the option that was chosen. my $value = $item->{-value}; $this->{-menubar}->menuoption_selected($value); # Let the complete menulistbox-hierarchy collapse. $this->{-prevobject}->{-returnaction} = 'COLLAPSE'; $this->loose_focus; return $this; } sub mouse_button1() { my $this = shift; my $event = shift; my $x = shift; my $y = shift; # First check if the click is inside the widget (since # this widget has modal focus, all events go to it). my $ev_x = $event->{-x}; my $ev_y = $event->{-y}; my $tree = $this->root->object_at_xy($this->root, $ev_x, $ev_y); # Another object is clicked... Collapse the menu. # If a menu-object was clicked, stay on that object # and rerun the event. if ($this ne $tree->[-1]) { $this->{-prevobject}->{-returnaction} = 'COLLAPSE:' . $tree->[-1]; $this->{-prevobject}->{-mouse_event} = $event; $this->loose_focus; return $this; } # Select listbox entry. $this->{-ypos} = $this->{-active} = $this->{-yscrpos} + $y; $this->layout_content(); $this->schedule_draw(1); $this->option_select(); } # Let Curses::UI->usemodule() believe that this module # was already loaded (usemodule() would else try to # require the non-existing file). # $INC{'Curses/UI/MenuListbox.pm'} = $INC{'Curses/UI/Menubar.pm'}; # ---------------------------------------------------------------------- # Menubar package # ---------------------------------------------------------------------- package Curses::UI::Menubar; use strict; use Curses; use Curses::UI::Common; use Curses::UI::Container; use Curses::UI::Window; use vars qw( $VERSION @ISA ); $VERSION = '1.10'; @ISA = qw( Curses::UI::Window Curses::UI::Common ); my %routines = ( 'escape' => \&escape, 'pulldown' => \&pulldown, 'menu-left' => \&menu_left, 'menu-right' => \&menu_right, 'mouse-button1' => \&mouse_button1, ); my %bindings = ( KEY_DOWN() => 'pulldown', 'j' => 'pulldown', KEY_ENTER() => 'pulldown', KEY_LEFT() => 'menu-left', 'h' => 'menu-left', KEY_RIGHT() => 'menu-right', 'l' => 'menu-right', CUI_ESCAPE() => 'escape', ); sub new () { my $class = shift; my %userargs = @_; keys_to_lowercase(\%userargs); my %args = ( -parent => undef, # the parent window -menu => [], # the menu definition -menuhandler => undef, # a custom menu handler (optional) -bg => -1, -fg => -1, %userargs, -routines => {%routines}, -bindings => {%bindings}, -width => undef, # Always use the full width -height => 1, # Always use height = 1 -focus => 0, -nocursor => 1, # This widget does not use a cursor -x => 0, -y => 0, -border => 0, -selected => 0, -returnaction => undef, # is set by MenuListboxes. -menuoption => undef, # the value for the chosen option # (is also set by MenuListboxes). -is_expanded => 0, # let show focused on expand ); my $this = $class->SUPER::new( %args ); $this->layout; if ($Curses::UI::ncurses_mouse) { $this->set_mouse_binding('mouse-button1', BUTTON1_CLICKED()); } return $this; } sub escape() { my $this = shift; $this->loose_focus; } sub layout() { my $this = shift; $this->SUPER::layout or return; return $this; } sub draw() { my $this = shift; my $no_doupdate = shift || 0; $this->SUPER::draw(1) or return $this; # Create full reverse menubar. $this->{-canvasscr}->attron(A_REVERSE); # Let there be color if ($Curses::UI::color_support) { my $co = $Curses::UI::color_object; my $pair = $co->get_color_pair( $this->{-bg}, $this->{-fg}); $this->{-canvasscr}->attron(COLOR_PAIR($pair)); } $this->{-canvasscr}->addstr(0, 0, " "x$this->canvaswidth); # Create menu-items. my $x = 1; my $idx = 0; foreach my $item (@{$this->{-menu}}) { # By default the bar is drawn in reverse. $this->{-canvasscr}->attron(A_REVERSE); # Let there be color if ($Curses::UI::color_support) { my $co = $Curses::UI::color_object; my $pair = $co->get_color_pair( $this->{-bg}, $this->{-fg}); $this->{-canvasscr}->attron(COLOR_PAIR($pair)); } # If the bar has focus, the selected item is # show without reverse. if ($this->{-focus} and $idx == $this->{-selected}) { $this->{-canvasscr}->attroff(A_REVERSE); } my $label = $item->{-label}; $this->{-canvasscr}->addstr(0, $x, " " . $item->{-label} . " "); $x += length($label) + 2; $idx++; } $this->{-canvasscr}->attroff(A_REVERSE); $this->{-canvasscr}->move(0,0); $this->{-canvasscr}->noutrefresh(); doupdate() unless $no_doupdate; return $this; } # This calls the default event_onfocus() routine of # the Widget class and it resets the -menuoption # data member if the menu is not expanded (this will # contain the chosen menuoption at the time the # menubar loses focus). # sub event_onfocus() { my $this = shift; unless ($this->{-is_expanded}) { $this->{-menuoption} = undef; $this->{-selected} = 0; } $this->SUPER::event_onfocus; } sub loose_focus() { my $this = shift; # Draw the menubar like it does not have the focus anymore. $this->{-focus} = 0; $this->draw; # Execute callback routine if a menuitem was selected. my $value = $this->{-menuoption}; if (defined $value) { # Run the make-your-own-handler handler if defined. if (defined $this->{-menuhandler}) { $this->{-menuhandler}->($this, $value); } # Default handler: If $value has CODE in it, run this code. elsif (defined $value and ref $value eq 'CODE') { $value->($this); } } # Focus shifted to another object? Then leave it that way. if ($this->root->focus_path(-1) ne $this) { return $this; } # Else go back to the previous focused window. else { $this->{-focus} = 0; my $prev = $this->root->{-draworder}->[-2]; if (defined $prev) { $this->root->focus($prev); } } } # This calls the default event_onblur() routine of the # Widget class, but if -is_expanded is set, the widget # will still render as a focused widget (this is to # let the selected menuoption show focused, even if # the focus is set to a menulistbox). # sub event_onblur() { my $this = shift; $this->SUPER::event_onblur; if ($this->{-is_expanded}) { $this->{-focus} = 1; } return $this; } sub menuoption_selected() { my $this = shift; my $value = shift; $this->{-menuoption} = $value; } sub pulldown() { my $this = shift; # Find the x position of the selected menu. my $x = 1; my $y = 1; # am I in a window if ($this->{-parent}->{-x}) { $x += $this->{-parent}->{-x}; } # does it have a border if ($this->{-parent}->{-border}) { $x += 1; } # find real x value for my $idx (1 .. $this->{-selected}) { $x += length($this->{-menu}->[$idx-1]->{-label}); $x += 2; } # same for y if ($this->{-parent}->{-y}) { $y += $this->{-parent}->{-y}; } # does it have a border if ($this->{-parent}->{-border}) { $y += 1; } # Add the submenu. my $id = "__submenu_$this"; my $submenu = $this->root->add( $id, 'MenuListbox', -x => $x, -y => $y, -is_topmenu => 1, -menu => $this->{-menu}->[$this->{-selected}]->{-submenu}, -menubar => $this, -prevobject => $this, -fg => $this->{-fg}, -bg => $this->{-bg}, -bfg => $this->{-fg}, -bbg => $this->{-bg}, ); # Focus the new window and wait until it returns. $this->{-returnaction} = undef; $this->{-is_expanded} = 1; $submenu->modalfocus; # Remove the submenu. $this->root->delete($id); $this->root->draw; $this->{-is_expanded} = 0; # Parameters that are set by the previous modal focused menulistbox. my $return = $this->{-returnaction}; my $event = $this->{-mouse_event}; if (defined $return) { # COLLAPSE:. Collapse further, unless # $this = . if ($return =~ /^COLLAPSE\:?(.*)$/) { if ($this ne $1) { $this->{-prevobject}->{-returnaction} = $return; $this->{-prevobject}->{-mouse_event} = $event; return $this->loose_focus; } else { $this->focus; return $this->event_mouse($event); } } elsif ($return eq 'COLLAPSE') { return $this->loose_focus; } elsif ($return eq 'CURSOR_LEFT') { $this->menu_left; $this->focus; $this->draw; $this->root->feedkey(KEY_DOWN()); } elsif ($return eq 'CURSOR_RIGHT') { $this->menu_right; $this->focus; $this->draw; $this->root->feedkey(KEY_DOWN()); } } return $return; } sub menu_left() { my $this = shift; $this->{-selected}--; $this->{-selected} = @{$this->{-menu}}-1 if $this->{-selected} < 0; $this->schedule_draw(1); return $this; } sub menu_right() { my $this = shift; $this->{-selected}++; $this->{-selected} = 0 if $this->{-selected} > (@{$this->{-menu}}-1); $this->schedule_draw(1); return $this; } sub mouse_button1 { my $this = shift; my $MEVENT = shift; my $x = shift; my $y = shift; my $mx = 1; my $idx = 0; foreach my $item (@{$this->{-menu}}) { $mx += length($item->{-label}) + 2; if ($mx > $x) { last } $idx++; } if ($idx > (@{$this->{-menu}}-1)) {$idx--} $this->focus(); $this->{-selected} = $idx; $this->pulldown(); $this->schedule_draw(1); return $this; } 1; =pod =head1 NAME Curses::UI::Menubar - Create and manipulate menubar widgets =head1 CLASS HIERARCHY Curses::UI::Widget | +----Curses::UI::Container | +----Curses::UI::Window | +----Curses::UI::Menubar =head1 SYNOPSIS use Curses::UI; my $cui = new Curses::UI; # define the menu datastructure. my $menu_data = [....]; my $menu = $cui->add( 'menu', 'Menubar', -menu => $menu_data ); $menu->focus(); =head1 DESCRIPTION This class can be used to add a menubar to Curses::UI. This menubar can contain a complete submenu hierarchy. It looks (remotely :-) like this: ------------------------------------- menu1 | menu2 | menu3 | .... ------------------------------------- +-------------+ |menuitem 1 | |menuitem 2 |+--------------+ |menuitem 3 >>||submenuitem 1 | |menuitem 4 ||submenuitem 2 | +-------------+|submenuitem 3 | |submenuitem 4 | |submenuitem 5 | +--------------+ See exampes/demo-Curses::UI::Menubar in the distribution for a short demo. =head1 STANDARD OPTIONS This class does not use any of the standard options that are provided by L. =head1 WIDGET-SPECIFIC OPTIONS There is only one option: B<-menu>. The value for this option is an ARRAYREF. This ARRAYREF behaves exactly like the one that is described in L. The difference is that for the top-level menu, you will only use -submenu's. Example data structure: my $menu1 = [ { -label => 'option 1', -value => '1-1' }, { -label => 'option 2', -value => '1-2' }, { -label => 'option 3', -value => '1-3' }, ]; my $menu2 = [ { -label => 'option 1', -value => \&sel1 }, { -label => 'option 2', -value => \&sel2 }, { -label => 'option 3', -value => \&sel3 }, ]; my $submenu = [ { -label => 'suboption 1', -value => '3-3-1' }, { -label => 'suboption 2', -callback=> \&do_it }, ]; my $menu3 = [ { -label => 'option 1', -value => \&sel2 }, { -label => 'option 2', -value => \&sel3 }, { -label => 'submenu 1', -submenu => $submenu }, ]; my $menu = [ { -label => 'menu 1', -submenu => $menu1 }, { -label => 'menu 2', -submenu => $menu2 } { -label => 'menu 3', -submenu => $menu3 } ]; =head1 METHODS =over 4 =item * B ( OPTIONS ) =item * B ( ) =item * B ( BOOLEAN ) =item * B ( ) These are standard methods. See L for an explanation of these. =back =head1 DEFAULT BINDINGS =over 4 =item * > Call the 'escape' routine. This will have the menubar loose its focus and return the value 'ESCAPE' to the calling routine. =item * > Call the 'return' routine. This will have the menubar loose its focus and return the value 'LOOSE_FOCUS' to the calling routine. =item * >, >, > Call the 'pulldown' routine. This will open the menulistbox for the current menu and give that menulistbox the focus. What happens after the menulistbox loses its focus, depends upon the returnvalue of it: * the value 'CURSOR_LEFT' Call the 'cursor-left' routine and after that call the 'pulldown' routine. So this will open the menulistbox for the previous menu. * the value 'CURSOR_RIGHT' Call the 'cursor-right' routine and after that call the 'pulldown' routine. So this will open the menulistbox for the next menu. * the value 'LOOSE_FOCUS' The menubar will keep the focus, but no menulistbox will be open. * the value 'ESCAPE' The menubar will loose its focus and return the value 'ESCAPE' to the calling routine. * A CODE reference The code will be excuted, the menubar will loose its focus and the returnvalue of the CODE will be returned to the calling routine. * Any other value The menubar will loose its focus and the value will be returned to the calling routine. =item * >, > Call the 'cursor-left' routine. This will select the previous menu. If the first menu is already selected, the last menu will be selected. =item * >, > Call the 'cursor-right' routine. This will select the next menu. If the last menu is already selected, the first menu will be selected. =back =head1 SEE ALSO L, L, L =head1 AUTHOR Copyright (c) 2001-2002 Maurice Makaay. All rights reserved. Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de) This package is free software and is provided "as is" without express or implied warranty. It may be used, redistributed and/or modified under the same terms as perl itself.