File Coverage

blib/lib/Term/Clui.pm

Criterion	Covered	Total	%
statement	9	1110	0.8
branch	2	594	0.3
condition	0	183	0.0
subroutine	4	59	6.7
pod	14	55	25.4
total	29	2001	1.4

# Term::Clui.pm
#########################################################################
#        This Perl module is Copyright (c) 2002, Peter J Billam         #
#               c/o P J B Computing, www.pjb.com.au                     #
#                                                                       #
#     This module is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

package Term::Clui;
our $VERSION = '1.76';
my $stupid_bloody_warning = $VERSION;  # circumvent -w warning
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ask ask_password ask_filename confirm
 choose help_text edit sorry view inform);
@EXPORT_OK = qw(beep tiview back_up get_default set_default timestamp);
%EXPORT_TAGS = (ALL => [@EXPORT,@EXPORT_OK]);

use 5.006;
no strict; no warnings;

my $have_Term_ReadKey = 1;
my $have_Term_Size = 0;
eval 'require "Term/ReadKey.pm"';
if ($@) {
	$have_Term_ReadKey = 0;
	$have_Term_Size = 1;
	eval 'require "Term/Size.pm"';
	if ($@) { $have_Term_Size = 0; }
}

my $Eflite;
my $Eflite_FH;  # open here at top-level so one sub can silence the previous
my $Espeak;
my $Espeak_PID;  # defined at top-level so one espeak can kill the previous
my $SpeakUpSilentFile;   # 1.62
if ($ENV{'CLUI_SPEAK'}) {  # 1.62 emacspeak not very relevant as a criterion
	for my $d ('/sys/accessibility', '/proc') {
		if (-w "$d/speakup/silent") {
			$SpeakUpSilentFile = "$d/speakup/silent"; break;
		}
	}
	$Eflite = &which('eflite');
	$Espeak = &which('espeak');
	if ($Eflite && !$Espeak) {   # 1.68 Espeak should be the default
		if (open($Eflite_FH,'|-',$Eflite)) {
			select((select($Eflite_FH), $| = 1)[0]); print $Eflite_FH q{};
		} else {
			warn "can't run $Eflite: $!\n";
		}
	} elsif (! $Espeak) {
		warn("Term::Clui warning: CLUI_SPEAK set; "
		. "but can't find eflite or espeak\n");
	}
}


# use open ':locale';  # the open pragma was introduced in 5.8.6
my $EncodingString = q{};
if (($ENV{LANG} =~ /utf-?8/i) || ($ENV{LC_TYPE} =~ /utf-?8/i)) {
	$EncodingString = ':encoding(utf8)';
}

# ------------------------ vt100 stuff -------------------------

$A_NORMAL    =  0;
$A_BOLD      =  1;
$A_UNDERLINE =  2;
$A_REVERSE   =  4;
$KEY_UP    = 0403;
$KEY_LEFT  = 0404;
$KEY_RIGHT = 0405;
$KEY_DOWN  = 0402;
$KEY_ENTER = "\r";
$KEY_INSERT = 0525;
$KEY_DELETE = 0524;
$KEY_HOME   = 0523;
$KEY_END    = 0522;
$KEY_PPAGE  = 0521;
$KEY_NPAGE  = 0520;
$KEY_BTAB   = 0541;
my $AbsCursX = 0; my $AbsCursY = 0; my $TopRow = 0; my $CursorRow;
my $LastEventWasPress = 0;  # in order to ignore left-over button-ups
my %SpecialKey = map { $_, 1 } (   # 1.51, used by ask to ignore these
	$KEY_UP, $KEY_LEFT, $KEY_RIGHT, $KEY_DOWN, $KEY_HOME, $KEY_END,
	$KEY_PPAGE, $KEY_NPAGE, $KEY_BTAB, $KEY_INSERT, $KEY_DELETE
);

my $irow; my $icol;   # maintained by &puts, &up, &down, &left and &right
sub puts   { my $s = join q{}, @_;
	$irow += ($s =~ tr/\n/\n/);
	if ($s =~ /\r\n?$/) { $icol = 0;
	} else { $icol += length($s);
	}
	print TTY $s;
}
# could terminfo sgr0, bold, rev, cub1, cuu1, cuf1, cud1 ...
sub attrset { my $attr = $_[0];
	if (! $attr) {
		print TTY "\e[0m";
	} else {
		if ($attr & $A_BOLD)      { print TTY "\e[1m" };
		if ($attr & $A_REVERSE)   { print TTY "\e[7m" };
		if ($attr & $A_UNDERLINE) { print TTY "\e[4m" };
	}
}
sub beep     { print TTY "\07"; }
sub clear    { print TTY "\e[H\e[J"; }
sub clrtoeol { print TTY "\e[K"; }
sub black    { print TTY "\e[30m"; }
sub red      { print TTY "\e[31m"; }
sub green    { print TTY "\e[32m"; }
sub blue     { print TTY "\e[34m"; }
sub violet   { print TTY "\e[35m"; }

sub getc_wrapper { my $timeout = 0 + $_[0];
	if ($have_Term_ReadKey) {
		return Term::ReadKey::ReadKey($timeout, *TTYIN);
	} else {
		#if ($timeout > 0.00001) {  # doesn't seem to work on openbsd...
		#	my $rin = q{};
		#	vec($rin,fileno(TTYIN),1) = 1;
		#	my $nfound = select($rin, undef, undef, $timeout);
		#	if (!$nfound) { return undef; }
		#}
		return getc(TTYIN);
	}
}

