Re: Keeping IMAP connection alive when using it in mail-sources

[Emanuel Berg]

Adam Sjøgren wrote:

> Here's the modified version of mail-source-fetch-imap
> I cobbled together - the handling of deleting the buffer if
> there is no process is not so pretty:
>
> (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)
>           (imap-shell-program (or (list program) imap-shell-program)))
>       (let ((buf (or (and (or (get-buffer-process " *imap source*")
>                               (and (get-buffer " *imap source*")
>                                    (kill-buffer " *imap source*")))
>                           (get-buffer " *imap source*"))
>                      (let ((newbuf (generate-new-buffer " *imap source*")))
>                      (if (and (imap-open server port stream authentication 
> newbuf)
>                               (imap-authenticate
>                                user (or (cdr (assoc from 
> mail-source-password-cache))
>                                           password)
>                                  newbuf))
>                            newbuf
>                          (progn
>                            (imap-close newbuf)
>                          ;; 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 
> newbuf))))))))
>         (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))))))
>         (mail-source-run-script
>          postscript
>          `((?p . ,password) (?t . ,mail-source-crash-box)
>            (?s . ,server) (?P . ,port) (?u . ,user)))
>         found))))

Good work but consider writing longer functions?

-- 
underground experts united
https://dataswamp.org/~incal