Emacs Wanderlust mail notifier

fmg-biff.el

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

;;; A fancy notify hook for Wanderlust.
;;;
;;; Time-stamp: <2019-09-26 15:45:18 fred>
;;;

;;;; Usage:
;;;
;;; 1. Set the variable wl-biff-check-folder-list to the list of
;;;    folders you want biff to check.
;;;
;;; 2. Set the wl-biff-check-interval and wl-biff-use-idle-timer
;;;    variables as you like them. 
;;;
;;; 3. Call the following:
;;;    (fmg-setup-biff-hook-notifier)
;;;
;;; If you have a gmail folder, you must set wl-strict-diff-folders to
;;; the list of gmail folders you want checked:
;;;
;;; (setq wl-strict-diff-folders
;;;  '("%INBOX:username/clear@imap.gmail.com:993!"))
;;;
;;; The folder names in this list should match the entries in the
;;; folders file exactly.
;;;
;;; It seems to work more robustly if you add all the folders you want
;;; biff to check to the wl-strict-diff-folders list. It appears to
;;; depend on how your IMAP server handles "recents".
;;;

;;;
;;; All this complication is to pop up a display of counts and
;;; summaries of unread messages.
;;;

(require 'wl)
(autoload 'elmo-imap4-get-session "elmo-imap4")
(autoload 'elmo-imap4-folder-diff-plugged "elmo-imap4" "Update folder stats" nil t)
(autoload 'elmo-imap4-send-command-wait "elmo-imap4")
(autoload 'elmo-imap4-response-bodydetail-text "elmo-imap4" "Return body text" nil t)
(autoload 'elmo-imap4-response-value "elmo-imap4" "Get value of symbol from response" nil t)


;;; Debug
(defvar fmg-biff-debug nil "Set to t to enable debug messages from notifier code.")

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

(defvar fmg-mb-player "/usr/bin/play"
  "The pathname of the sound player to use. This is set to the
sox player --- works with many different file formats. If you
change this you may have to change the \"dingie\" process
invocation in the fmg-biff-hook.el file to reflect the correct
arguments for your player.")

(defvar fmg-mb-player-volume ".33" 
  "Volume level with 1.0 as the highest level.")

(defvar fmg-mb-sound "~/lib/sounds/emailreceived.mp3" "Path to the
sound file played by the player selected.")
  
(defvar fmg-mb-popup "/usr/bin/notify-send"
  "Notifer to pop up the summary message. Defaults to 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 *fmg-mb-icon* "mail-message-new" 
  "This is not a file; it is the name of a standard icon. It is
set by whatever desktop theme you may have set up (assuming you
use the standard desktop notifier above). You can also use a file
of your choice." )

;;
;; A modified version of djcb-popup.
;; See https://emacs-fu.blogspot.com/2009/11/showing-pop-ups.html

(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 fmg-mb-popup
		 "-i" (or icon *fmg-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 fmg-mb-player
		 "-q" "-v" fmg-mb-player-volume
		 (expand-file-name (or sound fmg-mb-sound)))
  nil)

;;;;
;;; Defvars for the hook function.

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

(defun show-summaries (summaries unseen)
;;; debug
  (when fmg-biff-debug
    (message "notifying %d unseen email" unseen))
  (fmg-notify
   (format "You have %d unseen email %s" 
	   unseen	   
	   (if (= unseen 1) "message" "messages"))
   summaries))
  
(defun collect-summaries-for-folder (f)
;;; debug
  (when fmg-biff-debug
    (message "collecting summaries for %s" f))

  (let* ((summaries "")
	 (folder (elmo-get-folder f))
	 (session (elmo-imap4-get-session folder)))
    (multiple-value-bind (new unseen total)
	(elmo-imap4-folder-diff-plugged folder)
      ;; Collect unseen message summaries from each folder into SUMMARIES variable.
      (dotimes (i unseen)
	(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))))
	  (setf summaries (concatenate 'string summaries summary))))
;;; debug
      (when fmg-biff-debug
	(message "%d unseen messages for folder %s" unseen f))
      (list summaries unseen))))


(defun fmg-biff-hook ()
  "Hook to add to the wl-biff-notify-hook."

;;; debug
  (when fmg-biff-debug
    (message "Running fmg-biff-hook"))
  
  ;; If we get called, something must have happened.
  (let ((summaries "")
	(total-new 0)
	(total-unseen 0)
	(max-summaries *fmg-max-summaries*))

    (dolist (f wl-biff-check-folder-list)
;;; debug
      (when fmg-biff-debug
	(message "Collecting summaries for %s." f))
      (when (> max-summaries 0)
	(multiple-value-bind (new-summaries count)
	    (collect-summaries-for-folder f)
	  (when (> count 0)
	    (setf total-unseen (+ total-unseen count))
	    (setf max-summaries (- max-summaries count))
	    (setf summaries (concatenate 'string summaries new-summaries))))))

    (if (> total-unseen 0)
	;; Display message summaries to the user.
	(show-summaries summaries total-unseen)

;;; debug
      (when fmg-biff-debug
	(message "No messages to show")))))


(defun fmg-setup-biff-hook-notifier ()
  "Adds a notifier to the biff hook that displays summaries of
new and unread messages."
  (add-hook 'wl-biff-notify-hook 'fmg-biff-hook)
  )


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