1 |
;;; nnimap.el --- imap backend for Gnus |
;;; nnimap.el --- imap backend for Gnus |
2 |
;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. |
3 |
|
|
4 |
;; Author: Simon Josefsson <jas@pdc.kth.se> |
;; Author: Simon Josefsson <jas@pdc.kth.se> |
5 |
;; Jim Radford <radford@robby.caltech.edu> |
;; Jim Radford <radford@robby.caltech.edu> |
42 |
;; o Split up big fetches (1,* header especially) in smaller chunks |
;; o Split up big fetches (1,* header especially) in smaller chunks |
43 |
;; o What do I do with gnus-newsgroup-*? |
;; o What do I do with gnus-newsgroup-*? |
44 |
;; o Tell Gnus about new groups (how can we tell?) |
;; o Tell Gnus about new groups (how can we tell?) |
45 |
;; o Respooling (fix Gnus?) (unnecessery?) |
;; o Respooling (fix Gnus?) (unnecessary?) |
46 |
;; o Add support for the following: (if applicable) |
;; o Add support for the following: (if applicable) |
47 |
;; request-list-newsgroups, request-regenerate |
;; request-list-newsgroups, request-regenerate |
48 |
;; list-active-group, |
;; list-active-group, |
97 |
This can be a string or a list of strings.") |
This can be a string or a list of strings.") |
98 |
|
|
99 |
(defvar nnimap-split-rule nil |
(defvar nnimap-split-rule nil |
100 |
"*Mail will be split according to theese rules. |
"*Mail will be split according to these rules. |
101 |
|
|
102 |
Mail is read from mailbox(es) specified in `nnimap-split-inbox'. |
Mail is read from mailbox(es) specified in `nnimap-split-inbox'. |
103 |
|
|
106 |
everything else in the incoming mailbox, you could do something like |
everything else in the incoming mailbox, you could do something like |
107 |
this: |
this: |
108 |
|
|
109 |
(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") |
\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") |
110 |
(\"INBOX.junk\" \"Subject:.*buy\"))) |
(\"INBOX.junk\" \"Subject:.*buy\"))) |
111 |
|
|
112 |
As you can see, `nnimap-split-rule' is a list of lists, where the first |
As you can see, `nnimap-split-rule' is a list of lists, where the first |
127 |
even different split rules in different inboxes on the same server, |
even different split rules in different inboxes on the same server, |
128 |
the syntax of this variable have been extended along the lines of: |
the syntax of this variable have been extended along the lines of: |
129 |
|
|
130 |
(setq nnimap-split-rule |
\(setq nnimap-split-rule |
131 |
'((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") |
'((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") |
132 |
(\"junk\" \"From:.*Simon\"))) |
(\"junk\" \"From:.*Simon\"))) |
133 |
(\"my2server\" (\"INBOX\" nnimap-split-fancy)) |
(\"my2server\" (\"INBOX\" nnimap-split-fancy)) |
357 |
(imap-mailbox-unselect nnimap-server-buffer))) |
(imap-mailbox-unselect nnimap-server-buffer))) |
358 |
|
|
359 |
(defun nnimap-find-minmax-uid (group &optional examine) |
(defun nnimap-find-minmax-uid (group &optional examine) |
360 |
"Find lowest and highest active article nummber in GROUP. |
"Find lowest and highest active article number in GROUP. |
361 |
If EXAMINE is non-nil the group is selected read-only." |
If EXAMINE is non-nil the group is selected read-only." |
362 |
(with-current-buffer nnimap-server-buffer |
(with-current-buffer nnimap-server-buffer |
363 |
(when (imap-mailbox-select group examine) |
(when (imap-mailbox-select group examine) |
369 |
maxuid (if maxuid (max maxuid uid) uid))) |
maxuid (if maxuid (max maxuid uid) uid))) |
370 |
'UID)) |
'UID)) |
371 |
(list (imap-mailbox-get 'exists) minuid maxuid))))) |
(list (imap-mailbox-get 'exists) minuid maxuid))))) |
372 |
|
|
373 |
(defun nnimap-possibly-change-group (group &optional server) |
(defun nnimap-possibly-change-group (group &optional server) |
374 |
"Make GROUP the current group, and SERVER the current server." |
"Make GROUP the current group, and SERVER the current server." |
375 |
(when (nnimap-possibly-change-server server) |
(when (nnimap-possibly-change-server server) |
457 |
articles)))) |
articles)))) |
458 |
|
|
459 |
(defun nnimap-group-overview-filename (group server) |
(defun nnimap-group-overview-filename (group server) |
460 |
"Make pathname for GROUP on SERVER." |
"Make file name for GROUP on SERVER." |
461 |
(let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) |
(let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) |
462 |
(uidvalidity (gnus-group-get-parameter |
(uidvalidity (gnus-group-get-parameter |
463 |
(gnus-group-prefixed-name |
(gnus-group-prefixed-name |
598 |
(port (if nnimap-server-port |
(port (if nnimap-server-port |
599 |
(int-to-string nnimap-server-port) |
(int-to-string nnimap-server-port) |
600 |
"imap")) |
"imap")) |
601 |
(alist (gnus-netrc-machine list (or nnimap-server-address |
(alist (gnus-netrc-machine list (or nnimap-server-address |
602 |
nnimap-address server) |
nnimap-address server) |
603 |
port "imap")) |
port "imap")) |
604 |
(user (gnus-netrc-get alist "login")) |
(user (gnus-netrc-get alist "login")) |
683 |
(insert |
(insert |
684 |
(with-current-buffer nnimap-server-buffer |
(with-current-buffer nnimap-server-buffer |
685 |
(nnimap-demule |
(nnimap-demule |
686 |
(if (imap-capability 'IMAP4rev1) |
(if (imap-capability 'IMAP4rev1) |
687 |
;; xxx don't just use car? alist doesn't contain |
;; xxx don't just use car? alist doesn't contain |
688 |
;; anything else now, but it might... |
;; anything else now, but it might... |
689 |
(nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) |
(nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) |
857 |
(with-current-buffer nnimap-server-buffer |
(with-current-buffer nnimap-server-buffer |
858 |
(gnus-message 5 "nnimap: Updating info for %s..." |
(gnus-message 5 "nnimap: Updating info for %s..." |
859 |
(gnus-info-group info)) |
(gnus-info-group info)) |
860 |
|
|
861 |
(when (nnimap-mark-permanent-p 'read) |
(when (nnimap-mark-permanent-p 'read) |
862 |
(let (seen unseen) |
(let (seen unseen) |
863 |
;; read info could contain articles marked unread by other |
;; read info could contain articles marked unread by other |
897 |
;; nnimap mark dormant article as ticked too (for other clients) |
;; nnimap mark dormant article as ticked too (for other clients) |
898 |
;; so we remove that mark for gnus since we support dormant |
;; so we remove that mark for gnus since we support dormant |
899 |
(gnus-info-set-marks |
(gnus-info-set-marks |
900 |
info |
info |
901 |
(nnimap-update-alist-soft |
(nnimap-update-alist-soft |
902 |
'tick |
'tick |
903 |
(gnus-remove-from-range |
(gnus-remove-from-range |
905 |
(cdr-safe (assoc 'dormant (gnus-info-marks info)))) |
(cdr-safe (assoc 'dormant (gnus-info-marks info)))) |
906 |
(gnus-info-marks info)) |
(gnus-info-marks info)) |
907 |
t) |
t) |
908 |
|
|
909 |
(gnus-message 5 "nnimap: Updating info for %s...done" |
(gnus-message 5 "nnimap: Updating info for %s...done" |
910 |
(gnus-info-group info)) |
(gnus-info-group info)) |
911 |
|
|
987 |
to-groups) |
to-groups) |
988 |
(or nnimap-split-crosspost |
(or nnimap-split-crosspost |
989 |
(throw 'split-done to-groups)))))))))) |
(throw 'split-done to-groups)))))))))) |
990 |
|
|
991 |
(defun nnimap-assoc-match (key alist) |
(defun nnimap-assoc-match (key alist) |
992 |
(let (element) |
(let (element) |
993 |
(while (and alist (not element)) |
(while (and alist (not element)) |
1000 |
(if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) |
(if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) |
1001 |
(list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) |
(list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) |
1002 |
;; extended format |
;; extended format |
1003 |
(cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match |
(cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match |
1004 |
server nnimap-split-rule)))) |
server nnimap-split-rule)))) |
1005 |
nnimap-split-rule)) |
nnimap-split-rule)) |
1006 |
|
|
1056 |
(nnimap-before-find-minmax-bugworkaround) |
(nnimap-before-find-minmax-bugworkaround) |
1057 |
(dolist (pattern (nnimap-pattern-to-list-arguments |
(dolist (pattern (nnimap-pattern-to-list-arguments |
1058 |
nnimap-list-pattern)) |
nnimap-list-pattern)) |
1059 |
(dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil |
(dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil |
1060 |
nnimap-server-buffer)) |
nnimap-server-buffer)) |
1061 |
(or (catch 'found |
(or (catch 'found |
1062 |
(dolist (mailbox (imap-mailbox-get 'list-flags mbx |
(dolist (mailbox (imap-mailbox-get 'list-flags mbx |
1072 |
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" |
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" |
1073 |
(if (> (length server) 0) " on " "") server)) |
(if (> (length server) 0) " on " "") server)) |
1074 |
t)) |
t)) |
1075 |
|
|
1076 |
(deffoo nnimap-request-create-group (group &optional server args) |
(deffoo nnimap-request-create-group (group &optional server args) |
1077 |
(when (nnimap-possibly-change-server server) |
(when (nnimap-possibly-change-server server) |
1078 |
(or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) |
(or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) |
1154 |
result) |
result) |
1155 |
(nnimap-request-expire-articles (list article) group server t)) |
(nnimap-request-expire-articles (list article) group server t)) |
1156 |
result)))) |
result)))) |
1157 |
|
|
1158 |
(deffoo nnimap-request-accept-article (group &optional server last) |
(deffoo nnimap-request-accept-article (group &optional server last) |
1159 |
(when (nnimap-possibly-change-server server) |
(when (nnimap-possibly-change-server server) |
1160 |
(let (uid) |
(let (uid) |
1311 |
(cdr alist) |
(cdr alist) |
1312 |
(setcdr alist (nnimap-remassoc key (cdr alist))) |
(setcdr alist (nnimap-remassoc key (cdr alist))) |
1313 |
alist))) |
alist))) |
1314 |
|
|
1315 |
(defun nnimap-update-alist-soft (key value alist) |
(defun nnimap-update-alist-soft (key value alist) |
1316 |
(if value |
(if value |
1317 |
(cons (cons key value) (nnimap-remassoc key alist)) |
(cons (cons key value) (nnimap-remassoc key alist)) |