- (error
- (unless (yes-or-no-p
- (format "Mail source error (%s). Continue? " err))
- (error "Cannot get new mail."))
- 0))))))))
-
-(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))
+ (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))))))