Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 23432:5f51adf0b6ec
(ccl-compile-if): If there's no false-cmds,
set unconditional-jump to nil.
(ccl-compile-read-multibyte-character): Return nil.
(ccl-compile-write-multibyte-character): Likewise.
(ccl-compile-translate-character): Likewise
(ccl-compile-map-multiple): Likewise.
(ccl-compile-map-single): Likewise.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 12 Oct 1998 12:00:44 +0000 |
parents | 3f75d6c8ef33 |
children | 0d9fd0e4f7a3 |
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 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: mail, news |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
7 |
36 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 13 ;; any later version. |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
14169 | 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
36 | 24 |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
25 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
26 |
5365 | 27 ;; 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
|
28 ;; points of header parsing. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
29 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
30 ;;; Code: |
36 | 31 |
285 | 32 ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has |
33 ;;; been initialized. | |
34 (require 'lisp-mode) | |
36 | 35 |
268 | 36 ;;;###autoload |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
37 (defcustom mail-use-rfc822 nil "\ |
268 | 38 *If non-nil, use a full, hairy RFC822 parser on mail addresses. |
39 Otherwise, (the default) use a smaller, somewhat faster, and | |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
40 often correct parser." |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
41 :type 'boolean |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
42 :group 'mail) |
36 | 43 |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
44 ;; 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
|
45 ;;;###autoload |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
46 (defun mail-file-babyl-p (file) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
47 (let ((buf (generate-new-buffer " *rmail-file-p*"))) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
48 (unwind-protect |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
49 (save-excursion |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
50 (set-buffer buf) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
51 (insert-file-contents file nil 0 100) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
52 (looking-at "BABYL OPTIONS:")) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
53 (kill-buffer buf)))) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
54 |
36 | 55 (defun mail-string-delete (string start end) |
56 "Returns a string containing all of STRING except the part | |
57 from START (inclusive) to END (exclusive)." | |
58 (if (null end) (substring string 0 start) | |
59 (concat (substring string 0 start) | |
60 (substring string end nil)))) | |
61 | |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
62 (defun mail-quote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
63 "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
|
64 If the optional argument WRAPPER is non-nil, |
17506 | 65 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
|
66 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
67 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
68 (while (string-match "[?=\"\200-\377]" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
69 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
70 (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
|
71 (upcase (format "=%02x" |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
72 (aref string (match-beginning 0)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
73 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
74 (if wrapper |
17506 | 75 (concat "=?ISO-8859-1?Q?" |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
76 result (substring string i) |
17506 | 77 "?=") |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
78 (concat result (substring string i)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
79 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
80 (defun mail-unquote-printable-hexdigit (char) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
81 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
82 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
83 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
84 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
85 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
86 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
87 If the optional argument WRAPPER is non-nil, |
17506 | 88 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
|
89 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
90 (and wrapper |
17506 | 91 (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
|
92 (setq string (match-string 1 string))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
93 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
94 (while (string-match "=\\(..\\)" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
95 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
96 (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
|
97 (make-string 1 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
98 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
99 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
100 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
101 (aref string (1+ (match-beginning 1)))))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
102 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
103 (concat result (substring string i))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
104 |
36 | 105 (defun mail-strip-quoted-names (address) |
106 "Delete comments and quoted strings in an address list ADDRESS. | |
107 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
108 Return a modified address list." | |
477 | 109 (if (null address) |
110 nil | |
111 (if mail-use-rfc822 | |
112 (progn (require 'rfc822) | |
113 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
114 (let (pos) | |
36 | 115 |
477 | 116 ;; 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
|
117 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 118 ;; Strip nested comments. |
119 (save-excursion | |
120 (set-buffer (get-buffer-create " *temp*")) | |
121 (erase-buffer) | |
122 (insert address) | |
123 (set-syntax-table lisp-mode-syntax-table) | |
124 (goto-char 1) | |
125 (while (search-forward "(" nil t) | |
126 (forward-char -1) | |
127 (skip-chars-backward " \t") | |
128 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
129 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
130 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
131 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
132 (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
|
133 (point)))) |
477 | 134 (setq address (buffer-string)) |
135 (erase-buffer)) | |
136 ;; Strip non-nested comments an easier way. | |
137 (while (setq pos (string-match | |
138 ;; This doesn't hack rfc822 nested comments | |
139 ;; `(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
|
140 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 141 address)) |
142 (setq address | |
143 (mail-string-delete address | |
144 pos (match-end 0))))) | |
36 | 145 |
22002
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
146 ;; strip surrounding whitespace |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
147 (string-match "\\`[ \t\n]*" address) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
148 (setq address (substring address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
149 (match-end 0) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
150 (string-match "[ \t\n]*\\'" address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
151 (match-end 0)))) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
152 |
477 | 153 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
154 (setq pos 0) | |
155 (while (setq pos (string-match | |
19563
fd3807f45b7b
(mail-strip-quoted-names): Retain one whitespace
Richard M. Stallman <rms@gnu.org>
parents:
18204
diff
changeset
|
156 "\\([ \t]?\\)[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" |
477 | 157 address pos)) |
158 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
159 (if (and (> (length address) (match-end 0)) | |
160 (= (aref address (match-end 0)) ?@)) | |
161 (setq pos (match-end 0)) | |
162 (setq address | |
163 (mail-string-delete address | |
19563
fd3807f45b7b
(mail-strip-quoted-names): Retain one whitespace
Richard M. Stallman <rms@gnu.org>
parents:
18204
diff
changeset
|
164 (match-end 1) (match-end 0))))) |
477 | 165 ;; Retain only part of address in <> delims, if there is such a thing. |
18082
4a796f28f98e
(mail-strip-quoted-names): Don't delete angle brackets
Richard M. Stallman <rms@gnu.org>
parents:
17506
diff
changeset
|
166 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)" |
477 | 167 address)) |
168 (let ((junk-beg (match-end 1)) | |
169 (junk-end (match-beginning 2)) | |
170 (close (match-end 0))) | |
171 (setq address (mail-string-delete address (1- close) close)) | |
172 (setq address (mail-string-delete address junk-beg junk-end)))) | |
173 address)))) | |
36 | 174 |
175 ; rmail-dont-reply-to-names is defined in loaddefs | |
176 (defun rmail-dont-reply-to (userids) | |
177 "Returns string of mail addresses USERIDS sans any recipients | |
220 | 178 that start with matches for `rmail-dont-reply-to-names'. |
36 | 179 Usenet paths ending in an element that matches are removed also." |
180 (if (null rmail-dont-reply-to-names) | |
181 (setq rmail-dont-reply-to-names | |
182 (concat (if rmail-default-dont-reply-to-names | |
183 (concat rmail-default-dont-reply-to-names "\\|") | |
184 "") | |
5914
7643239d5bf2
(rmail-dont-reply-to): Change user-original-login-name to user-login-name.
Karl Heuer <kwzh@gnu.org>
parents:
5365
diff
changeset
|
185 (concat (regexp-quote (user-login-name)) |
36 | 186 "\\>")))) |
22710
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
187 (let ((match (concat "\\(^\\|,\\)[ \t\n]*" |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
188 ;; Can anyone figure out what this is for? |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
189 ;; Is it an obsolete remnant of another way of |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
190 ;; handling Foo Bar <foo@machine>? |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
191 "\\([^,\n]*[!<]\\|\\)" |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
192 "\\(" |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
193 rmail-dont-reply-to-names |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
194 "\\|" |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
195 ;; Include the human name that precedes <foo@bar>. |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
196 "\\([^\,.<\"]\\|\"[^\"]*\"\\)*" |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
197 "<\\(" rmail-dont-reply-to-names "\\)" |
36 | 198 "\\)")) |
199 (case-fold-search t) | |
200 pos epos) | |
22710
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
201 (while (setq pos (string-match match userids pos)) |
13590
bd48b68249cf
(rmail-dont-reply-to): Preserve whitespace after comma.
Richard M. Stallman <rms@gnu.org>
parents:
13192
diff
changeset
|
202 (if (> pos 0) (setq pos (match-beginning 2))) |
36 | 203 (setq epos |
14660
071940e2a563
(rmail-dont-reply-to): Allow parsing lists of addresses with comment fields.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
204 ;; Delete thru the next comma, plus whitespace after. |
17209
c7dbcb7494d1
(rmail-dont-reply-to): Delete debugging code.
Richard M. Stallman <rms@gnu.org>
parents:
16952
diff
changeset
|
205 (if (string-match ",[ \t\n]*" userids (match-end 0)) |
36 | 206 (match-end 0) |
207 (length userids))) | |
22710
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
208 ;; Count the double-quotes since the beginning of the list. |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
209 ;; Reject this match if it is inside a pair of doublequotes. |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
210 (let (quote-pos inside-quotes) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
211 (while (and (setq quote-pos (string-match "\"" userids quote-pos)) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
212 (< quote-pos pos)) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
213 (setq quote-pos (1+ quote-pos)) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
214 (setq inside-quotes (not inside-quotes))) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
215 (if inside-quotes |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
216 ;; Advance to next even-parity quote, and scan from there. |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
217 (setq pos (string-match "\"" userids pos)) |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
218 (setq userids |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
219 (mail-string-delete |
0df26ec111fd
(rmail-dont-reply-to): Understand
Richard M. Stallman <rms@gnu.org>
parents:
22002
diff
changeset
|
220 userids pos epos))))) |
36 | 221 ;; get rid of any trailing commas |
222 (if (setq pos (string-match "[ ,\t\n]*\\'" userids)) | |
223 (setq userids (substring userids 0 pos))) | |
224 ;; remove leading spaces. they bother me. | |
225 (if (string-match "\\s *" userids) | |
226 (substring userids (match-end 0)) | |
227 userids))) | |
228 | |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
229 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
230 (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
|
231 "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
|
232 The buffer is expected to be narrowed to just the header of the message. |
3f75d6c8ef33
(mail-fetch-field): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
22710
diff
changeset
|
233 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
|
234 If third arg ALL is non-nil, concatenate all such fields with commas between. |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
235 If 4th arg LIST is non-nil, return a list of all such fields." |
36 | 236 (save-excursion |
237 (goto-char (point-min)) | |
238 (let ((case-fold-search t) | |
239 (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
|
240 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
241 (let ((value (if all ""))) |
36 | 242 (while (re-search-forward name nil t) |
243 (let ((opoint (point))) | |
244 (while (progn (forward-line 1) | |
245 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
246 ;; 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
|
247 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
248 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
249 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
250 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
251 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
252 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
253 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
254 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
255 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
256 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
257 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
258 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
259 (and (not (string= value "")) value))) |
36 | 260 (if (re-search-forward name nil t) |
261 (progn | |
262 (if last (while (re-search-forward name nil t))) | |
263 (let ((opoint (point))) | |
264 (while (progn (forward-line 1) | |
265 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
266 ;; 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
|
267 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
268 (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
|
269 (buffer-substring-no-properties opoint (point))))))))) |
36 | 270 |
271 ;; Parse a list of tokens separated by commas. | |
272 ;; It runs from point to the end of the visible part of the buffer. | |
273 ;; Whitespace before or after tokens is ignored, | |
274 ;; but whitespace within tokens is kept. | |
275 (defun mail-parse-comma-list () | |
276 (let (accumulated | |
277 beg) | |
20409 | 278 (skip-chars-forward " \t\n") |
36 | 279 (while (not (eobp)) |
280 (setq beg (point)) | |
281 (skip-chars-forward "^,") | |
20409 | 282 (skip-chars-backward " \t\n") |
36 | 283 (setq accumulated |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
284 (cons (buffer-substring-no-properties beg (point)) |
36 | 285 accumulated)) |
286 (skip-chars-forward "^,") | |
20409 | 287 (skip-chars-forward ", \t\n")) |
36 | 288 accumulated)) |
289 | |
290 (defun mail-comma-list-regexp (labels) | |
291 (let (pos) | |
292 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
293 ;; Remove leading and trailing whitespace. | |
294 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
295 ;; Change each comma to \|, and flush surrounding whitespace. | |
296 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
297 (setq labels | |
298 (concat (substring labels 0 pos) | |
299 "\\|" | |
300 (substring labels (match-end 0)))))) | |
301 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
302 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
303 (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
|
304 (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
|
305 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
306 (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
|
307 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
308 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
309 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
310 (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
|
311 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
312 (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
|
313 (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
|
314 (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
|
315 (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
|
316 (mail-rfc822-time-zone time)))) |
584 | 317 |
318 (provide 'mail-utils) | |
319 | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
320 ;;; mail-utils.el ends here |