X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab6f89780a01ad996693c42c2cf9ad3d5c3665e9..6e66e4c6fc350fe8cb85d4cc35d9ca567df56548:/lisp/mail/mail-utils.el diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index c234411ac8..f540951206 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -34,10 +34,12 @@ (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" ') (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 ? + "\\([^,\n]*[!<]\\|\\)" + "\\(" + rmail-dont-reply-to-names + "\\|" + ;; Include the human name that precedes . + "\\([^\,.<\"]\\|\"[^\"]*\"\\)*" + "<\\(" 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." ;;;###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)