Menue-Auswahl auf Kommandozeile

Ich erlaube mir mal, ein Progrämmchen vor-/zur Diskussion zu stellen.

Es gibt noch welche, die viel mit der Kommandozeile arbeiten.

Und da stellt sich oft die Aufgabe schnell und übersichtlich aus einem
kleinen oder großen Array Auswahlen zu treffen. Angelehnt an
Autoergänzung mancher Shell hat sich "readlist()" im Laufe der Zeit
entwickelt. Ganz universell ist es leider nicht, es läuft mit Windows,
Cygwin, Linux, (eingeschränkt) in der Emacs-Eshell.

Vielleicht interessiert es jemanden, gibt es Vorschläge zur Verbesserung
der Systemunabhängikeit, sonstige Ergänzungen/ Korrekturen oder ich
habe das Rad zwei mal erfunden und bekomme Hinweise, wo bzw. wie es
besser/einfacher geht.

Bei folgendem kann man aus den keys %::doku auswählen und bekommt dann
die Kurzbeschreibung der jeweiligen Sub o.ä. angezeigt

Gruß Frank
------------------------------------------------------------ -----------
use strict;
#für nichtblockierendes einlesen
use Term::ReadKey;
#ReadKey(-1) ohne Anzeige auf terminal, 0 mit Anzeige
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
$|=1; #ungepuffertes stdout sonst klemmen ggfs. die zeitfunktionen

open(STTY,"stty 2>&1| grep Inappropriate|") or die "sttyerr $!";
my$stty=1;
if(){$stty=0;print "nostty"}
close STTY;# or die "closeerr $!";

$::doku{grepmod}='Die Variable $::grepmod legt fest, ob bei readlist ab
den Anfängen der Einträge ($::grepmod=^)
gesucht wird oder an beliebieger Stelle ($::grepmode="")';
$::grepmod="^"; #in readlist am anfang suchen = '^' sonst nichts

foreach(1..135){$::doku{$_}="dummyeintrag"}

while(my$key=readlist(keys %::doku))
{
print $::doku{$key};
}



$::doku{readlist}= <<'END_OF_TEXT';

auswahl=readlist(liste)
Die Funktion readlist wird zu schnellen Auswahl aus einer Liste verwendet.

Als Argument wird die Liste/Array übergeben, aus der ein Eintrag
ausgewählt werden soll.

Die Einträge werden sortiert und eventuell verkürzt angezeigt.

Maximal werden n Einträge angezeigt. Beginnen mehrere Einträge mit
selben Zeichenkombination wird nur diese mit folgenden Punkten
angezeigt. z. B. dre+kleiner Pfeil heißt, es gibt mehrere Einträge, die
mit dre beginnen.

Sobald eine Taste caseunabhängig gedrückt wird die Liste nach Einträgen
beginnend mit diesem Zeichen durchsucht und die verbleibenden Einträge
zur Auswähl angezeigt. Weiter gehts mit folgenden Tastendrücken bis die
Auswahl eindeutig ist. Mittels Rücktaste kann auch korrigiert werden.
(in der emacs eshell muß nach jeder Taste ein enter erfolgen).

Jederzeit kann die Auswählmöglichkeit mittels TAB-Taste genutzt werden.
Hier werden der Reihe nach alle verbleiben Einträge ausgewählt.

Jederzeit kann die Auswählmöglichkeit mittels ~-Taste genutzt werden.
Hier wird zufällig aus den verbleibenden Einträgen ausgewählt.

Mit Enter wird dann der Eintrag übernommen.

Bei jeder Benutzung von readlist wird das Resultat abhängig von der
übergebenen Argumentliste in einem Array gespeichert (wie Befehlsqueue
in der Shell). Die alten Einträge aus der selben Liste sind per
Pfeiltasten abrufbar. Durch getrennte Queues werden mit den Pfeiltasten
keine nicht in der Argumentliste enthaltenen Einträge angezeigt. Die
Auswahl der Queue erfolgt per Checksumme der übergebenen Liste.


ist \$readlist::spalten gesetzt, wird bei der Anzeige die spaltenzahl
nicht abhängig von der nötigen suchtiefe (bis zu welchem zeichen muß
angezeigt werdem, um einträge zu unterscheiden) gesetzt, sondern die
maximale anzeigebreite genutzt.