sub getch {
	my $c = getc_wrapper(0);
	if ($c eq "\e") {
		$c = getc_wrapper(0.10);

		if (! defined $c) { return("\e"); }
		if ($c eq 'A') { return($KEY_UP); }
		if ($c eq 'B') { return($KEY_DOWN); }
		if ($c eq 'C') { return($KEY_RIGHT); }
		if ($c eq 'D') { return($KEY_LEFT); }
		if ($c eq '2') { getc_wrapper(0); return($KEY_INSERT); }
		if ($c eq '3') { getc_wrapper(0); return($KEY_DELETE); } # 1.54
		if ($c eq '5') { getc_wrapper(0); return($KEY_PPAGE); }
		if ($c eq '6') { getc_wrapper(0); return($KEY_NPAGE); }
		if ($c eq 'Z') { return($KEY_BTAB); }
		if ($c eq 'O') {   # 1.68 Haiku wierdness, inherited from an old Suse
			$c = getc_wrapper(0);
			if ($c eq 'A') { return($KEY_UP); }    # 1.68
			if ($c eq 'B') { return($KEY_DOWN); }  # 1.68
			if ($c eq 'C') { return($KEY_RIGHT); } # 1.68
			if ($c eq 'D') { return($KEY_LEFT); }  # 1.68
			if ($c eq 'F') { return($KEY_END); }   # 1.68
			if ($c eq 'H') { return($KEY_HOME); }  # 1.68
			return($c);
		}
		if ($c eq '[') {
			$c = getc_wrapper(0);
			if ($c eq 'A') { return($KEY_UP); }
			if ($c eq 'B') { return($KEY_DOWN); }
			if ($c eq 'C') { return($KEY_RIGHT); }
			if ($c eq 'D') { return($KEY_LEFT); }
			if ($c eq 'F') { return($KEY_END); }   # 1.67
			if ($c eq 'H') { return($KEY_HOME); }  # 1.67
            if ($c eq 'M') {   # mouse report - we must be in BYTES !
				# http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
				my $event_type = ord(getc_wrapper(0))-32;
				my $x = ord(getc_wrapper(0))-32;
				my $y = ord(getc_wrapper(0))-32;
				# my $shift   = $event_type & 0x04; # used by wm
				# my $meta	= $event_type & 0x08;   # used by wm
				# my $control = $event_type & 0x10; # used by xterm
				my $button_drag = ($event_type & 0x20) >> 5;
				my $button_pressed;
				my $low3bits = $event_type & 0x03;
				if ($low3bits == 0x03) {
					$button_pressed = 0;
				} else {  # button 4 means wheel-up, button 5 means wheel-down
					if ($event_type & 0x40) { $button_pressed = $low3bits + 4;
					} else { $button_pressed = $low3bits + 1;
					}
				}
				return handle_mouse($x,$y,$button_pressed,$button_drag)
				 || getch();
			}
			if ($c =~ /\d/) { my $c1 = getc_wrapper(0);
				if ($c1 eq '~') {
					if ($c eq '2') { return($KEY_INSERT);
					} elsif ($c eq '3') { return($KEY_DELETE);
					} elsif ($c eq '5') { return($KEY_PPAGE);
					} elsif ($c eq '6') { return($KEY_NPAGE);
					}
				} else {   # cursor-position report, response to \e[6n
					$AbsCursY = 0 + $c;
					while (1) {
						last if $c1 eq ';';
						$AbsCursY = 10*$AbsCursY + $c1;
						# debug("c1=$c1 AbsCursY=$AbsCursY");
						$c1 = getc(TTYIN);
					}
					$AbsCursX = 0;
					while (1) {
						$c1 = getc(TTYIN);
						last if $c1 eq 'R';
						$AbsCursX = 10*$AbsCursX + $c1;
					}
					return getch();
				}
            }
			if ($c eq 'Z') { return($KEY_BTAB); }
			return($c);
		}
		return($c);
	#} elsif ($c eq ord(0217)) {  # 1.50 BUG what?? never gets here...
	#	$c = getc_wrapper(0);
	#	if ($c eq 'A') { return($KEY_UP); }
	#	if ($c eq 'B') { return($KEY_DOWN); }
	#	if ($c eq 'C') { return($KEY_RIGHT); }
	#	if ($c eq 'D') { return($KEY_LEFT); }
	#	return($c);
	#} elsif ($c eq ord(0233)) {  # 1.50 BUG what?? never gets here...
	#	$c = getc_wrapper(0);
	#	if ($c eq 'A') { return($KEY_UP); }
	#	if ($c eq 'B') { return($KEY_DOWN); }
	#	if ($c eq 'C') { return($KEY_RIGHT); }
	#	if ($c eq 'D') { return($KEY_LEFT); }
	#	if ($c eq '5') { getc_wrapper(0); return($KEY_PPAGE); }
	#	if ($c eq '6') { getc_wrapper(0); return($KEY_NPAGE); }
	#	if ($c eq 'Z') { return($KEY_BTAB); }
	#	return($c);
	} else {
		return($c);
	}
}
sub up    {
	# if ($_[0] < 0) { &down(0 - $_[0]); return; }
	print TTY "\e[A" x $_[0]; $irow -= $_[0];
}
sub down  {
	# if ($_[0] < 0) { &up(0 - $_[0]); return; }
	print TTY "\n" x $_[0]; $irow += $_[0];
}
sub right {
	# if ($_[0] < 0) { &left(0 - $_[0]); return; }
	print TTY "\e[C" x $_[0]; $icol += $_[0];
}
sub left  {
	# if ($_[0] < 0) { &right(0 - $_[0]); return; }
	print TTY "\e[D" x $_[0]; $icol -= $_[0];
}
sub goto { my $newcol = shift; my $newrow = shift;
	if ($newcol == 0) { print TTY "\r" ; $icol = 0;
	} elsif ($newcol > $icol) { &right($newcol-$icol);
	} elsif ($newcol < $icol) { &left($icol-$newcol);
	}
	if ($newrow > $irow)      { &down($newrow-$irow);
	} elsif ($newrow < $irow) { &up($irow-$newrow);
	}
}
# sub move { my ($ix,$iy) = @_; printf TTY "\e[%d;%dH",$iy+1,$ix+1; }

my $InitscrAlreadyRun = 0;
my $IsMouseMode  = 0;
my $WasMouseMode = 0;
my $IsSpeakUpSilent  = 0;  # 1.62
my $WasSpeakUpSilent = 0;  # 1.62
my $Stty = q{};

sub enter_mouse_mode {   # 1.50
	if ($ENV{'CLUI_MOUSE'} eq 'OFF') { return 0; }   # 1.62
	if ($IsMouseMode) {
		warn "enter_mouse_mode but already IsMouseMode\r\n"; return 1 ;
	}
	if ($EncodingString) {
		close TTYIN;
		open(TTYIN, "<:bytes", '/dev/tty')
			 || (warn "Can't read /dev/tty: $!\n", return 0);
	}
	print TTY "\e[?1003h";   # sets   SET_ANY_EVENT_MOUSE  mode
	$IsMouseMode = 1;
	return 1;
}
sub leave_mouse_mode {   # 1.50
	# if ($ENV{'CLUI_MOUSE'} =~ /off/i) { return 0; }   # 1.62
	if (!$IsMouseMode) {
		warn "leave_mouse_mode but not IsMouseMode\r\n"; return 1 ;
	}
	if ($EncodingString) {
		close TTYIN;
		open(TTYIN, "<$EncodingString", '/dev/tty')
 		 || (warn "Can't read /dev/tty: $!\n", return 0);
	}
	print TTY "\e[?1003l";   # cancels SET_ANY_EVENT_MOUSE mode
	$IsMouseMode = 0;
	return 1;
}

