[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Support all Gnus flags
1998-08-13 Jim Radford <radford@robby.caltech.edu>
* nnimap.el (nnimap-request-update-info): * nnimap.el
(nnimap-close-server): We now update all the flags if possible.
We now respect PERMANENTFLAGS and \\*. We use the IMAP builtin
ones that make sense and we create our own flags like
`gnus-bookmark' for those that don't fit. There are a few
inefficiencies, but it works for now.
* nnimap.el (nnimap-mark-to-flag-alist):
* nnimap.el (nnimap-mark-to-predicate-alist: New variables
* nnimap.el (nnimap-flag-permanent-p): Function to decide if
we can expect to change a flag.
* nnimap.el (nnimap-ok): Try and report the correct error
to gnus by setting `imap-last-status' to nil when command
works, thereby allowing nnheader-report to superceed.
We now actually report UIDVALIDITY mismatches to the user.
--- nnimap.el~ Thu Aug 13 03:06:18 1998
+++ nnimap.el Thu Aug 13 04:25:02 1998
@@ -39,6 +39,8 @@
;;; Note also that you shouldn't subscribe to goups on your nnimap
;;; server from the server buffer if the server is your primary server
;;; i.e. in `gnus-select-method'. I think this is a bug in Gnus.
+;;; Yep, I just checked. It is fixed in at least 5.6.27. It was
+;;; still broken in 5.5.
;;; Todo (roughly in order of priority):
@@ -52,7 +54,6 @@
;;; o Do we dare to send the EXPUNGE command?
;;; o fix nnimap-list-pattern (FIXED?)
;;; o Split up big fetches (1,* header especially) in smaller chunks
-;;; o test ephemeral group support
;;; o use \Draft to support the draft group??
;;; o What do I do with gnus-newsgroup-*?
;;; o Figure out when update-info is called and why and if we need to
@@ -509,6 +513,10 @@
(apply 'max articles) group)))
t)))));)
+;; 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
+;; this got fixed. That's what I get for not using the current
+;; version.
(defun gnus-group-normally-qualified (backend server group)
;; This is the format for groups in the group-info.
;; native groups are not qualified. Why?
@@ -523,29 +531,36 @@
;;; not touch the server.
(deffoo nnimap-close-group (group &optional server)
(when (nnimap-possibly-change-group group server)
+ (setq server (or server (nnoo-current-server 'nnimap)))
(with-current-buffer nnimap-server-buffer
;; For now we assume that we need to sync the group-info
;; with the server here.
+ (if (imap-folder-get 'writable)
(let* ((info (gnus-get-info
(gnus-group-normally-qualified 'nnimap server group)))
- (read (gnus-info-read info))
- (marks (gnus-info-marks info))
- (tick (cdr (assoc 'tick marks)))
- (reply (cdr (assoc 'reply marks))))
+ (marks (gnus-info-marks info)))
(unless (eq 0 (imap-folder-get 'EXISTS))
;; Cyrus server (v1.5.2) disconnects on empty groups ???
(nnimap-send-command-wait
- "UID STORE 1:* -FLAGS.SILENT (\\Seen \\Flagged \\Answered)"))
+ (concat "UID STORE 1:* -FLAGS.SILENT ("
+ (mapconcat
+ 'symbol-name
+ (remove '\\* (imap-folder-get 'permanentflags group))
+ " ")
+ ")")))
(mapc
- (lambda (mark)
- (if (car mark)
+ (lambda (mark-flag)
+ (if (nnimap-flag-permanent-p mark-flag group)
+ (let ((val (if (equal 'read (car mark-flag))
+ (gnus-info-read info)
+ (cdr (assoc (car mark-flag) marks)))))
+ (if val
(nnimap-send-command-wait
(concat "UID STORE "
- (nnimap-range-to-string (car mark))
- " +FLAGS.SILENT (" (cdr mark) ")"))))
- (list (cons read "\\Seen")
- (cons tick "\\Flagged")
- (cons reply "\\Answered"))))
+ (nnimap-range-to-string val)
+ " +FLAGS.SILENT (" (cdr mark-flag) ")"))))))
+ nnimap-mark-to-flag-alist)))
+ ;; When someone Qs out of a group we could EXAMINE first???
;; Close her up. We don't necessarily have to do this.
(when (nnimap-ok-p (nnimap-send-command-wait "CLOSE"))
(setq imap-current-folder nil
@@ -647,6 +662,40 @@
;; (setq nnimap-group-alist (nnmail-get-active)))
'active)))
+(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))))))
+ gnus-article-mark-lists))
+
+(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))
+
+(defun nnimap-flag-permanent-p (mark-string group)
+ (or (member (cdr (assoc (car mark-string)
+ nnimap-mark-to-flag-alist))
+ (mapcar 'symbol-name ; Yuck
+ (imap-folder-get 'permanentflags group)))
+ (and (string-match "gnus-" (cdr mark-string))
+ (memq '\\* (imap-folder-get 'permanentflags group)))))
+
;;; I really think this should update the active-info too???
(deffoo nnimap-request-update-info (group info &optional server)
(when (nnimap-possibly-change-group group server) ;; SELECT
@@ -698,18 +747,19 @@
(atom (car read)))
(list (cons (car read) (car read))) ;; xxx not my bug
read)))
+ (mapc
+ (lambda (mark-search)
+ (if (nnimap-flag-permanent-p mark-search group)
(gnus-info-set-marks
info
- (nnimap-update-alist-soft 'tick (gnus-compress-sequence
- (nnimap-search "FLAGGED"))
- (gnus-info-marks info)))
- (gnus-info-set-marks
- info
- (nnimap-update-alist-soft 'reply (gnus-compress-sequence
- (nnimap-search "ANSWERED"))
- (gnus-info-marks info))))
+ (nnimap-update-alist-soft (car mark-search)
+ (gnus-compress-sequence
+ (nnimap-search (cdr mark-search)))
+ (gnus-info-marks info)))))
+ nnimap-mark-to-predicate-alist))
info))
+
;;; Respond to articles with mail
(deffoo nnimap-request-type (group article)
'mail)
@@ -976,8 +1026,10 @@
(defun nnimap-ok-p (status)
(if status
- (or (eq 'OK (car status))
- (nnheader-report 'nnimap (cdr status)))
+ (if (not (eq 'OK (car status)))
+ (nnheader-report 'nnimap (cdr status))
+ (setq imap-last-status nil)
+ t)
(nnheader-report 'nnimap (format "IMAP Command Timed Out"))))
(defun nnimap-search (predicate)