0
|
1 ;;; Commands to move around in a VM folder
|
20
|
2 ;;; Copyright (C) 1989-1997 Kyle E. Jones
|
0
|
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-motion)
|
|
19
|
|
20 (defun vm-record-and-change-message-pointer (old new)
|
|
21 (intern (buffer-name) vm-buffers-needing-display-update)
|
20
|
22 (vm-garbage-collect-message)
|
0
|
23 (setq vm-last-message-pointer old
|
|
24 vm-message-pointer new
|
|
25 vm-need-summary-pointer-update t))
|
|
26
|
|
27 (defun vm-goto-message (n)
|
|
28 "Go to the message numbered N.
|
|
29 Interactively N is the prefix argument. If no prefix arg is provided
|
|
30 N is prompted for in the minibuffer.
|
|
31
|
|
32 If vm-follow-summary-cursor is non-nil this command will go to
|
|
33 the message under the cursor in the summary buffer if the summary
|
|
34 window is selected. This only happens if no prefix argument is
|
|
35 given."
|
|
36 (interactive
|
|
37 (list
|
|
38 (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg))
|
|
39 ((vm-follow-summary-cursor) nil)
|
|
40 (t
|
|
41 (let ((last-command last-command)
|
|
42 (this-command this-command))
|
|
43 (vm-read-number "Go to message: "))))))
|
|
44 (if (null n)
|
|
45 () ; nil means work has been done already
|
|
46 (vm-select-folder-buffer)
|
|
47 (vm-check-for-killed-summary)
|
|
48 (vm-error-if-folder-empty)
|
|
49 (vm-display nil nil '(vm-goto-message) '(vm-goto-message))
|
|
50 (let ((cons (nthcdr (1- n) vm-message-list)))
|
|
51 (if (null cons)
|
|
52 (error "No such message."))
|
|
53 (if (eq vm-message-pointer cons)
|
|
54 (vm-preview-current-message)
|
|
55 (vm-record-and-change-message-pointer vm-message-pointer cons)
|
|
56 (vm-preview-current-message)))))
|
|
57
|
|
58 (defun vm-goto-message-last-seen ()
|
|
59 "Go to the message last previewed."
|
|
60 (interactive)
|
|
61 (vm-select-folder-buffer)
|
|
62 (vm-check-for-killed-summary)
|
|
63 (vm-error-if-folder-empty)
|
|
64 (vm-display nil nil '(vm-goto-message-last-seen)
|
|
65 '(vm-goto-message-last-seen))
|
|
66 (if vm-last-message-pointer
|
|
67 (progn
|
|
68 (vm-record-and-change-message-pointer vm-message-pointer
|
|
69 vm-last-message-pointer)
|
|
70 (vm-preview-current-message))))
|
|
71
|
|
72 (defun vm-goto-parent-message ()
|
|
73 "Go to the parent of the current message."
|
|
74 (interactive)
|
|
75 (vm-follow-summary-cursor)
|
|
76 (vm-select-folder-buffer)
|
|
77 (vm-check-for-killed-summary)
|
|
78 (vm-error-if-folder-empty)
|
|
79 (vm-build-threads-if-unbuilt)
|
|
80 (vm-display nil nil '(vm-goto-parent-message)
|
|
81 '(vm-goto-parent-message))
|
|
82 (let ((list (vm-th-thread-list (car vm-message-pointer)))
|
|
83 message)
|
|
84 (if (null (cdr list))
|
|
85 (message "Message has no parent.")
|
|
86 (while (cdr (cdr list))
|
|
87 (setq list (cdr list)))
|
|
88 (setq message (car (get (car list) 'messages)))
|
|
89 (if (null message)
|
|
90 (message "Parent message is not in this folder.")
|
|
91 (vm-record-and-change-message-pointer vm-message-pointer
|
|
92 (memq message vm-message-list))
|
|
93 (vm-preview-current-message)))))
|
|
94
|
|
95 (defun vm-check-count (count)
|
|
96 (if (>= count 0)
|
|
97 (if (< (length vm-message-pointer) count)
|
|
98 (signal 'end-of-folder nil))
|
|
99 (if (< (1+ (- (length vm-message-list) (length vm-message-pointer)))
|
|
100 (vm-abs count))
|
|
101 (signal 'beginning-of-folder nil))))
|
|
102
|
|
103 (defun vm-move-message-pointer (direction)
|
|
104 (let ((mp vm-message-pointer))
|
|
105 (if (eq direction 'forward)
|
|
106 (progn
|
|
107 (setq mp (cdr mp))
|
|
108 (if (null mp)
|
|
109 (if vm-circular-folders
|
|
110 (setq mp vm-message-list)
|
|
111 (signal 'end-of-folder nil))))
|
|
112 (setq mp (vm-reverse-link-of (car mp)))
|
|
113 (if (null mp)
|
|
114 (if vm-circular-folders
|
|
115 (setq mp (vm-last vm-message-list))
|
|
116 (signal 'beginning-of-folder nil))))
|
|
117 (setq vm-message-pointer mp)))
|
|
118
|
|
119 (defun vm-should-skip-message (mp &optional skip-dogmatically)
|
|
120 (if skip-dogmatically
|
|
121 (or (and vm-skip-deleted-messages
|
|
122 (vm-deleted-flag (car mp)))
|
|
123 (and vm-skip-read-messages
|
|
124 (or (vm-deleted-flag (car mp))
|
|
125 (not (or (vm-new-flag (car mp))
|
|
126 (vm-unread-flag (car mp))))))
|
|
127 (and (eq last-command 'vm-next-command-uses-marks)
|
|
128 (null (vm-mark-of (car mp)))))
|
|
129 (or (and (eq vm-skip-deleted-messages t)
|
|
130 (vm-deleted-flag (car mp)))
|
|
131 (and (eq vm-skip-read-messages t)
|
|
132 (or (vm-deleted-flag (car mp))
|
|
133 (not (or (vm-new-flag (car mp))
|
|
134 (vm-unread-flag (car mp))))))
|
|
135 (and (eq last-command 'vm-next-command-uses-marks)
|
|
136 (null (vm-mark-of (car mp)))))))
|
|
137
|
|
138 (defun vm-next-message (&optional count retry signal-errors)
|
|
139 "Go forward one message and preview it.
|
|
140 With prefix arg (optional first argument) COUNT, go forward COUNT
|
|
141 messages. A negative COUNT means go backward. If the absolute
|
|
142 value of COUNT is greater than 1, then the values of the variables
|
|
143 vm-skip-deleted-messages and vm-skip-read-messages are ignored.
|
|
144
|
|
145 When invoked on marked messages (via vm-next-command-uses-marks)
|
|
146 this command 'sees' marked messages as it moves."
|
|
147 ;; second arg RETRY non-nil means retry a failed move, giving
|
|
148 ;; not nil-or-t values of the vm-skip variables a chance to
|
|
149 ;; work.
|
|
150 ;;
|
|
151 ;; third arg SIGNAL-ERRORS non-nil means that if after
|
|
152 ;; everything we still have bashed into the end or beginning of
|
|
153 ;; folder before completing the move, signal
|
|
154 ;; beginning-of-folder or end-of-folder. Otherwise no error
|
|
155 ;; will be signaled.
|
|
156 ;;
|
|
157 ;; Note that interactively all args are 1, so error signaling
|
|
158 ;; and retries apply to all interactive moves.
|
|
159 (interactive "p\np\np")
|
|
160 (if (interactive-p)
|
|
161 (vm-follow-summary-cursor))
|
|
162 (vm-select-folder-buffer)
|
|
163 (vm-check-for-killed-summary)
|
|
164 ;; include other commands that call vm-next-message so that the
|
|
165 ;; correct window configuration is applied for these particular
|
|
166 ;; non-interactive calls.
|
|
167 (vm-display nil nil '(vm-next-message
|
|
168 vm-delete-message
|
|
169 vm-undelete-message
|
|
170 vm-scroll-forward)
|
|
171 (list this-command))
|
|
172 (and signal-errors (vm-error-if-folder-empty))
|
|
173 (or count (setq count 1))
|
|
174 (let ((oldmp vm-message-pointer)
|
|
175 (use-marks (eq last-command 'vm-next-command-uses-marks))
|
|
176 (error)
|
|
177 (direction (if (> count 0) 'forward 'backward))
|
|
178 (count (vm-abs count)))
|
|
179 (cond
|
|
180 ((null vm-message-pointer)
|
|
181 (setq vm-message-pointer vm-message-list))
|
|
182 ((/= count 1)
|
|
183 (condition-case ()
|
|
184 (let ((oldmp oldmp))
|
|
185 (while (not (zerop count))
|
|
186 (vm-move-message-pointer direction)
|
|
187 (if (and use-marks (null (vm-mark-of (car vm-message-pointer))))
|
|
188 (progn
|
|
189 (while (and (not (eq vm-message-pointer oldmp))
|
|
190 (null (vm-mark-of (car vm-message-pointer))))
|
|
191 (vm-move-message-pointer direction))
|
|
192 (if (eq vm-message-pointer oldmp)
|
|
193 ;; terminate the loop
|
|
194 (setq count 1)
|
|
195 ;; reset for next pass
|
|
196 (setq oldmp vm-message-pointer))))
|
|
197 (vm-decrement count)))
|
|
198 (beginning-of-folder (setq error 'beginning-of-folder))
|
|
199 (end-of-folder (setq error 'end-of-folder))))
|
|
200 (t
|
|
201 (condition-case ()
|
|
202 (progn
|
|
203 (vm-move-message-pointer direction)
|
|
204 (while (and (not (eq oldmp vm-message-pointer))
|
|
205 (vm-should-skip-message vm-message-pointer t))
|
|
206 (vm-move-message-pointer direction))
|
|
207 ;; Retry the move if we've gone a complete circle and
|
|
208 ;; retries are allowed and there are other messages
|
|
209 ;; besides this one.
|
|
210 (and (eq vm-message-pointer oldmp) retry (cdr vm-message-list)
|
|
211 (progn
|
|
212 (vm-move-message-pointer direction)
|
|
213 (while (and (not (eq oldmp vm-message-pointer))
|
|
214 (vm-should-skip-message vm-message-pointer))
|
|
215 (vm-move-message-pointer direction)))))
|
|
216 (beginning-of-folder
|
|
217 ;; we bumped into the beginning of the folder without finding
|
|
218 ;; a suitable stopping point; retry the move if we're allowed.
|
|
219 (setq vm-message-pointer oldmp)
|
|
220 ;; if the retry fails, we make sure the message pointer
|
|
221 ;; is restored to its old value.
|
|
222 (if retry
|
|
223 (setq vm-message-pointer
|
|
224 (condition-case ()
|
|
225 (let ((vm-message-pointer vm-message-pointer))
|
|
226 (vm-move-message-pointer direction)
|
|
227 (while (vm-should-skip-message vm-message-pointer)
|
|
228 (vm-move-message-pointer direction))
|
|
229 vm-message-pointer )
|
|
230 (beginning-of-folder
|
|
231 (setq error 'beginning-of-folder)
|
|
232 oldmp )))
|
|
233 (setq error 'beginning-of-folder)))
|
|
234 (end-of-folder
|
|
235 ;; we bumped into the end of the folder without finding
|
|
236 ;; a suitable stopping point; retry the move if we're allowed.
|
|
237 (setq vm-message-pointer oldmp)
|
|
238 ;; if the retry fails, we make sure the message pointer
|
|
239 ;; is restored to its old value.
|
|
240 (if retry
|
|
241 (setq vm-message-pointer
|
|
242 (condition-case ()
|
|
243 (let ((vm-message-pointer vm-message-pointer))
|
|
244 (vm-move-message-pointer direction)
|
|
245 (while (vm-should-skip-message vm-message-pointer)
|
|
246 (vm-move-message-pointer direction))
|
|
247 vm-message-pointer )
|
|
248 (end-of-folder
|
|
249 (setq error 'end-of-folder)
|
|
250 oldmp )))
|
|
251 (setq error 'end-of-folder))))))
|
|
252 (if (not (eq vm-message-pointer oldmp))
|
|
253 (progn
|
|
254 (vm-record-and-change-message-pointer oldmp vm-message-pointer)
|
|
255 (vm-preview-current-message)))
|
|
256 (and error signal-errors
|
|
257 (signal error nil))))
|
|
258
|
|
259 (defun vm-previous-message (&optional count retry signal-errors)
|
|
260 "Go back one message and preview it.
|
|
261 With prefix arg COUNT, go backward COUNT messages. A negative COUNT
|
|
262 means go forward. If the absolute value of COUNT > 1 the values of the
|
|
263 variables vm-skip-deleted-messages and vm-skip-read-messages are
|
|
264 ignored."
|
|
265 (interactive "p\np\np")
|
|
266 (or count (setq count 1))
|
|
267 (if (interactive-p)
|
|
268 (vm-follow-summary-cursor))
|
|
269 (vm-select-folder-buffer)
|
|
270 (vm-display nil nil '(vm-previous-message) '(vm-previous-message))
|
|
271 (vm-next-message (- count) retry signal-errors))
|
|
272
|
|
273 (defun vm-next-message-no-skip (&optional count)
|
|
274 "Like vm-next-message but will not skip deleted or read messages."
|
|
275 (interactive "p")
|
|
276 (if (interactive-p)
|
|
277 (vm-follow-summary-cursor))
|
|
278 (vm-select-folder-buffer)
|
20
|
279 (vm-display nil nil '(vm-next-message-no-skip)
|
|
280 '(vm-next-message-no-skip))
|
0
|
281 (let ((vm-skip-deleted-messages nil)
|
|
282 (vm-skip-read-messages nil))
|
|
283 (vm-next-message count nil t)))
|
|
284 ;; backward compatibility
|
|
285 (fset 'vm-Next-message 'vm-next-message-no-skip)
|
|
286
|
|
287 (defun vm-previous-message-no-skip (&optional count)
|
|
288 "Like vm-previous-message but will not skip deleted or read messages."
|
|
289 (interactive "p")
|
|
290 (if (interactive-p)
|
|
291 (vm-follow-summary-cursor))
|
|
292 (vm-select-folder-buffer)
|
20
|
293 (vm-display nil nil '(vm-previous-message-no-skip)
|
|
294 '(vm-previous-message-no-skip))
|
0
|
295 (let ((vm-skip-deleted-messages nil)
|
|
296 (vm-skip-read-messages nil))
|
|
297 (vm-previous-message count)))
|
|
298 ;; backward compatibility
|
|
299 (fset 'vm-Previous-message 'vm-previous-message-no-skip)
|
|
300
|
|
301 (defun vm-next-unread-message ()
|
|
302 "Move forward to the nearest new or unread message, if there is one."
|
|
303 (interactive)
|
|
304 (if (interactive-p)
|
|
305 (vm-follow-summary-cursor))
|
|
306 (vm-select-folder-buffer)
|
|
307 (vm-check-for-killed-summary)
|
|
308 (vm-display nil nil '(vm-next-unread-message) '(vm-next-unread-message))
|
|
309 (condition-case ()
|
|
310 (let ((vm-skip-read-messages t)
|
|
311 (oldmp vm-message-pointer))
|
|
312 (vm-next-message 1 nil t)
|
|
313 ;; in case vm-circular-folders is non-nil
|
|
314 (and (eq vm-message-pointer oldmp) (signal 'end-of-folder nil)))
|
|
315 (end-of-folder (message "No next unread message"))))
|
|
316
|
|
317 (defun vm-previous-unread-message ()
|
|
318 "Move backward to the nearest new or unread message, if there is one."
|
|
319 (interactive)
|
|
320 (if (interactive-p)
|
|
321 (vm-follow-summary-cursor))
|
|
322 (vm-select-folder-buffer)
|
|
323 (vm-check-for-killed-summary)
|
|
324 (vm-display nil nil '(vm-previous-unread-message)
|
|
325 '(vm-previous-unread-message))
|
|
326 (condition-case ()
|
|
327 (let ((vm-skip-read-messages t)
|
|
328 (oldmp vm-message-pointer))
|
|
329 (vm-previous-message)
|
|
330 ;; in case vm-circular-folders is non-nil
|
|
331 (and (eq vm-message-pointer oldmp) (signal 'beginning-of-folder nil)))
|
|
332 (beginning-of-folder (message "No previous unread message"))))
|
|
333
|
|
334 (defun vm-next-message-same-subject ()
|
|
335 "Move forward to the nearest message with the same subject.
|
|
336 vm-subject-ignored-prefix and vm-subject-ignored-suffix will apply
|
|
337 to the subject comparisons."
|
|
338 (interactive)
|
|
339 (if (interactive-p)
|
|
340 (vm-follow-summary-cursor))
|
|
341 (vm-select-folder-buffer)
|
|
342 (vm-check-for-killed-summary)
|
|
343 (vm-display nil nil '(vm-next-message-same-subject)
|
|
344 '(vm-next-message-same-subject))
|
|
345 (let ((oldmp vm-message-pointer)
|
|
346 (done nil)
|
|
347 (subject (vm-so-sortable-subject (car vm-message-pointer))))
|
|
348 (condition-case ()
|
|
349 (progn
|
|
350 (while (not done)
|
|
351 (vm-move-message-pointer 'forward)
|
|
352 (if (eq oldmp vm-message-pointer)
|
|
353 (signal 'end-of-folder nil))
|
|
354 (if (equal subject
|
|
355 (vm-so-sortable-subject (car vm-message-pointer)))
|
|
356 (setq done t)))
|
|
357 (vm-record-and-change-message-pointer oldmp vm-message-pointer)
|
|
358 (vm-preview-current-message))
|
|
359 (end-of-folder
|
|
360 (setq vm-message-pointer oldmp)
|
|
361 (message "No next message with the same subject")))))
|
|
362
|
|
363 (defun vm-previous-message-same-subject ()
|
|
364 "Move backward to the nearest message with the same subject.
|
|
365 vm-subject-ignored-prefix and vm-subject-ignored-suffix will apply
|
|
366 to the subject comparisons."
|
|
367 (interactive)
|
|
368 (if (interactive-p)
|
|
369 (vm-follow-summary-cursor))
|
|
370 (vm-select-folder-buffer)
|
|
371 (vm-check-for-killed-summary)
|
|
372 (vm-display nil nil '(vm-previous-message-same-subject)
|
|
373 '(vm-previous-message-same-subject))
|
|
374 (let ((oldmp vm-message-pointer)
|
|
375 (done nil)
|
|
376 (subject (vm-so-sortable-subject (car vm-message-pointer))))
|
|
377 (condition-case ()
|
|
378 (progn
|
|
379 (while (not done)
|
|
380 (vm-move-message-pointer 'backward)
|
|
381 (if (eq oldmp vm-message-pointer)
|
|
382 (signal 'beginning-of-folder nil))
|
|
383 (if (equal subject
|
|
384 (vm-so-sortable-subject (car vm-message-pointer)))
|
|
385 (setq done t)))
|
|
386 (vm-record-and-change-message-pointer oldmp vm-message-pointer)
|
|
387 (vm-preview-current-message))
|
|
388 (beginning-of-folder
|
|
389 (setq vm-message-pointer oldmp)
|
|
390 (message "No previous message with the same subject")))))
|
|
391
|
|
392 (defun vm-find-first-unread-message (new)
|
|
393 (let (mp unread-mp)
|
|
394 (setq mp vm-message-list)
|
|
395 (if new
|
|
396 (while mp
|
|
397 (if (and (vm-new-flag (car mp)) (not (vm-deleted-flag (car mp))))
|
|
398 (setq unread-mp mp mp nil)
|
|
399 (setq mp (cdr mp))))
|
|
400 (while mp
|
|
401 (if (and (or (vm-new-flag (car mp)) (vm-unread-flag (car mp)))
|
|
402 (not (vm-deleted-flag (car mp))))
|
|
403 (setq unread-mp mp mp nil)
|
|
404 (setq mp (cdr mp)))))
|
|
405 unread-mp ))
|
|
406
|
|
407 (defun vm-thoughtfully-select-message ()
|
|
408 (let ((new (and vm-jump-to-new-messages (vm-find-first-unread-message t)))
|
|
409 (unread (and vm-jump-to-unread-messages
|
|
410 (vm-find-first-unread-message nil)))
|
|
411 fix mp)
|
|
412 (if (null vm-message-pointer)
|
|
413 (setq fix (vm-last vm-message-list)))
|
|
414 (setq mp (or new unread fix))
|
|
415 (if (and mp (not (eq mp vm-message-pointer)))
|
|
416 (progn
|
|
417 (vm-record-and-change-message-pointer vm-message-pointer mp)
|
|
418 mp )
|
|
419 nil )))
|
|
420
|
|
421 (defun vm-follow-summary-cursor ()
|
|
422 (and vm-follow-summary-cursor (eq major-mode 'vm-summary-mode)
|
|
423 (let ((point (point))
|
|
424 message-pointer message-list mp)
|
|
425 (save-excursion
|
|
426 (set-buffer vm-mail-buffer)
|
|
427 (setq message-pointer vm-message-pointer
|
|
428 message-list vm-message-list))
|
|
429 (cond ((or (null message-pointer)
|
|
430 (and (>= point (vm-su-start-of (car message-pointer)))
|
|
431 (< point (vm-su-end-of (car message-pointer)))))
|
|
432 nil )
|
|
433 ;; the position at eob belongs to the last message
|
|
434 ((and (eobp) (= (vm-su-end-of (car message-pointer)) point))
|
|
435 nil )
|
|
436 ;; make the position at eob belong to the last message
|
|
437 ((eobp)
|
|
438 (setq mp (vm-last message-pointer))
|
|
439 (save-excursion
|
|
440 (set-buffer vm-mail-buffer)
|
|
441 (vm-record-and-change-message-pointer vm-message-pointer mp)
|
|
442 (vm-preview-current-message)
|
|
443 ;; return non-nil so the caller will know that
|
|
444 ;; a new message was selected.
|
|
445 t ))
|
|
446 (t
|
|
447 (if (< point (vm-su-start-of (car message-pointer)))
|
|
448 (setq mp message-list)
|
|
449 (setq mp (cdr message-pointer) message-pointer nil))
|
|
450 (while (and (not (eq mp message-pointer))
|
|
451 (>= point (vm-su-end-of (car mp))))
|
|
452 (setq mp (cdr mp)))
|
|
453 (if (not (eq mp message-pointer))
|
|
454 (save-excursion
|
|
455 (set-buffer vm-mail-buffer)
|
|
456 (vm-record-and-change-message-pointer
|
|
457 vm-message-pointer mp)
|
|
458 (vm-preview-current-message)
|
|
459 ;; return non-nil so the caller will know that
|
|
460 ;; a new message was selected.
|
|
461 t )))))))
|