;;; mcalendar.el --- Mini-Calendar on Emacs -*- lexical-binding: nil -*-
;;;
;;; Version: 2026/05/01
;;;
;;; Install
;;;  copy mcalendar.el to /usr/share/emacs/site-lisp/.
;;;
;;; Setting
;;;  add to .emacs
;;;  ----
;;;  (require 'mcalendar)
;;;  ----
;;;
;;; Start
;;;  M-x mcalendar
;;;

;;; Code:

(defcustom mcalendar-month-caption-faceprop
  (list :foreground "blue"     ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-sunday-caption-faceprop
  (list :foreground "maroon"   ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-weekday-caption-faceprop
  (list :foreground "dark cyan") "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-saturday-caption-faceprop
  (list :foreground "maroon"   ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-sunday-faceprop
  (list :foreground "red"      ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-saturday-faceprop
  (list :foreground "blue"     ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-today-faceprop
  (list :underline t           ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-holiday-faceprop
  (list :background "orange"   ) "" :group 'mcalendar :type 'face-properties)
(defcustom mcalendar-display-width
  1 "横に並べるカレンダーの数を指定します" :group 'mcalendar :type 'integer)
(defcustom mcalendar-display-height
  1 "縦に並べるカレンダーの数を指定します" :group 'mcalendar :type 'integer)
(defcustom mcalendar-display-holidayname
  t "祝日名の表示/非表示を指定します"      :group 'mcalendar :type 'boolean)

(defcustom mcalendar-holidays
  '(((fixed-holiday    1  1 "元日"              ) ( 7 20 1948)             )
    ((fixed-holiday    1 15 "成人の日"          ) ( 7 20 1948) (12 31 1999))
    ((happy-monday     1  2 "成人の日"          ) ( 1  1 2000)             )
    ((fixed-holiday    2 11 "建国記念の日"      ) ( 6 25 1967)             )
    ((fixed-holiday    2 23 "天皇誕生日"        ) ( 5  1 2019)             )
    ((solar-equinoxes  3 20 "春分の日"          ) ( 7 20 1948)             )
    ((fixed-holiday    4 29 "天皇誕生日"        ) ( 7 20 1948) ( 2 17 1989))
    ((fixed-holiday    4 29 "みどりの日"        ) ( 2 17 1989) ( 1  1 2007))
    ((fixed-holiday    4 29 "昭和の日"          ) ( 1  1 2007)             )
    ((fixed-holiday    5  3 "憲法記念日"        ) ( 7 20 1948)             )
    ((fixed-holiday    5  4 "みどりの日"        ) ( 1  1 2007)             )
    ((fixed-holiday    5  5 "こどもの日"        ) ( 7 20 1948)             )
    ((fixed-holiday    7 24 "スポーツの日"      ) ( 7  1 2020) ( 7 31 2020))
    ((fixed-holiday    7 23 "スポーツの日"      ) ( 7  1 2021) ( 7 31 2021))
    ((fixed-holiday    7 20 "海の日"            ) ( 1  1 1996) ( 1  1 2003))
    ((happy-monday     7  3 "海の日"            ) ( 1  1 2003) (12 31 2019))
    ((fixed-holiday    7 23 "海の日"            ) ( 7  1 2020) ( 7 31 2020))
    ((fixed-holiday    7 22 "海の日"            ) ( 7  1 2021) ( 7 31 2021))
    ((happy-monday     7  3 "海の日"            ) ( 1  1 2022)             )
    ((fixed-holiday    8 11 "山の日"            ) ( 1  1 2016) (12 31 2019))
    ((fixed-holiday    8 10 "山の日"            ) ( 8  1 2020) ( 8 31 2020))
    ((fixed-holiday    8  8 "山の日"            ) ( 8  1 2021) ( 8 31 2021))
    ((fixed-holiday    8 11 "山の日"            ) ( 1  1 2022)             )
    ((fixed-holiday    9 15 "敬老の日"          ) ( 6 25 1966) ( 1  1 2003))
    ((happy-monday     9  3 "敬老の日"          ) ( 1  1 2003)             )
    ((solar-equinoxes  9 23 "秋分の日"          ) ( 7 20 1948)             )
    ((fixed-holiday   10 10 "体育の日"          ) ( 6 25 1966) ( 1  1 2000))
    ((happy-monday    10  2 "体育の日"          ) ( 1  1 2000) (12 31 2019))
    ((happy-monday    10  2 "スポーツの日"      ) ( 1  1 2022)             )
    ((fixed-holiday   11  3 "文化の日"          ) ( 7 20 1948)             )
    ((fixed-holiday   11 23 "勤労感謝の日"      ) ( 7 20 1948)             )
    ((fixed-holiday   12 23 "天皇誕生日"        ) ( 2 17 1989) ( 4 30 2019))
    ;;----------------------------------------------------------------------
    ((fixed-holiday    1  7 "人日"              ) ( 1  1 1868) (12 31 1872))
    ((fixed-holiday    3  3 "上巳"              ) ( 1  1 1868) ( 1  4 1873))
    ((fixed-holiday    5  5 "端午"              ) ( 1  1 1868) ( 1  4 1873))
    ((fixed-holiday    7  7 "七夕"              ) ( 1  1 1868) ( 1  4 1873))
    ((fixed-holiday    9  9 "重陽"              ) ( 1  1 1868) ( 1  4 1873))
    ;;----------------------------------------------------------------------
    ((fixed-holiday    1  3 "元始祭"            ) (10 14 1873) ( 7 20 1948))
    ((fixed-holiday    1  5 "新年宴会"          ) (10 14 1873) ( 7 20 1948))
    ((fixed-holiday    1 30 "孝明天皇祭"        ) (10 14 1873) ( 9  3 1912))
    ((fixed-holiday    2 11 "紀元節"            ) (10 14 1873) ( 7 20 1948))
    ((fixed-holiday    4  3 "神武天皇祭"        ) (10 14 1873) ( 7 20 1948))
    ((fixed-holiday    9 17 "神嘗祭"            ) (10 14 1873) ( 7  5 1879))
    ((fixed-holiday   11  3 "天長節"            ) (10 14 1873) ( 9  3 1912))
    ((fixed-holiday   11 23 "新嘗祭"            ) (10 14 1873) ( 7 20 1948))
    ((solar-equinoxes  3 20 "春季皇霊祭"        ) ( 6  5 1878) ( 7 20 1948))
    ((solar-equinoxes  9 23 "秋季皇霊祭"        ) ( 6  5 1878) ( 7 20 1948))
    ((fixed-holiday   10 17 "神嘗祭"            ) ( 7  5 1879) ( 7 20 1948))
    ((fixed-holiday    7 30 "明治天皇祭"        ) ( 9  3 1912) ( 3  3 1927))
    ((fixed-holiday    8 31 "天長節"            ) ( 9  3 1912) ( 3  3 1927))
    ((fixed-holiday   10 31 "天長節祝日"        ) (10 31 1913) ( 3  3 1927))
    ((fixed-holiday    4 29 "天長節"            ) ( 3  3 1927) ( 7 20 1948))
    ((fixed-holiday   11  3 "明治節"            ) ( 3  3 1927) ( 7 20 1948))
    ((fixed-holiday   12 25 "大正天皇祭"        ) ( 3  3 1927) ( 7 20 1948))
    ;;----------------------------------------------------------------------
    ((fixed-holiday    4 10 "明仁親王の結婚の儀") ( 4  1 1959) ( 4 30 1959))
    ((fixed-holiday    2 24 "昭和天皇の大喪の礼") ( 2  1 1989) ( 2 28 1989))
    ((fixed-holiday   11 12 "即位礼正殿の儀"    ) (11  1 1990) (11 30 1990))
    ((fixed-holiday    6  9 "徳仁親王の結婚の儀") ( 6  1 1993) ( 6 30 1993))
    ((fixed-holiday    5  1 "天皇の即位の日"    ) ( 1  1 2019) ( 5 31 2019))
    ((fixed-holiday   10 22 "即位礼正殿の儀"    ) ( 1  1 2019) (10 31 2019))
    )
  "休日リスト"
  :group 'mcalendar
  :type 'mcalendar-holidays-list
  )

(defvar mcalendar-buffername "*mcalendar*"
  "MiniCalendar buffer name")

(defvar mcalendar-cur-year  0)
(defvar mcalendar-cur-month 0)
(defvar mcalendar-cur-day   0)

(defvar mcalendar-mode-line-format
  '("    "
    mode-line-frame-identification
    mode-line-buffer-identification))

(defvar mcalendar-local-map nil)

(defvar mcalendar-etovec   ["申" "酉" "戌" "亥" "子" "丑" "寅" "卯" "辰" "巳" "午" "未"])

(defvar mcalendar-month-en  ["January" "February" "March" "April" "May" "June"
                             "July" "August" "September" "October" "November" "December"])
(defvar mcalendar-month-ja1 [" 1月" " 2月" " 3月" " 4月" " 5月" " 6月"
                             " 7月" " 8月" " 9月" "10月" "11月" "12月"])
(defvar mcalendar-month-ja2 ["睦月" "如月" "弥生" "卯月" "皐月" "水無月"
                             "文月" "葉月" "長月" "神無月" "霜月" "師走"])

(defcustom mcalendar-monthvec mcalendar-month-en
  "月の表示方法を指定します。
mcalendar-month-en, mcalendar-month-ja1, mcalendar-month-ja2
が用意されています。"
  :group 'mcalendar :type 'mcalender-custom-variable)

(defvar mcalendar-daynames-en ["Su " "Mo Tu We Th Fr " "Sa\n"])
(defvar mcalendar-daynames-ja ["日 " "月 火 水 木 金 " "土\n"])

(defcustom mcalendar-daynames mcalendar-daynames-en
  "曜日の表示方法を指定します。
mcalendar-daynames-en, mcalendar-daynames-ja
が用意されています。"
  :group 'mcalendar :type 'mcalender-custom-variable)

(defvar mcalendar-capformat-en '(format "%11s %4d %3s\n" (mcalendar-get-monthname month) year ""))
(defvar mcalendar-capformat-ja '(format "%3s  %4d年 %3s\n"
                                        (mcalendar-get-eto year)
                                        year
                                        (mcalendar-get-monthname month)))
(defvar mcalendar-capformat-ja2
  '(format
    "%s %s\n%s年\n"
    (cond
     ((<= 2019 year)
      (if (eq year 2019)
          (format "㋿元年/㍻%d年" (1+ (- year 1989)))
        (format "㋿%d年" (1+ (- year 2019)))))
     ((and (<= 1989 year) (<= year 2019))
      (if (eq year 1989)
          (format "㍻元年/㍼%d年" (1+ (- year 1926)))
        (format "㍻%d年" (1+ (- year 1989)))))
     ((and (<= 1926 year) (<= year 1989))
      (if (eq year 1926)
          (format "㍼元年/㍽%d年" (1+ (- year 1912)))
        (format "㍼%d年" (1+ (- year 1926)))))
     ((and (<= 1912 year) (<= year 1926))
      (if (eq year 1912)
          (format "㍽元年/㍾%d年" (1+ (- year 1868)))
        (format "㍽%d年" (1+ (- year 1912)))))
     ((and (<= 1868 year) (<= year 1912))
      (if (eq year 1868)
          (format "㍾元年")
        (format "㍾%d年" (1+ (- year 1868)))))
     (t (format "%d年" year)))
    (mcalendar-get-monthname month)
    year))

(defcustom mcalendar-capformat mcalendar-capformat-en
  "年の表示方法を指定します。
mcalendar-capformat-en, mcalendar-capformat-ja, mcalendar-capformat-ja2
が用意されています。"
  :group 'mcalendar :type 'mcalender-custom-variable)

(defun mcalendar(&optional othwin)
  "MiniCalendar"
  (interactive)

  (let ((selected))
    (setq selected (selected-window))
    (if othwin
        (switch-to-buffer-other-window mcalendar-buffername)
      (switch-to-buffer mcalendar-buffername))
    (setq major-mode 'mcalendar-mode
          mode-name "mcalendar mode")
    (setq mcalendar-local-map (make-keymap))
    (define-key mcalendar-local-map "p"  'mcalendar-backward-month)
    (define-key mcalendar-local-map "n"  'mcalendar-forward-month)
    (define-key mcalendar-local-map "."  'mcalendar-goto-today)
    (define-key mcalendar-local-map "h"  'mcalendar-toggle-display-holidayname)
    (define-key mcalendar-local-map "g"  'mcalendar-goto-month)
    (define-key mcalendar-local-map "t"  'mcalendar-set-display-tiling-size)
    (define-key mcalendar-local-map "q"  'mcalendar-quit-mcalender)
    (use-local-map mcalendar-local-map)
    (select-window selected))
  (mcalendar-init-rend))

(defun mcalendar-init-rend ()
  (setq mcalendar-cur-year  (string-to-number (format-time-string "%Y")))
  (setq mcalendar-cur-month (string-to-number (format-time-string "%m")))
  (setq mcalendar-cur-day   (string-to-number (format-time-string "%d")))
  (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname))

(defun mcalendar-other-window(&optional othwin)
  "MiniCalendar"
  (interactive)
  (mcalendar t))

(defun mcalendar-goto-today ()
  (interactive)
  (setq mcalendar-cur-year  (string-to-number (format-time-string "%Y")))
  (setq mcalendar-cur-month (string-to-number (format-time-string "%m")))
  (setq mcalendar-cur-day   (string-to-number (format-time-string "%d")))
  (if (mcalendar-check-buffer)
      (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))

(defun mcalendar-backward-month ()
  (interactive)
  (setq mcalendar-cur-year (+ mcalendar-cur-year (if (= mcalendar-cur-month 1) -1 0)))
  (setq mcalendar-cur-month (+ (% (+ (+ mcalendar-cur-month -1) 11) 12) 1))
  (if (mcalendar-check-buffer)
      (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))

(defun mcalendar-forward-month ()
  (interactive)
  (setq mcalendar-cur-year (+ mcalendar-cur-year (if (= mcalendar-cur-month 12) 1 0)))
  (setq mcalendar-cur-month (+ (% (+ (+ mcalendar-cur-month -1) 1) 12) 1))
  (if (mcalendar-check-buffer)
      (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))

(defun mcalendar-toggle-display-holidayname ()
  (interactive)
  (setq mcalendar-display-holidayname (not mcalendar-display-holidayname))
  (if (mcalendar-check-buffer)
      (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))

(defun mcalendar-quit-mcalender ()
  (interactive)
  (kill-buffer mcalendar-buffername))

(defun mcalendar-goto-month (y m)
  (interactive "nYear: \nnMonth(1-12): ")
  (if (or (< m 1) (< 12 m))
      (message "Month Please specify in the 1-12.")
    (progn
      (setq mcalendar-cur-year  y)
      (setq mcalendar-cur-month m)
      (setq mcalendar-cur-day   1)
      (if (mcalendar-check-buffer)
          (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))
    ))

(defun mcalendar-set-display-tiling-size (w h)
  (interactive "nNum of width: \nnNum of height: ")
  (if (and (< 0 w) (< 0 h))
      (progn
        (setq mcalendar-display-width  w)
        (setq mcalendar-display-height h)
        (if (mcalendar-check-buffer)
            (mcalendar-redraw-buffer mcalendar-cur-year mcalendar-cur-month mcalendar-cur-day mcalendar-display-holidayname)))
    (message "Both Please specify one or more of the value.")))

(defun mcalendar-check-buffer ()
  (let ((mch nil))
    (dolist (buf (buffer-list))
      (if (string= (buffer-name buf) mcalendar-buffername)
          (setq mch t)
        ))
    mch))

(defun mcalendar-is-leapyear (year)
  (and (eq (% year 4) 0)
           (or (not (eq (% year 100) 0))
               (= (% year 400) 0))))

(defun mcalendar-day-of-month (year month)
  (if (and (= month 2) (mcalendar-is-leapyear year))
      29
    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))

(defun mcalendar-day-of-week (year month day)
  (let* ((flag (or (= month 1) (= month 2)))
         (wky  (if flag (- year 1) year))
         (wkm  (if flag (+ month 12) month)))
    (% (+ wky
          (/ wky 4)
          (- 0 (/ wky 100))
          (/ wky 400)
          (/ (+ (* 13 wkm) 8) 5)
          day) 7)
         ))

(defun mcalendar-numconv (year month day)
  (+ (* year 10000) (* month 100) day))

(defun mcalendar-match-holiday (holiday month numfmt)
  (if (eq (nth 2 holiday) nil)
      (if (<= (mcalendar-numconv (nth 2 (nth 1 holiday))
                                 (nth 0 (nth 1 holiday))
                                 (nth 1 (nth 1 holiday)))
              numfmt)
          (if (= (nth 1 (nth 0 holiday)) month) holiday))
    (if (and (<= (mcalendar-numconv (nth 2 (nth 1 holiday))
                                    (nth 0 (nth 1 holiday))
                                    (nth 1 (nth 1 holiday)))
                 numfmt)
             (>= (mcalendar-numconv (nth 2 (nth 2 holiday))
                                    (nth 0 (nth 2 holiday))
                                    (nth 1 (nth 2 holiday)))
                 numfmt))
        (if (= (nth 1 (nth 0 holiday)) month) holiday)
      ))
  )

(defun mcalendar-holidays-of-month (year month day topptr)
  ;; ある月の祝日のリストを返す。
  ;; ただし、月を跨いだオセロルールをチェックする為に月の前後に1日分の判定域を用意したため
  ;; リストの要素0は先月の最終日、リストの最後の要素は来月の1日を示す。
  (let* ((cur_numfmt (mcalendar-numconv year month day))
         (prv_month_year (if (= month 1) (- year 1) year))
         (prv_month      (if (= month 1) 12 (- month 1)))
         (prv_month_last_numfmt (mcalendar-numconv
                                 prv_month_year
                                 prv_month
                                 (mcalendar-day-of-month prv_month_year prv_month)))
         (nxt_month_year (if (= month 12) (+ year 1) year))
         (nxt_month      (if (= month 12) 1 (+ month 1)))
         (nxt_month_first_numfmt (mcalendar-numconv
                                  nxt_month_year
                                  nxt_month
                                  1))
        (hlist (make-vector (+ (mcalendar-day-of-month year month) 2) (list 0 nil)))
        )
    (dolist (holiday mcalendar-holidays)
      (let ((mch (mcalendar-match-holiday holiday month cur_numfmt))
            (prv_mch (mcalendar-match-holiday holiday prv_month prv_month_last_numfmt))
            (nxt_mch (mcalendar-match-holiday holiday nxt_month nxt_month_first_numfmt))
            )
        (if (not (eq mch nil))
            (let ((type (nth 0 (nth 0 holiday)))
                  (name (nth 3 (nth 0 holiday))))
              (if (eq type 'fixed-holiday)
                  (aset hlist (nth 2 (nth 0 holiday)) (list 1 name) ))
              (if (eq type 'happy-monday)
                  (let ((monday_ptr (- (* (nth 2 (nth 0 holiday)) 7)
                                       (if (>= topptr 2) (- topptr 1)
                                         (if (= topptr 1) 7 6)))))
                    (aset hlist (+ monday_ptr 1) (list 2 name))
                    ))
              (if (eq type 'solar-equinoxes)
                  (aset hlist (mcalendar-get-day-of-equinox year month (nth 2 (nth 0 holiday))) (list 3 name))
                )
              ))
        (if (not (eq prv_mch nil))
            (let ((type (nth 0 (nth 0 holiday)))
                  (name (nth 3 (nth 0 holiday))))
              (if (and (eq type 'fixed-holiday)
                       (eq (nth 1 (nth 0 holiday)) prv_month)
                       (eq (nth 2 (nth 0 holiday)) (mcalendar-day-of-month prv_month_year prv_month)))
                  (aset hlist 0 (list 1 name) ))
              ))
        (if (not (eq nxt_mch nil))
            (let ((type (nth 0 (nth 0 holiday)))
                  (name (nth 3 (nth 0 holiday))))
              (if (and (eq type 'fixed-holiday)
                       (eq (nth 1 (nth 0 holiday)) nxt_month)
                       (eq (nth 2 (nth 0 holiday)) 1))
                  (aset hlist (- (length hlist) 1) (list 1 name) ))
              ))
        ))
    (if (>= cur_numfmt (mcalendar-numconv 1973 4 1)) ; 振り替え休日(1973年4月12日-) コード上は1973/4/1を適用開始としている
        (dotimes (n (- (length hlist) 1))
          (let ((chk_sunday (+ topptr n)))
            (if (= (% chk_sunday 7) 1)
                (if (> (nth 0 (aref hlist n)) 0)
                    (mcalendar-furikae hlist (+ n 1))
                  ))
            )))

    (if (>= year 1988) ; オセロルール
        (dotimes (n (length hlist))
          (if (and (> n 0 ) (< n (- (length hlist) 1)))
              (if (and (> (nth 0 (aref hlist (- n 1))) 0)
                       (= (nth 0 (aref hlist    n   )) 0)
                       (> (nth 0 (aref hlist (+ n 1))) 0))
                  (aset hlist n (list 5 "国民の休日") )))))
    hlist
    ))

(defun mcalendar-furikae (hlist offset)
  (if (= (nth 0 (aref hlist offset)) 0)
      (aset hlist offset (list 4 "振替休日"))
    (mcalendar-furikae hlist (+ offset 1))
    ))

(defun mcalendar-get-day-of-equinox (year month day)
  "1900年～2099年までの春分の日と秋分の日を返す。範囲外の場合はdayを返す。"
  (let ((mod4 (% year 4)))
    (cond
     ((= month 3)
      (cond
       ((= mod4 0) (cond
                    ((and (<= 1900 year) (<= year 1956)) 21)
                    ((and (<= 1960 year) (<= year 2088)) 20)
                    ((and (<= 2092 year) (<= year 2096)) 19)
                    (t day)))
       ((= mod4 1) (cond
                    ((and (<= 1901 year) (<= year 1989)) 21)
                    ((and (<= 1993 year) (<= year 2097)) 20)
                    (t day)))
       ((= mod4 2) (cond
                    ((and (<= 1902 year) (<= year 2022)) 21)
                    ((and (<= 2026 year) (<= year 2098)) 20)
                    (t day)))
       ((= mod4 3) (cond
                    ((and (<= 1903 year) (<= year 1923)) 22)
                    ((and (<= 1927 year) (<= year 2055)) 21)
                    ((and (<= 2059 year) (<= year 2099)) 20)
                    (t day)))
       (t day)
       ))
     ((= month 9)
      (cond
       ((= mod4 0) (cond
                    ((and (<= 1900 year) (<= year 2008)) 23)
                    ((and (<= 2012 year) (<= year 2096)) 22)
                    (t day)))
       ((= mod4 1) (cond
                    ((and (<= 1901 year) (<= year 1917)) 24)
                    ((and (<= 1921 year) (<= year 2041)) 23)
                    ((and (<= 2045 year) (<= year 2097)) 22)
                    (t day)))
       ((= mod4 2) (cond
                    ((and (<= 1902 year) (<= year 1946)) 24)
                    ((and (<= 1950 year) (<= year 2074)) 23)
                    ((and (<= 2078 year) (<= year 2098)) 22)
                    (t day)))
       ((= mod4 3) (cond
                    ((and (<= 1903 year) (<= year 1979)) 24)
                    ((and (<= 1983 year) (<= year 2099)) 23)
                    (t day)))
       (t day)
       ))
     )
    ))

(defun mcalendar-get-eto (year)
  (aref mcalendar-etovec (% year 12)))

(defun mcalendar-get-monthname (month)
  (aref mcalendar-monthvec
        (- month 1)))

(defun  mcalendar-caption (year month)
  (eval mcalendar-capformat))

(defun mcalendar-rend-header (strbuffer year month)
  (setq strbuffer (format "%s" (propertize
                                (mcalendar-caption year month)
                                'face mcalendar-month-caption-faceprop)))
  (setq strbuffer (format "%s%s" strbuffer (propertize (aref mcalendar-daynames 0) 'face mcalendar-sunday-caption-faceprop)))
  (setq strbuffer (format "%s%s" strbuffer (propertize (aref mcalendar-daynames 1) 'face mcalendar-weekday-caption-faceprop)))
  (setq strbuffer (format "%s%s" strbuffer (propertize (aref mcalendar-daynames 2) 'face mcalendar-saturday-caption-faceprop)))
  strbuffer)

(defun mcalendar-rend-calendar (year month day)
  (let* ((topptr (mcalendar-day-of-week year month 1))
         (today-str (format-time-string "%Y%m"))
         (holiday-vector)
         (strbuffer "")
         (holiday-list ""))
    (setq strbuffer (mcalendar-rend-header strbuffer year month))
    (dotimes (n topptr)
      (setq strbuffer (format "%s   " strbuffer)))

    (setq holiday-vector (mcalendar-holidays-of-month year month day topptr))
    (let ((days (mcalendar-day-of-month year month))
          (linebuf ""))
      (dotimes (n days)
        (let ((dsproplist)
              (name (nth 1 (aref holiday-vector (+ n 1)))))
          (if (= (% (+ n topptr) 7) 0) (setq dsproplist (append dsproplist mcalendar-sunday-faceprop)))
          (if (= (% (+ n topptr) 7) 6) (setq dsproplist (append dsproplist mcalendar-saturday-faceprop)))
          (if (and (string= today-str (format "%d%02d" year month)) (= (+ n 1) day))
              (setq dsproplist (append dsproplist mcalendar-today-faceprop)))
          (if (not (= (nth 0 (aref holiday-vector (+ n 1))) 0))
              (setq dsproplist (append dsproplist mcalendar-holiday-faceprop)))
          (if name
              (setq holiday-list (format "%s%2d %s\n" holiday-list (+ n 1) name)))

          (setq linebuf (format "%s%s" linebuf
                                (propertize
                                 (format "%2d" (+ n 1))
                                 'face  dsproplist)))
          (if (= (% (+ n topptr) 7) 6)
              (progn
                (setq strbuffer (format "%s%s\n" strbuffer linebuf))
                (setq linebuf ""))
            (setq linebuf (format "%s " linebuf)))
          ))
      (if (> (length linebuf) 0)
          (setq strbuffer (format "%s%s\n" strbuffer linebuf)))

      )
    (list strbuffer holiday-list)
    ))

(defun mcalendar-add-delta-month (year month dmonth)
  (let ((ryear  (+ year (/ (+ (- month 1) dmonth) 12)))
        (rmonth (+ (% (+ (- month 1) dmonth) 12) 1)))
    (list ryear rmonth)
    ))

(defun mcalendar-redraw-buffer (year month day &optional dispholydayname)
  (with-current-buffer (get-buffer-create mcalendar-buffername)
    (setq truncate-lines t)
    (setq cursor-type t)
    (read-only-mode 0)
    (buffer-disable-undo)
    (erase-buffer)

    (let ((cal-list)
          (maxline [0 0]))
      (dotimes (y mcalendar-display-height)
        (fillarray maxline 0)
        (dotimes (x mcalendar-display-width)
          (let* ((ym     (mcalendar-add-delta-month year month (+ (* mcalendar-display-width y) x)))
                 (cllist (mcalendar-rend-calendar (nth 0 ym) (nth 1 ym) day))
                 (clen   (length (split-string (nth 0 cllist) "\n")))
                 (hlen   (length (split-string (nth 1 cllist) "\n"))))
            (setq cal-list (append cal-list (list cllist)))
            (if (< (aref maxline 0) clen) (aset maxline 0 clen))
            (if (< (aref maxline 1) hlen) (aset maxline 1 hlen))
            ))
        (dotimes (i (if dispholydayname 2 1))
          (dotimes (n (- (aref maxline i) 1))
            (let ((catbuf ""))
              (dotimes (x mcalendar-display-width)
                (let* ((m (+ (* mcalendar-display-width y) x))
                       (line (nth n (split-string (nth i (nth m cal-list)) "\n"))))
                  (if (eq (length line) 0)
                      (setq line (format "%-20s" "")))
                  (if (= x 0)
                      (setq catbuf (format "%-20s" line))
                    (setq catbuf (format "%s    %-20s" catbuf line)))
                  )
                )
              (insert (format "%s\n" catbuf))
              ))
          (if (or (and (= i 0) dispholydayname)
                  (and (< y (- mcalendar-display-height 1)) (> mcalendar-display-height 1)))
              (insert "\n"))
          ))
      )

    (goto-char (point-min))
    (setq mode-line-format mcalendar-mode-line-format)
    (read-only-mode 1)
    ))

(provide 'mcalendar)
