Curses::UI - A curses based OO user interface framework

    use Curses::UI;

    # create a new C::UI object
    my $cui = Curses::UI->new( -clear_on_exit => 1,
                               -debug => $debug, );

    # this is where we gloss over setting up all the widgets and data
    # structures :)

    # start the event loop
    $cui->mainloop;

    my $cui = Curses::UI->new( OPTIONS );

    $cui->dialog("Hello, world!");

    my $yes = $cui->dialog(
        -message => "Hello, world?",
        -buttons =3D> ['yes','no'],
        -values  => [1,0],
        -title   => 'Question',
    );

    if ($yes) {
        # whatever
    }

    $cui->error("It's the end of the\n"
               ."world as we know it!");

    my $file = $cui->filebrowser(
        -path => "/tmp",
        -show_hidden => 1,
    );

    # Filebrowser will return undef
    # if no file was selected.
    if (defined $file) {
        unless (open F, ">$file") {
            print F "Hello, world!\n";
            close F;
    } else {
        $cui->error(qq(Error on writing to "$file":\n$!));
    }

    $cui->status("Saying hello to the world...");
    # code for saying "Hello, world!"

    $cui->status("Saying goodbye to the world...");
    # code for saying "Goodbye, world!"

    $cui->nostatus;

    $cui->progress(
        -max => 10,
        -message => "Counting 10 seconds...",
    );

    for my $second (0..10) {
        $cui->setprogress($second)
        sleep 1;
    }

    $cui->noprogress;

package Curses::UI;
use base qw(Curses::UI::Common Curses::UI::Container);

# If we do not know a terminal type, then imply VT100.
BEGIN { $ENV{TERM} = 'vt100' unless defined $ENV{TERM} }

use strict;
use warnings;

use Curses;
use Curses::UI::Language;
use Curses::UI::Color;
use FileHandle;
use Term::ReadKey;

use vars qw( $VERSION );
$VERSION = 0.9607;

$Curses::UI::debug            = 0;
$Curses::UI::screen_too_small = 0;
$Curses::UI::initialized      = 0;
$Curses::UI::color_support    = 0;
$Curses::UI::color_object     = 0;
$Curses::UI::ncurses_mouse    = 0;
$Curses::UI::gpm_mouse        = 0;

# Detect if we should use the new moushandler
if ($ENV{"TERM"} ne "xterm") {
    eval { require Curses::UI::Mousehandler::GPM;
	   import Curses::UI::Mousehandler::GPM; };
    if (!$@) {
	$Curses::UI::gpm_mouse = gpm_enable();
	print STDERR "DEBUG: gpm_mouse: " . $Curses::UI::gpm_mouse . "\n"
	    if $Curses::UI::debug;
    }
} else {
    # Detect ncurses functionality. Magic for Solaris 8
    eval { $Curses::UI::ncurses_mouse = (Curses->can('NCURSES_MOUSE_VERSION')
					 &&
					 (NCURSES_MOUSE_VERSION() >= 1 ) ) };
    print STDERR "DEBUG: Detected mouse support $Curses::UI::ncurses_mouse\n"
      if $Curses::UI::debug;
}

sub new {
    my ($class,%userargs) = @_;

    fatalerror("Curses::UI->new can only be called once!")
      if $Curses::UI::initialized;

    &Curses::UI::Common::keys_to_lowercase(\%userargs);

    my %args = (
        -compat        => 0,     # Use compatibility mode?
        -clear_on_exit => 0,     # Clear screen if program exits?
        -cursor_mode   => 0,     # What is the current cursor_mode?
	-debug         => undef, # Turn on debugging mode?
	-keydelay      => 0,     # Track seconds since last keystroke?
	-language      => undef, # Which language to use?
	-mouse_support => 1,     # Do we want mouse support
	-overlapping   => 1,     # Whether overlapping widgets are supported
	-color_support => 0,
	-default_colors=> 1,
        #user data
        -userdata       => undef,    #user internal data
	%userargs,
	-read_timeout   => -1,    # full blocking read by default
	-scheduled_code => [],
	-added_code     => {},
        -lastkey        => 0,     # Last keypress time (set in mainloop)
    );

    $Curses::UI::debug = $args{-debug}
        if defined $args{-debug};

    $Curses::UI::ncurses_mouse = $args{-mouse_support}
        if defined $args{-mouse_support};

    if ($Curses::UI::gpm_mouse && $args{-mouse_support}) {
	$Curses::UI::ncurses_mouse = 1;
	$args{-read_timeout} = 0.25;
    } else {
	$Curses::UI::gpm_mouse = 0;
    }

    my $self = bless { %args }, $class;

    my $lang = new Curses::UI::Language($self->{-language});
    $self->lang($lang);
    print STDERR "DEBUG: Loaded language: $lang->{-lang}\n"
	if $Curses::UI::debug;

    # Color support
    $Curses::UI::color_support = $args{-color_support} if
	defined $args{-color_support};

    $self->layout();

    return $self;
}

DESTROY {
    my $self = shift;
    my $scr = $self->{-canvasscr};
    $scr->delwin() if (defined($scr));
    endwin();
    $Curses::UI::initialized = 0;

    if ($self->{-clear_on_exit})
      {	Curses::erase(); Curses::clear() }
}

sub mainloop {
    my ($self) = @_;

    # Draw the initial screen.
    $self->focus(undef, 1); # 1 = forced focus
    $self->draw;
    doupdate();

    # Inifinite event loop.
    while (1) { $self->do_one_event }
}

sub schedule_event {
    my ($self, $code) = @_;

    $self->fatalerror("schedule_event(): callback is no CODE reference")
      unless defined $code and ref $code eq 'CODE';

    push @{$self->{-scheduled_code}}, $code;
}

sub layout {
    my ($self) = @_;

    $Curses::UI::screen_too_small = 0;

    # find the terminal size.
    my ($cols,$lines) = GetTerminalSize;
    $ENV{COLS}  = $cols;
    $ENV{LINES} = $lines;

    if ($Curses::UI::initialized)
    {
        my $scr = $self->{-canvasscr};
        $scr->delwin() if (defined($scr));
        endwin();
    }
    # Initialize the curses screen.
    initscr();
    noecho();
    raw();

    # Colors
    if ($Curses::UI::color_support) {
	if ( has_colors() ) {
	    $Curses::UI::color_object = new Curses::UI::Color(-default_colors => $self->{-default_colors});
	} else {
	    $Curses::UI::color_support = 0;
	}
    }

    # Mouse events if possible
    my $old = 0;
    my $mmreturn;
    if ( $Curses::UI::ncurses_mouse )
    {
	print STDERR "DEBUG: ncurses mouse events are enabled\n"
	    if $Curses::UI::debug;
        # In case of gpm, mousemask fails. (MT: Not for me, maybe GPM changed?)
	eval { $mmreturn = mousemask( ALL_MOUSE_EVENTS(), $old ) };
	if ($Curses::UI::debug) {
	    print STDERR "DEBUG: mousemask returned $mmreturn\n";
	    print STDERR "DEBUG: Old is now $old\n";
	    print STDERR "DEBUG: mousemask() failed: $@\n" if $@;
	}
    }

    # Create root window.
    my $root = newwin($lines, $cols, 0, 0);
    die "newwin($lines, $cols, 0, 0) failed\n"
	unless defined $root;

    # Let this object present itself as a standard
    # Curses::UI widget, regarding size, location and
    # drawing area. This will make it possible for
    # child windows / widgets to layout and draw themselves.
    $self->{-width}  = $self->{-w} = $self->{-bw} = $cols;
    $self->{-height} = $self->{-h} = $self->{-bh} = $lines;
    $self->{-x}      = $self->{-y} = 0;
    $self->{-canvasscr} = $root;

    # 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;

    # Let this object present itself as a standard 
    # Curses::UI widget, regarding size, location and
    # drawing area. This will make it possible for
    # child windows / widgets to layout and draw themselves.
    #
    $self->{-width}  = $self->{-w} = $self->{-bw} = $cols;
    $self->{-height} = $self->{-h} = $self->{-bh} = $lines;
    $self->{-x}      = $self->{-y} = 0;
#    $self->{-canvasscr} = $root;

    # Walk through all contained objects and let them
    # layout themselves.
    $self->layout_contained_objects;

    $Curses::UI::initialized = 1;
    $self->draw();
    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);
	doupdate();
    }

    # Read a key or use the feeded key.
    my $key = $self->{-feedkey};
    unless (defined $key) {
        $key = $self->get_key($self->{-read_timeout});
    }
    $self->{-feedkey} = undef;

    # If there was a keypress, set -lastkey
    $self->{-lastkey} = time() unless ($key eq '-1');

    # ncurses sends KEY_RESIZE() key on resize. Ignore this key.
    # TODO: Try to redraw and layout everything anew
    # KEY_RESIZE doesn't seem to work right;
    if (Curses->can("KEY_RESIZE")) {
        $key = '-1' if $key eq KEY_RESIZE();
    }
    my ($cols,$lines) = GetTerminalSize;
    if ( ($ENV{COLS} != $cols) || ( $ENV{LINES} != $lines )) {
	$self->layout();
	$self->draw;
    }

    # ncurses sends KEY_MOUSE()
    if ($Curses::UI::ncurses_mouse) {
	if ($key eq KEY_MOUSE()) {
	    print STDERR "DEBUG: Got a KEY_MOUSE(), handeling it\n"
		if $Curses::UI::debug;
	    $self->handle_mouse_event($object);
	    doupdate();
	    return $self;
	}
    }

    # If the screen is too small, then <CTRL+C> will exit.
    # Else the next event loop will be started.
    if ($Curses::UI::screen_too_small) {
	exit(1) if $key eq "\cC";
	return $self;
    }

    # Delegate the keypress. This is not done to $self,
    # but to $object, so all events will go to the
    # object that called do_one_event(). This is used to
    # enable modal focusing.
    $object->event_keypress($key) unless $key eq '-1';

    # Execute timer code
    $self->do_timer;

    # Execute one scheduled event;
    if (@{$self->{-scheduled_code}}) {
	my $code = shift @{$self->{-scheduled_code}};
	$code->($self);
    }

    # Execute added code
    foreach my $key (keys %{$self->{-added_code}}) {
	my $code = $self->{-added_code}->{$key};
	$self->fatalerror("Method $key is not a coderef")
	  if (ref $code ne 'CODE');
	$code->($self);
    }

    # See if there are pending keys on input. If I do not
    # feed them to the application in this way, the screen
    # hangs in case I do a lot of input on my Solaris
    # machine.
    $key = $self->get_key(0);
    $self->feedkey($key) unless $key eq '-1';

    # 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->flushkeys();
    $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';

    $self->fatalerror(
	"add_timer(): id is not set"
    ) unless defined $id;

    my $config = {
        -time     => $time,
        -callback => $callback,
        -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;
    }

    TIMER: while (my ($id, $config) = each %{$self->{-timers}}) 
    {
        # Skip timer if it is disabled.
        next TIMER unless $config->{-enabled};

        # No -lastrun set? Then do it now.
        unless (defined $config->{-lastrun})
        {
            $config->{-lastrun} = $now; 
            next TIMER;
        }

        if ($config->{-lastrun} <= ($now - $config->{-time})) 
        {
            $config->{-callback}->($self);
            $config->{-lastrun} = $now;
            $timers_done++;
        }
    }

    # Bring the cursor back to the focused object by
    # redrawing it. Due to drawing other objects, it might
    # have moved to another widget or screen location.
    #
    $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!):
    #
    # typedef struct
    # {
    #    short id;           /* ID to distinguish multiple devices */
    #	 int x, y, z;        /* event coordinates (character-cell) */
    #	 mmask_t bstate;     /* button state bits */
    # } MEVENT;
    #
    # ---------------
    # s signed short
    # x null byte
    # x null byte
    # ---------------
    # i integer
    # ---------------
    # i integer
    # ---------------
    # i integer
    # ---------------
    # l long
    # ---------------

    my ($id, $x, $y, $z, $bstate) = unpack("sx2i3l", $MEVENT);
    my %MEVENT = (
	-id     => $id,
	-x      => $x,
	-y      => $y,
        -bstate => $bstate,
    );

    # Get the objects at the mouse event position.
    my $tree = $self->object_at_xy($object, $MEVENT{-x}, $MEVENT{-y});

    # Walk through the object tree, top object first.
    foreach my $object (reverse @$tree)
    {
	# 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.

    return unless $MEVENT;

    my ($id, $x, $y, $z, $bstate) = unpack("sx2i3l", $MEVENT);
    my %MEVENT = (
	-id     => $id,
	-x      => $x,
	-y      => $y,
	-bstate => $bstate,
    );

    # Get the objects at the mouse event position.
    my $tree = $self->object_at_xy($object, $MEVENT{-x}, $MEVENT{-y});

    # Walk through the object tree, top object first.
    foreach my $object (reverse @$tree)
    {
	# 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;

    my $idx = -1;
    while (defined $object->{-draworder}->[$idx])
    {
        my $testobj = $object->getobj($object->{-draworder}->[$idx]);
        $idx--;

        # Find the window parameters for the $testobj.
        my $scr = defined $testobj->{-borderscr} ? '-borderscr' : '-canvasscr';
        my $winp = $testobj->windowparameters($scr);

        # Does the click fall inside this object?
        if ( $x >= $winp->{-x} and
             $x <  ($winp->{-x}+$winp->{-w}) and
             $y >= $winp->{-y} and
             $y <  ($winp->{-y}+$winp->{-h}) ) {

            if ( $testobj->isa('Curses::UI::Container') and
                 not $testobj->isa('Curses::UI::ContainerWidget')) {
                $self->object_at_xy($testobj, $x, $y, $tree)
            } else {
                push @$tree, $testobj;
            }
            return $tree;
        }
    }

    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};
    $s->clear;
    $s->addstr(0,0,"Fatal program error:\n"
    	     . "-"x($ENV{COLS}-1) . "\n"
    	     . $error 
    	     . "-"x($ENV{COLS}-1) . "\n"
    	     . "Press any key to exit...");
    $s->noutrefresh();
    doupdate();

    $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.
    if (not defined $INC{$file})
    {
        eval
	{
            require $file;
            $class->import;
        };

        # 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;
        $p_obj = $p_obj->{-id2object}->{$p_el};
        push @path, $p_obj;
        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
           $class =~ /^Dialog\:\:[^\:]+$/;

    $self->usemodule($class);

    $self->fatalerror(
	    "You may only add Curses::UI::Window objects to "
          . "Curses::UI and no $class objects"
    ) unless $class->isa('Curses::UI::Window');

    $self->SUPER::add($id, $class, %args);
}

# Sets/Get the user data
sub userdata
{
    my $self = shift;
    if (defined $_[0])
    {
        $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;
    $self->delete($id);
    $self->root->focus(undef, 1);
    return $return;
}

# 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};

    # Select a file to save to.
    my $file = $self->filebrowser(-editfilename => 1, %args);
    return unless defined $file;

    # Check if the file exists. Ask for overwrite
    # permission if it does.
    if (-e $file)
    {
	# Get language specific data.
	my $pre = $l->get('file_overwrite_question_pre');
	my $post = $l->get('file_overwrite_question_post');
	my $title = $l->get('file_overwrite_title');

        my $overwrite = $self->dialog(
            -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).
    $self->flushkeys;

    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);
}

1; # end of Curses::UI