Mercurial > emacs
comparison lisp/mail/mail-utils.el @ 112212:966cc18ff805
* lisp/mail/mail-utils.el (mail-strip-quoted-names): Make the regexp code
work for nested comments.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 13 Jan 2011 16:48:34 -0500 |
| parents | 40af77a50adc |
| children |
comparison
equal
deleted
inserted
replaced
| 112211:7e39a17684f8 | 112212:966cc18ff805 |
|---|---|
| 180 (if mail-use-rfc822 | 180 (if mail-use-rfc822 |
| 181 (progn (require 'rfc822) | 181 (progn (require 'rfc822) |
| 182 (mapconcat 'identity (rfc822-addresses address) ", ")) | 182 (mapconcat 'identity (rfc822-addresses address) ", ")) |
| 183 (let (pos) | 183 (let (pos) |
| 184 | 184 |
| 185 ;; Detect nested comments. | 185 ;; Strip comments. |
| 186 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) | 186 (while (setq pos (string-match |
| 187 ;; Strip nested comments. | 187 "[ \t]*(\\([^()\\]\\|\\\\.\\|\\\\\n\\)*)" |
| 188 (with-temp-buffer | 188 address)) |
| 189 (insert address) | 189 (setq address (replace-match "" nil nil address 0))) |
| 190 (set-syntax-table lisp-mode-syntax-table) | 190 |
| 191 (goto-char 1) | 191 ;; strip surrounding whitespace |
| 192 (while (search-forward "(" nil t) | 192 (string-match "\\`[ \t\n]*" address) |
| 193 (forward-char -1) | 193 (setq address (substring address |
| 194 (skip-chars-backward " \t") | 194 (match-end 0) |
| 195 (delete-region (point) | 195 (string-match "[ \t\n]*\\'" address |
| 196 (save-excursion | 196 (match-end 0)))) |
| 197 (condition-case () | 197 |
| 198 (forward-sexp 1) | 198 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
| 199 (error (goto-char (point-max)))) | 199 (setq pos 0) |
| 200 (point)))) | 200 (while (setq pos (string-match |
| 201 (setq address (buffer-string))) | |
| 202 ;; Strip non-nested comments an easier way. | |
| 203 (while (setq pos (string-match | |
| 204 ;; This doesn't hack rfc822 nested comments | |
| 205 ;; `(xyzzy (foo) whinge)' properly. Big deal. | |
| 206 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" | |
| 207 address)) | |
| 208 (setq address (replace-match "" nil nil address 0)))) | |
| 209 | |
| 210 ;; strip surrounding whitespace | |
| 211 (string-match "\\`[ \t\n]*" address) | |
| 212 (setq address (substring address | |
| 213 (match-end 0) | |
| 214 (string-match "[ \t\n]*\\'" address | |
| 215 (match-end 0)))) | |
| 216 | |
| 217 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') | |
| 218 (setq pos 0) | |
| 219 (while (setq pos (string-match | |
| 220 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" | 201 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" |
| 221 address pos)) | 202 address pos)) |
| 222 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | 203 ;; If the next thing is "@", we have "foo bar"@host. Leave it. |
| 223 (if (and (> (length address) (match-end 0)) | 204 (if (and (> (length address) (match-end 0)) |
| 224 (= (aref address (match-end 0)) ?@)) | 205 (= (aref address (match-end 0)) ?@)) |
| 225 (setq pos (match-end 0)) | 206 (setq pos (match-end 0)) |
| 226 ;; Otherwise discard the "..." part. | 207 ;; Otherwise discard the "..." part. |
| 227 (setq address (replace-match "" nil nil address 2)))) | 208 (setq address (replace-match "" nil nil address 2)))) |
| 228 ;; If this address contains <...>, replace it with just | 209 ;; If this address contains <...>, replace it with just |
| 229 ;; the part between the <...>. | 210 ;; the part between the <...>. |
| 230 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" | 211 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" |
| 231 address)) | 212 address)) |
| 232 (setq address (replace-match (match-string 3 address) | 213 (setq address (replace-match (match-string 3 address) |
| 233 nil 'literal address 2))) | 214 nil 'literal address 2))) |
| 234 address)))) | 215 address)))) |
| 235 | 216 |
| 236 ;; The following piece of ugliness is legacy code. The name was an | 217 ;; The following piece of ugliness is legacy code. The name was an |
| 237 ;; unfortunate choice --- a flagrant violation of the Emacs Lisp | 218 ;; unfortunate choice --- a flagrant violation of the Emacs Lisp |
| 238 ;; coding conventions. `mail-dont-reply-to' would have been | 219 ;; coding conventions. `mail-dont-reply-to' would have been |
| 239 ;; infinitely better. Also, `rmail-dont-reply-to-names' might have | 220 ;; infinitely better. Also, `rmail-dont-reply-to-names' might have |