emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/imap.el


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/imap.el
Date: Sat, 04 Sep 2004 09:49:03 -0400

Index: emacs/lisp/gnus/imap.el
diff -c emacs/lisp/gnus/imap.el:1.12 emacs/lisp/gnus/imap.el:1.13
*** emacs/lisp/gnus/imap.el:1.12        Mon Mar 22 15:08:55 2004
--- emacs/lisp/gnus/imap.el     Sat Sep  4 13:13:43 2004
***************
*** 1,5 ****
  ;;; imap.el --- imap library
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Simon Josefsson <address@hidden>
--- 1,5 ----
  ;;; imap.el --- imap library
! ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
  ;;        Free Software Foundation, Inc.
  
  ;; Author: Simon Josefsson <address@hidden>
***************
*** 125,130 ****
--- 125,131 ----
  ;; o Don't use `read' at all (important places already fixed)
  ;; o Accept list of articles instead of message set string in most
  ;;   imap-message-* functions.
+ ;; o Send strings as literal if they contain, e.g., ".
  ;;
  ;; Revision history:
  ;;
***************
*** 152,157 ****
--- 153,159 ----
    (autoload 'utf7-decode "utf7")
    (autoload 'format-spec "format-spec")
    (autoload 'format-spec-make "format-spec")
+   (autoload 'open-tls-stream "tls")
    ;; Avoid use gnus-point-at-eol so we're independent of Gnus.  These
    ;; days we have point-at-eol anyhow.
    (if (fboundp 'point-at-eol)
***************
*** 178,184 ****
    :group 'imap
    :type '(repeat string))
  
! (defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
    "List of strings containing commands for GSSAPI (krb5) authentication.
  %s is replaced with server hostname, %p with port to connect to, and
  %l with the value of `imap-default-user'.  The program should accept
--- 180,191 ----
    :group 'imap
    :type '(repeat string))
  
! (defcustom imap-gssapi-program (list
!                               (concat "gsasl --client --connect %s:%p "
!                                       "--imap --application-data "
!                                       "--mechanism GSSAPI "
!                                       "--authentication-id %l")
!                               "imtest -m gssapi -u %l -p %p %s")
    "List of strings containing commands for GSSAPI (krb5) authentication.
  %s is replaced with server hostname, %p with port to connect to, and
  %l with the value of `imap-default-user'.  The program should accept
***************
*** 213,238 ****
    :group 'imap
    :type '(repeat string))
  
! (defvar imap-shell-host "gateway"
!   "Hostname of rlogin proxy.")
  
! (defvar imap-default-user (user-login-name)
!   "Default username to use.")
  
! (defvar imap-error nil
!   "Error codes from the last command.")
  
  ;; Various variables.
  
  (defvar imap-fetch-data-hook nil
    "Hooks called after receiving each FETCH response.")
  
! (defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
    "Priority of streams to consider when opening connection to server.")
  
  (defvar imap-stream-alist
    '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
      (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
      (ssl       imap-ssl-p              imap-ssl-open)
      (network   imap-network-p          imap-network-open)
      (shell     imap-shell-p            imap-shell-open)
--- 220,286 ----
    :group 'imap
    :type '(repeat string))
  
! (defcustom imap-process-connection-type nil
!   "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
! The `process-connection-type' variable control type of device
! used to communicate with subprocesses.  Values are nil to use a
! pipe, or t or `pty' to use a pty.  The value has no effect if the
! system has no ptys or if all ptys are busy: then a pipe is used
! in any case.  The value takes effect when a IMAP server is
! opened, changing it after that has no effect.."
!   :group 'imap
!   :type 'boolean)
  
! (defcustom imap-use-utf7 t
!   "If non-nil, do utf7 encoding/decoding of mailbox names.
! Since the UTF7 decoding currently only decodes into ISO-8859-1
! characters, you may disable this decoding if you need to access UTF7
! encoded mailboxes which doesn't translate into ISO-8859-1."
!   :group 'imap
!   :type 'boolean)
  
! (defcustom imap-log nil
!   "If non-nil, a imap session trace is placed in *imap-log* buffer."
!   :group 'imap
!   :type 'boolean)
! 
! (defcustom imap-debug nil
!   "If non-nil, random debug spews are placed in *imap-debug* buffer."
!   :group 'imap
!   :type 'boolean)
! 
! (defcustom imap-shell-host "gateway"
!   "Hostname of rlogin proxy."
!   :group 'imap
!   :type 'string)
! 
! (defcustom imap-default-user (user-login-name)
!   "Default username to use."
!   :group 'imap
!   :type 'string)
! 
! (defcustom imap-read-timeout (if (string-match
!                                 "windows-nt\\|os/2\\|emx\\|cygwin"
!                                 (symbol-name system-type))
!                                1.0
!                              0.1)
!   "*How long to wait between checking for the end of output.
! Shorter values mean quicker response, but is more CPU intensive."
!   :type 'number
!   :group 'imap)
  
  ;; Various variables.
  
  (defvar imap-fetch-data-hook nil
    "Hooks called after receiving each FETCH response.")
  
! (defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
    "Priority of streams to consider when opening connection to server.")
  
  (defvar imap-stream-alist
    '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
      (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+     (tls       imap-tls-p              imap-tls-open)
      (ssl       imap-ssl-p              imap-ssl-open)
      (network   imap-network-p          imap-network-open)
      (shell     imap-shell-p            imap-shell-open)
***************
*** 242,248 ****
  \(NAME CHECK OPEN)
  
  NAME names the stream, CHECK is a function returning non-nil if the
! server supports the stream and OPEN is a function for opening the
  stream.")
  
  (defvar imap-authenticators '(gssapi
--- 290,296 ----
  \(NAME CHECK OPEN)
  
  NAME names the stream, CHECK is a function returning non-nil if the
! server support the stream and OPEN is a function for opening the
  stream.")
  
  (defvar imap-authenticators '(gssapi
***************
*** 268,283 ****
  the server support the authenticator and AUTHENTICATE is a function
  for doing the actual authentication.")
  
! (defvar imap-use-utf7 t
!   "If non-nil, do utf7 encoding/decoding of mailbox names.
! Since the UTF7 decoding currently only decodes into ISO-8859-1
! characters, you may disable this decoding if you need to access UTF7
! encoded mailboxes which doesn't translate into ISO-8859-1.")
  
  ;; Internal constants.  Change theese and die.
  
  (defconst imap-default-port 143)
  (defconst imap-default-ssl-port 993)
  (defconst imap-default-stream 'network)
  (defconst imap-coding-system-for-read 'binary)
  (defconst imap-coding-system-for-write 'binary)
--- 316,329 ----
  the server support the authenticator and AUTHENTICATE is a function
  for doing the actual authentication.")
  
! (defvar imap-error nil
!   "Error codes from the last command.")
  
  ;; Internal constants.  Change theese and die.
  
  (defconst imap-default-port 143)
  (defconst imap-default-ssl-port 993)
+ (defconst imap-default-tls-port 993)
  (defconst imap-default-stream 'network)
  (defconst imap-coding-system-for-read 'binary)
  (defconst imap-coding-system-for-write 'binary)
***************
*** 301,306 ****
--- 347,354 ----
                                 imap-process
                                 imap-calculate-literal-size-first
                                 imap-mailbox-data))
+ (defconst imap-log-buffer "*imap-log*")
+ (defconst imap-debug-buffer "*imap-debug*")
  
  ;; Internal variables.
  
***************
*** 368,405 ****
    "Non-nil indicates that the server emitted a continuation request.
  The actual value is really the text on the continuation line.")
  
! (defvar imap-log nil
!   "Name of buffer for imap session trace.
! For example: (setq imap-log \"*imap-log*\")")
! 
! (defvar imap-debug nil                        ;"*imap-debug*"
!   "Name of buffer for random debug spew.
! For example: (setq imap-debug \"*imap-debug*\")")
  
  
  ;; Utility functions:
  
  (defsubst imap-disable-multibyte ()
    "Enable multibyte in the current buffer."
    (when (fboundp 'set-buffer-multibyte)
      (set-buffer-multibyte nil)))
  
- (defun imap-read-passwd (prompt &rest args)
-   "Read a password using PROMPT.
- If ARGS, PROMPT is used as an argument to `format'."
-   (let ((prompt (if args
-                   (apply 'format prompt args)
-                 prompt)))
-     (funcall (if (or (fboundp 'read-passwd)
-                    (and (load "subr" t)
-                         (fboundp 'read-passwd))
-                    (and (load "passwd" t)
-                         (fboundp 'read-passwd)))
-                'read-passwd
-              (autoload 'ange-ftp-read-passwd "ange-ftp")
-              'ange-ftp-read-passwd)
-            prompt)))
- 
  (defsubst imap-utf7-encode (string)
    (if imap-use-utf7
        (and string
--- 416,446 ----
    "Non-nil indicates that the server emitted a continuation request.
  The actual value is really the text on the continuation line.")
  
! (defvar imap-callbacks nil
!   "List of response tags and callbacks, on the form `(number . function)'.
! The function should take two arguments, the first the IMAP tag and the
! second the status (OK, NO, BAD etc) of the command.")
  
  
  ;; Utility functions:
  
+ (defun imap-remassoc (key alist)
+   "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+ The modified LIST is returned.  If the first member
+ of LIST has a car that is `equal' to KEY, there is no way to remove it
+ by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+ sure of changing the value of `foo'."
+   (when alist
+     (if (equal key (caar alist))
+       (cdr alist)
+       (setcdr alist (imap-remassoc key (cdr alist)))
+       alist)))
+ 
  (defsubst imap-disable-multibyte ()
    "Enable multibyte in the current buffer."
    (when (fboundp 'set-buffer-multibyte)
      (set-buffer-multibyte nil)))
  
  (defsubst imap-utf7-encode (string)
    (if imap-use-utf7
        (and string
***************
*** 447,452 ****
--- 488,494 ----
        (let* ((port (or port imap-default-port))
             (coding-system-for-read imap-coding-system-for-read)
             (coding-system-for-write imap-coding-system-for-write)
+            (process-connection-type imap-process-connection-type)
             (process (start-process
                       name buffer shell-file-name shell-command-switch
                       (format-spec
***************
*** 461,469 ****
            (setq imap-client-eol "\n"
                  imap-calculate-literal-size-first t)
            (while (and (memq (process-status process) '(open run))
                        (goto-char (point-min))
!                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
!                       (or (while (looking-at "^C:")
                              (forward-line))
                            t)
                        ;; cyrus 1.6 imtest print "S: " before server greeting
--- 503,519 ----
            (setq imap-client-eol "\n"
                  imap-calculate-literal-size-first t)
            (while (and (memq (process-status process) '(open run))
+                       (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-min))
!                       ;; Athena IMTEST can output SSL verify errors
!                       (or (while (looking-at "^verify error:num=")
!                             (forward-line))
!                           t)
!                       (or (while (looking-at "^TLS connection established")
!                             (forward-line))
!                           t)
!                       ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
!                       (or (while (looking-at "^C:")
                              (forward-line))
                            t)
                        ;; cyrus 1.6 imtest print "S: " before server greeting
***************
*** 481,487 ****
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
--- 531,537 ----
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log-buffer)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
***************
*** 493,499 ****
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
!                 (imap-send-command-wait "LOGOUT"))
              (delete-process process)
              nil)))))
      done))
--- 543,549 ----
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
!                 (imap-send-command "LOGOUT"))
              (delete-process process)
              nil)))))
      done))
***************
*** 506,514 ****
--- 556,566 ----
        cmd done)
      (while (and (not done) (setq cmd (pop cmds)))
        (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
+       (erase-buffer)
        (let* ((port (or port imap-default-port))
             (coding-system-for-read imap-coding-system-for-read)
             (coding-system-for-write imap-coding-system-for-write)
+            (process-connection-type imap-process-connection-type)
             (process (start-process
                       name buffer shell-file-name shell-command-switch
                       (format-spec
***************
*** 520,530 ****
             response)
        (when process
          (with-current-buffer buffer
!           (setq imap-client-eol "\n")
            (while (and (memq (process-status process) '(open run))
                        (goto-char (point-min))
!                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
!                       (or (while (looking-at "^C:")
                              (forward-line))
                            t)
                        ;; cyrus 1.6 imtest print "S: " before server greeting
--- 572,584 ----
             response)
        (when process
          (with-current-buffer buffer
!           (setq imap-client-eol "\n"
!                 imap-calculate-literal-size-first t)
            (while (and (memq (process-status process) '(open run))
+                       (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-min))
!                       ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
!                       (or (while (looking-at "^C:")
                              (forward-line))
                            t)
                        ;; cyrus 1.6 imtest print "S: " before server greeting
***************
*** 534,545 ****
                        (not (and (imap-parse-greeting)
                                  ;; success in imtest 1.6:
                                  (re-search-forward
!                                  "^\\(Authenticat.*\\)" nil t)
                                  (setq response (match-string 1)))))
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
--- 588,602 ----
                        (not (and (imap-parse-greeting)
                                  ;; success in imtest 1.6:
                                  (re-search-forward
!                                  (concat "^\\(\\(Authenticat.*\\)\\|\\("
!                                          "Client authentication "
!                                          "finished.*\\)\\)")
!                                  nil t)
                                  (setq response (match-string 1)))))
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log-buffer)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
***************
*** 550,556 ****
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
!                 (imap-send-command-wait "LOGOUT"))
              (delete-process process)
              nil)))))
      done))
--- 607,613 ----
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
!                 (imap-send-command "LOGOUT"))
              (delete-process process)
              nil)))))
      done))
***************
*** 565,580 ****
        cmd done)
      (while (and (not done) (setq cmd (pop cmds)))
        (message "imap: Opening SSL connection with `%s'..." cmd)
        (let* ((port (or port imap-default-ssl-port))
             (coding-system-for-read imap-coding-system-for-read)
             (coding-system-for-write imap-coding-system-for-write)
             (process-connection-type nil)
             process)
        (when (progn
!               (setq process (start-process 
                               name buffer shell-file-name
                               shell-command-switch
!                              (format-spec cmd 
                                            (format-spec-make
                                             ?s server
                                             ?p (number-to-string port)))))
--- 622,638 ----
        cmd done)
      (while (and (not done) (setq cmd (pop cmds)))
        (message "imap: Opening SSL connection with `%s'..." cmd)
+       (erase-buffer)
        (let* ((port (or port imap-default-ssl-port))
             (coding-system-for-read imap-coding-system-for-read)
             (coding-system-for-write imap-coding-system-for-write)
             (process-connection-type nil)
             process)
        (when (progn
!               (setq process (start-process
                               name buffer shell-file-name
                               shell-command-switch
!                              (format-spec cmd
                                            (format-spec-make
                                             ?s server
                                             ?p (number-to-string port)))))
***************
*** 590,596 ****
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
--- 648,654 ----
              (accept-process-output process 1)
              (sit-for 1))
            (and imap-log
!                (with-current-buffer (get-buffer-create imap-log-buffer)
                   (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
***************
*** 602,610 ****
        (progn
          (message "imap: Opening SSL connection with `%s'...done" cmd)
          done)
!         (message "imap: Opening SSL connection with `%s'...failed" cmd)
        nil)))
  
  (defun imap-network-p (buffer)
    t)
  
--- 660,693 ----
        (progn
          (message "imap: Opening SSL connection with `%s'...done" cmd)
          done)
!       (message "imap: Opening SSL connection with `%s'...failed" cmd)
        nil)))
  
+ (defun imap-tls-p (buffer)
+   nil)
+ 
+ (defun imap-tls-open (name buffer server port)
+   (let* ((port (or port imap-default-tls-port))
+        (coding-system-for-read imap-coding-system-for-read)
+        (coding-system-for-write imap-coding-system-for-write)
+        (process (open-tls-stream name buffer server port)))
+     (when process
+       (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+                 (goto-char (point-max))
+                 (forward-line -1)
+                 (not (imap-parse-greeting)))
+       (accept-process-output process 1)
+       (sit-for 1))
+       (and imap-log
+          (with-current-buffer (get-buffer-create imap-log-buffer)
+            (imap-disable-multibyte)
+            (buffer-disable-undo)
+            (goto-char (point-max))
+            (insert-buffer-substring buffer)))
+       (when (memq (process-status process) '(open run))
+       process))))
+ 
  (defun imap-network-p (buffer)
    t)
  
***************
*** 615,626 ****
         (process (open-network-stream name buffer server port)))
      (when process
        (while (and (memq (process-status process) '(open run))
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
        (and imap-log
!          (with-current-buffer (get-buffer-create imap-log)
             (imap-disable-multibyte)
             (buffer-disable-undo)
             (goto-char (point-max))
--- 698,710 ----
         (process (open-network-stream name buffer server port)))
      (when process
        (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
        (and imap-log
!          (with-current-buffer (get-buffer-create imap-log-buffer)
             (imap-disable-multibyte)
             (buffer-disable-undo)
             (goto-char (point-max))
***************
*** 632,638 ****
    nil)
  
  (defun imap-shell-open (name buffer server port)
!   (let ((cmds imap-shell-program)
        cmd done)
      (while (and (not done) (setq cmd (pop cmds)))
        (message "imap: Opening IMAP connection with `%s'..." cmd)
--- 716,723 ----
    nil)
  
  (defun imap-shell-open (name buffer server port)
!   (let ((cmds (if (listp imap-shell-program) imap-shell-program
!               (list imap-shell-program)))
        cmd done)
      (while (and (not done) (setq cmd (pop cmds)))
        (message "imap: Opening IMAP connection with `%s'..." cmd)
***************
*** 651,718 ****
                         ?l imap-default-user)))))
        (when process
          (while (and (memq (process-status process) '(open run))
!                     (goto-char (point-min))
                      (not (imap-parse-greeting)))
            (accept-process-output process 1)
            (sit-for 1))
-         (erase-buffer)
          (and imap-log
!              (with-current-buffer (get-buffer-create imap-log)
                 (imap-disable-multibyte)
                 (buffer-disable-undo)
                 (goto-char (point-max))
                 (insert-buffer-substring buffer)))
          (when (memq (process-status process) '(open run))
            (setq done process)))))
      (if done
        (progn
          (message "imap: Opening IMAP connection with `%s'...done" cmd)
          done)
!         (message "imap: Opening IMAP connection with `%s'...failed" cmd)
        nil)))
  
  (defun imap-starttls-p (buffer)
!   (and (imap-capability 'STARTTLS buffer)
!        (condition-case ()
!          (progn
!            (require 'starttls)
!            (call-process "starttls"))
!        (error nil))))
  
  (defun imap-starttls-open (name buffer server port)
    (let* ((port (or port imap-default-port))
         (coding-system-for-read imap-coding-system-for-read)
         (coding-system-for-write imap-coding-system-for-write)
         (process (starttls-open-stream name buffer server port))
!        done)
      (message "imap: Connecting with STARTTLS...")
      (when process
        (while (and (memq (process-status process) '(open run))
!                 (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
        (and imap-log
!          (with-current-buffer (get-buffer-create imap-log)
             (buffer-disable-undo)
             (goto-char (point-max))
             (insert-buffer-substring buffer)))
!       (let ((imap-process process))
!       (unwind-protect
!           (progn
!             (set-process-filter imap-process 'imap-arrival-filter)
!             (when (and (eq imap-stream 'starttls)
!                        (imap-ok-p (imap-send-command-wait "STARTTLS")))
!               (starttls-negotiate imap-process)))
!         (set-process-filter imap-process nil)))
!       (when (memq (process-status process) '(open run))
        (setq done process)))
!     (if done
!       (progn
!         (message "imap: Connecting with STARTTLS...done")
!         done)
!       (message "imap: Connecting with STARTTLS...failed")
!       nil)))
  
  ;; Server functions; authenticator stuff:
  
--- 736,801 ----
                         ?l imap-default-user)))))
        (when process
          (while (and (memq (process-status process) '(open run))
!                     (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
!                     (goto-char (point-max))
!                     (forward-line -1)
                      (not (imap-parse-greeting)))
            (accept-process-output process 1)
            (sit-for 1))
          (and imap-log
!              (with-current-buffer (get-buffer-create imap-log-buffer)
                 (imap-disable-multibyte)
                 (buffer-disable-undo)
                 (goto-char (point-max))
                 (insert-buffer-substring buffer)))
+         (erase-buffer)
          (when (memq (process-status process) '(open run))
            (setq done process)))))
      (if done
        (progn
          (message "imap: Opening IMAP connection with `%s'...done" cmd)
          done)
!       (message "imap: Opening IMAP connection with `%s'...failed" cmd)
        nil)))
  
  (defun imap-starttls-p (buffer)
!   (imap-capability 'STARTTLS buffer))
  
  (defun imap-starttls-open (name buffer server port)
    (let* ((port (or port imap-default-port))
         (coding-system-for-read imap-coding-system-for-read)
         (coding-system-for-write imap-coding-system-for-write)
         (process (starttls-open-stream name buffer server port))
!        done tls-info)
      (message "imap: Connecting with STARTTLS...")
      (when process
        (while (and (memq (process-status process) '(open run))
!                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
!                 (goto-char (point-max))
!                 (forward-line -1)
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
+       (imap-send-command "STARTTLS")
+       (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+                 (goto-char (point-max))
+                 (forward-line -1)
+                 (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
+       (accept-process-output process 1)
+       (sit-for 1))
        (and imap-log
!          (with-current-buffer (get-buffer-create imap-log-buffer)
             (buffer-disable-undo)
             (goto-char (point-max))
             (insert-buffer-substring buffer)))
!       (when (and (setq tls-info (starttls-negotiate process))
!                (memq (process-status process) '(open run)))
        (setq done process)))
!     (if (stringp tls-info)
!       (message "imap: STARTTLS info: %s" tls-info))
!     (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
!     done))
  
  ;; Server functions; authenticator stuff:
  
***************
*** 729,740 ****
        (while (or (not user) (not passwd))
        (setq user (or imap-username
                       (read-from-minibuffer
!                       (concat "IMAP username for " imap-server ": ")
                        (or user imap-default-user))))
        (setq passwd (or imap-password
!                        (imap-read-passwd
                          (concat "IMAP password for " user "@"
!                                 imap-server ": "))))
        (when (and user passwd)
          (if (funcall loginfunc user passwd)
              (progn
--- 812,826 ----
        (while (or (not user) (not passwd))
        (setq user (or imap-username
                       (read-from-minibuffer
!                       (concat "IMAP username for " imap-server
!                               " (using stream `" (symbol-name imap-stream)
!                               "'): ")
                        (or user imap-default-user))))
        (setq passwd (or imap-password
!                        (read-passwd
                          (concat "IMAP password for " user "@"
!                                 imap-server " (using authenticator `"
!                                 (symbol-name imap-auth) "'): "))))
        (when (and user passwd)
          (if (funcall loginfunc user passwd)
              (progn
***************
*** 745,750 ****
--- 831,837 ----
                    (setq imap-password passwd)))
            (message "Login failed...")
            (setq passwd nil)
+           (setq imap-password nil)
            (sit-for 1))))
        ;;      (quit (with-current-buffer buffer
        ;;              (setq user nil
***************
*** 755,761 ****
        ret)))
  
  (defun imap-gssapi-auth-p (buffer)
!   (imap-capability 'AUTH=GSSAPI buffer))
  
  (defun imap-gssapi-auth (buffer)
    (message "imap: Authenticating using GSSAPI...%s"
--- 842,848 ----
        ret)))
  
  (defun imap-gssapi-auth-p (buffer)
!   (eq imap-stream 'gssapi))
  
  (defun imap-gssapi-auth (buffer)
    (message "imap: Authenticating using GSSAPI...%s"
***************
*** 763,769 ****
    (eq imap-stream 'gssapi))
  
  (defun imap-kerberos4-auth-p (buffer)
!   (imap-capability 'AUTH=KERBEROS_V4 buffer))
  
  (defun imap-kerberos4-auth (buffer)
    (message "imap: Authenticating using Kerberos 4...%s"
--- 850,857 ----
    (eq imap-stream 'gssapi))
  
  (defun imap-kerberos4-auth-p (buffer)
!   (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
!        (eq imap-stream 'kerberos4)))
  
  (defun imap-kerberos4-auth (buffer)
    (message "imap: Authenticating using Kerberos 4...%s"
***************
*** 793,800 ****
        (message "imap: Authenticating using CRAM-MD5...done")
        (message "imap: Authenticating using CRAM-MD5...failed"))))
  
- 
- 
  (defun imap-login-p (buffer)
    (and (not (imap-capability 'LOGINDISABLED buffer))
         (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
--- 881,886 ----
***************
*** 898,943 ****
      (setq imap-auth (or auth imap-auth))
      (setq imap-stream (or stream imap-stream))
      (message "imap: Connecting to %s..." imap-server)
!     (if (let ((imap-stream (or imap-stream imap-default-stream)))
!         (imap-open-1 buffer))
!       ;; Choose stream.
!       (let (stream-changed)
!         (message "imap: Connecting to %s...done" imap-server)
!         (when (null imap-stream)
!           (let ((streams imap-streams))
!             (while (setq stream (pop streams))
!               (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
!                   (setq stream-changed (not (eq (or imap-stream
!                                                     imap-default-stream)
!                                                 stream))
!                         imap-stream stream
!                         streams nil)))
!             (unless imap-stream
!               (error "Couldn't figure out a stream for server"))))
!         (when stream-changed
!           (message "imap: Reconnecting with stream `%s'..." imap-stream)
!           (imap-close buffer)
!           (if (imap-open-1 buffer)
!               (message "imap: Reconnecting with stream `%s'...done"
!                        imap-stream)
!             (message "imap: Reconnecting with stream `%s'...failed"
!                      imap-stream))
!           (setq imap-capability nil))
!         (if (imap-opened buffer)
!             ;; Choose authenticator
!             (when (and (null imap-auth) (not (eq imap-state 'auth)))
!               (let ((auths imap-authenticators))
!                 (while (setq auth (pop auths))
!                   (if (funcall (nth 1 (assq auth imap-authenticator-alist))
!                                buffer)
!                       (setq imap-auth auth
!                             auths nil)))
!                 (unless imap-auth
!                   (error "Couldn't figure out authenticator for server"))))))
!       (message "imap: Connecting to %s...failed" imap-server))
!     (when (imap-opened buffer)
!       (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
!       buffer)))
  
  (defun imap-opened (&optional buffer)
    "Return non-nil if connection to imap server in BUFFER is open.
--- 984,1036 ----
      (setq imap-auth (or auth imap-auth))
      (setq imap-stream (or stream imap-stream))
      (message "imap: Connecting to %s..." imap-server)
!     (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
!               (imap-open-1 buffer)))
!       (progn
!         (message "imap: Connecting to %s...failed" imap-server)
!         nil)
!       (when (null imap-stream)
!       ;; Need to choose stream.
!       (let ((streams imap-streams))
!         (while (setq stream (pop streams))
!           ;; OK to use this stream?
!           (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
!             ;; Stream changed?
!             (if (not (eq imap-default-stream stream))
!                 (with-current-buffer (get-buffer-create
!                                       (generate-new-buffer-name " *temp*"))
!                   (mapcar 'make-local-variable imap-local-variables)
!                   (imap-disable-multibyte)
!                   (buffer-disable-undo)
!                   (setq imap-server (or server imap-server))
!                   (setq imap-port (or port imap-port))
!                   (setq imap-auth (or auth imap-auth))
!                   (message "imap: Reconnecting with stream `%s'..." stream)
!                   (if (null (let ((imap-stream stream))
!                               (imap-open-1 (current-buffer))))
!                       (progn
!                         (kill-buffer (current-buffer))
!                         (message
!                          "imap: Reconnecting with stream `%s'...failed"
!                          stream))
!                     ;; We're done, kill the first connection
!                     (imap-close buffer)
!                     (kill-buffer buffer)
!                     (rename-buffer buffer)
!                     (message "imap: Reconnecting with stream `%s'...done"
!                              stream)
!                     (setq imap-stream stream)
!                     (setq imap-capability nil)
!                     (setq streams nil)))
!               ;; We're done
!               (message "imap: Connecting to %s...done" imap-server)
!               (setq imap-stream stream)
!               (setq imap-capability nil)
!               (setq streams nil))))))
!       (when (imap-opened buffer)
!       (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
!       (when imap-stream
!       buffer))))
  
  (defun imap-opened (&optional buffer)
    "Return non-nil if connection to imap server in BUFFER is open.
***************
*** 964,979 ****
        (make-local-variable 'imap-password)
        (if user (setq imap-username user))
        (if passwd (setq imap-password passwd))
!       (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)
!         (setq imap-state 'auth)))))
  
  (defun imap-close (&optional buffer)
    "Close connection to server in BUFFER.
  If BUFFER is nil, the current buffer is used."
    (with-current-buffer (or buffer (current-buffer))
!     (and (imap-opened)
!        (not (imap-ok-p (imap-send-command-wait "LOGOUT")))
!        (message "Server %s didn't let me log out" imap-server))
      (when (and imap-process
               (memq (process-status imap-process) '(open run)))
        (delete-process imap-process))
--- 1057,1092 ----
        (make-local-variable 'imap-password)
        (if user (setq imap-username user))
        (if passwd (setq imap-password passwd))
!       (if imap-auth
!         (and (funcall (nth 2 (assq imap-auth
!                                    imap-authenticator-alist)) buffer)
!              (setq imap-state 'auth))
!       ;; Choose authenticator.
!       (let ((auths imap-authenticators)
!             auth)
!         (while (setq auth (pop auths))
!           ;; OK to use authenticator?
!           (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
!             (message "imap: Authenticating to `%s' using `%s'..."
!                      imap-server auth)
!             (setq imap-auth auth)
!             (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
!                 (progn
!                   (message "imap: Authenticating to `%s' using `%s'...done"
!                            imap-server auth)
!                   (setq auths nil))
!               (message "imap: Authenticating to `%s' using `%s'...failed"
!                        imap-server auth)))))
!       imap-state))))
  
  (defun imap-close (&optional buffer)
    "Close connection to server in BUFFER.
  If BUFFER is nil, the current buffer is used."
    (with-current-buffer (or buffer (current-buffer))
!     (when (imap-opened)
!       (condition-case nil
!         (imap-send-command-wait "LOGOUT")
!       (quit nil)))
      (when (and imap-process
               (memq (process-status imap-process) '(open run)))
        (delete-process imap-process))
***************
*** 1105,1126 ****
            imap-state 'auth)
        t)))
  
! (defun imap-mailbox-expunge (&optional buffer)
    "Expunge articles in current folder in BUFFER.
  If BUFFER is nil the current buffer is assumed."
    (with-current-buffer (or buffer (current-buffer))
      (when (and imap-current-mailbox (not (eq imap-state 'examine)))
!       (imap-ok-p (imap-send-command-wait "EXPUNGE")))))
  
! (defun imap-mailbox-close (&optional buffer)
    "Expunge articles and close current folder in BUFFER.
  If BUFFER is nil the current buffer is assumed."
    (with-current-buffer (or buffer (current-buffer))
!     (when (and imap-current-mailbox
!              (imap-ok-p (imap-send-command-wait "CLOSE")))
!       (setq imap-current-mailbox nil
!           imap-message-data nil
!           imap-state 'auth)
        t)))
  
  (defun imap-mailbox-create-1 (mailbox)
--- 1218,1255 ----
            imap-state 'auth)
        t)))
  
! (defun imap-mailbox-expunge (&optional asynch buffer)
    "Expunge articles in current folder in BUFFER.
+ If ASYNCH, do not wait for succesful completion of the command.
  If BUFFER is nil the current buffer is assumed."
    (with-current-buffer (or buffer (current-buffer))
      (when (and imap-current-mailbox (not (eq imap-state 'examine)))
!       (if asynch
!         (imap-send-command "EXPUNGE")
!       (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
  
! (defun imap-mailbox-close (&optional asynch buffer)
    "Expunge articles and close current folder in BUFFER.
+ If ASYNCH, do not wait for succesful completion of the command.
  If BUFFER is nil the current buffer is assumed."
    (with-current-buffer (or buffer (current-buffer))
!     (when imap-current-mailbox
!       (if asynch
!         (imap-add-callback (imap-send-command "CLOSE")
!                            `(lambda (tag status)
!                               (message "IMAP mailbox `%s' closed... %s"
!                                        imap-current-mailbox status)
!                               (when (eq ,imap-current-mailbox
!                                         imap-current-mailbox)
!                                 ;; Don't wipe out data if another mailbox
!                                 ;; was selected...
!                                 (setq imap-current-mailbox nil
!                                       imap-message-data nil
!                                       imap-state 'auth))))
!       (when (imap-ok-p (imap-send-command-wait "CLOSE"))
!         (setq imap-current-mailbox nil
!               imap-message-data nil
!               imap-state 'auth)))
        t)))
  
  (defun imap-mailbox-create-1 (mailbox)
***************
*** 1225,1240 ****
           (imap-send-command-wait (list "STATUS \""
                                         (imap-utf7-encode mailbox)
                                         "\" "
!                                        (format "%s"
!                                                (if (listp items)
!                                                    items
!                                                  (list items))))))
        (if (listp items)
          (mapcar (lambda (item)
                    (imap-mailbox-get item mailbox))
                  items)
        (imap-mailbox-get items mailbox)))))
  
  (defun imap-mailbox-acl-get (&optional mailbox buffer)
    "Get ACL on mailbox from server in BUFFER."
    (let ((mailbox (imap-utf7-encode mailbox)))
--- 1354,1384 ----
           (imap-send-command-wait (list "STATUS \""
                                         (imap-utf7-encode mailbox)
                                         "\" "
!                                        (upcase
!                                         (format "%s"
!                                                 (if (listp items)
!                                                     items
!                                                   (list items)))))))
        (if (listp items)
          (mapcar (lambda (item)
                    (imap-mailbox-get item mailbox))
                  items)
        (imap-mailbox-get items mailbox)))))
  
+ (defun imap-mailbox-status-asynch (mailbox items &optional buffer)
+   "Send status item request ITEM on MAILBOX to server in BUFFER.
+ ITEMS can be a symbol or a list of symbols, valid symbols are one of
+ the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
+ or 'unseen.  The IMAP command tag is returned."
+   (with-current-buffer (or buffer (current-buffer))
+     (imap-send-command (list "STATUS \""
+                            (imap-utf7-encode mailbox)
+                            "\" "
+                            (format "%s"
+                                    (if (listp items)
+                                        items
+                                      (list items)))))))
+ 
  (defun imap-mailbox-acl-get (&optional mailbox buffer)
    "Get ACL on mailbox from server in BUFFER."
    (let ((mailbox (imap-utf7-encode mailbox)))
***************
*** 1286,1293 ****
    (mapconcat
     (lambda (item)
       (if (consp item)
!          (format "%d:%d"
!                  (car item) (cdr item))
         (format "%d" item)))
     (if (and (listp range) (not (listp (cdr range))))
         (list range) ;; make (1 . 2) into ((1 . 2))
--- 1430,1437 ----
    (mapconcat
     (lambda (item)
       (if (consp item)
!        (format "%d:%d"
!                (car item) (cdr item))
         (format "%d" item)))
     (if (and (listp range) (not (listp (cdr range))))
         (list range) ;; make (1 . 2) into ((1 . 2))
***************
*** 1398,1404 ****
      (imap-mailbox-put 'search 'dummy)
      (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " 
predicate)))
        (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
!         (error "Missing SEARCH response to a SEARCH command")
        (imap-mailbox-get-1 'search imap-current-mailbox)))))
  
  (defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
--- 1542,1550 ----
      (imap-mailbox-put 'search 'dummy)
      (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " 
predicate)))
        (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
!         (progn
!           (message "Missing SEARCH response to a SEARCH command (server not 
RFC compliant)...")
!           nil)
        (imap-mailbox-get-1 'search imap-current-mailbox)))))
  
  (defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
***************
*** 1464,1471 ****
              (if (imap-ok-p (imap-send-command-wait cmd))
                  t
                (when (and (not dont-create)
!                          (imap-mailbox-get-1 'trycreate mailbox))
!                 (imap-mailbox-create-1 mailbox)
                  (imap-ok-p (imap-send-command-wait cmd)))))
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
--- 1610,1620 ----
              (if (imap-ok-p (imap-send-command-wait cmd))
                  t
                (when (and (not dont-create)
!                          ;; removed because of buggy Oracle server
!                          ;; that doesn't send TRYCREATE tags (which
!                          ;; is a MUST according to specifications):
!                          ;;(imap-mailbox-get-1 'trycreate mailbox)
!                          (imap-mailbox-create-1 mailbox))
                  (imap-ok-p (imap-send-command-wait cmd)))))
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
***************
*** 1530,1539 ****
  
  ;; Internal functions.
  
  (defun imap-send-command-1 (cmdstr)
    (setq cmdstr (concat cmdstr imap-client-eol))
    (and imap-log
!        (with-current-buffer (get-buffer-create imap-log)
         (imap-disable-multibyte)
         (buffer-disable-undo)
         (goto-char (point-max))
--- 1679,1691 ----
  
  ;; Internal functions.
  
+ (defun imap-add-callback (tag func)
+   (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
+ 
  (defun imap-send-command-1 (cmdstr)
    (setq cmdstr (concat cmdstr imap-client-eol))
    (and imap-log
!        (with-current-buffer (get-buffer-create imap-log-buffer)
         (imap-disable-multibyte)
         (buffer-disable-undo)
         (goto-char (point-max))
***************
*** 1570,1583 ****
                     (imap-send-command-1 cmdstr)
                     (setq cmdstr nil)
                     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
!                        (setq command nil);; abort command if no cont-req
                       (let ((process imap-process)
                             (stream imap-stream)
                             (eol imap-client-eol))
                         (with-current-buffer cmd
                           (and imap-log
                                (with-current-buffer (get-buffer-create
!                                                     imap-log)
                                  (imap-disable-multibyte)
                                  (buffer-disable-undo)
                                  (goto-char (point-max))
--- 1722,1735 ----
                     (imap-send-command-1 cmdstr)
                     (setq cmdstr nil)
                     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
!                        (setq command nil) ;; abort command if no cont-req
                       (let ((process imap-process)
                             (stream imap-stream)
                             (eol imap-client-eol))
                         (with-current-buffer cmd
                           (and imap-log
                                (with-current-buffer (get-buffer-create
!                                                     imap-log-buffer)
                                  (imap-disable-multibyte)
                                  (buffer-disable-undo)
                                  (goto-char (point-max))
***************
*** 1591,1597 ****
               (setq cmdstr nil)
               (unwind-protect
                   (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
!                      (setq command nil);; abort command if no cont-req
                     (setq command (cons (funcall cmd imap-continuation)
                                         command)))
                 (setq imap-continuation nil)))
--- 1743,1749 ----
               (setq cmdstr nil)
               (unwind-protect
                   (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
!                      (setq command nil) ;; abort command if no cont-req
                     (setq command (cons (funcall cmd imap-continuation)
                                         command)))
                 (setq imap-continuation nil)))
***************
*** 1603,1617 ****
  
  (defun imap-wait-for-tag (tag &optional buffer)
    (with-current-buffer (or buffer (current-buffer))
!     (while (and (null imap-continuation)
!               (< imap-reached-tag tag))
!       (or (and (not (memq (process-status imap-process) '(open run)))
!              (sit-for 1))
!         (accept-process-output imap-process 1)))
!     (or (assq tag imap-failed-tags)
!       (if imap-continuation
!           'INCOMPLETE
!         'OK))))
  
  (defun imap-sentinel (process string)
    (delete-process process))
--- 1755,1788 ----
  
  (defun imap-wait-for-tag (tag &optional buffer)
    (with-current-buffer (or buffer (current-buffer))
!     (let (imap-have-messaged)
!       (while (and (null imap-continuation)
!                 (memq (process-status imap-process) '(open run))
!                 (< imap-reached-tag tag))
!       (let ((len (/ (point-max) 1024))
!             message-log-max)
!         (unless (< len 10)
!           (setq imap-have-messaged t)
!           (message "imap read: %dk" len))
!         (accept-process-output imap-process
!                                (truncate imap-read-timeout)
!                                (truncate (* (- imap-read-timeout
!                                                (truncate imap-read-timeout))
!                                             1000)))))
!       ;; A process can die _before_ we have processed everything it
!       ;; has to say.  Moreover, this can happen in between the call to
!       ;; accept-process-output and the call to process-status in an
!       ;; iteration of the loop above.
!       (when (and (null imap-continuation)
!                (< imap-reached-tag tag))
!       (accept-process-output imap-process 0 0))
!       (when imap-have-messaged
!       (message ""))
!       (and (memq (process-status imap-process) '(open run))
!          (or (assq tag imap-failed-tags)
!              (if imap-continuation
!                  'INCOMPLETE
!                'OK))))))
  
  (defun imap-sentinel (process string)
    (delete-process process))
***************
*** 1631,1664 ****
  
  (defun imap-arrival-filter (proc string)
    "IMAP process filter."
!   (with-current-buffer (process-buffer proc)
!     (goto-char (point-max))
!     (insert string)
!     (and imap-log
!        (with-current-buffer (get-buffer-create imap-log)
!          (imap-disable-multibyte)
!          (buffer-disable-undo)
!          (goto-char (point-max))
!          (insert string)))
!     (let (end)
!       (goto-char (point-min))
!       (while (setq end (imap-find-next-line))
!       (save-restriction
!         (narrow-to-region (point-min) end)
!         (delete-backward-char (length imap-server-eol))
!         (goto-char (point-min))
!         (unwind-protect
!             (cond ((eq imap-state 'initial)
!                    (imap-parse-greeting))
!                   ((or (eq imap-state 'auth)
!                        (eq imap-state 'nonauth)
!                        (eq imap-state 'selected)
!                        (eq imap-state 'examine))
!                    (imap-parse-response))
!                   (t
!                    (message "Unknown state %s in arrival filter"
!                             imap-state)))
!           (delete-region (point-min) (point-max))))))))
  
  
  ;; Imap parser.
--- 1802,1838 ----
  
  (defun imap-arrival-filter (proc string)
    "IMAP process filter."
!   ;; Sometimes, we are called even though the process has died.
!   ;; Better abstain from doing stuff in that case.
!   (when (buffer-name (process-buffer proc))
!     (with-current-buffer (process-buffer proc)
!       (goto-char (point-max))
!       (insert string)
!       (and imap-log
!          (with-current-buffer (get-buffer-create imap-log-buffer)
!            (imap-disable-multibyte)
!            (buffer-disable-undo)
!            (goto-char (point-max))
!            (insert string)))
!       (let (end)
!       (goto-char (point-min))
!       (while (setq end (imap-find-next-line))
!         (save-restriction
!           (narrow-to-region (point-min) end)
!           (delete-backward-char (length imap-server-eol))
!           (goto-char (point-min))
!           (unwind-protect
!               (cond ((eq imap-state 'initial)
!                      (imap-parse-greeting))
!                     ((or (eq imap-state 'auth)
!                          (eq imap-state 'nonauth)
!                          (eq imap-state 'selected)
!                          (eq imap-state 'examine))
!                      (imap-parse-response))
!                     (t
!                      (message "Unknown state %s in arrival filter"
!                               imap-state)))
!             (delete-region (point-min) (point-max)))))))))
  
  
  ;; Imap parser.
***************
*** 1803,1809 ****
        (when (eq (char-after) ?\))
          (imap-forward)
          (nreverse addresses)))
!     ;; (assert (imap-parse-nil)) ; With assert, the code might not be eval'd.
      (imap-parse-nil)))
  
  ;;   mailbox         = "INBOX" / astring
--- 1977,1984 ----
        (when (eq (char-after) ?\))
          (imap-forward)
          (nreverse addresses)))
!     ;; With assert, the code might not be eval'd.
!     ;; (assert (imap-parse-nil) t "In imap-parse-address-list")
      (imap-parse-nil)))
  
  ;;   mailbox         = "INBOX" / astring
***************
*** 1857,1863 ****
  ;;   resp-cond-bye   = "BYE" SP resp-text
  ;;
  ;;   mailbox-data    =  "FLAGS" SP flag-list /
! ;;                    "LIST" SP mailbox-list /
  ;;                      "LSUB" SP mailbox-list /
  ;;                    "SEARCH" *(SP nz-number) /
  ;;                      "STATUS" SP mailbox SP "("
--- 2032,2038 ----
  ;;   resp-cond-bye   = "BYE" SP resp-text
  ;;
  ;;   mailbox-data    =  "FLAGS" SP flag-list /
! ;;                    "LIST" SP mailbox-list /
  ;;                      "LSUB" SP mailbox-list /
  ;;                    "SEARCH" *(SP nz-number) /
  ;;                      "STATUS" SP mailbox SP "("
***************
*** 1895,1903 ****
                        (read (concat "(" (buffer-substring (point) 
(point-max)) ")"))))
           (STATUS     (imap-parse-status))
           (CAPABILITY (setq imap-capability
!                            (read (concat "(" (upcase (buffer-substring
!                                                       (point) (point-max)))
!                                          ")"))))
           (ACL        (imap-parse-acl))
           (t       (case (prog1 (read (current-buffer))
                            (imap-forward))
--- 2070,2078 ----
                        (read (concat "(" (buffer-substring (point) 
(point-max)) ")"))))
           (STATUS     (imap-parse-status))
           (CAPABILITY (setq imap-capability
!                              (read (concat "(" (upcase (buffer-substring
!                                                         (point) (point-max)))
!                                            ")"))))
           (ACL        (imap-parse-acl))
           (t       (case (prog1 (read (current-buffer))
                            (imap-forward))
***************
*** 1939,1945 ****
                        (push (list token status code text) imap-failed-tags)
                        (error "Internal error, tag %s status %s code %s text 
%s"
                               token status code text))))
!              (t   (message "Garbage: %s" (buffer-string))))))))))
  
  ;;   resp-text       = ["[" resp-text-code "]" SP] text
  ;;
--- 2114,2124 ----
                        (push (list token status code text) imap-failed-tags)
                        (error "Internal error, tag %s status %s code %s text 
%s"
                               token status code text))))
!              (t   (message "Garbage: %s" (buffer-string))))
!            (when (assq token imap-callbacks)
!              (funcall (cdr (assq token imap-callbacks)) token status)
!              (setq imap-callbacks
!                    (imap-remassoc token imap-callbacks)))))))))
  
  ;;   resp-text       = ["[" resp-text-code "]" SP] text
  ;;
***************
*** 1958,1964 ****
  ;;                               [flag-perm *(SP flag-perm)] ")" /
  ;;                     "READ-ONLY" /
  ;;                   "READ-WRITE" /
! ;;                   "TRYCREATE" /
  ;;                     "UIDNEXT" SP nz-number /
  ;;                   "UIDVALIDITY" SP nz-number /
  ;;                     "UNSEEN" SP nz-number /
--- 2137,2143 ----
  ;;                               [flag-perm *(SP flag-perm)] ")" /
  ;;                     "READ-ONLY" /
  ;;                   "READ-WRITE" /
! ;;                   "TRYCREATE" /
  ;;                     "UIDNEXT" SP nz-number /
  ;;                   "UIDVALIDITY" SP nz-number /
  ;;                     "UNSEEN" SP nz-number /
***************
*** 2005,2018 ****
  ;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
  
  (defun imap-parse-resp-text-code ()
    (when (eq (char-after) ?\[)
      (imap-forward)
      (cond ((search-forward "PERMANENTFLAGS " nil t)
           (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
!         ((search-forward "UIDNEXT " nil t)
!          (imap-mailbox-put 'uidnext (read (current-buffer))))
          ((search-forward "UNSEEN " nil t)
!          (imap-mailbox-put 'unseen (read (current-buffer))))
          ((looking-at "UIDVALIDITY \\([0-9]+\\)")
           (imap-mailbox-put 'uidvalidity (match-string 1)))
          ((search-forward "READ-ONLY" nil t)
--- 2184,2200 ----
  ;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
  
  (defun imap-parse-resp-text-code ()
+   ;; xxx next line for stalker communigate pro 3.3.1 bug
+   (when (looking-at " \\[")
+     (imap-forward))
    (when (eq (char-after) ?\[)
      (imap-forward)
      (cond ((search-forward "PERMANENTFLAGS " nil t)
           (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
!         ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
!          (imap-mailbox-put 'uidnext (match-string 1)))
          ((search-forward "UNSEEN " nil t)
!          (imap-mailbox-put 'first-unseen (read (current-buffer))))
          ((looking-at "UIDVALIDITY \\([0-9]+\\)")
           (imap-mailbox-put 'uidvalidity (match-string 1)))
          ((search-forward "READ-ONLY" nil t)
***************
*** 2111,2125 ****
  (defun imap-parse-fetch (response)
    (when (eq (char-after) ?\()
      (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
!             rfc822size body bodydetail bodystructure)
        (while (not (eq (char-after) ?\)))
        (imap-forward)
        (let ((token (read (current-buffer))))
          (imap-forward)
          (cond ((eq token 'UID)
!                (setq uid (ignore-errors (read (current-buffer)))))
                ((eq token 'FLAGS)
!                (setq flags (imap-parse-flag-list)))
                ((eq token 'ENVELOPE)
                 (setq envelope (imap-parse-envelope)))
                ((eq token 'INTERNALDATE)
--- 2293,2311 ----
  (defun imap-parse-fetch (response)
    (when (eq (char-after) ?\()
      (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
!             rfc822size body bodydetail bodystructure flags-empty)
        (while (not (eq (char-after) ?\)))
        (imap-forward)
        (let ((token (read (current-buffer))))
          (imap-forward)
          (cond ((eq token 'UID)
!                (setq uid (condition-case ()
!                              (read (current-buffer))
!                            (error))))
                ((eq token 'FLAGS)
!                (setq flags (imap-parse-flag-list))
!                (if (not flags)
!                    (setq flags-empty 't)))
                ((eq token 'ENVELOPE)
                 (setq envelope (imap-parse-envelope)))
                ((eq token 'INTERNALDATE)
***************
*** 2148,2154 ****
        (when uid
        (setq imap-current-message uid)
        (imap-message-put uid 'UID uid)
!       (and flags (imap-message-put uid 'FLAGS flags))
        (and envelope (imap-message-put uid 'ENVELOPE envelope))
        (and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
        (and rfc822 (imap-message-put uid 'RFC822 rfc822))
--- 2334,2340 ----
        (when uid
        (setq imap-current-message uid)
        (imap-message-put uid 'UID uid)
!       (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
        (and envelope (imap-message-put uid 'ENVELOPE envelope))
        (and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
        (and rfc822 (imap-message-put uid 'RFC822 rfc822))
***************
*** 2171,2194 ****
  
  (defun imap-parse-status ()
    (let ((mailbox (imap-parse-mailbox)))
!     (when (and mailbox (search-forward "(" nil t))
!       (while (not (eq (char-after) ?\)))
!       (let ((token (read (current-buffer))))
!         (cond ((eq token 'MESSAGES)
                 (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
!               ((eq token 'RECENT)
                 (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
!               ((eq token 'UIDNEXT)
!                (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox))
!               ((eq token 'UIDVALIDITY)
!                (and (looking-at " \\([0-9]+\\)")
!                     (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
!                     (goto-char (match-end 1))))
!               ((eq token 'UNSEEN)
                 (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
                (t
                 (message "Unknown status data %s in mailbox %s ignored"
!                         token mailbox))))))))
  
  ;;   acl_data        ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
  ;;                        rights)
--- 2357,2388 ----
  
  (defun imap-parse-status ()
    (let ((mailbox (imap-parse-mailbox)))
!     (if (eq (char-after) ? )
!       (forward-char))
!     (when (and mailbox (eq (char-after) ?\())
!       (while (and (not (eq (char-after) ?\)))
!                 (or (forward-char) t)
!                 (looking-at "\\([A-Za-z]+\\) "))
!       (let ((token (match-string 1)))
!         (goto-char (match-end 0))
!         (cond ((string= token "MESSAGES")
                 (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
!               ((string= token "RECENT")
                 (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
!               ((string= token "UIDNEXT")
!                (and (looking-at "[0-9]+")
!                     (imap-mailbox-put 'uidnext (match-string 0) mailbox)
!                     (goto-char (match-end 0))))
!               ((string= token "UIDVALIDITY")
!                (and (looking-at "[0-9]+")
!                     (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
!                     (goto-char (match-end 0))))
!               ((string= token "UNSEEN")
                 (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
                (t
                 (message "Unknown status data %s in mailbox %s ignored"
!                         token mailbox)
!                (read (current-buffer)))))))))
  
  ;;   acl_data        ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
  ;;                        rights)
***************
*** 2226,2237 ****
  
  (defun imap-parse-flag-list ()
    (let (flag-list start)
!     (assert (eq (char-after) ?\())
      (while (and (not (eq (char-after) ?\)))
!               (setq start (progn (imap-forward) (point)))
                (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
        (push (buffer-substring start (point)) flag-list))
!     (assert (eq (char-after) ?\)))
      (imap-forward)
      (nreverse flag-list)))
  
--- 2420,2435 ----
  
  (defun imap-parse-flag-list ()
    (let (flag-list start)
!     (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
      (while (and (not (eq (char-after) ?\)))
!               (setq start (progn
!                             (imap-forward)
!                             ;; next line for Courier IMAP bug.
!                             (skip-chars-forward " ")
!                             (point)))
                (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
        (push (buffer-substring start (point)) flag-list))
!     (assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
      (imap-forward)
      (nreverse flag-list)))
  
***************
*** 2262,2292 ****
  (defun imap-parse-envelope ()
    (when (eq (char-after) ?\()
      (imap-forward)
!     (vector (prog1 (imap-parse-nstring);; date
              (imap-forward))
!           (prog1 (imap-parse-nstring);; subject
              (imap-forward))
!           (prog1 (imap-parse-address-list);; from
              (imap-forward))
!           (prog1 (imap-parse-address-list);; sender
              (imap-forward))
!           (prog1 (imap-parse-address-list);; reply-to
              (imap-forward))
!           (prog1 (imap-parse-address-list);; to
              (imap-forward))
!           (prog1 (imap-parse-address-list);; cc
              (imap-forward))
!           (prog1 (imap-parse-address-list);; bcc
              (imap-forward))
!           (prog1 (imap-parse-nstring);; in-reply-to
              (imap-forward))
!           (prog1 (imap-parse-nstring);; message-id
              (imap-forward)))))
  
  ;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
  
  (defsubst imap-parse-string-list ()
!   (cond ((eq (char-after) ?\();; body-fld-param
         (let (strlist str)
           (imap-forward)
           (while (setq str (imap-parse-string))
--- 2460,2490 ----
  (defun imap-parse-envelope ()
    (when (eq (char-after) ?\()
      (imap-forward)
!     (vector (prog1 (imap-parse-nstring)       ;; date
              (imap-forward))
!           (prog1 (imap-parse-nstring) ;; subject
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; from
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; sender
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; reply-to
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; to
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; cc
              (imap-forward))
!           (prog1 (imap-parse-address-list) ;; bcc
              (imap-forward))
!           (prog1 (imap-parse-nstring) ;; in-reply-to
              (imap-forward))
!           (prog1 (imap-parse-nstring) ;; message-id
              (imap-forward)))))
  
  ;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
  
  (defsubst imap-parse-string-list ()
!   (cond ((eq (char-after) ?\() ;; body-fld-param
         (let (strlist str)
           (imap-forward)
           (while (setq str (imap-parse-string))
***************
*** 2316,2322 ****
        (while (eq (char-after) ?\ )
          (imap-forward)
          (push (imap-parse-body-extension) b-e))
!       (assert (eq (char-after) ?\)))
        (imap-forward)
        (nreverse b-e))
      (or (imap-parse-number)
--- 2514,2520 ----
        (while (eq (char-after) ?\ )
          (imap-forward)
          (push (imap-parse-body-extension) b-e))
!       (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
        (imap-forward)
        (nreverse b-e))
      (or (imap-parse-number)
***************
*** 2334,2340 ****
  
  (defsubst imap-parse-body-ext ()
    (let (ext)
!     (when (eq (char-after) ?\ );; body-fld-dsp
        (imap-forward)
        (let (dsp)
        (if (eq (char-after) ?\()
--- 2532,2538 ----
  
  (defsubst imap-parse-body-ext ()
    (let (ext)
!     (when (eq (char-after) ?\ )       ;; body-fld-dsp
        (imap-forward)
        (let (dsp)
        (if (eq (char-after) ?\()
***************
*** 2344,2358 ****
              (imap-forward)
              (push (imap-parse-string-list) dsp)
              (imap-forward))
!         ;; (assert (imap-parse-nil)) ; Code in assert might not be eval'd.
          (imap-parse-nil))
        (push (nreverse dsp) ext))
!       (when (eq (char-after) ?\ );; body-fld-lang
        (imap-forward)
        (if (eq (char-after) ?\()
            (push (imap-parse-string-list) ext)
          (push (imap-parse-nstring) ext))
!       (while (eq (char-after) ?\ );; body-extension
          (imap-forward)
          (setq ext (append (imap-parse-body-extension) ext)))))
      ext))
--- 2542,2557 ----
              (imap-forward)
              (push (imap-parse-string-list) dsp)
              (imap-forward))
!         ;; With assert, the code might not be eval'd.
!         ;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
          (imap-parse-nil))
        (push (nreverse dsp) ext))
!       (when (eq (char-after) ?\ ) ;; body-fld-lang
        (imap-forward)
        (if (eq (char-after) ?\()
            (push (imap-parse-string-list) ext)
          (push (imap-parse-nstring) ext))
!       (while (eq (char-after) ?\ ) ;; body-extension
          (imap-forward)
          (setq ext (append (imap-parse-body-extension) ext)))))
      ext))
***************
*** 2426,2516 ****
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))
!             ;; buggy stalker communigate pro 3.0 insert a SPC between
              ;; parts in multiparts
              (when (and (eq (char-after) ?\ )
                         (eq (char-after (1+ (point))) ?\())
                (imap-forward))
              (push subbody body))
            (imap-forward)
!           (push (imap-parse-string) body);; media-subtype
!           (when (eq (char-after) ?\ );; body-ext-mpart:
              (imap-forward)
!             (if (eq (char-after) ?\();; body-fld-param
                  (push (imap-parse-string-list) body)
                (push (and (imap-parse-nil) nil) body))
              (setq body
!                   (append (imap-parse-body-ext) body)));; body-ext-...
!           (assert (eq (char-after) ?\)))
            (imap-forward)
            (nreverse body))
  
!       (push (imap-parse-string) body);; media-type
        (imap-forward)
!       (push (imap-parse-string) body);; media-subtype
        (imap-forward)
        ;; next line for Sun SIMS bug
        (and (eq (char-after) ? ) (imap-forward))
!       (if (eq (char-after) ?\();; body-fld-param
            (push (imap-parse-string-list) body)
          (push (and (imap-parse-nil) nil) body))
        (imap-forward)
!       (push (imap-parse-nstring) body);; body-fld-id
        (imap-forward)
!       (push (imap-parse-nstring) body);; body-fld-desc
        (imap-forward)
        ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
        ;; nstring and return nil instead of defaulting back to 7BIT
        ;; as the standard says.
!       (push (or (imap-parse-nstring) "7BIT") body);; body-fld-enc
        (imap-forward)
!       (push (imap-parse-number) body);; body-fld-octets
  
!       ;; ok, we're done parsing the required parts, what comes now is one
        ;; of three things:
        ;;
        ;; envelope       (then we're parsing body-type-msg)
        ;; body-fld-lines (then we're parsing body-type-text)
        ;; body-ext-1part (then we're parsing body-type-basic)
        ;;
!       ;; the problem is that the two first are in turn optionally followed
!       ;; by the third.  So we parse the first two here (if there are any)...
  
        (when (eq (char-after) ?\ )
          (imap-forward)
          (let (lines)
!           (cond ((eq (char-after) ?\();; body-type-msg:
!                  (push (imap-parse-envelope) body);; envelope
                   (imap-forward)
!                  (push (imap-parse-body) body);; body
                   ;; buggy stalker communigate pro 3.0 doesn't print
                   ;; number of lines in message/rfc822 attachment
                   (if (eq (char-after) ?\))
                       (push 0 body)
                     (imap-forward)
                     (push (imap-parse-number) body))) ;; body-fld-lines
!                 ((setq lines (imap-parse-number))    ;; body-type-text:
!                  (push lines body))                  ;; body-fld-lines
                  (t
!                  (backward-char)))))                 ;; no match...
  
        ;; ...and then parse the third one here...
  
!       (when (eq (char-after) ?\ );; body-ext-1part:
          (imap-forward)
!         (push (imap-parse-nstring) body);; body-fld-md5
!         (setq body (append (imap-parse-body-ext) body)));; body-ext-1part..
  
!       (assert (eq (char-after) ?\)))
        (imap-forward)
        (nreverse body)))))
  
  (when imap-debug                      ; (untrace-all)
    (require 'trace)
!   (buffer-disable-undo (get-buffer-create imap-debug))
!   (mapcar (lambda (f) (trace-function-background f imap-debug))
          '(
-           imap-read-passwd
            imap-utf7-encode
            imap-utf7-decode
            imap-error-text
--- 2625,2714 ----
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))
!            ;; buggy stalker communigate pro 3.0 insert a SPC between
              ;; parts in multiparts
              (when (and (eq (char-after) ?\ )
                         (eq (char-after (1+ (point))) ?\())
                (imap-forward))
              (push subbody body))
            (imap-forward)
!           (push (imap-parse-string) body) ;; media-subtype
!           (when (eq (char-after) ?\ ) ;; body-ext-mpart:
              (imap-forward)
!             (if (eq (char-after) ?\() ;; body-fld-param
                  (push (imap-parse-string-list) body)
                (push (and (imap-parse-nil) nil) body))
              (setq body
!                   (append (imap-parse-body-ext) body))) ;; body-ext-...
!           (assert (eq (char-after) ?\)) t "In imap-parse-body")
            (imap-forward)
            (nreverse body))
  
!       (push (imap-parse-string) body) ;; media-type
        (imap-forward)
!       (push (imap-parse-string) body) ;; media-subtype
        (imap-forward)
        ;; next line for Sun SIMS bug
        (and (eq (char-after) ? ) (imap-forward))
!       (if (eq (char-after) ?\() ;; body-fld-param
            (push (imap-parse-string-list) body)
          (push (and (imap-parse-nil) nil) body))
        (imap-forward)
!       (push (imap-parse-nstring) body) ;; body-fld-id
        (imap-forward)
!       (push (imap-parse-nstring) body) ;; body-fld-desc
        (imap-forward)
        ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
        ;; nstring and return nil instead of defaulting back to 7BIT
        ;; as the standard says.
!       (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
        (imap-forward)
!       (push (imap-parse-number) body) ;; body-fld-octets
  
!    ;; ok, we're done parsing the required parts, what comes now is one
        ;; of three things:
        ;;
        ;; envelope       (then we're parsing body-type-msg)
        ;; body-fld-lines (then we're parsing body-type-text)
        ;; body-ext-1part (then we're parsing body-type-basic)
        ;;
!   ;; the problem is that the two first are in turn optionally followed
! ;; by the third.  So we parse the first two here (if there are any)...
  
        (when (eq (char-after) ?\ )
          (imap-forward)
          (let (lines)
!           (cond ((eq (char-after) ?\() ;; body-type-msg:
!                  (push (imap-parse-envelope) body) ;; envelope
                   (imap-forward)
!                  (push (imap-parse-body) body) ;; body
                   ;; buggy stalker communigate pro 3.0 doesn't print
                   ;; number of lines in message/rfc822 attachment
                   (if (eq (char-after) ?\))
                       (push 0 body)
                     (imap-forward)
                     (push (imap-parse-number) body))) ;; body-fld-lines
!                 ((setq lines (imap-parse-number)) ;; body-type-text:
!                  (push lines body)) ;; body-fld-lines
                  (t
!                  (backward-char))))) ;; no match...
  
        ;; ...and then parse the third one here...
  
!       (when (eq (char-after) ?\ ) ;; body-ext-1part:
          (imap-forward)
!         (push (imap-parse-nstring) body) ;; body-fld-md5
!         (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
  
!       (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
        (imap-forward)
        (nreverse body)))))
  
  (when imap-debug                      ; (untrace-all)
    (require 'trace)
!   (buffer-disable-undo (get-buffer-create imap-debug-buffer))
!   (mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
          '(
            imap-utf7-encode
            imap-utf7-decode
            imap-error-text




reply via email to

[Prev in Thread] Current Thread [Next in Thread]