[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.128 -> 0.129 patches
- To: nnimap@extundo.com
- Subject: nnimap 0.128 -> 0.129 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 21 Aug 1999 21:31:02 +0200
- User-Agent: Gnus/5.070095 (Pterodactyl Gnus v0.95) Emacs/20.4
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.271 nnimap/ChangeLog:1.277
*** nnimap/ChangeLog:1.271 Wed Aug 11 17:19:02 1999
--- nnimap/ChangeLog Sat Aug 21 12:10:38 1999
***************
*** 1,3 ****
--- 1,63 ----
+ 1999-08-21 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.129 released.
+
+ * nnimap.el (nnimap-request-newgroups): Case-insensitive \Noselect
+ match.
+
+ * imap.el (imap-utf7-p): New variable.
+ (imap-utf7-encode):
+ (imap-utf7-decode): Defsubst. Use it.
+
+ 1999-08-21 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el: Added some documentation.
+ (require): Remove tcp (emacs 19? 18?). Add format-spec.
+ (imap-imtest-program): Format-spec'ify.
+ (imap-kerberos4-open): Format-spec'ify.
+ (imap-imtest-arguments): Removed.
+ (imap-utf7-encode): Do UTF7 encoding.
+ (imap-utf7-decode): Do UTF7 decoding.
+ (imap-mailbox-examine): Re-order buffer argument.
+ (imap-*): API functions (see documentation) now UTF7 decode
+ mailbox parameters and UTF7 decode mailbox return values, API
+ functions with mailbox arguments that are called by other
+ functions within imap.el are split into `function' and
+ `function-1' where `function' UTF7 decodes mailbox arguments and
+ then call function-1, all functions calling API functions now call
+ function-1 instead.
+
+ * nnimap.el (nnimap-find-minmax-uid): Change for new api.
+ (nnimap-open-connection): Ditto.
+ (nnimap-split-articles): Ditto.
+ (nnimap-request-accept-article): Ditto.
+
+ * imap.el (imap-authenticate): Change argument list so buffer is
+ the last argument.
+ (imap-mailbox-select): Ditto.
+ (imap-message-flags-*): Ditto.
+ (imap-message-copy): Ditto.
+ (imap-mailbox-put): Print buffer name in error.
+ (imap-message-put): Ditto.
+ (imap-message-append): Ditto.
+
+ 1999-08-17 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-list): Update for new api.
+ (nnimap-request-update-info-internal): Break up statement for
+ edebug to work.
+ (nnimap-request-newgroups): Update for new api.
+ (nnimap-request-accept-article): Report errors.
+
+ * imap.el (imap-mailbox-list): Change have-delimiter to
+ add-delimiter. Clear out mailbox listed after finding hierarchy
+ separator.
+ (imap-mailbox-lsub): Ditto.
+
+ 1999-08-14 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-possibly-change-group): Error if uid-invalid.
+
1999-08-12 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.128 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.165 nnimap/imap.el:1.169
*** nnimap/imap.el:1.165 Wed Aug 11 16:27:25 1999
--- nnimap/imap.el Sat Aug 21 12:05:20 1999
***************
*** 23,138 ****
;;; Commentary:
;;
! ;; Without the work of John McClary Prevost and Jim Radford this library
! ;; would not have seen the light of day. Many thanks.
;;
! ;; This is a elisp library providing an interface for talking to IMAP
! ;; server.
! ;;
! ;; It supports RFC1730/2060 (IMAP4/IMAP4rev1), implemented imap
;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
! ;; (NAMESPACE), RFC2359 (UIDPLUS), the kerberos V4 part of RFC1731.
! ;; It also support the UNSELECT extension of the Cyrus IMAPD.
;;
! ;; Example session:
;;
;; (imap-open "my.mail.server")
! ;; " *imap* my.mail.server:0"
;;
! ;; (imap-authenticate " *imap* my.mail.server:0")
! ;; auth
;;
! ;; (imap-mailbox-lsub " *imap* my.mail.server:0")
! ;; ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
;;
! ;; (imap-mailbox-list " *imap* my.mail.server:0" "INBOX.n%")
! ;; ("INBOX.ntbugtraq" "INBOX.nymb" "INBOX.netboot" "INBOX.nnimap")
;;
! ;; (imap-mailbox-select "INBOX.nnimap" " *imap* my.mail.server:0")
! ;; "INBOX.nnimap"
;;
! ;; (imap-mailbox-get 'exists nil " *imap* my.mail.server:0")
! ;; 39
;;
! ;; (imap-search "FLAGGED SINCE 18-DEC-98" " *imap* my.mail.server:0")
! ;; (235 236)
;;
! ;; xxx: more examples
;;
! ;; Server functions:
;;
! ;; (imap-open SERVER &optional PORT STREAM AUTH BUFFER)
! ;;
! ;; Open a IMAP connection to host SERVER at PORT returning a
! ;; buffer. If PORT is unspecified, a default value is used (143 except
! ;; for SSL which use 993).
! ;; STREAM indicates the stream to use, see `imap-streams' for available
! ;; streams. If nil, it choices the best stream the server is capable of.
! ;; AUTH indicates authenticator to use, see `imap-authenticators' for
! ;; available authenticators. If nil, it choices the best stream the
! ;; server is capable of.
! ;; BUFFER can be a buffer or a name of a buffer, which is created if
! ;; necessery.
! ;;
! ;; (imap-opened &optional BUFFER)
! ;;
! ;; Return non-nil if connection to imap server in BUFFER is open. If
! ;; BUFFER is nil then the current buffer is used.
! ;;
! ;; (imap-close &optional BUFFER)
! ;;
! ;; Close connection to server in BUFFER. If BUFFER is nil, the current
! ;; buffer is used.
! ;;
! ;; (imap-authenticate BUFFER &optional USER PASSWD)
! ;;
! ;; Authenticate to server in BUFFER, using current buffer if nil. It
! ;; uses the authenticator specified when opening the server. If the
! ;; authenticator requires username/passwords, they are queried from the
! ;; user and optionally stored in the buffer. If USER and/or PASSWD is
! ;; specified, the user will not be questioned and the username and/or
! ;; password is remembered in the buffer.
! ;;
! ;; (imap-capability &optional IDENTIFIER BUFFER)
! ;;
! ;; Return a list of identifiers which server in BUFFER support. If
! ;; IDENTIFIER, return non-nil if it's among the servers capabilities. If
! ;; BUFFER is nil, the current buffer is assumed.
! ;;
! ;; (imap-namespace &optional BUFFER)
! ;;
! ;; Return a namespace hierarchy at server in BUFFER. If BUFFER is nil,
! ;; the current buffer is assumed.
! ;;
! ;; 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-wait-for-tag
! ;; imap-ok-p
! ;; imap-send-command-wait
! ;;
;; Todo:
;;
! ;; o Parse UIDs as strings? (28 bit limit)
! ;; o Don't use `read' at all (important places fixed)
;; o Accept list of articles instead of message set string in most
;; imap-message-* functions.
! ;; o Cyrus 1.6.x `imtest' support in the imtest wrapper
;;
;;; Code:
--- 23,133 ----
;;; Commentary:
+ ;; imap.el is a elisp library providing an interface for talking to
+ ;; IMAP servers.
;;
! ;; imap.el is roughly divided in two parts, one that parses IMAP
! ;; responses from the server and storing data into buffer-local
! ;; variables, and one for utility functions which send commands to
! ;; server, waits for an answer, and return information. The latter
! ;; part is layered on top of the previous.
! ;;
! ;; The imap.el API consist of the following functions, other functions
! ;; in this file should not be called directly and the result of doing
! ;; so are at best undefined.
! ;;
! ;; Global commands:
! ;;
! ;; imap-open, imap-opened, imap-authenticate, imap-close,
! ;; imap-capability, imap-namespace, imap-error-text
! ;;
! ;; Mailbox commands:
! ;;
! ;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox,
! ;; imap-current-mailbox-p, imap-search, imap-mailbox-select,
! ;; imap-mailbox-examine, imap-mailbox-unselect, imap-mailbox-expunge
! ;; imap-mailbox-close, imap-mailbox-create, imap-mailbox-delete
! ;; imap-mailbox-rename, imap-mailbox-lsub, imap-mailbox-list
! ;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status
! ;; imap-mailbox-acl-get, imap-mailbox-acl-set, imap-mailbox-acl-delete
! ;;
! ;; Message commands:
! ;;
! ;; imap-fetch-asynch, imap-fetch,
! ;; imap-current-message, imap-list-to-message-set,
! ;; imap-message-get, imap-message-map
! ;; imap-message-envelope-date, imap-message-envelope-subject,
! ;; imap-message-envelope-from, imap-message-envelope-sender,
! ;; imap-message-envelope-reply-to, imap-message-envelope-to,
! ;; imap-message-envelope-cc, imap-message-envelope-bcc
! ;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id
! ;; imap-message-body, imap-message-flag-permanent-p
! ;; imap-message-flags-set, imap-message-flags-del
! ;; imap-message-flags-add, imap-message-copyuid
! ;; imap-message-copy, imap-message-appenduid
! ;; imap-message-append, imap-envelope-from
! ;; imap-body-lines
! ;;
! ;; It is my hope that theese commands should be pretty self
! ;; explanatory for someone that know IMAP. All functions have
! ;; additional documentation on how to invoke them.
;;
! ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
! ;; (NAMESPACE), RFC2359 (UIDPLUS), and the kerberos V4 part of RFC1731
! ;; (with use of external program `imtest'). It also take advantage
! ;; the UNSELECT extension in Cyrus IMAPD.
;;
! ;; Without the work of John McClary Prevost and Jim Radford this library
! ;; would not have seen the light of day. Many thanks.
! ;;
! ;; This is a transcript of short interactive session for demonstration
! ;; purposes.
;;
;; (imap-open "my.mail.server")
! ;; => " *imap* my.mail.server:0"
;;
! ;; The rest are invoked with current buffer as the buffer returned by
! ;; `imap-open'. It is possible to do all without this, but it would
! ;; look ugly here since `buffer' is always the last argument for all
! ;; imap.el API functions.
;;
! ;; (imap-authenticate "myusername" "mypassword")
! ;; => auth
;;
! ;; (imap-mailbox-lsub "*")
! ;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
;;
! ;; (imap-mailbox-list "INBOX.n%")
! ;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq")
;;
! ;; (imap-mailbox-select "INBOX.nnimap")
! ;; => "INBOX.nnimap"
;;
! ;; (imap-mailbox-get 'exists)
! ;; => 166
;;
! ;; (imap-mailbox-get 'uidvalidity)
! ;; => "908992622"
;;
! ;; (imap-search "FLAGGED SINCE 18-DEC-98")
! ;; => (235 236)
;;
! ;; (imap-fetch 235 "RFC822.PEEK" 'RFC822)
! ;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
! ;;
;; Todo:
;;
! ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
! ;; o Don't use `read' at all (important places already fixed)
;; o Accept list of articles instead of message set string in most
;; imap-message-* functions.
! ;; o Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper
! ;; o Format-spec'ify the ssl horror
! ;;
! ;; Revision history:
! ;;
! ;; - this is unreleased software
;;
;;; Code:
***************
*** 144,161 ****
(require 'base64)
(require 'rfc2104)
(require 'md5)
! (unless (fboundp 'open-network-stream)
! (require 'tcp)))
;; User variables.
! (defvar imap-imtest-program "imtest"
! "Program to use for Kerberos 4 authentication. It should accept
! IMAP commands on stdin and return responses to stdout.")
- (defvar imap-imtest-arguments "-kp"
- "Arguments for `imap-imtest-program'.")
-
(defvar imap-ssl-program 'auto
"Program to use for SSL connections. It is called like this
--- 139,154 ----
(require 'base64)
(require 'rfc2104)
(require 'md5)
! (require 'format-spec))
;; User variables.
! (defvar imap-imtest-program "imtest -kp %s %p"
! "How to call program for Kerberos 4 authentication.
! %s is replaced with server and %p with port to connect to. The
! program should accept IMAP commands on stdin and return responses to
! stdout.")
(defvar imap-ssl-program 'auto
"Program to use for SSL connections. It is called like this
***************
*** 221,226 ****
--- 214,225 ----
the server support the authenticator and AUTHENTICATE is a function
for doing the actuall authentification.")
+ (defvar imap-utf7-p t
+ "If non-nil, do utf7 encoding/decoding of mailbox names.
+ Since the UTF7 decoding currently only decodes into ISO-8859-1
+ characters, you may disable this decoding if you need to access UTF7
+ encoded mailboxes which doesn't translate into ISO-8859-1.")
+
;; Internal constants. Change theese and die.
(defconst imap-default-port 143)
***************
*** 343,362 ****
prompt)))
(defsubst imap-utf7-encode (string)
! ;; (condition-case ()
! ;; (utf7-encode string t)
! ;; (error (message "Warning: Could not UTF7 encode `%s', using it raw..."
! ;; string)
! ;; string)))
! string)
(defsubst imap-utf7-decode (string)
! ;; (condition-case ()
! ;; (utf7-decode string t)
! ;; (error (message "Warning: Could not UTF7 decode `%s', using it raw..."
! ;; string)
! ;; string)))
! string)
(defsubst imap-ok-p (status)
(if (eq status 'OK)
--- 342,367 ----
prompt)))
(defsubst imap-utf7-encode (string)
! (if imap-utf7-p
! (and string
! (condition-case ()
! (utf7-encode string t)
! (error (message
! "imap: Could not UTF7 encode `%s', using it unencoded..."
! string)
! string)))
! string))
(defsubst imap-utf7-decode (string)
! (if imap-utf7-p
! (and string
! (condition-case ()
! (utf7-decode string t)
! (error (message
! "imap: Could not UTF7 decode `%s', using it undecoded..."
! string)
! string))
! string)))
(defsubst imap-ok-p (status)
(if (eq status 'OK)
***************
*** 379,387 ****
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
! (process (start-process name buffer imap-imtest-program
! imap-imtest-arguments
! server (number-to-string port))))
(when process
(with-current-buffer buffer
(setq imap-client-eol "\n")
--- 384,394 ----
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
! (process (start-process
! name buffer shell-file-name shell-command-switch
! (format-spec
! imap-imtest-program
! (format-spec-make ?s server ?p (number-to-string port))))))
(when process
(with-current-buffer buffer
(setq imap-client-eol "\n")
***************
*** 660,666 ****
(and imap-process
(memq (process-status imap-process) '(open run))))))
! (defun imap-authenticate (&optional buffer user passwd)
"Authenticate to server in BUFFER, using current buffer if nil. It
uses the authenticator specified when opening the server. If the
authenticator requires username/passwords, they are queried from the
--- 667,673 ----
(and imap-process
(memq (process-status imap-process) '(open run))))))
! (defun imap-authenticate (&optional user passwd buffer)
"Authenticate to server in BUFFER, using current buffer if nil. It
uses the authenticator specified when opening the server. If the
authenticator requires username/passwords, they are queried from the
***************
*** 724,781 ****
(if imap-mailbox-data
(put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
propname value)
! (error "Imap-mailbox-data is nil. Property %s value %s mailbox %s"
! propname value mailbox))
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-current-mailbox (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
! imap-current-mailbox))
(defun imap-current-mailbox-p (mailbox &optional examine buffer)
(with-current-buffer (or buffer (current-buffer))
! (and (string= mailbox imap-current-mailbox)
! (or (and examine
! (eq imap-state 'examine))
! (and (not examine)
! (eq imap-state 'selected))))))
! (defun imap-mailbox-select (mailbox &optional buffer examine)
"Select MAILBOX on server in BUFFER. If EXAMINE is non-nil, do a
read-only select."
(with-current-buffer (or buffer (current-buffer))
! (if (imap-current-mailbox-p mailbox examine)
! imap-current-mailbox
! (setq imap-current-mailbox mailbox)
! (if (imap-ok-p (imap-send-command-wait
! (concat (if examine "EXAMINE" "SELECT") " \""
! (imap-utf7-encode mailbox) "\"")))
! (progn
! (setq imap-message-data (make-vector imap-message-prime 0)
! imap-state (if examine 'examine 'selected))
! imap-current-mailbox)
! ;; Failed SELECT/EXAMINE unselects current mailbox
! (setq imap-current-mailbox nil)))))
(defun imap-mailbox-examine (mailbox &optional buffer)
"Examine MAILBOX on server in BUFFER"
! (imap-mailbox-select mailbox buffer 'exmine))
(defun imap-mailbox-unselect (&optional buffer)
"Close current folder in BUFFER, without expunging articles."
--- 731,805 ----
(if imap-mailbox-data
(put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
propname value)
! (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
! propname value mailbox (current-buffer)))
t))
+ (defsubst imap-mailbox-get-1 (propname &optional mailbox)
+ (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
+ propname))
+
(defun imap-mailbox-get (propname &optional mailbox buffer)
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
! (defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
(with-current-buffer (or buffer (current-buffer))
(let (result)
(mapatoms
(lambda (s)
! (push (funcall func (if mailbox-decoder
! (funcall mailbox-decoder (symbol-name s))
! (symbol-name s))) result))
imap-mailbox-data)
result)))
+ (defun imap-mailbox-map (func &optional buffer)
+ "Map a function across each mailbox in `imap-mailbox-data',
+ returning a list. Function should take a mailbox name (a string) as
+ the only argument."
+ (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
+
(defun imap-current-mailbox (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-utf7-decode imap-current-mailbox)))
+ (defun imap-current-mailbox-p-1 (mailbox &optional examine)
+ (and (string= mailbox imap-current-mailbox)
+ (or (and examine
+ (eq imap-state 'examine))
+ (and (not examine)
+ (eq imap-state 'selected)))))
+
(defun imap-current-mailbox-p (mailbox &optional examine buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine)))
! (defun imap-mailbox-select-1 (mailbox &optional examine)
"Select MAILBOX on server in BUFFER. If EXAMINE is non-nil, do a
read-only select."
+ (if (imap-current-mailbox-p-1 mailbox examine)
+ imap-current-mailbox
+ (setq imap-current-mailbox mailbox)
+ (if (imap-ok-p (imap-send-command-wait
+ (concat (if examine "EXAMINE" "SELECT") " \""
+ mailbox "\"")))
+ (progn
+ (setq imap-message-data (make-vector imap-message-prime 0)
+ imap-state (if examine 'examine 'selected))
+ imap-current-mailbox)
+ ;; Failed SELECT/EXAMINE unselects current mailbox
+ (setq imap-current-mailbox nil))))
+
+ (defun imap-mailbox-select (mailbox &optional examine buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-utf7-decode
! (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
(defun imap-mailbox-examine (mailbox &optional buffer)
"Examine MAILBOX on server in BUFFER"
! (imap-mailbox-select mailbox 'exmine buffer))
(defun imap-mailbox-unselect (&optional buffer)
"Close current folder in BUFFER, without expunging articles."
***************
*** 811,888 ****
imap-state 'auth)
t)))
(defun imap-mailbox-create (mailbox &optional buffer)
"Create MAILBOX on server in BUFFER. If BUFFER is nil the current
buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "CREATE \"" (imap-utf7-encode mailbox)
! "\"")))))
(defun imap-mailbox-delete (mailbox &optional buffer)
"Delete MAILBOX on server in BUFFER. If BUFFER is nil the current
buffer is assumed."
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "DELETE \"" (imap-utf7-encode mailbox)
! "\"")))))
(defun imap-mailbox-rename (oldname newname &optional buffer)
"Rename mailbox OLDNAME to NEWNAME on server in BUFFER. If BUFFER is
nil the current buffer is assumed."
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "RENAME \"" (imap-utf7-encode oldname)
! "\" \"" (imap-utf7-encode newname) "\"")))))
! (defun imap-mailbox-lsub (&optional buffer root have-delimiter reference)
"Return a list of subscribed mailboxes on server in BUFFER.
! Mailboxes have to match ROOT. A hierarchy delimiter is added unless
! HAVE-DELIMITER is non-nil. REFERENCE is a implementation-specific
! string that has to be passed to LSUB."
! (with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-map (lambda (mailbox)
! (imap-mailbox-put 'lsub nil mailbox)))
! (when root
! (unless have-delimiter
! (imap-send-command-wait (concat "LSUB \"" reference "\" \""
! (imap-utf7-encode root) "\""))))
! (when (imap-ok-p
(imap-send-command-wait
(concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
! (when (and root (not have-delimiter))
! (imap-mailbox-get 'delimiter root))
"%\"")))
(let (out)
! (imap-mailbox-map (lambda (mailbox)
! (when (imap-mailbox-get 'lsub mailbox)
! (push (imap-utf7-decode mailbox) out))))
(nreverse out)))))
! (defun imap-mailbox-list (&optional buffer root have-delimiter reference)
! "Return a list of subscribed mailboxes on server in BUFFER.
! Mailboxes have to match ROOT. A hierarchy delimiter is added unless
! HAVE-DELIMITER is non-nil. REFERENCE is a implementation-specific
! string that has to be passed to LIST."
! (with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-map (lambda (mailbox)
! (imap-mailbox-put 'list nil mailbox)))
! ;; 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 "\" \""
! (imap-utf7-encode root) "\""))))
! (when (imap-ok-p
(imap-send-command-wait
(concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
! (when (and root (not have-delimiter))
! (imap-mailbox-get 'delimiter root))
"%\"")))
(let (out)
! (imap-mailbox-map (lambda (mailbox)
! (when (imap-mailbox-get 'list mailbox)
! (push (imap-utf7-decode mailbox) out))))
(nreverse out)))))
(defun imap-mailbox-subscribe (mailbox &optional buffer)
--- 835,913 ----
imap-state 'auth)
t)))
+ (defun imap-mailbox-create-1 (mailbox)
+ (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\""))))
+
(defun imap-mailbox-create (mailbox &optional buffer)
"Create MAILBOX on server in BUFFER. If BUFFER is nil the current
buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
! (imap-mailbox-create-1 (imap-utf7-encode mailbox))))
(defun imap-mailbox-delete (mailbox &optional buffer)
"Delete MAILBOX on server in BUFFER. If BUFFER is nil the current
buffer is assumed."
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "DELETE \"" mailbox "\""))))))
(defun imap-mailbox-rename (oldname newname &optional buffer)
"Rename mailbox OLDNAME to NEWNAME on server in BUFFER. If BUFFER is
nil the current buffer is assumed."
! (let ((oldname (imap-utf7-encode oldname))
! (newname (imap-utf7-encode newname)))
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "RENAME \"" oldname "\" "
! "\"" newname "\""))))))
! (defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
"Return a list of subscribed mailboxes on server in BUFFER.
! If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is
! non-nil, a hierarchy delimiter is added to root. REFERENCE is a
! implementation-specific string that has to be passed to lsub command."
! (with-current-buffer (or buffer (current-buffer))
! ;; Make sure we know the hierarchy separator for root's hierarchy
! (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
! (imap-send-command-wait (concat "LIST \"" reference "\" \""
! (imap-utf7-encode root) "\"")))
! ;; clear list data (NB not delimiter and other stuff)
! (imap-mailbox-map-1 (lambda (mailbox)
! (imap-mailbox-put 'lsub nil mailbox)))
! (when (imap-ok-p
(imap-send-command-wait
(concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
! (and add-delimiter (imap-mailbox-get-1 'delimiter root))
"%\"")))
(let (out)
! (imap-mailbox-map-1 (lambda (mailbox)
! (when (imap-mailbox-get-1 'lsub mailbox)
! (push (imap-utf7-decode mailbox) out))))
(nreverse out)))))
! (defun imap-mailbox-list (root &optional reference add-delimiter buffer)
! "Return a list of mailboxes matching ROOT on server in BUFFER.
! If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
! root. REFERENCE is a implementation-specific string that has to be
! passed to list command."
! (with-current-buffer (or buffer (current-buffer))
! ;; Make sure we know the hierarchy separator for root's hierarchy
! (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
! (imap-send-command-wait (concat "LIST \"" reference "\" \""
! (imap-utf7-encode root) "\"")))
! ;; clear list data (NB not delimiter and other stuff)
! (imap-mailbox-map-1 (lambda (mailbox)
! (imap-mailbox-put 'list nil mailbox)))
! (when (imap-ok-p
(imap-send-command-wait
(concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
! (and add-delimiter (imap-mailbox-get-1 'delimiter root))
"%\"")))
(let (out)
! (imap-mailbox-map-1 (lambda (mailbox)
! (when (imap-mailbox-get-1 'list mailbox)
! (push (imap-utf7-decode mailbox) out))))
(nreverse out)))))
(defun imap-mailbox-subscribe (mailbox &optional buffer)
***************
*** 918,960 ****
(list items))))))
(if (listp items)
(mapcar (lambda (item)
! (imap-mailbox-get item mailbox))
items)
! (imap-mailbox-get items mailbox)))))
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (when (imap-ok-p
! (imap-send-command-wait (list "GETACL \""
! (imap-utf7-encode
! (or mailbox imap-current-mailbox))
! "\"")))
! (imap-mailbox-get 'acl (or mailbox imap-current-mailbox)))))
(defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
"Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in
BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "SETACL \""
! (imap-utf7-encode
! (or mailbox imap-current-mailbox))
! "\" "
! identifier
! " "
! rights)))))
(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
"Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from
server in BUFFER."
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "DELETEACL \""
! (imap-utf7-encode
! (or mailbox imap-current-mailbox))
! "\" "
! identifier)))))
;; Message functions:
--- 943,985 ----
(list items))))))
(if (listp items)
(mapcar (lambda (item)
! (imap-mailbox-get-1 item mailbox))
items)
! (imap-mailbox-get-1 items mailbox)))))
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (when (imap-ok-p
! (imap-send-command-wait (list "GETACL \""
! (or mailbox imap-current-mailbox)
! "\"")))
! (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
(defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
"Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in
BUFFER."
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "SETACL \""
! (or mailbox imap-current-mailbox)
! "\" "
! identifier
! " "
! rights))))))
(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
"Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from
server in BUFFER."
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (imap-ok-p
! (imap-send-command-wait (list "DELETEACL \""
! (or mailbox imap-current-mailbox)
! "\" "
! identifier))))))
;; Message functions:
***************
*** 1007,1014 ****
(if imap-message-data
(put (intern (number-to-string uid) imap-message-data)
propname value)
! (error "Imap-message-data is nil. Uid %d property %s value %s"
! uid propname value))
t))
(defun imap-message-get (uid propname &optional buffer)
--- 1032,1039 ----
(if imap-message-data
(put (intern (number-to-string uid) imap-message-data)
propname value)
! (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
! uid propname value (current-buffer)))
t))
(defun imap-message-get (uid propname &optional buffer)
***************
*** 1075,1083 ****
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-put 'search 'dummy)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
! (if (eq (imap-mailbox-get 'search) 'dummy)
(error "Missing SEARCH response to a SEARCH command")
! (imap-mailbox-get 'search)))))
(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
"Return t iff FLAG can be permanently (between IMAP sessions) saved
--- 1100,1108 ----
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-put 'search 'dummy)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
! (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
(error "Missing SEARCH response to a SEARCH command")
! (imap-mailbox-get-1 'search imap-current-mailbox)))))
(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
"Return t iff FLAG can be permanently (between IMAP sessions) saved
***************
*** 1086,1145 ****
(or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
(member flag (imap-mailbox-get 'permanentflags mailbox)))))
! (defun imap-message-flags-set (articles flags &optional buffer silent)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-flags-del (articles flags &optional buffer silent)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-flags-add (articles flags &optional buffer silent)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-appenduid (mailbox &optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (if (imap-capability 'UIDPLUS)
! (imap-mailbox-get 'appenduid mailbox)
! (let ((old-mailbox imap-current-mailbox)
! (state imap-state)
! (imap-message-data (make-vector 2 0)))
! (imap-mailbox-select mailbox nil 'examine)
! (imap-fetch "*" "UID")
(prog1
! (list (imap-mailbox-get 'uidvalidity mailbox)
! (car (imap-message-map (lambda (uid prop) uid) 'UID)))
(if old-mailbox
! (imap-mailbox-select old-mailbox nil (eq state 'examine))
(imap-mailbox-unselect)))))))
(defun imap-message-copyuid (mailbox &optional buffer)
(with-current-buffer (or buffer (current-buffer))
! (if (imap-capability 'UIDPLUS)
! (list (nth 0 (imap-mailbox-get 'copyuid mailbox))
! (string-to-number (nth 2 (imap-mailbox-get 'copyuid mailbox))))
! (let ((old-mailbox imap-current-mailbox)
! (state imap-state)
! (imap-message-data (make-vector 2 0)))
! (imap-mailbox-select mailbox nil 'examine)
! (imap-fetch "*" "UID")
! (prog1
! (list (imap-mailbox-get 'uidvalidity mailbox)
! (car (imap-message-map (lambda (uid prop) uid) 'UID)))
! (imap-mailbox-select old-mailbox nil (eq state 'examine)))))))
(defun imap-message-copy (articles mailbox
! &optional buffer dont-create no-copyuid)
"Copy ARTICLES (a string message set) to MAILBOX on server in
BUFFER, creating mailbox if it doesn't exist. If dont-create is
non-nil, it will not create a mailbox. On success, return a list with
--- 1111,1159 ----
(or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
(member flag (imap-mailbox-get 'permanentflags mailbox)))))
! (defun imap-message-flags-set (articles flags &optional silent buffer)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-flags-del (articles flags &optional silent buffer)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-flags-add (articles flags &optional silent buffer)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
! (defun imap-message-copyuid-1 (mailbox)
! (if (imap-capability 'UIDPLUS)
! (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
! (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
! (let ((old-mailbox imap-current-mailbox)
! (state imap-state)
! (imap-message-data (make-vector 2 0)))
! (when (imap-mailbox-examine mailbox)
(prog1
! (and (imap-fetch "*" "UID")
! (list (imap-mailbox-get-1 'uidvalidity mailbox)
! (max (imap-message-map (lambda (uid prop) uid) 'UID))))
(if old-mailbox
! (imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
(defun imap-message-copyuid (mailbox &optional buffer)
(with-current-buffer (or buffer (current-buffer))
! (imap-message-copyuid-1 (imap-utf7-decode mailbox))))
(defun imap-message-copy (articles mailbox
! &optional dont-create no-copyuid buffer)
"Copy ARTICLES (a string message set) to MAILBOX on server in
BUFFER, creating mailbox if it doesn't exist. If dont-create is
non-nil, it will not create a mailbox. On success, return a list with
***************
*** 1147,1173 ****
first element, rest of list contain the saved articles' UIDs."
(when articles
(with-current-buffer (or buffer (current-buffer))
! (if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\""))
! (imap-current-target-mailbox mailbox))
! (if (imap-ok-p (imap-send-command-wait cmd))
! t
! (when (and (not dont-create)
! (imap-mailbox-get 'trycreate mailbox))
! (imap-mailbox-create mailbox)
! (imap-ok-p (imap-send-command-wait cmd)))))
! (or no-copyuid
! (imap-message-copyuid mailbox))))))
! (defun imap-message-append (mailbox article &optional buffer flags date-time)
"Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. FLAGS and
DATE-TIME is currently not used. Return a cons holding uidvalidity of
MAILBOX and UID the newly created article got, or nil on failure."
! (with-current-buffer (or buffer (current-buffer))
! (and (let ((imap-current-target-mailbox mailbox))
! (imap-ok-p
! (imap-send-command-wait
! (list "APPEND \"" (imap-utf7-encode mailbox) "\" " article))))
! (imap-message-appenduid mailbox))))
(defun imap-body-lines (body)
"Return number of lines in article by looking at the mime bodystructure
--- 1161,1208 ----
first element, rest of list contain the saved articles' UIDs."
(when articles
(with-current-buffer (or buffer (current-buffer))
! (let ((mailbox (imap-utf7-encode mailbox)))
! (if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\""))
! (imap-current-target-mailbox mailbox))
! (if (imap-ok-p (imap-send-command-wait cmd))
! t
! (when (and (not dont-create)
! (imap-mailbox-get-1 'trycreate mailbox))
! (imap-mailbox-create-1 mailbox)
! (imap-ok-p (imap-send-command-wait cmd)))))
! (or no-copyuid
! (imap-message-copyuid-1 mailbox)))))))
! (defun imap-message-appenduid-1 (mailbox)
! (if (imap-capability 'UIDPLUS)
! (imap-mailbox-get-1 'appenduid mailbox)
! (let ((old-mailbox imap-current-mailbox)
! (state imap-state)
! (imap-message-data (make-vector 2 0)))
! (when (imap-mailbox-examine mailbox)
! (prog1
! (and (imap-fetch "*" "UID")
! (list (imap-mailbox-get-1 'uidvalidity mailbox)
! (max (imap-message-map (lambda (uid prop) uid) 'UID))))
! (if old-mailbox
! (imap-mailbox-select old-mailbox (eq state 'examine))
! (imap-mailbox-unselect)))))))
!
! (defun imap-message-appenduid (mailbox &optional buffer)
! (with-current-buffer (or buffer (current-buffer))
! (imap-message-appenduid-1 (imap-utf7-encode mailbox))))
!
! (defun imap-message-append (mailbox article &optional flags date-time buffer)
"Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. FLAGS and
DATE-TIME is currently not used. Return a cons holding uidvalidity of
MAILBOX and UID the newly created article got, or nil on failure."
! (let ((mailbox (imap-utf7-encode mailbox)))
! (with-current-buffer (or buffer (current-buffer))
! (and (let ((imap-current-target-mailbox mailbox))
! (imap-ok-p
! (imap-send-command-wait
! (list "APPEND \"" mailbox "\" " article))))
! (imap-message-appenduid-1 mailbox)))))
(defun imap-body-lines (body)
"Return number of lines in article by looking at the mime bodystructure
***************
*** 2143,2148 ****
--- 2178,2185 ----
(mapc (lambda (f) (trace-function-background f imap-debug))
'(
imap-read-passwd
+ imap-utf7-encode
+ imap-utf7-decode
imap-error-text
imap-kerberos4s-p
imap-kerberos4-open
***************
*** 2171,2184 ****
--- 2208,2225 ----
imap-send-command-wait
imap-mailbox-put
imap-mailbox-get
+ imap-mailbox-map-1
imap-mailbox-map
imap-current-mailbox
+ imap-current-mailbox-p-1
imap-current-mailbox-p
+ imap-mailbox-select-1
imap-mailbox-select
imap-mailbox-examine
imap-mailbox-unselect
imap-mailbox-expunge
imap-mailbox-close
+ imap-mailbox-create-1
imap-mailbox-create
imap-mailbox-delete
imap-mailbox-rename
***************
*** 2190,2196 ****
--- 2231,2239 ----
imap-mailbox-acl-get
imap-mailbox-acl-set
imap-mailbox-acl-delete
+ imap-current-message
imap-list-to-message-set
+ imap-fetch-asynch
imap-fetch
imap-message-put
imap-message-get
***************
*** 2200,2208 ****
imap-message-flags-set
imap-message-flags-del
imap-message-flags-add
! imap-message-appenduid
imap-message-copyuid
imap-message-copy
imap-message-append
imap-body-lines
imap-envelope-from
--- 2243,2253 ----
imap-message-flags-set
imap-message-flags-del
imap-message-flags-add
! imap-message-copyuid-1
imap-message-copyuid
imap-message-copy
+ imap-message-appenduid-1
+ imap-message-appenduid
imap-message-append
imap-body-lines
imap-envelope-from
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.220 nnimap/nnimap.el:1.224
*** nnimap/nnimap.el:1.220 Wed Aug 11 16:48:43 1999
--- nnimap/nnimap.el Sat Aug 21 12:06:33 1999
***************
*** 78,84 ****
(gnus-declare-backend "nnimap" 'post-mail 'address 'prompt-address
'physical-address)
! (defconst nnimap-version "nnimap 0.128")
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
--- 78,84 ----
(gnus-declare-backend "nnimap" 'post-mail 'address 'prompt-address
'physical-address)
! (defconst nnimap-version "nnimap 0.129")
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
***************
*** 321,327 ****
"Find lowest and highest active article nummber in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
! (when (imap-mailbox-select group nil examine)
(let (minuid maxuid)
(when (> (imap-mailbox-get 'exists) 0)
(imap-fetch "1,*" "UID" nil 'nouidfetch)
--- 321,327 ----
"Find lowest and highest active article nummber in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
! (when (imap-mailbox-select group examine)
(let (minuid maxuid)
(when (> (imap-mailbox-get 'exists) 0)
(imap-fetch "1,*" "UID" nil 'nouidfetch)
***************
*** 342,350 ****
(or server nnimap-current-server))
imap-current-mailbox
(imap-mailbox-unselect)
! (gnus-message 1 "nnimap: Group %s is not uid-valid." group)
! (ding)
! nil)
(nnheader-report 'nnimap (imap-error-text)))))))
(defun nnimap-replace-whitespace (string)
--- 342,348 ----
(or server nnimap-current-server))
imap-current-mailbox
(imap-mailbox-unselect)
! (error "nnimap: Group %s is not uid-valid." group))
(nnheader-report 'nnimap (imap-error-text)))))))
(defun nnimap-replace-whitespace (string)
***************
*** 534,540 ****
(gnus-netrc-machine list nnimap-address))
user (gnus-netrc-get alist "login")
passwd (gnus-netrc-get alist "password")))
! (if (imap-authenticate nnimap-server-buffer user passwd)
(prog1
(push (list server nnimap-server-buffer)
nnimap-server-buffer-alist)
--- 532,538 ----
(gnus-netrc-machine list nnimap-address))
user (gnus-netrc-get alist "login")
passwd (gnus-netrc-get alist "password")))
! (if (imap-authenticate user passwd nnimap-server-buffer)
(prog1
(push (list server nnimap-server-buffer)
nnimap-server-buffer-alist)
***************
*** 709,715 ****
(with-current-buffer nnimap-server-buffer
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
! nil (cdr pattern) t (car pattern)))
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
--- 707,713 ----
(with-current-buffer nnimap-server-buffer
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
! (cdr pattern) (car pattern)))
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
***************
*** 769,795 ****
(gnus-info-group info))
(when (nnimap-mark-permanent-p 'read)
! (gnus-info-set-read
! info
! (let (seen unseen)
! ;; read info could contain articles marked unread by other
! ;; imap clients! we correct this
! (setq seen (gnus-uncompress-range (gnus-info-read info))
! unseen (imap-search "UNSEEN UNDELETED")
! seen (gnus-set-difference seen unseen)
! ;; seen might lack articles marked as read by other
! ;; imap clients! we correct this
! seen (append seen (imap-search "SEEN"))
! ;; remove dupes
! seen (sort seen '<)
! seen (gnus-compress-sequence seen t))
! ;; we can't return '(1) since this isn't a "list of ranges",
! ;; and we can't return '((1)) since gnus-list-of-unread-articles
! ;; is buggy so we return '((1 . 1)).
! (if (and (integerp (car seen))
! (null (cdr seen)))
! (list (cons (car seen) (car seen)))
! seen))))
(mapc (lambda (pred)
(when (and (nnimap-mark-permanent-p (cdr pred))
--- 767,792 ----
(gnus-info-group info))
(when (nnimap-mark-permanent-p 'read)
! (let (seen unseen)
! ;; read info could contain articles marked unread by other
! ;; imap clients! we correct this
! (setq seen (gnus-uncompress-range (gnus-info-read info))
! unseen (imap-search "UNSEEN UNDELETED")
! seen (gnus-set-difference seen unseen)
! ;; seen might lack articles marked as read by other
! ;; imap clients! we correct this
! seen (append seen (imap-search "SEEN"))
! ;; remove dupes
! seen (sort seen '<)
! seen (gnus-compress-sequence seen t)
! ;; we can't return '(1) since this isn't a "list of ranges",
! ;; and we can't return '((1)) since g-list-of-unread-articles
! ;; is buggy so we return '((1 . 1)).
! seen (if (and (integerp (car seen))
! (null (cdr seen)))
! (list (cons (car seen) (car seen)))
! seen))
! (gnus-info-set-read info seen)))
(mapc (lambda (pred)
(when (and (nnimap-mark-permanent-p (cdr pred))
***************
*** 906,912 ****
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
(if (imap-message-copy (number-to-string article)
! to-group nil nil t)
(progn
(message "IMAP split moved %s:%s:%d to %s" server inbox
article to-group)
--- 903,909 ----
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
(if (imap-message-copy (number-to-string article)
! to-group nil 'nocopyuid)
(progn
(message "IMAP split moved %s:%s:%d to %s" server inbox
article to-group)
***************
*** 934,942 ****
(erase-buffer)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
! (dolist (mbx (imap-mailbox-lsub nnimap-server-buffer "*" t (car pattern)))
! (or (member "\\NoSelect"
! (imap-mailbox-get 'list-flags mbx nnimap-server-buffer))
;; Escape SPC in mailboxes xxx relies on gnus internals
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
--- 931,942 ----
(erase-buffer)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
! (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
! nnimap-server-buffer))
! (or (member-if (lambda (mailbox)
! (string= (downcase mailbox) "\\noselect"))
! (imap-mailbox-get 'list-flags mbx
! nnimap-server-buffer))
;; Escape SPC in mailboxes xxx relies on gnus internals
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
***************
*** 1031,1054 ****
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
(let (uid)
! (and (setq uid
! (if (string= nnimap-current-server nnimap-current-move-server)
! ;; moving article within same server, speed it up...
! (and (nnimap-possibly-change-group
! nnimap-current-move-group)
! (imap-message-copy (number-to-string
! nnimap-current-move-article)
! group nnimap-server-buffer))
! ;; turn into rfc822 format (\r\n eol's)
! (with-current-buffer (current-buffer)
! (goto-char (point-min))
! (while (search-forward "\n" nil t)
! (replace-match "\r\n")))
! ;; next line for Cyrus server bug
! (imap-mailbox-unselect nnimap-server-buffer)
! (imap-message-append group (current-buffer)
! nnimap-server-buffer)))
! (cons group (nth 1 uid))))))
(deffoo nnimap-request-delete-group (group force &optional server)
(when (nnimap-possibly-change-server server)
--- 1031,1055 ----
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
(let (uid)
! (if (setq uid
! (if (string= nnimap-current-server nnimap-current-move-server)
! ;; moving article within same server, speed it up...
! (and (nnimap-possibly-change-group
! nnimap-current-move-group)
! (imap-message-copy (number-to-string
! nnimap-current-move-article)
! group nnimap-server-buffer))
! ;; turn into rfc822 format (\r\n eol's)
! (with-current-buffer (current-buffer)
! (goto-char (point-min))
! (while (search-forward "\n" nil t)
! (replace-match "\r\n")))
! ;; next line for Cyrus server bug
! (imap-mailbox-unselect nnimap-server-buffer)
! (imap-message-append group (current-buffer) nil nil
! nnimap-server-buffer)))
! (cons group (nth 1 uid))
! (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
(deffoo nnimap-request-delete-group (group force &optional server)
(when (nnimap-possibly-change-server server)
Index: nnimap/nnimap.texi
diff -c nnimap/nnimap.texi:1.30 nnimap/nnimap.texi:1.31
*** nnimap/nnimap.texi:1.30 Sat Jul 17 13:42:08 1999
--- nnimap/nnimap.texi Sat Aug 21 12:10:58 1999
***************
*** 7,13 ****
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
@set NNIMAP-VERSION 0.123
@ifinfo
--- 7,13 ----
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
@set NNIMAP-VERSION 0.123
@ifinfo
***************
*** 553,566 ****
@cindex Authentication, kerberos
@pindex imtest
@vindex imap-imtest-program
- @vindex imap-imtest-arguments
For Kerberos authentication and encryption you need to have the external
program @code{imtest} which comes with Cyrus IMAPD
(@url{http://andrew2.andrew.cmu.edu/cyrus/}) in your path.
! Also see the documentation on variables @code{imap-imtest-program} and
! @code{imap-imtest-arguments} if you need to change the details.
@node config-ssl, debug, config-krb, config
@section Required programs for ssl
--- 553,565 ----
@cindex Authentication, kerberos
@pindex imtest
@vindex imap-imtest-program
For Kerberos authentication and encryption you need to have the external
program @code{imtest} which comes with Cyrus IMAPD
(@url{http://andrew2.andrew.cmu.edu/cyrus/}) in your path.
! Also see the documentation on variables @code{imap-imtest-program} if
! you want to use a different program and/or switches than the default.
@node config-ssl, debug, config-krb, config
@section Required programs for ssl