projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Change the Date defaults to showing a combined, continuosly updated "lapsed" format.
[gnus]
/
lisp
/
imap.el
diff --git
a/lisp/imap.el
b/lisp/imap.el
index
6393e8a
..
6d80b97
100644
(file)
--- a/
lisp/imap.el
+++ b/
lisp/imap.el
@@
-1,7
+1,6
@@
;;; imap.el --- imap library
;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
@@
-139,6
+138,7
@@
(eval-when-compile (require 'cl))
(eval-and-compile
(eval-when-compile (require 'cl))
(eval-and-compile
+ ;; For Emacs <22.2 and XEmacs.
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
@@
-267,7
+267,7
@@
See also `imap-log'."
:type 'string)
(defcustom imap-read-timeout (if (string-match
:type 'string)
(defcustom imap-read-timeout (if (string-match
- "windows-nt\\|os/2\\|
emx\\|
cygwin"
+ "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
1.0
0.1)
(symbol-name system-type))
1.0
0.1)
@@
-380,6
+380,7
@@
basis.")
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
+(defvar imap-last-authenticator nil)
(defvar imap-calculate-literal-size-first nil)
(defvar imap-state 'closed
"IMAP state.
(defvar imap-calculate-literal-size-first nil)
(defvar imap-state 'closed
"IMAP state.
@@
-474,10
+475,10
@@
sure of changing the value of `foo'."
(setcdr alist (imap-remassoc key (cdr alist)))
alist)))
(setcdr alist (imap-remassoc key (cdr alist)))
alist)))
-(def
subst
imap-disable-multibyte ()
+(def
macro
imap-disable-multibyte ()
"Enable multibyte in the current buffer."
"Enable multibyte in the current buffer."
- (
when (fboundp 'set-buffer-multibyte
)
- (set-buffer-multibyte nil)))
+ (
unless (featurep 'xemacs
)
+
'
(set-buffer-multibyte nil)))
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
@@
-514,6
+515,16
@@
sure of changing the value of `foo'."
\f
;; Server functions; stream stuff:
\f
;; Server functions; stream stuff:
+(defun imap-log (string-or-buffer)
+ (when imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (if (bufferp string-or-buffer)
+ (insert-buffer-substring string-or-buffer)
+ (insert string-or-buffer)))))
+
(defun imap-kerberos4-stream-p (buffer)
(imap-capability 'AUTH=KERBEROS_V4 buffer))
(defun imap-kerberos4-stream-p (buffer)
(imap-capability 'AUTH=KERBEROS_V4 buffer))
@@
-568,12
+579,6
@@
sure of changing the value of `foo'."
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
(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))
- (insert-buffer-substring buffer)))
(erase-buffer)
(message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
(if response (concat "done, " response) "failed"))
(erase-buffer)
(message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
(if response (concat "done, " response) "failed"))
@@
-644,12
+649,7
@@
sure of changing the value of `foo'."
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
(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))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(message "GSSAPI IMAP connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
(erase-buffer)
(message "GSSAPI IMAP connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
@@
-700,12
+700,7
@@
sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 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)))
+ (imap-log buffer)
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process))))))
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process))))))
@@
-739,12
+734,7
@@
sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 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)))
+ (imap-log buffer)
(when (memq (process-status process) '(open run))
process))))
(when (memq (process-status process) '(open run))
process))))
@@
-763,12
+753,7
@@
sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 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)))
+ (imap-log buffer)
(when (memq (process-status process) '(open run))
process))))
(when (memq (process-status process) '(open run))
process))))
@@
-802,12
+787,7
@@
sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 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)))
+ (imap-log buffer)
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process)))))
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process)))))
@@
-844,11
+824,7
@@
sure of changing the value of `foo'."
(not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
(accept-process-output process 1)
(sit-for 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)))
+ (imap-log buffer)
(when (and (setq tls-info (starttls-negotiate process))
(memq (process-status process) '(open run)))
(setq done process)))
(when (and (setq tls-info (starttls-negotiate process))
(memq (process-status process) '(open run)))
(setq done process)))
@@
-872,25
+848,26
@@
Returns t if login was successful, nil otherwise."
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
- (concat "
IMAP
username for " imap-server
+ (concat "
imap:
username for " imap-server
" (using stream `" (symbol-name imap-stream)
"'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
(read-passwd
" (using stream `" (symbol-name imap-stream)
"'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
(read-passwd
- (concat "
IMAP
password for " user "@"
+ (concat "
imap:
password for " user "@"
imap-server " (using authenticator `"
(symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
imap-server " (using authenticator `"
(symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
+ (message "imap: Login successful...")
(setq ret t
imap-username user)
(when (and (not imap-password)
(or imap-store-password
(setq ret t
imap-username user)
(when (and (not imap-password)
(or imap-store-password
- (y-or-n-p "
Store password for this
session? ")))
+ (y-or-n-p "
imap: Store password for this IMAP
session? ")))
(setq imap-password passwd)))
(setq imap-password passwd)))
- (message "Login failed...")
+ (message "
imap:
Login failed...")
(setq passwd nil)
(setq imap-password nil)
(sit-for 1))))
(setq passwd nil)
(setq imap-password nil)
(sit-for 1))))
@@
-1160,7
+1137,10
@@
necessary. If nil, the buffer name is generated."
buffer
(buffer-name buffer))))
(kill-buffer buffer)
buffer
(buffer-name buffer))))
(kill-buffer buffer)
- (rename-buffer name))
+ (rename-buffer name)
+ ;; set the passed buffer to the current one,
+ ;; so that (imap-opened buffer) later will work
+ (setq buffer (current-buffer)))
(message "imap: Reconnecting with stream `%s'...done"
stream)
(setq imap-stream stream)
(message "imap: Reconnecting with stream `%s'...done"
stream)
(setq imap-stream stream)
@@
-1173,6
+1153,7
@@
necessary. If nil, the buffer name is generated."
(setq streams nil))))))
(when (imap-opened buffer)
(setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
(setq streams nil))))))
(when (imap-opened buffer)
(setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer)
(when imap-stream
buffer))))
(when imap-stream
buffer))))
@@
-1217,25
+1198,32
@@
password is remembered in the buffer."
(eq imap-state 'examine))
(make-local-variable 'imap-username)
(make-local-variable 'imap-password)
(eq imap-state 'examine))
(make-local-variable 'imap-username)
(make-local-variable 'imap-password)
- (if user (setq imap-username user))
- (if passwd (setq imap-password passwd))
+ (make-local-variable 'imap-last-authenticator)
+ (when user (setq imap-username user))
+ (when passwd (setq imap-password passwd))
(if imap-auth
(if imap-auth
- (and (funcall (nth 2 (assq imap-auth
- imap-authenticator-alist)) (current-buffer))
+ (and (setq imap-last-authenticator
+ (assq imap-auth imap-authenticator-alist))
+ (funcall (nth 2 imap-last-authenticator) (current-buffer))
(setq imap-state 'auth))
;; Choose authenticator.
(let ((auths imap-authenticators)
auth)
(while (setq auth (pop auths))
;; OK to use authenticator?
(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)) (current-buffer))
+ (setq imap-last-authenticator
+ (assq auth imap-authenticator-alist))
+ (when (funcall (nth 1 imap-last-authenticator) (current-buffer))
(message "imap: Authenticating to `%s' using `%s'..."
imap-server auth)
(setq imap-auth auth)
(message "imap: Authenticating to `%s' using `%s'..."
imap-server auth)
(setq imap-auth auth)
- (if (funcall (nth 2
(assq auth imap-authenticator-alist)
) (current-buffer))
+ (if (funcall (nth 2
imap-last-authenticator
) (current-buffer))
(progn
(message "imap: Authenticating to `%s' using `%s'...done"
imap-server auth)
(progn
(message "imap: Authenticating to `%s' using `%s'...done"
imap-server auth)
+ ;; set imap-state correctly on successful auth attempt
+ (setq imap-state 'auth)
+ ;; stop iterating through the authenticator list
(setq auths nil))
(message "imap: Authenticating to `%s' using `%s'...failed"
imap-server auth)))))
(setq auths nil))
(message "imap: Authenticating to `%s' using `%s'...failed"
imap-server auth)))))
@@
-1946,12
+1934,7
@@
on failure."
(defun imap-send-command-1 (cmdstr)
(setq cmdstr (concat cmdstr imap-client-eol))
(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))
- (insert cmdstr)))
+ (imap-log cmdstr)
(process-send-string imap-process cmdstr))
(defun imap-send-command (command &optional buffer)
(process-send-string imap-process cmdstr))
(defun imap-send-command (command &optional buffer)
@@
-1989,13
+1972,7
@@
on failure."
(stream imap-stream)
(eol imap-client-eol))
(with-current-buffer cmd
(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))
- (insert-buffer-substring cmd)))
+ (imap-log cmd)
(process-send-region process (point-min)
(point-max)))
(process-send-string process imap-client-eol))))
(process-send-region process (point-min)
(point-max)))
(process-send-string process imap-client-eol))))
@@
-2071,18
+2048,13
@@
Return nil if no complete line has arrived."
(with-current-buffer (process-buffer proc)
(goto-char (point-max))
(insert string)
(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)))
+ (imap-log string)
(let (end)
(goto-char (point-min))
(while (setq end (imap-find-next-line))
(save-restriction
(narrow-to-region (point-min) end)
(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
))
+ (delete-
char (- (length imap-server-eol)
))
(goto-char (point-min))
(unwind-protect
(cond ((eq imap-state 'initial)
(goto-char (point-min))
(unwind-protect
(cond ((eq imap-state 'initial)
@@
-3080,5
+3052,4
@@
Return nil if no complete line has arrived."
(provide 'imap)
(provide 'imap)
-;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
;;; imap.el ends here
;;; imap.el ends here