This commit was generated by cvs2svn to compensate for changes in r3968,

which included commits to RCS files with non-trunk default branches.

diff --git a/lisp/imap.el b/lisp/imap.el
index 0b01b42..7aff9c5 100644 (file)
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -950,6 +950,10 @@ If EXAMINE is non-nil, do a read-only select."
     (imap-utf7-decode 
      (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
 
+(defun imap-mailbox-examine-1 (mailbox &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (imap-mailbox-select-1 mailbox 'exmine)))
+
 (defun imap-mailbox-examine (mailbox &optional buffer)
   "Examine MAILBOX on server in BUFFER."
   (imap-mailbox-select mailbox 'exmine buffer))
@@ -1288,7 +1292,7 @@ is non-nil return theese properties."
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine mailbox)
+      (when (imap-mailbox-examine-1 mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
@@ -1329,7 +1333,7 @@ first element, rest of list contain the saved articles' UIDs."
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine mailbox)
+      (when (imap-mailbox-examine-1 mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
@@ -2372,6 +2376,7 @@ Return nil if no complete line has arrived."
            imap-current-mailbox-p
            imap-mailbox-select-1
            imap-mailbox-select
+           imap-mailbox-examine-1
            imap-mailbox-examine
            imap-mailbox-unselect
            imap-mailbox-expunge

diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index 506fc3d..be0cea4 100644 (file)
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -114,7 +114,8 @@ Common keywords should be listed here.")
        (:password)
        (:authentication password))
       (maildir
-       (:path "~/Maildir/new/")
+       (:path (or (getenv "MAILDIR") "~/Maildir/"))
+       (:subdirs ("new" "cur"))
        (:function))
       (imap
        (:server (getenv "MAILHOST"))
@@ -606,13 +607,32 @@ This only works when `display-time' is enabled."
   "Fetcher for maildir sources."
   (mail-source-bind (maildir source)
     (let ((found 0)
-         (mail-source-string (format "maildir:%s" path)))
-      (dolist (file (directory-files path t))
-       (when (and (not (file-directory-p file))
-                  (not (if function
-                           (funcall function file mail-source-crash-box)
-                         (rename-file file mail-source-crash-box))))
-         (incf found (mail-source-callback callback file))))
+         mail-source-string)
+      (unless (string-match "/$" path)
+       (setq path (concat path "/")))
+      (dolist (subdir subdirs)
+       (when (file-directory-p (concat path subdir))
+         (setq mail-source-string (format "maildir:%s%s" path subdir))
+         (dolist (file (directory-files (concat path subdir) t))
+           (when (and (not (file-directory-p file))
+                      (not (if function
+                               (funcall function file mail-source-crash-box)
+                             (let ((coding-system-for-write 
+                                    mm-text-coding-system)
+                                   (coding-system-for-read 
+                                    mm-text-coding-system))
+                               (with-temp-file mail-source-crash-box
+                                 (insert-file-contents file)
+                                 (goto-char (point-min))
+                                 (unless (looking-at "\n*From ")
+                                   (insert "From maildir " 
+                                           (current-time-string) "\n"))
+                                 (while (re-search-forward "^From " nil t)
+                                   (replace-match ">From "))
+                                 (goto-char (point-max))
+                                 (insert "\n\n"))
+                               (delete-file file)))))
+             (incf found (mail-source-callback callback file))))))
       found)))
 
 (eval-and-compile

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index af1de33..699ef5d 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -37,7 +37,6 @@
 ;; Todo, minor things:
 ;;
 ;;   o Don't require half of Gnus -- backends should be standalone
-;;   o Support escape characters in `message-tokenize-header'
 ;;   o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
 ;;   o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
 ;;   o Split up big fetches (1,* header especially) in smaller chunks
@@ -113,10 +112,6 @@ element in each \"rule\" is the name of the IMAP mailbox, and the
 second is a regexp that nnimap will try to match on the header to find
 a fit.
 
-The first element can also be a list.  In that case, the first element
-is the server the second element is the group on that server in which
-the matching article will be stored.
-
 The second element can also be a function.  In that case, it will be
 called narrowed to the headers with the first element of the rule as
 the argument.  It should return a non-nil value if it thinks that the
@@ -124,7 +119,25 @@ mail belongs in that group.
 
 This variable can also have a function as its value, the function will
 be called with the headers narrowed and should return a group where it
-thinks the article should be splitted to.")
+thinks the article should be splitted to.  See `nnimap-split-fancy'.
+
+To allow for different split rules on different virtual servers, and
+even different split rules in different inboxes on the same server,
+the syntax of this variable have been extended along the lines of:
+
+(setq nnimap-split-rule
+      '((\"my1server\"    (\".*\"    ((\"ding\"    \"ding@gnus.org\")
+                                  (\"junk\"    \"From:.*Simon\")))
+        (\"my2server\"    (\"INBOX\" nnimap-split-fancy))
+        (\"my[34]server\" (\".*\"    ((\"private\" \"To:.*Simon\")
+                                  (\"junk\"    my-junk-func)))))
+
+The virtual server name is in fact a regexp, so that the same rules
+may apply to several servers.  In the example, the servers
+\"my3server\" and \"my4server\" both use the same rules.  Similarly,
+the inbox string is also a regexp.  The actual splitting rules are as
+before, either a function, or a list with group/regexp or
+group/function elements.")
 
 (defvar nnimap-split-predicate "UNSEEN UNDELETED"
   "The predicate used to find articles to split.
@@ -524,15 +537,14 @@ If EXAMINE is non-nil the group is selected read-only."
                (imap-capability 'IMAP4rev1 nnimap-server-buffer))
       (imap-close nnimap-server-buffer)
       (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
-    (let (list alist user passwd)
-      (and (fboundp 'gnus-parse-netrc)
-          (setq list (gnus-parse-netrc nnimap-authinfo-file)
-                alist (or (and (gnus-netrc-get
-                                (gnus-netrc-machine list server) "machine")
-                               (gnus-netrc-machine list server))
-                          (gnus-netrc-machine list nnimap-address))
-                user (gnus-netrc-get alist "login")
-                passwd (gnus-netrc-get alist "password")))
+    (let* ((list (gnus-parse-netrc nnimap-authinfo-file))
+          (port (if nnimap-server-port
+                    (int-to-string nnimap-server-port)
+                  "imap"))
+          (alist (or (gnus-netrc-machine list server port "imap")
+                     (gnus-netrc-machine list nnimap-address port "imap")))
+          (user (gnus-netrc-get alist "login"))
+          (passwd (gnus-netrc-get alist "password")))
       (if (imap-authenticate user passwd nnimap-server-buffer)
          (prog1
              (push (list server nnimap-server-buffer)
@@ -610,7 +622,12 @@ function is generally only called when Gnus is shutting down."
   (with-current-buffer nnimap-callback-buffer
     (insert
      (with-current-buffer nnimap-server-buffer
-       (nnimap-demule (imap-message-get (imap-current-message) 'RFC822)))) ;xxx
+       (nnimap-demule
+        (if (imap-capability 'IMAP4rev1) 
+            ;; xxx don't just use car? alist doesn't contain
+            ;; anything else now, but it might...
+            (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
+          (imap-message-get (imap-current-message) 'RFC822)))))
     (nnheader-ms-strip-cr)
     (funcall nnimap-callback-callback-function t)))
 
@@ -736,8 +753,9 @@ function is generally only called when Gnus is shutting down."
 
 (deffoo nnimap-request-post (&optional server)
   (let ((success t))
-    (dolist  (mbx (message-tokenize-header
-                  (message-fetch-field "Newsgroups")) success)
+    (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)
@@ -895,8 +913,19 @@ function is generally only called when Gnus is shutting down."
                (or nnimap-split-crosspost
                    (throw 'split-done to-groups))))))))))
   
+(defun nnimap-assoc-match (key alist)
+  (let (element)
+    (while (and alist (not element))
+      (if (string-match (car (car alist)) key)
+         (setq element (car alist)))
+      (setq alist (cdr alist)))
+    element))
+
 (defun nnimap-split-find-rule (server inbox)
-  nnimap-split-rule)
+  (if (listp (cadar nnimap-split-rule)) ;; extended format?
+      (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match 
+                                           server nnimap-split-rule))))
+    nnimap-split-rule))
 
 (defun nnimap-split-find-inbox (server)
   (if (listp nnimap-split-inbox)
@@ -1061,8 +1090,9 @@ function is generally only called when Gnus is shutting down."
                    (goto-char (point-min))
                    (while (search-forward "\n" nil t)
                      (replace-match "\r\n")))
-                 ;; next line for Cyrus server bug
-                 (imap-mailbox-unselect nnimap-server-buffer)
+                  ;; this 'or' is for Cyrus server bug
+                  (or (null (imap-current-mailbox nnimap-server-buffer))
+                      (imap-mailbox-unselect nnimap-server-buffer))
                  (imap-message-append group (current-buffer) nil nil
                                       nnimap-server-buffer)))
          (cons group (nth 1 uid))

diff --git a/lisp/nnslashdot.el b/lisp/nnslashdot.el
index 7d7ebf4..15f1ed6 100644 (file)
--- a/lisp/nnslashdot.el
+++ b/lisp/nnslashdot.el
@@ -104,7 +104,8 @@
       (let ((case-fold-search t))
        (erase-buffer)
        (when (= start 1)
-         (nnweb-insert (format nnslashdot-article-url sid) t)
+         (nnweb-insert (format nnslashdot-article-url
+                               (nnslashdot-sid-strip sid)) t)
          (goto-char (point-min))
          (search-forward "Posted by ")
          (when (looking-at "<a[^>]+>\\([^<]+\\)")
@@ -115,20 +116,23 @@
          (forward-line 2)
          (setq lines (count-lines
                       (point)
-                      (search-forward
-                       "A href=http://slashdot.org/article" nil t)))
+                      (re-search-forward
+                       "A href=\"\\(http://slashdot.org\\)?/article" nil t)))
          (push
           (cons
            1
            (make-full-mail-header
-            1 group from date (concat "<" sid "%1@slashdot>")
+            1 group from date
+            (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>")
             "" 0 lines nil nil))
           headers))
        (while (and (setq start (pop startats))
                    (< start last))
          (setq point (goto-char (point-max)))
          (nnweb-insert
-          (format nnslashdot-comments-url sid nnslashdot-threshold 0 start)
+          (format nnslashdot-comments-url
+                  (nnslashdot-sid-strip sid)
+                  nnslashdot-threshold 0 start)
           t)
          (when first-comments
            (setq first-comments nil)
@@ -163,7 +167,7 @@
            (setq lines (/ (abs (- (search-forward "<td ")
                                   (search-forward "</td>")))
                           70))
-           (forward-line 2)
+           (forward-line 4)
            (setq parent
                  (if (looking-at ".*cid=\\([0-9]+\\)")
                      (match-string 1)
@@ -176,11 +180,11 @@
               (1+ article)
               (concat subject " (" score ")")
               from date
-              (concat "<" sid "%"
+              (concat "<" (nnslashdot-sid-strip sid) "%"
                       (number-to-string (1+ article)) 
                       "@slashdot>")
               (if parent
-                  (concat "<" sid "%"
+                  (concat "<" (nnslashdot-sid-strip sid) "%"
                           (number-to-string (1+ (string-to-number parent)))
                           "@slashdot>")
                 "")
@@ -204,7 +208,8 @@
       (set-buffer nnslashdot-buffer)
       (erase-buffer)
       (when (= start 1)
-       (nnweb-insert (format nnslashdot-article-url sid) t)
+       (nnweb-insert (format nnslashdot-article-url
+                             (nnslashdot-sid-strip sid)) t)
        (goto-char (point-min))
        (search-forward "Posted by ")
        (when (looking-at "<a[^>]+>\\([^<]+\\)")
@@ -214,13 +219,14 @@
                    (buffer-substring (point) (1- (search-forward "<")))))
        (forward-line 2)
        (setq lines (count-lines (point)
-                                (search-forward
-                                 "A href=http://slashdot.org/article")))
+                                (re-search-forward
+                                 "A href=\"\\(http://slashdot.org\\)?/article")))
        (push
         (cons
          1
          (make-full-mail-header
-          1 group from date (concat "<" sid "%1@slashdot>")
+          1 group from date (concat "<" (nnslashdot-sid-strip sid)
+                                    "%1@slashdot>")
           "" 0 lines nil nil))
         headers))
       (while (or (not article)
@@ -230,7 +236,8 @@
          (setq start (1+ article)))
        (setq point (goto-char (point-max)))
        (nnweb-insert
-        (format nnslashdot-comments-url sid nnslashdot-threshold 4 start)
+        (format nnslashdot-comments-url (nnslashdot-sid-strip sid)
+                nnslashdot-threshold 4 start)
         t)
        (goto-char point)
        (while (re-search-forward
@@ -269,11 +276,11 @@
            (make-full-mail-header
             (1+ article) (concat subject " (" score ")")
             from date
-            (concat "<" sid "%"
+            (concat "<" (nnslashdot-sid-strip sid) "%"
                     (number-to-string (1+ article)) 
                     "@slashdot>")
             (if parent
-                (concat "<" sid "%"
+                (concat "<" (nnslashdot-sid-strip sid) "%"
                         (number-to-string (1+ (string-to-number parent)))
                         "@slashdot>")
               "")
@@ -329,7 +336,7 @@
                           (point)
                           (progn
                             (re-search-forward
-                             "<p>.*A href=http://slashdot\\.org/article")
+                             "<p>.*A href=\"\\(http://slashdot.org\\)?/article")
                             (match-beginning 0)))))
                (search-forward (format "<a name=\"%d\">" (1- article)))
                (setq contents
@@ -423,7 +430,7 @@
 
 (deffoo nnslashdot-request-post (&optional server)
   (nnslashdot-possibly-change-server nil server)
-  (let ((sid (message-fetch-field "newsgroups"))
+  (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups")))
        (subject (message-fetch-field "subject"))
        (references (car (last (split-string
                                (message-fetch-field "references")))))
@@ -532,6 +539,11 @@
 (defun nnslashdot-lose (why)
   (error "Slashdot HTML has changed; please get a new version of nnslashdot"))
 
+(defun nnslashdot-sid-strip (sid)
+  (if (string-match "^00/" sid)
+      (substring sid (match-end 0))
+    sid))
+
 (provide 'nnslashdot)
 
 ;;; nnslashdot.el ends here

diff --git a/lisp/nnwarchive.el b/lisp/nnwarchive.el
index f888a62..5103b55 100644 (file)
--- a/lisp/nnwarchive.el
+++ b/lisp/nnwarchive.el
@@ -68,9 +68,9 @@
      (list-dissect . nnwarchive-egroups-list)
      (list-groups . nnwarchive-egroups-list-groups)
      (xover-url 
-      "http://www.egroups.com/message/%s/%d" group aux)
+      "http://www.egroups.com/messages/%s/%d" group aux)
      (xover-last-url 
-      "http://www.egroups.com/message/%s/" group)
+      "http://www.egroups.com/messages/%s/" group)
      (xover-page-size . 13)
      (xover-dissect . nnwarchive-egroups-xover)
      (article-url 

diff --git a/lisp/webmail.el b/lisp/webmail.el
index bc33f3a..2110624 100644 (file)
--- a/lisp/webmail.el
+++ b/lisp/webmail.el
@@ -454,7 +454,8 @@
       (webmail-error "article@3.1"))
   (delete-region (match-beginning 0) (point-max))
   (nnweb-remove-markup)
-  (nnweb-decode-entities)
+  (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+    (nnweb-decode-entities))
   (goto-char (point-min))
   (while (re-search-forward "\r\n?" nil t)
     (replace-match "\n"))
@@ -483,7 +484,8 @@
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
@@ -539,7 +541,8 @@
            (if (looking-at "$") (forward-char))
            (delete-region (point-min) (point))
            (nnweb-remove-markup)
-           (nnweb-decode-entities)
+           (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+             (nnweb-decode-entities))
            nil)
           (t
            (setq mime t)
@@ -633,7 +636,8 @@
        (search-forward "</a>" nil t)
        (delete-region p (match-end 0)))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-max))
@@ -650,7 +654,8 @@
              (webmail-error "article@5"))
          (narrow-to-region p (match-end 0))
          (nnweb-remove-markup)
-         (nnweb-decode-entities)
+         (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+           (nnweb-decode-entities))
          (goto-char (point-min))
          (delete-blank-lines)
          (setq ct (mail-fetch-field "content-type")
@@ -721,6 +726,7 @@
     (webmail-error "login@1")))
 
 (defun webmail-netaddress-list ()
+  (webmail-refresh-redirect)
   (let (item id)
     (goto-char (point-min))
     (when (re-search-forward 
@@ -753,7 +759,8 @@
     (while (re-search-forward "<br>" nil t)
       (replace-match "\n"))
     (nnweb-remove-markup)
-    (nnweb-decode-entities) 
+    (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+      (nnweb-decode-entities))
     nil)
    (t
     (insert "<#part type=\"text/html\" disposition=inline>")
@@ -762,6 +769,7 @@
     t)))
 
 (defun webmail-netaddress-article (file id)
+  (webmail-refresh-redirect)
   (let (p p1 attachment count mime type)
     (save-restriction
       (webmail-encode-8bit)
@@ -781,7 +789,8 @@
       (while (search-forward "<b>" nil t)
        (replace-match "\n"))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))
@@ -906,7 +915,8 @@
       (while (search-forward "<b>" nil t)
        (replace-match "\n"))
       (nnweb-remove-markup)
-      (nnweb-decode-entities)
+      (let ((w3-html-entities (cons '(nbsp . 32) w3-html-entities)))
+       (nnweb-decode-entities))
       (goto-char (point-min))
       (delete-blank-lines)
       (goto-char (point-min))