Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-virtual.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 05472e90ae02
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Virtual folders for VM 1 ;;; Virtual folders for VM
2 ;;; Copyright (C) 1990-1997 Kyle E. Jones 2 ;;; Copyright (C) 1990, 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.
29 ;; definition. Matching messages are added to 29 ;; definition. Matching messages are added to
30 ;; vm-message-list, instead of replacing it. 30 ;; vm-message-list, instead of replacing it.
31 ;; 31 ;;
32 ;; The messages in new-messages must all be in the same real folder. 32 ;; The messages in new-messages must all be in the same real folder.
33 (defun vm-build-virtual-message-list (new-messages) 33 (defun vm-build-virtual-message-list (new-messages)
34 (vm-with-virtual-selector-variables 34 (let ((clauses (cdr vm-virtual-folder-definition))
35 (let ((clauses (cdr vm-virtual-folder-definition)) 35
36 (message-set (make-vector 311 0)) 36 (message-set (make-vector 311 0))
37 (vbuffer (current-buffer)) 37 (vbuffer (current-buffer))
38 (mirrored vm-virtual-mirror) 38 (mirrored vm-virtual-mirror)
39 (case-fold-search t) 39 (case-fold-search t)
40 (tail-cons (vm-last vm-message-list)) 40 (tail-cons (vm-last vm-message-list))
41 (new-message-list nil) 41 (new-message-list nil)
42 virtual location-vector 42
43 message mp folders folder 43 ;; selectors
44 selectors sel-list selector arglist i 44 (any 'vm-vs-any)
45 real-buffers-used) 45 (and 'vm-vs-and)
46 ;; Since there is at most one virtual message in the folder 46 (or 'vm-vs-or)
47 ;; buffer of a virtual folder, the location data vector (and 47 (not 'vm-vs-not)
48 ;; the markers in it) of all virtual messages in a virtual 48 (header 'vm-vs-header)
49 ;; folder is shared. We initialize the vector here if it 49 (label 'vm-vs-label)
50 ;; hasn't been created already. 50 (text 'vm-vs-text)
51 (if vm-message-list 51 (recipient 'vm-vs-recipient)
52 (setq location-vector (vm-location-data-of (car vm-message-pointer))) 52 (author 'vm-vs-author)
53 (setq i 0 53 (subject 'vm-vs-subject)
54 location-vector (make-vector vm-location-data-vector-length nil)) 54 (sent-before 'vm-vs-sent-before)
55 (while (< i vm-location-data-vector-length) 55 (sent-after 'vm-vs-sent-after)
56 (aset location-vector i (vm-marker nil)) 56 (more-chars-than 'vm-vs-more-chars-than)
57 (vm-increment i))) 57 (less-chars-than 'vm-vs-less-chars-than)
58 ;; To keep track of the messages in a virtual folder to 58 (more-lines-than 'vm-vs-more-lines-than)
59 ;; prevent duplicates we create and maintain a set that 59 (less-lines-than 'vm-vs-less-lines-than)
60 ;; contain all the real messages. 60 (new 'vm-vs-new)
61 (setq mp vm-message-list) 61 (unread 'vm-vs-unread)
62 (while mp 62 (read 'vm-vs-read)
63 (intern (vm-message-id-number-of (vm-real-message-of (car mp))) 63 (deleted 'vm-vs-deleted)
64 message-set) 64 (replied 'vm-vs-replied)
65 (setq mp (cdr mp))) 65 (forwarded 'vm-vs-forwarded)
66 ;; now select the messages 66 (filed 'vm-vs-filed)
67 (save-excursion 67 (written 'vm-vs-written)
68 (while clauses 68 (edited 'vm-vs-edited)
69 (setq folders (car (car clauses)) 69 (marked 'vm-vs-marked)
70 selectors (cdr (car clauses))) 70
71 (while folders 71 virtual location-vector
72 (setq folder (car folders)) 72 message mp folders folder
73 (and (stringp folder) 73 selectors sel-list selector arglist i
74 (setq folder (expand-file-name folder vm-folder-directory))) 74 real-buffers-used)
75 (and (listp folder) 75 ;; Since there is at most one virtual message in the folder
76 (setq folder (eval folder))) 76 ;; buffer of a virtual folder, the location data vector (and
77 (cond 77 ;; the markers in it) of all virtual messages in a virtual
78 ((null folder) 78 ;; folder is shared. We initialize the vector here if it
79 ;; folder was a s-expr which returned nil 79 ;; hasn't been created already.
80 ;; skip it 80 (if vm-message-list
81 nil ) 81 (setq location-vector (vm-location-data-of (car vm-message-pointer)))
82 ((and (stringp folder) (file-directory-p folder)) 82 (setq i 0
83 (setq folders (nconc folders 83 location-vector (make-vector vm-location-data-vector-length nil))
84 (vm-delete-backup-file-names 84 (while (< i vm-location-data-vector-length)
85 (vm-delete-auto-save-file-names 85 (aset location-vector i (vm-marker nil))
86 (vm-delete-directory-file-names 86 (vm-increment i)))
87 (directory-files folder t nil))))))) 87 ;; To keep track of the messages in a virtual folder to
88 ((or (null new-messages) 88 ;; prevent duplicates we create and maintain a set that
89 ;; If we're assimilating messages into an 89 ;; contain all the real messages.
90 ;; existing virtual folder, only allow selectors 90 (setq mp vm-message-list)
91 ;; that would be normally applied to this folder. 91 (while mp
92 (and (bufferp folder) 92 (intern (vm-message-id-number-of (vm-real-message-of (car mp)))
93 (eq (vm-buffer-of (car new-messages)) folder)) 93 message-set)
94 (and (stringp folder) 94 (setq mp (cdr mp)))
95 (eq (vm-buffer-of (car new-messages)) 95 ;; now select the messages
96 ;; letter bomb protection 96 (save-excursion
97 ;; set inhibit-local-variables to t for v18 Emacses 97 (while clauses
98 ;; set enable-local-variables to nil 98 (setq folders (car (car clauses))
99 ;; for newer Emacses 99 selectors (cdr (car clauses)))
100 (let ((inhibit-local-variables t) 100 (while folders
101 (enable-local-variables nil)) 101 (setq folder (car folders))
102 (find-file-noselect folder))))) 102 (and (stringp folder)
103 (set-buffer (or (and (bufferp folder) folder) 103 (setq folder (expand-file-name folder vm-folder-directory)))
104 (vm-get-file-buffer folder) 104 (and (listp folder)
105 (let ((inhibit-local-variables t) 105 (setq folder (eval folder)))
106 (enable-local-variables nil)) 106 (cond
107 (find-file-noselect folder)))) 107 ((null folder)
108 (if (eq major-mode 'vm-virtual-mode) 108 ;; folder was a s-expr which returned nil
109 (setq virtual t 109 ;; skip it
110 real-buffers-used 110 nil )
111 (append vm-real-buffers real-buffers-used)) 111 ((and (stringp folder) (file-directory-p folder))
112 (setq virtual nil) 112 (setq folders (nconc folders
113 (if (not (memq (current-buffer) real-buffers-used)) 113 (vm-delete-backup-file-names
114 (setq real-buffers-used (cons (current-buffer) 114 (vm-delete-auto-save-file-names
115 real-buffers-used))) 115 (vm-delete-directory-file-names
116 (if (not (eq major-mode 'vm-mode)) 116 (directory-files folder t nil)))))))
117 (vm-mode))) 117 ((or (null new-messages)
118 ;; change (sexpr) into ("/file" "/file2" ...) 118 ;; If we're assimilating messages into an
119 ;; this assumes that there will never be (sexpr sexpr2) 119 ;; existing virtual folder, only allow selectors
120 ;; in a virtual folder spec. 120 ;; that would be normally applied to this folder.
121 (if (bufferp folder) 121 (and (bufferp folder)
122 (if virtual 122 (eq (vm-buffer-of (car new-messages)) folder))
123 (setcar (car clauses) 123 (and (stringp folder)
124 (delq nil 124 (eq (vm-buffer-of (car new-messages))
125 (mapcar 'buffer-file-name vm-real-buffers))) 125 ;; letter bomb protection
126 (if buffer-file-name 126 ;; set inhibit-local-variables to t for v18 Emacses
127 (setcar (car clauses) (list buffer-file-name))))) 127 ;; set enable-local-variables to nil for newer Emacses
128 ;; if new-messages non-nil use it instead of the 128 (let ((inhibit-local-variables t)
129 ;; whole message list 129 (enable-local-variables nil))
130 (setq mp (or new-messages vm-message-list)) 130 (find-file-noselect folder)))))
131 (while mp 131 (set-buffer (or (and (bufferp folder) folder)
132 (if (and (not (intern-soft 132 (vm-get-file-buffer folder)
133 (vm-message-id-number-of 133 (find-file-noselect folder)))
134 (vm-real-message-of (car mp))) 134 (if (eq major-mode 'vm-virtual-mode)
135 message-set)) 135 (setq virtual t
136 (if virtual 136 real-buffers-used
137 (save-excursion 137 (append vm-real-buffers real-buffers-used))
138 (set-buffer 138 (setq virtual nil)
139 (vm-buffer-of 139 (if (not (memq (current-buffer) real-buffers-used))
140 (vm-real-message-of 140 (setq real-buffers-used (cons (current-buffer)
141 (car mp)))) 141 real-buffers-used)))
142 (apply 'vm-vs-or (car mp) selectors)) 142 (if (not (eq major-mode 'vm-mode))
143 (apply 'vm-vs-or (car mp) selectors))) 143 (vm-mode)))
144 (progn 144 ;; change (sexpr) into ("/file" "/file2" ...)
145 (intern 145 ;; this assumes that there will never be (sexpr sexpr2)
146 (vm-message-id-number-of 146 ;; in a virtual folder spec.
147 (vm-real-message-of (car mp))) 147 (if (bufferp folder)
148 (if virtual
149 (setcar (car clauses)
150 (delq nil
151 (mapcar 'buffer-file-name vm-real-buffers)))
152 (if buffer-file-name
153 (setcar (car clauses) (list buffer-file-name)))))
154 ;; if new-messages non-nil use it instead of the
155 ;; whole message list
156 (setq mp (or new-messages vm-message-list))
157 (while mp
158 (if (and (not (intern-soft
159 (vm-message-id-number-of
160 (vm-real-message-of (car mp)))
161 message-set))
162 (if virtual
163 (save-excursion
164 (set-buffer
165 (vm-buffer-of
166 (vm-real-message-of
167 (car mp))))
168 (apply 'vm-vs-or (vm-real-message-of (car mp))
169 selectors))
170 (apply 'vm-vs-or (car mp) selectors)))
171 (progn
172 (intern
173 (vm-message-id-number-of
174 (vm-real-message-of (car mp)))
148 message-set) 175 message-set)
149 (setq message (copy-sequence 176 (setq message (copy-sequence
150 (vm-real-message-of (car mp)))) 177 (vm-real-message-of (car mp))))
151 (if mirrored 178 (if mirrored
152 () 179 ()
153 (vm-set-mirror-data-of 180 (vm-set-mirror-data-of
154 message 181 message
155 (make-vector vm-mirror-data-vector-length nil)) 182 (make-vector vm-mirror-data-vector-length nil))
156 (vm-set-virtual-messages-sym-of 183 (vm-set-virtual-messages-sym-of
157 message (make-symbol "<v>")) 184 message (make-symbol "<v>"))
158 (vm-set-virtual-messages-of message nil) 185 (vm-set-virtual-messages-of message nil)
159 (vm-set-attributes-of 186 (vm-set-attributes-of
160 message 187 message
161 (make-vector vm-attributes-vector-length nil))) 188 (make-vector vm-attributes-vector-length nil)))
162 (vm-set-location-data-of message location-vector) 189 (vm-set-location-data-of message location-vector)
163 (vm-set-softdata-of 190 (vm-set-softdata-of
164 message 191 message
165 (make-vector vm-softdata-vector-length nil)) 192 (make-vector vm-softdata-vector-length nil))
166 (vm-set-real-message-sym-of 193 (vm-set-real-message-sym-of
167 message 194 message
168 (vm-real-message-sym-of (car mp))) 195 (vm-real-message-sym-of (car mp)))
169 (vm-set-message-type-of message vm-folder-type) 196 (vm-set-message-type-of message vm-folder-type)
170 (vm-set-message-id-number-of message 197 (vm-set-message-id-number-of message
171 vm-message-id-number) 198 vm-message-id-number)
172 (vm-increment vm-message-id-number) 199 (vm-increment vm-message-id-number)
173 (vm-set-buffer-of message vbuffer) 200 (vm-set-buffer-of message vbuffer)
174 (vm-set-reverse-link-sym-of message (make-symbol "<--")) 201 (vm-set-reverse-link-sym-of message (make-symbol "<--"))
175 (vm-set-reverse-link-of message tail-cons) 202 (vm-set-reverse-link-of message tail-cons)
176 (if (null tail-cons) 203 (if (null tail-cons)
177 (setq new-message-list (list message) 204 (setq new-message-list (list message)
178 tail-cons new-message-list) 205 tail-cons new-message-list)
179 (setcdr tail-cons (list message)) 206 (setcdr tail-cons (list message))
180 (if (null new-message-list) 207 (if (null new-message-list)
181 (setq new-message-list (cdr tail-cons))) 208 (setq new-message-list (cdr tail-cons)))
182 (setq tail-cons (cdr tail-cons))))) 209 (setq tail-cons (cdr tail-cons)))))
183 (setq mp (cdr mp))))) 210 (setq mp (cdr mp)))))
184 (setq folders (cdr folders))) 211 (setq folders (cdr folders)))
185 (setq clauses (cdr clauses)))) 212 (setq clauses (cdr clauses))))
186 ;; this doesn't need to work currently, but it might someday 213 ; this doesn't need to work currently, but it might someday
187 ;; (if virtual 214 ; (if virtual
188 ;; (setq real-buffers-used (vm-delete-duplicates real-buffers-used))) 215 ; (setq real-buffers-used (vm-delete-duplicates real-buffers-used)))
189 (vm-increment vm-modification-counter) 216 (vm-increment vm-modification-counter)
190 ;; Until this point the user doesn't really have a virtual 217 ;; Until this point the user doesn't really have a virtual
191 ;; folder, as the virtual messages haven't been linked to the 218 ;; folder, as the virtual messages haven't been linked to the
192 ;; real messages, virtual buffers to the real buffers, and no 219 ;; real messages, virtual buffers to the real buffers, and no
193 ;; message list has been installed. 220 ;; message list has been installed.
194 ;; 221 ;;
195 ;; Now we tie it all together, with this section of code being 222 ;; Now we tie it all together, with this section of code being
196 ;; uninterruptible. 223 ;; uninterruptible.
197 (let ((inhibit-quit t) 224 (let ((inhibit-quit t))
198 (label-obarray vm-label-obarray)) 225 (if (null vm-real-buffers)
199 (if (null vm-real-buffers) 226 (setq vm-real-buffers real-buffers-used))
200 (setq vm-real-buffers real-buffers-used)) 227 (save-excursion
201 (save-excursion 228 (while real-buffers-used
202 (while real-buffers-used 229 (set-buffer (car real-buffers-used))
203 (set-buffer (car real-buffers-used)) 230 (if (not (memq vbuffer vm-virtual-buffers))
204 ;; inherit the global label lists of all the associated 231 (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers)))
205 ;; real folders. 232 (setq real-buffers-used (cdr real-buffers-used))))
206 (mapatoms (function (lambda (x) (intern (symbol-name x) 233 (setq mp new-message-list)
207 label-obarray))) 234 (while mp
208 vm-label-obarray) 235 (vm-set-virtual-messages-of
209 (if (not (memq vbuffer vm-virtual-buffers)) 236 (vm-real-message-of (car mp))
210 (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers))) 237 (cons (car mp) (vm-virtual-messages-of (car mp))))
211 (setq real-buffers-used (cdr real-buffers-used)))) 238 (setq mp (cdr mp)))
212 (setq mp new-message-list) 239 (if vm-message-list
213 (while mp 240 (progn
214 (vm-set-virtual-messages-of 241 (vm-set-summary-redo-start-point new-message-list)
215 (vm-real-message-of (car mp)) 242 (vm-set-numbering-redo-start-point new-message-list))
216 (cons (car mp) (vm-virtual-messages-of (car mp)))) 243 (vm-set-summary-redo-start-point t)
217 (setq mp (cdr mp))) 244 (vm-set-numbering-redo-start-point t)
218 (if vm-message-list 245 (setq vm-message-list new-message-list)))))
219 (progn
220 (vm-set-summary-redo-start-point new-message-list)
221 (vm-set-numbering-redo-start-point new-message-list))
222 (vm-set-summary-redo-start-point t)
223 (vm-set-numbering-redo-start-point t)
224 (setq vm-message-list new-message-list))))))
225 246
226 (defun vm-create-virtual-folder (selector &optional arg read-only) 247 (defun vm-create-virtual-folder (selector &optional arg read-only)
227 "Create a new virtual folder from messages in the current folder. 248 "Create a new virtual folder from messages in the current folder.
228 The messages will be chosen by applying the selector you specify, 249 The messages will be chosen by applying the selector you specify,
229 which is normally read from the minibuffer. 250 which is normally read from the minibuffer.
246 (setq vm-virtual-folder-alist 267 (setq vm-virtual-folder-alist
247 (list 268 (list
248 (list name 269 (list name
249 (list (list (list 'get-buffer (buffer-name))) 270 (list (list (list 'get-buffer (buffer-name)))
250 (if arg (list selector arg) (list selector)))))) 271 (if arg (list selector arg) (list selector))))))
251 (vm-visit-virtual-folder name read-only)) 272 (vm-visit-virtual-folder name read-only)))
252 ;; have to do this again here because the known virtual
253 ;; folder menu is now hosed because we installed it while
254 ;; vm-virtual-folder-alist was bound to the temp value above
255 (if vm-use-menus
256 (vm-menu-install-known-virtual-folders-menu)))
257
258 273
259 (defun vm-apply-virtual-folder (name &optional read-only) 274 (defun vm-apply-virtual-folder (name &optional read-only)
260 "Apply the selectors of a named virtual folder to the current folder 275 "Apply the selectors of a named virtual folder to the current folder
261 and create a virtual folder containing the selected messages. 276 and create a virtual folder containing the selected messages.
262 277
279 (while clauses 294 (while clauses
280 (setcar (car clauses) (list (list 'get-buffer (buffer-name)))) 295 (setcar (car clauses) (list (list 'get-buffer (buffer-name))))
281 (setq clauses (cdr clauses))) 296 (setq clauses (cdr clauses)))
282 (setcar vfolder (format "%s/%s" (buffer-name) (car vfolder))) 297 (setcar vfolder (format "%s/%s" (buffer-name) (car vfolder)))
283 (setq vm-virtual-folder-alist (list vfolder)) 298 (setq vm-virtual-folder-alist (list vfolder))
284 (vm-visit-virtual-folder (car vfolder) read-only)) 299 (vm-visit-virtual-folder (car vfolder) read-only)))
285 ;; have to do this again here because the known virtual
286 ;; folder menu is now hosed because we installed it while
287 ;; vm-virtual-folder-alist was bound to the temp value above
288 (if vm-use-menus
289 (vm-menu-install-known-virtual-folders-menu)))
290 300
291 (defun vm-toggle-virtual-mirror () 301 (defun vm-toggle-virtual-mirror ()
292 (interactive) 302 (interactive)
293 (vm-select-folder-buffer) 303 (vm-select-folder-buffer)
294 (vm-check-for-killed-summary) 304 (vm-check-for-killed-summary)
340 (defun vm-virtual-help () 350 (defun vm-virtual-help ()
341 (interactive) 351 (interactive)
342 (vm-display nil nil '(vm-virtual-help) '(vm-virtual-help)) 352 (vm-display nil nil '(vm-virtual-help) '(vm-virtual-help))
343 (message "VV = visit, VA = apply selectors, VC = create, VM = toggle virtual mirror")) 353 (message "VV = visit, VA = apply selectors, VC = create, VM = toggle virtual mirror"))
344 354
355 (defun vm-delete-directory-file-names (list)
356 (vm-delete 'file-directory-p list))
357
358 (defun vm-delete-backup-file-names (list)
359 (vm-delete 'backup-file-name-p list))
360
361 (defun vm-delete-auto-save-file-names (list)
362 (vm-delete 'auto-save-file-name-p list))
363
345 (defun vm-vs-or (m &rest selectors) 364 (defun vm-vs-or (m &rest selectors)
346 (let ((result nil) selector arglist) 365 (let ((result nil) selector arglist)
347 (while selectors 366 (while selectors
348 (setq selector (car (car selectors)) 367 (setq selector (car (car selectors))
349 arglist (cdr (car selectors)) 368 arglist (cdr (car selectors))
386 405
387 (defun vm-vs-header (m arg) 406 (defun vm-vs-header (m arg)
388 (save-excursion 407 (save-excursion
389 (save-restriction 408 (save-restriction
390 (widen) 409 (widen)
391 (goto-char (vm-headers-of (vm-real-message-of m))) 410 (goto-char (vm-headers-of m))
392 (re-search-forward arg (vm-text-of (vm-real-message-of m)) t)))) 411 (re-search-forward arg (vm-text-of m) t))))
393 412
394 (defun vm-vs-label (m arg) 413 (defun vm-vs-label (m arg)
395 (vm-member arg (vm-labels-of m))) 414 (vm-member arg (vm-labels-of m)))
396 415
397 (defun vm-vs-text (m arg) 416 (defun vm-vs-text (m arg)
398 (save-excursion 417 (save-excursion
399 (save-restriction 418 (save-restriction
400 (widen) 419 (widen)
401 (goto-char (vm-text-of (vm-real-message-of m))) 420 (goto-char (vm-text-of m))
402 (re-search-forward arg (vm-text-end-of (vm-real-message-of m)) t)))) 421 (re-search-forward arg (vm-text-end-of m) t))))
403 422
404 (defun vm-vs-more-chars-than (m arg) 423 (defun vm-vs-more-chars-than (m arg)
405 (> (string-to-int (vm-su-byte-count m)) arg)) 424 (> (string-to-int (vm-su-byte-count m)) arg))
406 425
407 (defun vm-vs-less-chars-than (m arg) 426 (defun vm-vs-less-chars-than (m arg)
464 prompt 483 prompt
465 (vm-obarray-to-string-list 484 (vm-obarray-to-string-list
466 vm-label-obarray) 485 vm-label-obarray)
467 nil))))) 486 nil)))))
468 (t (setq arg (read-string prompt)))))) 487 (t (setq arg (read-string prompt))))))
469 (or (fboundp (intern (concat "vm-vs-" (symbol-name selector))))
470 (error "Invalid selector"))
471 (list selector arg))) 488 (list selector arg)))
472 489
473 ;; clear away links between real and virtual folders when 490 ;; clear away links between real and virtual folders when
474 ;; a vm-quit is performed in either type folder. 491 ;; a vm-quit is performed in either type folder.
475 (defun vm-virtual-quit () 492 (defun vm-virtual-quit ()
517 (while bp 534 (while bp
518 (set-buffer (car bp)) 535 (set-buffer (car bp))
519 (setq vm-real-buffers (delq b vm-real-buffers)) 536 (setq vm-real-buffers (delq b vm-real-buffers))
520 ;; set the message pointer to a new value if it is 537 ;; set the message pointer to a new value if it is
521 ;; now invalid. 538 ;; now invalid.
522 (cond 539 (setq vmp vm-message-pointer)
523 ((and vm-message-pointer 540 (while (and vm-message-pointer
524 (equal "Q" (vm-message-id-number-of 541 (equal "Q" (vm-message-id-number-of
525 (car vm-message-pointer)))) 542 (car vm-message-pointer))))
526 (vm-garbage-collect-message) 543 (setq vm-message-pointer
527 (setq vmp vm-message-pointer) 544 (cdr vm-message-pointer)))
528 (while (and vm-message-pointer 545 ;; if there were no good messages ahead, try going
529 (equal "Q" (vm-message-id-number-of 546 ;; backward.
530 (car vm-message-pointer)))) 547 (if (null vm-message-pointer)
531 (setq vm-message-pointer 548 (progn
532 (cdr vm-message-pointer))) 549 (setq vm-message-pointer vmp)
533 ;; if there were no good messages ahead, try going 550 (while (and vm-message-pointer
534 ;; backward. 551 (equal "Q" (vm-message-id-number-of
535 (if (null vm-message-pointer) 552 (car vm-message-pointer))))
536 (progn 553 (setq vm-message-pointer
537 (setq vm-message-pointer vmp) 554 (vm-reverse-link-of (car vm-message-pointer))))))
538 (while (and vm-message-pointer
539 (equal "Q" (vm-message-id-number-of
540 (car vm-message-pointer))))
541 (setq vm-message-pointer
542 (vm-reverse-link-of
543 (car vm-message-pointer))))))))
544 ;; expunge the virtual messages associated with 555 ;; expunge the virtual messages associated with
545 ;; real messages that are going away. 556 ;; real messages that are going away.
546 (setq vm-message-list 557 (setq vm-message-list
547 (vm-delete (function 558 (vm-delete (function
548 (lambda (m) 559 (lambda (m)