package UI::Dialog::Backend::CDialog;
###############################################################################
#  Copyright (C) 2004  Kevin C. Krinke <kckrinke@opendoorsoftware.com>
#
#  This library is free software; you can redistribute it and/or
#  modify it under the terms of the GNU Lesser General Public
#  License as published by the Free Software Foundation; either
#  version 2.1 of the License, or (at your option) any later version.
#
#  This library is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  Lesser General Public License for more details.
#
#  You should have received a copy of the GNU Lesser General Public
#  License along with this library; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
###############################################################################
use 5.006;
use strict;
use FileHandle;
use Carp;
use Cwd qw( abs_path );
use Time::HiRes qw( sleep );
use UI::Dialog::Backend;

BEGIN {
    use vars qw( $VERSION @ISA );
    @ISA = qw( UI::Dialog::Backend );
    $VERSION = '1.08';
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Constructor Method
#:

sub new {
    my $proto = shift();
    my $class = ref($proto) || $proto;
    my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
    my $self = {};
    bless($self, $class);
    $self->{'_state'} = {};
    $self->{'_opts'} = {};

	#: Dynamic path discovery...
	my $CFG_PATH = $cfg->{'PATH'};
	if ($CFG_PATH) {
		if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }
		elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }
		elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }
	} elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }
	else { $self->{'PATHS'} = ''; }

	$self->{'_opts'}->{'literal'} = $cfg->{'literal'} || 0;
    $self->{'_opts'}->{'callbacks'} = $cfg->{'callbacks'} || undef();
    $self->{'_opts'}->{'timeout'} = $cfg->{'timeout'} || 0;
    $self->{'_opts'}->{'wait'} = $cfg->{'wait'} || 0;
    $self->{'_opts'}->{'debug'} = $cfg->{'debug'} || undef();
    $self->{'_opts'}->{'title'} = $cfg->{'title'} || undef();
    $self->{'_opts'}->{'backtitle'} = $cfg->{'backtitle'} || undef();
    $self->{'_opts'}->{'width'} = $cfg->{'width'} || 65;
    $self->{'_opts'}->{'height'} = $cfg->{'height'} || 10;
    $self->{'_opts'}->{'percentage'} = $cfg->{'percentage'} || 1;
    $self->{'_opts'}->{'colours'} = ($cfg->{'colours'} || $cfg->{'colors'}) ? 1 : 0;
    $self->{'_opts'}->{'bin'} ||= $self->_find_bin('cdialog');
    $self->{'_opts'}->{'autoclear'} = $cfg->{'autoclear'} || 0;
    $self->{'_opts'}->{'clearbefore'} = $cfg->{'clearbefore'} || 0;
    $self->{'_opts'}->{'clearafter'} = $cfg->{'clearafter'} || 0;
    $self->{'_opts'}->{'beepbin'} = $cfg->{'beepbin'} || $self->_find_bin('beep') || '/usr/bin/beep';
    $self->{'_opts'}->{'beepbefore'} = $cfg->{'beepbefore'} || 0;
    $self->{'_opts'}->{'beepafter'} = $cfg->{'beepafter'} || 0;
    unless (-x $self->{'_opts'}->{'bin'}) {
		croak("the cdialog binary could not be found at: ".$self->{'_opts'}->{'bin'});
    }
    $self->{'_opts'}->{'DIALOGRC'} = $cfg->{'DIALOGRC'} || undef();
    my $beginref = $cfg->{'begin'};
    $self->{'_opts'}->{'begin'} = (ref($beginref) eq "ARRAY") ? $beginref : undef();
    $self->{'_opts'}->{'cancel-label'} = $cfg->{'cancel-label'} || undef();
    $self->{'_opts'}->{'defaultno'} = $cfg->{'defaultno'} || 0;
    $self->{'_opts'}->{'default-item'} = $cfg->{'default-item'} || undef();
    $self->{'_opts'}->{'exit-label'} = $cfg->{'exit-label'} || undef();
    $self->{'_opts'}->{'extra-button'} = $cfg->{'extra-button'} || 0;
    $self->{'_opts'}->{'extra-label'} = $cfg->{'extra-label'} || undef();
    $self->{'_opts'}->{'help-button'} = $cfg->{'help-button'} || 0;
    $self->{'_opts'}->{'help-label'} = $cfg->{'help-label'} || undef();
    $self->{'_opts'}->{'max-input'} = $cfg->{'max-input'} || 0;
    $self->{'_opts'}->{'no-cancel'} = $cfg->{'no-cancel'} || $cfg->{'nocancel'} || 0;
    $self->{'_opts'}->{'no-collapse'} = $cfg->{'no-collapse'} || 0;
    $self->{'_opts'}->{'no-shadow'} = $cfg->{'no-shadow'} || 0;
    $self->{'_opts'}->{'ok-label'} = $cfg->{'ok-label'} || undef();
    $self->{'_opts'}->{'shadow'} = $cfg->{'shadow'} || 0;
    $self->{'_opts'}->{'tab-correct'} = $cfg->{'tab-correct'} || 0;
    $self->{'_opts'}->{'tab-len'} = $cfg->{'tab-len'} || 0;
    $self->{'_opts'}->{'listheight'} = $cfg->{'listheight'} || $cfg->{'menuheight'} || 5;
    $self->{'_opts'}->{'formheight'} = $cfg->{'formheight'} || $cfg->{'listheight'} || 5;

    $self->_determine_dialog_variant();
    return($self);
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Private Methods
#:
sub _determine_dialog_variant {
    my $self = $_[0];
    my $str = `$self->{'_opts'}->{'bin'} --help 2>&1`;
    if ($str =~ /version\s0\.[34]/m) {
		# this version does not support colours, so far just FreeBSD 4.8 has this
		# ancient binary. Bugreport from Jeroen Bulten indicates that he's
		# got a version 0.3 (patched to 0.4) installed. ugh...
		$self->{'_variant'} = "dialog";
		# the separate-output option seems to be the culprit of FreeBSD failure.
		$self->{'_opts'}->{'force-no-separate-output'} = 1;
	} elsif ($str =~ /cdialog\s\(ComeOn\sDialog\!\)\sversion\s(\d+\.\d+.+)/) {
		# We consider cdialog to be a colour supporting dialog variant all others
		# are non-colourized and support only the base functionality :(
		my $ver = $1;
		if ($ver =~ /-200[3-9]/) {
			$self->{'_variant'} = "cdialog";
			# these versions support colours :)
			$self->{'_opts'}->{'colours'} = 1;
		} else {
			$self->{'_variant'} = "dialog";
		}
    } else { $self->{'_variant'} = "dialog"; }
    undef($str);
}

