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