xemacs-beta: lisp/vm/vm-folder.el comparison

comparison lisp/vm/vm-folder.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	a145efe76779
children	8619ce7e4c50

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
 		    (set-buffer b)
 		  (setq temp-buffer (generate-new-buffer "*vm-work*"))
 		  (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
 				       "-n" "1,/^$/p")))))))
 	  (save-excursion
 			  folder-buffer
 			  (vm-headers-of message)
 			  (vm-text-of message))
 			 (goto-char (point-min))))
 		   (setq old-header-start (point))
-		   (while (and (not (= (following-char) ?\n))
+		   ;; as we loop through the headers, skip >From
-			       (vm-match-header))
+		   ;; lines.  these can occur anywhere in the
+		   ;; header section if the message has been
+		   ;; manhandled by some dumb delivery agents
+		   ;; (SCO and Solaris are the usual suspects.)
+		   ;; it's a tough ol' world.
+		   (while (progn (while (looking-at ">From ")
+				   (forward-line))
+				 (and (not (= (following-char) ?\n))
+				      (vm-match-header)))
 		     (setq end-of-header (vm-matched-header-end)
 			   list (vm-match-ordered-header header-alist))
 		     ;; don't display/keep this header if
 		     ;;  keep-list not matched
 		     ;;  and discard-regexp is nil
 (setq inhibit-quit nil)
 (if (integerp vm-mail-check-interval)
 (if timer
 	  (timer-set-time timer (current-time) vm-mail-check-interval)
 	(set-itimer-restart current-itimer vm-mail-check-interval))
-;; user has changed the variable value to a something that
+;; user has changed the variable value to something that
 ;; isn't a number, make the timer go away.
 (if timer
 	(cancel-timer timer)
 (set-itimer-restart current-itimer nil)))
 (let ((b-list (buffer-list))
 (while (and (not (input-pending-p)) b-list)
 (save-excursion
 	(set-buffer (car b-list))
 	(if (and (eq major-mode 'vm-mode)
 		 (setq found-one t)
-		 (not vm-block-new-mail))
+		 ;; to avoid reentrance into the pop code
+		 (not vm-block-new-mail)
+		 ;; Don't bother checking if we already know from
+		 ;; a previous check that there's mail waiting
+		 ;; and the user hasn't retrieved it yet.  Not
+		 ;; completely accurate, but saves network
+		 ;; connection build and tear down which is slow
+		 ;; for some users.
+		 (not vm-spooled-mail-waiting))
 	    (progn
 	      (setq oldval vm-spooled-mail-waiting)
 	      (vm-check-for-spooled-mail nil)
 	      (if (not (eq oldval vm-spooled-mail-waiting))
 		  (progn
 (setq inhibit-quit nil)
 (if (integerp vm-auto-get-new-mail)
 (if timer
 	  (timer-set-time timer (current-time) vm-auto-get-new-mail)
 	(set-itimer-restart current-itimer vm-auto-get-new-mail))
-;; user has changed the variable value to a something that
+;; user has changed the variable value to something that
 ;; isn't a number, make the timer go away.
 (if timer
 	(cancel-timer timer)
 (set-itimer-restart current-itimer nil)))
 (let ((b-list (buffer-list))
 	     ;; crash box could contain a letter bomb...
 	     ;; force user notification of file variables for v18 Emacses
 	     ;; 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)
 	 (setq crash-folder-type (vm-get-folder-type))
 	 (if (and crash-folder-type vm-check-folder-types)
 	 (vm-increment vm-modification-counter)
 	 (set-buffer-modified-p old-buffer-modified-p)
 	 (kill-buffer crash-buf)
 	 (if (not (stringp vm-keep-crash-boxes))
 	     (vm-error-free-call 'delete-file crash-box)
-	   (let (name)
+	   (let ((time (decode-time (current-time)))
-	     (setq name (expand-file-name (format "Z%d" (vm-abs (random)))
+		 name)
-					  vm-keep-crash-boxes))
+	     (setq name
+		   (expand-file-name (format "Z-%02d-%02d-%05d"
+					     (nth 4 time)
+					     (nth 3 time)
+					     (% (vm-abs (random)) 100000))
+				     vm-keep-crash-boxes))
 	     (while (file-exists-p name)
-	       (setq name (expand-file-name (format "Z%d" (vm-abs (random)))
+	       (setq name
-					    vm-keep-crash-boxes)))
+		     (expand-file-name (format "Z-%02d-%02d-%05d"
+					       (nth 4 time)
+					       (nth 3 time)
+					       (% (vm-abs (random)) 100000))
+				       vm-keep-crash-boxes)))
 	     (rename-file crash-box name))))
 got-mail ))))
 (defun vm-compute-spool-files ()
 (let ((fallback-triples nil)
 				   (sleep-for 2)
 				   ;; we don't know if mail was
 				   ;; put into the crash box or
 				   ;; not, so return t just to be
 				   ;; safe.
+				   t )
+			    (quit (message "quitting from %s..."
+					    (if popdrop
+						'vm-pop-move-mail
+					      'vm-spool-move-mail))
+				   (sleep-for 1)
+				   ;; we don't know if mail was
+				   ;; put into the crash box or
+				   ;; not, so return t just to be
+				   ;; safe.
 				   t ))
 			(funcall retrieval-function maildrop crash))
 		      (if (vm-gobble-crash-box crash)
 			  (progn
 			    (setq got-mail t)
 		      folder))
 	   (save-excursion
 	     (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)
 	       (progn
 		 ;; say this NOW, before the non-previewers read

Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-folder.el @ 108:360340f9fd5f r20-1b6