Mercurial > emacs
comparison lisp/gnus/nnimap.el @ 110898:069deed4cdec
Merge changes made in Gnus trunk.
nnimap.el (nnimap-open-connection): If we have gnutls loaded, then try to use that for the tls stream.
nnimap.el (nnimap-retrieve-group-data-early): Rework the marks code to heed UIDVALIDITY and find out which groups are read-only and not.
nnimap.el (nnimap-get-flags): Use the same marks parsing code as the rest of nnimap.
nnimap.el (nnmail-expiry-target-group): Say that every expiry target group is the "last".
nnir.el (nnir-engines): Fix too many arguments.
nnimap.el: Start implementing QRESYNC support.
gnus.el (gnus-group-set-parameter): Fix typo.
shr.el: Rework the way things are indented by <li> slightly.
spam.el (gnus-summary-mode-map): Bind to "$".
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sun, 10 Oct 2010 00:15:21 +0000 |
parents | 07053df95af6 |
children | 2a4bfc24abf0 |
comparison
equal
deleted
inserted
replaced
110897:ddcc974a9f3d | 110898:069deed4cdec |
---|---|
315 "*nnimap*" (current-buffer) nnimap-address | 315 "*nnimap*" (current-buffer) nnimap-address |
316 (setq port (or nnimap-server-port "imap")) | 316 (setq port (or nnimap-server-port "imap")) |
317 'starttls)) | 317 'starttls)) |
318 '("imap")) | 318 '("imap")) |
319 ((memq nnimap-stream '(ssl tls)) | 319 ((memq nnimap-stream '(ssl tls)) |
320 (funcall (if (and nil | 320 (funcall (if (fboundp 'open-gnutls-stream) |
321 (fboundp 'open-gnutls-stream)) | |
322 'open-gnutls-stream | 321 'open-gnutls-stream |
323 'open-tls-stream) | 322 'open-tls-stream) |
324 "*nnimap*" (current-buffer) nnimap-address | 323 "*nnimap*" (current-buffer) nnimap-address |
325 (setq port | 324 (setq port |
326 (or nnimap-server-port | 325 (or nnimap-server-port |
336 (if (not (and (nnimap-process nnimap-object) | 335 (if (not (and (nnimap-process nnimap-object) |
337 (memq (process-status (nnimap-process nnimap-object)) | 336 (memq (process-status (nnimap-process nnimap-object)) |
338 '(open run)))) | 337 '(open run)))) |
339 (nnheader-report 'nnimap "Unable to contact %s:%s via %s" | 338 (nnheader-report 'nnimap "Unable to contact %s:%s via %s" |
340 nnimap-address port nnimap-stream) | 339 nnimap-address port nnimap-stream) |
341 (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) | 340 (gnus-set-process-query-on-exit-flag |
341 (nnimap-process nnimap-object) nil) | |
342 (if (not (setq connection-result (nnimap-wait-for-connection))) | 342 (if (not (setq connection-result (nnimap-wait-for-connection))) |
343 (nnheader-report 'nnimap | 343 (nnheader-report 'nnimap |
344 "%s" (buffer-substring | 344 "%s" (buffer-substring |
345 (point) (line-end-position))) | 345 (point) (line-end-position))) |
346 ;; Store the greeting (for debugging purposes). | 346 ;; Store the greeting (for debugging purposes). |
624 (nnimap-send-command "UID FETCH 1:* FLAGS"))) | 624 (nnimap-send-command "UID FETCH 1:* FLAGS"))) |
625 (nnimap-wait-for-response flag-sequence) | 625 (nnimap-wait-for-response flag-sequence) |
626 (setq marks | 626 (setq marks |
627 (nnimap-flags-to-marks | 627 (nnimap-flags-to-marks |
628 (nnimap-parse-flags | 628 (nnimap-parse-flags |
629 (list (list group-sequence flag-sequence 1 group))))) | 629 (list (list group-sequence flag-sequence |
630 (when info | 630 1 group "SELECT"))))) |
631 (when (and info | |
632 marks) | |
631 (nnimap-update-infos marks (list info))) | 633 (nnimap-update-infos marks (list info))) |
632 (goto-char (point-max)) | 634 (goto-char (point-max)) |
633 (let ((uidnext (nth 5 (car marks)))) | 635 (let ((uidnext (nth 5 (car marks)))) |
634 (setq high (or (if uidnext | 636 (setq high (or (if uidnext |
635 (1- uidnext) | 637 (1- uidnext) |
653 (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) | 655 (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) |
654 | 656 |
655 (deffoo nnimap-request-rename-group (group new-name &optional server) | 657 (deffoo nnimap-request-rename-group (group new-name &optional server) |
656 (when (nnimap-possibly-change-group nil server) | 658 (when (nnimap-possibly-change-group nil server) |
657 (with-current-buffer (nnimap-buffer) | 659 (with-current-buffer (nnimap-buffer) |
658 (car (nnimap-command "RENAME %S %S" (utf7-encode group t) (utf7-encode new-name t)))))) | 660 (car (nnimap-command "RENAME %S %S" |
661 (utf7-encode group t) (utf7-encode new-name t)))))) | |
659 | 662 |
660 (deffoo nnimap-request-expunge-group (group &optional server) | 663 (deffoo nnimap-request-expunge-group (group &optional server) |
661 (when (nnimap-possibly-change-group group server) | 664 (when (nnimap-possibly-change-group group server) |
662 (with-current-buffer (nnimap-buffer) | 665 (with-current-buffer (nnimap-buffer) |
663 (car (nnimap-command "EXPUNGE"))))) | 666 (car (nnimap-command "EXPUNGE"))))) |
664 | 667 |
665 (defun nnimap-get-flags (spec) | 668 (defun nnimap-get-flags (spec) |
666 (let ((articles nil) | 669 (let ((articles nil) |
667 elems) | 670 elems end) |
668 (with-current-buffer (nnimap-buffer) | 671 (with-current-buffer (nnimap-buffer) |
669 (erase-buffer) | 672 (erase-buffer) |
670 (nnimap-wait-for-response (nnimap-send-command | 673 (nnimap-wait-for-response (nnimap-send-command |
671 "UID FETCH %s FLAGS" spec)) | 674 "UID FETCH %s FLAGS" spec)) |
675 (setq end (point)) | |
676 (subst-char-in-region (point-min) (point-max) | |
677 ?\\ ?% t) | |
672 (goto-char (point-min)) | 678 (goto-char (point-min)) |
673 (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" nil t) | 679 (while (search-forward " FETCH " end t) |
674 (setq elems (nnimap-parse-line (match-string 1))) | 680 (setq elems (read (current-buffer))) |
675 (push (cons (string-to-number (cadr (member "UID" elems))) | 681 (push (cons (cadr (memq 'UID elems)) |
676 (cadr (member "FLAGS" elems))) | 682 (cadr (memq 'FLAGS elems))) |
677 articles))) | 683 articles))) |
678 (nreverse articles))) | 684 (nreverse articles))) |
679 | 685 |
680 (deffoo nnimap-close-group (group &optional server) | 686 (deffoo nnimap-close-group (group &optional server) |
681 t) | 687 t) |
938 t)) | 944 t)) |
939 | 945 |
940 (deffoo nnimap-retrieve-group-data-early (server infos) | 946 (deffoo nnimap-retrieve-group-data-early (server infos) |
941 (when (nnimap-possibly-change-group nil server) | 947 (when (nnimap-possibly-change-group nil server) |
942 (with-current-buffer (nnimap-buffer) | 948 (with-current-buffer (nnimap-buffer) |
949 (erase-buffer) | |
950 (setf (nnimap-group nnimap-object) nil) | |
943 ;; QRESYNC handling isn't implemented. | 951 ;; QRESYNC handling isn't implemented. |
944 (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object))) | 952 (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object))) |
945 marks groups sequences) | 953 params groups sequences active uidvalidity modseq group) |
946 ;; Go through the infos and gather the data needed to know | 954 ;; Go through the infos and gather the data needed to know |
947 ;; what and how to request the data. | 955 ;; what and how to request the data. |
948 (dolist (info infos) | 956 (dolist (info infos) |
949 (setq marks (gnus-info-marks info)) | 957 (setq params (gnus-info-params info) |
950 (push (list (gnus-group-real-name (gnus-info-group info)) | 958 group (gnus-group-real-name (gnus-info-group info)) |
951 (cdr (assq 'active marks)) | 959 active (cdr (assq 'active params)) |
952 (cdr (assq 'uid marks))) | 960 uidvalidity (cdr (assq 'uidvalidity params)) |
953 groups)) | 961 modseq (cdr (assq 'modseq params))) |
954 ;; Then request the data. | |
955 (erase-buffer) | |
956 (setf (nnimap-group nnimap-object) nil) | |
957 (dolist (elem groups) | |
958 (if (and qresyncp | 962 (if (and qresyncp |
959 (nth 2 elem)) | 963 uidvalidity |
964 modseq) | |
960 (push | 965 (push |
961 (list 'qresync | 966 (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" |
962 (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" | 967 group uidvalidity modseq) |
963 (car elem) | 968 'qresync |
964 (car (nth 2 elem)) | 969 nil group 'qresync) |
965 (cdr (nth 2 elem))) | |
966 nil | |
967 (car elem)) | |
968 sequences) | 970 sequences) |
969 (let ((start | 971 (let ((start |
970 (if (nth 1 elem) | 972 (if (and active uidvalidity) |
971 ;; Fetch the last 100 flags. | 973 ;; Fetch the last 100 flags. |
972 (max 1 (- (cdr (nth 1 elem)) 100)) | 974 (max 1 (- (cdr active) 100)) |
973 1))) | 975 1)) |
974 (push (list (nnimap-send-command "EXAMINE %S" (car elem)) | 976 (command |
977 (if uidvalidity | |
978 "EXAMINE" | |
979 ;; If we don't have a UIDVALIDITY, then this is | |
980 ;; the first time we've seen the group, so we | |
981 ;; have to do a SELECT (which is slower than an | |
982 ;; examine), but will tell us whether the group | |
983 ;; is read-only or not. | |
984 "SELECT"))) | |
985 (push (list (nnimap-send-command "%s %S" command group) | |
975 (nnimap-send-command "UID FETCH %d:* FLAGS" start) | 986 (nnimap-send-command "UID FETCH %d:* FLAGS" start) |
976 start | 987 start group command) |
977 (car elem)) | |
978 sequences))) | 988 sequences))) |
979 ;; Some servers apparently can't have many outstanding | 989 ;; Some servers apparently can't have many outstanding |
980 ;; commands, so throttle them. | 990 ;; commands, so throttle them. |
981 (when (and (not nnimap-streaming) | 991 (when (and (not nnimap-streaming) |
982 (car sequences)) | 992 (car sequences)) |
986 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) | 996 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) |
987 (when (and sequences | 997 (when (and sequences |
988 (nnimap-possibly-change-group nil server)) | 998 (nnimap-possibly-change-group nil server)) |
989 (with-current-buffer (nnimap-buffer) | 999 (with-current-buffer (nnimap-buffer) |
990 ;; Wait for the final data to trickle in. | 1000 ;; Wait for the final data to trickle in. |
991 (when (nnimap-wait-for-response (cadar sequences) t) | 1001 (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync) |
992 ;; Now we should have all the data we need, no matter whether | 1002 (caar sequences) |
993 ;; we're QRESYNCING, fetching all the flags from scratch, or | 1003 (cadar sequences)) |
994 ;; just fetching the last 100 flags per group. | 1004 t) |
1005 ;; Now we should have most of the data we need, no matter | |
1006 ;; whether we're QRESYNCING, fetching all the flags from | |
1007 ;; scratch, or just fetching the last 100 flags per group. | |
995 (nnimap-update-infos (nnimap-flags-to-marks | 1008 (nnimap-update-infos (nnimap-flags-to-marks |
996 (nnimap-parse-flags | 1009 (nnimap-parse-flags |
997 (nreverse sequences))) | 1010 (nreverse sequences))) |
998 infos) | 1011 infos) |
999 ;; Finally, just return something resembling an active file in | 1012 ;; Finally, just return something resembling an active file in |
1009 (cdr active) | 1022 (cdr active) |
1010 (car active))))))))))) | 1023 (car active))))))))))) |
1011 | 1024 |
1012 (defun nnimap-update-infos (flags infos) | 1025 (defun nnimap-update-infos (flags infos) |
1013 (dolist (info infos) | 1026 (dolist (info infos) |
1014 (let ((group (gnus-group-real-name (gnus-info-group info)))) | 1027 (let* ((group (gnus-group-real-name (gnus-info-group info))) |
1015 (nnimap-update-info info (cdr (assoc group flags)))))) | 1028 (marks (cdr (assoc group flags)))) |
1029 (when marks | |
1030 (nnimap-update-info info marks))))) | |
1016 | 1031 |
1017 (defun nnimap-update-info (info marks) | 1032 (defun nnimap-update-info (info marks) |
1018 (when (and marks | 1033 (destructuring-bind (existing flags high low uidnext start-article |
1019 ;; Ignore groups with no UIDNEXT/marks. This happens for | 1034 permanent-flags uidvalidity |
1020 ;; completely empty groups. | 1035 vanished highestmodseq) marks |
1021 (or (car marks) | 1036 (cond |
1022 (nth 4 marks))) | 1037 ;; Ignore groups with no UIDNEXT/marks. This happens for |
1023 (destructuring-bind (existing flags high low uidnext start-article | 1038 ;; completely empty groups. |
1024 permanent-flags) marks | 1039 ((and (not existing) |
1040 (not uidnext)) | |
1041 ) | |
1042 ;; We have a mismatch between the old and new UIDVALIDITY | |
1043 ;; identifiers, so we have to re-request the group info (the next | |
1044 ;; time). This virtually never happens. | |
1045 ((let ((old-uidvalidity | |
1046 (cdr (assq 'uidvalidity (gnus-info-params info))))) | |
1047 (and old-uidvalidity | |
1048 (not (equal old-uidvalidity uidvalidity)) | |
1049 (> start-article 1))) | |
1050 (gnus-group-remove-parameter info 'uidvalidity) | |
1051 (gnus-group-remove-parameter info 'modseq)) | |
1052 ;; We have the data needed to update. | |
1053 (t | |
1025 (let ((group (gnus-info-group info)) | 1054 (let ((group (gnus-info-group info)) |
1026 (completep (and start-article | 1055 (completep (and start-article |
1027 (= start-article 1)))) | 1056 (= start-article 1)))) |
1028 (when uidnext | 1057 (when uidnext |
1029 (setq high (1- uidnext))) | 1058 (setq high (1- uidnext))) |
1044 nil))) | 1073 nil))) |
1045 (gnus-set-active | 1074 (gnus-set-active |
1046 group | 1075 group |
1047 (cons (car (gnus-active group)) | 1076 (cons (car (gnus-active group)) |
1048 (or high (1- uidnext))))) | 1077 (or high (1- uidnext))))) |
1049 ;; Then update the list of read articles. | 1078 ;; See whether this is a read-only group. |
1050 (let* ((unread | 1079 (unless (eq permanent-flags 'not-scanned) |
1051 (gnus-compress-sequence | 1080 (gnus-group-set-parameter |
1052 (gnus-set-difference | 1081 info 'permanent-flags |
1053 (gnus-set-difference | 1082 (if (memq '%* permanent-flags) |
1054 existing | 1083 t |
1055 (cdr (assoc '%Seen flags))) | 1084 nil))) |
1056 (cdr (assoc '%Flagged flags))))) | 1085 ;; Update marks and read articles if this isn't a |
1057 (read (gnus-range-difference | 1086 ;; read-only IMAP group. |
1058 (cons start-article high) unread))) | 1087 (when (cdr (assq 'permanent-flags (gnus-info-params info))) |
1059 (when (> start-article 1) | 1088 (if (and highestmodseq |
1060 (setq read | 1089 (not start-article)) |
1061 (gnus-range-nconcat | 1090 ;; We've gotten the data by QRESYNCing. |
1062 (if (> start-article 1) | 1091 (nnimap-update-qresync-info |
1063 (gnus-sorted-range-intersection | 1092 info (nnimap-imap-ranges-to-gnus-ranges vanished) flags) |
1064 (cons 1 (1- start-article)) | 1093 ;; Do normal non-QRESYNC flag updates. |
1065 (gnus-info-read info)) | 1094 ;; Update the list of read articles. |
1066 (gnus-info-read info)) | 1095 (let* ((unread |
1067 read))) | 1096 (gnus-compress-sequence |
1068 (gnus-info-set-read info read) | 1097 (gnus-set-difference |
1069 ;; Update the marks. | 1098 (gnus-set-difference |
1070 (setq marks (gnus-info-marks info)) | 1099 existing |
1071 ;; Note the active level for the next run-through. | 1100 (cdr (assoc '%Seen flags))) |
1072 (let ((active (assq 'active marks))) | 1101 (cdr (assoc '%Flagged flags))))) |
1073 (if active | 1102 (read (gnus-range-difference |
1074 (setcdr active (gnus-active group)) | 1103 (cons start-article high) unread))) |
1075 (push (cons 'active (gnus-active group)) marks))) | 1104 (when (> start-article 1) |
1076 (dolist (type (cdr nnimap-mark-alist)) | 1105 (setq read |
1077 (let ((old-marks (assoc (car type) marks)) | 1106 (gnus-range-nconcat |
1078 (new-marks | 1107 (if (> start-article 1) |
1079 (gnus-compress-sequence | 1108 (gnus-sorted-range-intersection |
1080 (cdr (or (assoc (caddr type) flags) ; %Flagged | 1109 (cons 1 (1- start-article)) |
1081 (assoc (intern (cadr type) obarray) flags) | 1110 (gnus-info-read info)) |
1082 (assoc (cadr type) flags)))))) ; "\Flagged" | 1111 (gnus-info-read info)) |
1083 (setq marks (delq old-marks marks)) | 1112 read))) |
1084 (pop old-marks) | 1113 (gnus-info-set-read info read) |
1085 (when (and old-marks | 1114 ;; Update the marks. |
1086 (> start-article 1)) | 1115 (setq marks (gnus-info-marks info)) |
1087 (setq old-marks (gnus-range-difference | 1116 (dolist (type (cdr nnimap-mark-alist)) |
1088 old-marks | 1117 (let ((old-marks (assoc (car type) marks)) |
1089 (cons start-article high))) | 1118 (new-marks |
1090 (setq new-marks (gnus-range-nconcat old-marks new-marks))) | 1119 (gnus-compress-sequence |
1091 (when new-marks | 1120 (cdr (or (assoc (caddr type) flags) ; %Flagged |
1092 (push (cons (car type) new-marks) marks))) | 1121 (assoc (intern (cadr type) obarray) flags) |
1093 (gnus-info-set-marks info marks t) | 1122 (assoc (cadr type) flags)))))) ; "\Flagged" |
1094 (nnimap-store-info info (gnus-active group)))))))) | 1123 (setq marks (delq old-marks marks)) |
1124 (pop old-marks) | |
1125 (when (and old-marks | |
1126 (> start-article 1)) | |
1127 (setq old-marks (gnus-range-difference | |
1128 old-marks | |
1129 (cons start-article high))) | |
1130 (setq new-marks (gnus-range-nconcat old-marks new-marks))) | |
1131 (when new-marks | |
1132 (push (cons (car type) new-marks) marks))) | |
1133 (gnus-info-set-marks info marks t))))) | |
1134 ;; Note the active level for the next run-through. | |
1135 (gnus-group-set-parameter info 'active (gnus-active group)) | |
1136 (gnus-group-set-parameter info 'uidvalidity uidvalidity) | |
1137 (gnus-group-set-parameter info 'modseq highestmodseq) | |
1138 (nnimap-store-info info (gnus-active group))))))) | |
1139 | |
1140 (defun nnimap-update-qresync-info (info vanished flags) | |
1141 ;; Add all the vanished articles to the list of read articles. | |
1142 (gnus-info-set-read | |
1143 info | |
1144 (gnus-range-add (gnus-info-read info) | |
1145 vanished)) | |
1146 ) | |
1147 | |
1148 (defun nnimap-imap-ranges-to-gnus-ranges (irange) | |
1149 (if (zerop (length irange)) | |
1150 nil | |
1151 (let ((result nil)) | |
1152 (dolist (elem (split-string irange ",")) | |
1153 (push | |
1154 (if (string-match ":" elem) | |
1155 (let ((numbers (split-string elem ":"))) | |
1156 (cons (string-to-number (car numbers)) | |
1157 (string-to-number (cadr numbers)))) | |
1158 (string-to-number elem)) | |
1159 result)) | |
1160 (nreverse result)))) | |
1095 | 1161 |
1096 (defun nnimap-store-info (info active) | 1162 (defun nnimap-store-info (info active) |
1097 (let* ((group (gnus-group-real-name (gnus-info-group info))) | 1163 (let* ((group (gnus-group-real-name (gnus-info-group info))) |
1098 (entry (assoc group nnimap-current-infos))) | 1164 (entry (assoc group nnimap-current-infos))) |
1099 (if entry | 1165 (if entry |
1100 (setcdr entry (list info active)) | 1166 (setcdr entry (list info active)) |
1101 (push (list group info active) nnimap-current-infos)))) | 1167 (push (list group info active) nnimap-current-infos)))) |
1102 | 1168 |
1103 (defun nnimap-flags-to-marks (groups) | 1169 (defun nnimap-flags-to-marks (groups) |
1104 (let (data group totalp uidnext articles start-article mark permanent-flags) | 1170 (let (data group totalp uidnext articles start-article mark permanent-flags |
1171 uidvalidity vanished highestmodseq) | |
1105 (dolist (elem groups) | 1172 (dolist (elem groups) |
1106 (setq group (car elem) | 1173 (setq group (car elem) |
1107 uidnext (nth 1 elem) | 1174 uidnext (nth 1 elem) |
1108 start-article (nth 2 elem) | 1175 start-article (nth 2 elem) |
1109 permanent-flags (nth 3 elem) | 1176 permanent-flags (nth 3 elem) |
1110 articles (nthcdr 4 elem)) | 1177 uidvalidity (nth 4 elem) |
1178 vanished (nth 5 elem) | |
1179 highestmodseq (nth 6 elem) | |
1180 articles (nthcdr 7 elem)) | |
1111 (let ((high (caar articles)) | 1181 (let ((high (caar articles)) |
1112 marks low existing) | 1182 marks low existing) |
1113 (dolist (article articles) | 1183 (dolist (article articles) |
1114 (setq low (car article)) | 1184 (setq low (car article)) |
1115 (push (car article) existing) | 1185 (push (car article) existing) |
1117 (setq mark (assoc flag marks)) | 1187 (setq mark (assoc flag marks)) |
1118 (if (not mark) | 1188 (if (not mark) |
1119 (push (list flag (car article)) marks) | 1189 (push (list flag (car article)) marks) |
1120 (setcdr mark (cons (car article) (cdr mark)))))) | 1190 (setcdr mark (cons (car article) (cdr mark)))))) |
1121 (push (list group existing marks high low uidnext start-article | 1191 (push (list group existing marks high low uidnext start-article |
1122 permanent-flags) | 1192 permanent-flags uidvalidity vanished highestmodseq) |
1123 data))) | 1193 data))) |
1124 data)) | 1194 data)) |
1125 | 1195 |
1126 (defun nnimap-parse-flags (sequences) | 1196 (defun nnimap-parse-flags (sequences) |
1127 (goto-char (point-min)) | 1197 (goto-char (point-min)) |
1128 ;; Change \Delete etc to %Delete, so that the reader can read it. | 1198 ;; Change \Delete etc to %Delete, so that the reader can read it. |
1129 (subst-char-in-region (point-min) (point-max) | 1199 (subst-char-in-region (point-min) (point-max) |
1130 ?\\ ?% t) | 1200 ?\\ ?% t) |
1131 (let (start end articles groups uidnext elems permanent-flags) | 1201 (let (start end articles groups uidnext elems permanent-flags |
1202 uidvalidity vanished highestmodseq) | |
1132 (dolist (elem sequences) | 1203 (dolist (elem sequences) |
1133 (destructuring-bind (group-sequence flag-sequence totalp group) elem | 1204 (destructuring-bind (group-sequence flag-sequence totalp group command) |
1205 elem | |
1134 (setq start (point)) | 1206 (setq start (point)) |
1135 ;; The EXAMINE was successful. | 1207 (when (and |
1136 (when (and (search-forward (format "\n%d OK " group-sequence) nil t) | 1208 ;; The EXAMINE was successful. |
1137 (progn | 1209 (search-forward (format "\n%d OK " group-sequence) nil t) |
1138 (forward-line 1) | 1210 (progn |
1139 (setq end (point)) | 1211 (forward-line 1) |
1140 (goto-char start) | 1212 (setq end (point)) |
1141 (setq permanent-flags | 1213 (goto-char start) |
1214 (setq permanent-flags | |
1215 (if (equal command "SELECT") | |
1142 (and (search-forward "PERMANENTFLAGS " | 1216 (and (search-forward "PERMANENTFLAGS " |
1143 (or end (point-min)) t) | 1217 (or end (point-min)) t) |
1144 (read (current-buffer)))) | 1218 (read (current-buffer))) |
1145 (goto-char start) | 1219 'not-scanned)) |
1146 (setq uidnext | 1220 (goto-char start) |
1147 (and (search-forward "UIDNEXT " | 1221 (setq uidnext |
1148 (or end (point-min)) t) | 1222 (and (search-forward "UIDNEXT " |
1149 (read (current-buffer)))) | 1223 (or end (point-min)) t) |
1150 (goto-char end) | 1224 (read (current-buffer)))) |
1151 (forward-line -1)) | 1225 (goto-char start) |
1152 ;; The UID FETCH FLAGS was successful. | 1226 (setq uidvalidity |
1153 (search-forward (format "\n%d OK " flag-sequence) nil t)) | 1227 (and (re-search-forward "UIDVALIDITY \\([0-9]+\\)" |
1154 (setq start (point)) | 1228 (or end (point-min)) t) |
1155 (goto-char end) | 1229 ;; Store UIDVALIDITY as a string, as it's |
1230 ;; too big for 32-bit Emacsen, usually. | |
1231 (match-string 1))) | |
1232 (goto-char start) | |
1233 (setq vanished | |
1234 (and (eq flag-sequence 'qresync) | |
1235 (re-search-forward "VANISHED.* \\([0-9:,]+\\)" | |
1236 (or end (point-min)) t) | |
1237 (match-string 1))) | |
1238 (goto-char start) | |
1239 (setq highestmodseq | |
1240 (and (search-forward "HIGHESTMODSEQ " | |
1241 (or end (point-min)) t) | |
1242 (read (current-buffer)))) | |
1243 (goto-char end) | |
1244 (forward-line -1)) | |
1245 ;; The UID FETCH FLAGS was successful. | |
1246 (or (eq flag-sequence 'qresync) | |
1247 (search-forward (format "\n%d OK " flag-sequence) nil t))) | |
1248 (if (eq flag-sequence 'qresync) | |
1249 (progn | |
1250 (goto-char start) | |
1251 (setq start end)) | |
1252 (setq start (point)) | |
1253 (goto-char end)) | |
1156 (while (search-forward " FETCH " start t) | 1254 (while (search-forward " FETCH " start t) |
1157 (setq elems (read (current-buffer))) | 1255 (setq elems (read (current-buffer))) |
1158 (push (cons (cadr (memq 'UID elems)) | 1256 (push (cons (cadr (memq 'UID elems)) |
1159 (cadr (memq 'FLAGS elems))) | 1257 (cadr (memq 'FLAGS elems))) |
1160 articles)) | 1258 articles)) |
1161 (push (nconc (list group uidnext totalp permanent-flags) articles) | 1259 (push (nconc (list group uidnext totalp permanent-flags uidvalidity |
1260 vanished highestmodseq) | |
1261 articles) | |
1162 groups) | 1262 groups) |
1263 (goto-char end) | |
1163 (setq articles nil)))) | 1264 (setq articles nil)))) |
1164 groups)) | 1265 groups)) |
1165 | 1266 |
1166 (defun nnimap-find-process-buffer (buffer) | 1267 (defun nnimap-find-process-buffer (buffer) |
1167 (cadr (assoc buffer nnimap-connection-alist))) | 1268 (cadr (assoc buffer nnimap-connection-alist))) |
1291 (if (eql (setq char (following-char)) ? ) | 1392 (if (eql (setq char (following-char)) ? ) |
1292 (forward-char 1) | 1393 (forward-char 1) |
1293 (push | 1394 (push |
1294 (cond | 1395 (cond |
1295 ((eql char ?\[) | 1396 ((eql char ?\[) |
1296 (split-string (buffer-substring | 1397 (split-string |
1297 (1+ (point)) | 1398 (buffer-substring |
1298 (1- (search-forward "]" (line-end-position) 'move))))) | 1399 (1+ (point)) |
1400 (1- (search-forward "]" (line-end-position) 'move))))) | |
1299 ((eql char ?\() | 1401 ((eql char ?\() |
1300 (split-string (buffer-substring | 1402 (split-string |
1301 (1+ (point)) | 1403 (buffer-substring |
1302 (1- (search-forward ")" (line-end-position) 'move))))) | 1404 (1+ (point)) |
1405 (1- (search-forward ")" (line-end-position) 'move))))) | |
1303 ((eql char ?\") | 1406 ((eql char ?\") |
1304 (forward-char 1) | 1407 (forward-char 1) |
1305 (buffer-substring | 1408 (buffer-substring |
1306 (point) | 1409 (point) |
1307 (1- (or (search-forward "\"" (line-end-position) 'move) | 1410 (1- (or (search-forward "\"" (line-end-position) 'move) |