Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Emacs Wanderlust mail notifier
;;; -*- 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)
;;; This will cause the summary folder lines to highlight when new
;;; mail appears in those folders. We only do this if we think we have
;;; new messages.
(defun fmg-wl-update-current-summaries ()
(let ((buffers (wl-collect-summary)))
(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:
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment