X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=bc784f7eabb2fdd8878fd1afbc84aa7659fa4dd8;hb=e5bec5d05f433a43fa2d14cdb7bebeeefab8835f;hp=9c72266a2b3d42704a1025bb39377fc3b83df4ea;hpb=ae2b783ff77305c9e0bef64297d9eb337e4f29e7;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 9c72266..bc784f7 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -842,6 +842,13 @@ See the manual for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 
+(defcustom gnus-treat-leading-whitespace nil
+  "Remove leading whitespace in headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
 (defcustom gnus-treat-hide-headers 'head
   "Hide headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1163,6 +1170,7 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-hide-citation gnus-article-hide-citation)
     (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
+    (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
     (gnus-treat-strip-pgp gnus-article-hide-pgp)
     (gnus-treat-strip-pem gnus-article-hide-pem)
     (gnus-treat-highlight-headers gnus-article-highlight-headers)
@@ -1295,8 +1303,7 @@ Initialized from `text-mode-syntax-table.")
   (unless gnus-inhibit-hiding
     (save-excursion
       (save-restriction
-	(let ((buffer-read-only nil)
-	      (inhibit-read-only t)
+	(let ((inhibit-read-only t)
 	      (case-fold-search t)
 	      (max (1+ (length gnus-sorted-header-list)))
 	      (ignored (when (not gnus-visible-headers)
@@ -1396,9 +1403,9 @@ always hide."
 	     ((eq elem 'to-address)
 	      (let ((to (message-fetch-field "to"))
 		    (to-address
-		     (gnus-group-find-parameter
+		     (gnus-parameter-to-address
 		      (if (boundp 'gnus-newsgroup-name)
-			  gnus-newsgroup-name "") 'to-address)))
+			  gnus-newsgroup-name ""))))
 		(when (and to to-address
 			   (ignore-errors
 			     (gnus-string-equal
@@ -1486,8 +1493,7 @@ if given a positive prefix, always hide."
 	(header-end (point-min))
 	header-start field-end field-start
 	(inhibit-point-motion-hooks t)
-	(inhibit-read-only t)
-	buffer-read-only)
+	(inhibit-read-only t))
     (save-restriction
       (widen)
       (while (and (setq header-start
@@ -2408,118 +2414,116 @@ should replace the \"Date:\" one, or should be added below it."
 
 (defun article-make-date-line (date type)
   "Return a DATE line of TYPE."
-  (let ((time (condition-case ()
-		  (date-to-time date)
-		(error '(0 0)))))
-    (cond
-     ;; Convert to the local timezone.  We have to slap a
-     ;; `condition-case' round the calls to the timezone
-     ;; functions since they aren't particularly resistant to
-     ;; buggy dates.
-     ((eq type 'local)
-      (let ((tz (car (current-time-zone time))))
-	(format "Date: %s %s%02d%02d" (current-time-string time)
-		(if (> tz 0) "+" "-") (/ (abs tz) 3600)
-		(/ (% (abs tz) 3600) 60))))
-     ;; Convert to Universal Time.
-     ((eq type 'ut)
-      (concat "Date: "
-	      (current-time-string
-	       (let* ((e (parse-time-string date))
-		      (tm (apply 'encode-time e))
-		      (ms (car tm))
-		      (ls (- (cadr tm) (car (current-time-zone time)))))
-		 (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-		       ((> ls 65535) (list (1+ ms) (- ls 65536)))
-		       (t (list ms ls)))))
-	      " UT"))
-     ;; Get the original date from the article.
-     ((eq type 'original)
-      (concat "Date: " (if (string-match "\n+$" date)
-			   (substring date 0 (match-beginning 0))
-			 date)))
-     ;; Let the user define the format.
-     ((eq type 'user)
-      (if (gnus-functionp gnus-article-time-format)
-	  (funcall gnus-article-time-format time)
-	(concat
-	 "Date: "
-	 (format-time-string gnus-article-time-format time))))
-     ;; ISO 8601.
-     ((eq type 'iso8601)
-      (let ((tz (car (current-time-zone time))))
-	(concat
-	 "Date: "
-	 (format-time-string "%Y%m%dT%H%M%S" time)
-	 (format "%s%02d%02d"
-		 (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-		 (/ (% (abs tz) 3600) 60)))))
-     ;; Do an X-Sent lapsed format.
-     ((eq type 'lapsed)
-      ;; If the date is seriously mangled, the timezone functions are
-      ;; liable to bug out, so we ignore all errors.
-      (let* ((now (current-time))
-	     (real-time (subtract-time now time))
-	     (real-sec (and real-time
-			    (+ (* (float (car real-time)) 65536)
-			       (cadr real-time))))
-	     (sec (and real-time (abs real-sec)))
-	     num prev)
+  (unless (memq type '(local ut original user iso8601 lapsed english))
+    (error "Unknown conversion type: %s" type))
+  (condition-case ()
+      (let ((time (date-to-time date)))
 	(cond
-	 ((null real-time)
-	  "X-Sent: Unknown")
-	 ((zerop sec)
-	  "X-Sent: Now")
-	 (t
-	  (concat
-	   "X-Sent: "
-	   ;; This is a bit convoluted, but basically we go
-	   ;; through the time units for years, weeks, etc,
-	   ;; and divide things to see whether that results
-	   ;; in positive answers.
-	   (mapconcat
-	    (lambda (unit)
-	      (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
-		  ;; The (remaining) seconds are too few to
-		  ;; be divided into this time unit.
-		  ""
-		;; It's big enough, so we output it.
-		(setq sec (- sec (* num (cdr unit))))
-		(prog1
-		    (concat (if prev ", " "") (int-to-string
-					       (floor num))
-			    " " (symbol-name (car unit))
-			    (if (> num 1) "s" ""))
-		  (setq prev t))))
-	    article-time-units "")
-	   ;; If dates are odd, then it might appear like the
-	   ;; article was sent in the future.
-	   (if (> real-sec 0)
-	       " ago"
-	     " in the future"))))))
-     ;; Display the date in proper English
-     ((eq type 'english)
-      (let ((dtime (decode-time time)))
-	(concat
-	 "Date: the "
-	 (number-to-string (nth 3 dtime))
-	 (let ((digit (% (nth 3 dtime) 10)))
-	   (cond
-	    ((memq (nth 3 dtime) '(11 12 13)) "th")
-	    ((= digit 1) "st")
-	    ((= digit 2) "nd")
-	    ((= digit 3) "rd")
-	    (t "th")))
-	 " of "
-	 (nth (1- (nth 4 dtime)) gnus-english-month-names)
-	 " "
-	 (number-to-string (nth 5 dtime))
-	 " at "
-	 (format "%02d" (nth 2 dtime))
-	 ":"
-	 (format "%02d" (nth 1 dtime)))))
-     (t
-      (error "Unknown conversion type: %s" type)))))
+	 ;; Convert to the local timezone.
+	 ((eq type 'local)
+	  (let ((tz (car (current-time-zone time))))
+	    (format "Date: %s %s%02d%02d" (current-time-string time)
+		    (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+		    (/ (% (abs tz) 3600) 60))))
+	 ;; Convert to Universal Time.
+	 ((eq type 'ut)
+	  (concat "Date: "
+		  (current-time-string
+		   (let* ((e (parse-time-string date))
+			  (tm (apply 'encode-time e))
+			  (ms (car tm))
+			  (ls (- (cadr tm) (car (current-time-zone time)))))
+		     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+			   ((> ls 65535) (list (1+ ms) (- ls 65536)))
+			   (t (list ms ls)))))
+		  " UT"))
+	 ;; Get the original date from the article.
+	 ((eq type 'original)
+	  (concat "Date: " (if (string-match "\n+$" date)
+			       (substring date 0 (match-beginning 0))
+			     date)))
+	 ;; Let the user define the format.
+	 ((eq type 'user)
+	  (if (gnus-functionp gnus-article-time-format)
+	      (funcall gnus-article-time-format time)
+	    (concat
+	     "Date: "
+	     (format-time-string gnus-article-time-format time))))
+	 ;; ISO 8601.
+	 ((eq type 'iso8601)
+	  (let ((tz (car (current-time-zone time))))
+	    (concat
+	     "Date: "
+	     (format-time-string "%Y%m%dT%H%M%S" time)
+	     (format "%s%02d%02d"
+		     (if (> tz 0) "+" "-") (/ (abs tz) 3600)
+		     (/ (% (abs tz) 3600) 60)))))
+	 ;; Do an X-Sent lapsed format.
+	 ((eq type 'lapsed)
+	  ;; If the date is seriously mangled, the timezone functions are
+	  ;; liable to bug out, so we ignore all errors.
+	  (let* ((now (current-time))
+		 (real-time (subtract-time now time))
+		 (real-sec (and real-time
+				(+ (* (float (car real-time)) 65536)
+				   (cadr real-time))))
+		 (sec (and real-time (abs real-sec)))
+		 num prev)
+	    (cond
+	     ((null real-time)
+	      "X-Sent: Unknown")
+	     ((zerop sec)
+	      "X-Sent: Now")
+	     (t
+	      (concat
+	       "X-Sent: "
+	       ;; This is a bit convoluted, but basically we go
+	       ;; through the time units for years, weeks, etc,
+	       ;; and divide things to see whether that results
+	       ;; in positive answers.
+	       (mapconcat
+		(lambda (unit)
+		  (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+		      ;; The (remaining) seconds are too few to
+		      ;; be divided into this time unit.
+		      ""
+		    ;; It's big enough, so we output it.
+		    (setq sec (- sec (* num (cdr unit))))
+		    (prog1
+			(concat (if prev ", " "") (int-to-string
+						   (floor num))
+				" " (symbol-name (car unit))
+				(if (> num 1) "s" ""))
+		      (setq prev t))))
+		article-time-units "")
+	       ;; If dates are odd, then it might appear like the
+	       ;; article was sent in the future.
+	       (if (> real-sec 0)
+		   " ago"
+		 " in the future"))))))
+	 ;; Display the date in proper English
+	 ((eq type 'english)
+	  (let ((dtime (decode-time time)))
+	    (concat
+	     "Date: the "
+	     (number-to-string (nth 3 dtime))
+	     (let ((digit (% (nth 3 dtime) 10)))
+	       (cond
+		((memq (nth 3 dtime) '(11 12 13)) "th")
+		((= digit 1) "st")
+		((= digit 2) "nd")
+		((= digit 3) "rd")
+		(t "th")))
+	     " of "
+	     (nth (1- (nth 4 dtime)) gnus-english-month-names)
+	     " "
+	     (number-to-string (nth 5 dtime))
+	     " at "
+	     (format "%02d" (nth 2 dtime))
+	     ":"
+	     (format "%02d" (nth 1 dtime)))))))
+	(error
+	 (format "Date: %s (from Oort)" date))))
 
 (defun article-date-local (&optional highlight)
   "Convert the current article date to the local timezone."
@@ -2606,6 +2610,17 @@ This format is defined by the `gnus-article-time-format' variable."
       (let ((buffer-read-only nil))
 	(gnus-article-unhide-text (point-min) (point-max))))))
 
+(defun article-remove-leading-whitespace ()
+  "Remove excessive whitespace from all headers."
+  (interactive)
+  (save-excursion
+    (save-restriction
+      (let ((buffer-read-only nil))
+	(article-narrow-to-head)
+	(goto-char (point-min))
+	(while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t)
+	  (delete-region (match-beginning 1) (match-end 1)))))))
+
 (defun article-emphasize (&optional arg)
   "Emphasize text according to `gnus-emphasis-alist'."
   (interactive (gnus-article-hidden-arg))
@@ -2943,6 +2958,15 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 	 (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)))
        gnus-article-save-directory)))
 
+(defun gnus-sender-save-name (newsgroup headers &optional last-file)
+  "Generate file name from sender."
+  (let ((from (mail-header-from headers)))
+    (expand-file-name
+     (if (and from (string-match "\\([^ <]+\\)@" from))
+	 (match-string 1 from)
+       "nobody")
+     gnus-article-save-directory)))
+
 (defun article-verify-x-pgp-sig ()
   "Verify X-PGP-Sig."
   (interactive)
@@ -3043,6 +3067,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-fill-long-lines
      article-capitalize-sentences
      article-remove-cr
+     article-remove-leading-whitespace
      article-display-x-face
      article-de-quoted-unreadable
      article-de-base64-unreadable
@@ -3109,34 +3134,24 @@ If variable `gnus-use-long-file-name' is non-nil, it is
   "\M-g" gnus-article-read-summary-keys)
 
 ;; Define almost undefined keys to `gnus-article-read-summary-keys'.
-(mapcar
- (lambda (key)
-   (unless (lookup-key gnus-article-mode-map key)
-     (define-key gnus-article-mode-map key
-       'gnus-article-read-summary-keys)))
- (delq nil
-       (append
-	(mapcar
-	 (lambda (elt)
-	   (let ((key (car elt)))
-	     (and (> (length key) 0)
-		  (not (eq 'menu-bar (aref key 0)))
-		  (symbolp (lookup-key gnus-summary-mode-map key))
-		  key)))
-	 (accessible-keymaps gnus-summary-mode-map))
-	(let ((c 127)
-	      keys)
-	  (while (>= c 32)
-	    (push (char-to-string c) keys)
-	    (decf c))
-	  keys))))
-
-(eval-when-compile
-  (defvar gnus-article-commands-menu))
-
-(defvar gnus-article-post-menu nil)
+(let (keys)
+  (let ((key 32))
+    (while (<= key 127)
+      (push (char-to-string key) keys)
+      (incf key))
+    (dolist (elem (accessible-keymaps gnus-summary-mode-map))
+      (setq key (car elem))
+      (when (and (> (length key) 0)
+		 (not (eq 'menu-bar (aref key 0)))
+		 (symbolp (lookup-key gnus-summary-mode-map key)))
+	(push key keys))))
+  (dolist (key keys)
+    (unless (lookup-key gnus-article-mode-map key)
+      (define-key gnus-article-mode-map key 'gnus-article-read-summary-keys))))
 
 (defun gnus-article-make-menu-bar ()
+  (unless (boundp 'gnus-article-commands-menu)
+    (gnus-summary-make-menu-bar))
   (gnus-turn-off-edit-menu 'article)
   (unless (boundp 'gnus-article-article-menu)
     (easy-menu-define
@@ -3158,20 +3173,12 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["Hide citation" gnus-article-hide-citation t]
        ["Treat overstrike" gnus-article-treat-overstrike t]
        ["Remove carriage return" gnus-article-remove-cr t]
+       ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
        ["Decode HZ" gnus-article-decode-HZ t]))
 
     ;; Note "Commands" menu is defined in gnus-sum.el for consistency
-    
-    (when (boundp 'gnus-summary-post-menu)
-      (cond 
-       ((not (keymapp gnus-summary-post-menu))
-	(setq gnus-article-post-menu gnus-summary-post-menu))
-       ((not gnus-article-post-menu)
-	;; Don't share post menu.
-	(setq gnus-article-post-menu
-	      (copy-keymap gnus-summary-post-menu))))
-      (define-key gnus-article-mode-map [menu-bar post]
-	(cons "Post" gnus-article-post-menu)))
+
+    ;; Note "Post" menu is defined in gnus-sum.el for consistency
 
     (gnus-run-hooks 'gnus-article-menu-hook)))
 
@@ -3352,7 +3359,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 	   result)
       (save-excursion
 	(gnus-article-setup-buffer)
-	(set-buffer gnus-original-article-buffer)
+	(set-buffer gnus-article-buffer)
 	;; Deactivate active regions.
 	(when (and (boundp 'transient-mark-mode)
 		   transient-mark-mode)
@@ -3514,29 +3521,36 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 ;;;###autoload
 (defun gnus-article-prepare-display ()
   "Make the current buffer look like a nice article."
-  (setq gnus-article-wash-types nil)
-  (gnus-run-hooks 'gnus-tmp-internal-hook)
-  (gnus-run-hooks 'gnus-article-prepare-hook)
+  (let ((gnus-article-buffer (current-buffer))
+	buffer-read-only)
+    (unless (eq major-mode 'gnus-article-mode)
+      (gnus-article-mode))
+    (setq buffer-read-only nil
+	  gnus-button-marker-list nil
+	  gnus-article-wash-types nil)
+    (save-restriction
+      (widen)
+      (static-if (featurep 'xemacs)
+	  (map-extents (lambda (extent maparg) (delete-extent extent)))
+	(let ((lists (overlay-lists)))
+	  (dolist (overlay (nconc (car lists) (cdr lists)))
+	    (delete-overlay overlay)))))
+    (gnus-run-hooks 'gnus-tmp-internal-hook))
+  (set-buffer gnus-original-article-buffer)
   ;; Display message.
-  (let (mime-display-header-hook mime-display-text/plain-hook)
-    (funcall (if gnus-show-mime
-		 (progn
-		   (setq mime-message-structure gnus-current-headers)
-		   (mime-buffer-entity-set-buffer-internal
-		    mime-message-structure
-		    gnus-original-article-buffer)
-		   (mime-entity-set-representation-type-internal
-		    mime-message-structure 'mime-buffer-entity)
-		   (luna-send mime-message-structure
-			      'initialize-instance
-			      mime-message-structure)
-		   gnus-article-display-method-for-mime)
-	       gnus-article-display-method-for-traditional)))
-  ;; Associate this article with the current summary buffer.
-  (setq gnus-article-current-summary gnus-summary-buffer)
+  (setq mime-message-structure gnus-current-headers)
+  (mime-buffer-entity-set-buffer-internal mime-message-structure
+					  gnus-original-article-buffer)
+  (mime-entity-set-representation-type-internal mime-message-structure
+						'mime-buffer-entity)
+  (luna-send mime-message-structure 'initialize-instance
+	     mime-message-structure)
+  (if gnus-show-mime
+      (let (mime-display-header-hook mime-display-text/plain-hook)
+	(funcall gnus-article-display-method-for-mime))
+    (funcall gnus-article-display-method-for-traditional))
   ;; Call the treatment functions.
-  (let ((inhibit-read-only t)
-	buffer-read-only)
+  (let ((inhibit-read-only t))
     (save-restriction
       (widen)
       (if gnus-show-mime
@@ -3552,17 +3566,17 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 	(narrow-to-region (point) (point-max))
 	(gnus-treat-article nil))
       (put-text-property (point-min) (point-max) 'read-only nil)))
-  ;; Perform the article display hooks.  Incidentally, this hook is
-  ;; an obsolete variable by now.
-  (gnus-run-hooks 'gnus-article-display-hook))
+  (gnus-run-hooks 'gnus-article-prepare-hook))
 
 (defun gnus-article-decode-article-as-default-mime-charset ()
   "Decode an article as `default-mime-charset'.  It won't work if the
 value of the variable `gnus-show-mime' is non-nil."
   (unless gnus-show-mime
+    (set (make-local-variable 'default-mime-charset)
+	 (with-current-buffer gnus-summary-buffer
+	   default-mime-charset))
     (decode-mime-charset-region (point-min) (point-max)
-				(with-current-buffer gnus-summary-buffer
-				  default-mime-charset))))
+				default-mime-charset)))
 
 ;;;
 ;;; Gnus MIME viewing functions
@@ -3603,9 +3617,14 @@ value of the variable `gnus-show-mime' is non-nil."
 
 (defun gnus-article-mime-part-status ()
   (with-current-buffer gnus-article-buffer
-    (let ((entity (get-text-property (point-min) 'mime-view-entity)))
-      (if (and entity (mime-entity-children entity))
-	  (format " (%d parts)" (length (mime-entity-children entity)))
+    (let ((entity (get-text-property (point-min) 'mime-view-entity))
+	  children)
+      (if (and entity
+	       (setq children (mime-entity-children entity))
+	       (setq children (length children)))
+	  (if (eq 1 children)
+	      " (1 part)"
+	    (format " (%d parts)" children))
 	""))))
 
 (defvar gnus-mime-button-map
@@ -3658,8 +3677,10 @@ value of the variable `gnus-show-mime' is non-nil."
   (interactive)
   (gnus-article-check-buffer)
   (let* ((data (get-text-property (point) 'gnus-data))
-	 (file (and data (mm-save-part data)))
-	 param)
+	 file param)
+    (if (mm-multiple-handles gnus-article-mime-handles)
+	(error "This function is not implemented."))
+    (setq file (and data (mm-save-part data)))
     (when file
       (with-current-buffer (mm-handle-buffer data)
 	(erase-buffer)
@@ -3734,7 +3755,9 @@ value of the variable `gnus-show-mime' is non-nil."
   (gnus-article-check-buffer)
   (let ((data (get-text-property (point) 'gnus-data)))
     (when data
-      (push (setq data (copy-sequence data)) gnus-article-mime-handles)
+      (setq gnus-article-mime-handles
+	    (mm-merge-handles
+	     gnus-article-mime-handles (setq data (copy-sequence data))))
       (mm-interactively-view-part data))))
 
 (defun gnus-mime-view-part-as-type-internal ()
@@ -3766,7 +3789,8 @@ value of the variable `gnus-show-mime' is non-nil."
 			    (mm-handle-description handle)
 			    (mm-handle-cache handle)
 			    (mm-handle-id handle)))
-      (push handle gnus-article-mime-handles)
+      (setq gnus-article-mime-handles
+	    (mm-merge-handles gnus-article-mime-handles handle))
       (gnus-mm-display-part handle))))
 
 (defun gnus-mime-copy-part (&optional handle)
@@ -3829,7 +3853,8 @@ value of the variable `gnus-show-mime' is non-nil."
 	(goto-char b)))))
 
 (defun gnus-mime-view-part-as-charset (&optional handle arg)
-  "Insert the MIME part under point into the current buffer."
+  "Insert the MIME part under point into the current buffer using the
+specified charset."
   (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
@@ -3864,7 +3889,7 @@ value of the variable `gnus-show-mime' is non-nil."
 
 (defun gnus-mime-internalize-part (&optional handle)
   "View the MIME part under point with an internal viewer.
-In no internal viewer is available, use an external viewer."
+If no internal viewer is available, use an external viewer."
   (interactive)
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
@@ -4141,6 +4166,8 @@ In no internal viewer is available, use an external viewer."
 	      (gnus-treat-article 'head))))))))
 
 (defvar gnus-mime-display-multipart-as-mixed nil)
+(defvar gnus-mime-display-multipart-alternative-as-mixed nil)
+(defvar gnus-mime-display-multipart-related-as-mixed nil)
 
 (defun gnus-mime-display-part (handle)
   (cond
@@ -4153,13 +4180,15 @@ In no internal viewer is available, use an external viewer."
 	     handle))
    ;; multipart/alternative
    ((and (equal (car handle) "multipart/alternative")
-	 (not gnus-mime-display-multipart-as-mixed))
+	 (not (or gnus-mime-display-multipart-as-mixed
+		  gnus-mime-display-multipart-alternative-as-mixed)))
     (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
    ((and (equal (car handle) "multipart/related")
-	 (not gnus-mime-display-multipart-as-mixed))
+	 (not (or gnus-mime-display-multipart-as-mixed
+		  gnus-mime-display-multipart-related-as-mixed)))
     ;;;!!!We should find the start part, but we just default
     ;;;!!!to the first part.
     ;;(gnus-mime-display-part (cadr handle))
@@ -4658,10 +4687,16 @@ Argument LINES specifies lines to be scrolled down."
       (save-excursion
 	(set-buffer gnus-article-current-summary)
 	(let (gnus-pick-mode)
-	  (push (elt key 0) unread-command-events)
-	  (setq key (if (featurep 'xemacs)
-			(events-to-keys (read-key-sequence "Describe key: "))
-		      (read-key-sequence "Describe key: "))))
+	  (if (featurep 'xemacs)
+	      (progn
+		(push (elt key 0) unread-command-events)
+		(setq key (events-to-keys
+			   (read-key-sequence "Describe key: "))))
+	    (setq unread-command-events
+		  (mapcar
+		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+		   key))
+	    (setq key (read-key-sequence "Describe key: "))))
 	(describe-key key))
     (describe-key key)))
 
@@ -4673,10 +4708,16 @@ Argument LINES specifies lines to be scrolled down."
       (save-excursion
 	(set-buffer gnus-article-current-summary)
 	(let (gnus-pick-mode)
-	  (push (elt key 0) unread-command-events)
-	  (setq key (if (featurep 'xemacs)
-			(events-to-keys (read-key-sequence "Describe key: "))
-		      (read-key-sequence "Describe key: "))))
+	  (if (featurep 'xemacs)
+	      (progn
+		(push (elt key 0) unread-command-events)
+		(setq key (events-to-keys
+			   (read-key-sequence "Describe key: "))))
+	    (setq unread-command-events
+		  (mapcar
+		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+		   key))
+	    (setq key (read-key-sequence "Describe key: "))))
 	(describe-key-briefly key insert))
     (describe-key-briefly key insert)))
 
@@ -4936,12 +4977,13 @@ groups."
     (set-buffer gnus-article-buffer)
     (gnus-article-edit-mode)
     (funcall start-func)
+    (set-buffer-modified-p nil)
     (gnus-configure-windows 'edit-article)
     (setq gnus-article-edit-done-function exit-func)
     (setq gnus-prev-winconf winconf)
     (when gnus-article-edit-article-setup-function
       (funcall gnus-article-edit-article-setup-function))
-    (gnus-message 6 "C-c C-c to end edits")))
+    (gnus-message 6 "C-c C-c to end edits; C-c C-k to exit")))
 
 (defun gnus-article-edit-done (&optional arg)
   "Update the article edits and exit."
@@ -4951,7 +4993,20 @@ groups."
 	(start (window-start)))
     (remove-hook 'gnus-article-mode-hook
 		 'gnus-article-mime-edit-article-unwind)
-    (gnus-article-edit-exit)
+    ;; We remove all text props from the article buffer.
+    (let ((content
+	   (buffer-substring-no-properties (point-min) (point-max)))
+	  (p (point)))
+      (erase-buffer)
+      (insert content)
+      (let ((winconf gnus-prev-winconf))
+	(gnus-article-mode)
+	(set-window-configuration winconf)
+	;; Tippy-toe some to make sure that point remains where it was.
+	(save-current-buffer
+	  (set-buffer buf)
+	  (set-window-start (get-buffer-window (current-buffer)) start)
+	  (goto-char p))))
     (save-excursion
       (set-buffer buf)
       (let ((buffer-read-only nil))
@@ -4975,21 +5030,22 @@ groups."
 (defun gnus-article-edit-exit ()
   "Exit the article editing without updating."
   (interactive)
-  ;; We remove all text props from the article buffer.
-  (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
-	(curbuf (current-buffer))
-	(p (point))
-	(window-start (window-start)))
-    (erase-buffer)
-    (insert buf)
-    (let ((winconf gnus-prev-winconf))
-      (gnus-article-mode)
-      (set-window-configuration winconf)
-      ;; Tippy-toe some to make sure that point remains where it was.
-      (save-current-buffer
-	(set-buffer curbuf)
-	(set-window-start (get-buffer-window (current-buffer)) window-start)
-	(goto-char p)))))
+  (when (or (not (buffer-modified-p))
+	    (yes-or-no-p "Article modified; kill anyway? "))
+    (let ((curbuf (current-buffer))
+	  (p (point))
+	  (window-start (window-start)))
+      (erase-buffer)
+      (if (gnus-buffer-live-p gnus-original-article-buffer)
+	  (insert-buffer gnus-original-article-buffer))
+      (let ((winconf gnus-prev-winconf))
+	(gnus-article-mode)
+	(set-window-configuration winconf)
+	;; Tippy-toe some to make sure that point remains where it was.
+	(save-current-buffer
+	  (set-buffer curbuf)
+	  (set-window-start (get-buffer-window (current-buffer)) window-start)
+	  (goto-char p))))))
 
 (defun gnus-article-edit-full-stops ()
   "Interactively repair spacing at end of sentences."
@@ -5012,12 +5068,12 @@ groups."
 (defun gnus-article-mime-edit-article-unwind ()
   "Unwind `gnus-article-buffer' if article editing was given up."
   (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
-  (when mime-edit-mode-flag
-    (mime-edit-exit 'nomime 'no-error)
-    (message ""))
   (when (featurep 'font-lock)
     (setq font-lock-defaults nil)
-    (font-lock-mode 0)))
+    (font-lock-mode -1))
+  (when mime-edit-mode-flag
+    (mime-edit-exit 'nomime 'no-error)
+    (message "")))
 
 (defun gnus-article-mime-edit-article-setup ()
   "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode
@@ -5026,7 +5082,8 @@ after replacing with the original article."
   (setq gnus-article-edit-done-function
 	`(lambda (&rest args)
 	   (when mime-edit-mode-flag
-	     (mime-edit-exit)
+	     (let (mime-edit-insert-user-agent-field)
+	       (mime-edit-exit))
 	     (message ""))
 	   (goto-char (point-min))
 	   (let (case-fold-search)
@@ -5034,53 +5091,79 @@ after replacing with the original article."
 		    (format "^%s$" (regexp-quote mail-header-separator))
 		    nil t)
 	       (replace-match "")))
-	   (when (featurep 'font-lock)
-	     (setq font-lock-defaults nil)
-	     (font-lock-mode 0))
 	   (apply ,gnus-article-edit-done-function args)
-	   (set-buffer gnus-original-article-buffer)
-	   (erase-buffer)
-	   (insert-buffer gnus-article-buffer)
+	   (insert
+	    (prog1
+		(buffer-substring-no-properties (point-min) (point-max))
+	      (set-buffer (get-buffer-create gnus-original-article-buffer))
+	      (erase-buffer)))
 	   (setq gnus-current-headers (gnus-article-make-full-mail-header))
+	   (set-buffer gnus-article-buffer)
 	   (gnus-article-prepare-display)))
-  (substitute-key-definition
-   'gnus-article-edit-exit 'gnus-article-mime-edit-exit
-   gnus-article-edit-mode-map)
+  (substitute-key-definition 'gnus-article-edit-done
+			     'gnus-article-mime-edit-done
+			     gnus-article-edit-mode-map)
+  (substitute-key-definition 'gnus-article-edit-exit
+			     'gnus-article-mime-edit-exit
+			     gnus-article-edit-mode-map)
   (erase-buffer)
   (insert-buffer gnus-original-article-buffer)
-  (mime-edit-again)
+  (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+    (fset 'mime-edit-decode-single-part-in-buffer
+	  (lambda (&rest args)
+	    (if (let ((content-type (car args)))
+		  (and (eq 'message (mime-content-type-primary-type
+				     content-type))
+		       (eq 'rfc822 (mime-content-type-subtype content-type))))
+		(setcar (cdr args) 'not-decode-text))
+	    (apply ofn args)))
+    (unwind-protect
+	(mime-edit-again)
+      (fset 'mime-edit-decode-single-part-in-buffer ofn)))
   (when (featurep 'font-lock)
     (set (make-local-variable 'font-lock-defaults)
 	 '(message-font-lock-keywords t))
     (font-lock-set-defaults)
     (turn-on-font-lock))
+  (set-buffer-modified-p nil)
+  (delete-other-windows)
   (add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
   (gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook))
 
+(defun gnus-article-mime-edit-done (&optional arg)
+  "Update the article MIME edits and exit."
+  (interactive "P")
+  (when (featurep 'font-lock)
+    (setq font-lock-defaults nil)
+    (font-lock-mode -1))
+  (gnus-article-edit-done arg))
+
 (defun gnus-article-mime-edit-exit ()
   "Exit the article MIME editing without updating."
   (interactive)
-  (let ((winconf gnus-prev-winconf)
-	buf)
+  (when (or (not (buffer-modified-p))
+	    (yes-or-no-p "Article modified; kill anyway? "))
+    (when (featurep 'font-lock)
+      (setq font-lock-defaults nil)
+      (font-lock-mode -1))
     (when mime-edit-mode-flag
-      (mime-edit-exit)
+      (let (mime-edit-insert-user-agent-field)
+	(mime-edit-exit))
       (message ""))
     (goto-char (point-min))
     (let (case-fold-search)
       (when (re-search-forward
 	     (format "^%s$" (regexp-quote mail-header-separator)) nil t)
 	(replace-match "")))
-    (when (featurep 'font-lock)
-      (setq font-lock-defaults nil)
-      (font-lock-mode 0))
-    ;; We remove all text props from the article buffer.
-    (setq buf (buffer-substring-no-properties (point-min) (point-max)))
-    (set-buffer (get-buffer-create gnus-original-article-buffer))
-    (erase-buffer)
-    (insert buf)
-    (setq gnus-current-headers (gnus-article-make-full-mail-header))
-    (gnus-article-prepare-display)
-    (set-window-configuration winconf)))
+    (let ((winconf gnus-prev-winconf))
+      (insert (prog1
+		  (buffer-substring-no-properties (point-min) (point-max))
+		(set-buffer (get-buffer-create gnus-original-article-buffer))
+		(erase-buffer)))
+      (setq gnus-current-headers (gnus-article-make-full-mail-header))
+      (set-buffer gnus-article-buffer)
+      (gnus-article-prepare-display)
+      (set-window-configuration winconf))))
 
 ;;;
 ;;; Article highlights
@@ -5096,9 +5179,10 @@ after replacing with the original article."
   :type 'regexp)
 
 (defcustom gnus-button-alist
-  `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
-     0 t gnus-button-message-id 2)
-    ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1)
+  `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+     0 t gnus-button-handle-news 3)
+    ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
+     gnus-button-handle-news 2)
     ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
      1 t
      gnus-button-fetch-group 4)
@@ -5484,6 +5568,45 @@ specified by `gnus-button-alist'."
 	(gnus-message 1 "You must define `%S' to use this button"
 		      (cons fun args)))))))
 
+(defun gnus-parse-news-url (url)
+  (let (scheme server group message-id articles)
+    (with-temp-buffer
+      (insert url)
+      (goto-char (point-min))
+      (when (looking-at "\\([A-Za-z]+\\):")
+	(setq scheme (match-string 1))
+	(goto-char (match-end 0)))
+      (when (looking-at "//\\([^/]+\\)/")
+	(setq server (match-string 1))
+	(goto-char (match-end 0)))
+	
+      (cond
+       ((looking-at "\\(.*@.*\\)")
+	(setq message-id (match-string 1)))
+       ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)")
+	(setq group (match-string 1)
+	      articles (split-string (match-string 2) "-")))
+       ((looking-at "\\([^/]+\\)/?")
+	(setq group (match-string 1)))
+       (t
+	(error "Unknown news URL syntax"))))
+    (list scheme server group message-id articles)))
+
+(defun gnus-button-handle-news (url)
+  "Fetch a news URL."
+  (destructuring-bind (scheme server group message-id articles)
+      (gnus-parse-news-url url)
+    (cond
+     (message-id
+      (save-excursion
+	(set-buffer gnus-summary-buffer)
+	(if server
+	    (let ((gnus-refer-article-method (list (list 'nntp server))))
+	      (gnus-summary-refer-article message-id))
+	  (gnus-summary-refer-article message-id))))
+     (group
+      (gnus-button-fetch-group url)))))
+
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
   (save-excursion