[Mew-dist 1781] Re: Delete Mail in +trash

[Shinji Kawakami]

In article <19970829113309Z.kazu at example.com> Mew-dist 1772,
	   [Kazu Yamamoto (山本和彦) <Kazu at example.com>] writes:
> > ぐっとくるかどうかは分かりませんが…
> > mew-mark.elを眺めていたら +trash folderだったら Deleteしないような
> > 記述がありました。だったら、+trash folderだったら本当に削除してしまえば
> > いいのではと思い以下のようにしてみました。
> 
> 削除に関して、みなさんこれでいいですか？

miya at example.com さんのコードだと、trash folder の中身がすべて、
D mark してないにも関らず消えてしまいませんか?

私が、1.85がでてすぐに出した、[Mew-dist 1211]の案はいかがでしょう?
つまり trash folder で、D mark したものだけを本当に消すという案です。

指定のファイルだけ unlink する IM (MHでいうところの、rmm)をを作って
呼び出す形にするとか…。
# 勝手に、imrmm と命名して作っちゃいました。(^-^;
# 元は、imrm か immv だったと思う…。

そのパッチです。

# あと、imrm を呼び出す関数が欲しいな…。

-- 
河上眞二               JEOL System Technology Co.,Ltd.
Shinji Kawakami       Semiconductor Engineering Group
kawakami at example.com, include at example.com(Private)


-------------- next part --------------
*** mew-mark.el.ORIG	Tue Aug 26 09:56:51 1997
--- mew-mark.el	Fri Aug 29 12:37:50 1997
***************
*** 497,508 ****
  	;;
  	;; delete at once
  	;;
! 	(if (and dels (not (equal src mew-trash-folder)))
! 	    (apply (function call-process)
! 		   mew-prog-immv nil nil nil
! 		   (format "--src=%s" src)
! 		   mew-trash-folder
! 		   dels))
  	;;
  	;; ending...
  	;;
--- 497,514 ----
  	;;
  	;; delete at once
  	;;
! 	(if dels
! 	    (if (equal src mew-trash-folder)
! 		(apply (function call-process)
! 		       mew-prog-imrmm nil nil nil
! 		       (format "--src=%s" src)
! 		       dels)
! 	      ;; else (src folder is not trash folder)
! 	      (apply (function call-process)
! 		     mew-prog-immv nil nil nil
! 		     (format "--src=%s" src)
! 		     mew-trash-folder
! 		     dels)))
  	;;
  	;; ending...
  	;;
-------------- next part --------------
*** mew.el.ORIG	Tue Aug 26 09:59:26 1997
--- mew.el	Fri Aug 29 12:37:12 1997
***************
*** 407,412 ****
--- 407,413 ----
  (defvar mew-prog-impath      "impath")
  (defvar mew-prog-impack      "impack")
  (defvar mew-prog-immv        "immv")
+ (defvar mew-prog-imrmm       "imrmm")
  (defvar mew-prog-imput       "imput")
  (defvar mew-prog-imsort      "imsort")
  (defvar mew-prog-imgrep      "imgrep")
-------------- next part --------------
#! /usr/local/bin/perl
################################################################
###
###				imrmm
###
###	      Copyright (C) 1997  Internet Message Group
### 
###		     This Perl5 library conforms
###		GNU GENERAL PUBLIC LICENSE Version 2.
###
###
### Author:  Internet Message Group <img at example.com>
### Created: Apr 23, 1997
### Revised: Jul  1, 1997
### 

my $VERSION = "imrmm version 970701";

$Prog = 'imrmm';

##
## Require packages
##

use IM::Config;
use IM::Folder;

##
## Environments
##

#$DEBUG    = 1;
%NewMsgCache = ();

$EXPLANATION = "
$Prog :: Internet Message Remove Message
$VERSION

Usage: $Prog [options] msgs...
";

@OptConfig = (
    'noharm;b;;' => "Display the commands but do not actually execute them.",
    'src;F;;'    => "Set source folder.",
    'help;b;;'   => "Show this message.",
    );

##
## Profile and option processing
##

init_opt(\@OptConfig);
read_env(\@EnvConfig);
read_cfg();
read_opt(\@ARGV); # help?
help($EXPLANATION) && exit $EXIT_SUCCESS if ($opt_help);

##
## Main
##

@ARGV    || im_die "no message specified.\n";

@msgs  = @ARGV;
$msgs  = \@msgs;

imrmm($opt_src, $msgs);
exit $EXIT_SUCCESS;

##################################################
##
## Work horse
##
sub imrmm
{
    my ($src, $msgs) = @_;
    my @msg_paths;

    chk_folder_existance($src);             # not return in case false.
    chk_msg_existance($src, @{$msgs});      # not return in case false.
    
    @msg_paths = impath($src, @{$msgs});

    foreach (@msg_paths){
	$opt_noharm ? print "unlink $_\n" :
	    unlink($_) || die $@;
    }
}

sub printd
{
    print STDERR @_ if $DEBUG;
}

##
## Check folder existance.
##
sub chk_folder_existance
{
    my @folders = @_;
    my $path;

    printd("chk_folder_existance: folder: @folders\n");

    foreach (@folders){
	$path = impath($_);

	im_die "no folder $_. (Nothing was removed.)\n"
	    if (!-d $path);
	im_die "folder $_ is not writable. (Nothing was removed.)\n"
	    if (!-w $path);
    }
    printd("chk_folder_existance: OK.\n");
}

sub chk_msg_existance
{
    my $folder = shift;
    my @paths  = impath($folder, @_);

    printd("chk_msg_existance: folder: $folder msg: @_\n");

    foreach (@paths){
	im_die "message specification error in $folder. (Nothing was removed.)\n"
	    if (!-f $_);
    }
    printd("chk_msg_existance: OK.\n");
}

sub impath
{
    my $folder = shift;
    my @msgs  = @_;
    my @paths;

    printd("impath: folder: $folder msgs: @msgs\n");
    @paths = get_message_paths($folder, @msgs);
    printd("impath: paths: @paths\n");

    return wantarray ? @paths : $paths[0];
}