mime-preview-follow-current-entity

[Katsumi Yamaoka]

>>>>> In [emacs-mime-ja : No.00007] 
>>>>>	Katsumi Yamaoka <yamaoka ＠ jpl.org> wrote:

tomo> そういう訳で、個人的には『entity に follow する』機能に加え
tomo> 『entity にreply する』機能を追加するのが良いと思います。

山岡> 実はそれも考えたのですが、どうもそういうのって gnus 独自の文化で
山岡> はないかと思いまして実施は思いとどまりました。

守岡さんからお返事が頂けなかったのでもう一度書きますが、MIME-View で
follow (ニュース記事の送信) と reply (メールの送信) を区別した方が良い
のでしょうか? 現在の Semi-gnus などにとっては都合が良いのですが、gnus
以外の MUA ではそうとは限らない気がします。その観点から、MIME-View は
デコード済みのヘッダとボディを含むバッファを用意し、それをどう扱うかは
MUA の任せてしまって良いのではないでしょうか?

それから、

>>>>> In [emacs-mime-ja : No.00007] 
>>>>>	Katsumi Yamaoka <yamaoka ＠ jpl.org> wrote:

山岡> そういうわけで、手修正を許して曲がりなりにも使えるものにするため
山岡> の最低限の対応が、

山岡> 津邑さんのパッチ:     tm-ja  5458
山岡> 山岡のパッチ: emacs-mime-ja 00004

山岡> であるわけです。

これらだけではまだ不完全でしたので、書き直したものを添付いたします。
text-property `mime-view-entity' の変化点を探す動作は従来と変わりませ
ん。Narrowing された MIME-View のバッファには対応していません。必要な
ら follow と reply を区別するための変更は可能です。
MUA がどんな場合でも問題無いかどうかは確認できませんが、大抵の場合に正
常動作するという点だけでも、現行の SEMI 1.13 に盛り込む価値があるもの
と信じます。
-------------- next part --------------
(defun mime-preview-follow-current-entity ()
  "Write follow message to current entity.
It calls following-method selected from variable
`mime-preview-following-method-alist'."
  (interactive)
  (let ((entity (get-text-property (point) 'mime-view-entity)))
    (if entity
	(let* ((mode (mime-preview-original-major-mode 'recursive))
	       (method (cdr (assq mode mime-preview-following-method-alist))))
	  (if (not (functionp method))
	      (message
	       (format
		"Sorry, following method for %s is not implemented yet."
		mode))
	    (let (header)
	      (let (child)
		(while (and entity
			    (eq 'message (mime-entity-media-type entity))
			    (eq 'rfc822 (mime-entity-media-subtype entity))
			    (setq child (car (mime-entity-children entity))))
		  (setq header t
			entity child)))
	      (or header
		  (let ((parent (mime-entity-parent entity)))
		    (setq header
			  (and
			   parent
			   (eq 'message (mime-entity-media-type parent))
			   (eq 'rfc822 (mime-entity-media-subtype parent))))))
	      (let* ((start (text-property-any (point-min) (point-max)
					       'mime-view-entity entity))
		     (end start)
		     (node-id (mime-entity-node-id entity)))
		(if node-id
		    (let ((len (length node-id))
			  next)
		      (while (and
			      (<= end (point-max))
			      (setq end (or (next-single-property-change
					     end 'mime-view-entity)
					    (point-max))
				    next (get-text-property end
							    'mime-view-entity))
			      (> (length (mime-entity-node-id next)) len))))
		  (setq header t
			end (point-max)))
		(let ((buffer (get-buffer-create
			       (format "%s-%s" (buffer-name)
				       (reverse node-id))))
		      (content (buffer-substring-no-properties start end)))
		  (with-current-buffer buffer
		    (erase-buffer)
		    (if header
			(insert content)
		      (mime-insert-header (or (mime-entity-parent entity)
					      entity))
		      (mime-decode-header-in-buffer)
		      (goto-char (point-max))
		      (insert "\n" content)))
		  (funcall method buffer)))))))))