Function: mail-source-fetch-imap

mail-source-fetch-imap is a byte-compiled function defined in mail-source.el.gz.

Signature

(mail-source-fetch-imap SOURCE CALLBACK)

Documentation

Fetcher for imap sources.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/mail-source.el.gz
(defun mail-source-fetch-imap (source callback)
  "Fetcher for imap sources."
  (mail-source-bind (imap source)
    (mail-source-run-script
     prescript
     `((?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*"))
	  (imap-shell-program (or (list program) imap-shell-program)))
      (if (and (imap-open server port stream authentication buf)
	       (imap-authenticate
		user (or (cdr (assoc from mail-source-password-cache))
                         password)
                buf))
          (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
            (dolist (mailbox mailbox-list)
              (when (imap-mailbox-select mailbox nil buf)
                (let ((coding-system-for-write
                       mail-source-imap-file-coding-system)
                      (mail-source-string (format "imap:%s:%s" server mailbox))
                      str remove)
            (message "Fetching from %s..." mailbox)
	    (with-temp-file mail-source-crash-box
	      ;; Avoid converting 8-bit chars from inserted strings to
	      ;; multibyte.
	      (mm-disable-multibyte)
	      ;; remember password
	      (with-current-buffer buf
		(when (and imap-password
			   (not (member (cons from imap-password)
                                        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
		    (insert str "\n\n"))
		  (while (let ((case-fold-search nil))
			   (re-search-forward "^From " nil t))
		    (replace-match ">From "))
		  (goto-char (point-max))))
	      (nnheader-ms-strip-cr))
	    (cl-incf found (mail-source-callback callback server))
	    (mail-source-delete-crash-box)
	    (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
	;; was because of a wrong password being given.
	(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
       `((?p . ,password) (?t . ,mail-source-crash-box)
         (?s . ,server) (?P . ,port) (?u . ,user)))
      found)))