Content-Location for w3m display (was: Using nnrss very actively)

[Kevin Ryde <user42@zip.com.au>]

[-- Attachment #1: Type: text/plain, Size: 905 bytes --]

Speaking of Content-Location, I see w3m-region in
mm-inline-text-html-render-with-w3m can be passed a url location so
relative links and images go to the right place.  I wonder if something
like below could pass that through from RFC2557 mhtml parts.

The decode bit is fairly nasty, because I believe in a multipart it's
necessary to propagate the Content-Location down into subparts (if they
don't have their own Content-Location).  Or at least that's my reading
of the rfc and the sample messages at
http://people.dsv.su.se/~jpalme/ietf/mhtml-test/mhtml.html

On those samples you can see the relative links for the images come out
right with w3m-region passed the Content-Location urls.  (Looking just
with describe-char if you've got image display disabled, as I do, and
without worrying, yet, whether w3m can pick out the image contents from
the multipart/related parts instead of downloading ...)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mm-view.el.content-location.diff --]
[-- Type: text/x-diff, Size: 514 bytes --]

--- mm-view.el	04 Nov 2008 10:26:46 +1100	7.59
+++ mm-view.el	04 Nov 2008 10:26:55 +1100	
@@ -257,7 +257,8 @@
 	    (insert (mm-decode-string text charset))))
 	(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
 	      w3m-force-redisplay)
-	  (w3m-region (point-min) (point-max) nil charset))
+	  (w3m-region (point-min) (point-max)
+                      (mm-handle-content-location handle) charset))
 	(when (and mm-inline-text-html-with-w3m-keymap
 		   (boundp 'w3m-minor-mode-map)
 		   w3m-minor-mode-map)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: mm-decode.el.content-location.diff --]
[-- Type: text/x-diff, Size: 4098 bytes --]

--- mm-decode.el	04 Nov 2008 10:27:16 +1100	7.68
+++ mm-decode.el	04 Nov 2008 10:27:23 +1100	
@@ -89,6 +89,8 @@
   `(setcar (nthcdr 6 ,handle) ,contents))
 (defmacro mm-handle-id (handle)
   `(nth 7 ,handle))
+(defmacro mm-handle-content-location (handle)
+  `(nth 8 ,handle))
 (defmacro mm-handle-multipart-original-buffer (handle)
   `(get-text-property 0 'buffer (car ,handle)))
 (defmacro mm-handle-multipart-from (handle)
@@ -98,9 +100,9 @@
 
 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
 				    disposition description cache
-				    id)
+				    id content-location)
   `(list ,buffer ,type ,encoding ,undisplayer
-	 ,disposition ,description ,cache ,id))
+	 ,disposition ,description ,cache ,id ,content-location))
 
 (defcustom mm-text-html-renderer
   (cond ((executable-find "w3m")
@@ -550,7 +552,7 @@
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
-(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
+(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from content-location)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
     (let (ct ctl type subtype cte cd description id result)
@@ -564,7 +566,9 @@
 		cte (mail-fetch-field "content-transfer-encoding")
 		cd (mail-fetch-field "content-disposition")
 		description (mail-fetch-field "content-description")
-		id (mail-fetch-field "content-id"))
+		id (mail-fetch-field "content-id")
+		content-location (or (mail-fetch-field "content-location")
+                                     content-location))
 	  (unless from
 	    (setq from (mail-fetch-field "from")))
 	  ;; FIXME: In some circumstances, this code is running within
@@ -583,7 +587,7 @@
 	   (and cte (intern (downcase (mail-header-strip cte))))
 	   no-strict-mime
 	   (and cd (mail-header-parse-content-disposition cd))
-	   description)
+	   description content-location)
 	(setq type (split-string (car ctl) "/"))
 	(setq subtype (cadr type)
 	      type (car type))
@@ -608,7 +612,7 @@
 					'from from
 					'start start)
 				  (car ctl))
-	     (cons (car ctl) (mm-dissect-multipart ctl from))))
+	     (cons (car ctl) (mm-dissect-multipart ctl from content-location))))
 	  (t
 	   (mm-possibly-verify-or-decrypt
 	    (mm-dissect-singlepart
@@ -616,7 +620,7 @@
 	     (and cte (intern (downcase (mail-header-strip cte))))
 	     no-strict-mime
 	     (and cd (mail-header-parse-content-disposition cd))
-	     description id)
+	     description id content-location)
 	    ctl))))
 	(when id
 	  (when (string-match " *<\\(.*\\)> *" id)
@@ -624,15 +628,15 @@
 	  (push (cons id result) mm-content-id-alist))
 	result))))
 
-(defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
+(defun mm-dissect-singlepart (ctl cte &optional force cdl description id content-location)
   (when (or force
 	    (if (equal "text/plain" (car ctl))
 		(assoc 'format ctl)
 	      t))
     (mm-make-handle
-     (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+     (mm-copy-to-buffer) ctl cte nil cdl description nil id content-location)))
 
-(defun mm-dissect-multipart (ctl from)
+(defun mm-dissect-multipart (ctl from content-location)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
 	 (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
@@ -649,7 +653,7 @@
 	(save-excursion
 	  (save-restriction
 	    (narrow-to-region start (point))
-	    (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
+	    (setq parts (nconc (list (mm-dissect-buffer t nil from content-location)) parts)))))
       (end-of-line 2)
       (or (looking-at boundary)
 	  (forward-line 1))
@@ -658,7 +662,7 @@
       (save-excursion
 	(save-restriction
 	  (narrow-to-region start end)
-	  (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
+	  (setq parts (nconc (list (mm-dissect-buffer t nil from content-location)) parts)))))
     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 
 (defun mm-copy-to-buffer ()