;;; cal-china.el --- calendar functions for the Chinese calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
:prefix "calendar-chinese-"
:group 'calendar)
-(define-obsolete-variable-alias 'chinese-calendar-time-zone
- 'calendar-chinese-time-zone "23.1")
-
(defcustom calendar-chinese-time-zone
'(if (< year 1928)
(+ 465 (/ 40.0 60.0))
(put 'chinese-calendar-time-zone 'risky-local-variable t)
-(define-obsolete-variable-alias 'chinese-calendar-location-name
- 'calendar-chinese-location-name "23.1")
-
;; FIXME unused.
(defcustom calendar-chinese-location-name "Beijing"
"Name of location used for calculation of Chinese calendar."
:type 'string
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-time-offset
- 'calendar-chinese-daylight-time-offset "23.1")
-
(defcustom calendar-chinese-daylight-time-offset 0
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-standard-time-zone-name
- 'calendar-chinese-standard-time-zone-name "23.1")
-
(defcustom calendar-chinese-standard-time-zone-name
'(if (< year 1928)
"PMT"
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-time-zone-name
- 'calendar-chinese-daylight-time-zone-name "23.1")
-
(defcustom calendar-chinese-daylight-time-zone-name "CDT"
"Abbreviated name of daylight saving time zone used for Chinese calendar."
:type 'string
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts
- 'calendar-chinese-daylight-saving-start "23.1")
-
(defcustom calendar-chinese-daylight-saving-start nil
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends
- 'calendar-chinese-daylight-saving-end "23.1")
-
(defcustom calendar-chinese-daylight-saving-end nil
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts-time
- 'calendar-chinese-daylight-saving-start-time "23.1")
-
(defcustom calendar-chinese-daylight-saving-start-time 0
"Number of minutes after midnight that daylight saving time starts.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends-time
- 'calendar-chinese-daylight-saving-end-time "23.1")
-
(defcustom calendar-chinese-daylight-saving-end-time 0
"Number of minutes after midnight that daylight saving time ends.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-celestial-stem
- 'calendar-chinese-celestial-stem "23.1")
-
(defcustom calendar-chinese-celestial-stem
["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]
"Prefixes used by `calendar-chinese-sexagesimal-name'."
(string :tag "Ren")
(string :tag "Gui")))
-(define-obsolete-variable-alias 'chinese-calendar-terrestrial-branch
- 'calendar-chinese-terrestrial-branch "23.1")
-
(defcustom calendar-chinese-terrestrial-branch
["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]
"Suffixes used by `calendar-chinese-sexagesimal-name'."
(calendar-chinese-year g-year))
(calendar-chinese-year (1+ g-year))))))))
-(define-obsolete-function-alias 'calendar-absolute-from-chinese
- 'calendar-chinese-to-absolute "23.1")
-
(defun calendar-chinese-from-absolute (date)
"Compute Chinese date (cycle year month day) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
(message "Chinese date: %s"
(calendar-chinese-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-chinese-date
- 'calendar-chinese-print-date "23.1")
-
(defun calendar-chinese-months-to-alist (l)
"Make list of months L into an assoc list."
(and l (car l)
(calendar-chinese-to-absolute date)))
(or noecho (calendar-chinese-print-date)))
-(define-obsolete-function-alias 'calendar-goto-chinese-date
- 'calendar-chinese-goto-date "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
"Chinese calendar equivalent of date diary entry."
(format "Chinese date: %s" (calendar-chinese-date-string date)))
+;;;; diary support
+
+(autoload 'calendar-mark-1 "diary-lib")
+(autoload 'diary-mark-entries-1 "diary-lib")
+(autoload 'diary-list-entries-1 "diary-lib")
+(autoload 'diary-insert-entry-1 "diary-lib")
+(autoload 'diary-date-display-form "diary-lib")
+(autoload 'diary-make-date "diary-lib")
+(autoload 'diary-ordinal-suffix "diary-lib")
+(defvar diary-sexp-entry-symbol)
+(defvar entry) ;used by `diary-chinese-anniversary'
+
+(defvar calendar-chinese-month-name-array
+ ["正月" "二月" "三月" "四月" "五月" "六月"
+ "七月" "八月" "九月" "十月" "冬月" "臘月"])
+
+;;; NOTE: In the diary the cycle and year of a Chinese date is
+;;; combined using this formula: (+ (* cycle 100) year).
+;;;
+;;; 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)))
+ ;; 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
+ (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)
+ (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 ()
+ "Mark days in the calendar window that have Chinese date diary entries.
+Marks each entry in `diary-file' (or included files) visible in the calendar
+window. See `diary-chinese-list-entries' for more information.
+
+This function is provided for use with `diary-nongregorian-marking-hook'."
+ (diary-mark-entries-1 #'calendar-chinese-mark-date-pattern
+ calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-list-entries ()
+ "Add any Chinese date entries from the diary file to `diary-entries-list'.
+Chinese date diary entries must be prefixed by `diary-chinese-entry-symbol'
+\(normally a `C'). The same `diary-date-forms' govern the style
+of the Chinese calendar entries. If a Chinese date diary entry begins with
+`diary-nonmarking-symbol', the entry will appear in the diary listing,
+but will not be marked in the calendar.
+
+This function is provided for use with `diary-nongregorian-listing-hook'."
+ (diary-list-entries-1 calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-anniversary (month day &optional year mark)
+ "Like `diary-anniversary' (which see) but accepts Chinese date."
+ (pcase-let* ((ddate (diary-make-date month day year))
+ (`(,dc ,dy ,dm ,dd) ;diary chinese date
+ (if year
+ (calendar-chinese-from-absolute
+ (calendar-chinese-to-absolute-for-diary ddate))
+ (list nil nil (calendar-extract-month ddate)
+ (calendar-extract-day ddate))))
+ (`(,cc ,cy ,cm ,cd) ;current chinese date
+ (calendar-chinese-from-absolute
+ (calendar-absolute-from-gregorian date)))
+ (diff (if (and dc dy)
+ (+ (* 60 (- cc dc)) (- cy dy))
+ 100)))
+ (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
+(defun diary-chinese-insert-anniversary-entry (&optional arg)
+ "Insert an anniversary diary entry for the Chinese date at point.
+Prefix argument ARG makes the entry nonmarking."
+ (interactive "P")
+ (let ((calendar-date-display-form (diary-date-display-form)))
+ (diary-make-entry
+ (format "%s(diary-chinese-anniversary %s)"
+ diary-sexp-entry-symbol
+ (calendar-date-string
+ (calendar-chinese-from-absolute-for-diary
+ (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
+ arg)))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-entry (&optional arg)
+ "Insert a diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 nil arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-monthly-entry (&optional arg)
+ "Insert a monthly diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 'monthly arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-yearly-entry (&optional arg)
+ "Insert a yearly diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 'yearly arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
(provide 'cal-china)
;;; cal-china.el ends here