* Movemail

#+begin_src emacs-lisp
  (defgroup movemail nil
    "GNU Mailutils movemail interface for GNU Emacs."
    :group 'external
    :prefix "movemail-"
    :tag "Movemail")

  (defcustom movemail-command "movemail"
    "Command for calling movemail.

  Do not set options in this variable.  To do so, customize
  `movemail-flags'."
    :type 'string
    :group 'movemail)

  (defcustom movemail-flags '("--emacs" "--ignore-errors")
    "List of flags to pass to movemail execution.

  Execute \\[movemail-help] to view a complete list of flags."
    :type '(repeat string)
    :group 'movemail)

  (defcustom movemail-use-tickets nil
    "Whether to use the tickets file for retrieving credentials.

  This file will be used to get the password for a remote
  connection with the desired mailbox(es), but only if the
  `auth-source' method fails."
    :type 'boolean
    :initialize #'custom-initialize-set
    :set (lambda (symbol value)
           (set-default symbol value)
           (when value
             (add-to-list 'auth-sources "~/.mu-tickets")))
    :group 'movemail)

  (defun movemail--check-installation (&optional fun fun-args)
    "Verify if movemail is installed.
  If passed, optional FUN can be applied with optional FUN-ARGS,
  when movemail is located."
    (let ((program movemail-command))
      (if (executable-find program)
          (when fun
            (apply fun fun-args))
        (error "Could not find %s in `exec-path'" program))))

  (defun movemail--get-password (mailbox host port prompt)
    "Get password to move mail from remote servers.
  The password will be searched through `auth-source', associating
  it with MAILBOX, HOST and PORT.  When it fails, the credentials
  stored in \"~/.mu-tickets\" file will be used by movemail.  If
  `movemail-use-tickets' is nil or the file is absent, the user
  will be prompted for a password instead, with a custom PROMPT."
    (let ((remote-password nil))
      (setq remote-password
            (let ((found (nth 0 (auth-source-search
                                 :max 1
                                 :user mailbox
                                 :host host
                                 :port port
                                 :require '(:secret)))))
              (if found
                  (let ((secret (plist-get found :secret)))
                    (if (functionp secret)
                        (funcall secret)
                      secret))
                (unless (and movemail-use-tickets
                             (file-exists-p "~/.mu-tickets"))
                  (read-passwd prompt)))))))

  (defun movemail--get-prompt (proto)
    "Return a prompt, according to PROTO, for password request."
    (cond
     ((string-match-p "\\(?:imaps?\\)" proto)
      "IMAP password: ")
     ((string-match-p "\\(?:pops?\\)" proto)
      "POP password: ")
     ((string-match-p "smtp" proto)
      "SMTP password: ")))

  (defun movemail-help ()
    "Generate a buffer containing movemail help information."
    (interactive)
    (let* ((command (list (concat movemail-command " --help")))
           (contents (movemail--check-installation
                      #'shell-command-to-string command))
           (buffer "*Movemail Help*"))
      (with-help-window buffer
        (with-current-buffer buffer
          (princ contents)))))

  (defun movemail-version ()
    "Echo movemail version information."
    (interactive)
    (let* ((command (list (concat movemail-command " -V")))
           (contents (movemail--check-installation
                      #'shell-command-to-string command)))
      (message (string-trim contents))))

  (defun movemail-move-mail (orig dest &optional pop-pass id)
    "Move mail, asynchronously, from one mailbox to another.
  ORIG and DEST must be alists whose elements have the form (KEY
  . VALUE) that are intended to represent the components of a link
  accepted by movemail.  Those are specified in the Info
  node `(emacs) Movemail'.

  Here, KEY can be one of the following:

  protocol:	VALUE must be one of the protocols supported by
                  movemail.
  user:		VALUE must be the username for the mailbox.
  password:	VALUE must represent the password used for
                  authentication.
  auth-mechanism: VALUE must contain the mechanisms used for
                  authentication, when more than one, separated by
                  commas.
  port:		VALUE must be a string containing the port of the
                  remote server.
  imap-folder:	VALUE must be the name of the folder to be
                  accessed over an IMAP connection.
  extra-params:	VALUE must contain extra parameters, separated by
                  semicolons (when more than one).
  file-name:	VALUE must contain the name of a file or directory.

  For example, the link:

      imaps://my.email%40example.com@imap.example.com:993/all

  Can be represented in the following alist:

      ((protocol . \"imaps\")
       (user . \"my.email@example.com\")
       (host . \"imap.example.com\")
       (port . \"993\")
       (imap-folder . \"all\"))

  It is worth noting that certain cons cells are specific to
  certain protocols, such as \"auth-mechanisms\" and
  \"extra-params\", commonly used in POP and SMTP connections, as
  well as the \"file-name\", which should be used to represent
  links that point to local files or directories.

  The optional POP-PASS is here for the sake of completeness: it
  will only be used if ORIG represents a link to a POP connection
  and if the KEY \"password\" is nil.  Finally, the optional ID
  must be a string that will be concatenated to the name of the
  process in the form \"movemail--id\"."
    (let ((creds (list orig dest))
          (links '(orig-link dest-link))
          (use-pop-pass nil))
      (while creds
        (let-alist (car creds)
          (if (not .protocol)
              (setf (symbol-value (car links)) (expand-file-name .file-name)
                    creds (cdr creds)
                    links (cdr links))
            (setf (symbol-value (car links))
                  (concat .protocol
                          "://"
                          (if (not (string-match-p
                                    "\\(?:imaps?\\|pops?\\|smtp\\)" .protocol))
                              (expand-file-name .file-name)
                            (concat
                             (replace-regexp-in-string "@" "%40" .user)
                             (if .password
                                 (concat ":" .password)
                               (if (and (length= creds 2)
                                        (string-match-p "\\(?:pops?\\)" .protocol)
                                        pop-pass)
                                   (progn
                                     (setq use-pop-pass t)
                                     nil)
                                 (concat ":" (movemail--get-password
                                              .user
                                              .host
                                              .port
                                              (movemail--get-prompt .protocol)))))
                             (when (and .password .auth-mechanisms)
                               (concat ";" .auth-mechanisms))
                             "@"
                             .host
                             (when .port (concat ":" .port))
                             (when .imap-folder (concat "/" .imap-folder))
                             (when .extra-params (concat ";" .extra-params)))))
                  creds (cdr creds)
                  links (cdr links)))))
      (movemail--check-installation #'start-process
                                    (flatten-tree
                                     (list (concat "movemail"
                                                   (when id (concat "--" id)))
                                           "*Movemail*"
                                           movemail-command
                                           movemail-flags
                                           orig-link
                                           dest-link
                                           (if use-pop-pass pop-pass ""))))))
#+end_src

#+begin_src emacs-lisp
  ;; Movemail extension: credentials system
#+end_src

#+begin_src emacs-lisp
  (defgroup movemail-credentials nil
    "Provide information to `movemail' from a lisp-data file."
    :group 'movemail
    :prefix "movemail-credentials-"
    :tag "Movemail Credentials")

  (defcustom movemail-credentials-file (expand-file-name
                                        "credentials.el"
                                        user-emacs-directory)
    "File that stores the credentials used by `movemail'.

  This must to be a lisp-data file, encrypted or not, containing
  alists whose elements can be structured as follows:

      ((foo . ((ignore . nil)
               (mail-address . \"foo@example.com\")
               (password . \"p4s3w0rd\")
               (fetch-auth . \"auth=+APOP\")
               (fetch-protocol . \"pop\")
               (fetch-server . \"pop.example.com\")
               (fetch-port . \"110\")
               (fetch-params . \"notls\")
               (inbox-filename . \"~/Mail/some-name\"))
       (bar . ((ignore .t)
               (mail-address . \"bar@example.com\")
               (fetch-protocol . \"imaps\")
               (fetch-server . \"imap.example.com\")
               (fetch-port . \"993\")
               (fetch-folder . \"INBOX\")
               (inbox-filename . (my-func args))))))

  The \"inbox-filename\" can be any file or destination link
  containing any local protocol supported by movemail, as well as a
  function that returns a string---it will be evaluated when
  needed.  See the Info node `(emacs) Movemail' for more details on
  supported links.

  It is not necessary to inform the password in the credentials
  file, since it will try to retrieve it through the `auth-source'.
  However, if unsuccessful, movemail will try to get the password
  from the traditional GNU Mailutils \"~/.mu-tickets\" file.  See
  the Info node `(mailutils) mailutils wicket' for more details
  about this file.  If `movemail-use-tickets' is nil or the tickets
  file is not in the home directory, the user will be asked for the
  password instead.

  Only fields that describes mail address, protocol, server and
  destination file name are strictly necessary."
    :type 'file
    :group 'movemail-credentials)

  (defun movemail-credentials-read ()
    "Read contents of the `movemail-credentials-file'."
    (let ((file movemail-credentials-file))
      (if (file-exists-p file)
          (with-temp-buffer
            (insert-file-contents file)
            (read (current-buffer)))
        (error "Credentials file \"%s\" not found"
               (file-name-nondirectory file)))))

  (defun movemail-credentials-list ()
    "Return a list of non-ignored mailboxes.

  Those are listed in the credentials file.  See
  `movemail-credentials-file' for more details."
    (let ((credentials (movemail-credentials-read))
          (mailboxes (list))
          (count 0))
      (while (< count (length credentials))
        (let ((current (nth count credentials)))
          (unless (alist-get 'ignore current)
            (push (car current) mailboxes)))
        (setq count (1+ count)))
      (nreverse mailboxes)))
#+end_src

#+begin_src emacs-lisp
  ;; Movemail extension: fetch mail helper
#+end_src

#+begin_src emacs-lisp
  (defgroup movemail-fetch nil
    "Extension to fetch mail in a convenient way with `movemail'."
    :group 'movemail
    :prefix "movemail-fetch-"
    :tag "Movemail Fetch")

  (defcustom movemail-fetch-filter nil
    "Filter function for processes started by `movemail-fetch-mail'.

  See `set-process-filter' for more info on filter functions."
    :type '(choice boolean function)
    :group 'movemail-fetch)

  (defcustom movemail-fetch-sentinel nil
    "Sentinel function for processes started by `movemail-fetch-mail'.

  See `set-process-sentinel' for more info on sentinels."
    :type 'function
    :group 'movemail-fetch)

  (defun movemail-fetch-mail ()
    "Fetch remote mail to a local inbox with `movemail-move-mail'.

  A filter and a sentinel function can be added to each movemail
  process execution setting `movemail-fetch-filter' and
  `movemail-fetch-sentinel', respectively.

  To use this function it will be necessary to create and set a
  credentials file.  See `movemail-credentials-file' for more
  information."
    (interactive)
    (let ((credentials (movemail-credentials-read))
          (mailboxes (movemail-credentials-list)))
      (while mailboxes
        (let-alist (alist-get (car mailboxes) credentials)
          (let ((id (symbol-name (car mailboxes)))
                (orig (list (cons 'protocol .fetch-protocol)
                            (cons 'user .mail-address)
                            (cons 'password .password)
                            (cons 'auth-mechanisms .fetch-auth)
                            (cons 'host .fetch-server)
                            (cons 'port .fetch-port)
                            (cons 'imap-folder .fetch-folder)
                            (cons 'extra-params .fetch-params)))
                (dest (list (cons 'file-name (eval .inbox-filename))))
                (process nil))
            (if (string-match-p
                 "\\(?:\\(?:imaps?\\|pops?\\|smtp\\)://\\)"
                 (alist-get 'file-name dest))
                (user-error "%s: \"inbox-filename\" is not a local mailbox" id)
              (setq process (movemail-move-mail orig dest nil id))
              (set-process-filter process movemail-fetch-filter)
              (when (functionp movemail-fetch-sentinel)
                (set-process-sentinel process movemail-fetch-sentinel)))))
        (setq mailboxes (cdr mailboxes)))))
#+end_src

#+begin_src emacs-lisp
  ;; Movemail extension: auto-fetch mail
#+end_src

#+begin_src emacs-lisp
  (defgroup movemail-auto-fetch nil
    "Auto-fetch extension for GNU Mailutils movemail on Emacs."
    :group 'movemail
    :prefix "movemail-auto-fetch-"
    :tag "Movemail Auto-Fetch")

  (defcustom movemail-auto-fetch-step 60
    "Time step to calculate the auto fetch frequency."
    :type 'integer
    :group 'movemail-auto-fetch)

  (defcustom movemail-auto-fetch-timer 5
    "Timer to auto fetch mails.

  The time step can be configured in `movemail-auto-fetch-step'."
    :type 'number
    :group 'movemail-auto-fetch)

  (defvar movemail-auto-fetch-object nil
    "Timer object generated from `movemail-auto-fetch-mode'.")

  (define-minor-mode movemail-auto-fetch-mode
    "Minor mode to auto-fetch mail in background with `movemail'."
    :global t
    :init-value nil
    :lighter " AFMail"
    (let ((time (* movemail-auto-fetch-step movemail-auto-fetch-timer))
          (object movemail-auto-fetch-object))
      (if (not movemail-auto-fetch-mode)
          (when (timerp object)
            (cancel-timer object)
            (setq movemail-auto-fetch-object nil))
        (unless (timerp object)
          (setq movemail-auto-fetch-object
                (run-with-timer 0 time #'movemail-fetch-mail))))))
#+end_src

#+begin_src emacs-lisp
  (add-hook 'after-init-hook #'movemail-auto-fetch-mode 100)
#+end_src