sub enter_speakup_silent {   # 1.62
	# echo 7 > /sys/accessibility/speakup/silent  if it exists
	if (!$SpeakUpSilentFile) { return 0; }
	if ($IsSpeakUpSilent) {
		warn "enter_speakup_silent but already IsSpeakUpSilent\r\n"; return 1 ;
	}
	if (open(S, '>', $SpeakUpSilentFile)) { print S "7\n"; close S; }
	$IsSpeakUpSilent = 1;
	return 1;
}
sub leave_speakup_silent {   # 1.62
	# echo 4 > /sys/accessibility/speakup/silent  if it exists
	if (!$SpeakUpSilentFile) { return 0; }
	if (!$IsSpeakUpSilent) {
		warn "leave_speakup_silent but not IsSpeakUpSilent\r\n"; return 1 ;
	}
	if (open(S, '>', $SpeakUpSilentFile)) { print S "4\n"; close S; }
	$IsSpeakUpSilent = 0;
	return 1;
}

sub initscr { my %args = @_;
	my $mouse_mode = $args{'mouse_mode'};          # for mouse-handling
	if ($ENV{'CLUI_MOUSE'} eq 'OFF') { $mouse_mode = undef; }  # 1.62
	my $speakup_silent = $args{'speakup_silent'};  # to silence SpeakUp
	if ($InitscrAlreadyRun) {
		$InitscrAlreadyRun++;
		if (!$mouse_mode and $IsMouseMode) {
			leave_mouse_mode() or return 0;
		} elsif ($mouse_mode and !$IsMouseMode) {
			enter_mouse_mode() or return 0;
		}
		$WasMouseMode = $IsMouseMode;
		if (!$speakup_silent and $IsSpeakUpSilent) {   # 1.62
			leave_speakup_silent() or return 0;
		} elsif ($speakup_silent and !$IsSpeakUpSilent) {
			enter_speakup_silent() or return 0;
		}
		$WasSpeakUpSilent = $IsSpeakUpSilent;
		$icol = 0; $irow = 0;
		return;
	}
	open(TTY, ">$EncodingString", '/dev/tty')   # 1.43
	 || (warn "Can't write /dev/tty: $!\n", return 0);
	if (!$have_Term_ReadKey) { $Stty = `stty -g`; chop $Stty; }
	my $encoding_string;
	if ($mouse_mode) {
		$IsMouseMode = 1; $encoding_string = ':bytes';
		print TTY "\e[?1003h";   # sets  SET_ANY_EVENT_MOUSE  mode
	} else {
		$IsMouseMode = 0; $encoding_string = $EncodingString;
	}
	if ($speakup_silent and !$IsSpeakUpSilent) { enter_speakup_silent(); }
	open(TTYIN, "<$encoding_string", '/dev/tty')
	 || (warn "Can't read /dev/tty: $!\n", return 0);

	if ($have_Term_ReadKey) {
		Term::ReadKey::ReadMode('ultra-raw', *TTYIN);
	} else {
		if ($^O =~ /^FreeBSD$/i) { system("stty -echo -icrnl raw
		} else { system("stty -echo -icrnl raw /dev/tty");
		}
	}
	select((select(TTY), $| = 1)[0]); print TTY q{};
	$rin = q{}; vec($rin, fileno(TTYIN), 1) = 1;
	$icol = 0; $irow = 0; $InitscrAlreadyRun = 1;
}

sub endwin {
	print TTY "\e[0m";
	if ($InitscrAlreadyRun > 1) {
		if      ($IsMouseMode and !$WasMouseMode) { leave_mouse_mode();
		} elsif (!$IsMouseMode and $WasMouseMode) { enter_mouse_mode();
		}
		if      ($IsSpeakUpSilent and !$WasSpeakUpSilent) {   # 1.62
			leave_speakup_silent();
		} elsif (!$IsSpeakUpSilent and $WasSpeakUpSilent) {
			enter_speakup_silent();
		}
		$InitscrAlreadyRun--; return;
	}
	print TTY "\e[?1003l";   $IsMouseMode = 0;
	if ($IsSpeakUpSilent) { leave_speakup_silent(); }
	if ($have_Term_ReadKey) {
		Term::ReadKey::ReadMode('restore', *TTYIN);
		close TTY; close TTYIN;
	} else {
		close TTY; close TTYIN;
		if ($^O =~ /^FreeBSD$/i) { system("stty $Stty
		} else { system("stty $Stty /dev/tty") if $Stty;
		}
	}
	$InitscrAlreadyRun = 0;
}

# ----------------------- size handling ----------------------

my ($maxcols, $maxrows); my $size_changed = 1;
my @OtherLines;  # 20131002 $otherlines, $notherlines no longer global

sub check_size {
	if (! $size_changed) { return; }
	if ($have_Term_ReadKey) {
		($maxcols, $maxrows) = Term::ReadKey::GetTerminalSize(*STDERR);
	} elsif ($have_Term_Size) {
		($maxcols, $maxrows) = Term::Size::chars(*STDERR);
	} else {
		$maxcols = `tput cols`;
		$maxrows = (`tput lines` + 0) || (`tput rows` + 0);
	}
	$maxcols = $maxcols || 80; $maxcols--;
	$maxrows = $maxrows || 24;
	if (@OtherLines) {
		@OtherLines = &fmt(join("\n",@OtherLines));
	}
	$size_changed = 0;
}
$SIG{'WINCH'} = sub { $size_changed = 1; };

# ------------------------ ask stuff -------------------------

# Options such as integer, real, positive, >x, >=x,
# non-null, max-length, min-length, silent  ...
# default could be just one more option, and backward compatibilty
# could be preserved by checking whether the 2nd arg is a hashref ...

sub ask_filename { my ($question, $default) = @_;  # 1.65 tab-completion
	eval 'require Term::ReadLine'; if ($@) {
		sorry("you should install Term::ReadLine::Gnu from www.cpan.org");
		return ask($question, $default);
	}
	initscr(speakup_silent=>1);
	endwin();
	$term = Term::ReadLine->new('ProgramName');
	my $filename = $term->readline($question.' ');   # 1.70
	print STDERR "\e[J";
	$filename =~ s/ $//;   # 1.66
	return $filename;
}
sub ask_password { # no echo - use for passwords
	local ($silent) = 'yes'; &ask($_[0]);
}
sub ask { my ($question, $default) = @_;
	return q{} unless $question;
	&initscr(speakup_silent=>1);
	my $nol = &display_question($question);

	my $i = 0; my $n = 0; my @s = (); # cursor position, length, string
	if (defined $default) {  # 1.69 defined, to include 0
		&speak("$question, default is $default");
		$default =~ s/\t/	/g;
		@s = split(q{}, $default); $n = scalar @s; $i = 0;
		foreach $j (0 .. $#s) { &puts($s[$j]); }
		&left($n);
	} else {
		&speak($question);
	}

	while (1) {
		my $c = &getch();
		if ($c eq "\r") { &erase_lines(1); last; }
		if ($size_changed) {
			&erase_lines(0); $nol = &display_question($question);
		}
		if ($c == $KEY_LEFT) {
			if ($i > 0) { $i--; &left(1); }  # 1.44
		} elsif ($c == $KEY_RIGHT) {
			if ($i < $n) { &puts($silent ? "x" : $s[$i]); $i++; }
		} elsif ($c == $KEY_DELETE) {  # 1.54
			if ($i < $n) {
			 	$n--; splice(@s, $i, 1);
			  	foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); } # 1.67
			  	&clrtoeol(); &left($n-$i);
			}
		} elsif (($c eq "\cH") || ($c eq "\c?")) {
			if ($i > 0) {
			 	$n--; $i--;
				if (! $silent) { &speak($s[$i]); }   # 1.63
				splice(@s, $i, 1); &left(1);
			  	foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); } # 1.67
			  	&clrtoeol(); &left($n-$i);
			}
		} elsif ($c eq "\cC") {  # 1.56
			&erase_lines(1); &endwin();
			warn "^C\n"; kill('INT', $$); return undef;
		} elsif ($c eq "\cX" || $c eq "\cD") {  # clear ...
			&left($i); $i = 0; $n = 0; &clrtoeol(); @s = ();
		} elsif ($c eq "\cA" || $c == $KEY_HOME) { &left($i); $i = 0;
		} elsif ($c eq "\cE" || $c == $KEY_END)  { &right($n-$i); $i = $n;
		} elsif ($c eq "\cL") { &speak(join("", @s));  # redraw ...
		} elsif ($SpecialKey{$c}) { &beep();
		} elsif (ord($c) >= 32) {  # 1.51
			splice(@s, $i, 0, $c);
			&puts($silent ? "x" : $c);
			if (! $silent) {  &speak($c); }
			$n++; $i++;
			foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); }  # 1.67
			&clrtoeol();  &left($n-$i);
		} else { &beep();
		}
	}
	&speak(join("", @s), 'wait');
	&endwin(); $silent = q{}; return join("", @s);
}

