Curses-UI
view release on metacpan or search on metacpan
examples/color_editor view on Meta::CPAN
" ^Q Quit from the program ^S save file"
. " ^W toggle wrapping\n"
. " ^X Open the menu ^O open file"
. " ^R toggle hard returns viewing",
);
# ----------------------------------------------------------------------
# Callback routines
# ----------------------------------------------------------------------
sub open_dialog()
{
my $file = $cui->loadfilebrowser(
-file => $currentfile,
-bg => "green",
-fg => "white",
-bbg => "green",
-bfg => "white",
-tbg => "green",
-tfg => "white",
);
examples/color_editor view on Meta::CPAN
close F;
$editor->text($text);
$editor->cursor_to_home;
$currentfile = $file;
} else {
$cui->error(-message => "Can't read file \"$file\":\n$!");
}
}
}
sub save_dialog()
{
my $file = $cui->savefilebrowser(
-file => $currentfile,
-bg => "green",
-fg => "white",
-bbg => "green",
-bfg => "white",
-tbg => "green",
-tfg => "white",
examples/color_editor view on Meta::CPAN
$cui->dialog(-message => "File \"$file\"\nsuccessfully saved");
$currentfile = $file;
} else {
$cui->error(-message => "Error on closing file \"$file\":\n$!");
}
} else {
$cui->error(-message => "Can't write to $file:\n$!");
}
}
sub about_dialog()
{
$cui->dialog(
-title => 'About editor',
-message => "Program : Curses::UI Editor\n"
. "Author : Maurice Makaay\n"
. " Marcus Thiesen\n"
. "\n"
. "The sole purpose of this editor\n"
. "is the demonstration of the perl\n"
. "Curses::UI widget set and the newly\n"
. "developed color support.\n",
-bg => "white",
-fg => "red",
-bbg => "white",
-bfg => "red",
-tbg => "white",
-tfg => "red",
);
}
sub exit_dialog()
{
my $return = $cui->dialog(
-title => "Are you sure???",
-buttons => ['yes', 'no'],
-message => "Do you really want to quit?",
-tbg => "white",
-tfg => "red",
-bg => "white",
-fg => "red",
-bbg => "white",
examples/demo-widgets view on Meta::CPAN
# Demo index
my $current_demo = 1;
# Demo windows
my %w = ();
# ----------------------------------------------------------------------
# Create a menu
# ----------------------------------------------------------------------
sub select_demo($;)
{
my $nr = shift;
$current_demo = $nr;
$w{$current_demo}->focus;
}
my $file_menu = [
{ -label => 'Quit program', -value => sub {exit(0)} },
],
examples/demo-widgets view on Meta::CPAN
);
$w{2}->add(
'buttonlabel', 'Label',
-y => 7,
-width => -1,
-bold => 1,
-text => "Press a button please...",
);
sub button_callback($;)
{
my $this = shift;
my $label = $this->parent->getobj('buttonlabel');
$label->text("You pressed: " . $this->get);
}
$w{2}->add(
undef, 'Buttonbox',
-y => 5,
-buttons => [
examples/demo-widgets view on Meta::CPAN
undef, 'Label',
-text => "The listbox can be used for selecting on or more options\n"
. "out of a predefined list of options. <SPACE> and <ENTER> will\n"
. "change the current selected option for a normal listbox and a\n"
. "radiobuttonbox, They will toggle the state of the active option in\n"
. "a multi-select listbox. In a multi-select listbox you can also\n"
. "use <Y> and <N> to check or uncheck options. Press </> for a\n"
. "'less'-like search through the list."
);
sub listbox_callback()
{
my $listbox = shift;
my $label = $listbox->parent->getobj('listboxlabel');
my @sel = $listbox->get;
@sel = ('<none>') unless @sel;
my $sel = "selected: " . join (", ", @sel);
$label->text($listbox->title . " $sel");
}
$w{5}->add(
examples/demo-widgets view on Meta::CPAN
-x => 15, -y => 6, -showvalue => 1 );
$w{7}->add( undef, "Label", -y => 10, -text => "No centerline");
$w{7}->add( 'p2', 'Progressbar', -max => 60,
-x => 15, -y => 9, -nocenterline => 1 );
$w{7}->add( undef, "Label", -y => 13, -text => "No percentage");
$w{7}->add( 'p3', 'Progressbar', -max => 60,
-x => 15, -y => 12, -nopercentage => 1 );
sub progressbar_timer_callback($;)
{
my $cui = shift;
my @l = localtime;
$w{7}->getobj('p1')->pos($l[2]);
$w{7}->getobj('p2')->pos($l[1]);
$w{7}->getobj('p3')->pos($l[0]);
$w{7}->getobj('progressbarlabel')->text(
sprintf("%02d:%02d:%02d", @l[2,1,0])
);
}
examples/demo-widgets view on Meta::CPAN
# ----------------------------------------------------------------------
# Setup bindings and focus
# ----------------------------------------------------------------------
# Bind <CTRL+Q> to quit.
$cui->set_binding( sub{ exit }, "\cQ" );
# Bind <CTRL+X> to menubar.
$cui->set_binding( sub{ shift()->root->focus('menu') }, "\cX" );
sub goto_next_demo()
{
$current_demo++;
$current_demo = @screens if $current_demo > @screens;
$w{$current_demo}->focus;
}
$cui->set_binding( \&goto_next_demo, "\cN" );
sub goto_prev_demo()
{
$current_demo--;
$current_demo = 1 if $current_demo < 1;
$w{$current_demo}->focus;
}
$cui->set_binding( \&goto_prev_demo, "\cP" );
$w{$current_demo}->focus;
examples/editor view on Meta::CPAN
" ^Q Quit from the program ^S save file"
. " ^W toggle wrapping\n"
. " ^X Open the menu ^O open file"
. " ^R toggle hard returns viewing",
);
# ----------------------------------------------------------------------
# Callback routines
# ----------------------------------------------------------------------
sub open_dialog()
{
my $file = $cui->loadfilebrowser(
-file => $currentfile,
);
if (defined $file)
{
if (open F, "<$file") {
my $text = "";
while (<F>) { $text .= $_ }
close F;
$editor->text($text);
$editor->cursor_to_home;
$currentfile = $file;
} else {
$cui->error(-message => "Can't read file \"$file\":\n$!");
}
}
}
sub save_dialog()
{
my $file = $cui->savefilebrowser(
-file => $currentfile,
);
return unless defined $file;
if (open F, ">$file") {
print F $editor->text;
if (close F) {
$cui->dialog(-message => "File \"$file\"\nsuccessfully saved");
$currentfile = $file;
} else {
$cui->error(-message => "Error on closing file \"$file\":\n$!");
}
} else {
$cui->error(-message => "Can't write to $file:\n$!");
}
}
sub about_dialog()
{
$cui->dialog(
-title => 'About editor',
-message => "Program : Curses::UI Editor\n"
. "Author : Maurice Makaay\n"
. "\n"
. "The sole purpose of this editor\n"
. "is the demonstration of my perl\n"
. "Curses::UI widget set."
);
}
sub exit_dialog()
{
my $return = $cui->dialog(
-title => "Are you sure???",
-buttons => ['yes', 'no'],
-message => "Do you really want to quit?"
);
exit(0) if $return;
}
examples/pop3_reader view on Meta::CPAN
my $pop3 = undef;
my $connection = undef;
# We do not want STDERR to clutter our screen.
open STDERR, ">/dev/null";
# ----------------------------------------------------------------------
# setup(): Setup the connection
# ----------------------------------------------------------------------
sub check_connection($;)
{
my $buttons = shift;
my $conwin = $buttons->parent;
my $cui = $conwin->root;
foreach my $key ('username','password','host','port')
{
my $obj = $conwin->getobj($key);
my $value = $obj->get;
$connection->{$key} = $value;
examples/pop3_reader view on Meta::CPAN
if ($value =~ /^\s*$/) {
$cui->error("Missing value for $key field");
$obj->focus;
return;
}
}
return 1;
}
sub setup_connection()
{
my $conwin = $cui->add(
'connection_window', 'Window',
-border => 1,
-ipad => 2,
-height => 15,
-width => 60,
-centered => 1,
-title => "POP3 connection",
);
examples/pop3_reader view on Meta::CPAN
);
$conwin->modalfocus;
$cui->delete('connection_window')
}
# ----------------------------------------------------------------------
# pop3_connect(): Connect to the POP3 server and exit if it fails
# ----------------------------------------------------------------------
sub pop3_connect()
{
$cui->progress(
-message => "Connecting to the POP3 server...",
-max => 4,
-pos => 1,
);
my $error = 0;
$pop3 = Net::POP3->new(
examples/pop3_reader view on Meta::CPAN
$cui->noprogress;
return !$error;
}
# ----------------------------------------------------------------------
# The inbox screen
# ----------------------------------------------------------------------
sub build_inbox()
{
my $list = $pop3->list();
my @ids = sort {$a<=>$b} keys %$list;
my $msg = "Retrieving headers";
$cui->progress(
-max => scalar(@ids),
-message => $msg,
);
examples/pop3_reader view on Meta::CPAN
);
$ml->set_binding(sub{exit(0)}, "\cC", "\cQ");
$ml->set_routine('option-select', \&view_message);
}
# ----------------------------------------------------------------------
# view_message(): callback routine for the inbox list
# ----------------------------------------------------------------------
sub view_message()
{
my $this = shift;
# Get the selected message id.
$this->{-selected} = $this->{-ypos};
my $id = $this->get;
$this->{-selected} = undef;
# Retrieve the message from the POP3 server.
$cui->status("Retrieving message $id from the POP3 server...");
examples/tutorial view on Meta::CPAN
);
my $win1 = $cui->add(
'win1', 'Window',
-border => 1,
-y => 1,
-bfg => 'red',
);
sub exit_dialog()
{
my $return = $cui->dialog(
-message => "Do you really want to quit?",
-title => "Are you sure???",
-buttons => ['yes', 'no'],
);
exit(0) if $return;
}
lib/Curses/UI.pm view on Meta::CPAN
# Walk through all contained objects and let them
# layout themselves.
$self->layout_contained_objects;
$self->draw();
$Curses::UI::initialized = 1;
return $self;
}
sub layout_new()
{
my $self = shift;
$Curses::UI::screen_too_small = 0;
# find the terminal size.
my ($cols,$lines) = GetTerminalSize;
$ENV{COLS} = $cols;
$ENV{LINES} = $lines;
lib/Curses/UI.pm view on Meta::CPAN
return $self;
}
# ----------------------------------------------------------------------
# Event handling
# ----------------------------------------------------------------------
# TODO: document
sub do_one_event(;$)
{
my $self = shift;
my $object = shift;
$object = $self unless defined $object;
eval {curs_set($self->{-cursor_mode})};
# gpm mouse?
if ($Curses::UI::gpm_mouse) {
$self->handle_gpm_mouse_event($object);
lib/Curses/UI.pm view on Meta::CPAN
# Update the screen.
doupdate();
return $self;
}
# TODO: document
# TODO: document
sub add_callback()
{
my $self = shift;
my $id = shift;
my $code = shift;
$self->fatalerror(
"add_callback(): is is not set"
) unless defined $id;
$self->fatalerror(
"add_callback(): callback is no CODE reference"
) unless defined $code and ref $code eq 'CODE';
$self->{-added_code}->{$id} = $code;
}
# TODO: document
sub delete_callback()
{
my $self = shift;
my $id = shift;
$self->fatalerror(
"delete_callback(): id is not set"
) unless defined $id;
delete $self->{-added_code}->{$id} if
defined $self->{-added_code}->{$id};
}
sub draw()
{
my $self = shift;
my $no_doupdate = shift || 0;
if ($Curses::UI::screen_too_small)
{
my $s = $self->{-canvasscr};
$s->clear;
$s->addstr(0, 0, $self->lang->get('screen_too_small'));
$s->move(4,0);
$s->noutrefresh();
doupdate();
} else {
$self->SUPER::draw(1);
doupdate() unless $no_doupdate;
}
}
# TODO: document
sub feedkey()
{
my $self = shift;
my $key = shift;
$self->{-feedkey} = $key;
return $self;
}
# TODO: document
sub flushkeys()
{
my $self = shift;
my $key = '';
my @k = ();
until ( $key eq "-1" ) {
$key = $self->get_key(0);
}
}
# Returns 0 if less than -keydelay seconds have elapsed since the last
# user action. Returns the number of elapsed seconds otherwise.
sub keydelay()
{
my $self = shift;
my $time = time();
my $elapsed = $time - $self->{-lastkey};
return 0 if ($elapsed < $self->{-keydelay});
return $elapsed;
}
# ----------------------------------------------------------------------
# Timed event handling
# ----------------------------------------------------------------------
sub set_read_timeout()
{
my $self = shift;
my $new_timeout = -1;
TIMER: while (my ($id, $config) = each %{$self->{-timers}})
{
# Skip timer if it is disabled.
next TIMER unless $config->{-enabled};
$new_timeout = $config->{-time}
unless $new_timeout != -1 and
$new_timeout < $config->{-time};
}
$new_timeout = 1 if $new_timeout < 0 and $new_timeout != -1;
$self->{-read_timeout} = $new_timeout;
return $self;
}
sub set_timer($$;)
{
my $self = shift;
my $id = shift;
my $callback = shift;
my $time = shift || 1;
$self->fatalerror(
"add_timer(): callback is no CODE reference"
) unless defined $callback and ref $callback eq 'CODE';
lib/Curses/UI.pm view on Meta::CPAN
-enabled => 1,
-lastrun => time(),
};
$self->{-timers}->{$id} = $config;
$self->set_read_timeout;
return $self;
}
sub disable_timer($;)
{
my ($self,$id) = @_;
if (defined $self->{-timers}->{$id}) {
$self->{-timers}->{$id}->{-enabled} = 0;
}
$self->set_read_timeout;
return $self;
}
sub enable_timer($;)
{
my ($self,$id) = @_;
if (defined $self->{-timers}->{$id}) {
$self->{-timers}->{$id}->{-enabled} = 1;
}
$self->set_read_timeout;
return $self;
}
sub delete_timer($;)
{
my ($self,$id) = @_;
if (defined $self->{-timers}->{$id}) {
delete $self->{-timers}->{$id};
}
$self->set_read_timeout;
return $self;
}
sub do_timer()
{
my $self = shift;
my $now = time();
my $timers_done = 0;
# Short-circuit timers if the keydelay hasn't elapsed
if ($self->{-keydelay}) {
return $self unless $self->keydelay;
}
lib/Curses/UI.pm view on Meta::CPAN
#
$self->focus_path(-1)->draw if $timers_done;
return $self;
}
# ----------------------------------------------------------------------
# Mouse events
# ----------------------------------------------------------------------
sub handle_mouse_event()
{
my $self = shift;
my $object = shift;
$object = $self unless defined $object;
my $MEVENT = 0;
getmouse($MEVENT);
# $MEVENT is a struct. From curses.h (note: this might change!):
#
lib/Curses/UI.pm view on Meta::CPAN
{
# Send the mouse-event to the object.
# Leave the loop if the object handled the event.
print STDERR "Asking $object to handle $MEVENT{-bstate} ...\n" if
$Curses::UI::debug;
my $return = $object->event_mouse(\%MEVENT);
last if defined $return and $return ne 'DELEGATE';
}
}
sub handle_gpm_mouse_event()
{
my $self = shift;
my $object = shift;
$object = $self unless defined $object;
return unless $Curses::UI::gpm_mouse;
my $MEVENT = gpm_get_mouse_event();
# $MEVENT from C:UI:MH:GPM is identical.
lib/Curses/UI.pm view on Meta::CPAN
{
# Send the mouse-event to the object.
# Leave the loop if the object handled the event.
my $return = $object->event_mouse(\%MEVENT);
last if defined $return and $return ne 'DELEGATE';
}
}
sub object_at_xy($$;$)
{
my $self = shift;
my $object = shift;
my $x = shift;
my $y = shift;
my $tree = shift;
$tree = [] unless defined $tree;
push @$tree, $object;
lib/Curses/UI.pm view on Meta::CPAN
return $tree;
}
# ----------------------------------------------------------------------
# Other subroutines
# ----------------------------------------------------------------------
# TODO: document
sub fatalerror($$;$)
{
my $self = shift;
my $error = shift;
my $exit = shift;
$exit = 1 unless defined $exit;
chomp $error;
$error .= "\n";
my $s = $self->{-canvasscr};
lib/Curses/UI.pm view on Meta::CPAN
$self->flushkeys();
for (;;)
{
my $key = $self->get_key();
last if $key ne "-1";
}
exit($exit);
}
sub usemodule($;)
{
my $self = shift;
my $class = shift;
# Create class filename.
my $file = $class;
$file =~ s|::|/|g;
$file .= '.pm';
# Automatically load the required class.
lib/Curses/UI.pm view on Meta::CPAN
};
# Fatal error if the class could not be loaded.
$self->fatalerror("Could not load $class from $file:\n$@")
if $@;
}
return $self;
}
sub focus_path()
{
my $self = shift;
my $index = shift;
my $p_obj = $self;
my @path = ($p_obj);
for(;;)
{
my $p_el = $p_obj->{-draworder}->[-1];
last unless defined $p_el;
lib/Curses/UI.pm view on Meta::CPAN
last if $p_obj->isa('Curses::UI::ContainerWidget');
}
return (defined $index ? $path[$index] : @path);
}
# add() is overridden, because we only want to be able
# to add Curses::UI:Window objects to the Curses::UI
# rootlevel.
#
sub add()
{
my $self = shift;
my $id = shift;
my $class = shift;
my %args = @_;
# Make it possible to specify WidgetType instead of
# Curses::UI::WidgetType.
$class = "Curses::UI::$class"
if $class !~ /\:\:/ or
lib/Curses/UI.pm view on Meta::CPAN
{
$self->{-userdata} = $_[0];
}
return $self->{-userdata};
}
# ----------------------------------------------------------------------
# Focusable dialog windows
# ----------------------------------------------------------------------
sub tempdialog()
{
my $self = shift;
my $class = shift;
my %args = @_;
my $id = "__window_$class";
my $dialog = $self->add($id, $class, %args);
$dialog->modalfocus;
my $return = $dialog->get;
lib/Curses/UI.pm view on Meta::CPAN
# The argument list will be returned unchanged, unless it
# contains only one item. In that case ($ifone, $_[0]) will
# be returned. This enables constructions like:
#
# $cui->dialog("Some dialog message");
#
# instead of:
#
# $cui->dialog(-message => "Some dialog message");
#
sub process_args()
{
my $self = shift;
my $ifone = shift;
if (@_ == 1) { @_ = ($ifone => $_[0]) }
return @_;
}
sub error()
{
my $self = shift;
my %args = $self->process_args('-message', @_);
$self->tempdialog('Dialog::Error', %args);
}
sub dialog()
{
my $self = shift;
my %args = $self->process_args('-message', @_);
$self->tempdialog('Dialog::Basic', %args);
}
sub question()
{
my $self = shift;
my %args = $self->process_args('-question', @_);
$self->tempdialog('Dialog::Question', %args);
}
sub calendardialog()
{
my $self = shift;
my %args = $self->process_args('-title', @_);
$self->tempdialog('Dialog::Calendar', %args);
}
sub filebrowser()
{
my $self = shift;
my %args = $self->process_args('-title', @_);
# Create title
unless (defined $args{-title}) {
my $l = $self->root->lang;
$args{-title} = $l->get('file_title');
}
# Select a file to load from.
$self->tempdialog('Dialog::Filebrowser', %args);
}
sub dirbrowser()
{
my $self = shift;
my %args = $self->process_args('-title', @_);
# Create title
unless (defined $args{-title}) {
my $l = $self->root->lang;
$args{-title} = $l->get('dir_title');
}
# Select a file to load from.
$self->tempdialog('Dialog::Dirbrowser', %args);
}
sub savefilebrowser()
{
my $self = shift;
my %args = $self->process_args('-title', @_);
my $l = $self->root->lang;
# Create title.
$args{-title} = $l->get('file_savetitle')
unless defined $args{-title};
lib/Curses/UI.pm view on Meta::CPAN
-title => $title,
-buttons => [ 'yes', 'no' ],
-message => $pre . $file . $post,
);
return unless $overwrite;
}
return $file;
}
sub loadfilebrowser()
{
my $self = shift;
my %args = $self->process_args('-title', @_);
# Create title
unless (defined $args{-title}) {
my $l = $self->root->lang;
$args{-title} = $l->get('file_loadtitle');
}
$self->filebrowser(-editfilename => 0, %args);
}
# ----------------------------------------------------------------------
# Non-focusable dialogs
# ----------------------------------------------------------------------
my $status_id = "__status_dialog";
sub status($;)
{
my $self = shift;
my %args = $self->process_args('-message', @_);
$self->delete($status_id);
$self->add($status_id, 'Dialog::Status', %args)->draw;
return $self;
}
sub nostatus()
{
my $self = shift;
$self->delete($status_id);
$self->flushkeys();
$self->draw;
return $self;
}
sub progress()
{
my $self = shift;
my %args = @_;
$self->add(
"__progress_$self",
'Dialog::Progress',
%args
);
$self->draw;
return $self;
}
sub setprogress($;$)
{
my $self = shift;
my $pos = shift;
my $message = shift;
# If I do not do this, the progress bar seems frozen
# if a key is pressed on my Solaris machine. Flushing
# the input keys solves this. And this is not a bad
# thing to do during a progress dialog (input is ignored
# this way).
lib/Curses/UI.pm view on Meta::CPAN
my $p = $self->getobj("__progress_$self");
return unless defined $p;
$p->pos($pos) if defined $pos;
$p->message($message) if defined $message;
$p->draw;
return $self;
}
sub noprogress()
{
my $self = shift;
$self->delete("__progress_$self");
$self->flushkeys;
$self->draw;
return $self;
}
sub leave_curses()
{
my $self = shift;
def_prog_mode();
endwin();
}
sub reset_curses()
{
my $self = shift;
reset_prog_mode();
$self->layout(); # In case the terminal has been resized
}
### Color support
sub color() {
my $self = shift;
return $Curses::UI::color_object;
}
sub set_color {
my $self = shift;
my $co = shift;
$Curses::UI::color_object = $co;
}
# ----------------------------------------------------------------------
# Accessor functions
# ----------------------------------------------------------------------
sub compat(;$) { shift()->accessor('-compat', shift()) }
sub clear_on_exit(;$) { shift()->accessor('-clear_on_exit', shift()) }
sub cursor_mode(;$) { shift()->accessor('-cursor_mode', shift()) }
sub lang(;$) { shift()->accessor('-language_object', shift()) }
sub overlapping(;$) { shift()->accessor('-overlapping', shift()) }
# TODO: document
sub debug(;$)
{
my $self = shift;
my $value = shift;
$Curses::UI::debug = $self->accessor('-debug', $value);
}
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
$this->layout();
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding('mouse-button1', BUTTON1_CLICKED());
}
return $this;
}
sub process_buttondefs()
{
my $this = shift;
my $buttons = $this->{-buttons};
# Process button types.
my @buttons = ();
foreach my $button (@$buttons)
{
if (ref $button eq 'HASH') {
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
}
keys_to_lowercase($button);
push @buttons, $button;
}
$this->{-buttons} = \@buttons;
return $this;
}
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
# Compute the space that is needed for the buttons.
my $xneed = $this->compute_buttonwidth;
my $yneed = $this->compute_buttonheight;
if ( ($xneed > $this->canvaswidth) || ($yneed > $this->canvasheight) )
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
# Make shortcuts all upper-case.
foreach my $button (@{$this->{-buttons}}) {
if (defined $button->{-shortcut}) {
$button->{-shortcut} = uc $button->{-shortcut};
}
}
return $this;
}
sub get_selected_button()
{
my $this = shift;
my $selected = $this->{-selected};
my $button = $this->{-buttons}->[$selected];
return $button;
}
sub get()
{
my $this = shift;
my $button = $this->get_selected_button;
if (defined $button->{-value}) {
return $button->{-value};
} else {
return $this->{-selected};
}
}
sub next_button()
{
my $this = shift;
$this->{-selected}++;
$this->schedule_draw(1);
return $this;
}
sub previous_button()
{
my $this = shift;
$this->{-selected}--;
$this->schedule_draw(1);
return $this;
}
# Focus the next button. If the last button was
# selected, let the buttonbox loose focus.
sub focus_shift()
{
my $this = shift;
my $key = shift;
if ( $key eq KEY_BTAB() )
{
$this->previous_button();
if ($this->{-selected} < 0)
{
# $this->schedule_draw(0);
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
{
# $this->schedule_draw(0);
$this->{-selected} = 0;
$this->do_routine('loose-focus', $key);
}
}
return $this;
}
sub press_button()
{
my $this = shift;
my $button = $this->get_selected_button;
my $command = $button->{-onpress};
$this->schedule_draw(1);
if (defined $command and ref $command eq 'CODE') {
$command->($this);
}
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget.
$this->SUPER::draw(1) or return $this;
# Check if active element isn't out of bounds.
$this->{-selected} = 0 unless defined $this->{-selected};
$this->{-selected} = 0 if $this->{-selected} < 0;
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
$id++;
}
$this->{-canvasscr}->move(0,0);
$this->{-canvasscr}->noutrefresh;
doupdate() unless $no_doupdate;
return $this;
}
sub mouse_button1($$$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
my $idx = 0;
my $bx = $this->{-xpos};
# Clicked left of the buttons?
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
undef $idx if defined $idx and
$idx > (@{$this->{-buttons}} - 1);
if (defined $idx) {
$this->{-selected} = $idx;
$this->focus();
$this->do_routine('press-button', $event);
}
}
sub compute_buttonheight($;)
{
my $this = shift;
my $height = 1;
if ( (defined $this->{-vertical}) && ($this->{-vertical}) ) {
$height = scalar @{$this->{-buttons}};
}
return $height;
}
sub compute_buttonwidth($;)
{
my $this = shift;
$this->process_buttondefs;
my $width=0;
if ( (defined $this->{-vertical}) && ($this->{-vertical}) ) {
foreach my $button (@{$this->{-buttons}}) {
if ($width < length($button->{-label})) {
lib/Curses/UI/Buttonbox.pm view on Meta::CPAN
$width = @{$this->{-buttons}} - 1;
# Buttons
foreach my $button (@{$this->{-buttons}}) {
$width += length($button->{-label});
}
}
return $width;
}
sub shortcut()
{
my $this = shift;
my $key = uc shift;
# Walk through shortcuts to see if the pressed key
# is in the list of -shortcuts.
my $idx = 0;
my $found_idx;
SHORTCUT: foreach my $button (@{$this->{-buttons}})
{
lib/Curses/UI/Calendar.pm view on Meta::CPAN
'mouse-button', BUTTON1_CLICKED(), BUTTON3_CLICKED());
}
return $this;
}
# ----------------------------------------------------------------------
# Methods
# ----------------------------------------------------------------------
sub onChange(;$) { shift()->set_event('-onchange', shift()) }
sub day($;) { shift()->accessor('-day', shift()) }
sub month($;) { shift()->accessor('-month', shift()) }
sub year($;) { shift()->accessor('-year', shift()) }
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
return $this;
}
sub setdate($;$)
{
my $this = shift;
my $date = shift;
my $nodraw = shift || 0;
if (not defined $date)
{
$this->{-year} = undef;
$this->{-month} = undef;
$this->{-day} = undef;
lib/Curses/UI/Calendar.pm view on Meta::CPAN
$this->{-month} = $2;
$this->{-day} = $3;
}
$this->make_sane_date;
$this->intellidraw unless $nodraw;
return $this;
}
sub make_sane_date()
{
my $this = shift;
my $cursor = shift;
my $c = $cursor ? 'c' : '';
# Determine 'today'.
my @now = localtime(); $now[4]++; $now[5]+=1900;
# Use today's values if undefined.
$this->{"-${c}day"} = $now[3]
lib/Curses/UI/Calendar.pm view on Meta::CPAN
# undef value?
if ($this->{"-${c}year"} == 1752 and $this->{"-${c}month"} == 9) {
if ($this->{"-${c}day"} > 2 and $this->{"-${c}day"} < 14) {
$this->{"-${c}day"} = ($this->{"-${c}day"} > 8 ? 14 : 2);
}
}
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget
$this->SUPER::draw(1) or return $this;
$this->make_sane_date;
$this->make_sane_date(1);
lib/Curses/UI/Calendar.pm view on Meta::CPAN
# Move the cursor to the bottomright corner of the widget
# (in case the terminal does not support widget hiding).
$this->{-canvasscr}->move($this->canvasheight-1, $this->canvaswidth-1);
$this->{-canvasscr}->noutrefresh();
doupdate() unless $no_doupdate;
return $this;
}
sub date_selected()
{
my $this = shift;
$this->{-cyear} = $this->{-year};
$this->{-cmonth} = $this->{-month};
$this->{-cday} = $this->{-day};
$this->schedule_draw(1);
return $this;
}
sub date_today()
{
my $this = shift;
$this->{-cmonth} = undef;
$this->{-cday} = undef;
$this->{-cyear} = undef;
$this->schedule_draw(1);
return $this;
}
sub date_prevyear()
{
my $this = shift;
$this->{-cyear}--;
$this->{-cyear} = 0 if $this->{-cyear} < 0;
$this->schedule_draw(1);
return $this;
}
sub date_nextyear()
{
my $this = shift;
$this->{-cyear}++;
$this->{-cyear} = 9999 if $this->{-cyear} > 9999;
$this->schedule_draw(1);
return $this;
}
sub date_prevmonth()
{
my $this = shift;
$this->{-cmonth}--;
if ($this->{-cmonth} < 1 and $this->{-cyear} > 0) {
$this->{-cmonth} = 12;
$this->{-cyear}--;
}
$this->schedule_draw(1);
return $this;
}
sub date_nextmonth()
{
my $this = shift;
$this->{-cmonth}++;
if ($this->{-cmonth} > 12 and $this->{-cyear} < 9999) {
$this->{-cmonth} = 1;
$this->{-cyear}++;
}
$this->schedule_draw(1);
return $this;
}
sub date_delta_days($;)
{
my $this = shift;
my $delta = shift;
if ($delta < 0)
{
my $startday = $this->{-cday};
$this->{-cday} += $delta;
if ($this->{-cday} < 1)
{
lib/Curses/UI/Calendar.pm view on Meta::CPAN
}
if ($this->{-cyear} == 1752 and $this->{-cmonth} == 9) {
if ($this->{-cday} > 2 and $this->{-cday} < 14) {
$this->{-cday} = ($delta > 0 ? 14 : 2);
}
}
$this->schedule_draw(1);
}
sub date_prevweek()
{
my $this = shift;
$this->date_delta_days(-7);
$this->schedule_draw(1);
return $this;
}
sub date_nextweek()
{
my $this = shift;
$this->date_delta_days(+7);
$this->schedule_draw(1);
return $this;
}
sub date_prevday()
{
my $this = shift;
$this->date_delta_days(-1);
$this->schedule_draw(1);
return $this;
}
sub date_nextday()
{
my $this = shift;
$this->date_delta_days(+1);
$this->schedule_draw(1);
return $this;
}
sub date_select()
{
my $this = shift;
$this->{-day} = $this->{-cday};
$this->{-month} = $this->{-cmonth};
$this->{-year} = $this->{-cyear};
$this->schedule_draw(1);
$this->run_event('-onchange');
return $this;
}
sub mouse_button($$$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
# Click in the day area?
if ($y > 3 and $y < 10)
{
my @month = build_month($this->{-cyear}, $this->{-cmonth});
lib/Curses/UI/Calendar.pm view on Meta::CPAN
$this->date_prevmonth;
}
$this->focus();
}
return $this;
}
sub get()
{
my $this = shift;
$this->make_sane_date();
return sprintf("%04d-%02d-%02d",
$this->{-year}, $this->{-month}, $this->{-day});
}
# ----------------------------------------------------------------------
# Date calculation
# ----------------------------------------------------------------------
my @days_in_month = (undef,31,28,31,30,31,30,31,31,30,31,30,31);
sub is_julian ($$;)
{
my ($year, $month) = @_;
return $year < 1752 or ($year == 1752 and $month <= 9);
}
sub day_of_week($$$;)
{
my $year = shift;
my $month = shift;
my $day = shift;
my $a = int( (14 - $month)/12 );
my $y = $year - $a;
my $m = $month + (12 * $a) - 2;
my $day_of_week;
if (is_julian($year, $month))
lib/Curses/UI/Calendar.pm view on Meta::CPAN
+ $y + int($y/4)
- int($y/100)
+ int($y/400)
+ int(31*$m/12)
) % 7;
}
return $day_of_week;
}
sub days_in_month($$;)
{
my $year = shift;
my $month = shift;
if($month == 2 and is_leap_year($year)) {
return 29;
} else {
return $days_in_month[$month];
}
}
sub is_leap_year($;)
{
my $year = shift;
if (is_julian($year,1)) {
return 1 if $year % 4 == 0;
} else {
return 1 if ($year % 4 == 0 and $year % 100 != 0)
or $year % 400 == 0;
}
return 0;
lib/Curses/UI/Checkbox.pm view on Meta::CPAN
=head1 STANDARD METHODS
layout draw intellidraw
focus onFocus onBlur
See L<Curses::UI::Widget|Curses::UI::Widget> for an explanation of
these.
=cut
sub event_onblur() {
my $this = shift;
$this->SUPER::event_onblur;
$this->{-focus} = 0;
$this->draw();
return $this;
}
sub layout() {
my $this = shift;
my $label = $this->getobj('label');
if (defined $label) {
my $lh = $label->{-height};
$lh = 1 if $lh <= 0;
$this->{-height} = $lh;
}
$this->SUPER::layout or return;
return $this;
}
sub draw(;$) {
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget.
$this->SUPER::draw(1) or return $this;
# Draw the checkbox.
if ($Curses::UI::color_support) {
my $co = $Curses::UI::color_object;
my $pair = $co->get_color_pair(
lib/Curses/UI/Checkbox.pm view on Meta::CPAN
=head1 WIDGET-SPECIFIC METHODS
=head2 get
Returns the current state of the checkbox (0 == unchecked, 1 ==
checked).
=cut
sub get() {
my $this = shift;
return $this->{-checked};
}
=head2 check
Sets the checkbox to "checked".
=cut
sub check() {
my $this = shift;
my $changed = ($this->{-checked} ? 0 : 1);
$this->{-checked} = 1;
if ($changed) {
$this->run_event('-onchange');
$this->schedule_draw(1);
}
return $this;
}
=head2 uncheck
Sets the checkbox to "unchecked".
=cut
sub uncheck() {
my $this = shift;
my $changed = ($this->{-checked} ? 1 : 0);
$this->{-checked} = 0;
if ($changed) {
$this->run_event('-onchange');
$this->schedule_draw(1);
}
return $this;
}
=head2 toggle
Flip-flops the checkbox to its "other" state. If the checkbox is
unchecked then it will become checked, and vice versa.
=cut
sub toggle() {
my $this = shift;
$this->{-checked} = ($this->{-checked} ? 0 : 1);
$this->run_event('-onchange');
$this->schedule_draw(1);
}
=head2 onChange
This method can be used to set the C<-onchange> event handler (see
above) after initialization of the checkbox. It expects a coderef as
its argument.
=cut
sub onChange(;$) { shift()->set_event('-onchange', shift()) }
sub mouse_button1($$$$;) {
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
$this->focus();
$this->toggle();
return $this;
}
lib/Curses/UI/Common.pm view on Meta::CPAN
split_to_lines
text_dimension
CUI_ESCAPE CUI_SPACE CUI_TAB
WORDWRAP NO_WORDWRAP
);
# ----------------------------------------------------------------------
# Misc. routines
# ----------------------------------------------------------------------
sub parent()
{
my $this = shift;
$this->{-parent};
}
sub root()
{
my $this = shift;
my $root = $this;
while (defined $root->{-parent}) {
$root = $root->{-parent};
}
return $root;
}
sub accessor($;$)
{
my $this = shift;
my $key = shift;
my $value = shift;
$this->{$key} = $value if defined $value;
return $this->{$key};
}
sub keys_to_lowercase($;)
{
my $hash = shift;
my $copy = {%$hash};
while (my ($k,$v) = each %$copy) {
$hash->{lc $k} = $v;
}
return $hash;
}
# ----------------------------------------------------------------------
# Text processing
# ----------------------------------------------------------------------
sub split_to_lines($;)
{
# Make $this->split_to_lines() possible.
shift if ref $_[0];
my $text = shift;
# Break up the text in lines. IHATEBUGS is
# because a split with /\n/ on "\n\n\n" would
# return zero result :-(
my @lines = split /\n/, $text . "IHATEBUGS";
$lines[-1] =~ s/IHATEBUGS$//g;
return \@lines;
}
sub scrlength($;)
{
# Make $this->scrlength() possible.
shift if ref $_[0];
my $line = shift;
return 0 unless defined $line;
my $scrlength = 0;
for (my $i=0; $i < length($line); $i++)
{
lib/Curses/UI/Common.pm view on Meta::CPAN
if ($chr eq "\t") {
while ($scrlength%8) {
$scrlength++;
}
}
}
return $scrlength;
}
# Contstants for text_wrap()
sub NO_WORDWRAP() { 1 }
sub WORDWRAP() { 0 }
sub text_wrap($$;)
{
# Make $this->text_wrap() possible.
shift if ref $_[0];
my ($line, $maxlen, $wordwrap) = @_;
$wordwrap = WORDWRAP unless defined $wordwrap;
$maxlen = int $maxlen;
return [""] if $line eq '';
my @wrapped = ();
lib/Curses/UI/Common.pm view on Meta::CPAN
$text = $';
}
else {
push(@tokens, $text);
last;
}
}
return @tokens;
}
sub text_draw($$;)
{
my $this = shift;
my ($y, $x, $text) = @_;
if ($this->{-htmltext}) {
my @tokens = &text_tokenize($text);
foreach my $token (@tokens) {
if ($token =~ m/^<(standout|reverse|bold|underline|blink|dim)>$/s) {
my $type = $1;
if ($type eq 'standout') { $this->{-canvasscr}->attron(A_STANDOUT); }
lib/Curses/UI/Common.pm view on Meta::CPAN
return ($width, $height);
}
# ----------------------------------------------------------------------
# Keyboard input
# ----------------------------------------------------------------------
# Constants:
# Keys that are not defined in curses.h, but which might come in handy.
sub CUI_ESCAPE() { "\x1b" }
sub CUI_TAB() { "\t" }
sub CUI_SPACE() { " " }
# Make ascii representation of a key.
sub key_to_ascii($;)
{
my $this = shift;
my $key = shift;
if ($key eq CUI_ESCAPE()) {
$key = '<Esc>';
}
# Control characters. Change them into something printable
# via Curses' unctrl function.
elsif ($key lt ' ' and $key ne "\n" and $key ne "\t") {
lib/Curses/UI/Common.pm view on Meta::CPAN
return $key;
}
# For the select() syscall in char_read().
my $rin = '';
my $fno = fileno(STDIN);
$fno = 0 unless $fno >= 0;
vec($rin, $fno , 1) = 1;
sub char_read(;$)
{
my $this = shift;
my $blocktime = shift;
# Initialize the toplevel window for
# reading a key.
my $s = $this->root->{-canvasscr};
noecho();
raw();
$s->keypad(1);
lib/Curses/UI/Common.pm view on Meta::CPAN
if ($found < 0 ) {
print STDERR "DEBUG: get_key() -> select() -> $!\n"
if $Curses::UI::debug;
} elsif ($found) {
$key = $s->getch();
}
return $key;
}
sub get_key(;$)
{
my $this = shift;
my $blocktime = shift || 0;
my $key = $this->char_read($blocktime);
# ------------------------------------ #
# Hacks for broken termcaps / curses #
# ------------------------------------ #
lib/Curses/UI/Container.pm view on Meta::CPAN
@ISA = qw(
Curses::UI::Widget
Curses::UI::Common
);
# ----------------------------------------------------------------------
# Public interface
# ----------------------------------------------------------------------
# Create a new Container object.
sub new()
{
my $class = shift;
my %userargs = @_;
keys_to_lowercase(\%userargs);
my %args = (
-releasefocus => 0, # Allows the focus to be released to parent on end
%userargs,
lib/Curses/UI/Container.pm view on Meta::CPAN
my $this = $class->SUPER::new(%args);
}
DESTROY()
{
my $this = shift;
$this->SUPER::delete_subwindows();
}
# Add an object to the container
sub add($@)
{
my $this = shift;
my $id = shift;
my $class = shift;
my %args = @_;
$this->root->fatalerror(
"The object id \"$id\" is already in use!"
) if defined $id and
defined $this->{-id2object}->{$id};
lib/Curses/UI/Container.pm view on Meta::CPAN
# last focus/draw). This can be overriden by the
# set_focusorder() and set_draworder() functions.
push @{$this->{-focusorder}}, $id;
unshift @{$this->{-draworder}}, $id;
# Return the created object.
return $object;
}
# Delete the contained object with id=$id from the Container.
sub delete(;$)
{
my $this = shift;
my $id = shift;
return $this unless defined $this->{-id2object}->{$id};
# Delete curses subwindows.
$this->{-id2object}->{$id}->delete_subwindows();
# Destroy object.
lib/Curses/UI/Container.pm view on Meta::CPAN
$new_focused_obj = $this->{-id2object}->{$new_focused_id}
if $new_focused_id;
$new_focused_obj->event_onfocus
if $new_focused_obj;
}
}
return $this;
}
sub delete_subwindows()
{
my $this = shift;
while (my ($id, $object) = each %{$this->{-id2object}}) {
$object->delete_subwindows();
}
$this->SUPER::delete_subwindows();
return $this;
}
# Draw the container and it's contained objects.
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the Widget.
$this->SUPER::draw(1) or return $this;
# Draw all contained object.
foreach my $id (@{$this->{-draworder}}) {
$this->{-id2object}->{$id}->draw(1);
}
# Update the screen unless suppressed.
doupdate() unless $no_doupdate;
return $this;
}
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
$this->layout_contained_objects();
return $this;
}
sub layout_contained_objects()
{
my $this = shift;
# Layout all contained objects.
foreach my $id (@{$this->{-draworder}})
{
my $obj = $this->{-id2object}->{$id};
$obj->{-parent} = $this;
$obj->layout();
$obj->draw();
}
return $this;
}
# Look if there are objects of a certain kind in the container.
sub hasa($;)
{
my $this = shift;
my $class = shift;
my $count = 0;
while (my ($id,$obj) = each %{$this->{-id2object}}) {
$count++ if ref $obj eq $class;
}
return $count;
}
sub window_is_ontop($;)
{
my $this = shift;
my $win = shift;
# If we have a stack of no windows, return immediately.
return undef if @{$this->{-draworder}} == 0;
my $topwin = $this->{-draworder}->[-1];
if (ref $win) { $topwin = $this->getobj($topwin) }
return $topwin eq $win;
}
sub event_keypress($;)
{
my $this = shift;
my $key = shift;
# Try to run the event on this widget. Return
# unless the binding returns 'DELEGATE' which
# means that this widget should try to delegate
# the event to its contained object which has
# the focus.
#
lib/Curses/UI/Container.pm view on Meta::CPAN
# Get the current focused object and send the
# keypress to it.
$obj = $this->getfocusobj;
if (defined $obj) {
return $obj->event_keypress($key);
} else {
return 'DELEGATE';
}
}
sub focus_prev()
{
my $this = shift;
# Return without doing anything if we do not
# have a focuslist.
return $this unless @{$this->{-focusorder}};
# Find the current focused object id.
my $id = $this->{-draworder}->[-1];
lib/Curses/UI/Container.pm view on Meta::CPAN
last if (defined $new_obj && $new_obj->focusable);
}
# Focus the previous object.
$this->focus($this->{-focusorder}->[$idx], undef, -1);
if ( $circle_flag && $this->{-releasefocus} ) {
$this->{-parent}->focus_prev;
}
}
sub focus_next()
{
my $this = shift;
# Return without doing anything if we do not
# have a focuslist.
return $this unless @{$this->{-focusorder}};
# Find the current focused object id.
my $id = $this->{-draworder}->[-1];
lib/Curses/UI/Container.pm view on Meta::CPAN
}
# Focus the next object.
$this->focus($this->{-focusorder}->[$idx], undef, +1);
#check if we have to release the focus
if ( $circle_flag && $this->{-releasefocus} ) {
$this->{-parent}->focus_next;
}
}
sub focus(;$$$)
{
my $this = shift;
my $focus_to = shift;
my $forced = shift || 0;
my $direction = shift || 1;
# The direction in which to look for other objects
# if this object is not focusable.
$direction = ($direction < 0 ? -1 : 1);
lib/Curses/UI/Container.pm view on Meta::CPAN
unless ($new_obj->{-has_modal_focus}) {
$cur_obj->event_onblur;
}
$new_obj->event_onfocus;
}
}
$this->SUPER::focus();
}
sub event_onfocus()
{
my $this = shift;
# Do an onfocus event for this object.
$this->SUPER::event_onfocus;
# If there is a focused object within this
# container and this container is not a
# container widget, then send an onfocus event to it.
unless ($this->isa('Curses::UI::ContainerWidget')) {
my $focused_object = $this->getfocusobj;
if (defined $focused_object) {
$focused_object->event_onfocus;
}
}
return $this;
}
sub event_onblur()
{
my $this = shift;
#If the Container loose it focus
#the current focused child must be unfocused
#get the id
my $id = $this->{-draworder}->[-1];
return unless $id;
lib/Curses/UI/Container.pm view on Meta::CPAN
#draw the widget without the focus
$obj->{-focus} = 0;
$obj->draw;
$this->SUPER::event_onblur();
return $this;
}
sub set_focusorder(@)
{
my $this = shift;
my @order = @_;
$this->{-focusorder} = \@order;
return $this;
}
sub set_draworder(@)
{
my $this = shift;
my @order = @_;
$this->{-draworder} = \@order;
return $this;
}
sub getobj($;)
{
my $this = shift;
my $id = shift;
return $this->{-id2object}->{$id};
}
sub getfocusobj()
{
my $this = shift;
my $id = $this->{-draworder}->[-1];
return (defined $id ? $this->getobj($id) : undef);
}
# ----------------------------------------------------------------------
# Private functions
# ----------------------------------------------------------------------
sub draworder_id2idx($;) {shift()->base_id2idx('-draworder' , shift())}
sub focusorder_id2idx($;) {shift()->base_id2idx('-focusorder', shift())}
sub base_id2idx($;)
{
my $this = shift;
my $param = shift;
my $id = shift;
my $idx;
my $i = 0;
foreach my $win_id (@{$this->{$param}})
{
if ($win_id eq $id) {
lib/Curses/UI/Dialog/Basic.pm view on Meta::CPAN
$Curses::UI::screen_too_small = $remember;
$this->layout;
# Set the initial focus to the buttons.
$b->focus;
return bless $this, $class;
}
# TODO delete_curses_windows
sub layout()
{
my $this = shift;
return $this if $Curses::UI::screen_too_small;
# The maximum available space on the screen.
my $avail_width = $ENV{COLS};
my $avail_height = $ENV{LINES};
# Compute the maximum available space for the message.
lib/Curses/UI/Dialog/Basic.pm view on Meta::CPAN
$h += $this->{-ipadtop} + $this->{-ipadbottom};
$this->{-width} = $w;
$this->{-height} = $h;
$this->SUPER::layout;
return $this;
}
sub get()
{
my $this = shift;
$this->getobj('buttons')->get;
}
1;
=pod
lib/Curses/UI/Dialog/Calendar.pm view on Meta::CPAN
my $this = shift;
$this->{-selected_date} = undef;
$this->loose_focus;
}, CUI_ESCAPE());
$this->layout();
return bless $this, $class;
}
sub layout()
{
my $this = shift;
my $cal = $this->getobj('calendar');
if ($cal) {
$this->{-width} = width_by_windowscrwidth(
$this->getobj('calendar')->{-width}, %$this);
$this->{-height} = height_by_windowscrheight(
$this->getobj('calendar')->{-height}, %$this);
}
$this->SUPER::layout() or return;
return $this;
}
sub get()
{
my $this = shift;
return $this->{-selected_date};
}
sub press_button_callback()
{
my $buttons = shift;
my $this = $buttons->parent;
my $ok_pressed = $buttons->get;
if ($ok_pressed)
{
$this->{-selected_date} = $this->getobj('calendar')->get;
} else {
$this->{-selected_date} = undef;
lib/Curses/UI/Dialog/Dirbrowser.pm view on Meta::CPAN
$this->getobj('buttons')->{-selected} = 1;
$this->loose_focus;
}, CUI_ESCAPE);
$this->layout();
$this->get_dir;
return bless $this, $class;
}
sub layout()
{
my $this = shift;
my $w = 50;
my $h = 18;
$this->{-width} = $w,
$this->{-height} = $h,
$this->SUPER::layout() or return;
return $this;
}
sub get_dir()
{
my $this = shift;
# Get pathvalue, filevalue, dirbrowser and filebrowser objects.
my $pv = $this->getobj('pathvalue');
my $db = $this->getobj('dirbrowser');
my $path = $pv->text;
# Resolve path.
lib/Curses/UI/Dialog/Dirbrowser.pm view on Meta::CPAN
$db->values(\@dirs);
$db->{-ypos} = $this->{-selected_cache}->{$path};
$db->{-ypos} = 0 unless defined $db->{-ypos};
$db->{-selected} = undef;
$db->layout_content->draw(1);
return $this;
}
# Set $this->{-path} to the homedirectory of the current user.
sub goto_homedirectory()
{
my $this = shift;
my @pw = getpwuid($>);
if (@pw) {
if (-d $pw[7]) {
$this->{-path} = $pw[7];
} else {
$this->{-path} = '/';
$this->root->error("Homedirectory $pw[7] not found");
lib/Curses/UI/Dialog/Dirbrowser.pm view on Meta::CPAN
}
} else {
$this->{-path} = '/';
$this->root->error("Can't find a passwd entry for uid $>");
return;
}
return $this;
}
sub select_homedirectory()
{
my $b = shift; # dir-/filebrowser
my $this = $b->parent;
my $pv = $this->getobj('pathvalue');
$this->goto_homedirectory or return $b;
$pv->text($this->{-path});
$this->get_dir;
return $b;
}
sub dirselect()
{
my $db = shift; # dirbrowser
my $this = $db->parent;
my $pv = $this->getobj('pathvalue');
# Find the new path.
my $add = $db->values->[$db->{-ypos}];
my $savepath = $pv->text;
$this->{-selected_cache}->{$savepath} = $db->{-ypos};
$pv->text("/$savepath/$add");
# Get the selected directory.
unless ($this->get_dir) {
$pv->text($savepath);
}
return $db;
}
sub maskbox_onchange()
{
my $maskbox = shift;
my $this = $maskbox->parent;
$this->{-activemask} = $maskbox->get;
$this->get_dir;
return $maskbox;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw Window
$this->SUPER::draw(1) or return $this;
$this->{-canvasscr}->noutrefresh();
doupdate() unless $no_doupdate;
return $this;
}
sub get()
{
my $this = shift;
if ($this->getobj('buttons')->get) {
my $file = $this->getobj('pathvalue')->get;
$file =~ s|/+|/|g;
return $file;
} else {
return;
}
}
sub press_button_callback()
{
my $buttons = shift;
my $this = $buttons->parent;
my $file = $this->get;
my $ok_pressed = $buttons->get;
if ($ok_pressed and $file =~ m|/$|) {
my $l = $this->root->lang;
$this->root->error($l->get('file_err_nofileselected'));
return;
lib/Curses/UI/Dialog/Error.pm view on Meta::CPAN
my $this = $class->SUPER::new(%args);
unless (defined $this->{-title}) {
my $l = $this->root->lang;
$this->title($l->get('error_title'));
}
bless $this, $class;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw widget
$this->SUPER::draw(1) or return $this;
# Draw sign
$this->{-borderscr}->addstr(2, 1, " _");
$this->{-borderscr}->addstr(3, 1, " / \\");
lib/Curses/UI/Dialog/Filebrowser.pm view on Meta::CPAN
if ($this->{-editfilename}) {
$this->getobj('filevalue')->focus;
} else {
$this->getobj('filebrowser')->focus;
}
return bless $this, $class;
}
sub layout()
{
my $this = shift;
my $w = 60;
my $h = 18;
$h += 2 if defined $this->{-mask};
$this->{-width} = $w,
$this->{-height} = $h,
$this->SUPER::layout() or return;
return $this;
}
sub get_dir()
{
my $this = shift;
# Get pathvalue, filevalue, dirbrowser and filebrowser objects.
my $pv = $this->getobj('pathvalue');
my $db = $this->getobj('dirbrowser');
my $fb = $this->getobj('filebrowser');
my $path = $pv->text;
lib/Curses/UI/Dialog/Filebrowser.pm view on Meta::CPAN
$db->layout_content->draw(1);
$fb->values(\@files);
$fb->{-ypos} = $fb->{-yscrpos} = 0;
$fb->layout_content->draw(1);
return $this;
}
# Set $this->{-path} to the homedirectory of the current user.
sub goto_homedirectory()
{
my $this = shift;
my @pw = getpwuid($>);
if (@pw) {
if (-d $pw[7]) {
$this->{-path} = $pw[7];
} else {
$this->{-path} = '/';
$this->root->error("Homedirectory $pw[7] not found");
lib/Curses/UI/Dialog/Filebrowser.pm view on Meta::CPAN
}
} else {
$this->{-path} = '/';
$this->root->error("Can't find a passwd entry for uid $>");
return;
}
return $this;
}
sub select_homedirectory()
{
my $b = shift; # dir-/filebrowser
my $this = $b->parent;
my $pv = $this->getobj('pathvalue');
$this->goto_homedirectory or return $b;
$pv->text($this->{-path});
$this->get_dir;
return $b;
}
sub dirselect()
{
my $db = shift; # dirbrowser
my $this = $db->parent;
my $fv = $this->getobj('filevalue');
my $pv = $this->getobj('pathvalue');
# Find the new path.
my $add = $db->values->[$db->{-ypos}];
my $savepath = $pv->text;
$this->{-selected_cache}->{$savepath} = $db->{-ypos};
lib/Curses/UI/Dialog/Filebrowser.pm view on Meta::CPAN
$fv->text('') unless $this->{-editfilename};
# Get the selected directory.
unless ($this->get_dir) {
$pv->text($savepath);
}
return $db;
}
sub fileselect()
{
my $filebrowser = shift;
my $this = $filebrowser->parent;
my $selected = $filebrowser->{-ypos};
my $file = $filebrowser->values->[$selected];
if (defined $file) {
$this->{-file} = $file;
$this->getobj('filevalue')->text($file);
}
# TODO: find out if it is done by mouseclick. If yes, then do
# not change focus.
# Doubleclick may also select the file.
# $this->getobj('buttons')->focus;
}
sub maskbox_onchange()
{
my $maskbox = shift;
my $this = $maskbox->parent;
$this->{-activemask} = $maskbox->get;
$this->get_dir;
return $maskbox;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw Window
$this->SUPER::draw(1) or return $this;
$this->{-canvasscr}->noutrefresh();
doupdate() unless $no_doupdate;
return $this;
}
sub get()
{
my $this = shift;
if ($this->getobj('buttons')->get) {
my $file = $this->getobj('pathvalue')->get
. "/"
. $this->getobj('filevalue')->get;
$file =~ s|/+|/|g;
return $file;
} else {
return;
}
}
sub press_button_callback()
{
my $buttons = shift;
my $this = $buttons->parent;
my $file = $this->get;
my $ok_pressed = $buttons->get;
if ($ok_pressed and $file =~ m|/$|) {
my $l = $this->root->lang;
$this->root->error($l->get('file_err_nofileselected'));
return;
lib/Curses/UI/Dialog/Progress.pm view on Meta::CPAN
%pb_args,
-intellidraw => 0,
);
$this->layout();
bless $this, $class;
}
# There is no need to focus a progress dialog
sub focus() {} ;
sub layout()
{
my $this = shift;
if (not defined $this->{-height}
and defined $this->getobj('progressbar'))
{
# Space between progressbar and message.
my $need = ($this->{-nomessage} ? 0 : 1);
# The height for the message.
lib/Curses/UI/Dialog/Progress.pm view on Meta::CPAN
my $height = $this->height_by_windowscrheight($need, %$this);
$this->{-height} = $height;
}
$this->SUPER::layout or return;
return $this;
}
sub pos($;)
{
my $this = shift;
my $pos = shift;
$this->getobj('progressbar')->pos($pos);
return $this;
}
sub message()
{
my $this = shift;
return $this if $this->{-nomessage};
my $msg = shift;
$this->getobj('label')->text($msg);
return $this;
}
1;
lib/Curses/UI/Dialog/Question.pm view on Meta::CPAN
$Curses::UI::screen_too_small = $remember;
$this->layout;
# Set the initial focus to the answer box.
$a->focus;
return bless $this, $class;
}
# TODO delete_curses_windows
sub layout()
{
my $this = shift;
return $this if $Curses::UI::screen_too_small;
# The maximum available space on the screen.
my $avail_width = $ENV{COLS};
my $avail_height = $ENV{LINES};
# Compute the maximum available space for the message.
lib/Curses/UI/Dialog/Question.pm view on Meta::CPAN
$h += $this->{-ipadtop} + $this->{-ipadbottom};
$this->{-width} = $w;
$this->{-height} = $h;
$this->SUPER::layout;
return $this;
}
sub get()
{
my $this = shift;
return undef if $this->{-cancelled};
$this->getobj('answer')->get;
}
1;
lib/Curses/UI/Dialog/Status.pm view on Meta::CPAN
-fg => $this->{-fg},
-bg => $this->{-bg},
);
$this->layout();
bless $this, $class;
}
# There is no need to focus a status dialog
sub focus() {} ;
sub layout()
{
my $this = shift;
my $label = $this->getobj('label');
# The label might not be added at this point.
if (defined $label)
{
# Compute the width the dialog window needs.
if (not defined $this->{-width})
lib/Curses/UI/Dialog/Status.pm view on Meta::CPAN
);
}
}
$this->SUPER::layout or return;
return $this;
}
sub message($;)
{
my $this = shift;
my $message = shift;
$message = 'no message' unless defined $message;
$this->getobj('label')->text($message);
return $this;
}
1;
lib/Curses/UI/Label.pm view on Meta::CPAN
$args{-text} = '' unless defined $args{-text};
# Create the widget.
my $this = $class->SUPER::new( %args );
$this->layout();
return $this;
}
sub layout()
{
my $this = shift;
$this->SUPER::layout or return;
return $this;
}
sub bold ($;$) { shift()->set_attribute('-bold', shift()) }
sub reverse ($;$) { shift()->set_attribute('-reverse', shift()) }
sub underline ($;$) { shift()->set_attribute('-underline', shift()) }
sub dim ($;$) { shift()->set_attribute('-dim', shift()) }
sub blink ($;$) { shift()->set_attribute('-blink', shift()) }
sub set_attribute($$;)
{
my $this = shift;
my $attribute = shift;
my $value = shift || 0;
$this->{$attribute} = $value;
$this->intellidraw;
return $this;
}
sub text($;$)
{
my $this = shift;
my $text = shift;
if (defined $text)
{
$this->{-text} = $text;
$this->intellidraw;
return $this;
} else {
return $this->{-text};
}
}
sub get() { shift()->text }
sub textalignment($;)
{
my $this = shift;
my $value = shift;
$this->{-textalignment} = $value;
$this->intellidraw;
return $this;
}
sub compute_xpos()
{
my $this = shift;
my $line = shift;
# Compute the x location of the text.
my $xpos = 0;
if (defined $this->{-textalignment})
{
if ($this->{-textalignment} eq 'right') {
$xpos = $this->canvaswidth - length($line);
} elsif ($this->{-textalignment} eq 'middle') {
$xpos = int (($this->canvaswidth-length($line))/2);
}
}
$xpos = 0 if $xpos < 0;
return $xpos;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget.
$this->SUPER::draw(1) or return $this;
# Clear all attributes.
$this->{-canvasscr}->attroff(A_REVERSE);
$this->{-canvasscr}->attroff(A_BOLD);
lib/Curses/UI/Language.pm view on Meta::CPAN
'no' => 'norwegian',
'es' => 'spanish',
'tr' => 'tukish',
'cn' => 'chinese',
);
sub new()
{
my $class = shift;
my $lang = shift;
my $this = {
-tags => {},
-lang => undef,
};
bless $this, $class;
# Load english tags so these can be used
# as a fallback for other languages.
$this->loadlanguage('english');
# Load the wanted language.
$this->loadlanguage($lang);
return $this;
}
sub loadlanguage($;)
{
my $this = shift;
my $lang = shift;
# Construct the language module to use.
$lang = $default_lang unless defined $lang;
$lang =~ s/[^\w\_]//g;
$lang = lc $lang;
$lang = $lang_alias{$lang} if defined $lang_alias{$lang};
lib/Curses/UI/Language.pm view on Meta::CPAN
}
elsif (!m/^\s*$/) {
warn "$l_file, line $.: found data outside tag block\n";
}
}
$this->store($tag, $block);
close(LANG_DATA);
}
sub store($$;)
{
my $this = shift;
my $tag = shift;
my $block = shift;
return $this unless defined $tag;
# Remove empty start- and endlines.
my @block = split /\n/, $block;
while (@block and $block[0] =~ /^\s*$/) { shift @block }
while (@block and $block[-1] =~ /^\s*$/) { pop @block }
$this->{-tags}->{lc $tag} = join "\n", @block;
return $this;
}
sub get($;)
{
my $this = shift;
my $tag = shift;
my $block = $this->{-tags}->{$tag};
unless (defined $block) {
warn "get(): no language block for tag '$tag'";
$block = '';
}
return $block;
}
sub getarray($;)
{
my $this = shift;
my $tag = shift;
my $block = $this->get($tag);
return () unless defined $block;
$block =~ s/\n/ /g;
return split " ", $block;
}
lib/Curses/UI/Listbox.pm view on Meta::CPAN
$this->layout_content();
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding('mouse-button1', BUTTON1_CLICKED());
$this->set_mouse_binding('mouse-button1', BUTTON1_DOUBLE_CLICKED());
}
return $this;
}
sub onChange(;$) { shift()->set_event('-onchange', shift()) }
sub onSelectionChange(;$) { shift()->set_event('-onselchange', shift()) };
sub values(;$)
{
my $this = shift;
my $values = shift;
if (defined $values && ! ref $values) {
$values = [ $values, @_ ];
}
if (defined $values and ref $values eq 'ARRAY') {
# Clear and go to first item if we get new data
lib/Curses/UI/Listbox.pm view on Meta::CPAN
$this->option_first() if defined $values;
# Make this widget non-focusable if there are
# no values in it.
$this->focusable(scalar(@{$values}));
}
return $this->{-values}
}
sub insert_at()
{
my $this = shift;
my $pos = shift;
my $values = shift;
# Clear and go to first item if we get new data
$this->clear_selection();
if (defined $values ) {
lib/Curses/UI/Listbox.pm view on Meta::CPAN
@{$this->{-values}});
$this->{-values} = \@newdata;
}
}
return $this->{-values};
}
sub labels(;$)
{
my $this = shift;
my $labels = shift;
if (defined $labels and ref $labels eq 'HASH') {
$this->{-labels} = $labels;
}
return $this->{-labels}
}
sub add_labels(;$)
{
my $this = shift;
my $labels = shift;
if (defined $labels and ref $labels eq 'HASH') {
map $this->{-labels}->{$_} = $labels->{$_}, keys %{$labels};
}
return $this->{-labels}
}
sub maxlabelwidth(@)
{
my %args = @_;
my $maxwidth = 0;
foreach my $value (@{$args{-values}})
{
my $label = $value;
$label = $args{-labels}->{$value}
if defined $args{-labels}->{$value};
$maxwidth = length($label)
if length($label) > $maxwidth;
}
return $maxwidth;
}
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
$this->layout_content;
# Scroll up if we can and the number of visible lines
# is smaller than the number of available lines in the screen.
my $inscreen = ($this->canvasheight
- ($this->number_of_lines - $this->{-yscrpos}));
while ($this->{-yscrpos} > 0 and $inscreen < $this->canvasheight)
{
$this->{-yscrpos}--;
$inscreen = ($this->canvasheight
- ($this->number_of_lines - $this->{-yscrpos}));
}
return $this;
}
sub layout_content()
{
my $this = shift;
return $this if $Curses::UI::screen_too_small;
# Check bounds for -ypos index.
$this->{-max_selected} = @{$this->{-values}} - 1;
$this->{-ypos} = $this->{-max_selected}
if $this->{-ypos} > $this->{-max_selected};
$this->{-ypos} = 0 if $this->{-ypos} < 0;
lib/Curses/UI/Listbox.pm view on Meta::CPAN
$this->{-vscrolllen} = @{$this->{-values}};
$this->{-vscrollpos} = $this->{-yscrpos};
if ( @{$this->{-values}} <= $this->canvasheight) {
undef $this->{-vscrolllen};
}
return $this;
}
sub getlabel($;)
{
my $this = shift;
my $idx = shift || 0;
my $value = $this->{-values}->[$idx];
my $label = $value;
$label = $this->{-labels}->{$label}
if defined $this->{-labels}->{$label};
$label =~ s/\t/ /g; # do not show TABs
return $label;
}
sub get_active_value($;)
{
my $this = shift;
my $id = $this->{-ypos};
my $value = $this->{'-values'}->[$id];
return $value;
}
sub get_active_id($;)
{
my $this = shift;
return $this->{-ypos};;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget
$this->SUPER::draw(1) or return $this;
$this->layout_content;
# Let there be color
lib/Curses/UI/Listbox.pm view on Meta::CPAN
$cursor_x = 1 if $this->{-multi} or $this->{-radio};
$this->{-canvasscr}->move($cursor_y, $cursor_x);
}
$this->{-canvasscr}->noutrefresh();
doupdate() unless $no_doupdate;
return $this;
}
sub option_last()
{
my $this = shift;
$this->{-ypos} = $this->{-max_selected};
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub option_nextpage()
{
my $this = shift;
if ($this->{-ypos} >= $this->{-max_selected}) {
$this->dobeep;
return $this;
}
if ($this->{-ypos} + $this->canvasheight - 1 >= $this->{-max_selected}) {
$this->{-ypos} = $this->{-max_selected};
} else {
$this->{-ypos} += $this->canvasheight - 1;
}
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub option_prevpage()
{
my $this = shift;
if ($this->{-ypos} <= 0) {
$this->dobeep;
return $this;
}
if ($this->{-ypos} - $this->canvasheight - 1 < 0) {
$this->{-ypos} = 0;
} else {
$this->{-ypos} -= $this->canvasheight - 1;
}
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub clear_selection()
{
my $this = shift;
if ($this->{-multi}) {
my $selection = $this->{-selected};
return unless defined $selection;
foreach my $id (keys %$selection) {
$selection->{$id} = 0;
}
} else {
$this->{-selected} = undef;
}
$this->schedule_draw(1);
}
sub set_selection()
{
my $this = shift;
my $id;
foreach $id (@_) {
next if $id > @{$this->{-values}};
if ($this->{-multi})
{
my $changed = ($this->{-selected}->{$id} ? 0 : 1);
$this->{-selected}->{$id} = 1;
lib/Curses/UI/Listbox.pm view on Meta::CPAN
my $changed = (not defined $this->{-selected} or
($this->{-selected} != $id));
$this->{-selected} = $id;
$this->run_event('-onchange') if $changed;
$this->schedule_draw(1);
}
}
return $this;
}
sub option_next()
{
my $this = shift;
if ($this->{-ypos} >= $this->{-max_selected}) {
if ($this->{-wraparound}) {
$this->{-ypos} = 0;
} else {
$this->dobeep;
}
} else {
$this->{-ypos}++;
}
$this->layout_content;
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub option_prev()
{
my $this = shift;
if ($this->{-ypos} <= 0) {
if ($this->{-wraparound}) {
$this->{-ypos} = $this->{-max_selected};
} else {
$this->dobeep;
}
} else {
$this->{-ypos}--;
}
$this->layout_content;
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub option_select()
{
my $this = shift;
if ($this->{-multi})
{
$this->{-selected}->{$this->{-ypos}} =
!$this->{-selected}->{$this->{-ypos}};
$this->run_event('-onselchange');
$this->run_event('-onchange');
$this->schedule_draw(1);
lib/Curses/UI/Listbox.pm view on Meta::CPAN
my $changed = (not defined $this->{-selected} or
($this->{-selected} != $this->{-ypos}));
$this->{-selected} = $this->{-ypos};
$this->run_event('-onselchange')if $changed;
$this->run_event('-onchange') if $changed;
$this->schedule_draw(1);
return ($this->{-radio} ? $this : 'LOOSE_FOCUS');
}
}
sub option_first()
{
my $this = shift;
$this->{-ypos} = 0;
$this->run_event('-onselchange');
$this->schedule_draw(1);
return $this;
}
sub option_check()
{
my $this = shift;
if ($this->{-multi})
{
my $changed = ($this->{-selected}->{$this->{-ypos}} ? 0 : 1);
$this->{-selected}->{$this->{-ypos}} = 1;
$this->{-ypos}++;
$this->run_event('-onchange') if $changed;
$this->schedule_draw(1);
lib/Curses/UI/Listbox.pm view on Meta::CPAN
} else {
my $changed = (not defined $this->{-selected} or
($this->{-selected} != $this->{-ypos}));
$this->{-selected} = $this->{-ypos};
$this->run_event('-onchange') if $changed;
$this->schedule_draw(1);
return ($this->{-radio} ? $this : undef);
}
}
sub option_uncheck()
{
my $this = shift;
if ($this->{-multi})
{
my $changed = ($this->{-selected}->{$this->{-ypos}} ? 1 : 0);
$this->{-selected}->{$this->{-ypos}} = 0;
$this->run_event('-onchange') if $changed;
$this->{-ypos}++;
} else {
$this->dobeep;
}
$this->schedule_draw(1);
return $this;
}
sub mouse_button1($$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
return unless $this->{-focusable};
$this->layout_content;
lib/Curses/UI/Listbox.pm view on Meta::CPAN
my $newypos = $this->{-yscrpos} + $y;
if (@{$this->{-values}} and
$newypos >= 0 and $newypos < @{$this->{-values}}) {
$this->{-ypos} = $newypos;
$this->do_routine('option-select');
}
$this->schedule_draw(1);
}
sub get()
{
my $this = shift;
return unless defined $this->{-selected};
if ($this->{-multi}) {
my @values = ();
while (my ($id, $val) = each %{$this->{-selected}}) {
next unless $val;
push @values, $this->{-values}->[$id];
}
return @values;
} else {
return $this->{-values}->[$this->{-selected}];
}
}
sub id()
{
my $this = shift;
return unless defined $this->{-selected};
if ($this->{-multi}) {
my @values = ();
while (my ($id, $val) = each %{$this->{-selected}}) {
next unless $val;
push @values, $id;
}
return @values;
} else {
return $this->{-selected};
}
}
sub get_selectedlabel()
{
my $this = shift;
my $value = $this->get;
return unless defined $value;
my $label = $this->{-labels}->{$value};
return (defined $label ? $label : $value);
}
sub set_color_fg {
my $this = shift;
lib/Curses/UI/Listbox.pm view on Meta::CPAN
my $this = shift;
$this->{-bg} = shift;
$this->intellidraw;
}
# ----------------------------------------------------------------------
# Routines for search support
# ----------------------------------------------------------------------
sub number_of_lines() { @{shift()->{-values}} }
sub getline_at_ypos($;) { shift()->getlabel(shift()) }
1;
=pod
=head1 NAME
Curses::UI::Listbox - Create and manipulate listbox widgets
lib/Curses/UI/Menubar.pm view on Meta::CPAN
);
$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
lib/Curses/UI/Menubar.pm view on Meta::CPAN
$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})
{
lib/Curses/UI/Menubar.pm view on Meta::CPAN
# 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;
}
lib/Curses/UI/Menubar.pm view on Meta::CPAN
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};
lib/Curses/UI/Menubar.pm view on Meta::CPAN
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
lib/Curses/UI/Menubar.pm view on Meta::CPAN
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)
lib/Curses/UI/Menubar.pm view on Meta::CPAN
}
}
# 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};
lib/Curses/UI/Menubar.pm view on Meta::CPAN
$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
lib/Curses/UI/Notebook.pm view on Meta::CPAN
"\cA" => 'goto_first_page',
KEY_END() => 'goto_last_page',
"\cE" => 'goto_last_page',
KEY_NPAGE() => 'goto_next_page',
"\cN" => 'goto_next_page',
KEY_PPAGE() => 'goto_prev_page',
"\cP" => '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',
lib/Curses/UI/Notebook.pm view on Meta::CPAN
my $this = $class->SUPER::new(%args);
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding(\&mouse_button1, BUTTON1_CLICKED());
}
@{$this->{-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.
lib/Curses/UI/Notebook.pm view on Meta::CPAN
unless (defined $this->{-borderscr}) {
$this->{-bh} = $this->{-sh};
$this->{-bw} = $this->{-sw};
$this->{-by} = $this->{-sy};
$this->{-bx} = $this->{-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->hidden;
return if $Curses::UI::screen_too_small;
lib/Curses/UI/Notebook.pm view on Meta::CPAN
# Draw active window.
$this->getobj($active_page)->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->{-intellidraw} and !$this->hidden) {
# Check if parent window has modal focus or is on top of focus path.
my $parent = $this->parentwindow;
debug_msg " parent window = " . $parent;
my @path = $this->root->focus_path;
debug_msg " focus_path " . join(" & ", @path);
lib/Curses/UI/Notebook.pm view on Meta::CPAN
$this->draw if (
$parent->{-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->root->fatalerror("The notebook already has a page named '$page'!")
if (defined $this->{-id2object}->{$page});
# Make sure the page does not cause the 'tabs' window to overflow.
lib/Curses/UI/Notebook.pm view on Meta::CPAN
# we need to adjust them manually.
my $active_page = $this->active_page;
$this->set_draworder($active_page);
$this->set_focusorder($active_page);
}
return $this->getobj($page);
}
sub delete_page($$) {
debug_msg;
my $this = shift;
my $page = shift or return;
# Make sure page is part of the notebook.
$this->root->fatalerror("The notebook widget does not have a page named '$page'!")
unless (defined $this->{-id2object}->{$page});
debug_msg " deleting '$page' page";
lib/Curses/UI/Notebook.pm view on Meta::CPAN
my $active_page = $this->active_page;
@{$this->{-pages}} = grep($page ne $_, @{$this->{-pages}});
$this->activate_page($this->first_page) if ($page eq $active_page);
$this->SUPER::DESTROY($page);
return;
}
sub active_page($) {
debug_msg;
my $this = shift;
return unless (@{$this->{-pages}});
my $page = defined $this->{-active_page} ?
$this->{-active_page} :
($this->{-active_page} = '');
debug_msg " active page = '$page'";
return $page;
}
sub first_page($) {
debug_msg;
my $this = shift;
return unless (@{$this->{-pages}});
my $page = ${$this->{-pages}}[0];
debug_msg " first page = '$page'";
return $page;
}
sub last_page($) {
debug_msg;
my $this = shift;
return unless (@{$this->{-pages}});
my $page = ${$this->{-pages}}[$#{$this->{-pages}}];
debug_msg " last page = '$page'";
return $page;
}
sub prev_page($) {
debug_msg;
my $this = shift;
return unless (@{$this->{-pages}});
my $active_page = $this->active_page;
my $i = scalar(@{$this->{-pages}});
while (--$i >= 0) {
last if ($active_page eq ${$this->{-pages}}[$i]);
}
return if ($i < 0);
lib/Curses/UI/Notebook.pm view on Meta::CPAN
$i-1 :
$this->{-wraparound} ?
$#{$this->{-pages}} :
0;
my $page = ${$this->{-pages}}[$i];
debug_msg " prev page = '$page'";
return $page;
}
sub next_page($) {
debug_msg;
my $this = shift;
return unless (@{$this->{-pages}});
my $active_page = $this->active_page;
my $i = scalar(@{$this->{-pages}});
while (--$i >= 0) {
last if ($active_page eq ${$this->{-pages}}[$i]);
}
return if ($i < 0);
lib/Curses/UI/Notebook.pm view on Meta::CPAN
$i+1 :
$this->{-wraparound} ?
0 :
$#{$this->{-pages}};
my $page = ${$this->{-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->root->fatalerror("The notebook widget does not have a page named '$page'!")
unless (defined $this->{-id2object}->{$page});
my $active_page = $this->active_page;
debug_msg " old active page = '$active_page'";
lib/Curses/UI/Notebook.pm view on Meta::CPAN
$this->set_draworder($active_page);
$this->set_focusorder($active_page);
# Redraw the notebook widget only if in curses mode.
$this->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->{-x};
my $ev_y = $event->{-y};
debug_msg " mouse click at ($ev_x,$ev_y)";
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
@ISA
);
$VERSION = '1.0011';
@ISA = qw(
Curses::UI::Listbox
Curses::UI::Window
);
sub new()
{
my $class = shift;
my $this = $class->SUPER::new(@_);
# Do own option_select() method.
$this->set_routine('option-select', \&option_select);
return $this;
}
sub option_select()
{
my $this = shift;
$this->SUPER::option_select();
$this->loose_focus;
return $this;
}
# Let Curses::UI->usemodule() believe that this module
# was already loaded (usemodule() would else try to
# require the non-existing file).
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
$this->layout;
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding('mouse-button1', BUTTON1_CLICKED());
}
return $this;
}
sub onChange(;$) { shift()->set_event('-onchange', shift()) }
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
# Compute the location and length of the listbox.
my $ll = height_by_windowscrheight(@{$this->{-values}}, -border=>1);
my $lx = $this->{-x} + $this->{-parent}->{-sx};
my $ly = $this->{-y} + $this->{-parent}->{-sy} + 1;
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
# Store the listbox layout setup for later use.
$this->{-listbox}->{-x} = $lx;
$this->{-listbox}->{-y} = $ly;
$this->{-listbox}->{-width} = $this->width;
$this->{-listbox}->{-height} = $ll;
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget.
$this->SUPER::draw(1) or return $this;
# Get the selected label.
my $sellabel;
if (defined $this->{-selected})
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
$this->{-canvasscr}->move(0,$this->canvaswidth-1);
$this->{-canvasscr}->attroff(A_DIM);
$this->{-canvasscr}->attroff(A_REVERSE);
$this->{-canvasscr}->noutrefresh;
doupdate() unless $no_doupdate;;
return $this;
}
sub open_popup()
{
my $this = shift;
my $pre_value = $this->get;
my %listbox_options = %{$this->{-listbox}};
foreach my $option (qw(
-values -labels
-selected -wraparound
)) {
$listbox_options{$option} = $this->{$option}
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
$pre_value ne $post_value)) {
$this->run_event('-onchange');
}
$this->root->delete($id);
$this->root->draw;
return $this;
}
sub get()
{
my $this = shift;
my $value;
if (defined $this->{-selected}) {
$value = $this->{-values}->[$this->{-selected}];
}
return $value;
}
sub select_next()
{
my $this = shift;
my $pre_value = $this->get;
if (defined $this->{-selected}) {
$this->{-selected}++;
if ( $this->{-selected} > (@{$this->{-values}}-1) ) {
$this->{-selected} = @{$this->{-values}} - 1;
}
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
if ((not defined $pre_value and defined $post_value) or
(defined $pre_value and $pre_value ne $post_value)) {
$this->run_event('-onchange');
}
$this->schedule_draw(1);
return $this;
}
sub select_prev()
{
my $this = shift;
my $pre_value = $this->get;
if (defined $this->{-selected}) {
$this->{-selected}--;
$this->{-selected} = 0 if $this->{-selected} <= 0;
} else {
$this->{-selected} = @{$this->{-values}} - 1;
lib/Curses/UI/Popupmenu.pm view on Meta::CPAN
if ((not defined $pre_value and defined $post_value) or
(defined $pre_value and $pre_value ne $post_value)) {
$this->run_event('-onchange');
}
$this->schedule_draw(1);
return $this;
}
sub mouse_button1($$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
unless ($this->{-focus}) {
$this->focus;
}
$this->open_popup;
lib/Curses/UI/Progressbar.pm view on Meta::CPAN
$args{-max} = $tmp;
}
my $height = height_by_windowscrheight(1, %args);
$args{-height} = $height;
my $this = $class->SUPER::new( %args );
return $this;
}
sub get()
{
my $this = shift;
return $this->{-pos};
}
sub pos(;$)
{
my $this = shift;
my $pos = shift || 0;
$this->{-pos} = $pos;
$this->intellidraw;
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Draw the widget
$this->SUPER::draw(1) or return $this;
# Check bounds for the position.
$this->{-pos} = $this->{-max} if $this->{-pos} > $this->{-max};
$this->{-pos} = $this->{-min} if $this->{-pos} < $this->{-min};
lib/Curses/UI/Searchable.pm view on Meta::CPAN
$VERSION
@ISA
);
$VERSION = "1.10";
@ISA = qw(
Curses::UI::ContainerWidget
);
sub new()
{
my $class = shift;
my %userargs = @_;
keys_to_lowercase(\%userargs);
my %args = (
-prompt => '/', # The initial search prompt
%userargs,
lib/Curses/UI/Searchable.pm view on Meta::CPAN
-intellidraw => 0,
);
$entry->set_routine('loose-focus', \&entry_loose_focus);
$this->layout;
return $this;
}
sub entry_loose_focus()
{
my $this = shift;
$this->parent->loose_focus;
}
sub event_keypress($;)
{
my $this = shift;
my $key = shift;
my $entry = $this->getobj('entry');
if ($entry->{-focus}) {
$this->getobj('entry')->event_keypress($key);
} else {
$this->{-key} = $key;
}
return $this;
}
sub get()
{
my $this = shift;
$this->getobj('entry')->get;
}
sub pos(;$)
{
my $this = shift;
my $pos = shift;
$this->getobj('entry')->pos($pos);
}
sub text(;$)
{
my $this = shift;
my $text = shift;
$this->getobj('entry')->text($text);
}
sub prompt(;$)
{
my $this = shift;
my $prompt = shift;
if (defined $prompt)
{
$prompt = substr($prompt, 0, 1);
$this->{-prompt} = $prompt;
$this->getobj('prompt')->text($prompt);
$this->intellidraw;
return $this;
lib/Curses/UI/Searchable.pm view on Meta::CPAN
Exporter
);
@EXPORT = qw(
search_forward
search_backward
search
search_next
);
sub search_forward()
{
my $this = shift;
$this->search("/", +1);
}
sub search_backward()
{
my $this = shift;
$this->search("?", -1);
}
sub search()
{
my $this = shift;
my $prompt = shift || ':';
my $direction = shift || +1;
$this->change_canvasheight(-1);
$this->draw;
my $querybox = new Curses::UI::SearchEntry(
-parent => $this,
lib/Curses/UI/Searchable.pm view on Meta::CPAN
# Restore the screen.
$this->root->cursor_mode($old_cursor_mode);
$this->change_canvasheight(+1);
$this->draw;
$this->root->feedkey($querybox->{-key});
return $this;
}
sub search_next($$;)
{
my $this = shift;
my $query = shift;
my $direction = shift;
$direction = ($direction > 0 ? +1 : -1);
$this->search_get($query, $direction);
}
sub change_canvasheight($;)
{
my $this = shift;
my $change = shift;
if ($change < 0)
{
# Change the canvasheight, so we can fit in the searchline.
$this->{-sh}--;
$this->{-yscrpos}++
if ($this->{-ypos}-$this->{-yscrpos} == $this->canvasheight);
lib/Curses/UI/Searchable.pm view on Meta::CPAN
$inscreen = ($this->canvasheight
- ($this->number_of_lines
- $this->{-yscrpos}));
}
}
$this->{-search_highlight} = undef;
$this->layout_content();
}
sub search_get($$;)
{
my $this = shift;
my $query = shift;
my $direction = shift || +1;
my $startpos = $this->{-ypos};
my $offset = 0;
my $wrapped = 0;
for (;;)
{
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
$this->readonly($this->{-readonly});
$this->layout_content;
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding('mouse-button1', BUTTON1_CLICKED());
}
return $this;
}
sub getrealxpos()
{
my $this = shift;
my $offset = $this->{-xscrpos};
my $length = $this->{-xpos} - $this->{-xscrpos};
return 0 if $length <= 0;
my $current_line = $this->{-scr_lines}->[$this->{-ypos}];
my $before_cursor = substr(
$current_line,
$this->{-xscrpos}, # Screen's x position
$this->{-xpos} - $this->{-xscrpos} # Space up to the cursor
);
my $realxpos = scrlength($before_cursor);
return $realxpos;
}
sub layout()
{
my $this = shift;
$this->SUPER::layout() or return;
# Scroll up if we can and the number of visible lines
# is smaller than the number of available lines in the screen.
my $inscreen = ($this->canvasheight
- ($this->number_of_lines
- $this->{-yscrpos}));
while ($this->{-yscrpos} > 0 and
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
$this->{-xscrpos}--;
$inscreen = ($this->canvaswidth
- ($this->number_of_columns
- $this->{-xscrpos}));
}
$this->layout_content();
return $this;
}
sub layout_content()
{
my $this = shift;
return $this if $Curses::UI::screen_too_small;
# ----------------------------------------------------------------------
# Build an array of lines to display and determine the cursor position
# ----------------------------------------------------------------------
my $lines_src = $this->split_to_lines($this->{-text});
foreach (@$lines_src) {$_ .= "\n"}
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
$this->{-vscrolllen} = @{$this->{-scr_lines}};
$this->{-vscrollpos} = $this->{-yscrpos};
} else {
$this->{-vscrolllen} = 0;
$this->{-vscrollpos} = 0;
}
return $this;
}
sub draw_text(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
return $this if $Curses::UI::screen_too_small;
# Return immediately if this object is hidden.
return $this if $this->hidden;
# Turn on underlines and fill the screen with lines
# if neccessary.
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
);
}
$this->{-canvasscr}->attroff(A_UNDERLINE) if $this->{-showlines};
$this->{-canvasscr}->attroff(A_REVERSE) if $this->{-reverse};
$this->{-canvasscr}->noutrefresh();
doupdate() unless $no_doupdate;
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
$this->SUPER::draw(1) or return $this;
$this->layout_content;
$this->draw_text(1);
doupdate() unless $no_doupdate;
return $this;
}
sub event_onblur()
{
my $this = shift;
$this->SUPER::event_onblur;
# Set the cursor position to the startposition
# if -homeonblur is set.
if ($this->{-homeonblur}) {
$this->cursor_to_home;
$this->layout_content;
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
$this->run_event('-onchange');
$this->draw(1);
}
# Save the current key.
$this->{-prevkey} = $key;
return $ret;
}
sub add_string($;)
{
my $this = shift;
my $ch = shift;
my @ch = split //, $ch;
$ch = '';
foreach (@ch) {
$ch .= $this->key_to_ascii($_);
}
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
# pasted string. Get it and process it. Don't do
# special bindings, but only add-string and newline.
$ch = $this->get_key(0);
}
$this->layout_content;
$this->set_curxpos;
return $this;
}
sub toggle_showoverflow()
{
my $this = shift;
$this->{-showoverflow} = ! $this->{-showoverflow};
return $this;
}
sub toggle_wrapping()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
$this->{-wrapping} = ! $this->{-wrapping};
$this->layout;
return $this;
}
sub toggle_showhardreturns()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
$this->{-showhardreturns} = ! $this->{-showhardreturns};
return $this;
}
sub cursor_right()
{
my $this = shift;
# Handle cursor_right for read only mode.
if ($this->{-readonly})
{
return $this->dobeep
unless defined $this->{-hscrolllen};
return $this->dobeep
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
if ($this->{-pos} == length($this->{-text})) {
$this->dobeep;
} else {
$this->{-pos}++;
}
$this->layout_content;
$this->set_curxpos;
return $this;
}
sub cursor_left()
{
my $this = shift;
# Handle cursor_left for read only mode.
if ($this->{-readonly})
{
return $this->dobeep if $this->{-xscrpos} <= 0;
$this->{-xscrpos} -= 1;
$this->{-xpos} = $this->{-xscrpos};
return $this;
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
if ($this->{-pos} <= 0) {
$this->dobeep;
} else {
$this->{-pos}--;
}
$this->layout_content;
$this->set_curxpos;
return $this;
}
sub set_curxpos()
{
my $this = shift;
$this->{-curxpos} = $this->{-xpos};
return $this;
}
sub cursor_up(;$)
{
my $this = shift;
shift; # stub for bindings handling.
my $amount = shift || 1;
return $this->dobeep if $this->{-singleline};
# Handle cursor_up for read only mode.
if ($this->{-readonly})
{
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
my $line = $l->[$idx];
my $line_length = length($line);
$this->{-pos} -= $line_length;
$amount--;
}
$this->cursor_to_curxpos;
return $this;
}
sub cursor_pageup()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
$this->cursor_up(undef, $this->canvasheight - 1);
return $this;
}
sub cursor_down($;)
{
my $this = shift;
shift; # stub for bindings handling.
my $amount = shift || 1;
return $this->dobeep if $this->{-singleline};
# Handle cursor_down for read only mode.
if ($this->{-readonly})
{
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
my $line = $l->[$idx];
my $line_length = length($line);
$this->{-pos} += $line_length;
$amount--;
}
$this->cursor_to_curxpos;
return $this;
}
sub cursor_pagedown()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
$this->cursor_down(undef, $this->canvasheight - 1);
return $this;
}
sub cursor_to_home()
{
my $this = shift;
if ($this->{-readonly})
{
$this->{-xscrpos} = $this->{-xpos} = 0;
$this->{-yscrpos} = $this->{-ypos} = 0;
return $this;
}
$this->{-pos} = 0;
$this->set_curxpos;
return $this;
}
sub cursor_to_end()
{
my $this = shift;
if ($this->{-readonly})
{
$this->{-xscrpos} = $this->{-xpos} = 0;
$this->{-yscrpos} = $this->{-ypos} =
$this->{-vscrolllen}-$this->canvasheight;
return $this;
}
$this->{-pos} = length($this->{-text});
$this->set_curxpos;
return $this;
}
sub cursor_to_scrlinestart()
{
my $this = shift;
# Key argument is set if called from binding.
my $from_binding = shift;
if ($this->{-readonly})
{
$this->{-xscrpos} = $this->{-xpos} = 0;
return $this;
}
$this->{-pos} -= $this->{-xpos};
$this->{-xpos} = 0;
$this->set_curxpos if defined $from_binding;
return $this;
}
sub cursor_to_scrlineend()
{
my $this = shift;
my $from_binding = shift;
if ($this->{-readonly})
{
$this->{-xscrpos} = $this->{-xpos} =
$this->{-hscrolllen} - $this->canvaswidth ;
return $this;
}
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
my $newpos = $this->{-pos};
my $l = $this->{-scr_lines};
my $len = length($l->[$this->{-ypos}]) - 1;
$newpos += $len - $this->{-xpos};
$this->{-pos} = $newpos;
$this->layout_content;
$this->set_curxpos if defined $from_binding;
return $this;
}
sub cursor_to_linestart()
{
my $this = shift;
# Move cursor back, until \n is found. That is
# the previous line. Then go one position to the
# right to find the start of the line.
my $newpos = $this->{-pos};
for(;;)
{
last if $newpos <= 0;
$newpos--;
last if substr($this->{-text}, $newpos, 1) eq "\n";
}
$newpos++ unless $newpos == 0;
$newpos = length($this->{-text}) if $newpos > length($this->{-text});
$this->{-pos} = $newpos;
$this->layout_content;
return $this;
}
sub cursor_to_curxpos()
{
my $this = shift;
my $right = $this->{-curxpos};
$right = 0 unless defined $right;
my $len = length($this->{-scr_lines}->[$this->{-ypos}]) - 1;
if ($right > $len) { $right = $len }
$this->{-pos} += $right;
$this->layout_content;
return $this;
}
sub clear_line()
{
my $this = shift;
$this->cursor_to_linestart;
$this->delete_till_eol;
return $this;
}
sub delete_line()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
my $len = length($this->{-text});
if ($len == 0)
{
$this->dobeep;
return $this;
}
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
->delete_till_eol
->cursor_left
->delete_character
->cursor_right
->cursor_to_linestart
->set_curxpos
->beep_on;
return $this;
}
sub delete_till_eol()
{
my $this = shift;
$this->set_undoinfo;
# Cursor is at newline. No action needed.
return $this if substr($this->{-text}, $this->{-pos}, 1) eq "\n";
# Find the next newline. Delete the content up to that newline.
my $pos = $this->{-pos};
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
last if substr($this->{-text}, $pos, 1) eq "\n";
}
$this->add_to_pastebuffer(
substr($this->{-text}, $this->{-pos}, $pos - $this->{-pos})
);
substr($this->{-text}, $this->{-pos}, $pos - $this->{-pos}, '');
return $this;
}
sub delete_character()
{
my $this = shift;
shift(); # stub for bindings handling.
my $is_backward = shift;
if ($this->{-pos} >= length($this->{-text})) {
$this->dobeep;
} else {
$this->set_undoinfo;
$this->add_to_pastebuffer(
substr($this->{-text}, $this->{-pos}, 1),
$is_backward
);
substr($this->{-text}, $this->{-pos}, 1, ''),
}
return $this;
}
sub backspace()
{
my $this = shift;
if ($this->{-pos} <= 0) {
$this->dobeep;
} else {
$this->set_undoinfo;
$this->{-pos}--;
$this->delete_character(undef,1);
$this->layout_content;
$this->set_curxpos;
}
return $this;
}
sub newline()
{
my $this = shift;
return $this->dobeep if $this->{-singleline};
$this->add_string("\n");
}
sub mouse_button1($$$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
return unless $this->{-focusable};
# TODO: make this possible for multi line widgets.
if ($this->{-singleline})
{
$this->{-pos} = $this->{-xscrpos} + $x;
$this->layout_content;
$this->set_curxpos;
}
$this->focus();
return $this;
}
sub resetsetundo() { shift()->{-didsetundo} = 0}
sub didsetundo() { shift()->{-didsetundo} }
sub set_undoinfo()
{
my $this = shift;
return $this if $this->didsetundo;
push @{$this->{-undotext}}, $this->{-text};
push @{$this->{-undopos}}, $this->{-pos};
my $l = $this->{-undolevels};
if ($l and @{$this->{-undotext}} > $l) {
splice(@{$this->{-undotext}}, 0, @{$this->{-undotext}}-$l, ());
splice(@{$this->{-undopos}}, 0, @{$this->{-undopos}}-$l, ());
}
$this->{-didsetundo} = 1;
return $this;
}
sub undo()
{
my $this = shift;
if (@{$this->{-undotext}})
{
my $text = pop @{$this->{-undotext}};
my $pos = pop @{$this->{-undopos}};
$this->{-text} = $text;
$this->{-pos} = $pos;
}
return $this;
}
sub do_new_pastebuffer(;$)
{
my $this = shift;
my $value = shift;
$this->{-do_new_pastebuffer} = $value
if defined $value;
$this->{-pastebuffer} = '' unless defined $this->{-pastebuffer};
return $this->{-do_new_pastebuffer};
}
sub clear_pastebuffer()
{
my $this = shift;
$this->{-pastebuffer} = '';
return $this;
}
sub add_to_pastebuffer($;)
{
my $this = shift;
my $add = shift;
my $is_backward = shift || 0;
$this->clear_pastebuffer if $this->do_new_pastebuffer;
if ($is_backward) {
$this->{-pastebuffer} = $add . $this->{-pastebuffer};
} else {
$this->{-pastebuffer} .= $add;
}
$this->do_new_pastebuffer(0);
return $this;
}
sub paste()
{
my $this = shift;
if ($this->{-pastebuffer} ne '') {
$this->add_string($this->{-pastebuffer});
}
return $this;
}
sub readonly($;)
{
my $this = shift;
my $readonly = shift;
$this->{-readonly} = $readonly;
if ($readonly)
{
my %mybindings = (
%basebindings,
lib/Curses/UI/TextEditor.pm view on Meta::CPAN
%basebindings,
%editbindings
);
$this->{-bindings} = \%mybindings;
$this->{-nocursor} = 0;
}
return $this;
}
sub get() {shift()->text}
sub pos(;$)
{
my $this = shift;
my $pos = shift;
if (defined $pos)
{
$this->{-pos} = $pos;
$this->layout_content;
$this->intellidraw;
return $this;
}
return $this->{-pos};
}
sub text(;$)
{
my $this = shift;
my $text = shift;
if (defined $text)
{
$this->{-text} = $text;
$this->layout_content;
$this->intellidraw;
return $this;
}
return $this->{-text};
}
sub onChange(;$) { shift()->set_event('-onchange', shift()) }
sub set_password_char {
my ($this, $char) = @_;
$char = substr($char, 0, 1) if defined $char;
$this->{-password} = $char;
}
# ----------------------------------------------------------------------
# Routines for search support
# ----------------------------------------------------------------------
sub number_of_lines() { @{shift()->{-scr_lines}} }
sub number_of_columns()
{
my $this = shift;
my $columns = 0;
foreach (@{$this->{-scr_lines}}) {
$columns = length($_)
if length($_) > $columns;
}
return $columns;
}
sub getline_at_ypos($;) { shift()->{-scr_lines}->[shift()] }
#
# Color
#
sub set_color_fg {
my $this = shift;
$this->{-fg} = shift;
$this->intellidraw;
}
lib/Curses/UI/Widget.pm view on Meta::CPAN
$this->layout;
if ($Curses::UI::ncurses_mouse) {
$this->set_mouse_binding(\&mouse_button1, BUTTON1_CLICKED())
unless $this->{-mousebindings}->{BUTTON1_CLICKED()};
}
return $this;
}
sub DESTROY()
{
my $this = shift;
$this->delete_subwindows();
}
sub userdata
{
my $this = shift;
if (defined $_[0])
{
$this->{-userdata} = $_[0];
}
return $this->{-userdata};
}
sub focusable(;$) {
my $this = shift;
my $focusable = shift;
if (defined $focusable)
{
$this->accessor('-focusable', $focusable);
# Let the parent find another widget to focus
# if this widget is not focusable anymore.
if ($this->{-focus} and not $focusable) {
$this->parent->focus($this);
}
}
return $this->{-focusable};
}
sub layout()
{
cbreak();
my $this = shift;
return if $Curses::UI::screen_too_small;
$this->process_padding;
# -------------------------------------------------------
lib/Curses/UI/Widget.pm view on Meta::CPAN
$this->{-bw} = $this->{-sw};
$this->{-bh} = $this->{-sh};
$this->{-bx} = $this->{-sx};
$this->{-by} = $this->{-sy};
}
return $this;
}
sub process_padding($;)
{
my $this = shift;
# Process the padding arguments.
foreach my $type ('-pad','-ipad') {
if (defined $this->{$type}) {
foreach my $side ('right','left','top','bottom') {
$this->{$type . $side} = $this->{$type}
unless defined $this->{$type . $side};
}
}
}
foreach my $type ('-pad','-ipad') {
foreach my $side ('right','left','top','bottom') {
$this->{$type . $side} = 0
unless defined $this->{$type . $side};
}
}
}
sub width_by_windowscrwidth($@)
{
my $width = shift || 0;
$width = shift if ref $width; # make $this->width... possible.
my %args = @_;
$width += 2 if $args{-border}; # border
$width += 2 if $args{-sbborder}; # sbborder
$width += 1 if (not $args{-border} and # scrollbar and no border
not $args{-sbborder} and
$args{-vscrollbar});
lib/Curses/UI/Widget.pm view on Meta::CPAN
if ($args{$t}) {
$width += 2*$args{$t};
} else {
$width += $args{$t . "left"} if defined $args{$t . "left"};
$width += $args{$t . "right"} if defined $args{$t . "right"};
}
}
return $width;
}
sub height_by_windowscrheight($@)
{
my $height = shift || 0;
$height = shift if ref $height; # make $this->height... possible.
my %args = @_;
$height += 2 if $args{-border}; # border
$height += 1 if (not $args{-border} and $args{-hscrollbar});
foreach my $t ("-ipad", "-pad") # internal + external padding
{
if ($args{$t})
lib/Curses/UI/Widget.pm view on Meta::CPAN
if (defined $title)
{
$this->{-title} = $title;
$this->intellidraw;
}
return $this->{-title}
}
sub windowparameters()
{
my $this = shift;
my $scr = shift;
$scr = "-canvasscr" unless defined $scr;
my $s = $this->{$scr};
my ($x,$y,$w,$h);
$s->getbegyx($y, $x);
$s->getmaxyx($h, $w);
lib/Curses/UI/Widget.pm view on Meta::CPAN
-h => $h,
-x => $x,
-y => $y,
};
}
#
# Actually, the focus is not loose but the widget should
# lose the focus:
sub lose_focus()
{
my $this = shift;
$this->loose_focus(@_);
}
sub loose_focus()
{
my $this = shift;
my $key = shift;
# The focus change will draw $this anyhow and this
# will reset the schedule if somewhere in the middle of
# a binding routine loose_focus() is called (else
# first the focus would shift and after that $this
# would be redrawn).
#
lib/Curses/UI/Widget.pm view on Meta::CPAN
if (defined $key and $key eq KEY_BTAB()) {
$this->parent->focus_prev();
} else {
$this->parent->focus_next();
}
}
return $this;
}
sub focus()
{
my $this = shift;
# Let the parent focus this object.
my $parent = $this->parent;
$parent->focus($this) if defined $parent;
$this->draw(1) if ($this->root->overlapping);
return $this;
}
lib/Curses/UI/Widget.pm view on Meta::CPAN
$this->root->do_one_event($this);
}
$this->{-focus} = 0;
$this->{-has_modal_focus} = 0;
return $this;
}
sub draw(;$)
{
my $this = shift;
my $no_doupdate = shift || 0;
# Return immediately if this object is hidden of if
# the screen is currently too small.
return if $Curses::UI::screen_too_small;
return if $this->hidden;
eval { curs_set(0) }; # not available on every system.
lib/Curses/UI/Widget.pm view on Meta::CPAN
}
$this->draw_scrollbars();
$this->{-borderscr}->noutrefresh();
}
doupdate() unless $no_doupdate;
return $this;
}
sub draw_scrollbars()
{
my $this = shift;
return $this unless defined $this->{-borderscr};
if ($this->{-vscrollbar} and defined $this->{-vscrolllen})
{
# Compute the drawing range for the scrollbar.
my $xpos = $this->{-vscrollbar} eq 'left'
lib/Curses/UI/Widget.pm view on Meta::CPAN
for my $i (0 .. $actlen-1) {
$this->{-borderscr}->addch($ypos, $i+$actpos," ");
}
$this->{-borderscr}->attroff(A_REVERSE);
}
}
return $this;
}
sub beep_on() { my $this = shift; $this->{-nobeep} = 0; return $this }
sub beep_off() { my $this = shift; $this->{-nobeep} = 1; return $this }
sub dobeep()
{
my $this = shift;
beep() unless $this->{-nobeep};
return $this;
}
# TODO: work out hiding of objects.
sub hidden() { shift()->{-hidden} }
sub hide() { shift()->{-hidden} = 1 }
sub show() { shift()->{-hidden} = 0 }
sub intellidraw(;$)
{
my $this = shift;
if ( $this->{-intellidraw} and
not $this->hidden and
$this->in_topwindow ) {
$this->draw(1);
}
return $this;
}
sub delete_subwindows()
{
my $this = shift;
delete $this->{-scr};
foreach my $win (qw(-borderscr -canvasscr))
{
if (defined $this->{$win})
{
$this->{$win}->delwin;
delete $this->{$win};
}
}
}
sub parentwindow()
{
my $object = shift;
until (not defined $object or
$object->isa('Curses::UI::Window')) {
$object = $object->parent
}
return $object;
}
sub in_topwindow()
{
my $this = shift;
# Get the parent window of this widget.
my $win = $this->parentwindow();
return unless defined $win;
# A modal window should always be the topwindow.
return 1 if $win->{-has_modal_focus};
lib/Curses/UI/Widget.pm view on Meta::CPAN
}
# Check if the parent window is on top.
return (@path and ($win eq $path[-1]));
}
# ----------------------------------------------------------------------
# Binding
# ----------------------------------------------------------------------
sub clear_binding($;)
{
my $this = shift;
my $binding = shift;
my @delete = ();
while (my ($k,$v) = each %{$this->{-bindings}}) {
push @delete, $k if $v eq $binding;
}
foreach (@delete) {
delete $this->{-bindings}->{$_};
}
return $this;
}
sub set_routine($$;)
{
my $this = shift;
my $binding = shift;
my $routine = shift;
$this->{-routines}->{$binding} = $routine;
return $this;
}
sub set_binding($@)
{
my $this = shift;
my $routine = shift;
my @keys = @_;
# Create a routine entry if the routine that was
# passed is a code reference instead of a
# routine name.
if (ref $routine eq 'CODE')
{
lib/Curses/UI/Widget.pm view on Meta::CPAN
$this->root->fatalerror("set_binding(): $routine: no such routine")
unless defined $this->{-routines}->{$routine};
foreach my $key (@keys) {
$this->{-bindings}->{$key} = $routine;
}
return $this;
}
sub set_mouse_binding($@)
{
my $this = shift;
my $routine = shift;
my @mouse_events = @_;
# Create a routine entry if the routine that was
# passed is a code reference instead of a
# routine name.
if (ref $routine eq 'CODE')
{
lib/Curses/UI/Widget.pm view on Meta::CPAN
$this->root->fatalerror("set_binding(): $routine: no such routine")
unless defined $this->{-routines}->{$routine};
foreach my $mouse_event (@mouse_events) {
$this->{-mousebindings}->{$mouse_event} = $routine;
}
return $this;
}
sub schedule_draw(;$) { shift()->accessor('-schedule_draw', shift()) }
sub process_bindings($;$@)
{
my $this = shift;
my $key = shift;
my $is_mouse_event = shift || 0;
my @extra = @_;
# Reset draw schedule.
$this->schedule_draw(0);
# Find the binding to use.
lib/Curses/UI/Widget.pm view on Meta::CPAN
if (defined $binding) {
my $return = $this->do_routine($binding, $key, @extra);
# Redraw if draw schedule is set.
$this->intellidraw if $this->schedule_draw;
return $return;
} else {
return 'DELEGATE';
}
}
sub do_routine($;$)
{
my $this = shift;
my $binding = shift;
my @arguments = @_;
# Find the routine to call.
my $routine = $this->{-routines}->{$binding};
if (defined $routine)
{
lib/Curses/UI/Widget.pm view on Meta::CPAN
} else {
return $routine;
}
} else {
$this->root->fatalerror(
"No routine defined for keybinding \"$binding\"!"
);
}
}
sub onFocus($;$) { shift()->set_event('-onfocus', shift()) }
sub onBlur($;$) { shift()->set_event('-onblur', shift()) }
sub event_onfocus()
{
my $this = shift;
# Let the parent find another widget to focus
# if this widget is not focusable.
unless ($this->focusable) {
return $this->parent->focus($this);
}
$this->{-focus} = 1;
lib/Curses/UI/Widget.pm view on Meta::CPAN
# Set cursor mode
my $show_cursor = $this->{-nocursor} ? 0 : 1;
$this->root->cursor_mode($show_cursor);
$this->draw(1) if (not $this->root->overlapping);
return $this;
}
sub event_onblur()
{
my $this = shift;
$this->{-focus} = 0;
$this->run_event('-onblur');
$this->draw(1) if (not $this->root->overlapping);
return $this;
}
sub event_keypress($;)
{
my $this = shift;
my $key = shift;
$this->process_bindings($key);
}
sub event_mouse($;)
{
my $this = shift;
my $MEVENT = shift;
my $winp = $this->windowparameters;
my $abs_x = $MEVENT->{-x} - $winp->{-x};
my $abs_y = $MEVENT->{-y} - $winp->{-y};
$this->process_bindings($MEVENT, 1, $abs_x, $abs_y);
}
sub mouse_button1($$$$;)
{
my $this = shift;
my $event = shift;
my $x = shift;
my $y = shift;
$this->focus() if not $this->{-focus} and $this->focusable;
}
# ----------------------------------------------------------------------
# Event handling
# ----------------------------------------------------------------------
sub clear_event($;)
{
my $this = shift;
my $event = shift;
$this->set_event($event, undef);
return $this;
}
sub set_event($;$)
{
my $this = shift;
my $event = shift;
my $callback = shift;
if (defined $callback)
{
if (ref $callback eq 'CODE') {
$this->{$event} = $callback;
} else {
lib/Curses/UI/Widget.pm view on Meta::CPAN
"$event callback for $this "
. "($callback) is no CODE reference"
);
}
} else {
$this->{$event} = undef;
}
return $this;
}
sub run_event($;)
{
my $this = shift;
my $event = shift;
my $callback = $this->{$event};
if (defined $callback) {
if (ref $callback eq 'CODE') {
return $callback->($this);
} else {
$this->root->fatalerror(
( run in 1.580 second using v1.01-cache-2.11-cpan-65fba6d93b7 )