GopherProxy

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