[Mew-dist 17552] delete old mails when mew-pop-delete is nil

[INOUE Tomohiro]

井上といいます。

mew-pop-delete が nil の時、
「pop server に N 日間だけメールを残す」というのを実装してみました。
＃remote folder はまだ先のようですし。

mew-pop-keep に残したい日数を設定します。（config-alist でも可）


注意：
.mew-uidl の書式を変えてしまっているので、最初の一回だけは
サーバに残っているメールを全部取り直してしまいます。

実際に古いメールを消す処理がここ(mew-pop-command-umsg)でいいのか
どうか良くわかりませんでした。
また、Truncate されたメールも消してしまうというのはもしかしたら
問題かもしれません。


---
井上 知洋

-------------- next part --------------
*** mew-config.el.orig	Sat May 26 08:35:47 2001
--- mew-config.el	Sat May 26 11:35:47 2001
***************
*** 210,215 ****
--- 210,218 ----
  (defun mew-pop-delete (&optional case)
    (mew-cfent-value case "pop-delete" mew-pop-delete))
  
+ (defun mew-pop-keep (&optional case)
+   (mew-cfent-value case "pop-keep" mew-pop-keep))
+ 
  ;;
  
  (defun mew-nntp-server (&optional case)
*** mew-vars.el.orig	Sat May 26 10:54:06 2001
--- mew-vars.el	Sat May 26 11:23:29 2001
***************
*** 465,470 ****
--- 465,476 ----
    :group 'mew-env
    :type 'boolean)
  
+ (defcustom mew-pop-keep 0
+   "*Days to keep messgaes on the pop server when 'mew-pop-delete' is nil
+ 0 means to keep forever."
+   :group 'mew-env
+   :type 'integer)
+ 
  (defcustom mew-pop-size (* 54 1024) ;; 4K hdr + 50K bdy
    "*The limit of message size to be retrieved by POP.
  0 means no limit, retrives any messages."
*** mew-pop.el.orig	Sat May 26 08:35:48 2001
--- mew-pop.el	Sat May 26 14:11:36 2001
***************
*** 551,561 ****
        (mew-pop-set-status pnm "quit")
        (mew-pop-command-quit pro pnm))))
  
  (defun mew-pop-command-umsg (pro pnm)
    (let ((old-msgs (mew-pop-get-messages pnm)) ;; (num siz)
  	(sul (mew-pop-get-sul pnm))           ;; (siz uid lmsg)
  	(old-uidl (mew-pop-uidl-db-get pnm))
! 	num siz uid msgs uidl n siz-uid-lmsg)
      (while (re-search-forward "^\\([0-9]+\\) +\\([!-~]+\\)" nil t)
        (setq num (mew-match 1))
        (setq uid (mew-match 2))
--- 551,569 ----
        (mew-pop-set-status pnm "quit")
        (mew-pop-command-quit pro pnm))))
  
+ (defsubst mew-pop-uidl-expired (utime keep)
+   (let ((now (current-time)) day)
+     (when (and (numberp keep) (> keep 0))
+       (setq day (/ (+ (* 65536 (- (nth 0 now) (nth 0 utime)))
+ 		      (- (nth 1 now) (nth 1 utime)))
+ 		   86400)) ;; one day (* 60 60 24)
+       (if (> day keep) t))))
+ 
  (defun mew-pop-command-umsg (pro pnm)
    (let ((old-msgs (mew-pop-get-messages pnm)) ;; (num siz)
  	(sul (mew-pop-get-sul pnm))           ;; (siz uid lmsg)
  	(old-uidl (mew-pop-uidl-db-get pnm))
! 	num siz uid uid-time msgs uidl n siz-uid-lmsg)
      (while (re-search-forward "^\\([0-9]+\\) +\\([!-~]+\\)" nil t)
        (setq num (mew-match 1))
        (setq uid (mew-match 2))
***************
*** 564,574 ****
  	(if (setq siz-uid-lmsg (mew-assoc-equal uid sul 1))
  	    (setq msgs (cons (cons num siz-uid-lmsg) msgs))))
         (t ;; (num siz uidl)
! 	(setq uidl (cons uid uidl))
! 	(if (member uid old-uidl)
! 	    ()
  	  (setq siz (nth 1 (assoc num old-msgs)))
! 	  (setq msgs (cons (list num siz uid) msgs))))))
      (mew-pop-set-uidl pnm uidl)
      (setq msgs (nreverse msgs))
      (mew-pop-set-messages pnm msgs)
--- 572,588 ----
  	(if (setq siz-uid-lmsg (mew-assoc-equal uid sul 1))
  	    (setq msgs (cons (cons num siz-uid-lmsg) msgs))))
         (t ;; (num siz uidl)
! 	;; (setq uidl (cons uid uidl))
! 	(setq uid-time (assoc uid old-uidl))
! 	(if uid-time
! 	    (when (and (not (mew-pop-delete))
! 		       (mew-pop-uidl-expired 
! 			(cdr uid-time) (mew-pop-keep (mew-pop-get-case pnm))))
! 	      (process-send-string pro (format "dele %s%s" num mew-cs-eol)))
! 	  (setq uid-time (cons uid (current-time)))
  	  (setq siz (nth 1 (assoc num old-msgs)))
! 	  (setq msgs (cons (list num siz uid) msgs)))
! 	(setq uidl (cons uid-time uidl)))))
      (mew-pop-set-uidl pnm uidl)
      (setq msgs (nreverse msgs))
      (mew-pop-set-messages pnm msgs)
*** mew-vars2.el.orig	Thu May 24 21:43:34 2001
--- mew-vars2.el	Mon May 28 23:10:24 2001
***************
*** 847,853 ****
  \"smtp-user\", \"smtp-auth\", \"smtp-auth-list\", 
  \"pop-server\", \"pop-port\", \"pop-ssh-server\", 
  \"pop-user\", \"pop-auth\", 
! \"pop-size\", \"pop-body-lines\", \"pop-delete\", 
  \"inbox-folder\", \"queue-folder\",
  \"mailbox-type\", \"mbox-command\", \"mbox-command-arg\", 
  \"nntp-server\", \"signature-file\" .
--- 847,853 ----
  \"smtp-user\", \"smtp-auth\", \"smtp-auth-list\", 
  \"pop-server\", \"pop-port\", \"pop-ssh-server\", 
  \"pop-user\", \"pop-auth\", 
! \"pop-size\", \"pop-body-lines\", \"pop-delete\", \"pop-keep\", 
  \"inbox-folder\", \"queue-folder\",
  \"mailbox-type\", \"mbox-command\", \"mbox-command-arg\", 
  \"nntp-server\", \"signature-file\" .