Mercurial > emacs

comparison lisp/gnus/nnimap.el @ 108439:c3622fa53abe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Fri, 26 Mar 2010 15:03:20 +0000
parents 0fe940324254
children 943a190d417a
comparison
equal deleted inserted replaced
108438:2485b1fb98d3 108439:c3622fa53abe
499 499
500 (nnoo-define-basics nnimap) 500 (nnoo-define-basics nnimap)
501 501
502 ;; Utility functions: 502 ;; Utility functions:
503 503
504 (defsubst nnimap-decode-group-name (group)
505 (and group
506 (gnus-group-decoded-name group)))
507
508 (defsubst nnimap-encode-group-name (group)
509 (and group
510 (mm-encode-coding-string group (gnus-group-name-charset nil group))))
511
512 (defun nnimap-group-prefixed-name (group &optional server)
513 (gnus-group-prefixed-name group
514 (gnus-server-to-method
515 (format "nnimap:%s"
516 (or server nnimap-current-server)))))
517
504 (defsubst nnimap-get-server-buffer (server) 518 (defsubst nnimap-get-server-buffer (server)
505 "Return buffer for SERVER, if nil use current server." 519 "Return buffer for SERVER, if nil use current server."
506 (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) 520 (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
507 521
508 (defun nnimap-remove-server-from-buffer-alist (server list) 522 (defun nnimap-remove-server-from-buffer-alist (server list)
519 (setq nnimap-current-server (or server nnimap-current-server) 533 (setq nnimap-current-server (or server nnimap-current-server)
520 nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server))) 534 nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
521 535
522 (defun nnimap-verify-uidvalidity (group server) 536 (defun nnimap-verify-uidvalidity (group server)
523 "Verify stored uidvalidity match current one in GROUP on SERVER." 537 "Verify stored uidvalidity match current one in GROUP on SERVER."
524 (let* ((gnusgroup (gnus-group-prefixed-name 538 (let* ((gnusgroup (nnimap-group-prefixed-name group server))
525 group (gnus-server-to-method
526 (format "nnimap:%s" server))))
527 (new-uidvalidity (imap-mailbox-get 'uidvalidity)) 539 (new-uidvalidity (imap-mailbox-get 'uidvalidity))
528 (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) 540 (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
529 (dir (file-name-as-directory (expand-file-name nnimap-directory))) 541 (dir (file-name-as-directory (expand-file-name nnimap-directory)))
530 (nameuid (nnheader-translate-file-chars 542 (nameuid (nnheader-translate-file-chars
531 (concat nnimap-nov-file-name 543 (concat nnimap-nov-file-name
542 nnmail-pathname-coding-system) 554 nnmail-pathname-coding-system)
543 dir)))) 555 dir))))
544 (if old-uidvalidity 556 (if old-uidvalidity
545 (if (not (equal old-uidvalidity new-uidvalidity)) 557 (if (not (equal old-uidvalidity new-uidvalidity))
546 ;; uidvalidity clash 558 ;; uidvalidity clash
547 (gnus-delete-file file) 559 (progn
548 (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) 560 (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
561 (gnus-group-remove-parameter gnusgroup 'imap-status)
562 (gnus-sethash (gnus-group-prefixed-name group server)
563 nil nnimap-mailbox-info)
564 (gnus-delete-file file))
549 t) 565 t)
550 (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity)) 566 (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
567 (gnus-group-remove-parameter gnusgroup 'imap-status)
568 (gnus-sethash ; Maybe not necessary here.
569 (gnus-group-prefixed-name group server)
570 nil nnimap-mailbox-info)
551 t))) 571 t)))
552 572
553 (defun nnimap-before-find-minmax-bugworkaround () 573 (defun nnimap-before-find-minmax-bugworkaround ()
554 "Function called before iterating through mailboxes with 574 "Function called before iterating through mailboxes with
555 `nnimap-find-minmax-uid'." 575 `nnimap-find-minmax-uid'."
561 581
562 (defun nnimap-find-minmax-uid (group &optional examine) 582 (defun nnimap-find-minmax-uid (group &optional examine)
563 "Find lowest and highest active article number in GROUP. 583 "Find lowest and highest active article number in GROUP.
564 If EXAMINE is non-nil the group is selected read-only." 584 If EXAMINE is non-nil the group is selected read-only."
565 (with-current-buffer nnimap-server-buffer 585 (with-current-buffer nnimap-server-buffer
566 (when (or (string= group (imap-current-mailbox)) 586 (let ((decoded-group (nnimap-decode-group-name group)))
567 (imap-mailbox-select group examine)) 587 (when (or (string= decoded-group (imap-current-mailbox))
568 (let (minuid maxuid) 588 (imap-mailbox-select decoded-group examine))
569 (when (> (imap-mailbox-get 'exists) 0) 589 (let (minuid maxuid)
570 (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) 590 (when (> (imap-mailbox-get 'exists) 0)
571 (imap-message-map (lambda (uid Uid) 591 (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)
572 (setq minuid (if minuid (min minuid uid) uid) 592 (imap-message-map (lambda (uid Uid)
573 maxuid (if maxuid (max maxuid uid) uid))) 593 (setq minuid (if minuid (min minuid uid) uid)
574 'UID)) 594 maxuid (if maxuid (max maxuid uid) uid)))
575 (list (imap-mailbox-get 'exists) minuid maxuid))))) 595 'UID))
596 (list (imap-mailbox-get 'exists) minuid maxuid))))))
576 597
577 (defun nnimap-possibly-change-group (group &optional server) 598 (defun nnimap-possibly-change-group (group &optional server)
578 "Make GROUP the current group, and SERVER the current server." 599 "Make GROUP the current group, and SERVER the current server."
579 (when (nnimap-possibly-change-server server) 600 (when (nnimap-possibly-change-server server)
580 (with-current-buffer nnimap-server-buffer 601 (let ((decoded-group (nnimap-decode-group-name group)))
581 (if (or (null group) (imap-current-mailbox-p group)) 602 (with-current-buffer nnimap-server-buffer
582 imap-current-mailbox 603 (if (or (null group) (imap-current-mailbox-p decoded-group))
583 (if (imap-mailbox-select group) 604 imap-current-mailbox ; Note: utf-7 encoded.
584 (if (or (nnimap-verify-uidvalidity 605 (if (imap-mailbox-select decoded-group)
585 group (or server nnimap-current-server)) 606 (if (or (nnimap-verify-uidvalidity
586 (zerop (imap-mailbox-get 'exists group)) 607 group (or server nnimap-current-server))
587 t ;; for OGnus to see if ignoring uidvalidity 608 (zerop (imap-mailbox-get 'exists decoded-group))
588 ;; changes has any bad effects. 609 t ;; for OGnus to see if ignoring uidvalidity
589 (yes-or-no-p 610 ;; changes has any bad effects.
590 (format 611 (yes-or-no-p
591 "nnimap: Group %s is not uidvalid. Continue? " group))) 612 (format
592 imap-current-mailbox 613 "nnimap: Group %s is not uidvalid. Continue? "
593 (imap-mailbox-unselect) 614 decoded-group)))
594 (error "nnimap: Group %s is not uid-valid" group)) 615 imap-current-mailbox ; Note: utf-7 encoded.
595 (nnheader-report 'nnimap (imap-error-text))))))) 616 (imap-mailbox-unselect)
617 (error "nnimap: Group %s is not uid-valid" decoded-group))
618 (nnheader-report 'nnimap (imap-error-text))))))))
596 619
597 (defun nnimap-replace-whitespace (string) 620 (defun nnimap-replace-whitespace (string)
598 "Return STRING with all whitespace replaced with space." 621 "Return STRING with all whitespace replaced with space."
599 (when string 622 (when string
600 (while (string-match "[\r\n\t]+" string) 623 (while (string-match "[\r\n\t]+" string)
616 nnimap-progress-chars))) 639 nnimap-progress-chars)))
617 (with-current-buffer nntp-server-buffer 640 (with-current-buffer nntp-server-buffer
618 (let (headers lines chars uid mbx) 641 (let (headers lines chars uid mbx)
619 (with-current-buffer nnimap-server-buffer 642 (with-current-buffer nnimap-server-buffer
620 (setq uid imap-current-message 643 (setq uid imap-current-message
621 mbx imap-current-mailbox 644 mbx (nnimap-encode-group-name (imap-current-mailbox))
622 headers (if (imap-capability 'IMAP4rev1) 645 headers (if (imap-capability 'IMAP4rev1)
623 ;; xxx don't just use car? alist doesn't contain 646 ;; xxx don't just use car? alist doesn't contain
624 ;; anything else now, but it might... 647 ;; anything else now, but it might...
625 (nth 2 (car (imap-message-get uid 'BODYDETAIL))) 648 (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
626 (imap-message-get uid 'RFC822.HEADER)) 649 (imap-message-get uid 'RFC822.HEADER))
663 686
664 (defun nnimap-group-overview-filename (group server) 687 (defun nnimap-group-overview-filename (group server)
665 "Make file name for GROUP on SERVER." 688 "Make file name for GROUP on SERVER."
666 (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) 689 (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
667 (uidvalidity (gnus-group-get-parameter 690 (uidvalidity (gnus-group-get-parameter
668 (gnus-group-prefixed-name 691 (nnimap-group-prefixed-name group server)
669 group (gnus-server-to-method
670 (format "nnimap:%s" server)))
671 'uidvalidity)) 692 'uidvalidity))
672 (name (nnheader-translate-file-chars 693 (name (nnheader-translate-file-chars
673 (concat nnimap-nov-file-name 694 (concat nnimap-nov-file-name
674 (if (equal server "") 695 (if (equal server "")
675 "unnamed" 696 "unnamed"
962 (format "HEADER Message-Id \"%s\"" article) 983 (format "HEADER Message-Id \"%s\"" article)
963 nnimap-server-buffer)) 984 nnimap-server-buffer))
964 article))) 985 article)))
965 (when article 986 (when article
966 (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." 987 (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
967 article (or group imap-current-mailbox 988 article (or (nnimap-decode-group-name group)
968 gnus-newsgroup-name)) 989 (imap-current-mailbox)
990 (nnimap-decode-group-name
991 gnus-newsgroup-name)))
969 (if (not nnheader-callback-function) 992 (if (not nnheader-callback-function)
970 (with-current-buffer (or to-buffer nntp-server-buffer) 993 (with-current-buffer (or to-buffer nntp-server-buffer)
971 (erase-buffer) 994 (erase-buffer)
972 (let ((data (imap-fetch article part prop nil 995 (let ((data (imap-fetch article part prop nil
973 nnimap-server-buffer))) 996 nnimap-server-buffer)))
977 (nth 2 (car data)) 1000 (nth 2 (car data))
978 data))))) 1001 data)))))
979 (nnheader-ms-strip-cr) 1002 (nnheader-ms-strip-cr)
980 (gnus-message 1003 (gnus-message
981 10 "nnimap: Fetching (part of) article %d from %s...done" 1004 10 "nnimap: Fetching (part of) article %d from %s...done"
982 article (or group imap-current-mailbox gnus-newsgroup-name)) 1005 article (or (nnimap-decode-group-name group)
1006 (imap-current-mailbox)
1007 (nnimap-decode-group-name gnus-newsgroup-name)))
983 (if (bobp) 1008 (if (bobp)
984 (nnheader-report 'nnimap "No such article %d in %s: %s" 1009 (nnheader-report 'nnimap "No such article %d in %s: %s"
985 article (or group imap-current-mailbox 1010 article (or (nnimap-decode-group-name group)
986 gnus-newsgroup-name) 1011 (imap-current-mailbox)
1012 (nnimap-decode-group-name
1013 gnus-newsgroup-name))
987 (imap-error-text nnimap-server-buffer)) 1014 (imap-error-text nnimap-server-buffer))
988 (cons group article))) 1015 (cons group article)))
989 (add-hook 'imap-fetch-data-hook 1016 (add-hook 'imap-fetch-data-hook
990 (nnimap-make-callback article 1017 (nnimap-make-callback article
991 nnheader-callback-function 1018 nnheader-callback-function
1018 article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))) 1045 article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)))
1019 1046
1020 (deffoo nnimap-request-group (group &optional server fast) 1047 (deffoo nnimap-request-group (group &optional server fast)
1021 (nnimap-request-update-info-internal 1048 (nnimap-request-update-info-internal
1022 group 1049 group
1023 (gnus-get-info (gnus-group-prefixed-name 1050 (gnus-get-info (nnimap-group-prefixed-name group server))
1024 group (gnus-server-to-method (format "nnimap:%s" server))))
1025 server) 1051 server)
1026 (when (nnimap-possibly-change-group group server) 1052 (when (nnimap-possibly-change-group group server)
1027 (nnimap-before-find-minmax-bugworkaround) 1053 (nnimap-before-find-minmax-bugworkaround)
1028 (let (info) 1054 (let (info)
1029 (cond (fast group) 1055 (cond (fast group)
1042 (gnus-sethash 1068 (gnus-sethash
1043 (gnus-group-prefixed-name group server) 1069 (gnus-group-prefixed-name group server)
1044 (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) 1070 (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
1045 nnimap-mailbox-info))) 1071 nnimap-mailbox-info)))
1046 (list (nth 0 old) (nth 1 old) 1072 (list (nth 0 old) (nth 1 old)
1047 (imap-mailbox-status group 'unseen nnimap-server-buffer) 1073 (imap-mailbox-status (nnimap-decode-group-name group)
1048 (nth 3 old))) 1074 'unseen nnimap-server-buffer)))
1049 nnimap-mailbox-info)) 1075 nnimap-mailbox-info))
1050 1076
1051 (defun nnimap-close-group (group &optional server) 1077 (defun nnimap-close-group (group &optional server)
1052 (with-current-buffer nnimap-server-buffer 1078 (with-current-buffer nnimap-server-buffer
1053 (when (and (imap-opened) 1079 (when (and (imap-opened)
1058 (imap-mailbox-expunge nnimap-close-asynchronous) 1084 (imap-mailbox-expunge nnimap-close-asynchronous)
1059 (unless nnimap-dont-close 1085 (unless nnimap-dont-close
1060 (imap-mailbox-close nnimap-close-asynchronous)))) 1086 (imap-mailbox-close nnimap-close-asynchronous))))
1061 (ask (if (and (imap-search "DELETED") 1087 (ask (if (and (imap-search "DELETED")
1062 (gnus-y-or-n-p (format "Expunge articles in group `%s'? " 1088 (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
1063 imap-current-mailbox))) 1089 (imap-current-mailbox))))
1064 (progn 1090 (progn
1065 (imap-mailbox-expunge nnimap-close-asynchronous) 1091 (imap-mailbox-expunge nnimap-close-asynchronous)
1066 (unless nnimap-dont-close 1092 (unless nnimap-dont-close
1067 (imap-mailbox-close nnimap-close-asynchronous))) 1093 (imap-mailbox-close nnimap-close-asynchronous)))
1068 (imap-mailbox-unselect))) 1094 (imap-mailbox-unselect)))
1087 (with-current-buffer nnimap-server-buffer 1113 (with-current-buffer nnimap-server-buffer
1088 (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) 1114 (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
1089 (dolist (mbx (funcall nnimap-request-list-method 1115 (dolist (mbx (funcall nnimap-request-list-method
1090 (cdr pattern) (car pattern))) 1116 (cdr pattern) (car pattern)))
1091 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) 1117 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
1092 (let ((info (nnimap-find-minmax-uid mbx 'examine))) 1118 (let* ((encoded-mbx (nnimap-encode-group-name mbx))
1119 (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
1093 (when info 1120 (when info
1094 (with-current-buffer nntp-server-buffer 1121 (with-current-buffer nntp-server-buffer
1095 (insert (format "\"%s\" %d %d y\n" 1122 (insert (format "\"%s\" %d %d y\n"
1096 mbx (or (nth 2 info) 0) 1123 encoded-mbx (or (nth 2 info) 0)
1097 (max 1 (or (nth 1 info) 1))))))))))) 1124 (max 1 (or (nth 1 info) 1)))))))))))
1098 (gnus-message 5 "nnimap: Generating active list%s...done" 1125 (gnus-message 5 "nnimap: Generating active list%s...done"
1099 (if (> (length server) 0) (concat " for " server) "")) 1126 (if (> (length server) 0) (concat " for " server) ""))
1100 t)) 1127 t))
1101 1128
1141 (when (nnimap-possibly-change-server server) 1168 (when (nnimap-possibly-change-server server)
1142 (gnus-message 5 "nnimap: Checking mailboxes...") 1169 (gnus-message 5 "nnimap: Checking mailboxes...")
1143 (with-current-buffer nntp-server-buffer 1170 (with-current-buffer nntp-server-buffer
1144 (erase-buffer) 1171 (erase-buffer)
1145 (nnimap-before-find-minmax-bugworkaround) 1172 (nnimap-before-find-minmax-bugworkaround)
1146 (let (asyncgroups slowgroups) 1173 (let (asyncgroups slowgroups decoded-group)
1147 (if (null nnimap-retrieve-groups-asynchronous) 1174 (if (null nnimap-retrieve-groups-asynchronous)
1148 (setq slowgroups groups) 1175 (setq slowgroups groups)
1149 (dolist (group groups) 1176 (dolist (group groups)
1150 (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) 1177 (setq decoded-group (nnimap-decode-group-name group))
1151 (add-to-list (if (gnus-gethash-safe 1178 (gnus-message 9 "nnimap: Quickly checking mailbox %s"
1152 (gnus-group-prefixed-name group server) 1179 decoded-group)
1153 nnimap-mailbox-info) 1180 (add-to-list (if (gnus-group-get-parameter
1181 (nnimap-group-prefixed-name group)
1182 'imap-status)
1154 'asyncgroups 1183 'asyncgroups
1155 'slowgroups) 1184 'slowgroups)
1156 (list group (imap-mailbox-status-asynch 1185 (list group (imap-mailbox-status-asynch
1157 group '(uidvalidity uidnext unseen) 1186 decoded-group
1187 '(uidvalidity uidnext unseen)
1158 nnimap-server-buffer)))) 1188 nnimap-server-buffer))))
1159 (dolist (asyncgroup asyncgroups) 1189 (dolist (asyncgroup asyncgroups)
1160 (let ((group (nth 0 asyncgroup)) 1190 (let* ((group (nth 0 asyncgroup))
1161 (tag (nth 1 asyncgroup)) 1191 (tag (nth 1 asyncgroup))
1162 new old) 1192 (gnusgroup (nnimap-group-prefixed-name group))
1193 (saved-uidvalidity (gnus-group-get-parameter gnusgroup
1194 'uidvalidity))
1195 (saved-imap-status (gnus-group-get-parameter gnusgroup
1196 'imap-status))
1197 (saved-info (and saved-imap-status
1198 (split-string saved-imap-status " "))))
1199 (setq decoded-group (nnimap-decode-group-name group))
1163 (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) 1200 (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
1164 (if (or (not (string= 1201 (if (or (not (equal
1165 (nth 0 (gnus-gethash (gnus-group-prefixed-name 1202 saved-uidvalidity
1166 group server) 1203 (imap-mailbox-get 'uidvalidity decoded-group
1167 nnimap-mailbox-info))
1168 (imap-mailbox-get 'uidvalidity group
1169 nnimap-server-buffer))) 1204 nnimap-server-buffer)))
1170 (not (string= 1205 (not (equal
1171 (nth 1 (gnus-gethash (gnus-group-prefixed-name 1206 (nth 0 saved-info)
1172 group server) 1207 (imap-mailbox-get 'uidnext decoded-group
1173 nnimap-mailbox-info))
1174 (imap-mailbox-get 'uidnext group
1175 nnimap-server-buffer)))) 1208 nnimap-server-buffer))))
1176 (push (list group) slowgroups) 1209 (push (list group) slowgroups)
1177 (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name 1210 (gnus-sethash
1178 group server) 1211 (gnus-group-prefixed-name group server)
1179 nnimap-mailbox-info)))))))) 1212 (list (imap-mailbox-get 'uidvalidity
1213 decoded-group nnimap-server-buffer)
1214 (imap-mailbox-get 'uidnext
1215 decoded-group nnimap-server-buffer)
1216 (imap-mailbox-get 'unseen
1217 decoded-group nnimap-server-buffer))
1218 nnimap-mailbox-info)
1219 (insert (format "\"%s\" %s %s y\n" group
1220 (nth 2 saved-info)
1221 (nth 1 saved-info))))))))
1180 (dolist (group slowgroups) 1222 (dolist (group slowgroups)
1181 (if nnimap-retrieve-groups-asynchronous 1223 (if nnimap-retrieve-groups-asynchronous
1182 (setq group (car group))) 1224 (setq group (car group)))
1183 (gnus-message 7 "nnimap: Mailbox %s modified" group) 1225 (setq decoded-group (nnimap-decode-group-name group))
1184 (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) 1226 (gnus-message 7 "nnimap: Mailbox %s modified" decoded-group)
1185 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group 1227 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags decoded-group
1186 nnimap-server-buffer)) 1228 nnimap-server-buffer))
1187 (let* ((info (nnimap-find-minmax-uid group 'examine)) 1229 (let* ((gnusgroup (nnimap-group-prefixed-name group))
1188 (str (format "\"%s\" %d %d y\n" group 1230 (status (imap-mailbox-status
1189 (or (nth 2 info) 0) 1231 decoded-group '(uidvalidity uidnext unseen)
1190 (max 1 (or (nth 1 info) 1))))) 1232 nnimap-server-buffer))
1191 (when (> (or (imap-mailbox-get 'recent group 1233 (info (nnimap-find-minmax-uid group 'examine))
1234 (min-uid (max 1 (or (nth 1 info) 1)))
1235 (max-uid (or (nth 2 info) 0)))
1236 (when (> (or (imap-mailbox-get 'recent decoded-group
1192 nnimap-server-buffer) 0) 1237 nnimap-server-buffer) 0)
1193 0) 1238 0)
1194 (push (list (cons group 0)) nnmail-split-history)) 1239 (push (list (cons decoded-group 0)) nnmail-split-history))
1195 (insert str) 1240 (insert (format "\"%s\" %d %d y\n" group max-uid min-uid))
1196 (when nnimap-retrieve-groups-asynchronous 1241 (gnus-sethash
1197 (gnus-sethash 1242 (gnus-group-prefixed-name group server)
1198 (gnus-group-prefixed-name group server) 1243 status
1199 (list (or (imap-mailbox-get 1244 nnimap-mailbox-info)
1200 'uidvalidity group nnimap-server-buffer) 1245 (if (not (equal (nth 0 status)
1201 (imap-mailbox-status 1246 (gnus-group-get-parameter gnusgroup
1202 group 'uidvalidity nnimap-server-buffer)) 1247 'uidvalidity)))
1203 (or (imap-mailbox-get 1248 (nnimap-verify-uidvalidity group nnimap-current-server))
1204 'uidnext group nnimap-server-buffer) 1249 ;; The imap-status parameter is a string on the form
1205 (imap-mailbox-status 1250 ;; "<uidnext> <min-uid> <max-uid>".
1206 group 'uidnext nnimap-server-buffer)) 1251 (gnus-group-add-parameter
1207 (or (imap-mailbox-get 1252 gnusgroup
1208 'unseen group nnimap-server-buffer) 1253 (cons 'imap-status
1209 (imap-mailbox-status 1254 (format "%s %s %s" (nth 1 status) min-uid max-uid))))))))
1210 group 'unseen nnimap-server-buffer))
1211 str)
1212 nnimap-mailbox-info)))))))
1213 (gnus-message 5 "nnimap: Checking mailboxes...done") 1255 (gnus-message 5 "nnimap: Checking mailboxes...done")
1214 'active)) 1256 'active))
1215 1257
1216 (deffoo nnimap-request-update-info-internal (group info &optional server) 1258 (deffoo nnimap-request-update-info-internal (group info &optional server)
1217 (when (nnimap-possibly-change-group group server) 1259 (when (nnimap-possibly-change-group group server)
1218 (when info ;; xxx what does this mean? should we create a info? 1260 (when info ;; xxx what does this mean? should we create a info?
1219 (with-current-buffer nnimap-server-buffer 1261 (with-current-buffer nnimap-server-buffer
1220 (gnus-message 5 "nnimap: Updating info for %s..." 1262 (gnus-message 5 "nnimap: Updating info for %s..."
1221 (gnus-info-group info)) 1263 (nnimap-decode-group-name (gnus-info-group info)))
1222 1264
1223 (when (nnimap-mark-permanent-p 'read) 1265 (when (nnimap-mark-permanent-p 'read)
1224 (let (seen unseen) 1266 (let (seen unseen)
1225 ;; read info could contain articles marked unread by other 1267 ;; read info could contain articles marked unread by other
1226 ;; imap clients! we correct this 1268 ;; imap clients! we correct this
1262 (cdr-safe (assoc 'dormant (gnus-info-marks info)))) 1304 (cdr-safe (assoc 'dormant (gnus-info-marks info))))
1263 (gnus-info-marks info)) 1305 (gnus-info-marks info))
1264 t)) 1306 t))
1265 1307
1266 (gnus-message 5 "nnimap: Updating info for %s...done" 1308 (gnus-message 5 "nnimap: Updating info for %s...done"
1267 (gnus-info-group info)) 1309 (nnimap-decode-group-name (gnus-info-group info)))
1268 1310
1269 info)))) 1311 info))))
1270 1312
1271 (deffoo nnimap-request-type (group &optional article) 1313 (deffoo nnimap-request-type (group &optional article)
1272 (if (and nnimap-news-groups (string-match nnimap-news-groups group)) 1314 (if (and nnimap-news-groups (string-match nnimap-news-groups group))
1275 1317
1276 (deffoo nnimap-request-set-mark (group actions &optional server) 1318 (deffoo nnimap-request-set-mark (group actions &optional server)
1277 (when (nnimap-possibly-change-group group server) 1319 (when (nnimap-possibly-change-group group server)
1278 (with-current-buffer nnimap-server-buffer 1320 (with-current-buffer nnimap-server-buffer
1279 (let (action) 1321 (let (action)
1280 (gnus-message 7 "nnimap: Setting marks in %s..." group) 1322 (gnus-message 7 "nnimap: Setting marks in %s..."
1323 (nnimap-decode-group-name group))
1281 (while (setq action (pop actions)) 1324 (while (setq action (pop actions))
1282 (let ((range (nth 0 action)) 1325 (let ((range (nth 0 action))
1283 (what (nth 1 action)) 1326 (what (nth 1 action))
1284 (cmdmarks (nth 2 action)) 1327 (cmdmarks (nth 2 action))
1285 marks) 1328 marks)
1316 (nnimap-mark-to-flag marks nil t))) 1359 (nnimap-mark-to-flag marks nil t)))
1317 ((eq what 'set) 1360 ((eq what 'set)
1318 (imap-message-flags-set 1361 (imap-message-flags-set
1319 (imap-range-to-message-set range) 1362 (imap-range-to-message-set range)
1320 (nnimap-mark-to-flag marks nil t))))))) 1363 (nnimap-mark-to-flag marks nil t)))))))
1321 (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) 1364 (gnus-message 7 "nnimap: Setting marks in %s...done"
1365 (nnimap-decode-group-name group)))))
1322 nil) 1366 nil)
1323 1367
1324 (defun nnimap-split-fancy () 1368 (defun nnimap-split-fancy ()
1325 "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'." 1369 "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'."
1326 (let ((nnmail-split-fancy nnimap-split-fancy)) 1370 (let ((nnmail-split-fancy nnimap-split-fancy))
1327 (nnmail-split-fancy))) 1371 (nnmail-split-fancy)))
1328 1372
1329 (defun nnimap-split-to-groups (rules) 1373 (defun nnimap-split-to-groups (rules)
1330 ;; tries to match all rules in nnimap-split-rule against content of 1374 ;; tries to match all rules in nnimap-split-rule against content of
1331 ;; nntp-server-buffer, returns a list of groups that matched. 1375 ;; nntp-server-buffer, returns a list of groups that matched.
1376 ;; Note: This function takes and returns decoded group names.
1332 (with-current-buffer nntp-server-buffer 1377 (with-current-buffer nntp-server-buffer
1333 ;; Fold continuation lines. 1378 ;; Fold continuation lines.
1334 (goto-char (point-min)) 1379 (goto-char (point-min))
1335 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) 1380 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
1336 (replace-match " " t t)) 1381 (replace-match " " t t))
1379 (if (listp nnimap-split-inbox) 1424 (if (listp nnimap-split-inbox)
1380 nnimap-split-inbox 1425 nnimap-split-inbox
1381 (list nnimap-split-inbox))) 1426 (list nnimap-split-inbox)))
1382 1427
1383 (defun nnimap-split-articles (&optional group server) 1428 (defun nnimap-split-articles (&optional group server)
1429 ;; Note: Assumes decoded group names in nnimap-split-inbox,
1430 ;; nnimap-split-rule, nnimap-split-fancy, and nnmail-split-history.
1384 (when (nnimap-possibly-change-server server) 1431 (when (nnimap-possibly-change-server server)
1385 (with-current-buffer nnimap-server-buffer 1432 (with-current-buffer nnimap-server-buffer
1386 (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) 1433 (let (rule inbox removeorig
1434 (inboxes (nnimap-split-find-inbox server)))
1387 ;; iterate over inboxes 1435 ;; iterate over inboxes
1388 (while (and (setq inbox (pop inboxes)) 1436 (while (and (setq inbox (pop inboxes))
1389 (nnimap-possibly-change-group inbox)) ;; SELECT 1437 (nnimap-possibly-change-group
1438 (nnimap-encode-group-name inbox))) ;; SELECT
1390 ;; find split rule for this server / inbox 1439 ;; find split rule for this server / inbox
1391 (when (setq rule (nnimap-split-find-rule server inbox)) 1440 (when (setq rule (nnimap-split-find-rule server inbox))
1392 ;; iterate over articles 1441 ;; iterate over articles
1393 (dolist (article (imap-search nnimap-split-predicate)) 1442 (dolist (article (imap-search nnimap-split-predicate))
1394 (when (if (if (eq nnimap-split-download-body 'default) 1443 (when (if (if (eq nnimap-split-download-body 'default)
1413 (with-current-buffer nntp-server-buffer 1462 (with-current-buffer nntp-server-buffer
1414 (let (msgid) 1463 (let (msgid)
1415 (and (setq msgid 1464 (and (setq msgid
1416 (nnmail-fetch-field "message-id")) 1465 (nnmail-fetch-field "message-id"))
1417 (nnmail-cache-insert msgid 1466 (nnmail-cache-insert msgid
1418 to-group 1467 (nnimap-encode-group-name to-group)
1419 (nnmail-fetch-field "subject")))))) 1468 (nnmail-fetch-field "subject"))))))
1420 ;; Add the group-art list to the history list. 1469 ;; Add the group-art list to the history list.
1421 (push (list (cons to-group 0)) nnmail-split-history)) 1470 (push (list (cons to-group 0)) nnmail-split-history))
1422 (t 1471 (t
1423 (message "IMAP split failed to move %s:%s:%d to %s" 1472 (message "IMAP split failed to move %s:%s:%d to %s"
1456 (dolist (mailbox (imap-mailbox-get 'list-flags mbx 1505 (dolist (mailbox (imap-mailbox-get 'list-flags mbx
1457 nnimap-server-buffer)) 1506 nnimap-server-buffer))
1458 (if (string= (downcase mailbox) "\\noselect") 1507 (if (string= (downcase mailbox) "\\noselect")
1459 (throw 'found t))) 1508 (throw 'found t)))
1460 nil) 1509 nil)
1461 (let ((info (nnimap-find-minmax-uid mbx 'examine))) 1510 (let* ((encoded-mbx (nnimap-encode-group-name mbx))
1511 (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
1462 (when info 1512 (when info
1463 (insert (format "\"%s\" %d %d y\n" 1513 (insert (format "\"%s\" %d %d y\n"
1464 mbx (or (nth 2 info) 0) 1514 encoded-mbx (or (nth 2 info) 0)
1465 (max 1 (or (nth 1 info) 1))))))))) 1515 (max 1 (or (nth 1 info) 1)))))))))
1466 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" 1516 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
1467 (if (> (length server) 0) " on " "") server)) 1517 (if (> (length server) 0) " on " "") server))
1468 t)) 1518 t))
1469 1519
1470 (deffoo nnimap-request-create-group (group &optional server args) 1520 (deffoo nnimap-request-create-group (group &optional server args)
1471 (when (nnimap-possibly-change-server server) 1521 (when (nnimap-possibly-change-server server)
1472 (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) 1522 (let ((decoded-group (nnimap-decode-group-name group)))
1473 (imap-mailbox-create group nnimap-server-buffer) 1523 (or (imap-mailbox-status decoded-group 'uidvalidity nnimap-server-buffer)
1474 (nnheader-report 'nnimap "%S" 1524 (imap-mailbox-create decoded-group nnimap-server-buffer)
1475 (imap-error-text nnimap-server-buffer))))) 1525 (nnheader-report 'nnimap "%S"
1526 (imap-error-text nnimap-server-buffer))))))
1476 1527
1477 (defun nnimap-time-substract (time1 time2) 1528 (defun nnimap-time-substract (time1 time2)
1478 "Return TIME for TIME1 - TIME2." 1529 "Return TIME for TIME1 - TIME2."
1479 (let* ((ms (- (car time1) (car time2))) 1530 (let* ((ms (- (car time1) (car time2)))
1480 (ls (- (nth 1 time1) (nth 1 time2)))) 1531 (ls (- (nth 1 time1) (nth 1 time2))))
1601 ;; moving article within same server, speed it up... 1652 ;; moving article within same server, speed it up...
1602 (and (nnimap-possibly-change-group 1653 (and (nnimap-possibly-change-group
1603 nnimap-current-move-group) 1654 nnimap-current-move-group)
1604 (imap-message-copy (number-to-string 1655 (imap-message-copy (number-to-string
1605 nnimap-current-move-article) 1656 nnimap-current-move-article)
1606 group 'dontcreate nil 1657 (nnimap-decode-group-name group)
1658 'dontcreate nil
1607 nnimap-server-buffer)) 1659 nnimap-server-buffer))
1608 (with-current-buffer (current-buffer) 1660 (with-current-buffer (current-buffer)
1609 (goto-char (point-min)) 1661 (goto-char (point-min))
1610 ;; remove any 'From blabla' lines, some IMAP servers 1662 ;; remove any 'From blabla' lines, some IMAP servers
1611 ;; reject the entire message otherwise. 1663 ;; reject the entire message otherwise.
1621 (when (and last nnmail-cache-accepted-message-ids) 1673 (when (and last nnmail-cache-accepted-message-ids)
1622 (nnmail-cache-close)) 1674 (nnmail-cache-close))
1623 ;; this 'or' is for Cyrus server bug 1675 ;; this 'or' is for Cyrus server bug
1624 (or (null (imap-current-mailbox nnimap-server-buffer)) 1676 (or (null (imap-current-mailbox nnimap-server-buffer))
1625 (imap-mailbox-unselect nnimap-server-buffer)) 1677 (imap-mailbox-unselect nnimap-server-buffer))
1626 (imap-message-append group (current-buffer) nil nil 1678 (imap-message-append (nnimap-decode-group-name group)
1679 (current-buffer) nil nil
1627 nnimap-server-buffer))) 1680 nnimap-server-buffer)))
1628 (cons group (nth 1 uid)) 1681 (cons group (nth 1 uid))
1629 (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) 1682 (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
1630 1683
1631 (deffoo nnimap-request-delete-group (group force &optional server) 1684 (deffoo nnimap-request-delete-group (group force &optional server)
1632 (when (nnimap-possibly-change-server server) 1685 (when (nnimap-possibly-change-server server)
1686 (setq group (nnimap-decode-group-name group))
1633 (when (string= group (imap-current-mailbox nnimap-server-buffer)) 1687 (when (string= group (imap-current-mailbox nnimap-server-buffer))
1634 (imap-mailbox-unselect nnimap-server-buffer)) 1688 (imap-mailbox-unselect nnimap-server-buffer))
1635 (with-current-buffer nnimap-server-buffer 1689 (with-current-buffer nnimap-server-buffer
1636 (if force 1690 (if force
1637 (or (null (imap-mailbox-status group 'uidvalidity)) 1691 (or (null (imap-mailbox-status group 'uidvalidity))
1639 ;; UNSUBSCRIBE? 1693 ;; UNSUBSCRIBE?
1640 t)))) 1694 t))))
1641 1695
1642 (deffoo nnimap-request-rename-group (group new-name &optional server) 1696 (deffoo nnimap-request-rename-group (group new-name &optional server)
1643 (when (nnimap-possibly-change-server server) 1697 (when (nnimap-possibly-change-server server)
1644 (imap-mailbox-rename group new-name nnimap-server-buffer))) 1698 (imap-mailbox-rename (nnimap-decode-group-name group)
1699 (nnimap-decode-group-name new-name)
1700 nnimap-server-buffer)))
1645 1701
1646 (defun nnimap-expunge (mailbox server) 1702 (defun nnimap-expunge (mailbox server)
1647 (when (nnimap-possibly-change-group mailbox server) 1703 (when (nnimap-possibly-change-group mailbox server)
1648 (imap-mailbox-expunge nil nnimap-server-buffer))) 1704 (imap-mailbox-expunge nil nnimap-server-buffer)))
1649 1705
1650 (defun nnimap-acl-get (mailbox server) 1706 (defun nnimap-acl-get (mailbox server)
1651 (when (nnimap-possibly-change-server server) 1707 (when (nnimap-possibly-change-server server)
1652 (and (imap-capability 'ACL nnimap-server-buffer) 1708 (and (imap-capability 'ACL nnimap-server-buffer)
1653 (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) 1709 (imap-mailbox-acl-get (nnimap-decode-group-name mailbox)
1710 nnimap-server-buffer))))
1654 1711
1655 (defun nnimap-acl-edit (mailbox method old-acls new-acls) 1712 (defun nnimap-acl-edit (mailbox method old-acls new-acls)
1656 (when (nnimap-possibly-change-server (cadr method)) 1713 (when (nnimap-possibly-change-server (cadr method))
1657 (unless (imap-capability 'ACL nnimap-server-buffer) 1714 (unless (imap-capability 'ACL nnimap-server-buffer)
1658 (error "Your server does not support ACL editing")) 1715 (error "Your server does not support ACL editing"))
1659 (with-current-buffer nnimap-server-buffer 1716 (with-current-buffer nnimap-server-buffer
1660 ;; delete all removed identifiers 1717 ;; delete all removed identifiers
1661 (mapc (lambda (old-acl) 1718 (mapc (lambda (old-acl)
1662 (unless (assoc (car old-acl) new-acls) 1719 (unless (assoc (car old-acl) new-acls)
1663 (or (imap-mailbox-acl-delete (car old-acl) mailbox) 1720 (or (imap-mailbox-acl-delete (car old-acl)
1721 (nnimap-decode-group-name mailbox))
1664 (error "Can't delete ACL for %s" (car old-acl))))) 1722 (error "Can't delete ACL for %s" (car old-acl)))))
1665 old-acls) 1723 old-acls)
1666 ;; set all changed acl's 1724 ;; set all changed acl's
1667 (mapc (lambda (new-acl) 1725 (mapc (lambda (new-acl)
1668 (let ((new-rights (cdr new-acl)) 1726 (let ((new-rights (cdr new-acl))
1669 (old-rights (cdr (assoc (car new-acl) old-acls)))) 1727 (old-rights (cdr (assoc (car new-acl) old-acls))))
1670 (unless (and old-rights new-rights 1728 (unless (and old-rights new-rights
1671 (string= old-rights new-rights)) 1729 (string= old-rights new-rights))
1672 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) 1730 (or (imap-mailbox-acl-set (car new-acl) new-rights
1731 (nnimap-decode-group-name mailbox))
1673 (error "Can't set ACL for %s to %s" (car new-acl) 1732 (error "Can't set ACL for %s to %s" (car new-acl)
1674 new-rights))))) 1733 new-rights)))))
1675 new-acls) 1734 new-acls)
1676 t))) 1735 t)))
1677 1736