X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=b912b57d9968090ce080c7f249cdd6d0bed111d8;hb=db857b4d28af9b2cacb93c1017afb70184375ca4;hp=65d38ced7770f0b400e618e4574c12bb50756c2b;hpb=1fabbb0eee2b36b4b416aaf7b8c34e46ee36439f;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 65d38ce..b912b57 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -636,6 +636,38 @@ Initialized from `text-mode-syntax-table.")
      (max (1- b) (point-min))
      b 'intangible (cddr (memq 'intangible props)))))
 
+(defmacro gnus-with-article (article &rest forms)
+  "Select ARTICLE, copy the contents of the original article buffer to a new buffer, and then perform FORMS there.
+Then replace the article with the result."
+  `(progn
+     ;; We don't want the article to be marked as read.
+     (let (gnus-mark-article-hook)
+       (gnus-summary-select-article t t nil ,article))
+     (set-buffer gnus-original-article-buffer)
+     (let ((buf (format "%s" (buffer-string))))
+       (with-temp-buffer
+	 (insert buf)
+	 ,@forms
+	 (unless (gnus-request-replace-article
+		  ,article (car gnus-article-current)
+		  (current-buffer) t)
+	   (error "Couldn't replace article"))
+	 ;; The cache and backlog have to be flushed somewhat.
+	 (when gnus-keep-backlog
+	   (gnus-backlog-remove-article
+	    (car gnus-article-current) (cdr gnus-article-current)))
+	 ;; Flush original article as well.
+	 (save-excursion
+	   (when (get-buffer gnus-original-article-buffer)
+	     (set-buffer gnus-original-article-buffer)
+	     (setq gnus-original-article nil)))
+	 (when gnus-use-cache
+	   (gnus-cache-update-article
+	    (car gnus-article-current) (cdr gnus-article-current)))))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
+
 (defsubst gnus-article-unhide-text (b e)
   "Remove hidden text properties from region between B and E."
   (remove-text-properties b e gnus-hidden-properties)
@@ -2227,10 +2259,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (gnus-run-hooks 'gnus-tmp-internal-hook)
     (gnus-run-hooks 'gnus-article-prepare-hook)
     (when gnus-display-mime-function
-      ;(let ((url-standalone-mode (not gnus-plugged)))
-	(funcall gnus-display-mime-function)
-	)
-    ;)
+      (let ((url-standalone-mode (not gnus-plugged)))
+	(funcall gnus-display-mime-function)))
     ;; Perform the article display hooks.
     (gnus-run-hooks 'gnus-article-display-hook)))
 
@@ -2260,8 +2290,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     ;(gnus-mime-view-part	"\M-\r"	"View Interactively...")
     (gnus-mime-view-part	"v"	"View Interactively...")
     (gnus-mime-save-part	"o"	"Save...")
-    (gnus-mime-copy-part	"c"	"View In Buffer")
-    (gnus-mime-inline-part	"i"	"View Inline")
+    (gnus-mime-copy-part	"c"	"View As Text, In Other Buffer")
+    (gnus-mime-inline-part	"i"	"View As Text, In This Buffer")
     (gnus-mime-externalize-part	"e"	"View Externally")
     (gnus-mime-pipe-part	"|"	"Pipe To Command...")))
 
@@ -2352,12 +2382,13 @@ If ALL-HEADERS is non-nil, no headers are hidden."
   (interactive "P") ; For compatibility reasons we are not using "z".
   (gnus-article-check-buffer)
   (let* ((data (get-text-property (point) 'gnus-data))
-	 (contents (mm-get-part data))
+	 contents
 	 ;(url-standalone-mode (not gnus-plugged))
 	 (b (point))
 	 buffer-read-only)
     (if (mm-handle-undisplayer data)
 	(mm-remove-part data)
+      (setq contents (mm-get-part data))
       (forward-line 2)
       (when charset 
 	(unless (symbolp charset)
@@ -2457,6 +2488,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 
 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
   (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
+	(filename (mail-content-type-get (mm-handle-disposition handle)
+					 'filename))
 	(gnus-tmp-type (car (mm-handle-type handle)))
 	(gnus-tmp-description (mm-handle-description handle))
 	(gnus-tmp-dots
@@ -2467,6 +2500,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 			   (set-buffer (mm-handle-buffer handle))
 			   (buffer-size)))
 	b e)
+    (setq gnus-tmp-name (or gnus-tmp-name filename))
     (setq gnus-tmp-name
 	  (if gnus-tmp-name
 	      (concat " (" gnus-tmp-name ")")
@@ -2497,34 +2531,48 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 
 (defun gnus-display-mime (&optional ihandles)
   "Insert MIME buttons in the buffer."
-  (save-selected-window
-    (let ((window (get-buffer-window gnus-article-buffer)))
-      (when window
-	(select-window window)))
-    (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
-	   handle name type b e display)
-      (unless ihandles
-	;; Top-level call; we clean up.
-	(mm-destroy-parts gnus-article-mime-handles)
-	(setq gnus-article-mime-handles handles
-	      gnus-article-mime-handle-alist nil)
-	;; We allow users to glean info from the handles.
-	(when gnus-article-mime-part-function
-	  (gnus-mime-part-function handles)))
-      (when (and handles
-		 (or (not (stringp (car handles)))
-		     (cdr handles)))
+  (save-excursion
+    (save-selected-window
+      (let ((window (get-buffer-window gnus-article-buffer)))
+	(when window
+	  (select-window window)))
+      (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
+	     handle name type b e display)
 	(unless ihandles
-	  ;; Clean up for mime parts.
-	  (article-goto-body)
-	  (delete-region (point) (point-max)))
-	(if (stringp (car handles))
-	    (if (equal (car handles) "multipart/alternative")
-		(let ((id (1+ (length gnus-article-mime-handle-alist))))
-		  (push (cons id handles) gnus-article-mime-handle-alist)
-		  (gnus-mime-display-alternative (cdr handles) nil nil id))
-	      (gnus-mime-display-mixed (cdr handles)))
-	  (gnus-mime-display-single handles))))))
+	  ;; Top-level call; we clean up.
+	  (mm-destroy-parts gnus-article-mime-handles)
+	  (setq gnus-article-mime-handles handles
+		gnus-article-mime-handle-alist nil)
+	  ;; We allow users to glean info from the handles.
+	  (when gnus-article-mime-part-function
+	    (gnus-mime-part-function handles)))
+	(when (and handles
+		   (or (not (stringp (car handles)))
+		       (cdr handles)))
+	  (unless ihandles
+	    ;; Clean up for mime parts.
+	    (article-goto-body)
+	    (delete-region (point) (point-max)))
+	  (gnus-mime-display-part handles))))))
+
+(defun gnus-mime-display-part (handle)
+  (cond
+   ;; Single part.
+   ((not (stringp (car handle)))
+    (gnus-mime-display-single handle))
+   ;; multipart/alternative
+   ((equal (car handle) "multipart/alternative")
+    (let ((id (1+ (length gnus-article-mime-handle-alist))))
+      (push (cons id handle) gnus-article-mime-handle-alist)
+      (gnus-mime-display-alternative (cdr handle) nil nil id)))
+   ;; multipart/related
+   ((equal (car handle) "multipart/related")
+    ;;;!!!We should find the start part, but we just default
+    ;;;!!!to the first part.
+    (gnus-mime-display-part (cadr handle)))
+   ;; Other multiparts are handled like multipart/mixed.
+   (t
+    (gnus-mime-display-mixed (cdr handle)))))
 
 (defun gnus-mime-part-function (handles)
   (if (stringp (car handles))
@@ -2532,20 +2580,13 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (funcall gnus-article-mime-part-function handles)))
 
 (defun gnus-mime-display-mixed (handles)
-  (let (handle)
-    (while (setq handle (pop handles))
-      (if (stringp (car handle))
-	  (if (equal (car handle) "multipart/alternative")
-	      (let ((id (1+ (length gnus-article-mime-handle-alist))))
-		(push (cons id handle) gnus-article-mime-handle-alist)
-		(gnus-mime-display-alternative (cdr handle) nil nil id))
-	    (gnus-mime-display-mixed (cdr handle)))
-	(gnus-mime-display-single handle)))))
+  (mapcar 'gnus-mime-display-part handles))
 
 (defun gnus-mime-display-single (handle)
   (let ((type (car (mm-handle-type handle)))
 	(ignored gnus-ignored-mime-types)
 	(not-attachment t)
+	(move nil)
 	display text)
     (catch 'ignored
       (progn
@@ -2569,19 +2610,22 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 	    (gnus-article-insert-newline)
 	    (gnus-insert-mime-button
 	     handle id (list (or display
-				 (and (not not-attachment) text))))
-	    (gnus-article-insert-newline)))	
-	(gnus-article-insert-newline)
+				 (and not-attachment text))))
+	    (gnus-article-insert-newline)
+	    (gnus-article-insert-newline)
+	    (setq move t)))
 	(cond
 	 (display
-	  (forward-line -2)
+	  (when move
+	    (forward-line -2))
 	  (let ((rfc2047-default-charset gnus-newsgroup-default-charset)
 		(mm-charset-iso-8859-1-forced 
 		 gnus-newsgroup-iso-8859-1-forced))
 	    (mm-display-part handle t))
 	  (goto-char (point-max)))
 	 ((and text not-attachment)
-	  (forward-line -2)
+	  (when move
+	    (forward-line -2))
 	  (gnus-article-insert-newline)
 	  (mm-insert-inline handle (mm-get-part handle))
 	  (goto-char (point-max))))))))
@@ -3803,7 +3847,7 @@ forbidden in URL encoding."
     (select-window win)))
 
 (defvar gnus-decode-header-methods
-  '(mail-decode-encoded-word-region)
+  '(gnus-decode-with-mail-decode-encoded-word-region)
   "List of methods used to decode headers
 
 This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
@@ -3819,6 +3863,10 @@ For example:
 
 (defvar gnus-decode-header-methods-cache nil)
 
+(defun gnus-decode-with-mail-decode-encoded-word-region (start end)
+  (let ((rfc2047-default-charset gnus-default-charset))
+    (mail-decode-encoded-word-region start end)))
+
 (defun gnus-multi-decode-header (start end)
   "Apply the functions from `gnus-encoded-word-methods' that match."
   (unless (and gnus-decode-header-methods-cache