END_OF_TEXT



sub readlist
{
my$chsum=unpack("%32C*",join('',@_)) % 65535;#checksumme der liste
my@foo=@_;
my$muster="";
my$dmuster;
if($#foo<0){print "keine Liste uebergeben\n";return undef;}
print "\n";#.@foo." Eintraege\n";
my$vorherkeinrueck=1;#1=letzte runde kein <-;
while(defined(my$i=ReadKey1(-1))){};#tastaturbuffer löschen;
while(1) # suchen
{
# {{{ #anzeige;

my@footemp=sort @foo;
my%hash1;
my%hash2;
my$laenge=1;
my@lim;;#spaltenbeginn;
my$spalten;
if(defined $readlist::spalten)#anzeige soll nicht gekürzt werden
{
$spalten=1;
@lim=(0);
}
if($#footemp>39)#nicht alle anzeigen;
{
my%einfach;
my%einfach2;
my$i=0;
while($i<=$#footemp)#speudobedingung, abbruch erfolgt unten mit last
{
my$aktkey=lc(substr($footemp[$i],0,$laenge));
#if key vorhanden erfolgt anz. in kleinbuchstaben am ende mit ... ;
#sonst direkt mit dem eventuell abgeschnittenen namen;
if(defined $hash1{$aktkey})
{
$hash1{$aktkey}=$aktkey . chr(26);#chr(26)=kleiner pfeil
}
else
{
$hash1{$aktkey}=substr($footemp[$i],0,$laenge);
}
push @{$einfach{$aktkey}},$i;
$i++;
my$anz=keys %hash1;
if($anz>39)#überschritten hash von vorher übernehmen, break
{
if($laenge > 1)#else stringanfänge auch mit sonderz.;
{
%hash1=%hash2;
%einfach=%einfach2;
}
last;
}
elsif($i>$#footemp)#nicht genug gefunden, weiter mit buchstabe mehr;
{
%einfach2=%einfach;
%hash2=%hash1;
undef %hash1;
$laenge++;
$i=0;
}
}
unless($spalten)#keine fernbestimmung der spaltenanzahl
{
@lim=spaltenteilung($laenge+1);
$spalten=@lim;
}
#keys erweitern solange es nicht mehr werden
foreach my$aktkey (keys %hash1)
{
#+3 scheint zu hoch aber ergebnis stimmte bisher immer
my$breite=int 80/$spalten+3;
if(@{$einfach{$aktkey}}==1)#key nur für 1 eintrag, direkt anzeigen
{
$hash1{$aktkey}=substr($footemp[$einfach{$aktkey}[0]],0,$bre ite);
}
else#soweit erweitern, wie es geht
{
my$nlaenge=$laenge;
WHILE1: while(1)
{
my%temphs;
foreach my$ind (@{$einfach{$aktkey}})
{
$temphs{lc(substr($footemp[$ind],0,$nlaenge))}='';
if((keys %temphs > 1) or ($nlaenge >= $breite))
{
$hash1{$aktkey}=lc(substr($footemp[$ind],0,$nlaenge-1))
.chr(26);#kleiner pfeil
last WHILE1;
}
}
$nlaenge++;
}
}
}
@footemp=sort {lc($a) cmp lc($b)} values %hash1;
}

#immer, wenn fernbestimmung ($readlist::spalten) noch optimierung möglich
my$maxlength=0;
foreach(@footemp){if($maxlength @lim=spaltenteilung($maxlength);
$spalten=@lim;#anzahl spalten;

my$lang;
#sortieren;
my$maxind=int($#footemp/$spalten);
my@footemp2;

#in spalten sortieren
foreach my$i (0..($spalten-1))
{
foreach my$j (0..$maxind)
{
my$ix2=$i+$j*$spalten;
my$ix=$j+$i*($maxind+1);
$footemp2[$ix2]=$footemp[$ix] if defined $footemp[$ix];
}
}
my$spalteakt=0;#aktuelle spalte;
print "\n";
foreach (@footemp2)
{
if($spalteakt==0){
print;
$lang=length;
}
elsif(defined $_)#if wegen evtl. undefined $_ am zeilenende bringt
warnung
{
print " " x ($lim[$spalteakt]-$lang);
print;
$lang=$lim[$spalteakt]+length;
}
$spalteakt++;
if($spalteakt>=$spalten)
{
print "\n";
$spalteakt=0;
}
}

# }}}
print "\n";
print("----------------\nAuswahl = ");
if($vorherkeinrueck)
{
if($#foo>0)
{
while(gleicheb(@foo,length($muster))){
$muster.=substr($foo[0],length($muster),1)}
}
else{$muster=$foo[0]}
}
print $muster;
while(not defined ($dmuster=ReadKey1(-1)))
{
select(undef,undef,undef,0.05); #blockiert sonst den rechner;
}
if($dmuster eq '*'){$::grepmod=($::grepmod eq '')?'^':''}#umschalten
grepmode
my$odm=ord($dmuster);
if($odm==13||$odm==10) #eingabe enter; 10 bei zygwin;
{
if(!$muster){print "nichts";return undef}#ohne muster direkt zurück;
foreach(@foo)
{ #parameter gefunden, der so heißt;
if(length($_)==length($muster))
{
print "\n";
queue($readlist::qu{$chsum},\$_);
return $_;
}
}
$dmuster="";#kein passender parameter enter ignorieren;
}
while($odm == 9 || $odm == 126)#tab auswahl per tabtaste oder ~;
{
my$mtemp=$muster;
foreach(@foo)
{
my$mneu=($odm==126)?$foo[int(rand(@foo))]:$_;#auswahl per zufall
oder reihenfolge

print "\b" x length($mtemp) . #cursor zurueck;
" " x length($mtemp) . #altes löschen (wenn altes länger reicht
überschreiben mit neuem nicht);
"\b" x length($mtemp). $mneu; #cursor zuruck, neu schreiben
$mtemp=$mneu;
while(not defined ($odm=ReadKey1(-1))){};
$odm=ord($odm);
if($odm==13||$odm==10)#enter; 10 bei zygwin;
{
print "\n";
queue($readlist::qu{$chsum},\$mneu);
return $mneu;
}
last if ($odm != 9 && $odm != 126);
}
print "\b" x length($mtemp) . #cursor zurueck;
" " x length($mtemp) . #altes löschen (wenn altes länger reicht
überschreiben mit neuem nicht);
"\b" x length($mtemp). $muster; #cursor zuruck, muster schreiben;
}

if($odm == 8)#backspace;
{
$dmuster="";
my@neu;
while(1)
{
$muster=substr($muster,0,length($muster)-1);
#$muster darf nicht einfach . ? * + ^ $ | \ ( ) [ { enthalten;
my$muster1=grepbar($muster);
my@neu = grep(/$muster1/i,@_);
last if(($muster eq "") || ($#foo < $#neu));
}
$vorherkeinrueck=0;
}
elsif(!$odm)#queue auswerten;
{
if($readlist::qu{$chsum})#schon eintrag vorhanden?;
{
my@temp=@{$readlist::qu{$chsum}};#geht nicht warum?;
#my@temp;
#foreach(@{$readlist::qu{$chsum}}){push(@temp,$_)}

#queue anzeigen:;
print "Queue(".scalar @temp."):";
foreach(@temp){print " $_\n"}
until($odm)
{
my$wahl=pop @temp;
print "\nAuswahl = $wahl";
unshift(@temp,$wahl);
while(not defined ($odm=ReadKey1(-1)))
{
select(undef,undef,undef,0.05); #blockiert sonst den rechner;
}
$odm=ord($odm);
if($odm==13||$odm==10)#enter; 10 bei zygwin;
{
my$wahl1=grepbar($wahl);
my@fooneu = grep(/$wahl1/,@_);
if(@fooneu)
{ #passende(r) parameter, muster übernehmen;
print "\n";
queue($readlist::qu{$chsum},\$wahl);
#push(@{$readlist::qu{chsum}},$wahl);
return $wahl;
}
}
}
}
}
else{$vorherkeinrueck=1}
my$musterneu=$muster.$dmuster;
$musterneu=grepbar($musterneu);
my@fooneu = grep(/$musterneu/i,@_);
if($#fooneu >= 0)
{ #passende(r) parameter, muster übernehmen;
print $dmuster;
$muster.=$dmuster;
@foo=@fooneu;
}
}
}




$::doku{"ReadKey1"} = <<'END_OF_TEXT';

Die Funktion ReadKey wird hier noch mal geklammert. Bei cygwin ist es
notwendig, stty -icanon eol \\001 auszuführen, damit einzelne Zeichen
gelesen werden können. Ein weiteres Problem sind die Sonderzeichen. Die
Pfeiltasten führen zu 3 übergebenen Chars. Diese werden ausgewertet und
die ascii-Werte 24=hoch, 25=runter, 26=rechts, 27=links zurückgegeben.
Wird von der bash aus windowsperl genutzt, sind die Pfeiltasten nicht
erreichbar. Die Variante windowsperl von der bash aus hat den Vorteil,
daß die Eingabequeue funktioniert, also entweder Eingabequeue oder
Pfeiltasten.

END_OF_TEXT

sub ReadKey1
{
my$i;
if ($^O eq "MSWin32")
{
ReadMode 3;
$i=ReadKey($_[0]);
ReadMode 0;
}
else
{
system("stty -echo") if ($_[0] and $stty);
system 'stty -icanon eol \001' if $stty;#zeilenendezeichen
my$flags = fcntl(STDIN, F_GETFL, 0)or die "Can't get flags for the
socket: $!\n";
#+nichtblockierend
fcntl(STDIN, F_SETFL, $flags | O_NONBLOCK)or die "Can't set flags for
the socket: $!\n";
$i= <>;
$i=substr($i,0,1) if defined $i;#im emacs kommts mit enter

#-nichtblockierend
fcntl(STDIN, F_SETFL, $flags)or die "Can't set flags for the socket:
$!\n";
#system "stty", 'icanon', 'eol', '^@';#zeilenendezeichen ASCII null;
system 'stty icanon eol ^@' if $stty;#zeilenendezeichen ASCII null
}
system("stty echo") if ($_[0] and $stty);
return $i;
}


$::doku{spaltenteilung}="
übergeben maximale länge der einträge
rückgabe array spaltenbeginn";

sub spaltenteilung
{
my@lim;
if($_[0] > 39){@lim=0}
elsif($_[0] > 26){@lim=(0,40)}
elsif($_[0] > 19){@lim=(0,27,54)}
elsif($_[0] > 15){@lim=(0,20,40,60)}
else{@lim=(0,16,32,48,64)}
return @lim;
}



$::doku{grepbar}="string grepfähig machen darf nicht einfach . ? * + ^ $
| \ ( ) [ { enthalten";
sub grepbar
{
my$i=$_[0];
$i=~ s/\\/\\\\/g;#muß zuerst stehen, macht sonst alles folgende unsinnig
#$i=~ s/\./\\./g;#funktioniert dann nicht
$i=~ s/\?/\\?/g;
$i=~ s/\*/\\*/g;
$i=~ s/\+/\\+/g;
$i=~ s/\^/\\^/g;
#$i=~ s/\$/\\$/g;bringt fehler $/ ist vordef. variable;
$i=~ s/\|/\\|/g;
$i=~ s/\(/\\(/g;
$i=~ s/\)/\\)/g;
$i=~ s/\{/\\{/g;
#print "gb:$_[0]:$i\n";
return $::grepmod.$i;
}

$::doku{gleicheb}="

kontrolle ob gleiche buchstaben an x.stelle

x= letztes argument
andere argumente zu untersuchendes feld
nur, wenn grep ab 1. buchstaben";
sub gleicheb
{
return 0 unless $::grepmod;
my$lim=pop;
my$ist=lc(substr(shift,$lim,1));
foreach (@_){if(lc(substr($_,$lim,1)) ne $ist){return 0}}
return 1;
}

# }}}

$::doku{queue}="queue(arrayref,stringref) hängt ans array scalar dran,
wenn scalar nicht schon am ende steht";
sub queue
{
if(@{$_[0]}[$#{$_[0]}] ne ${$_[1]})
{
push(@{$_[0]},${$_[1]});
}
}