comparison lisp/calendar/cal-china.el @ 92579:8ddfb879916b

Unquote lambda functions. Add autoload cookies to functions formerly autoloaded in calendar.el. Set `generated-autoload-file' to "cal-loaddefs.el". (chinese-calendar): Move custom group here from calendar.el. (chinese-calendar-celestial-stem, chinese-calendar-terrestrial-branch): Make constants.

92578:8b2b620788b7

(defvar displayed-month)
(defvar displayed-year)

(require 'lunar)

(defvar chinese-calendar-celestial-stem
  ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])

(defvar chinese-calendar-terrestrial-branch
  ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])

(defcustom chinese-calendar-time-zone
  '(if (< year 1928)
       (+ 465 (/ 40.0 60.0))
     480)

(defcustom chinese-calendar-daylight-savings-ends-time 0
  "Number of minutes after midnight that daylight saving time ends for
Chinese calendar.  Default is for no daylight saving time."
  :type 'integer
  :group 'chinese-calendar)

(defun chinese-zodiac-sign-on-or-after (d)
  "Absolute date of first new Zodiac sign on or after absolute date d.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
 (let* ((year (extract-calendar-year

          (list
           (list chinese-new-year
                 (format "Chinese New Year (%s)"
                         (calendar-chinese-sexagesimal-name (+ y 57))))))))))

(defun calendar-chinese-date-string (&optional date)
  "String of Chinese date of Gregorian DATE.
Defaults to today's date if DATE is not given."
  (let* ((a-date (calendar-absolute-from-gregorian
                  (or date (calendar-current-date))))

..., N congruent to 60 gives the sixtieth name."
  (format "%s-%s"
          (aref chinese-calendar-celestial-stem (% (1- n) 10))
          (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))

(defun calendar-print-chinese-date ()
  "Show the Chinese date equivalents of date."
  (interactive)
  (message "Computing Chinese date...")
  (message "Chinese date: %s"
           (calendar-chinese-date-string (calendar-cursor-to-date t))))

(defun calendar-goto-chinese-date (date &optional noecho)
  "Move cursor to Chinese date DATE.
Echo Chinese date unless NOECHO is t."
  (interactive
   (let* ((c (calendar-chinese-from-absolute
              (calendar-absolute-from-gregorian
               (calendar-current-date))))
          (cycle (calendar-read
                  "Chinese calendar cycle number (>44): "
                  '(lambda (x) (> x 44))
                  (int-to-string (car c))))
          (year (calendar-read
                 "Year in Chinese cycle (1..60): "
                 '(lambda (x) (and (<= 1 x) (<= x 60)))
                 (int-to-string (car (cdr c)))))
          (month-list (make-chinese-month-assoc-list
                       (chinese-months cycle year)))
          (month (cdr (assoc
                       (completing-read "Chinese calendar month: "

                                       (list cycle year month 1))))))))
                    30
                  29))
          (day (calendar-read
                (format "Chinese calendar day (1-%d): " last)
                '(lambda (x) (and (<= 1 x) (<= x last))))))
     (list (list cycle year month day))))
  (calendar-goto-date (calendar-gregorian-from-absolute
                       (calendar-absolute-from-chinese date)))
  (or noecho (calendar-print-chinese-date)))

(defun chinese-months (c y)
  "A list of the months in cycle C, year Y of the Chinese calendar."
  (let* ((l (memq 1 (append
                     (mapcar '(lambda (x)
                                (car x))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list c y 1 1))))))
                     (mapcar '(lambda (x)
                                (if (> (car x) 11) (car x)))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list (if (= y 60) (1+ c) c)

  "Chinese calendar equivalent of date diary entry."
  (format "Chinese date: %s" (calendar-chinese-date-string date)))

(provide 'cal-china)

;;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
;;; cal-china.el ends here

92579:8ddfb879916b

(defvar displayed-month)
(defvar displayed-year)

(require 'lunar)

(defgroup chinese-calendar nil
  "Chinese calendar support."
  :group 'calendar)

(defcustom chinese-calendar-time-zone
  '(if (< year 1928)
       (+ 465 (/ 40.0 60.0))
     480)

(defcustom chinese-calendar-daylight-savings-ends-time 0
  "Number of minutes after midnight that daylight saving time ends for
Chinese calendar.  Default is for no daylight saving time."
  :type 'integer
  :group 'chinese-calendar)

;;; End of user options.


(defconst chinese-calendar-celestial-stem
  ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])

(defconst chinese-calendar-terrestrial-branch
  ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])

(defun chinese-zodiac-sign-on-or-after (d)
  "Absolute date of first new Zodiac sign on or after absolute date d.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
 (let* ((year (extract-calendar-year

          (list
           (list chinese-new-year
                 (format "Chinese New Year (%s)"
                         (calendar-chinese-sexagesimal-name (+ y 57))))))))))

;;;###autoload
(defun calendar-chinese-date-string (&optional date)
  "String of Chinese date of Gregorian DATE.
Defaults to today's date if DATE is not given."
  (let* ((a-date (calendar-absolute-from-gregorian
                  (or date (calendar-current-date))))

..., N congruent to 60 gives the sixtieth name."
  (format "%s-%s"
          (aref chinese-calendar-celestial-stem (% (1- n) 10))
          (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))

;;;###autoload
(defun calendar-print-chinese-date ()
  "Show the Chinese date equivalents of date."
  (interactive)
  (message "Computing Chinese date...")
  (message "Chinese date: %s"
           (calendar-chinese-date-string (calendar-cursor-to-date t))))

;;;###autoload
(defun calendar-goto-chinese-date (date &optional noecho)
  "Move cursor to Chinese date DATE.
Echo Chinese date unless NOECHO is t."
  (interactive
   (let* ((c (calendar-chinese-from-absolute
              (calendar-absolute-from-gregorian
               (calendar-current-date))))
          (cycle (calendar-read
                  "Chinese calendar cycle number (>44): "
                  (lambda (x) (> x 44))
                  (int-to-string (car c))))
          (year (calendar-read
                 "Year in Chinese cycle (1..60): "
                 (lambda (x) (and (<= 1 x) (<= x 60)))
                 (int-to-string (car (cdr c)))))
          (month-list (make-chinese-month-assoc-list
                       (chinese-months cycle year)))
          (month (cdr (assoc
                       (completing-read "Chinese calendar month: "

                                       (list cycle year month 1))))))))
                    30
                  29))
          (day (calendar-read
                (format "Chinese calendar day (1-%d): " last)
                (lambda (x) (and (<= 1 x) (<= x last))))))
     (list (list cycle year month day))))
  (calendar-goto-date (calendar-gregorian-from-absolute
                       (calendar-absolute-from-chinese date)))
  (or noecho (calendar-print-chinese-date)))

(defun chinese-months (c y)
  "A list of the months in cycle C, year Y of the Chinese calendar."
  (let* ((l (memq 1 (append
                     (mapcar (lambda (x)
                                (car x))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list c y 1 1))))))
                     (mapcar (lambda (x)
                                (if (> (car x) 11) (car x)))
                             (chinese-year (extract-calendar-year
                                            (calendar-gregorian-from-absolute
                                             (calendar-absolute-from-chinese
                                              (list (if (= y 60) (1+ c) c)

  "Chinese calendar equivalent of date diary entry."
  (format "Chinese date: %s" (calendar-chinese-date-string date)))

(provide 'cal-china)

;; Local Variables:
;; generated-autoload-file: "cal-loaddefs.el"
;; End:

;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
;;; cal-china.el ends here