ecomplete.el (ecomplete-highlight-match-line): Fix typos in comment.

[gnus] / lisp / nnmail.el

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index d5fdd35..8ccd7b0 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -25,7 +25,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.

 (eval-and-compile
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 
 (eval-and-compile
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 


@@ -104,7 +104,9 @@ mail belongs in that group.
 
 The last element should always have \"\" as the regexp.
 
 
 The last element should always have \"\" as the regexp.
 

-This variable can also have a function as its value."
+This variable can also have a function as its value, and it can
+also have a fancy split method as its value.  See
+`nnmail-split-fancy' for an explanation of that syntax."

   :group 'nnmail-split
   :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
                                             (choice regexp function)))
   :group 'nnmail-split
   :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
                                             (choice regexp function)))


@@ -225,7 +227,7 @@ Example:
 
 In this case, articles containing the string \"boss\" in the To or the
 From header will be expired to the group \"nnfolder:Work\";
 
 In this case, articles containing the string \"boss\" in the To or the
 From header will be expired to the group \"nnfolder:Work\";

-articles containing the sting \"IMPORTANT\" in the Subject header will
+articles containing the string \"IMPORTANT\" in the Subject header will

 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 everything else will be expired to \"nnfolder:Archive-YYYY\"."
   :version "22.1"
 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 everything else will be expired to \"nnfolder:Archive-YYYY\"."
   :version "22.1"


@@ -675,8 +677,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
   "Returns an assoc of group names and active ranges.
 nn*-request-list should have been called before calling this function."
   ;; Go through all groups from the active list.
   "Returns an assoc of group names and active ranges.
 nn*-request-list should have been called before calling this function."
   ;; Go through all groups from the active list.

-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer

     (nnmail-parse-active)))
 
 (defun nnmail-parse-active ()
     (nnmail-parse-active)))
 
 (defun nnmail-parse-active ()


@@ -964,7 +965,7 @@ If SOURCE is a directory spec, try to return the group name component."
        (goto-char end)))
     count))
 
        (goto-char end)))
     count))
 

-(defun nnmail-process-mmdf-mail-format (func artnum-func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)

   (let ((delim "^\^A\^A\^A\^A$")
        (case-fold-search t)
        (count 0)
   (let ((delim "^\^A\^A\^A\^A$")
        (case-fold-search t)
        (count 0)


@@ -1012,7 +1013,7 @@ If SOURCE is a directory spec, try to return the group name component."
            (narrow-to-region start (point))
            (goto-char (point-min))
            (incf count)
            (narrow-to-region start (point))
            (goto-char (point-min))
            (incf count)

-           (nnmail-check-duplication message-id func artnum-func)
+           (nnmail-check-duplication message-id func artnum-func junk-func)

            (setq end (point-max))))
        (goto-char end)
        (forward-line 2)))
            (setq end (point-max))))
        (goto-char end)
        (forward-line 2)))


@@ -1057,7 +1058,7 @@ If SOURCE is a directory spec, try to return the group name component."
   "Non-nil means group names are not encoded.")
 
 (defun nnmail-split-incoming (incoming func &optional exit-func
   "Non-nil means group names are not encoded.")
 
 (defun nnmail-split-incoming (incoming func &optional exit-func

-                                      group artnum-func)
+                                      group artnum-func junk-func)

   "Go through the entire INCOMING file and pick out each individual mail.
 FUNC will be called with the buffer narrowed to each mail.
 INCOMING can also be a buffer object.  In that case, the mail
   "Go through the entire INCOMING file and pick out each individual mail.
 FUNC will be called with the buffer narrowed to each mail.
 INCOMING can also be a buffer object.  In that case, the mail


@@ -1069,9 +1070,8 @@ will be copied over from that buffer."
                                  (list (list group ""))
                                nnmail-split-methods))
        (nnmail-group-names-not-encoded-p t))
                                  (list (list group ""))
                                nnmail-split-methods))
        (nnmail-group-names-not-encoded-p t))

-    (save-excursion
-      ;; Insert the incoming file.
-      (set-buffer (get-buffer-create nnmail-article-buffer))
+    ;; Insert the incoming file.
+    (with-current-buffer (get-buffer-create nnmail-article-buffer)

       (erase-buffer)
       (if (bufferp incoming)
          (insert-buffer-substring incoming)
       (erase-buffer)
       (if (bufferp incoming)
          (insert-buffer-substring incoming)


@@ -1089,7 +1089,8 @@ will be copied over from that buffer."
                       (looking-at "BABYL OPTIONS:"))
                   (nnmail-process-babyl-mail-format func artnum-func))
                  ((looking-at "\^A\^A\^A\^A")
                       (looking-at "BABYL OPTIONS:"))
                   (nnmail-process-babyl-mail-format func artnum-func))
                  ((looking-at "\^A\^A\^A\^A")

-                  (nnmail-process-mmdf-mail-format func artnum-func))
+                  (nnmail-process-mmdf-mail-format
+                   func artnum-func junk-func))

                  ((looking-at "Return-Path:")
                   (nnmail-process-maildir-mail-format func artnum-func))
                  (t
                  ((looking-at "Return-Path:")
                   (nnmail-process-maildir-mail-format func artnum-func))
                  (t


@@ -1098,7 +1099,7 @@ will be copied over from that buffer."
          (funcall exit-func))
        (kill-buffer (current-buffer))))))
 
          (funcall exit-func))
        (kill-buffer (current-buffer))))))
 

-(defun nnmail-article-group (func &optional trace)
+(defun nnmail-article-group (func &optional trace junk-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 (or nnmail-split-methods '(("bogus" ""))))
   "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 (or nnmail-split-methods '(("bogus" ""))))


@@ -1112,9 +1113,8 @@ FUNC will be called with the group name to determine the article number."
        (setq group-art
              (list (cons (caar methods) (funcall func (caar methods)))))
       ;; We do actual comparison.
        (setq group-art
              (list (cons (caar methods) (funcall func (caar methods)))))
       ;; We do actual comparison.

-      (save-excursion
-       ;; Copy the article into the work buffer.
-       (set-buffer nntp-server-buffer)
+      ;; Copy the article into the work buffer.
+      (with-current-buffer nntp-server-buffer

        (erase-buffer)
        (insert-buffer-substring obuf)
        ;; Narrow to headers.
        (erase-buffer)
        (insert-buffer-substring obuf)
        ;; Narrow to headers.


@@ -1147,28 +1147,41 @@ FUNC will be called with the group name to determine the article number."
        (run-hooks 'nnmail-split-hook)
        (when (setq nnmail-split-tracing trace)
          (setq nnmail-split-trace nil))
        (run-hooks 'nnmail-split-hook)
        (when (setq nnmail-split-tracing trace)
          (setq nnmail-split-trace nil))

-       (if (and (symbolp nnmail-split-methods)
-                (fboundp nnmail-split-methods))
-           (let ((split
-                  (condition-case error-info
-                      ;; `nnmail-split-methods' is a function, so we
-                      ;; just call this function here and use the
-                      ;; result.
-                      (or (funcall nnmail-split-methods)
-                          (and (not nnmail-inhibit-default-split-group)
-                               ("bogus")))
-                    (error
-                     (nnheader-message
-                      5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
-                     (sit-for 1)
-                     '("bogus")))))
+       (if (or (and (symbolp nnmail-split-methods)
+                    (fboundp nnmail-split-methods))
+               (and (listp nnmail-split-methods)
+                    ;; Not a regular split method, so it has to be a
+                    ;; fancy one.
+                    (not (let ((top-element (car-safe nnmail-split-methods)))
+                           (and (= 2 (length top-element))
+                                (stringp (nth 0 top-element))
+                                (stringp (nth 1 top-element)))))))
+           (let* ((method-function
+                   (if (and (symbolp nnmail-split-methods)
+                            (fboundp nnmail-split-methods))
+                       nnmail-split-methods
+                     'nnmail-split-fancy))
+                  (split
+                   (condition-case error-info
+                       ;; `nnmail-split-methods' is a function, so we
+                       ;; just call this function here and use the
+                       ;; result.
+                       (or (funcall method-function)
+                           (and (not nnmail-inhibit-default-split-group)
+                                '("bogus")))
+                     (error
+                      (nnheader-message
+                       5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
+                      (sit-for 1)
+                      '("bogus")))))

              (setq split (mm-delete-duplicates split))
              ;; The article may be "cross-posted" to `junk'.  What
              ;; to do?  Just remove the `junk' spec.  Don't really
              ;; see anything else to do...
              (setq split (mm-delete-duplicates split))
              ;; 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 (car (memq 'junk split)))
-                 (setq split (delq elem split))))
+             (when (and (memq 'junk split)
+                        junk-func)
+               (funcall junk-func 'junk))
+             (setq split (delq 'junk split))

              (when split
                (setq group-art
                      (mapcar
              (when split
                (setq group-art
                      (mapcar


@@ -1581,10 +1594,9 @@ See the documentation for the variable `nnmail-split-fancy' for details."
          (and nnmail-cache-buffer
               (buffer-name nnmail-cache-buffer)))
       ()                               ; The buffer is open.
          (and nnmail-cache-buffer
               (buffer-name nnmail-cache-buffer)))
       ()                               ; The buffer is open.

-    (save-excursion
-      (set-buffer
+    (with-current-buffer

        (setq nnmail-cache-buffer
        (setq nnmail-cache-buffer

-            (get-buffer-create " *nnmail message-id cache*")))
+            (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))
       (gnus-add-buffer)
       (when (file-exists-p nnmail-message-id-cache-file)
        (nnheader-insert-file-contents nnmail-message-id-cache-file))


@@ -1596,8 +1608,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
             nnmail-treat-duplicates
             (buffer-name nnmail-cache-buffer)
             (buffer-modified-p nnmail-cache-buffer))
             nnmail-treat-duplicates
             (buffer-name nnmail-cache-buffer)
             (buffer-modified-p nnmail-cache-buffer))

-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer

       ;; Weed out the excess number of Message-IDs.
       (goto-char (point-max))
       (when (search-backward "\n" nil t nnmail-message-id-cache-length)
       ;; Weed out the excess number of Message-IDs.
       (goto-char (point-max))
       (when (search-backward "\n" nil t nnmail-message-id-cache-length)


@@ -1614,10 +1625,6 @@ See the documentation for the variable `nnmail-split-fancy' for details."
       (setq nnmail-cache-buffer nil)
       (gnus-kill-buffer (current-buffer)))))
 
       (setq nnmail-cache-buffer nil)
       (gnus-kill-buffer (current-buffer)))))
 

-;; Compiler directives.
-(defvar group)
-(defvar group-art-list)
-(defvar group-art)

 (defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
     ;; this will handle cases like `B r' where the group is nil
 (defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
     ;; this will handle cases like `B r' where the group is nil


@@ -1632,8 +1639,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
       ;; pass the first (of possibly >1) group which matches. -Josh
       (unless (gnus-buffer-live-p nnmail-cache-buffer)
        (nnmail-cache-open))
       ;; pass the first (of possibly >1) group which matches. -Josh
       (unless (gnus-buffer-live-p nnmail-cache-buffer)
        (nnmail-cache-open))

-      (save-excursion
-       (set-buffer nnmail-cache-buffer)
+      (with-current-buffer nnmail-cache-buffer

        (goto-char (point-max))
        (if (and grp (not (string= "" grp))
                 (gnus-methods-equal-p gnus-command-method
        (goto-char (point-max))
        (if (and grp (not (string= "" grp))
                 (gnus-methods-equal-p gnus-command-method


@@ -1666,8 +1672,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
 ;; cache.
 (defun nnmail-cache-fetch-group (id)
   (when (and nnmail-treat-duplicates nnmail-cache-buffer)
 ;; cache.
 (defun nnmail-cache-fetch-group (id)
   (when (and nnmail-treat-duplicates nnmail-cache-buffer)

-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer

       (goto-char (point-max))
       (when (search-backward id nil t)
        (beginning-of-line)
       (goto-char (point-max))
       (when (search-backward id nil t)
        (beginning-of-line)


@@ -1711,8 +1716,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
 (defun nnmail-cache-id-exists-p (id)
   (when nnmail-treat-duplicates
 
 (defun nnmail-cache-id-exists-p (id)
   (when nnmail-treat-duplicates

-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
+    (with-current-buffer nnmail-cache-buffer

       (goto-char (point-max))
       (search-backward id nil t))))
 
       (goto-char (point-max))
       (search-backward id nil t))))
 


@@ -1722,7 +1726,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (message-narrow-to-head)
       (message-fetch-field header))))
 
       (message-narrow-to-head)
       (message-fetch-field header))))
 

-(defun nnmail-check-duplication (message-id func artnum-func)
+(defun nnmail-check-duplication (message-id func artnum-func
+                                           &optional junk-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))
   (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))


@@ -1747,7 +1752,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (cond
      ((not duplication)
       (funcall func (setq group-art
     (cond
      ((not duplication)
       (funcall func (setq group-art

-                         (nreverse (nnmail-article-group artnum-func))))
+                         (nreverse (nnmail-article-group
+                                    artnum-func nil junk-func))))

       (nnmail-cache-insert message-id (caar group-art)))
      ((eq action 'delete)
       (setq group-art nil))
       (nnmail-cache-insert message-id (caar group-art)))
      ((eq action 'delete)
       (setq group-art nil))


@@ -1866,9 +1872,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (run-hooks 'nnmail-post-get-new-mail-hook))))
 
 (defun nnmail-expired-article-p (group time force &optional inhibit)
       (run-hooks 'nnmail-post-get-new-mail-hook))))
 
 (defun nnmail-expired-article-p (group time force &optional inhibit)

-  "Say whether an article that is TIME old in GROUP should be expired."
+  "Say whether an article that is TIME old in GROUP should be expired.
+If TIME is nil, then return the cutoff time for oldness instead."

   (if force
   (if force

-      t
+      (if (null time)
+         (current-time)
+       t)

     (let ((days (or (and nnmail-expiry-wait-function
                         (funcall nnmail-expiry-wait-function group))
                    nnmail-expiry-wait)))
     (let ((days (or (and nnmail-expiry-wait-function
                         (funcall nnmail-expiry-wait-function group))
                    nnmail-expiry-wait)))


@@ -1879,14 +1888,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
             nil)
            ((eq days 'immediate)
             ;; We expire all articles on sight.
             nil)
            ((eq days 'immediate)
             ;; We expire all articles on sight.

-            t)
+            (if (null time)
+                (current-time)
+              t))

            ((equal time '(0 0))
            ;; This is an ange-ftp group, and we don't have any dates.
             nil)
            ((numberp days)
             (setq days (days-to-time days))
             ;; Compare the time with the current time.
            ((equal time '(0 0))
            ;; This is an ange-ftp group, and we don't have any dates.
             nil)
            ((numberp days)
             (setq days (days-to-time days))
             ;; Compare the time with the current time.

-            (ignore-errors (time-less-p days (time-since time))))))))
+            (if (null time)
+                (time-subtract (current-time) days)
+              (ignore-errors (time-less-p days (time-since time)))))))))

 
 (declare-function gnus-group-mark-article-read "gnus-group" (group article))
 
 
 (declare-function gnus-group-mark-article-read "gnus-group" (group article))
 


@@ -1901,7 +1914,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (unless (eq target 'delete)
       (when (or (gnus-request-group target)
                (gnus-request-create-group target))
     (unless (eq target 'delete)
       (when (or (gnus-request-group target)
                (gnus-request-create-group target))

-       (let ((group-art (gnus-request-accept-article target nil nil t)))
+       (let ((group-art (gnus-request-accept-article target nil t t)))

          (when (consp group-art)
            (gnus-group-mark-article-read target (cdr group-art))))))))
 
          (when (consp group-art)
            (gnus-group-mark-article-read target (cdr group-art))))))))