Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / nnmail.el
index 05e9022..a7ca27f 100644 (file)
 
 (eval-and-compile
   (autoload 'gnus-error "gnus-util")
-  (autoload 'gnus-buffer-live-p "gnus-util"))
-
-(eval-when-compile (require 'static))
-
-(static-condition-case nil
-    :symbol-for-testing-whether-colon-keyword-is-available-or-not
-  (void-variable
-   (defconst :user ':user)
-   (defconst :path ':path)
-   (defconst :predicate ':predicate)))
+  (autoload 'gnus-buffer-live-p "gnus-util")
+  (autoload 'gnus-add-buffer "gnus"))
 
 (defgroup nnmail nil
   "Reading mail with Gnus."
@@ -94,8 +86,8 @@ else, you could do something like this:
 
  (setq nnmail-split-methods
        '((\"mail.4ad\" \"From:.*4ad\")
-         (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
-         (\"mail.misc\" \"\")))
+        (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
+        (\"mail.misc\" \"\")))
 
 As you can see, this variable is a list of lists, where the first
 element in each \"rule\" is the name of the group (which, by the way,
@@ -123,6 +115,14 @@ If nil, the first match found will be used."
   :group 'nnmail-split
   :type 'boolean)
 
+(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
+  "Regexp that matches group names to be ignored when applying
+`nnmail-split-fancy-with-parent'.  This can also be a list of regexps."
+  :group 'nnmail-split
+  :type '(choice (const :tag "none" nil)
+                (regexp :value ".*")
+                (repeat :value (".*") regexp)))
+
 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
 (defcustom nnmail-keep-last-article nil
   "If non-nil, nnmail will never delete/move a group's last article.
@@ -167,8 +167,8 @@ Eg.:
 
 \(setq nnmail-expiry-wait-function
       (lambda (newsgroup)
-        (cond ((string-match \"private\" newsgroup) 31)
-              ((string-match \"junk\" newsgroup) 1)
+       (cond ((string-match \"private\" newsgroup) 31)
+             ((string-match \"junk\" newsgroup) 1)
              ((string-match \"important\" newsgroup) 'never)
              (t 7))))"
   :group 'nnmail-expire
@@ -184,10 +184,10 @@ 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)."
   :version "21.1"
-    :group 'nnmail-expire
-    :type '(choice (const delete)
-                  (function :format "%v" nnmail-)
-                  string))
+  :group 'nnmail-expire
+  :type '(choice (const delete)
+                (function :format "%v" nnmail-)
+                string))
 
 (defcustom nnmail-cache-accepted-message-ids nil
   "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
@@ -246,9 +246,9 @@ running (\"xwatch\", etc.)
 Eg.
 
 \(add-hook 'nnmail-read-incoming-hook
-          (lambda ()
-            (call-process \"/local/bin/mailsend\" nil nil nil
-                          \"read\" nnmail-spool-file)))
+         (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.
@@ -345,6 +345,12 @@ GROUP: Mail will be stored in GROUP (a string).
   return value FUNCTION should be a split, which is then recursively
   processed.
 
+junk: Mail will be deleted.  Use with care!  Do not submerge in water!
+  Example:
+  (setq nnmail-split-fancy
+        '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
+            ...other.rules.omitted...))
+
 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.
@@ -372,13 +378,13 @@ Example:
             ;; Other mailing lists...
             (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
             (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
-             ;; Both lists below have the same suffix, so prevent
-             ;; cross-posting to mkpkg.list of messages posted only to
-             ;; the bugs- list, but allow cross-posting when the
-             ;; message was really cross-posted.
-             (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
-             (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
-             ;;
+            ;; Both lists below have the same suffix, so prevent
+            ;; cross-posting to mkpkg.list of messages posted only to
+            ;; the bugs- list, but allow cross-posting when the
+            ;; message was really cross-posted.
+            (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
+            (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
+            ;;
             ;; People...
             (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
          ;; Unmatched mail goes to the catch all group.
@@ -441,6 +447,9 @@ parameter.  It should return nil, `warn' or `delete'."
 
 ;;; Internal variables.
 
+(defvar nnmail-article-buffer " *nnmail incoming*"
+  "The buffer used for splitting incoming mails.")
+
 (defvar nnmail-split-history nil
   "List of group/article elements that say where the previous split put messages.")
 
@@ -475,7 +484,7 @@ parameter.  It should return nil, `warn' or `delete'."
   nnheader-text-coding-system
   "Coding system used in reading inbox")
 
-(defvar nnmail-pathname-coding-system 'binary
+(defvar nnmail-pathname-coding-system nil
   "*Coding system for pathname.")
 
 (defun nnmail-find-file (file)
@@ -539,8 +548,8 @@ nn*-request-list should have been called before calling this function."
            (setq group (read buffer))
            (unless (stringp group)
              (setq group (symbol-name group)))
-           (if (and (numberp (setq max (read nntp-server-buffer)))
-                    (numberp (setq min (read nntp-server-buffer))))
+           (if (and (numberp (setq max (read buffer)))
+                    (numberp (setq min (read buffer))))
                (push (list group (cons min max))
                      group-assoc)))
        (error nil))
@@ -906,7 +915,7 @@ FUNC will be called with the buffer narrowed to each mail."
                                nnmail-split-methods)))
     (save-excursion
       ;; Insert the incoming file.
-      (set-buffer (get-buffer-create " *nnmail incoming*"))
+      (set-buffer (get-buffer-create nnmail-article-buffer))
       (erase-buffer)
       (let ((nnheader-file-coding-system nnmail-incoming-coding-system))
        (nnheader-insert-file-contents incoming))
@@ -1102,19 +1111,19 @@ Return the number of characters in the body."
 
 (defun nnmail-remove-list-identifiers ()
   "Remove list identifiers from Subject headers."
-  (let ((regexp 
-        (if (consp nnmail-list-identifiers) 
+  (let ((regexp
+        (if (consp nnmail-list-identifiers)
             (mapconcat 'identity nnmail-list-identifiers " *\\|")
           nnmail-list-identifiers)))
     (when regexp
       (goto-char (point-min))
       (while (re-search-forward
-              (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
-              nil t)
-        (delete-region (match-beginning 2) (match-end 0))
-        (beginning-of-line))
+             (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
+             nil t)
+       (delete-region (match-beginning 2) (match-end 0))
+       (beginning-of-line))
       (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t)
-        (delete-region (match-beginning 1) (match-end 1))
+       (delete-region (match-beginning 1) (match-end 1))
        (beginning-of-line)))))
 
 (defun nnmail-remove-tabs ()
@@ -1130,14 +1139,36 @@ Return the number of characters in the body."
       (beginning-of-line)
       (insert "X-Gnus-Broken-Eudora-"))
     (goto-char (point-min))
-    (when (re-search-forward "^In-Reply-To:[^\n]+\\(\n[ \t]+\\)" nil t)
-      (replace-match "" t t nil 1))))
+    (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
+      (replace-match "\\1" t))))
 
 (custom-add-option 'nnmail-prepare-incoming-header-hook
                   'nnmail-fix-eudora-headers)
 
 ;;; Utility functions
 
+(defun nnmail-do-request-post (accept-func &optional server)
+  "Utility function to directly post a message to an nnmail-derived group.
+Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
+to actually put the message in the right group."
+  (let ((success t))
+    (dolist (mbx (message-unquote-tokens
+                 (message-tokenize-header
+                  (message-fetch-field "Newsgroups") ", ")) success)
+      (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
+       (or (gnus-active to-newsgroup)
+           (gnus-activate-group to-newsgroup)
+           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
+                                      to-newsgroup))
+               (or (and (gnus-request-create-group
+                         to-newsgroup gnus-command-method)
+                        (gnus-activate-group to-newsgroup nil nil
+                                             gnus-command-method))
+                   (error "Couldn't create group %s" to-newsgroup)))
+           (error "No such group: %s" to-newsgroup))
+       (unless (funcall accept-func mbx (nth 1 gnus-command-method))
+         (setq success nil))))))
+
 (defun nnmail-split-fancy ()
   "Fancy splitting method.
 See the documentation for the variable `nnmail-split-fancy' for documentation."
@@ -1353,6 +1384,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
       (set-buffer
        (setq nnmail-cache-buffer
             (get-buffer-create " *nnmail message-id cache*")))
+      (gnus-add-buffer)
       (when (file-exists-p nnmail-message-id-cache-file)
        (nnheader-insert-file-contents nnmail-message-id-cache-file))
       (set-buffer-modified-p nil)
@@ -1397,34 +1429,34 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
     ;; 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 "")))
+            (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))
+       (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"))))))
+       (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))
+       (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)))
+                (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
@@ -1435,29 +1467,45 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
       (set-buffer nnmail-cache-buffer)
       (goto-char (point-max))
       (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))))))))
+       (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 ()
+  "Split this message into the same group as its parent.
+This function can be used as an entry in `nnmail-split-fancy', for
+example like this: (: nnmail-split-fancy)
+For a message to be split, it looks for the parent message in the
+References or In-Reply-To header and then looks in the message id
+cache file (given by the variable `nnmail-message-id-cache-file') to
+see which group that message was put in.  This group is returned.
+
+See the Info node `(gnus)Fancy Mail Splitting' for more details."
   (let* ((refstr (or (message-fetch-field "references")
-                     (message-fetch-field "in-reply-to")))
-         (references nil)
-         (res nil))
+                    (message-fetch-field "in-reply-to")))
+        (references nil)
+        (res nil)
+        (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
+                    (mapconcat
+                     (lambda (x) (format "\\(%s\\)" x))
+                     nnmail-split-fancy-with-parent-ignore-groups
+                     "\\|")
+                  nnmail-split-fancy-with-parent-ignore-groups)))
     (when refstr
       (setq references (nreverse (gnus-split-references refstr)))
       (unless (gnus-buffer-live-p nnmail-cache-buffer)
-        (nnmail-cache-open))
+       (nnmail-cache-open))
       (mapcar (lambda (x)
-                (setq res (or (nnmail-cache-fetch-group x) res))
-                (when (string= "drafts" res)
-                  (setq res nil)))
-              references)
+               (setq res (or (nnmail-cache-fetch-group x) res))
+               (when (or (string= "drafts" res)
+                         (and regexp res (string-match regexp res)))
+                 (setq res nil)))
+             references)
       res)))
 
 (defun nnmail-cache-id-exists-p (id)
@@ -1566,12 +1614,11 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
            (setq source (append source
                                 (list
                                  :predicate
-                                 `(lambda (file)
-                                    (string-match
-                                     ,(concat
-                                       (regexp-quote (concat group suffix))
-                                       "$")
-                                     file)))))))
+                                 (gnus-byte-compile
+                                  `(lambda (file)
+                                     (string-equal
+                                      ,(concat group suffix)
+                                      (file-name-nondirectory file)))))))))
        (when nnmail-fetched-sources
          (if (member source nnmail-fetched-sources)
              (setq source nil)
@@ -1592,14 +1639,15 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
        (when (setq new
                    (mail-source-fetch
                     source
-                    `(lambda (file orig-file)
-                       (nnmail-split-incoming
-                        file ',(intern (format "%s-save-mail" method))
-                        ',spool-func
-                        (if (equal file orig-file)
-                            nil
-                          (nnmail-get-split-group orig-file ',source))
-                        ',(intern (format "%s-active-number" method))))))
+                    (gnus-byte-compile
+                     `(lambda (file orig-file)
+                        (nnmail-split-incoming
+                         file ',(intern (format "%s-save-mail" method))
+                         ',spool-func
+                         (if (equal file orig-file)
+                             nil
+                           (nnmail-get-split-group orig-file ',source))
+                         ',(intern (format "%s-active-number" method)))))))
          (incf total new)
          (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.
@@ -1643,6 +1691,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
             (ignore-errors (time-less-p days (time-since time))))))))
 
 (defun nnmail-expiry-target-group (target group)
+  ;; Do not invoke this from nntp-server-buffer!  At least nnfolder clears
+  ;; that buffer if the nnfolder group isn't selected.
   (let (nnmail-cache-accepted-message-ids)
     ;; Don't enter Message-IDs into cache.
     ;; Let users hack it in TARGET function.