Mercurial > hg > xemacs-beta
diff lisp/vm/vm-folder.el @ 54:05472e90ae02 r19-16-pre2
Import from CVS: tag r19-16-pre2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:57:55 +0200 |
parents | 8b8b7f3559a2 |
children | 131b0175ea99 |
line wrap: on
line diff
--- a/lisp/vm/vm-folder.el Mon Aug 13 08:57:25 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 08:57:55 2007 +0200 @@ -508,7 +508,7 @@ (set-buffer temp-buffer) (if (file-readable-p file) (condition-case nil - (let ((overriding-file-coding-system 'binary)) + (let ((coding-system-for-read 'binary)) (insert-file-contents file nil 0 4096)) (wrong-number-of-arguments (call-process "sed" file temp-buffer nil @@ -1166,7 +1166,7 @@ (vm-total-count 0) (modulus (+ (% (vm-abs (random)) 11) 25)) (case-fold-search t) - data) + oldpoint data) (while mp (vm-increment vm-total-count) (if (vm-attributes-of (car mp)) @@ -1182,17 +1182,28 @@ (vm-text-of (car mp)) t) (goto-char (match-beginning 2)) (condition-case () - (setq data (read (current-buffer))) - (error (setq data - (list - (make-vector vm-attributes-vector-length nil) - (make-vector vm-cache-vector-length nil) - nil)) - ;; In lieu of a valid attributes header - ;; assume the message is new. avoid - ;; vm-set-new-flag because it asks for a - ;; summary update. - (vm-set-new-flag-in-vector (car data) t))) + (progn + (setq oldpoint (point) + data (read (current-buffer))) + (if (and (or (not (listp data)) (not (= 3 (length data)))) + (not (vectorp data))) + (progn + (error "Bad x-vm-v5-data at %d in buffer %s" + oldpoint (buffer-name)))) + data ) + (error + (message "Bad x-vm-v5-data header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq data + (list + (make-vector vm-attributes-vector-length nil) + (make-vector vm-cache-vector-length nil) + nil)) + ;; In lieu of a valid attributes header + ;; assume the message is new. avoid + ;; vm-set-new-flag because it asks for a + ;; summary update. + (vm-set-new-flag-in-vector (car data) t))) ;; support version 4 format (cond ((vectorp data) (setq data (vm-convert-v4-attributes data)) @@ -1406,8 +1417,19 @@ (vm-skip-past-folder-header) (vm-skip-past-leading-message-separator) (if (re-search-forward vm-labels-header-regexp lim t) - (let (list) - (setq list (read (current-buffer))) + (let ((oldpoint (point)) + list) + (condition-case () + (progn + (setq list (read (current-buffer))) + (if (not (listp list)) + (error "Bad global label list at %d in buffer %s" + oldpoint (buffer-name))) + list ) + (error + (message "Bad global label list at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq list nil) )) (mapcar (function (lambda (s) (intern s vm-label-obarray))) @@ -1418,7 +1440,8 @@ ;; Returns non-nil if successful, nil otherwise. (defun vm-gobble-bookmark () (let ((case-fold-search t) - n lim) + (n nil) + lim oldpoint) (save-excursion (vm-save-restriction (widen) @@ -1431,7 +1454,18 @@ (vm-skip-past-folder-header) (vm-skip-past-leading-message-separator) (if (re-search-forward vm-bookmark-header-regexp lim t) - (setq n (read (current-buffer)))))) + (condition-case () + (progn + (setq oldpoint (point) + n (read (current-buffer))) + (if (not (natnump n)) + (error "Bad bookmark at %d in buffer %s" + oldpoint (buffer-name))) + n ) + (error + (message "Bad bookmark at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq n 1)))))) (if n (vm-record-and-change-message-pointer vm-message-pointer @@ -1490,13 +1524,25 @@ (vm-skip-past-folder-header) (vm-skip-past-leading-message-separator) (if (re-search-forward vm-message-order-header-regexp lim t) - (progn + (let ((oldpoint (point))) (message "Reordering messages...") - (setq order (read (current-buffer)) - list-length (length vm-message-list) + (condition-case nil + (progn + (setq order (read (current-buffer))) + (if (not (listp order)) + (error "Bad order header at %d in buffer %s" + oldpoint (buffer-name))) + order ) + (error + (message "Bad order header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq order nil))) + (setq list-length (length vm-message-list) v (make-vector (max list-length (length order)) nil)) (while (and order mp) - (aset v (1- (car order)) (car mp)) + (condition-case nil + (aset v (1- (car order)) (car mp)) + (args-out-of-range nil)) (setq order (cdr order) mp (cdr mp))) ;; lock out interrupts while the message list is in ;; an inconsistent state. @@ -1529,8 +1575,13 @@ (vm-skip-past-folder-header) (vm-skip-past-leading-message-separator) (if (re-search-forward vm-summary-header-regexp lim t) - (progn - (setq summary (read (current-buffer))) + (let ((oldpoint (point))) + (condition-case () + (setq summary (read (current-buffer))) + (error + (message "Bad summary header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq summary ""))) (if (not (equal summary vm-summary-format)) (while mp (vm-set-summary-of (car mp) nil) @@ -2173,17 +2224,20 @@ (error nil)) (let (timer) (and (natnump vm-flush-interval) + (not (vm-timer-using 'vm-flush-itimer-function)) (setq timer (run-at-time vm-flush-interval vm-flush-interval 'vm-flush-itimer-function nil)) (timer-set-function timer 'vm-flush-itimer-function (list timer))) (and (natnump vm-mail-check-interval) + (not (vm-timer-using 'vm-check-mail-itimer-function)) (setq timer (run-at-time vm-mail-check-interval vm-mail-check-interval 'vm-check-mail-itimer-function nil)) (timer-set-function timer 'vm-check-mail-itimer-function (list timer))) (and (natnump vm-auto-get-new-mail) + (not (vm-timer-using 'vm-get-mail-itimer-function)) (setq timer (run-at-time vm-auto-get-new-mail vm-auto-get-new-mail 'vm-get-mail-itimer-function nil)) @@ -2193,6 +2247,15 @@ (setq vm-flush-interval t vm-auto-get-new-mail t)))) +(defun vm-timer-using (fun) + (let ((p timer-list) + (done nil)) + (while (and p (not done)) + (if (eq (aref (car p) 5) fun) + (setq done t) + (setq p (cdr p)))) + p )) + ;; support for vm-mail-check-interval ;; if timer argument is present, this means we're using the Emacs ;; 'timer package rather than the 'itimer package. @@ -2484,7 +2547,7 @@ (if (eq major-mode 'vm-summary-mode) (vm-select-folder-buffer)) (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))) - (pop-up-frames vm-mutable-frames)) + (pop-up-frames (and vm-mutable-frames vm-frame-per-help))) (cond ((eq last-command 'vm-help) (describe-function major-mode)) @@ -2499,7 +2562,7 @@ ((eq major-mode 'mail-mode) (message (substitute-command-keys - "Type \\[vm-mail-send-and-exit] to send message, \\[kill-buffer] to discard this message"))) + "Type \\[vm-mail-send-and-exit] to send message, \\[kill-buffer] to discard this composition"))) (t (describe-mode))))) (defun vm-spool-move-mail (source destination) @@ -2555,7 +2618,7 @@ ;; enable-local-variables == nil disables them for newer Emacses (let ((inhibit-local-variables t) (enable-local-variables nil) - (overriding-file-coding-system 'no-conversion)) + (coding-system-for-read 'no-conversion)) (find-file-noselect crash-box))) (save-excursion (set-buffer crash-buf) @@ -2886,7 +2949,7 @@ (vm-save-restriction (widen) (goto-char (point-max)) - (let ((overriding-file-coding-system 'binary)) + (let ((coding-system-for-read 'binary)) (insert-file-contents folder)))) (setq mcount (length vm-message-list)) (if (vm-assimilate-new-messages)