Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-digest.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents a145efe76779
children 7d55a9ba150c
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
159 ((vm-mime-types-match "multipart/digest" 159 ((vm-mime-types-match "multipart/digest"
160 (car (vm-mm-layout-type layout))) 160 (car (vm-mm-layout-type layout)))
161 (setq part-list (vm-mm-layout-parts layout)) 161 (setq part-list (vm-mm-layout-parts layout))
162 (while part-list 162 (while part-list
163 ;; Maybe we should verify that each part is 163 ;; Maybe we should verify that each part is
164 ;; of type message/rfc822 in here. But it 164 ;; of type message/rfc822 or message/news in
165 ;; seems more useful to just copy whatever 165 ;; here. But it seems more useful to just
166 ;; the contents are and let teh user see the 166 ;; copy whatever the contents are and let the
167 ;; goop, whatever type it really is. 167 ;; user see the goop, whatever type it really
168 ;; is.
168 (insert (vm-leading-message-separator folder-type)) 169 (insert (vm-leading-message-separator folder-type))
169 (and ident-header (insert ident-header)) 170 (and ident-header (insert ident-header))
170 (setq start (point)) 171 (setq start (point))
171 (vm-mime-insert-mime-body (car part-list)) 172 (vm-mime-insert-mime-body (car part-list))
172 (vm-munge-message-separators folder-type start (point)) 173 (vm-munge-message-separators folder-type start (point))
173 (insert (vm-trailing-message-separator folder-type)) 174 (insert (vm-trailing-message-separator folder-type))
174 (setq part-list (cdr part-list)))) 175 (setq part-list (cdr part-list))))
175 (t (error 176 (t (error
176 "MIME type is not multipart/digest or message/rfc822"))) 177 "MIME type is not multipart/digest or message/rfc822 or message/news")))
177 ;; do header conversions. 178 ;; do header conversions.
178 (let ((vm-folder-type folder-type)) 179 (let ((vm-folder-type folder-type))
179 (goto-char (point-min)) 180 (goto-char (point-min))
180 (while (vm-find-leading-message-separator) 181 (while (vm-find-leading-message-separator)
181 (vm-skip-past-leading-message-separator) 182 (vm-skip-past-leading-message-separator)
377 (if vm-digest-identifier-header-format 378 (if vm-digest-identifier-header-format
378 (setq ident-header (vm-sprintf 'vm-digest-identifier-header-format m))) 379 (setq ident-header (vm-sprintf 'vm-digest-identifier-header-format m)))
379 (if rfc1153 380 (if rfc1153
380 (setq prologue-separator-regexp "^----------------------------------------------------------------------\n" 381 (setq prologue-separator-regexp "^----------------------------------------------------------------------\n"
381 separator-regexp "^------------------------------\n") 382 separator-regexp "^------------------------------\n")
382 (setq prologue-separator-regexp "^-[^ ].*\n" 383 (setq prologue-separator-regexp "\\(^-[^ ].*\n+\\)+"
383 separator-regexp "^-[^ ].*\n")) 384 separator-regexp "\\(^-[^ ].*\n+\\)+"))
384 (vm-save-restriction 385 (vm-save-restriction
385 (save-excursion 386 (save-excursion
386 (widen) 387 (widen)
387 (unwind-protect 388 (unwind-protect
388 (catch 'done 389 (catch 'done
423 ;; isn't a real boundary. 424 ;; isn't a real boundary.
424 (if (not 425 (if (not
425 (save-excursion 426 (save-excursion
426 (save-match-data 427 (save-match-data
427 (skip-chars-forward "\n") 428 (skip-chars-forward "\n")
428 (and (vm-match-header) 429 (or (and (vm-match-header)
429 (or (vm-digest-get-header-contents "From") 430 (vm-digest-get-header-contents "From"))
430 (not (re-search-forward separator-regexp 431 (not (re-search-forward separator-regexp
431 nil t))))))) 432 nil t))))))
432 (setq prev-sep (point) 433 (setq prev-sep (point)
433 after-prev-sep (point)) 434 after-prev-sep (point))
434 ;; insert a trailing message separator 435 ;; insert a trailing message separator
435 ;; delete the digest separator 436 ;; delete the digest separator
436 ;; insert the leading separator 437 ;; insert the leading separator
599 (let ((layout (vm-mm-layout m))) 600 (let ((layout (vm-mm-layout m)))
600 (if (and (vectorp layout) 601 (if (and (vectorp layout)
601 (or (vm-mime-types-match "multipart/digest" 602 (or (vm-mime-types-match "multipart/digest"
602 (car (vm-mm-layout-type layout))) 603 (car (vm-mm-layout-type layout)))
603 (vm-mime-types-match "message/rfc822" 604 (vm-mime-types-match "message/rfc822"
605 (car (vm-mm-layout-type layout)))
606 (vm-mime-types-match "message/news"
604 (car (vm-mm-layout-type layout))))) 607 (car (vm-mm-layout-type layout)))))
605 (throw 'return-value "mime")))) 608 (throw 'return-value "mime"))))
606 (save-excursion 609 (save-excursion
607 (save-restriction 610 (save-restriction
608 (widen) 611 (widen)