[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.84 -> 0.85
- To: nnimap@extundo.com
- Subject: nnimap 0.84 -> 0.85
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 19 Dec 1998 02:22:00 +0100
- User-Agent: Gnus/5.070066 (Pterodactyl Gnus v0.66) XEmacs/21.2(beta5) (Aphrodite)
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.145 nnimap/ChangeLog:1.148
*** nnimap/ChangeLog:1.145 Thu Dec 17 20:47:00 1998
--- nnimap/ChangeLog Fri Dec 18 17:15:42 1998
***************
*** 1,3 ****
--- 1,53 ----
+ 1998-12-19 02:11:12 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.85 released.
+
+ 1998-12-19 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-fetch-data-hook): Renamed.
+ (imap-response-data-fetch): Run hook.
+
+ 1998-12-19 02:06:26 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-expire-articles-progress):
+ (nnimap-request-expire-articles): Update for fetch hook which is
+ called with `run-hooks' now.
+
+ 1998-12-19 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-failed-tags): New variable.
+ (imap-wait-for-tag): Return status.
+ (imap-ok-p): Check status.
+ (imap-arrival-filter): Delete eol after command.
+ (imap-parse-response): Handle NO and BAD.
+ (imap-response-data-expunge): Don't do anything.
+ (imap-response-data-capability):
+ (imap-response-data-list): Faster.
+ (imap-response-data-search):
+ (imap-parse-flag-list): Don't use replace-in-string.
+ (imap-response-data-fetch): Don't error when no UID (uw imap 4.4
+ is buggy)
+
+ * imap.el: Turn require into autoload.
+
+ 1998-12-18 21:48:57 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.texi (Top):
+ * README: Require pgnus.
+
+ 1998-12-19 00:41:08 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-list-mapper):
+ (nnimap-request-group): Lotus bug wasn't a bug: if there is only
+ one message in the mailbox, fetches for 1,* is the same as 1,1
+ which is the same as 1 => only one response.
+ (nnimap-ok-p): Use nnheader-report.
+ (nnimap-split-move-article):
+ (nnimap-status-message): Don't use imap-last-status.
+ (nnimap-request-article-part): Don't multibyte
+ (nnimap-request-article-part):
+ (nnimap-retrieve-headers): Remove \r's.
+
1998-12-18 05:41:09 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.84 released.
Index: nnimap/README
diff -c nnimap/README:1.4 nnimap/README:1.5
*** nnimap/README:1.4 Fri Aug 28 01:00:10 1998
--- nnimap/README Fri Dec 18 12:51:34 1998
***************
*** 1,11 ****
! 1998-08-28
! $ make nnimap.info
! To get info pages which contains documentation.
Lacking makeinfo, the manual is also available on
! http://www.extundo.com/gnus-imap/nnimap.html.
--
jas@pdc.kth.se
--- 1,13 ----
! 1998-12-18
! Nnimap requires Pterodactyl Gnus.
!
! Build a manual for further instructions:
! $ make nnimap.info
Lacking makeinfo, the manual is also available on
! http://www.extundo.com/nnimap/nnimap.html.
--
jas@pdc.kth.se
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.81 nnimap/imap.el:1.83
*** nnimap/imap.el:1.81 Thu Dec 17 20:49:26 1998
--- nnimap/imap.el Fri Dec 18 17:11:39 1998
***************
*** 22,54 ****
;;; 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)
- (require 'md5)
-
(eval-when-compile (require 'cl))
(eval-and-compile
(autoload 'open-ssl-stream "ssl")
(unless (fboundp 'open-network-stream)
(require 'tcp)))
--- 22,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 Handle literals in ENVELOPE/BODY fetch responses
;; o Parse UIDs as strings? (28 bit limit)
;; o Sleep.
! ;;
;;; Code:
(eval-when-compile (require 'cl))
(eval-and-compile
(autoload 'open-ssl-stream "ssl")
+ (autoload 'base64-decode "base64")
+ (autoload 'rfc2104-hash "rfc2104")
+ (autoload 'md5 "md5")
(unless (fboundp 'open-network-stream)
(require 'tcp)))
***************
*** 62,70 ****
;; 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
--- 146,153 ----
;; Various variables.
! (defvar imap-fetch-data-hook nil
! "Hooks called after receiving each FETCH response.")
(defvar imap-streams '(kerberos4 ssl network)
"Priority of streams to consider when opening connection to
***************
*** 119,127 ****
--- 202,212 ----
imap-namespace
imap-state
imap-reached-tag
+ imap-failed-tags
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)
***************
*** 190,195 ****
--- 275,286 ----
(defvar imap-reached-tag 0
"Lower limit on command tags that have been parsed.")
+ (defvar imap-failed-tags nil
+ "Alist of tags that failed. Each element is a list with four
+ elements; tag (a integer), response state (a symbol, `OK', `NO' or
+ `BAD'), response code (a string), and human readable response text (a
+ string).")
+
(defvar imap-tag 0
"Command tag number.")
***************
*** 383,388 ****
--- 474,489 ----
imap-process)))
(defun 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."
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(unless (get-buffer buffer)
(setq imap-buffer-list (cons buffer imap-buffer-list)))
***************
*** 435,440 ****
--- 536,543 ----
buffer))
(defun 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."
(and (setq buffer (get-buffer (or buffer (current-buffer))))
(buffer-live-p buffer)
(with-current-buffer buffer
***************
*** 442,447 ****
--- 545,556 ----
(memq (process-status imap-process) '(open run))))))
(defun 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."
(with-current-buffer buffer
(when (eq imap-state 'nonauth)
(make-variable-buffer-local 'imap-username)
***************
*** 468,475 ****
t))
(defun imap-capability (&optional identifier buffer)
! "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"))
--- 577,585 ----
t))
(defun 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."
(with-current-buffer (or buffer (current-buffer))
(unless imap-capability
(unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
***************
*** 479,491 ****
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:
--- 589,608 ----
imap-capability)))
(defun imap-namespace (&optional buffer)
! "Return a namespace hierarchy at server in BUFFER. If BUFFER is nil,
! the current buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
(unless imap-namespace
(when (imap-capability 'NAMESPACE)
(imap-send-command-wait 'NAMESPACE)))
imap-namespace))
+ (defun imap-send-command-wait (command &optional buffer)
+ (imap-wait-for-tag (imap-send-command command buffer) buffer))
+
+ (defun imap-ok-p (status)
+ (eq status 'OK))
+
;; Mailbox functions:
***************
*** 672,692 ****
(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))))
--- 789,806 ----
(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))
! (or (assq tag imap-failed-tags)
! 'OK)))
!
(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))))
***************
*** 709,714 ****
--- 823,829 ----
(while (setq end (imap-find-next-line))
(save-restriction
(narrow-to-region (point-min) end)
+ (delete-backward-char (length imap-server-eol))
(goto-char (point-min))
;; unwind-protect when parser is debugged
(cond ((eq imap-state 'initial)
***************
*** 760,770 ****
(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))))
--- 875,885 ----
(cond ((eq token '*)
(let* ((response (read (current-buffer)))
(func (cdr (assq response imap-parse-response-data-cb))))
! (goto-char (1+ (point)))
(when (integerp response)
(setq func (cdr (assq (read (current-buffer))
imap-parse-response-data-cb)))
! (goto-char (1+ (point))))
(if func
(funcall func response)
(message "Unknown untagged response: %s" response))))
***************
*** 773,789 ****
(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) ")" ] /
--- 888,920 ----
(cond ((eq status 'OK)
(setq imap-reached-tag (max imap-reached-tag token)))
((eq status 'NO)
! (setq imap-reached-tag (max imap-reached-tag token))
! (let (code text)
! (forward-char)
! (when (eq (char-after) ?\[)
! (setq code (buffer-substring (point)
! (search-forward "]")))
! (forward-char))
! (setq text (buffer-substring (point)))
! (push (list token status code text) imap-failed-tags)))
((eq status 'BAD)
! (setq imap-reached-tag (max imap-reached-tag token))
! (let (code text)
! (forward-char)
! (when (eq (char-after) ?\[)
! (setq code (buffer-substring (point)
! (search-forward "]")))
! (forward-char))
! (setq text (buffer-substring (point)))
! (push (list token status code text) imap-failed-tags)
! (error "Internal error, tag %s status %s code %s text %s"
! token status code text)))
(t
! (error "Garbage after tag: %s" (buffer-substring))))))
((eq token '+)
(imap-parse-continue-req))
(t
! (error "Garbage: %s" (buffer-substring))))))
;; resp-text-code = "ALERT" /
;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
***************
*** 838,849 ****
((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
--- 969,976 ----
((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))))))
;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
;; mailbox-data / message-data / capability-data) CRLF
***************
*** 866,872 ****
;; "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"
;;
--- 993,1000 ----
;; "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"
;;
***************
*** 887,900 ****
(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
--- 1015,1027 ----
(imap-mailbox-put 'exists response))
(defun imap-response-data-expunge (response)
! t)
(defun imap-response-data-recent (response)
(imap-mailbox-put 'recent response))
(defun imap-response-data-capability (response)
! (setq imap-capability (read (concat "(" (buffer-substring (point)) ")"))))
;; mailbox = "INBOX" / astring
;; ; INBOX is case-insensitive. All case variants of
***************
*** 917,938 ****
;;
;; 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)))
--- 1044,1065 ----
;;
;; mbx-list-sflag = "\Noselect" / "\Marked" / "\Unmarked"
;; ; Selectability flags; only one per LIST response
+ ;;
+ ;; QUOTED-CHAR = <any TEXT-CHAR except quoted-specials> /
+ ;; "\" quoted-specials
+ ;;
+ ;; quoted-specials = DQUOTE / "\"
(defun imap-response-data-list (type)
(let (flags delimiter mailbox)
! (setq flags (imap-parse-flag-list))
! (when (looking-at " NIL\\| \"\\(.\\)\"")
! (setq delimiter (match-string 1))
! (goto-char (1+ (match-end 0)))
! (when (setq mailbox (or (imap-parse-atom) (imap-parse-string)))
! (imap-mailbox-put type t mailbox)
! (imap-mailbox-put 'list-flags flags mailbox)
! (imap-mailbox-put 'delimiter delimiter mailbox)))))
(defun imap-response-data-flags (response)
(imap-mailbox-put 'flags (imap-parse-flag-list)))
***************
*** 989,1042 ****
;; ; 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) ?\())
--- 1116,1166 ----
;; ; Strictly ascending
(defun imap-response-data-fetch (response)
! (if (not (save-excursion (re-search-forward "UID \\([0-9]+\\)" nil t)))
! (message "Skipping UID-less fetch response (probably broken server)...")
! (setq imap-current-message (string-to-number (match-string 1)))
! (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)))))
! (run-hooks 'imap-fetch-data-hook)))
(defun imap-response-data-search (response)
! (imap-mailbox-put 'search
! (read (concat "(" (buffer-substring (point)) ")"))))
(defun imap-response-data-status (response)
(assert (eq (char-after) ?\())
***************
*** 1045,1061 ****
(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))))))
--- 1169,1185 ----
(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))))))
***************
*** 1076,1084 ****
;; ; 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
--- 1200,1210 ----
;; ; revisions of this specification.
(defun imap-parse-flag-list ()
! (let ((str (buffer-substring (point) (search-forward ")" nil t)))
! pos)
! (while (setq pos (string-match "\\\\" str (and pos (+ 2 pos))))
! (setq str (replace-match "\\\\" nil t str)))
! (read str)))
;; 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
***************
*** 1282,1287 ****
--- 1408,1415 ----
imap-close
imap-capability
imap-namespace
+ imap-send-command-wait
+ imap-ok-p
imap-mailbox-put
imap-mailbox-get
imap-mailbox-map
***************
*** 1295,1308 ****
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
--- 1423,1434 ----
imap-message-put
imap-message-get
imap-message-map
! imap-message-search
imap-message-flags-set
imap-message-flags-del
imap-message-flags-add
imap-send-command
imap-wait-for-tag
imap-sentinel
imap-find-next-line
imap-arrival-filter
***************
*** 1319,1326 ****
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
--- 1445,1450 ----
***************
*** 1330,1336 ****
imap-parse-string
imap-parse-quoted
imap-parse-literal
- imap-parse-text
imap-read-passwd
)))
--- 1454,1459 ----
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.107 nnimap/nnimap.el:1.110
*** nnimap/nnimap.el:1.107 Thu Dec 17 20:44:34 1998
--- nnimap/nnimap.el Fri Dec 18 17:16:03 1998
***************
*** 96,102 ****
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.84")
;; Various server variables.
--- 96,102 ----
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.85")
;; Various server variables.
***************
*** 402,407 ****
--- 402,411 ----
(delete-char -2)
(insert ".\n")))))
uncompressed)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (delete-backward-char 1)))
'headers))))
(deffoo nnimap-open-server (server &optional defs)
***************
*** 477,484 ****
nnimap-server-buffer-alist))))
(when buffer
(with-current-buffer buffer
! (or (cdr imap-last-status)
! (nnoo-status-message 'nnimap server))))))
(deffoo nnimap-request-article (article &optional group server to-buffer)
(nnimap-request-article-part 'RFC822 article group server to-buffer t))
--- 481,487 ----
nnimap-server-buffer-alist))))
(when buffer
(with-current-buffer buffer
! (nnoo-status-message 'nnimap server)))))
(deffoo nnimap-request-article (article &optional group server to-buffer)
(nnimap-request-article-part 'RFC822 article group server to-buffer t))
***************
*** 503,519 ****
;; Find the article by number
(nnimap-send-command-wait (format "UID FETCH %d (%s%s)" article part
(if add-peek ".PEEK" "")))
! (let ((text (funcall (if (and (fboundp 'string-as-multibyte)
! (subrp (symbol-function
! 'string-as-multibyte)))
! 'string-as-multibyte
! 'identity) (imap-message-get article part))))
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(if (not text)
(nnheader-report 'nnimap
(format "Article %s does not exist." article))
(insert text)
t)))))))
;;; Select GROUP and unless FAST return 211 EXISTS LOWEST HIGHEST GROUP
--- 506,521 ----
;; Find the article by number
(nnimap-send-command-wait (format "UID FETCH %d (%s%s)" article part
(if add-peek ".PEEK" "")))
! (let ((text (imap-message-get article part)))
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(if (not text)
(nnheader-report 'nnimap
(format "Article %s does not exist." article))
(insert text)
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (delete-backward-char 1))
t)))))))
;;; Select GROUP and unless FAST return 211 EXISTS LOWEST HIGHEST GROUP
***************
*** 536,568 ****
(gnus-message 7 "Opening nnimap group %s..." group)
(when (nnimap-possibly-change-group group server)
(with-current-buffer nnimap-server-buffer
! ;; 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))
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
! (push uid articles)) 'UID)
! ;; start of bug workaround code
! ;; Lotus CCmail is broken, returns:
! ;; C13 FETCH 1,* (UID)
! ;; * 1 FETCH (UID 4198)
! ;; C13 OK Completed
! ;; we fetch * in addition
! (when (< 2 (length articles))
! (when (nnimap-ok-p (nnimap-send-command-wait "FETCH * (UID"))
! (imap-message-map (lambda (uid Uid)
! (push uid articles)) 'UID)))
! ;; end of bug workaround code
! ))
! (when articles
! (nnheader-insert "211 %d %d %d %s\n" exists
! (max 1 (apply 'min articles))
! (apply 'max articles) group)))))
(gnus-message 7 "Opening nnimap group %s...done" group)))
;; Note that there is no need for this in current Gnus (5.6.27), all
--- 538,553 ----
(gnus-message 7 "Opening nnimap group %s..." group)
(when (nnimap-possibly-change-group group server)
(with-current-buffer nnimap-server-buffer
! (let ((exists (imap-mailbox-get 'exists))
articles)
(if (eq 0 exists)
(setq articles '(0))
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
! (push uid articles)) 'UID)))
! (nnheader-insert "211 %d %d %d %s\n" exists
! (max 1 (apply 'min articles))
! (apply 'max articles) group))))
(gnus-message 7 "Opening nnimap group %s...done" group)))
;; Note that there is no need for this in current Gnus (5.6.27), all
***************
*** 593,631 ****
(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)
! ;; start of bug workaround code
! ;; Lotus CCmail is broken, returns:
! ;; C13 FETCH 1,* (UID)
! ;; * 1 FETCH (UID 4198)
! ;; C13 OK Completed
! ;; we fetch * in addition
! (when (< 2 (length articles))
! (when (nnimap-ok-p (nnimap-send-command-wait "FETCH * (UID"))
! (imap-message-map (lambda (uid Uid)
! (push uid articles)) 'UID)))
! ;; end of bug workaround code
! (when articles
! (with-current-buffer nntp-server-buffer
! (insert (format "%s %d %d y\n" group
! (apply 'max articles)
! (apply 'min articles)))
! t)))))))
((eq nnimap-group-list-speed 'medium)
(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)))
--- 578,601 ----
(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)))
(when (nnimap-ok-p (nnimap-send-command-wait "FETCH 1,* (UID)"))
(imap-message-map (lambda (uid Uid)
(push uid articles)) 'UID)
! (with-current-buffer nntp-server-buffer
! (insert (format "%s %d %d y\n" group
! (apply 'max articles)
! (apply 'min articles))))))
! t)))
((eq nnimap-group-list-speed 'medium)
(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)))
***************
*** 764,771 ****
(if (nnimap-ok-p (nnimap-send-command-wait
(format "CREATE %s" to-group)))
(nnimap-split-copy-delete-article article group to-group server)
! (message "Could not create mailbox %s: %s"
! to-group imap-last-status)))))
;; tries to match all rules in nnimap-split-rule against content of
;; nntp-server-buffer, returns a list of groups that matched.
--- 734,740 ----
(if (nnimap-ok-p (nnimap-send-command-wait
(format "CREATE %s" to-group)))
(nnimap-split-copy-delete-article article group to-group server)
! (message "Could not create mailbox %s." to-group)))))
;; tries to match all rules in nnimap-split-rule against content of
;; nntp-server-buffer, returns a list of groups that matched.
***************
*** 916,923 ****
(substring date 1)
date)))
! (defun nnimap-request-expire-articles-progress (num fetch data)
! (gnus-message 5 "Expiring; marking article %d for deletion..." num))
;; Notice that we don't actually delete anything, we just mark them deleted.
(deffoo nnimap-request-expire-articles (articles group &optional server force)
--- 885,893 ----
(substring date 1)
date)))
! (defun nnimap-request-expire-articles-progress ()
! (gnus-message 5 "Expiring; marking article %d for deletion..."
! imap-current-message))
;; Notice that we don't actually delete anything, we just mark them deleted.
(deffoo nnimap-request-expire-articles (articles group &optional server force)
***************
*** 949,956 ****
(format "UID %s NOT SINCE %s"
(nnimap-range-to-string artseq)
(nnimap-date-days-ago days))))
! (let ((imap-cb-fetch-hook
! 'nnimap-request-expire-articles-progress))
(when (and oldarts (imap-message-flags-add
(nnimap-range-to-string
(gnus-compress-sequence oldarts))
--- 919,926 ----
(format "UID %s NOT SINCE %s"
(nnimap-range-to-string artseq)
(nnimap-date-days-ago days))))
! (let ((imap-fetch-data-hook
! '(nnimap-request-expire-articles-progress)))
(when (and oldarts (imap-message-flags-add
(nnimap-range-to-string
(gnus-compress-sequence oldarts))
***************
*** 998,1004 ****
(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)))))))
--- 968,974 ----
(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)))))))
***************
*** 1129,1135 ****
(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
--- 1099,1107 ----
(imap-send-command-wait command buffer))
(defun nnimap-ok-p (status)
! (if (imap-ok-p status)
! t
! (nnheader-report 'nnimap (nth 3 status))))
(defun nnimap-expunge-close-group (&optional server)
(with-current-buffer nnimap-server-buffer
Index: nnimap/nnimap.texi
diff -c nnimap/nnimap.texi:1.18 nnimap/nnimap.texi:1.19
*** nnimap/nnimap.texi:1.18 Thu Dec 17 20:45:55 1998
--- nnimap/nnimap.texi Fri Dec 18 12:51:18 1998
***************
*** 7,13 ****
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
@set NNIMAP-VERSION 0.84
@ifinfo
--- 7,13 ----
@setchapternewpage odd
@paragraphindent 0
! @set VERSION $Revision: 1.1 $
@set NNIMAP-VERSION 0.84
@ifinfo
***************
*** 58,63 ****
--- 58,66 ----
The intent of this document is to describe every aspect of nnimap at the
user level. This document corresponds to nnimap @value{NNIMAP-VERSION}.
+
+ Please note that nnimap require that you use the latest Gnus series,
+ called Pterodactyl Gnus.
To use nnimap, you should
@enumerate