;;; Support code for RFC934 digests
;;; Copyright (C) 1989 Kyle E. Jones
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(require 'vm)

(defun vm-rfc934-char-stuff-region (start end)
  (setq end (vm-marker end))
  (save-excursion
    (goto-char start)
    (while (and (< (point) end) (re-search-forward "^-" end t))
      (replace-match "- -" t t)))
  (set-marker end nil))

(defun vm-rfc934-char-unstuff-region (start end)
  (setq end (vm-marker end))
  (save-excursion
    (goto-char start)
    (while (and (< (point) end) (re-search-forward "^- "  end t))
      (replace-match "" t t)
      (forward-char)))
  (set-marker end nil))

(defun vm-digestify-region (start end)
  (setq end (vm-marker end))
  (let ((separator-regexp (if (eq vm-folder-type 'mmdf)
			      "\n+\001\001\001\001\n\001\001\001\001"
			    "\n+\nFrom .*")))
    (save-excursion
      (vm-rfc934-char-stuff-region start end)
      (goto-char start)
      (insert-before-markers "------- Start of digest -------\n")
      (delete-region (point) (progn (forward-line) (point)))
      (while (re-search-forward separator-regexp end t)
	(replace-match "\n\n------------------------------\n" t nil))
      (goto-char end)
      (if (eq vm-folder-type 'mmdf)
	  (delete-region (point) (progn (forward-line -1) (point))))
      (insert-before-markers "------- End of digest -------\n")))
  (set-marker end nil))

(defun vm-burst-digest ()
  "Burst the current message (a digest) into its individual messages.
The digest's messages are assimilated into the folder as new mail would be,
e.g. message grouping takes place and if you're not reading a message
you will be moved to the first new or unread message."
  (interactive)
  (vm-follow-summary-cursor)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (vm-error-if-folder-empty)
  (let ((inhibit-quit t) start end reg-start leader trailer
	(reg-end (vm-marker nil))
	(text-start (vm-marker nil))
	(buffer-read-only)
	(old-buffer-modified-p (buffer-modified-p))
	(m (car vm-message-pointer)))
    (save-excursion
      (vm-save-restriction
       (condition-case ()
	   (progn
	     (widen)
	     (goto-char (point-max))
	     (setq start (point))
	     (insert-buffer-substring (current-buffer)
				      (vm-text-of (car vm-message-pointer))
				      (vm-text-end-of
				       (car vm-message-pointer)))
	     (if (not
		  (re-search-backward "\\(^-[^ ].*\n+\\|^-\n+\\)+" start t))
		 (error "final EB not found")
	       (setq end (point-marker))
	       ;; Reverse searchs are odd.  The above expression simply
	       ;; will not match  more than one message separator despite
	       ;; the "1 or more" directive at the end.
	       ;; This will have to suffice.
	       (while
		   (and
		    (save-excursion
		      (re-search-backward "\\(^-[^ ].*\n+\\|^-\n+\\)+" start t)
		      (= end (match-end 0))))
		 (set-marker end (match-beginning 0))
		 (goto-char end))
	       (skip-chars-backward "\n")
	       (set-marker end (point))
	       (delete-region end (point-max)))
	     (goto-char start)
	     (if (not (re-search-forward "^-[^ ]" end t))
		 (error "start EB not found")
	       (delete-region start (match-beginning 0)))
	     ;; Concoct suitable separator strings for the future messages.
	     (if (eq vm-folder-type 'mmdf)
		 (setq leader "\001\001\001\001\n"
		       trailer "\n\001\001\001\001\n")
	       (setq leader (concat "From " (vm-from-of m) " "
				    (current-time-string) "\n")
		     trailer "\n\n"))
	     (goto-char start)
	     (while (re-search-forward
		     "\\(\\(\n+\\)\\|\\(^\\)\\)\\(-[^ ].*\n+\\|-\n+\\)+"
		     end 0)
	       ;; delete EB
	       (replace-match "" t t)
	       ;; stuff separator
	       (if (match-beginning 2)
		   (insert trailer))
	       (insert leader)
	       ;; Delete attribute headers so message will appear
	       ;; brand new to the user
	       (setq reg-start (point))
	       (save-excursion
		 (search-forward "\n\n" nil 0)
		 (set-marker text-start (point)))
	       (if (re-search-forward vm-attributes-header-regexp text-start t)
		   (delete-region (match-beginning 0) (match-end 0)))
	       (if vm-berkeley-mail-compatibility
		   (progn
		     (goto-char reg-start)
		     (if (re-search-forward vm-berkeley-mail-status-header-regexp
					    text-start t)
			 (delete-region (match-beginning 0) (match-end 0)))))
	       ;; find end of message separator and unstuff the message
	       (goto-char reg-start)
	       (set-marker reg-end (if (re-search-forward "\n+-[^ ]" end 0)
				       (match-beginning 0)
				     (point)))
	       (vm-rfc934-char-unstuff-region reg-start reg-end)
	       (goto-char reg-end))
	     (goto-char end)
	     (insert trailer)
	     (set-marker end nil)
	     (set-marker reg-end nil)
	     (vm-clear-modification-flag-undos))
	 (error (and start (delete-region start (point-max)))
		(set-buffer-modified-p old-buffer-modified-p)
		(error "Malformed digest")))))
    (if (vm-assimilate-new-messages)
	(progn
	  (vm-emit-totals-blurb)
	  ;; If there's a current grouping, then the summary has already
	  ;; been redone in vm-group-messages.
	  (if (and vm-summary-buffer (not vm-current-grouping))
	      (progn
		(vm-do-summary)
		(vm-emit-totals-blurb)))
	  (vm-thoughtfully-select-message)
	  (if vm-summary-buffer
	      (vm-set-summary-pointer (car vm-message-pointer)))))))
