annotate lisp/mail/mail-utils.el @ 112095:96d88ed18438

* lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the " *temp*" buffer.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sat, 01 Jan 2011 22:16:03 -0500
parents f8b430cb91a7
children 40af77a50adc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
923ce6cefb8e (mail-fetch-field): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 101102
diff changeset
3 ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
112092
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
4 ;; 2009, 2010, 2011 Free Software Foundation, Inc.
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 811
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
15
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
20
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
362f4c3bd99c Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 5289
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
30
285
adb31fcccc2b *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 268
diff changeset
31 ;;; We require lisp-mode to make sure that lisp-mode-syntax-table has
adb31fcccc2b *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 268
diff changeset
32 ;;; been initialized.
adb31fcccc2b *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 268
diff changeset
33 (require 'lisp-mode)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 44033
diff changeset
34
268
2dd411fe2f72 *** empty log message ***
Brian Preble <rassilon@gnu.org>
parents: 262
diff changeset
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
2dd411fe2f72 *** empty log message ***
Brian Preble <rassilon@gnu.org>
parents: 262
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
51 (defun mail-string-delete (string start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
52 "Returns a string containing all of STRING except the part
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
53 from START (inclusive) to END (exclusive)."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
54 (if (null end) (substring string 0 start)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
55 (concat (substring string 0 start)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
56 (substring string end nil))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
3c0b3d55c1bc Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17425
diff changeset
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
3c0b3d55c1bc Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17425
diff changeset
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
3c0b3d55c1bc Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17425
diff changeset
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
3c0b3d55c1bc Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17425
diff changeset
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
3c0b3d55c1bc Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17425
diff changeset
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
107080
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
126 ;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el.
25271
0d9fd0e4f7a3 (mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents: 22949
diff changeset
127 ;;;###autoload
54261
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
128 (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
129 unibyte)
25271
0d9fd0e4f7a3 (mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents: 22949
diff changeset
130 "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
131 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
132 we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
107080
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
133 On encountering malformed quoted-printable text, exits with an error,
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
134 unless NOERROR is non-nil, in which case it continues, and returns nil
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
135 when finished. Returns non-nil on successful completion.
54261
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
136 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
137 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
138 as Rmail does."
106953
a1e356d208cd * mail/rmailmm.el (rmail-mime-handle): Don't set the buffer to unibyte
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 106815
diff changeset
139 ;; FIXME: `unibyte' should always be non-nil, and the iso-latin-1
a1e356d208cd * mail/rmailmm.el (rmail-mime-handle): Don't set the buffer to unibyte
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 106815
diff changeset
140 ;; specific handling should be removed (or moved elsewhere and generalized).
25271
0d9fd0e4f7a3 (mail-unquote-printable): Make it autoload.
Karl Heuer <kwzh@gnu.org>
parents: 22949
diff changeset
141 (interactive "r\nP")
53569
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
142 (let (failed)
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
143 (save-match-data
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
144 (save-excursion
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
145 (save-restriction
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
146 (narrow-to-region beg end)
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
147 (goto-char (point-min))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
148 (when (and wrapper
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
149 (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
150 (delete-region (match-end 1) end)
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
151 (delete-region (point) (match-beginning 1)))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
152 (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
153 (goto-char (match-end 0))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
154 (cond ((= (char-after (match-beginning 1)) ?\n)
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
155 (replace-match ""))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
156 ((= (char-after (match-beginning 1)) ?=)
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
157 (replace-match "="))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
158 ((match-beginning 2)
54261
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
159 (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
160 (char-after (match-beginning 2))))
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
161 (mail-unquote-printable-hexdigit
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
162 (char-after (1+ (match-beginning 2)))))))
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
163 (if unibyte
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
164 (progn
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
165 (replace-match "")
98411
c5fb918370c8 (mail-unquote-printable-region): Use insert-byte instead of insert-char,
Eli Zaretskii <eliz@gnu.org>
parents: 94674
diff changeset
166 ;; 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
167 ;; 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
168 (insert-byte char 1))
54261
94db0f6330b3 (mail-unquote-printable-region): New arg UNIBYTE.
Richard M. Stallman <rms@gnu.org>
parents: 53968
diff changeset
169 (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
170 (noerror
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
171 (setq failed t))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
172 (t
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
173 (error "Malformed MIME quoted-printable message"))))
3b872f61f08d (mail-unquote-printable-hexdigit): Upcase CHAR.
Richard M. Stallman <rms@gnu.org>
parents: 52401
diff changeset
174 (not failed))))))
17425
10076111abf2 (mail-quote-printable, mail-unquote-printable)
Richard M. Stallman <rms@gnu.org>
parents: 17258
diff changeset
175
44033
588b5b177b8a Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents: 44026
diff changeset
176 (eval-when-compile (require 'rfc822))
588b5b177b8a Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents: 44026
diff changeset
177
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
178 (defun mail-strip-quoted-names (address)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
179 "Delete comments and quoted strings in an address list ADDRESS.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
180 Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
181 Return a modified address list."
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
182 (if (null address)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
183 nil
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
184 (if mail-use-rfc822
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
185 (progn (require 'rfc822)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
186 (mapconcat 'identity (rfc822-addresses address) ", "))
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
187 (let (pos)
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
188
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
189 ;; 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
190 (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
191 ;; Strip nested comments.
112093
f8b430cb91a7 Mail-utils fix for bug#7746. (tiny change)
Glenn Morris <rgm@gnu.org>
parents: 112092
diff changeset
192 (with-temp-buffer
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
193 (insert address)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
194 (set-syntax-table lisp-mode-syntax-table)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
195 (goto-char 1)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
196 (while (search-forward "(" nil t)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
197 (forward-char -1)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
198 (skip-chars-backward " \t")
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
199 (delete-region (point)
3118
e7dd24a618fb (mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents: 2307
diff changeset
200 (save-excursion
e7dd24a618fb (mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents: 2307
diff changeset
201 (condition-case ()
e7dd24a618fb (mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents: 2307
diff changeset
202 (forward-sexp 1)
e7dd24a618fb (mail-strip-quoted-names): Catch errors from forward-sexp.
Richard M. Stallman <rms@gnu.org>
parents: 2307
diff changeset
203 (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
204 (point))))
112093
f8b430cb91a7 Mail-utils fix for bug#7746. (tiny change)
Glenn Morris <rgm@gnu.org>
parents: 112092
diff changeset
205 (setq address (buffer-string)))
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
206 ;; Strip non-nested comments an easier way.
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 44033
diff changeset
207 (while (setq pos (string-match
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
208 ;; This doesn't hack rfc822 nested comments
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
209 ;; `(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
210 "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)"
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
211 address))
30333
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 0))))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
213
22002
c40d3d44e6fd (mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents: 21907
diff changeset
214 ;; strip surrounding whitespace
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 (setq address (substring address
c40d3d44e6fd (mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents: 21907
diff changeset
217 (match-end 0)
c40d3d44e6fd (mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents: 21907
diff changeset
218 (string-match "[ \t\n]*\\'" address
c40d3d44e6fd (mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents: 21907
diff changeset
219 (match-end 0))))
c40d3d44e6fd (mail-strip-quoted-names):
Richard M. Stallman <rms@gnu.org>
parents: 21907
diff changeset
220
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
221 ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
222 (setq pos 0)
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
223 (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
224 "\\([ \t]?\\)\\([ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*\\)"
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
225 address pos))
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
226 ;; If the next thing is "@", we have "foo bar"@host. Leave it.
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
227 (if (and (> (length address) (match-end 0))
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
228 (= (aref address (match-end 0)) ?@))
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
229 (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
230 ;; Otherwise discard the "..." part.
6c60ac6cf8b6 (mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents: 27682
diff changeset
231 (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
232 ;; 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
233 ;; the part between the <...>.
6c60ac6cf8b6 (mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents: 27682
diff changeset
234 (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)\\([^,]*<\\([^>,:]*\\)>[^,]*\\)\\(\\s-*,\\|\\'\\)"
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
235 address))
30333
6c60ac6cf8b6 (mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents: 27682
diff changeset
236 (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
237 nil 'literal address 2)))
477
ab9a55b26bd4 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 285
diff changeset
238 address))))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
239
112095
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
240 ;; The following piece of ugliness is legacy code. The name was an
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
241 ;; unfortunate choice --- a flagrant violation of the Emacs Lisp
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
242 ;; coding conventions. `mail-dont-reply-to' would have been
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
243 ;; infinitely better. Also, `rmail-dont-reply-to-names' might have
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
244 ;; been better named `mail-dont-reply-to-names' and sourced from this
96d88ed18438 * lisp/mail/mail-utils.el (mail-strip-quoted-names): Don't modify the
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112093
diff changeset
245 ;; file instead of in rmail.el. Yuck. -pmr
44026
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
246 (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
247 "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
248 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
249 the comma-separated list. The pruned list is returned."
107080
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
250 ;; FIXME this (setting a user option the first time a command is used)
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
251 ;; is somewhat strange. Normally one would never set the option,
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
252 ;; but instead fall back to the default so long as it was nil.
da4ec7ca387c * mail/mail-utils.el (mail-unquote-printable-region): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 106953
diff changeset
253 ;; Or just set the default directly in the defcustom.
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
254 (if (null rmail-dont-reply-to-names)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
255 (setq rmail-dont-reply-to-names
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
256 (concat (if rmail-default-dont-reply-to-names
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
257 (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
258 "")
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
259 (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
260 (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
261 ;; 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
262 ;; 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
263 ;; 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
264 ;; "barfoo@baz.com".
d65998606b6d (rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53569
diff changeset
265 (concat "\\`"
d65998606b6d (rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53569
diff changeset
266 (regexp-quote user-mail-address)
d65998606b6d (rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53569
diff changeset
267 "\\'\\|")
44026
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
268 "")
53968
d65998606b6d (rmail-dont-reply-to): Anchor user login
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53569
diff changeset
269 (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
270 ;; 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
271 (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
272 (case-fold-search t))
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
273 (while start-pos
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
274 (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
275 (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
276 ;; Search for matching quote.
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
277 (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
278 (if next-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 (1+ next-pos))
30333
6c60ac6cf8b6 (mail-strip-quoted-names): Handle case where <...> appears inside "...".
Richard M. Stallman <rms@gnu.org>
parents: 27682
diff changeset
280 ;; 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
281 ;; 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
282 ;; 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
283 ;; are weird elsewhere.
44026
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
284 (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
285 (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
286 (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
287 (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
288 (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
289 (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
290 (setq destinations (concat (substring destinations 0 start-pos)
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 44033
diff changeset
291 (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
292 (1+ cur-pos))))
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
293 cur-pos start-pos)
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
294 (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
295 start-pos cur-pos))))))
55bcbf42cf3f (rmail-dont-reply-to): Overhaul to correctly apply the regular
Paul Reilly <pmr@pajato.com>
parents: 38597
diff changeset
296 ;; get rid of any trailing commas
44033
588b5b177b8a Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents: 44026
diff changeset
297 (let ((pos (string-match "[ ,\t\n]*\\'" destinations)))
588b5b177b8a Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents: 44026
diff changeset
298 (if pos
588b5b177b8a Eliminate compilation warnings due to `rfc822-addresses'.
Paul Reilly <pmr@pajato.com>
parents: 44026
diff changeset
299 (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
300 ;; 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
301 (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
302 (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
303 destinations))
27460
cccffb3304b3 (rmail-dont-reply-to): Replace matched
Gerd Moellmann <gerd@gnu.org>
parents: 25271
diff changeset
304
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
305
5289
4e000b7b285a (mail-fetch-field): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents: 5095
diff changeset
306 ;;;###autoload
16952
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
307 (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
308 "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
309 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
310 If third arg ALL is non-nil, concatenate all such fields with commas between.
101696
923ce6cefb8e (mail-fetch-field): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 101102
diff changeset
311 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
312 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
313 matches may be returned from the message body."
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
314 (save-excursion
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
315 (goto-char (point-min))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
316 (let ((case-fold-search t)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
317 (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
318 (if (or all list)
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
319 (let ((value (if all "")))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
320 (while (re-search-forward name nil t)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
321 (let ((opoint (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
322 (while (progn (forward-line 1)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
323 (looking-at "[ \t]")))
5095
976d7492e00e (mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents: 4022
diff changeset
324 ;; 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
325 (forward-char -1)
14989
7bba84af4b94 (mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents: 14660
diff changeset
326 (skip-chars-backward " \t" opoint)
16952
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
327 (if list
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
328 (setq value (cons (buffer-substring-no-properties
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
329 opoint (point))
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
330 value))
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
331 (setq value (concat value
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
332 (if (string= value "") "" ", ")
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
333 (buffer-substring-no-properties
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
334 opoint (point)))))))
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
335 (if list
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
336 value
ba0d48943e13 (mail-fetch-field): New arg LIST.
Richard M. Stallman <rms@gnu.org>
parents: 16062
diff changeset
337 (and (not (string= value "")) value)))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
338 (if (re-search-forward name nil t)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
339 (progn
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
340 (if last (while (re-search-forward name nil t)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
341 (let ((opoint (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
342 (while (progn (forward-line 1)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
343 (looking-at "[ \t]")))
5095
976d7492e00e (mail-fetch-field): Exclude trailing whitespace.
Richard M. Stallman <rms@gnu.org>
parents: 4022
diff changeset
344 ;; 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
345 (forward-char -1)
14989
7bba84af4b94 (mail-fetch-field): Use skip-chars-backward
Richard M. Stallman <rms@gnu.org>
parents: 14660
diff changeset
346 (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
347 (buffer-substring-no-properties opoint (point)))))))))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
348
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
349 ;; Parse a list of tokens separated by commas.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
350 ;; It runs from point to the end of the visible part of the buffer.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
351 ;; Whitespace before or after tokens is ignored,
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
352 ;; but whitespace within tokens is kept.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
353 (defun mail-parse-comma-list ()
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
354 (let (accumulated
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
355 beg)
20409
87d7cc50d029 (mail-parse-comma-list):
Karl Heuer <kwzh@gnu.org>
parents: 19563
diff changeset
356 (skip-chars-forward " \t\n")
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
357 (while (not (eobp))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
358 (setq beg (point))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
359 (skip-chars-forward "^,")
20409
87d7cc50d029 (mail-parse-comma-list):
Karl Heuer <kwzh@gnu.org>
parents: 19563
diff changeset
360 (skip-chars-backward " \t\n")
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
361 (setq accumulated
18204
0634e43b52c8 (mail-parse-comma-list): Use buffer-substring-no-properties.
Richard M. Stallman <rms@gnu.org>
parents: 18082
diff changeset
362 (cons (buffer-substring-no-properties beg (point))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
363 accumulated))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
364 (skip-chars-forward "^,")
20409
87d7cc50d029 (mail-parse-comma-list):
Karl Heuer <kwzh@gnu.org>
parents: 19563
diff changeset
365 (skip-chars-forward ", \t\n"))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
366 accumulated))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
367
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
368 (defun mail-comma-list-regexp (labels)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
369 (let (pos)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
370 (setq pos (or (string-match "[^ \t]" labels) 0))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
371 ;; Remove leading and trailing whitespace.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
372 (setq labels (substring labels pos (string-match "[ \t]*$" labels pos)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
373 ;; Change each comma to \|, and flush surrounding whitespace.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
374 (while (setq pos (string-match "[ \t]*,[ \t]*" labels))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
375 (setq labels
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
376 (concat (substring labels 0 pos)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
377 "\\|"
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
378 (substring labels (match-end 0))))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
379 labels)
4022
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
380
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
381 (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
382 (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
383 (absmin (/ (abs sec) 60)))
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
384 (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
385
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
386 (defun mail-rfc822-date ()
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
387 (let* ((time (current-time))
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
388 (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
389 (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s)
a3d3d7eef5ce (mail-rfc822-time-zone, mail-rfc822-date): New fns.
Richard M. Stallman <rms@gnu.org>
parents: 3118
diff changeset
390 (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
391 (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
392 (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
393 (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
394 (mail-rfc822-time-zone time))))
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 477
diff changeset
395
102091
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
396 (defun mail-mbox-from ()
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
397 "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
398 The buffer should be narrowed to just the header."
112092
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
399 (let* ((from (mail-strip-quoted-names (or (mail-fetch-field "from")
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
400 (mail-fetch-field "really-from")
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
401 (mail-fetch-field "sender")
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
402 (mail-fetch-field "return-path")
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
403 "unknown")))
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
404 (date (mail-fetch-field "date"))
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
405 ;; A From: header can contain multiple addresses, a "From "
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
406 ;; line must contain only one. (Bug#7760)
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
407 ;; See eg RFC 5322, 3.6.2. Originator Fields.
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
408 (end (string-match "[ \t]*[,\n]" from)))
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
409 (format "From %s %s\n" (if end
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
410 (substring from 0 end)
c343ad0f54f7 Small mail-utils fix for bug 7760.
Glenn Morris <rgm@gnu.org>
parents: 110923
diff changeset
411 from)
102091
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
412 (or (and date
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
413 (ignore-errors
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
414 (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
415 (current-time-string)))))
dd4853d4b1e2 (mail-mbox-from): Move here from rmailout.el.
Glenn Morris <rgm@gnu.org>
parents: 101919
diff changeset
416
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 477
diff changeset
417 (provide 'mail-utils)
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 477
diff changeset
418
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
419 ;;; mail-utils.el ends here