X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b578f267af27af50e3c091f8c9c9eee939b69978..7c7d40755ab10f374dd656e9f0e5f2a158ae9edb:/lisp/mail/rfc822.el diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el index 4204d2175a..1a5dfad67f 100644 --- a/lisp/mail/rfc822.el +++ b/lisp/mail/rfc822.el @@ -26,15 +26,17 @@ ;;; Commentary: ;; Support functions for parsing RFC-822 headers, used by mail and news -;; modes. +;; modes. ;;; Code: -;; uses address-start free, throws to address +(defvar rfc822-address-start) + +;; uses rfc822-address-start free, throws to address (defun rfc822-bad-address (reason) (save-restriction (insert "_^_") - (narrow-to-region address-start + (narrow-to-region rfc822-address-start (if (re-search-forward "[,;]" nil t) (max (point-min) (1- (point))) (point-max))) @@ -49,10 +51,10 @@ (setq losers (cdr losers)))) (goto-char (point-min)) (insert "(Unparsable address -- " reason - ":\n\t \"") + ": \"") (goto-char (point-max)) (insert "\")")) (rfc822-nuke-whitespace) - (throw 'address (buffer-substring address-start (point)))) + (throw 'address (buffer-substring rfc822-address-start (point)))) (defun rfc822-nuke-whitespace (&optional leave-space) (let (ch) @@ -75,7 +77,7 @@ (forward-char -1) (delete-char 2) t) - ((memq ch '(?\ ?\t ?\n)) + ((memq ch '(?\ ?\t ?\n)) (delete-region (point) (progn (skip-chars-forward " \t\n") (point))) t) @@ -99,7 +101,7 @@ t)))) (let ((tem (match-data))) (rfc822-nuke-whitespace leave-space) - (store-match-data tem) + (set-match-data tem) t))) (defun rfc822-snarf-word () @@ -108,7 +110,7 @@ ;; quoted-string (or (rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"") (rfc822-bad-address "Unterminated quoted string"))) - ((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+") + ((rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\".]+") ;; atom ) (t @@ -125,7 +127,7 @@ ;; domain-ref (or (rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]") (rfc822-bad-address "Unterminated domain literal [...]"))) - ((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+") + ((rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\".]+") ;; domain-literal = atom ) (t @@ -179,7 +181,7 @@ ;; domain-literal is "[" *(dtext | quoted-pair) "]" ;; dtext is "[^][\\n" ;; domain-ref is atom - (let ((address-start (point)) + (let ((rfc822-address-start (point)) (n 0)) (catch 'address ;; optimize common cases: @@ -190,7 +192,7 @@ ;; foo bar ;; "foo bar" ;; those aren't hacked yet. - (if (and (rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\(\\|@[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\)" t) + (if (and (rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\"]+\\(\\|@[^][\000-\037 ()<>@,;:\\\"]+\\)" t) (progn (or (eobp) (rfc822-looking-at ?,)))) (progn @@ -198,14 +200,14 @@ (or (bobp) (/= (preceding-char) ?\ ) (delete-char -1)) ;; relying on the fact that rfc822-looking-at ;; doesn't mung match-data - (throw 'address (buffer-substring address-start (match-end 0))))) - (goto-char address-start) + (throw 'address (buffer-substring rfc822-address-start (match-end 0))))) + (goto-char rfc822-address-start) (while t (cond ((and (= n 1) (rfc822-looking-at ?@)) ;; local-part@domain (rfc822-snarf-domain) (throw 'address - (buffer-substring address-start (point)))) + (buffer-substring rfc822-address-start (point)))) ((rfc822-looking-at ?:) (cond ((not allow-groups) (rfc822-bad-address "A group name may not appear here")) @@ -244,7 +246,7 @@ (buffer-substring (if strip start (1- start)) (if strip end (1+ end)))) (rfc822-bad-address "Unterminated <...> address"))))) - ((looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]") + ((looking-at "[^][\000-\037 ()<>@,;:\\.]") ;; this allows "." to be part of the words preceding ;; an addr-spec, since many broken mailers output ;; "Hern K. Herklemeyer III @@ -256,12 +258,12 @@ (rfc822-snarf-words) (setq n (1+ n)) (setq again (or (rfc822-looking-at ?.) - (looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]")))))) + (looking-at "[^][\000-\037 ()<>@,;:\\.]")))))) ((= n 0) (throw 'address nil)) ((= n 1) ; allow "foo" (losing unix seems to do this) (throw 'address - (buffer-substring address-start (point)))) + (buffer-substring rfc822-address-start (point)))) ((> n 1) (rfc822-bad-address "Missing comma between addresses or badly-formatted address")) ((or (eobp) (= (following-char) ?,)) @@ -269,9 +271,9 @@ (t (rfc822-bad-address "Strange character or missing comma"))))))) - + (defun rfc822-addresses (header-text) - (if (string-match "\\`[ \t]*\\([^][\000-\037\177-\377 ()<>@,;:\\\".]+\\)[ \t]*\\'" + (if (string-match "\\`[ \t]*\\([^][\000-\037 ()<>@,;:\\\".]+\\)[ \t]*\\'" header-text) ;; Make very simple case moderately fast. (list (substring header-text (match-beginning 1) (match-end 1))) @@ -289,17 +291,17 @@ (replace-match "\\1 " t)) (goto-char (point-min)) - (rfc822-nuke-whitespace) (let ((list ()) tem - address-start); this is for rfc822-bad-address + rfc822-address-start); this is for rfc822-bad-address + (rfc822-nuke-whitespace) (while (not (eobp)) - (setq address-start (point)) + (setq rfc822-address-start (point)) (setq tem (catch 'address ; this is for rfc822-bad-address (cond ((rfc822-looking-at ?\,) nil) - ((looking-at "[][\000-\037\177-\377@;:\\.>)]") + ((looking-at "[][\000-\037@;:\\.>)]") (forward-char) (rfc822-bad-address (format "Strange character \\%c found" @@ -316,4 +318,5 @@ (provide 'rfc822) +;;; arch-tag: 5d388a24-e173-40fb-9b8e-85269de44b37 ;;; rfc822.el ends here