Don't message so much when reading nnimap stuff.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 1fd0840..49cceaa 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -168,6 +168,8 @@ textual parts.")
                   nnmail-extra-headers))))
 
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
                   nnmail-extra-headers))))
 
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)


@@ -190,7 +192,7 @@ textual parts.")
   (let (article bytes lines size string)
     (block nil
       (while (not (eobp))
   (let (article bytes lines size string)
     (block nil
       (while (not (eobp))

-       (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
+       (while (not (looking-at "\\* [0-9]+ FETCH.+?UID \\([0-9]+\\)"))

          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))


@@ -216,9 +218,14 @@ textual parts.")
          (let ((structure (ignore-errors
                             (read (current-buffer)))))
            (while (and (consp structure)
          (let ((structure (ignore-errors
                             (read (current-buffer)))))
            (while (and (consp structure)

-                       (not (stringp (car structure))))
+                       (not (atom (car structure))))

              (setq structure (car structure)))
              (setq structure (car structure)))

-           (setq lines (nth 7 structure))))
+           (setq lines (if (and
+                            (stringp (car structure))
+                            (equal (upcase (nth 0 structure)) "MESSAGE")
+                            (equal (upcase (nth 1 structure)) "RFC822"))
+                           (nth 9 structure)
+                         (nth 7 structure)))))

        (delete-region (line-beginning-position) (line-end-position))
        (insert (format "211 %s Article retrieved." article))
        (forward-line 1)
        (delete-region (line-beginning-position) (line-end-position))
        (insert (format "211 %s Article retrieved." article))
        (forward-line 1)


@@ -338,6 +345,11 @@ textual parts.")
        nil
       stream)))
 
        nil
       stream)))
 

+(defun nnimap-map-port (port)
+  (if (equal port "imaps")
+      "993"
+    port))
+

 (defun nnimap-open-connection-1 (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
 (defun nnimap-open-connection-1 (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)


@@ -345,7 +357,6 @@ textual parts.")
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)

-          (port nil)

           (ports
            (cond
             ((memq nnimap-stream '(network plain starttls))
           (ports
            (cond
             ((memq nnimap-stream '(network plain starttls))


@@ -367,7 +378,8 @@ textual parts.")
        (push nnimap-server-port ports))
       (let* ((stream-list
              (open-protocol-stream
        (push nnimap-server-port ports))
       (let* ((stream-list
              (open-protocol-stream

-              "*nnimap*" (current-buffer) nnimap-address (car ports)
+              "*nnimap*" (current-buffer) nnimap-address
+              (nnimap-map-port (car ports))

               :type nnimap-stream
               :return-list t
               :shell-command nnimap-shell-program
               :type nnimap-stream
               :return-list t
               :shell-command nnimap-shell-program


@@ -390,7 +402,7 @@ textual parts.")
        (if (not stream)
            (progn
              (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
        (if (not stream)
            (progn
              (nnheader-report 'nnimap "Unable to contact %s:%s via %s"

-                              nnimap-address port nnimap-stream)
+                              nnimap-address (car ports) nnimap-stream)

              'no-connect)
          (gnus-set-process-query-on-exit-flag stream nil)
          (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
              'no-connect)
          (gnus-set-process-query-on-exit-flag stream nil)
          (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))


@@ -519,6 +531,8 @@ textual parts.")
   nnimap-status-string)
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)
   nnimap-status-string)
 
 (deffoo nnimap-request-article (article &optional group server to-buffer)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
          parts structure)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
          parts structure)


@@ -550,6 +564,8 @@ textual parts.")
            (cons group article)))))))
 
 (deffoo nnimap-request-head (article &optional group server to-buffer)
            (cons group article)))))))
 
 (deffoo nnimap-request-head (article &optional group server to-buffer)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (when (stringp article)
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (when (stringp article)


@@ -696,7 +712,11 @@ textual parts.")
        (incf num)))
     (nreverse parts)))
 
        (incf num)))
     (nreverse parts)))
 

