using qp.el, rfc2047.el in mailutils, rmail

[Dave Love]

I was reminded of these changes I've had hanging around for ages.  I
don't remember why they're not installed, but I don't recall any
objection.  They use better implementations from Gnus.  (Not properly
tested, since I don't rmail.)

2003-10-22  Dave Love  <address@hidden>

        * mail/mail-utils.el: Doc fixes.
        (rfc822): Require when compiling.
        (rfc2047-encode-string, quoted-printable-encode-string)
        (quoted-printable-decode-string, quoted-printable-decode-region)
        (rfc2047-decode-string, rfc2047-decode-region): Autoload.
        (mail-unquote-printable-hexdigit): Deleted.
        (mail-quote-printable, mail-unquote-printable): Use rfc2047.el,
        qp.el functions.

        * mail/rmail.el (rmail-message-filter): Fix :type.
        (rmail-convert-to-babyl-format): Use quoted-printable-decode-region.
        (rmail-hex-char-to-integer, rmail-hex-string-to-integer) 
        (rmail-decode-quoted-printable): Deleted.

Index: lisp/mail/mail-utils.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/mail-utils.el,v
retrieving revision 1.54
diff -u -p -r1.54 mail-utils.el
--- lisp/mail/mail-utils.el     1 Sep 2003 15:45:29 -0000       1.54
+++ lisp/mail/mail-utils.el     22 Oct 2003 17:53:47 -0000
@@ -1,6 +1,6 @@
-;;; mail-utils.el --- utility functions used both by rmail and rnews
+;;; mail-utils.el --- utility functions for mail and netnews
 
-;; Copyright (C) 1985, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail, news
@@ -33,17 +33,26 @@
 ;;; been initialized.
 (require 'lisp-mode)
 
+(eval-when-compile (require 'rfc822))
+
+(autoload 'rfc2047-encode-string "rfc2047")
+(autoload 'quoted-printable-encode-string "qp")
+(autoload 'quoted-printable-decode-string "qp")
+(autoload 'quoted-printable-decode-region "qp")
+(autoload 'rfc2047-decode-string "rfc2047")
+(autoload 'rfc2047-decode-region "rfc2047")
+
 ;;;###autoload
-(defcustom mail-use-rfc822 nil "\
-*If non-nil, use a full, hairy RFC822 parser on mail addresses.
+(defcustom mail-use-rfc822 nil
+  "*Non-nil means use a full, hairy RFC822 parser on mail addresses.
 Otherwise, (the default) use a smaller, somewhat faster, and
 often correct parser."
   :type 'boolean
   :group 'mail)
 
-;; Returns t if file FILE is an Rmail file.
 ;;;###autoload
 (defun mail-file-babyl-p (file)
+  "Return t if file FILE is an Rmail file."
   (let ((buf (generate-new-buffer " *rmail-file-p*")))
     (unwind-protect
        (save-excursion
@@ -53,85 +62,44 @@ often correct parser."
       (kill-buffer buf))))
 
 (defun mail-string-delete (string start end)
-  "Returns a string containing all of STRING except the part
-from START (inclusive) to END (exclusive)."
+  "Return contents of STRING excluding START (inclusive) to END (exclusive)."
   (if (null end) (substring string 0 start)
     (concat (substring string 0 start)
            (substring string end nil))))
 
 ;;;###autoload
 (defun mail-quote-printable (string &optional wrapper)
-  "Convert a string to the \"quoted printable\" Q encoding.
+  "Convert STRING to the \"quoted printable\" Q encoding.
 If the optional argument WRAPPER is non-nil,
-we add the wrapper characters =?ISO-8859-1?Q?....?=."
-  (let ((i 0) (result ""))
-    (save-match-data
-      (while (string-match "[?=\"\200-\377]" string i)
-       (setq result
-             (concat result (substring string i (match-beginning 0))
-                     (upcase (format "=%02x"
-                                     (aref string (match-beginning 0))))))
-       (setq i (match-end 0)))
-      (if wrapper
-         (concat "=?ISO-8859-1?Q?"
-                 result (substring string i)
-                 "?=")
-       (concat result (substring string i))))))
-
-(defun mail-unquote-printable-hexdigit (char)
-  (if (>= char ?A)
-      (+ (- char ?A) 10)
-    (- char ?0)))
+we add the RFC 2047 wrapper, e.g. \"=?iso-8859-1?q?....?=\".
+
+See `rfc2047-encode-string' or `quoted-printable-encode-string'."
+  (if wrapper
+      (rfc2047-encode-string string)
+    (quoted-printable-encode-string string)))
 
 ;;;###autoload
 (defun mail-unquote-printable (string &optional wrapper)
-  "Undo the \"quoted printable\" encoding.
-If the optional argument WRAPPER is non-nil,
-we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
-  (save-match-data
-    (and wrapper
-        (string-match "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?" string)
-        (setq string (match-string 1 string)))
-    (let ((i 0) strings)
-      (while (string-match "=\\(..\\|\n\\)" string i)
-       (setq strings (cons (substring string i (match-beginning 0)) strings))
-       (unless (= (aref string (match-beginning 1)) ?\n)
-         (setq strings
-               (cons (make-string 1
-                                  (+ (* 16 (mail-unquote-printable-hexdigit
-                                            (aref string (match-beginning 1))))
-                                     (mail-unquote-printable-hexdigit
-                                      (aref string (1+ (match-beginning 1))))))
-                     strings)))
-       (setq i (match-end 0)))
-      (apply 'concat (nreverse (cons (substring string i) strings))))))
+  "Undo \"quoted printable\" encoding os STRING.
+If the optional argument WRAPPER is non-nil, we expect to find and
+remove RFC 2047 wrapper characters like \"=?ISO-8859-1?Q?....?=\".
+
+See `rfc2047-decode-string' and `quoted-printable-decode-string'."
+  (if wrapper
+      (rfc2047-decode-string string)
+    (quoted-printable-decode-string string)))
 
 ;;;###autoload
 (defun mail-unquote-printable-region (beg end &optional wrapper)
   "Undo the \"quoted printable\" encoding in buffer from BEG to END.
-If the optional argument WRAPPER is non-nil,
-we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
+If the optional argument WRAPPER is non-nil, we expect to find and
+remove RFC 2047 wrapper characters like \"=?ISO-8859-1?Q?....?=\".
+
+See `rfc2047-decode-region' and `quoted-printable-decode-region'."
   (interactive "r\nP")
-  (save-match-data
-    (save-excursion
-      (save-restriction
-       (narrow-to-region beg end)
-       (goto-char (point-min))
-       (when (and wrapper
-                  (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
-         (delete-region (match-end 1) end)
-         (delete-region (point) (match-beginning 1)))
-       (while (re-search-forward "=\\(..\\|\n\\)" nil t)
-         (goto-char (match-end 0))
-         (replace-match
-          (if (= (char-after (match-beginning 1)) ?\n)
-              ""
-            (make-string 1
-                         (+ (* 16 (mail-unquote-printable-hexdigit
-                                   (char-after (match-beginning 1))))
-                            (mail-unquote-printable-hexdigit
-                             (char-after (1+ (match-beginning 1)))))))
-          t t))))))
+  (if wrapper
+      (rfc2047-decode-region beg end)
+    (quoted-printable-decode-region beg end)))
 
 (eval-when-compile (require 'rfc822))
 
@@ -297,11 +265,11 @@ If 4th arg LIST is non-nil, return a lis
                (skip-chars-backward " \t" opoint)
                (buffer-substring-no-properties opoint (point)))))))))
 
-;; Parse a list of tokens separated by commas.
-;; It runs from point to the end of the visible part of the buffer.
-;; Whitespace before or after tokens is ignored,
-;; but whitespace within tokens is kept.
 (defun mail-parse-comma-list ()
+  "Parse a list of tokens separated by commas.
+It runs from point to the end of the visible part of the buffer.
+Whitespace before or after tokens is ignored,
+but whitespace within tokens is kept."
   (let (accumulated
        beg)
     (skip-chars-forward " \t\n")
Index: lisp/mail/rmail.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/rmail.el,v
retrieving revision 1.375
diff -u -p -r1.375 rmail.el
--- lisp/mail/rmail.el  16 Oct 2003 16:54:48 -0000      1.375
+++ lisp/mail/rmail.el  22 Oct 2003 17:57:46 -0000
@@ -290,7 +290,7 @@ still the current message in the Rmail b
 Called with region narrowed to the message, including headers,
 before obeying `rmail-ignored-headers'."
   :group 'rmail-headers
-  :type 'function)
+  :type '(choice (const nil) function))
 
 (defcustom rmail-automatic-folder-directives nil
   "List of directives specifying where to put a message.
@@ -1820,7 +1820,7 @@ It returns t if it got any new messages.
                 (setq count (1+ count))
                 (if quoted-printable-header-field-end
                     (save-excursion
-                      (rmail-decode-quoted-printable header-end (point))
+                      (quoted-printable-decode-region header-end (point))
                       ;; Change "quoted-printable" to "8bit",
                       ;; to reflect the decoding we just did.
                       (goto-char quoted-printable-header-field-end)
@@ -1873,45 +1873,6 @@ It returns t if it got any new messages.
              ((eolp) (delete-char 1))
              (t (error "Cannot convert to babyl format")))))
     count))
-
-(defun rmail-hex-char-to-integer (character)
-  "Return CHARACTER's value interpreted as a hex digit."
-  (if (and (>= character ?0) (<= character ?9))
-      (- character ?0)
-    (let ((ch (logior character 32)))
-      (if (and (>= ch ?a) (<= ch ?f))
-         (- ch (- ?a 10))
-       (error "Invalid hex digit `%c'" ch)))))
-
-(defun rmail-hex-string-to-integer (hex-string)
-  "Return decimal integer for HEX-STRING."
-  (let ((hex-num 0)
-       (index 0))
-    (while (< index (length hex-string))
-      (setq hex-num (+ (* hex-num 16)
-                      (rmail-hex-char-to-integer (aref hex-string index))))
-      (setq index (1+ index)))
-    hex-num))
-
-(defun rmail-decode-quoted-printable (from to)
-  "Decode Quoted-Printable in the region between FROM and TO."
-  (interactive "r")
-  (goto-char from)
-  (or (markerp to)
-      (setq to (copy-marker to)))
-  (while (search-forward "=" to t)
-    (cond ((eq (following-char) ?\n)
-          (delete-char -1)
-          (delete-char 1))
-         ((looking-at "[0-9A-F][0-9A-F]")
-          (let ((byte (rmail-hex-string-to-integer
-                       (buffer-substring (point) (+ 2 (point))))))
-            (delete-region (1- (point)) (+ 2 (point)))
-            (insert byte)))
-         ((looking-at "=")
-          (delete-char 1))
-         (t
-          (message "Malformed MIME quoted-printable message")))))
 
 ;; Delete the "From ..." line, creating various other headers with
 ;; information from it if they don't already exist.  Now puts the