[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/mail-source.el
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/mail-source.el |
|
Date: |
Sat, 04 Sep 2004 09:45:16 -0400 |
Index: emacs/lisp/gnus/mail-source.el
diff -c emacs/lisp/gnus/mail-source.el:1.14 emacs/lisp/gnus/mail-source.el:1.15
*** emacs/lisp/gnus/mail-source.el:1.14 Mon Sep 1 15:45:24 2003
--- emacs/lisp/gnus/mail-source.el Sat Sep 4 13:13:43 2004
***************
*** 1,5 ****
;;; mail-source.el --- functions for fetching mail
! ;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; Keywords: news, mail
--- 1,6 ----
;;; mail-source.el --- functions for fetching mail
! ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
! ;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; Keywords: news, mail
***************
*** 32,40 ****
(eval-and-compile
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
! (autoload 'nnheader-cancel-timer "nnheader"))
(require 'format-spec)
(require 'mm-util)
(defgroup mail-source nil
"The mail-fetching library."
--- 33,43 ----
(eval-and-compile
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
! (autoload 'nnheader-cancel-timer "nnheader")
! (autoload 'nnheader-run-at-time "nnheader"))
(require 'format-spec)
(require 'mm-util)
+ (require 'message) ;; for `message-directory'
(defgroup mail-source nil
"The mail-fetching library."
***************
*** 58,63 ****
--- 61,67 ----
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
:group 'mail-source
+ :link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(repeat
(choice :format "%[Value Menu%] %v"
:value (file)
***************
*** 81,90 ****
(function :tag "Predicate"))
(group :inline t
(const :format "" :value :prescript)
! (string :tag "Prescript"))
(group :inline t
(const :format "" :value :postscript)
! (string :tag "Postscript"))
(group :inline t
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))
--- 85,100 ----
(function :tag "Predicate"))
(group :inline t
(const :format "" :value :prescript)
! (choice :tag "Prescript"
! :value nil
! (string :format "%v")
! (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
! (choice :tag "Postscript"
! :value nil
! (string :format "%v")
! (function :format "%v")))
(group :inline t
(const :format "" :value :plugged)
(boolean :tag "Plugged"))))
***************
*** 111,120 ****
(string :tag "Program"))
(group :inline t
(const :format "" :value :prescript)
! (string :tag "Prescript"))
(group :inline t
(const :format "" :value :postscript)
! (string :tag "Postscript"))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
--- 121,136 ----
(string :tag "Program"))
(group :inline t
(const :format "" :value :prescript)
! (choice :tag "Prescript"
! :value nil
! (string :format "%v")
! (function :format "%v")))
(group :inline t
(const :format "" :value :postscript)
! (choice :tag "Postscript"
! :value nil
! (string :format "%v")
! (function :format "%v")))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
***************
*** 160,165 ****
--- 176,184 ----
:value network
,@mail-source-imap-streams))
(group :inline t
+ (const :format "" :value :program)
+ (string :tag "Program"))
+ (group :inline t
(const :format ""
:value :authenticator)
(choice :tag "Authenticator"
***************
*** 213,230 ****
(const :format "" :value :plugged)
(boolean :tag "Plugged")))))))
(defcustom mail-source-primary-source nil
"*Primary source for incoming mail.
If non-nil, this maildrop will be checked periodically for new mail."
:group 'mail-source
:type 'sexp)
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
:group 'mail-source
:type 'file)
! (defcustom mail-source-directory "~/Mail/"
"Directory where files (if any) will be stored."
:group 'mail-source
:type 'directory)
--- 232,259 ----
(const :format "" :value :plugged)
(boolean :tag "Plugged")))))))
+ (defcustom mail-source-ignore-errors nil
+ "*Ignore errors when querying mail sources.
+ If nil, the user will be prompted when an error occurs. If non-nil,
+ the error will be ignored.")
+
(defcustom mail-source-primary-source nil
"*Primary source for incoming mail.
If non-nil, this maildrop will be checked periodically for new mail."
:group 'mail-source
:type 'sexp)
+ (defcustom mail-source-flash t
+ "*If non-nil, flash periodically when mail is available."
+ :group 'mail-source
+ :type 'boolean)
+
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
:group 'mail-source
:type 'file)
! (defcustom mail-source-directory message-directory
"Directory where files (if any) will be stored."
:group 'mail-source
:type 'directory)
***************
*** 235,241 ****
:type 'integer)
(defcustom mail-source-delete-incoming t
! "*If non-nil, delete incoming files after handling."
:group 'mail-source
:type 'boolean)
--- 264,286 ----
:type 'integer)
(defcustom mail-source-delete-incoming t
! "*If non-nil, delete incoming files after handling.
! If t, delete immediately, if nil, never delete. If a positive number, delete
! files older than number of days."
! ;; Note: The removing happens in `mail-source-callback', i.e. no old
! ;; incoming files will be deleted, unless you receive new mail.
! ;;
! ;; You may also set this to `nil' and call `mail-source-delete-old-incoming'
! ;; from a hook or interactively.
! :group 'mail-source
! :type '(choice (const :tag "immediately" t)
! (const :tag "never" nil)
! (integer :tag "days")))
!
! (defcustom mail-source-delete-old-incoming-confirm t
! "*If non-nil, ask for for confirmation before deleting old incoming files.
! This variable only applies when `mail-source-delete-incoming' is a positive
! number."
:group 'mail-source
:type 'boolean)
***************
*** 254,259 ****
--- 299,309 ----
:group 'mail-source
:type 'number)
+ (defcustom mail-source-movemail-program nil
+ "If non-nil, name of program for fetching new mail."
+ :group 'mail-source
+ :type '(choice (const nil) string))
+
;;; Internal variables.
(defvar mail-source-string ""
***************
*** 295,312 ****
(:authentication password))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
! (:subdirs ("new" "cur"))
(:function))
(imap
(:server (getenv "MAILHOST"))
(:port)
(:stream)
(:authentication)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
(:password)
(:mailbox "INBOX")
(:predicate "UNSEEN UNDELETED")
(:fetchflag "\\Deleted")
(:dontexpunge))
(webmail
(:subtype hotmail)
--- 345,366 ----
(:authentication password))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
! (:subdirs ("cur" "new"))
(:function))
(imap
(:server (getenv "MAILHOST"))
(:port)
(:stream)
+ (:program)
(:authentication)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
(:password)
(:mailbox "INBOX")
(:predicate "UNSEEN UNDELETED")
(:fetchflag "\\Deleted")
+ (:prescript)
+ (:prescript-delay)
+ (:postscript)
(:dontexpunge))
(webmail
(:subtype hotmail)
***************
*** 365,371 ****
,@body))
(put 'mail-source-bind 'lisp-indent-function 1)
! (put 'mail-source-bind 'edebug-form-spec '(form body))
(defun mail-source-set-1 (source)
(let* ((type (pop source))
--- 419,425 ----
,@body))
(put 'mail-source-bind 'lisp-indent-function 1)
! (put 'mail-source-bind 'edebug-form-spec '(sexp body))
(defun mail-source-set-1 (source)
(let* ((type (pop source))
***************
*** 408,414 ****
,@body))
(put 'mail-source-bind-common 'lisp-indent-function 1)
! (put 'mail-source-bind-common 'edebug-form-spec '(form body))
(defun mail-source-value (value)
"Return the value of VALUE."
--- 462,468 ----
,@body))
(put 'mail-source-bind-common 'lisp-indent-function 1)
! (put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
(defun mail-source-value (value)
"Return the value of VALUE."
***************
*** 442,465 ****
(setq found (mail-source-callback
callback mail-source-crash-box)))
(+ found
! (condition-case err
(funcall function source callback)
! (error
! (unless (yes-or-no-p
! (format "Mail source error (%s). Continue? " err))
! (error "Cannot get new mail"))
! 0))))))))
!
! (eval-and-compile
! (if (fboundp 'make-temp-file)
! (defalias 'mail-source-make-complex-temp-name 'make-temp-file)
! (defun mail-source-make-complex-temp-name (prefix)
! (let ((newname (make-temp-name prefix))
! (newprefix prefix))
! (while (file-exists-p newname)
! (setq newprefix (concat newprefix "x"))
! (setq newname (make-temp-name newprefix)))
! newname))))
(defun mail-source-callback (callback info)
"Call CALLBACK on the mail file, and then remove the mail file.
--- 496,547 ----
(setq found (mail-source-callback
callback mail-source-crash-box)))
(+ found
! (if (or debug-on-quit debug-on-error)
(funcall function source callback)
! (condition-case err
! (funcall function source callback)
! (error
! (if (and (not mail-source-ignore-errors)
! (not
! (yes-or-no-p
! (format "Mail source %s error (%s). Continue? "
! (if (memq ':password source)
! (let ((s (copy-sequence source)))
! (setcar (cdr (memq ':password s))
! "********")
! s)
! source)
! (cadr err)))))
! (error "Cannot get new mail"))
! 0)))))))))
!
! (defun mail-source-delete-old-incoming (&optional age confirm)
! "Remove incoming files older than AGE days.
! If CONFIRM is non-nil, ask for confirmation before removing a file."
! (interactive "P")
! (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days
! (low2days (/ 1.0 65536.0)) ;; convert low bits to days
! (diff (if (natnump age) age 30));; fallback, if no valid AGE given
! currday files)
! (setq files (directory-files
! mail-source-directory t
! (concat mail-source-incoming-file-prefix "*"))
! currday (* (car (current-time)) high2days)
! currday (+ currday (* low2days (nth 1 (current-time)))))
! (while files
! (let* ((ffile (car files))
! (bfile (gnus-replace-in-string
! ffile "\\`.*/\\([^/]+\\)\\'" "\\1"))
! (filetime (nth 5 (file-attributes ffile)))
! (fileday (* (car filetime) high2days))
! (fileday (+ fileday (* low2days (nth 1 filetime)))))
! (setq files (cdr files))
! (when (and (> (- currday fileday) diff)
! (gnus-message 8 "File `%s' is older than %s day(s)"
! bfile diff)
! (or (not confirm)
! (y-or-n-p (concat "Remove file `" bfile "'? "))))
! (delete-file ffile))))))
(defun mail-source-callback (callback info)
"Call CALLBACK on the mail file, and then remove the mail file.
***************
*** 474,489 ****
(funcall callback mail-source-crash-box info)
(when (file-exists-p mail-source-crash-box)
;; Delete or move the incoming mail out of the way.
! (if mail-source-delete-incoming
(delete-file mail-source-crash-box)
(let ((incoming
! (mail-source-make-complex-temp-name
(expand-file-name
mail-source-incoming-file-prefix
mail-source-directory))))
(unless (file-exists-p (file-name-directory incoming))
(make-directory (file-name-directory incoming) t))
! (rename-file mail-source-crash-box incoming t)))))))
(defun mail-source-movemail (from to)
"Move FROM to TO using movemail."
--- 556,576 ----
(funcall callback mail-source-crash-box info)
(when (file-exists-p mail-source-crash-box)
;; Delete or move the incoming mail out of the way.
! (if (eq mail-source-delete-incoming t)
(delete-file mail-source-crash-box)
(let ((incoming
! (mm-make-temp-file
(expand-file-name
mail-source-incoming-file-prefix
mail-source-directory))))
(unless (file-exists-p (file-name-directory incoming))
(make-directory (file-name-directory incoming) t))
! (rename-file mail-source-crash-box incoming t)
! ;; remove old incoming files?
! (when (natnump mail-source-delete-incoming)
! (mail-source-delete-old-incoming
! mail-source-delete-incoming
! mail-source-delete-old-incoming-confirm))))))))
(defun mail-source-movemail (from to)
"Move FROM to TO using movemail."
***************
*** 518,529 ****
'call-process
(append
(list
! (expand-file-name "movemail" exec-directory)
nil errors nil from to)))))
(when (file-exists-p to)
(set-file-modes to mail-source-default-file-modes))
! (if (and (not (buffer-modified-p errors))
! (zerop result))
;; No output => movemail won.
t
(set-buffer errors)
--- 605,619 ----
'call-process
(append
(list
! (or mail-source-movemail-program
! (expand-file-name "movemail" exec-directory))
nil errors nil from to)))))
(when (file-exists-p to)
(set-file-modes to mail-source-default-file-modes))
! (if (and (or (not (buffer-modified-p errors))
! (zerop (buffer-size errors)))
! (and (numberp result)
! (zerop result)))
;; No output => movemail won.
t
(set-buffer errors)
***************
*** 540,547 ****
(goto-char (point-min))
(when (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
(unless (yes-or-no-p
! (format "movemail: %s (%d return). Continue? "
(buffer-string) result))
(error "%s" (buffer-string)))
(setq to nil)))))))
--- 630,638 ----
(goto-char (point-min))
(when (looking-at "movemail: ")
(delete-region (point-min) (match-end 0)))
+ ;; Result may be a signal description string.
(unless (yes-or-no-p
! (format "movemail: %s (%s return). Continue? "
(buffer-string) result))
(error "%s" (buffer-string)))
(setq to nil)))))))
***************
*** 557,585 ****
(not (zerop (nth 7 (file-attributes from))))
(delete-file from)))
- (defvar mail-source-read-passwd nil)
- (defun mail-source-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
- If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt
- (if args
- (apply 'format prompt args)
- prompt)))
- (unless mail-source-read-passwd
- (if (or (fboundp 'read-passwd) (load "passwd" t))
- (setq mail-source-read-passwd 'read-passwd)
- (unless (fboundp 'ange-ftp-read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp"))
- (setq mail-source-read-passwd 'ange-ftp-read-passwd)))
- (funcall mail-source-read-passwd prompt)))
-
(defun mail-source-fetch-with-program (program)
! (zerop (call-process shell-file-name nil nil nil
! shell-command-switch program)))
(defun mail-source-run-script (script spec &optional delay)
(when script
! (if (and (symbolp script) (fboundp script))
(funcall script)
(mail-source-call-script
(format-spec script spec))))
--- 648,660 ----
(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)))
(defun mail-source-run-script (script spec &optional delay)
(when script
! (if (functionp script)
(funcall script)
(mail-source-call-script
(format-spec script spec))))
***************
*** 616,623 ****
"Fetcher for directory sources."
(mail-source-bind (directory source)
(mail-source-run-script
! prescript (format-spec-make ?t path)
! prescript-delay)
(let ((found 0)
(mail-source-string (format "directory:%s" path)))
(dolist (file (directory-files
--- 691,697 ----
"Fetcher for directory sources."
(mail-source-bind (directory source)
(mail-source-run-script
! prescript (format-spec-make ?t path) prescript-delay)
(let ((found 0)
(mail-source-string (format "directory:%s" path)))
(dolist (file (directory-files
***************
*** 626,633 ****
(funcall predicate file)
(mail-source-movemail file mail-source-crash-box))
(incf found (mail-source-callback callback file))))
! (mail-source-run-script
! postscript (format-spec-make ?t path))
found)))
(defun mail-source-fetch-pop (source callback)
--- 700,706 ----
(funcall predicate file)
(mail-source-movemail file mail-source-crash-box))
(incf found (mail-source-callback callback file))))
! (mail-source-run-script postscript (format-spec-make ?t path))
found)))
(defun mail-source-fetch-pop (source callback)
***************
*** 645,651 ****
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
! (mail-source-read-passwd
(format "Password for %s at %s: " user server)))))
(when server
(setenv "MAILHOST" server))
--- 718,724 ----
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
! (read-passwd
(format "Password for %s at %s: " user server)))))
(when server
(setenv "MAILHOST" server))
***************
*** 667,673 ****
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
! (save-excursion (pop3-movemail mail-source-crash-box))))))
(if result
(progn
(when (eq authentication 'password)
--- 740,756 ----
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
! (if (or debug-on-quit debug-on-error)
! (save-excursion (pop3-movemail mail-source-crash-box))
! (condition-case err
! (save-excursion (pop3-movemail mail-source-crash-box))
! (error
! ;; We nix out the password in case the error
! ;; was because of a wrong password being given.
! (setq mail-source-password-cache
! (delq (assoc from mail-source-password-cache)
! mail-source-password-cache))
! (signal (car err) (cdr err)))))))))
(if result
(progn
(when (eq authentication 'password)
***************
*** 699,705 ****
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
! (mail-source-read-passwd
(format "Password for %s at %s: " user server))))
(unless (assoc from mail-source-password-cache)
(push (cons from password) mail-source-password-cache)))
--- 782,788 ----
(setq password
(or password
(cdr (assoc from mail-source-password-cache))
! (read-passwd
(format "Password for %s at %s: " user server))))
(unless (assoc from mail-source-password-cache)
(push (cons from password) mail-source-password-cache)))
***************
*** 718,724 ****
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
! (save-excursion (pop3-get-message-count))))))
(if result
;; Inform display-time that we have new mail.
(setq mail-source-new-mail-available (> result 0))
--- 801,817 ----
(pop3-port port)
(pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)))
! (if (or debug-on-quit debug-on-error)
! (save-excursion (pop3-get-message-count))
! (condition-case err
! (save-excursion (pop3-get-message-count))
! (error
! ;; We nix out the password in case the error
! ;; was because of a wrong password being given.
! (setq mail-source-password-cache
! (delq (assoc from mail-source-password-cache)
! mail-source-password-cache))
! (signal (car err) (cdr err)))))))))
(if result
;; Inform display-time that we have new mail.
(setq mail-source-new-mail-available (> result 0))
***************
*** 729,736 ****
--- 822,852 ----
mail-source-password-cache)))
result)))
+ (defun mail-source-touch-pop ()
+ "Open and close a POP connection shortly.
+ POP server should be defined in `mail-source-primary-source' (which is
+ preferred) or `mail-sources'. You may use it for the POP-before-SMTP
+ authentication. To do that, you need to set the
+ `message-send-mail-function' variable as `message-smtpmail-send-it'
+ and put the following line in your ~/.gnus.el file:
+
+ \(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
+
+ See the Gnus manual for details."
+ (let ((sources (if mail-source-primary-source
+ (list mail-source-primary-source)
+ mail-sources)))
+ (while sources
+ (if (eq 'pop (car (car sources)))
+ (mail-source-check-pop (car sources)))
+ (setq sources (cdr sources)))))
+
(defun mail-source-new-mail-p ()
"Handler for `display-time' to indicate when new mail is available."
+ ;; Flash (ie. ring the visible bell) if mail is available.
+ (if (and mail-source-flash mail-source-new-mail-available)
+ (let ((visible-bell t))
+ (ding)))
;; Only report flag setting; flag is updated on a different schedule.
mail-source-new-mail-available)
***************
*** 753,760 ****
mail-source-idle-time-delay
nil
(lambda ()
! (setq mail-source-report-new-mail-idle-timer nil)
! (mail-source-check-pop mail-source-primary-source))))
;; Since idle timers created when Emacs is already in the idle
;; state don't get activated until Emacs _next_ becomes idle, we
;; need to force our timer to be considered active now. We do
--- 869,877 ----
mail-source-idle-time-delay
nil
(lambda ()
! (unwind-protect
! (mail-source-check-pop mail-source-primary-source)
! (setq mail-source-report-new-mail-idle-timer nil)))))
;; Since idle timers created when Emacs is already in the idle
;; state don't get activated until Emacs _next_ becomes idle, we
;; need to force our timer to be considered active now. We do
***************
*** 785,792 ****
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
! (run-at-time t (* 60 mail-source-report-new-mail-interval)
! #'mail-source-start-idle-timer))
;; When you get new mail, clear "Mail" from the mode line.
(add-hook 'nnmail-post-get-new-mail-hook
'display-time-event-handler)
--- 902,911 ----
(setq display-time-mail-function #'mail-source-new-mail-p)
;; Set up the main timer.
(setq mail-source-report-new-mail-timer
! (nnheader-run-at-time
! (* 60 mail-source-report-new-mail-interval)
! (* 60 mail-source-report-new-mail-interval)
! #'mail-source-start-idle-timer))
;; When you get new mail, clear "Mail" from the mode line.
(add-hook 'nnmail-post-get-new-mail-hook
'display-time-event-handler)
***************
*** 817,829 ****
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
! ;;; ;; Unix mail format
! ;;; (unless (looking-at "\n*From ")
! ;;; (insert "From maildir "
! ;;; (current-time-string) "\n"))
! ;;; (while (re-search-forward "^From " nil t)
! ;;; (replace-match ">From "))
! ;;; (goto-char (point-max))
;;; (insert "\n\n")
;; MMDF mail format
(insert "\001\001\001\001\n"))
--- 936,948 ----
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
! ;;; ;; Unix mail format
! ;;; (unless (looking-at "\n*From ")
! ;;; (insert "From maildir "
! ;;; (current-time-string) "\n"))
! ;;; (while (re-search-forward "^From " nil t)
! ;;; (replace-match ">From "))
! ;;; (goto-char (point-max))
;;; (insert "\n\n")
;; MMDF mail format
(insert "\001\001\001\001\n"))
***************
*** 852,861 ****
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
! (buf (get-buffer-create (generate-new-buffer-name " *imap source*")))
(mail-source-string (format "imap:%s:%s" server mailbox))
remove)
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
--- 971,985 ----
(defun mail-source-fetch-imap (source callback)
"Fetcher for imap sources."
(mail-source-bind (imap source)
+ (mail-source-run-script
+ prescript (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user)
+ prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
! (buf (generate-new-buffer " *imap source*"))
(mail-source-string (format "imap:%s:%s" server mailbox))
+ (imap-shell-program (or (list program) imap-shell-program))
remove)
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
***************
*** 870,881 ****
(mm-disable-multibyte)
;; remember password
(with-current-buffer buf
! (when (or imap-password
! (assoc from mail-source-password-cache))
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
! (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
(push uid remove)
(insert "From imap " (current-time-string) "\n")
(save-excursion
--- 994,1009 ----
(mm-disable-multibyte)
;; remember password
(with-current-buffer buf
! (when (and imap-password
! (not (assoc from mail-source-password-cache)))
(push (cons from imap-password) mail-source-password-cache)))
;; if predicate is nil, use all uids
(dolist (uid (imap-search (or predicate "1:*") buf))
! (when (setq str
! (if (imap-capability 'IMAP4rev1 buf)
! (caddar (imap-fetch uid "BODY.PEEK[]"
! 'BODYDETAIL nil buf))
! (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
(push uid remove)
(insert "From imap " (current-time-string) "\n")
(save-excursion
***************
*** 886,897 ****
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
(when (and remove fetchflag)
(imap-message-flags-add
(imap-range-to-message-set (gnus-compress-sequence remove))
fetchflag nil buf))
(if dontexpunge
(imap-mailbox-unselect buf)
! (imap-mailbox-close buf))
(imap-close buf))
(imap-close buf)
;; We nix out the password in case the error
--- 1014,1026 ----
(nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server))
(when (and remove fetchflag)
+ (setq remove (nreverse remove))
(imap-message-flags-add
(imap-range-to-message-set (gnus-compress-sequence remove))
fetchflag nil buf))
(if dontexpunge
(imap-mailbox-unselect buf)
! (imap-mailbox-close nil buf))
(imap-close buf))
(imap-close buf)
;; We nix out the password in case the error
***************
*** 899,906 ****
(setq mail-source-password-cache
(delq (assoc from mail-source-password-cache)
mail-source-password-cache))
! (error (imap-error-text buf)))
(kill-buffer buf)
found)))
(eval-and-compile
--- 1028,1039 ----
(setq mail-source-password-cache
(delq (assoc from mail-source-password-cache)
mail-source-password-cache))
! (error "IMAP error: %s" (imap-error-text buf)))
(kill-buffer buf)
+ (mail-source-run-script
+ postscript
+ (format-spec-make ?p password ?t mail-source-crash-box
+ ?s server ?P port ?u user))
found)))
(eval-and-compile
***************
*** 917,923 ****
(or password
(cdr (assoc (format "webmail:%s:%s" subtype user)
mail-source-password-cache))
! (mail-source-read-passwd
(format "Password for %s at %s: " user subtype))))
(when (and password
(not (assoc (format "webmail:%s:%s" subtype user)
--- 1050,1056 ----
(or password
(cdr (assoc (format "webmail:%s:%s" subtype user)
mail-source-password-cache))
! (read-passwd
(format "Password for %s at %s: " user subtype))))
(when (and password
(not (assoc (format "webmail:%s:%s" subtype user)
- [Emacs-diffs] Changes to emacs/lisp/gnus/mail-source.el,
Miles Bader <=