;; Copyright (C) 1999--2000 Jens Klöcker

;; Contributors: Jens Klöcker <kloecker@springer.de>
;;               Andreas Fuchs <asf@acm.org>
;; Created: 1999-10-07
;; Version: $Id: sc-jk-headers.el,v 1.5 2000/05/17 09:27:22 kloecker Exp $
;; Keywords: mail news supercite gnus lisp

;; 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Requirements: supercite
;;               gnus

;; To load the library insert
;;
;;    (require 'sc-jk-headers)
;;
;; into your .emacs or .gnus file. 

;; The provided functions for citation headers are
;;
;;    * sc-jk-header-on-wrote
;;
;; You can tell supercite to use an extra function by inserting 
;; it into sc-rewrite-header-list. You can choose your preferred one by
;; setting sc-preferred-header-style.

;;; Code:

(defconst sc-jk-headers-version "0.2"
  "This version of sc-jk-headers.")

(defun sc-jk-normalize-date (date)
  "Extract the date (day month year) from an RFC 822 message
and write it as year-month-day (ISO 8601)"
  (let ((date-list (cdr (cdr (cdr (parse-time-string date))))))
    (let ((day (pop date-list)))
      (let ((month (pop date-list)))
	(let ((year (car date-list)))
	  (and 
	   year month day 
	   (format "%d-%02d-%02d" year month day)))))))

(defun sc-jk-switch-name (name)
  "Last name, first name --> first name last name"
  (if (string-match "^ *\\([^,]+\\) *, *\\([^,]+\\) *$" name)
      (concat (match-string 2 name) " " (match-string 1 name))
    name))

(defvar sc-jk-user-name 
  (user-full-name)
  "Regexp for the full user name.
This regexp is compared with sc-author and, if matches, 
the full name will be replaced withsc-jk-header-self-intro.")

(defvar sc-jk-blank-lines-before-header 1
  "Number of blank lines to insert before the header.")

(defvar sc-jk-header-fill-character ?=
  "Leading (repeated) character for header.")

(defvar sc-jk-header-self-intro "I"
  "String to show instead of name when citing my own messages.")

(defun sc-jk-header-on-wrote ()
  "\"On <date>, <from> (attr) wrote:\""
  (let ((sc-mumble ""))
    (let ((author (sc-mail-field "sc-author"))
	  (normal-date (sc-jk-normalize-date (sc-mail-field "date")))
	  (tag-string-length (+ 
			      (length (sc-mail-field "sc-attribution"))
			      (length sc-citation-leader))))
      (let ((sc-reference-tag-string 
	     (concat (make-string sc-jk-blank-lines-before-header ?\n)
		     (if (not sc-nested-citation-p)
			 (concat (make-string tag-string-length 
					      sc-jk-header-fill-character) 
				 sc-citation-delimiter " ")))))
	(if author
	    (insert sc-reference-tag-string
		    (if (equal normal-date 
			       (sc-jk-normalize-date (current-time-string)))
			"Today, "
		      (sc-hdr "On " normal-date ", "))
		    (sc-hdr "" 
			    (if (string-match sc-jk-user-name author)
				sc-jk-header-self-intro
			      (sc-jk-switch-name author))
			    " ")
		    (sc-hdr "<" (sc-mail-field (if sc-nested-citation-p
						   "sc-from-address"
						 "sc-attribution")) ">")
		    " wrote:\n"))))))

(provide 'sc-jk-headers)

;;; sc-jk-headers.el ends here