Commit bfcb5172 authored by Glenn Morris's avatar Glenn Morris
Browse files

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.
parent e708e9d9
...@@ -51,11 +51,9 @@ ...@@ -51,11 +51,9 @@
(require 'lunar) (require 'lunar)
(defvar chinese-calendar-celestial-stem (defgroup chinese-calendar nil
["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]) "Chinese calendar support."
:group 'calendar)
(defvar chinese-calendar-terrestrial-branch
["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
(defcustom chinese-calendar-time-zone (defcustom chinese-calendar-time-zone
'(if (< year 1928) '(if (< year 1928)
...@@ -131,6 +129,15 @@ Chinese calendar. Default is for no daylight saving time." ...@@ -131,6 +129,15 @@ Chinese calendar. Default is for no daylight saving time."
:type 'integer :type 'integer
:group 'chinese-calendar) :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) (defun chinese-zodiac-sign-on-or-after (d)
"Absolute date of first new Zodiac sign on or after absolute date 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." The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
...@@ -374,6 +381,7 @@ Gregorian date Sunday, December 31, 1 BC." ...@@ -374,6 +381,7 @@ Gregorian date Sunday, December 31, 1 BC."
(format "Chinese New Year (%s)" (format "Chinese New Year (%s)"
(calendar-chinese-sexagesimal-name (+ y 57)))))))))) (calendar-chinese-sexagesimal-name (+ y 57))))))))))
;;;###autoload
(defun calendar-chinese-date-string (&optional date) (defun calendar-chinese-date-string (&optional date)
"String of Chinese date of Gregorian DATE. "String of Chinese date of Gregorian DATE.
Defaults to today's date if DATE is not given." Defaults to today's date if DATE is not given."
...@@ -415,6 +423,7 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name, ...@@ -415,6 +423,7 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name,
(aref chinese-calendar-celestial-stem (% (1- n) 10)) (aref chinese-calendar-celestial-stem (% (1- n) 10))
(aref chinese-calendar-terrestrial-branch (% (1- n) 12)))) (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))
;;;###autoload
(defun calendar-print-chinese-date () (defun calendar-print-chinese-date ()
"Show the Chinese date equivalents of date." "Show the Chinese date equivalents of date."
(interactive) (interactive)
...@@ -422,6 +431,7 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name, ...@@ -422,6 +431,7 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name,
(message "Chinese date: %s" (message "Chinese date: %s"
(calendar-chinese-date-string (calendar-cursor-to-date t)))) (calendar-chinese-date-string (calendar-cursor-to-date t))))
;;;###autoload
(defun calendar-goto-chinese-date (date &optional noecho) (defun calendar-goto-chinese-date (date &optional noecho)
"Move cursor to Chinese date DATE. "Move cursor to Chinese date DATE.
Echo Chinese date unless NOECHO is t." Echo Chinese date unless NOECHO is t."
...@@ -431,11 +441,11 @@ Echo Chinese date unless NOECHO is t." ...@@ -431,11 +441,11 @@ Echo Chinese date unless NOECHO is t."
(calendar-current-date)))) (calendar-current-date))))
(cycle (calendar-read (cycle (calendar-read
"Chinese calendar cycle number (>44): " "Chinese calendar cycle number (>44): "
'(lambda (x) (> x 44)) (lambda (x) (> x 44))
(int-to-string (car c)))) (int-to-string (car c))))
(year (calendar-read (year (calendar-read
"Year in Chinese cycle (1..60): " "Year in Chinese cycle (1..60): "
'(lambda (x) (and (<= 1 x) (<= x 60))) (lambda (x) (and (<= 1 x) (<= x 60)))
(int-to-string (car (cdr c))))) (int-to-string (car (cdr c)))))
(month-list (make-chinese-month-assoc-list (month-list (make-chinese-month-assoc-list
(chinese-months cycle year))) (chinese-months cycle year)))
...@@ -453,7 +463,7 @@ Echo Chinese date unless NOECHO is t." ...@@ -453,7 +463,7 @@ Echo Chinese date unless NOECHO is t."
29)) 29))
(day (calendar-read (day (calendar-read
(format "Chinese calendar day (1-%d): " last) (format "Chinese calendar day (1-%d): " last)
'(lambda (x) (and (<= 1 x) (<= x last)))))) (lambda (x) (and (<= 1 x) (<= x last))))))
(list (list cycle year month day)))) (list (list cycle year month day))))
(calendar-goto-date (calendar-gregorian-from-absolute (calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-chinese date))) (calendar-absolute-from-chinese date)))
...@@ -462,13 +472,13 @@ Echo Chinese date unless NOECHO is t." ...@@ -462,13 +472,13 @@ Echo Chinese date unless NOECHO is t."
(defun chinese-months (c y) (defun chinese-months (c y)
"A list of the months in cycle C, year Y of the Chinese calendar." "A list of the months in cycle C, year Y of the Chinese calendar."
(let* ((l (memq 1 (append (let* ((l (memq 1 (append
(mapcar '(lambda (x) (mapcar (lambda (x)
(car x)) (car x))
(chinese-year (extract-calendar-year (chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
(calendar-absolute-from-chinese (calendar-absolute-from-chinese
(list c y 1 1)))))) (list c y 1 1))))))
(mapcar '(lambda (x) (mapcar (lambda (x)
(if (> (car x) 11) (car x))) (if (> (car x) 11) (car x)))
(chinese-year (extract-calendar-year (chinese-year (extract-calendar-year
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
...@@ -498,5 +508,9 @@ Echo Chinese date unless NOECHO is t." ...@@ -498,5 +508,9 @@ Echo Chinese date unless NOECHO is t."
(provide 'cal-china) (provide 'cal-china)
;;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644 ;; Local Variables:
;; generated-autoload-file: "cal-loaddefs.el"
;; End:
;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
;;; cal-china.el ends here ;;; cal-china.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment