aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGnus developers2012-11-02 23:37:02 +0000
committerKatsumi Yamaoka2012-11-02 23:37:02 +0000
commita71e2379a331e430f774fc16645f460f1de2b4a0 (patch)
treeead84ee93d53a139674be60ee09b2aa4f41e9347
parent00a3b041730e178fe68850b76ac4216af62ea606 (diff)
downloademacs-a71e2379a331e430f774fc16645f460f1de2b4a0.tar.gz
emacs-a71e2379a331e430f774fc16645f460f1de2b4a0.zip
Merge changes made in Gnus master
2012-10-05 Katsumi Yamaoka <yamaoka@jpl.org> * gnus.texi (Mail Source Specifiers): Document :leave keyword used for pop mail source. 2012-10-25 Tassilo Horn <tsdh@gnu.org> * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer by default. Patch provided by Stephen Eglen. 2012-10-05 Katsumi Yamaoka <yamaoka@jpl.org> New UIDL implementation. * mail-source.el (mail-sources, mail-source-keyword-map): Add :leave as a pop3 keyword. (mail-source-fetch-pop): Bind pop3-leave-mail-on-server. * pop3.el (pop3-leave-mail-on-server): Allow number. (pop3-uidl-file, pop3-uidl-file-backup): New user options. (pop3-movemail): Add UIDL support. (pop3-send-streaming-command): Take a list of mail numbers instead of the number of mails. (pop3-write-to-file): Add X-UIDL header. (pop3-uidl-stat, pop3-uidl-dele, pop3-uidl-load, pop3-uidl-save) (pop3-uidl-add-xheader): New functions. * message.el (message-ignored-resent-headers): Add X-Content-Length and X-UIDL headers.
-rw-r--r--doc/misc/ChangeLog5
-rw-r--r--doc/misc/gnus.texi41
-rw-r--r--lisp/gnus/ChangeLog25
-rw-r--r--lisp/gnus/gnus-dired.el4
-rw-r--r--lisp/gnus/mail-source.el21
-rw-r--r--lisp/gnus/message.el4
-rw-r--r--lisp/gnus/pop3.el314
7 files changed, 368 insertions, 46 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index d719a02e32e..768a846bd1a 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
12012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus.texi (Mail Source Specifiers):
4 Document :leave keyword used for pop mail source.
5
12012-11-01 Glenn Morris <rgm@gnu.org> 62012-11-01 Glenn Morris <rgm@gnu.org>
2 7
3 * cl.texi: General copyedits for style, line-breaks, etc. 8 * cl.texi: General copyedits for style, line-breaks, etc.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index a9cd0d3567c..47ff355d946 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -14759,20 +14759,37 @@ This can be either the symbol @code{password} or the symbol @code{apop}
14759and says what authentication scheme to use. The default is 14759and says what authentication scheme to use. The default is
14760@code{password}. 14760@code{password}.
14761 14761
14762@item :leave
14763Non-@code{nil} if the mail is to be left on the @acronym{POP} server
14764after fetching. Mails once fetched will never be fetched again by the
14765@acronym{UIDL} control. Only the built-in @code{pop3-movemail} program
14766(the default) supports this keyword.
14767
14768If this is neither @code{nil} nor a number, all mails will be left on
14769the server. If this is a number, leave mails on the server for this
14770many days since you first checked new mails. If this is @code{nil}
14771(the default), mails will be deleted on the server right after fetching.
14772
14773@vindex pop3-uidl-file
14774The @code{pop3-uidl-file} variable specifies the file to which the
14775@acronym{UIDL} data are locally stored. The default value is
14776@file{~/.pop3-uidl}.
14777
14778Note that @acronym{POP} servers maintain no state information between
14779sessions, so what the client believes is there and what is actually
14780there may not match up. If they do not, then you may get duplicate
14781mails or the whole thing can fall apart and leave you with a corrupt
14782mailbox.
14783
14762@end table 14784@end table
14763 14785
14764@vindex pop3-movemail 14786@findex pop3-movemail
14765@vindex pop3-leave-mail-on-server 14787@vindex pop3-leave-mail-on-server
14766If the @code{:program} and @code{:function} keywords aren't specified, 14788If the @code{:program} and @code{:function} keywords aren't specified,
14767@code{pop3-movemail} will be used. If @code{pop3-leave-mail-on-server} 14789@code{pop3-movemail} will be used.
14768is non-@code{nil} the mail is to be left on the @acronym{POP} server
14769after fetching when using @code{pop3-movemail}. Note that POP servers
14770maintain no state information between sessions, so what the client
14771believes is there and what is actually there may not match up. If they
14772do not, then you may get duplicate mails or the whole thing can fall
14773apart and leave you with a corrupt mailbox.
14774 14790
14775Here are some examples for getting mail from a @acronym{POP} server. 14791Here are some examples for getting mail from a @acronym{POP} server.
14792
14776Fetch from the default @acronym{POP} server, using the default user 14793Fetch from the default @acronym{POP} server, using the default user
14777name, and default fetcher: 14794name, and default fetcher:
14778 14795
@@ -14787,6 +14804,14 @@ Fetch from a named server with a named user and password:
14787 :user "user-name" :password "secret") 14804 :user "user-name" :password "secret")
14788@end lisp 14805@end lisp
14789 14806
14807Leave mails on the server for 14 days:
14808
14809@lisp
14810(pop :server "my.pop.server"
14811 :user "user-name" :password "secret"
14812 :leave 14)
14813@end lisp
14814
14790Use @samp{movemail} to move the mail: 14815Use @samp{movemail} to move the mail:
14791 14816
14792@lisp 14817@lisp
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8cb53de85fa..a2bb0a88baa 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,28 @@
12012-11-02 Tassilo Horn <tsdh@gnu.org>
2
3 * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer
4 by default. Patch provided by Stephen Eglen.
5
62012-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
7
8 New UIDL implementation.
9
10 * mail-source.el (mail-sources, mail-source-keyword-map):
11 Add :leave as a pop3 keyword.
12 (mail-source-fetch-pop): Bind pop3-leave-mail-on-server.
13
14 * pop3.el (pop3-leave-mail-on-server): Allow number.
15 (pop3-uidl-file, pop3-uidl-file-backup): New user options.
16 (pop3-movemail): Add UIDL support.
17 (pop3-send-streaming-command): Take a list of mail numbers instead of
18 the number of mails.
19 (pop3-write-to-file): Add X-UIDL header.
20 (pop3-uidl-stat, pop3-uidl-dele, pop3-uidl-load, pop3-uidl-save)
21 (pop3-uidl-add-xheader): New functions.
22
23 * message.el (message-ignored-resent-headers):
24 Add X-Content-Length and X-UIDL headers.
25
12012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> 262012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
2 27
3 * nndiary.el (nndiary-request-create-group-functions) 28 * nndiary.el (nndiary-request-create-group-functions)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index d341cea34bb..e15a6c732b5 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -155,8 +155,8 @@ filenames."
155 (setq destination 155 (setq destination
156 (if (= (length bufs) 1) 156 (if (= (length bufs) 1)
157 (get-buffer (car bufs)) 157 (get-buffer (car bufs))
158 (gnus-completing-read "Attach to which mail composition buffer" 158 (gnus-completing-read "Attach to buffer"
159 bufs t))) 159 bufs t nil nil (car bufs))))
160 ;; setup a new mail composition buffer 160 ;; setup a new mail composition buffer
161 (let ((mail-user-agent gnus-dired-mail-mode) 161 (let ((mail-user-agent gnus-dired-mail-mode)
162 ;; A workaround to prevent Gnus from displaying the Gnus 162 ;; A workaround to prevent Gnus from displaying the Gnus
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index ad66fecc427..fc66414a9f0 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -63,7 +63,7 @@
63This variable is a list of mail source specifiers. 63This variable is a list of mail source specifiers.
64See Info node `(gnus)Mail Source Specifiers'." 64See Info node `(gnus)Mail Source Specifiers'."
65 :group 'mail-source 65 :group 'mail-source
66 :version "23.1" ;; No Gnus 66 :version "24.4"
67 :link '(custom-manual "(gnus)Mail Source Specifiers") 67 :link '(custom-manual "(gnus)Mail Source Specifiers")
68 :type `(choice 68 :type `(choice
69 (const :tag "None" nil) 69 (const :tag "None" nil)
@@ -159,7 +159,18 @@ See Info node `(gnus)Mail Source Specifiers'."
159 :value nil 159 :value nil
160 (const :tag "Clear" nil) 160 (const :tag "Clear" nil)
161 (const starttls) 161 (const starttls)
162 (const :tag "SSL/TLS" ssl))))) 162 (const :tag "SSL/TLS" ssl)))
163 (group :inline t
164 (const :format "" :value :leave)
165 (choice :format "\
166%{Leave mail on server%}:\n\t\t%[Value Menu%] %v"
167 :value nil
168 (const :tag "\
169Don't leave mails" nil)
170 (const :tag "\
171Leave all mails" t)
172 (number :tag "\
173Leave mails for this many days" :value 14)))))
163 (cons :tag "Maildir (qmail, postfix...)" 174 (cons :tag "Maildir (qmail, postfix...)"
164 (const :format "" maildir) 175 (const :format "" maildir)
165 (checklist :tag "Options" :greedy t 176 (checklist :tag "Options" :greedy t
@@ -340,7 +351,8 @@ Common keywords should be listed here.")
340 (:function) 351 (:function)
341 (:password) 352 (:password)
342 (:authentication password) 353 (:authentication password)
343 (:stream nil)) 354 (:stream nil)
355 (:leave))
344 (maildir 356 (maildir
345 (:path (or (getenv "MAILDIR") "~/Maildir/")) 357 (:path (or (getenv "MAILDIR") "~/Maildir/"))
346 (:subdirs ("cur" "new")) 358 (:subdirs ("cur" "new"))
@@ -825,7 +837,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
825 (pop3-port port) 837 (pop3-port port)
826 (pop3-authentication-scheme 838 (pop3-authentication-scheme
827 (if (eq authentication 'apop) 'apop 'pass)) 839 (if (eq authentication 'apop) 'apop 'pass))
828 (pop3-stream-type stream)) 840 (pop3-stream-type stream)
841 (pop3-leave-mail-on-server leave))
829 (if (or debug-on-quit debug-on-error) 842 (if (or debug-on-quit debug-on-error)
830 (save-excursion (pop3-movemail mail-source-crash-box)) 843 (save-excursion (pop3-movemail mail-source-crash-box))
831 (condition-case err 844 (condition-case err
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 5360f008432..8905acb9d1f 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -592,8 +592,10 @@ Done before generating the new subject of a forward."
592 ;; comes back to you (e.g. a mailing-list to which you subscribe, in which 592 ;; comes back to you (e.g. a mailing-list to which you subscribe, in which
593 ;; case you may be removed from the list on the grounds that mail to you 593 ;; case you may be removed from the list on the grounds that mail to you
594 ;; bounced with a "mailing loop" error). 594 ;; bounced with a "mailing loop" error).
595 "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:" 595 "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\
596\\|^X-Content-Length:\\|^X-UIDL:"
596 "*All headers that match this regexp will be deleted when resending a message." 597 "*All headers that match this regexp will be deleted when resending a message."
598 :version "24.4"
597 :group 'message-interface 599 :group 'message-interface
598 :link '(custom-manual "(message)Resending") 600 :link '(custom-manual "(message)Resending")
599 :type '(repeat :value-to-internal (lambda (widget value) 601 :type '(repeat :value-to-internal (lambda (widget value)
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 25330989e00..f95bf26ad1d 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -98,20 +98,53 @@ set this to 1."
98 :group 'pop3) 98 :group 'pop3)
99 99
100(defcustom pop3-leave-mail-on-server nil 100(defcustom pop3-leave-mail-on-server nil
101 "*Non-nil if the mail is to be left on the POP server after fetching. 101 "Non-nil if the mail is to be left on the POP server after fetching.
102 102Mails once fetched will never be fetched again by the UIDL control.
103If `pop3-leave-mail-on-server' is non-nil the mail is to be left 103
104on the POP server after fetching. Note that POP servers maintain 104If this is neither nil nor a number, all mails will be left on the
105no state information between sessions, so what the client 105server. If this is a number, leave mails on the server for this many
106believes is there and what is actually there may not match up. 106days since you first checked new mails. If this is nil, mails will be
107If they do not, then you may get duplicate mails or the whole 107deleted on the server right after fetching.
108thing can fall apart and leave you with a corrupt mailbox." 108
109 ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org: 109Gnus users should use the `:leave' keyword in a mail source to direct
110 ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de 110the behaviour per server, rather than directly modifying this value.
111 ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org 111
112 ;; Any volunteer to re-implement this? 112Note that POP servers maintain no state information between sessions,
113 :version "22.1" ;; Oort Gnus 113so what the client believes is there and what is actually there may
114 :type 'boolean 114not match up. If they do not, then you may get duplicate mails or
115the whole thing can fall apart and leave you with a corrupt mailbox."
116 :version "24.4"
117 :type '(choice (const :tag "Don't leave mails" nil)
118 (const :tag "Leave all mails" t)
119 (number :tag "Leave mails for this many days" :value 14))
120 :group 'pop3)
121
122(defcustom pop3-uidl-file "~/.pop3-uidl"
123 "File used to save UIDL."
124 :version "24.4"
125 :type 'file
126 :group 'pop3)
127
128(defcustom pop3-uidl-file-backup '(0 9)
129 "How to backup the UIDL file `pop3-uidl-file' when updating.
130If it is a list of numbers, the first one binds `kept-old-versions' and
131the other binds `kept-new-versions' to keep number of oldest and newest
132versions. Otherwise, the value binds `version-control' (which see).
133
134Note: Backup will take place whenever you check new mails on a server.
135So, you may lose the backup files having been saved before a trouble
136if you set it so as to make too few backups whereas you have access to
137many servers."
138 :version "24.4"
139 :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3
140 (number :tag "oldest")
141 (number :tag "newest"))
142 (sexp :format "%v"
143 :match (lambda (widget value)
144 (condition-case nil
145 (not (and (numberp (car value))
146 (numberp (car (cdr value)))))
147 (error t)))))
115 :group 'pop3) 148 :group 'pop3)
116 149
117(defvar pop3-timestamp nil 150(defvar pop3-timestamp nil
@@ -144,34 +177,66 @@ Shorter values mean quicker response, but are more CPU intensive.")
144 (truncate pop3-read-timeout)) 177 (truncate pop3-read-timeout))
145 1000)))))) 178 1000))))))
146 179
180(defvar pop3-uidl)
181;; List of UIDLs of existing messages at pesent in the server:
182;; ("UIDL1" "UIDL2" "UIDL3"...)
183
184(defvar pop3-uidl-saved)
185;; Locally saved UIDL data; an alist of the server, the user, and the UIDL
186;; and timestamp pairs:
187;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
188;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
189;; ...)
190;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
191;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
192;; ...))
193;; Where TIMESTAMP is the most significant two digits of an Emacs time,
194;; i.e. the return value of `current-time'.
195
147;;;###autoload 196;;;###autoload
148(defun pop3-movemail (file) 197(defun pop3-movemail (file)
149 "Transfer contents of a maildrop to the specified FILE. 198 "Transfer contents of a maildrop to the specified FILE.
150Use streaming commands." 199Use streaming commands."
151 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 200 (let ((process (pop3-open-server pop3-mailhost pop3-port))
152 message-count message-total-size) 201 messages total-size
202 pop3-uidl
203 pop3-uidl-saved)
153 (pop3-logon process) 204 (pop3-logon process)
154 (with-current-buffer (process-buffer process) 205 (if pop3-leave-mail-on-server
206 (setq messages (pop3-uidl-stat process)
207 total-size (cadr messages)
208 messages (car messages))
155 (let ((size (pop3-stat process))) 209 (let ((size (pop3-stat process)))
156 (setq message-count (car size) 210 (dotimes (i (car size)) (push (1+ i) messages))
157 message-total-size (cadr size))) 211 (setq messages (nreverse messages)
158 (when (> message-count 0) 212 total-size (cadr size))))
159 (pop3-send-streaming-command 213 (when messages
160 process "RETR" message-count message-total-size) 214 (with-current-buffer (process-buffer process)
161 (pop3-write-to-file file) 215 (pop3-send-streaming-command process "RETR" messages total-size)
216 (pop3-write-to-file file messages)
162 (unless pop3-leave-mail-on-server 217 (unless pop3-leave-mail-on-server
163 (pop3-send-streaming-command 218 (pop3-send-streaming-command process "DELE" messages nil))))
164 process "DELE" message-count nil)))) 219 (if pop3-leave-mail-on-server
165 (pop3-quit process) 220 (when (prog1 (pop3-uidl-dele process) (pop3-quit process))
221 (pop3-uidl-save))
222 (pop3-quit process)
223 ;; Remove UIDL data for the account that got not to leave mails.
224 (setq pop3-uidl-saved (pop3-uidl-load))
225 (let ((elt (assoc pop3-maildrop
226 (cdr (assoc pop3-mailhost pop3-uidl-saved)))))
227 (when elt
228 (setcdr elt nil)
229 (pop3-uidl-save))))
166 t)) 230 t))
167 231
168(defun pop3-send-streaming-command (process command count total-size) 232(defun pop3-send-streaming-command (process command messages total-size)
169 (erase-buffer) 233 (erase-buffer)
170 (let ((i 1) 234 (let ((count (length messages))
235 (i 1)
171 (start-point (point-min)) 236 (start-point (point-min))
172 (waited-for 0)) 237 (waited-for 0))
173 (while (>= count i) 238 (while messages
174 (process-send-string process (format "%s %d\r\n" command i)) 239 (process-send-string process (format "%s %d\r\n" command (pop messages)))
175 ;; Only do 100 messages at a time to avoid pipe stalls. 240 ;; Only do 100 messages at a time to avoid pipe stalls.
176 (when (zerop (% i pop3-stream-length)) 241 (when (zerop (% i pop3-stream-length))
177 (setq start-point 242 (setq start-point
@@ -207,7 +272,7 @@ Use streaming commands."
207 (pop3-accept-process-output process)) 272 (pop3-accept-process-output process))
208 start-point) 273 start-point)
209 274
210(defun pop3-write-to-file (file) 275(defun pop3-write-to-file (file messages)
211 (let ((pop-buffer (current-buffer)) 276 (let ((pop-buffer (current-buffer))
212 (start (point-min)) 277 (start (point-min))
213 beg end 278 beg end
@@ -230,6 +295,8 @@ Use streaming commands."
230 (pop3-clean-region hstart (point)) 295 (pop3-clean-region hstart (point))
231 (goto-char (point-max)) 296 (goto-char (point-max))
232 (pop3-munge-message-separator hstart (point)) 297 (pop3-munge-message-separator hstart (point))
298 (when pop3-leave-mail-on-server
299 (pop3-uidl-add-xheader hstart (pop messages)))
233 (goto-char (point-max)))))) 300 (goto-char (point-max))))))
234 (let ((coding-system-for-write 'binary)) 301 (let ((coding-system-for-write 'binary))
235 (goto-char (point-min)) 302 (goto-char (point-min))
@@ -275,6 +342,184 @@ Use streaming commands."
275 (pop3-quit process) 342 (pop3-quit process)
276 message-count)) 343 message-count))
277 344
345(defun pop3-uidl-stat (process)
346 "Return a list of unread message numbers and total size."
347 (pop3-send-command process "UIDL")
348 (let (err messages size)
349 (if (condition-case code
350 (progn
351 (pop3-read-response process)
352 t)
353 (error (setq err (error-message-string code))
354 nil))
355 (let ((start pop3-read-point)
356 saved list)
357 (with-current-buffer (process-buffer process)
358 (while (not (re-search-forward "^\\.\r\n" nil t))
359 (unless (memq (process-status process) '(open run))
360 (error "pop3 server closed the connection"))
361 (pop3-accept-process-output process)
362 (goto-char start))
363 (setq pop3-read-point (point-marker)
364 pop3-uidl nil)
365 (while (progn (forward-line -1) (>= (point) start))
366 (when (looking-at "[0-9]+ \\([^\n\r ]+\\)")
367 (push (match-string 1) pop3-uidl)))
368 (when pop3-uidl
369 (setq pop3-uidl-saved (pop3-uidl-load)
370 saved (cdr (assoc pop3-maildrop
371 (cdr (assoc pop3-mailhost
372 pop3-uidl-saved)))))
373 (let ((i (length pop3-uidl)))
374 (while (> i 0)
375 (unless (member (nth (1- i) pop3-uidl) saved)
376 (push i messages))
377 (decf i)))
378 (when messages
379 (setq list (pop3-list process)
380 size 0)
381 (dolist (msg messages)
382 (setq size (+ size (cdr (assq msg list)))))
383 (list messages size)))))
384 (message "%s doesn't support UIDL (%s), so we try a regressive way..."
385 pop3-mailhost err)
386 (sit-for 1)
387 (setq size (pop3-stat process))
388 (dotimes (i (car size)) (push (1+ i) messages))
389 (setcar size (nreverse messages))
390 size)))
391
392(defun pop3-uidl-dele (process)
393 "Delete messages according to `pop3-leave-mail-on-server'.
394Return non-nil if it is necessary to update the local UIDL file."
395 (let* ((ctime (current-time))
396 (srvr (assoc pop3-mailhost pop3-uidl-saved))
397 (saved (assoc pop3-maildrop (cdr srvr)))
398 i uidl mod new tstamp dele)
399 (setcdr (cdr ctime) nil)
400 ;; Add new messages to the data to be saved.
401 (cond ((and pop3-uidl saved)
402 (setq i (1- (length pop3-uidl)))
403 (while (>= i 0)
404 (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved))
405 (push ctime new)
406 (push uidl new))
407 (decf i)))
408 (pop3-uidl
409 (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime))
410 pop3-uidl)))))
411 (when new (setq mod t))
412 ;; List expirable messages and delete them from the data to be saved.
413 (setq ctime (when (numberp pop3-leave-mail-on-server)
414 (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400))
415 i (1- (length saved)))
416 (while (> i 0)
417 (if (member (setq uidl (nth (1- i) saved)) pop3-uidl)
418 (progn
419 (setq tstamp (nth i saved))
420 (if (and ctime
421 (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp))
422 86400))
423 pop3-leave-mail-on-server))
424 ;; Mails to delete.
425 (progn
426 (setq mod t)
427 (push uidl dele))
428 ;; Mails to keep.
429 (push tstamp new)
430 (push uidl new)))
431 ;; Mails having been deleted in the server.
432 (setq mod t))
433 (decf i 2))
434 (cond (saved
435 (setcdr saved new))
436 (srvr
437 (setcdr (last srvr) (list (cons pop3-maildrop new))))
438 (t
439 (add-to-list 'pop3-uidl-saved
440 (list pop3-mailhost (cons pop3-maildrop new))
441 t)))
442 ;; Actually delete the messages in the server.
443 (when dele
444 (setq uidl nil
445 i (length pop3-uidl))
446 (while (> i 0)
447 (when (member (nth (1- i) pop3-uidl) dele)
448 (push i uidl))
449 (decf i))
450 (when uidl
451 (pop3-send-streaming-command process "DELE" uidl nil)))
452 mod))
453
454(defun pop3-uidl-load ()
455 "Load saved UIDL."
456 (when (file-exists-p pop3-uidl-file)
457 (with-temp-buffer
458 (condition-case code
459 (progn
460 (insert-file-contents pop3-uidl-file)
461 (goto-char (point-min))
462 (read (current-buffer)))
463 (error
464 (message "Error while loading %s (%s)"
465 pop3-uidl-file (error-message-string code))
466 (sit-for 1)
467 nil)))))
468
469(defun pop3-uidl-save ()
470 "Save UIDL."
471 (with-temp-buffer
472 (if pop3-uidl-saved
473 (progn
474 (insert "(")
475 (dolist (srvr pop3-uidl-saved)
476 (when (cdr srvr)
477 (insert "(\"" (pop srvr) "\"\n ")
478 (dolist (elt srvr)
479 (when (cdr elt)
480 (insert "(\"" (pop elt) "\"\n ")
481 (while elt
482 (insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
483 (delete-char -4)
484 (insert ")\n ")))
485 (delete-char -3)
486 (if (eq (char-before) ?\))
487 (insert ")\n ")
488 (goto-char (1+ (point-at-bol)))
489 (delete-region (point) (point-max)))))
490 (when (eq (char-before) ? )
491 (delete-char -2))
492 (insert ")\n"))
493 (insert "()\n"))
494 (let ((buffer-file-name pop3-uidl-file)
495 (delete-old-versions t)
496 (kept-new-versions kept-new-versions)
497 (kept-old-versions kept-old-versions)
498 (version-control version-control))
499 (if (consp pop3-uidl-file-backup)
500 (setq kept-new-versions (cadr pop3-uidl-file-backup)
501 kept-old-versions (car pop3-uidl-file-backup)
502 version-control t)
503 (setq version-control pop3-uidl-file-backup))
504 (save-buffer))))
505
506(defun pop3-uidl-add-xheader (start msgno)
507 "Add X-UIDL header."
508 (let ((case-fold-search t))
509 (save-restriction
510 (narrow-to-region start (progn
511 (goto-char start)
512 (search-forward "\n\n" nil 'move)
513 (1- (point))))
514 (goto-char start)
515 (while (re-search-forward "^x-uidl:" nil t)
516 (while (progn
517 (forward-line 1)
518 (memq (char-after) '(?\t ? ))))
519 (delete-region (match-beginning 0) (point)))
520 (goto-char (point-max))
521 (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n"))))
522
278(defcustom pop3-stream-type nil 523(defcustom pop3-stream-type nil
279 "*Transport security type for POP3 connections. 524 "*Transport security type for POP3 connections.
280This may be either nil (plain connection), `ssl' (use an 525This may be either nil (plain connection), `ssl' (use an
@@ -663,6 +908,13 @@ and close the connection."
663;; Possible responses: 908;; Possible responses:
664;; +OK [all delete marks removed] 909;; +OK [all delete marks removed]
665 910
911;; UIDL [msg]
912;; Arguments: a message-id (optional)
913;; Restrictions: transaction state; msg must not be deleted
914;; Possible responses:
915;; +OK [uidl listing follows]
916;; -ERR [no such message]
917
666;;; UPDATE STATE 918;;; UPDATE STATE
667 919
668;; QUIT 920;; QUIT