Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 53730:2a4fc5c14ddd
Change rmail-spam-filter- or spam-filter-
or rmail-spam- to rsf- in all function and variable names.
(rsf-min-region-to-spam-list): New variable.
(rsf-bbdb-auto-delete-spam-entries): Renamed from
rmail-bbdb-auto-delete-spam-bbdb-entries. The cc: field is
scanned together with the recipients field for spam testing; Don't
delete spam message if rmail-delete-after-output is non-nil;
(check-field) New function, extracted from code in
rmail-spam-filter to ease addition of header fields like content-type:.
(message-content-type) New variable. The content-type: field was
added also in defcustom of rsf-definitions-alist;
(rmail-spam-filter): Replace repeated test code for header fields
by calls to check-field; change the call to
rmail-output-to-rmail-file such that rmail-current-message stays
the same to avoid wrong deletion of unseen flags.
(rmail-use-spam-filter): Add autoload cookie.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 27 Jan 2004 19:00:40 +0000 |
parents | 3b872f61f08d |
children | d65998606b6d |
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 |
38597
16d2187c5524
(mail-strip-quoted-names): Replace text
Gerd Moellmann <gerd@gnu.org>
parents:
31880
diff
changeset
|
3 ;; Copyright (C) 1985, 2001 Free Software Foundation, Inc. |
845 | 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) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
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 | |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
62 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
63 (defun mail-quote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
64 "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
|
65 If the optional argument WRAPPER is non-nil, |
17506 | 66 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
|
67 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
68 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
69 (while (string-match "[?=\"\200-\377]" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
70 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
71 (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
|
72 (upcase (format "=%02x" |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
73 (aref string (match-beginning 0)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
74 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
75 (if wrapper |
17506 | 76 (concat "=?ISO-8859-1?Q?" |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
77 result (substring string i) |
17506 | 78 "?=") |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
79 (concat result (substring string i)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
80 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
81 (defun mail-unquote-printable-hexdigit (char) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
82 (setq char (upcase char)) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
83 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
84 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
85 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
86 |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
87 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
88 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
89 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
90 If the optional argument WRAPPER is non-nil, |
17506 | 91 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
|
92 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
93 (and wrapper |
17506 | 94 (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
|
95 (setq string (match-string 1 string))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
96 (let ((i 0) strings) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
97 (while (string-match "=\\(..\\|\n\\)" string i) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
98 (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
|
99 (unless (= (aref string (match-beginning 1)) ?\n) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
100 (setq strings |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
101 (cons (make-string 1 |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
102 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
103 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
104 (mail-unquote-printable-hexdigit |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
105 (aref string (1+ (match-beginning 1)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
106 strings))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
107 (setq i (match-end 0))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
108 (apply 'concat (nreverse (cons (substring string i) strings)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
109 |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
110 ;;;###autoload |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
111 (defun mail-unquote-printable-region (beg end &optional wrapper noerror) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
112 "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
|
113 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
|
114 we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=. |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
115 If NOERROR is non-nil, return t if successful." |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
116 (interactive "r\nP") |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
117 (let (failed) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
118 (save-match-data |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
119 (save-excursion |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
120 (save-restriction |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
121 (narrow-to-region beg end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
122 (goto-char (point-min)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
123 (when (and wrapper |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
124 (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
125 (delete-region (match-end 1) end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
126 (delete-region (point) (match-beginning 1))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
127 (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
|
128 (goto-char (match-end 0)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
129 (cond ((= (char-after (match-beginning 1)) ?\n) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
130 (replace-match "")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
131 ((= (char-after (match-beginning 1)) ?=) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
132 (replace-match "=")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
133 ((match-beginning 2) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
134 (replace-match |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
135 (make-string 1 |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
136 (+ (* 16 (mail-unquote-printable-hexdigit |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
137 (char-after (match-beginning 2)))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
138 (mail-unquote-printable-hexdigit |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
139 (char-after (1+ (match-beginning 2)))))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
140 t t)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
141 (noerror |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
142 (setq failed t)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
143 (t |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
144 (error "Malformed MIME quoted-printable message")))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
145 (not failed)))))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
146 |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
147 (eval-when-compile (require 'rfc822)) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
148 |
36 | 149 (defun mail-strip-quoted-names (address) |
150 "Delete comments and quoted strings in an address list ADDRESS. | |
151 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
152 Return a modified address list." | |
477 | 153 (if (null address) |
154 nil | |
155 (if mail-use-rfc822 | |
156 (progn (require 'rfc822) | |
157 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
158 (let (pos) | |
36 | 159 |
477 | 160 ;; 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
|
161 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 162 ;; Strip nested comments. |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
163 (with-current-buffer (get-buffer-create " *temp*") |
477 | 164 (erase-buffer) |
165 (insert address) | |
166 (set-syntax-table lisp-mode-syntax-table) | |
167 (goto-char 1) | |
168 (while (search-forward "(" nil t) | |
169 (forward-char -1) | |
170 (skip-chars-backward " \t") | |
171 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
172 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
173 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
174 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
175 (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
|
176 (point)))) |
477 | 177 (setq address (buffer-string)) |
178 (erase-buffer)) | |
179 ;; Strip non-nested comments an easier way. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
180 (while (setq pos (string-match |
477 | 181 ;; This doesn't hack rfc822 nested comments |
182 ;; `(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
|
183 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 184 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
185 (setq address (replace-match "" nil nil address 0)))) |
36 | 186 |
22002
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
187 ;; strip surrounding whitespace |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
188 (string-match "\\`[ \t\n]*" address) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
189 (setq address (substring address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
190 (match-end 0) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
191 (string-match "[ \t\n]*\\'" address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
192 (match-end 0)))) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
193 |
477 | 194 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
195 (setq pos 0) | |
196 (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
|
197 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" |
477 | 198 address pos)) |
199 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
200 (if (and (> (length address) (match-end 0)) | |
201 (= (aref address (match-end 0)) ?@)) | |
202 (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
|
203 ;; Otherwise discard the "..." part. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
204 (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
|
205 ;; 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
|
206 ;; the part between the <...>. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
207 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" |
477 | 208 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
209 (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
|
210 nil 'literal address 2))) |
477 | 211 address)))) |
36 | 212 |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
213 ;;; 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
|
214 ;;; 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
|
215 ;;; 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
|
216 ;;; 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
|
217 ;;; 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
|
218 ;;; 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
|
219 (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
|
220 "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
|
221 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
|
222 the comma-separated list. The pruned list is returned." |
36 | 223 (if (null rmail-dont-reply-to-names) |
224 (setq rmail-dont-reply-to-names | |
225 (concat (if rmail-default-dont-reply-to-names | |
226 (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
|
227 "") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
228 (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
|
229 (not (equal user-mail-address user-login-name))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
230 (concat (regexp-quote user-mail-address) "\\|") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
231 "") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
232 (concat (regexp-quote user-login-name) "\\>")))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
233 ;; 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
|
234 (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
|
235 (case-fold-search t)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
236 (while start-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
237 (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
|
238 (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
|
239 ;; Search for matching quote. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
240 (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
|
241 (if next-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
242 (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
|
243 ;; 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
|
244 ;; 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
|
245 ;; 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
|
246 ;; are weird elsewhere. |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
247 (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
|
248 (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
|
249 (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
|
250 (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
|
251 (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
|
252 (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
|
253 (setq destinations (concat (substring destinations 0 start-pos) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
254 (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
|
255 (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
256 cur-pos start-pos) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
257 (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
|
258 start-pos cur-pos)))))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
259 ;; get rid of any trailing commas |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
260 (let ((pos (string-match "[ ,\t\n]*\\'" destinations))) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
261 (if pos |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
262 (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
|
263 ;; 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
|
264 (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
|
265 (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
|
266 destinations)) |
27460
cccffb3304b3
(rmail-dont-reply-to): Replace matched
Gerd Moellmann <gerd@gnu.org>
parents:
25271
diff
changeset
|
267 |
36 | 268 |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
269 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
270 (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
|
271 "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
|
272 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
|
273 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
|
274 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
|
275 If 4th arg LIST is non-nil, return a list of all such fields." |
36 | 276 (save-excursion |
277 (goto-char (point-min)) | |
278 (let ((case-fold-search t) | |
279 (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
|
280 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
281 (let ((value (if all ""))) |
36 | 282 (while (re-search-forward name nil t) |
283 (let ((opoint (point))) | |
284 (while (progn (forward-line 1) | |
285 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
286 ;; 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
|
287 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
288 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
289 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
290 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
291 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
292 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
293 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
294 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
295 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
296 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
297 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
298 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
299 (and (not (string= value "")) value))) |
36 | 300 (if (re-search-forward name nil t) |
301 (progn | |
302 (if last (while (re-search-forward name nil t))) | |
303 (let ((opoint (point))) | |
304 (while (progn (forward-line 1) | |
305 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
306 ;; 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
|
307 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
308 (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
|
309 (buffer-substring-no-properties opoint (point))))))))) |
36 | 310 |
311 ;; Parse a list of tokens separated by commas. | |
312 ;; It runs from point to the end of the visible part of the buffer. | |
313 ;; Whitespace before or after tokens is ignored, | |
314 ;; but whitespace within tokens is kept. | |
315 (defun mail-parse-comma-list () | |
316 (let (accumulated | |
317 beg) | |
20409 | 318 (skip-chars-forward " \t\n") |
36 | 319 (while (not (eobp)) |
320 (setq beg (point)) | |
321 (skip-chars-forward "^,") | |
20409 | 322 (skip-chars-backward " \t\n") |
36 | 323 (setq accumulated |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
324 (cons (buffer-substring-no-properties beg (point)) |
36 | 325 accumulated)) |
326 (skip-chars-forward "^,") | |
20409 | 327 (skip-chars-forward ", \t\n")) |
36 | 328 accumulated)) |
329 | |
330 (defun mail-comma-list-regexp (labels) | |
331 (let (pos) | |
332 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
333 ;; Remove leading and trailing whitespace. | |
334 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
335 ;; Change each comma to \|, and flush surrounding whitespace. | |
336 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
337 (setq labels | |
338 (concat (substring labels 0 pos) | |
339 "\\|" | |
340 (substring labels (match-end 0)))))) | |
341 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
342 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
343 (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
|
344 (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
|
345 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
346 (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
|
347 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
348 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
349 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
350 (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
|
351 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
352 (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
|
353 (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
|
354 (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
|
355 (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
|
356 (mail-rfc822-time-zone time)))) |
584 | 357 |
358 (provide 'mail-utils) | |
359 | |
52401 | 360 ;;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
361 ;;; mail-utils.el ends here |