[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.83 -> 0.84 patches
- To: nnimap@extundo.com
- Subject: nnimap 0.83 -> 0.84 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 18 Dec 1998 06:03:00 +0100
- User-Agent: Gnus/5.070065 (Pterodactyl Gnus v0.65) XEmacs/21.2(beta5) (Aphrodite)
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.133.4.1 nnimap/ChangeLog:1.145
*** nnimap/ChangeLog:1.133.4.1 Thu Dec 17 19:50:05 1998
--- nnimap/ChangeLog Thu Dec 17 20:47:00 1998
***************
*** 1,3 ****
--- 1,80 ----
+ 1998-12-18 05:41:09 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.84 released.
+
+ 1998-12-18 05:33:22 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-pattern-to-list-arguments): Don't quote
+ arguments.
+ (nnimap-request-list): Use imap-mailbox-list.
+
+ 1998-12-18 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-mailbox-prime):
+ (imap-message-prime): Tuned down considerably.
+ (imap-kerberos4-open): Debug more. Cleanup.
+ (imap-disable-multibyte): Removed.
+ (imap-wait-for-tag): Don't sit-for (sigh).
+ (imap-send-command-wait): Pass buffer.
+ (imap-find-next-line): New function.
+ (imap-arrival-filter): Narrow to command.
+ (imap-parse-*): Lots of changes.
+
+ 1998-12-18 03:48:55 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-group): Change to group even if fast.
+
+ 1998-12-16 21:51:45 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-retrieve-headers): Remove \r.
+
+ 1998-12-15 09:54:38 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el: Update for new imap.el.
+
+ 1998-12-15 07:47:33 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open-1): Set imap state before connecting.
+ (imap-kerberos4-open): Parse server greeting.
+
+ 1998-12-14 17:24:58 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el: Rewrite.
+
+ 1998-12-13 16:54:19 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-parse-*): Skeleton IMAP parser.
+
+ * imap.el (imap-current-mailbox): New variable.
+ (imap-mailbox-unselect): Don't take group argument.
+ (imap-mailbox-lsub): Reorder arguments.
+
+ 1998-12-13 07:58:31 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-open): Don't disable multibyte.
+
+ * imap.el (imap-find-next-line): Rewrite.
+
+ * imap.el (imap-eol): Variable removed.
+ (imap-server-eol):
+ (imap-client-eol): New variables.
+ (imap-kerberos4-open):
+ (imap-send-command): Use imap-client-eol.
+
+ 1998-12-13 00:19:49 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.texi: Auth/stream stuff updated. Various fixes.
+
+ 1998-12-11 17:27:31 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-update-flags-hook): Use range aware
+ `gnus-remove-from-range'.
+
+ 1998-12-09 23:18:28 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-wait-for-tag): Don't timeout.
+ * imap.el (imap-timeout): Removed.
+
1998-12-18 04:36:33 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.83 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.68.4.1 nnimap/imap.el:1.81
*** nnimap/imap.el:1.68.4.1 Thu Dec 17 19:50:48 1998
--- nnimap/imap.el Thu Dec 17 20:49:26 1998
***************
*** 1,47 ****
! ;;; imap.el --- IMAP library for emacs
! ;;; Copyright (C) 1998 Simon Josefsson
! ;;; Copyright (C) 1998 Jim Radford
! ;;; Copyright (C) 1997 John McClary Prevost
!
! ;;; This program is free software; you can redistribute it and/or modify
! ;;; it under the terms of the GNU General Public License as published by
! ;;; the Free Software Foundation; either version 2 of the License, or
! ;;; (at your option) any later version.
!
! ;;; This program is distributed in the hope that it will be useful,
! ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
! ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! ;;; GNU General Public License for more details.
!
! ;;; You should have received a copy of the GNU General Public License
! ;;; along with this program; if not, write to the Free Software
! ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Commentary:
! ;;; This file provides a low level interface to an IMAP server.
! ;;; It provides functions to send commands and wait for responses.
! ;;; The results are parsed into lisp expressions and returned.
! ;;; IMAP untagged responses are stuffed in to obarrays based on
! ;;; the current group. All the parameter variables become local
! ;;; to the IMAP process buffer.
!
! ;;; RFC1730 (IMAP4): done
! ;;; RFC1731 (Authentication mecanisms): currently only support for KERBEROS_V4
! ;;; RFC2060 (IMAP4rev1): done
! ;;; RFC???? (UNSELECT ext): done
! ;;; RFC2195 (CRAM-MD5 auth): done
! ;;; RFC2086 (ACL ext): done
! ;;; RFC2342 (NAMESPACE ext): done
! ;;; RFC2359 (UIDPLUS ext): done
!
! ;;; Todo:
! ;;;
! ;;; o On expunge, remove messages from message-data. Note it doesn't
! ;;; return UIDs. Ouch.
! ;;; o Rename "folder" to "mailbox".
! ;;;
(require 'rfc2104)
(require 'base64)
--- 1,45 ----
! ;;; imap.el --- imap library
! ;; Copyright (C) 1998 Free Software Foundation, Inc.
! ;; Author: Simon Josefsson <jas@pdc.kth.se>
! ;; This file is not part of GNU Emacs.
!
! ;; GNU Emacs is free software; you can redistribute it and/or modify
! ;; it under the terms of the GNU General Public License as published by
! ;; the Free Software Foundation; either version 2, or (at your option)
! ;; any later version.
!
! ;; GNU Emacs is distributed in the hope that it will be useful,
! ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! ;; GNU General Public License for more details.
!
! ;; You should have received a copy of the GNU General Public License
! ;; along with GNU Emacs; see the file COPYING. If not, write to the
! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
! ;; Boston, MA 02111-1307, USA.
;;; Commentary:
! ;;
! ;; RFC1730 (IMAP4): done
! ;; RFC1731 (Authentication mecanisms): currently only support for KERBEROS_V4
! ;; RFC2060 (IMAP4rev1): done
! ;; RFC???? (UNSELECT ext): done
! ;; RFC2195 (CRAM-MD5 auth): done
! ;; RFC2086 (ACL ext): done
! ;; RFC2342 (NAMESPACE ext): done
! ;; RFC2359 (UIDPLUS ext): done
! ;;
! ;; Todo:
! ;;
! ;; o Handle literals in LIST/LSUB untagged responses
! ;; o Fix imap-ok-p.
! ;; o Parse UIDs as strings? (28 bit limit)
! ;; o Sleep.
! ;;
!
! ;;; Code:
(require 'rfc2104)
(require 'base64)
***************
*** 54,74 ****
(unless (fboundp 'open-network-stream)
(require 'tcp)))
! ;;; New varibles (copyright jas):
! (defvar imap-data-capability nil
! "Current server's capability list")
! (defvar imap-data-namespace nil
! "Current server's namespace.")
(defvar imap-cb-fetch-hook nil
"Hook called when receiving a FETCH response. Called with article NUM,
FETCH and DATA response.")
- (defvar imap-default-user (user-login-name)
- "Default username to use.")
-
(defvar imap-streams '(kerberos4 ssl network)
"Priority of streams to consider when opening connection to
server.")
--- 52,71 ----
(unless (fboundp 'open-network-stream)
(require 'tcp)))
! ;; User variables.
! (defvar imap-imtest-arguments "-kp"
! "Privacy / integrity checking arguments passed to `imtest'.")
!
! (defvar imap-default-user (user-login-name)
! "Default username to use.")
! ;; Various variables.
(defvar imap-cb-fetch-hook nil
"Hook called when receiving a FETCH response. Called with article NUM,
FETCH and DATA response.")
(defvar imap-streams '(kerberos4 ssl network)
"Priority of streams to consider when opening connection to
server.")
***************
*** 102,110 ****
the server support the authenticator and AUTHENTICATE is a function
for doing the actuall authentification.")
- (defvar imap-imtest-arguments "-kp"
- "Privacy / integrity checking arguments passed to `imtest'.")
-
;; Internal constants. Change theese and die.
(defconst imap-default-port 143)
--- 99,104 ----
***************
*** 114,125 ****
(defconst imap-coding-system-for-write 'binary)
(defconst imap-local-variables '(imap-server
imap-port
imap-auth
imap-stream
imap-username
! imap-password))
! ;; Internal variables:
(defvar imap-buffer-list nil
"List of buffers the imap library has created, which are destroyed
--- 108,147 ----
(defconst imap-coding-system-for-write 'binary)
(defconst imap-local-variables '(imap-server
imap-port
+ imap-client-eol
+ imap-server-eol
imap-auth
imap-stream
imap-username
! imap-password
! imap-current-mailbox
! imap-capability
! imap-namespace
! imap-state
! imap-reached-tag
! imap-tag
! imap-process
! imap-mailbox-data))
! (defconst imap-parse-response-data-cb
! '((OK . imap-response-data-text-code)
! (NO . imap-response-data-text-code)
! (BAD . imap-response-data-text-code)
! (BYE . imap-response-data-bye)
! (EXISTS . imap-response-data-exists)
! (EXPUNGE . imap-response-data-expunge)
! (RECENT . imap-response-data-recent)
! (CAPABILITY . imap-response-data-capability)
! (LIST . imap-response-data-list)
! (LSUB . imap-response-data-list)
! (FLAGS . imap-response-data-flags)
! (FETCH . imap-response-data-fetch)
! (SEARCH . imap-response-data-search)
! (STATUS . imap-response-data-status)
! (ACL . imap-response-data-acl)
! (NAMESPACE . imap-response-data-namespace)))
!
! ;; Internal variables.
(defvar imap-buffer-list nil
"List of buffers the imap library has created, which are destroyed
***************
*** 131,236 ****
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
! ;;; Old varibles (see changelog for copyright status):
!
! ;;; External variables
! (defvar imap-convenient-group-prime 2999
! "*A convenient prime which will be used to set the size of the group hash.
! We have a lot of groups at CMU, so this should probably be adjusted down.")
! (defvar imap-convenient-folder-prime 997
! "*A convenient prime which will be used to set the size of the folder
! (message) hash.")
! (defvar imap-eol "\r\n"
! "*The string sent to end a command.")
! (defvar imap-last-status nil
! "*Status returned by last IMAP command")
! ;;; Internal variables
! (defvar imap-process nil
! "The active process for the current IMAP buffer.")
! (defvar imap-data-folder nil
! "Obarray which contains group information.")
! (defvar imap-cb-finished-tags '()
! "Alist of tags which are completed but not yet handled.")
! (defvar imap-message-data nil
! "Obarray which contains current message cache.")
! (defvar imap-current-folder nil
! "Name of the current folder")
! (defvar imap-current-message nil
! "Symbol of current message.")
! (defvar imap-current-server nil
! "Name of current server machine.")
!
! (defvar imap-tag-num 0
! "Number for tag increment.")
! (defvar imap-tag-char ?A
! "Unique tag char per connection.")
!
! (defvar imap-connection-number 0
! "Unique tag char per connection.")
!
! (defvar imap-cb-function-alist '((OK . imap-cb-response)
! (NO . imap-cb-response)
! (BAD . imap-cb-response)
! (PREAUTH . imap-cb-response)
! (BYE . imap-cb-bye)
! (EXISTS . imap-cb-numbered)
! (EXPUNGE . imap-cb-numbered)
! (RECENT . imap-cb-numbered)
! (CAPABILITY . imap-cb-capability)
! (LIST . imap-cb-list)
! (LSUB . imap-cb-list)
! (FLAGS . imap-cb-flags)
! (FETCH . imap-cb-fetch)
! (SEARCH . imap-cb-search)
! (STATUS . imap-cb-status)
! (ACL . imap-cb-acl)
! (NAMESPACE . imap-cb-namespace)
! (default . imap-cb-default))
! "Alist of IMAP code to function callbacks.")
!
! (defvar imap-cb-tag-alist '()
! "Alist of tags to callbacks for tagged responses.")
!
! (defvar imap-locals '(imap-cb-finished-tags
! imap-cb-tag-alist
! imap-current-folder
! imap-current-message
! imap-current-server
! imap-data-capability
! imap-data-namespace
! imap-data-folder
! imap-message-data
! imap-default-name
! imap-last-status
! imap-process
! imap-tag-num
! imap-tag-char
! imap-eol)
! "A list the variables that define an individual imap connection.
! They are reset from their `default-value's . You can pass values for
! any of these to `imap-open-server'.")
!
!
! ;; If non nil these hold the name of a buffer to put debug into
! (defvar imap-log "*imap-log*") ; imap session trace
! (defvar imap-last nil);"*imap-last*") ; last line we attempted to parse
! (defvar imap-debug nil);"*imap-debug*") ; random debug spew
! ;;; New functions (copyright jas):
;; Server functions; stream stuff:
--- 153,206 ----
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
+ (defvar imap-state 'closed
+ "IMAP state. Valid states are `closed', `initial', `nonauth',
+ `auth', `selected' and `examine'.")
! (defvar imap-server-eol "\r\n"
! "The EOL string sent from the server.")
! (defvar imap-client-eol "\r\n"
! "The EOL string we send to the server.")
! (defvar imap-current-mailbox nil
! "Current mailbox name.")
! (defvar imap-mailbox-data nil
! "Obarray with mailbox data.")
! (defvar imap-mailbox-prime 127
! "Length of imap-mailbox-data.")
! (defvar imap-current-message nil
! "Current message number.")
! (defvar imap-message-data nil
! "Obarray with message data.")
! (defvar imap-message-prime 67
! "Length of imap-message-data.")
! (defvar imap-capability nil
! "Capability for server.")
! (defvar imap-namespace nil
! "Namespace for current server.")
! (defvar imap-reached-tag 0
! "Lower limit on command tags that have been parsed.")
! (defvar imap-tag 0
! "Command tag number.")
! (defvar imap-process nil
! "Process.")
! (defvar imap-log "*imap-log*"
! "Imap session trace.")
! (defvar imap-debug nil;"*imap-debug*"
! "Random debug spew.")
;; Server functions; stream stuff:
***************
*** 245,274 ****
(process (start-process name buffer "imtest" imap-imtest-arguments
server (number-to-string port))))
(with-current-buffer (process-buffer process)
! (setq imap-eol "\n") ;; xxx
(when process
(message "Opening Kerberized IMAP connection...")
;; Result of authentication is a string: __Full privacy protection__
(while (and (memq (process-status process) '(open run))
! (goto-char (point-max))
! (not (or
! ;; if everything is ok, this will match...
! (re-search-backward "__\\(.*\\)__\n" nil t)
! ;; ...errors will match this
! (re-search-backward
! "\\. \\([^OA][^KU][^T][^H].*\\)\r\n" nil t))))
(accept-process-output process 1)
(sit-for 1))
(let ((response (match-string 1)))
(message "Kerberized IMAP connection: %s" response)
(if (let ((case-fold-search nil))
! (string-match "failed\\|NO\\|BAD" response))
! (progn
! (imap-send-command-wait "LOGOUT")
! (delete-process process)
! response)
! (erase-buffer)
! process))))))
(defun imap-ssl-p (buffer)
nil)
--- 215,243 ----
(process (start-process name buffer "imtest" imap-imtest-arguments
server (number-to-string port))))
(with-current-buffer (process-buffer process)
! (setq imap-client-eol "\n")
(when process
(message "Opening Kerberized IMAP connection...")
;; Result of authentication is a string: __Full privacy protection__
(while (and (memq (process-status process) '(open run))
! (goto-char (point-min))
! (not (and (imap-parse-greeting)
! (re-search-forward "__\\(.*\\)__\n" nil t))))
(accept-process-output process 1)
(sit-for 1))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log)
+ (goto-char (point-max))
+ (insert-buffer (process-buffer process))))
(let ((response (match-string 1)))
+ (erase-buffer)
(message "Kerberized IMAP connection: %s" response)
(if (let ((case-fold-search nil))
! (not (string-match "failed" response)))
! process
! (imap-send-command-wait "LOGOUT")
! (delete-process process)
! nil))))))
(defun imap-ssl-p (buffer)
nil)
***************
*** 399,425 ****
(defun imap-open-1 (buffer)
(with-current-buffer buffer
! (setq imap-process (funcall (nth 2 (assq imap-stream imap-stream-alist))
"imap" buffer imap-server imap-port))
(when imap-process
(set-process-filter imap-process 'imap-arrival-filter)
(set-process-sentinel imap-process 'imap-sentinel)
! (setq imap-current-folder nil
! imap-current-message nil)
! ;; legacy:
! (set-marker (process-mark imap-process) (point-min))
! (setq imap-tag-char (int-char (+ (char-int ?A)
! (% imap-connection-number 26))))
! (setq imap-connection-number (1+ imap-connection-number))
! (setq imap-data-folder (make-vector imap-convenient-group-prime 0))
! ;; end legacy
imap-process)))
- (defsubst imap-disable-multibyte ()
- "Enable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
-
(defun imap-open (server &optional port stream auth buffer)
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(unless (get-buffer buffer)
--- 368,387 ----
(defun imap-open-1 (buffer)
(with-current-buffer buffer
! (setq imap-current-mailbox nil
! imap-current-message nil
! imap-state 'initial
! imap-process (funcall (nth 2 (assq imap-stream imap-stream-alist))
"imap" buffer imap-server imap-port))
(when imap-process
(set-process-filter imap-process 'imap-arrival-filter)
(set-process-sentinel imap-process 'imap-sentinel)
! (while (eq imap-state 'initial)
! (message "Waiting for server response...")
! (accept-process-output imap-process 1))
! (message "Waiting for server response...done")
imap-process)))
(defun imap-open (server &optional port stream auth buffer)
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(unless (get-buffer buffer)
***************
*** 428,437 ****
(let (stream-changed)
(if (imap-opened buffer)
(imap-close buffer)
- (mapc 'make-variable-buffer-local imap-locals)
(mapc 'make-variable-buffer-local imap-local-variables)
! (buffer-disable-undo)
! (imap-disable-multibyte)) ;; we shouldn't do this
(if server (setq imap-server server))
(if port (setq imap-port port))
(if auth (setq imap-auth auth))
--- 390,397 ----
(let (stream-changed)
(if (imap-opened buffer)
(imap-close buffer)
(mapc 'make-variable-buffer-local imap-local-variables)
! (buffer-disable-undo))
(if server (setq imap-server server))
(if port (setq imap-port port))
(if auth (setq imap-auth auth))
***************
*** 468,473 ****
--- 428,434 ----
(unless imap-auth
(error "Couldn't figure out authenticator for server"))))
(when stream-changed
+ (message "Reconnecting with %s..." imap-stream)
(imap-close buffer)
(imap-open-1 buffer))))))
(if (imap-opened buffer)
***************
*** 482,492 ****
(defun imap-authenticate (buffer &optional user passwd)
(with-current-buffer buffer
! (make-variable-buffer-local 'imap-username)
! (make-variable-buffer-local 'imap-password)
! (if user (setq imap-username user))
! (if passwd (setq imap-password passwd))
! (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)))
(defun imap-close (&optional buffer)
"Close connection to server in BUFFER. If BUFFER is nil, the current
--- 443,455 ----
(defun imap-authenticate (buffer &optional user passwd)
(with-current-buffer buffer
! (when (eq imap-state 'nonauth)
! (make-variable-buffer-local 'imap-username)
! (make-variable-buffer-local '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
***************
*** 498,504 ****
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
! (setq imap-current-folder nil
imap-current-message nil
imap-process nil)
(erase-buffer)
--- 461,467 ----
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
! (setq imap-current-mailbox nil
imap-current-message nil
imap-process nil)
(erase-buffer)
***************
*** 508,606 ****
"Return a list of identifiers which the server support. If IDENTIFIER,
return non-nil if it's among the servers capabilities."
(with-current-buffer (or buffer (current-buffer))
! (unless imap-data-capability
(unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
! (setq imap-data-capability '(IMAP2))))
(if identifier
! (memq identifier imap-data-capability)
! imap-data-capability)))
! (defun imap-namespace-get (&optional buffer)
"Return server's namespace."
(with-current-buffer (or buffer (current-buffer))
! (unless imap-data-namespace
(when (imap-capability 'NAMESPACE)
! (imap-send-command-wait "NAMESPACE")))
! imap-data-namespace))
;; Mailbox functions:
(defun imap-mailbox-map (func &optional buffer)
! "Call (func FOLDER) for each folder in `imap-data-folder', returning
! a sequence."
(with-current-buffer (or buffer (current-buffer))
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (symbol-name s)) result))
! imap-data-folder)
result)))
! (defun imap-mailbox-reset (&optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (setq imap-data-folder (make-vector imap-convenient-group-prime 0))))
!
! (defun imap-mailbox-select (folder &optional buffer examine)
(with-current-buffer (or buffer (current-buffer))
! ;; xxx: check SELECT/EXAMINE status! This is BAD.
! (unless (string= folder imap-current-folder)
! (setq imap-current-folder folder)
(if (imap-ok-p (imap-send-command-wait
! (concat (if examine "EXAMINE" "SELECT") " " folder)))
! (setq imap-message-data (make-vector imap-convenient-folder-prime 0))
;; Failed SELECT unselects the current group
! (setq imap-current-folder nil
! imap-message-data nil)))
! imap-current-folder))
! (defun imap-mailbox-unselect (&optional group buffer)
"Close current folder in BUFFER, without expunging articles."
(with-current-buffer (or buffer (current-buffer))
! (when (or (and (imap-capability 'UNSELECT)
(imap-ok-p (imap-send-command-wait "UNSELECT")))
(and (imap-ok-p
! (imap-send-command-wait (concat "EXAMINE "
! (or group
! imap-current-folder))))
(imap-ok-p (imap-send-command-wait "CLOSE"))))
! (setq imap-current-folder nil
! imap-message-data nil)
t)))
(defun imap-mailbox-close (&optional buffer)
"Expunge articles and close current folder in BUFFER."
(with-current-buffer (or buffer (current-buffer))
(when (imap-ok-p (imap-send-command-wait "CLOSE"))
! (setq imap-current-folder nil
! imap-message-data nil)
t)))
! (defun imap-mailbox-lsub (&optional reference buffer)
! "Return a list of strings of subscribed mailboxes on server in
! BUFFER. REFERENCE is the implementation-specific string that has to be
! passed to LSUB."
(with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-reset)
(when (imap-ok-p (imap-send-command-wait
(concat "LSUB \"" reference "\" \"*\"")))
(imap-mailbox-map 'identity))))
! (defun imap-mailbox-list (&optional root have-delimiter reference buffer)
"List all mailboxes that starts with ROOT in BUFFER. If
HAVE-DELIMITER is non-nil, a hierarchy delimiter is not added to
ROOT. REFERENCE is the implementation-specific string that has to be
passed to LIST."
(with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-reset)
! ;; Find hierarchy separator
! (unless have-delimiter
! (imap-send-command-wait (concat "LIST \"" reference "\" \"" root "\"")))
(when (imap-ok-p
(imap-send-command-wait
(concat "LIST \"" reference "\" \"" root
! (when (and (not have-delimiter) root)
! (imap-folder-get 'delimiter root))
"%\"")))
(imap-mailbox-map 'identity))))
--- 471,585 ----
"Return a list of identifiers which the server support. If IDENTIFIER,
return non-nil if it's among the servers capabilities."
(with-current-buffer (or buffer (current-buffer))
! (unless imap-capability
(unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
! (setq imap-capability '(IMAP2))))
(if identifier
! (memq identifier imap-capability)
! imap-capability)))
! (defun imap-namespace (&optional buffer)
"Return server's namespace."
(with-current-buffer (or buffer (current-buffer))
! (unless imap-namespace
(when (imap-capability 'NAMESPACE)
! (imap-send-command-wait 'NAMESPACE)))
! imap-namespace))
;; Mailbox functions:
+ (defun imap-mailbox-put (propname value &optional mailbox buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
+ propname value)
+ t))
+
+ (defun imap-mailbox-get (propname &optional mailbox buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
+ propname)))
+
(defun imap-mailbox-map (func &optional buffer)
! "Map a function across each mailbox in `imap-mailbox-data',
! returning a list."
(with-current-buffer (or buffer (current-buffer))
(let (result)
(mapatoms
(lambda (s)
(push (funcall func (symbol-name s)) result))
! imap-mailbox-data)
result)))
! (defun imap-mailbox-select (mailbox &optional buffer examine)
(with-current-buffer (or buffer (current-buffer))
! (unless (and (string= mailbox imap-current-mailbox)
! (or (and examine
! (eq imap-state 'examine))
! (and (not examine)
! (eq imap-state 'selected))))
! (setq imap-current-mailbox mailbox)
(if (imap-ok-p (imap-send-command-wait
! (concat (if examine "EXAMINE" "SELECT") " " mailbox)))
! (setq imap-message-data (make-vector imap-message-prime 0)
! imap-state (if examine 'examine 'selected))
;; Failed SELECT unselects the current group
! (setq imap-current-mailbox nil
! imap-message-data nil
! imap-state 'auth)))
! imap-current-mailbox))
! (defun imap-mailbox-unselect (&optional buffer)
"Close current folder in BUFFER, without expunging articles."
(with-current-buffer (or buffer (current-buffer))
! (when (or (eq imap-state 'auth)
! (and (imap-capability 'UNSELECT)
(imap-ok-p (imap-send-command-wait "UNSELECT")))
(and (imap-ok-p
! (imap-send-command-wait (concat "EXAMINE "
! 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-close (&optional buffer)
"Expunge articles and close current folder in BUFFER."
(with-current-buffer (or buffer (current-buffer))
(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-lsub (&optional buffer reference)
! "Clear the mailbox data and fill it with subscribed mailboxes on
! server in BUFFER. REFERENCE is the implementation-specific string that
! has to be passed to LSUB."
(with-current-buffer (or buffer (current-buffer))
! (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
(when (imap-ok-p (imap-send-command-wait
(concat "LSUB \"" reference "\" \"*\"")))
(imap-mailbox-map 'identity))))
! (defun imap-mailbox-list (&optional buffer root have-delimiter reference)
"List all mailboxes that starts with ROOT in BUFFER. If
HAVE-DELIMITER is non-nil, a hierarchy delimiter is not added to
ROOT. REFERENCE is the implementation-specific string that has to be
passed to LIST."
(with-current-buffer (or buffer (current-buffer))
! (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
! ;; Find hierarchy separator if root turns out to be a mailbox
! ;; instead of just a prefix.
! (when root
! (unless have-delimiter
! (imap-send-command-wait (concat "LIST \"" reference "\" \"" root "\""))))
(when (imap-ok-p
(imap-send-command-wait
(concat "LIST \"" reference "\" \"" root
! (when (and root (not have-delimiter))
! (imap-mailbox-get 'delimiter root))
"%\"")))
(imap-mailbox-map 'identity))))
***************
*** 619,629 ****
;; Message functions:
(defun imap-search (predicate &optional buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-folder-set 'search nil)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
! (imap-folder-get 'search))))
(defun imap-message-flags-set (articles flags &optional buffer silent)
(when (and articles flags)
--- 598,630 ----
;; Message functions:
+ (defun imap-message-put (uid propname value &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (put (intern (number-to-string uid) imap-message-data)
+ propname value)
+ t))
+
+ (defun imap-message-get (uid propname &optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (get (intern-soft (number-to-string uid) imap-message-data)
+ propname)))
+
+ (defun imap-message-map (func propname &optional buffer)
+ "Map a function across each mailbox in `imap-message-data',
+ returning a list."
+ (with-current-buffer (or buffer (current-buffer))
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (get s 'UID) (get s propname)) result))
+ imap-message-data)
+ result)))
+
(defun imap-search (predicate &optional buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-put 'search nil)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
! (imap-mailbox-get 'search))))
(defun imap-message-flags-set (articles flags &optional buffer silent)
(when (and articles flags)
***************
*** 646,932 ****
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-reset (&optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (setq imap-message-data (make-vector imap-convenient-folder-prime 0))))
! ;; Stuff:
! (defun imap-cb-capability (code &rest capabilities)
! (setq imap-data-capability capabilities))
! (defun imap-cb-acl (code group &rest acls)
! (imap-folder-set 'acl acls (symbol-name group)))
! (defun imap-cb-namespace (code &rest namespace)
! (setq imap-data-namespace namespace))
(defun imap-sentinel (process string)
(delete-process process))
! ;;; Old functions (see changelog for copyright status):
!
! (when imap-debug ; (untrace-all)
! (require 'trace)
! (buffer-disable-undo (get-buffer-create imap-debug))
! (imap-disable-multibyte)
! (mapc (lambda (f) (trace-function-background f imap-debug))
! '(imap-kerberos4s-p
! imap-kerberos4-open
! imap-ssl-p
! imap-ssl-open-1
! imap-ssl-open
! imap-network-p
! imap-network-open
! imap-interactive-login
! imap-kerberos4a-p
! imap-kerberos4-auth
! imap-cram-md5-p
! imap-cram-md5-auth
! imap-login-p
! imap-login-auth
! imap-anonymous-p
! imap-anonymous-open
! imap-open-1
! imap-open
! imap-opened
! imap-close
! imap-mailbox-select
! imap-mailbox-unselect
! imap-mailbox-expunge-close
! imap-sentinel
! imap-send-command
! imap-send-command-wait
! imap-send-commands-wait
! ; imap-ok-p
! imap-wait-for-tag
! imap-capability
! imap-namespace-get
! imap-folder-set
! imap-folder-get
! imap-folder-plist
! imap-mailbox-reset
! imap-dispatch
! imap-authenticate
! imap-authenticate-login
! imap-authenticate-cram-md5
! imap-search
! imap-message-set
! imap-message-get
! imap-message-map
! imap-message-plist
! imap-message-reset
! imap-cb-response
! imap-cb-bye
! imap-cb-numbered
! imap-cb-capability
! imap-cb-namespace
! imap-cb-list
! imap-cb-flags
! imap-cb-fetch
! imap-cb-search
! imap-cb-status
! imap-cb-default)))
!
! ;;; Compatibility
!
! (or (fboundp 'char-int)
! (fset 'char-int (symbol-function 'identity)))
!
! (or (fboundp 'int-char)
! (fset 'int-char (symbol-function 'identity)))
!
! (if (not (fboundp 'remassoc))
! (defun 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 (remassoc key (cdr alist)))
! alist))))
!
! (if (not (fboundp 'save-current-buffer))
! (defmacro save-current-buffer (&rest body)
! "Save the current buffer; execute BODY; restore the current buffer.
! Executes BODY just like `progn'."
! (` (let ((orig-buffer (current-buffer)))
! (unwind-protect
! (progn (,@ body))
! (set-buffer orig-buffer))))))
!
! (if (not (fboundp 'with-current-buffer))
! (defmacro with-current-buffer (buffer &rest body)
! "Execute the forms in BODY with BUFFER as the current buffer.
! The value returned is the value of the last form in BODY.
! See also `with-temp-buffer'."
! `(save-current-buffer
! (set-buffer ,buffer)
! ,@body)))
!
! (if (not (fboundp 'destructive-plist-to-alist)) ;; From XEmacs subr.el
! (defun destructive-plist-to-alist (plist)
! "Convert property list PLIST into the equivalent association-list form.
! The alist is returned. This converts from
!
! \(a 1 b 2 c 3)
!
! into
!
! \((a . 1) (b . 2) (c . 3))
!
! The original plist is destroyed in the process of constructing the alist.
! See also `plist-to-alist'."
! (let ((head plist)
! next)
! (while plist
! ;; remember the next plist pair.
! (setq next (cddr plist))
! ;; make the cons holding the property value into the alist element.
! (setcdr (cdr plist) (cadr plist))
! (setcar (cdr plist) (car plist))
! ;; reattach into alist form.
! (setcar plist (cdr plist))
! (setcdr plist next)
! (setq plist next))
! head)))
!
! ;;; Interface functions
!
! (defun imap-current-server (&optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! imap-current-server))
!
! ;; If there is a need for sending commands without a callback, then
! ;; have `imap-send-command-wait'ing commands pass
! ;; `imap-cb-tag-default' itself. Maybe `imap-wait-for-tag' should
! ;; be internal. It currently doesn't accept a buffer (nor set one).
! ;; I guess until then this is an internal command also. Use
! ;; `imap-send-command-wait' instead.
!
! (defun imap-send-command (command &optional buffer callback)
! "Send a COMMAND to the server for BUFFER returning the command's TAG. If
! BUFFER is omitted or is nil the current buffer is used. You can
! then call `imap-wait-for-tag'. If CALLBACK is provided, then you cannot
! call `imap-wait-for-tag'.
!
! COMMAND may be a list of strings, buffers and/or functions which should
! be `concat'ed together. The buffers are sent as IMAP string literals.
! The functions accept one argument and are called with a server challenge and
! should return the client response or \"*\" to give up."
! (with-current-buffer (or buffer (current-buffer))
! (setq imap-last-status nil) ; Yuck
! (let* ((tag (format "%c%d" imap-tag-char (setq imap-tag-num (1+ imap-tag-num))))
! (commands (append (list tag " ")
! (if (listp command) command (list command))
! (list imap-eol)))
! (strings))
! (setq imap-cb-tag-alist ;; removed by `imap-dispatch'
! (cons (cons tag (or callback 'imap-cb-tag-default))
! imap-cb-tag-alist))
! (while commands
! (while (stringp (car commands)) ; This should be easier
! (push (car commands) strings) ; How to append without reversing???
! (pop commands))
! (when commands ; buffer or function
! (cond
! ((bufferp (car commands))
! (push (format "{%d}%s" (with-current-buffer (car commands)
! (buffer-size))
! imap-eol)
! strings))
! ((functionp (car commands))
! (push imap-eol strings)))
! (setq imap-cb-tag-alist ;; removed by `imap-dispatch'
! (cons (cons "+" 'imap-cb-tag-default) imap-cb-tag-alist)))
! (setq strings (apply 'concat (nreverse strings)))
! (and imap-log (with-current-buffer (get-buffer-create imap-log)
! (buffer-disable-undo)
! (imap-disable-multibyte)
! (goto-char (point-max))
! (insert strings)))
! (process-send-string nil strings)
! (setq strings nil)
! (when commands ; buffer or function
! ;; Waiting for "+" and bail out if we get tag.
! (let ((data (imap-wait-for-tag "+" tag)))
! (if (not data)
! (setq commands nil) ; Don't bother sending the rest
! (cond
! ((bufferp (car commands)) ; buffer
! (and imap-log (with-current-buffer (get-buffer-create imap-log)
! (goto-char (point-max))
! (insert-buffer-substring (car commands))))
! (let ((process imap-process))
! (with-current-buffer (car commands)
! (process-send-region process (point-min) (point-max))))
! (pop commands))
! ((functionp (car commands)) ; function
! ;; Assume function comes at the end.
! ;; Send result of function call by prepending it to
! ;; the list of command strings.
! ;; The function gets removed only after the end
! ;; of the exchange (by an `imap-wait-for-tag' bailout).
! (setq commands
! (cons (funcall (car commands) (car data))
! commands))))))))
! tag)))
!
! (defun imap-send-command-wait (command &optional buffer)
! "Send a COMMAND to the server for BUFFER with a new TAG, and wait for
! the command to complete on the IMAP server before returning. If buffer is
! omitted, the current buffer is used.
!
! COMMAND may be a list of strings and buffers which should
! be `concat'ed together. The buffers are sent as IMAP string literals."
! (interactive "sCommand: ")
! (with-current-buffer (or buffer (current-buffer))
! (imap-wait-for-tag (imap-send-command command))))
!
! (defun imap-send-commands-wait (command-list &optional buffer)
! "Send a list of commands and wait for results. Results are returned
! in order. See `imap-send-command-wait'."
! (with-current-buffer (or buffer (current-buffer))
! (mapcar 'imap-wait-for-tag
! (mapcar 'imap-send-command command-list))))
! (defun imap-ok-p (status)
! (when (and status
! (eq 'OK (car status)))
! (setq imap-last-status nil)
! t))
! ;;; Variable setters and getters
! (defun imap-folder-plist (&optional folder buffer)
! "Set PROP to VALUE for FOLDER in BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (object-plist (intern (or folder
! imap-current-folder)
! imap-data-folder))))
! (defun imap-folder-set (prop value &optional folder buffer)
! "Set PROP to VALUE for FOLDER in BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (put (intern (or folder
! imap-current-folder)
! imap-data-folder) prop value)))
! (defun imap-folder-get (prop &optional folder buffer)
! "Get PROP for FOLDER or the current folder in BUFFER"
! (with-current-buffer (or buffer (current-buffer))
! (get (intern (or folder
! imap-current-folder) imap-data-folder) prop)))
! ;;; Internal functions
(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 (load "passwd" t)
--- 647,1251 ----
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
!
! ;; Internal functions.
! (defun imap-send-command (command &optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (if (not (listp command)) (setq command (list command)))
! (let ((tag (setq imap-tag (1+ imap-tag)))
! cmdstr cmd)
! (setq cmdstr (concat (number-to-string imap-tag) " "))
! (while (setq cmd (pop command))
! (cond ((stringp cmd)
! (setq cmdstr (concat cmdstr cmd)))
! (t
! (error "Unknown command type"))))
! (setq cmdstr (concat cmdstr imap-client-eol))
! (and imap-log
! (with-current-buffer (get-buffer-create imap-log)
! (goto-char (point-max))
! (insert cmdstr)))
! (process-send-string imap-process cmdstr)
! tag)))
! (defun imap-wait-for-tag (tag &optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (while (< imap-reached-tag tag)
! (accept-process-output imap-process))))
! (defun imap-ok-p (&rest foo)
! t)
! (defun imap-send-command-wait (command &optional buffer)
! (imap-wait-for-tag (imap-send-command command buffer) buffer))
(defun imap-sentinel (process string)
(delete-process process))
! (defun imap-find-next-line ()
! "Return point at end of current line, taking into account
! literals. Return nil if no complete line has arrived."
! (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}" imap-server-eol)
! nil t)
! (if (match-string 1)
! (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
! nil
! (goto-char (+ (point) (string-to-number (match-string 1))))
! (imap-find-next-line))
! (point))))
! (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)
! (goto-char (point-max))
! (insert string)))
! (goto-char (point-min))
! (let (end)
! (while (setq end (imap-find-next-line))
! (save-restriction
! (narrow-to-region (point-min) end)
! (goto-char (point-min))
! ;; unwind-protect when parser is debugged
! (cond ((eq imap-state 'initial)
! (imap-parse-greeting))
! ((or (eq imap-state 'auth)
! (eq imap-state 'nonauth)
! (eq imap-state 'selected))
! (imap-parse-response))
! (t
! (error "Unknown state %s in arrival filter" imap-state)))
! (delete-region (point-min) (point-max)))))))
!
! ;; Imap parser.
! ;; greeting = "*" SP (resp-cond-auth / resp-cond-bye) CRLF
! ;;
! ;; resp-cond-auth = ("OK" / "PREAUTH") SP resp-text
! ;; ; Authentication condition
! ;;
! ;; resp-cond-bye = "BYE" SP resp-text
!
! (defun imap-parse-greeting ()
! "Parse a IMAP greeting."
! (cond ((looking-at "\\* OK ")
! (setq imap-state 'nonauth))
! ((looking-at "\\* PREAUTH ")
! (setq imap-state 'auth))
! ((looking-at "\\* BYE ")
! (setq imap-state 'closed))))
!
! ;; response = *(continue-req / response-data) response-done
! ;;
! ;; continue-req = "+" SP (resp-text / base64) CRLF
! ;;
! ;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
! ;; mailbox-data / message-data / capability-data) CRLF
! ;;
! ;; response-done = response-tagged / response-fatal
! ;;
! ;; response-fatal = "*" SP resp-cond-bye CRLF
! ;; ; Server closes connection immediately
! ;;
! ;; response-tagged = tag SP resp-cond-state CRLF
!
! (defun imap-parse-response ()
! "Parse a IMAP command response."
! (let ((token (read (current-buffer))))
! (cond ((eq token '*)
! (let* ((response (read (current-buffer)))
! (func (cdr (assq response imap-parse-response-data-cb))))
! (forward-char)
! (when (integerp response)
! (setq func (cdr (assq (read (current-buffer))
! imap-parse-response-data-cb)))
! (forward-char))
! (if func
! (funcall func response)
! (message "Unknown untagged response: %s" response))))
! ((integerp token)
! (let ((status (read (current-buffer))))
! (cond ((eq status 'OK)
! (setq imap-reached-tag (max imap-reached-tag token)))
! ((eq status 'NO)
! (error "Imap server said no: %s"
! (buffer-substring (point) (point-max))))
! ((eq status 'BAD)
! (error "Internal protocol error: %s"
! (buffer-substring (point) (point-max))))
! (t
! (error "Unknown tagged status: %s" status)))))
! ((eq token '+)
! (imap-parse-continue-req))
! (t
! (error "Unknown symbol error")))))
!
! ;; resp-text-code = "ALERT" /
! ;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
! ;; "NEWNAME" SP string SP string /
! ;; "PARSE" /
! ;; "PERMANENTFLAGS" SP "(" [flag-perm *(SP flag-perm)] ")" /
! ;; "READ-ONLY" /
! ;; "READ-WRITE" /
! ;; "TRYCREATE" /
! ;; "UIDNEXT" SP nz-number /
! ;; "UIDVALIDITY" SP nz-number /
! ;; "UNSEEN" SP nz-number /
! ;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
! ;;
! ;; flag-perm = flag / "\*"
! ;;
! ;; flag = "\Answered" / "\Flagged" / "\Deleted" /
! ;; "\Seen" / "\Draft" / flag-keyword / flag-extension
! ;; ; Does not include "\Recent"
! ;;
! ;; flag-extension = "\" atom
! ;; ; Future expansion. Client implementations
! ;; ; MUST accept flag-extension flags. Server
! ;; ; implementations MUST NOT generate
! ;; ; flag-extension flags except as defined by
! ;; ; future standard or standards-track
! ;; ; revisions of this specification.
! ;;
! ;; flag-keyword = atom
! ;;
! ;; resp-text-atom = 1*<any ATOM-CHAR except "]">
!
! (defun imap-response-data-text-code (response)
! (assert (eq (char-after) ?\[))
! (forward-char)
! (cond ((search-forward "PERMANENTFLAGS " nil t)
! (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
! ((search-forward "READ-ONLY" nil t)
! (imap-mailbox-put 'read-only t))
! ((search-forward "UIDNEXT " nil t)
! (imap-mailbox-put 'uidnext (read (current-buffer))))
! ((looking-at "UIDVALIDITY \\([0-9]+\\)")
! (imap-mailbox-put 'uidvalidity (match-string 1)))
! ((search-forward "UNSEEN " nil t)
! (imap-mailbox-put 'unseen (read (current-buffer))))
! ((search-forward "NEWNAME " nil t)
! (let (oldname newname)
! (setq oldname (imap-parse-string))
! (forward-char)
! (setq newname (imap-parse-string))
! (imap-mailbox-put 'newname newname oldname)))
! ((search-forward "TRYCREATE" nil t)
! (imap-mailbox-put 'trycreate t))
! ((search-forward "ALERT] " nil t)
! (message "Imap server %s information: %s"
! imap-server
! (buffer-substring (point)
! (- (point-max) (length imap-server-eol)))))
! (t
! (error "Unknown response code: %s" (read (current-buffer))))))
!
! ;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
! ;; mailbox-data / message-data / capability-data) CRLF
! ;;
! ;; resp-cond-bye = "BYE" SP resp-text
! (defun imap-response-data-bye (response)
! t)
! ;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
! ;; mailbox-data / message-data / capability-data) CRLF
! ;;
! ;; resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text
! ;; ; Status condition
! ;;
! ;; 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 "("
! ;; [status-att SP number *(SP status-att SP number)] ")" /
! ;; number SP "EXISTS" /
! ;; number SP "RECENT"
! ;;
! ;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
! ;;
! ;; capability = "AUTH=" auth-type / atom
! ;; ; New capabilities MUST begin with "X" or be
! ;; ; registered with IANA as standard or
! ;; ; standards-track
! ;;
! ;; capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1"
! ;; *(SP capability)
! ;; ; IMAP4rev1 servers which offer RFC 1730
! ;; ; compatibility MUST list "IMAP4" as the first
! ;; ; capability.
!
! (defun imap-response-data-exists (response)
! (imap-mailbox-put 'exists response))
!
! (defun imap-response-data-expunge (response)
! (imap-mailbox-put 'exists response))
!
! (defun imap-response-data-recent (response)
! (imap-mailbox-put 'recent response))
!
! (defun imap-response-data-capability (response)
! (and (looking-at (concat "[^" imap-server-eol "]+" imap-server-eol))
! (setq imap-capability (read (concat "(" (match-string 0) ")")))))
!
! ;; mailbox = "INBOX" / astring
! ;; ; INBOX is case-insensitive. All case variants of
! ;; ; INBOX (e.g. "iNbOx") MUST be interpreted as INBOX
! ;; ; not as an astring. An astring which consists of
! ;; ; the case-insensitive sequence "I" "N" "B" "O" "X"
! ;; ; is considered to be INBOX and not an astring.
! ;; ; Refer to section 5.1 for further
! ;; ; semantic details of mailbox names.
! ;;
! ;; mailbox-list = "(" [mbx-list-flags] ")" SP
! ;; (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox
! ;;
! ;; mbx-list-flags = *(mbx-list-oflag SP) mbx-list-sflag
! ;; *(SP mbx-list-oflag) /
! ;; mbx-list-oflag *(SP mbx-list-oflag)
! ;;
! ;; mbx-list-oflag = "\Noinferiors" / flag-extension
! ;; ; Other flags; multiple possible per LIST response
! ;;
! ;; mbx-list-sflag = "\Noselect" / "\Marked" / "\Unmarked"
! ;; ; Selectability flags; only one per LIST response
!
! (defun imap-response-data-list (type)
! (let (flags delimiter mailbox)
! (if (looking-at "\\(([^)]*)\\) \\(NIL\\|\"\\(.\\)\\\"\\) ")
! (setq flags (match-string 1)
! delimiter (match-string 3))
! (error "Parse error"))
! (goto-char (match-end 0))
! (setq flags (read (replace-in-string flags "\\\\" "")))
! (if (looking-at "\"?\\([^\r\n\"]+\\)\"?")
! (setq mailbox (match-string 1))
! (error "Parse error"))
! (goto-char (match-end 0))
! (imap-mailbox-put type t mailbox)
! (imap-mailbox-put 'flags flags mailbox)
! (imap-mailbox-put 'delimiter delimiter mailbox)))
!
! (defun imap-response-data-flags (response)
! (imap-mailbox-put 'flags (imap-parse-flag-list)))
!
! ;; msg-att = "(" (msg-att-dynamic / msg-att-static)
! ;; *(SP (msg-att-dynamic / msg-att-static)) ")"
! ;;
! ;; msg-att-dynamic = "FLAGS" SP "(" [flag-fetch *(SP flag-fetch)] ")"
! ;; ; MAY change for a message
! ;;
! ;; flag-fetch = flag / "\Recent"
! ;;
! ;; flag = "\Answered" / "\Flagged" / "\Deleted" /
! ;; "\Seen" / "\Draft" / flag-keyword / flag-extension
! ;; ; Does not include "\Recent"
! ;;
! ;; flag-keyword = atom
! ;;
! ;; flag-extension = "\" atom
! ;; ; Future expansion. Client implementations
! ;; ; MUST accept flag-extension flags. Server
! ;; ; implementations MUST NOT generate
! ;; ; flag-extension flags except as defined by
! ;; ; future standard or standards-track
! ;; ; revisions of this specification.
! ;;
! ;; msg-att-static = "ENVELOPE" SP envelope /
! ;; "INTERNALDATE" SP date-time /
! ;; "RFC822" [".HEADER" / ".TEXT"] SP nstring /
! ;; "RFC822.SIZE" SP number /
! ;; "BODY" ["STRUCTURE"] SP body /
! ;; "BODY" section ["<" number ">"] SP nstring /
! ;; "UID" SP uniqueid
! ;; ; MUST NOT change for a message
! ;;
! ;; section = "[" [section-spec] "]"
! ;;
! ;; section-msgtext = "HEADER" / "HEADER.FIELDS" [".NOT"] SP header-list /
! ;; "TEXT"
! ;; ; top-level or MESSAGE/RFC822 part
! ;;
! ;; section-part = nz-number *("." nz-number)
! ;; ; body part nesting
! ;;
! ;; section-spec = section-msgtext / (section-part ["." section-text])
! ;;
! ;; section-text = section-msgtext / "MIME"
! ;; ; text other than actual body part (headers, etc.)
! ;;
! ;; date-time = DQUOTE date-day-fixed "-" date-month "-" date-year
! ;; SP time SP zone DQUOTE
! ;;
! ;; uniqueid = nz-number
! ;; ; Strictly ascending
!
! (defun imap-response-data-fetch (response)
! ;; we don't know where to store things until we know the UID.
! ;; close your eyes now...
! (save-excursion
! (unless (re-search-forward "UID \\([0-9]+\\)" nil t)
! (error "Can't find UID"))
! (setq imap-current-message (string-to-number (match-string 1))))
! ;; ...you may open them again.
! (imap-message-put imap-current-message 'UID imap-current-message)
! (assert (eq (char-after) ?\())
! (while (not (eq (char-after) ?\)))
! (forward-char)
! (let ((token (read (current-buffer))))
! (forward-char)
! (cond ((eq token 'UID)
! (forward-sexp))
! ((eq token 'FLAGS)
! (imap-message-put imap-current-message 'FLAGS
! (imap-parse-flag-list)))
! ((eq token 'ENVELOPE)
! (imap-message-put imap-current-message 'ENVELOPE
! (imap-parse-envelope)))
! ((eq token 'INTERNALDATE)
! (imap-message-put imap-current-message 'INTERNALDATE
! (read (current-buffer))))
! ((eq token 'RFC822)
! (imap-message-put imap-current-message 'RFC822
! (imap-parse-nstring)))
! ((eq token 'RFC822.HEADER)
! (imap-message-put imap-current-message 'RFC822.HEADER
! (imap-parse-nstring)))
! ((eq token 'RFC822.TEXT)
! (imap-message-put imap-current-message 'RFC822.TEXT
! (imap-parse-nstring)))
! ((eq token 'RFC822.SIZE)
! (imap-message-put imap-current-message 'RFC822.SIZE
! (read (current-buffer))))
! ((eq token 'BODY)
! (imap-message-put imap-current-message 'BODY
! (imap-parse-body)))
! ((eq token 'BODYSTRUCTURE)
! (imap-message-put imap-current-message 'BODYSTRUCTURE
! (imap-parse-body)))
! (t
! (error "Unknown message data: %s" token))))))
!
! (defun imap-response-data-search (response)
! (and (looking-at (concat "[^" imap-server-eol "]+" imap-server-eol))
! (imap-mailbox-put 'search (read (concat "(" (match-string 0) ")")))))
!
! (defun imap-response-data-status (response)
! (assert (eq (char-after) ?\())
! (while (not (eq (char-after) ?\)))
! (forward-char)
! (let ((token (read (current-buffer))))
! (forward-char)
! (cond ((eq token 'MESSAGES)
! (imap-mailbox-put 'MESSAGES (read (current-buffer))))
! ((eq token 'RECENT)
! (imap-mailbox-put 'RECENT (read (current-buffer))))
! ((eq token 'UIDNEXT)
! (imap-mailbox-put 'UIDNEXT (read (current-buffer))))
! ((eq token 'UIDVALIDITY)
! (and (looking-at "[0-9]+")
! (imap-mailbox-put 'UIDVALIDITY (match-string 0))
! (goto-char (match-end 0))))
! ((eq token 'UNSEEN)
! (imap-mailbox-put 'UNSEEN (read (current-buffer))))
! (t
! (error "Unknown status data: %s" token))))))
!
! ;; flag-list = "(" [flag *(SP flag)] ")"
! ;;
! ;; flag = "\Answered" / "\Flagged" / "\Deleted" /
! ;; "\Seen" / "\Draft" / flag-keyword / flag-extension
! ;; ; Does not include "\Recent"
! ;;
! ;; flag-keyword = atom
! ;;
! ;; flag-extension = "\" atom
! ;; ; Future expansion. Client implementations
! ;; ; MUST accept flag-extension flags. Server
! ;; ; implementations MUST NOT generate
! ;; ; flag-extension flags except as defined by
! ;; ; future standard or standards-track
! ;; ; revisions of this specification.
!
! (defun imap-parse-flag-list ()
! (when (looking-at "([^)]*)")
! (goto-char (match-end 0))
! (read (replace-in-string (match-string 0) "\\\\" "\\\\\\\\"))))
!
! ;; envelope = "(" env-date SP env-subject SP env-from SP env-sender SP
! ;; env-reply-to SP env-to SP env-cc SP env-bcc SP
! ;; env-in-reply-to SP env-message-id ")"
! ;;
! ;; env-bcc = "(" 1*address ")" / nil
! ;;
! ;; env-cc = "(" 1*address ")" / nil
! ;;
! ;; env-date = nstring
! ;;
! ;; env-from = "(" 1*address ")" / nil
! ;;
! ;; env-in-reply-to = nstring
! ;;
! ;; env-message-id = nstring
! ;;
! ;; env-reply-to = "(" 1*address ")" / nil
! ;;
! ;; env-sender = "(" 1*address ")" / nil
! ;;
! ;; env-subject = nstring
! ;;
! ;; env-to = "(" 1*address ")" / nil
!
! (defun imap-parse-envelope ()
! ;; xxx: does not handle literals
! (read (current-buffer)))
!
! ;; body = "(" body-type-1part / body-type-mpart ")"
! ;;
! ;; body-extension = nstring / number /
! ;; "(" body-extension *(SP body-extension) ")"
! ;; ; Future expansion. Client implementations
! ;; ; MUST accept body-extension fields. Server
! ;; ; implementations MUST NOT generate
! ;; ; body-extension fields except as defined by
! ;; ; future standard or standards-track
! ;; ; revisions of this specification.
! ;;
! ;; body-ext-1part = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
! ;; *(SP body-extension)]]
! ;; ; MUST NOT be returned on non-extensible
! ;; ; "BODY" fetch
! ;;
! ;; body-ext-mpart = body-fld-param [SP body-fld-dsp [SP body-fld-lang
! ;; *(SP body-extension)]]
! ;; ; MUST NOT be returned on non-extensible
! ;; ; "BODY" fetch
! ;;
! ;; body-fields = body-fld-param SP body-fld-id SP body-fld-desc SP
! ;; body-fld-enc SP body-fld-octets
! ;;
! ;; body-fld-desc = nstring
! ;;
! ;; body-fld-dsp = "(" string SP body-fld-param ")" / nil
! ;;
! ;; body-fld-enc = (DQUOTE ("7BIT" / "8BIT" / "BINARY" / "BASE64"/
! ;; "QUOTED-PRINTABLE") DQUOTE) / string
! ;;
! ;; body-fld-id = nstring
! ;;
! ;; body-fld-lang = nstring / "(" string *(SP string) ")"
! ;;
! ;; body-fld-lines = number
! ;;
! ;; body-fld-md5 = nstring
! ;;
! ;; body-fld-octets = number
! ;;
! ;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
! ;;
! ;; body-type-1part = (body-type-basic / body-type-msg / body-type-text)
! ;; [SP body-ext-1part]
! ;;
! ;; body-type-basic = media-basic SP body-fields
! ;; ; MESSAGE subtype MUST NOT be "RFC822"
! ;;
! ;; body-type-mpart = 1*body SP media-subtype
! ;; [SP body-ext-mpart]
! ;;
! ;; body-type-msg = media-message SP body-fields SP envelope
! ;; SP body SP body-fld-lines
! ;;
! ;; body-type-text = media-text SP body-fields SP body-fld-lines
! ;;
! ;; media-basic = ((DQUOTE ("APPLICATION" / "AUDIO" / "IMAGE" / "MESSAGE" /
! ;; "VIDEO") DQUOTE) / string) SP media-subtype
! ;; ; Defined in [MIME-IMT]
!
! ;; ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 7415 213)
! ;; (("TEXT" "PLAIN" ("CHARSET" "US-ASCII") NIL NIL "7BIT" 9 2)(("TEXT" "PLAIN" ("CHARSET" "US-ASCII") NIL NIL "7BIT" 8 2)("IMAGE" "GIF" NIL NIL NIL "BASE64" 2802) "ALTERNATIVE")("TEXT" "PLAIN" NIL NIL NIL "7BIT" 7 1) "MIXED")
! ;; (("IMAGE" "JPEG" NIL NIL NIL "BASE64" 1222)("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 2 1)(("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 21 2)("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 20 2)(("IMAGE" "JPEG" NIL NIL NIL "BASE64" 1222) "MIXED") "ALTERNATIVE")("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 111 5) "MIXED")
!
! (defun imap-parse-body ()
! ;; xxx: does not handle literals
! (read (current-buffer)))
!
! ;; atom = 1*ATOM-CHAR
! ;;
! ;; ATOM-CHAR = <any CHAR except atom-specials>
! ;;
! ;; atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards /
! ;; quoted-specials
! ;;
! ;; list-wildcards = "%" / "*"
! ;;
! ;; quoted-specials = DQUOTE / "\"
!
! (defun imap-parse-atom ()
! (and (looking-at "[^(){ %*\"\\\r\n]+") ;; xxx: CTL
! (intern (match-string 0))))
!
! ;; astring = atom / string
!
! (defun imap-parse-astring ()
! (or (imap-parse-atom)
! (imap-parse-string)))
!
! ;; nil = "NIL"
! ;;
! ;; nstring = string / nil
!
! (defun imap-parse-nstring ()
! (let ((str (imap-parse-string)))
! (if (string= "NIL" str)
! nil
! str)))
!
! ;; string = quoted / literal
!
! (defun imap-parse-string ()
! (or (imap-parse-quoted)
! (imap-parse-literal)))
!
! ;; quoted = DQUOTE *QUOTED-CHAR DQUOTE
! ;;
! ;; QUOTED-CHAR = <any TEXT-CHAR except quoted-specials> /
! ;; "\" quoted-specials
! ;;
! ;; quoted-specials = DQUOTE / "\"
! ;;
! ;; TEXT-CHAR = <any CHAR except CR and LF>
!
! (defun imap-parse-quoted ()
! (and (looking-at "\"\\([^\r\n]*\\)\"")
! (match-string 1)))
!
! ;; literal = "{" number "}" CRLF *CHAR8
! ;; ; Number represents the number of CHAR8s
!
! (defun imap-parse-literal ()
! (when (looking-at "{\\([0-9]+\\)}\r\n")
! (let ((pos (match-end 0))
! (len (string-to-number (match-string 1))))
! (if (< (point-max) (+ pos len))
! nil
! (goto-char (+ pos len))
! (buffer-substring pos (+ pos len))))))
!
! ;; Utility functions.
(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 (load "passwd" t)
***************
*** 935,1265 ****
(autoload 'ange-ftp-read-passwd "ange-ftp"))
'ange-ftp-read-passwd) prompt)))
! (defun imap-arrival-filter (proc string)
! "Process filter for imap process. Stow the string, then call the routines
! to try to handle any input. We need this because we're not guaranteed to
! receive the whole thing at once."
! (with-current-buffer (process-buffer proc)
! (goto-char (point-max))
! (insert string)
! ;; Keep a log of server tranactions in `imap-log'
! (when imap-log
! (with-current-buffer (get-buffer-create imap-log)
! (goto-char (point-max))
! (insert string)))
! (let (end)
! ;; Find compete server line
! (while (setq end (imap-find-next-line))
! (save-restriction
! ;; Restrict to it
! (narrow-to-region (point-min) end)
! ;; Parse and then dispatch
! (unwind-protect (apply 'imap-dispatch (imap-parse-line))
! ;; Delete it ensuring that the parser doesn't get out of
! ;; sync on errors by leaving half parsed stuff around
! (delete-region (point-min) (point-max))))))))
!
! ;;; Callback dispatching
!
! (defun imap-get-cb (name)
! "Get the callback associated with the given result type, or use the default."
! (cdr (or (assoc name imap-cb-function-alist)
! (assoc 'default imap-cb-function-alist))))
!
! (defun imap-dispatch (tag response &rest data)
! "Take the parsed IMAP sludge and figure out who can deal with it. When
! the guy is found, send it to him to process."; Tag Response Data
! (unless (eq tag '+)
! (apply (imap-get-cb (if (numberp response) ; Ex: * 3 EXISTS
! (car data) ; Ex: A25 OK LOGIN
! response)) ; Ex: * SEARCH 1 2 3
! (cons response data))) ; allow callee to decide the number of args
! (if (not (eq tag '*))
! (let ((fn (assoc (symbol-name tag) imap-cb-tag-alist)))
! (setq imap-last-status data) ; Yuck
! (if (not fn)
! (error "No callback for %s" (symbol-name tag))
! (funcall (cdr fn) tag response data)
! ;; (apply (cdr fn) (list tag response data))
! (setq imap-cb-tag-alist
! (remassoc (symbol-name tag) imap-cb-tag-alist))))))
!
! ;;; IMAP Notes:
! ;;; o RESPONSE is one of (OK NO BAD PREAUTH BYE)
! ;;; o TAG is a unique identifier for COMMAND
! ;;; o Response to TAG/COMMAND has matching TAG/COMMAND
! ;;; o TEXT is an unquoted human readable string
! ;;; o DATA is parenthesized list of lists of space separated literals or
! ;;; quoted strings
! ;;; o quoted strings are either {LENGTH}\r\nUNQUOTED_DATA
! ;;; or a "" string with with '\' quoting.
! ;;; We assume that if something need quoting the server would use {} not ""
! ;;; o literals have no spaces and can contain '\'s.
! ;;; o CODE is one of (TRYCREATE READ-ONLY ALERT ...)
!
! ;;; Grammar (condensed)
! ;;; IMAP command
! ;;; TAG COMMAND DATA*
! ;;; IMAP responses
! ;;; + TEXT
! ;;; TAG RESPONSE [CODE DATA?] COMMAND TEXT
! ;;; * RESPONSE [CODE DATA?] TEXT
! ;;; * WORD DATA*
! ;;; * NUMBER WORD
!
!
!
! ;;; Basic tokenizing and parsing
! ;;; Well--not really. Listen up, this is sort of gross. What we do is
! ;;; scan across the input, munching as we go. We convert anything
! ;;; unfriendly to something friendlier (usually \ it), then use (read)
! ;;; to gobble up the input.
! ;;; I told you it was gross.
!
! (defun imap-find-next-line ()
! "Find the next available input into the buffer. This is similar to the
! actual scanning code, except that it doesn't munch or read anything. All
! it does is verify that there's a complete response in the buffer, and return
! the position of the end of the response. If there is no complete response,
! this returns nil."
! (goto-char (point-min))
! (let ((finished nil)
! (jump-amount nil)
! (return-val nil))
! ;; We're looking for three things--
! ;; {num} is a string literal--skip it.
! ;; "..." is a string--skip it, too.
! ;; CRLF is what we see (not in a string) when we're done.
! (while (and (not finished)
! (re-search-forward
! "\"[^\"]*\"\\|\r\n\\|{\\([^}]+\\)}" nil t))
! (and (match-string 1)
! (setq jump-amount (string-to-number (match-string 1))))
! (cond ((eq (preceding-char) ?\n)
! (setq finished t)
! (setq return-val (point)))
! ((eq (preceding-char) ?\})
! (if (< (point-max)
! (+ (point) jump-amount 2))
! (setq finished t)
! (goto-char (+ (point) jump-amount 2))))))
! return-val))
!
! (defun imap-parse-line ()
!
! ;; Parse one server response. We do translations to buffer so we
! ;; can use `read'. We quote the UIDVALIDITY number to avoid 28-bit
! ;; integer limitations. Quotes [] into {} so that things like
! ;; BODY[HEADER] are one symbol, backslashify things, turn CRLF into
! ;; LF. Call this at the start of the block to suck in, narrowed to
! ;; the entirety of the block (you should know the end of it...).
!
! ;; The only place we could have a problem is in the arbitrary TEXT
! ;; following a status response. So we quote that first, and be
! ;; sure to remove all " and \'s that we can't handle.
!
! (let ((leave-brackets 0))
! (goto-char (point-min))
! (insert "(")
! (when (re-search-forward
! "\\=\\(\\(\\+\\)\\|[^ ]+ +\\(OK\\|NO\\|BAD\\|PREAUTH\\|BYE\\)\\( +\\[.*?\\]\\)?\\) *"
! nil t)
! (unless (or (match-string 2) (match-string 4))
! (insert "[] "))
! (setq leave-brackets (if (match-string 3) (point-marker) (point-min-marker)))
! (save-restriction
! (narrow-to-region (point) (- (point-max) 2))
! (insert "\"")
! (while (re-search-forward "\\\\\\|\"" nil 00)
! (replace-match "")) ; xxx
! (insert "\""))
! (goto-char (point-min)))
! (goto-char (- (point-max) 2))
! (insert ")")
! (goto-char (point-min))
! (let ((finished nil)
! (jump-amount nil))
! (while (and (not finished)
! (re-search-forward
! (mapconcat 'identity
! '("\"[^\"]*\"" ; quoted strings
! "\\[\\|\\]" ; [] characters
! "\\(UIDVALIDITY\\|COPYUID\\|APPENDUID\\) \\([0123456789]+\\)"
! "\\." ; . characters
! "\\#" ; # characters
! "\\\\" ; \ characters
! "\r\n" ; CRLF
! "{\\([^}]+\\)}") ; string literals
! "\\|") nil t)) ; regexp or
! (and (match-string 3)
! (setq jump-amount (string-to-number (match-string 3))))
! (let ((pc (preceding-char)))
! (cond ((eq pc ?\n)
! (setq finished t))
! ((member pc '(?\\ ?. ?#))
! (backward-char)
! (insert "\\")
! (forward-char))
! ((and (eq pc ?\[) (> (point) leave-brackets))
! (replace-match "{"))
! ((and (eq pc ?\]) (> (point) leave-brackets))
! (replace-match "}"))
! ((and (>= pc ?0)
! (<= pc ?9))
! ;; replace numbers too big for emacs with strings
! (replace-match "\\1 \"\\2\""))
! ((eq pc ?\})
! (delete-region (match-beginning 0) (match-end 0))
! (delete-char 2)
! (save-restriction;; save-res is good; we change buffer size.
! (narrow-to-region (point) (+ (point) jump-amount))
! (insert "\"")
! (while (re-search-forward "\\\\\\|\"" nil 00)
! (replace-match "\\\\\\&"))
! (goto-char (point-min))
! (while (search-forward "\r\n" nil 00)
! (replace-match "\n" nil t))
! (insert "\"")))))))
! (goto-char (point-min))
!
! (and imap-last
! (let ((buffer (current-buffer)))
! (with-current-buffer (get-buffer-create imap-last)
! (buffer-disable-undo)
! (imap-disable-multibyte)
! (erase-buffer)
! (insert-buffer-substring buffer))))
!
! (read (current-buffer))))
!
! (defun imap-cb-default (&rest a)
! (error "Default Callback Called %s" a))
!
! (defun imap-cb-list (code taglist delim name-symbol-or-string)
! (let ((name (if (symbolp name-symbol-or-string)
! (symbol-name name-symbol-or-string)
! name-symbol-or-string)))
! (imap-folder-set 'flags (mapcar 'symbol-name taglist) name)
! (imap-folder-set 'delimiter delim name)
! (when (eq code 'LSUB)
! (imap-folder-set 'subbed t name))))
!
! (defun imap-cb-flags (code flags)
! (imap-folder-set 'list-flags (mapcar 'symbol-name flags)))
!
! (defun imap-message-to-string (message)
! (if (numberp message)
! (format "\\%s" message)
! message))
!
! (defun imap-message-plist (id &optional buffer)
! "Set PROP to VALUE for message ID in buffer."
! (with-current-buffer (or buffer (current-buffer))
! (object-plist (intern (imap-message-plist id) imap-message-data))))
!
! (defun imap-message-map (func prop &optional buffer)
! "Call (func UID VALUE) for each message in `imap-message-data'.
! VALUE is the value of PROP for each message."
! (with-current-buffer (or buffer (current-buffer))
! (mapatoms
! (lambda (s)
! (funcall func (get s 'UID) (get s prop)))
! imap-message-data)))
!
! (defun imap-message-set (id prop value &optional buffer)
! "Set PROP to VALUE for message ID in buffer."
! (with-current-buffer (or buffer (current-buffer))
! (put (intern (imap-message-to-string id) imap-message-data) prop value)))
!
! (defun imap-message-get (id prop &optional buffer)
! "Get PROP for message ID in BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (get (intern (imap-message-to-string id) imap-message-data) prop)))
!
! ; Fetches MUST include (UID) otherwise we can't store the results.
! ; NUM is always the logical message number not the UID. We ignore it.
! (defun imap-cb-fetch (num fetch data)
! "Set `imap-current-message', Set all of the prop/value pairs
! in `imap-message-data'."
! (when imap-cb-fetch-hook
! (funcall imap-cb-fetch-hook num fetch data))
! ; (check-valid-plist data) ; Remove me when you have confidence???
! (setq data (destructive-plist-to-alist data))
! ;; All fetches should have used UID FETCH so UID should exist.
! ;; UID STORE will not have a UID in the data, in this case the UID is num
! (setq imap-current-message (or (cdr (assoc 'UID data)) num))
! (mapc (lambda (c) (imap-message-set imap-current-message (car c) (cdr c)))
! data))
!
! (defun imap-cb-search (search &rest found)
! ;; For some reason found doesn't have parens so we need the &rest
! (imap-folder-set 'search found))
!
! (defun imap-cb-status (code folder statuses)
! ; (check-valid-plist statuses)
! (mapc (lambda (c) (imap-folder-set (car c) (cdr c) (symbol-name folder)))
! (destructive-plist-to-alist statuses)))
!
! (defun imap-cb-numbered (number code) ; These are just numbers not UIDs
! (cond ((eq 'EXISTS code)
! (imap-folder-set 'EXISTS number))
! ((eq 'RECENT code)
! (imap-folder-set 'RECENT number))))
!
! (defun imap-cb-bye (bye nothing string)
! "Called on BYE. This is most likely an autologout. Clean up."
! ;; Do something here???
! )
!
! (defun imap-cb-response (response code string)
! (setq code (append code '()))
! (let ((var (car code))
! (value (cadr code)))
! ;; missing NEWNAME, PARSE
! (when var
! (cond ((equal var 'ALERT)
! (y-or-n-p (concat "IMAP: ALERT! " string)))
! ((equal var 'APPENDUID) ;; xxx: set in mailbox we're appending to
! (imap-folder-set 'appenduid (cons value (caddr code))
! (or imap-current-folder
! "uGlYHacK")))
! ((equal var 'PERMANENTFLAGS)
! (imap-folder-set 'permanentflags (mapcar 'symbol-name value)))
! ((equal var 'READ-ONLY)
! (imap-folder-set 'writable nil))
! ((equal var 'READ-WRITE)
! (imap-folder-set 'writable t))
! ((equal var 'TRYCREATE)
! (message "IMAP: %s %s" code string))
! ((equal var 'UIDNEXT)
! (imap-folder-set 'uidnext value))
! ((equal var 'UIDNOTSTICKY)
! (imap-folder-set 'uidnotsticky value))
! ((equal var 'UNSEEN)
! (imap-folder-set 'unseen value))
! ((equal var 'UIDVALIDITY) ; We should wipe cache clean here only???
! (imap-folder-set 'uidvalidity value))
! ((equal var 'COPYUID)
! (imap-folder-set 'copyuid value))
! (t (error "IMAP: Unknown response code: %s %s" code string))))))
!
! (defun imap-cb-tag-default (tag response data)
! "This will put args on `imap-cb-finished-tags' for `imap-wait-for-tag'."
! (let ((stats (list response data)))
! (setq imap-cb-finished-tags (cons (cons (symbol-name tag) stats)
! imap-cb-finished-tags))))
!
! (defun imap-wait-for-tag (tag &optional bail)
! "Wait for TAG to complete by calling `imap-cb-tag-default' and return
! its args. Stop waiting if BAIL is seen"
! (let (data bailed)
! (while (when (not (or (setq data (assoc tag imap-cb-finished-tags))
! (setq bailed (assoc bail imap-cb-finished-tags))))
! (accept-process-output imap-process)))
! (unless (or data bailed)
! (message "IMAP: Timed out waiting for %s" tag))
! (when (or data bailed)
! (setq imap-cb-finished-tags (remassoc tag imap-cb-finished-tags))
! (cdr data))))
!
(provide 'imap)
--- 1254,1337 ----
(autoload 'ange-ftp-read-passwd "ange-ftp"))
'ange-ftp-read-passwd) prompt)))
! (when imap-debug ; (untrace-all)
! (require 'trace)
! (buffer-disable-undo (get-buffer-create imap-debug))
! (mapc (lambda (f) (trace-function-background f imap-debug))
! '(
! imap-kerberos4s-p
! imap-kerberos4-open
! imap-ssl-p
! imap-ssl-open-1
! imap-ssl-open
! imap-network-p
! imap-network-open
! imap-interactive-login
! imap-kerberos4a-p
! imap-kerberos4-auth
! imap-cram-md5-p
! imap-cram-md5-auth
! imap-login-p
! imap-login-auth
! imap-anonymous-p
! imap-anonymous-open
! imap-open-1
! imap-open
! imap-opened
! imap-authenticate
! imap-close
! imap-capability
! imap-namespace
! imap-mailbox-put
! imap-mailbox-get
! imap-mailbox-map
! imap-mailbox-select
! imap-mailbox-unselect
! imap-mailbox-close
! imap-mailbox-lsub
! imap-mailbox-list
! imap-mailbox-subscribe
! imap-mailbox-unsubscribe
! imap-message-put
! imap-message-get
! imap-message-map
! imap-search
! imap-message-flags-set
! imap-message-flags-del
! imap-message-flags-add
! imap-send-command
! imap-wait-for-tag
! imap-ok-p
! imap-send-command-wait
! imap-sentinel
! imap-find-next-line
! imap-arrival-filter
! imap-parse-greeting
! imap-parse-response
! imap-response-data-text-code
! imap-response-data-bye
! imap-response-data-exists
! imap-response-data-expunge
! imap-response-data-recent
! imap-response-data-capability
! imap-response-data-list
! imap-response-data-flags
! imap-response-data-fetch
! imap-response-data-search
! imap-response-data-status
! imap-parse-base64
! imap-parse-continue-req
! imap-parse-flag-list
! imap-parse-envelope
! imap-parse-body
! imap-parse-atom
! imap-parse-astring
! imap-parse-nstring
! imap-parse-string
! imap-parse-quoted
! imap-parse-literal
! imap-parse-text
! imap-read-passwd
! )))
!
(provide 'imap)
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.101.4.1 nnimap/nnimap.el:1.107
*** nnimap/nnimap.el:1.101.4.1 Thu Dec 17 19:51:26 1998
--- nnimap/nnimap.el Thu Dec 17 20:44:34 1998
***************
*** 96,102 ****
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.83")
;; Various server variables.
--- 96,102 ----
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.84")
;; Various server variables.
***************
*** 399,405 ****
(insert (format "Chars: %d\n" size))
(insert (format "Lines: %d\n" lines))
(insert header)
! (delete-char -1)
(insert ".\n")))))
uncompressed)
'headers))))
--- 399,405 ----
(insert (format "Chars: %d\n" size))
(insert (format "Lines: %d\n" lines))
(insert header)
! (delete-char -2)
(insert ".\n")))))
uncompressed)
'headers))))
***************
*** 539,546 ****
;; clear message data, we won't necesserily have to do this if
;; it weren't for buggy CCmail (we can't know how many tagged
;; responses were returned otherwise).
! (imap-message-reset)
! (let ((exists (imap-folder-get 'EXISTS))
articles)
(if (eq 0 exists)
(setq articles '(0))
--- 539,546 ----
;; clear message data, we won't necesserily have to do this if
;; it weren't for buggy CCmail (we can't know how many tagged
;; responses were returned otherwise).
! ;(imap-message-reset)
! (let ((exists (imap-mailbox-get 'EXISTS))
articles)
(if (eq 0 exists)
(setq articles '(0))
***************
*** 585,591 ****
;;; Returns: GROUP HIGHEST LOWEST [ynmxj=]
(defun nnimap-request-list-mapper (group)
! (unless (or (member "\\NoSelect" (imap-folder-get 'flags group))
;; We ignore groups with spaces (Gnus can't handle them)
(string-match " " group))
(let (high)
--- 585,591 ----
;;; Returns: GROUP HIGHEST LOWEST [ynmxj=]
(defun nnimap-request-list-mapper (group)
! (unless (or (member "\\NoSelect" (imap-mailbox-get 'flags group))
;; We ignore groups with spaces (Gnus can't handle them)
(string-match " " group))
(let (high)
***************
*** 593,606 ****
(cond
((eq nnimap-group-list-speed 'slow)
(when (imap-mailbox-select group)
! (let ((exists (imap-folder-get 'EXISTS))
articles)
(if (eq 0 exists)
(with-current-buffer nntp-server-buffer
(insert (format "%s 0 1 y\n" group))
t)
;; if it weren't for buggy CCmail we needn't reset
! (imap-message-reset)
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
(push uid articles)) 'UID)
--- 593,606 ----
(cond
((eq nnimap-group-list-speed 'slow)
(when (imap-mailbox-select group)
! (let ((exists (imap-mailbox-get 'EXISTS))
articles)
(if (eq 0 exists)
(with-current-buffer nntp-server-buffer
(insert (format "%s 0 1 y\n" group))
t)
;; if it weren't for buggy CCmail we needn't reset
! ;(imap-message-reset)
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
(push uid articles)) 'UID)
***************
*** 625,631 ****
(when (nnimap-ok-p (nnimap-send-command-wait
(concat "STATUS " group
" (UIDNEXT)")))
! (setq high (1- (imap-folder-get 'UIDNEXT group)))
(with-current-buffer nntp-server-buffer
(insert (format "%s %d 1 y\n" group high))
t)))
--- 625,631 ----
(when (nnimap-ok-p (nnimap-send-command-wait
(concat "STATUS " group
" (UIDNEXT)")))
! (setq high (1- (imap-mailbox-get 'UIDNEXT group)))
(with-current-buffer nntp-server-buffer
(insert (format "%s %d 1 y\n" group high))
t)))
***************
*** 639,647 ****
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p) (if (consp p)
! (cons (concat "\"" (car p) "\"")
! (concat "\"" (cdr p) "\""))
! (cons "\"\"" (concat "\"" p "\""))))
(if (and (listp pattern)
(listp (cdr pattern)))
pattern
--- 639,647 ----
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p) (if (consp p)
! (cons (car p)
! (cdr p))
! (cons nil p)))
(if (and (listp pattern)
(listp (cdr pattern)))
pattern
***************
*** 656,669 ****
pattern)
(gnus-message 5 "Generating active list for %s" server)
(while (setq pattern (pop patterns))
! (nnimap-ok-p (nnimap-send-command-wait
! (concat nnimap-list-method " "
! (car pattern) " "
! (cdr pattern))))))
! (let ((nnimap-group-list-speed 'fast))
! (imap-mailbox-map 'nnimap-request-list-mapper))
t)))
-
;;; IMAP doesn't support posting, but this must be defined
(deffoo nnimap-request-post (&optional server)
--- 656,665 ----
pattern)
(gnus-message 5 "Generating active list for %s" server)
(while (setq pattern (pop patterns))
! (imap-mailbox-list nil (cdr pattern) t (car pattern))
! (let ((nnimap-group-list-speed 'fast))
! (imap-mailbox-map 'nnimap-request-list-mapper))))
t)))
;;; IMAP doesn't support posting, but this must be defined
(deffoo nnimap-request-post (&optional server)
***************
*** 735,741 ****
(mapc (lambda (pred)
(when (and (nnimap-mark-permanent-p (cdr pred))
(member (nnimap-mark-to-flag (cdr pred))
! (imap-folder-get 'list-flags)))
(gnus-info-set-marks
info
(nnimap-update-alist-soft
--- 731,737 ----
(mapc (lambda (pred)
(when (and (nnimap-mark-permanent-p (cdr pred))
(member (nnimap-mark-to-flag (cdr pred))
! (imap-mailbox-get 'list-flags)))
(gnus-info-set-marks
info
(nnimap-update-alist-soft
***************
*** 991,1008 ****
nnimap-server-buffer)))
(with-current-buffer (current-buffer)
(goto-char (point-min))
! (unless (string= "\n" imap-eol)
(while (re-search-forward "\n" nil t)
! (replace-match imap-eol))))
(when (nnimap-ok-p (nnimap-send-command-wait
;; Optional flags,date???
(list (concat "APPEND " group " ")
(current-buffer))
nnimap-server-buffer))
(let ((high (if (imap-capability 'UIDPLUS nnimap-server-buffer)
! (cdr (imap-folder-get 'appenduid "uGlYHacK"
nnimap-server-buffer))
! (imap-folder-get 'UIDNEXT group
nnimap-server-buffer))))
(when high
(cons group high)))))))
--- 987,1004 ----
nnimap-server-buffer)))
(with-current-buffer (current-buffer)
(goto-char (point-min))
! (unless (string= "\n" imap-client-eol)
(while (re-search-forward "\n" nil t)
! (replace-match imap-client-eol))))
(when (nnimap-ok-p (nnimap-send-command-wait
;; Optional flags,date???
(list (concat "APPEND " group " ")
(current-buffer))
nnimap-server-buffer))
(let ((high (if (imap-capability 'UIDPLUS nnimap-server-buffer)
! (cdr (imap-mailbox-get 'appenduid nil
nnimap-server-buffer))
! (imap-mailbox-get 'UIDNEXT group
nnimap-server-buffer))))
(when high
(cons group high)))))))
***************
*** 1097,1104 ****
"Return t iff MARK can be permanently (between IMAP sessions) saved
on articles, in GROUP."
(with-current-buffer nnimap-server-buffer
! (or (member "\\*" (imap-folder-get 'permanentflags group))
! (member (nnimap-mark-to-flag mark) (imap-folder-get 'permanentflags
group)))))
(defun nnimap-update-alist-soft (key value alist)
--- 1093,1100 ----
"Return t iff MARK can be permanently (between IMAP sessions) saved
on articles, in GROUP."
(with-current-buffer nnimap-server-buffer
! (or (member "\\*" (imap-mailbox-get 'permanentflags group))
! (member (nnimap-mark-to-flag mark) (imap-mailbox-get 'permanentflags
group)))))
(defun nnimap-update-alist-soft (key value alist)
***************
*** 1133,1148 ****
(imap-send-command-wait command buffer))
(defun nnimap-ok-p (status)
! (if status
! (if (imap-ok-p status)
! t
! (nnheader-report 'nnimap (cdr status)))
! (nnheader-report 'nnimap (format "IMAP Command Timed Out"))))
(defun nnimap-expunge-close-group (&optional server)
(with-current-buffer nnimap-server-buffer
(when (and (nnimap-possibly-change-server server)
! imap-current-folder)
(cond ((eq nnimap-expunge-on-close 'always)
(when nnimap-need-expunge
(setq nnimap-need-expunge nil)
--- 1129,1140 ----
(imap-send-command-wait command buffer))
(defun nnimap-ok-p (status)
! (imap-ok-p status))
(defun nnimap-expunge-close-group (&optional server)
(with-current-buffer nnimap-server-buffer
(when (and (nnimap-possibly-change-server server)
! imap-current-mailbox)
(cond ((eq nnimap-expunge-on-close 'always)
(when nnimap-need-expunge
(setq nnimap-need-expunge nil)
***************
*** 1153,1163 ****
((eq nnimap-expunge-on-close 'ask)
(when (imap-search "DELETED")
(if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
! imap-current-folder))
(and (nnimap-ok-p (nnimap-send-command-wait "EXPUNGE"))
(imap-mailbox-close))
(imap-mailbox-unselect)))))))
! (not imap-current-folder))
(defun nnimap-possibly-change-server (server)
"Change to server SERVER if needed (open it if it's closed). If SERVER is
--- 1145,1155 ----
((eq nnimap-expunge-on-close 'ask)
(when (imap-search "DELETED")
(if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
! imap-current-mailbox))
(and (nnimap-ok-p (nnimap-send-command-wait "EXPUNGE"))
(imap-mailbox-close))
(imap-mailbox-unselect)))))))
! (not imap-current-mailbox))
(defun nnimap-possibly-change-server (server)
"Change to server SERVER if needed (open it if it's closed). If SERVER is
***************
*** 1172,1184 ****
(when group
(let ((groupname (gnus-group-normally-qualified
'nnimap server group)))
! (if (and imap-current-folder
! (not (string= group imap-current-folder)))
(nnimap-expunge-close-group))
(when (imap-mailbox-select group nil
(gnus-ephemeral-group-p groupname))
;; check/set UIDVALIDITY
! (let ((new-uid (imap-folder-get 'uidvalidity))
(old-uid (gnus-group-get-parameter groupname 'uidvalidity))
(info (gnus-get-info groupname)))
(if (not old-uid)
--- 1164,1176 ----
(when group
(let ((groupname (gnus-group-normally-qualified
'nnimap server group)))
! (if (and imap-current-mailbox
! (not (string= group imap-current-mailbox)))
(nnimap-expunge-close-group))
(when (imap-mailbox-select group nil
(gnus-ephemeral-group-p groupname))
;; check/set UIDVALIDITY
! (let ((new-uid (imap-mailbox-get 'uidvalidity))
(old-uid (gnus-group-get-parameter groupname 'uidvalidity))
(info (gnus-get-info groupname)))
(if (not old-uid)
***************
*** 1192,1198 ****
(message "UIDVALIDITY clash. Old value `%s', new `%s'"
old-uid new-uid)
(imap-mailbox-unselect))))))))
! imap-current-folder)))
;;; Gnus functions
--- 1184,1190 ----
(message "UIDVALIDITY clash. Old value `%s', new `%s'"
old-uid new-uid)
(imap-mailbox-unselect))))))))
! imap-current-mailbox)))
;;; Gnus functions
***************
*** 1225,1234 ****
(unless (imap-capability 'ACL nnimap-server-buffer)
(error "Your server does not support ACL editing"))
(gnus-edit-form (with-current-buffer nnimap-server-buffer
! (imap-folder-set 'acl nil mailbox)
(nnimap-send-command-wait (format "GETACL %s" mailbox))
(setq acl (destructive-plist-to-alist
! (imap-folder-get 'acl mailbox))))
(format "Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
--- 1217,1226 ----
(unless (imap-capability 'ACL nnimap-server-buffer)
(error "Your server does not support ACL editing"))
(gnus-edit-form (with-current-buffer nnimap-server-buffer
! (imap-mailbox-put 'acl nil mailbox)
(nnimap-send-command-wait (format "GETACL %s" mailbox))
(setq acl (destructive-plist-to-alist
! (imap-mailbox-get 'acl mailbox))))
(format "Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
***************
*** 1303,1312 ****
(let* ((new-read (gnus-info-read new-info))
(old-read (gnus-info-read old-info))
! (add (gnus-remove-from-range new-read (gnus-uncompress-range
! old-read)))
! (del (gnus-remove-from-range old-read (gnus-uncompress-range
! new-read))))
(if add
(push (list add 'add '(read)) delta-marks))
(if del
--- 1295,1302 ----
(let* ((new-read (gnus-info-read new-info))
(old-read (gnus-info-read old-info))
! (add (gnus-remove-from-range new-read old-read))
! (del (gnus-remove-from-range old-read new-read)))
(if add
(push (list add 'add '(read)) delta-marks))
(if del
***************
*** 1321,1330 ****
(unless (memq type '(cache score bookmark))
(setq old-mark (cdr (assq type (gnus-info-marks old-info)))
new-mark (cdr (assq type (gnus-info-marks new-info)))
! add (gnus-remove-from-range new-mark (gnus-uncompress-range
! old-mark))
! del (gnus-remove-from-range old-mark (gnus-uncompress-range
! new-mark)))
(if add
(push (list add 'add (list type)) delta-marks))
(if del
--- 1311,1318 ----
(unless (memq type '(cache score bookmark))
(setq old-mark (cdr (assq type (gnus-info-marks old-info)))
new-mark (cdr (assq type (gnus-info-marks new-info)))
! add (gnus-remove-from-range new-mark old-mark)
! del (gnus-remove-from-range old-mark new-mark))
(if add
(push (list add 'add (list type)) delta-marks))
(if del
Index: nnimap/nnimap.texi
diff -c nnimap/nnimap.texi:1.16 nnimap/nnimap.texi:1.18
*** nnimap/nnimap.texi:1.16 Fri Dec 4 06:44:42 1998
--- nnimap/nnimap.texi Thu Dec 17 20:45:55 1998
***************
*** 7,14 ****
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
! @set NNIMAP-VERSION 0.33
@ifinfo
This file documents nnimap, an Emacs Lisp package for accessing
--- 7,14 ----
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
! @set NNIMAP-VERSION 0.84
@ifinfo
This file documents nnimap, an Emacs Lisp package for accessing
***************
*** 176,182 ****
(nnimap-address "cyrus.andrew.cmu.edu")
(nnimap-list-pattern ("INBOX" "archive.*")))
(nnimap "yoyo"
! (nnimap-auth-method cram-md5)
(nnimap-address "your.mail.server"))))
@end lisp
--- 176,182 ----
(nnimap-address "cyrus.andrew.cmu.edu")
(nnimap-list-pattern ("INBOX" "archive.*")))
(nnimap "yoyo"
! (nnimap-stream ssl)
(nnimap-address "your.mail.server"))))
@end lisp
***************
*** 187,193 ****
@item
@ref{config-list-pattern}.
@item
! @ref{config-auth-method}.
@end itemize
Now when Gnus starts, it will ask you for a username/password for each
--- 187,195 ----
@item
@ref{config-list-pattern}.
@item
! @ref{config-stream}.
! @item
! @ref{config-authenticator}.
@end itemize
Now when Gnus starts, it will ask you for a username/password for each
***************
*** 243,249 ****
* config-server-port:: nnimap-server-port
* config-list-method:: nnimap-list-method
* config-list-pattern:: nnimap-list-pattern
! * config-auth-method:: nnimap-auth-method
* config-expunge-on-close:: nnimap-expunge-on-close
@end menu
@end ifinfo
--- 245,252 ----
* config-server-port:: nnimap-server-port
* config-list-method:: nnimap-list-method
* config-list-pattern:: nnimap-list-pattern
! * config-stream:: nnimap-stream
! * config-authenticator:: nnimap-authenticator
* config-expunge-on-close:: nnimap-expunge-on-close
@end menu
@end ifinfo
***************
*** 262,274 ****
@cindex Server port
@vindex nnimap-server-port
! Port on server to contact. Defaults to 143.
@node config-list-method, config-list-pattern, config-server-port, config-server
@subsection @code{nnimap-list-method}
@cindex List method
@cindex Listing mailboxes
! @vindex nnimap-list-pattern
When listing mailboxes on the server, the IMAP protocol has two
commands. "LIST", the default in nnimap, lists all mailboxes (limited by
--- 265,277 ----
@cindex Server port
@vindex nnimap-server-port
! Port on server to contact. Defaults to port 143, or 993 for SSL.
@node config-list-method, config-list-pattern, config-server-port, config-server
@subsection @code{nnimap-list-method}
@cindex List method
@cindex Listing mailboxes
! @vindex nnimap-list-method
When listing mailboxes on the server, the IMAP protocol has two
commands. "LIST", the default in nnimap, lists all mailboxes (limited by
***************
*** 289,295 ****
(nnimap-list-method "LSUB"))))
@end lisp
! @node config-list-pattern, config-auth-method, config-list-method, config-server
@subsection @code{nnimap-list-pattern}
@cindex Finding mailboxes
@cindex Mailbox regexp
--- 292,298 ----
(nnimap-list-method "LSUB"))))
@end lisp
! @node config-list-pattern, config-stream, config-list-method, config-server
@subsection @code{nnimap-list-pattern}
@cindex Finding mailboxes
@cindex Mailbox regexp
***************
*** 325,365 ****
@c
@c -->
! @node config-auth-method, config-expunge-on-close, config-list-pattern, config-server
! @subsection @code{nnimap-auth-method}
! @cindex Authorization method
! @vindex nnimap-auth-method
! This server variable let's you change the login scheme used for the
! server. Naturally, the server must support the scheme selected.
! Valid options are:
@itemize @bullet
@item
! @dfn{smart:} Try to figure out which scheme we should use. Currently
! this cannot deal with kerberos and ssl, but it will choose CRAM MD5 over
! plain text passwords.
! @item
! @dfn{login:} Force plain text password LOGIN.
@item
! @dfn{cram-md5:} Force CRAM MD5 authentication.
@item
! @dfn{kerberos4:} Force KERBEROS_V4 authentication. @xref{config-krb}
@item
! @dfn{ssl:} Force SSL encryption. @xref{config-ssl}.
@end itemize
Example:
@lisp
(setq gnus-secondary-select-methods
'((nnimap "nana"
(nnimap-address "mail.server")
! (nnimap-auth-method kerberos4))))
@end lisp
! @node config-expunge-on-close, , config-auth-method, config-server
@subsection @code{nnimap-expunge-on-close}
@cindex Expunging
@cindex Closing mailboxes
--- 328,404 ----
@c
@c -->
! @node config-stream, config-authenticator, config-list-pattern, config-server
! @subsection @code{nnimap-stream}
! @cindex Network streams
! @vindex nnimap-stream
!
! This server variable let you change the stream method used to connect to
! the server. If unset, nnimap will use the best stream your server is
! capable of.
! @itemize @bullet
! @item
! @dfn{kerberos4:} Use the `imtest' program. @xref{config-krb}
! @item
! @dfn{ssl:} Use the `s_client' program. @xref{config-ssl}.
! @item
! @dfn{network:} Plain, TCP/IP network connection.
! @end itemize
! You would want to change this from the default for two reasons:
!
! @itemize @bullet
! @item You want to connect with SSL. The SSL integration with IMAP is brain-dead so you'll have to tell it specifically.
! @item Your server is more capable than your environment -- i.e. your server
! accept Kerberos login's but you haven't installed the `imtest' program
! or your machine isn't configured for Kerberos.
! @end itemize
!
! Example:
!
! @lisp
! (setq gnus-secondary-select-methods
! '((nnimap "nana"
! (nnimap-address "mail.server")
! (nnimap-stream ssl))))
! @end lisp
!
! @node config-authenticator, config-expunge-on-close, config-stream, config-server
! @subsection @code{nnimap-authenticator}
! @cindex Auhtorization method
! @vindex nnimap-authenticator
!
! This server variable let you change the authenticator used to connect to
! the server. If unset, nnimap will use the best stream your server is
! capable of.
@itemize @bullet
@item
! @dfn{kerberos4:} Kerberos authentication. @xref{config-krb}
@item
! @dfn{cram-md5:} Encrypted username/password via CRAM-MD5.
@item
! @dfn{login:} Plain-text username/password via LOGIN.
@item
! @dfn{anonymous:} Login as `anonymous', supplying your emailadress as password.
@end itemize
+ There is only one reason for fiddling with this variable, and that is if
+ your server is more capable than your environment -- i.e. you connect to
+ a server that accept Kerberos login's but you haven't installed the
+ `imtest' program or your machine isn't configured for Kerberos.
+
Example:
@lisp
(setq gnus-secondary-select-methods
'((nnimap "nana"
(nnimap-address "mail.server")
! (nnimap-authenticator anonymous))))
@end lisp
! @node config-expunge-on-close, , config-authenticator, config-server
@subsection @code{nnimap-expunge-on-close}
@cindex Expunging
@cindex Closing mailboxes
***************
*** 532,540 ****
For SSL encryption you need to have the external program @code{s_client},
which comes with SSLeay (@url{http://www.ssleay.org/},) in your path.
- @strong{Note} If you get SSL to work, please send me a note! I have not
- been able to verify that this works.
-
@node using, trix, config, Top
@chapter Using nnimap
@cindex using nnimap
--- 571,576 ----
***************
*** 749,756 ****
(nnimap-address "localhost")
(nnimap-server-port 4712))
(nnimap "server3"
! (nnimap-auth-method 'md5)
! (nnimap-server-address "localhost")
(nnimap-server-port 4713))
(nnimap "server4"
(nnimap-address "localhost"))
--- 785,792 ----
(nnimap-address "localhost")
(nnimap-server-port 4712))
(nnimap "server3"
! (nnimap-stream ssl)
! (nnimap-address "localhost")
(nnimap-server-port 4713))
(nnimap "server4"
(nnimap-address "localhost"))
***************
*** 758,765 ****
@end lisp
Note also that in this example you have two server connections open to
! localhost:4713, one as user3 with CRAM-MD5 logins and one anonymous
! login using the auto-detect login method.
Now you should be able to connect to your IMAP server securely to read
your mail, which, by the way, has been sent in clear-text through the
--- 794,801 ----
@end lisp
Note also that in this example you have two server connections open to
! localhost:4713, one as user3 over a SSL connection and one anonymous
! login using the auto-detect stream / authenticator method.
Now you should be able to connect to your IMAP server securely to read
your mail, which, by the way, has been sent in clear-text through the