From c9173857852350261b1b8c12510414f81ccab25e Mon Sep 17 00:00:00 2001
From: Lars Magne Ingebrigtsen <larsi@gnus.org>
Date: Mon, 31 Dec 2001 05:28:18 +0000
Subject: [PATCH] * smiley-ems.el (smiley-update-cache): Check for valid types.

* gnus-art.el (gnus-with-article-buffer): New macro.

* gnus-picon.el (gnus-picon-transform-newsgroups): Keep the
strings as well as the glyphs.
(gnus-picon-transform-address): Ditto.
(gnus-picon-insert-glyph): Ditto.
(gnus-picon-transform-newsgroups): Toggle.
(gnus-picon-transform-address): Toggle.

* gnus-ems.el (gnus-remove-image): New function.
(gnus-put-image): Take an optional string.

* gnus-util.el (gnus-text-with-property): New function.

* gnus-art.el (gnus-delete-images): New function.

* gnus-ems.el (gnus-article-display-xface): Mark and store image.

* gnus-art.el (gnus-article-wash-status-entry): Renamed.
(gnus-article-wash-status): Use it.
(gnus-signature-toggle): Clean up.
(gnus-add-wash-status): New function.
(gnus-delete-wash-status): New function.
(gnus-article-hide-text-type): Use them throughout.
(gnus-add-image): New function.

* gnus-ems.el (gnus-article-display-xface): Use new interface.

* gnus-xmas.el (gnus-xmas-article-display-xface): Use new
interface.

* gnus-art.el (article-display-x-face): Cleaned up.

* rfc2047.el (rfc2047-field-value): New function.

* mail-parse.el (mail-header-field-value): New alias.
---
 lisp/ChangeLog     |  39 +++++++++
 lisp/gnus-art.el   | 198 ++++++++++++++++++++++-----------------------
 lisp/gnus-cite.el  |   9 +--
 lisp/gnus-ems.el   |  19 +++--
 lisp/gnus-picon.el |  49 +++++++----
 lisp/gnus-sum.el   |   3 +-
 lisp/gnus-util.el  |  11 +++
 lisp/gnus-xmas.el  |  12 +--
 lisp/mail-parse.el |   1 +
 lisp/rfc2047.el    |   8 ++
 lisp/smiley-ems.el |  17 ++--
 11 files changed, 217 insertions(+), 149 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c3678324b..98728ef9b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,44 @@
 2001-12-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* smiley-ems.el (smiley-update-cache): Check for valid types.
+
+	* gnus-art.el (gnus-with-article-buffer): New macro.
+
+	* gnus-picon.el (gnus-picon-transform-newsgroups): Keep the
+	strings as well as the glyphs.
+	(gnus-picon-transform-address): Ditto.
+	(gnus-picon-insert-glyph): Ditto.
+	(gnus-picon-transform-newsgroups): Toggle.
+	(gnus-picon-transform-address): Toggle.
+
+	* gnus-ems.el (gnus-remove-image): New function.
+	(gnus-put-image): Take an optional string.
+
+	* gnus-util.el (gnus-text-with-property): New function.
+
+	* gnus-art.el (gnus-delete-images): New function.
+
+	* gnus-ems.el (gnus-article-display-xface): Mark and store image. 
+
+	* gnus-art.el (gnus-article-wash-status-entry): Renamed.
+	(gnus-article-wash-status): Use it.
+	(gnus-signature-toggle): Clean up.
+	(gnus-add-wash-status): New function.
+	(gnus-delete-wash-status): New function.
+	(gnus-article-hide-text-type): Use them throughout.
+	(gnus-add-image): New function.
+
+	* gnus-ems.el (gnus-article-display-xface): Use new interface.
+
+	* gnus-xmas.el (gnus-xmas-article-display-xface): Use new
+	interface. 
+
+	* gnus-art.el (article-display-x-face): Cleaned up.
+
+	* rfc2047.el (rfc2047-field-value): New function.
+
+	* mail-parse.el (mail-header-field-value): New alias.
+
 	* gnus-art.el (gnus-mime-print-part): Fix typos.
 
 	* smiley-ems.el (gnus-smiley-file-types): New variable.
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 668e0604a..139278d36 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1167,6 +1167,7 @@ It is a string, such as \"PGP\". If nil, ask user."
 (defvar article-goto-body-goes-to-point-min-p nil)
 (defvar gnus-article-wash-types nil)
 (defvar gnus-article-emphasis-alist nil)
