[Date Prev][Date Next]
[Chronological]
[Thread]
[Top]
nnimap 0.101 released
- To: nnimap@extundo.com
- Subject: nnimap 0.101 released
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 18 May 1999 00:00:08 +0200
- User-Agent: Gnus/5.070083 (Pterodactyl Gnus v0.83) Emacs/20.3
Index: nnimap/ChangeLog
diff -c nnimap/ChangeLog:1.202 nnimap/ChangeLog:1.204
*** nnimap/ChangeLog:1.202 Fri May 14 08:07:27 1999
--- nnimap/ChangeLog Mon May 17 14:45:55 1999
***************
*** 1,3 ****
--- 1,38 ----
+ 1999-05-17 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.101 released.
+
+ * nnimap.el (nnimap-replace-tabs): Use nsubstitue.
+ (nnimap-retrieve-headers-progress): Don't insert NOV lines
+ here. nnml messages.
+ (nnimap-retrieve-headers-get-uids): Don't search articles.
+ (nnimap-retrieve-headers): Insert NOV lines. nnml messages.
+ (nnimap-request-article-part): Use new imap-fetch.
+ (nnimap-nov-file): New variable.
+
+ * imap.el (imap-parse-astring): Don't use `line-end-position',
+ Emacs 20.4 specific.
+
+ 1999-05-17 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
+
+ * nnimap.el (nnimap-split-articles): Turn number into string.
+
+ 1999-05-15 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-retrieve-headers-store-uids):
+ (nnimap-retrieve-headers-get-uids):
+ (nnimap-retrieve-headers-from-cache):
+ (nnimap-retrieve-headers): Prepare for NOV caching.
+
+ * imap.el (imap-message-fetch): Renamed to imap-fetch. Return
+ props formatted as arguments.
+
+ * nnimap.el: Never expunge articles if unsure.
+ (nnimap-body-lines): Removed.
+ (nnimap-need-expunge): Removed.
+ (nnimap-retrieve-headers-progress): Use gnus-strip-whitespace.
+ (nnimap-expunge-close-group): Cleanup, default to no expunging.
+
1999-05-14 Simon Josefsson <jas@pdc.kth.se>
* nnimap.el: 0.100 released.
Index: nnimap/imap.el
diff -c nnimap/imap.el:1.130 nnimap/imap.el:1.132
*** nnimap/imap.el:1.130 Fri May 14 07:53:21 1999
--- nnimap/imap.el Mon May 17 13:41:04 1999
***************
*** 858,886 ****
(list list))
","))
! (defun imap-message-fetch (uids props &optional receive nouidfetch buffer)
"Fetch properties PROPS from message set UIDS from server in
! BUFFER. UIDS is a list of articles. If RECEIVE is non-nil return
! theese properties."
(with-current-buffer (or buffer (current-buffer))
! (let ((uids (if (or (stringp uids) (listp uids)) uids (list uids)))
! (props (if (or (stringp props) (listp props)) props (list props))))
! (when (imap-ok-p (imap-send-command-wait
! (concat (or nouidfetch
! "UID ")
! "FETCH "
! (if (listp uids)
! (imap-list-to-message-set uids)
! uids)
! " "
! props)))
! (if (not (and receive (listp uids)))
! t
! (mapcar (lambda (uid)
! (mapcar (lambda (prop)
! (imap-message-get uid prop))
! (if (listp receive) receive (list receive))))
! uids))))))
(defun imap-message-put (uid propname value &optional buffer)
(with-current-buffer (or buffer (current-buffer))
--- 858,885 ----
(list list))
","))
! (defun imap-fetch (uids props &optional receive nouidfetch buffer)
"Fetch properties PROPS from message set UIDS from server in
! BUFFER. UIDS can be a string, number or a list of numbers. If RECEIVE
! is non-nil return theese properties."
(with-current-buffer (or buffer (current-buffer))
! (when (imap-ok-p (imap-send-command-wait
! (format "%sFETCH %s %s" (or nouidfetch "UID ")
! (if (listp uids)
! (imap-list-to-message-set uids)
! uids)
! props)))
! (if (or (null receive) (stringp uids))
! t
! (if (listp uids)
! (mapcar (lambda (uid)
! (if (listp receive)
! (mapcar (lambda (prop)
! (imap-message-get uid prop))
! receive)
! (imap-message-get uid receive)))
! uids)
! (imap-message-get uids receive))))))
(defun imap-message-put (uid propname value &optional buffer)
(with-current-buffer (or buffer (current-buffer))
***************
*** 993,999 ****
(state imap-state)
(imap-message-data (make-vector 2 0)))
(imap-mailbox-select mailbox nil 'examine)
! (imap-message-fetch "*" "UID")
(prog1
(list (imap-mailbox-get 'uidvalidity mailbox)
(car (imap-message-map (lambda (uid prop) uid) 'UID)))
--- 992,998 ----
(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)))
***************
*** 1010,1016 ****
(state imap-state)
(imap-message-data (make-vector 2 0)))
(imap-mailbox-select mailbox nil 'examine)
! (imap-message-fetch "*" "UID")
(prog1
(list (imap-mailbox-get 'uidvalidity mailbox)
(car (imap-message-map (lambda (uid prop) uid) 'UID)))
--- 1009,1015 ----
(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)))
***************
*** 1273,1281 ****
(defsubst imap-parse-astring ()
(or (imap-parse-string)
! (buffer-substring (point)
! (or (search-forward " " (line-end-position) t)
! (line-end-position)))))
;; address = "(" addr-name SP addr-adl SP addr-mailbox SP
;; addr-host ")"
--- 1272,1278 ----
(defsubst imap-parse-astring ()
(or (imap-parse-string)
! (buffer-substring (point) (re-search-forward " \r\n" nil t))))
;; address = "(" addr-name SP addr-adl SP addr-mailbox SP
;; addr-host ")"
Index: nnimap/nnimap.el
diff -c nnimap/nnimap.el:1.149 nnimap/nnimap.el:1.155
*** nnimap/nnimap.el:1.149 Fri May 14 08:06:57 1999
--- nnimap/nnimap.el Mon May 17 14:46:21 1999
***************
*** 90,99 ****
(require 'imap))
(require 'nnoo)
(nnoo-declare nnimap)
! (defconst nnimap-version "nnimap 0.100")
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
--- 90,105 ----
(require 'imap))
(require 'nnoo)
+ (require 'nnmail)
+ (require 'gnus)
+ (require 'gnus-range)
(nnoo-declare nnimap)
+
+ (gnus-declare-backend "nnimap" 'mail 'address 'prompt-address
+ 'physical-address)
! (defconst nnimap-version "nnimap 0.101")
(defvoo nnimap-address nil
"Address of physical IMAP server. If nil, use the virtual server's name.")
***************
*** 179,188 ****
(defvoo nnimap-directory message-directory
"Data directory for the nnimap backend.")
! (defvoo nnimap-active-file
! (concat (file-name-as-directory nnimap-directory) "active.nnimap.")
! "Mail active file for the nnimap backend. The virtual server name
! will be appended")
(defcustom nnimap-authinfo-file "~/.authinfo"
"Authorization information for IMAP servers. In .netrc format."
--- 185,195 ----
(defvoo nnimap-directory message-directory
"Data directory for the nnimap backend.")
! (defvoo nnimap-nov-file "overview."
! "NOV cache base filename. The group name will be appended. A typical
! complete file name would be ~/Mail/overview.nnimap+pdc:INBOX.spam, or
! ~/Mail/overview/nnimap/pdc/INBOX/spam if `gnus-use-long-file-name' is
! nil")
(defcustom nnimap-authinfo-file "~/.authinfo"
"Authorization information for IMAP servers. In .netrc format."
***************
*** 207,222 ****
;; Legacy variables:
- (require 'nnheader)
- (require 'nnmail)
- (require 'gnus)
- (require 'gnus-range)
-
- (eval-when-compile (require 'cl))
-
- (gnus-declare-backend "nnimap" 'mail 'address 'prompt-address
- 'physical-address 'respool) ;; respool??
-
;; Various server variables.
(defvoo nnimap-list-pattern "*"
--- 214,219 ----
***************
*** 270,286 ****
;; Internal variables.
- (defvoo nnimap-need-expunge nil)
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
(defvar nnimap-length)
(defvar nnimap-counter)
(defvar nnimap-debug "*nnimap-debug*")
;; nnimap 1.x functions:
(defmacro nnimap-get-server-buffer (server)
"Return buffer for SERVER. If SERVER is nil, the current server is
used."
--- 267,285 ----
;; Internal variables.
(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
(defvar nnimap-current-server nil) ;; Current server
(defvar nnimap-server-buffer nil) ;; Current servers' buffer
(defvar nnimap-length)
(defvar nnimap-counter)
+ (defvar nnimap-uids)
(defvar nnimap-debug "*nnimap-debug*")
;; nnimap 1.x functions:
+ (nnoo-define-basics nnimap)
+
(defmacro nnimap-get-server-buffer (server)
"Return buffer for SERVER. If SERVER is nil, the current server is
used."
***************
*** 293,357 ****
(setq nnimap-current-server (or server nnimap-current-server)
nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
- (nnoo-define-basics nnimap)
-
(defsubst nnimap-replace-tabs (string)
"Translate TAB characters into SPACE characters in STRING."
! (subst-char-in-string ?\t ? string t))
!
! (defsubst nnimap-remove-delimiter (string)
! "Remove trailing \r\n\r\n (rfc822 head/body delimiter) from string"
! (and (> (length string) 4)
! (substring string 0 -4)))
(defun nnimap-retrieve-headers-progress ()
! (when (and (> nnimap-length 25) (eq (mod nnimap-counter 5) 0))
! (setq nnimap-counter (1+ nnimap-counter))
! (message "Fetching headers... %-3d%%"
! (* 100.0 (/ (float nnimap-counter) nnimap-length))))
! (with-current-buffer nntp-server-buffer
! (nnheader-insert-nov
! (vector imap-current-message
! (nnimap-replace-tabs (imap-message-envelope-subject
! imap-current-message))
! (nnimap-replace-tabs (imap-envelope-from
! (car-safe (imap-message-envelope-from
! imap-current-message))))
! (nnimap-replace-tabs (imap-message-envelope-date
! imap-current-message))
! (nnimap-replace-tabs (imap-message-envelope-message-id
! imap-current-message))
! (nnimap-replace-tabs
! (nnimap-remove-delimiter
! (nth 2 (assoc "HEADER.FIELDS (References)"
! (imap-message-get imap-current-message
! 'BODYDETAIL)))))
! (imap-message-get imap-current-message 'RFC822.SIZE)
! (imap-body-lines (imap-message-body imap-current-message))
! nil ;; xref
! nil))) ;; extra-headers
! )
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when (nnimap-possibly-change-group group server)
! (with-current-buffer nntp-server-buffer
! (erase-buffer))
! (let* ((articles (if (numberp (car articles))
! articles
! (mapcar (lambda (msgid)
! (imap-search
! (format "HEADER Message-Id %s" msgid
! nnimap-server-buffer)))
! articles)))
! (compressed (gnus-compress-sequence articles t))
! (imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
! (nnimap-length (length articles))
! (nnimap-counter 0))
! (imap-message-fetch (if (and fetch-old (not (numberp fetch-old)))
! "1:*" (nnimap-range-to-string compressed))
! "(UID RFC822.SIZE ENVELOPE BODY BODY.PEEK[HEADER.FIELDS (References)])"
! nil nil nnimap-server-buffer))
! 'nov))
(defun nnimap-open-connection (server)
(if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
--- 292,361 ----
(setq nnimap-current-server (or server nnimap-current-server)
nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
(defsubst nnimap-replace-tabs (string)
"Translate TAB characters into SPACE characters in STRING."
! (nsubstitute ? ?\t string))
(defun nnimap-retrieve-headers-progress ()
! (and (numberp nnmail-large-newsgroup)
! (> nnimap-length nnmail-large-newsgroup)
! (zerop (% (incf nnimap-counter) 20))
! (nnheader-message 6 "nnimap: Receiving headers... %d%%"
! (/ (* nnimap-counter 100) nnimap-length))))
!
! (defun nnimap-retrieve-headers-store-uids ()
! (setq nnimap-uids (cons imap-current-message nnimap-uids)))
!
! (defun nnimap-retrieve-headers-get-uids (articles fetch-old)
! (with-current-buffer nnimap-server-buffer
! (if (numberp (car articles))
! (if (and fetch-old (not (numberp fetch-old)))
! (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-store-uids))
! nnimap-uids)
! (imap-fetch "1:*" "UID")
! (nreverse nnimap-uids))
! articles)
! (mapcar (lambda (msgid)
! (imap-search
! (format "HEADER Message-Id %s" msgid)))
! articles))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when (nnimap-possibly-change-group group server)
! (let ((uids (nnimap-retrieve-headers-get-uids articles fetch-old))
! (imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
! (nnimap-length (length articles))
! (nnimap-counter 0))
! (imap-fetch (nnimap-range-to-string (gnus-compress-sequence uids t))
! (concat "(UID RFC822.SIZE ENVELOPE BODY "
! "BODY.PEEK[HEADER.FIELDS (References)])")
! nil nil nnimap-server-buffer)
! (and (numberp nnmail-large-newsgroup)
! (> nnimap-length nnmail-large-newsgroup)
! (nnheader-message 6 "nnimap: Receiving headers...done"))
! (with-current-buffer nntp-server-buffer
! (dolist (uid uids)
! (nnheader-insert-nov
! (vector uid
! (nnimap-replace-tabs (imap-message-envelope-subject uid))
! (nnimap-replace-tabs
! (imap-envelope-from
! (car-safe (imap-message-envelope-from uid))))
! (nnimap-replace-tabs (imap-message-envelope-date uid))
! (nnimap-replace-tabs (imap-message-envelope-message-id uid))
! (let ((str (gnus-strip-whitespace
! (nth 2 (assoc
! "HEADER.FIELDS (References)"
! (imap-message-get
! uid 'BODYDETAIL))))))
! (if (> (length str) (length "References:"))
! (substring str (length "References:"))
! str))
! (imap-message-get uid 'RFC822.SIZE)
! (imap-body-lines (imap-message-body uid))
! nil ;; xref
! nil)))) ;; extra-headers
! 'nov)))
(defun nnimap-open-connection (server)
(if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
***************
*** 449,463 ****
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(insert (nnimap-demule
! (or (car-safe
! (car-safe
! (imap-message-fetch
! (if (stringp article)
! (car-safe (imap-search
! (format "HEADER Message-Id %s" article
! nnimap-server-buffer)))
! article)
! part prop nil nnimap-server-buffer)))
"")))
(nnheader-ms-strip-cr)
(if (bobp)
--- 453,465 ----
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(insert (nnimap-demule
! (or (imap-fetch
! (if (stringp article)
! (car-safe (imap-search
! (format "HEADER Message-Id %s" article
! nnimap-server-buffer)))
! article)
! part prop nil nnimap-server-buffer)
"")))
(nnheader-ms-strip-cr)
(if (bobp)
***************
*** 476,481 ****
--- 478,501 ----
(nnimap-request-article-part
article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))
+ (defun nnimap-expunge-close-group (&optional server)
+ (with-current-buffer nnimap-server-buffer
+ (when (nnimap-possibly-change-server server)
+ (case nnimap-expunge-on-close
+ ('always (imap-mailbox-expunge)
+ (imap-mailbox-close))
+ ('ask (when (imap-search "DELETED")
+ (if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
+ imap-current-mailbox))
+ (and (imap-mailbox-expunge)
+ (imap-mailbox-close))
+ (imap-mailbox-unselect))))
+ (t (imap-mailbox-unselect)))
+ (not imap-current-mailbox))))
+
+ (deffoo nnimap-close-group (group &optional server)
+ (nnimap-expunge-close-group server))
+
(defun nnimap-pattern-to-list-arguments (pattern)
(mapcar (lambda (p)
(cons (car-safe p) (or (cdr-safe p) p)))
***************
*** 507,536 ****
;; Optional backend functions
- (defun nnimap-body-lines (body)
- "Return number of lines in article by looking at the mime bodystructure
- BODY."
- (if (listp body)
- (if (stringp (car body))
- (cond ((and (string= (car body) "TEXT")
- (numberp (nth 7 body)))
- (nth 7 body))
- ((and (string= (car body) "MESSAGE")
- (numberp (nth 9 body)))
- (nth 9 body))
- (t 0))
- (apply '+ (mapcar 'nnimap-body-lines body)))
- 0))
-
- ;; nnimap-request-scan doesn't need to do anything. the delivery agent
- ;; program is responsible for putting new message in the imap folders.
- ;; compare the situation with nntp (nil function) and with all nnmail-
- ;; backends (fetches mail from spools, POPing, saving in files on local
- ;; storage etc).
- ;; On the other hand, we could do message splitting here.
- (deffoo nnimap-request-scan (&optional group server)
- (nnimap-split-articles group server))
-
;; This is from nnmail.el:nnmail-expand-newtext, written by Larsi.
(defun nnimap-expand-newtext (newtext)
(let ((len (length newtext))
--- 527,532 ----
***************
*** 616,622 ****
;; copy article to right group(s)
(setq removeorig nil)
(dolist (to-group (nnimap-split-to-groups rule))
! (if (imap-message-copy article to-group nil nil t)
(progn
(message "IMAP split moved %s:%s:%d to %s" server inbox
article to-group)
--- 612,619 ----
;; copy article to right group(s)
(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)
***************
*** 624,633 ****
(message "IMAP split failed to move %s:%s:%d to %s" server
inbox article to-group)))
;; remove article if it was successfully copied somewhere
! (when removeorig
! (setq nnimap-need-expunge t)
! (imap-message-flags-add (format "%d" article)
! "\\Seen \\Deleted")))))
(when (imap-mailbox-select inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(nnimap-expunge-close-group)))
--- 621,629 ----
(message "IMAP split failed to move %s:%s:%d to %s" server
inbox article to-group)))
;; remove article if it was successfully copied somewhere
! (and removeorig
! (imap-message-flags-add (format "%d" article)
! "\\Seen \\Deleted")))))
(when (imap-mailbox-select inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(nnimap-expunge-close-group)))
***************
*** 636,649 ****
(deffoo nnimap-request-type (group &optional article)
'mail)
- ;; (nn)IMAP specific decisions:
- ;;
- ;; o dormant articles are also marked as ticked (for other imap clients)
- ;;
- ;; action looks like:
- ;; (((1 . 10) 'set '(read ticked))
- ;; ((1 . 10) 'del '(tick reply expire killed dormant save download unsend)))
- ;;
(deffoo nnimap-request-set-mark (group actions &optional server)
(when (nnimap-possibly-change-group group server)
(with-current-buffer nnimap-server-buffer
--- 632,637 ----
***************
*** 683,693 ****
--- 671,741 ----
(nnoo-current-server 'nnimap) group))))
nil)
+ (deffoo nnimap-request-scan (&optional group server)
+ (nnimap-split-articles group server))
+
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
(or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
(imap-mailbox-create group nnimap-server-buffer))))
+ (defun nnimap-time-substract (time1 time2)
+ "Return TIME for TIME1 - TIME2."
+ (let* ((ms (- (car time1) (car time2)))
+ (ls (- (nth 1 time1) (nth 1 time2))))
+ (if (< ls 0)
+ (list (- ms 1) (+ (expt 2 16) ls))
+ (list ms ls))))
+
+ (defun nnimap-date-days-ago (daysago)
+ "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
+ (let ((date (format-time-string "%d-%b-%Y"
+ (nnimap-time-substract
+ (current-time)
+ (if (fboundp 'days-to-time)
+ (days-to-time daysago)
+ (nnmail-days-to-time daysago))))))
+ (if (eq ?0 (string-to-char date))
+ (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)
+ (let ((artseq (gnus-compress-sequence articles)))
+ (when (and artseq (nnimap-possibly-change-group group server))
+ (with-current-buffer nnimap-server-buffer
+ (if force
+ (and (imap-message-flags-add
+ (nnimap-range-to-string artseq) "\\Deleted")
+ (setq articles nil))
+ (let ((days (or (and nnmail-expiry-wait-function
+ (funcall nnmail-expiry-wait-function group))
+ nnmail-expiry-wait)))
+ (cond ((eq days 'immediate)
+ (and (imap-message-flags-add
+ (nnimap-range-to-string artseq) "\\Deleted")
+ (setq articles nil)))
+ ((numberp days)
+ (let ((oldarts (imap-search
+ (format "UID %s NOT SINCE %s"
+ (nnimap-range-to-string artseq)
+ (nnimap-date-days-ago days))))
+ (imap-fetch-data-hook
+ '(nnimap-request-expire-articles-progress)))
+ (and oldarts
+ (imap-message-flags-add
+ (nnimap-range-to-string
+ (gnus-compress-sequence oldarts))
+ "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts)))))))))))
+ ;; return articles not deleted
+ articles)
+
(deffoo nnimap-request-move-article (article group server
accept-form &optional last)
(when (nnimap-possibly-change-server server)
***************
*** 866,875 ****
(apply 'max articles) group))))
(gnus-message 7 "Opening nnimap group %s...done" group)))
- (deffoo nnimap-close-group (group &optional server)
- (when (nnimap-possibly-change-group group server)
- (nnimap-expunge-close-group server)))
-
;;; Returns: GROUP HIGHEST LOWEST [ynmxj=]
(defun nnimap-request-list-mapper (group)
(unless (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group))
--- 914,919 ----
***************
*** 969,1040 ****
gnus-article-mark-lists))))
info)
- (defun nnimap-time-substract (time1 time2)
- "Return TIME for TIME1 - TIME2."
- (let* ((ms (- (car time1) (car time2)))
- (ls (- (nth 1 time1) (nth 1 time2))))
- (if (< ls 0)
- (list (- ms 1) (+ (expt 2 16) ls))
- (list ms ls))))
-
- (defun nnimap-date-days-ago (daysago)
- "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
- (let ((date (format-time-string "%d-%b-%Y"
- (nnimap-time-substract
- (current-time)
- (if (fboundp 'days-to-time)
- (days-to-time daysago)
- (nnmail-days-to-time daysago))))))
- (if (eq ?0 (string-to-char date))
- (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)
- (let (oldarts (artseq (gnus-compress-sequence articles)))
- (when (and artseq (nnimap-possibly-change-group group server))
- (with-current-buffer nnimap-server-buffer
- (if force
- ;; add delete flag to article
- (when (imap-message-flags-add (nnimap-range-to-string artseq)
- "\\Deleted")
- (setq nnimap-need-expunge t)
- (setq articles nil))
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((eq days 'immediate)
- ;; add delete flag to article
- (when (imap-message-flags-add
- (nnimap-range-to-string artseq) "\\Deleted")
- (setq nnimap-need-expunge t)
- (setq articles nil)))
- ((numberp days)
- ;; We should not search only gnus-expired articles,
- ;; Gnus makes sure request-expire-articles is called
- ;; with correct arguments. (with total-expire,
- ;; the articles won't have gnus-expire set but should
- ;; be expired)
- (setq oldarts (imap-search
- (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))
- "\\Deleted"))
- (setq nnimap-need-expunge t)
- (setq articles (gnus-set-difference articles
- oldarts)))))))))))
- ;; return articles not deleted
- articles)
-
;;; Internal functions
--- 1013,1018 ----
***************
*** 1157,1182 ****
t
(nnheader-report 'nnimap (nth 3 status))))
- (defun nnimap-expunge-close-group (&optional server)
- (with-current-buffer nnimap-server-buffer
- (when (and (nnimap-possibly-change-server server)
- imap-current-mailbox)
- (cond ((eq nnimap-expunge-on-close 'always)
- (when nnimap-need-expunge
- (setq nnimap-need-expunge nil)
- (imap-send-command "EXPUNGE"))
- (imap-mailbox-close))
- ((eq nnimap-expunge-on-close 'never)
- (imap-mailbox-unselect))
- ((eq nnimap-expunge-on-close 'ask)
- (when (imap-search "DELETED")
- (if (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
- imap-current-mailbox))
- (and (nnimap-ok-p (nnimap-send-command-wait "EXPUNGE"))
- (imap-mailbox-close))
- (imap-mailbox-unselect)))))))
- (not imap-current-mailbox))
-
(defun nnimap-possibly-change-group (group &optional server)
(when (nnimap-possibly-change-server server)
(with-current-buffer nnimap-server-buffer
--- 1135,1140 ----
***************
*** 1209,1261 ****
(buffer-disable-undo (get-buffer-create nnimap-debug))
(mapc (lambda (f) (trace-function-background f nnimap-debug))
'(
! ;nnimap-body-lines
! nnimap-request-scan
! nnimap-split-copy-delete-article
! nnimap-split-move-article
! nnimap-expand-newtext
! nnimap-split-to-groups
! ;nnimap-split-find-rule
! nnimap-demule
! nnimap-split-find-inbox
! nnimap-split-articles
! nnimap-request-set-mark
! nnimap-request-move-article
! gnus-group-nnimap-expunge
! gnus-group-nnimap-edit-acl
! gnus-group-nnimap-edit-acl-done
! nnimap-group-mode-hook
;nnimap-retrieve-headers-progress
nnimap-retrieve-headers
nnimap-open-server
nnimap-close-server
nnimap-request-close
- nnimap-server-opened
nnimap-status-message
nnimap-request-article
nnimap-request-head
nnimap-request-body
! nnimap-request-article-part
! nnimap-request-group
nnimap-close-group
- nnimap-request-list-mapper
nnimap-pattern-to-list-arguments
nnimap-request-list
nnimap-request-post
! nnimap-retrieve-groups
! nnimap-request-update-info-internal
nnimap-request-type
! nnimap-request-group-description
! nnimap-request-list-newsgroups
! nnimap-request-newgroups
nnimap-request-create-group
nnimap-time-substract
nnimap-date-days-ago
;nnimap-request-expire-articles-progress
nnimap-request-expire-articles
nnimap-request-accept-article
nnimap-request-delete-group
nnimap-request-rename-group
;nnimap-mark-to-predicate
;nnimap-mark-to-flag-1
;nnimap-mark-to-flag
--- 1167,1219 ----
(buffer-disable-undo (get-buffer-create nnimap-debug))
(mapc (lambda (f) (trace-function-background f nnimap-debug))
'(
! nnimap-possibly-change-server
;nnimap-retrieve-headers-progress
+ ;nnimap-retrieve-headers-store-uids
+ nnimap-retrieve-headers-get-uids
+ nnimap-retrieve-headers-from-cache
nnimap-retrieve-headers
+ nnimap-open-connection
nnimap-open-server
+ nnimap-server-opened
nnimap-close-server
nnimap-request-close
nnimap-status-message
+ nnimap-demule
+ nnimap-request-article-part
nnimap-request-article
nnimap-request-head
nnimap-request-body
! nnimap-expunge-close-group
nnimap-close-group
nnimap-pattern-to-list-arguments
nnimap-request-list
nnimap-request-post
! nnimap-expand-newtext
! nnimap-split-to-groups
! nnimap-split-find-rule
! nnimap-split-find-inbox
! nnimap-split-articles
nnimap-request-type
! nnimap-request-set-mark
! nnimap-request-scan
nnimap-request-create-group
nnimap-time-substract
nnimap-date-days-ago
;nnimap-request-expire-articles-progress
nnimap-request-expire-articles
+ nnimap-request-move-article
nnimap-request-accept-article
nnimap-request-delete-group
nnimap-request-rename-group
+ gnus-group-nnimap-expunge
+ gnus-group-nnimap-edit-acl
+ gnus-group-nnimap-edit-acl-done
+ nnimap-group-mode-hook
+ nnimap-request-group
+ nnimap-request-list-mapper
+ nnimap-retrieve-groups
+ nnimap-request-update-info-internal
;nnimap-mark-to-predicate
;nnimap-mark-to-flag-1
;nnimap-mark-to-flag
***************
*** 1264,1271 ****
nnimap-range-to-string
nnimap-send-command-wait
;nnimap-ok-p
- nnimap-expunge-close-group
- nnimap-possibly-change-server
nnimap-possibly-change-group
)))
--- 1222,1227 ----