git.marmaro.de Git - mmh/blob - docs/contrib/vpick

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use vars qw($cui $list $win $VERSION);
   4
   5 #5.12 introduced a warning about prototypes that afflicts old Curses::UI
   6 #BEGIN{ if( $^V lt v5.12.0 ){eval "use Curses::UI"}else{ eval "no warnings 'illegalproto'; use Curses::UI" }  }
   7
   8 use Curses::UI 0.9608;
   9 use Getopt::Long;
  10
  11 $VERSION = 0.14;
  12 my %opts = configure();
  13 my $exit = sprintf("marked sequence %s in +%s\n",
  14    ($opts{newsequence}||$opts{sequence}), $opts{'+'});
  15 $SIG{CONT} = sub{ $cui->leave_curses(); $cui->reset_curses() };
  16
  17 $cui = new Curses::UI;
  18 $cui->add('status', 'Window', -y=>-1, -height=>1)->
  19 #, -htmltext=>1
  20       add('explain', 'Label', -reverse=>1, -bold=>1, -text=>
  21           '    H)elp  I)nvert  V)iew  Q)uit  S)ave  '. #  </reverse>
  22           "+$opts{'+'} -seq $opts{sequence}".
  23           ($opts{cull}?' -cull':'').($opts{zero}?' -zero':'').
  24           ($opts{newsequence}?" -new $opts{newsequence}":''));
  25
  26 $cui->set_binding(\&help, 'h');
  27 $cui->set_binding($SIG{CONT}, "\cL");
  28 $cui->set_binding(\&setSequence, 's');
  29 $cui->set_binding(sub{ kill "STOP", $$}, "\cZ");
  30 #XXX clear on sleep?
  31
  32 my(@values, %labels, %indices);
  33 scan(\@values, \%labels, \%indices);
  34
  35 $win = $cui->add('window', 'Window', -padbottom=>1);
  36 $list = $win->
  37   add('mylistbox', 'Listbox', -multi=>1, -values=>\@values, -labels=>\%labels, -htmltext=>0);
  38
  39 #XXX use -bindings and -routines as in Widget to clean up code?
  40 $list->set_binding(sub{ $exit=''; exit }, "\cC", 'q');
  41 $list->set_binding(\&invert=>'i');
  42 $list->set_binding(\&view, 'v', 'm');
  43 $list->set_binding(\&pgdn, "\cV", ' ' );
  44 $list->set_binding(\&pgup, "\eV", 'b');
  45 $list->set_selection(@indices{getSequence()}) unless $opts{zero};
  46 $list->focus();
  47 $cui->mainloop;
  48
  49
  50 ##Heavy Lifting
  51 END{
  52   $cui->leave_curses();
  53   print "\n", $exit;
  54   exit;
  55 }
  56
  57 sub configure{
  58   my %args = (_MBMHR=>(eval "use Mail::Box::MH::Resource 0.06", !$@),
  59               _NR   =>(eval "use Number::Range", !$@) );
  60
  61   {#Get default values
  62     local $_;
  63     my $nom = $0;
  64     $nom =~ s%^.+/%%;
  65     $_ = $args{_MBMHR} ? Mail::Box::MH::Resource->new()->get($nom) :
  66           `mhparam $nom`;
  67     unshift(@ARGV, split) if defined;
  68   }
  69
  70   Getopt::Long::Configure qw(auto_abbrev pass_through);
  71   GetOptions (\%args, 'sequence=s', 'newsequence:s',
  72               'cull!', 'reverse!', 'zero!');
  73   $args{'+'} = (grep {/^\+/} @ARGV)[0] || '';
  74   $args{'+'} =~ s/^\+//;
  75   unless( $args{sequence} ){
  76     $args{sequence}='vpick';
  77     $args{zero} = 1;
  78   }
  79
  80   $args{newsequence} ||= 'vpick' if defined $args{newsequence};
  81
  82   if( $args{_MBMHR} ){
  83     my $MHR = Mail::Box::MH::Resource->new();
  84     $args{_Path} = $MHR->get('Path');
  85     $args{_Path} = File::Spec->file_name_is_absolute($args{_Path}) ?
  86                                                      $args{_Path} :
  87                      File::Spec->catfile($ENV{HOME}, $args{_Path});
  88     $MHR = Mail::Box::MH::Resource->new(File::Spec->catfile($args{_Path},
  89                                                           'context'));
  90     $args{'+'} ||= $MHR->get('Current-Folder');
  91   }
  92   else{
  93     $args{zero} = 1; }
  94   return %args;
  95 }
  96
  97 sub help{
  98   $cui->dialog(
  99                -title   =>'Navigation',
 100                -message =><<MESSAGE
 101                         vpick v$VERSION
 102
 103   ^A <Home>             Top of list
 104    b <PgUp>             Page up
 105    k <Up>               Scroll up
 106
 107    l <Right> <Enter>    Mark message
 108               y      1  Mark   & advance
 109               n      0  Unmark & advance
 110
 111    j <Down>             Scroll down
 112   ^V <PgDn>  <Space>    Page down
 113   ^E <End>              Bottom of list
 114
 115    /                    Search forward
 116    ?                    Search backward
 117 \0
 118 MESSAGE
 119               );
 120 }
 121
 122 sub invert{
 123   my %count;
 124   my @F = getSequence();
 125   foreach($list->get(), @values){ $count{$_}++ }
 126   foreach(keys %count){ delete($count{$_}) if $count{$_} > 1 }
 127   $list->clear_selection();
 128   $list->set_selection(@indices{%count});
 129   $list->draw();
 130 }
 131
 132 sub pgdn{
 133   my $this = shift;
 134   if ($this->{-ypos} >= $this->{-max_selected}) {
 135     $this->dobeep;
 136     return $this;
 137   }
 138   {
 139     use integer;
 140     $this->{-ypos} = $this->canvasheight *
 141       ( 2 + $this->{-ypos}/$this->canvasheight );
 142   }
 143   $this->run_event('-onselchange');
 144
 145   #This is critical for to end up at the top of the screen,
 146   #and why jumped two pages
 147   $this->draw();
 148   $this->{-ypos} -= $this->canvasheight;
 149
 150   $this->run_event('-onselchange');
 151   $this->schedule_draw(1);
 152   return $this;
 153 }
 154
 155 sub pgup{
 156   my $this = shift;
 157   if ($this->{-ypos} <= 0) {
 158     $this->dobeep;
 159     return $this;
 160   }
 161   $this->{-ypos} -= $this->canvasheight
 162     +$this->{-ypos}%$this->canvasheight;
 163   $this->run_event('-onselchange');
 164   $this->schedule_draw(1);
 165   return $this;
 166 }
 167
 168 sub scan{
 169   #Add back space for wide msg number, less the space used by the checkbox
 170   #XXX #my $width = q'-width '. (qx'scan -format "%(width)" -noheader last'+6);
 171   my $width = q'-width '. ($ENV{COLS} + 6);
 172   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}>>%>'`;
 173   my $args = "+$opts{'+'} " if $opts{_MBMHR};
 174      $args.= $opts{reverse} ? '-reverse' : '-noreverse';
 175
 176      $args.= " $opts{sequence}" if $opts{cull};
 177
 178   my $i=0;
 179   foreach( split/\n/, qx/scan -noheader $width $format $args/ ){
 180     my (undef, $value, $label) = split(/\s+/, $_, 3);
 181     push @{$_[0]}, $value;
 182     $_[1]->{$value} = $label;
 183     $_[2]->{$value} = $i++;
 184   }
 185
 186 }
 187
 188 sub view{
 189   my $view;
 190   if( $view = $win->getobj('view') ){
 191     $view->focus();
 192   }
 193   else{
 194     $view = $win->add('view', 'TextViewer', -vscrollbar=>1, -wrapping=>1);
 195     $view->set_binding(sub{ $list->focus(); $win->delete('view') },
 196                        "\cC", 'q', 'v', 'm');
 197 #    $view->set_binding(sub{ $list->focus() }, "\cC", 'q', 'v', 'm');
 198     $view->set_binding('cursor-pagedown'=>"\cV");
 199     $view->set_binding('cursor-pageup'  =>"\eV", 'b');
 200   }
 201
 202   my $path;
 203   my $msg = $list->get_active_value();
 204   if( $opts{_MBMHR} ){
 205     $path = File::Spec->catfile($opts{_Path},$opts{'+'},$msg); }
 206   else{
 207     $path = qx(mhpath $msg); }
 208   $view->text("Message: $msg\n". do{ local $/=undef; open(MSG, $path); <MSG>});
 209   #XXX || Error
 210   $view->focus();
 211 }
 212
 213 sub getSequence{
 214   my $MHR = Mail::Box::MH::Resource->new(
 215               File::Spec->catfile($opts{_Path}, $opts{'+'}, '.mh_sequences') );
 216   local $_ = $MHR->get($opts{sequence});
 217   s/(?=\s)/,/g; s/-/\.\./g;
 218   eval;
 219 }
 220
 221 sub setSequence{
 222   if( $opts{_NR} && $opts{_MBMHR} ){
 223     my $seq = scalar Number::Range->new($list->get())->range();
 224     $seq =~ s/\.\./-/g;
 225     $seq =~ y/,/ /;
 226     my $MHR = Mail::Box::MH::Resource->new(
 227                 File::Spec->catfile($opts{_Path},$opts{'+'},'.mh_sequences'));
 228     $MHR->set($opts{newsequence}||$opts{sequence}=>$seq);
 229     exit $MHR->close(); }
 230   else{
 231     exit system('mark', '-zero', '-seq', $opts{sequence}, $list->get())>>8;}
 232 }
 233
 234 __END__
 235 =pod
 236
 237 =head1 NAME
 238
 239 vpick - visual pick, mark a message sequence by eye
 240
 241 =head1 SYNOPSIS
 242
 243 vpick [+folder] [B<-sequence> name] [B<-newsequence> [name]] [B<-cull>] [B<-zero>] [B<-reverse>] [B<sequence>]
 244
 245 =begin html
 246
 247 =head1 SCREENSHOT
 248
 249 <img src="vpick.png" height=464 width=992>
 250
 251 =head1 DOWNLOAD
 252
 253 =over
 254
 255 =item The script source.
 256
 257 <a href="vpick">vpick</a>
 258
 259 =item A binary for i686 Linux (Perl 5.8.0) for testing the software without ins\
 260 talling the L<dependencies|/REQUIREMENTS>.
 261
 262 <a href="ftp://pthbb.org/pub/MH/vpick.gz">vpick.gz</a>
 263
 264 =back
 265
 266 =end html
 267
 268 =head1 DESCRIPTION
 269
 270 A nifty little tool for those dyed-in-the-wool MH users whom occasionally envy
 271 those pine/elm/mutt users. For those times when you'll know what you want when
 272 you see it and mark just won't cut it. vpick allows you to check boxes for
 273 individual messages to save them in a sequence.
 274
 275 If you're lucky and your local curses library has mouse support you might even
 276 be the envy of your friends.
 277
 278 =head2 INTERFACE
 279
 280 =over
 281
 282 =item * C<h>
 283
 284 Online navigation help.
 285
 286 =item * C<i>
 287
 288 Invert the current message selections.
 289
 290 =item * C<m>, C<v>
 291
 292 Toggle a display of the highlighted message.
 293
 294 =item * C<s>
 295
 296 Save the sequence and exit.
 297
 298 =item * C<q>
 299
 300 Exit without saving changes to the sequence.
 301
 302 =back
 303
 304 =head3 Navigation
 305
 306 =over
 307
 308 =item * C<Right>, C<l>, C<Enter>
 309
 310 Add the current message to the sequence.
 311
 312 =item * C<1>, C<y>
 313
 314 Add the current message to the sequence and advance to the next message.
 315
 316 =item * C<0>, C<n>
 317
 318 Remove the current message from the sequence and advance to the next message.
 319
 320 =item * C<Down>, C<j>
 321
 322 Advance to the next message.
 323
 324 =item * C<Up>, C<k>
 325
 326 Select previous message.
 327
 328 =item * C<PageUp>, C<b>, C<M-v>
 329
 330 Scroll up a page.
 331
 332 =item * C<PageDown>, C<C-v>
 333
 334 Scroll down a page.
 335
 336 =item * C<Home>, C<C-a>
 337
 338 Select the first message in the folder.
 339
 340 =item * C<End>, C<C-e>
 341
 342 Select the last message in the folder.
 343
 344 =item * C</>
 345
 346 Search message entries with a 'less'-like search system.
 347 A searchstring is entered and selection advances to the first match.
 348 After that the C<n> will search for the next occurance,
 349 and C<N> the previous.
 350
 351 =item * C<?>
 352
 353 The same as C</>, only it will search in the opposite direction.
 354
 355 =back
 356
 357 =head1 OPTIONS
 358
 359 Like MH commands, vpick options can be abbreviated to a shortest unique string,
 360 and any option that does not take an argument can be prefixed by I<no> to
 361 override earlier options.
 362
 363 =over
 364
 365 =item B<+folder>
 366
 367 The name of the folder to edit a sequence for. Defaults to the current folder.
 368
 369 =item B<-sequence> name
 370
 371 The name of the sequence to edit. Defaults to I<vpick>.
 372
 373 =item B<sequence>
 374
 375 Only display the messages in the specified sequence.
 376 You probably want B<-cull> instead.
 377
 378 =back
 379
 380 =over
 381
 382 =item B<-cull>, B<-nocull>
 383
 384 Only display the messages currently in B<-sequence>. Shorthand for:
 385
 386  -seq foo foo
 387
 388 =item B<-reverse>, B<-noreverse>
 389
 390 View the folder in reverse order.
 391
 392 =item B<-newsequence> name
 393
 394 Save the altered message sequence as this new name, rather than clobber the
 395 existing sequence. The sequence name is otpional, and defaults to I<vpick>.
 396
 397 This is useful for catching up on a backlog of unread messages like so:
 398
 399   -seq unseen -new -cull
 400
 401 This preserves your I<unseen> sequence, so that when you C<rmm> the chaff
 402 in I<vpick>, I<unseen> contains only wheat.
 403
 404 =item B<-zero>, B<-nozero>
 405
 406 Zeroing loads an empty sequence, B<-nozero> flags existing messages from
 407 the sequence. Default is B<-nozero> unless B<-sequence> defaults to I<vpick>.
 408 See L</REQUIREMENTS>.
 409
 410 =back
 411
 412 =head1 REQUIREMENTS
 413
 414 =over
 415
 416 =item C<Curses::UI>
 417
 418 To provide the nifty visual interface.
 419
 420 =item C<scan>
 421
 422 Required to summarize folder contents. But then you use MH, you knew that.
 423
 424 =item C<mark> OR C<Mail::Box::MH::Resource> + C<Number::Range>
 425
 426 Required to preserve sequences.
 427 The latter is preferred, without it some functionality will be disabled i.e;
 428 vpick will be forced to run as if -zero were given.
 429
 430 Strictly speaking, you can also use vpick with MBMHR and not Number::Range.
 431
 432 =back
 433
 434 =head1 CAVEATS
 435
 436 If using C<mark> instead of MBMHR and Number::Range with large sequences
 437 you may loose; blame the shell.
 438
 439 You should not do anything to alter message ordering/numbering while vpick
 440 is running e.g; L<sortm(1)>, L<folder(1)> -pack Other operations are fine.
 441
 442 =head1 RESTRICTIONS
 443
 444 The scan format is embedded in the program, it doesn't seem worthwhile to
 445 abstract it to a user configurable setting.
 446
 447 =head1 SEE ALSO
 448
 449 L<mark(1)>, L<pick(1)>, L<scan(1)>
 450
 451 =head1 AUTHOR
 452
 453 Jerrad Pierce <jpierce@cpan.org>.
 454
 455 =head1 LICENSE
 456
 457 =over
 458
 459 =item * Thou shalt not claim ownership of unmodified materials.
 460
 461 =item * Thou shalt not claim whole ownership of modified materials.
 462
 463 =item * Thou shalt grant the indemnity of the provider of materials.
 464
 465 =item * Thou shalt use and dispense freely without other restrictions.
 466
 467 =back
 468
 469 =head1 CHANGES
 470
 471 0.14
 472
 473 =over
 474
 475 =item Removed warning under modern perls
 476
 477 5.12 introduced a warning about prototypes that Curses::UI has not yet fixed
 478
 479 =back
 480
 481 0.13
 482
 483 =over
 484
 485 =item Fix inclusion of year in scan format.
 486
 487 =item Documentation clean-up.
 488
 489 =item Check profile for default switches, using the name we're invoked as.
 490
 491 =item Added display of B<-cull> and B<-newsequence> to the status line
 492
 493 =item Fixed exit status message, which didn't account for B<-newsequence>.
 494
 495 =item Removed closing reverse tag from status
 496
 497       Curses::UI implies support for that feature but it doesn't offer it yet :-/
 498
 499 =back
 500
 501 0.12
 502
 503 =over
 504
 505 =item Added -cull & -newsquence options
 506
 507 =back
 508
 509 0.11
 510
 511 =over
 512
 513 =item Fixed status bar, it always showed -zero
 514
 515 =back
 516
 517 0.10
 518
 519 =over
 520
 521 =item Fixed paging behavior, it only DWIMd if you were on the first item of a page.
 522
 523 =back
 524
 525 0.09
 526
 527 =over
 528
 529 =item Changed paging behavior to more closely Do What I Mean
 530
 531 =back
 532
 533 0.08
 534
 535 =over
 536
 537 =item Added support for ^Z
 538
 539 =back
 540
 541 0.07
 542
 543 =over
 544
 545 =item Added message viewing
 546
 547 =back
 548
 549 =head1 TODO
 550
 551 =over
 552
 553 =item shift for self or root to kill use vars
 554
 555 =item switch scan from qx to pipe read to minimize delay?
 556
 557 =item M-< / M-> for end/begin?
 558
 559 =item Add back </reverse> to status once Curses::UI better supports htmltext
 560
 561 =back
 562
 563 =cut