;;; cal-japanese.el --- Japanese Calendar support

;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.

;; Author: SL Baur <steve@xemacs.org>
;; Keywords: calendar

;; This file is part of XEmacs.

;; XEmacs 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.

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

;;; Synched up with: Not in FSF

;;; Commentary:

;; 

;;; Code:

(eval-when-compile
  (require 'cl)
  (require 'calendar))

;; We're not ready for this, yet.
;; (defvar calendar-japanese-day-names
;;   ["日曜日" "月曜日" "火曜日" "水曜日" "木曜日" "金曜日" "土曜日"])

(defvar calendar-japanese-day-names
  ["日" "月" "火" "水" "木" "金" "土"]
  "Japanese shortened week day names.")

;(setq calendar-month-name-array
;      ["睦月" "如月" "弥生" "卯月" "皐月" "水無月"
;       "文月" "葉月" "長月" "神無月" "霜月" "師走"])

(defvar calendar-japanese-month-names
  ["1月" "2月" "3月" "4月" "5月" "6月"
   "7月" "8月" "9月" "10月" "11月" "12月"]
  "Japanese month names.")

(defvar calendar-japanese-year-names
  '((1989 1 8 "平成")
    (1926 12 25 "昭和")
    (1912 7 30 "大正")
    (1868 9 8 "明治")
    (1865 4 7 "慶応")
    (1864 2 20 "元治")
    (1861 2 19 "文久")
    (1860 3 18 "万延")
    (1854 11 27 "安政")
    (1848 2 28 "嘉永")
    (1844 12 2 "弘化")
    (1830 12 19 "天保")
    (1818 4 22 "文政")
    (1804 2 11 "文化")
    (1801 2 5 "亨和"))
  "Japanese year names.")

(defun calendar-japanese-year-string (year month day)
  (let ((year-alist calendar-japanese-year-names)
	year-rec result)
    (while (and (null result) (setq year-rec (pop year-alist)))
      (cond
       ((or (> year (car year-rec))
	    (and (= year (car year-rec))
		 (> month (cadr year-rec))))
	(setq result (format "%d(%s%d)年"
			     year
			     (cadddr year-rec)
			     (1+ (- year (car year-rec))))))
       ))
    (if result
	result
      (format "%d" year))))

(defun calendar-enable-japanese ()
  "Enable Japanese day and month names in the calendar."
  (interactive)
  (setq calendar-day-name-array calendar-japanese-day-names)
  (setq calendar-month-name-array calendar-japanese-month-names)
  (setq calendar-year-name-function 'calendar-japanese-year-string))

(provide 'cal-japanese)

;;; cal-japanese.el ends here