X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=5c0cd70805e0ec374d968265f259c92a6ef35c38;hb=754a007c9c67f3506008dab6e7e8943eb51848f2;hp=6ba318fa262ab91d10fdcaf11d18e881bd4a884c;hpb=7ebbcbb06bab7d80b94f9df6164cbcd37ab07c91;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 6ba318fa2..5c0cd7080 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -25,14 +25,17 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'nnheader) (require 'timezone) (require 'message) -(require 'cl) (require 'custom) (eval-and-compile - (autoload 'gnus-error "gnus-util")) + (autoload 'gnus-error "gnus-util") + (autoload 'gnus-buffer-live-p "gnus-util") + (autoload 'gnus-encode-coding-string "gnus-ems")) (defgroup nnmail nil "Reading mail with Gnus." @@ -73,7 +76,7 @@ (defcustom nnmail-split-methods '(("mail.misc" "")) - "Incoming mail will be split according to this variable. + "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the \"4ad-l\" mailing list, one group for junk mail and one for everything @@ -112,7 +115,9 @@ If nil, the first match found will be used." ;; 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. + "If non-nil, nnmail will never delete/move a group's last article. +It can be marked expirable, so it will be deleted when it is no longer last. + 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 @@ -168,7 +173,7 @@ Eg.: (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) - "Where the mail backends will look for incoming mail. + "*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. If this variable is a list, all files mentioned in this list will be @@ -216,7 +221,7 @@ several files - eg. \".spool[0-9]*\"." (if (string-match "windows-nt\\|emx" (format "%s" system-type)) 'copy-file 'add-name-to-file) - "Function called to create a copy of a file. + "*Function called to create a copy of a file. This is `add-name-to-file' by default, which means that crossposts will use hard links. If your file system doesn't allow hard links, you could set this variable to `copy-file' instead." @@ -245,7 +250,7 @@ to be moved to." (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) - "Hook that will be run after the incoming mail has been transferred. + "*Hook that will be run after the incoming mail has been transferred. The incoming mail is moved from `nnmail-spool-file' (which normally is something like \"/usr/spool/mail/$user\") to the user's home directory. This hook is called after the incoming mail box has been @@ -297,8 +302,8 @@ that) from the headers before splitting and saving the messages." This can also be a list of regexps." :group 'nnmail-prepare :type '(choice (const :tag "none" nil) - regexp - (repeat regexp))) + (regexp :value ".*") + (repeat :value (".*") regexp))) (defcustom nnmail-pre-get-new-mail-hook nil "Hook called just before starting to handle new incoming mail." @@ -398,11 +403,11 @@ Example: (from . "from\\|sender\\|resent-from") (nato . "to\\|cc\\|resent-to\\|resent-cc") (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) - "Alist of abbreviations allowed in `nnmail-split-fancy'." + "*Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) -(defcustom nnmail-delete-incoming t +(defcustom nnmail-delete-incoming nil "*If non-nil, the mail backends will delete incoming files after splitting." :group 'nnmail-retrieve @@ -442,6 +447,8 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-split-history nil "List of group/article elements that say where the previous split put messages.") +(defvar nnmail-current-spool nil) + (defvar nnmail-pop-password nil "*Password to use when reading mail from a POP server, if required.") @@ -471,6 +478,9 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) +(defvar nnmail-file-coding-system 'raw-text + "Coding system used in nnmail.") + (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) @@ -478,19 +488,31 @@ parameter. It should return nil, `warn' or `delete'." (let ((format-alist nil) (after-insert-file-functions nil)) (condition-case () - (progn (insert-file-contents file) t) + (let ((coding-system-for-read nnmail-file-coding-system) + (pathname-coding-system 'binary)) + (insert-file-contents file) + t) (file-error nil)))) +(defvar nnmail-pathname-coding-system + 'iso-8859-1 + "*Coding system for pathname.") + (defun nnmail-group-pathname (group dir &optional file) "Make pathname for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) + (setq group (nnheader-translate-file-chars group)) ;; 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 ?. ?/) "/"))) + (concat dir + (gnus-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + "/"))) (or file ""))) (defun nnmail-date-to-time (date) @@ -539,7 +561,7 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-move-inbox (inbox) "Move INBOX to `nnmail-crash-box'." (if (not (file-writable-p nnmail-crash-box)) - (gnus-error 1 "Can't write to crash box %s. Not moving mail." + (gnus-error 1 "Can't write to crash box %s. Not moving mail" nnmail-crash-box) ;; If the crash box exists and is empty, we delete it. (when (and (file-exists-p nnmail-crash-box) @@ -569,7 +591,7 @@ parameter. It should return nil, `warn' or `delete'." (nnmail-read-passwd (format "Password for %s: " (substring inbox (+ popmail 3)))))) - (message "Getting mail from post office ...")) + (message "Getting mail from the post office...")) (when (or (and (file-exists-p tofile) (/= 0 (nnheader-file-size tofile))) (and (file-exists-p inbox) @@ -593,17 +615,17 @@ parameter. It should return nil, `warn' or `delete'." (save-excursion (setq errors (generate-new-buffer " *nnmail loss*")) (buffer-disable-undo errors) - (let ((default-directory "/")) - (if (nnheader-functionp nnmail-movemail-program) - (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)))) + (if (nnheader-functionp nnmail-movemail-program) + (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)))) + (let ((default-directory "/")) (setq result (apply 'call-process @@ -668,11 +690,16 @@ nn*-request-list should have been called before calling this function." group-assoc))) group-assoc)) +(defvar nnmail-active-file-coding-system + 'iso-8859-1 + "*Coding system for active file.") + (defun nnmail-save-active (group-assoc file-name) "Save GROUP-ASSOC in ACTIVE-FILE." - (when file-name - (nnheader-temp-write file-name - (nnmail-generate-active group-assoc)))) + (let ((coding-system-for-write nnmail-active-file-coding-system)) + (when file-name + (nnheader-temp-write file-name + (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) "Generate an active file from group-alist ALIST." @@ -709,8 +736,8 @@ is a spool. If not using procmail, return GROUP." (defun nnmail-process-babyl-mail-format (func artnum-func) (let ((case-fold-search t) start message-id content-length do-search end) - (goto-char (point-min)) (while (not (eobp)) + (goto-char (point-min)) (re-search-forward " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) (goto-char (match-end 0)) @@ -804,7 +831,7 @@ is a spool. If not using procmail, return GROUP." (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) @@ -833,7 +860,7 @@ is a spool. If not using procmail, return GROUP." (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) @@ -847,7 +874,9 @@ is a spool. If not using procmail, return GROUP." (if (not (and (re-search-forward "^From " nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (progn + (pop-to-buffer (find-file-noselect nnmail-current-spool)) + (error "Error, unknown mail format! (Possibly corrupted.)")) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point) @@ -932,7 +961,9 @@ is a spool. If not using procmail, return GROUP." (if (not (and (re-search-forward delim nil t) (forward-line 1))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (progn + (pop-to-buffer (find-file-noselect nnmail-current-spool)) + (error "Error, unknown mail format! (Possibly corrupted.)")) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point)) @@ -1010,15 +1041,15 @@ FUNC will be called with the buffer narrowed to each mail." (funcall exit-func)) (kill-buffer (current-buffer))))) -;; Mail crossposts suggested by Brian Edmonds . (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)) (beg (point-min)) - end group-art method) - (if (and (sequencep methods) (= (length methods) 1)) + end group-art method regrepp) + (if (and (sequencep methods) + (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. (setq group-art @@ -1052,11 +1083,12 @@ FUNC will be called with the group name to determine the article number." "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) + (setq split (remove-duplicates split :test 'equal)) ;; The article may be "cross-posted" to `junk'. What ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... (let (elem) - (while (setq elem (assq 'junk split)) + (while (setq elem (car (memq 'junk split))) (setq split (delq elem split)))) (when split (setq group-art @@ -1064,21 +1096,31 @@ FUNC will be called with the group name to determine the article number." (lambda (group) (cons group (funcall func group))) split)))) ;; Go through the split methods to find a match. - (while (and methods (or nnmail-crosspost (not group-art))) + (while (and methods + (or nnmail-crosspost + (not group-art))) (goto-char (point-max)) - (setq method (pop methods)) + (setq method (pop methods) + regrepp nil) (if (or methods (not (equal "" (nth 1 method)))) (when (and (ignore-errors (if (stringp (nth 1 method)) - (re-search-backward (cadr method) nil t) + (progn + (setq regrepp + (string-match "\\\\[0-9&]" (car 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))) + (push (cons (if regrepp + (replace-match + (car method) nil nil (car method)) + (car method)) + (funcall func (car method))) group-art)) ;; This is the final group, which is used as a ;; catch-all. @@ -1093,7 +1135,7 @@ FUNC will be called with the group name to determine the article number." ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... (let (elem) - (while (setq elem (assq 'junk group-art)) + (while (setq elem (car (memq 'junk group-art))) (setq group-art (delq elem group-art))) (nreverse group-art))))))) @@ -1125,7 +1167,10 @@ Return the number of characters in the body." (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - (insert (format " %s:%d" (caar group-alist) (cdar group-alist))) + (insert (format " %s:%d" + (gnus-encode-coding-string (caar group-alist) + nnmail-pathname-coding-system) + (cdar group-alist))) (setq group-alist (cdr group-alist))) (insert "\n")))) @@ -1154,7 +1199,6 @@ Return the number of characters in the body." ;;; Utility functions -;; Written by byer@mv.us.adobe.com (Scott Byer). (defun nnmail-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) (newprefix prefix)) @@ -1207,7 +1251,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Builtin : operation. ((eq (car split) ':) - (nnmail-split-it (eval (cdr split)))) + (nnmail-split-it (save-excursion (eval (cdr split))))) ;; Check the cache for the regexp for this split. ;; FIX FIX FIX could avoid calling assq twice here @@ -1302,7 +1346,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nnmail-use-procmail) (directory-files nnmail-procmail-directory - t (concat (if group (concat "^" group) "") + t (concat (if group (concat "^" (regexp-quote group)) "") nnmail-procmail-suffix "$")))) (p procmails) (crash (when (and (file-exists-p nnmail-crash-box) @@ -1355,6 +1399,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) + (nnheader-init-server-buffer) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force @@ -1500,12 +1545,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) "Read new incoming mail." - ;; Nix out the previous split history. - (unless group - (setq nnmail-split-history nil)) (let* ((spools (nnmail-get-spool-files group)) (group-in group) - incoming incomings spool) + nnmail-current-spool incoming incomings spool) (when (and (nnmail-get-value "%s-get-new-mail" method) nnmail-spool-file) ;; We first activate all the groups. @@ -1527,6 +1569,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (nnheader-message 3 "%s: Reading incoming mail..." method) (when (and (nnmail-move-inbox spool) (file-exists-p nnmail-crash-box)) + (setq nnmail-current-spool spool) ;; 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)) @@ -1544,6 +1587,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (file-name-nondirectory (concat (file-name-as-directory temp) "Incoming"))) (concat (file-name-as-directory temp) "Incoming"))))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) (rename-file nnmail-crash-box incoming t) (push incoming incomings)))) ;; If we did indeed read any incoming spools, we save all info. @@ -1616,8 +1661,10 @@ If ARGS, PROMPT is used as an argument to `format'." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." - (write-region start end filename append visit lockname) - (set-file-modes filename nnmail-default-file-modes)) + (let ((coding-system-for-write nnmail-file-coding-system) + (pathname-coding-system 'binary)) + (write-region start end filename append visit lockname) + (set-file-modes filename nnmail-default-file-modes))) ;;; ;;; Status functions @@ -1693,6 +1740,16 @@ If ARGS, PROMPT is used as an argument to `format'." ", ")) (princ "\n"))))) +(defun nnmail-purge-split-history (group) + "Remove all instances of GROUP from `nnmail-split-history'." + (let ((history nnmail-split-history) + prev) + (while history + (setcar history (delete-if (lambda (e) (string= (car e) group)) + (car history))) + (pop history)) + (setq nnmail-split-history (delq nil nnmail-split-history)))) + (defun nnmail-new-mail-p (group) "Say whether GROUP has new mail." (let ((his nnmail-split-history)