xemacs-beta: lisp/gnus/nnmail.el comparison

comparison lisp/gnus/nnmail.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	cf808b4c4290
children	fe104dbd9147

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
 ;;; Code:
 (require 'nnheader)
 (require 'timezone)
 (require 'message)
-(eval-when-compile (require 'cl))
+(require 'cl)
 (require 'custom)
+(eval-and-compile
+(autoload 'gnus-error "gnus-util"))
 (defgroup nnmail nil
 "Reading mail with Gnus."
 :group 'gnus)
 :group 'nnmail-split
 :type 'boolean)
 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 (defcustom nnmail-keep-last-article nil
 "If non-nil, nnmail will never delete the last expired article in a directory.
 You may need to set this variable if other programs are putting
 new mail into folder numbers that Gnus has marked as expired."
 :group 'nnmail-procmail
 :group 'nnmail-various
 :type 'boolean)
 	      (t 7))))"
 :group 'nnmail-expire
 :type '(choice (const :tag "nnmail-expiry-wait" nil)
 		 (function :format "%v" nnmail-)))
 (defcustom nnmail-spool-file
 (or (getenv "MAIL")
 (concat "/usr/spool/mail/" (user-login-name)))
 "Where the mail backends will look for incoming mail.
 This variable is \"/usr/spool/mail/$user\" by default.
 If this variable is nil, no mail backends will read incoming mail.
 (defcustom nnmail-pop-password-required nil
 "*Non-nil if a password is required when reading mail using POP."
 :group 'nnmail-retrieve
 :type 'boolean)
 (defcustom nnmail-read-incoming-hook
 (if (eq system-type 'windows-nt)
 '(nnheader-ms-strip-cr)
 nil)
 "Hook that will be run after the incoming mail has been transferred.
 The incoming mail is moved from `nnmail-spool-file' (which normally is
 emptied, and can be used to call any mail box programs you have
 running (\"xwatch\", etc.)
 Eg.
 \(add-hook 'nnmail-read-incoming-hook
 	   (lambda ()
 	     (start-process \"mailsend\" nil
 			    \"/local/bin/mailsend\" \"read\" \"mbox\")))
 If you have xwatch running, this will alert it that mail has been
 read.
 If you use `display-time', you could use something like this:
 \(add-hook 'nnmail-read-incoming-hook
 	  (lambda ()
 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
 The format is this variable is SPLIT, where SPLIT can be one of
 the following:
 GROUP: Mail will be stored in GROUP (a string).
 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
 VALUE (a regexp), store the messages as specified by SPLIT.
 \(| SPLIT...): Process each SPLIT expression until one of them matches.
 A SPLIT expression is said to match if it will cause the mail
 message to be stored in one or more groups.
 \(& SPLIT...): Process each SPLIT expression.
 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
 the buffer containing the message headers.  The return value FUNCTION
 should be a split, which is then recursively processed.
 FIELD must match a complete field name.  VALUE must match a complete
 word according to the `nnmail-split-fancy-syntax-table' syntax table.
-You can use .* in the regexps to match partial field names or words.
+You can use \".*\" in the regexps to match partial field names or words.
 FIELD and VALUE can also be lisp symbols, in that case they are expanded
 as specified in `nnmail-split-abbrev-alist'.
 GROUP can contain \\& and \\N which will substitute from matching
 (defun nnmail-group-pathname (group dir &optional file)
 "Make pathname for GROUP."
 (concat
 (let ((dir (file-name-as-directory (expand-file-name dir))))
 ;; If this directory exists, we use it directly.
 (if (or nnmail-use-long-file-names
 	     (file-directory-p (concat dir group)))
 	 (concat dir group "/")
 ;; If not, we translate dots into slashes.
 (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
 (or file "")))
 		    (and (file-exists-p inbox)
 			 (/= 0 (nnheader-file-size inbox))))
 	    (message "Getting mail from %s..." inbox)))
 	;; Set TOFILE if have not already done so, and
 	;; rename or copy the file INBOX to TOFILE if and as appropriate.
 	(cond
 	 ((file-exists-p tofile)
 	  ;; The crash box exists already.
 	  t)
 	 ((and (not popmail)
 	       (not (file-exists-p inbox)))
 	      (save-excursion
 		(setq errors (generate-new-buffer " *nnmail loss*"))
 		(buffer-disable-undo errors)
 		(let ((default-directory "/"))
 		  (if (nnheader-functionp nnmail-movemail-program)
-		      (funcall nnmail-movemail-program inbox tofile)
+		      (condition-case err
+			  (progn
+			    (funcall nnmail-movemail-program inbox tofile)
+			    (setq result 0))
+			(error
+			 (save-excursion
+			   (set-buffer errors)
+			   (insert (prin1-to-string err))
+			   (setq result 255))))
 		    (setq result
 			  (apply
 			   'call-process
 			   (append
 			    (list
 			     (expand-file-name
 			      nnmail-movemail-program exec-directory)
 			     nil errors nil inbox tofile)
 			    (when nnmail-internal-password
 			      (list nnmail-internal-password)))))))
 		(if (and (not (buffer-modified-p errors))
 (let (group-assoc)
 ;; Go through all groups from the active list.
 (save-excursion
 (set-buffer nntp-server-buffer)
 (goto-char (point-min))
 (while (re-search-forward
 	      "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
 	;; We create an alist with `(GROUP (LOW . HIGH))' elements.
 	(push (list (match-string 1)
 		    (cons (string-to-int (match-string 3))
 			  (string-to-int (match-string 2))))
 				"\\([^/]*\\)" nnmail-procmail-suffix "$")
 			(expand-file-name file))
 	  (let ((procmail-group (substring (expand-file-name file)
 					   (match-beginning 1)
 					   (match-end 1))))
 	    (if group
 		(if (string-equal group procmail-group)
 		    group
 		  nil)
 	      procmail-group))
 	nil)
 	  (forward-line -1)
 	  (insert "Message-ID: " (setq message-id (nnmail-message-id))
 		  "\n")))
 ;; Look for a Content-Length header.
 (if (not (save-excursion
 		 (and (re-search-backward
 		       "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
 		      (setq content-length (string-to-int
 					    (buffer-substring
 					     (match-beginning 1)
 					     (match-end 1))))
 		      ;; We destroy the header, since none of
 		      ;; the backends ever use it, and we do not
 		      ;; want to confuse other mailers by having
 	      (goto-char (+ (point) content-length))
 	      (setq do-search nil))
 	  (setq do-search t)))
 (widen)
 ;; Go to the beginning of the next article - or to the end
 ;; of the buffer.
 (when do-search
 	(if (re-search-forward "^" nil t)
 	    (goto-char (match-beginning 0))
 	  (goto-char (1- (point-max)))))
 (delete-char 1)			; delete ^_
 (while (not (eobp))
 	(setq start (point)
 	      end nil)
 	;; Find the end of the head.
 	(narrow-to-region
 	 start
 	 (if (search-forward "\n\n" nil t)
 	     (1- (point))
 	   ;; This will never happen, but just to be on the safe side --
 	   ;; if there is no head-body delimiter, we search a bit manually.
 	   (while (and (looking-at "From \\|[^ \t]+:")
 	(goto-char (point-min))
 	(if (not (re-search-forward
 		  "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
 	    (setq content-length nil)
 	  (setq content-length (string-to-int (match-string 1)))
 	  ;; We destroy the header, since none of the backends ever
 	  ;; use it, and we do not want to confuse other mailers by
 	  ;; having a (possibly) faulty header.
 	  (beginning-of-line)
 	  (insert "X-"))
 	(run-hooks 'nnmail-prepare-incoming-header-hook)
 		((looking-at "[ \t]*\n\\(From \\)")
 		 (setq end (match-beginning 1)))
 		(t (setq end nil))))
 	(if end
 	    (goto-char end)
 	  ;; No Content-Length, so we find the beginning of the next
 	  ;; article or the end of the buffer.
 	  (goto-char head-end)
 	  (or (nnmail-search-unix-mail-delim)
 	      (goto-char (point-max))))
 	;; Allow the backend to save the article.
 ;; Carry on until the bitter end.
 (while (not (eobp))
 	(setq start (point))
 	;; Find the end of the head.
 	(narrow-to-region
 	 start
 	 (if (search-forward "\n\n" nil t)
 	     (1- (point))
 	   ;; This will never happen, but just to be on the safe side --
 	   ;; if there is no head-body delimiter, we search a bit manually.
 	   (while (and (looking-at "From \\|[^ \t]+:")
 	       (nnmail-process-unix-mail-format func artnum-func))))
 (when exit-func
 	(funcall exit-func))
 (kill-buffer (current-buffer)))))
 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
 (defun nnmail-article-group (func)
 "Look at the headers and return an alist of groups that match.
 FUNC will be called with the group name to determine the article number."
 (let ((methods nnmail-split-methods)
 	(obuf (current-buffer))
 	    (let ((split
 		   (condition-case nil
 		       (or (funcall nnmail-split-methods)
 			   '("bogus"))
 		     (error
 		      (message
 		       "Error in `nnmail-split-methods'; using `bogus' mail group")
 		      (sit-for 1)
 		      '("bogus")))))
 	      (unless (equal split '(junk))
 		;; `nnmail-split-methods' is a function, so we just call
 		;; this function here and use the result.
 		(setq group-art
 		      (mapcar
 		       (lambda (group) (cons group (funcall func group)))
 		       split))))
 		       (ignore-errors
 			 (if (stringp (nth 1 method))
 			     (re-search-backward (cadr method) nil t)
 			   ;; Function to say whether this is a match.
 			   (funcall (nth 1 method) (car method))))
 		       ;; Don't enter the article into the same
 		       ;; group twice.
 		       (not (assoc (car method) group-art)))
 		  (push (cons (car method) (funcall func (car method)))
 			group-art))
 	      ;; This is the final group, which is used as a
 	      ;; catch-all.
 	      (unless group-art
 		(setq group-art
 		      (list (cons (car method)
 				  (funcall func (car method)))))))))
 	;; See whether the split methods returned `junk'.
 	(if (equal group-art '(junk))
 	    nil
 ;; Get a list of spool files to read.
 (defun nnmail-get-spool-files (&optional group)
 (if (null nnmail-spool-file)
 ;; No spool file whatsoever.
 nil
 (let* ((procmails
 	    ;; If procmail is used to get incoming mail, the files
 	    ;; are stored in this directory.
 	    (and (file-exists-p nnmail-procmail-directory)
 		 (or (eq nnmail-spool-file 'procmail)
 		     nnmail-use-procmail)
 		 (directory-files
 		  nnmail-procmail-directory
 		  t (concat (if group (concat "^" group) "")
 			    nnmail-procmail-suffix "$"))))
 	   (p procmails)
 	   (crash (when (and (file-exists-p nnmail-crash-box)
 			     (> (nnheader-file-size
 				 (file-truename nnmail-crash-box))
 				0))
 		    (list nnmail-crash-box))))
 ;; Remove any directories that inadvertently match the procmail
 ;; suffix, which might happen if the suffix is "".
 (while p
 	(when (file-directory-p (car p))
 	  (setq procmails (delete (car p) procmails)))
 	(setq p (cdr p)))
 ;; Return the list of spools.
 (append
 crash
 (cond ((and group
 		   (or (eq nnmail-spool-file 'procmail)
 		       nnmail-use-procmail)
 		   procmails)
 	     ((and group
 		   (eq nnmail-spool-file 'procmail))
 	      nil)
 	     ((listp nnmail-spool-file)
 	      (nconc
 	       (apply
 		'nconc
 		(mapcar
 		 (lambda (file)
 		   (if (and (not (string-match "^po:" file))
 			    (file-directory-p file))
 		       (nnheader-directory-regular-files file)
 		     (list file)))
 		 nnmail-spool-file))
 	       procmails))
 	     ((stringp nnmail-spool-file)
 	      (if (and (not (string-match "^po:" nnmail-spool-file))
 		       (file-directory-p nnmail-spool-file))
 		  (nconc
 		   (nnheader-directory-regular-files nnmail-spool-file)
 		   procmails)
 		(cons nnmail-spool-file procmails)))
 	     ((eq nnmail-spool-file 'pop)
 	      (cons (format "po:%s" (user-login-name)) procmails))
 	     (t
 	      procmails))))))
 ;; Activate a backend only if it isn't already activated.
 ;; If FORCE, re-read the active file even if the backend is
 ;; already activated.
 (defun nnmail-activate (backend &optional force)
 (let (file timestamp file-time)
 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
 	    force
 	    (and (setq file (ignore-errors
 			      (symbol-value (intern (format "%s-active-file"
 							    backend)))))
 		 (setq file-time (nth 5 (file-attributes file)))
 		 (or (not
 		      (setq timestamp
 			    (condition-case ()
 				(symbol-value (intern
 					       (format "%s-active-timestamp"
 						       backend)))
 			      (error 'none))))
 		     (not (consp timestamp))
 		     (equal timestamp '(0 0))
 		     (> (nth 0 file-time) (nth 0 timestamp))
 		     (and (= (nth 0 file-time) (nth 0 timestamp))
 			  (> (nth 1 file-time) (nth 1 timestamp))))))
 	(save-excursion
 	  (or (eq timestamp 'none)
 	      (set (intern (format "%s-active-timestamp" backend))
-;;; dmoore@ucsd.edu 25.10.96
+		   file-time))
-;;; it's not always the case that current-time
+	  (funcall (intern (format "%s-request-list" backend)))))
-;;; does correspond to changes in the file's time.  So just compare
-;;; the file's new time against its own previous time.
-;;;		   (current-time)
-		   file-time
-		   ))
-	  (funcall (intern (format "%s-request-list" backend)))
-;;; dmoore@ucsd.edu 25.10.96
-;;; BACKEND-request-list already does this itself!
-;;;	  (set (intern (format "%s-group-alist" backend))
-;;;	       (nnmail-get-active))
-	  ))
 t))
 (defun nnmail-message-id ()
 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
 (if (or (not nnmail-treat-duplicates)
 	  (and nnmail-cache-buffer
 	       (buffer-name nnmail-cache-buffer)))
 ()				; The buffer is open.
 (save-excursion
 (set-buffer
 (setq nnmail-cache-buffer
 	     (get-buffer-create " *nnmail message-id cache*")))
 (buffer-disable-undo (current-buffer))
 (when (file-exists-p nnmail-message-id-cache-file)
 	(nnheader-insert-file-contents nnmail-message-id-cache-file))
 (set-buffer-modified-p nil)
 			  t))
 (nnmail-write-region (point-min) (point-max)
 			   nnmail-message-id-cache-file nil 'silent)
 (set-buffer-modified-p nil)
 (setq nnmail-cache-buffer nil)
-;;(kill-buffer (current-buffer))
+(kill-buffer (current-buffer)))))
-)))
 (defun nnmail-cache-insert (id)
 (when nnmail-treat-duplicates
+(unless (gnus-buffer-live-p nnmail-cache-buffer)
+(nnmail-cache-open))
 (save-excursion
 (set-buffer nnmail-cache-buffer)
 (goto-char (point-max))
 (insert id "\n"))))
 (when nnmail-treat-duplicates
 (save-excursion
 (set-buffer nnmail-cache-buffer)
 (goto-char (point-max))
 (search-backward id nil t))))
+(defun nnmail-fetch-field (header)
+(save-excursion
+(save-restriction
+(message-narrow-to-head)
+(message-fetch-field header))))
 (defun nnmail-check-duplication (message-id func artnum-func)
 (run-hooks 'nnmail-prepare-incoming-message-hook)
 ;; If this is a duplicate message, then we do not save it.
 (let* ((duplication (nnmail-cache-id-exists-p message-id))
 			  (nreverse (nnmail-article-group artnum-func)))))
 ((eq action 'delete)
 (setq group-art nil))
 ((eq action 'warn)
 ;; We insert a warning.
-(let ((case-fold-search t)
+(let ((case-fold-search t))
-	    (newid (nnmail-message-id)))
 	(goto-char (point-min))
-	(when (re-search-forward "^message-id[ \t]*:" nil t)
+	(re-search-forward "^message-id[ \t]*:" nil t)
-	  (beginning-of-line)
-	  (insert "Original-"))
 	(beginning-of-line)
 	(insert
-	 "Message-ID: " newid "\n"
 	 "Gnus-Warning: This is a duplicate of message " message-id "\n")
-	(nnmail-cache-insert newid)
 	(funcall func (setq group-art
 			    (nreverse (nnmail-article-group artnum-func))))))
 (t
 (funcall func (setq group-art
 			  (nreverse (nnmail-article-group artnum-func))))))
 		     (file-exists-p nnmail-crash-box))
 	    ;; There is new mail.  We first find out if all this mail
 	    ;; is supposed to go to some specific group.
 	    (setq group (nnmail-get-split-group spool group-in))
 	    ;; We split the mail
 	    (nnmail-split-incoming
 	     nnmail-crash-box (intern (format "%s-save-mail" method))
 	     spool-func group (intern (format "%s-active-number" method)))
 	    ;; Check whether the inbox is to be moved to the special tmp dir.
 	    (setq incoming
 		  (nnmail-make-complex-temp-name
 		   (expand-file-name
 		    (if nnmail-tmp-directory
 			(concat
 			 (file-name-as-directory nnmail-tmp-directory)
 			 (file-name-nondirectory
 			  (concat (file-name-as-directory temp) "Incoming")))
 		      (concat (file-name-as-directory temp) "Incoming")))))
 	    (rename-file nnmail-crash-box incoming t)
 	    (push incoming incomings))))
 ;; If we did indeed read any incoming spools, we save all info.
 (when incomings
 	(nnmail-save-active
 	 (nnmail-get-value "%s-group-alist" method)
 	 (nnmail-get-value "%s-active-file" method))
 	(when exit-func
 	  (funcall exit-func))
 	(run-hooks 'nnmail-read-incoming-hook)
 (when (assoc group (pop his))
 	(setq found t
 	      his nil)))
 found))
+(eval-and-compile
+(autoload 'pop3-movemail "pop3"))
 (defun nnmail-pop3-movemail (inbox crashbox)
 "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
-(require 'pop3)
 (let ((pop3-maildrop
 (substring inbox (match-end (string-match "^po:" inbox)))))
 (pop3-movemail crashbox)))
 (run-hooks 'nnmail-load-hook)
 (provide 'nnmail)
 ;;; nnmail.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnmail.el @ 108:360340f9fd5f r20-1b6