Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 18989:6253a99afd95
(rmail-pop-password-error): New variable.
(rmail-insert-inbox-text): If there's an error getting mail from
the POP server, and the error matches rmail-pop-password-error or
we prompted for the POP password, assume that the password is
incorrect and erase it so that the user will be prompted again the
next time he gets mail.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 25 Jul 1997 22:08:24 +0000 |
parents | 0634e43b52c8 |
children | fd3807f45b7b |
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 |
37 (defvar mail-use-rfc822 nil "\ | |
38 *If non-nil, use a full, hairy RFC822 parser on mail addresses. | |
39 Otherwise, (the default) use a smaller, somewhat faster, and | |
40 often correct parser.") | |
36 | 41 |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
42 ;; 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
|
43 ;;;###autoload |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
44 (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
|
45 (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
|
46 (unwind-protect |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
47 (save-excursion |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
48 (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
|
49 (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
|
50 (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
|
51 (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
|
52 |
36 | 53 (defun mail-string-delete (string start end) |
54 "Returns a string containing all of STRING except the part | |
55 from START (inclusive) to END (exclusive)." | |
56 (if (null end) (substring string 0 start) | |
57 (concat (substring string 0 start) | |
58 (substring string end nil)))) | |
59 | |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
60 (defun mail-quote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
61 "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
|
62 If the optional argument WRAPPER is non-nil, |
17506 | 63 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
|
64 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
65 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
66 (while (string-match "[?=\"\200-\377]" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
67 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
68 (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
|
69 (upcase (format "=%02x" |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
70 (aref string (match-beginning 0)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
71 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
72 (if wrapper |
17506 | 73 (concat "=?ISO-8859-1?Q?" |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
74 result (substring string i) |
17506 | 75 "?=") |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
76 (concat result (substring string i)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
77 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
78 (defun mail-unquote-printable-hexdigit (char) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
79 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
80 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
81 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
82 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
83 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
84 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
85 If the optional argument WRAPPER is non-nil, |
17506 | 86 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
|
87 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
88 (and wrapper |
17506 | 89 (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
|
90 (setq string (match-string 1 string))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
91 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
92 (while (string-match "=\\(..\\)" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
93 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
94 (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
|
95 (make-string 1 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
96 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
97 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
98 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
99 (aref string (1+ (match-beginning 1)))))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
100 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
101 (concat result (substring string i))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
102 |
36 | 103 (defun mail-strip-quoted-names (address) |
104 "Delete comments and quoted strings in an address list ADDRESS. | |
105 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
106 Return a modified address list." | |
477 | 107 (if (null address) |
108 nil | |
109 (if mail-use-rfc822 | |
110 (progn (require 'rfc822) | |
111 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
112 (let (pos) | |
113 (string-match "\\`[ \t\n]*" address) | |
114 ;; strip surrounding whitespace | |
115 (setq address (substring address | |
116 (match-end 0) | |
117 (string-match "[ \t\n]*\\'" address | |
118 (match-end 0)))) | |
36 | 119 |
477 | 120 ;; 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
|
121 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 122 ;; Strip nested comments. |
123 (save-excursion | |
124 (set-buffer (get-buffer-create " *temp*")) | |
125 (erase-buffer) | |
126 (insert address) | |
127 (set-syntax-table lisp-mode-syntax-table) | |
128 (goto-char 1) | |
129 (while (search-forward "(" nil t) | |
130 (forward-char -1) | |
131 (skip-chars-backward " \t") | |
132 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
133 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
134 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
135 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
136 (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
|
137 (point)))) |
477 | 138 (setq address (buffer-string)) |
139 (erase-buffer)) | |
140 ;; Strip non-nested comments an easier way. | |
141 (while (setq pos (string-match | |
142 ;; This doesn't hack rfc822 nested comments | |
143 ;; `(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
|
144 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 145 address)) |
146 (setq address | |
147 (mail-string-delete address | |
148 pos (match-end 0))))) | |
36 | 149 |
477 | 150 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
151 (setq pos 0) | |
152 (while (setq pos (string-match | |
153 "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" | |
154 address pos)) | |
155 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
156 (if (and (> (length address) (match-end 0)) | |
157 (= (aref address (match-end 0)) ?@)) | |
158 (setq pos (match-end 0)) | |
159 (setq address | |
160 (mail-string-delete address | |
161 pos (match-end 0))))) | |
162 ;; 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
|
163 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)" |
477 | 164 address)) |
165 (let ((junk-beg (match-end 1)) | |
166 (junk-end (match-beginning 2)) | |
167 (close (match-end 0))) | |
168 (setq address (mail-string-delete address (1- close) close)) | |
169 (setq address (mail-string-delete address junk-beg junk-end)))) | |
170 address)))) | |
36 | 171 |
172 (or (and (boundp 'rmail-default-dont-reply-to-names) | |
173 (not (null rmail-default-dont-reply-to-names))) | |
174 (setq rmail-default-dont-reply-to-names "info-")) | |
175 | |
176 ; rmail-dont-reply-to-names is defined in loaddefs | |
177 (defun rmail-dont-reply-to (userids) | |
178 "Returns string of mail addresses USERIDS sans any recipients | |
220 | 179 that start with matches for `rmail-dont-reply-to-names'. |
36 | 180 Usenet paths ending in an element that matches are removed also." |
181 (if (null rmail-dont-reply-to-names) | |
182 (setq rmail-dont-reply-to-names | |
183 (concat (if rmail-default-dont-reply-to-names | |
184 (concat rmail-default-dont-reply-to-names "\\|") | |
185 "") | |
5914
7643239d5bf2
(rmail-dont-reply-to): Change user-original-login-name to user-login-name.
Karl Heuer <kwzh@gnu.org>
parents:
5365
diff
changeset
|
186 (concat (regexp-quote (user-login-name)) |
36 | 187 "\\>")))) |
17258
fb6013017dce
(make-auto-save-file-name): Replace both / and \
Richard M. Stallman <rms@gnu.org>
parents:
17209
diff
changeset
|
188 (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*[!<]\\|\\)\\(" |
36 | 189 rmail-dont-reply-to-names |
16062
2a9b6a25cb9e
(rmail-dont-reply-to): Recognize the names to delete
Richard M. Stallman <rms@gnu.org>
parents:
15606
diff
changeset
|
190 "\\|[^\,.<]*<\\(" rmail-dont-reply-to-names "\\)" |
36 | 191 "\\)")) |
192 (case-fold-search t) | |
193 pos epos) | |
194 (while (setq pos (string-match match userids)) | |
13590
bd48b68249cf
(rmail-dont-reply-to): Preserve whitespace after comma.
Richard M. Stallman <rms@gnu.org>
parents:
13192
diff
changeset
|
195 (if (> pos 0) (setq pos (match-beginning 2))) |
36 | 196 (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
|
197 ;; 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
|
198 (if (string-match ",[ \t\n]*" userids (match-end 0)) |
36 | 199 (match-end 0) |
200 (length userids))) | |
201 (setq userids | |
202 (mail-string-delete | |
203 userids pos epos))) | |
204 ;; get rid of any trailing commas | |
205 (if (setq pos (string-match "[ ,\t\n]*\\'" userids)) | |
206 (setq userids (substring userids 0 pos))) | |
207 ;; remove leading spaces. they bother me. | |
208 (if (string-match "\\s *" userids) | |
209 (substring userids (match-end 0)) | |
210 userids))) | |
211 | |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
212 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
213 (defun mail-fetch-field (field-name &optional last all list) |
220 | 214 "Return the value of the header field FIELD-NAME. |
36 | 215 The buffer is expected to be narrowed to just the headers of the message. |
220 | 216 If second arg LAST is non-nil, use the last such field if there are several. |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
217 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
|
218 If 4th arg LIST is non-nil, return a list of all such fields." |
36 | 219 (save-excursion |
220 (goto-char (point-min)) | |
221 (let ((case-fold-search t) | |
222 (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
|
223 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
224 (let ((value (if all ""))) |
36 | 225 (while (re-search-forward name nil t) |
226 (let ((opoint (point))) | |
227 (while (progn (forward-line 1) | |
228 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
229 ;; 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
|
230 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
231 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
232 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
233 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
234 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
235 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
236 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
237 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
238 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
239 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
240 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
241 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
242 (and (not (string= value "")) value))) |
36 | 243 (if (re-search-forward name nil t) |
244 (progn | |
245 (if last (while (re-search-forward name nil t))) | |
246 (let ((opoint (point))) | |
247 (while (progn (forward-line 1) | |
248 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
249 ;; 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
|
250 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
251 (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
|
252 (buffer-substring-no-properties opoint (point))))))))) |
36 | 253 |
254 ;; Parse a list of tokens separated by commas. | |
255 ;; It runs from point to the end of the visible part of the buffer. | |
256 ;; Whitespace before or after tokens is ignored, | |
257 ;; but whitespace within tokens is kept. | |
258 (defun mail-parse-comma-list () | |
259 (let (accumulated | |
260 beg) | |
261 (skip-chars-forward " ") | |
262 (while (not (eobp)) | |
263 (setq beg (point)) | |
264 (skip-chars-forward "^,") | |
265 (skip-chars-backward " ") | |
266 (setq accumulated | |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
267 (cons (buffer-substring-no-properties beg (point)) |
36 | 268 accumulated)) |
269 (skip-chars-forward "^,") | |
270 (skip-chars-forward ", ")) | |
271 accumulated)) | |
272 | |
273 (defun mail-comma-list-regexp (labels) | |
274 (let (pos) | |
275 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
276 ;; Remove leading and trailing whitespace. | |
277 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
278 ;; Change each comma to \|, and flush surrounding whitespace. | |
279 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
280 (setq labels | |
281 (concat (substring labels 0 pos) | |
282 "\\|" | |
283 (substring labels (match-end 0)))))) | |
284 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
285 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
286 (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
|
287 (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
|
288 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
289 (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
|
290 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
291 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
292 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
293 (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
|
294 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
295 (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
|
296 (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
|
297 (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
|
298 (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
|
299 (mail-rfc822-time-zone time)))) |
584 | 300 |
301 (provide 'mail-utils) | |
302 | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
303 ;;; mail-utils.el ends here |