[mew-dist 21349] Re: Delete duplicated messages

KOIE Hidetaka ( 鯉江英隆 ) hide at example.com
2002年 8月 1日 (木) 11:48:55 JST


  Message-Id: <20020801.105802.41639444.hide at example.com>
  Date:       Thu, 01 Aug 2002 10:58:02 +0900 (JST)
  From:       KOIE Hidetaka (鯉江英隆) <hide at example.com>
  Subject:    [mew-dist 21347] Re: Delete duplicated messages

  | 複数の経路から同じメイルがとどくことが多いので重宝してます。
  | 
  |   | ようは、Message-Id: が重複しているメッセージに D が付けばいいだけです
  |   | ので、こんなのを仕立ててみました。ちなみに、Sylpheedには同じような機能
  |   | が載っているようです。

  | obarrayをつかって高速化しました。

重複したメッセージの最初のメッセージに `*' マークをつけるようにしました。

--
KOIE Hidetaka 鯉江英隆 <hide at example.com>
-------------- next part --------------
(defun mew-summary-delete-duplicates (&optional arg)
  "Put delete marks on the duplicased messages in Summary, Virtual or
Thread mode.

If called with '\\[universal-argument]', process in the region."
  (interactive "P")
  (mew-summary-not-in-queue
   (mew-summary-not-in-draft
    (let (beg end region my-id fst-id p size ids (revs 0) (dels 0))
      (cond
       (arg
	(setq region (mew-summary-get-region))
	(setq beg (car region))
	(setq end (cdr region)))
       (t
	(setq beg (point-min))
	(setq end (point-max))))
      ;; mew-summary-thread-region in mew-threaed.el
      (setq size (mew-count-lines beg end))
      (cond
       ((<= size 211)
        (setq size 211))
       ((<= size 1511)
        (setq size 1511))
       ((<= size 7211)
        (setq size 7211))
       (t
        (setq size 18211)))
      (setq ids (make-vector size 0))
      (message "Marking duplications...")
      (save-excursion
	(goto-char end)
	(beginning-of-line)
	(setq end (point))
	(goto-char beg)
	(beginning-of-line)
	(while (< (point) end)
	  (when (and (mew-summary-message-number)
		     (not (mew-summary-marked-p)))
	    (setq my-id (mew-summary-my-id))
	    (when (> (length my-id) 0)
              (setq fst-id (intern-soft my-id ids))
              (if (null fst-id)
                  (set (intern my-id ids) (point))
                (setq p (symbol-value fst-id))
                (if (numberp p)
                    (save-excursion
                      (goto-char p)
                      (mew-mark-put-mark mew-mark-review 'no-msg)
                      (setq revs (1+ revs))
                      (set (intern my-id ids) t)))
                (mew-mark-put-mark mew-mark-delete 'no-msg)
                (setq dels (1+ dels)))))
            (forward-line 1)))
      (if (= revs 0)
          (message "Marking duplications...done  (no duplications)")
        (message "Marking duplications...done  (%c marked: %d, %c marked: %d)"
                 mew-mark-review revs mew-mark-delete dels))))))


Mew-dist メーリングリストの案内