cgit.sxemacs.org Git - packages/blob - xemacs-packages/vm/lisp/vm-undo.el

   1 ;;; vm-undo.el --- Commands to undo message attribute changes in VM
   2 ;;
   3 ;; Copyright (C) 1989-1995 Kyle E. Jones
   4 ;; Copyright (C) 2003-2006 Robert Widhopf-Fenk
   5 ;;
   6 ;; This program is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 2 of the License, or
   9 ;; (at your option) any later version.
  10 ;;
  11 ;; This program is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15 ;;
  16 ;; You should have received a copy of the GNU General Public License along
  17 ;; with this program; if not, write to the Free Software Foundation, Inc.,
  18 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 ;;; Code:
  21 (defun vm-set-buffer-modified-p (flag &optional buffer)
  22   (save-excursion
  23     (and buffer (set-buffer buffer))
  24     (set-buffer-modified-p flag)
  25     (vm-increment vm-modification-counter)
  26     (intern (buffer-name) vm-buffers-needing-display-update)
  27     (if (null flag)
  28         (setq vm-messages-not-on-disk 0))))
  29
  30 (defun vm-undo-boundary ()
  31   (if (car vm-undo-record-list)
  32       (setq vm-undo-record-list (cons nil vm-undo-record-list))))
  33
  34 (defun vm-add-undo-boundaries ()
  35   (save-excursion
  36     (mapatoms (function
  37                (lambda (b)
  38                  (setq b (get-buffer (symbol-name b)))
  39                  (if b
  40                      (progn
  41                        (set-buffer b)
  42                        (vm-undo-boundary)))))
  43               vm-buffers-needing-undo-boundaries)
  44     (fillarray vm-buffers-needing-undo-boundaries 0)))
  45
  46 (defun vm-clear-expunge-invalidated-undos ()
  47   (let ((udp vm-undo-record-list) udp-prev)
  48     (while udp
  49       (cond ((null (car udp))
  50              (setq udp-prev udp))
  51             ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
  52                   ;; delete flag == expunged is the
  53                   ;; indicator of an expunged message
  54                   (eq (vm-deleted-flag (car (cdr (car udp)))) 'expunged))
  55              (cond (udp-prev (setcdr udp-prev (cdr udp)))
  56                    (t (setq vm-undo-record-list (cdr udp)))))
  57             (t (setq udp-prev udp)))
  58       (setq udp (cdr udp))))
  59   (vm-clear-modification-flag-undos))
  60
  61 (defun vm-clear-virtual-quit-invalidated-undos ()
  62   (let ((udp vm-undo-record-list) udp-prev)
  63     (while udp
  64       (cond ((null (car udp))
  65              (setq udp-prev udp))
  66             ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p))
  67                   ;; message-id-number == "Q" is the
  68                   ;; indicator of a dead message
  69                   (equal (vm-message-id-number-of (car (cdr (car udp)))) "Q"))
  70              (cond (udp-prev (setcdr udp-prev (cdr udp)))
  71                    (t (setq vm-undo-record-list (cdr udp)))))
  72             (t (setq udp-prev udp)))
  73       (setq udp (cdr udp))))
  74   (vm-clear-modification-flag-undos))
  75
  76 (defun vm-clear-modification-flag-undos ()
  77   (let ((udp vm-undo-record-list) udp-prev)
  78     (while udp
  79       (cond ((null (car udp))
  80              (setq udp-prev udp))
  81             ((eq (car (car udp)) 'vm-set-buffer-modified-p)
  82              (cond (udp-prev (setcdr udp-prev (cdr udp)))
  83                    (t (setq vm-undo-record-list (cdr udp)))))
  84             (t (setq udp-prev udp)))
  85       (setq udp (cdr udp)))
  86     (vm-squeeze-consecutive-undo-boundaries)))
  87
  88 ;; squeeze out consecutive record separators left by record deletions
  89 (defun vm-squeeze-consecutive-undo-boundaries ()
  90   (let ((udp vm-undo-record-list) udp-prev)
  91     (while udp
  92       (cond ((and (null (car udp)) udp-prev (null (car udp-prev)))
  93              (setcdr udp-prev (cdr udp)))
  94             (t (setq udp-prev udp)))
  95       (setq udp (cdr udp)))
  96     (if (equal '(nil) vm-undo-record-list)
  97         (setq vm-undo-record-list nil)))
  98   ;; for the Undo button on the menubar, if present
  99   (and (null vm-undo-record-list)
 100        (vm-menu-support-possible-p)
 101        (vm-menu-xemacs-menus-p)
 102        (vm-menu-set-menubar-dirty-flag)))
 103
 104 (defun vm-undo-record (sexp)
 105   ;; for the Undo button on the menubar, if present
 106   (and (null vm-undo-record-list)
 107        (vm-menu-support-possible-p)
 108        (vm-menu-xemacs-menus-p)
 109        (vm-menu-set-menubar-dirty-flag))
 110   (setq vm-undo-record-list (cons sexp vm-undo-record-list)))
 111
 112 (defun vm-undo-describe (record)
 113   (let ((cell
 114          (assq (car record)
 115                '((vm-set-new-flag "new" "old")
 116                  (vm-set-unread-flag "unread" "read")
 117                  (vm-set-deleted-flag "deleted" "undeleted")
 118                  (vm-set-forwarded-flag "forwarded" "unforwarded")
 119                  (vm-set-replied-flag "answered" "unanswered")
 120                  (vm-set-redistributed-flag "redistributed" "unredistributed")
 121                  (vm-set-filed-flag "filed" "unfiled")
 122                  (vm-set-written-flag "written" "unwritten"))))
 123         (m (nth 1 record))
 124         labels)
 125     (cond (cell
 126            (message "VM Undo! %s/%s %s -> %s"
 127                     (buffer-name (vm-buffer-of m))
 128                     (vm-number-of m)
 129                     (if (nth 2 record)
 130                         (nth 2 cell)
 131                       (nth 1 cell))
 132                     (if (nth 2 record)
 133                         (nth 1 cell)
 134                       (nth 2 cell))))
 135           ((eq (car cell) 'vm-set-labels)
 136            (setq labels (nth 2 record))
 137            (message "VM Undo! %s/%s %s%s"
 138                     (buffer-name (vm-buffer-of m))
 139                     (vm-number-of m)
 140                     (if (null labels)
 141                         "lost all its labels"
 142                       "labels set to ")
 143                     (if (null labels)
 144                         ""
 145                       (mapconcat 'identity labels ", ")))))))
 146
 147 (defun vm-undo-set-message-pointer (record)
 148   (if (and (not (eq (car record) 'vm-set-buffer-modified-p))
 149            (not (eq (nth 1 record) vm-message-pointer)))
 150       (progn
 151         (vm-record-and-change-message-pointer
 152          vm-message-pointer
 153          (or (cdr (vm-reverse-link-of (nth 1 record)))
 154              vm-message-list))
 155         ;; make folder read-only to avoid modifications when we
 156         ;; do this.
 157         (let ((vm-folder-read-only t))
 158           (vm-preview-current-message)))))
 159
 160 ;;;###autoload
 161 (defun vm-undo ()
 162   "Undo last change to message attributes in the current folder.
 163 Consecutive invocations of this command cause sequentially earlier
 164 changes to be undone.  After an intervening command between undos,
 165 the undos themselves become undoable."
 166   (interactive)
 167   (vm-select-folder-buffer)
 168   (vm-check-for-killed-summary)
 169   (vm-error-if-folder-read-only)
 170   (vm-display nil nil '(vm-undo) '(vm-undo))
 171   (let ((modified (buffer-modified-p)))
 172     (if (not (eq last-command 'vm-undo))
 173         (setq vm-undo-record-pointer vm-undo-record-list))
 174     (if (not vm-undo-record-pointer)
 175         (error "No further VM undo information available"))
 176     ;; skip current record boundary
 177     (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))
 178     (while (car vm-undo-record-pointer)
 179       (vm-undo-set-message-pointer (car vm-undo-record-pointer))
 180       (vm-undo-describe (car vm-undo-record-pointer))
 181       (eval (car vm-undo-record-pointer))
 182       (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)))
 183     (and modified (not (buffer-modified-p))
 184          (delete-auto-save-file-if-necessary))
 185     (vm-update-summary-and-mode-line)))
 186
 187 ;;;###autoload
 188 (defun vm-set-message-attributes (string count)
 189   "Set message attributes.
 190 Use this command to change attributes like `deleted' or
 191 `replied'.  Interactively you will be prompted for the attributes
 192 to be changed, and only the attributes you enter will be altered.
 193 You can use completion to expand the attribute names.  The names
 194 should be entered as a space separated list.
 195
 196 A numeric prefix argument COUNT causes the current message and
 197 the next COUNT-1 message to have their attributes altered.  A
 198 negative COUNT arg causes the current message and the previous
 199 COUNT-1 messages to be altered.  COUNT defaults to one."
 200   (interactive
 201    (let ((last-command last-command)
 202          (this-command this-command))
 203      ;; so the user can see what message they are about to
 204      ;; modify.
 205      (vm-follow-summary-cursor)
 206      (list
 207       (vm-read-string "Set attributes: " vm-supported-attribute-names t)
 208       (prefix-numeric-value current-prefix-arg))))
 209   (vm-follow-summary-cursor)
 210   (vm-select-folder-buffer)
 211   (vm-check-for-killed-summary)
 212   (vm-error-if-folder-read-only)
 213   (vm-error-if-folder-empty)
 214   (vm-display nil nil '(vm-set-message-attributes)
 215               '(vm-set-message-attributes))
 216   (let ((name-list (vm-parse string "[ \t]*\\([^ \t]+\\)"))
 217         (m-list (vm-select-marked-or-prefixed-messages count))
 218         n-list name m)
 219     (while m-list
 220       (setq m (car m-list)
 221             n-list name-list)
 222       (while n-list
 223         (setq name (car n-list))
 224         (cond ((string= name "new")
 225                (vm-set-new-flag m t))
 226               ((string= name "recent")
 227                (vm-set-new-flag m t))
 228               ((string= name "unread")
 229                (vm-set-unread-flag m t))
 230               ((string= name "unseen")
 231                (vm-set-unread-flag m t))
 232               ((string= name "read")
 233                (vm-set-new-flag m nil)
 234                (vm-set-unread-flag m nil))
 235               ((string= name "deleted")
 236                (vm-set-deleted-flag m t))
 237               ((string= name "replied")
 238                (vm-set-replied-flag m t))
 239               ((string= name "answered")
 240                (vm-set-replied-flag m t))
 241               ((string= name "forwarded")
 242                (vm-set-forwarded-flag m t))
 243               ((string= name "redistributed")
 244                (vm-set-redistributed-flag m t))
 245               ((string= name "filed")
 246                (vm-set-filed-flag m t))
 247               ((string= name "written")
 248                (vm-set-written-flag m t))
 249               ((string= name "edited")
 250                (vm-set-edited-flag-of m t))
 251               ((string= name "undeleted")
 252                (vm-set-deleted-flag m nil))
 253               ((string= name "unreplied")
 254                (vm-set-replied-flag m nil))
 255               ((string= name "unanswered")
 256                (vm-set-replied-flag m nil))
 257               ((string= name "unforwarded")
 258                (vm-set-forwarded-flag m nil))
 259               ((string= name "unredistributed")
 260                (vm-set-redistributed-flag m nil))
 261               ((string= name "unfiled")
 262                (vm-set-filed-flag m nil))
 263               ((string= name "unwritten")
 264                (vm-set-written-flag m nil))
 265               ((string= name "unedited")
 266                (vm-set-edited-flag-of m nil)))
 267         (setq n-list (cdr n-list)))
 268       (setq m-list (cdr m-list)))
 269     (vm-update-summary-and-mode-line)))
 270
 271 ;;;###autoload
 272 (defun vm-add-message-labels (string count)
 273   "Attach some labels to a message.
 274 These are arbitrary user-defined labels, not to be confused with
 275 message attributes like `new' and `deleted'.  Interactively you
 276 will be prompted for the labels to be added.  You can use
 277 completion to expand the label names, with the completion list
 278 being all the labels that have ever been used in this folder.
 279 The names should be entered as a space separated list.  Label
 280 names are compared case-insensitively.
 281
 282 A numeric prefix argument COUNT causes the current message and
 283 the next COUNT-1 message to have the labels added.  A
 284 negative COUNT arg causes the current message and the previous
 285 COUNT-1 messages to be altered.  COUNT defaults to one."
 286   (interactive
 287    (let ((last-command last-command)
 288          (this-command this-command)
 289          (vm-completion-auto-correct nil)
 290          (completion-ignore-case t))
 291      ;; so the user can see what message they are about to
 292      ;; modify.
 293      (vm-follow-summary-cursor)
 294      (vm-select-folder-buffer)
 295      (list
 296       (vm-read-string "Add labels: "
 297                       (vm-obarray-to-string-list vm-label-obarray) t)
 298       (prefix-numeric-value current-prefix-arg))))
 299   (vm-follow-summary-cursor)
 300   (vm-select-folder-buffer)
 301   (vm-check-for-killed-summary)
 302   (vm-error-if-folder-read-only)
 303   (vm-error-if-folder-empty)
 304   (vm-add-or-delete-message-labels string count 'all))
 305
 306 ;;;###autoload
 307 (defun vm-add-existing-message-labels (string count)
 308   "Attach some already existing labels to a message.
 309 Only labels that are currently attached to some message in this
 310 folder or labels that have previously been attached to messages
 311 in this folder will be added.  Other labels will be silently
 312 ignored.
 313
 314 These are arbitrary user-defined labels, not to be confused with
 315 message attributes like `new' and `deleted'.  Interactively you
 316 will be prompted for the labels to be added.  You can use
 317 completion to expand the label names, with the completion list
 318 being all the labels that have ever been used in this folder.
 319 The names should be entered as a space separated list.  Label
 320 names are compared case-insensitively.
 321
 322 A numeric prefix argument COUNT causes the current message and
 323 the next COUNT-1 messages to have the labels added.  A
 324 negative COUNT arg causes the current message and the previous
 325 COUNT-1 messages to be altered.  COUNT defaults to one."
 326   (interactive
 327    (let ((last-command last-command)
 328          (this-command this-command)
 329          (vm-completion-auto-correct nil)
 330          (completion-ignore-case t))
 331      ;; so the user can see what message they are about to
 332      ;; modify.
 333      (vm-follow-summary-cursor)
 334      (vm-select-folder-buffer)
 335      (list
 336       (vm-read-string "Add labels: "
 337                       (vm-obarray-to-string-list vm-label-obarray) t)
 338       (prefix-numeric-value current-prefix-arg))))
 339   (vm-follow-summary-cursor)
 340   (vm-select-folder-buffer)
 341   (vm-check-for-killed-summary)
 342   (vm-error-if-folder-read-only)
 343   (vm-error-if-folder-empty)
 344   (let ((ignored-labels
 345          (vm-add-or-delete-message-labels string count 'existing-only)))
 346     (if ignored-labels
 347         (progn
 348           (set-buffer (get-buffer-create "*Ignored Labels*"))
 349           (erase-buffer)
 350           (insert "These labels do not exist and were not added:\n\n")
 351           (while ignored-labels
 352             (insert (car ignored-labels) "\n")
 353             (setq ignored-labels (cdr ignored-labels)))
 354           (display-buffer (current-buffer))))))
 355
 356 ;;;###autoload
 357 (defun vm-delete-message-labels (string count)
 358   "Delete some labels from a message.
 359 These are arbitrary user-defined labels, not to be confused with
 360 message attributes like `new' and `deleted'.  Interactively you
 361 will be prompted for the labels to be deleted.  You can use
 362 completion to expand the label names, with the completion list
 363 being all the labels that have ever been used in this folder.
 364 The names should be entered as a space separated list.  Label
 365 names are compared case-insensitively.
 366
 367 A numeric prefix argument COUNT causes the current message and
 368 the next COUNT-1 message to have the labels deleted.  A
 369 negative COUNT arg causes the current message and the previous
 370 COUNT-1 messages to be altered.  COUNT defaults to one."
 371   (interactive
 372    (let ((last-command last-command)
 373          (this-command this-command)
 374          (vm-completion-auto-correct nil)
 375          (completion-ignore-case t))
 376      ;; so the user can see what message they are about to
 377      ;; modify.
 378      (vm-follow-summary-cursor)
 379      (vm-select-folder-buffer)
 380      (list
 381       (vm-read-string "Delete labels: "
 382                       (vm-obarray-to-string-list vm-label-obarray) t)
 383       (prefix-numeric-value current-prefix-arg))))
 384   (vm-follow-summary-cursor)
 385   (vm-select-folder-buffer)
 386   (vm-check-for-killed-summary)
 387   (vm-error-if-folder-read-only)
 388   (vm-error-if-folder-empty)
 389   (vm-add-or-delete-message-labels string count nil))
 390
 391 (defun vm-add-or-delete-message-labels (string count add)
 392   (vm-display nil nil '(vm-add-message-labels vm-delete-message-labels)
 393               (list this-command))
 394   (setq string (downcase string))
 395   (let ((m-list (vm-select-marked-or-prefixed-messages count))
 396         (action-labels (vm-parse string
 397 "[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*"))
 398         (ignored-labels nil)
 399         labels act-labels m mm-list)
 400     (if (and add m-list)
 401         (if (eq add 'all)
 402             (progn
 403               (setq act-labels action-labels)
 404               (while act-labels
 405                 (intern (car act-labels) vm-label-obarray)
 406                 (setq act-labels (cdr act-labels))))
 407           (let ((newlist nil))
 408             (setq act-labels action-labels)
 409             (while act-labels
 410               (if (intern-soft (car act-labels) vm-label-obarray)
 411                   (setq newlist (cons (car act-labels) newlist))
 412                 (setq ignored-labels (cons (car act-labels) ignored-labels)))
 413               (setq act-labels (cdr act-labels)))
 414             (setq action-labels newlist))))
 415     (if (null action-labels)
 416         (setq m-list nil))
 417     (while m-list
 418       (setq m (car m-list))
 419       (if (and add (vm-virtual-message-p m))
 420           (let ((labels action-labels))
 421             (save-excursion
 422               (set-buffer (vm-buffer-of (vm-real-message-of m)))
 423               (while labels
 424                 (intern (car labels) vm-label-obarray)
 425                 (setq labels (cdr labels))))))
 426       (if add
 427           (save-excursion
 428             (setq mm-list (vm-virtual-messages-of m))
 429             (while mm-list
 430               (let ((labels action-labels))
 431                 (set-buffer (vm-buffer-of (car mm-list)))
 432                 (while labels
 433                   (intern (car labels) vm-label-obarray)
 434                   (setq labels (cdr labels))))
 435               (setq mm-list (cdr mm-list)))))
 436       (setq act-labels action-labels
 437             labels (copy-sequence (vm-labels-of (car m-list))))
 438       (if add
 439           (while act-labels
 440             (setq labels (cons (car act-labels) labels)
 441                   act-labels (cdr act-labels)))
 442         (while act-labels
 443           (setq labels (vm-delqual (car act-labels) labels)
 444                 act-labels (cdr act-labels))))
 445       (if add
 446           (setq labels (vm-delete-duplicates labels)))
 447       (vm-set-labels (car m-list) labels)
 448       (setq m-list (cdr m-list)))
 449     (vm-update-summary-and-mode-line)
 450     ignored-labels))
 451
 452 (defun vm-set-xxxx-flag (m flag norecord function attr-index)
 453   (let ((m-list nil) vmp)
 454     (cond
 455      ((and (not vm-folder-read-only)
 456            (or (not (vm-virtual-messages-of m))
 457                (not (save-excursion
 458                       (set-buffer
 459                        (vm-buffer-of
 460                          (vm-real-message-of m)))
 461                       vm-folder-read-only))))
 462       (cond
 463        ((not norecord)
 464         (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m)))
 465         (while vmp
 466           (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp)))
 467               (setq m-list (cons (car vmp) m-list)))
 468           (setq vmp (cdr vmp)))
 469         (if (null m-list)
 470             (setq m-list (cons m m-list)))
 471         (while m-list
 472           (save-excursion
 473             (set-buffer (vm-buffer-of (car m-list)))
 474             (cond ((not (buffer-modified-p))
 475                    (vm-set-buffer-modified-p t)
 476                    (vm-undo-record (list 'vm-set-buffer-modified-p nil))))
 477             (vm-undo-record (list function (car m-list) (not flag)))
 478 ;;;         (vm-undo-boundary)
 479             (vm-increment vm-modification-counter))
 480           (setq m-list (cdr m-list)))))
 481       (aset (vm-attributes-of m) attr-index flag)
 482       (vm-mark-for-summary-update m)
 483       (if (not norecord)
 484           (progn
 485             (vm-set-attribute-modflag-of m t)
 486             (if (eq vm-flush-interval t)
 487                 (vm-stuff-virtual-attributes m)
 488               (vm-set-stuff-flag-of m t))))))))
 489
 490
 491 (defun vm-set-labels (m labels)
 492   (let ((m-list nil)
 493         (old-labels (vm-labels-of m))
 494         vmp)
 495     (cond
 496      ((and (not vm-folder-read-only)
 497            (or (not (vm-virtual-messages-of m))
 498                (not (save-excursion
 499                       (set-buffer
 500                        (vm-buffer-of
 501                          (vm-real-message-of m)))
 502                       vm-folder-read-only))))
 503       (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m)))
 504       (while vmp
 505         (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp)))
 506             (setq m-list (cons (car vmp) m-list)))
 507         (setq vmp (cdr vmp)))
 508       (if (null m-list)
 509           (setq m-list (cons m m-list)))
 510       (while m-list
 511         (save-excursion
 512           (set-buffer (vm-buffer-of (car m-list)))
 513           (cond ((not (buffer-modified-p))
 514                  (vm-set-buffer-modified-p t)
 515                  (vm-undo-record (list 'vm-set-buffer-modified-p nil))))
 516           (vm-undo-record (list 'vm-set-labels m old-labels))
 517 ;;;       (vm-undo-boundary)
 518           (vm-increment vm-modification-counter))
 519         (setq m-list (cdr m-list)))
 520       (vm-set-labels-of m labels)
 521       (vm-set-label-string-of m nil)
 522       (vm-mark-for-summary-update m)
 523       (if (eq vm-flush-interval t)
 524           (vm-stuff-virtual-attributes m)
 525         (vm-set-stuff-flag-of m t))))))
 526
 527
 528 (defun vm-set-new-flag (m flag &optional norecord)
 529   (vm-set-xxxx-flag m flag norecord 'vm-set-new-flag 0))
 530
 531 (defun vm-set-unread-flag (m flag &optional norecord)
 532   (vm-set-xxxx-flag m flag norecord 'vm-set-unread-flag 1))
 533
 534 (defun vm-set-deleted-flag (m flag &optional norecord)
 535   (vm-set-xxxx-flag m flag norecord 'vm-set-deleted-flag 2))
 536
 537 (defun vm-set-filed-flag (m flag &optional norecord)
 538   (vm-set-xxxx-flag m flag norecord 'vm-set-filed-flag 3))
 539
 540 (defun vm-set-replied-flag (m flag &optional norecord)
 541   (vm-set-xxxx-flag m flag norecord 'vm-set-replied-flag 4))
 542
 543 (defun vm-set-written-flag (m flag &optional norecord)
 544   (vm-set-xxxx-flag m flag norecord 'vm-set-written-flag 5))
 545
 546 (defun vm-set-forwarded-flag (m flag &optional norecord)
 547   (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 6))
 548
 549 (defun vm-set-redistributed-flag (m flag &optional norecord)
 550   (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 8))
 551
 552 ;; use these to avoid undo and summary update.
 553 (defun vm-set-new-flag-of (m flag) (aset (aref m 2) 0 flag))
 554 (defun vm-set-unread-flag-of (m flag) (aset (aref m 2) 1 flag))
 555 (defun vm-set-deleted-flag-of (m flag) (aset (aref m 2) 2 flag))
 556 (defun vm-set-filed-flag-of (m flag) (aset (aref m 2) 3 flag))
 557 (defun vm-set-replied-flag-of (m flag) (aset (aref m 2) 4 flag))
 558 (defun vm-set-written-flag-of (m flag) (aset (aref m 2) 5 flag))
 559 (defun vm-set-forwarded-flag-of (m flag) (aset (aref m 2) 6 flag))
 560 (defun vm-set-redistributed-flag-of (m flag) (aset (aref m 2) 8 flag))
 561
 562 ;; this is solely for the use of vm-stuff-attributes and appears here
 563 ;; only because this function should be grouped with others of its kind
 564 ;; for maintenance purposes.
 565 (defun vm-set-deleted-flag-in-vector (v flag)
 566   (aset v 2 flag))
 567 ;; ditto.  this is for vm-read-attributes.
 568 (defun vm-set-new-flag-in-vector (v flag)
 569   (aset v 0 flag))
 570
 571 (provide 'vm-undo)
 572
 573 ;;; vm-undo.el ends here