mime-w3m support multipart/related

[ari@xxxxxxxxxxxxxxxx (Akihiro Arisawa)]

multipart/related な画像を含むメッセージを、mime-w3m で
インライン表示できるようにしてみました。

ただし、`mime-find-root-entity' に bug があるようで以下のように
定義しなおさないとダメです。

(defun mime-find-root-entity (entity)
  "Return root entity of ENTITY."
  (let ((p (mime-entity-parent entity)))
    (if (null p)
	entity
      (mime-find-root-entity p))))

;; あとで emacs-mime-ja に報告しなきゃ。

2001-03-09  Akihiro Arisawa  <ari@mbf.sphere.ne.jp>

	* w3m.el (w3m-cid-retrieve-function-alist): New variable.
	(w3m-retrieve): Add support for URLs which has `cid:' prefix.

	* mime-w3m.el: Always require `w3m'.
	Require `cl' when compiling.
	Set `w3m-cid-retrieve-function-alist'.
	(mime-w3m-message-structure): New variable.
	(mime-w3m-preview-text/html): Set `mime-w3m-message-structure'.
	(mime-w3m-cid-retrieve): New function.

Index: w3m.el
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/w3m.el,v
retrieving revision 1.84
diff -u -r1.84 w3m.el
--- w3m.el	2001/03/08 11:57:59	1.84
+++ w3m.el	2001/03/08 17:12:07
@@ -1818,6 +1818,8 @@
 		    (w3m-decode-buffer type charset))
 	       type))))))))
 
+(defvar w3m-cid-retrieve-function-alist nil)
+
 (defun w3m-retrieve (url &optional no-decode accept-type-regexp no-cache)
   "Retrieve content of URL and insert it to the working buffer.
 This function will return content-type of URL as string when retrieval
@@ -1835,6 +1837,10 @@
 	(w3m-about url no-decode accept-type-regexp no-cache))))
    ((string-match "^\\(file:\\|/\\)" url)
     (w3m-local-retrieve url no-decode accept-type-regexp))
+   ((string-match "^cid:"; url)
+    (let ((func (cdr (assq major-mode w3m-cid-retrieve-function-alist))))
+      (when func
+	(funcall func url no-decode accept-type-regexp no-cache))))
    (t
     (w3m-w3m-retrieve url no-decode accept-type-regexp no-cache))))
 
Index: mime-w3m.el
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/mime-w3m.el,v
retrieving revision 1.5
diff -u -r1.5 mime-w3m.el
--- mime-w3m.el	2001/03/08 00:35:51	1.5
+++ mime-w3m.el	2001/03/08 17:12:08
@@ -45,10 +45,9 @@
 
 ;;; Code:
 
-(condition-case nil
-    (require 'w3m)
-  (error nil))
+(require 'w3m)
 (require 'mime)
+(eval-when-compile (require 'cl))
 
 (defvar mime-w3m-mode-map nil)
 
@@ -68,8 +67,10 @@
 	   ))
     (cons 'progn body)))
 
+(defvar mime-w3m-message-structure nil)
+
 (defun mime-w3m-preview-text/html (entity situation)
-  (goto-char (point-max))
+  (setq mime-w3m-message-structure (mime-find-root-entity entity))
   (let ((p (point))
 	(xref (mime-entity-fetch-field entity "xref")))
     ;; For nnshimbun.el.
@@ -89,6 +90,20 @@
 	 (error (message (format "%s" err))))
        (mime-put-keymap-region p (point-max) mime-w3m-mode-map)
        ))))
+
+(defun mime-w3m-cid-retrieve (url &optional no-decode accept-type-regexp
+				  no-cache)
+  (let ((entity (mime-find-entity-from-content-id (mime-uri-parse-cid url)
+						  mime-w3m-message-structure)))
+    (when entity
+      (w3m-with-work-buffer
+       (delete-region (point-min) (point-max))
+       (set-buffer-multibyte nil)
+       (mime-insert-entity-content entity))
+      (mime-entity-type/subtype entity))))
+
+(push (cons 'mime-view-mode 'mime-w3m-cid-retrieve)
+      w3m-cid-retrieve-function-alist)
 
 (unless mime-w3m-mode-map
   (let ((map (copy-keymap w3m-mode-map)))

以下にサンプルを添付します。
;; 画像が複数ないとあまり嬉しく無いですが。

-- 
有沢 明宏

--- Begin Message ---

• From: ari@xxxxxxxxxxxxxxxx
• Date: Thu, 08 Mar 2001 20:33:27 +0900

↓にインライン画像があるはず。

どう?
--- End Message ---