[mew-dist 19855] Re: Forward で references をつける方法

[Hideyuki SHIRAI ( 白井秀行 )]

From: KOIE Hidetaka (鯉江英隆) <hide at example.com> さん曰く
Subject: [mew-dist 19853] Re: Forward で references をつける方法
Message-ID: <01Dec17.201812jst.29576 at example.com>
Date: Mon, 17 Dec 2001 19:40:18 +0900

鯉江> スレッド表示したいだけなら
鯉江>     `r' (mew-summary-resend) 
鯉江> でいいと思うです。

鯉江> resendの欠点は
鯉江>   * forwardとちがって一口コメントを添付できないこと
鯉江>   * 転送メイルをうけとった人がかなりの確立でびっくりすること

う〜ん、ちょっと違うような気がしますけど :-)

鯉江> ちょっと興味があるのですがWLでは
鯉江>     外側のメイルのreferences: <= 内側のメイルのreferences:
鯉江> になるでしょうか、それとも
鯉江>     外側のメイルのreferences: <= 内側のメイルのreferences:
鯉江>                                + 内側のメイルのmessage-id:
鯉江> でしょうか。

後者になるようです。ぼくもその方が便利だと思います。

白井> # そういえば、以前、藤井さんと同じことを思ったことがありました。

と思ったとき(*1)があったので、なしくずし的に(無理やり)、wl の動
作を真似してみました。RFC 的にどうなのかは全然調べていません。^^;;;

summary で "f", "F", attach で "y" したときは自動で References:
と In-Reply-To: をつけて、attach で "r" すると、それでもつけます。
やっぱり、やりスギだと思うので、前半は必要なものを適当にコメント
アウトして使った方が良いでしょう。

(*1) 他の人を話しに巻き込むときに、forward すると、話はつながる
 のだけどスレッドがきれてしまって悲しかったことがある。

-- 
白井秀行 (mailto:shirai at example.com)

;; nil だと動かなくなる
(defvar mew-add-refences-from-attach t)

(add-hook 'mew-draft-mode-hook
	  (lambda ()
	    (define-key mew-draft-attach-map "r" 'mew-add-refences-from-attach)))

(defadvice mew-summary-forward (after add-references activate)
  (save-excursion
    (goto-char (mew-attach-begin))
    (when (and (re-search-forward "Message/Rfc822" nil t)
	       (mew-syntax-nums))
      (mew-add-refences-from-attach 'nocheck))))

(defadvice mew-summary-multi-forward (after add-references activate)
  (save-excursion
    (goto-char (mew-attach-begin))
    (while (and (re-search-forward "Message/Rfc822" nil t)
		(mew-syntax-nums))
      (mew-add-refences-from-attach 'nocheck)
      (forward-line))))

(defadvice mew-attach-link-message (after add-references activate)
  (mew-add-refences-from-attach 'nocheck))

(defun mew-add-refences-from-attach (&optional nocheck)
  "(無理やり)attach 上の Message/Rfc822 の references/messge-id を header につける。"
  (interactive)
  (when mew-add-refences-from-attach
    (if (not (mew-attach-not-line012-1-dot))
	(message "Cannot open message here")
      (let* ((nums (mew-syntax-nums))
	     (attachdir (mew-attachdir))
	     (syntax (mew-syntax-get-entry mew-encode-syntax nums))
	     (ct (mew-syntax-get-ct syntax))
	     (file (mew-syntax-get-file syntax))
	     (regex "<[^>]+>")
	     efile orefs oinrepl msgid nrefs ninrepl tmp)
	(if (and (not (eq ct '("Message/Rfc822")))
		 (not nocheck))
	    (message "Cannot open message here")
	  (save-excursion
	    (setq orefs (mew-header-get-value mew-references:))
	    (setq oinrepl (mew-header-get-value mew-in-reply-to:))
	    (when orefs
	      (setq tmp orefs orefs nil)
	      (while (string-match regex tmp)
		(setq orefs (cons (mew-match 0 tmp) orefs))
		(setq tmp (substring tmp (match-end 0)))))
	    (when oinrepl
	      (setq tmp oinrepl oinrepl nil)
	      (while (string-match regex tmp)
		(setq oinrepl (cons (mew-match 0 tmp) oinrepl))
		(setq tmp (substring tmp (match-end 0))))))
	  ;; Message/Rfc822 には subdir が(いまのところ)ない
	  (if (not (and file
			(file-readable-p (setq file (expand-file-name file attachdir)))))
	      (message "Cannot open message here")
	    (with-temp-buffer
	      (insert-file-contents file)
	      (setq nrefs (mew-header-get-value mew-references:))
	      (setq msgid (mew-header-get-value mew-message-id:))
	      (when nrefs
		(setq tmp nrefs nrefs nil)
		(while (string-match regex tmp)
		  (setq nrefs (cons (mew-match 0 tmp) nrefs))
		  (setq tmp (substring tmp (match-end 0)))))
	      (when msgid
		(when (string-match regex msgid)
		  (setq nrefs (cons (mew-match 0 msgid) nrefs))
		  (setq ninrepl (list (mew-match 0 msgid))))))
	    (when (or nrefs ninrepl)
	      (setq nrefs (delq nil (append nrefs orefs)))
	      (setq nrefs (mew-uniq-list nrefs))
	      (when (and (integerp mew-references-max-count)
			 (> (length nrefs) mew-references-max-count))
		(setcdr (nthcdr (1- mew-references-max-count) nrefs) nil))
	      (setq nrefs (mapconcat 'identity (nreverse nrefs) "\n\t"))
	      (setq ninrepl (delq nil (append ninrepl oinrepl)))
	      (setq ninrepl (mew-uniq-list ninrepl))
	      (setq ninrepl (mapconcat 'identity (nreverse ninrepl) "\n\t"))
	      (save-excursion
		(mew-header-delete-lines (list mew-references: mew-in-reply-to:))
		(mew-header-goto-end)
		(insert mew-in-reply-to: " " ninrepl "\n")
		(insert mew-references: " " nrefs "\n")
		(message "Replace headers")))))))))