X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fimap.el;h=ed72d7b9ce0b10a2936bd027b29bb1fcade495c7;hp=a47822533e568840a292fc8fe95d8840eae33106;hb=d3a52f935848c1b6c6d62fcb1d6aacf1d4ea0185;hpb=9a8731d6dea8021a10dec1b42f382609336a9aa9 diff --git a/lisp/imap.el b/lisp/imap.el index a47822533..ed72d7b9c 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -267,7 +267,7 @@ See also `imap-log'." :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) @@ -475,10 +475,10 @@ sure of changing the value of `foo'." (setcdr alist (imap-remassoc key (cdr alist))) alist))) -(defsubst imap-disable-multibyte () +(defmacro imap-disable-multibyte () "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 @@ -515,6 +515,16 @@ sure of changing the value of `foo'." ;; 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)) @@ -569,12 +579,6 @@ sure of changing the value of `foo'." (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")) @@ -645,12 +649,7 @@ sure of changing the value of `foo'." (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)) @@ -701,12 +700,7 @@ sure of changing the value of `foo'." (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)))))) @@ -740,12 +734,7 @@ sure of changing the value of `foo'." (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)))) @@ -764,12 +753,7 @@ sure of changing the value of `foo'." (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)))) @@ -803,12 +787,7 @@ sure of changing the value of `foo'." (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))))) @@ -845,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)) - (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))) @@ -1227,7 +1202,7 @@ password is remembered in the buffer." (when user (setq imap-username user)) (when passwd (setq imap-password passwd)) (if imap-auth - (and (setq imap-last-authenticator + (and (setq imap-last-authenticator (assq imap-auth imap-authenticator-alist)) (funcall (nth 2 imap-last-authenticator) (current-buffer)) (setq imap-state 'auth)) @@ -1959,12 +1934,7 @@ on failure." (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) @@ -2002,13 +1972,7 @@ on failure." (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)))) @@ -2084,18 +2048,13 @@ Return nil if no complete line has arrived." (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) - (delete-backward-char (length imap-server-eol)) + (delete-char (- (length imap-server-eol))) (goto-char (point-min)) (unwind-protect (cond ((eq imap-state 'initial) @@ -3093,5 +3052,4 @@ Return nil if no complete line has arrived." (provide 'imap) -;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7 ;;; imap.el ends here