+(defun nnimap-decode-gnus-group (group)
+  (decode-coding-string group 'utf-8))
+

 (deffoo nnimap-request-group (group &optional server dont-check info)
 (deffoo nnimap-request-group (group &optional server dont-check info)

+  (setq group (nnimap-decode-gnus-group group))

   (let ((result (nnimap-possibly-change-group
                 ;; Don't SELECT the group if we're going to select it
                 ;; later, anyway.
   (let ((result (nnimap-possibly-change-group
                 ;; Don't SELECT the group if we're going to select it
                 ;; later, anyway.


@@ -746,16 +766,19 @@ textual parts.")
        t))))
 
 (deffoo nnimap-request-create-group (group &optional server args)
        t))))
 
 (deffoo nnimap-request-create-group (group &optional server args)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-delete-group (group &optional force server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-rename-group (group new-name &optional server)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
 (deffoo nnimap-request-rename-group (group new-name &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (nnimap-unselect-group)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       (nnimap-unselect-group)


@@ -770,6 +793,7 @@ textual parts.")
   (nnimap-command "EXAMINE DOES.NOT.EXIST"))
 
 (deffoo nnimap-request-expunge-group (group &optional server)
   (nnimap-command "EXAMINE DOES.NOT.EXIST"))
 
 (deffoo nnimap-request-expunge-group (group &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "EXPUNGE")))))
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "EXPUNGE")))))


@@ -797,6 +821,7 @@ textual parts.")
 
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)
 
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)

+  (setq group (nnimap-decode-gnus-group group))

   (with-temp-buffer
     (mm-disable-multibyte)
     (when (funcall (if internal-move-group
   (with-temp-buffer
     (mm-disable-multibyte)
     (when (funcall (if internal-move-group


@@ -825,6 +850,7 @@ textual parts.")
              result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
              result)))))))
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)

