Mercurial > emacs
annotate lisp/mail/mail-utils.el @ 82603:d0c9cce4628c
* net/tramp.el (top): Require cl.el, when `copy-tree' is not available
otherwise.
(tramp-get-remote-path): New defun. Replace occurences of
`tramp-default-remote-path' by this function.
(tramp-set-remote-path): Move most of the code to
`tramp-get-remote-path'.
(tramp-get-ls-command, tramp-get-remote-id): Don't check for not
existing directories, this is done already in
`tramp-get-remote-path'.
author | Michael Albinus <michael.albinus@gmx.de> |
---|---|
date | Wed, 22 Aug 2007 05:47:42 +0000 |
parents | 8e27d63c45eb |
children | de499b20517a f55f9811f5d7 |
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, |
75347 | 4 ;; 2005, 2006, 2007 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 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
78232
8e27d63c45eb
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
13 ;; the Free Software Foundation; either version 3, or (at your option) |
36 | 14 ;; any later version. |
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 | |
14169 | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
36 | 25 |
2307
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
26 ;;; Commentary: |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
27 |
5365 | 28 ;; 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
|
29 ;; points of header parsing. |
10e417efb12a
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
845
diff
changeset
|
30 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
31 ;;; Code: |
36 | 32 |
285 | 33 ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has |
34 ;;; been initialized. | |
35 (require 'lisp-mode) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
36 |
268 | 37 ;;;###autoload |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
38 (defcustom mail-use-rfc822 nil "\ |
268 | 39 *If non-nil, use a full, hairy RFC822 parser on mail addresses. |
40 Otherwise, (the default) use a smaller, somewhat faster, and | |
21493
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
41 often correct parser." |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
42 :type 'boolean |
a22b10628409
Customize mail-use-rfc822.
Stephen Eglen <stephen@gnu.org>
parents:
20409
diff
changeset
|
43 :group 'mail) |
36 | 44 |
13055
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
45 ;; 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
|
46 ;;;###autoload |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
47 (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
|
48 (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
|
49 (unwind-protect |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
50 (save-excursion |
d94531fd96a4
(mail-file-babyl-p): Function moved from rmail.el and renamed.
Richard M. Stallman <rms@gnu.org>
parents:
12613
diff
changeset
|
51 (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
|
52 (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
|
53 (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
|
54 (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
|
55 |
36 | 56 (defun mail-string-delete (string start end) |
57 "Returns a string containing all of STRING except the part | |
58 from START (inclusive) to END (exclusive)." | |
59 (if (null end) (substring string 0 start) | |
60 (concat (substring string 0 start) | |
61 (substring string end nil)))) | |
62 | |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
63 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
64 (defun mail-quote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
65 "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
|
66 If the optional argument WRAPPER is non-nil, |
17506 | 67 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
|
68 (let ((i 0) (result "")) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
69 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
70 (while (string-match "[?=\"\200-\377]" string i) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
71 (setq result |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
72 (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
|
73 (upcase (format "=%02x" |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
74 (aref string (match-beginning 0)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
75 (setq i (match-end 0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
76 (if wrapper |
17506 | 77 (concat "=?ISO-8859-1?Q?" |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
78 result (substring string i) |
17506 | 79 "?=") |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
80 (concat result (substring string i)))))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
81 |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
82 (defun mail-unquote-printable-hexdigit (char) |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
83 (setq char (upcase char)) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
84 (if (>= char ?A) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
85 (+ (- char ?A) 10) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
86 (- char ?0))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
87 |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
88 ;;;###autoload |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
89 (defun mail-unquote-printable (string &optional wrapper) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
90 "Undo the \"quoted printable\" encoding. |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
91 If the optional argument WRAPPER is non-nil, |
17506 | 92 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
|
93 (save-match-data |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
94 (and wrapper |
17506 | 95 (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
|
96 (setq string (match-string 1 string))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
97 (let ((i 0) strings) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
98 (while (string-match "=\\(..\\|\n\\)" string i) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
99 (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
|
100 (unless (= (aref string (match-beginning 1)) ?\n) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
101 (setq strings |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
102 (cons (make-string 1 |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
103 (+ (* 16 (mail-unquote-printable-hexdigit |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
104 (aref string (match-beginning 1)))) |
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
105 (mail-unquote-printable-hexdigit |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
106 (aref string (1+ (match-beginning 1)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
107 strings))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
108 (setq i (match-end 0))) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
109 (apply 'concat (nreverse (cons (substring string i) strings)))))) |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
110 |
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
111 ;;;###autoload |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
112 (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
|
113 unibyte) |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
114 "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
|
115 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
|
116 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
|
117 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
|
118 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
|
119 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
|
120 as Rmail does." |
25271
0d9fd0e4f7a3
(mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents:
22949
diff
changeset
|
121 (interactive "r\nP") |
53569
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
122 (let (failed) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
123 (save-match-data |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
124 (save-excursion |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
125 (save-restriction |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
126 (narrow-to-region beg end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
127 (goto-char (point-min)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
128 (when (and wrapper |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
129 (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
130 (delete-region (match-end 1) end) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
131 (delete-region (point) (match-beginning 1))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
132 (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
|
133 (goto-char (match-end 0)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
134 (cond ((= (char-after (match-beginning 1)) ?\n) |
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 ((= (char-after (match-beginning 1)) ?=) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
137 (replace-match "=")) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
138 ((match-beginning 2) |
54261
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
139 (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
|
140 (char-after (match-beginning 2)))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
141 (mail-unquote-printable-hexdigit |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
142 (char-after (1+ (match-beginning 2))))))) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
143 (if unibyte |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
144 (progn |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
145 (replace-match "") |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
146 ;; 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
|
147 (insert-char char 1)) |
94db0f6330b3
(mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents:
53968
diff
changeset
|
148 (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
|
149 (noerror |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
150 (setq failed t)) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
151 (t |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
152 (error "Malformed MIME quoted-printable message")))) |
3b872f61f08d
(mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
153 (not failed)))))) |
17425
10076111abf2
(mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents:
17258
diff
changeset
|
154 |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
155 (eval-when-compile (require 'rfc822)) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
156 |
36 | 157 (defun mail-strip-quoted-names (address) |
158 "Delete comments and quoted strings in an address list ADDRESS. | |
159 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. | |
160 Return a modified address list." | |
477 | 161 (if (null address) |
162 nil | |
163 (if mail-use-rfc822 | |
164 (progn (require 'rfc822) | |
165 (mapconcat 'identity (rfc822-addresses address) ", ")) | |
166 (let (pos) | |
36 | 167 |
477 | 168 ;; 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
|
169 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) |
477 | 170 ;; Strip nested comments. |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
171 (with-current-buffer (get-buffer-create " *temp*") |
477 | 172 (erase-buffer) |
173 (insert address) | |
174 (set-syntax-table lisp-mode-syntax-table) | |
175 (goto-char 1) | |
176 (while (search-forward "(" nil t) | |
177 (forward-char -1) | |
178 (skip-chars-backward " \t") | |
179 (delete-region (point) | |
3118
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
180 (save-excursion |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
181 (condition-case () |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
182 (forward-sexp 1) |
e7dd24a618fb
(mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents:
2307
diff
changeset
|
183 (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
|
184 (point)))) |
477 | 185 (setq address (buffer-string)) |
186 (erase-buffer)) | |
187 ;; Strip non-nested comments an easier way. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
188 (while (setq pos (string-match |
477 | 189 ;; This doesn't hack rfc822 nested comments |
190 ;; `(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
|
191 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" |
477 | 192 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
193 (setq address (replace-match "" nil nil address 0)))) |
36 | 194 |
22002
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
195 ;; strip surrounding whitespace |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
196 (string-match "\\`[ \t\n]*" address) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
197 (setq address (substring 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 (string-match "[ \t\n]*\\'" address |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
200 (match-end 0)))) |
c40d3d44e6fd
(mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents:
21907
diff
changeset
|
201 |
477 | 202 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>') |
203 (setq pos 0) | |
204 (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
|
205 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)" |
477 | 206 address pos)) |
207 ;; If the next thing is "@", we have "foo bar"@host. Leave it. | |
208 (if (and (> (length address) (match-end 0)) | |
209 (= (aref address (match-end 0)) ?@)) | |
210 (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
|
211 ;; Otherwise discard the "..." part. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
212 (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
|
213 ;; 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
|
214 ;; the part between the <...>. |
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
215 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)" |
477 | 216 address)) |
30333
6c60ac6cf8b6
(mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents:
27682
diff
changeset
|
217 (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
|
218 nil 'literal address 2))) |
477 | 219 address)))) |
36 | 220 |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
221 ;;; 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
|
222 ;;; 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
|
223 ;;; 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
|
224 ;;; 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
|
225 ;;; 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
|
226 ;;; 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
|
227 (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
|
228 "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
|
229 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
|
230 the comma-separated list. The pruned list is returned." |
36 | 231 (if (null rmail-dont-reply-to-names) |
232 (setq rmail-dont-reply-to-names | |
233 (concat (if rmail-default-dont-reply-to-names | |
234 (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
|
235 "") |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
236 (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
|
237 (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
|
238 ;; 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
|
239 ;; 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
|
240 ;; 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
|
241 ;; "barfoo@baz.com". |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
242 (concat "\\`" |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
243 (regexp-quote user-mail-address) |
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
244 "\\'\\|") |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
245 "") |
53968
d65998606b6d
(rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53569
diff
changeset
|
246 (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
|
247 ;; 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
|
248 (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
|
249 (case-fold-search t)) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
250 (while start-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
251 (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
|
252 (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
|
253 ;; Search for matching quote. |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
254 (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
|
255 (if next-pos |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
256 (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
|
257 ;; 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
|
258 ;; 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
|
259 ;; 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
|
260 ;; are weird elsewhere. |
44026
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
261 (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
|
262 (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
|
263 (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
|
264 (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
|
265 (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
|
266 (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
|
267 (setq destinations (concat (substring destinations 0 start-pos) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
44033
diff
changeset
|
268 (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
|
269 (1+ cur-pos)))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
270 cur-pos start-pos) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
271 (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
|
272 start-pos cur-pos)))))) |
55bcbf42cf3f
(rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents:
38597
diff
changeset
|
273 ;; get rid of any trailing commas |
44033
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
274 (let ((pos (string-match "[ ,\t\n]*\\'" destinations))) |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
275 (if pos |
588b5b177b8a
Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents:
44026
diff
changeset
|
276 (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
|
277 ;; 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
|
278 (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
|
279 (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
|
280 destinations)) |
27460
cccffb3304b3
(rmail-dont-reply-to): Replace matched
Gerd Moellmann <gerd@gnu.org>
parents:
25271
diff
changeset
|
281 |
36 | 282 |
5289
4e000b7b285a
(mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
5095
diff
changeset
|
283 ;;;###autoload |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
284 (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
|
285 "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
|
286 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
|
287 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
|
288 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
|
289 If 4th arg LIST is non-nil, return a list of all such fields." |
36 | 290 (save-excursion |
291 (goto-char (point-min)) | |
292 (let ((case-fold-search t) | |
293 (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
|
294 (if (or all list) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
295 (let ((value (if all ""))) |
36 | 296 (while (re-search-forward name nil t) |
297 (let ((opoint (point))) | |
298 (while (progn (forward-line 1) | |
299 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
300 ;; 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
|
301 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
302 (skip-chars-backward " \t" opoint) |
16952
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
303 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
304 (setq value (cons (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
305 opoint (point)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
306 value)) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
307 (setq value (concat value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
308 (if (string= value "") "" ", ") |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
309 (buffer-substring-no-properties |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
310 opoint (point))))))) |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
311 (if list |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
312 value |
ba0d48943e13
(mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents:
16062
diff
changeset
|
313 (and (not (string= value "")) value))) |
36 | 314 (if (re-search-forward name nil t) |
315 (progn | |
316 (if last (while (re-search-forward name nil t))) | |
317 (let ((opoint (point))) | |
318 (while (progn (forward-line 1) | |
319 (looking-at "[ \t]"))) | |
5095
976d7492e00e
(mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents:
4022
diff
changeset
|
320 ;; 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
|
321 (forward-char -1) |
14989
7bba84af4b94
(mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents:
14660
diff
changeset
|
322 (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
|
323 (buffer-substring-no-properties opoint (point))))))))) |
36 | 324 |
325 ;; Parse a list of tokens separated by commas. | |
326 ;; It runs from point to the end of the visible part of the buffer. | |
327 ;; Whitespace before or after tokens is ignored, | |
328 ;; but whitespace within tokens is kept. | |
329 (defun mail-parse-comma-list () | |
330 (let (accumulated | |
331 beg) | |
20409 | 332 (skip-chars-forward " \t\n") |
36 | 333 (while (not (eobp)) |
334 (setq beg (point)) | |
335 (skip-chars-forward "^,") | |
20409 | 336 (skip-chars-backward " \t\n") |
36 | 337 (setq accumulated |
18204
0634e43b52c8
(mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents:
18082
diff
changeset
|
338 (cons (buffer-substring-no-properties beg (point)) |
36 | 339 accumulated)) |
340 (skip-chars-forward "^,") | |
20409 | 341 (skip-chars-forward ", \t\n")) |
36 | 342 accumulated)) |
343 | |
344 (defun mail-comma-list-regexp (labels) | |
345 (let (pos) | |
346 (setq pos (or (string-match "[^ \t]" labels) 0)) | |
347 ;; Remove leading and trailing whitespace. | |
348 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos))) | |
349 ;; Change each comma to \|, and flush surrounding whitespace. | |
350 (while (setq pos (string-match "[ \t]*,[ \t]*" labels)) | |
351 (setq labels | |
352 (concat (substring labels 0 pos) | |
353 "\\|" | |
354 (substring labels (match-end 0)))))) | |
355 labels) | |
4022
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
356 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
357 (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
|
358 (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
|
359 (absmin (/ (abs sec) 60))) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
360 (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
|
361 |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
362 (defun mail-rfc822-date () |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
363 (let* ((time (current-time)) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
364 (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
|
365 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) |
a3d3d7eef5ce
(mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents:
3118
diff
changeset
|
366 (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
|
367 (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
|
368 (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
|
369 (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
|
370 (mail-rfc822-time-zone time)))) |
584 | 371 |
372 (provide 'mail-utils) | |
373 | |
52401 | 374 ;;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
375 ;;; mail-utils.el ends here |