Fix my last change.
[gnus] / lisp / nnmail.el
index 2aa740b..4e8fd9d 100644 (file)
@@ -1,5 +1,6 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995,96,97,98,99, 00 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
@@ -167,7 +168,13 @@ Eg.:
                 (function :format "%v" nnmail-)))
 
 (defcustom nnmail-expiry-target 'delete
-  "*Variable that says where expired messages should end up."
+  "*Variable that says where expired messages should end up.
+The default value is `delete' (which says to delete the messages),
+but it can also be a string or a function.  If it is a string, expired
+messages end up in that group.  If it is a function, the function is
+called in a buffer narrowed to the message in question.  The function
+receives one argument, the name of the group the message comes from.
+The return value should be `delete' or a group name (a string)."
     :group 'nnmail-expire
     :type '(choice (const delete)
                   (function :format "%v" nnmail-)
@@ -190,6 +197,12 @@ This variable is obsolete; `mail-sources' should be used instead."
   :group 'nnmail-procmail
   :type 'boolean)
 
+(defcustom nnmail-scan-directory-mail-source-once nil
+  "*If non-nil, scan all incoming procmail sorted mails once.
+It scans low-level sorted spools even when not required."
+  :group 'nnmail-procmail
+  :type 'boolean)
+
 (defcustom nnmail-delete-file-function 'delete-file
   "Function called to delete files in some mail backends."
   :group 'nnmail-files
@@ -213,7 +226,7 @@ links, you could set this variable to `copy-file' instead."
       '(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
+The incoming mail is moved from the specified 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
 emptied, and can be used to call any mail box programs you have
@@ -222,9 +235,9 @@ running (\"xwatch\", etc.)
 Eg.
 
 \(add-hook 'nnmail-read-incoming-hook
-          (lambda ()
-            (start-process \"mailsend\" nil
-                           \"/local/bin/mailsend\" \"read\" \"mbox\")))
+          (lambda ()
+            (call-process \"/local/bin/mailsend\" nil nil nil
+                          \"read\" nnmail-spool-file)))
 
 If you have xwatch running, this will alert it that mail has been
 read.
@@ -461,7 +474,7 @@ parameter.  It should return nil, `warn' or `delete'."
     (condition-case ()
        (let ((coding-system-for-read nnmail-file-coding-system)
              (auto-mode-alist (mm-auto-mode-alist))
-             (pathname-coding-system nnmail-pathname-coding-system))
+             (file-name-coding-system nnmail-pathname-coding-system))
          (insert-file-contents file)
          t)
       (file-error nil))))
@@ -1340,14 +1353,84 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
       (setq nnmail-cache-buffer nil)
       (kill-buffer (current-buffer)))))
 
+;; Compiler directives.
+(defvar group)
+(defvar group-art-list)
+(defvar group-art)
 (defun nnmail-cache-insert (id)
   (when nnmail-treat-duplicates
-    (unless (gnus-buffer-live-p nnmail-cache-buffer)
-      (nnmail-cache-open))
+    ;; Store some information about the group this message is written
+    ;; to.  This function might have been called from various places.
+    ;; Sometimes, a function up in the calling sequence has an
+    ;; argument GROUP which is bound to a string, the group name.  At
+    ;; other times, there is a function up in the calling sequence
+    ;; which has an argument GROUP-ART which is a list of pairs, and
+    ;; the car of a pair is a group name.  Should we check that the
+    ;; length of the list is equal to 1? -- kai
+    (let ((g nil))
+      (cond ((and (boundp 'group) group)
+             (setq g group))
+            ((and (boundp 'group-art-list) group-art-list
+                  (listp group-art-list))
+             (setq g (caar group-art-list)))
+            ((and (boundp 'group-art) group-art (listp group-art))
+             (setq g (caar group-art)))
+            (t (setq g "")))
+      (unless (gnus-buffer-live-p nnmail-cache-buffer)
+        (nnmail-cache-open))
+      (save-excursion
+        (set-buffer nnmail-cache-buffer)
+        (goto-char (point-max))
+        (if (and g (not (string= "" g))
+                 (gnus-methods-equal-p gnus-command-method
+                                       (nnmail-cache-primary-mail-backend)))
+            (insert id "\t" g "\n")
+          (insert id "\n"))))))
+
+(defun nnmail-cache-primary-mail-backend ()
+  (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
+        (be nil)
+        (res nil))
+    (while (and (null res) be-list)
+      (setq be (car be-list))
+      (setq be-list (cdr be-list))
+      (when (and (gnus-method-option-p be 'respool)
+                 (eval (intern (format "%s-get-new-mail" (car be)))))
+        (setq res be)))
+    res))
+
+;; Fetch the group name corresponding to the message id stored in the
+;; cache.
+(defun nnmail-cache-fetch-group (id)
+  (when (and nnmail-treat-duplicates nnmail-cache-buffer)
     (save-excursion
       (set-buffer nnmail-cache-buffer)
       (goto-char (point-max))
-      (insert id "\n"))))
+      (when (search-backward id nil t)
+        (beginning-of-line)
+        (skip-chars-forward "^\n\r\t")
+        (unless (eolp)
+          (forward-char 1)
+          (buffer-substring (point)
+                            (progn (end-of-line) (point))))))))
+
+;; Function for nnmail-split-fancy: look up all references in the
+;; cache and if a match is found, return that group.
+(defun nnmail-split-fancy-with-parent ()
+  (let* ((refstr (or (message-fetch-field "references")
+                     (message-fetch-field "in-reply-to")))
+         (references nil)
+         (res nil))
+    (when refstr
+      (setq references (nreverse (gnus-split-references refstr)))
+      (unless (gnus-buffer-live-p nnmail-cache-buffer)
+        (nnmail-cache-open))
+      (mapcar (lambda (x)
+                (setq res (or (nnmail-cache-fetch-group x) res))
+                (when (string= "drafts" res)
+                  (setq res nil)))
+              references)
+      res)))
 
 (defun nnmail-cache-id-exists-p (id)
   (when nnmail-treat-duplicates
@@ -1431,7 +1514,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
         (total 0)
         incoming incomings source)
     (when (and (nnmail-get-value "%s-get-new-mail" method)
-              nnmail-spool-file)
+              sources)
       (while (setq source (pop sources))
        ;; Be compatible with old values.
        (cond
@@ -1449,6 +1532,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
          nil))
        ;; Hack to only fetch the contents of a single group's spool file.
        (when (and (eq (car source) 'directory)
+                  (null nnmail-scan-directory-mail-source-once)
                   group)
          (mail-source-bind (directory source)
            (setq source (append source
@@ -1532,7 +1616,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
   (when (nnheader-functionp target)
     (setq target (funcall target group)))
   (unless (eq target 'delete)
-    (gnus-request-accept-article target)))
+    (gnus-request-accept-article target nil nil t)))
 
 (defun nnmail-check-syntax ()
   "Check (and modify) the syntax of the message in the current buffer."
@@ -1545,7 +1629,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
 (defun nnmail-write-region (start end filename &optional append visit lockname)
   "Do a `write-region', and then set the file modes."
   (let ((coding-system-for-write nnmail-file-coding-system)
-       (pathname-coding-system nnmail-pathname-coding-system))
+       (file-name-coding-system nnmail-pathname-coding-system))
     (write-region start end filename append visit lockname)
     (set-file-modes filename nnmail-default-file-modes)))