;;; From: Takashi Hattori <hattori@sfc.keio.ac.jp> 
;;; Subject: Japanese holiday 
;;; Newsgroups: fj.editor.emacs 
;;; Date: 20 Apr 1999 17:17:51 +0900 
;;; Message-ID: <tzpv4zu2mo.fsf@tenryu.tom.sfc.keio.ac.jp> 
;;; Organization: ToM Research Group, Keio SFC 
;;; 
;;; ex. http://queen.heart.ne.jp/cgi-bin/queen
;;;
;;; write .emacs like this
;;; (load "japanese-holidays.el")

;; Holidays in Japan
;; by T. Hattori 1999/4/20

(autoload 'solar-equinoxes/solstices "solar")

(defvar general-holidays-JP
  '((holiday-fixed-furikae 1 1 "元旦")
    (holiday-float 1 1 2 "成人の日")
    (holiday-fixed-furikae 2 11 "建国記念の日")
    (let ((equinox (solar-equinoxes/solstices 0 displayed-year)))
      (holiday-fixed-furikae (extract-calendar-month equinox)
			     (truncate (extract-calendar-day equinox))
			     "春分の日"))
    (holiday-fixed-furikae 4 29 "みどりの日")
    (holiday-fixed 5 3 "憲法記念日")
    (and (> (calendar-day-of-week (list 5 4 displayed-year))0)
	 (holiday-fixed 5 4 "国民の休日"))
    (holiday-fixed-furikae 5 5 "こどもの日")
    (holiday-fixed-furikae 7 20 "海の日")
    (holiday-fixed-furikae 9 15 "敬老の日")
    (let ((equinox (solar-equinoxes/solstices 2 displayed-year)))
      (holiday-fixed-furikae (extract-calendar-month equinox)
			     (truncate (extract-calendar-day equinox))
			     "秋分の日"))
    (holiday-fixed-furikae 10 10 "体育の日")
    (holiday-fixed-furikae 11 3 "文化の日")
    (holiday-fixed-furikae 11 23 "勤労感謝の日")
    (holiday-fixed-furikae 12 23 "天皇誕生日")))

(defun holiday-fixed-furikae (m d s)
  (append (holiday-fixed m d s)
	  (and (= (calendar-day-of-week (list m d displayed-year)) 0)
	       (holiday-fixed m (1+ d) "振替休日"))))

(defvar calendar-weekend '(0)
  "List of days of week to be marked as holiday.")
(defvar calendar-weekend-marker nil)

(defun calendar-mark-weekend ()
  (let ((m displayed-month)
	(y displayed-year))
    (increment-calendar-month m y -1)
    (calendar-for-loop
     i from 1 to 3 do
     (let ((sunday (- 1 (calendar-day-of-week (list m 1 y))))
	   (last (calendar-last-day-of-month m y)))
       (while (<= sunday last)
	 (mapcar (function
		  (lambda (x)
		    (let ((d (+ sunday x)))
		      (and (<= 1 d)
			   (<= d last)
			   (mark-visible-calendar-date (list m d y) calendar-weekend-marker)))))
		 calendar-weekend)
	 (setq sunday (+ sunday 7))))
     (increment-calendar-month m y 1))))

(add-hook 'calendar-load-hook
	  (function
	   (lambda ()
	     (setq calendar-weekend-marker calendar-holiday-marker
		   calendar-holidays (append general-holidays-JP
					     local-holidays
					     other-holidays)))))
(add-hook 'today-visible-calendar-hook 'calendar-mark-weekend)
(add-hook 'today-visible-calendar-hook 'mark-calendar-holidays)
(add-hook 'today-visible-calendar-hook 'calendar-mark-today)
(add-hook 'today-invisible-calendar-hook 'calendar-mark-weekend)
(add-hook 'today-invisible-calendar-hook 'mark-calendar-holidays)