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