;;; Guile bindings for Mutt
;;; Copyright (C) 2003  Ludovic Courtès

;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */

(mutt-module (mutt notify)
	     #:use-module (mutt helpers misc)
	     #:documentation
"Module that provides a mean of notifying you of important
incoming messages by either opening a pop-up window (using
@code{xmessage(1)}) or writing to your terminal (using @code{write(1)}).
Note that this can be configured by redefining the @code{notify-new-message}
function which takes one message object as an argument.")



;;; Configuration options

(define-public notify-pattern (compile-pattern "~A"))

(define (set-notify-pattern! name pattern hint)
  "Ask to be notified for every new message matching @var{pattern}."
  (let ((pat (compile-pattern pattern)))
    (if (not pat)
        (and
	  (set-error-message! (string-append pattern ": Invalid pattern")) #f)
	(begin
	  (ui-message
	    (format #f "You will be notified for messages matching ~a"
	     pattern))
	  (set! notify-pattern pat)))))

(register-option! "notify-pattern" #f set-notify-pattern!
		  "Pattern of messages for which you want to be notified.")

(define-public (notify-new-message message)
  "Procedure (that may be modified) which notifies the user of new incoming
message @var{message}."
  (let* ((envelope    (message-envelope message))
	 (sender-addr (envelope-from envelope))
	 (sender      (pretty-address sender-addr))
	 (subject     (quote-string (envelope-real-subject envelope))))
    (if (getenv "DISPLAY")
	(system (format #f "xmessage -default okay \"From ~a: ~a\" &"
			sender subject))
	(system (format #f "echo \"From ~a: ~a\" | write \"~a\""
			sender subject (cuserid))))))

; This can be seen as a particular `aspect', in the AOP sense, of the message
; scoring function.
(define-aspect (score-message message update-mailbox? mailbox)
  "Notify about important incoming messages."
  (if (and (not (message-read? message))
	   (execute-pattern notify-pattern message M_MATCH_FULL_ADDRESS))
      (notify-new-message message))
  (next-aspect message update-mailbox? mailbox))
