]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/mail-utils.el
(mail-extr-all-letters-but-separators)
[gnu-emacs] / lisp / mail / mail-utils.el
index c234411ac8708342d82fdc81df1a03d345090193..f54095120684e884422de1afadf8a8870b442ea4 100644 (file)
 (require 'lisp-mode)
                     
 ;;;###autoload
-(defvar mail-use-rfc822 nil "\
+(defcustom mail-use-rfc822 nil "\
 *If non-nil, use a full, hairy RFC822 parser on mail addresses.
 Otherwise, (the default) use a smaller, somewhat faster, and
-often correct parser.")
+often correct parser."
+  :type 'boolean
+  :group 'mail)
 
 ;; Returns t if file FILE is an Rmail file.
 ;;;###autoload
@@ -57,6 +59,7 @@ from START (inclusive) to END (exclusive)."
     (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.
 If the optional argument WRAPPER is non-nil,
@@ -80,6 +83,7 @@ we add the wrapper characters =?ISO-8859-1?Q?....?=."
       (+ (- char ?A) 10)
     (- char ?0)))
 
+;;;###autoload
 (defun mail-unquote-printable (string &optional wrapper)
   "Undo the \"quoted printable\" encoding.
 If the optional argument WRAPPER is non-nil,
@@ -88,17 +92,46 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
     (and wrapper
         (string-match "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?" string)
         (setq string (match-string 1 string)))
-    (let ((i 0) (result ""))
-      (while (string-match "=\\(..\\)" string i)
-       (setq result
-             (concat result (substring string i (match-beginning 0))
-                     (make-string 1
+    (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))))))))
+                                      (aref string (1+ (match-beginning 1))))))
+                     strings)))
        (setq i (match-end 0)))
-      (concat result (substring string i)))))
+      (apply 'concat (nreverse (cons (substring string i) strings))))))
+
+;;;###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?....?=."
+  (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))))))
 
 (defun mail-strip-quoted-names (address)
   "Delete comments and quoted strings in an address list ADDRESS.
@@ -110,12 +143,6 @@ Return a modified address list."
        (progn (require 'rfc822)
               (mapconcat 'identity (rfc822-addresses address) ", "))
       (let (pos)
-       (string-match "\\`[ \t\n]*" address)
-       ;; strip surrounding whitespace
-       (setq address (substring address
-                               (match-end 0)
-                               (string-match "[ \t\n]*\\'" address
-                                             (match-end 0))))
 
        ;; Detect nested comments.
        (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
@@ -147,10 +174,17 @@ Return a modified address list."
                 (mail-string-delete address
                                     pos (match-end 0)))))
 
+       ;; strip surrounding whitespace
+       (string-match "\\`[ \t\n]*" address)
+       (setq address (substring address
+                               (match-end 0)
+                               (string-match "[ \t\n]*\\'" address
+                                             (match-end 0))))
+
        ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
        (setq pos 0)
        (while (setq pos (string-match
-                         "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
+                          "\\([ \t]?\\)[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
                          address pos))
         ;; If the next thing is "@", we have "foo bar"@host.  Leave it.
         (if (and (> (length address) (match-end 0))
@@ -158,7 +192,7 @@ Return a modified address list."
             (setq pos (match-end 0))
           (setq address
                 (mail-string-delete address
-                                    pos (match-end 0)))))
+                                     (match-end 1) (match-end 0)))))
        ;; Retain only part of address in <> delims, if there is such a thing.
        (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)"
                                      address))
@@ -168,10 +202,6 @@ Return a modified address list."
           (setq address (mail-string-delete address (1- close) close))
           (setq address (mail-string-delete address junk-beg junk-end))))
        address))))
-  
-(or (and (boundp 'rmail-default-dont-reply-to-names)
-        (not (null rmail-default-dont-reply-to-names)))
-    (setq rmail-default-dont-reply-to-names "info-"))
 
 ; rmail-dont-reply-to-names is defined in loaddefs
 (defun rmail-dont-reply-to (userids)
@@ -185,22 +215,40 @@ Usenet paths ending in an element that matches are removed also."
                        "")
                    (concat (regexp-quote (user-login-name))
                            "\\>"))))
-  (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*[!<]\\|\\)\\("
-                      rmail-dont-reply-to-names
-                      "\\|[^\,.<]*<\\(" rmail-dont-reply-to-names "\\)"
+  (let ((match (concat "\\(^\\|,\\)[ \t\n]*"
+                      ;; Can anyone figure out what this is for?
+                      ;; Is it an obsolete remnant of another way of
+                      ;; handling Foo Bar <foo@machine>?
+                      "\\([^,\n]*[!<]\\|\\)"
+                      "\\("
+                            rmail-dont-reply-to-names
+                      "\\|"
+                            ;; Include the human name that precedes <foo@bar>.
+                            "\\([^\,.<\"]\\|\"[^\"]*\"\\)*"
+                            "<\\(" rmail-dont-reply-to-names "\\)"
                       "\\)"))
        (case-fold-search t)
        pos epos)
-    (while (setq pos (string-match match userids))
+    (while (setq pos (string-match match userids pos))
       (if (> pos 0) (setq pos (match-beginning 2)))
       (setq epos
            ;; Delete thru the next comma, plus whitespace after.
            (if (string-match ",[ \t\n]*" userids (match-end 0))
                (match-end 0)
              (length userids)))
-      (setq userids
-           (mail-string-delete
-             userids pos epos)))
+      ;; Count the double-quotes since the beginning of the list.
+      ;; Reject this match if it is inside a pair of doublequotes.
+      (let (quote-pos inside-quotes)
+       (while (and (setq quote-pos (string-match "\"" userids quote-pos))
+                   (< quote-pos pos))
+         (setq quote-pos (1+ quote-pos))
+         (setq inside-quotes (not inside-quotes)))
+       (if inside-quotes
+           ;; Advance to next even-parity quote, and scan from there.
+           (setq pos (string-match "\"" userids pos))
+         (setq userids
+               (mail-string-delete
+                userids pos epos)))))
     ;; get rid of any trailing commas
     (if (setq pos (string-match "[ ,\t\n]*\\'" userids))
        (setq userids (substring userids 0 pos)))
@@ -211,9 +259,9 @@ Usenet paths ending in an element that matches are removed also."
 \f
 ;;;###autoload
 (defun mail-fetch-field (field-name &optional last all list)
-  "Return the value of the header field FIELD-NAME.
-The buffer is expected to be narrowed to just the headers of the message.
-If second arg LAST is non-nil, use the last such field if there are several.
+  "Return the value of the header field whose type is FIELD-NAME.
+The buffer is expected to be narrowed to just the header of the message.
+If second arg LAST is non-nil, use the last field of type FIELD-NAME.
 If third arg ALL is non-nil, concatenate all such fields with commas between.
 If 4th arg LIST is non-nil, return a list of all such fields."
   (save-excursion
@@ -258,16 +306,16 @@ If 4th arg LIST is non-nil, return a list of all such fields."
 (defun mail-parse-comma-list ()
   (let (accumulated
        beg)
-    (skip-chars-forward " ")
+    (skip-chars-forward " \t\n")
     (while (not (eobp))
       (setq beg (point))
       (skip-chars-forward "^,")
-      (skip-chars-backward " ")
+      (skip-chars-backward " \t\n")
       (setq accumulated
-           (cons (buffer-substring beg (point))
+           (cons (buffer-substring-no-properties beg (point))
                  accumulated))
       (skip-chars-forward "^,")
-      (skip-chars-forward ", "))
+      (skip-chars-forward ", \t\n"))
     accumulated))
 
 (defun mail-comma-list-regexp (labels)