;;; 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.

;;; Automagically replies to emails whose subject is "PING".

(mutt-module (mutt ping)
	     #:use-module (mutt helpers send)
	     #:documentation
"This module enables automagic reply to incoming messages whose subject
is equal to @var{ping-subject}.
Yeah, this is one of my favorites. :-)")


(define-public ping-enabled?       #t)
(define-public ping-subject       "PING")
(define-public ping-reply-subject "PONG!")
(define-public ping-file-name     "/tmp/.mutt-ping")
(define-public ping-command       "w")
(define-public ping-include-body? #t)
(define-public ping-show-unread-messages? #t)

(register-boolean-option!
 "ping-enabled?"
 "Tells whether the ping feature is enabled.")

(register-option! "ping-subject"   #f  #f
		  "Ping message subject.")

(register-option! "ping-reply-subject" #f #f
		  "Ping reply message subject.")

(register-option! "pong-subject"
		  (lambda (name) ping-reply-subject)
		  (lambda (name value hint)
		    (set! ping-reply-subject value))
		  "Ping reply message subject.")

(register-option! "ping-file-name" #f #f
		  "Name of the file containing the ping reply.")

(register-option! "ping-command"   #f #f
		  "Command whose output is directed to $ping-file-name.")

(register-boolean-option!
 "ping-include-body?"
 "Tells whether the original message body should be included in
the reply message")

(register-boolean-option!
 "ping-show-unread-messages?"
 "If true, tell the sender of the ping message how many pending unread
messages from him you have.")



(define-public (ping-run-command)
  "The function that is executed to produce the @var{ping-file-name} file
(it may be changed)."
  (system (string-append ping-command " > " ping-file-name)))

(define-public (ping-reply message mailbox)
  "If @var{message}'s subject is equal to @var{ping-subject}, then
automatically send a reply message with subject @var{ping-reply-subject}.
If @var{mailbox} is false, @code{current-mailbox} is assumed."
  (if (not mailbox)
      (set! mailbox (current-mailbox)))
  (let* ((subject (envelope-subject (message-envelope message)))
	 (rcpt    (envelope-to (message-envelope message)))
	 (sender  (envelope-from (message-envelope message)))
	 (sender-mailbox (and sender (address-mailbox sender))))
    (if (and (not (message-read? message))
	     (not (message-replied? message))
	     (address-is-user? rcpt)
	     (not (is-mailing-list? sender))
	     (string=? ping-subject subject))
	(begin
	  (ping-run-command)
	  (let ((pong-msg
		 (build-simple-message ping-reply-subject
				       sender ping-file-name)))
	    
	    (update-message-references pong-msg message)

	    (if (or ping-include-body? ping-show-unread-messages?)
		(let ((port (false-if-exception
			     (open-file ping-file-name "a"))))
		  ;; Show the number of unread messages from the guy
		  (if (and ping-show-unread-messages? port)
		      (let ((unread (length
				     (mailbox-select-messages
				      (lambda (m)
					(and sender-mailbox
					     (string-ci=?
					      sender-mailbox
					      (address-mailbox
					       (envelope-from
						(message-envelope m))))))))))
			(if (= 0 unread)
			    (display "\nNo unread message from you.\n" port)
			    (format port "~a unread message~a from you.\n"
				    unread
				    (if (= 1 unread) "" "s")))))

		  ;; Include the original email body
		  (if (and ping-include-body? port
			   (newline port)
			   (include-reply-body port message mailbox))
		      #t
		      (ui-error "ping: Unable to include reply body"))
		  
		  (if port (close-port port))))
	    
	    (if (builtin-send-message pong-msg)
		(begin
		  (message-reply! message #t mailbox)
		  (ui-message "Successfully replied to ping")
		  (sleep 1))
		(ui-message "Failed to send ping reply!"))
	    (false-if-exception (delete-file ping-file-name)))))))

(define-aspect (score-message message update-mailbox? mailbox)
  "The automatic reply aspect."
  (if ping-enabled?
      (ping-reply message mailbox))
  (next-aspect message update-mailbox? mailbox))
