Source

calendar / cal-japanese.el

;;; 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
;;   ["$BF|MKF|(B" "$B7nMKF|(B" "$B2PMKF|(B" "$B?eMKF|(B" "$BLZMKF|(B" "$B6bMKF|(B" "$BEZMKF|(B"])

(defvar calendar-japanese-day-names
  ["$BF|(B" "$B7n(B" "$B2P(B" "$B?e(B" "$BLZ(B" "$B6b(B" "$BEZ(B"]
  "Japanese shortened week day names.")

;(setq calendar-month-name-array
;      ["$BKS7n(B" "$BG!7n(B" "$BLo@8(B" "$B1,7n(B" "$B;)7n(B" "$B?eL57n(B"
;       "$BJ87n(B" "$BMU7n(B" "$BD97n(B" "$B?@L57n(B" "$BAz7n(B" "$B;UAv(B"])

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

(defvar calendar-japanese-year-names
  '((1989 1 8 "$BJ?@.(B")
    (1926 12 25 "$B><OB(B")
    (1912 7 30 "$BBg@5(B")
    (1868 9 8 "$BL@<#(B")
    (1865 4 7 "$B7D1~(B")
    (1864 2 20 "$B85<#(B")
    (1861 2 19 "$BJ85W(B")
    (1860 3 18 "$BK|1d(B")
    (1854 11 27 "$B0B@/(B")
    (1848 2 28 "$B2E1J(B")
    (1844 12 2 "$B902=(B")
    (1830 12 19 "$BE7J](B")
    (1818 4 22 "$BJ8@/(B")
    (1804 2 11 "$BJ82=(B")
    (1801 2 5 "$B5|OB(B"))
  "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)$BG/(B"
			     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