Mercurial > emacs

changeset 111214:b01067bf2ec9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gnus-art.el: Improve MIME part functions. gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt. (gnus-mime-copy-part): Check coding system, not charset. (gnus-mime-view-part-externally): Never remove part. (gnus-mime-view-part-internally): Don't remove part here. (gnus-article-part-wrapper): Make sure MIME tag is visible. (gnus-article-goto-part): Go to displayed or preferred subpart if it is multipart/alternative. mm-decode.el (mm-display-part): Take optional arg `force'.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 28 Oct 2010 06:37:35 +0000
parents 2cd6d2fadf9c
children 99e2b63fd6dd
files lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/mm-decode.el
diffstat 3 files changed, 64 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Wed Oct 27 20:49:40 2010 -0700
+++ b/lisp/gnus/ChangeLog	Thu Oct 28 06:37:35 2010 +0000
@@ -1,3 +1,15 @@
+2010-10-28  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-jump-to-part): Error on no part; fix prompt.
+	(gnus-mime-copy-part): Check coding system, not charset.
+	(gnus-mime-view-part-externally): Never remove part.
+	(gnus-mime-view-part-internally): Don't remove part here.
+	(gnus-article-part-wrapper): Make sure MIME tag is visible.
+	(gnus-article-goto-part): Go to displayed or preferred subpart if it is
+	multipart/alternative.
+
+	* mm-decode.el (mm-display-part): Take optional arg `force'.
+
 2010-10-26  Julien Danjou  <julien@danjou.info>
 
 	* gnus-group.el (gnus-group-default-list-level): Add this function to
--- a/lisp/gnus/gnus-art.el	Wed Oct 27 20:49:40 2010 -0700
+++ b/lisp/gnus/gnus-art.el	Thu Oct 28 06:37:35 2010 +0000
@@ -4811,11 +4811,17 @@
 (defun gnus-article-jump-to-part (n)
   "Jump to MIME part N."
   (interactive "P")
-  (pop-to-buffer gnus-article-buffer)
-  ;; FIXME: why is it necessary?
-  (sit-for 0)
-  (let ((parts (length gnus-article-mime-handle-alist)))
-    (or n (setq n (read-number (format "Jump to part (2..%s): " parts))))
+  (let ((parts (with-current-buffer gnus-article-buffer
+		 (length gnus-article-mime-handle-alist))))
+    (when (zerop parts)
+      (error "No such part"))
+    (pop-to-buffer gnus-article-buffer)
+    ;; FIXME: why is it necessary?
+    (sit-for 0)
+    (or n
+	(setq n (if (= parts 1)
+		    1
+		  (read-number (format "Jump to part (1..%s): " parts)))))
     (unless (and (integerp n) (<= n parts) (>= n 1))
       (setq n
 	    (progn
@@ -5115,7 +5121,7 @@
       (if (or coding-system
 	      (and charset
 		   (setq coding-system (mm-charset-to-coding-system charset))
-		   (not (eq charset 'ascii))))
+		   (not (eq coding-system 'ascii))))
 	  (progn
 	    (mm-enable-multibyte)
 	    (insert (mm-decode-coding-string contents coding-system))
@@ -5290,9 +5296,7 @@
 	(gnus-mime-view-part-as-type
 	 nil (lambda (type) (stringp (mailcap-mime-info type))))
       (when handle
-	(if (mm-handle-undisplayer handle)
-	    (mm-remove-part handle)
-	  (mm-display-part handle))))))
+	(mm-display-part handle nil t)))))
 
 (defun gnus-mime-view-part-internally (&optional handle)
   "View the MIME part under point with an internal viewer.
@@ -5311,9 +5315,7 @@
         (gnus-mime-view-part-as-type
          nil (lambda (type) (mm-inlinable-p handle type)))
       (when handle
-	(if (mm-handle-undisplayer handle)
-	    (mm-remove-part handle)
-	  (gnus-bind-safe-url-regexp (mm-display-part handle)))))))
+	(gnus-bind-safe-url-regexp (mm-display-part handle))))))
 
 (defun gnus-mime-action-on-part (&optional action)
   "Do something with the MIME attachment at \(point\)."
@@ -5376,6 +5378,10 @@
 	  (when (gnus-article-goto-part n)
 	    ;; We point the cursor and the arrow at the MIME button
 	    ;; when the `function' prompt the user for something.
+	    (unless (and (pos-visible-in-window-p)
+			 (> (count-lines (point) (window-end))
+			    (/ (1- (window-height)) 3)))
+	      (recenter (/ (1- (window-height)) 3)))
 	    (let ((cursor-in-non-selected-windows t)
 		  (overlay-arrow-string "=>")
 		  (overlay-arrow-position (point-marker)))
@@ -5387,11 +5393,10 @@
 		    (funcall function))
 		   (interactive
 		    (call-interactively
-		     function
-		     (cdr (assq n gnus-article-mime-handle-alist))))
+		     function (get-text-property (point) 'gnus-data)))
 		   (t
 		    (funcall function
-			     (cdr (assq n gnus-article-mime-handle-alist)))))
+			     (get-text-property (point) 'gnus-data))))
 		(set-marker overlay-arrow-position nil)
 		(unless gnus-auto-select-part
 		  (gnus-select-frame-set-input-focus frame)
@@ -5556,7 +5561,35 @@
 
 (defun gnus-article-goto-part (n)
   "Go to MIME part N."
-  (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
+  (let ((start (text-property-any (point-min) (point-max) 'gnus-part n))
+	part handle end next handles)
+    (when start
+      (goto-char start)
+      (if (setq handle (get-text-property start 'gnus-data))
+	  start
+	;; Go to the displayed subpart, assuming this is multipart/alternative.
+	(setq part start
+	      end (point-at-eol))
+	(while (and (not handle)
+		    part
+		    (< part end)
+		    (setq next (text-property-not-all part end
+						      'gnus-data nil)))
+	  (setq part next
+		handle (get-text-property part 'gnus-data))
+	  (push (cons handle part) handles)
+	  (unless (mm-handle-displayed-p handle)
+	    (setq handle nil
+		  part (text-property-any part end 'gnus-data nil))))
+	(unless handle
+	  ;; No subpart is displayed, so we find preferred one.
+	  (setq part
+		(cdr (assq (mm-preferred-alternative
+			    (nreverse (mapcar 'car handles)))
+			   handles))))
+	(if part
+	    (goto-char (1+ part))
+	  start)))))
 
 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
   (let ((gnus-tmp-name
--- a/lisp/gnus/mm-decode.el	Wed Oct 27 20:49:40 2010 -0700
+++ b/lisp/gnus/mm-decode.el	Thu Oct 28 06:37:35 2010 +0000
@@ -696,13 +696,14 @@
 (autoload 'mailcap-parse-mailcaps "mailcap")
 (autoload 'mailcap-mime-info "mailcap")
 
-(defun mm-display-part (handle &optional no-default)
+(defun mm-display-part (handle &optional no-default force)
   "Display the MIME part represented by HANDLE.
 Returns nil if the part is removed; inline if displayed inline;
 external if displayed external."
   (save-excursion
     (mailcap-parse-mailcaps)
-    (if (mm-handle-displayed-p handle)
+    (if (and (not force)
+	     (mm-handle-displayed-p handle))
 	(mm-remove-part handle)
       (let* ((ehandle (if (equal (mm-handle-media-type handle)
 				 "message/external-body")