;;; 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 attribution)
	     #:use-module (mutt helpers misc)
	     #:documentation
"Customized message attribution line when replying to messages.
Feel free to contribute with you own message attribution methods!")


(define-public builtin-attribution? #f)
(define-public attribution-sender-full? #f)

(register-boolean-option!
 "builtin-attribution?"
 "If \"yes\", use the built-in attribution mechanism.")

(register-boolean-option!
 "attribution-sender-full?"
 "If \"yes\", write the full sender address.")


(define (append-cool-message-attribution port replied mailbox)
  "Append a nice message attribution."
  (let* ((now       (current-time))
	 (date-sent (message-date-sent replied))
	 (ago       (- now date-sent))
	 (sender-addr (envelope-from (message-envelope replied)))
	 (sender (if attribution-sender-full?
		     (full-address   sender-addr)
		     (pretty-address sender-addr))))

    ; Avoid clock skews
    (if (< ago 0)
	(begin
	  (set! date-sent (message-date-received replied))
	  (set! ago (- now date-sent))))
    
    (display
     (if (>= ago 0)
	 (let* ((seconds      (modulo ago 60))
		(minutes      (modulo (quotient ago 60) 60))
		(hours        (modulo (quotient ago 3600) 24))
		(days         (quotient ago (* 3600 24)))
		(now-hours    (modulo (quotient now 3600) 24))
		(now-minutes  (modulo (quotient now 60) 60))
		(sent-hours   (modulo (quotient date-sent 3600) 24))
		(sent-minutes (modulo (quotient date-sent 60) 60)))
	   (string-append
;	    (format #f "now ~a:~a | sent ~a:~a~%"
;		    now-hours now-minutes sent-hours sent-minutes)
	    (if (> days 0)
		(if (= days 1)
		    "One day, "
		    (format #f "~a days, " days))
		(cond ((or (> sent-hours now-hours)
			   (and (= sent-hours now-hours)
				(>= sent-minutes now-minutes)))
		       "Yesterday, ")
		      (#t "Today, ")))
	    (if (> hours 0)
		(if (= hours 1)
		    "one hour, "
		    (format #f "~a hours, " hours))
		"")
	    (if (> minutes 0)
		(if (= minutes 1)
		    "one minute, "
		    (format #f "~a minutes, " minutes))
		"")
	    (if attribution-show-seconds?
		(if (> seconds 1)
		    (format #f "~a seconds ago" seconds)
		    (format #f "~a second ago" seconds))
		"")
	    ", "
	    (if attribution-split-if-needed?
		(if (> days 0) "\n" ""))
	    sender " wrote:\n"))
	 (string-append "In the future (!), "
			sender " will have written:\n"))
     port)))

(set! append-message-attribution
      (lambda (port replied mailbox)
	"Append a message attribution when replying to an email."
	(if builtin-attribution?
	    (builtin-append-message-attribution port replied mailbox)
	    (append-cool-message-attribution port replied mailbox))))
