--- /dev/null
+#!/usr/bin/perl -w
+use strict;
+use vars qw($cui $list $win $VERSION);
+
+#5.12 introduced a warning about prototypes that afflicts old Curses::UI
+#BEGIN{ if( $^V lt v5.12.0 ){eval "use Curses::UI"}else{ eval "no warnings 'illegalproto'; use Curses::UI" } }
+
+use Curses::UI 0.9608;
+use Getopt::Long;
+
+$VERSION = 0.14;
+my %opts = configure();
+my $exit = sprintf("marked sequence %s in +%s\n",
+ ($opts{newsequence}||$opts{sequence}), $opts{'+'});
+$SIG{CONT} = sub{ $cui->leave_curses(); $cui->reset_curses() };
+
+$cui = new Curses::UI;
+$cui->add('status', 'Window', -y=>-1, -height=>1)->
+#, -htmltext=>1
+ add('explain', 'Label', -reverse=>1, -bold=>1, -text=>
+ ' H)elp I)nvert V)iew Q)uit S)ave '. # </reverse>
+ "+$opts{'+'} -seq $opts{sequence}".
+ ($opts{cull}?' -cull':'').($opts{zero}?' -zero':'').
+ ($opts{newsequence}?" -new $opts{newsequence}":''));
+
+$cui->set_binding(\&help, 'h');
+$cui->set_binding($SIG{CONT}, "\cL");
+$cui->set_binding(\&setSequence, 's');
+$cui->set_binding(sub{ kill "STOP", $$}, "\cZ");
+#XXX clear on sleep?
+
+my(@values, %labels, %indices);
+scan(\@values, \%labels, \%indices);
+
+$win = $cui->add('window', 'Window', -padbottom=>1);
+$list = $win->
+ add('mylistbox', 'Listbox', -multi=>1, -values=>\@values, -labels=>\%labels, -htmltext=>0);
+
+#XXX use -bindings and -routines as in Widget to clean up code?
+$list->set_binding(sub{ $exit=''; exit }, "\cC", 'q');
+$list->set_binding(\&invert=>'i');
+$list->set_binding(\&view, 'v', 'm');
+$list->set_binding(\&pgdn, "\cV", ' ' );
+$list->set_binding(\&pgup, "\eV", 'b');
+$list->set_selection(@indices{getSequence()}) unless $opts{zero};
+$list->focus();
+$cui->mainloop;
+
+
+##Heavy Lifting
+END{
+ $cui->leave_curses();
+ print "\n", $exit;
+ exit;
+}
+
+sub configure{
+ my %args = (_MBMHR=>(eval "use Mail::Box::MH::Resource 0.06", !$@),
+ _NR =>(eval "use Number::Range", !$@) );
+
+ {#Get default values
+ local $_;
+ my $nom = $0;
+ $nom =~ s%^.+/%%;
+ $_ = $args{_MBMHR} ? Mail::Box::MH::Resource->new()->get($nom) :
+ `mhparam $nom`;
+ unshift(@ARGV, split) if defined;
+ }
+
+ Getopt::Long::Configure qw(auto_abbrev pass_through);
+ GetOptions (\%args, 'sequence=s', 'newsequence:s',
+ 'cull!', 'reverse!', 'zero!');
+ $args{'+'} = (grep {/^\+/} @ARGV)[0] || '';
+ $args{'+'} =~ s/^\+//;
+ unless( $args{sequence} ){
+ $args{sequence}='vpick';
+ $args{zero} = 1;
+ }
+
+ $args{newsequence} ||= 'vpick' if defined $args{newsequence};
+
+ if( $args{_MBMHR} ){
+ my $MHR = Mail::Box::MH::Resource->new();
+ $args{_Path} = $MHR->get('Path');
+ $args{_Path} = File::Spec->file_name_is_absolute($args{_Path}) ?
+ $args{_Path} :
+ File::Spec->catfile($ENV{HOME}, $args{_Path});
+ $MHR = Mail::Box::MH::Resource->new(File::Spec->catfile($args{_Path},
+ 'context'));
+ $args{'+'} ||= $MHR->get('Current-Folder');
+ }
+ else{
+ $args{zero} = 1; }
+ return %args;
+}
+
+sub help{
+ $cui->dialog(
+ -title =>'Navigation',
+ -message =><<MESSAGE
+ vpick v$VERSION
+
+ ^A <Home> Top of list
+ b <PgUp> Page up
+ k <Up> Scroll up
+
+ l <Right> <Enter> Mark message
+ y 1 Mark & advance
+ n 0 Unmark & advance
+
+ j <Down> Scroll down
+ ^V <PgDn> <Space> Page down
+ ^E <End> Bottom of list
+
+ / Search forward
+ ? Search backward
+\0
+MESSAGE
+ );
+}
+
+sub invert{
+ my %count;
+ my @F = getSequence();
+ foreach($list->get(), @values){ $count{$_}++ }
+ foreach(keys %count){ delete($count{$_}) if $count{$_} > 1 }
+ $list->clear_selection();
+ $list->set_selection(@indices{%count});
+ $list->draw();
+}
+
+sub pgdn{
+ my $this = shift;
+ if ($this->{-ypos} >= $this->{-max_selected}) {
+ $this->dobeep;
+ return $this;
+ }
+ {
+ use integer;
+ $this->{-ypos} = $this->canvasheight *
+ ( 2 + $this->{-ypos}/$this->canvasheight );
+ }
+ $this->run_event('-onselchange');
+
+ #This is critical for to end up at the top of the screen,
+ #and why jumped two pages
+ $this->draw();
+ $this->{-ypos} -= $this->canvasheight;
+
+ $this->run_event('-onselchange');
+ $this->schedule_draw(1);
+ return $this;
+}
+
+sub pgup{
+ my $this = shift;
+ if ($this->{-ypos} <= 0) {
+ $this->dobeep;
+ return $this;
+ }
+ $this->{-ypos} -= $this->canvasheight
+ +$this->{-ypos}%$this->canvasheight;
+ $this->run_event('-onselchange');
+ $this->schedule_draw(1);
+ return $this;
+}
+
+sub scan{
+ #Add back space for wide msg number, less the space used by the checkbox
+ #XXX #my $width = q'-width '. (qx'scan -format "%(width)" -noheader last'+6);
+ my $width = q'-width '. ($ENV{COLS} + 6);
+ my $format= q`-format '%9(msg) %02(mon{date})/%02(mday{date})/%(void(year{date}))%02(modulo 100)%<{date}%> %<(mymbox{from})%<{to}To:%21(addr{to})%>%>%<(zero)%24(addr{from})%> %{subject}%<{body}<<%{body}>>%>'`;
+ my $args = "+$opts{'+'} " if $opts{_MBMHR};
+ $args.= $opts{reverse} ? '-reverse' : '-noreverse';
+
+ $args.= " $opts{sequence}" if $opts{cull};
+
+ my $i=0;
+ foreach( split/\n/, qx/scan -noheader $width $format $args/ ){
+ my (undef, $value, $label) = split(/\s+/, $_, 3);
+ push @{$_[0]}, $value;
+ $_[1]->{$value} = $label;
+ $_[2]->{$value} = $i++;
+ }
+
+}
+
+sub view{
+ my $view;
+ if( $view = $win->getobj('view') ){
+ $view->focus();
+ }
+ else{
+ $view = $win->add('view', 'TextViewer', -vscrollbar=>1, -wrapping=>1);
+ $view->set_binding(sub{ $list->focus(); $win->delete('view') },
+ "\cC", 'q', 'v', 'm');
+# $view->set_binding(sub{ $list->focus() }, "\cC", 'q', 'v', 'm');
+ $view->set_binding('cursor-pagedown'=>"\cV");
+ $view->set_binding('cursor-pageup' =>"\eV", 'b');
+ }
+
+ my $path;
+ my $msg = $list->get_active_value();
+ if( $opts{_MBMHR} ){
+ $path = File::Spec->catfile($opts{_Path},$opts{'+'},$msg); }
+ else{
+ $path = qx(mhpath $msg); }
+ $view->text("Message: $msg\n". do{ local $/=undef; open(MSG, $path); <MSG>});
+ #XXX || Error
+ $view->focus();
+}
+
+sub getSequence{
+ my $MHR = Mail::Box::MH::Resource->new(
+ File::Spec->catfile($opts{_Path}, $opts{'+'}, '.mh_sequences') );
+ local $_ = $MHR->get($opts{sequence});
+ s/(?=\s)/,/g; s/-/\.\./g;
+ eval;
+}
+
+sub setSequence{
+ if( $opts{_NR} && $opts{_MBMHR} ){
+ my $seq = scalar Number::Range->new($list->get())->range();
+ $seq =~ s/\.\./-/g;
+ $seq =~ y/,/ /;
+ my $MHR = Mail::Box::MH::Resource->new(
+ File::Spec->catfile($opts{_Path},$opts{'+'},'.mh_sequences'));
+ $MHR->set($opts{newsequence}||$opts{sequence}=>$seq);
+ exit $MHR->close(); }
+ else{
+ exit system('mark', '-zero', '-seq', $opts{sequence}, $list->get())>>8;}
+}
+
+__END__
+=pod
+
+=head1 NAME
+
+vpick - visual pick, mark a message sequence by eye
+
+=head1 SYNOPSIS
+
+vpick [+folder] [B<-sequence> name] [B<-newsequence> [name]] [B<-cull>] [B<-zero>] [B<-reverse>] [B<sequence>]
+
+=begin html
+
+=head1 SCREENSHOT
+
+<img src="vpick.png" height=464 width=992>
+
+=head1 DOWNLOAD
+
+=over
+
+=item The script source.
+
+<a href="vpick">vpick</a>
+
+=item A binary for i686 Linux (Perl 5.8.0) for testing the software without ins\
+talling the L<dependencies|/REQUIREMENTS>.
+
+<a href="ftp://pthbb.org/pub/MH/vpick.gz">vpick.gz</a>
+
+=back
+
+=end html
+
+=head1 DESCRIPTION
+
+A nifty little tool for those dyed-in-the-wool MH users whom occasionally envy
+those pine/elm/mutt users. For those times when you'll know what you want when
+you see it and mark just won't cut it. vpick allows you to check boxes for
+individual messages to save them in a sequence.
+
+If you're lucky and your local curses library has mouse support you might even
+be the envy of your friends.
+
+=head2 INTERFACE
+
+=over
+
+=item * C<h>
+
+Online navigation help.
+
+=item * C<i>
+
+Invert the current message selections.
+
+=item * C<m>, C<v>
+
+Toggle a display of the highlighted message.
+
+=item * C<s>
+
+Save the sequence and exit.
+
+=item * C<q>
+
+Exit without saving changes to the sequence.
+
+=back
+
+=head3 Navigation
+
+=over
+
+=item * C<Right>, C<l>, C<Enter>
+
+Add the current message to the sequence.
+
+=item * C<1>, C<y>
+
+Add the current message to the sequence and advance to the next message.
+
+=item * C<0>, C<n>
+
+Remove the current message from the sequence and advance to the next message.
+
+=item * C<Down>, C<j>
+
+Advance to the next message.
+
+=item * C<Up>, C<k>
+
+Select previous message.
+
+=item * C<PageUp>, C<b>, C<M-v>
+
+Scroll up a page.
+
+=item * C<PageDown>, C<C-v>
+
+Scroll down a page.
+
+=item * C<Home>, C<C-a>
+
+Select the first message in the folder.
+
+=item * C<End>, C<C-e>
+
+Select the last message in the folder.
+
+=item * C</>
+
+Search message entries with a 'less'-like search system.
+A searchstring is entered and selection advances to the first match.
+After that the C<n> will search for the next occurance,
+and C<N> the previous.
+
+=item * C<?>
+
+The same as C</>, only it will search in the opposite direction.
+
+=back
+
+=head1 OPTIONS
+
+Like MH commands, vpick options can be abbreviated to a shortest unique string,
+and any option that does not take an argument can be prefixed by I<no> to
+override earlier options.
+
+=over
+
+=item B<+folder>
+
+The name of the folder to edit a sequence for. Defaults to the current folder.
+
+=item B<-sequence> name
+
+The name of the sequence to edit. Defaults to I<vpick>.
+
+=item B<sequence>
+
+Only display the messages in the specified sequence.
+You probably want B<-cull> instead.
+
+=back
+
+=over
+
+=item B<-cull>, B<-nocull>
+
+Only display the messages currently in B<-sequence>. Shorthand for:
+
+ -seq foo foo
+
+=item B<-reverse>, B<-noreverse>
+
+View the folder in reverse order.
+
+=item B<-newsequence> name
+
+Save the altered message sequence as this new name, rather than clobber the
+existing sequence. The sequence name is otpional, and defaults to I<vpick>.
+
+This is useful for catching up on a backlog of unread messages like so:
+
+ -seq unseen -new -cull
+
+This preserves your I<unseen> sequence, so that when you C<rmm> the chaff
+in I<vpick>, I<unseen> contains only wheat.
+
+=item B<-zero>, B<-nozero>
+
+Zeroing loads an empty sequence, B<-nozero> flags existing messages from
+the sequence. Default is B<-nozero> unless B<-sequence> defaults to I<vpick>.
+See L</REQUIREMENTS>.
+
+=back
+
+=head1 REQUIREMENTS
+
+=over
+
+=item C<Curses::UI>
+
+To provide the nifty visual interface.
+
+=item C<scan>
+
+Required to summarize folder contents. But then you use MH, you knew that.
+
+=item C<mark> OR C<Mail::Box::MH::Resource> + C<Number::Range>
+
+Required to preserve sequences.
+The latter is preferred, without it some functionality will be disabled i.e;
+vpick will be forced to run as if -zero were given.
+
+Strictly speaking, you can also use vpick with MBMHR and not Number::Range.
+
+=back
+
+=head1 CAVEATS
+
+If using C<mark> instead of MBMHR and Number::Range with large sequences
+you may loose; blame the shell.
+
+You should not do anything to alter message ordering/numbering while vpick
+is running e.g; L<sortm(1)>, L<folder(1)> -pack Other operations are fine.
+
+=head1 RESTRICTIONS
+
+The scan format is embedded in the program, it doesn't seem worthwhile to
+abstract it to a user configurable setting.
+
+=head1 SEE ALSO
+
+L<mark(1)>, L<pick(1)>, L<scan(1)>
+
+=head1 AUTHOR
+
+Jerrad Pierce <jpierce@cpan.org>.
+
+=head1 LICENSE
+
+=over
+
+=item * Thou shalt not claim ownership of unmodified materials.
+
+=item * Thou shalt not claim whole ownership of modified materials.
+
+=item * Thou shalt grant the indemnity of the provider of materials.
+
+=item * Thou shalt use and dispense freely without other restrictions.
+
+=back
+
+=head1 CHANGES
+
+0.14
+
+=over
+
+=item Removed warning under modern perls
+
+5.12 introduced a warning about prototypes that Curses::UI has not yet fixed
+
+=back
+
+0.13
+
+=over
+
+=item Fix inclusion of year in scan format.
+
+=item Documentation clean-up.
+
+=item Check profile for default switches, using the name we're invoked as.
+
+=item Added display of B<-cull> and B<-newsequence> to the status line
+
+=item Fixed exit status message, which didn't account for B<-newsequence>.
+
+=item Removed closing reverse tag from status
+
+ Curses::UI implies support for that feature but it doesn't offer it yet :-/
+
+=back
+
+0.12
+
+=over
+
+=item Added -cull & -newsquence options
+
+=back
+
+0.11
+
+=over
+
+=item Fixed status bar, it always showed -zero
+
+=back
+
+0.10
+
+=over
+
+=item Fixed paging behavior, it only DWIMd if you were on the first item of a page.
+
+=back
+
+0.09
+
+=over
+
+=item Changed paging behavior to more closely Do What I Mean
+
+=back
+
+0.08
+
+=over
+
+=item Added support for ^Z
+
+=back
+
+0.07
+
+=over
+
+=item Added message viewing
+
+=back
+
+=head1 TODO
+
+=over
+
+=item shift for self or root to kill use vars
+
+=item switch scan from qx to pipe read to minimize delay?
+
+=item M-< / M-> for end/begin?
+
+=item Add back </reverse> to status once Curses::UI better supports htmltext
+
+=back
+
+=cut
projects / mmh / commitdiff