gnus-art.el (gnus-mime-buttonize-attachments-in-header): Improve criterion that finds...
[gnus] / lisp / mail-source.el
index 2315cff..51b9c91 100644 (file)
@@ -1,6 +1,6 @@
 ;;; mail-source.el --- functions for fetching mail
 
-;; Copyright (C) 1999-201 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2014 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
 
 ;;; Code:
 
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
 (require 'format-spec)
 (eval-when-compile
   (require 'cl)
@@ -63,7 +59,7 @@
 This variable is a list of mail source specifiers.
 See Info node `(gnus)Mail Source Specifiers'."
   :group 'mail-source
-  :version "23.1" ;; No Gnus
+  :version "24.4"
   :link '(custom-manual "(gnus)Mail Source Specifiers")
   :type `(choice
          (const :tag "None" nil)
@@ -159,7 +155,18 @@ See Info node `(gnus)Mail Source Specifiers'."
                                                   :value nil
                                                   (const :tag "Clear" nil)
                                                   (const starttls)
-                                                  (const :tag "SSL/TLS" ssl)))))
+                                                  (const :tag "SSL/TLS" ssl)))
+                                   (group :inline t
+                                          (const :format "" :value :leave)
+                                          (choice :format "\
+%{Leave mail on server%}:\n\t\t%[Value Menu%] %v"
+                                                  :value nil
+                                                  (const :tag "\
+Don't leave mails" nil)
+                                                  (const :tag "\
+Leave all mails" t)
+                                                  (number :tag "\
+Leave mails for this many days" :value 14)))))
                   (cons :tag "Maildir (qmail, postfix...)"
                         (const :format "" maildir)
                         (checklist :tag "Options" :greedy t
@@ -340,7 +347,8 @@ Common keywords should be listed here.")
        (:function)
        (:password)
        (:authentication password)
-       (:stream nil))
+       (:stream nil)
+       (:leave))
       (maildir
        (:path (or (getenv "MAILDIR") "~/Maildir/"))
        (:subdirs ("cur" "new"))
@@ -721,12 +729,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
       ;; Return whether we moved successfully or not.
       to)))
 
-(defun mail-source-movemail-and-remove (from to)
-  "Move FROM to TO using movemail, then remove FROM if empty."
-  (or (not (mail-source-movemail from to))
-      (not (zerop (nth 7 (file-attributes from))))
-      (delete-file from)))
-
 (defun mail-source-fetch-with-program (program)
   (eq 0 (call-process shell-file-name nil nil nil
                      shell-command-switch program)))
@@ -803,6 +805,10 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
      prescript-delay)
     (let ((from (format "%s:%s:%s" server user port))
          (mail-source-string (format "pop:%s@%s" user server))
+         (process-environment (if server
+                                  (cons (concat "MAILHOST=" server)
+                                        process-environment)
+                                process-environment))
          result)
       (when (eq authentication 'password)
        (setq password
@@ -810,8 +816,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
                  (cdr (assoc from mail-source-password-cache))
                  (read-passwd
                   (format "Password for %s at %s: " user server)))))
-      (when server
-       (setenv "MAILHOST" server))
       (setq result
            (cond
             (program
@@ -831,7 +835,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
                    (pop3-port port)
                    (pop3-authentication-scheme
                     (if (eq authentication 'apop) 'apop 'pass))
-                   (pop3-stream-type stream))
+                   (pop3-stream-type stream)
+                   (pop3-leave-mail-on-server leave))
                (if (or debug-on-quit debug-on-error)
                    (save-excursion (pop3-movemail mail-source-crash-box))
                  (condition-case err
@@ -870,6 +875,10 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
   (mail-source-bind (pop source)
     (let ((from (format "%s:%s:%s" server user port))
          (mail-source-string (format "pop:%s@%s" user server))
+         (process-environment (if server
+                                  (cons (concat "MAILHOST=" server)
+                                        process-environment)
+                                process-environment))
          result)
       (when (eq authentication 'password)
        (setq password
@@ -879,8 +888,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
                   (format "Password for %s at %s: " user server))))
        (unless (assoc from mail-source-password-cache)
          (push (cons from password) mail-source-password-cache)))
-      (when server
-       (setenv "MAILHOST" server))
       (setq result
            (cond
             ;; No easy way to check whether mail is waiting for these.