Lines Matching defs:source
1 ;;; mail-source.el --- functions for fetching mail
43 (defgroup mail-source nil
49 (defconst mail-source-imap-authenticators
54 (defconst mail-source-imap-streams
62 This variable is a list of mail source specifiers.
64 :group 'mail-source
180 ,@mail-source-imap-streams))
189 ,@mail-source-imap-authenticators))
238 (defcustom mail-source-ignore-errors nil
243 :group 'mail-source
246 (defcustom mail-source-primary-source nil
247 "*Primary source for incoming mail.
249 :group 'mail-source
252 (defcustom mail-source-flash t
254 :group 'mail-source
257 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
259 :group 'mail-source
262 (defcustom mail-source-directory message-directory
263 "Directory where incoming mail source files (if any) will be stored."
264 :group 'mail-source
267 (defcustom mail-source-default-file-modes 384
269 :group 'mail-source
272 (defcustom mail-source-delete-incoming t
276 ;; Note: The removing happens in `mail-source-callback', i.e. no old
279 ;; You may also set this to `nil' and call `mail-source-delete-old-incoming'
281 :group 'mail-source
286 (defcustom mail-source-delete-old-incoming-confirm t
288 This variable only applies when `mail-source-delete-incoming' is a positive
291 :group 'mail-source
294 (defcustom mail-source-incoming-file-prefix "Incoming"
296 :group 'mail-source
299 (defcustom mail-source-report-new-mail-interval 5
301 :group 'mail-source
304 (defcustom mail-source-idle-time-delay 5
306 :group 'mail-source
309 (defcustom mail-source-movemail-program nil
312 :group 'mail-source
317 (defvar mail-source-string ""
318 "A dynamically bound string that says what the current mail source is.")
320 (defvar mail-source-new-mail-available nil
324 (defvar mail-source-common-keyword-map
329 (defvar mail-source-keyword-map
382 (defvar mail-source-fetcher-alist
383 '((file mail-source-fetch-file)
384 (directory mail-source-fetch-directory)
385 (pop mail-source-fetch-pop)
386 (maildir mail-source-fetch-maildir)
387 (imap mail-source-fetch-imap)
388 (webmail mail-source-fetch-webmail))
389 "A mapping from source type to fetcher function.")
391 (defvar mail-source-password-cache nil)
393 (defvar mail-source-plugged t)
398 (defun mail-source-strip-keyword (keyword)
403 (defun mail-source-bind-1 (type)
404 (let* ((defaults (cdr (assq type mail-source-keyword-map)))
407 (push (list (mail-source-strip-keyword (car default))
412 (defmacro mail-source-bind (type-source &rest body)
413 "Return a `let' form that binds all variables in source TYPE.
416 At run time, the mail source specifier SOURCE will be inspected,
424 the `mail-source-keyword-map' variable."
425 `(let ,(mail-source-bind-1 (car type-source))
426 (mail-source-set-1 ,(cadr type-source))
429 (put 'mail-source-bind 'lisp-indent-function 1)
430 (put 'mail-source-bind 'edebug-form-spec '(sexp body))
432 (defun mail-source-set-1 (source)
433 (let* ((type (pop source))
434 (defaults (cdr (assq type mail-source-keyword-map)))
437 (set (mail-source-strip-keyword (setq keyword (car default)))
438 (if (setq value (plist-get source keyword))
439 (mail-source-value value)
440 (mail-source-value (cadr default)))))))
443 (defun mail-source-bind-common-1 ()
444 (let* ((defaults mail-source-common-keyword-map)
447 (push (list (mail-source-strip-keyword (car default))
452 (defun mail-source-set-common-1 (source)
453 (let* ((type (pop source))
454 (defaults mail-source-common-keyword-map)
455 (defaults-1 (cdr (assq type mail-source-keyword-map)))
458 (set (mail-source-strip-keyword (setq keyword (car default)))
459 (if (setq value (plist-get source keyword))
460 (mail-source-value value)
462 (mail-source-value (cadr value))
463 (mail-source-value (cadr default))))))))
465 (defmacro mail-source-bind-common (source &rest body)
467 See `mail-source-bind'."
468 `(let ,(mail-source-bind-common-1)
469 (mail-source-set-common-1 source)
472 (put 'mail-source-bind-common 'lisp-indent-function 1)
473 (put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
475 (defun mail-source-value (value)
489 (defun mail-source-fetch (source callback)
494 (mail-source-bind-common source
495 (if (or mail-source-plugged plugged)
497 (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
500 (error "%S is an invalid mail source specification" source))
502 (when (file-exists-p mail-source-crash-box)
503 (message "Processing mail from %s..." mail-source-crash-box)
504 (setq found (mail-source-callback
505 callback mail-source-crash-box)))
508 (funcall function source callback)
510 (funcall function source callback)
512 (if (and (not mail-source-ignore-errors)
515 (format "Mail source %s error (%s). Continue? "
516 (if (memq ':password source)
517 (let ((s (copy-sequence source)))
521 source)
526 (defun mail-source-delete-old-incoming (&optional age confirm)
535 mail-source-directory t
536 (concat mail-source-incoming-file-prefix "*"))
554 (defun mail-source-callback (callback info)
557 (if (or (not (file-exists-p mail-source-crash-box))
558 (zerop (nth 7 (file-attributes mail-source-crash-box))))
560 (when (file-exists-p mail-source-crash-box)
561 (delete-file mail-source-crash-box))
564 (funcall callback mail-source-crash-box info)
565 (when (file-exists-p mail-source-crash-box)
567 (if (eq mail-source-delete-incoming t)
568 (delete-file mail-source-crash-box)
572 mail-source-incoming-file-prefix
573 mail-source-directory))))
576 (rename-file mail-source-crash-box incoming t)
578 (when (natnump mail-source-delete-incoming)
579 (mail-source-delete-old-incoming
580 mail-source-delete-incoming
581 mail-source-delete-old-incoming-confirm))))))))
583 (defun mail-source-movemail (from to)
609 (setq errors (generate-new-buffer " *mail source loss*"))
616 (or mail-source-movemail-program
620 (set-file-modes to mail-source-default-file-modes))
653 (defun mail-source-movemail-and-remove (from to)
655 (or (not (mail-source-movemail from to))
659 (defun mail-source-fetch-with-program (program)
663 (defun mail-source-run-script (script spec &optional delay)
667 (mail-source-call-script
672 (defun mail-source-call-script (script)
684 (defun mail-source-fetch-file (source callback)
686 (mail-source-bind (file source)
687 (mail-source-run-script
688 prescript (format-spec-make ?t mail-source-crash-box)
690 (let ((mail-source-string (format "file:%s" path)))
691 (if (mail-source-movemail path mail-source-crash-box)
693 (mail-source-callback callback path)
694 (mail-source-run-script
695 postscript (format-spec-make ?t mail-source-crash-box)))
698 (defun mail-source-fetch-directory (source callback)
700 (mail-source-bind (directory source)
701 (mail-source-run-script
704 (mail-source-string (format "directory:%s" path)))
709 (mail-source-movemail file mail-source-crash-box))
710 (incf found (mail-source-callback callback file))))
711 (mail-source-run-script postscript (format-spec-make ?t path))
714 (defun mail-source-fetch-pop (source callback)
716 (mail-source-bind (pop source)
717 (mail-source-run-script
719 (format-spec-make ?p password ?t mail-source-crash-box
723 (mail-source-string (format "pop:%s@%s" user server))
728 (cdr (assoc from mail-source-password-cache))
736 (mail-source-fetch-with-program
739 (format-spec-make ?p password ?t mail-source-crash-box
742 (funcall function mail-source-crash-box))
753 (save-excursion (pop3-movemail mail-source-crash-box))
755 (save-excursion (pop3-movemail mail-source-crash-box))
759 (setq mail-source-password-cache
760 (delq (assoc from mail-source-password-cache)
761 mail-source-password-cache))
766 (unless (assoc from mail-source-password-cache)
767 (push (cons from password) mail-source-password-cache)))
769 (mail-source-callback callback server)
771 (if (equal source mail-source-primary-source)
772 (setq mail-source-new-mail-available nil))
773 (mail-source-run-script
775 (format-spec-make ?p password ?t mail-source-crash-box
779 (setq mail-source-password-cache
780 (delq (assoc from mail-source-password-cache)
781 mail-source-password-cache))
784 (defun mail-source-check-pop (source)
786 (mail-source-bind (pop source)
788 (mail-source-string (format "pop:%s@%s" user server))
793 (cdr (assoc from mail-source-password-cache))
796 (unless (assoc from mail-source-password-cache)
797 (push (cons from password) mail-source-password-cache)))
821 (setq mail-source-password-cache
822 (delq (assoc from mail-source-password-cache)
823 mail-source-password-cache))
827 (setq mail-source-new-mail-available (> result 0))
830 (setq mail-source-password-cache
831 (delq (assoc from mail-source-password-cache)
832 mail-source-password-cache)))
835 (defun mail-source-touch-pop ()
837 POP server should be defined in `mail-source-primary-source' (which is
843 \(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
846 (let ((sources (if mail-source-primary-source
847 (list mail-source-primary-source)
851 (mail-source-check-pop (car sources)))
854 (defun mail-source-new-mail-p ()
857 (if (and mail-source-flash mail-source-new-mail-available)
861 mail-source-new-mail-available)
864 (defvar mail-source-report-new-mail nil)
865 (defvar mail-source-report-new-mail-timer nil)
866 (defvar mail-source-report-new-mail-idle-timer nil)
873 (defun mail-source-start-idle-timer ()
876 (unless mail-source-report-new-mail-idle-timer
877 (setq mail-source-report-new-mail-idle-timer
879 mail-source-idle-time-delay
883 (mail-source-check-pop mail-source-primary-source)
884 (setq mail-source-report-new-mail-idle-timer nil)))))
890 (aset mail-source-report-new-mail-idle-timer 0 nil)))
892 (defun mail-source-report-new-mail (arg)
896 (if (not mail-source-primary-source)
897 (error "Need to set `mail-source-primary-source' to check for new mail"))
899 (not mail-source-report-new-mail)
901 (setq mail-source-report-new-mail on)
902 (and mail-source-report-new-mail-timer
903 (nnheader-cancel-timer mail-source-report-new-mail-timer))
904 (and mail-source-report-new-mail-idle-timer
905 (nnheader-cancel-timer mail-source-report-new-mail-idle-timer))
906 (setq mail-source-report-new-mail-timer nil)
907 (setq mail-source-report-new-mail-idle-timer nil)
912 (setq display-time-mail-function #'mail-source-new-mail-p)
914 (setq mail-source-report-new-mail-timer
916 (* 60 mail-source-report-new-mail-interval)
917 (* 60 mail-source-report-new-mail-interval)
918 #'mail-source-start-idle-timer))
928 (defun mail-source-fetch-maildir (source callback)
930 (mail-source-bind (maildir source)
932 mail-source-string)
937 (setq mail-source-string (format "maildir:%s%s" path subdir))
941 (funcall function file mail-source-crash-box)
946 (with-temp-file mail-source-crash-box
960 (incf found (mail-source-callback callback file))))))
978 (defvar mail-source-imap-file-coding-system 'binary
979 "Coding system for the crashbox made by `mail-source-fetch-imap'.")
981 (defun mail-source-fetch-imap (source callback)
983 (mail-source-bind (imap source)
984 (mail-source-run-script
985 prescript (format-spec-make ?p password ?t mail-source-crash-box
990 (buf (generate-new-buffer " *imap source*"))
991 (mail-source-string (format "imap:%s:%s" server mailbox))
996 user (or (cdr (assoc from mail-source-password-cache))
999 (let ((coding-system-for-write mail-source-imap-file-coding-system)
1001 (with-temp-file mail-source-crash-box
1008 (not (assoc from mail-source-password-cache)))
1009 (push (cons from imap-password) mail-source-password-cache)))
1025 (incf found (mail-source-callback callback server))
1038 (setq mail-source-password-cache
1039 (delq (assoc from mail-source-password-cache)
1040 mail-source-password-cache))
1043 (mail-source-run-script
1045 (format-spec-make ?p password ?t mail-source-crash-box
1052 (defun mail-source-fetch-webmail (source callback)
1053 "Fetch for webmail source."
1054 (mail-source-bind (webmail source)
1055 (let ((mail-source-string (format "webmail:%s:%s" subtype user))
1062 mail-source-password-cache))
1067 mail-source-password-cache)))
1069 mail-source-password-cache)))
1070 (webmail-fetch mail-source-crash-box subtype user password)
1071 (mail-source-callback callback (symbol-name subtype)))))
1073 (provide 'mail-source)
1076 ;;; mail-source.el ends here