[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
nnimap 0.3.31 -> 0.32 patches
- To: gnus-imap@vic20.dzp.se
- Subject: nnimap 0.3.31 -> 0.32 patches
- From: Simon Josefsson <jas@pdc.kth.se>
- Date: 10 Oct 1998 22:22:48 +0200
- User-Agent: Gnus/5.070033 (Pterodactyl Gnus v0.33) Emacs/20.3
Yikes.
Just noticed we went from version 0.3.31 to 0.32. Also forgot about
updating the version label in nnimap.el. The version change should not
be taken as a sign of nothing else than my absent-mindedness. :-)
Also, hmac.el was renamed to rfc2104.el.
diff -u nnimap-0.3.31/ChangeLog nnimap-0.32/ChangeLog
--- nnimap-0.3.31/ChangeLog Fri Sep 4 11:37:18 1998
+++ nnimap-0.32/ChangeLog Sat Oct 10 22:06:59 1998
@@ -1,3 +1,125 @@
+1998-10-10 22:00:32 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap 0.32 released.
+
+1998-10-10 21:43:34 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el: Hook nnimap-update-flags-hook to gnus-summary-exit-hook.
+
+ * nnimap.el: Hook nnimap-save-info-hook to gnus-summary-prepare-hook.
+
+ * nnimap.el (nnimap-save-info-hook):
+ (nnimap-update-flags-hook): New functions.
+
+ * nnimap.el (nnimap-expunge-close-group): Change buffer before
+ looking at imap-current-folder.
+
+ * nnimap.el (nnimap-mark-to-flag-1):
+ * nnimap.el (nnimap-mark-to-flag):
+ * nnimap.el (nnimap-mark-to-predicate): New functions.
+
+ * nnimap.el (nnimap-request-expire-articles): Don't return nil if
+ we didn't remove all articles.
+
+ * nnimap.el (nnimap-date-days-ago): Check if days-to-time
+ exist. Document buggy zero-padding of date.
+
+ * nnimap.el (nnimap-request-set-mark): New function, soon-to-be
+ new Gnus backend function.
+
+ * nnimap.el (nnimap-request-update-mark): Removed.
+
+ * nnimap.el (nnimap-split-move-article):
+ * nnimap.el (nnimap-split-copy-delete-article): Message server-name.
+
+ * nnimap.el (nnimap-request-update-info-internal): Works.
+
+ * nnimap.el: Comment explaining "mark", "flag" and "predicate".
+
+ * nnimap.el (nnimap-flag-permanent-p): Rewritten and renamed to
+ nnimap-mark-permanent-p.
+
+ * nnimap.el (nnimap-mark-to-predicate-alist): Added "read".
+
+ * nnimap.el (nnimap-saved-info):
+ (nnimap-active-hashtb):
+ * nnimap.el (nnimap-directory):
+ (nnimap-active-file): New variables.
+
+ * nnimap.el: Don't require gnus-sum.
+
+1998-10-05 20:00:01 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-cb-flags): Flags are always strings.
+
+1998-10-05 13:26:40 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-group): Always update info.
+ (nnimap-request-group): "...done" message.
+
+1998-10-05 13:25:39 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-article-part): Multibyte string.
+
+1998-10-05 13:03:36 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-close-group): Pass server.
+
+1998-10-05 13:00:58 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-debug): Disable tracing.
+
+1998-09-30 20:16:47 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-close-group): Pass server.
+
+1998-09-30 20:05:07 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-date-days-ago): Blank pad dates.
+
+1998-09-26 21:29:03 Simon Josefsson <jas@pdc.kth.se>
+
+ * nnimap.el (nnimap-request-expire-articles): Don't try to do
+ anything if articles=nil.
+
+1998-09-25 23:03:45 Simon Josefsson <jas@pdc.kth.se>
+
+ * rfc2104.el (rfc2104-hex-to-int):
+ (rfc2104-hash): Use the new functions.
+
+1998-09-25 22:55:12 Simon Josefsson <jas@pdc.kth.se>
+
+ * Makefile: Update for rfc2104.
+
+1998-09-25 22:52:58 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-disable-multibyte): New function.
+ (imap-debug):
+ (imap-open-server):
+ (imap-send-command):
+ (imap-parse-line): Use it.
+
+1998-09-25 22:51:27 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-authenticate-cram-md5): Use rfc2104.
+
+1998-09-25 22:50:49 Simon Josefsson <jas@pdc.kth.se>
+
+ * rfc2104.el (rfc2104-ipad):
+ (rfc2104-opad):
+ (rfc2104-zero):
+ (rfc2104-hex-alist):
+ (rfc2104-hex-to-int):
+ (rfc2104-hash): Renamed.
+
+1998-09-25 22:46:34 Simon Josefsson <jas@pdc.kth.se>
+
+ * rfc2104.el: File renamed.
+
+1998-09-20 08:12:55 Simon Josefsson <jas@pdc.kth.se>
+
+ * imap.el (imap-store-flags-set): New function.
+
1998-09-04 11:32:57 Simon Josefsson <jas@pdc.kth.se>
* nnimap 0.3.31 released.
diff -u nnimap-0.3.31/Makefile nnimap-0.32/Makefile
--- nnimap-0.3.31/Makefile Fri Sep 4 11:37:18 1998
+++ nnimap-0.32/Makefile Sat Oct 10 22:07:00 1998
@@ -2,13 +2,13 @@
ELCC=$(EMACS) -batch -q -no-site-file
VERSION=`date +%y%m%d-%H%M`
-all: hmac.elc imap.elc nnimap.elc nnimap.info
+all: rfc2104.elc imap.elc nnimap.elc nnimap.info
-hmac.elc: hmac.el
- $(ELCC) -f batch-byte-compile hmac.el
+rfc2104.elc: rfc2104.el
+ $(ELCC) -f batch-byte-compile rfc2104.el
-imap.elc: hmac.elc imap.el
- $(ELCC) -l hmac.elc -f batch-byte-compile imap.el
+imap.elc: rfc2104.elc imap.el
+ $(ELCC) -l rfc2104.elc -f batch-byte-compile imap.el
nnimap.elc: imap.elc nnimap.el
$(ELCC) -l imap.el -f batch-byte-compile nnimap.el
@@ -20,7 +20,7 @@
makeinfo nnimap.texi
clean:
- rm -f imap.elc nnimap.elc hmac.elc nnimap.info nnimap.html
+ rm -f imap.elc nnimap.elc rfc2104.elc nnimap.info nnimap.html
tar:
cvs export -D now -d nnimap-$(VERSION) nnimap
Only in nnimap-0.3.31: hmac.el
diff -u nnimap-0.3.31/imap.el nnimap-0.32/imap.el
--- nnimap-0.3.31/imap.el Fri Sep 4 11:37:19 1998
+++ nnimap-0.32/imap.el Sat Oct 10 22:07:00 1998
@@ -199,12 +199,18 @@
;; If non nil these hold the name of a buffer to put debug into
(defvar imap-log "*imap-log*") ; imap session trace
-(defvar imap-last "*imap-last*") ; last line we attempted to parse
-(defvar imap-debug "*imap-debug*") ; random debug spew
+(defvar imap-last nil);"*imap-last*") ; last line we attempted to parse
+(defvar imap-debug nil);"*imap-debug*") ; random debug spew
+
+(defsubst imap-disable-multibyte ()
+ "Enable multibyte in the current buffer."
+ (when (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil)))
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug))
+ (imap-disable-multibyte)
(mapc (lambda (f) (trace-function-background f imap-debug))
'(imap-open-server
imap-close-server
@@ -348,7 +354,7 @@
(defun imap-authenticate-cram-md5 (server &optional buffer)
"Login to server using the AUTH CRAM-MD5 method."
(require 'mel-b) ;; from TM/FLIM
- (require 'hmac)
+ (require 'rfc2104)
(require 'md5)
(with-current-buffer (or buffer (current-buffer))
(and (imap-authinfo-get server)
@@ -359,8 +365,8 @@
"AUTHENTICATE CRAM-MD5"
(lambda (challenge)
(let* ((decoded (base64-decode-string challenge))
- (hmaced (hmac 'md5 64 16 (cdr imap-authinfo) decoded))
- (response (concat (car imap-authinfo) " " hmaced))
+ (hash (rfc2104-hash 'md5 64 16 (cdr imap-authinfo) decoded))
+ (response (concat (car imap-authinfo) " " hash))
(encoded (base64-encode-string response)))
encoded))))))))
@@ -375,6 +381,7 @@
(defun imap-open-server (server &optional port buffer local-defs)
(with-current-buffer (get-buffer-create (or buffer (current-buffer)))
(buffer-disable-undo)
+ (imap-disable-multibyte)
(imap-close-server) ; makes vars local, sets them to their defaults, erases
(mapc (lambda (ld) (set (car ld) (cdr ld))) local-defs)
(when (setq imap-process
@@ -436,6 +443,7 @@
(setq strings (apply 'concat (nreverse strings)))
(and imap-log (with-current-buffer (get-buffer-create imap-log)
(buffer-disable-undo)
+ (imap-disable-multibyte)
(goto-char (point-max))
(insert strings)))
(process-send-string nil strings)
@@ -495,6 +503,13 @@
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
(imap-folder-get 'search))))
+(defun imap-store-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-store-flags-del (articles flags &optional buffer silent)
(when (and articles flags)
(with-current-buffer (or buffer (current-buffer))
@@ -864,6 +879,7 @@
(let ((buffer (current-buffer)))
(with-current-buffer (get-buffer-create imap-last)
(buffer-disable-undo)
+ (imap-disable-multibyte)
(erase-buffer)
(insert-buffer-substring buffer))))
@@ -882,7 +898,7 @@
(imap-folder-set 'subbed t name))))
(defun imap-cb-flags (code flags)
- (imap-folder-set 'list-flags flags))
+ (imap-folder-set 'list-flags (mapcar 'symbol-name flags)))
(defun imap-message-to-string (message)
(if (numberp message)
diff -u nnimap-0.3.31/nnimap.el nnimap-0.32/nnimap.el
--- nnimap-0.3.31/nnimap.el Fri Sep 4 11:37:20 1998
+++ nnimap-0.32/nnimap.el Sat Oct 10 22:07:01 1998
@@ -49,8 +49,6 @@
;;; o Move common IMAP commands to functions in imap.el.
;;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
-;;; o split to other backends, different split rules for different
-;;; servers/inboxes
;;; o dont uid fetch 1,* in nnimap-retrive-groups (slow)
;;; o Split up big fetches (1,* header especially) in smaller chunks
;;; o use \Draft to support the draft group??
@@ -70,7 +68,9 @@
;;; request-associate-buffer, request-restore-buffer,
;;; o When UIDVALIDITY changed, I should reconstruct everything gnus knows
-;;; about the group (possible?)
+;;; about the group (possible?) (fixed?)
+;;; o split to other backends, different split rules for different
+;;; servers/inboxes
;;; o UTF-7 encode mailbox names (does Gnus deal with SPC in group names?)
;;; o Fix Gnus to handle leading '.' in group names
;;; o Fix the flag situation when using the Gnus Agent
@@ -87,7 +87,6 @@
(require 'nnheader)
(require 'nnmail)
(require 'gnus)
-(require 'gnus-sum)
(require 'gnus-range)
(eval-when-compile (require 'cl))
@@ -101,6 +100,13 @@
;; Various server variables.
+(defvoo nnimap-directory message-directory
+ "Data directory for the nnimap backend.")
+
+(defvoo nnimap-active-file
+ (concat (file-name-as-directory nnimap-directory) "active")
+ "Mail active file for the nnimap backend.")
+
(defvoo nnimap-list-pattern "*"
"*PATTERN or list of PATTERNS use to limit available groups.
@@ -234,6 +240,8 @@
;; Internal variables.
(defvoo nnimap-need-expunge nil)
(defvoo nnimap-server-buffer nil)
+(defvar nnimap-saved-info nil)
+(defvoo nnimap-active-hashtb nil)
;; radford:
;; shouldn't have to keep this info around, nnoo should???
@@ -290,18 +298,23 @@
; nnimap-split-to-groups
nnimap-split-articles
nnimap-request-update-info-internal
- nnimap-request-update-mark
+ nnimap-request-set-mark
nnimap-retrieve-groups
nnimap-retrieve-headers
nnimap-server-opened
nnimap-status-message
nnimap-update-alist-soft
nnimap-range-to-string
- nnimap-request-expire-articles-progress
+; nnimap-request-expire-articles-progress
nnimap-request-expire-articles
nnimap-request-move-article
+ nnimap-mark-to-predicate
+ nnimap-mark-to-flag
+ nnimap-mark-permanent-p
gnus-group-nnimap-edit-acl-done
gnus-group-nnimap-edit-acl
+ nnimap-save-info-hook
+ nnimap-update-flags-hook
)))
@@ -517,7 +530,9 @@
;; 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)))
+ (let ((text (funcall (if (fboundp '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)
@@ -535,14 +550,15 @@
;;; when entering something into the active-hashtb but it does when
;;; it looks for new news. Damn.
(deffoo nnimap-request-group (group &optional server fast)
+ (nnimap-request-update-info-internal
+ group
+ (gnus-get-info (gnus-group-normally-qualified 'nnimap server group))
+ server)
(if fast
(with-current-buffer nntp-server-buffer
(erase-buffer)
t)
(gnus-message 7 "Opening nnimap group %s..." group)
- (nnimap-request-update-info-internal
- group (gnus-get-info (gnus-group-normally-qualified 'nnimap server group))
- server)
(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
@@ -569,9 +585,10 @@
;; end of bug workaround code
))
(when articles
- (nnheader-insert "211 %d %d %d %s\n" exists
+ (nnheader-insert "211 %d %d %d %s\n" exists
(max 1 (apply 'min articles))
- (apply 'max articles) group)))))))
+ (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
;; you need to do is use gnus-group-prefixed-name. I'm not sure when
@@ -589,7 +606,7 @@
(deffoo nnimap-close-group (group &optional server)
(when (nnimap-possibly-change-group group server)
- (nnimap-expunge-close-group)))
+ (nnimap-expunge-close-group server)))
;;; Returns: GROUP HIGHEST LOWEST [ynmxj=]
(defun nnimap-request-list-mapper (group)
@@ -695,48 +712,15 @@
(nnimap-request-list-mapper group)))
'active)))
-(defvar nnimap-mark-to-predicate-alist
- (mapcar
- (lambda (pair) ; cdr is the mark
- (or (assoc (cdr pair)
- '(;;(read . "SEEN")
- (tick . "FLAGGED")
- ;;(expire . "DELETED")
- (draft . "DRAFT")
- (reply . "ANSWERED")))
- (cons (cdr pair)
- (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
- gnus-article-mark-lists))
-
-(defvar nnimap-mark-to-flag-alist
- (mapcar
- (lambda (pair) ; cdr is the mark
- (or (assoc (cdr pair)
- '((read . "\\Seen")
- (tick . "\\Flagged")
- ;;(expire . "\\Deleted")
- (draft . "\\Draft")
- (reply . "\\Answered")))
- (cons (cdr pair)
- (format "gnus-%s" (symbol-name (cdr pair))))))
- (cons '(read . read) gnus-article-mark-lists)))
-
-(defun nnimap-flag-permanent-p (mark-string group)
- (or (member (cdr (assoc (car mark-string)
- nnimap-mark-to-flag-alist))
- (imap-folder-get 'permanentflags group))
- (and (string-match "gnus-" (cdr mark-string))
- (member "\\*" (imap-folder-get 'permanentflags group)))))
-
;; This is nnimap-request-update-info, but it's so extremely slow
-;; we can't have Gnus call it all the time. Instead, it's called upon
+;; we can't have Gnus call it all the time. Instead, it's called by
;; nnimap-request-group.
(deffoo nnimap-request-update-info-internal (group info &optional server)
- ;; We reset the uidvalidity here because we are about to do a full resync.
- (gnus-info-set-params info (nnimap-update-alist-soft
- 'uidvalidity nil (gnus-info-params info)) t)
-
(when (nnimap-possibly-change-group group server) ;; SELECT
+ ;; We reset the uidvalidity here because we are about to do a full resync.
+ (gnus-info-set-params info (nnimap-update-alist-soft
+ 'uidvalidity nil (gnus-info-params info)) t)
+
(with-current-buffer nnimap-server-buffer
(gnus-message 5 "Updating info for mailbox %s" group)
@@ -746,61 +730,70 @@
(gnus-info-set-params info nil t))
;; Replace list of read and marked articles with authoritative
- ;; data from server
- (gnus-info-set-read
- info
- ;; xxx This is extremely slow.
- (let* (
- ;; oldseen could contain articles marked unread by other
- ;; imap clients! we correct this
- (oldseentmp (gnus-uncompress-range (gnus-info-read info)))
- (unseen (imap-search "UNSEEN UNDELETED"))
- (oldseen (gnus-set-difference oldseentmp unseen))
- ;; oldseen might lack articles marked as read by other
- ;; imap clients! we correct this
- (newseen (imap-search "SEEN"))
- ;; ok, read articles are in oldseen+newseen (xxx lots of dupes)
- (seen (append oldseen newseen))
- ;; sort to have gnus-compress-sequence remove dupes
- (seens (sort seen '<))
- (read (gnus-compress-sequence seens t)))
- (if (and read
- (atom (car read)))
- (list (cons (car read) (car read))) ;; xxx not my bug
- read)))
- (mapc
- (lambda (mark-search)
- (if (and (memq (cdr mark-search) (imap-folder-get 'list-flags))
- (nnimap-flag-permanent-p mark-search group))
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft (car mark-search)
- (gnus-compress-sequence
- (imap-search (cdr mark-search)))
- (gnus-info-marks info)))))
- nnimap-mark-to-predicate-alist)))
+ ;; data from server.
+
+ ;; If server is read-only (no article mark memory), we don't
+ ;; overwrite local flags -- this way one can use it as a nntp type
+ ;; of server (all mark memory in client).
+
+ (when (nnimap-mark-permanent-p 'read)
+ (gnus-info-set-read
+ info
+ ;; xxx This is extremely slow.
+ (let* (
+ ;; oldseen could contain articles marked unread by other
+ ;; imap clients! we correct this
+ (oldseentmp (gnus-uncompress-range (gnus-info-read info)))
+ (unseen (imap-search "UNSEEN UNDELETED"))
+ (oldseen (gnus-set-difference oldseentmp unseen))
+ ;; oldseen might lack articles marked as read by other
+ ;; imap clients! we correct this
+ (newseen (imap-search "SEEN"))
+ ;; ok, read articles are in oldseen+newseen (xxx lots of dupes)
+ (seen (append oldseen newseen))
+ ;; sort to have gnus-compress-sequence remove dupes
+ (seens (sort seen '<))
+ (read (gnus-compress-sequence seens t)))
+ (if (and read
+ (atom (car read)))
+ (list (cons (car read) (car read))) ;; xxx not my bug
+ read))))
+
+ (mapc (lambda (pred)
+ (when (and (nnimap-mark-permanent-p (cdr pred))
+ (member (nnimap-mark-to-flag (cdr pred))
+ (imap-folder-get 'list-flags)))
+ (gnus-info-set-marks
+ info
+ (nnimap-update-alist-soft
+ (cdr pred)
+ (gnus-compress-sequence
+ (imap-search (nnimap-mark-to-predicate (cdr pred))))
+ (gnus-info-marks info)))))
+ gnus-article-mark-lists)))
info)
;;; Respond to articles with mail
(deffoo nnimap-request-type (group article)
'mail)
-(defun nnimap-split-copy-delete-article (article group to-group)
+(defun nnimap-split-copy-delete-article (article group to-group server)
"Move article ARTICLE from group GROUP on current server to group TO-GROUP."
(when (nnimap-ok-p (nnimap-send-command-wait
(format "UID COPY %d %s" article to-group)))
(setq nnimap-need-expunge t)
(if (imap-store-flags-add (format "%d" article) "\\Seen \\Deleted")
- (message "IMAP split: moved %s:%d to %s" group article to-group)
+ (message "IMAP split moved %s:%s:%d to %s" server group
+ article to-group)
(error "IMAP flag store failed: you may have unread mail marked as read!"))))
-(defun nnimap-split-move-article (article group to-group)
+(defun nnimap-split-move-article (article group to-group server)
(when to-group
- (unless (nnimap-split-copy-delete-article article group to-group)
+ (unless (nnimap-split-copy-delete-article article group to-group server)
(message "Could not find mailbox %s, creating..." to-group)
(if (nnimap-ok-p (nnimap-send-command-wait
(format "CREATE %s" to-group)))
- (nnimap-split-copy-delete-article article group to-group)
+ (nnimap-split-copy-delete-article article group to-group server)
(message "Could not create mailbox %s: %s"
to-group imap-last-status)))))
@@ -847,10 +840,10 @@
(let (to-group)
(while (setq to-group (pop groups))
(nnimap-split-move-article article inbox
- to-group)))
+ to-group server)))
;; move to first matching box, if any
(nnimap-split-move-article article inbox
- (car groups))))))))
+ (car groups) server)))))))
(when (imap-select-folder inbox) ;; just in case
;; todo: UID EXPUNGE (if available) to remove splitted articles
(nnimap-expunge-close-group)))
@@ -886,45 +879,42 @@
(erase-buffer))
t))
-;; todo: are there any other flags we should propagate to the server?
-(deffoo nnimap-request-update-mark (group article mark)
- (when (nnimap-possibly-change-group group)
+;; (nn)IMAP specific decisions:
+;;
+;; o deletion of reply-marks is prohibited
+;; o dormant articles are also marked as ticked
+;;
+;; 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
- (let ((artstr (format "%d" article)))
- (cond ((eq mark gnus-unread-mark)
- ;; more stuff? less stuff?
- (imap-store-flags-del artstr "\\Seen \\Flagged \\Deleted gnus-expire gnus-killed"))
- ((eq mark gnus-ticked-mark)
- (imap-store-flags-add artstr "\\Seen \\Flagged"))
- ((eq mark gnus-dormant-mark)
- (imap-store-flags-add artstr "gnus-dormant"))
- ((eq mark gnus-del-mark)
- (imap-store-flags-add artstr "\\Seen"))
- ((eq mark gnus-read-mark)
- (imap-store-flags-add artstr "\\Seen"))
- ((eq mark gnus-expirable-mark)
- (imap-store-flags-add artstr "\\Seen gnus-expire"))
- ((eq mark gnus-killed-mark)
- (imap-store-flags-add artstr "gnus-killed"))
- ;((eq mark gnus-souped-mark) ??
- ;((eq mark gnus-kill-file-mark) ??
- ;((eq mark gnus-low-score-mark) ??
- ;((eq mark gnus-catchup-mark) ??
- ((eq mark gnus-replied-mark)
- (imap-store-flags-add artstr "\\Answered"))
- ((eq mark gnus-cached-mark)
- t)
- ((eq mark gnus-saved-mark)
- (imap-store-flags-add artstr "gnus-saved"))
- ;((eq mark gnus-ancient-mark) ??
- ;((eq mark gnus-sparse-mark) ??
- ;((eq mark gnus-canceled-mark) ??
- ;((eq mark gnus-duplicate-mark) ??
- ;((eq mark gnus-undownloaded-mark) ??
- ;((eq mark gnus-downloadable-mark) ??
- ;((eq mark gnus-unsendable-mark) ??
- ))))
- mark)
+ (let (action)
+ (gnus-message 7 "Setting marks in %s:%s..."
+ (nnoo-current-server 'nnimap) group)
+ (while (setq action (pop actions))
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (pred (nth 2 action)))
+ ;; enforce local decisions
+ (if (eq what 'del)
+ (setq pred (delq 'reply pred)))
+ (if (memq 'dormant pred)
+ (setq pred (cons 'tick pred)))
+ (when (and range pred)
+ (cond ((eq what 'del)
+ (imap-store-flags-del (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))
+ ((eq what 'add)
+ (imap-store-flags-add (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))
+ ((eq what 'set)
+ (imap-store-flags-set (nnimap-range-to-string range)
+ (nnimap-mark-to-flag pred nil t)))))))
+ (gnus-message 7 "Setting marks in %s:%s...done"
+ (nnoo-current-server 'nnimap) group)))))
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
@@ -939,12 +929,15 @@
(if (< ls 0)
(list (- ms 1) (+ (expt 2 16) ls))
(list ms ls))))
-
+
+;; xxx: day should not be zero-padded or blank-padded.
(defun nnimap-date-days-ago (daysago)
- "Return date, in format \"28-Aug-98\", for DAYSAGO days ago."
+ "Return date, in format \"03-Aug-98\", for DAYSAGO days ago."
(format-time-string "%d-%b-%y" (nnimap-time-substract
(current-time)
- (nnmail-days-to-time daysago))))
+ (if (fboundp 'days-to-time)
+ (days-to-time daysago)
+ (nnmail-days-to-time daysago)))))
(defun nnimap-request-expire-articles-progress (num fetch data)
(gnus-message 5 "Expiring; marking article %d for deletion..." num))
@@ -952,7 +945,7 @@
;;; 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 (nnimap-possibly-change-group group server)
+ (when (and artseq (nnimap-possibly-change-group group server))
(with-current-buffer nnimap-server-buffer
(if force
;; add delete flag to article
@@ -986,7 +979,8 @@
(gnus-compress-sequence oldarts))
"\\Deleted"))
(setq nnimap-need-expunge t)
- (setq articles nil))))))))))
+ (setq articles (gnus-set-difference articles
+ oldarts)))))))))))
;; return articles not deleted
articles)
@@ -1055,6 +1049,78 @@
;;; Internal functions
+;;
+;; This is confusing.
+;;
+;; mark => read, tick, draft, reply etc
+;; flag => "\\Seen", "\\Flagged", "\\Draft", "gnus-expire" etc
+;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc
+;;
+;; Mark should not really contain 'read since it's not a "mark" in the Gnus
+;; world, but we cheat. Mark == gnus-articlemark-lists + '(read . read).
+;;
+
+(defconst nnimap-mark-to-predicate-alist
+ (mapcar
+ (lambda (pair) ; cdr is the mark
+ (or (assoc (cdr pair)
+ '((read . "SEEN")
+ (tick . "FLAGGED")
+ (draft . "DRAFT")
+ (reply . "ANSWERED")))
+ (cons (cdr pair)
+ (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
+ (cons '(read . read) gnus-article-mark-lists)))
+
+(defun nnimap-mark-to-predicate (pred)
+ "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP
+predicate (a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD
+gnus-expire\") to be used within a IMAP SEARCH query."
+ (cdr (assq pred nnimap-mark-to-predicate-alist)))
+
+(defconst nnimap-mark-to-flag-alist
+ (mapcar
+ (lambda (pair)
+ (or (assoc (cdr pair)
+ '((read . "\\Seen")
+ (tick . "\\Flagged")
+ (draft . "\\Draft")
+ (reply . "\\Answered")))
+ (cons (cdr pair)
+ (format "gnus-%s" (symbol-name (cdr pair))))))
+ (cons '(read . read) gnus-article-mark-lists)))
+
+(defun nnimap-mark-to-flag-1 (preds)
+ (if (and (not (null preds)) (listp preds))
+ (cons (nnimap-mark-to-flag (car preds))
+ (nnimap-mark-to-flag (cdr preds)))
+ (cdr (assoc preds nnimap-mark-to-flag-alist))))
+
+(defun nnimap-mark-to-flag (preds &optional always-list make-string)
+ "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP
+flag (a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\") to
+be used in a STORE FLAGS command."
+ (let ((result (nnimap-mark-to-flag-1 preds)))
+ (setq result (if (and (or make-string always-list)
+ (not (listp result)))
+ (list result)
+ result))
+ (if make-string
+ (mapconcat (lambda (flag)
+ (if (listp flag)
+ (mapconcat 'identity flag " ")
+ flag))
+ result " ")
+ result)))
+
+(defun nnimap-mark-permanent-p (mark &optional group)
+ "Return t iff MARK can be permanently (between IMAP sessions) saved
+on articles, in GROUP."
+ (with-current-buffer nnimap-server-buffer
+ (or (member "\\*" (imap-folder-get 'permanentflags group))
+ (member (nnimap-mark-to-flag mark) (imap-folder-get 'permanentflags
+ group)))))
+
(defun nnimap-update-alist-soft (key value alist)
(if value
(cons (cons key value) (remassoc key alist))
@@ -1094,9 +1160,9 @@
(nnheader-report 'nnimap (format "IMAP Command Timed Out"))))
(defun nnimap-expunge-close-group (&optional server)
- (when (and (nnimap-possibly-change-server server)
- imap-current-folder)
- (with-current-buffer nnimap-server-buffer
+ (with-current-buffer nnimap-server-buffer
+ (when (and (nnimap-possibly-change-server server)
+ imap-current-folder)
(cond ((eq nnimap-expunge-on-close 'always)
(when nnimap-need-expunge
(setq nnimap-need-expunge nil)
@@ -1239,6 +1305,54 @@
(eq 'NO (car status)))
(error "Can't set ACL: %s" (cadr status))))))))))))
+;;; Flag stuff.
+
+(defun nnimap-save-info-hook ()
+ (make-variable-buffer-local 'nnimap-saved-info)
+ (setq nnimap-saved-info (copy-list (gnus-get-info gnus-newsgroup-name))))
+
+(defun nnimap-update-flags-hook (&rest foo)
+ (when (eq 'nnimap (car (gnus-find-method-for-group gnus-newsgroup-name)))
+ (with-current-buffer gnus-summary-buffer
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ (old-info nnimap-saved-info)
+ (new-info (gnus-get-info gnus-newsgroup-name))
+ delta-marks)
+
+ ;; Update read marks.
+
+ (let* ((new-read (gnus-info-read new-info))
+ (old-read (gnus-info-read old-info))
+ (add (gnus-remove-from-range new-read (gnus-uncompress-range
+ old-read)))
+ (del (gnus-remove-from-range old-read (gnus-uncompress-range
+ new-read))))
+ (if add
+ (push (list add 'add '(read)) delta-marks))
+ (if del
+ (push (list del 'del '(read)) delta-marks)))
+
+ ;; Update marks.
+
+ (let ((types gnus-article-mark-lists)
+ type list old-mark new-mark add del)
+ (while (setq type (cdr (pop types)))
+ ;; cache, score, bookmark are not proper flags.
+ (unless (memq type '(cache score bookmark))
+ (setq old-mark (cdr (assq type (gnus-info-marks old-info)))
+ new-mark (cdr (assq type (gnus-info-marks new-info)))
+ add (gnus-remove-from-range new-mark (gnus-uncompress-range
+ old-mark))
+ del (gnus-remove-from-range old-mark (gnus-uncompress-range
+ new-mark)))
+ (if add
+ (push (list add 'add (list type)) delta-marks))
+ (if del
+ (push (list del 'del (list type)) delta-marks)))))
+
+ (nnimap-request-set-mark group delta-marks)
+ (nnimap-expunge-close-group)))))
+
;;; Gnus glue
(defun nnimap-group-mode-hook ()
@@ -1249,6 +1363,9 @@
(read-kbd-macro "G x"))
'gnus-group-nnimap-expunge))
(add-hook 'gnus-group-mode-hook 'nnimap-group-mode-hook)
+
+(add-hook 'gnus-summary-prepare-hook 'nnimap-save-info-hook)
+(add-hook 'gnus-summary-exit-hook 'nnimap-update-flags-hook)
;; We're done.