annotate lisp/vm/vm-mark.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children a145efe76779
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; Commands for handling messages marks
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;;; Copyright (C) 1990, 1993, 1994 Kyle E. Jones
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;;; This program is free software; you can redistribute it and/or modify
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;;; it under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 ;;; the Free Software Foundation; either version 1, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;;; This program is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;;; GNU General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;;; You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;;; along with this program; if not, write to the Free Software
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 (provide 'vm-mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 (defun vm-clear-all-marks ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 "Removes all message marks in the current folder."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 (let ((mp vm-message-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 (if (vm-mark-of (car mp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 (vm-set-mark-of (car mp) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 (vm-mark-for-summary-update (car mp) t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 (setq mp (cdr mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 (vm-display nil nil '(vm-clear-all-marks)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 '(vm-clear-all-marks marking-message))
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 54
diff changeset
35 (vm-update-summary-and-mode-line))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 (defun vm-mark-all-messages ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 "Mark all messages in the current folder."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 (let ((mp vm-message-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 (vm-set-mark-of (car mp) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 (vm-mark-for-summary-update (car mp) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 (setq mp (cdr mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 (vm-display nil nil '(vm-mark-all-messages)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 '(vm-mark-all-messages marking-message))
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 54
diff changeset
50 (vm-update-summary-and-mode-line))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 (defun vm-mark-message (count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 "Mark the current message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 Numeric prefix argument N means mark the current message and the next
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 N-1 messages. A negative N means mark the current message and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 previous N-1 messages."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 (interactive "p")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 (if (interactive-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 (vm-follow-summary-cursor))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 (let ((direction (if (< count 0) 'backward 'forward))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 (count (vm-abs count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 (oldmp vm-message-pointer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 (vm-message-pointer vm-message-pointer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 (while (not (zerop count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 (if (not (vm-mark-of (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 (vm-set-mark-of (car vm-message-pointer) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (vm-mark-for-summary-update (car vm-message-pointer) t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 (vm-decrement count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 (if (not (zerop count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 (vm-move-message-pointer direction))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (vm-display nil nil '(vm-mark-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 '(vm-mark-message marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 (vm-update-summary-and-mode-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 (defun vm-unmark-message (count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 "Remove the mark from the current message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 Numeric prefix argument N means unmark the current message and the next
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 N-1 messages. A negative N means unmark the current message and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 previous N-1 messages."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 (interactive "p")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (if (interactive-p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (vm-follow-summary-cursor))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 (let ((mlist (vm-select-marked-or-prefixed-messages count)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (while mlist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (if (vm-mark-of (car mlist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 (vm-set-mark-of (car mlist) nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 (vm-mark-for-summary-update (car mlist) t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 (setq mlist (cdr mlist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 (vm-display nil nil '(vm-unmark-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 '(vm-unmark-message marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 (vm-update-summary-and-mode-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100
98
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
101 (defun vm-mark-summary-region ()
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
102 "Mark all messages with summary lines contained in the region."
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
103 (interactive)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
104 (vm-select-folder-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
105 (vm-check-for-killed-summary)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
106 (vm-error-if-folder-empty)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
107 (if (null vm-summary-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
108 (error "No summary."))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
109 (set-buffer vm-summary-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
110 (if (not (mark))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
111 (error "The region is not active now"))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
112 (vm-mark-or-unmark-summary-region t)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
113 (vm-display nil nil '(vm-mark-summary-region)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
114 '(vm-mark-summary-region marking-message))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
115 (vm-update-summary-and-mode-line))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
116
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
117 (defun vm-unmark-summary-region ()
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
118 "Remove marks from messages with summary lines contained in the region."
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
119 (interactive)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
120 (vm-select-folder-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
121 (vm-check-for-killed-summary)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
122 (vm-error-if-folder-empty)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
123 (if (null vm-summary-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
124 (error "No summary."))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
125 (set-buffer vm-summary-buffer)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
126 (if (not (mark))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
127 (error "The region is not active now"))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
128 (vm-mark-or-unmark-summary-region nil)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
129 (vm-display nil nil '(vm-unmark-summary-region)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
130 '(vm-unmark-summary-region marking-message))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
131 (vm-update-summary-and-mode-line))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
132
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
133 (defun vm-mark-or-unmark-summary-region (markit)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
134 ;; The folder buffers copy of vm-message-list has already been
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
135 ;; propagated to the summary buffer.
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
136 (let ((mp vm-message-list)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
137 (beg (point))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
138 (end (mark))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
139 tmp m)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
140 (if (> beg end)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
141 (setq tmp beg beg end end tmp))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
142 (while mp
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
143 (setq m (car mp))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
144 (if (not (eq (not markit) (not (vm-mark-of m))))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
145 (if (or (and (> (vm-su-end-of m) beg)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
146 (< (vm-su-end-of m) end))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
147 (and (>= (vm-su-start-of m) beg)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
148 (< (vm-su-start-of m) end))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
149 (and (>= beg (vm-su-start-of m))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
150 (< beg (vm-su-end-of m))))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
151 (progn
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
152 (vm-set-mark-of m markit)
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
153 (vm-mark-for-summary-update m t))))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
154 (setq mp (cdr mp)))))
0d2f883870bc Import from CVS: tag r20-1b1
cvs
parents: 70
diff changeset
155
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 (defun vm-mark-or-unmark-messages-with-selector (val selector arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 (let ((mlist vm-message-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 (virtual (eq major-mode 'vm-virtual-mode))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 (arglist (if arg (list arg) nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 (count 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 (setq selector (intern (concat "vm-vs-" (symbol-name selector))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 (while mlist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 (if (if virtual
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 (set-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 (vm-buffer-of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 (vm-real-message-of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 (car mlist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 (apply selector (vm-real-message-of (car mlist)) arglist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 (apply selector (car mlist) arglist))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 (vm-set-mark-of (car mlist) val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 (vm-mark-for-summary-update (car mlist) t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 (vm-increment count)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 (setq mlist (cdr mlist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 (vm-display nil nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 '(vm-mark-matching-messages vm-unmark-matching-messages)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 (list this-command 'marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 (vm-update-summary-and-mode-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 (message "%d message%s %smarked"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 (if (= 1 count) "" "s")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 (if val "" "un"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 (defun vm-mark-matching-messages (selector &optional arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 "Mark messages matching some criterion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 You can use any of the virtual folder selectors, except for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 `and', `or' and `not' selectors. See the documentation for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 variable vm-virtual-folder-alist for more information."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 (let ((last-command last-command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 (this-command this-command))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 (vm-read-virtual-selector "Mark messages: ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 (vm-mark-or-unmark-messages-with-selector t selector arg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 (defun vm-unmark-matching-messages (selector &optional arg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 "Unmark messages matching some criterion.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202 You can use any of the virtual folder selectors, except for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 `and', `or' and `not' selectors. See the documentation for the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 variable vm-virtual-folder-alist for more information."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
205 (interactive
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 (let ((last-command last-command)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
207 (this-command this-command))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
208 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 (vm-read-virtual-selector "Unmark messages: ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
212 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213 (vm-mark-or-unmark-messages-with-selector nil selector arg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 (defun vm-mark-thread-subtree ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 "Mark all messages in the thread tree rooted at the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222 (vm-mark-or-unmark-thread-subtree t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 (defun vm-unmark-thread-subtree ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 "Unmark all messages in the thread tree rooted at the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 (vm-mark-or-unmark-thread-subtree nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 (defun vm-mark-or-unmark-thread-subtree (mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 (vm-build-threads-if-unbuilt)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235 (let ((list (list (car vm-message-pointer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236 (loop-obarray (make-vector 29 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 subject-sym id-sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 (while list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239 (if (not (eq (vm-mark-of (car list)) mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
241 (vm-set-mark-of (car list) mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 (vm-mark-for-summary-update (car list))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 (setq id-sym (car (vm-last (vm-th-thread-list (car list)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 (if (null (intern-soft (symbol-name id-sym) loop-obarray))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246 (intern (symbol-name id-sym) loop-obarray)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 (nconc list (copy-sequence (get id-sym 'children)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 (setq subject-sym (intern (vm-so-sortable-subject (car list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 vm-thread-subject-obarray))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 (if (and (boundp subject-sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 (eq id-sym (aref (symbol-value subject-sym) 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252 (nconc list (copy-sequence
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253 (aref (symbol-value subject-sym) 2))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 (setq list (cdr list))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255 (vm-display nil nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 '(vm-mark-thread-subtree vm-unmark-thread-subtree)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 (list this-command 'marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 (vm-update-summary-and-mode-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 (defun vm-mark-messages-same-subject ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 "Mark all messages with the same subject as the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 (vm-mark-or-unmark-messages-same-subject t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 (defun vm-unmark-messages-same-subject ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 "Unmark all messages with the same subject as the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 (vm-mark-or-unmark-messages-same-subject nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 (defun vm-mark-or-unmark-messages-same-subject (mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 (let ((mp vm-message-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 (mark-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 (subject (vm-so-sortable-subject (car vm-message-pointer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283 (if (and (not (eq (vm-mark-of (car mp)) mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 (string-equal subject (vm-so-sortable-subject (car mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286 (vm-set-mark-of (car mp) mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 (vm-increment mark-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288 (vm-mark-for-summary-update (car mp) t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 (setq mp (cdr mp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290 (if (zerop mark-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 (message "No messages %smarked" (if mark "" "un"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 (message "%d message%s %smarked"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 mark-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 (if (= 1 mark-count) "" "s")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 (if mark "" "un"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 (vm-display nil nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 '(vm-mark-messages-same-subject
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 vm-unmark-messages-same-subject)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 (list this-command 'marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 (vm-update-summary-and-mode-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 (defun vm-mark-messages-same-author ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303 "Mark all messages with the same author as the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 (vm-mark-or-unmark-messages-same-author t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 (defun vm-unmark-messages-same-author ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 "Unmark all messages with the same author as the current message."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 (vm-follow-summary-cursor)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315 (vm-select-folder-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 (vm-check-for-killed-summary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 (vm-error-if-folder-empty)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318 (vm-mark-or-unmark-messages-same-author nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 (defun vm-mark-or-unmark-messages-same-author (mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321 (let ((mp vm-message-list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 (mark-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 (author (vm-su-from (car vm-message-pointer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325 (if (and (not (eq (vm-mark-of (car mp)) mark))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 (string-equal author (vm-su-from (car mp))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328 (vm-set-mark-of (car mp) mark)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 (vm-increment mark-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 (vm-mark-for-summary-update (car mp) t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 (setq mp (cdr mp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 (if (zerop mark-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 (message "No messages %smarked" (if mark "" "un"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 (message "%d message%s %smarked"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 mark-count
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336 (if (= 1 mark-count) "" "s")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 (if mark "" "un"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338 (vm-display nil nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 '(vm-mark-messages-same-author
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 vm-unmark-messages-same-author)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 (list this-command 'marking-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 (vm-update-summary-and-mode-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 (defun vm-next-command-uses-marks ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 "Does nothing except insure that the next VM command will operate only
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 54
diff changeset
346 on the marked messages in the current folder."
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 (setq this-command 'vm-next-command-uses-marks)
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 54
diff changeset
349 (vm-unsaved-message "Next command uses marks...")
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 (vm-display nil nil '(vm-next-command-uses-marks)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 '(vm-next-command-uses-marks)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353 (defun vm-marked-messages ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 (let (list (mp vm-message-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
355 (while mp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
356 (if (vm-mark-of (car mp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357 (setq list (cons (car mp) list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
358 (setq mp (cdr mp)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359 (nreverse list)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 (defun vm-mark-help ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 (vm-display nil nil '(vm-mark-help) '(vm-mark-help))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 (message "MM = mark, MU = unmark, Mm = mark all, Mu = unmark all, MN = use marks, ..."))