[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

nnimap 0.3.31 -> 0.32 patches



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.