home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / vm / vm-delete.el < prev    next >
Encoding:
Text File  |  1989-09-11  |  4.0 KB  |  114 lines
  1. ;;; Delete and expunge commands for 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. ;;; Send bug reports to kyle@cs.odu.edu.
  19.  
  20. (require 'vm)
  21.  
  22. (defun vm-delete-message (count)
  23.   "Mark the current message for deletion.
  24. With a prefix arg mark the next COUNT messages for deletion.  A negative
  25. arg means the previous COUNT messages are marked."
  26.   (interactive "p")
  27.   (if (interactive-p)
  28.       (vm-follow-summary-cursor))
  29.   (if vm-mail-buffer
  30.       (set-buffer vm-mail-buffer))
  31.   (vm-error-if-folder-empty)
  32.   (if (not (eq vm-circular-folders t))
  33.       (vm-check-count count))
  34.   (let ((direction (if (< count 0) 'backward 'forward))
  35.     (count (vm-abs count))
  36.     (oldmp vm-message-pointer)
  37.     (vm-message-pointer vm-message-pointer))
  38.     (while (not (zerop count))
  39.       (if (not (vm-deleted-flag (car vm-message-pointer)))
  40.       (vm-set-deleted-flag (car vm-message-pointer) t))
  41.       (vm-decrement count)
  42.       (if (not (zerop count))
  43.       (vm-move-message-pointer direction))))
  44.   (vm-update-summary-and-mode-line)
  45.   (if vm-move-after-deleting
  46.       (vm-next-message count t)))
  47.  
  48. (defun vm-undelete-message (count)
  49.   "Remove the deletion mark from the current message.
  50. With a prefix arg unmark the next COUNT messages.  A negative arg means
  51. the previous COUNT messages are unmarked."
  52.   (interactive "p")
  53.   (if (interactive-p)
  54.       (vm-follow-summary-cursor))
  55.   (if vm-mail-buffer
  56.       (set-buffer vm-mail-buffer))
  57.   (vm-error-if-folder-empty)
  58.   (if (not (eq vm-circular-folders t))
  59.       (vm-check-count count))
  60.   (let ((direction (if (< count 0) 'backward 'forward))
  61.     (count (vm-abs count))
  62.     (oldmp vm-message-pointer)
  63.     (vm-message-pointer vm-message-pointer))
  64.     (while (not (zerop count))
  65.       (if (vm-deleted-flag (car vm-message-pointer))
  66.       (vm-set-deleted-flag (car vm-message-pointer) nil))
  67.       (vm-decrement count)
  68.       (if (not (zerop count))
  69.       (vm-move-message-pointer direction))))
  70.   (vm-update-summary-and-mode-line))
  71.  
  72. (defun vm-kill-subject ()
  73.   "Mark all messages with the same subject as the current message
  74. \(ignoring re:'s) for deletion."
  75.   (interactive)
  76.   (vm-follow-summary-cursor)
  77.   (if vm-mail-buffer
  78.       (set-buffer vm-mail-buffer))
  79.   (vm-error-if-folder-empty)
  80.   (let ((subject (vm-su-subject (car vm-message-pointer)))
  81.     (mp vm-message-list))
  82.     (if (string-match "^\\(re: *\\)+" subject)
  83.     (setq subject (substring subject (match-end 0))))
  84.     (setq subject (concat "^\\(re: *\\)*" (regexp-quote subject) " *$"))
  85.     (while mp
  86.       (if (and (not (vm-deleted-flag (car mp)))
  87.            (string-match subject (vm-su-subject (car mp))))
  88.       (vm-set-deleted-flag (car mp) t))
  89.       (setq mp (cdr mp))))
  90.   (vm-update-summary-and-mode-line))
  91.  
  92. (defun vm-expunge-folder (&optional quitting shaddap)
  93.   "Expunge deleted messages, but don't save folder to disk or exit VM."
  94.   (interactive)
  95.   (if vm-mail-buffer
  96.       (set-buffer vm-mail-buffer))
  97.   (let ((inhibit-quit t))
  98.     (if (vm-gobble-deleted-messages)
  99.     (if (not quitting)
  100.         (progn
  101.           (if (not shaddap)
  102.           (message "Deleted messages expunged."))
  103.           (vm-number-messages)
  104.           (if vm-summary-buffer
  105.           (vm-do-summary))
  106.           (if (and vm-message-pointer vm-summary-buffer)
  107.           (vm-set-summary-pointer (car vm-message-pointer)))
  108.           (if (null vm-message-pointer)
  109.           (vm-next-message)
  110.         (if (null vm-system-state)
  111.             (vm-preview-current-message)
  112.           (vm-update-summary-and-mode-line)))))
  113.       (error "No messages are marked for deletion."))))
  114.