;;; Dates.el
;;; Simple library of routines for dealing with dates.
;;; by Boris Goldowsky <boris@psych.rochester.edu>

(require 'point-at)
(autoload 'day-number "cal" "Converts MONTH DAY YEAR to day in year")
(autoload 'f+ "float.el" "Floating point addition")

(defun date-read (&optional default prompt)
  "Read a date from the minibuffer, using (optional) DEFAULT and PROMPT"
  (if (not default)
      (setq default (date-current-date))
    (setq default (date-beautify default)))
  (if (not prompt)
      (setq prompt (format "Date (default %s, or = for today): " default)))
  (let ((input (read-string prompt)))
    (cond ((equal input "") default)
	  ((equal input "=") (date-current-date))
	  (t input))))

;;;
;;; Functions to deal with dates of the form: "7mar91"
;;;                                       or: " 07 March   1991."

(defun date-parse (date)
  "Given string DATE, returns (year month day index), 4 ints.  The last 
is the index of the first character in the string following the date.
Defaults to current month and year, but day 0, so that Apr91 will end up before
1apr91 in sorted order."
  (if (date-parse-date_ date)
      (list (or (date-year_  date) (date-current-year))
	    (or (date-month_ date) (date-current-month))
	    (or (date-day_   date) (date-current-day))
	    (date-end_ date))))

(defun date-parse-nodefault (date)
  "Like date-parse, but will not fill in missing parts of dates
with defaults.  Instead, returns nil for that part, or nil for the
whole date if nothing matched."
  (if (date-parse-date_ date)
      (list (date-year_ date)
	    (date-month_ date)
	    (date-day_ date)
	    (date-end_ date))))

(defun date-day (date)
  "User-level routine to get day from DATE"
  (if (date-parse-date_ date)
      (date-day_ date)))

(defun date-month (date)
  "User-level routine to get number of month from DATE"
  (if (date-parse-date_ date)
      (date-month_ date)))

(defun date-monstr (date)
  "User-level routine to get name of month from DATE"
  (if (date-parse-date_ date)
      (date-monstr_ date)))

(defun date-year (date)
  "User-level routine to get year from DATE"
  (if (date-parse-date_ date)
      (date-year_ date)))

(defun date-to-day-number (date)
  "Returns day in year for DATE, so 1feb92 yields 32."
  (if (date-parse-date_ date)
      (day-number (date-month_ date) (date-day_ date) (date-year_ date))))

(defun date-to-epoch (date)
  "Returns DATE as a decimal year, so 1feb92 yields 92.0847
\(or approximately 92 1/12).  A floating point object is returned, see 
float.el for details.  Does not account for leap years."
  (if (date-parse-date_ date)
      (f+ (f (date-year_ date))
	  (f/ (f (day-number (date-month_ date) (date-day_ date) 
			     (date-year_ date)))
	      (f 366)))))

(defun date-beautify (date)
  "Puts DATE into canonical format"
  (let ((y-m-d-rest (date-parse date)))
    (date-sarp (elt y-m-d-rest 0) (elt y-m-d-rest 1) (elt y-m-d-rest 2))))

(defun date-sarp (year month day)
  (concat (int-to-string day)
	  (nth month '(nil "jan" "feb" "mar" "apr" "may" "jun" "jul" "aug"
		       "sep" "oct" "nov" "dec"))
	  (int-to-string year)))

(defun date-insert-today ()
  (interactive)
  (insert-string (date-current-date)))

(defun date-complete (&optional default)
  "Auto-complete the date before point.
If optional arg DEFAULT is missing, missing parts of date are filled in 
with today's day, month, year."
  (interactive)
  (let* ((end (point))
	 (beg (point-at (beginning-of-line)))
	 (new (date-beautify (buffer-substring beg end))))
    (delete-region beg end)
    (insert new)))

;;;
;;; Internal functions for the above.
;;;

(defun date-parse-date_ (date)
  "Internal function to set up match-beginning and -end data.
Returns nonnil if there was anything at all there to match."
  (and (string-match 
	"^[ \t]*\\([0-9]*\\)[ \t]*\\([A-Za-z]*\\)[ \t]*\\([0-9]*\\)" date)
       (>= (match-end 0) 0)))

(defun date-day_ (date)
  (string-to-int date))

(defun date-monstr_ (date)
  (substring date (match-beginning 2) (match-end 2)))

(defun date-month_ (date)
  (monstr-month (date-monstr_ date)))
    
(defun date-year_ (date)
  (let ((date (substring date (match-beginning 3))))
    (if (>= (length date) 2)
	(string-to-int date))))

(defun date-end_ (date)
  "Index of first character after the date."
  (match-end 0))

(defun monstr-month (monstr)
  "Return numerical month given string name, or nil."
  (if (>= (length monstr) 3)
      (let ((mon (substring monstr 0 3))
	    (case-fold-search t))
	(cond ((date-string-fold-equal mon "jan") 1)
	      ((date-string-fold-equal mon "feb") 2)
	      ((date-string-fold-equal mon "mar") 3)
	      ((date-string-fold-equal mon "apr") 4)
	      ((date-string-fold-equal mon "may") 5)
	      ((date-string-fold-equal mon "jun") 6)
	      ((date-string-fold-equal mon "jul") 7)
	      ((date-string-fold-equal mon "aug") 8)
	      ((date-string-fold-equal mon "sep") 9)
	      ((date-string-fold-equal mon "oct") 10)
	      ((date-string-fold-equal mon "nov") 11)
	      ((date-string-fold-equal mon "dec") 12)))))

(defun date-string-fold-equal (a b)
  "Like string-equal, but respects the setting of case-fold-search."
  (let ((ptr (length a)))
    (if (/= ptr (length b))
	nil
      (setq ptr (- ptr 1))
      (while (and (>= ptr 0)
		  (char-equal (aref a ptr) (aref b ptr)))
	(setq ptr (- ptr 1)))
      (= ptr -1))))

;;; The following commands work on "datestrings," ie strings of the form 
;;; returned by (current-time-string).  May not be portable to different OS.

(defun date-current-date () (date-timestring-date (current-time-string)))

(defun date-parse-timestring (s)
  (list (string-to-int (date-timestring-yearstr s))
	(monstr-month (date-timestring-monstr s))
	(string-to-int (date-timestring-yearstr s))))

(defun date-timestring-date (s)
  (concat (date-timestring-daystr s) 
	  (substring (date-timestring-monstr s) 0 3)
	  (date-timestring-yearstr s)))

(defun date-current-day ()
  (string-to-int (date-timestring-daystr (current-time-string))))
(defun date-current-month () 
  (monstr-month (date-timestring-monstr (current-time-string))))
(defun date-current-year ()
  (string-to-int (date-timestring-yearstr (current-time-string))))

(defun date-timestring-daystr (s) (if (= ?\  (aref s 8))
				 (substring s 9 10)
			       (substring s 8 10)))
(defun date-timestring-monstr (s) (substring s 4 7))
(defun date-timestring-yearstr (s) (substring s -2))

(defun date-equal (a b)
  "Returns t iff A and B are the same date."
  (let ((a (date-parse a))
	(b (date-parse b)))
    (and a b (equal a b))))

(defun date-lessp (a b)
  "Returns t if A is earlier than B, where both are dates"
  (let ((a (date-parse a))
	(b (date-parse b)))
    (and a b (date-list-lessp a b))))

(defun date-list-lessp (a b)
  "Compares A and B item by item, returns t if at the first
divergence A is smaller.  A and B should be lists of integers."
  (cond ((null a) nil)
	((null b) nil)
	((< (car a) (car b)) t)
	((> (car a) (car b)) nil)
	(t (date-list-lessp (cdr a) (cdr b)))))

(provide 'dates)