annotate lisp/mail/mailheader.el @ 101683:1c8fb01a3229

Fix typo.
author Chong Yidong <cyd@stupidchicken.com>
date Fri, 30 Jan 2009 18:13:39 +0000
parents a9dc0e7c3f2b
children 1d1d5d9bd884
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 33413
diff changeset
1 ;;; mailheader.el --- mail header parsing, merging, formatting
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2
74509
f7702c5f335d Update copyright years.
Glenn Morris <rgm@gnu.org>
parents: 68648
diff changeset
3 ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005,
100908
a9dc0e7c3f2b Add 2009 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 94674
diff changeset
4 ;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5
30316
a0e2fa7d8bb7 Correct author's mail address.
Gerd Moellmann <gerd@gnu.org>
parents: 26135
diff changeset
6 ;; Author: Erik Naggum <erik@naggum.no>
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7 ;; Keywords: tools, mail, news
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.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
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.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.
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.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/>.
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
23
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24 ;;; Commentary:
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26 ;; This package provides an abstraction to RFC822-style messages, used in
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
27 ;; mail, news, and some other systems. The simple syntactic rules for such
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
28 ;; headers, such as quoting and line folding, are routinely reimplemented
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
29 ;; in many individual packages. This package removes the need for this
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 ;; redundancy by representing message headers as association lists,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 ;; offering functions to extract the set of headers from a message, to
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 ;; parse individual headers, to merge sets of headers, and to format a set
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 ;; of headers.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
34
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35 ;; The car of each element in the message-header alist is a symbol whose
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 ;; print name is the name of the header, in all lower-case. The cdr of an
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
37 ;; element depends on the operation. After extracting headers from a
33413
ac84f72e0a9f comment fix
Dave Love <fx@gnu.org>
parents: 30316
diff changeset
38 ;; message, it is a string, the value of the header. An extracted set of
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 ;; headers may be parsed further, which may turn it into a list, whose car
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 ;; is the original value and whose subsequent elements depend on the
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
41 ;; header. For formatting, it is evaluated to obtain the strings to be
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 ;; inserted. For merging, one set of headers consists of strings, while
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 ;; the other set will be evaluated with the symbols in the first set of
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 ;; headers bound to their respective values.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
45
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46 ;;; Code:
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
48 (eval-when-compile
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
49 (require 'cl))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
50
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51 ;; Make the byte-compiler shut up.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 (defvar headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54 (defun mail-header-extract ()
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 "Extract headers from current buffer after point.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56 Returns a header alist, where each element is a cons cell (name . value),
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57 where NAME is a symbol, and VALUE is the string value of the header having
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
58 that name."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
59 (let ((message-headers ()) (top (point))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 start end)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61 (while (and (setq start (point))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 (> (skip-chars-forward "^\0- :") 0)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 (= (following-char) ?:)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 (setq end (point))
26135
6d8687925869 (mail-header-extract, mail-header-format): Doc fix.
Dave Love <fx@gnu.org>
parents: 22866
diff changeset
65 (progn (forward-char)
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66 (> (skip-chars-forward " \t") 0)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 (let ((header (intern (downcase (buffer-substring start end))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (value (list (buffer-substring
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 (point) (progn (end-of-line) (point))))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (while (progn (forward-char) (> (skip-chars-forward " \t") 0))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 (push (buffer-substring (point) (progn (end-of-line) (point)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 value))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 (push (if (cdr value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 (cons header (mapconcat #'identity (nreverse value) " "))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 (cons header (car value)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 message-headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 (goto-char top)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 (nreverse message-headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80 (defun mail-header-extract-no-properties ()
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 "Extract headers from current buffer after point, without properties.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 Returns a header alist, where each element is a cons cell (name . value),
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 where NAME is a symbol, and VALUE is the string value of the header having
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
84 that name."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
85 (mapcar
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 (lambda (elt)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 elt)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 (mail-header-extract)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91 (defun mail-header-parse (parsing-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 "Apply PARSING-RULES to HEADERS.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 PARSING-RULES is an alist whose keys are header names (symbols) and whose
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 value is a parsing function. The function takes one argument, a string,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
95 and return a list of values, which will destructively replace the value
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 associated with the key in HEADERS, after being prepended with the original
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 value."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 (dolist (rule parsing-rules)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 (let ((header (assq (car rule) headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (when header
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (if (consp (cdr header))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 (setf (cddr header) (funcall (cdr rule) (cadr header)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 (setf (cdr header)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 (cons (cdr header) (funcall (cdr rule) (cdr header))))))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107 (defsubst mail-header (header &optional header-alist)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 "Return the value associated with header HEADER in HEADER-ALIST.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 If the value is a string, it is the original value of the header. If the
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 value is a list, its first element is the original value of the header,
26135
6d8687925869 (mail-header-extract, mail-header-format): Doc fix.
Dave Love <fx@gnu.org>
parents: 22866
diff changeset
111 with any subsequent elements being the result of parsing the value.
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 (cdr (assq header (or header-alist headers))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115 (defun mail-header-set (header value &optional header-alist)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 See `mail-header' for the semantics of VALUE."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 (let* ((alist (or header-alist headers))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (entry (assq header alist)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 (if entry
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (setf (cdr entry) value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (nconc alist (list (cons header value)))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126 (defsetf mail-header (header &optional header-alist) (value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 `(mail-header-set ,header ,value ,header-alist))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129 (defun mail-header-merge (merge-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 "Return a new header alist with MERGE-RULES applied to HEADERS.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 MERGE-RULES is an alist whose keys are header names (symbols) and whose
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 values are forms to evaluate, the results of which are the new headers. It
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
133 should be a string or a list of string. The first element may be nil to
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
134 denote that the formatting functions must use the remaining elements, or
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
135 skip the header altogether if there are no other elements.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 The macro `mail-header' can be used to access headers in HEADERS."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 (mapcar
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (lambda (rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 (cons (car rule) (eval (cdr rule))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 merge-rules))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142 (defvar mail-header-format-function
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (lambda (header value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 "Function to format headers without a specified formatting function."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 (insert (capitalize (symbol-name header))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 ": "
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 (if (consp value) (car value) value)
67213
818361523ce8 * longlines.el (longlines-mode): Add mail-setup-hook.
Chong Yidong <cyd@stupidchicken.com>
parents: 66965
diff changeset
148 "\n")))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150 (defun mail-header-format (format-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 "Use FORMAT-RULES to format HEADERS and insert into current buffer.
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
152 HEADERS should be an alist of the form (HEADER . VALUE),
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
153 where HEADER is a header field name (a symbol or a string),
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
154 and VALUE is the contents for that header field.
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
155
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
156 FORMAT-RULES is an alist of elements (HEADER . FUNCTION) Here HEADER
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
157 is a header field name (a symbol), and FUNCTION is how to format that
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
158 header field, if it appears in HEADERS. Each FUNCTION should take two
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
159 arguments: the header symbol, and the value of that header. The value
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
160 returned by FUNCTION is inserted in the buffer unless it is nil.
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
161
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
162 If the function for a header field is nil, or if no function is
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
163 specified for a particular header field, the default action is to
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
164 insert the value of the header, unless it is nil.
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
165
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
166 The headers are inserted in the order of the FORMAT-RULES.
26135
6d8687925869 (mail-header-extract, mail-header-format): Doc fix.
Dave Love <fx@gnu.org>
parents: 22866
diff changeset
167 A key of t in FORMAT-RULES represents any otherwise unmentioned headers.
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
168 A key of nil has as its value a list of defaulted headers to ignore."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
169 (let ((ignore (append (cdr (assq nil format-rules))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
170 (mapcar #'car format-rules))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (dolist (rule format-rules)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 (let* ((header (car rule))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 (value (mail-header header)))
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
174 (if (stringp header)
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
175 (setq header (intern header)))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
176 (cond ((null header) 'ignore)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 ((eq header t)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 (dolist (defaulted headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (unless (memq (car defaulted) ignore)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (let* ((header (car defaulted))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (value (cdr defaulted)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (if (cdr rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (funcall (cdr rule) header value)
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
184 (funcall mail-header-format-function header value))))))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
185 (value
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (if (cdr rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 (funcall (cdr rule) header value)
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
188 (funcall mail-header-format-function header value))))))
67213
818361523ce8 * longlines.el (longlines-mode): Add mail-setup-hook.
Chong Yidong <cyd@stupidchicken.com>
parents: 66965
diff changeset
189 (insert "\n")))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191 (provide 'mailheader)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 79712
diff changeset
193 ;; arch-tag: 6e7aa221-80b5-4b3d-b46f-fd66ab567be0
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
194 ;;; mailheader.el ends here