Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-digest.el @ 136:b980b6286996 r20-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b2
author cvs
date Mon, 13 Aug 2007 09:31:12 +0200
parents 7d55a9ba150c
children 585fb297b004
comparison
equal deleted inserted replaced
135:4636a6841cd6 136:b980b6286996
52 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)") 52 (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)")
53 (vm-reorder-message-headers nil keep-list discard-regexp))))) 53 (vm-reorder-message-headers nil keep-list discard-regexp)))))
54 (goto-char (point-max)) 54 (goto-char (point-max))
55 (insert "------- end of forwarded message -------\n")))) 55 (insert "------- end of forwarded message -------\n"))))
56 56
57 (defun vm-mime-encapsulate-messages (message-list keep-list discard-regexp) 57 (defun vm-mime-encapsulate-messages (message-list keep-list discard-regexp
58 always-use-digest)
58 "Encapsulate the messages in MESSAGE-LIST as per the MIME spec. 59 "Encapsulate the messages in MESSAGE-LIST as per the MIME spec.
59 The resulting digest is inserted at point in the current buffer. 60 The resulting digest is inserted at point in the current buffer.
60 Point is not moved. 61 Point is not moved.
61 62
62 MESSAGE-LIST should be a list of message structs (real or virtual). 63 MESSAGE-LIST should be a list of message structs (real or virtual).
65 DISCARD-REGEXP should be a regexp that matches headers to be discarded. 66 DISCARD-REGEXP should be a regexp that matches headers to be discarded.
66 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers 67 KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers
67 to be forwarded. See the docs for vm-reorder-message-headers 68 to be forwarded. See the docs for vm-reorder-message-headers
68 to find out how KEEP-LIST and DISCARD-REGEXP are used. 69 to find out how KEEP-LIST and DISCARD-REGEXP are used.
69 70
70 Returns the multipart boundary parameter (string) that should be used 71 If ALWAYS-USE-DIGEST is non-nil, always encapsulate for a multipart/digest.
71 in the Content-Type header." 72 Otherwise if there are fewer than two messages to be encapsulated
73 leave off the multipart boundary strings. The caller is assumed to
74 be using message/rfc822 or message/news encoding instead.
75
76 If multipart/digest encapsulation is done, the function returns
77 the multipart boundary parameter (string) that should be used in
78 the Content-Type header. Otherwise nil is returned."
72 (if message-list 79 (if message-list
73 (let ((target-buffer (current-buffer)) 80 (let ((target-buffer (current-buffer))
74 (boundary-positions nil) 81 (boundary-positions nil)
75 (mlist message-list) 82 (mlist message-list)
76 (mime-keep-list (append keep-list vm-mime-header-list)) 83 (mime-keep-list (append keep-list vm-mime-header-list))
77 boundary source-buffer m start n beg) 84 (boundary nil)
85 source-buffer m start n beg)
78 (save-restriction 86 (save-restriction
79 ;; narrow to a zero length region to avoid interacting 87 ;; narrow to a zero length region to avoid interacting
80 ;; with anything that might have already been inserted 88 ;; with anything that might have already been inserted
81 ;; into the buffer. 89 ;; into the buffer.
82 (narrow-to-region (point) (point)) 90 (narrow-to-region (point) (point))
95 keep-list 103 keep-list
96 mime-keep-list) 104 mime-keep-list)
97 discard-regexp) 105 discard-regexp)
98 (goto-char (point-max)) 106 (goto-char (point-max))
99 (setq mlist (cdr mlist))) 107 (setq mlist (cdr mlist)))
100 (goto-char start) 108 (if (and (< (length message-list) 2) (not always-use-digest))
101 (setq boundary (vm-mime-make-multipart-boundary)) 109 nil
102 (while (re-search-forward (concat "^--" 110 (goto-char start)
103 (regexp-quote boundary)
104 "\\(--\\)?$")
105 nil t)
106 (setq boundary (vm-mime-make-multipart-boundary)) 111 (setq boundary (vm-mime-make-multipart-boundary))
107 (goto-char start)) 112 (while (re-search-forward (concat "^--"
108 (goto-char (point-max)) 113 (regexp-quote boundary)
109 (insert "\n--" boundary "--\n") 114 "\\(--\\)?$")
110 (while boundary-positions 115 nil t)
111 (goto-char (car boundary-positions)) 116 (setq boundary (vm-mime-make-multipart-boundary))
112 (insert "\n--" boundary "\n\n") 117 (goto-char start))
113 (setq boundary-positions (cdr boundary-positions))) 118 (goto-char (point-max))
114 (goto-char start) 119 (insert "\n--" boundary "--\n")
115 (setq n (length message-list)) 120 (while boundary-positions
116 (insert (format "This is a %s%sMIME encapsulation.\n" 121 (goto-char (car boundary-positions))
117 (if (cdr message-list) 122 (insert "\n--" boundary "\n\n")
118 "digest, " 123 (setq boundary-positions (cdr boundary-positions)))
119 "forwarded message, ") 124 (goto-char start)
120 (if (cdr message-list) 125 (setq n (length message-list))
121 (format "%d messages, " n) 126 (insert
122 ""))) 127 (format "This is a digest, %d messages, MIME encapsulation.\n"
128 n)))
123 (goto-char start)) 129 (goto-char start))
124 boundary ))) 130 boundary )))
125 131
126 (defun vm-mime-burst-message (m) 132 (defun vm-mime-burst-message (m)
127 "Burst messages from the digest message M. 133 "Burst messages from the digest message M.