Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 107357:0f6a30c8d91a
Additional fix for rfc822-addresses (Bug#5692).
* mail/rfc822.el (rfc822-addresses): Use nested catches to ensure
that all errors are caught, and that the return value is always a
list (Bug#5692).
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 08 Mar 2010 11:17:30 -0500 |
parents | da4ec7ca387c |
children | 9246a8f688c5 |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; mail-utils.el --- utility functions used both by rmail and rnews |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
101696 | 3 ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
106815 | 4 ;; 2009, 2010 Free Software Foundation, Inc. |
845 | 5 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
6 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
7 ;; Keywords: mail, news |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
8 |
36 | 9 ;; This file is part of GNU Emacs. |
10 | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
36 | 12 ;; it under the terms of the GNU General Public License as published by |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
36 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
36 | 23 |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
24 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
25 |
5365 | 26 ;; Utility functions for mail and netnews handling. These handle fine |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
27 ;; points of header parsing. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
28 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
29 ;;; Code: |
36 | 30 |
285 | 31 ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has |
32 ;;; been initialized. | |
33 (require 'lisp-mode) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
34 |
268 | 35 ;;;###autoload |
101919
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
36 (defcustom mail-use-rfc822 nil |
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
37 "If non-nil, use a full, hairy RFC822 parser on mail addresses. |
268 | 38 Otherwise, (the default) use a smaller, somewhat faster, and |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
39 often correct parser." |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
40 :type 'boolean |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
41 :group 'mail) |
36 | 42 |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
43 ;; Returns t if file FILE is an Rmail file. |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
44 ;;;###autoload |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
45 (defun mail-file-babyl-p (file) |
101919
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
46 "Return non-nil if FILE is a Babyl file." |
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
47 (with-temp-buffer |
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
48 (insert-file-contents file nil 0 100) |
fbf831e1e7b0
(mail-use-rfc822): Remove * from defcustom doc.
Glenn Morris <rgm@gnu.org>
parents:
101786
diff
changeset
|
49 (looking-at "BABYL OPTIONS:"))) |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
50 |
36 | 51 (defun mail-string-delete (string start end) |
52 "Returns a string containing all of STRING except the part | |
53 from START (inclusive) to END (exclusive)." | |
54 (if (null end) (substring string 0 start) | |
55 (concat (substring string 0 start) | |
56 (substring string end nil)))) | |
57 | |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
58 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
59 (defun mail-quote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
60 "Convert a string to the \"quoted printable\" Q encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
61 If the optional argument WRAPPER is non-nil, |
17506 | 62 we add the wrapper characters =?ISO-8859-1?Q?....?=." |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
63 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
64 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
65 (while (string-match "[?=\"\200-\377]" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
66 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
67 (concat result (substring string i (match-beginning 0)) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
68 (upcase (format "=%02x" |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
69 (aref string (match-beginning 0)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
70 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
71 (if wrapper |
17506 | 72 (concat "=?ISO-8859-1?Q?" |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
73 result (substring string i) |
17506 | 74 "?=") |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
75 (concat result (substring string i)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
76 |
101102
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
77 ;;;###autoload |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
78 (defun mail-quote-printable-region (beg end &optional wrapper) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
79 "Convert the region to the \"quoted printable\" Q encoding. |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
80 If the optional argument WRAPPER is non-nil, |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
81 we add the wrapper characters =?ISO-8859-1?Q?....?=." |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
82 (interactive "r\nP") |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
83 (save-match-data |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
84 (save-excursion |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
85 (goto-char beg) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
86 (save-restriction |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
87 (narrow-to-region beg end) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
88 (while (re-search-forward "[?=\"\200-\377]" nil t) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
89 (replace-match (upcase (format "=%02x" (preceding-char))) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
90 t t)) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
91 (when wrapper |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
92 (goto-char beg) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
93 (insert "=?ISO-8859-1?Q?") |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
94 (goto-char end) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
95 (insert "?=")))))) |
e65de16571ff
(mail-quote-printable-region): New function.
Richard M. Stallman <rms@gnu.org>
parents:
100908
diff
changeset
|
96 |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
97 (defun mail-unquote-printable-hexdigit (char) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
98 (setq char (upcase char)) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
99 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
100 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
101 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
102 |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
103 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
104 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
105 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
106 If the optional argument WRAPPER is non-nil, |
17506 | 107 we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=." |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
108 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
109 (and wrapper |
17506 | 110 (string-match "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?" string) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
111 (setq string (match-string 1 string))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
112 (let ((i 0) strings) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
113 (while (string-match "=\\(..\\|\n\\)" string i) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
114 (setq strings (cons (substring string i (match-beginning 0)) strings)) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
115 (unless (= (aref string (match-beginning 1)) ?\n) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
116 (setq strings |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
117 (cons (make-string 1 |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
118 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
119 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
120 (mail-unquote-printable-hexdigit |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
121 (aref string (1+ (match-beginning 1)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
122 strings))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
123 (setq i (match-end 0))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
124 (apply 'concat (nreverse (cons (substring string i) strings)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
125 |
107080
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
126 ;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el. |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
127 ;;;###autoload |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
128 (defun mail-unquote-printable-region (beg end &optional wrapper noerror |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
129 unibyte) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
130 "Undo the \"quoted printable\" encoding in buffer from BEG to END. |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
131 If the optional argument WRAPPER is non-nil, |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
132 we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=. |
107080
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
133 On encountering malformed quoted-printable text, exits with an error, |
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
134 unless NOERROR is non-nil, in which case it continues, and returns nil |
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
135 when finished. Returns non-nil on successful completion. |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
136 If UNIBYTE is non-nil, insert converted characters as unibyte. |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
137 That is useful if you are going to character code decoding afterward, |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
138 as Rmail does." |
106953
a1e356d208cd
* mail/rmailmm.el (rmail-mime-handle): Don't set the buffer to unibyte
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
139 ;; FIXME: `unibyte' should always be non-nil, and the iso-latin-1 |
a1e356d208cd
* mail/rmailmm.el (rmail-mime-handle): Don't set the buffer to unibyte
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
140 ;; specific handling should be removed (or moved elsewhere and generalized). |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
141 (interactive "r\nP") |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
142 (let (failed) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
143 (save-match-data |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
144 (save-excursion |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
145 (save-restriction |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
146 (narrow-to-region beg end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
147 (goto-char (point-min)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
148 (when (and wrapper |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
149 (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
150 (delete-region (match-end 1) end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
151 (delete-region (point) (match-beginning 1))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
152 (while (re-search-forward "=\\(\\([0-9A-F][0-9A-F]\\)\\|[=\n]\\|..\\)" nil t) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
153 (goto-char (match-end 0)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
154 (cond ((= (char-after (match-beginning 1)) ?\n) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
155 (replace-match "")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
156 ((= (char-after (match-beginning 1)) ?=) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
157 (replace-match "=")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
158 ((match-beginning 2) |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
159 (let ((char (+ (* 16 (mail-unquote-printable-hexdigit |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
160 (char-after (match-beginning 2)))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
161 (mail-unquote-printable-hexdigit |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
162 (char-after (1+ (match-beginning 2))))))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
163 (if unibyte |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
164 (progn |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
165 (replace-match "") |
98411
c5fb918370c8
(mail-unquote-printable-region): Use insert-byte instead of insert-char,
Eli Zaretskii <eliz@gnu.org>
parents:
94674
diff
changeset
|
166 ;; insert-byte will insert this as a |
c5fb918370c8
(mail-unquote-printable-region): Use insert-byte instead of insert-char,
Eli Zaretskii <eliz@gnu.org>
parents:
94674
diff
changeset
|
167 ;; corresponding eight-bit character. |
c5fb918370c8
(mail-unquote-printable-region): Use insert-byte instead of insert-char,
Eli Zaretskii <eliz@gnu.org>
parents:
94674
diff
changeset
|
168 (insert-byte char 1)) |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
169 (replace-match (make-string 1 char) t t)))) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
170 (noerror |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
171 (setq failed t)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
172 (t |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
173 (error "Malformed MIME quoted-printable message")))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
174 (not failed)))))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
175 |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
176 (eval-when-compile (require 'rfc822)) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
177 |
36 | 178 (defun mail-strip-quoted-names (address) |
179 "Delete comments and quoted strings in an address list ADDRESS. | |
180 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
181 Return a modified address list." | |
477 | 182 (if (null address) |
183 nil | |
184 (if mail-use-rfc822 | |
185 (progn (require 'rfc822) | |
186 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
187 (let (pos) | |
36 | 188 |
477 | 189 ;; Detect nested comments. |
15439
b549210f6989
(mail-strip-quoted-names): `"' is not special inside an RFC 822 comment.
Richard M. Stallman <rms@gnu.org>
parents:
14989
diff
changeset
|
190 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 191 ;; Strip nested comments. |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
192 (with-current-buffer (get-buffer-create " *temp*") |
477 | 193 (erase-buffer) |
194 (insert address) | |
195 (set-syntax-table lisp-mode-syntax-table) | |
196 (goto-char 1) | |
197 (while (search-forward "(" nil t) | |
198 (forward-char -1) | |
199 (skip-chars-backward " \t") | |
200 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
201 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
202 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
203 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
204 (error (goto-char (point-max)))) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
205 (point)))) |
477 | 206 (setq address (buffer-string)) |
207 (erase-buffer)) | |
208 ;; Strip non-nested comments an easier way. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
209 (while (setq pos (string-match |
477 | 210 ;; This doesn't hack rfc822 nested comments |
211 ;; `(xyzzy (foo) whinge)' properly. Big deal. | |
15439
b549210f6989
(mail-strip-quoted-names): `"' is not special inside an RFC 822 comment.
Richard M. Stallman <rms@gnu.org>
parents:
14989
diff
changeset
|
212 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 213 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
214 (setq address (replace-match "" nil nil address 0)))) |
36 | 215 |
22002
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
216 ;; strip surrounding whitespace |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
217 (string-match "\\`[ \t\n]*" address) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
218 (setq address (substring address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
219 (match-end 0) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
220 (string-match "[ \t\n]*\\'" address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
221 (match-end 0)))) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
222 |
477 | 223 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
224 (setq pos 0) | |
225 (while (setq pos (string-match | |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
226 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" |
477 | 227 address pos)) |
228 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
229 (if (and (> (length address) (match-end 0)) | |
230 (= (aref address (match-end 0)) ?@)) | |
231 (setq pos (match-end 0)) | |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
232 ;; Otherwise discard the "..." part. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
233 (setq address (replace-match "" nil nil address 2)))) |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
234 ;; If this address contains <...>, replace it with just |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
235 ;; the part between the <...>. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
236 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" |
477 | 237 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
238 (setq address (replace-match (match-string 3 address) |
38597
16d2187c5524
(mail-strip-quoted-names): Replace text
Gerd Moellmann <gerd@gnu.org>
parents:
31880
diff
changeset
|
239 nil 'literal address 2))) |
477 | 240 address)))) |
36 | 241 |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
242 ;;; The following piece of ugliness is legacy code. The name was an |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
243 ;;; unfortunate choice --- a flagrant violation of the Emacs Lisp |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
244 ;;; coding conventions. `mail-dont-reply-to' would have been |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
245 ;;; infinitely better. Also, `rmail-dont-reply-to-names' might have |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
246 ;;; been better named `mail-dont-reply-to-names' and sourced from this |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
247 ;;; file instead of in rmail.el. Yuck. -pmr |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
248 (defun rmail-dont-reply-to (destinations) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
249 "Prune addresses from DESTINATIONS, a list of recipient addresses. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
250 All addresses matching `rmail-dont-reply-to-names' are removed from |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
251 the comma-separated list. The pruned list is returned." |
107080
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
252 ;; FIXME this (setting a user option the first time a command is used) |
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
253 ;; is somewhat strange. Normally one would never set the option, |
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
254 ;; but instead fall back to the default so long as it was nil. |
da4ec7ca387c
* mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
106953
diff
changeset
|
255 ;; Or just set the default directly in the defcustom. |
36 | 256 (if (null rmail-dont-reply-to-names) |
257 (setq rmail-dont-reply-to-names | |
258 (concat (if rmail-default-dont-reply-to-names | |
259 (concat rmail-default-dont-reply-to-names "\\|") | |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
260 "") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
261 (if (and user-mail-address |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
262 (not (equal user-mail-address user-login-name))) |
53968
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
263 ;; Anchor the login name and email address so |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
264 ;; that we don't match substrings: if the |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
265 ;; login name is "foo", we shouldn't match |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
266 ;; "barfoo@baz.com". |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
267 (concat "\\`" |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
268 (regexp-quote user-mail-address) |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
269 "\\'\\|") |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
270 "") |
53968
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
271 (concat "\\`" (regexp-quote user-login-name) "@")))) |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
272 ;; Split up DESTINATIONS and match each element separately. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
273 (let ((start-pos 0) (cur-pos 0) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
274 (case-fold-search t)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
275 (while start-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
276 (setq cur-pos (string-match "[,\"]" destinations cur-pos)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
277 (if (and cur-pos (equal (match-string 0 destinations) "\"")) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
278 ;; Search for matching quote. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
279 (let ((next-pos (string-match "\"" destinations (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
280 (if next-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
281 (setq cur-pos (1+ next-pos)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
282 ;; If the open-quote has no close-quote, |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
283 ;; delete the open-quote to get something well-defined. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
284 ;; This case is not valid, but it can happen if things |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
285 ;; are weird elsewhere. |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
286 (setq destinations (concat (substring destinations 0 cur-pos) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
287 (substring destinations (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
288 (setq cur-pos start-pos))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
289 (let* ((address (substring destinations start-pos cur-pos)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
290 (naked-address (mail-strip-quoted-names address))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
291 (if (string-match rmail-dont-reply-to-names naked-address) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
292 (setq destinations (concat (substring destinations 0 start-pos) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
293 (and cur-pos (substring destinations |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
294 (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
295 cur-pos start-pos) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
296 (setq cur-pos (and cur-pos (1+ cur-pos)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
297 start-pos cur-pos)))))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
298 ;; get rid of any trailing commas |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
299 (let ((pos (string-match "[ ,\t\n]*\\'" destinations))) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
300 (if pos |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
301 (setq destinations (substring destinations 0 pos)))) |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
302 ;; remove leading spaces. they bother me. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
303 (if (string-match "\\(\\s \\|,\\)*" destinations) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
304 (substring destinations (match-end 0)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
305 destinations)) |
27460
cccffb3304b3
(rmail-dont-reply-to): Replace matched
Gerd Moellmann <gerd@gnu.org>
parents:
25271
diff
changeset
|
306 |
36 | 307 |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
308 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
309 (defun mail-fetch-field (field-name &optional last all list) |
22949
3f75d6c8ef33
(mail-fetch-field): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
22710
diff
changeset
|
310 "Return the value of the header field whose type is FIELD-NAME. |
3f75d6c8ef33
(mail-fetch-field): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
22710
diff
changeset
|
311 If second arg LAST is non-nil, use the last field of type FIELD-NAME. |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
312 If third arg ALL is non-nil, concatenate all such fields with commas between. |
101696 | 313 If 4th arg LIST is non-nil, return a list of all such fields. |
101786
e3ef741fe489
(mail-fetch-field): Previous doc fix was ill-advised.
Glenn Morris <rgm@gnu.org>
parents:
101696
diff
changeset
|
314 The buffer should be narrowed to just the header, else false |
e3ef741fe489
(mail-fetch-field): Previous doc fix was ill-advised.
Glenn Morris <rgm@gnu.org>
parents:
101696
diff
changeset
|
315 matches may be returned from the message body." |
36 | 316 (save-excursion |
317 (goto-char (point-min)) | |
318 (let ((case-fold-search t) | |
319 (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*"))) | |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
320 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
321 (let ((value (if all ""))) |
36 | 322 (while (re-search-forward name nil t) |
323 (let ((opoint (point))) | |
324 (while (progn (forward-line 1) | |
325 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
326 ;; Back up over newline, then trailing spaces or tabs |
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
327 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
328 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
329 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
330 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
331 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
332 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
333 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
334 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
335 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
336 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
337 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
338 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
339 (and (not (string= value "")) value))) |
36 | 340 (if (re-search-forward name nil t) |
341 (progn | |
342 (if last (while (re-search-forward name nil t))) | |
343 (let ((opoint (point))) | |
344 (while (progn (forward-line 1) | |
345 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
346 ;; Back up over newline, then trailing spaces or tabs |
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
347 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
348 (skip-chars-backward " \t" opoint) |
12613
1243b1f01079
(mail-fetch-field): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
5914
diff
changeset
|
349 (buffer-substring-no-properties opoint (point))))))))) |
36 | 350 |
351 ;; Parse a list of tokens separated by commas. | |
352 ;; It runs from point to the end of the visible part of the buffer. | |
353 ;; Whitespace before or after tokens is ignored, | |
354 ;; but whitespace within tokens is kept. | |
355 (defun mail-parse-comma-list () | |
356 (let (accumulated | |
357 beg) | |
20409 | 358 (skip-chars-forward " \t\n") |
36 | 359 (while (not (eobp)) |
360 (setq beg (point)) | |
361 (skip-chars-forward "^,") | |
20409 | 362 (skip-chars-backward " \t\n") |
36 | 363 (setq accumulated |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
364 (cons (buffer-substring-no-properties beg (point)) |
36 | 365 accumulated)) |
366 (skip-chars-forward "^,") | |
20409 | 367 (skip-chars-forward ", \t\n")) |
36 | 368 accumulated)) |
369 | |
370 (defun mail-comma-list-regexp (labels) | |
371 (let (pos) | |
372 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
373 ;; Remove leading and trailing whitespace. | |
374 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
375 ;; Change each comma to \|, and flush surrounding whitespace. | |
376 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
377 (setq labels | |
378 (concat (substring labels 0 pos) | |
379 "\\|" | |
380 (substring labels (match-end 0)))))) | |
381 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
382 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
383 (defun mail-rfc822-time-zone (time) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
384 (let* ((sec (or (car (current-time-zone time)) 0)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
385 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
386 (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
387 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
388 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
389 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
390 (s (current-time-string time))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
391 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
392 (concat (substring s (match-beginning 2) (match-end 2)) " " |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
393 (substring s (match-beginning 1) (match-end 1)) " " |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
394 (substring s (match-beginning 4) (match-end 4)) " " |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
395 (substring s (match-beginning 3) (match-end 3)) " " |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
396 (mail-rfc822-time-zone time)))) |
584 | 397 |
102091
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
398 (defun mail-mbox-from () |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
399 "Return an mbox \"From \" line for the current message. |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
400 The buffer should be narrowed to just the header." |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
401 (let ((from (or (mail-fetch-field "from") |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
402 (mail-fetch-field "really-from") |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
403 (mail-fetch-field "sender") |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
404 "unknown")) |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
405 (date (mail-fetch-field "date"))) |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
406 (format "From %s %s\n" (mail-strip-quoted-names from) |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
407 (or (and date |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
408 (ignore-errors |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
409 (current-time-string (date-to-time date)))) |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
410 (current-time-string))))) |
dd4853d4b1e2
(mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents:
101919
diff
changeset
|
411 |
584 | 412 (provide 'mail-utils) |
413 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79712
diff
changeset
|
414 ;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
415 ;;; mail-utils.el ends here |