+(defvar gnus-article-image-alist nil)
 
 (defvar gnus-article-mime-handle-alist-1 nil)
 (defvar gnus-treatment-function-alist
@@ -1257,6 +1258,15 @@ Initialized from `text-mode-syntax-table.")
 (put 'gnus-with-article-headers 'lisp-indent-function 0)
 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
 
+(defmacro gnus-with-article-buffer (&rest forms)
+  `(save-excursion
+     (set-buffer gnus-article-buffer)
+     (let ((buffer-read-only nil))
+       ,@forms)))
+
+(put 'gnus-with-article-buffer 'lisp-indent-function 0)
+(put 'gnus-with-article-buffer 'edebug-form-spec '(body))
+
 (defun gnus-article-goto-header (header)
   "Go to HEADER, which is a regular expression."
   (re-search-forward (concat "^\\(" header "\\):") nil t))
@@ -1278,14 +1288,13 @@ Initialized from `text-mode-syntax-table.")
 
 (defun gnus-article-hide-text-type (b e type)
   "Hide text of TYPE between B and E."
-  (push type gnus-article-wash-types)
+  (gnus-add-wash-type type)
   (gnus-article-hide-text
    b e (cons 'article-type (cons type gnus-hidden-properties))))
 
 (defun gnus-article-unhide-text-type (b e type)
   "Unhide text of TYPE between B and E."
-  (setq gnus-article-wash-types
-	(delq type gnus-article-wash-types))
+  (gnus-delete-wash-type type)
   (remove-text-properties
    b e (cons 'article-type (cons type gnus-hidden-properties)))
   (when (memq 'intangible gnus-hidden-properties)
@@ -1384,7 +1393,7 @@ Initialized from `text-mode-syntax-table.")
 	  (when (setq beg (text-property-any
 			   (point-min) (point-max) 'message-rank (+ 2 max)))
 	    ;; We delete the unwanted headers.
-	    (push 'headers gnus-article-wash-types)
+	    (gnus-add-wash-type 'headers)
 	    (add-text-properties (point-min) (+ 5 (point-min))
 				 '(article-type headers dummy-invisible t))
 	    (delete-region beg (point-max))))))))
@@ -1716,90 +1725,52 @@ unfolded."
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
   (interactive (list 'force))
-  (save-excursion
+  (gnus-with-article-headers
     ;; Delete the old process, if any.
     (when (process-status "article-x-face")
       (delete-process "article-x-face"))
-    (let ((inhibit-point-motion-hooks t)
-	  x-faces
-	  (case-fold-search t)
-	  from last)
-      (save-restriction
-	(article-narrow-to-head)
-	(when (and buffer-read-only ;; When type `W f'
-		   (progn
-		     (goto-char (point-min))
-		     (not (re-search-forward "^X-Face:[\t ]*" nil t)))
-		   (gnus-buffer-live-p gnus-original-article-buffer))
-	  (with-current-buffer gnus-original-article-buffer
-	    (save-restriction
-	      (article-narrow-to-head)
-	      (while (re-search-forward "^X-Face:" nil t)
-		(setq x-faces
-		      (concat
-		       (or x-faces "")
-		       (buffer-substring
-			(match-beginning 0)
-			(1- (re-search-forward
-			     "^\\($\\|[^ \t]\\)" nil t))))))))
-	  (if x-faces
-	      (let (point start bface eface buffer-read-only)
-		(goto-char (point-max))
-		(forward-line -1)
-		(setq bface (get-text-property (gnus-point-at-bol) 'face)
-		      eface (get-text-property (1- (gnus-point-at-eol)) 'face))
-		(goto-char (point-max))
-		(setq point (point))
-		(insert x-faces)
-		(goto-char point)
-		(while (looking-at "\\([^:]+\\): *")
-		  (put-text-property (match-beginning 1) (1+ (match-end 1))
-				     'face bface)
-		  (setq start (match-end 0))
-		  (forward-line 1)
-		  (while (looking-at "[\t ]")
-		    (forward-line 1))
-		  (put-text-property start (point)
-				     'face eface)))))
-	(goto-char (point-min))
-	(setq from (message-fetch-field "from"))
-	(goto-char (point-min))
-	(while (and gnus-article-x-face-command
-		    (not last)
+    (if (memq 'xface gnus-article-wash-types)
+	;; We have already displayed X-Faces, so we remove them
+	;; instead.
+	(gnus-delete-images 'xface)
+      ;; Display X-Faces.
+      (let (x-faces from face)
+	(save-excursion
+	  (set-buffer gnus-original-article-buffer)
+	  (save-restriction
+	    (mail-narrow-to-head)
+	    (while (gnus-article-goto-header "x-face")
+	      (push (mail-header-field-value) x-faces))
+	    (setq from (message-fetch-field "from"))))
+	;; Sending multiple EOFs to xv doesn't work, so we only do a
+	;; single external face.
+	(when (stringp gnus-article-x-face-command)
+	  (setq x-faces (list (car x-faces))))
+	(while (and (setq face (pop x-faces))
+		    gnus-article-x-face-command
 		    (or force
 			;; Check whether this face is censored.
 			(not gnus-article-x-face-too-ugly)
 			(and gnus-article-x-face-too-ugly from
 			     (not (string-match gnus-article-x-face-too-ugly
-						from))))
-		    ;; Has to be present.
-		    (re-search-forward "^X-Face:[\t ]*" nil t))
-	  ;; This used to try to do multiple faces (`while' instead of
-	  ;; `when' above), but (a) sending multiple EOFs to xv doesn't
-	  ;; work (b) it can crash some versions of Emacs (c) are
-	  ;; multiple faces really something to encourage?
-	  (when (stringp gnus-article-x-face-command)
-	    (setq last t))
-	  ;; We now have the area of the buffer where the X-Face is stored.
-	  (save-excursion
-	    (let ((beg (point))
-		  (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))
-		  buffer-read-only)
-	      ;; We display the face.
-	      (if (symbolp gnus-article-x-face-command)
-		  ;; The command is a lisp function, so we call it.
-		  (if (gnus-functionp gnus-article-x-face-command)
-		      (funcall gnus-article-x-face-command beg end)
-		    (error "%s is not a function" gnus-article-x-face-command))
-		;; The command is a string, so we interpret the command
-		;; as a, well, command, and fork it off.
-		(let ((process-connection-type nil))
-		  (process-kill-without-query
-		   (start-process
-		    "article-x-face" nil shell-file-name shell-command-switch
-		    gnus-article-x-face-command))
-		  (process-send-region "article-x-face" beg end)
-		  (process-send-eof "article-x-face"))))))))))
+						from)))))
+	  ;; We display the face.
+	  (if (symbolp gnus-article-x-face-command)
+	      ;; The command is a lisp function, so we call it.
+	      (if (gnus-functionp gnus-article-x-face-command)
+		  (funcall gnus-article-x-face-command face)
+		(error "%s is not a function" gnus-article-x-face-command))
+	    ;; The command is a string, so we interpret the command
+	    ;; as a, well, command, and fork it off.
+	    (let ((process-connection-type nil))
+	      (process-kill-without-query
+	       (start-process
+		"article-x-face" nil shell-file-name shell-command-switch
+		gnus-article-x-face-command))
+	      (with-temp-buffer
+		(insert face)
+		(process-send-region "article-x-face" (point-min) (point-max)))
+	      (process-send-eof "article-x-face"))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2039,7 +2010,7 @@ The `gnus-list-identifiers' variable specifies what to do."
 	(article-goto-body)
 	;; Hide the "header".
 	(when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
-	  (push 'pgp gnus-article-wash-types)
+	  (gnus-add-wash-type 'pgp)
 	  (delete-region (match-beginning 0) (match-end 0))
 	  ;; Remove armor headers (rfc2440 6.2)
 	  (delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t)
@@ -2079,7 +2050,7 @@ always hide."
 		    "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
 		    nil t)
 		   (setq end (1+ (match-beginning 0))))
-	  (push 'pem gnus-article-wash-types)
+	  (gnus-add-wash-type 'pem)
 	  (gnus-article-hide-text-type
 	   end
 	   (if (search-forward "\n\n" nil t)
@@ -2339,7 +2310,7 @@ Originally it is hide instead of DUMMY."
      (point-min) (point-max)
      (cons 'article-type (cons type
 			       gnus-hidden-properties)))
-    (setq gnus-article-wash-types (delq type gnus-article-wash-types))))
+    (gnus-delete-wash-type type)))
 
 (defconst article-time-units
   `((year . ,(* 365.25 24 60 60))
@@ -2639,7 +2610,7 @@ This format is defined by the `gnus-article-time-format' variable."
 	       (match-beginning visible) (match-end visible) 'emphasis)
 	      (gnus-put-overlay-excluding-newlines
 	       (match-beginning visible) (match-end visible) 'face face)
-	      (push 'emphasis gnus-article-wash-types)
+	      (gnus-add-wash-type 'emphasis)
 	      (goto-char (match-end invisible)))))))))
 
 (defun gnus-article-setup-highlight-words (&optional highlight-words)
@@ -3052,7 +3023,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 	 (setq afunc func
 	       gfunc (intern (format "gnus-%s" func))))
        (defalias gfunc
-	 (if (fboundp afunc)
+	 (when (fboundp afunc)
 	   `(lambda (&optional interactive &rest args)
 	      ,(documentation afunc t)
 	      (interactive (list t))
@@ -3211,6 +3182,7 @@ commands:
   (make-local-variable 'gnus-article-decoded-p)
   (make-local-variable 'gnus-article-mime-handle-alist)
   (make-local-variable 'gnus-article-wash-types)
+  (make-local-variable 'gnus-article-image-alist)
   (make-local-variable 'gnus-article-charset)
   (make-local-variable 'gnus-article-ignored-charsets)
   (gnus-set-default-directory)
@@ -3399,7 +3371,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
     (unless (eq major-mode 'gnus-article-mode)
       (gnus-article-mode))
     (setq buffer-read-only nil
-	  gnus-article-wash-types nil)
+	  gnus-article-wash-types nil
+	  gnus-article-image-alist nil)
     (gnus-run-hooks 'gnus-tmp-internal-hook)
     (when gnus-display-mime-function
       (funcall gnus-display-mime-function))
@@ -4049,12 +4022,10 @@ If no internal viewer is available, use an external viewer."
     ;;;!!! No, w3 can display everything just fine.
     (gnus-mime-display-part (cadr handle)))
    ((equal (car handle) "multipart/signed")
-    (or (memq 'signed gnus-article-wash-types)
-	(push 'signed gnus-article-wash-types))
+    (gnus-add-wash-type 'signed)
     (gnus-mime-display-security handle))
    ((equal (car handle) "multipart/encrypted")
-    (or (memq 'encrypted gnus-article-wash-types)
-	(push 'encrypted gnus-article-wash-types))
+    (gnus-add-wash-type 'encrypted)
     (gnus-mime-display-security handle))
    ;; Other multiparts are handled like multipart/mixed.
    (t
@@ -4280,7 +4251,7 @@ representing the particular washing function, ON is the string to use
 in the article mode line when the washing function is active, and OFF
 is the string to use when it is inactive.")
 
-(defun gnus-gnus-article-wash-status-entry (key value)
+(defun gnus-article-wash-status-entry (key value)
   (let ((entry (assoc key gnus-article-wash-status-strings)))
     (if value (nth 1 entry) (nth 2 entry))))
 
@@ -4298,14 +4269,37 @@ is the string to use when it is inactive.")
 	  (signature (memq 'signature gnus-article-wash-types))
 	  (overstrike (memq 'overstrike gnus-article-wash-types))
 	  (emphasis (memq 'emphasis gnus-article-wash-types)))
-      (concat (gnus-gnus-article-wash-status-entry 'cite cite)
-	      (gnus-gnus-article-wash-status-entry 'headers
-						   (or headers boring))
-	      (gnus-gnus-article-wash-status-entry
-	       'pgp (or pgp pem signed encrypted))
-	      (gnus-gnus-article-wash-status-entry 'signature signature)
-	      (gnus-gnus-article-wash-status-entry 'overstrike overstrike)
-	      (gnus-gnus-article-wash-status-entry 'emphasis emphasis)))))
+      (concat
+       (gnus-article-wash-status-entry 'cite cite)
+       (gnus-article-wash-status-entry 'headers (or headers boring))
+       (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted))
+       (gnus-article-wash-status-entry 'signature signature)
+       (gnus-article-wash-status-entry 'overstrike overstrike)
+       (gnus-article-wash-status-entry 'emphasis emphasis)))))
+
+(defun gnus-add-wash-type (type)
+  "Add a washing of TYPE to the current status."
+  (push type gnus-article-wash-types))
+
+(defun gnus-delete-wash-type (type)
+  "Add a washing of TYPE to the current status."
+  (setq gnus-article-wash-types (delq type gnus-article-wash-types)))
+
+(defun gnus-add-image (category image)
+  "Add IMAGE of CATEGORY to the list of displayed images."
+  (let ((entry (assq category gnus-article-image-alist)))
+    (unless entry
+      (setq entry (list category))
+      (push entry gnus-article-image-alist))
+    (nconc entry (list image))))
+
+(defun gnus-delete-images (category)
+  "Delete all images in CATEGORY."
+  (let ((entry (assq category gnus-article-image-alist)))
+    (dolist (image (cdr entry))
+      (gnus-remove-image image))
+    (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
+    (gnus-delete-wash-type category)))
 
 (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
 
@@ -5256,14 +5250,12 @@ specified by `gnus-button-alist'."
 	  (inhibit-point-motion-hooks t))
       (if (text-property-any end (point-max) 'article-type 'signature)
 	  (progn
-	    (setq gnus-article-wash-types
-		  (delq 'signature gnus-article-wash-types))
+	    (gnus-delete-wash-type 'signature)
 	    (gnus-remove-text-properties-when
 	     'article-type 'signature end (point-max)
 	     (cons 'article-type (cons 'signature
 				       gnus-hidden-properties))))
-	(or (memq 'signature gnus-article-wash-types)
-	    (push 'signature gnus-article-wash-types))
+	(gnus-add-wash-type 'signature)
 	(gnus-add-text-properties-when
 	 'article-type nil end (point-max)
 	 (cons 'article-type (cons 'signature
diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
index f482729f0..6a09a47f0 100644
--- a/lisp/gnus-cite.el
+++ b/lisp/gnus-cite.el
@@ -510,8 +510,7 @@ always hide."
 		      (setq beg nil)
 		  (setq end (point-marker))))))
 	    (when (and beg end)
-	      (or (memq 'cite gnus-article-wash-types)
-		  (push 'cite gnus-article-wash-types))
+	      (gnus-add-wash-type 'cite)
 	      ;; We use markers for the end-points to facilitate later
 	      ;; wrapping and mangling of text.
 	      (setq beg (set-marker (make-marker) beg)
@@ -557,8 +556,7 @@ means show, nil means toggle."
 	     'article-type 'cite beg end
 	     (cons 'article-type (cons 'cite
 				       gnus-hidden-properties))))
-	(or (memq 'cite gnus-article-wash-types)
-	    (push 'cite gnus-article-wash-types))
+	(gnus-add-wash-type 'cite)
 	(gnus-add-text-properties-when
 	 'article-type nil beg end
 	 (cons 'article-type (cons 'cite
@@ -968,8 +966,7 @@ See also the documentation for `gnus-article-highlight-citation'."
 				       gnus-hidden-properties))
 	      ((assq number gnus-cite-attribution-alist))
 	      (t
-	       (or (memq 'cite gnus-article-wash-types)
-		   (push 'cite gnus-article-wash-types))
+	       (gnus-add-wash-type 'cite)
 	       (gnus-add-text-properties
 		(point) (progn (forward-line 1) (point))
 		(nconc (list 'article-type 'cite)
diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el
index 46493064f..61ab87423 100644
--- a/lisp/gnus-ems.el
+++ b/lisp/gnus-ems.el
@@ -224,8 +224,8 @@
   "Non-nil means the compface program supports the -X option.
 That produces XBM output.")
 
-(defun gnus-article-display-xface (beg end &optional buffer)
-  "Display an XFace header from between BEG and END in BUFFER.
+(defun gnus-article-display-xface (data)
+  "Display the XFace header FACE in the current buffer.
 Requires support for images in your Emacs and the external programs
 `uncompface', and `icontopbm'.  On a GNU/Linux system these
 might be in packages with names like `compface' or `faces-xface' and
@@ -243,10 +243,6 @@ for XEmacs."
 	    (make-ring gnus-article-xface-ring-size)))
     (save-excursion
       (let* ((cur (current-buffer))
-	     (data (if buffer
-		       (with-current-buffer buffer
-			 (buffer-substring beg end))
-		     (buffer-substring beg end)))
 	     (image (cdr-safe (assoc data (ring-elements
 					   gnus-article-xface-ring-internal))))
 	     default-enable-multibyte-characters)
@@ -289,6 +285,8 @@ for XEmacs."
 	  (re-search-forward "^From:" nil 'move)
  	  (while (get-text-property (point) 'display)
  	    (goto-char (next-single-property-change (point) 'display)))
+	  (gnus-add-wash-type 'xface)
+	  (gnus-add-image 'xface image)
 	  (insert-image image))))))
 
 ;;; Image functions.
@@ -300,8 +298,13 @@ for XEmacs."
 (defun gnus-create-image (file)
   (create-image file))
 
-(defun gnus-put-image (glyph)
-  (put-image glyph (point)))
+(defun gnus-put-image (glyph &optional string)
+  (insert-image glyph string))
+
+(defun gnus-remove-image (image)
+  (dolist (position (gnus-text-with-property 'display))
+    (when (equal (get-text-property position 'display) image)
+      (put-text-property position (1+ position) 'display nil))))
 
 (provide 'gnus-ems)
 
diff --git a/lisp/gnus-picon.el b/lisp/gnus-picon.el
index bc9c8d748..7f73ea78d 100644
--- a/lisp/gnus-picon.el
+++ b/lisp/gnus-picon.el
@@ -141,12 +141,14 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
 	file
       nil)))
 
-(defun gnus-picon-insert-glyph (glyph)
+(defun gnus-picon-insert-glyph (glyph category)
   "Insert GLYPH into the buffer.
 GLYPH can be either a glyph or a string."
   (if (stringp glyph)
       (insert glyph)
-    (gnus-put-image glyph)))
+    (gnus-add-wash-type category)
+    (gnus-add-image category (car glyph))
+    (gnus-put-image (car glyph) (cdr glyph))))
 
 (defun gnus-picon-create-glyph (file)
   (or (cdr (assoc file gnus-picon-glyph-alist))
@@ -155,8 +157,7 @@ GLYPH can be either a glyph or a string."
 
 ;;; Functions that does picon transformations:
 
-(defun gnus-picon-transform-address (header)
-  (interactive)
+(defun gnus-picon-transform-address (header category)
   (gnus-with-article-headers
     (let ((addresses
 	   (mail-header-parse-addresses (mail-fetch-field header)))
@@ -168,21 +169,24 @@ GLYPH can be either a glyph or a string."
 		   (setq spec (gnus-picon-split-address address)))
 	  (when (setq file (gnus-picon-find-face
 			    address gnus-picon-user-directories))
-	    (setcar spec (gnus-picon-create-glyph file)))
+	    (setcar spec (cons (gnus-picon-create-glyph file)
+			       (car spec))))
 	  (dotimes (i (1- (length spec)))
 	    (when (setq file (gnus-picon-find-face
 			      (concat "unknown@"
 				      (mapconcat
 				       'identity (nthcdr (1+ i) spec) "."))
 			      gnus-picon-domain-directories t))
-	      (setcar (nthcdr (1+ i) spec) (gnus-picon-create-glyph file))))
+	      (setcar (nthcdr (1+ i) spec)
+		      (cons (gnus-picon-create-glyph file)
+			    (nth (1+ i) spec)))))
 	  
 	  (gnus-article-goto-header header)
 	  (mail-header-narrow-to-field)
 	  (when (search-forward address nil t)
 	    (delete-region (match-beginning 0) (match-end 0))
 	    (while spec
-	      (gnus-picon-insert-glyph (pop spec))
+	      (gnus-picon-insert-glyph (pop spec) category)
 	      (when spec
 		(if (not first)
 		    (insert ".")
@@ -205,7 +209,9 @@ GLYPH can be either a glyph or a string."
 				    (mapconcat
 				     'identity (nthcdr i spec) "."))
 			    gnus-picon-news-directories t))
-	    (setcar (nthcdr i spec) (gnus-picon-create-glyph file))))
+	    (setcar (nthcdr i spec)
+		    (cons (gnus-picon-create-glyph file)
+			  (nth i spec)))))
 	
 	(gnus-article-goto-header header)
 	(mail-header-narrow-to-field)
@@ -213,7 +219,7 @@ GLYPH can be either a glyph or a string."
 	  (delete-region (match-beginning 0) (match-end 0))
 	  (setq spec (nreverse spec))
 	  (while spec
-	    (gnus-picon-insert-glyph (pop spec))
+	    (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)
 	    (when spec
 	      (insert "."))))))))
 
@@ -221,20 +227,35 @@ GLYPH can be either a glyph or a string."
 
 ;;;###autoload
 (defun gnus-treat-from-picon ()
+  "Display picons in the From header.
+If picons are already displayed, remove them."
   (interactive)
-  (gnus-picon-transform-address "from"))
+  (gnus-with-article-buffer
+    (if (memq 'from-picon gnus-article-wash-types)
+	(gnus-delete-images 'from-picon)
+      (gnus-picon-transform-address "from" 'from-picon))))
 
 ;;;###autoload
 (defun gnus-treat-mail-picon ()
+  "Display picons in the Cc and To headers.
+If picons are already displayed, remove them."
   (interactive)
-  (gnus-picon-transform-address "cc")
-  (gnus-picon-transform-address "to"))
+  (gnus-with-article-buffer
+    (if (memq 'mail-picon gnus-article-wash-types)
+	(gnus-delete-images 'mail-picon)
+      (gnus-picon-transform-address "cc" 'mail-picon)
+      (gnus-picon-transform-address "to" 'mail-picon))))
 
 ;;;###autoload
 (defun gnus-treat-newsgroups-picon ()
+  "Display picons in the Newsgroups and Followup-To headers.
+If picons are already displayed, remove them."
   (interactive)
-  (gnus-picon-transform-newsgroups "newsgroups")
-  (gnus-picon-transform-newsgroups "followup-to"))
+  (gnus-with-article-buffer
+    (if (memq 'newsgroups-picon gnus-article-wash-types)
+	(gnus-delete-images  'newsgroups-picon)
+      (gnus-picon-transform-newsgroups "newsgroups")
+      (gnus-picon-transform-newsgroups "followup-to"))))
 
 (provide 'gnus-picon)
 
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index b546b043e..37ecf234c 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -8066,8 +8066,7 @@ If ARG is a negative number, hide the unwanted header lines."
 	  (if  hidden
 	      (let ((gnus-treat-hide-headers nil)
 		    (gnus-treat-hide-boring-headers nil))
-		(setq gnus-article-wash-types
-		      (delq 'headers gnus-article-wash-types))
+		(gnus-delete-wash-type 'headers)
 		(gnus-treat-article 'head))
 	    (gnus-treat-article 'head)))
 	(gnus-set-mode-line 'article)))))
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 9b578743d..c9a48e011 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -221,6 +221,17 @@
 	(delete-char 1))
       (goto-char (next-single-property-change (point) prop nil (point-max))))))
 
+(defun gnus-text-with-property (prop)
+  "Return a list of all points where the text has PROP."
+  (let ((points nil)
+	(point 1))
+    (save-excursion
+      (while (< point (point-max))
+	(when (get-text-property point prop)
+	  (push point points))
+	(incf point)))
+    (nreverse points)))
+
 (require 'nnheader)
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."
diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el
index aefb066e4..d16841e72 100644
--- a/lisp/gnus-xmas.el
+++ b/lisp/gnus-xmas.el
@@ -648,23 +648,19 @@ XEmacs compatibility workaround."
   "Face to show X face"
   :group 'gnus-xmas)
 
-(defun gnus-xmas-article-display-xface (beg end &optional buffer)
+(defun gnus-xmas-article-display-xface (data)
   "Display any XFace headers in BUFFER."
   (save-excursion
     (let ((xface-glyph
 	   (cond
 	    ((featurep 'xface)
 	     (make-glyph (vector 'xface :data
-				 (concat "X-Face: "
-					 (if buffer
-					     (with-current-buffer buffer
-					       (buffer-substring beg end))
-					   (buffer-substring beg end))))))
+				 (concat "X-Face: " data))))
 	    ((featurep 'xpm)
 	     (let ((cur (or buffer (current-buffer))))
 	       (save-excursion
 		 (gnus-set-work-buffer)
-		 (insert-buffer-substring cur beg end)
+		 (insert data)
 		 (let ((coding-system-for-read 'binary)
 		       (coding-system-for-write 'binary))
 		   (gnus-xmas-call-region "uncompface")
@@ -832,7 +828,7 @@ XEmacs compatibility workaround."
     (insert-file-contents file)
     (mm-create-image-xemacs (car (last (split-string file "[.]"))))))
 
-(defun gnus-xmas-put-image (glyph)
+(defun gnus-xmas-put-image (glyph &optional string)
   (let ((annot (make-annotation glyph nil 'text)))
     (set-extent-property annot 'mm t)
     (set-extent-property annot 'duplicable t)))
diff --git a/lisp/mail-parse.el b/lisp/mail-parse.el
index ea6b242eb..a5de09bcf 100644
--- a/lisp/mail-parse.el
+++ b/lisp/mail-parse.el
@@ -62,6 +62,7 @@
 (defalias 'mail-header-fold-field 'rfc2047-fold-field)
 (defalias 'mail-header-unfold-field 'rfc2047-unfold-field)
 (defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
+(defalias 'mail-header-field-value 'rfc2047-field-value)
 
 (defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
 (defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header)
diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index c1ab6ca5c..10eff841e 100644
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -116,6 +116,14 @@ Valid encodings are nil, `Q' and `B'.")
        (point-max))))
   (goto-char (point-min)))
 
+(defun rfc2047-field-value ()
+  "Return the value of the field at point."
+  (save-excursion
+    (save-restriction
+      (rfc2047-narrow-to-field)
+      (re-search-forward ":[ \t\n]*" nil t)
+      (buffer-substring (point) (point-max)))))
+
 (defun rfc2047-encode-message-header ()
   "Encode the message header according to `rfc2047-header-encoding-alist'.
 Should be called narrowed to the head of the message."
diff --git a/lisp/smiley-ems.el b/lisp/smiley-ems.el
index 41d1f1f9e..f86d4d69e 100644
--- a/lisp/smiley-ems.el
+++ b/lisp/smiley-ems.el
@@ -91,15 +91,16 @@ regexp to replace with IMAGE.  IMAGE is the name of a PBM file in
       (while (and (not file)
 		  (setq type (pop types)))
 	(unless (file-exists-p
-	       (setq file (expand-file-name (concat (nth 2 elt) "." type)
-					    smiley-data-directory)))
+		 (setq file (expand-file-name (concat (nth 2 elt) "." type)
+					      smiley-data-directory)))
 	  (setq file nil)))
-      (let ((image (find-image (list (list :type (intern type) 
-					   :file file
-					   :ascent 'center)))))
-	(when image
-	  (push (list (car elt) (cadr elt) image)
-		smiley-cached-regexp-alist))))))
+      (when type
+	(let ((image (find-image (list (list :type (intern type) 
+					     :file file
+					     :ascent 'center)))))
+	  (when image
+	    (push (list (car elt) (cadr elt) image)
+		  smiley-cached-regexp-alist)))))))
 
 (defvar smiley-active nil
   "Non-nil means smilies in the buffer will be displayed.")
-- 
2.25.1