X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=51009cb6dac03f8acff1f6786d27ec3fab17e8a0;hb=931e64049c6d898e55d204449f536e170937a03c;hp=85d619c2eb65276e3ecf441e308b89af17c30134;hpb=f344bd14c4b7e73add97d561de63bb7d85ab6571;p=gnus

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 85d619c2e..51009cb6d 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -683,7 +683,7 @@ displayed by the first non-nil matching CONTENT face."
 
 (defcustom gnus-article-decode-hook
   '(article-decode-charset article-decode-encoded-words
-			   article-decode-group-name)
+			   article-decode-group-name article-decode-idna-rhs)
   "*Hook run to decode charsets in articles."
   :group 'gnus-article-headers
   :type 'hook)
@@ -818,6 +818,7 @@ used."
 (defcustom gnus-mime-action-alist
   '(("save to file" . gnus-mime-save-part)
     ("save and strip" . gnus-mime-save-part-and-strip)
+    ("delete part" . gnus-mime-delete-part)
     ("display as text" . gnus-mime-inline-part)
     ("view the part" . gnus-mime-view-part)
     ("pipe to command" . gnus-mime-pipe-part)
@@ -857,7 +858,7 @@ used."
 (defvar gnus-inhibit-treatment nil
   "Whether to inhibit treatment.")
 
-(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
+(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
   "Highlight the signature.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles'."
@@ -1319,6 +1320,12 @@ It is a string, such as \"PGP\". If nil, ask user."
 (defvar gnus-article-wash-function nil
   "Function used for converting HTML into text.")
 
+(defcustom gnus-use-idna (condition-case nil (require 'idna) (file-error))
+  "Whether IDNA decoding of headers is used when viewing messages.
+This requires GNU Libidn, and by default only enabled if it is found."
+  :group 'gnus-article-headers
+  :type 'boolean)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
@@ -1820,7 +1827,7 @@ unfolded."
       (while (not (eobp))
 	(save-restriction
 	  (mail-header-narrow-to-field)
-	  (let ((header (buffer-substring (point-min) (point-max))))
+	  (let ((header (buffer-string)))
 	    (with-temp-buffer
 	      (insert header)
 	      (goto-char (point-min))
@@ -2088,7 +2095,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
 	(mm-decode-body
 	 charset (and cte (intern (downcase
 				   (gnus-strip-whitespace cte))))
-	 (car ctl)))))))
+	 (car ctl) prompt))))))
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."
@@ -2127,6 +2134,27 @@ If PROMPT (the prefix), prompt for a coding system to use."
 				    (nnmail-fetch-field "Followup-To"))
 				  gnus-newsgroup-name method))))))
 
+(defun article-decode-idna-rhs ()
+  "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
+  (when gnus-use-idna
+    (save-restriction
+      (let ((inhibit-point-motion-hooks t)
+	    buffer-read-only)
+	(article-narrow-to-head)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t)
+	  (let (ace unicode)
+	    (when (save-match-data
+		    (and (setq ace (match-string 1))
+			 (save-excursion
+			   (and (re-search-backward "^[^ \t]" nil t)
+				(looking-at "From\\|To\\|Cc")))
+			 (save-excursion (backward-char)
+					 (message-idna-inside-rhs-p))
+			 (setq unicode (idna-to-unicode ace))))
+	      (unless (string= ace unicode)
+		(replace-match unicode nil nil nil 1)))))))))
+
 (defun article-de-quoted-unreadable (&optional force read-charset)
   "Translate a quoted-printable-encoded article.
 If FORCE, decode the article whether it is marked as quoted-printable
@@ -2269,7 +2297,6 @@ If READ-CHARSET, ask for a coding system."
     (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
 				   nil
 				 "\\`cid:"))
-	  (w3m-display-inline-images mm-inline-text-html-with-images)
 	  w3m-force-redisplay)
       (w3m-region (point-min) (point-max)))
     (when mm-inline-text-html-with-w3m-keymap
@@ -3734,6 +3761,7 @@ General format specifiers can also be used.  See Info node
     (gnus-mime-view-part-as-charset "C" "View As charset...")
     (gnus-mime-save-part "o" "Save...")
     (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
+    (gnus-mime-delete-part "d" "Delete part")
     (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
     (gnus-mime-view-part-internally "E" "View Internally")
@@ -3873,6 +3901,87 @@ General format specifiers can also be used.  See Info node
 	   ,(gnus-group-read-only-p)
 	   ,gnus-summary-buffer no-highlight))))))
 
