hrp@snoid.cray.com (Hal Peterson) (12/04/88)
Gnu Emacs version 18.52 doesn't handle nested objects in mail
headers---e.g, nested comments or nested parens. The following diffs
patch rmail.el and mail-utils.el to handle nesting correctly.
--
Hal Peterson / Cray Research / 1440 Northland Dr. / Mendota Hts, MN 55120
hrp@cray.com bungia!cray!hrp (612) 681-3145
============================================================
*** mail-utils.el-dist Thu Jun 23 15:50:59 1988
--- mail-utils.el Thu Jun 23 16:24:49 1988
***************
*** 49,62 ****
(string-match "[ \t\n]*\\'" address
(match-end 0))))
;; strip rfc822 comments
! (while (setq pos (string-match
! ;; This doesn't hack rfc822 nested comments
! ;; `(xyzzy (foo) whinge)' properly. Big deal.
! "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
! address))
! (setq address
! (mail-string-delete address
! pos (match-end 0))))
;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
(setq pos 0)
(while (setq pos (string-match
--- 49,55 ----
(string-match "[ \t\n]*\\'" address
(match-end 0))))
;; strip rfc822 comments
! (setq address (mail-strip-rfc822-comments address))
;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
(setq pos 0)
(while (setq pos (string-match
***************
*** 78,83 ****
--- 71,104 ----
(setq address (mail-string-delete address (1- close) close))
(setq address (mail-string-delete address junk-beg junk-end))))
address)))
+
+ (defun mail-strip-rfc822-comments (address)
+ "Remove RFC822 (parenthesized) comments from the string ADDRESS."
+ (let ((position 0) (depth 0) (end (length address)) deletions start)
+ (while (< position end)
+ (cond ((= (aref address position) ?\()
+ (if (= depth 0)
+ (setq start position))
+ (setq depth (1+ depth)))
+ ((= (aref address position) ?\))
+ (if (< depth 1)
+ (error
+ "extra close parenthesis in mail address \"%s\" at %d"
+ address position))
+ (setq depth (1- depth))
+ (if (= depth 0)
+ (setq deletions (cons (list start
+ position)
+ deletions)))))
+ (setq position (1+ position)))
+ (if (> depth 0)
+ (error "extra open parenthesis in mail address \"%s\"" address))
+ (while deletions
+ (setq address (mail-string-delete address
+ (car (car deletions))
+ (1+ (car (cdr (car deletions)))))
+ deletions (cdr deletions))))
+ address)
(or (and (boundp 'rmail-default-dont-reply-to-names)
(not (null rmail-default-dont-reply-to-names)))
*** rmail.el-dist Fri Jul 1 17:37:07 1988
--- rmail.el Fri Jul 1 18:00:08 1988
***************
*** 1244,1253 ****
;; Compute the sender for the in-reply-to; prefer full name.
(let* ((stop-pos (string-match " *at \\| *@ \\| *<" from))
(start-pos (if stop-pos 0
! ;;>> this loses on nested ()'s
! (let ((pos (string-match " *(" from)))
! (if (not pos) nil
! (setq stop-pos (string-match ")" from pos))
(if (zerop pos) 0 (+ 2 pos)))))))
(setq field (if stop-pos
(substring from start-pos stop-pos)
--- 1244,1259 ----
;; Compute the sender for the in-reply-to; prefer full name.
(let* ((stop-pos (string-match " *at \\| *@ \\| *<" from))
(start-pos (if stop-pos 0
! (let ((pos (string-match " *(" from)) (level 1))
! (if (not pos)
! nil
! (setq stop-pos (1- (match-end 0)))
! (while (> level 0)
! (setq stop-pos (1+ stop-pos))
! (cond ((= (aref from stop-pos) ?\()
! (setq level (1+ level)))
! ((= (aref from stop-pos) ?\))
! (setq level (1- level)))))
(if (zerop pos) 0 (+ 2 pos)))))))
(setq field (if stop-pos
(substring from start-pos stop-pos)