Windowsっぽいフォワード

Outlook とか使ってる人にフォワードするとこの添付ファイル何？とか言われるから作った。せめて text/plain な別パートにしようかとも思ったけど、そうすると Beckey で別のタブになるからそれもナシ。
summary-mode で "f" を押すと

Select Forward Method: R)fc822 W)indows like

って表示される。"r" で今まで通り。"w" で Windows っぽくフォワードする。

(define-key wl-summary-mode-map "f" 'wl-summary-forward-select)

(defun wl-summary-forward-like-windows ()
  "windows っぽいフォワード"
  (interactive)
  (let ((summary-buf (current-buffer))
	(message (wl-summary-message-string 'maybe))
	(folder (wl-summary-buffer-folder-name))
	(number (wl-summary-message-number))
	to subject forward-subject date in-reply-to cc references newsgroups mail-followup-to
	content-type content-transfer-encoding from
	body-beg body)
    (with-temp-buffer
      (set-buffer-multibyte t)
      (insert (string-to-multibyte message))
      (setq subject (std11-field-body "Subject"))
      (setq subject (or (and subject
			     (eword-decode-string
			      (decode-mime-charset-string
			       subject
			       wl-mime-charset)))
			"")
	    forward-subject (wl-draft-forward-make-subject subject))
      (setq to (std11-field-body "To"))
      (setq to (or (and to
			(eword-decode-string
			 (decode-mime-charset-string
			  to
			  wl-mime-charset)))
		   ""))
      (setq from (std11-field-body "From"))
      (setq from (and from
		      (eword-decode-string
		       (decode-mime-charset-string
			from
			wl-mime-charset))))
      (setq date (std11-field-body "Date"))
      (setq date (or (and date
			  (let ((datevec (timezone-parse-date date)))
			    (format "%s/%s/%s %s"
				    (aref datevec 0)
				    (aref datevec 1)
				    (aref datevec 2)
				    (aref datevec 3))))
		     ""))
      (setq references (nconc
			(std11-field-bodies '("References" "In-Reply-To"))
			(list (std11-field-body "Message-Id"))))
      (setq references (delq nil references)
	    references (mapconcat 'identity references " ")
	    references (wl-draft-parse-msg-id-list-string references)
	    references (wl-delete-duplicates references)
	    references (when references
			 (mapconcat 'identity references "\n\t")))
      (setq content-type (std11-field-body "Content-Type"))
      (setq content-transfer-encoding (std11-field-body "Content-Transfer-Encoding"))
      (goto-char (point-min))
      (or (re-search-forward "\n\n" nil t)
	  (search-forward (concat mail-header-separator "\n") nil t))
      (setq body (buffer-substring (point) (point-max))))
    ;; draft buffer の準備
    (wl-draft (list (cons 'To "")
		    (cons 'Subject forward-subject)
		    (cons 'References references))
	      content-type content-transfer-encoding body t folder number)
    ;; いらないタグの削除
    (wl-draft-body-goto-top)
    (save-excursion
      (let* ((ret (mime-edit-find-inmost)))
	(let ((bb (nth 1 ret))
	      (be (nth 2 ret))
	      (eb (nth 3 ret)))
	  (when eb
	    (goto-char eb)
	    (when (looking-at mime-edit-end-tag-regexp)
	      (delete-region (match-beginning 0) (match-end 0))))
	  (when (and bb be)
	    (delete-region bb be)))))
    (when (looking-at mime-edit-single-part-tag-regexp)
      (delete-region (match-beginning 0) (match-end 0)))
    ;; citation header の挿入
    (insert "\n---------- Forwarded Message ----------\n")
    (insert "From: " from "\n")
    (insert "Subject: " subject "\n")
    (insert "Date: " date "\n")
    (insert "To: " to "\n")
    ;; 最後の準備
    (mail-position-on-field "To")
    (setq wl-draft-config-variables
	  (append wl-draft-parent-variables
		  wl-draft-config-variables))
    (wl-draft-config-info-operation wl-draft-buffer-message-number 'save)
    (run-hooks 'wl-draft-forward-hook)
    (with-current-buffer summary-buf (run-hooks 'wl-summary-forward-hook))
    (run-hooks 'wl-mail-setup-hook)))

(defun wl-summary-forward-select ()
  "フォワード方法を選択"
  (interactive)
  (let ((c (read-char "Select Forward Method: R)fc822 W)indows like")))
    (cond ((eq c ?r) (wl-summary-forward))
	  ((eq c ?w) (wl-summary-forward-like-windows))
	  (t (message "Cancel")))))

• [2007-03-19]フックを実行するようにしてみる。フォワードマークが付くようになった。
• [2007-03-12]Forwarded Message の Subject に "Forward" が付いてたのを修正。
• [2007-03-12]"f" を押したときにフォワード方法を選択できるように。