merge from trunk

13 files changed, 364 insertions, 36 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index df35e998c31..37d89ba8cad 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,82 @@
+2012-09-03  Lars Ingebrigtsen  <larsi@gnus.org>
+
+	* dgnushack.el: XEmacs 21.5 compilation fix.
+
+	* gnus-notifications.el (gnus-notifications-notify): Use it.
+
+	* gnus-fun.el (gnus-funcall-no-warning): New function to silence
+	warnings on XEmacs.
+
+2012-09-01  Paul Eggert  <eggert@cs.ucla.edu>
+
+	Better seeds for (random).
+	* gnus-sync.el (gnus-sync-lesync-setup):
+	* message.el (message-canlock-generate, message-unique-id):
+	Change (random t) to (random), now that the latter is more random.
+
+2012-08-31  Dave Abrahams  <dave@boostpro.com>
+
+	* auth-source.el (auth-sources): Fix macos keychain access.
+
+	* gnus-int.el (gnus-request-head): When gnus-override-method is set,
+	allow the backend `request-head' function to determine the group
+	name on its own.
+	(gnus-request-expire-articles): Filter out negative article numbers
+	during expiry (Bug#11980).
+
+	* gnus-range.el (gnus-set-difference): Change gnus-set-difference from
+	O(N^2) to O(N).  This makes warping into huge groups tolerable.
+
+	* gnus-registry.el (gnus-try-warping-via-registry): Don't act as though
+	you've found the article when you haven't.
+
+2012-08-31  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* gnus-notifications.el (gnus-notifications-action): Avoid CL-ism.
+
+2012-08-30  Julien Danjou  <julien@danjou.info>
+
+	* gnus-notifications.el (gnus-notifications-notify): Use timeout from
+	`gnus-notifications-timeout'.
+	(gnus-notifications-timeout): Add.
+	(gnus-notifications-action): New function.
+	(gnus-notifications-notify): Add :action using
+	`gnus-notifications-action'.
+	(gnus-notifications-id-to-msg): New variable.
+	(gnus-notifications): Use `gnus-notifications-id-to-msg' to map
+	notifications id to messages.
+
+2012-08-30  Kenichi Handa  <handa@gnu.org>
+
+	* qp.el (quoted-printable-decode-region): Decode multiple bytes at
+	once.
+
+2012-08-29  Julien Danjou  <julien@danjou.info>
+
+	* gnus-notifications.el: New file.
+	(gnus-notifications-notify): New function.
+	(gnus-notifications): Use `gnus-notifications-notify'.
+
+2012-08-28  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-sum.el (gnus-summary-enter-digest-group): Decode content
+	transfer encoding first; bind gnus-newsgroup-charset to the charset
+	that the article specifies (Bug#12209).
+
+2012-08-22  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-cus.el (gnus-group-customize): Decode values posting-style holds.
+	(gnus-group-customize-done): Encode values posting-style holds.
+
+	* gnus-msg.el (gnus-summary-resend-message)
+	(gnus-configure-posting-styles): Decode values posting-style group
+	parameter holds.
+
+2012-08-21  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-msg.el (gnus-summary-resend-message): Honor posting-style for
+	`name' and `address' in Resent-From header.
+
 2012-08-14  Chong Yidong  <cyd@gnu.org>
 
 	* gnus-art.el (article-display-face): Handle failure in
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 262da447358..4c5e5ffadce 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -256,10 +256,10 @@ can get pretty complex."
                   (const :tag "Temp Secrets API Collection" "secrets:session")
 
                   (const :tag "Default internet Mac OS Keychain"
-                         'macos-keychain-internet)
+                         macos-keychain-internet)
 
                   (const :tag "Default generic Mac OS Keychain"
-                         'macos-keychain-generic)
+                         macos-keychain-generic)
 
                   (list :tag "Source definition"
                         (const :format "" :value :source)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 234d0f7ae56..3440e6310af 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -417,6 +417,11 @@ category."))
 	    (delq elem tmp))
 	  (setq tmp (cdr tmp))))
 
