# Flagbits:
##   1 kurzes Listing?
##   2 ASCII-Kürzel anzeigen+zurückliefern?
##   4 '-'  ist OK
##   8 '*'  ist OK
##  16 '??' ist OK (wird zurückgemeldet)
##  32 '?x' ist OK (wird als '?##' zurückgemeldet)
##  64 numerische Angaben sind auch ohne Selektor OK
## 128 sortiere numerisch
## 256 'l' ist OK, wird als '-1' zurückgeliefert
## 512 'a' ist OK, wird als '-2' zurückgeliefert
##1024 'l' ist OK, generiert lange Liste (sonst '?l')
##2048 '?' liefert keine kurze Liste
##4096 'del' ist OK, wird als 'del' zurückgeliefert
##8192 immer Zahl zurückliefern
#16384 ? macht langes Listing
#32768 ? Hauptmenuefunktionen
#65536 'H' ist OK, wird als '-3' zurückgeliefert
#131072 '!' ist OK, wird als '-4' zurückgeliefert
#262144 nur Deskriptoren der angegebenen $gruppe zulassen
# $kn ist Standard-Start-mit-Leerzeichen, leer, oder ein verstehbares
# Prompt. Wenn leer: upcase_first($dname).

use utf8;
use warnings; no warnings "redefine";
use strict;
use Loader qw(line_in edit_deskrip);
use Dbase::Help qw(DoFn qquote);
use Dbase::Globals qw(
	bignum
	cenum_descr
	clist_descr
	enum_descr
	find_descr
	get_gruppen
	list_descr
	test_gruppe
  );
use Fehler qw(problem);

sub select_descr($$;$$$$) {
	my($dname,$flag,$addhelp,$kn,$gruppe,$template) = @_;
	my $desc = DoFn "select id from descr_typ where name=${\qquote $dname}";
	return problem "Deskriptor '$dname' gibt es nicht.\n"
		unless defined $desc;
	$addhelp = '' unless $addhelp;

	if(defined $kn and $kn =~ s/^\s+//) {
		$kn = "### $kn";
	} elsif(not defined $kn or $kn eq "") {
		$kn = ucfirst $dname;
	}

	my($grs,$grc);
	($grs,$grc) = get_gruppen("${dname}_ident", $gruppe)
	  if ( my $strict_gruppe = defined $gruppe && $flag & 262144 );
	
	while(1) {
		my $act = line_in "$kn> ", $flag&32768 ? 4 : 0, undef, $template; return undef if $act eq "";

		# die folgenden Eingaben werden 1:1 zurückgeliefert
		# ALTLAST: '-' und '*' sind hier mehrdeutig!
		return $act if $flag & 4 and $act eq '-';
		return $act if $flag & 8 and $act eq '*';
		return $act if $flag &16 and $act eq '??';
		return $act if $flag &4096 and $act eq 'del';

		# die folgenden Eingaben könnten durchaus in der Tabelle
		# vorkommen und werden deshalb hier durch negative Zahlen
		# ersetzt
		return -1 if $act eq "l" and $flag & 256;
		return -2 if $act eq "a" and $flag & 512;
		return -3 if $act eq "H" and $flag & 65536;
		return -4 if $act eq "!" and $flag & 131072;

		# Editor-Shortcut
		if($act eq "!") {
			edit_deskrip($desc,2,$kn);
			next;
		}

		if($act eq "?L" or $act eq "?l" or $flag & 1024 and $act eq "l") {
			$flag ^= 128 if $act eq "?L";
			if($flag & 2) { # ASCII
				print clist_descr($dname,$flag & 128, $gruppe)."\n";
			} else { # numerisch
				print list_descr($dname,$flag & 128, $gruppe)."\n";
			}
			$flag ^= 128 if $act eq "?L";
			next;
		}

		if($act eq "?" and $flag & 2048) {
			print $addhelp;
			next;
		}
		if($act eq "?" or $act eq "?a" or $act eq "?n") {
			print $addhelp;
			unless($flag & 16384) { # kurz ## IMMER
				if($flag & 2) { # ASCII
					print cenum_descr($dname,(($flag & 128) and $act ne "?a" or $act eq "?n"), $gruppe)."\n";
				} else { # numerisch
					print enum_descr($dname,(($flag & 128) and $act ne "?a" or $act eq "?n"), $gruppe)."\n";
				}
			} else { # lang
				if($flag & 2) { # ASCII
					print clist_descr($dname,(($flag & 128) and $act ne "?a" or $act eq "?n"), $gruppe)."\n";
				} else { # numerisch
					print list_descr($dname,(($flag & 128) and $act ne "?a" or $act eq "?n"), $gruppe)."\n";
				}
			}
			next;
		}

		if ( defined( my $idn = $flag & 64 && $act =~ /^\d+$/ ? $act : find_descr($dname,$act) ) ) {
			if ( !$strict_gruppe || test_gruppe( $dname, $idn, $grs, $grc ) ) {
				$idn = qquote(chr($idn)) if ( $flag & (2|8192) ) == 2;
				return $flag & 32 && $act =~ s/^\?// ? "?$idn" : $idn;
			}
		}
		print "... nicht gefunden.\n";
	}
}

1;
