;;; Commands to undo message attribute changes in VM
;;; 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-undo-boundary ()
  (if (car vm-undo-record-list)
      (setq vm-undo-record-list (cons nil vm-undo-record-list))))

(defun vm-clear-expunge-invalidated-undos ()
  (let ((udp vm-undo-record-list) udp-prev)
    (while udp
      (cond ((null (car udp))
	     (setq udp-prev udp))
	    ((and (not (eq (car (car udp)) 'set-buffer-modified-p))
		  (vm-deleted-flag (car (cdr (car udp)))))
	     (cond (udp-prev (setcdr udp-prev (cdr udp)))
		   (t (setq vm-undo-record-list (cdr udp)))))
	    (t (setq udp-prev udp)))
      (setq udp (cdr udp)))
    (vm-clear-modification-flag-undos))
  (vm-squeeze-consecutive-undo-boundaries))
	    
(defun vm-clear-modification-flag-undos ()
  (let ((udp vm-undo-record-list) udp-prev)
    (while udp
      (cond ((null (car udp))
	     (setq udp-prev udp))
	    ((eq (car (car udp)) 'set-buffer-modified-p)
	     (cond (udp-prev (setcdr udp-prev (cdr udp)))
		   (t (setq vm-undo-record-list (cdr udp)))))
	    (t (setq udp-prev udp)))
      (setq udp (cdr udp))))
  (vm-squeeze-consecutive-undo-boundaries))

;; squeeze out consecutive record separators left by the deletions
(defun vm-squeeze-consecutive-undo-boundaries ()
  (let ((udp vm-undo-record-list) udp-prev)
    (while udp
      (cond ((and (null (car udp)) udp-prev (null (car udp-prev)))
	     (setcdr udp-prev (cdr udp)))
	    (t (setq udp-prev udp)))
      (setq udp (cdr udp)))
    (if (equal '(nil) vm-undo-record-list)
	(setq vm-undo-record-list nil))))
	    
(defun vm-undo-record (sexp)
  (setq vm-undo-record-list (cons sexp vm-undo-record-list)))

(defun vm-undo ()
  "Undo last change to message attributes in the current folder.
Consecutive invocations of this command cause sequentially earlier
changes to be undone.  After an intervening command between undos,
the undos themselves become undoable."
  (interactive)
  (if vm-mail-buffer
      (set-buffer vm-mail-buffer))
  (let ((inhibit-quit t))
    (if (not (eq last-command 'vm-undo))
	(setq vm-undo-record-pointer vm-undo-record-list))
    (if (not vm-undo-record-pointer)
	(error "No further VM undo information available"))
    ;; skip current record boundary
    (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))
    (while (car vm-undo-record-pointer)
      (eval (car vm-undo-record-pointer))
      (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)))
    (message "VM Undo!")
    (vm-update-summary-and-mode-line)))

(defun vm-set-new-flag (m flag)
  (let ((inhibit-quit t))
    (cond ((not (buffer-modified-p))
	   (set-buffer-modified-p t)
	   (vm-undo-record (list 'set-buffer-modified-p nil))))
    (vm-undo-record (list 'vm-set-new-flag m (not flag)))
    (vm-undo-boundary)
    (aset (aref m 5) 0 flag)
    (vm-mark-for-display-update m)))

(defun vm-set-unread-flag (m flag)
  (let ((inhibit-quit t))
    (cond ((not (buffer-modified-p))
	   (set-buffer-modified-p t)
	   (vm-undo-record (list 'set-buffer-modified-p nil))))
    (vm-undo-record (list 'vm-set-unread-flag m (not flag)))
    (vm-undo-boundary)
    (aset (aref m 5) 1 flag)
    (vm-mark-for-display-update m)))

(defun vm-set-deleted-flag (m flag)
  (let ((inhibit-quit t))
    (cond ((not (buffer-modified-p))
	   (set-buffer-modified-p t)
	   (vm-undo-record (list 'set-buffer-modified-p nil))))
    (vm-undo-record (list 'vm-set-deleted-flag m (not flag)))
    (vm-undo-boundary)
    (aset (aref m 5) 2 flag)
    (vm-mark-for-display-update m)))

(defun vm-set-filed-flag (m flag)
  (let ((inhibit-quit t))
    (cond ((not (buffer-modified-p))
	   (set-buffer-modified-p t)
	   (vm-undo-record (list 'set-buffer-modified-p nil))))
    (vm-undo-record (list 'vm-set-filed-flag m (not flag)))
    (vm-undo-boundary)
    (aset (aref m 5) 3 flag)
    (vm-mark-for-display-update m)))

(defun vm-set-replied-flag (m flag)
  (let ((inhibit-quit t))
    (cond ((not (buffer-modified-p))
	   (set-buffer-modified-p t)
	   (vm-undo-record (list 'set-buffer-modified-p nil))))
    (vm-undo-record (list 'vm-set-replied-flag m (not flag)))
    (vm-undo-boundary)
    (aset (aref m 5) 4 flag)
    (vm-mark-for-display-update m)))
