|
0
|
1 ;;; Commands to undo message attribute changes in VM
|
|
70
|
2 ;;; Copyright (C) 1989, 1990, 1993, 1994 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-undo)
|
|
|
19
|
|
|
20 (defun vm-set-buffer-modified-p (flag &optional buffer)
|
|
|
21 (save-excursion
|
|
|
22 (and buffer (set-buffer buffer))
|
|
|
23 (set-buffer-modified-p flag)
|
|
|
24 (vm-increment vm-modification-counter)
|
|
|
25 (intern (buffer-name) vm-buffers-needing-display-update)
|
|
|
26 (if (null flag)
|
|
|
27 (setq vm-messages-not-on-disk 0))))
|
|
|
28
|
|
|
29 (defun vm-undo-boundary ()
|
|
|
30 (if (car vm-undo-record-list)
|
|
|
31 (setq vm-undo-record-list (cons nil vm-undo-record-list))))
|
|
|
32
|
|
|
33 (defun vm-clear-expunge-invalidated-undos ()
|
|
|
34 (let ((udp vm-undo-record-list) udp-prev)
|
|
|
35 (while udp
|
|
|
36 (cond ((null (car udp))
|
|
|
37 (setq udp-prev udp))
|
|
|
38 ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
|
|
|
39 ;; delete flag == expunged is the
|
|
|
40 ;; indicator of an expunged message
|
|
|
41 (eq (vm-deleted-flag (car (cdr (car udp)))) 'expunged))
|
|
|
42 (cond (udp-prev (setcdr udp-prev (cdr udp)))
|
|
|
43 (t (setq vm-undo-record-list (cdr udp)))))
|
|
|
44 (t (setq udp-prev udp)))
|
|
|
45 (setq udp (cdr udp))))
|
|
|
46 (vm-clear-modification-flag-undos))
|
|
|
47
|
|
|
48 (defun vm-clear-virtual-quit-invalidated-undos ()
|
|
|
49 (let ((udp vm-undo-record-list) udp-prev)
|
|
|
50 (while udp
|
|
|
51 (cond ((null (car udp))
|
|
|
52 (setq udp-prev udp))
|
|
|
53 ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
|
|
|
54 ;; message-id-number == "Q" is the
|
|
|
55 ;; indicator of a dead message
|
|
|
56 (equal (vm-message-id-number-of (car (cdr (car udp)))) "Q"))
|
|
|
57 (cond (udp-prev (setcdr udp-prev (cdr udp)))
|
|
|
58 (t (setq vm-undo-record-list (cdr udp)))))
|
|
|
59 (t (setq udp-prev udp)))
|
|
|
60 (setq udp (cdr udp))))
|
|
|
61 (vm-clear-modification-flag-undos))
|
|
|
62
|
|
|
63 (defun vm-clear-modification-flag-undos ()
|
|
|
64 (let ((udp vm-undo-record-list) udp-prev)
|
|
|
65 (while udp
|
|
|
66 (cond ((null (car udp))
|
|
|
67 (setq udp-prev udp))
|
|
|
68 ((eq (car (car udp)) 'vm-set-buffer-modified-p)
|
|
|
69 (cond (udp-prev (setcdr udp-prev (cdr udp)))
|
|
|
70 (t (setq vm-undo-record-list (cdr udp)))))
|
|
|
71 (t (setq udp-prev udp)))
|
|
|
72 (setq udp (cdr udp)))
|
|
|
73 (vm-squeeze-consecutive-undo-boundaries)))
|
|
|
74
|
|
|
75 ;; squeeze out consecutive record separators left by record deletions
|
|
|
76 (defun vm-squeeze-consecutive-undo-boundaries ()
|
|
|
77 (let ((udp vm-undo-record-list) udp-prev)
|
|
|
78 (while udp
|
|
|
79 (cond ((and (null (car udp)) udp-prev (null (car udp-prev)))
|
|
|
80 (setcdr udp-prev (cdr udp)))
|
|
|
81 (t (setq udp-prev udp)))
|
|
|
82 (setq udp (cdr udp)))
|
|
|
83 (if (equal '(nil) vm-undo-record-list)
|
|
|
84 (setq vm-undo-record-list nil)))
|
|
|
85 ;; for the Undo button on the menubar, if present
|
|
|
86 (and (null vm-undo-record-list)
|
|
|
87 (vm-menu-support-possible-p)
|
|
|
88 (vm-menu-xemacs-menus-p)
|
|
|
89 (vm-menu-set-menubar-dirty-flag)))
|
|
|
90
|
|
|
91 (defun vm-undo-record (sexp)
|
|
|
92 ;; for the Undo button on the menubar, if present
|
|
|
93 (and (null vm-undo-record-list)
|
|
|
94 (vm-menu-support-possible-p)
|
|
|
95 (vm-menu-xemacs-menus-p)
|
|
|
96 (vm-menu-set-menubar-dirty-flag))
|
|
|
97 (setq vm-undo-record-list (cons sexp vm-undo-record-list)))
|
|
|
98
|
|
|
99 (defun vm-undo-describe (record)
|
|
|
100 (let ((cell
|
|
|
101 (assq (car record)
|
|
|
102 '((vm-set-new-flag "new" "old")
|
|
|
103 (vm-set-unread-flag "unread" "read")
|
|
|
104 (vm-set-deleted-flag "deleted" "undeleted")
|
|
|
105 (vm-set-forwarded-flag "forwarded" "unforwarded")
|
|
|
106 (vm-set-replied-flag "answered" "unanswered")
|
|
|
107 (vm-set-redistributed-flag "redistributed" "unredistributed")
|
|
|
108 (vm-set-filed-flag "filed" "unfiled")
|
|
|
109 (vm-set-written-flag "written" "unwritten"))))
|
|
|
110 (m (nth 1 record))
|
|
|
111 labels)
|
|
|
112 (cond (cell
|
|
|
113 (message "VM Undo! %s/%s %s -> %s"
|
|
|
114 (buffer-name (vm-buffer-of m))
|
|
|
115 (vm-number-of m)
|
|
|
116 (if (nth 2 record)
|
|
|
117 (nth 2 cell)
|
|
|
118 (nth 1 cell))
|
|
|
119 (if (nth 2 record)
|
|
|
120 (nth 1 cell)
|
|
|
121 (nth 2 cell))))
|
|
|
122 ((eq (car cell) 'vm-set-labels)
|
|
|
123 (setq labels (nth 2 record))
|
|
|
124 (message "VM Undo! %s/%s %s%s"
|
|
|
125 (buffer-name (vm-buffer-of m))
|
|
|
126 (vm-number-of m)
|
|
|
127 (if (null labels)
|
|
|
128 "lost all its labels"
|
|
|
129 "labels set to ")
|
|
|
130 (if (null labels)
|
|
|
131 ""
|
|
|
132 (mapconcat 'identity labels ", ")))))))
|
|
|
133
|
|
|
134 (defun vm-undo-set-message-pointer (record)
|
|
|
135 (if (and (not (eq (car record) 'vm-set-buffer-modified-p))
|
|
|
136 (not (eq (nth 1 record) vm-message-pointer)))
|
|
|
137 (progn
|
|
|
138 (vm-record-and-change-message-pointer
|
|
|
139 vm-message-pointer
|
|
|
140 (or (cdr (vm-reverse-link-of (nth 1 record)))
|
|
|
141 vm-message-list))
|
|
|
142 ;; make folder read-only to avoid modifications when we
|
|
|
143 ;; do this.
|
|
|
144 (let ((vm-folder-read-only t))
|
|
|
145 (vm-preview-current-message)))))
|
|
|
146
|
|
|
147 (defun vm-undo ()
|
|
|
148 "Undo last change to message attributes in the current folder.
|
|
|
149 Consecutive invocations of this command cause sequentially earlier
|
|
|
150 changes to be undone. After an intervening command between undos,
|
|
|
151 the undos themselves become undoable."
|
|
|
152 (interactive)
|
|
|
153 (vm-select-folder-buffer)
|
|
|
154 (vm-check-for-killed-summary)
|
|
|
155 (vm-display nil nil '(vm-undo) '(vm-undo))
|
|
|
156 (let ((modified (buffer-modified-p)))
|
|
|
157 (if (not (eq last-command 'vm-undo))
|
|
|
158 (setq vm-undo-record-pointer vm-undo-record-list))
|
|
|
159 (if (not vm-undo-record-pointer)
|
|
|
160 (error "No further VM undo information available"))
|
|
|
161 ;; skip current record boundary
|
|
|
162 (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))
|
|
|
163 (while (car vm-undo-record-pointer)
|
|
|
164 (vm-undo-set-message-pointer (car vm-undo-record-pointer))
|
|
|
165 (vm-undo-describe (car vm-undo-record-pointer))
|
|
|
166 (eval (car vm-undo-record-pointer))
|
|
|
167 (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)))
|
|
|
168 (and modified (not (buffer-modified-p))
|
|
|
169 (delete-auto-save-file-if-necessary))
|
|
|
170 (vm-update-summary-and-mode-line)))
|
|
|
171
|
|
|
172 (defun vm-set-message-attributes (string count)
|
|
|
173 "Set message attributes.
|
|
|
174 Use this command to change attributes like `deleted' or
|
|
|
175 `replied'. Interactively you will be prompted for the attributes
|
|
|
176 to be changed, and only the attributes you enter will be altered.
|
|
|
177 You can use completion to expand the attribute names. The names
|
|
|
178 should be entered as a space separated list.
|
|
|
179
|
|
|
180 A numeric prefix argument COUNT causes the current message and
|
|
|
181 the next COUNT-1 message to have their attributes altered. A
|
|
|
182 negative COUNT arg causes the current message and the previous
|
|
|
183 COUNT-1 messages to be altered. COUNT defaults to one."
|
|
|
184 (interactive
|
|
|
185 (let ((last-command last-command)
|
|
|
186 (this-command this-command))
|
|
|
187 ;; so the user can see what message they are about to
|
|
|
188 ;; modify.
|
|
|
189 (vm-follow-summary-cursor)
|
|
|
190 (list
|
|
|
191 (vm-read-string "Set attributes: " vm-supported-attribute-names t)
|
|
|
192 (prefix-numeric-value current-prefix-arg))))
|
|
|
193 (vm-follow-summary-cursor)
|
|
|
194 (vm-select-folder-buffer)
|
|
|
195 (vm-check-for-killed-summary)
|
|
|
196 (vm-error-if-folder-read-only)
|
|
|
197 (vm-error-if-folder-empty)
|
|
|
198 (vm-display nil nil '(vm-set-message-attributes)
|
|
|
199 '(vm-set-message-attributes))
|
|
|
200 (let ((name-list (vm-parse string "[ \t]*\\([^ \t]+\\)"))
|
|
|
201 (m-list (vm-select-marked-or-prefixed-messages count))
|
|
|
202 n-list name m)
|
|
|
203 (while m-list
|
|
|
204 (setq m (car m-list)
|
|
|
205 n-list name-list)
|
|
|
206 (while n-list
|
|
|
207 (setq name (car n-list))
|
|
|
208 (cond ((string= name "new")
|
|
|
209 (vm-set-new-flag m t))
|
|
|
210 ((string= name "recent")
|
|
|
211 (vm-set-new-flag m t))
|
|
|
212 ((string= name "unread")
|
|
|
213 (vm-set-unread-flag m t))
|
|
|
214 ((string= name "unseen")
|
|
|
215 (vm-set-unread-flag m t))
|
|
|
216 ((string= name "read")
|
|
|
217 (vm-set-new-flag m nil)
|
|
|
218 (vm-set-unread-flag m nil))
|
|
|
219 ((string= name "deleted")
|
|
|
220 (vm-set-deleted-flag m t))
|
|
|
221 ((string= name "replied")
|
|
|
222 (vm-set-replied-flag m t))
|
|
|
223 ((string= name "answered")
|
|
|
224 (vm-set-replied-flag m t))
|
|
|
225 ((string= name "forwarded")
|
|
|
226 (vm-set-forwarded-flag m t))
|
|
|
227 ((string= name "redistributed")
|
|
|
228 (vm-set-redistributed-flag m t))
|
|
|
229 ((string= name "filed")
|
|
|
230 (vm-set-filed-flag m t))
|
|
|
231 ((string= name "written")
|
|
|
232 (vm-set-written-flag m t))
|
|
|
233 ((string= name "edited")
|
|
|
234 (vm-set-edited-flag-of m t))
|
|
|
235 ((string= name "undeleted")
|
|
|
236 (vm-set-deleted-flag m nil))
|
|
|
237 ((string= name "unreplied")
|
|
|
238 (vm-set-replied-flag m nil))
|
|
|
239 ((string= name "unanswered")
|
|
|
240 (vm-set-replied-flag m nil))
|
|
|
241 ((string= name "unforwarded")
|
|
|
242 (vm-set-forwarded-flag m nil))
|
|
|
243 ((string= name "unredistributed")
|
|
|
244 (vm-set-redistributed-flag m nil))
|
|
|
245 ((string= name "unfiled")
|
|
|
246 (vm-set-filed-flag m nil))
|
|
|
247 ((string= name "unwritten")
|
|
|
248 (vm-set-written-flag m nil))
|
|
|
249 ((string= name "unedited")
|
|
|
250 (vm-set-edited-flag-of m nil)))
|
|
|
251 (setq n-list (cdr n-list)))
|
|
|
252 (setq m-list (cdr m-list)))
|
|
|
253 (vm-update-summary-and-mode-line)))
|
|
|
254
|
|
|
255 (defun vm-add-message-labels (string count)
|
|
|
256 "Attach some labels to a message.
|
|
|
257 These are arbitrary user-defined labels, not to be confused with
|
|
|
258 message attributes like `new' and `deleted'. Interactively you
|
|
|
259 will be prompted for the labels to be added. You can use
|
|
|
260 completion to expand the label names, with the completion list
|
|
|
261 being all the labels that have ever been used in this folder.
|
|
|
262 The names should be entered as a space separated list. Label
|
|
|
263 names are compared case-insensitively.
|
|
|
264
|
|
|
265 A numeric prefix argument COUNT causes the current message and
|
|
|
266 the next COUNT-1 message to have the labels added. A
|
|
|
267 negative COUNT arg causes the current message and the previous
|
|
|
268 COUNT-1 messages to be altered. COUNT defaults to one."
|
|
|
269 (interactive
|
|
|
270 (let ((last-command last-command)
|
|
|
271 (this-command this-command)
|
|
|
272 (vm-completion-auto-correct nil)
|
|
|
273 (completion-ignore-case t))
|
|
|
274 ;; so the user can see what message they are about to
|
|
|
275 ;; modify.
|
|
|
276 (vm-follow-summary-cursor)
|
|
|
277 (vm-select-folder-buffer)
|
|
|
278 (list
|
|
|
279 (vm-read-string "Add labels: "
|
|
|
280 (vm-obarray-to-string-list vm-label-obarray) t)
|
|
|
281 (prefix-numeric-value current-prefix-arg))))
|
|
|
282 (vm-follow-summary-cursor)
|
|
|
283 (vm-select-folder-buffer)
|
|
|
284 (vm-check-for-killed-summary)
|
|
|
285 (vm-error-if-folder-read-only)
|
|
|
286 (vm-error-if-folder-empty)
|
|
|
287 (vm-add-or-delete-message-labels string count t))
|
|
|
288
|
|
|
289 (defun vm-delete-message-labels (string count)
|
|
|
290 "Delete some labels from a message.
|
|
|
291 These are arbitrary user-defined labels, not to be confused with
|
|
|
292 message attributes like `new' and `deleted'. Interactively you
|
|
|
293 will be prompted for the labels to be deleted. You can use
|
|
|
294 completion to expand the label names, with the completion list
|
|
|
295 being all the labels that have ever been used in this folder.
|
|
|
296 The names should be entered as a space separated list. Label
|
|
|
297 names are compared case-insensitively.
|
|
|
298
|
|
|
299 A numeric prefix argument COUNT causes the current message and
|
|
|
300 the next COUNT-1 message to have the labels deleted. A
|
|
|
301 negative COUNT arg causes the current message and the previous
|
|
|
302 COUNT-1 messages to be altered. COUNT defaults to one."
|
|
|
303 (interactive
|
|
|
304 (let ((last-command last-command)
|
|
|
305 (this-command this-command)
|
|
|
306 (vm-completion-auto-correct nil)
|
|
|
307 (completion-ignore-case t))
|
|
|
308 ;; so the user can see what message they are about to
|
|
|
309 ;; modify.
|
|
|
310 (vm-follow-summary-cursor)
|
|
|
311 (vm-select-folder-buffer)
|
|
|
312 (list
|
|
|
313 (vm-read-string "Delete labels: "
|
|
|
314 (vm-obarray-to-string-list vm-label-obarray) t)
|
|
|
315 (prefix-numeric-value current-prefix-arg))))
|
|
|
316 (vm-follow-summary-cursor)
|
|
|
317 (vm-select-folder-buffer)
|
|
|
318 (vm-check-for-killed-summary)
|
|
|
319 (vm-error-if-folder-read-only)
|
|
|
320 (vm-error-if-folder-empty)
|
|
|
321 (vm-add-or-delete-message-labels string count nil))
|
|
|
322
|
|
|
323 (defun vm-add-or-delete-message-labels (string count add)
|
|
|
324 (vm-display nil nil '(vm-add-message-labels vm-delete-message-labels)
|
|
|
325 (list this-command))
|
|
|
326 (setq string (downcase string))
|
|
|
327 (let ((m-list (vm-select-marked-or-prefixed-messages count))
|
|
|
328 (action-labels (vm-parse string
|
|
|
329 "[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*"))
|
|
|
330 labels act-labels)
|
|
|
331 (if (and add m-list)
|
|
|
332 (progn
|
|
|
333 (setq act-labels action-labels)
|
|
|
334 (while act-labels
|
|
|
335 (intern (car act-labels) vm-label-obarray)
|
|
|
336 (setq act-labels (cdr act-labels)))))
|
|
|
337 (while m-list
|
|
|
338 (setq act-labels action-labels
|
|
|
339 labels (copy-sequence (vm-labels-of (car m-list))))
|
|
|
340 (if add
|
|
|
341 (while act-labels
|
|
|
342 (setq labels (cons (car act-labels) labels)
|
|
|
343 act-labels (cdr act-labels)))
|
|
|
344 (while act-labels
|
|
|
345 (setq labels (vm-delqual (car act-labels) labels)
|
|
|
346 act-labels (cdr act-labels))))
|
|
|
347 (if add
|
|
|
348 (setq labels (vm-delete-duplicates labels)))
|
|
|
349 (vm-set-labels (car m-list) labels)
|
|
|
350 (setq m-list (cdr m-list))))
|
|
|
351 (vm-update-summary-and-mode-line))
|
|
|
352
|
|
|
353 (defun vm-set-xxxx-flag (m flag norecord function attr-index)
|
|
|
354 (let ((m-list nil) vmp)
|
|
|
355 (cond
|
|
|
356 ((and (not vm-folder-read-only)
|
|
|
357 (or (not (vm-virtual-messages-of m))
|
|
|
358 (not (save-excursion
|
|
|
359 (set-buffer
|
|
|
360 (vm-buffer-of
|
|
|
361 (vm-real-message-of m)))
|
|
|
362 vm-folder-read-only))))
|
|
70
|
363 (aset (vm-attributes-of m) attr-index flag)
|
|
|
364 (vm-mark-for-summary-update m)
|
|
0
|
365 (cond
|
|
|
366 ((not norecord)
|
|
70
|
367 (if (eq vm-flush-interval t)
|
|
|
368 (vm-stuff-virtual-attributes m)
|
|
|
369 (vm-set-modflag-of m t))
|
|
0
|
370 (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m)))
|
|
|
371 (while vmp
|
|
|
372 (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp)))
|
|
|
373 (setq m-list (cons (car vmp) m-list)))
|
|
|
374 (setq vmp (cdr vmp)))
|
|
|
375 (if (null m-list)
|
|
|
376 (setq m-list (cons m m-list)))
|
|
|
377 (while m-list
|
|
|
378 (save-excursion
|
|
|
379 (set-buffer (vm-buffer-of (car m-list)))
|
|
|
380 (cond ((not (buffer-modified-p))
|
|
|
381 (vm-set-buffer-modified-p t)
|
|
|
382 (vm-undo-record (list 'vm-set-buffer-modified-p nil))))
|
|
|
383 (vm-undo-record (list function (car m-list) (not flag)))
|
|
|
384 (vm-undo-boundary)
|
|
|
385 (vm-increment vm-modification-counter))
|
|
70
|
386 (setq m-list (cdr m-list)))))))))
|
|
0
|
387
|
|
|
388 (defun vm-set-labels (m labels)
|
|
|
389 (let ((m-list nil)
|
|
|
390 (old-labels (vm-labels-of m))
|
|
|
391 vmp)
|
|
|
392 (cond
|
|
|
393 ((and (not vm-folder-read-only)
|
|
|
394 (or (not (vm-virtual-messages-of m))
|
|
|
395 (not (save-excursion
|
|
|
396 (set-buffer
|
|
|
397 (vm-buffer-of
|
|
|
398 (vm-real-message-of m)))
|
|
|
399 vm-folder-read-only))))
|
|
70
|
400 (vm-set-labels-of m labels)
|
|
|
401 (vm-set-label-string-of m nil)
|
|
|
402 (vm-mark-for-summary-update m)
|
|
|
403 (if (eq vm-flush-interval t)
|
|
|
404 (vm-stuff-virtual-attributes m)
|
|
|
405 (vm-set-modflag-of m t))
|
|
0
|
406 (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m)))
|
|
|
407 (while vmp
|
|
|
408 (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp)))
|
|
|
409 (setq m-list (cons (car vmp) m-list)))
|
|
|
410 (setq vmp (cdr vmp)))
|
|
|
411 (if (null m-list)
|
|
|
412 (setq m-list (cons m m-list)))
|
|
|
413 (while m-list
|
|
|
414 (save-excursion
|
|
|
415 (set-buffer (vm-buffer-of (car m-list)))
|
|
|
416 (cond ((not (buffer-modified-p))
|
|
|
417 (vm-set-buffer-modified-p t)
|
|
|
418 (vm-undo-record (list 'vm-set-buffer-modified-p nil))))
|
|
|
419 (vm-undo-record (list 'vm-set-labels m old-labels))
|
|
|
420 (vm-undo-boundary)
|
|
|
421 (vm-increment vm-modification-counter))
|
|
70
|
422 (setq m-list (cdr m-list)))))))
|
|
0
|
423
|
|
|
424 (defun vm-set-new-flag (m flag &optional norecord)
|
|
|
425 (vm-set-xxxx-flag m flag norecord 'vm-set-new-flag 0))
|
|
|
426
|
|
|
427 (defun vm-set-unread-flag (m flag &optional norecord)
|
|
|
428 (vm-set-xxxx-flag m flag norecord 'vm-set-unread-flag 1))
|
|
|
429
|
|
|
430 (defun vm-set-deleted-flag (m flag &optional norecord)
|
|
|
431 (vm-set-xxxx-flag m flag norecord 'vm-set-deleted-flag 2))
|
|
|
432
|
|
|
433 (defun vm-set-filed-flag (m flag &optional norecord)
|
|
|
434 (vm-set-xxxx-flag m flag norecord 'vm-set-filed-flag 3))
|
|
|
435
|
|
|
436 (defun vm-set-replied-flag (m flag &optional norecord)
|
|
|
437 (vm-set-xxxx-flag m flag norecord 'vm-set-replied-flag 4))
|
|
|
438
|
|
|
439 (defun vm-set-written-flag (m flag &optional norecord)
|
|
|
440 (vm-set-xxxx-flag m flag norecord 'vm-set-written-flag 5))
|
|
|
441
|
|
|
442 (defun vm-set-forwarded-flag (m flag &optional norecord)
|
|
|
443 (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 6))
|
|
|
444
|
|
|
445 (defun vm-set-redistributed-flag (m flag &optional norecord)
|
|
|
446 (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 8))
|
|
|
447
|
|
|
448 ;; use these to avoid undo and summary update.
|
|
|
449 (defun vm-set-new-flag-of (m flag) (aset (aref m 2) 0 flag))
|
|
|
450 (defun vm-set-unread-flag-of (m flag) (aset (aref m 2) 1 flag))
|
|
|
451 (defun vm-set-deleted-flag-of (m flag) (aset (aref m 2) 2 flag))
|
|
|
452 (defun vm-set-filed-flag-of (m flag) (aset (aref m 2) 3 flag))
|
|
|
453 (defun vm-set-replied-flag-of (m flag) (aset (aref m 2) 4 flag))
|
|
|
454 (defun vm-set-written-flag-of (m flag) (aset (aref m 2) 5 flag))
|
|
|
455 (defun vm-set-forwarded-flag-of (m flag) (aset (aref m 2) 6 flag))
|
|
|
456 (defun vm-set-redistributed-flag-of (m flag) (aset (aref m 2) 8 flag))
|
|
|
457
|
|
|
458 ;; this is solely for the use of vm-stuff-attributes and appears here
|
|
|
459 ;; only because this function should be grouped with others of its kind
|
|
|
460 ;; for maintenance purposes.
|
|
|
461 (defun vm-set-deleted-flag-in-vector (v flag)
|
|
|
462 (aset v 2 flag))
|
|
|
463 ;; ditto. this is for vm-read-attributes.
|
|
|
464 (defun vm-set-new-flag-in-vector (v flag)
|
|
|
465 (aset v 0 flag))
|