+  (setq group (nnimap-decode-gnus-group group))

   (cond
    ((null articles)
     nil)
   (cond
    ((null articles)
     nil)


@@ -952,6 +978,8 @@ textual parts.")
                                 "delete this article now"))))))
 
 (deffoo nnimap-request-scan (&optional group server)
                                 "delete this article now"))))))
 
 (deffoo nnimap-request-scan (&optional group server)

+  (when group
+    (setq group (nnimap-decode-gnus-group group)))

   (when (and (nnimap-possibly-change-group nil server)
             nnimap-inbox
             nnimap-split-methods)
   (when (and (nnimap-possibly-change-group nil server)
             nnimap-inbox
             nnimap-split-methods)


@@ -967,6 +995,7 @@ textual parts.")
     flags))
 
 (deffoo nnimap-request-update-group-status (group status &optional server)
     flags))
 
 (deffoo nnimap-request-update-group-status (group status &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (let ((command (assoc
                    status
   (when (nnimap-possibly-change-group nil server)
     (let ((command (assoc
                    status


@@ -977,6 +1006,7 @@ textual parts.")
          (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
 
 (deffoo nnimap-request-set-mark (group actions &optional server)
          (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
 
 (deffoo nnimap-request-set-mark (group actions &optional server)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)


@@ -1001,6 +1031,7 @@ textual parts.")
          (nnimap-wait-for-response sequence))))))
 
 (deffoo nnimap-request-accept-article (group &optional server last)
          (nnimap-wait-for-response sequence))))))
 
 (deffoo nnimap-request-accept-article (group &optional server last)

+  (setq group (nnimap-decode-gnus-group group))

   (when (nnimap-possibly-change-group nil server)
     (nnmail-check-syntax)
     (let ((message-id (message-field-value "message-id"))
   (when (nnimap-possibly-change-group nil server)
     (nnmail-check-syntax)
     (let ((message-id (message-field-value "message-id"))


@@ -1077,6 +1108,7 @@ textual parts.")
     result))
 
 (deffoo nnimap-request-replace-article (article group buffer)
     result))
 
 (deffoo nnimap-request-replace-article (article group buffer)

+  (setq group (nnimap-decode-gnus-group group))

   (let (group-art)
     (when (and (nnimap-possibly-change-group group nil)
               ;; Put the article into the group.
   (let (group-art)
     (when (and (nnimap-possibly-change-group group nil)
               ;; Put the article into the group.


@@ -1182,7 +1214,8 @@ textual parts.")
        ;; what and how to request the data.
        (dolist (info infos)
          (setq params (gnus-info-params info)
        ;; what and how to request the data.
        (dolist (info infos)
          (setq params (gnus-info-params info)

-               group (gnus-group-real-name (gnus-info-group info))
+               group (nnimap-decode-gnus-group
+                      (gnus-group-real-name (gnus-info-group info)))

                active (cdr (assq 'active params))
                uidvalidity (cdr (assq 'uidvalidity params))
                modseq (cdr (assq 'modseq params)))
                active (cdr (assq 'active params))
                uidvalidity (cdr (assq 'uidvalidity params))
                modseq (cdr (assq 'modseq params)))


@@ -1258,13 +1291,15 @@ textual parts.")
                   (active (gnus-active group)))
              (when active
                (insert (format "%S %d %d y\n"
                   (active (gnus-active group)))
              (when active
                (insert (format "%S %d %d y\n"

-                               (gnus-group-real-name group)
+                               (decode-coding-string
+                                (gnus-group-real-name group) 'utf-8)

                                (cdr active)
                                (car active)))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)
                                (cdr active)
                                (car active)))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)

-    (let* ((group (gnus-group-real-name (gnus-info-group info)))
+    (let* ((group (nnimap-decode-gnus-group
+                  (gnus-group-real-name (gnus-info-group info))))

           (marks (cdr (assoc group flags))))
       (when marks
        (nnimap-update-info info marks)))))
           (marks (cdr (assoc group flags))))
       (when marks
        (nnimap-update-info info marks)))))


@@ -1522,7 +1557,7 @@ textual parts.")
                 (goto-char start)
                 (setq vanished
                       (and (eq flag-sequence 'qresync)
                 (goto-char start)
                 (setq vanished
                       (and (eq flag-sequence 'qresync)

-                           (re-search-forward "^\\* VANISHED .* \\([0-9:,]+\\)"
+                           (re-search-forward "^\\* VANISHED .*? \\([0-9:,]+\\)"

                                               (or end (point-min)) t)
                            (match-string 1)))
                 (goto-char start)
                                               (or end (point-min)) t)
                            (match-string 1)))
                 (goto-char start)


@@ -1566,7 +1601,9 @@ textual parts.")
                  (articles &optional limit force-new dependencies))
 
 (deffoo nnimap-request-thread (header &optional group server)
                  (articles &optional limit force-new dependencies))
 
 (deffoo nnimap-request-thread (header &optional group server)

-  (if gnus-refer-thread-use-nnir 
+  (when group
+    (setq group (nnimap-decode-gnus-group group)))
+  (if gnus-refer-thread-use-nnir

       (nnir-search-thread header)
     (when (nnimap-possibly-change-group group server)
       (let* ((cmd (nnimap-make-thread-query header))
       (nnir-search-thread header)
     (when (nnimap-possibly-change-group group server)
       (let* ((cmd (nnimap-make-thread-query header))


@@ -1686,7 +1723,8 @@ textual parts.")
                                      (looking-at "\\*"))))
                        (not (looking-at (format "%d .*\n" sequence)))))
            (when messagep
                                      (looking-at "\\*"))))
                        (not (looking-at (format "%d .*\n" sequence)))))
            (when messagep

-             (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000)))
+             (nnheader-message-maybe
+              7 "nnimap read %dk" (/ (buffer-size) 1000)))

            (nnheader-accept-process-output process)
            (goto-char (point-max)))
           openp)
            (nnheader-accept-process-output process)
            (goto-char (point-max)))
           openp)