+      ;; Decode values posting-style holds.
+      (dolist (style (cdr (assq 'posting-style values)))
+	(when (stringp (cadr style))
+	  (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+
       (setq gnus-custom-params
             (apply 'widget-create 'group
                    :value values
@@ -487,14 +492,17 @@ form, but who cares?"
 (defun gnus-group-customize-done (&rest ignore)
   "Apply changes and bury the buffer."
   (interactive)
-  (if gnus-custom-topic
-      (gnus-topic-set-parameters gnus-custom-topic
-				 (widget-value gnus-custom-params))
-    (gnus-group-edit-group-done 'params gnus-custom-group
-				(widget-value gnus-custom-params))
-    (gnus-group-edit-group-done 'method gnus-custom-group
-				(widget-value gnus-custom-method)))
-  (bury-buffer))
+  (let ((params (widget-value gnus-custom-params)))
+    ;; Encode values posting-style holds.
+    (dolist (style (cdr (assq 'posting-style params)))
+      (when (stringp (cadr style))
+	(setcdr style (list (mm-encode-coding-string (cadr style) 'utf-8)))))
+    (if gnus-custom-topic
+	(gnus-topic-set-parameters gnus-custom-topic params)
+      (gnus-group-edit-group-done 'params gnus-custom-group params)
+      (gnus-group-edit-group-done 'method gnus-custom-group
+				  (widget-value gnus-custom-method)))
+    (bury-buffer)))
 
 ;;; Score Customization:
 
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index f33eb910c6a..f5e1c5ad691 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -278,6 +278,10 @@ colors of the displayed X-Faces."
 	  values))
   (mapconcat 'identity values " ")))
 
+(defun gnus-funcall-no-warning (function &rest args)
+  (when (fboundp function)
+    (apply function args)))
+
 (provide 'gnus-fun)
 
 ;;; gnus-fun.el ends here
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 339e3d951c2..bc3ba187dd4 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -599,7 +599,8 @@ real group. Does nothing on a real group."
 	    clean-up t))
      ;; Use `head' function.
      ((fboundp head)
-      (setq res (funcall head article (gnus-group-real-name group)
+      (setq res (funcall head article
+                         (and (not gnus-override-method) (gnus-group-real-name group))
 			 (nth 1 gnus-command-method))))
      ;; Use `article' function.
      (t
@@ -706,6 +707,10 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
 
 (defun gnus-request-expire-articles (articles group &optional force)
   (let* ((gnus-command-method (gnus-find-method-for-group group))
+         ;; Filter out any negative article numbers; they can't be
+         ;; expired here.
+         (articles
+          (delq nil (mapcar (lambda (n) (and (>= n 0) n)) articles)))
 	 (gnus-inhibit-demon t)
 	 (not-deleted
 	  (funcall
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 594f68bb86f..c2f79e70d1e 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1369,7 +1369,24 @@ For the \"inline\" alternatives, also see the variable
 	      (nnmail-fetch-field "to"))))
 	 current-prefix-arg))
   (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
-	(message-sent-hook (copy-sequence message-sent-hook)))
+	(message-sent-hook (copy-sequence message-sent-hook))
+	;; Honor posting-style for `name' and `address' in Resent-From header.
+	(styles (gnus-group-find-parameter gnus-newsgroup-name
+					   'posting-style t))
+	(user-full-name user-full-name)
+	(user-mail-address user-mail-address)
+	tem)
+    (dolist (style styles)
+      (when (stringp (cadr style))
+	(setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+    (dolist (style (if styles
+		       (append gnus-posting-styles (list (cons ".*" styles)))
+		     gnus-posting-styles))
+      (when (string-match (pop style) gnus-newsgroup-name)
+	(when (setq tem (cadr (assq 'name style)))
+	  (setq user-full-name tem))
+	(when (setq tem (cadr (assq 'address style)))
+	  (setq user-mail-address tem))))
     ;; `gnus-summary-resend-message-insert-gcc' must run last.
     (add-hook 'message-header-setup-hook
 	      'gnus-summary-resend-message-insert-gcc t)
@@ -1793,6 +1810,10 @@ this is a reply."
       (when gnus-newsgroup-name
 	(let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
 	  (when tmp-style
+	    (dolist (style tmp-style)
+	      (when (stringp (cadr style))
+		(setcdr style (list (mm-decode-coding-string (cadr style)
+							     'utf-8)))))
 	    (setq styles (append styles (list (cons ".*" tmp-style)))))))
       ;; Go through all styles and look for matches.
       (dolist (style styles)
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
new file mode 100644
index 00000000000..f9c2d309a35
--- /dev/null
+++ b/lisp/gnus/gnus-notifications.el
@@ -0,0 +1,187 @@
+;; gnus-notifications.el -- Send notification on new message in Gnus
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This implements notifications using `notifications-notify' on new
+;; messages received.
+;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
+;; to get notifications just after getting the new news.
+
+;;; Code:
+
+(ignore-errors
+  (require 'notifications))
+(require 'gnus-sum)
+(require 'gnus-group)
+(require 'gnus-int)
+(require 'gnus-art)
+(require 'gnus-util)
+(ignore-errors
+  (require 'google-contacts))        ; Optional
+(require 'gnus-fun)
+
+(defgroup gnus-notifications nil
+  "Send notifications on new message in Gnus."
+  :group 'gnus)
+
+(defcustom gnus-notifications-use-google-contacts t
+  "Use Google Contacts to retrieve photo."
+  :type 'boolean
+  :group 'gnus-notifications)
+
+(defcustom gnus-notifications-use-gravatar t
+  "Use Gravatar to retrieve photo."
+  :type 'boolean
+  :group 'gnus-notifications)
+
+(defcustom gnus-notifications-minimum-level 1
+  "Minimum group level the message should have to be notified.
+Any message in a group that has a greater value than this will
+not get notifications."
+  :type 'integer
+  :group 'gnus-notifications)
+
+(defcustom gnus-notifications-timeout nil
+  "Timeout used for notifications sent via `notifications-notify'."
+  :type 'integer
+  :group 'gnus-notifications)
+
+(defvar gnus-notifications-sent nil
+  "Notifications already sent.")
+
+(defvar gnus-notifications-id-to-msg nil
+  "Map notifications ids to messages.")
+
+(defun gnus-notifications-action (id key)
+  (when (string= key "read")
+    (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+      (when group-article
+        (let ((group (cadr group-article))
+              (article (nth 2 group-article)))
+          (gnus-fetch-group group (list article)))))))
+
+(defun gnus-notifications-notify (from subject photo-file)
+  "Send a notification about a new mail.
+Return a notification id if any, or t on success."
+  (if (fboundp 'notifications-notify)
+      (gnus-funcall-no-warning
+       'notifications-notify
+       :title from
+       :body subject
+       :actions '("read" "Read")
+       :on-action 'gnus-notifications-action
+       :app-icon (gnus-funcall-no-warning
+		  'image-search-load-path "gnus/gnus.png")
+       :app-name "Gnus"
+       :category "email.arrived"
+       :timeout gnus-notifications-timeout
+       :image-path photo-file)
+    (message "New message from %s: %s" from subject)
+    ;; Don't return an id
+    t))
+
+(defun gnus-notifications-get-photo (mail-address)
+  "Get photo for mail address."
+  (let ((google-photo (when (and gnus-notifications-use-google-contacts
+                                 (fboundp 'google-contacts-get-photo))
+                        (ignore-errors
+                          (gnus-funcall-no-warning
+			   'google-contacts-get-photo mail-address)))))
+    (if google-photo
+        google-photo
+      (when gnus-notifications-use-gravatar
+        (let ((gravatar (ignore-errors
+                          (gravatar-retrieve-synchronously mail-address))))
+          (if (eq gravatar 'error)
+              nil
+            (plist-get (cdr gravatar) :data)))))))
+
+(defun gnus-notifications-get-photo-file (mail-address)
+  "Get a temporary file with an image for MAIL-ADDRESS.
+You have to delete the temporary image yourself using
+`delete-image'.
+
+Returns nil if no image found."
+  (let ((photo (gnus-notifications-get-photo mail-address)))
+    (when photo
+      (let ((photo-file (make-temp-file "gnus-notifications-photo-"))
+            (coding-system-for-write 'binary))
+        (with-temp-file photo-file
+          (insert photo))
+        photo-file))))
+
+;;;###autoload
+(defun gnus-notifications ()
+  "Send a notification on new message.
+This check for new messages that are in group with a level lower
+or equal to `gnus-notifications-minimum-level' and send a
+notification using `notifications-notify' for it.
+
+This is typically a function to add in
+`gnus-after-getting-new-news-hook'"
+  (dolist (entry gnus-newsrc-alist)
+    (let ((group (car entry)))
+      ;; Check that the group level is less than
+      ;; `gnus-notifications-minimum-level' and the the group has unread
+      ;; messages.
+      (when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
+                 (let ((unread (gnus-group-unread group)))
+                   (and (numberp unread)
+                        (> unread 0))))
+        ;; Each group should have an entry in the `gnus-notifications-sent'
+        ;; alist. If not, we add one at this time.
+        (let ((group-notifications (or (assoc group gnus-notifications-sent)
+                                       ;; Nothing, add one and return it.
+                                       (assoc group
+                                              (add-to-list
+                                               'gnus-notifications-sent
+                                               (cons group nil))))))
+          (dolist (article (gnus-list-of-unread-articles group))
+            ;; Check if the article already has been notified
+            (unless (memq article (cdr group-notifications))
+              (with-current-buffer nntp-server-buffer
+                (gnus-request-head article group)
+                (article-decode-encoded-words) ; to decode mail addresses, subjects, etc
+                (let* ((address-components (mail-extract-address-components
+                                            (or (mail-fetch-field "From") "")))
+                       (address (cadr address-components)))
+                  ;; Ignore mails from ourselves
+                  (unless (gnus-string-match-p gnus-ignored-from-addresses
+                                               address)
+                    (let* ((photo-file (gnus-notifications-get-photo-file address))
+                           (notification-id (gnus-notifications-notify
+                                             (or (car address-components) address)
+                                             (mail-fetch-field "Subject")
+                                             photo-file)))
+                      (when notification-id
+                        ;; Register that we did notify this message
+                        (setcdr group-notifications (cons article (cdr group-notifications)))
+                        (unless (eq notification-id t)
+                          ;; Register the notification id for later actions
+                          (add-to-list 'gnus-notifications-id-to-msg (list notification-id group article))))
+                      (when photo-file
+                        (delete-file photo-file)))))))))))))
+
+(provide 'gnus-notifications)
+
+;;; gnus-notifications.el ends here
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 68729da0910..091276ee4f8 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -52,11 +52,13 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
 
 (defun gnus-set-difference (list1 list2)
   "Return a list of elements of LIST1 that do not appear in LIST2."
-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1))
+  (let ((hash2 (make-hash-table :test 'eq))
+        (result nil))
+    (dolist (elt list2) (puthash elt t hash2))
+    (dolist (elt list1)
+      (unless (gethash elt hash2)
+        (setq result (cons elt result))))
+    (nreverse result)))
 
 (defun gnus-range-nconcat (&rest ranges)
   "Return a range comprising all the RANGES, which are pre-sorted.
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 8aecc98ee86..71e00967548 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1169,9 +1169,10 @@ data stored in the registry."
 
             ;; Try to activate the group.  If that fails, just move
             ;; along.  We may have more groups to work with
-            (ignore-errors
-	      (gnus-select-group-with-message-id group message-id))
-            (throw 'found t)))))))
+            (when
+                (ignore-errors
+                  (gnus-select-group-with-message-id group message-id) t)
+              (throw 'found t))))))))
 
 ;; TODO: a few things
 
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 06f17bcf646..b44b953bec6 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9137,7 +9137,7 @@ To control what happens when you exit the group, see the
 			   (list (cons 'save-article-group ogroup))))
 	   (case-fold-search t)
 	   (buf (current-buffer))
-	   dig to-address)
+	   dig to-address charset)
       (with-current-buffer gnus-original-article-buffer
 	;; Have the digest group inherit the main mail address of
 	;; the parent article.
@@ -9150,16 +9150,32 @@ To control what happens when you exit the group, see the
 				      to-address))))))
 	(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
 	(insert-buffer-substring gnus-original-article-buffer)
-	;; Remove lines that may lead nndoc to misinterpret the
-	;; document type.
 	(narrow-to-region
 	 (goto-char (point-min))
 	 (or (search-forward "\n\n" nil t) (point)))
+	;; Remove lines that may lead nndoc to misinterpret the
+	;; document type.
 	(goto-char (point-min))
 	(delete-matching-lines "^Path:\\|^From ")
+	;; Parse charset, and decode content transfer encoding.
+	(setq charset (mail-content-type-get
+		       (mail-header-parse-content-type
+			(or (gnus-fetch-field "content-type") ""))
+		       'charset))
+	(let ((encoding (gnus-fetch-field "content-transfer-encoding")))
+	  (when encoding
+	    (message-remove-header "content-transfer-encoding")
+	    (goto-char (point-max))
+	    (widen)
+	    (narrow-to-region (point) (point-max))
+	    (mm-decode-content-transfer-encoding
+	     (intern (downcase (mail-header-strip encoding))))))
 	(widen))
       (unwind-protect
-	  (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+	  (if (let ((gnus-newsgroup-ephemeral-charset
+		     (if charset
+			 (intern (downcase (gnus-strip-whitespace charset)))
+		       gnus-newsgroup-charset))
 		    (gnus-newsgroup-ephemeral-ignored-charsets
 		     gnus-newsgroup-ignored-charsets))
 		(gnus-group-read-ephemeral-group
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index 15d94810c3a..ca8662ff936 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -225,7 +225,7 @@ When SALT is nil, a random one will be generated using `random'."
          (security-object (concat url "/_security"))
          (user-record `((names . [,user]) (roles . [])))
          (couch-user-name (format "org.couchdb.user:%s" user))
-         (salt (or salt (sha1 (format "%s" (random t)))))
+         (salt (or salt (sha1 (format "%s" (random)))))
          (couch-user-record
           `((_id . ,couch-user-name)
             (type . user)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 8fd89b1742c..18088423eb0 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4820,9 +4820,7 @@ Do not use this for anything important, it is cryptographically weak."
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)
-		  (format "%x%x%x" (random)
-			  (progn (random t) (random))
-			  (random))
+		  (format "%x%x%x" (random) (random) (random))
 		  (prin1-to-string (recent-keys))
 		  (prin1-to-string (garbage-collect))))))
 
@@ -5525,7 +5523,6 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()
-  (random t)
   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index c8481aa9dee..87252684a48 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -53,7 +53,10 @@ them into characters should be done separately."
       ;; or both of which are lowercase letters in "abcdef", is
       ;; formally illegal. A robust implementation might choose to
       ;; recognize them as the corresponding uppercase letters.''
-      (let ((case-fold-search t))
+      (let ((case-fold-search t)
+	    (decode-hex #'(lambda (n1 n2)
+			    (+ (* (if (<= n1 ?9) (- n1 ?0) (+ (- n1 ?A) 10)) 16)
+			       (if (<= n2 ?9) (- n2 ?0) (+ (- n2 ?A) 10))))))
 	(narrow-to-region from to)
 	;; Do this in case we're called from Gnus, say, in a buffer
 	;; which already contains non-ASCII characters which would
@@ -65,12 +68,17 @@ them into characters should be done separately."
 		    (not (eobp)))
 	  (cond ((eq (char-after (1+ (point))) ?\n)
 		 (delete-char 2))
-		((looking-at "=[0-9A-F][0-9A-F]")
-		 (let ((byte (string-to-number (buffer-substring (1+ (point))
-							      (+ 3 (point)))
-					    16)))
-		   (mm-insert-byte byte 1)
-		   (delete-char 3)))
+		((looking-at "\\(=[0-9A-F][0-9A-F]\\)+")
+		 ;; Decode this sequence at once; i.e. by a single
+		 ;; deletion and insertion.
+		 (let* ((n (/ (- (match-end 0) (point)) 3))
+			(str (make-string n 0)))
+		   (dotimes (i n)
+		     (aset str i (funcall decode-hex (char-after (1+ (point)))
+					  (char-after (+ 2 (point)))))
+		     (forward-char 3))
+		   (delete-region (match-beginning 0) (match-end 0))
+		   (insert str)))
 		(t
 		 (message "Malformed quoted-printable text")
 		 (forward-char)))))