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