;;; yrnen.el - Convert years between A.D. and Japanese era (Meiji-Heisei)
;;; Created 2008-9-29 by David Meyer.

(setq era-list  ; - eras in reverse chron. order
                ; - epoch is day after prev. emperor's death
      '((name "Heisei"  epoch-yr 1989  epoch-mo 10  epoch-day 8)
	(name "Showa"   epoch-yr 1926  epoch-mo 12  epoch-day 25)
	(name "Taisho"  epoch-yr 1912  epoch-mo 7   epoch-day 30)
	(name "Meiji"   epoch-yr 1868  epoch-mo 9   epoch-day 9)))

(setq month-name 
      '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"))

(defun month-long (month) "Return full name of month (1-12)."
  (nth (1- month) month-name))

(defun month-short (month) "Return month (1-12) abbreviation."
  (substring (month-long month) 0 3)

(defun initial (string) "Return first character of string."
  (substring string 0 1))

;(defun get-era-prop (era-i property) "Return prop. ('name, 'epoch-yr, 'epoch-mo, 'epoch-day) of era at index."
  (plist-get (nth era-i era-list) property))
b
(defun ad->wareki (year) "Convert A.D. year to Japanese (era year)."
  (let ((era-yr-start nil) (era-yr-end nil) (prev-eras era-list))
    (while (and prev-eras (not era-yr-start))
      (let* ((e (car prev-eras)) (epoch-yr (plist-get e 'epoch-yr)))
	(setq prev-eras (cdr prev-eras))
	(cond
	 ((> year epoch-yr) (setq era-yr-start e))
	 ((= year epoch-yr) (setq era-yr-end e)))))
    


  (let ((nen nil) (i 0))
    (while (and (not nen) (< i (length era-list)))
      (let ((epoch-yr (get-era-prop i 'epoch-yr)))
	(cond ((> year epoch-yr)
		(setq nen (list i (1+ (- year epoch-yr)))))
	       ((= year epoch-yr)
		(setq nen
		      (if (= i (1- (length era-list)))
			  (list i 1)
			(list (1+ i)
			      (- epoch-yr
			         (get-era-prop (1+ i) 'epoch-yr))
			      i
			      1))))))
      (setq i (1+ i)))
  (if (not nen) '(-1) nen)))