Handle leap months in Chinese calendar

Fixes: debbugs:18953
* calendar/cal-china.el (calendar-chinese-from-absolute-for-diary)
(calendar-chinese-to-absolute-for-diary)
(calendar-chinese-mark-date-pattern, diary-chinese-anniversary):
Handle leap months in Chinese calendar.  (Bug#18953)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 422336332bfca2c428e2c3ac8bac2c6f33fc2f5b..43b3f9abc8c3fee4b2369db4b0e43c721635c2f6 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-11-23  Leo Liu  <sdl.web@gmail.com>
+
+       * calendar/cal-china.el (calendar-chinese-from-absolute-for-diary)
+       (calendar-chinese-to-absolute-for-diary)
+       (calendar-chinese-mark-date-pattern, diary-chinese-anniversary):
+       Handle leap months in Chinese calendar.  (Bug#18953)
+
 2014-11-22  Alan Mackenzie  <acm@muc.de>
 
        Fix error with `mark-defun' and "protected:" in C++ Mode.

diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index c5860653a3e60c73e0a7c81398ebd38311c41edd..8b61ef1f3effeae6b498f6894b9c84ebb5412bab 100644 (file)
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -662,18 +662,30 @@ Echo Chinese date unless NOECHO is non-nil."
 ;;; These two functions convert to and back from this representation.
 (defun calendar-chinese-from-absolute-for-diary (date)
   (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date)))
-    (list m d (+ (* c 100) y))))
-
-(defun calendar-chinese-to-absolute-for-diary (date)
-  (pcase-let ((`(,m ,d ,y) date))
+    ;; Note: For leap months M is a float.
+    (list (floor m) d (+ (* c 100) y))))
+
+(defun calendar-chinese-to-absolute-for-diary (date &optional prefer-leap)
+  (pcase-let* ((`(,m ,d ,y) date)
+               (cycle (floor y 100))
+               (year (mod y 100))
+               (months (calendar-chinese-months cycle year))
+               (lm (+ (floor m) 0.5)))
     (calendar-chinese-to-absolute
-     (list (floor y 100) (mod y 100) m d))))
+     (if (and prefer-leap (memql lm months))
+         (list cycle year lm d)
+       (list cycle year m d)))))
 
 (defun calendar-chinese-mark-date-pattern (month day year &optional color)
   (calendar-mark-1 month day year
                    #'calendar-chinese-from-absolute-for-diary
                    #'calendar-chinese-to-absolute-for-diary
-                   color))
+                   color)
+  (unless (zerop month)
+    (calendar-mark-1 month day year
+                     #'calendar-chinese-from-absolute-for-diary
+                     (lambda (date) (calendar-chinese-to-absolute-for-diary date t))
+                     color)))
 
 ;;;###cal-autoload
 (defun diary-chinese-mark-entries ()
@@ -717,7 +729,10 @@ This function is provided for use with `diary-nongregorian-listing-hook'."
                (diff (if (and dc dy)
                          (+ (* 60 (- cc dc)) (- cy dy))
                        100)))
-    (and (> diff 0) (= dm cm) (= dd cd)
+    (and (> diff 0)
+         ;; The Chinese month can differ by 0.5 in a leap month.
+         (or (= dm cm) (= (+ 0.5 dm) cm))
+         (= dd cd)
          (cons mark (format entry diff (diary-ordinal-suffix diff))))))
 
 ;;;###cal-autoload