Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 96905:43f0edb65a25
(Fns_selection_exists_p, Fns_selection_owner_p)
(Fx_get_selection_internal, Fns_rotate_cut_buffers_internal)
(Fns_own_selection_internal, Fx_disown_selection_internal)
(Fns_get_cut_buffer_internal, Fns_store_cut_buffer_internal):
Change to use 'doc: /* ... */' style of docstrings. Doc fixes.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 22 Jul 2008 19:25:08 +0000 |
parents | ef65fa4dca3b |
children | c5fb918370c8 |
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 |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, |
79712 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
845 | 5 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
6 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
7 ;; Keywords: mail, news |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
8 |
36 | 9 ;; This file is part of GNU Emacs. |
10 | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
36 | 12 ;; it under the terms of the GNU General Public License as published by |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
36 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94674
ef65fa4dca3b
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
36 | 23 |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
24 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
25 |
5365 | 26 ;; Utility functions for mail and netnews handling. These handle fine |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
27 ;; points of header parsing. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
28 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
29 ;;; Code: |
36 | 30 |
285 | 31 ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has |
32 ;;; been initialized. | |
33 (require 'lisp-mode) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
34 |
268 | 35 ;;;###autoload |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
36 (defcustom mail-use-rfc822 nil "\ |
268 | 37 *If non-nil, use a full, hairy RFC822 parser on mail addresses. |
38 Otherwise, (the default) use a smaller, somewhat faster, and | |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
39 often correct parser." |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
40 :type 'boolean |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
41 :group 'mail) |
36 | 42 |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
43 ;; Returns t if file FILE is an Rmail file. |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
44 ;;;###autoload |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
45 (defun mail-file-babyl-p (file) |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
46 (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
|
47 (unwind-protect |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
48 (save-excursion |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
49 (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
|
50 (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
|
51 (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
|
52 (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
|
53 |
36 | 54 (defun mail-string-delete (string start end) |
55 "Returns a string containing all of STRING except the part | |
56 from START (inclusive) to END (exclusive)." | |
57 (if (null end) (substring string 0 start) | |
58 (concat (substring string 0 start) | |
59 (substring string end nil)))) | |
60 | |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
61 ;;;###autoload |
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) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
81 (setq char (upcase char)) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
82 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
83 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
84 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
85 |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
86 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
87 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
88 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
89 If the optional argument WRAPPER is non-nil, |
17506 | 90 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
|
91 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
92 (and wrapper |
17506 | 93 (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
|
94 (setq string (match-string 1 string))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
95 (let ((i 0) strings) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
96 (while (string-match "=\\(..\\|\n\\)" string i) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
97 (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
|
98 (unless (= (aref string (match-beginning 1)) ?\n) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
99 (setq strings |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
100 (cons (make-string 1 |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
101 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
102 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
103 (mail-unquote-printable-hexdigit |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
104 (aref string (1+ (match-beginning 1)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
105 strings))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
106 (setq i (match-end 0))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
107 (apply 'concat (nreverse (cons (substring string i) strings)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
108 |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
109 ;;;###autoload |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
110 (defun mail-unquote-printable-region (beg end &optional wrapper noerror |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
111 unibyte) |
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?....?=. |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
115 If NOERROR is non-nil, return t if successful. |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
116 If UNIBYTE is non-nil, insert converted characters as unibyte. |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
117 That is useful if you are going to character code decoding afterward, |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
118 as Rmail does." |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
119 (interactive "r\nP") |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
120 (let (failed) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
121 (save-match-data |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
122 (save-excursion |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
123 (save-restriction |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
124 (narrow-to-region beg end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
125 (goto-char (point-min)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
126 (when (and wrapper |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
127 (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
128 (delete-region (match-end 1) end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
129 (delete-region (point) (match-beginning 1))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
130 (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
|
131 (goto-char (match-end 0)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
132 (cond ((= (char-after (match-beginning 1)) ?\n) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
133 (replace-match "")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
134 ((= (char-after (match-beginning 1)) ?=) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
135 (replace-match "=")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
136 ((match-beginning 2) |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
137 (let ((char (+ (* 16 (mail-unquote-printable-hexdigit |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
138 (char-after (match-beginning 2)))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
139 (mail-unquote-printable-hexdigit |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
140 (char-after (1+ (match-beginning 2))))))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
141 (if unibyte |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
142 (progn |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
143 (replace-match "") |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
144 ;; insert-char will insert this as unibyte, |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
145 (insert-char char 1)) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
146 (replace-match (make-string 1 char) t t)))) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
147 (noerror |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
148 (setq failed t)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
149 (t |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
150 (error "Malformed MIME quoted-printable message")))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
151 (not failed)))))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
152 |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
153 (eval-when-compile (require 'rfc822)) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
154 |
36 | 155 (defun mail-strip-quoted-names (address) |
156 "Delete comments and quoted strings in an address list ADDRESS. | |
157 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
158 Return a modified address list." | |
477 | 159 (if (null address) |
160 nil | |
161 (if mail-use-rfc822 | |
162 (progn (require 'rfc822) | |
163 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
164 (let (pos) | |
36 | 165 |
477 | 166 ;; 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
|
167 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 168 ;; Strip nested comments. |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
169 (with-current-buffer (get-buffer-create " *temp*") |
477 | 170 (erase-buffer) |
171 (insert address) | |
172 (set-syntax-table lisp-mode-syntax-table) | |
173 (goto-char 1) | |
174 (while (search-forward "(" nil t) | |
175 (forward-char -1) | |
176 (skip-chars-backward " \t") | |
177 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
178 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
179 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
180 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
181 (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
|
182 (point)))) |
477 | 183 (setq address (buffer-string)) |
184 (erase-buffer)) | |
185 ;; Strip non-nested comments an easier way. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
186 (while (setq pos (string-match |
477 | 187 ;; This doesn't hack rfc822 nested comments |
188 ;; `(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
|
189 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 190 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
191 (setq address (replace-match "" nil nil address 0)))) |
36 | 192 |
22002
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
193 ;; strip surrounding whitespace |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
194 (string-match "\\`[ \t\n]*" address) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
195 (setq address (substring address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
196 (match-end 0) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
197 (string-match "[ \t\n]*\\'" address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
198 (match-end 0)))) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
199 |
477 | 200 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
201 (setq pos 0) | |
202 (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
|
203 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" |
477 | 204 address pos)) |
205 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
206 (if (and (> (length address) (match-end 0)) | |
207 (= (aref address (match-end 0)) ?@)) | |
208 (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
|
209 ;; Otherwise discard the "..." part. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
210 (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
|
211 ;; 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
|
212 ;; the part between the <...>. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
213 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" |
477 | 214 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
215 (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
|
216 nil 'literal address 2))) |
477 | 217 address)))) |
36 | 218 |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
219 ;;; 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
|
220 ;;; 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
|
221 ;;; 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
|
222 ;;; 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
|
223 ;;; 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
|
224 ;;; 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
|
225 (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
|
226 "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
|
227 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
|
228 the comma-separated list. The pruned list is returned." |
36 | 229 (if (null rmail-dont-reply-to-names) |
230 (setq rmail-dont-reply-to-names | |
231 (concat (if rmail-default-dont-reply-to-names | |
232 (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
|
233 "") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
234 (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
|
235 (not (equal user-mail-address user-login-name))) |
53968
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
236 ;; Anchor the login name and email address so |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
237 ;; that we don't match substrings: if the |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
238 ;; login name is "foo", we shouldn't match |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
239 ;; "barfoo@baz.com". |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
240 (concat "\\`" |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
241 (regexp-quote user-mail-address) |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
242 "\\'\\|") |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
243 "") |
53968
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
244 (concat "\\`" (regexp-quote user-login-name) "@")))) |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
245 ;; 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
|
246 (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
|
247 (case-fold-search t)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
248 (while start-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 (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
|
250 (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
|
251 ;; Search for matching quote. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
252 (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
|
253 (if next-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
254 (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
|
255 ;; 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
|
256 ;; 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
|
257 ;; 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
|
258 ;; are weird elsewhere. |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
259 (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
|
260 (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
|
261 (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
|
262 (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
|
263 (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
|
264 (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
|
265 (setq destinations (concat (substring destinations 0 start-pos) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
266 (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
|
267 (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
268 cur-pos start-pos) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
269 (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
|
270 start-pos cur-pos)))))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
271 ;; get rid of any trailing commas |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
272 (let ((pos (string-match "[ ,\t\n]*\\'" destinations))) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
273 (if pos |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
274 (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
|
275 ;; 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
|
276 (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
|
277 (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
|
278 destinations)) |
27460
cccffb3304b3
(rmail-dont-reply-to): Replace matched
Gerd Moellmann <gerd@gnu.org>
parents:
25271
diff
changeset
|
279 |
36 | 280 |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
281 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
282 (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
|
283 "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
|
284 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
|
285 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
|
286 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
|
287 If 4th arg LIST is non-nil, return a list of all such fields." |
36 | 288 (save-excursion |
289 (goto-char (point-min)) | |
290 (let ((case-fold-search t) | |
291 (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
|
292 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
293 (let ((value (if all ""))) |
36 | 294 (while (re-search-forward name nil t) |
295 (let ((opoint (point))) | |
296 (while (progn (forward-line 1) | |
297 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
298 ;; 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
|
299 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
300 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
301 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
302 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
303 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
304 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
305 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
306 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
307 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
308 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
309 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
310 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
311 (and (not (string= value "")) value))) |
36 | 312 (if (re-search-forward name nil t) |
313 (progn | |
314 (if last (while (re-search-forward name nil t))) | |
315 (let ((opoint (point))) | |
316 (while (progn (forward-line 1) | |
317 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
318 ;; 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
|
319 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
320 (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
|
321 (buffer-substring-no-properties opoint (point))))))))) |
36 | 322 |
323 ;; Parse a list of tokens separated by commas. | |
324 ;; It runs from point to the end of the visible part of the buffer. | |
325 ;; Whitespace before or after tokens is ignored, | |
326 ;; but whitespace within tokens is kept. | |
327 (defun mail-parse-comma-list () | |
328 (let (accumulated | |
329 beg) | |
20409 | 330 (skip-chars-forward " \t\n") |
36 | 331 (while (not (eobp)) |
332 (setq beg (point)) | |
333 (skip-chars-forward "^,") | |
20409 | 334 (skip-chars-backward " \t\n") |
36 | 335 (setq accumulated |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
336 (cons (buffer-substring-no-properties beg (point)) |
36 | 337 accumulated)) |
338 (skip-chars-forward "^,") | |
20409 | 339 (skip-chars-forward ", \t\n")) |
36 | 340 accumulated)) |
341 | |
342 (defun mail-comma-list-regexp (labels) | |
343 (let (pos) | |
344 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
345 ;; Remove leading and trailing whitespace. | |
346 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
347 ;; Change each comma to \|, and flush surrounding whitespace. | |
348 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
349 (setq labels | |
350 (concat (substring labels 0 pos) | |
351 "\\|" | |
352 (substring labels (match-end 0)))))) | |
353 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
354 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
355 (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
|
356 (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
|
357 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
358 (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
|
359 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
360 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
361 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
362 (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
|
363 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
364 (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
|
365 (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
|
366 (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
|
367 (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
|
368 (mail-rfc822-time-zone time)))) |
584 | 369 |
370 (provide 'mail-utils) | |
371 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79712
diff
changeset
|
372 ;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
373 ;;; mail-utils.el ends here |