diff options
| author | Gnus developers | 2012-11-02 23:37:02 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2012-11-02 23:37:02 +0000 |
| commit | a71e2379a331e430f774fc16645f460f1de2b4a0 (patch) | |
| tree | ead84ee93d53a139674be60ee09b2aa4f41e9347 | |
| parent | 00a3b041730e178fe68850b76ac4216af62ea606 (diff) | |
| download | emacs-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/ChangeLog | 5 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 41 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 25 | ||||
| -rw-r--r-- | lisp/gnus/gnus-dired.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/mail-source.el | 21 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/pop3.el | 314 |
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 @@ | |||
| 1 | 2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * gnus.texi (Mail Source Specifiers): | ||
| 4 | Document :leave keyword used for pop mail source. | ||
| 5 | |||
| 1 | 2012-11-01 Glenn Morris <rgm@gnu.org> | 6 | 2012-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} | |||
| 14759 | and says what authentication scheme to use. The default is | 14759 | and says what authentication scheme to use. The default is |
| 14760 | @code{password}. | 14760 | @code{password}. |
| 14761 | 14761 | ||
| 14762 | @item :leave | ||
| 14763 | Non-@code{nil} if the mail is to be left on the @acronym{POP} server | ||
| 14764 | after 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 | |||
| 14768 | If this is neither @code{nil} nor a number, all mails will be left on | ||
| 14769 | the server. If this is a number, leave mails on the server for this | ||
| 14770 | many 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 | ||
| 14774 | The @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 | |||
| 14778 | Note that @acronym{POP} servers maintain no state information between | ||
| 14779 | sessions, so what the client believes is there and what is actually | ||
| 14780 | there may not match up. If they do not, then you may get duplicate | ||
| 14781 | mails or the whole thing can fall apart and leave you with a corrupt | ||
| 14782 | mailbox. | ||
| 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 |
| 14766 | If the @code{:program} and @code{:function} keywords aren't specified, | 14788 | If 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. |
| 14768 | is non-@code{nil} the mail is to be left on the @acronym{POP} server | ||
| 14769 | after fetching when using @code{pop3-movemail}. Note that POP servers | ||
| 14770 | maintain no state information between sessions, so what the client | ||
| 14771 | believes is there and what is actually there may not match up. If they | ||
| 14772 | do not, then you may get duplicate mails or the whole thing can fall | ||
| 14773 | apart and leave you with a corrupt mailbox. | ||
| 14774 | 14790 | ||
| 14775 | Here are some examples for getting mail from a @acronym{POP} server. | 14791 | Here are some examples for getting mail from a @acronym{POP} server. |
| 14792 | |||
| 14776 | Fetch from the default @acronym{POP} server, using the default user | 14793 | Fetch from the default @acronym{POP} server, using the default user |
| 14777 | name, and default fetcher: | 14794 | name, 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 | ||
| 14807 | Leave 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 | |||
| 14790 | Use @samp{movemail} to move the mail: | 14815 | Use @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 @@ | |||
| 1 | 2012-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 | |||
| 6 | 2012-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 | |||
| 1 | 2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> | 26 | 2012-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 @@ | |||
| 63 | This variable is a list of mail source specifiers. | 63 | This variable is a list of mail source specifiers. |
| 64 | See Info node `(gnus)Mail Source Specifiers'." | 64 | See 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 "\ | ||
| 169 | Don't leave mails" nil) | ||
| 170 | (const :tag "\ | ||
| 171 | Leave all mails" t) | ||
| 172 | (number :tag "\ | ||
| 173 | Leave 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 | 102 | Mails once fetched will never be fetched again by the UIDL control. | |
| 103 | If `pop3-leave-mail-on-server' is non-nil the mail is to be left | 103 | |
| 104 | on the POP server after fetching. Note that POP servers maintain | 104 | If this is neither nil nor a number, all mails will be left on the |
| 105 | no state information between sessions, so what the client | 105 | server. If this is a number, leave mails on the server for this many |
| 106 | believes is there and what is actually there may not match up. | 106 | days since you first checked new mails. If this is nil, mails will be |
| 107 | If they do not, then you may get duplicate mails or the whole | 107 | deleted on the server right after fetching. |
| 108 | thing 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: | 109 | Gnus users should use the `:leave' keyword in a mail source to direct |
| 110 | ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de | 110 | the 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? | 112 | Note that POP servers maintain no state information between sessions, |
| 113 | :version "22.1" ;; Oort Gnus | 113 | so what the client believes is there and what is actually there may |
| 114 | :type 'boolean | 114 | not match up. If they do not, then you may get duplicate mails or |
| 115 | the 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. | ||
| 130 | If it is a list of numbers, the first one binds `kept-old-versions' and | ||
| 131 | the other binds `kept-new-versions' to keep number of oldest and newest | ||
| 132 | versions. Otherwise, the value binds `version-control' (which see). | ||
| 133 | |||
| 134 | Note: Backup will take place whenever you check new mails on a server. | ||
| 135 | So, you may lose the backup files having been saved before a trouble | ||
| 136 | if you set it so as to make too few backups whereas you have access to | ||
| 137 | many 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. |
| 150 | Use streaming commands." | 199 | Use 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'. | ||
| 394 | Return 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. |
| 280 | This may be either nil (plain connection), `ssl' (use an | 525 | This 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 |