# ----------------------- choose stuff -------------------------
sub debug {
	if (! open (DEBUG, '>>/tmp/clui.log')) {
		warn "can't open /tmp/clui.log: $!\n"; return;
	}
	print DEBUG "$_[0]\n"; close DEBUG;
}

my (%irow, %icol, $nrows, $clue_has_been_given, $choice, $this_cell);
my @marked;
my $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];
srand(time() ^ ($$+($$<15)));

sub choose {  my $question = shift; local @list = @_;  # @list must be local
	# As from 1.22, allows multiple choice if called in array context

	return unless @list;
	grep (($_ =~ s/[\r\n]+$//) && 0, @list);	# chop final newlines
	my @biglist = @list; my $icell; @marked = ();

	$question =~ s/^[\n\r]+//;   # strip initial newline(s)
	$question =~ s/[\n\r]+$//;   # strip final newline(s)
	my ($firstline,$otherlines) = split(/\r?\n/, $question, 2);
	my $firstlinelength = length $firstline;

	$choice = &get_default($firstline);
	# If wantarray ? Is remembering multiple choices safe ?

	&initscr(mouse_mode=>1, speakup_silent=>1);
	&size_and_layout(0);
	@OtherLines = &fmt($otherlines);
	my $speaktext = join(' ',$list[$this_cell],'. ',@OtherLines);
	if (wantarray) {
		$#marked = $#list;
		if ($firstlinelength < $maxcols-30) {
			&puts("$firstline (multiple choice with spacebar)\n\r");
		} elsif ($firstlinelength < $maxcols-16) {
			&puts("$firstline (multiple choice)\n\r");
		} elsif ($firstlinelength < $maxcols-9) {
			&puts("$firstline (multiple)\n\r");
		} else {
			&puts("$firstline\n\r");
		}
		if ($nrows >= $maxrows) { &speak("$firstline, ", 'wait');
		} else { &speak("$firstline, multiple choice, $speaktext");
		}
	} else {
		&puts("$firstline\n\r");
		if ($nrows >= $maxrows) { &speak("$firstline, ", 'wait');
		} else { &speak("$firstline, choose, $speaktext");
		}
	}
	if ($nrows >= $maxrows) {
		@list = &narrow_the_search(@list);
		if (! @list) {
			&up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0;
			return wantarray ? () : undef;
		}
		my $speaktext = join(' ',$list[$this_cell],'. ',@OtherLines);
		&speak("choose, $speaktext");
	}
	&wr_screen();
	# the cursor is now on this_cell, not on the question
	print TTY "\e[6n";  # terminfo u7, will set $AbsCursX,$AbsCursY
	$CursorRow = $irow[$this_cell];  # global, needed by handle_mouse

	while (1) {
		$c = &getch();
		if ($size_changed) {
			&size_and_layout($nrows);
			if ($nrows >= $maxrows) {
				@list = &narrow_the_search(@list);
				if (! @list) {
					&up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0;
					return wantarray ? () : undef;
				}
			}
			&wr_screen();
			&speak("choose, $list[$this_cell]");
		}
		if ($c eq "q" || $c eq "\cD" || $c eq "\cX") {
			&erase_lines(1);
			if ($clue_has_been_given) {
				my $re_clue = &confirm("Do you want to change your clue ?");
				&up(1); &clrtoeol();   # erase the confirm
				if ($re_clue) {
					$irow = 1;
					@list = &narrow_the_search(@biglist); &wr_screen();
					&speak("choose, $list[$this_cell]");
					next;
				} else {
					&up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0;
					return wantarray ? () : undef;
				}
			}
			&goto(0,0); &clrtoeol(); &endwin(); $clue_has_been_given = 0;
			return wantarray ? () : undef;
		} elsif (($c eq "\t") && ($this_cell < $#list)) {
			$this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ((($c eq "l") || ($c == $KEY_RIGHT)) && ($this_cell < $#list)
			&& ($irow[$this_cell] == $irow[$this_cell+1])) {
			$this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ((($c eq "\cH") || ($c == $KEY_BTAB)) && ($this_cell > 0)) {
			$this_cell--; &wr_cell($this_cell+1); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ((($c eq "h") || ($c == $KEY_LEFT)) && ($this_cell > 0)
			&& ($irow[$this_cell] == $irow[$this_cell-1])) {
			$this_cell--; &wr_cell($this_cell+1); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ((($c eq "j") || ($c == $KEY_DOWN)) && ($irow < $nrows)) {
			my $mid_col = $icol[$this_cell] + 0.5 * length($list[$this_cell]);
			my $left_of_target = 1000;
			for ($inew=$this_cell+1; $inew < $#list; $inew++) {
				last if $icol[$inew] < $mid_col;	# skip rest of row
			}
			my $new_mid_col = 0;
			for (; $inew < $#list; $inew++) {
				$new_mid_col = $icol[$inew] + 0.5*length($list[$inew]);
				last if $new_mid_col >= $mid_col;		# we've reached it
				last if $icol[$inew+1] <= $icol[$inew]; # we're at EOL
				$left_of_target = $mid_col - $new_mid_col;
			}
			if (($new_mid_col - $mid_col) > $left_of_target) { $inew--; }
			$iold = $this_cell; $this_cell = $inew;
			&wr_cell($iold); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ((($c eq "k") || ($c == $KEY_UP)) && ($irow > 1)) {
			my $mid_col = $icol[$this_cell] + 0.5*length($list[$this_cell]);
			my $right_of_target = 1000;
			for ($inew=$this_cell-1; $inew > 0; $inew--) {
				last if $irow[$inew] < $irow[$this_cell];	# skip rest of row
			}
			my $new_mid_col = 0;
			for (; $inew > 0; $inew--) {
				last unless $icol[$inew];
				$new_mid_col = $icol[$inew] + 0.5*length($list[$inew]);
				last if $new_mid_col <= $mid_col;		 # we're past it
				$right_of_target = $new_mid_col - $mid_col;
			}
			if (($mid_col - $new_mid_col) > $right_of_target) { $inew++; }
			$iold = $this_cell; $this_cell = $inew;
			&wr_cell($iold); &wr_cell($this_cell);
			&speak($list[$this_cell]);
		} elsif ($c eq "\cL") {
			if ($size_changed) {
				&size_and_layout($nrows);
				if ($nrows >= $maxrows) {
					@list = &narrow_the_search(@list);
					if (! @list) {
						&up(1); &clrtoeol(); &endwin();
						$clue_has_been_given = 0;
						return wantarray ? () : undef;
					}
				}
			}
			&wr_screen();
		} elsif ($c eq "\cC") {  # 1.56
			&erase_lines(1); &endwin();
			warn "^C\n"; kill('INT', $$); return undef;
		} elsif ($c eq "\r") {
			&erase_lines(1); &goto($firstlinelength+1, 0);
			my @chosen;
			if (wantarray) {
				my $i; for ($i=0; $i<=$#list; $i++) {
					if ($marked[$i] || $i==$this_cell) {
						push @chosen, $list[$i];
					}
				}
				&clrtoeol();
				my $remaining = $maxcols-$firstlinelength;
				my $last = pop @chosen;
				my $dotsprinted;
				foreach (@chosen) {
					if (($remaining - length $_) < 4) {
						$dotsprinted=1; &puts("..."); $remaining -= 3; last;
					} else {
						&puts("$_, "); $remaining -= (2 + length $_);
					}
				}
				if (!$dotsprinted) {
					if (($remaining - length $last)>0) { &puts($last);
					} elsif ($remaining > 2) { &puts('...');
					}
				}
				&puts("\n\r");
				push @chosen, $last;
			} else {
				&puts($list[$this_cell]."\n\r");
			}
			&endwin();
			&set_default($firstline, $list[$this_cell]); # join($,,@chosen) ?
			$clue_has_been_given = 0;
			if (wantarray) {
				&speak(join(' and ',@chosen), 'wait'); return @chosen;
			} else {
				&speak($list[$this_cell], 'wait'); return $list[$this_cell];
			}
		} elsif ($c eq " ") {
			if (wantarray) {
				$marked[$this_cell] = !$marked[$this_cell];
				#if ($this_cell < $#list) {
					#  $this_cell++; &wr_cell($this_cell-1); # 1.50
				&wr_cell($this_cell);
				&speak('marked');
				#}
			#} elsif ($this_cell < $#list) {
			#	$this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell);
			}
		} elsif ($c eq "?") {
			warn "help\r\n";
		}
	}
	&endwin();
	warn "choose: shouldn't reach here ...\n";
}
sub layout { my @list = @_;
	$this_cell = 0; my $irow = 1; my $icol = 0;  my $i;
	for ($i=0; $i<=$#list; $i++) {
		$l[$i] = length($list[$i]) + 2;
		if ($l[$i] > $maxcols-1) { $l[$i] = $maxcols-1; }  # 1.42
		if (($icol + $l[$i]) >= $maxcols ) { $irow++; $icol = 0; }
		if ($irow > $maxrows) { return $irow; }  # save time
		$irow[$i] = $irow; $icol[$i] = $icol;
		$icol += $l[$i];
		if ($list[$i] eq $choice) { $this_cell = $i; }
	}
	return $irow;
}
sub wr_screen {
	for (my $i=0; $i<=$#list; $i++) {
		&wr_cell($i) unless $i==$this_cell;
	}
	my $notherlines = scalar @OtherLines;
	if ($notherlines && ($nrows+$notherlines) < $maxrows) {
		&puts("\r\n", join("\r\n", @OtherLines), "\r");
	}
	&wr_cell($this_cell);
}
sub wr_cell { my $i = shift;
	my $no_tabs = $list[$i];
	$no_tabs =~ s/\t/ /g;
	&goto($icol[$i], $irow[$i]);
	if ($marked[$i]) { &attrset($A_BOLD | $A_UNDERLINE); }
	if ($i == $this_cell) { &attrset($A_REVERSE); }
	&puts(substr " $no_tabs ", 0, $maxcols);  # 1.42, 1.54
	if ($marked[$i] || $i == $this_cell) { &attrset($A_NORMAL); }
}
sub size_and_layout {
	my $erase_rows = shift;
	&check_size();
	if ($erase_rows) {
		if ($erase_rows > $maxrows) { $erase_rows = $maxrows; } # XXX?
		&erase_lines(1);
	}
	$nrows = &layout(@list);
}
sub narrow_the_search { my @biglist = @_;
	# replaces the old ... require 'complete.pl';
	# return &Complete("$firstline (TAB to complete, ^D to list) ", @list);
	my $nchoices = scalar @_;
	my $n; my $i; my @s; my $s; my @list = @biglist;
	$clue_has_been_given = 1;
	if ($IsMouseMode) { leave_mouse_mode(); }
	&ask_for_clue($nchoices, $i, $s);
	while (1) {
		$c = &getch();
		if ($size_changed) {
			&size_and_layout(0);
			if ($nrows < $maxrows) {
				&erase_lines(1); enter_mouse_mode(); return @list;
			}
		}
		if ($c == $KEY_LEFT && $i > 0) { $i--; &left(1); next;
		} elsif ($c == $KEY_RIGHT) {
			if ($i < $n) { &puts($s[$i]); $i++; next; }
		} elsif (($c eq "\cH") || ($c eq "\c?")) {
			if ($i > 0) {
			 	$n--; $i--;
				&speak($s[$i], 'wait');   # 1.63
				splice(@s, $i, 1); &left(1);
			  	foreach $j ($i..$n) { &puts($s[$j]); }
				&clrtoeol(); &left($n-$i);
			}
		} elsif ($c eq "\cC") {  # 1.56
			&erase_lines(1); &endwin();
			warn "^C\n"; kill('INT', $$); return undef;
		} elsif ($c eq "\cX" || $c eq "\cD") {  # clear ...
			if (! @s) {   # 20070305 ?
				$clue_has_been_given = 0; &erase_lines(1);
				enter_mouse_mode(); return ();
			}
			&left($i); $i = 0; $n = 0; @s = (); &clrtoeol();
		} elsif ($c eq "\cA") { &left($i); $i = 0; next;
		} elsif ($c eq "\cE") { &right($n-$i); $i = $n; next;
		} elsif ($c eq "\cL") {
		} elsif ($SpecialKey{$c}) { &beep();
		} elsif (ord($c) >= 32) {  # 1.51
			splice(@s, $i, 0, $c);
			$n++; $i++; &puts($c);
			foreach $j ($i..$n) { &puts($s[$j]); } &clrtoeol();  &left($n-$i);
			&speak($c, 'wait');   # 1.63
		} else { &beep();
		}
		# grep, and if $nchoices=1 return
		$s = join("", @s);
		@list = grep(0 <= index($_,$s), @biglist);
		$nchoices = scalar @list;
		$nrows = &layout(@list);
		if ($nchoices==1 || ($nchoices && ($nrows<$maxrows))) {
			&puts("\r"); &clrtoeol(); &up(1); &clrtoeol();
			enter_mouse_mode(); return @list;
		}
		&ask_for_clue($nchoices, $i, $s);
	}
	warn "narrow_the_search: shouldn't reach here ...\n";
}
sub ask_for_clue { my ($nchoices, $i, $s) = @_;
	if ($nchoices) {
		if ($s) {
			my $headstr = "the choices won't fit; there are still";
			&goto(0,1); &puts("$headstr $nchoices of them"); &clrtoeol();
			&goto(0,2); &puts("lengthen the clue : "); &right($i);
			&speak("still $nchoices choices, lengthen the clue");
		} else {
			my $headstr = "the choices won't fit; there are";
			&goto(0,1); &puts("$headstr $nchoices of them"); &clrtoeol();
			&goto(0,2);
			&puts("   give me a clue :             (or ctrl-X to quit)");
			&left(31);   # 1.62
			&speak("$nchoices choices, give me a clue, or control-X to quit");
		}
	} else {
		&goto(0,1); &puts("No choices fit this clue !"); &clrtoeol();
		&goto(0,2); &puts(" shorten the clue : "); &right($i);
		&speak("no choices fit, shorten the clue");
	}
}
sub get_default { my ($question) = @_;
	if ($ENV{CLUI_DIR} =~ /off/i) { return undef; }
	if (! $question) { return undef; }
	my @choices;
	my $n_tries = 5;
	while ($n_tries--) {
		if (dbmopen (%CHOICES, &dbm_file(), 0600)) {
			last;
		} else {
			if ($! eq 'Resource temporarily unavailable') {
				my $wait = rand 0.45; select undef, undef, undef, $wait;
			} else { return undef;
			}
		}
	}
	@choices = split ($; ,$CHOICES{$question}); dbmclose %CHOICES;
	if (wantarray) { return @choices;
	} else { return $choices[0];
	}
}
sub set_default { my $question = shift; my $s = join($; , @_);
	if ($ENV{CLUI_DIR} =~ /off/i) { return undef; }
	if (! $question) { return undef; }
	my $n_tries = 5;
	while ($n_tries--) {
		if (dbmopen(%CHOICES, &dbm_file(), 0600)) {
			last;
		} else {
			if ($! eq 'Resource temporarily unavailable') {
				my $wait = rand 0.50; select undef, undef, undef, $wait;
			} else { return undef;
			}
		}
	}
	$CHOICES{$question} = $s; dbmclose %CHOICES;
	return $s;
}
sub dbm_file {
	if ($ENV{CLUI_DIR} =~ /off/i) { return undef; }
	my $db_dir;
	if ($ENV{CLUI_DIR}) {
		$db_dir = $ENV{CLUI_DIR};
		$db_dir =~ s#^~/#$HOME/#;
	} else { $db_dir = "$HOME/.clui_dir";
	}
	mkdir ($db_dir,0750);
	return "$db_dir/choices";
}
sub handle_mouse { my ($x, $y, $button_pressed, $button_drag) = @_;  # 1.50
	$TopRow = $AbsCursY - $CursorRow;
	if ($LastEventWasPress) { $LastEventWasPress = 0; return(''); }
	return('') unless $y >= $TopRow;
	my $mouse_row = $y - $TopRow;
	my $mouse_col = $x - 1;
	# debug("x=$x y=$y TopRow=$TopRow mouse_row=$mouse_row");
	# debug("button_pressed=$button_pressed button_drag=$button_drag");
	my $found = 0;
	my $i = 0; while ($i < @irow) {
		if ($irow[$i] == $mouse_row) {
			# debug("list[$i]=$list[$i] is the right row");
			if ($icol[$i] < $mouse_col
			 and ($icol[$i]+length($list[$i]) >= $mouse_col)) {
				$found = 1; last;
			}
			last if $irow[$i] > $mouse_row;
		}
		$i += 1;
	}
	return unless $found;
	# if xterm doesn't receive a button-up event it thinks it's dragging
	my $return_char = q{};
	if ($button_pressed == 1 and !$button_drag) {
		$LastEventWasPress = 1;
		$return_char = $KEY_ENTER;
	} elsif ($button_pressed == 3 and !$button_drag) {
		$LastEventWasPress = 1;
		$return_char = q{ };
	}
	if ($i != $this_cell) {
		my $t = $this_cell; $this_cell = $i;
		&wr_cell($t); &wr_cell($this_cell);
	}
	return $return_char;
}
sub help_text { # 1.54
	my $text;
	if ($_[0] eq 'ask') {
		return "\nLeft and Right arrowkeys, Backspace, Delete; control-A = "
		 . " beginning; control-E = end; control-X = clear; then Return.";
	}
	if ($ENV{'CLUI_MOUSE'} eq 'OFF') {
		$text = "\nmove around with Arrowkeys (or hjkl);";
	} else {
		$text = "\nmove around with Mouse or Arrowkeys (or hjkl);";
	}
	if ($_[0] =~ /^mult/) {
		$text .= " multiselect with Rightclick or Spacebar;";
	}
	$text .= " then either q or ctrl-X for quit,";
	if ($ENV{'CLUI_MOUSE'} eq 'OFF') {
		$text .= " or Return to choose.";
	} else {
		$text .= " or choose with Leftclick or Return.";
	}
}

# ----------------------- confirm stuff -------------------------

sub confirm { my $question = shift;  # asks user Yes|No, returns 1|0
	return(0) unless $question;  return(0) unless -t STDERR;
	&initscr(speakup_silent=>1);
	my $nol = &display_question($question); &puts(" (y/n) ");
	&speak($question . ', y or n');
	while (1) {
		$response=&getch();
		if ($response eq "\cC") {  # 1.56
			&erase_lines(1); &endwin();
			warn "^C\n"; kill('INT', $$); return undef;
		}
		last if ($response=~/[yYnN]/);
		&beep();
	}
	&left(6); &clrtoeol();
	if ($response=~/^[yY]/) {
		&puts("Yes");
		&speak('yess', 'wait');
	} else {
		&puts("No");
		&speak('know', 'wait');
	}
	&erase_lines(1); &endwin();
	if ($response =~ /^[yY]/) { return 1; } else { return 0 ; }
}

# ----------------------- edit stuff -------------------------

sub edit {	my ($title, $text) = @_;
	my $argc = $#_ - 0 +1;
	my ($dirname, $basename, $rcsdir, $rcsfile, $rcs_ok);

	if ($argc == 0) {	# start editor session with no preloaded file
		system $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db
	} elsif ($argc == 2) {
		# must create tmp file with title embedded in name
		my $tmpdir = '/tmp';
		my $safename = $title;
		$safename =~ s/[\W_]+/_/g;
		my $file = "$tmpdir/$safename.$$";
		if (!open(F,">$file")) {&sorry("can't open $file: $!\n");return q{};}
		print F $text; close F;
		$editor = $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db
		system "$editor $file";
		if (!open(F,"< $file")) {&sorry("can't open $file: $!\n");return 0;}
		undef $/; $text = ; $/ = "\n";
		close F; unlink $file; return $text;
	} elsif ($argc == 1) {	# its a file, we will try RCS ...
		my $file = $title;

		# weed out no-go situations
		if (-d $file) {&sorry("$file is already a directory\n"); return 0;}
		if (-B _ && -s _) {&sorry("$file is not a text file\n"); return 0;}
		if (-T _ && !-w _) { &view($file); return 1; }

		# it's a writeable text file, so work out the locations
		if ($file =~ /\//) {
			($dirname, $basename) = $file =~ /^(.*)\/([^\/]+)$/;
			$rcsdir  = "$dirname/RCS";
			$rcsfile = "$rcsdir/$basename,v";
		} else {
			$basename = $file;
			$rcsdir  = "RCS";
			$rcsfile = "$rcsdir/$basename,v";
		}
		$rcslog = "$rcsdir/log";

		# we no longer create the RCS directory if it doesn't exist,
		# so `mkdir RCS' to enable rcs in a directory ...
		$rcs_ok = 1;	if (!-d $rcsdir) { $rcs_ok = 0; }
		if (-d _ && ! -w _) { $rcs_ok = 0;	warn "can't write in $rcsdir\n"; }

		# if the file doesn't exist, but the RCS does, then check it out
		if ($rcs_ok && -f $rcsfile && !-f $file) {
			system "co -l $file $rcsfile";
		}

		my $starttime = time;
		$editor = $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db
		system "$editor $file";
		my $elapsedtime = time - $starttime;
		# could be output or logged, for worktime accounting

		if ($rcs_ok && -T $file) {	 # check it in
			if (!-f $rcsfile) {
				my $msg = &ask("$file is new. Please describe it:");
				my $quotedmsg = $msg;  $quotedmsg =~ s/'/'"'"'/g;
				if ($msg) {
					system "ci -q -l -t-'$quotedmsg' -i $file $rcsfile";
					&logit($basename, $msg);
				}
			} else {
				my $msg = &ask("What changes have you made to $file ?");
				my $quotedmsg = $msg;  $quotedmsg =~ s/'/'"'"'/g;
				if ($msg) {
					system "ci -q -l -m'$quotedmsg' $file $rcsfile";
					&logit($basename, $msg);
				}
			}
		}
	}
}
sub logit { my ($file, $msg) = @_;
	if (! open(LOG, ">> $rcslog")) {  warn "can't open $rcslog: $!\n";
	} else {
		$pid = fork;	# log in background for better response time
		if (! $pid) {
			($user) = getpwuid($>);
			print LOG ×tamp, " $file $user $msg\n"; close LOG;
			if ($pid == 0) { exit 0; }	# the child's end, if a fork occurred
		}
	}
}
sub timestamp {
	# returns current date and time in "199403011 113520" format
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
	$wday += 0; $yday += 0; $isdst += 0; # avoid bloody -w warning
	return sprintf("%4.4d%2.2d%2.2d %2.2d%2.2d%2.2d",
		$year+1900, $mon+1, $mday, $hour, $min, $sec);
}

# ----------------------- sorry stuff -------------------------

sub sorry { # warns user of an error condition
	print STDERR "Sorry, $_[0]\n";
	&speak("Sorry, $_[0]", 'wait');
}
sub inform { my $text = $_[0];
	$text =~ s/([^\n])$/$1\n/s;
	if (open(TTY, ">$EncodingString", '/dev/tty')) {  # 1.43
		print TTY $text; close TTY;
	} else { warn $text;
	}
	&speak($text, 'wait');
}

# ----------------------- view stuff -------------------------

foreach $f ("/usr/bin/less", "/usr/bin/more") {
	if (-x $f) { $default_pager = $f; }
}
sub view {	my ($title, $text) = @_;	# or ($filename) =
	my $pager = $ENV{PAGER} || $default_pager;
	if (! $text and ($title =~ /\.doc$/i) and -r $title) {   # 1.65
		my $wvText = which('wvText');   if ($wvText) {
			my $tmpf = "/tmp/wv$$";
			system "$wvText '$title' $tmpf"; system "$pager $tmpf";
			unlink $tmpf; return 1;
		}
		my $antiword = which('antiword');   if ($antiword) {
			system "$antiword -i 1 '$title' | $pager"; return 1;
		}
		my $catdoc = which('catdoc');   if ($catdoc) {
			system "$catdoc '$title' | $pager"; return 1;
		}
		sorry("it's a .doc file; you need to install wv, antiword or catdoc");
		return 0;
	} elsif (! $text && -T $title && open(F,"< $title")) {
		$nlines = 0;
		while () { last if ($nlines++ > $maxrows); } close F;
		if ($nlines > (0.6*$maxrows)) {
			system "$pager  \'$title\'";
		} else {
			open(F,"< $title"); undef $/; $text=; $/="\n"; close F;
			&tiview($title, $text);
		}
	} else {
		local (@lines) = split(/\r?\n/, $text, $maxrows);
		if (($#lines) < 21) {
			&tiview($title, $text);
		} else {
			local ($safetitle); ($safetitle = $title) =~ s/[^a-zA-Z0-9]+/_/g;
			local ($tmp) = "/tmp/$safetitle.$$";
			if (!open(TMP, ">$tmp")) {warn "can't open $tmp: $!\n"; return;}
			print TMP $text;	close TMP;
			system "$pager \'$tmp\'";
			unlink $tmp;
			return 1;
		}
	}
}
sub tiview {	my ($title, $text) = @_;
	return unless $text;
	$title =~ s/\t/ /g; my $titlelength = length $title;

	&check_size();
	my @rows = &fmt($text, nofill=>1);
	&initscr();
	if (3 > scalar @rows) {
		&puts("$title\r\n".join("\r\n",@rows), "\r\n");
		&speak("$title, ".join(" ",@rows), 'wait');
		&endwin(); return 1;
	}
	if ($titlelength > ($maxcols-35)) { &puts("$title\r\n");
	} else { &puts("$title   ( to continue, q to clear)\r\n");
	}
	&puts("\r", join("\e[K\r\n",@rows), "\r");
	&speak("$title, enter to continue, ".join(" ",@rows));
	$icol = 0; $irow = scalar @rows; &goto($titlelength+1, 0);

	while (1) {
		$c = &getch();
		if ($c eq 'q' || $c eq "\cX" || $c eq "\cW" || $c eq "\cZ"
		|| $c eq "\cC" || $c eq "\c\\") {
			&erase_lines(0); &endwin(); return 1;
		} elsif ($c eq "\r") {  #  retains text on screen
			&clrtoeol(); &goto(0, @rows+1); &endwin(); return 1;
		} elsif ($c eq "\cL") {
			&puts("\r"); &endwin(); &tiview($title,$text); return 1;
		}
	}
	warn "tiview: shouldn't reach here\n";
}

# -------------------------- infrastructure -------------------------

sub which {
	my $f;
	foreach $d (split(":",$ENV{'PATH'})) {$f="$d/$_[0]"; return $f if -x $f;}
}
%SpeakMode = ();
sub END {
	if ($Eflite_FH) { print $Eflite_FH "s\nq { }\n"; close $Eflite_FH;
	} elsif ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait;
	}
}
sub speak {  my ($text, $wait) = @_;
	$text="$text";
	return unless length($text);  # should clean up for exit: kill or wait
	# could replace the punctuation chars with descriptive words...
	if ($SpeakMode{'dot'}) {
		$text =~ s/\s*\.\s*/ dot /g;
		$text =~ s/\s*\.(\w)/ dot $1/g;
	}
	if ($Eflite_FH) {
		if (length($text) == 1) {
			if ($text eq '.') { print $Eflite_FH "s\nq { dot }\nd\n";
			} else { print $Eflite_FH "s\nl {$text}\n";
			}
			if ($wait) { select(undef,undef,undef,0.5); }
		} else {
			print $Eflite_FH "s\nq {$text}\nd\n";
			# useless emacspeak op: tts_sy nc_state all 0 0  1 225\nq {[:np  ]}
			if ($wait) { select(undef,undef,undef,0.3+0.07*length($text)); }
		}
	} elsif ($Espeak) {  # 1.68 should be using Speech::eSpeak !
		if ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait; $Espeak_PID = 0; }
		$Espeak_PID = fork();
		if ($Espeak_PID) {
			if ($wait) {
				if (length($text) == 1) { select(undef,undef,undef,0.5);
				} else { select(undef,undef,undef,0.3+0.07*length($text));
				}
			}
			return 1;
		} else {
			my $espeak_FH;
			my $espeak_PID;
			if ($espeak_PID = open($espeak_FH,'|-',$Espeak)) {
				select((select($espeak_FH), $| = 1)[0]); print $espeak_FH q{};
			} else {
				warn "can't run $Espeak: $!\n"; return;
			}
			# binmode($espeak_FH, ':unix');
			sub huphandler { kill 'KILL', $espeak_PID; }
			$SIG{HUP} = \&huphandler;
			if ($text eq '.') { print $espeak_FH "dot\n";
			} else { print $espeak_FH "$text\n";
			}
			# close $espeak_FH;   # Must Not Close! close Hangs, unkillable !
			wait;
			exit 0;
		}
	}
}

sub display_question {   my $question = shift; my %options = @_;
	# used by &ask and &confirm, but not by &choose ...
	&check_size();
	my ($firstline, $otherlines);  # 20131002 @otherlines => $otherlines
	if ($options{nofirstline}) {
		@OtherLines = &fmt($question);
	} else {
		($firstline,$otherlines) = split(/\r?\n/, $question, 2);
		@OtherLines = &fmt($otherlines);
		if ($firstline) { &puts("$firstline "); }
	}
	if (@OtherLines) {
		&puts("\r\n", join("\r\n", @OtherLines), "\r");
		&goto(1 + length $firstline, 0);
	}
	return scalar @OtherLines;
}
sub erase_lines {  # leaves cursor at beginning of line $_[0]
	&goto(0, $_[0]); print TTY "\e[J";
}
sub fmt { my $text = shift; my %options = @_;
	# Used by tiview, ask and confirm; formats the text within $maxcols cols
	my (@i_words, $o_line, @o_lines, $o_length, $last_line_empty, $w_length);
	my (@i_lines, $initial_space);
	@i_lines = split(/\r?\n/, $text);
	foreach $i_line (@i_lines) {
		if ($i_line =~ /^\s*$/) {   # blank line ?
			if ($o_line) { push @o_lines, $o_line; $o_line=q{}; $o_length=0; }
			if (! $last_line_empty) { push @o_lines,""; $last_line_empty=1; }
			next;
		}
		$last_line_empty = 0;

		if ($options{nofill}) {
			push @o_lines, substr($i_line, 0, $maxcols-1); next;
		}
		if ($i_line =~ s/^(\s+)//) {   # line begins with space ?
			$initial_space = $1; $initial_space =~ s/\t/   /g;
			if ($o_line) { push @o_lines, $o_line; }
			$o_line = $initial_space; $o_length = length $initial_space;
		} else {
			$initial_space = q{};
		}

		@i_words = split(' ', $i_line);
		foreach $i_word (@i_words) {
			$w_length = length $i_word;
			if (($o_length + $w_length) >= $maxcols) {
				push @o_lines, $o_line;
				$o_line = $initial_space; $o_length = length $initial_space;
			}
			if ($w_length >= $maxcols) {  # chop it !
				push @o_lines, substr($i_word,0,$maxcols-1); next;
			}
			if ($o_line) { $o_line .= ' '; $o_length += 1; }
			$o_line .= $i_word; $o_length += $w_length;
		}
	}
	if ($o_line) { push @o_lines, $o_line; }
	if ((scalar @o_lines) < $maxrows-2) { return(@o_lines);
	} else { return splice (@o_lines, 0, $maxrows-2);
	}
}
sub back_up {
	open(TTY, '>', '/dev/tty')   # 1.43
	 || (warn "Can't write /dev/tty: $!\n", return 0);
	print TTY "\r\e[K\e[A\e[K";
	close TTY;
}
1;

__END__