[mew-dist 25639] Re: マーク変換

[Hideyuki SHIRAI ( 白井秀行 )]

From: Kazu Yamamoto (山本和彦) <kazu at example.com> さん曰く
Subject: [mew-dist 25638] マーク変換
Message-ID: <20041109.112421.123810047.kazu at example.com>
Date: Tue, 09 Nov 2004 11:24:21 +0900 (JST)

> マーク変換コマンド "e" を実装しました。
> "o" マーク以外のマークが変換できます。

処理時間は格段に増えますが、thread/virtual でも OK と "o" 対応を
やってみました。"eoo" で refile 先を変更できるのは面白いかも。

# ちょっと力ずくか。

-- 
白井秀行 (mailto:shirai at example.com)

(defun mew-summary-input-exchangeable-mark (msg)
  (let (mark)
    (catch 'loop
      (while t
	(setq mark (mew-input-mark msg))
	(if mark
	    (throw 'loop mark)
	  (message "That is not a mark")
	  (mew-let-user-read))))))

(defun mew-summary-exchange-marks ()
  (interactive)
  (let* ((from (mew-summary-input-exchangeable-mark "Input mark from: "))
	 (to (mew-summary-input-exchangeable-mark "Input mark to: "))
	 (regex (mew-mark-regex from))
	 (refile (eq to mew-mark-refile))
	 folders)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward regex nil t)
	(when refile
	  (while (not folders)
	    (setq folders (mew-summary-exchange-refile-folders))))
	(mew-summary-undo-one 'nomsg)
	(if refile
	    (mew-summary-refile-body folders nil 'nomsg)
	  (mew-mark-put-mark to 'nomsg))
	(forward-line 1)))))

(defun mew-summary-exchange-refile-folders ()
  (let (fld msg folders folder tmp
	    mew-inherit-refile-case mew-inherit-refile-proto)
    (mew-summary-goto-message)
    (when (mew-sumsyn-match mew-regex-sumsyn-short)
      (setq fld (mew-sumsyn-folder-name))
      (setq msg (mew-sumsyn-message-number))
      (setq mew-inherit-refile-case  (mew-case:folder-case fld))
      (setq mew-inherit-refile-proto (mew-case:folder-folder fld))
      (if (setq buf (mew-cache-hit fld msg))
	  (setq folders (car (mew-refile-decide-folders buf msg nil)))
	(with-temp-buffer
	  (mew-insert-message
	   fld msg mew-cs-text-for-read mew-header-reasonable-size)
	  (mew-refile-decode-subject)
	  (setq folders
		(car (mew-refile-decide-folders (current-buffer)
						msg nil)))))
      (setq folders (delete mew-draft-folder folders))
      (while folders
	(setq folder (car folders))
	(setq folders (cdr folders))
	(unless (mew-folder-queuep folder)
	  (setq tmp (cons folder tmp))))
      (nreverse tmp))))