]> code.delx.au - gnu-emacs/blobdiff - lisp/calendar/cal-china.el
* lisp/calendar/calendar.el (calendar-mode): Locally set scroll-margin to 0.
[gnu-emacs] / lisp / calendar / cal-china.el
index f4f10a1b8dcb657518cd390b28fd3bb5d44bcab6..03a4b320059270589a7d6d08cc13361b4a317066 100644 (file)
@@ -1,12 +1,12 @@
 ;;; cal-china.el --- calendar functions for the Chinese calendar
 
-;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; Human-Keywords: Chinese calendar, calendar, holidays, diary
+;; Package: calendar
 
 ;; This file is part of GNU Emacs.
 
@@ -517,37 +517,42 @@ Returns (((MONTH DAY YEAR) TEXT)), where the date is Gregorian."
 If MONTH, DAY (Chinese) is visible, returns the corresponding
 Gregorian date as the list (((month day year) STRING)).
 Returns nil if it is not visible in the current calendar window."
-  ;; This is calendar-nongregorian-visible-p adapted for the form of
-  ;; chinese dates: (cycle year month day) as opposed to (month day year).
-  (let* ((m1 displayed-month)
-         (y1 displayed-year)
-         (m2 displayed-month)
-         (y2 displayed-year)
-         ;; Absolute date of first/last dates in calendar window.
-         (start-date (progn
-                       (calendar-increment-month m1 y1 -1)
-                       (calendar-absolute-from-gregorian (list m1 1 y1))))
-         (end-date (progn
-                     (calendar-increment-month m2 y2 1)
-                     (calendar-absolute-from-gregorian
-                      (list m2 (calendar-last-day-of-month m2 y2) y2))))
-         ;; Local date of first/last date in calendar window.
-         (local-start (calendar-chinese-from-absolute start-date))
-         ;; A basic optimization.  We only care about the year part,
-         ;; and the Chinese year can only change if Jan or Feb are
-         ;; visible.  FIXME can we do more?
-         (local-end (if (memq displayed-month '(12 1 2 3))
-                        (calendar-chinese-from-absolute end-date)
-                      local-start))
-         ;; When Chinese New Year is visible on the far right of the
-         ;; calendar, what is the earliest Chinese month in the
-         ;; previous year that might still visible?  This test doesn't
-         ;; have to be precise.
-         (local (if (< month 10) local-end local-start))
-         (cycle (car local))
-         (year (cadr local))
-         (date (calendar-gregorian-from-absolute
-                (calendar-chinese-to-absolute (list cycle year month day)))))
+  (let ((date
+         (calendar-gregorian-from-absolute
+          ;; A basic optimization.  Chinese year can only change if
+          ;; Jan or Feb are visible.  FIXME can we do more?
+          (if (memq displayed-month '(12 1 2 3))
+              ;; This is calendar-nongregorian-visible-p adapted for
+              ;; the form of chinese dates: (cycle year month day) as
+              ;; opposed to (month day year).
+              (let* ((m1 displayed-month)
+                     (y1 displayed-year)
+                     (m2 displayed-month)
+                     (y2 displayed-year)
+                     ;; Absolute date of first/last dates in calendar window.
+                     (start-date (progn
+                                   (calendar-increment-month m1 y1 -1)
+                                   (calendar-absolute-from-gregorian
+                                    (list m1 1 y1))))
+                     (end-date (progn
+                                 (calendar-increment-month m2 y2 1)
+                                 (calendar-absolute-from-gregorian
+                                  (list m2 (calendar-last-day-of-month m2 y2)
+                                        y2))))
+                     ;; Local date of first/last date in calendar window.
+                     (local-start (calendar-chinese-from-absolute start-date))
+                     (local-end (calendar-chinese-from-absolute end-date))
+                     ;; When Chinese New Year is visible on the far
+                     ;; right of the calendar, what is the earliest
+                     ;; Chinese month in the previous year that might
+                     ;; still visible?  This test doesn't have to be precise.
+                     (local (if (< month 10) local-end local-start))
+                     (cycle (car local))
+                     (year (cadr local)))
+                (calendar-chinese-to-absolute (list cycle year month day)))
+            ;; Simple form for when new years are not visible.
+            (+ (cadr (assoc month (calendar-chinese-year displayed-year)))
+               (1- day))))))
     (if (calendar-date-is-visible-p date)
         (list (list date string)))))
 
@@ -570,8 +575,7 @@ Defaults to today's date if DATE is not given."
                             ;; Remainder of (1+(floor month))/12, with
                             ;; 12 instead of 0.
                             (1+ (mod (floor month) 12))
-                            1)))
-         (m-cycle (% (+ (* year 5) (floor month)) 60)))
+                            1))))
     (format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)"
             cycle
             year (calendar-chinese-sexagesimal-name year)
@@ -680,5 +684,4 @@ Echo Chinese date unless NOECHO is non-nil."
 
 (provide 'cal-china)
 
-;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
 ;;; cal-china.el ends here