my $SIG_CODE = {};
sub _del_gauge {
    my $CODE = $SIG_CODE->{$$};
    unless (not ref($CODE)) {
		delete($CODE->{'_GAUGE'});
		$CODE->rv('1');
		$CODE->rs('null');
		$CODE->ra('null');
		$SIG_CODE->{$$} = "";
    }
}
sub _mk_cmnd {
    my $self = shift();
    my $final = shift();
    my $cmnd;
    my $args = $self->_merge_attrs(@_);

    $ENV{'DIALOGRC'} ||= ($args->{'DIALOGRC'} && -r $args->{'DIALOGRC'}) ? $args->{'DIALOGRC'} : "";
    $ENV{'DIALOG_CANCEL'} = '1';
    $ENV{'DIALOG_ERROR'}  = '254';
    $ENV{'DIALOG_ESC'}    = '255';
    $ENV{'DIALOG_EXTRA'}  = '3';
    $ENV{'DIALOG_HELP'}   = '2';
    $ENV{'DIALOG_OK'}     = '0';

    $cmnd = $self->{'_opts'}->{'bin'};

    $cmnd .= ' --title "' . ($args->{'title'} || $self->{'_opts'}->{'title'}) . '"'
     unless not $args->{'title'} and not $self->{'_opts'}->{'title'};
    $cmnd .= ' --backtitle "' . ($args->{'backtitle'} || $self->{'_opts'}->{'backtitle'}) . '"'
     unless not $args->{'backtitle'} and not $self->{'_opts'}->{'backtitle'};
	$cmnd .= ' --separate-output' unless $self->{'_opts'}->{'force-no-separate-output'}
	 or (not $args->{'separate-output'} and not $self->{'_opts'}->{'separate-output'});
    if ($self->is_cdialog()) {
		$cmnd .= ' --colors';
		$cmnd .= ' --cr-wrap';
		# --begin <x> <y>
		my $begin = $args->{'begin'};
		if (ref($begin) eq "ARRAY") {
			$cmnd .= ' --begin '.$begin->[0].' '.$begin->[1];
		}
		$cmnd .= ' --cancel-label "'.$args->{'cancel-label'}.'"' unless not $args->{'cancel-label'};
		$cmnd .= ' --defaultno' unless not $args->{'defaultno'};
		$cmnd .= ' --default-item "'.$args->{'default-item'}.'"' unless not $args->{'default-item'};
		$cmnd .= ' --exit-label "'.$args->{'exit-label'}.'"' unless not $args->{'exit-label'};
		$cmnd .= ' --extra-button' unless not $args->{'extra-button'} and not $args->{'extra-label'};
		$cmnd .= ' --extra-label "'.$args->{'extra-label'}.'"' unless not $args->{'extra-label'};
		$cmnd .= ' --help-button' unless not $args->{'help-button'} and not $args->{'help-label'};
		$cmnd .= ' --help-label "'.$args->{'help-label'}.'"' unless not $args->{'help-label'};
		$cmnd .= ' --max-input "'.$args->{'max-input'}.'"' unless not $args->{'max-input'};
		$cmnd .= ' --no-cancel' unless not $args->{'nocancel'} and not $args->{'no-cancel'};
		$cmnd .= ' --no-collapse' unless not $args->{'no-collapse'} and not $args->{'literal'};
		$cmnd .= ' --no-shadow' unless not $args->{'no-shadow'};
		$cmnd .= ' --ok-label "'.$args->{'ok-label'}.'"' unless not $args->{'ok-label'};
		$cmnd .= ' --shadow' unless not $args->{'shadow'};
		$cmnd .= ' --tab-correct' unless not $args->{'tab-correct'};
		$cmnd .= ' --tab-len "'.$args->{'tab-len'}.'"' unless not $args->{'tab-len'};

		# --item-help                        #<-- NEEDS WORK
		# --no-kill                          #<-- tailboxbg only

    }
    $cmnd .= " " . $final;
    return($cmnd);
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Override Inherited Methods
#:
sub command_state {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug("".$cmnd);
    system($cmnd . " 2> /dev/null");
    return($? >> 8);
}
sub command_string {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug($cmnd);
    $self->gen_tempfile_name(); # don't accept the first result
    my $tmpfile = $self->gen_tempfile_name();
    my $text;
    system($cmnd." 2> ".$tmpfile);
    my $rv = $? >> 8;
    if (-f $tmpfile # don't assume the file exists
		&& open(WHIPF,"<".$tmpfile)) {
		local $/;
		$text = <WHIPF>;
		close(WHIPF);
		unlink($tmpfile);
    } else { $text = ""; }
    return($text) unless defined wantarray;
    return (wantarray) ? ($rv,$text) : $text;
}
sub command_array {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug($cmnd);
    $self->gen_tempfile_name(); # don't accept the first result
    my $tmpfile = $self->gen_tempfile_name();
    my $text;
    system($cmnd." 2> ".$tmpfile);
    my $rv = $? >> 8;
    if (-f $tmpfile # don't assume the file exists
		&& open(WHIPF,"<".$tmpfile)) {
		local $/;
		$text = <WHIPF>;
		close(WHIPF);
		unlink($tmpfile);
    } else { $text = ""; }
	if ($self->{'_opts'}->{'force-no-separate-output'}) {
		# a side effect of this forcible backwards compatibility is that any
		# "tags" with spaces will get broken down. *shrugs* Not much I can
		# do about this and because it's a minority of users with these
		# ancient versions of dialog I'm not delving any deeper into it.
		return([split(/\s/,$text)]) unless defined wantarray;
		return (wantarray) ? ($rv,[split(/\s/,$text)]) : [split(/\s/,$text)];
	} else {
		return([split("\n",$text)]) unless defined wantarray;
		return (wantarray) ? ($rv,[split("\n",$text)]) : [split("\n",$text)];
	}
}
sub _organize_text {
    my $self = $_[0];
    my $text = $_[1] || return();
    my $width = $_[2] || 65;
    my @array;

    if (ref($text) eq "ARRAY") { push(@array,@{$text}); }
    elsif ($text =~ /\\n/) { @array = split(/\\n/,$text); }
    else { @array = split(/\n/,$text); }
    $text = undef();

    @array = $self->word_wrap($width,"","",@array);
    my $max = @array;
    for (my $i = 0; $i < $max; $i++) { $array[$i] = $self->_esc_text($array[$i]); }

    if ($self->{'scale'}) {
		foreach my $line (@array) {
			my $s_line = $self->__TRANSLATE_CLEAN($line);
			$s_line =~ s!\[A\=\w+\]!!gi;
			$self->{'width'} = length($s_line) + 5
			 if ($self->{'width'} - 5) < length($s_line)
			  && (length($s_line) <= $self->{'max-scale'});
		}
    }
    foreach my $line (@array) {
		my $pad;
		my $s_line = $self->_strip_text($line);
		if ($line =~ /\[A\=(\w+)\]/i) {
			my $align = $1;
			$line =~ s!\[A\=\w+\]!!gi;
			if (uc($align) eq "CENTER" || uc($align) eq "C") {
				$pad = ((($self->{'_opts'}->{'width'} - 5) - length($s_line)) / 2);
				#		$pad = (($self->{'_opts'}->{'width'} - length($s_line)) / 2);
			} elsif (uc($align) eq "LEFT" || uc($align) eq "L") {
				$pad = 0;
			} elsif (uc($align) eq "RIGHT" || uc($align) eq "R") {
				$pad = (($self->{'_opts'}->{'width'} - 5) - length($s_line));
				#		$pad = (($self->{'_opts'}->{'width'}) - length($s_line));
			}
		}
		if ($pad) { $text .= (" " x $pad).$line."\n"; }
		else { $text .= $line."\n"; }
    }
    return($self->_filter_text($text));
}
sub _strip_text {
    my $self = shift();
    my $text = shift();
    $text =~ s!\\Z0!!gmi;
    $text =~ s!\\Z1!!gmi;
    $text =~ s!\\Z2!!gmi;
    $text =~ s!\\Z3!!gmi;
    $text =~ s!\\Z4!!gmi;
    $text =~ s!\\Z5!!gmi;
    $text =~ s!\\Z6!!gmi;
    $text =~ s!\\Z7!!gmi;
    $text =~ s!\\Zb!!gmi;
    $text =~ s!\\ZB!!gmi;
    $text =~ s!\\Zu!!gmi;
    $text =~ s!\\ZU!!gmi;
    $text =~ s!\\Zr!!gmi;
    $text =~ s!\\ZR!!gmi;
    $text =~ s!\\Zn!!gmi;
    $text =~ s!\[C=black\]!!gmi;
    $text =~ s!\[C=red\]!!gmi;
    $text =~ s!\[C=green\]!!gmi;
    $text =~ s!\[C=yellow\]!!gmi;
    $text =~ s!\[C=blue\]!!gmi;
    $text =~ s!\[C=magenta\]!!gmi;
    $text =~ s!\[C=cyan\]!!gmi;
    $text =~ s!\[C=white\]!!gmi;
    $text =~ s!\[B\]!!gmi;
    $text =~ s!\[/B\]!!gmi;
    $text =~ s!\[U\]!!gmi;
    $text =~ s!\[/U\]!!gmi;
    $text =~ s!\[R\]!!gmi;
    $text =~ s!\[/R\]!!gmi;
    $text =~ s!\[N\]!!gmi;
    $text =~ s!\[A=\w+\]!!gmi;
    return($text);
}
sub _filter_text {
    my $self = shift();
    my $text = shift() || return();
    if ($self->is_cdialog() && $self->{'_opts'}->{'colours'}) {
		$text =~ s!\[C=black\]!\\Z0!gmi;
		$text =~ s!\[C=red\]!\\Z1!gmi;
		$text =~ s!\[C=green\]!\\Z2!gmi;
		$text =~ s!\[C=yellow\]!\\Z3!gmi;
		$text =~ s!\[C=blue\]!\\Z4!gmi;
		$text =~ s!\[C=magenta\]!\\Z5!gmi;
		$text =~ s!\[C=cyan\]!\\Z6!gmi;
		$text =~ s!\[C=white\]!\\Z7!gmi;
		$text =~ s!\[B\]!\\Zb!gmi;
		$text =~ s!\[/B\]!\\ZB!gmi;
		$text =~ s!\[U\]!\\Zu!gmi;
		$text =~ s!\[/U\]!\\ZU!gmi;
		$text =~ s!\[R\]!\\Zr!gmi;
		$text =~ s!\[/R\]!\\ZR!gmi;
		$text =~ s!\[N\]!\\Zn!gmi;
		$text =~ s!\[A=\w+\]!!gmi;
		return($text);
    } else {
		return($self->_strip_text($text));
    }
}


#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Public Methods
#:

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: test for the good stuff
sub is_cdialog {
    my $self = $_[0];
    return(1) if $self->{'_variant'} && $self->{'_variant'} eq "cdialog";
    return(0);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Ask a binary question (Yes/No)
sub yesno {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(' --yesno',@_);
	$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my $rv = $self->command_state($command);
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->ra("NO");
		$self->rs("NO");
		$self->rv($rv);
		$this_rv = 0;
    } else {
		$self->ra("YES");
		$self->rs("YES");
		$self->rv('null');
		$this_rv = 1;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Text entry
sub inputbox {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $cmnd_prefix = ' --inputbox';
    if ($args->{'password'}) { $cmnd_prefix = ' --passwordbox'; }
    my $command = $self->_mk_cmnd($cmnd_prefix,@_);
	$command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'init'}||$args->{'entry'}||'') . '"'
     unless not $args->{'init'} and not $args->{'entry'};

    my ($rv,$text) = $self->command_string($command);
    $self->ra('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->rs('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->rs($text);
		$self->ra($text);
		$this_rv = $text;
    }
    $self->_post($args);
    return($this_rv);
}
#: password boxes aren't supported by gdialog
sub password {
    my $self = shift();
    return($self->inputbox('caller',((caller(1))[3]||'main'),@_,'password',1));
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: Text box
sub msgbox {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $args->{'msgbox'} ||= 'msgbox';

    my $command = $self->_mk_cmnd(' --'.$args->{'msgbox'},@_);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my $rv = $self->command_state($command);
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$this_rv = 0;
    } else {
		if (($args->{'msgbox'} eq "infobox") && ($args->{'timeout'} || $args->{'wait'})) {
			my $s = int(($args->{'wait'}) ? $args->{'wait'} :
						($args->{'timeout'}) ? ($args->{'timeout'} / 1000.0) : 1.0);
			sleep($s);
		}
		$self->rv('null');
		$this_rv = 1;
    }
    $self->_post($args);
    return($this_rv);
}
sub infobox {
    my $self = shift();
    return($self->msgbox('caller',((caller(1))[3]||'main'),@_,'msgbox','infobox'));
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: File box
sub textbox {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --textbox",@_);
    $command .= ' "' . ($args->{'path'}||'.') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my ($rv,$text) = $self->command_string($command);
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$this_rv = 0;
    } else {
		$self->rv('null');
		$this_rv = 1;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: a simple menu
sub menu {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --menu",@_);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

    if ($args->{'list'}) {
		$args->{'list'} = [ ' ', ' ' ] unless ref($args->{'list'}) eq "ARRAY";
		foreach my $item (@{$args->{'list'}}) {
			$command .= ' "' . ($item||' ') . '"';
		}
    } else {
		$args->{'items'} = [ ' ', ' ' ] unless ref($args->{'items'}) eq "ARRAY";
		foreach my $item (@{$args->{'items'}}) {
			$command .= ' "' . ($item||' ') . '"';
		}
    }

    my ($rv,$selected) = $self->command_string($command);
    $self->ra('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->rs('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->rs($selected);
		$this_rv = $selected;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: a check list
sub checklist {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $self->{'checklist'} ||= 'checklist';

    my $command = $self->_mk_cmnd(" --".$self->{'checklist'},@_,'separate-output',1);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

    if ($args->{'list'}) {
		$args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";
		my ($item,$info);
		while (@{$args->{'list'}}) {
			$item = shift(@{$args->{'list'}});
			$info = shift(@{$args->{'list'}});
			$command .= ' "'.($item||' ').'" "'.($info->[0]||' ').'" "'.(($info->[1]) ? 'on' : 'off').'"';
		}
    } else {
		$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";
		foreach my $item (@{$args->{'items'}}) {
			$command .= ' "' . ($item|' ') . '"';
		}
    }
    my ($rv,$selected) = $self->command_array($command);
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->ra('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->ra(@$selected);
		$self->rs(join("\n",@$selected));
		$this_rv = $selected;
    }
    $self->_post($args);
    return($this_rv) unless ref($this_rv) eq "ARRAY";
    return(@{$this_rv});
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: a radio button list
sub radiolist {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $self->{'radiolist'} ||= 'radiolist';

    my $command = $self->_mk_cmnd(" --".$self->{'radiolist'},@_);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

    if ($args->{'list'}) {
		$args->{'list'} = [ ' ', [' ', 1] ] unless ref($args->{'list'}) eq "ARRAY";
		my ($item,$info);
		while (@{$args->{'list'}}) {
			$item = shift(@{$args->{'list'}});
			$info = shift(@{$args->{'list'}});
			$command .= ' "'.($item||' ').'" "'.($info->[0]||' ').'" "'.(($info->[1]) ? 'on' : 'off').'"';
		}
    } else {
		$args->{'items'} = [ ' ', ' ', 'off' ] unless ref($args->{'items'}) eq "ARRAY";
		foreach my $item (@{$args->{'items'}}) {
			$command .= ' "' . ($item||' ') . '"';
		}
    }

    my ($rv,$selected) = $self->command_string($command);
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->ra('null');
		$self->rs('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->ra($selected);
		$self->rs($selected);
		$this_rv = $selected;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: file select
sub fselect {
    my $self = shift();

    unless ($self->is_cdialog()) {
		return($self->SUPER::fselect(@_));
    }

    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --fselect",@_);
    $command .= ' "' . ($args->{'path'}||abs_path()) . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my ($rv,$file) = $self->command_string($command);
    $self->ra('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->rs('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->rs($file);
		$self->ra($file);
		$this_rv = $file;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: calendar

sub calendar {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --calendar",@_);
    $command .= ' "' . ($args->{'text'}||'') . '"';
    $command .= ' "' . ($args->{'height'}||'6') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'day'}||'') . '"';
    $command .= ' "' . ($args->{'month'}||'') . '"';
    $command .= ' "' . ($args->{'year'}||'') . '"';

    my ($rv,$date) = $self->command_string($command);
    $self->ra('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->rs('null');
		$this_rv = 0;
    } else {
		chomp($date);
		$self->rv('null');
		$self->rs($date);
		$self->ra(split(/\//,$date));
		$this_rv = $date;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: timebox

sub timebox {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    my $command = $self->_mk_cmnd(" --timebox",@_);
    $command .= ' "' . ($args->{'text'}||'') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'hour'}||$hour) . '"';
    $command .= ' "' . ($args->{'minute'}||$min) . '"';
    $command .= ' "' . ($args->{'second'}||$sec) . '"';

    my ($rv,$time) = $self->command_string($command);
    $self->ra('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->rs('null');
		$this_rv = 0;
    } else {
		chomp($time);
		$self->rv('null');
		$self->rs($time);
		$self->ra(split(/\:/,$time));
		$this_rv = $time;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: tailbox

sub tailbox {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --tailbox",@_);
    $command .= ' "' . ($args->{'path'}||'') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my ($rv) = $self->command_state($command);
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$this_rv = 0;
    } else {
		$self->rv('null');
		$this_rv = 1;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: tailboxbg

sub tailboxbg {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    my $command = $self->_mk_cmnd(" --tailboxbg",@_);
    $command .= ' "' . ($args->{'path'}||'') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';

    my ($rv) = $self->command_state($command);
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$this_rv = 0;
    } else {
		$self->rv('null');
		$this_rv = 1;
    }
    $self->_post($args);
    return($this_rv);
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: an editable form (wow is this useful! holy cripes!)
sub form {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $self->{'form'} ||= 'form';

    my $command = $self->_mk_cmnd(" --".$self->{'form'},@_);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'30') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'formheight'}||$args->{'menuheight'}||$args->{'listheight'}||'5') . '"';

	# <label1> <l_y1> <l_x1> <item1> <i_y1> <i_x1> <flen1> <ilen1>
	# [ [ 'label1', 1, 1 ], [ 'item1', 1, 5, 10, 10 ], ... ]

	$args->{'list'} = [ [ 'bad', 1, 1 ], [ 'list', 1, 5, 4, "0" ] ] unless ref($args->{'list'}) eq "ARRAY";
	my ($item,$info);
	while (@{$args->{'list'}}) {
		$item = shift(@{$args->{'list'}}) || [ 'bad', 1, 1 ];
		$info = shift(@{$args->{'list'}}) || [ 'list', 1, 5, 4, "0" ];
		$command .= ' "'.($item->[0]||' ').'" "'.$item->[1].'" "'.$item->[2].'" "'.($info->[0]||' ').'" "'.$info->[1].'" "'.$info->[2].'" "'.$info->[3].'" "'.$info->[4].'"';
	}

    my ($rv,$selected) = $self->command_array($command);
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) {
		$self->rv($rv);
		$self->ra('null');
		$this_rv = 0;
    } else {
		$self->rv('null');
		$self->ra(@$selected);
		$self->rs(join("\n",@$selected));
		$this_rv = $selected;
    }
    $self->_post($args);
    return($this_rv) unless ref($this_rv) eq "ARRAY";
    return(@{$this_rv});
}

# #:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# #: inputmenu

# sub inputmenu {
#     my $self = shift();
#     my $args = $self->_merge_attrs(@_);

#     $self->_beep($args->{'beepbefore'});

#     my ($rv,$list) = (0,($args->{'list'}||$args->{'items'}));
#   INPUTMENULOOP: while (1) {

# 	my $command = $self->_mk_cmnd(" --inputmenu",@_);
# 	$command .= ' "' . ($args->{'text'}||'') . '"';
# 	$command .= ' "' . ($args->{'height'}||'20') . '"';
# 	$command .= ' "' . ($args->{'width'}||'65') . '"';
# 	$command .= ' "' . ($args->{'list-height'}||'10') . '"';

# 	$list = [ ' ', ' ' ] unless ref($list) eq "ARRAY";
# 	foreach my $item (@{$list}) {
# 	    $command .= ' "' . ($item||' ') . '"';
# 	}

# 	($rv,$list) = $self->command_array($command);
# 	$self->rs('null');
# 	if ($rv && $rv >= 1) {
# 	    $self->rv($rv);
# 	    $self->ra('null');
# 	    # return(0);
# 	} else {
# 	    $self->rv('null');
# 	    $self->ra($list);
# 	    # return($list);
# 	}

# 	use Data::Dumper;
# 	if ($self->state() eq "EXTRA" && $list->[0] =~ /^.*RENAMED\s([+)\s(.+)$/) {
# 	    my ($RTag,$RName) = ($1,$2);
# 	    my $alt_list = [];
# 	    while (@$list) {
# 		my $item = shift(@$list);
# 		my $name = shift(@$list);
# 		if ($item eq $RTag) {
# 		    push(@$alt_list,$item,$RName);
# 		} else {
# 		    push(@$alt_list,$item,$name);
# 		}
# 		print "$item $name\n"; sleep(1);
# 	    }
# 	    print Dumper($RTag,$RName,$alt_list); sleep(2);
# 	    $list = $alt_list;
# 	    next INPUTMENULOOP;
# 	}
# 	last INPUTMENULOOP;
#     }

#     $self->_beep($args->{'beepafter'});
#     $self->rs('null');
#     if ($rv && $rv >= 1) {
# 	$self->rv($rv);
# 	$self->ra('null');
# 	return(0);
#     } else {
# 	$self->rv('null');
# 	$self->ra($list);
# 	return($list);
#     }
# }

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: progress meter
sub gauge_start {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $self->{'_GAUGE'} ||= {};
    $self->{'_GAUGE'}->{'ARGS'} = $args;

    if (defined $self->{'_GAUGE'}->{'FH'}) {
		$self->rv(129);
		$self->_post($args);
		return(0);
    }

    my $command = $self->_mk_cmnd(" --gauge",@_);
    $command .= ' "' . (($args->{'literal'} ? $args->{'text'} : $self->_organize_text($args->{'text'}))||' ') . '"';
    $command .= ' "' . ($args->{'height'}||'20') . '"';
    $command .= ' "' . ($args->{'width'}||'65') . '"';
    $command .= ' "' . ($args->{'percentage'}||'0') . '"';

    $self->{'_GAUGE'}->{'FH'} = new FileHandle;
    $self->{'_GAUGE'}->{'FH'}->open("| $command");
    my $rv = $? >> 8;
    $self->{'_GAUGE'}->{'FH'}->autoflush(1);
    $self->rv($rv||'null');
    $self->ra('null');
    $self->rs('null');
    my $this_rv;
    if ($rv && $rv >= 1) { $this_rv = 0; }
    else { $this_rv = 1; }
    return($this_rv);
}
sub gauge_inc {
    my $self = $_[0];
    my $incr = $_[1] || 1;

    return(0) unless defined $self->{'_GAUGE'}->{'FH'};

    my $fh = $self->{'_GAUGE'}->{'FH'};
    $self->{'_GAUGE'}->{'PERCENT'} += $incr;
    $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
    print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
    return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
}
sub gauge_dec {
    my $self = $_[0];
    my $decr = $_[1] || 1;

    return(0) unless defined $self->{'_GAUGE'}->{'FH'};

    my $fh = $self->{'_GAUGE'}->{'FH'};
    $self->{'_GAUGE'}->{'PERCENT'} -= $decr;
    $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
    print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
    return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
}
sub gauge_set {
    my $self = $_[0];
    my $perc = $_[1] || $self->{'_GAUGE'}->{'PERCENT'} || 1;

    return(0) unless $self->{'_GAUGE'}->{'FH'};

    my $fh = $self->{'_GAUGE'}->{'FH'};
    $self->{'_GAUGE'}->{'PERCENT'} = $perc;
    $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
    print $fh $self->{'_GAUGE'}->{'PERCENT'}."\n";
    return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
}
# funky flicker... grr
sub gauge_text {
    my $self = $_[0];
    my $mesg = $_[1] || return(0);

    return(0) unless $self->{'_GAUGE'}->{'FH'};

    my $fh = $self->{'_GAUGE'}->{'FH'};
    $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
    print $fh "\nXXX\n\n".$mesg."\n\nXXX\n\n".$self->{'_GAUGE'}->{'PERCENT'}."\n";
    return(((defined $self->{'_GAUGE'}->{'FH'}) ? 1 : 0));
}
sub gauge_stop {
    my $self = $_[0];

    return(0) unless $self->{'_GAUGE'}->{'FH'};

    my $args = $self->{'_GAUGE'}->{'ARGS'};
    my $fh = $self->{'_GAUGE'}->{'FH'};
    $SIG_CODE->{$$} = $self; local $SIG{'PIPE'} = \&_del_gauge;
    $self->{'_GAUGE'}->{'FH'}->close();
    delete($self->{'_GAUGE'}->{'FH'});
    delete($self->{'_GAUGE'}->{'ARGS'});
    delete($self->{'_GAUGE'}->{'PERCENT'});
    delete($self->{'_GAUGE'});
    $self->rv('null');
    $self->rs('null');
    $self->ra('null');
    $self->_post($args);
    return(1);
}


1;