[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.85 -> 0.86 patches
- To: nnimap@extundo.com
- Subject: nnimap 0.85 -> 0.86 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 19 Dec 1998 23:56:51 +0100
- User-Agent: Gnus/5.070066 (Pterodactyl Gnus v0.66) XEmacs/21.2(beta5) (Aphrodite)
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.148 nnimap/ChangeLog:1.152
*** nnimap/ChangeLog:1.148 Fri Dec 18 17:15:42 1998
--- nnimap/ChangeLog Sat Dec 19 14:23:50 1998
***************
*** 1,3 ****
--- 1,47 ----
+ 1998-12-19 23:21:02 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.86 released.
+
+ 1998-12-19 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el: Don't `error' in process filter (`message' instead).
+
+ * imap.el (imap-current-target-mailbox): New variable for
+ COPY/APPEND data.
+ (imap-mailbox-status): Work.
+ (imap-message-append): Don't encode article (send-command need it
+ as a buffer).
+ (imap-response-data-text-code): Handle UIDPLUS.
+ (imap-response-data-status): Work.
+
+ 1998-12-19 06:32:32 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-parse-response):
+ (imap-response-data-text-code):
+ (imap-response-data-capability):
+ (imap-response-data-search): Buffer-substring requires two
+ arguments in Emacs.
+
+ 1998-12-19 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-retrieve-headers-progress): New function
+ (nnimap-retrieve-headers): Use it to display progress.
+ (nnimap-length):
+ (nnimap-counter): New variables.
+ (nnimap-request-accept-article): Use imap-message-append.
+
+ * imap.el (imap-mailbox-status):
+ (imap-message-append): New API functions.
+ (imap-parse-literal):
+ (imap-parse-string):
+ (imap-parse-nstring):
+ (imap-parse-astring):
+ (imap-parse-mailbox): Defsubst, optimize.
+ (imap-parse-quoted):
+ (imap-parse-atom): Removed.
+ (imap-response-data-status): Work.
+ (imap-encode-string): New function.
+
1998-12-19 02:11:12 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.85 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.83 nnimap/imap.el:1.87
*** nnimap/imap.el:1.83 Fri Dec 18 17:11:39 1998
--- nnimap/imap.el Sat Dec 19 14:28:50 1998
***************
*** 198,203 ****
--- 198,204 ----
imap-username
imap-password
imap-current-mailbox
+ imap-current-target-mailbox
imap-capability
imap-namespace
imap-state
***************
*** 251,256 ****
--- 252,260 ----
(defvar imap-current-mailbox nil
"Current mailbox name.")
+ (defvar imap-current-target-mailbox nil
+ "Current target mailbox for COPY and APPEND commands.")
+
(defvar imap-mailbox-data nil
"Obarray with mailbox data.")
***************
*** 459,464 ****
--- 463,469 ----
(defun imap-open-1 (buffer)
(with-current-buffer buffer
+ (erase-buffer)
(setq imap-current-mailbox nil
imap-current-message nil
imap-state 'initial
***************
*** 566,572 ****
(with-current-buffer (or buffer (current-buffer))
(and (imap-opened)
(not (imap-ok-p (imap-send-command-wait "LOGOUT")))
! (error "Server %s didn't let me log out" imap-server))
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
--- 571,577 ----
(with-current-buffer (or buffer (current-buffer))
(and (imap-opened)
(not (imap-ok-p (imap-send-command-wait "LOGOUT")))
! (message "Server %s didn't let me log out" imap-server))
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
***************
*** 712,717 ****
--- 717,743 ----
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " mailbox)))))
+ (defun imap-mailbox-status (mailbox items &optional buffer)
+ "Get status items ITEM in MAILBOX from server in BUFFER. ITEMS can
+ be a symbol or a list of symbols, valid symbols are one of the STATUS
+ data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity or
+ 'unseen. If ITEMS is a list of symbols, a list of values is returned,
+ if ITEMS is a symbol only it's value is returned."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (imap-ok-p
+ (imap-send-command-wait (list "STATUS "
+ (imap-encode-string mailbox)
+ " "
+ (format "%s"
+ (if (listp items)
+ items
+ (list items))))))
+ (if (listp items)
+ (mapcar (lambda (item)
+ (imap-mailbox-get item mailbox))
+ items)
+ (imap-mailbox-get items mailbox)))))
+
;; Message functions:
***************
*** 764,769 ****
--- 790,812 ----
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
+ (defun imap-message-append (mailbox article &optional buffer flags date-time)
+ "Append ARTICLE buffer to MAILBOX on server in BUFFER. FLAGS and
+ DATE-TIME is currently not used."
+ (with-current-buffer (or buffer (current-buffer))
+ (if (imap-capability 'UIDPLUS)
+ (let ((imap-current-target-mailbox mailbox))
+ (when (imap-ok-p (imap-send-command-wait
+ (list "APPEND " (imap-encode-string mailbox) " "
+ article)))
+ (cdr (imap-mailbox-get 'appenduid mailbox))))
+ (let (res)
+ (when (setq res (imap-mailbox-status mailbox '(uidvalidity uidnext)))
+ (when (imap-ok-p (imap-send-command-wait
+ (list "APPEND " (imap-encode-string mailbox) " "
+ article)))
+ res))))))
+
;; Internal functions.
***************
*** 825,844 ****
(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)
! (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
--- 868,974 ----
(narrow-to-region (point-min) end)
(delete-backward-char (length imap-server-eol))
(goto-char (point-min))
! (unwind-protect
! (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
! (message "Unknown state %s in arrival filter"
! imap-state)))
! (delete-region (point-min) (point-max))))))))
;; Imap parser.
+ ;; literal = "{" number "}" CRLF *CHAR8
+ ;; ; Number represents the number of CHAR8s
+
+ (defsubst 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))))))
+
+ ;; string = quoted / 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>
+
+
+ (defsubst imap-parse-string ()
+ (cond ((eq (char-after) ?\")
+ (read (current-buffer)))
+ ((eq (char-after) ?{)
+ (imap-parse-literal))))
+
+ ;; nil = "NIL"
+ ;;
+ ;; nstring = string / nil
+
+ (defsubst imap-parse-nstring ()
+ (or (imap-parse-string)
+ (when (looking-at "NIL")
+ (goto-char (+ (point) 3))
+ nil)))
+
+ ;; astring = atom / string
+ ;;
+ ;; atom = 1*ATOM-CHAR
+ ;;
+ ;; ATOM-CHAR = <any CHAR except atom-specials>
+ ;;
+ ;; atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards /
+ ;; quoted-specials
+ ;;
+ ;; list-wildcards = "%" / "*"
+ ;;
+ ;; quoted-specials = DQUOTE / "\"
+
+ (defsubst imap-parse-astring ()
+ (or (imap-parse-string)
+ (read (current-buffer))))
+
+ ;; 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.
+ ;;
+ ;; astring = atom / string
+ ;;
+ ;; atom = 1*ATOM-CHAR
+ ;;
+ ;; ATOM-CHAR = <any CHAR except atom-specials>
+ ;;
+ ;; atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards /
+ ;; quoted-specials
+ ;;
+ ;; list-wildcards = "%" / "*"
+ ;;
+ ;; quoted-specials = DQUOTE / "\"
+
+ (defsubst imap-parse-mailbox ()
+ (let ((mailbox (or (imap-parse-string)
+ (format "%s" (read (current-buffer))))))
+ (if (string-equal "INBOX" (upcase mailbox))
+ "INBOX"
+ mailbox)))
+
;; greeting = "*" SP (resp-cond-auth / resp-cond-bye) CRLF
;;
;; resp-cond-auth = ("OK" / "PREAUTH") SP resp-text
***************
*** 895,901 ****
(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))
--- 1025,1031 ----
(setq code (buffer-substring (point)
(search-forward "]")))
(forward-char))
! (setq text (buffer-substring (point) (point-max)))
(push (list token status code text) imap-failed-tags)))
((eq status 'BAD)
(setq imap-reached-tag (max imap-reached-tag token))
***************
*** 905,920 ****
(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) ")" ] /
--- 1035,1050 ----
(setq code (buffer-substring (point)
(search-forward "]")))
(forward-char))
! (setq text (buffer-substring (point) (point-max)))
(push (list token status code text) imap-failed-tags)
! (message "Internal error, tag %s status %s code %s text %s"
! token status code text)))
(t
! (message "Garbage after tag: %s" (buffer-string))))))
((eq token '+)
(imap-parse-continue-req))
(t
! (message "Garbage: %s" (buffer-string))))))
;; resp-text-code = "ALERT" /
;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
***************
*** 929,934 ****
--- 1059,1066 ----
;; "UNSEEN" SP nz-number /
;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
;;
+ ;; resp_code_apnd = "APPENDUID" SPACE nz_number SPACE uniqueid
+ ;;
;; flag-perm = flag / "\*"
;;
;; flag = "\Answered" / "\Flagged" / "\Deleted" /
***************
*** 952,965 ****
(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))
--- 1084,1099 ----
(forward-char)
(cond ((search-forward "PERMANENTFLAGS " nil t)
(imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
((search-forward "UIDNEXT " nil t)
(imap-mailbox-put 'uidnext (read (current-buffer))))
((search-forward "UNSEEN " nil t)
(imap-mailbox-put 'unseen (read (current-buffer))))
+ ((looking-at "UIDVALIDITY \\([0-9]+\\)")
+ (imap-mailbox-put 'uidvalidity (match-string 1)))
+ ((search-forward "READ-ONLY" nil t)
+ (imap-mailbox-put 'read-only t))
+ ((search-forward "COPYUID" nil t)
+ t)
((search-forward "NEWNAME " nil t)
(let (oldname newname)
(setq oldname (imap-parse-string))
***************
*** 968,976 ****
(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))))))
;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
;; mailbox-data / message-data / capability-data) CRLF
--- 1102,1115 ----
(imap-mailbox-put 'newname newname oldname)))
((search-forward "TRYCREATE" nil t)
(imap-mailbox-put 'trycreate t))
+ ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
+ (imap-mailbox-put 'appenduid
+ (list (match-string 1)
+ (string-to-number (match-string 2)))
+ imap-current-target-mailbox))
((search-forward "ALERT] " nil t)
(message "Imap server %s information: %s" imap-server
! (buffer-substring (point) (point-max))))))
;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
;; mailbox-data / message-data / capability-data) CRLF
***************
*** 1021,1037 ****
(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
- ;; ; 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
;;
--- 1160,1168 ----
(imap-mailbox-put 'recent response))
(defun imap-response-data-capability (response)
! (setq imap-capability
! (read (concat "(" (buffer-substring (point) (point-max)) ")"))))
;; mailbox-list = "(" [mbx-list-flags] ")" SP
;; (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox
;;
***************
*** 1056,1062 ****
(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)))))
--- 1187,1193 ----
(when (looking-at " NIL\\| \"\\(.\\)\"")
(setq delimiter (match-string 1))
(goto-char (1+ (match-end 0)))
! (when (setq mailbox (imap-parse-mailbox))
(imap-mailbox-put type t mailbox)
(imap-mailbox-put 'list-flags flags mailbox)
(imap-mailbox-put 'delimiter delimiter mailbox)))))
***************
*** 1153,1187 ****
(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) ?\())
! (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)] ")"
;;
--- 1284,1330 ----
(imap-parse-body)))
((eq token 'BODYSTRUCTURE)
(imap-message-put imap-current-message 'BODYSTRUCTURE
! (imap-parse-body))))))
(run-hooks 'imap-fetch-data-hook)))
+ ;; mailbox-data = ...
+ ;; "SEARCH" *(SP nz-number) /
+ ;; ...
+
(defun imap-response-data-search (response)
! (imap-mailbox-put
! 'search
! (read (concat "(" (buffer-substring (point) (point-max)) ")"))))
!
! ;; mailbox-data = ...
! ;; "STATUS" SP mailbox SP "("
! ;; [status-att SP number
! ;; *(SP status-att SP number)] ")"
! ;; ...
! ;;
! ;; status-att = "MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" /
! ;; "UNSEEN"
(defun imap-response-data-status (response)
! (let ((mailbox (imap-parse-mailbox)))
! (when (and mailbox (search-forward "(" nil t))
! (while (not (eq (char-after) ?\)))
! (let ((token (read (current-buffer))))
! (cond ((eq token 'MESSAGES)
! (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
! ((eq token 'RECENT)
! (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
! ((eq token 'UIDNEXT)
! (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox))
! ((eq token 'UIDVALIDITY)
! (and (looking-at " \\([0-9]+\\)")
! (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
! (goto-char (match-end 1))))
! ((eq token 'UNSEEN)
! (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
! (t
! (message "Unknown status data %s in mailbox %s ignored"
! token mailbox))))))))
;; flag-list = "(" [flag *(SP flag)] ")"
;;
***************
*** 1303,1373 ****
;; 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'."
--- 1446,1458 ----
;; xxx: does not handle literals
(read (current-buffer)))
;; Utility functions.
+ (defun imap-encode-string (string)
+ ;; xxx make literal if strange characters in string
+ (concat "\"" string "\""))
+
(defun imap-read-passwd (prompt &rest args)
"Read a password using PROMPT. If ARGS, PROMPT is used as an
argument to `format'."
***************
*** 1448,1458 ****
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-read-passwd
)))
--- 1533,1541 ----
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.110 nnimap/nnimap.el:1.112
*** nnimap/nnimap.el:1.110 Fri Dec 18 17:16:03 1998
--- nnimap/nnimap.el Sat Dec 19 14:23:31 1998
***************
*** 96,102 ****
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.85")
;; Various server variables.
--- 96,102 ----
(nnoo-declare nnimap) ; we derive from no one
! (defconst nnimap-version "nnimap 0.86")
;; Various server variables.
***************
*** 282,287 ****
--- 282,289 ----
;; been opened, the function should fail."
(defvar nnimap-server-buffer-alist nil)
+ (defvar nnimap-length)
+ (defvar nnimap-counter)
(defvar nnimap-debug "*nnimap-debug*")
(when nnimap-debug
***************
*** 366,371 ****
--- 368,381 ----
(apply '+ (mapcar 'nnimap-body-lines body)))
0))
+
+ (defun nnimap-retrieve-headers-progress ()
+ (when (> nnimap-length 25)
+ (setq nnimap-counter (1+ nnimap-counter))
+ (message "Fetching headers... %-3d%%"
+ (* 100.0 (/ (float nnimap-counter)
+ nnimap-length)))))
+
;; todo:
;; use NOV lines instead? A fetch like
;; (UID RFC822.SIZE BODY BODY[HEADER.FIELDS (References)]) would do it
***************
*** 381,392 ****
;; had the mailbox SELECTed. This isn't really necessery (the user
;; will find out when he selects the article anyway).
;(imap-message-reset)
! (nnimap-ok-p (nnimap-send-command-wait
! (concat "UID FETCH "
! (if (and fetch-old (not (numberp fetch-old)))
! "1:*"
! (nnimap-range-to-string compressed))
! " (UID RFC822.HEADER RFC822.SIZE BODY)")))
(mapc (lambda (num)
(let* ((header (imap-message-get num 'RFC822.HEADER))
(size (imap-message-get num 'RFC822.SIZE))
--- 391,405 ----
;; had the mailbox SELECTed. This isn't really necessery (the user
;; will find out when he selects the article anyway).
;(imap-message-reset)
! (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
! (nnimap-length (length uncompressed))
! (nnimap-counter 0))
! (nnimap-ok-p (nnimap-send-command-wait
! (concat "UID FETCH "
! (if (and fetch-old (not (numberp fetch-old)))
! "1:*"
! (nnimap-range-to-string compressed))
! " (UID RFC822.HEADER RFC822.SIZE BODY)"))))
(mapc (lambda (num)
(let* ((header (imap-message-get num 'RFC822.HEADER))
(size (imap-message-get num 'RFC822.SIZE))
***************
*** 950,977 ****
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
! ;; We assume article is appended as UIDNEXT if no UIDPLUS support.
! (when (or (imap-capability 'UIDPLUS nnimap-server-buffer)
! (nnimap-ok-p (nnimap-send-command-wait
! (concat "STATUS " group " (UIDNEXT)")
! 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)))))))
;; (deffoo nnimap-request-replace-article -- IMAP does not support replacing
--- 963,978 ----
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-server server)
! ;; turn into rfc822 format (\r\n eol's) if needed
! (with-current-buffer (current-buffer)
! (goto-char (point-min))
! (while (re-search-forward "\\(^\\|[^\r]\\)\n" nil t)
! (replace-match "\r\n")))
! (let ((status (imap-message-append group
! (current-buffer)
! nnimap-server-buffer)))
! (when status
! (cons group (nth 2 status))))))
;; (deffoo nnimap-request-replace-article -- IMAP does not support replacing