Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-delete.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 441bb1e64a06
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Delete and expunge commands for VM. 1 ;;; Delete and expunge commands for VM.
2 ;;; Copyright (C) 1989-1997 Kyle E. Jones 2 ;;; Copyright (C) 1989, 1990, 1991, 1993, 1994, 1995 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 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 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) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
105 (if (and vm-move-after-undeleting (not used-marks)) 105 (if (and vm-move-after-undeleting (not used-marks))
106 (let ((vm-circular-folders (and vm-circular-folders 106 (let ((vm-circular-folders (and vm-circular-folders
107 (eq vm-move-after-undeleting t)))) 107 (eq vm-move-after-undeleting t))))
108 (vm-next-message count t executing-kbd-macro))))) 108 (vm-next-message count t executing-kbd-macro)))))
109 109
110 (defun vm-kill-subject (&optional arg) 110 (defun vm-kill-subject ()
111 "Delete all messages with the same subject as the current message. 111 "Delete all messages with the same subject as the current message.
112 Message subjects are compared after ignoring parts matched by 112 Message subjects are compared after ignoring parts matched by
113 the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix. 113 the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix."
114 114 (interactive)
115 The optional prefix argument ARG specifies the direction to move
116 if vm-move-after-killing is non-nil. The default direction is
117 forward. A positive prefix argument means move forward, a
118 negative arugment means move backward, a zero argument means
119 don't move at all."
120 (interactive "p")
121 (vm-follow-summary-cursor) 115 (vm-follow-summary-cursor)
122 (vm-select-folder-buffer) 116 (vm-select-folder-buffer)
123 (vm-check-for-killed-summary) 117 (vm-check-for-killed-summary)
124 (vm-error-if-folder-read-only) 118 (vm-error-if-folder-read-only)
125 (vm-error-if-folder-empty) 119 (vm-error-if-folder-empty)
137 (and (interactive-p) 131 (and (interactive-p)
138 (if (zerop n) 132 (if (zerop n)
139 (message "No messages deleted.") 133 (message "No messages deleted.")
140 (message "%d message%s deleted" n (if (= n 1) "" "s"))))) 134 (message "%d message%s deleted" n (if (= n 1) "" "s")))))
141 (vm-display nil nil '(vm-kill-subject) '(vm-kill-subject)) 135 (vm-display nil nil '(vm-kill-subject) '(vm-kill-subject))
142 (vm-update-summary-and-mode-line) 136 (vm-update-summary-and-mode-line))
143 (cond ((or (not (numberp arg)) (> arg 0))
144 (setq arg 1))
145 ((< arg 0)
146 (setq arg -1))
147 (t (setq arg 0)))
148 (if vm-move-after-killing
149 (let ((vm-circular-folders (and vm-circular-folders
150 (eq vm-move-after-killing t))))
151 (vm-next-message arg t executing-kbd-macro))))
152 137
153 (defun vm-expunge-folder (&optional shaddap) 138 (defun vm-expunge-folder (&optional shaddap)
154 "Expunge messages with the `deleted' attribute. 139 "Expunge messages with the `deleted' attribute.
155 For normal folders this means that the deleted messages are 140 For normal folders this means that the deleted messages are
156 removed from the message list and the message contents are 141 removed from the message list and the message contents are
171 ;; do this so we have a clean slate. code below depends on the 156 ;; do this so we have a clean slate. code below depends on the
172 ;; fact that the numbering redo start point begins as nil in 157 ;; fact that the numbering redo start point begins as nil in
173 ;; all folder buffers. 158 ;; all folder buffers.
174 (vm-update-summary-and-mode-line) 159 (vm-update-summary-and-mode-line)
175 (if (not shaddap) 160 (if (not shaddap)
176 (message "Expunging...")) 161 (vm-unsaved-message "Expunging..."))
177 (let ((use-marks (eq last-command 'vm-next-command-uses-marks)) 162 (let ((use-marks (eq last-command 'vm-next-command-uses-marks))
178 (mp vm-message-list) 163 (mp vm-message-list)
179 (virtual (eq major-mode 'vm-virtual-mode)) 164 (virtual (eq major-mode 'vm-virtual-mode))
180 (buffers-altered (make-vector 29 0)) 165 (buffers-altered (make-vector 29 0))
181 prev virtual-messages) 166 prev virtual-messages)
286 (mapatoms 271 (mapatoms
287 (function 272 (function
288 (lambda (buffer) 273 (lambda (buffer)
289 (set-buffer (symbol-name buffer)) 274 (set-buffer (symbol-name buffer))
290 (if (null vm-system-state) 275 (if (null vm-system-state)
291 (progn 276 (if (null vm-message-pointer)
292 (vm-garbage-collect-message) 277 ;; folder is now empty
293 (if (null vm-message-pointer) 278 (progn (setq vm-folder-type nil)
294 ;; folder is now empty 279 (vm-update-summary-and-mode-line))
295 (progn (setq vm-folder-type nil) 280 (vm-preview-current-message))
296 (vm-update-summary-and-mode-line))
297 (vm-preview-current-message)))
298 (vm-update-summary-and-mode-line)) 281 (vm-update-summary-and-mode-line))
299 (if (not (eq major-mode 'vm-virtual-mode)) 282 (if (not (eq major-mode 'vm-virtual-mode))
300 (setq vm-message-order-changed 283 (setq vm-message-order-changed
301 (or vm-message-order-changed 284 (or vm-message-order-changed
302 vm-message-order-header-present))) 285 vm-message-order-header-present)))