Mercurial > emacs

annotate lisp/mail/mailheader.el @ 24103:4adfa5300fd8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(RVA_TO_PTR): Redefine to convert RVA to address in current process. (round_to_next): Obsolete function removed. (preload_heap_section): New variable. (data_region_size): Obsolete variable removed. (allocate_heap): Modified to determine end of static heap section used during preload, and use that as initial base address for dynamic heap instead of hard-coded value. (sbrk): Remove call to allocate_heap; handled by init_heap. Skip calls to commit or decommit pages when allocating from static heap section during preload. (recreate_heap): Obsolete function removed. (init_heap): New function to initialize internal sbrk heap variables. Uses static heap section during preload, otherwise calls allocate_heap to reserve a heap region dynamically. (round_heap): Use ROUND_UP macro instead of round_to_next.
author Andrew Innes <andrewi@gnu.org>
date Sun, 17 Jan 1999 19:22:55 +0000 (1999-01-17)
parents 011361a15bac
children 6d8687925869
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
1 ;;; mailheader.el --- Mail header parsing, merging, formatting
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
2
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
3 ;; Copyright (C) 1996 by Free Software Foundation, Inc.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
4
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
5 ;; Author: Erik Naggum <erik@arcana.naggum.no>
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
6 ;; Keywords: tools, mail, news
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
7
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
9
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
13 ;; any later version.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
14
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
19
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
24
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
25 ;;; Commentary:
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
26
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
27 ;; 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
28 ;; 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
29 ;; headers, such as quoting and line folding, are routinely reimplemented
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
30 ;; in many individual packages. This package removes the need for this
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
31 ;; redundancy by representing message headers as association lists,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
32 ;; offering functions to extract the set of headers from a message, to
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
33 ;; 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
34 ;; of headers.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
35
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
36 ;; 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
37 ;; 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
38 ;; element depends on the operation. After extracting headers from a
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
39 ;; messge, it is a string, the value of the header. An extracted set of
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
40 ;; 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
41 ;; is the original value and whose subsequent elements depend on the
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
42 ;; header. For formatting, it is evaluated to obtain the strings to be
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
43 ;; inserted. For merging, one set of headers consists of strings, while
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
44 ;; 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
45 ;; headers bound to their respective values.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
46
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
47 ;;; Code:
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
48
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
49 (eval-when-compile
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
50 (require 'cl))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
51
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
52 ;; Make the byte-compiler shut up.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
53 (defvar headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
54
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
55 (defun mail-header-extract ()
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
56 "Extract headers from current buffer after point.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
57 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
58 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
59 that name."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
60 (let ((message-headers ()) (top (point))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
61 start end)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
62 (while (and (setq start (point))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
63 (> (skip-chars-forward "^\0- :") 0)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
64 (= (following-char) ?:)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
65 (setq end (point))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
66 (progn (forward-char)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
67 (> (skip-chars-forward " \t") 0)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
68 (let ((header (intern (downcase (buffer-substring start end))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
69 (value (list (buffer-substring
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
70 (point) (progn (end-of-line) (point))))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
71 (while (progn (forward-char) (> (skip-chars-forward " \t") 0))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
72 (push (buffer-substring (point) (progn (end-of-line) (point)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
73 value))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
74 (push (if (cdr value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
75 (cons header (mapconcat #'identity (nreverse value) " "))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
76 (cons header (car value)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
77 message-headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
78 (goto-char top)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
79 (nreverse message-headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
80
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
81 (defun mail-header-extract-no-properties ()
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
82 "Extract headers from current buffer after point, without properties.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
83 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
84 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
85 that name."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
86 (mapcar
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
87 (lambda (elt)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
88 (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
89 elt)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
90 (mail-header-extract)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
91
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
92 (defun mail-header-parse (parsing-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
93 "Apply PARSING-RULES to HEADERS.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
94 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
95 value is a parsing function. The function takes one argument, a string,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
96 and return a list of values, which will destructively replace the value
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
97 associated with the key in HEADERS, after being prepended with the original
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
98 value."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
99 (dolist (rule parsing-rules)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
100 (let ((header (assq (car rule) headers)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
101 (when header
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
102 (if (consp (cdr header))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
103 (setf (cddr header) (funcall (cdr rule) (cadr header)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
104 (setf (cdr header)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
105 (cons (cdr header) (funcall (cdr rule) (cdr header))))))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
106 headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
107
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
108 (defsubst mail-header (header &optional header-alist)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
109 "Return the value associated with header HEADER in HEADER-ALIST.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
110 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
111 value is a list, its first element is the original value of the header,
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
112 with any subsequent elements bing the result of parsing the value.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
113 If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
114 (cdr (assq header (or header-alist headers))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
115
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
116 (defun mail-header-set (header value &optional header-alist)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
117 "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
118 HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
119 See `mail-header' for the semantics of VALUE."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
120 (let* ((alist (or header-alist headers))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
121 (entry (assq header alist)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
122 (if entry
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
123 (setf (cdr entry) value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
124 (nconc alist (list (cons header value)))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
125 value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
126
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
127 (defsetf mail-header (header &optional header-alist) (value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
128 `(mail-header-set ,header ,value ,header-alist))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
129
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
130 (defun mail-header-merge (merge-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
131 "Return a new header alist with MERGE-RULES applied to HEADERS.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
132 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
133 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
134 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
135 denote that the formatting functions must use the remaining elements, or
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
136 skip the header altogether if there are no other elements.
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
137 The macro `mail-header' can be used to access headers in HEADERS."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
138 (mapcar
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
139 (lambda (rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
140 (cons (car rule) (eval (cdr rule))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
141 merge-rules))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
142
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
143 (defvar mail-header-format-function
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
144 (lambda (header value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
145 "Function to format headers without a specified formatting function."
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
146 (insert (capitalize (symbol-name header))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
147 ": "
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
148 (if (consp value) (car value) value)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
149 "\n")))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
150
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
151 (defun mail-header-format (format-rules headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
152 "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
153 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
154 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
155 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
156
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
157 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
158 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
159 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
160 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
161 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
162
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
163 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
164 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
165 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
166
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
167 The headers are inserted in the order of the FORMAT-RULES.
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
168 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
169 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
170 (let ((ignore (append (cdr (assq nil format-rules))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
171 (mapcar #'car format-rules))))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
172 (dolist (rule format-rules)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
173 (let* ((header (car rule))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
174 (value (mail-header header)))
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
175 (if (stringp header)
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
176 (setq header (intern header)))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
177 (cond ((null header) 'ignore)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
178 ((eq header t)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
179 (dolist (defaulted headers)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
180 (unless (memq (car defaulted) ignore)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
181 (let* ((header (car defaulted))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
182 (value (cdr defaulted)))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
183 (if (cdr rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
184 (funcall (cdr rule) header value)
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
185 (funcall mail-header-format-function header value))))))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
186 (value
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
187 (if (cdr rule)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
188 (funcall (cdr rule) header value)
22866
011361a15bac (mail-header-format): Convert string to symbol.
Richard M. Stallman <rms@gnu.org>
parents: 15580
diff changeset
189 (funcall mail-header-format-function header value))))))
15512
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
190 (insert "\n")))
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
191
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
192 (provide 'mailheader)
47d9b7a1dee3 Initial revision
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
diff changeset
193
15580
1808d2672d00 (require 'cl) is only necessary when compiling.
Erik Naggum <erik@naggum.no>
parents: 15512
diff changeset
194 ;;; mailheader.el ends here