pldb (list): Add `-w' option to show a window around the group position(s).

diff --git a/pldb b/pldb
index 7f5937327a792a72a83bb0f6ab54e3019ee07e7e..40c67e03ea964da8a32c88eeaabb3661304a029a 100755 (executable)
--- a/pldb
+++ b/pldb
@@ -260,11 +260,11 @@ defcmd "next [-pu] [-o N] [-n N] GROUP [LIST]", sub {
   defined $prevlist and print "$prevlist\n", map "\t$_\n", @out;
 };
 
   defined $prevlist and print "$prevlist\n", map "\t$_\n", @out;
 };
 

-defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] LIST", sub {
+defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] [-w WIN] LIST", sub {

   local @ARGV = @_;
   my $bogusp = 0;
   my %opt;
   local @ARGV = @_;
   my $bogusp = 0;
   my %opt;

-  getopts("g:r:", \%opt) or $bogusp = 1;
+  getopts("g:r:w:", \%opt) or $bogusp = 1;

   @ARGV == 1 or $bogusp = 1;
   if ($bogusp) { bail_usage; }
   my ($list) = @ARGV;
   @ARGV == 1 or $bogusp = 1;
   if ($bogusp) { bail_usage; }
   my ($list) = @ARGV;


@@ -285,9 +285,10 @@ defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] LIST", sub {
   my %pos; my $plen = -1;
   if (defined $opt{"g"}) {
     my @g = split /,/, $opt{"g"};
   my %pos; my $plen = -1;
   if (defined $opt{"g"}) {
     my @g = split /,/, $opt{"g"};

-    for (@g) {
+    GROUP: for (@g) {

       my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g;
       $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array;
       my ($pre, $g) = /^ (?: (.*?)=)? (.*) $/x; must_group $g;
       $st_pos->execute($g, $list); my ($pos) = $st_pos->fetchrow_array;

+      next GROUP unless defined $pos;

       my $t = $pos{$pos} =
        (exists $pos{$pos} ? $pos{$pos} . "," : "") .
        ($pre // (@g == 1 ? "" : $g));
       my $t = $pos{$pos} =
        (exists $pos{$pos} ? $pos{$pos} . "," : "") .
        ($pre // (@g == 1 ? "" : $g));


@@ -320,6 +321,12 @@ defcmd "list [-g [MARK=]GROUP,...] [-r [LO][-[HI]],...] LIST", sub {
     }
   }
 
     }
   }
 

+  if (defined $opt{"w"}) {
+    (my $w = $opt{"w"}) =~ /^\d+$/ or die "bad window size `$opt{w}'";
+    %pos or die "no positions";
+    for my $pos (keys %pos) { push @r, [$pos - $w, $pos + $w + 1] }
+  }
+

   if (@r) {
     my ($curr_lo, $curr_hi) = (undef, undef);
     my @newr;
   if (@r) {
     my ($curr_lo, $curr_hi) = (undef, undef);
     my @newr;