home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / vm / vm-undo.el < prev    next >
Encoding:
Text File  |  1989-09-11  |  4.8 KB  |  134 lines
  1. ;;; Commands to undo message attribute changes in VM
  2. ;;; Copyright (C) 1989 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (require 'vm)
  19.  
  20. (defun vm-undo-boundary ()
  21.   (if (car vm-undo-record-list)
  22.       (setq vm-undo-record-list (cons nil vm-undo-record-list))))
  23.  
  24. (defun vm-clear-expunge-invalidated-undos ()
  25.   (let ((udp vm-undo-record-list) udp-prev)
  26.     (while udp
  27.       (cond ((null (car udp))
  28.          (setq udp-prev udp))
  29.         ((and (not (eq (car (car udp)) 'set-buffer-modified-p))
  30.           (vm-deleted-flag (car (cdr (car udp)))))
  31.          (cond (udp-prev (setcdr udp-prev (cdr udp)))
  32.            (t (setq vm-undo-record-list (cdr udp)))))
  33.         (t (setq udp-prev udp)))
  34.       (setq udp (cdr udp)))
  35.     (vm-clear-modification-flag-undos))
  36.   (vm-squeeze-consecutive-undo-boundaries))
  37.         
  38. (defun vm-clear-modification-flag-undos ()
  39.   (let ((udp vm-undo-record-list) udp-prev)
  40.     (while udp
  41.       (cond ((null (car udp))
  42.          (setq udp-prev udp))
  43.         ((eq (car (car udp)) 'set-buffer-modified-p)
  44.          (cond (udp-prev (setcdr udp-prev (cdr udp)))
  45.            (t (setq vm-undo-record-list (cdr udp)))))
  46.         (t (setq udp-prev udp)))
  47.       (setq udp (cdr udp))))
  48.   (vm-squeeze-consecutive-undo-boundaries))
  49.  
  50. ;; squeeze out consecutive record separators left by the deletions
  51. (defun vm-squeeze-consecutive-undo-boundaries ()
  52.   (let ((udp vm-undo-record-list) udp-prev)
  53.     (while udp
  54.       (cond ((and (null (car udp)) udp-prev (null (car udp-prev)))
  55.          (setcdr udp-prev (cdr udp)))
  56.         (t (setq udp-prev udp)))
  57.       (setq udp (cdr udp)))
  58.     (if (equal '(nil) vm-undo-record-list)
  59.     (setq vm-undo-record-list nil))))
  60.         
  61. (defun vm-undo-record (sexp)
  62.   (setq vm-undo-record-list (cons sexp vm-undo-record-list)))
  63.  
  64. (defun vm-undo ()
  65.   "Undo last change to message attributes in the current folder.
  66. Consecutive invocations of this command cause sequentially earlier
  67. changes to be undone.  After an intervening command between undos,
  68. the undos themselves become undoable."
  69.   (interactive)
  70.   (if vm-mail-buffer
  71.       (set-buffer vm-mail-buffer))
  72.   (let ((inhibit-quit t))
  73.     (if (not (eq last-command 'vm-undo))
  74.     (setq vm-undo-record-pointer vm-undo-record-list))
  75.     (if (not vm-undo-record-pointer)
  76.     (error "No further VM undo information available"))
  77.     ;; skip current record boundary
  78.     (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))
  79.     (while (car vm-undo-record-pointer)
  80.       (eval (car vm-undo-record-pointer))
  81.       (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)))
  82.     (message "VM Undo!")
  83.     (vm-update-summary-and-mode-line)))
  84.  
  85. (defun vm-set-new-flag (m flag)
  86.   (let ((inhibit-quit t))
  87.     (cond ((not (buffer-modified-p))
  88.        (set-buffer-modified-p t)
  89.        (vm-undo-record (list 'set-buffer-modified-p nil))))
  90.     (vm-undo-record (list 'vm-set-new-flag m (not flag)))
  91.     (vm-undo-boundary)
  92.     (aset (aref m 5) 0 flag)
  93.     (vm-mark-for-display-update m)))
  94.  
  95. (defun vm-set-unread-flag (m flag)
  96.   (let ((inhibit-quit t))
  97.     (cond ((not (buffer-modified-p))
  98.        (set-buffer-modified-p t)
  99.        (vm-undo-record (list 'set-buffer-modified-p nil))))
  100.     (vm-undo-record (list 'vm-set-unread-flag m (not flag)))
  101.     (vm-undo-boundary)
  102.     (aset (aref m 5) 1 flag)
  103.     (vm-mark-for-display-update m)))
  104.  
  105. (defun vm-set-deleted-flag (m flag)
  106.   (let ((inhibit-quit t))
  107.     (cond ((not (buffer-modified-p))
  108.        (set-buffer-modified-p t)
  109.        (vm-undo-record (list 'set-buffer-modified-p nil))))
  110.     (vm-undo-record (list 'vm-set-deleted-flag m (not flag)))
  111.     (vm-undo-boundary)
  112.     (aset (aref m 5) 2 flag)
  113.     (vm-mark-for-display-update m)))
  114.  
  115. (defun vm-set-filed-flag (m flag)
  116.   (let ((inhibit-quit t))
  117.     (cond ((not (buffer-modified-p))
  118.        (set-buffer-modified-p t)
  119.        (vm-undo-record (list 'set-buffer-modified-p nil))))
  120.     (vm-undo-record (list 'vm-set-filed-flag m (not flag)))
  121.     (vm-undo-boundary)
  122.     (aset (aref m 5) 3 flag)
  123.     (vm-mark-for-display-update m)))
  124.  
  125. (defun vm-set-replied-flag (m flag)
  126.   (let ((inhibit-quit t))
  127.     (cond ((not (buffer-modified-p))
  128.        (set-buffer-modified-p t)
  129.        (vm-undo-record (list 'set-buffer-modified-p nil))))
  130.     (vm-undo-record (list 'vm-set-replied-flag m (not flag)))
  131.     (vm-undo-boundary)
  132.     (aset (aref m 5) 4 flag)
  133.     (vm-mark-for-display-update m)))
  134.