<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w
# This file was preprocessed, do not edit!


package Debconf::FrontEnd::Readline;
use strict;
use Term::ReadLine;
use Debconf::Gettext;
use base qw(Debconf::FrontEnd::Teletype);


sub init {
	my $this=shift;

	$this-&gt;SUPER::init(@_);

	open(TESTTY, "/dev/tty") || die gettext("This frontend requires a controlling tty.")."\n";
	close TESTTY;

	$Term::ReadLine::termcap_nowarn = 1; # Turn off stupid termcap warning.
	$this-&gt;readline(Term::ReadLine-&gt;new('debconf'));
	$this-&gt;readline-&gt;ornaments(1);

	if (-p STDOUT &amp;&amp; -p STDERR) { # make readline play nice with buffered stdout
		$this-&gt;readline-&gt;newTTY(*STDIN, *STDOUT);
	}

	if (Term::ReadLine-&gt;ReadLine =~ /::Gnu$/) {
		if (exists $ENV{TERM} &amp;&amp; $ENV{TERM} =~ /emacs/i) {
			die gettext("Term::ReadLine::GNU is incompatable with emacs shell buffers.")."\n";
		}
		
		$this-&gt;readline-&gt;add_defun('previous-question',	
			sub {
				if ($this-&gt;capb_backup) {
					$this-&gt;_skip(1);
					$this-&gt;_direction(-1);
					$this-&gt;readline-&gt;stuff_char(ord "\n");
				}
				else {
					$this-&gt;readline-&gt;ding;
				}
			}, ord "\cu");
		$this-&gt;readline-&gt;add_defun('next-question',
			sub {
				if ($this-&gt;capb_backup) {
					$this-&gt;readline-&gt;stuff_char(ord "\n");
				}
			}, ord "\cv");
		$this-&gt;readline-&gt;parse_and_bind('"\e[5~": previous-question');
		$this-&gt;readline-&gt;parse_and_bind('"\e[6~": next-question');
		$this-&gt;capb('backup');
	}
	
	if (Term::ReadLine-&gt;ReadLine =~ /::Stub$/) {
		$this-&gt;promptdefault(1);
	}
}


sub elementtype {
	return 'Teletype';
}


sub go {
	my $this=shift;

	foreach my $element (grep ! $_-&gt;visible, @{$this-&gt;elements}) {
		my $value=$element-&gt;show;
		return if $this-&gt;backup &amp;&amp; $this-&gt;capb_backup;
		$element-&gt;question-&gt;value($value);
	}

	my @elements=grep $_-&gt;visible, @{$this-&gt;elements};
	unless (@elements) {
		$this-&gt;_didbackup('');
		return 1;
	}

	my $current=$this-&gt;_didbackup ? $#elements : 0;

	$this-&gt;_direction(1);
	for (; $current &gt; -1 &amp;&amp; $current &lt; @elements; $current += $this-&gt;_direction) {
		my $value=$elements[$current]-&gt;show;
	}

	if ($current &lt; 0) {
		$this-&gt;_didbackup(1);
		return;
	}
	else {
		$this-&gt;_didbackup('');
		return 1;
	}
}


sub prompt {
	my $this=shift;
	my %params=@_;
	my $prompt=$params{prompt}." ";
	my $default=$params{default};
	my $noshowdefault=$params{noshowdefault};
	my $completions=$params{completions};

	if ($completions) {
		my @matches;
		$this-&gt;readline-&gt;Attribs-&gt;{completion_entry_function} = sub {
			my $text=shift;
			my $state=shift;
			
			if ($state == 0) {
				@matches=();
				foreach (@{$completions}) {
					push @matches, $_ if /^\Q$text\E/i;
				}
			}

			return pop @matches;
		};
	}
	else {
		$this-&gt;readline-&gt;Attribs-&gt;{completion_entry_function} = undef;
	}

	if (exists $params{completion_append_character}) {
		$this-&gt;readline-&gt;Attribs-&gt;{completion_append_character}=$params{completion_append_character};
	}
	else {
		$this-&gt;readline-&gt;Attribs-&gt;{completion_append_character}='';
	}
	
	$this-&gt;linecount(0);
	my $ret;
	$this-&gt;_skip(0);
	if (! $noshowdefault) {
		$ret=$this-&gt;readline-&gt;readline($prompt, $default);
	}
	else {
		$ret=$this-&gt;readline-&gt;readline($prompt);
	}
	$this-&gt;display_nowrap("\n");
	return if $this-&gt;_skip;
	$this-&gt;_direction(1);
	$this-&gt;readline-&gt;addhistory($ret);
	return $ret;
}


sub prompt_password {
	my $this=shift;
	my %params=@_;

	if (Term::ReadLine-&gt;ReadLine =~ /::Perl$/) {
		return $this-&gt;SUPER::prompt_password(%params);
	}
	
	delete $params{default};
	system('stty -echo 2&gt;/dev/null');
	my $ret=$this-&gt;prompt(@_, noshowdefault =&gt; 1, completions =&gt; []);
	system('stty sane 2&gt;/dev/null');
	print "\n";
	return $ret;
}


1
</pre></body></html>