Emacs Wanderlust mail notifier

fmg-biff.el

;;; -*- Mode: EMACS-LISP -*-

;;; A fancy notify hook for Wanderlust.
;;;
;;; Time-stamp: <2017-02-02 07:10:29 fred>
;;;

;; Note: elmo must be loaded before byte-compiling this. Otherwise,
;; when the hook runs it will produce an invalid-funcion error because
;; of the elmo-imap4-response-value macro.

;;; This isn't used as a hook. Instead, it gets run by a timer.
;;; Put the following in wl-init.el.
;;;
;;; (setq fmg-biff-timer (run-with-timer 30 30  'fmg-biff-hook))
;;; (add-hook 'wl-exit-hook (lambda nil (cancel-timer fmg-biff-timer)))

;;;
;;; All the complication is to allow displaying counts and summaries
;;; of unread messages.
;;;
;;; It may be possible to add this to wl-biff-notfy-hook. But the way
;;; it is works for now.

;;; Variables for the notifier and sound player.
;; Configure these to your preference.

;; Sox player --- works with many different file formats. If you
;; change this you will probably have to change the "dingie" process
;; invocation below to reflect the correct arguments for your player.
(defvar *mb-player* "/usr/bin/play")  

(defvar *mb-player-volume* ".33")     ; Play at 33% volume.
(defvar *mb-sound* "~/lib/sounds/emailreceived.mp3")

;; Standard freedesktop notifier. If you change the notifier you may
;; have to change the "showie" process invocation below to reflect the
;; correct arguments for whatever notifier you choose.
(defvar *mb-popup* "/usr/bin/notify-send")

;; This is not a file; it is a standard icon. It is set by whatever
;; desktop theme you may have set up. You can also use a file of your
;; choice.
(defvar *mb-icon* "mail-message-new") 

;;
;; A modified version of djcb-popup.
(defun fmg-notify (title msg &optional icon sound)
  "Show a popup and play a sound; TITLE is the title of the
message, MSG is the content. A default icon will be displayed and
a default sound will be played. Both can be replaced by supplying
the optional arguments."
  (start-process "showie" nil *mb-popup*
                 "-i" (or icon *mb-icon*) 
                 ;; NOTA BENE!!! url-insert-entities-in-string is
                 ;; necessary to avoid disruption by shell characters
                 ;; such as "<" or ">". Email messages headers often
                 ;; have these.
                 (url-insert-entities-in-string title)
                 (url-insert-entities-in-string msg))
  (start-process "dingie" nil *mb-player*
                 "-q" "-v" *mb-player-volume*
                 (expand-file-name (or sound *mb-sound*)))
  nil)

    (dolist (b buffers)
      (with-current-buffer b
        (save-excursion
          (wl-summary-sync-update))))))

;;; XXX Unfortunately for some reason the "new" value returned from
;;; ELMO-IMAP4-FOLDER-DIFF-PLUGGED doesn't seem to reflect reality. So
;;; in order to figure out when we have new messages, we sum the
;;; number of messages in each folder and then compare that with the
;;; old total. If there are more, we collect the summary information
;;; and display it, and save the new message total.

;;; Save last count of total messages in all folders we check.
(defvar fmg-biff-hook-last-total 0)

;;; How many email message summaries do you want to see in the
;;; notification?
(defvar *max-summaries* 10)

(defun fmg-biff-hook ()
  (let ((summaries "")
        (msg-unseen 0)
        (msg-total 0))

    ;; Get total number of messages in all folders.
    (dolist (f wl-biff-check-folder-list)
      (let* ((folder (elmo-get-folder f))
             (session (elmo-imap4-get-session folder)))
;;; debug
;;;     (message "Checking folder %s" f)
        (multiple-value-bind (new unseen total)
            (elmo-imap4-folder-diff-plugged folder)
          (incf msg-total total))))

;;; debug    
;;;    (message "Old message count: %d; new count %d" fmg-biff-hook-last-total msg-total)
    (when (> msg-total fmg-biff-hook-last-total)
      ;; Looks like we got some new messages.
      (setq fmg-biff-hook-last-total msg-total)

      ;; Because unread mail may not reflect new messages, we wind up
      ;; doing this loop twice. This avoids sending the SELECT command
      ;; to the imap server repeatedly when no new messages have come.
      (dolist (f wl-biff-check-folder-list)
        (wl-folder-sync-entity f)
        (let* ((folder (elmo-get-folder f))
               (session (elmo-imap4-get-session folder)))
          (multiple-value-bind (new unseen total)
              (elmo-imap4-folder-diff-plugged folder)
            (incf msg-unseen unseen)
;;; debug           
;;;         (message "%d messages unread (%d new) out of %d in folder %s" unseen new total f)
            ;; Collect unseen message summaries from each folder into SUMMARIES variable.
            (dotimes (i (min unseen *max-summaries*))
              (elmo-imap4-send-command-wait session "SELECT \"INBOX\"")
              (let* ((number (- total i))
                     (command
                      (format 
                       "FETCH %d (FLAGS BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT)])"
                       number))
                     (summary
                      (elmo-imap4-response-bodydetail-text
                       (elmo-imap4-response-value
                        (elmo-imap4-send-command-wait session command)
                        'fetch))))
                (setq summaries (concatenate 'string summaries summary)))))))
      ;; Display message summaries to the user.
      (fmg-notify
       (format "You have %d new email %s" 
               msg-unseen
               (if (= msg-unseen 1) "message" "messages"))
       summaries)
      (fmg-wl-update-current-summaries)
      )
    
    ;; If a message got deleted or something, update the counter.
    (when (< msg-total fmg-biff-hook-last-total)
      (setq fmg-biff-hook-last-total msg-total))))


(message "fmg-biff-hook loaded.")
;;; Local Variables:
;;; eval: (eldoc-mode 1)
;;; End:

Forgot I had a github account. This is my work.

Something dropped out from my original cut-and-paste. But since I posted anonymously I can't do anything to it.

Please use the forked version under user fgilham.