+(defun gnus-mime-delete-part ()
+  "Delete the MIME part under point.
+Replace it with some information about the removed part."
+  (interactive)
+  (gnus-article-check-buffer)
+  (let* ((data (get-text-property (point) 'gnus-data))
+	 (handles gnus-article-mime-handles)
+	 (none "(none)")
+	 (description
+	  (or
+	   (mail-decode-encoded-word-string (or (mm-handle-description data)
+						none))))
+	 (filename
+	  (or (mail-content-type-get (mm-handle-disposition data) 'filename)
+	      none))
+	 (type (mm-handle-media-type data)))
+    (if (mm-multiple-handles gnus-article-mime-handles)
+	(error "This function is not implemented"))
+    (with-current-buffer (mm-handle-buffer data)
+      (let ((bsize (format "%s" (buffer-size))))
+	(erase-buffer)
+	(insert
+	 (concat
+	  "<#part type=text/plain nofile=yes disposition=attachment"
+	  " description=\"Deleted attachment (" bsize " Byte)\">"
+	  ",----\n"
+	  "| The following attachment has been deleted:\n"
+	  "|\n"
+	  "| Type:           " type "\n"
+	  "| Filename:       " filename "\n"
+	  "| Size (encoded): " bsize " Byte\n"
+	  "| Description:    " description "\n"
+	  "`----\n"
+	  "<#/part>"))
+	(setcdr data
+		(cdr (mm-make-handle nil `("text/plain"))))))
+    (set-buffer gnus-summary-buffer)
+    ;; FIXME: maybe some of the following code (borrowed from
+    ;; `gnus-mime-save-part-and-strip') isn't necessary?
+    (gnus-article-edit-article
+     `(lambda ()
+	(erase-buffer)
+	(let ((mail-parse-charset (or gnus-article-charset
+				      ',gnus-newsgroup-charset))
+	      (mail-parse-ignored-charsets
+	       (or gnus-article-ignored-charsets
+		   ',gnus-newsgroup-ignored-charsets))
+	      (mbl mml-buffer-list))
+	  (setq mml-buffer-list nil)
+	  (insert-buffer gnus-original-article-buffer)
+	  (mime-to-mml ',handles)
+	  (setq gnus-article-mime-handles nil)
+	  (let ((mbl1 mml-buffer-list))
+	    (setq mml-buffer-list mbl)
+	    (set (make-local-variable 'mml-buffer-list) mbl1))
+	  ;; LOCAL argument of add-hook differs between GNU Emacs
+	  ;; and XEmacs. make-local-hook makes sure they are local.
+	  (make-local-hook 'kill-buffer-hook)
+	  (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+     `(lambda (no-highlight)
+	(let ((mail-parse-charset (or gnus-article-charset
+				      ',gnus-newsgroup-charset))
+	      (message-options message-options)
+	      (message-options-set-recipient)
+	      (mail-parse-ignored-charsets
+	       (or gnus-article-ignored-charsets
+		   ',gnus-newsgroup-ignored-charsets)))
+	  (mml-to-mime)
+	  (mml-destroy-buffers)
+	  (remove-hook 'kill-buffer-hook
+		       'mml-destroy-buffers t)
+	  (kill-local-variable 'mml-buffer-list))
+	(gnus-summary-edit-article-done
+	 ,(or (mail-header-references gnus-current-headers) "")
+	 ,(gnus-group-read-only-p)
+	 ,gnus-summary-buffer no-highlight))))
+  ;; Not in `gnus-mime-save-part-and-strip':
+  (gnus-article-edit-done)
+  (gnus-summary-expand-window)
+  (gnus-summary-show-article))
+
 (defun gnus-mime-save-part ()
   "Save the MIME part under point."
   (interactive)
@@ -4282,7 +4391,10 @@ If no internal viewer is available, use an external viewer."
 	 gnus-part ,gnus-tmp-id
 	 article-type annotation
 	 gnus-data ,handle))
-    (setq e (point))
+    (setq e (if (bolp)
+		;; Exclude a newline.
+		(1- (point))
+	      (point)))
     (widget-convert-button
      'link b e
      :mime-handle handle
@@ -6296,7 +6408,10 @@ specified by `gnus-button-alist'."
 	 gnus-callback gnus-article-button-prev-page
 	 article-type annotation))
     (widget-convert-button
-     'link b (point)
+     'link b (if (bolp)
+		 ;; Exclude a newline.
+		 (1- (point))
+	       (point))
      :action 'gnus-button-prev-page
      :button-keymap gnus-prev-page-map)))
 
@@ -6343,7 +6458,10 @@ specified by `gnus-button-alist'."
 			  gnus-callback gnus-article-button-next-page
 			  article-type annotation))
     (widget-convert-button
-     'link b (point)
+     'link b (if (bolp)
+		 ;; Exclude a newline.
+		 (1- (point))
+	       (point))
      :action 'gnus-button-next-page
      :button-keymap gnus-next-page-map)))
 
@@ -6516,7 +6634,7 @@ For example:
 				   (search-forward field nil t))
 				 (prog2
 				     (message-narrow-to-field)
-				     (buffer-substring (point-min) (point-max))
+				     (buffer-string)
 				   (delete-region (point-min) (point-max))
 				   (widen))))
 			  '("Content-Type:" "Content-Transfer-Encoding:"
@@ -6685,7 +6803,10 @@ For example:
 	 gnus-mime-details ,gnus-mime-security-button-pressed
 	 article-type annotation
 	 gnus-data ,handle))
-    (setq e (point))
+    (setq e (if (bolp)
+		;; Exclude a newline.
+		(1- (point))
+	      (point)))
     (widget-convert-button
      'link b e
      :mime-handle handle