lisp/calendar/lunar.el

1 ;;; lunar.el --- calendar functions for phases of the moon
8 ;; Keywords: calendar
9 ;; Human-Keywords: moon, lunar phases, calendar, diary
30 ;; This collection of functions implements lunar phases for calendar.el and
49 (defvar displayed-month)
58 (defun lunar-phase-list (month year)
60   (let ((end-month month)
62         (start-month month)
64     (increment-calendar-month end-month end-year 3)
65     (increment-calendar-month start-month start-year -1)
66     (let* ((end-date (list (list end-month 1 end-year)))
67            (start-date (list (list start-month
68                                    (calendar-last-day-of-month
69                                     start-month start-year)
75                             ( / (calendar-day-number (list month 1 year))
80       (while (calendar-date-compare new-moon end-date)
81         (if (calendar-date-compare start-date new-moon)
95          (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900))
168 	 (date (+ date (/ (- calendar-time-zone
170                               (extract-calendar-year
171                                (calendar-gregorian-from-absolute
175 	 (date (calendar-gregorian-from-absolute (truncate date)))
179 (defun lunar-phase-name (phase)
187 (defun calendar-phases-of-moon ()
188   "Create a buffer with the lunar phases for the current calendar window."
191   (let ((m1 displayed-month)
193         (m2 displayed-month)
195     (increment-calendar-month m1 y1 -1)
196     (increment-calendar-month m2 y2 1)
199     (calendar-set-mode-line
202                  (calendar-month-name m1) (calendar-month-name m2) y2)
204                (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
212            (concat (calendar-date-string date)
214                    (lunar-phase-name phase)
226   "Display the quarters of the moon for last month, this month, and next month.
227 If called with an optional prefix argument, prompts for month and year.
233                      (calendar-read-date t)
234                    (calendar-current-date)))
235            (displayed-month (extract-calendar-month date))
236            (displayed-year (extract-calendar-year date)))
237       (calendar-phases-of-moon))))
243 use when highlighting the day in the calendar."
247                        (+ (extract-calendar-year date)
248                           ( / (calendar-day-number date)
252     (while (calendar-date-compare phase (list date))
255     (if (calendar-date-equal (car phase) date)
256         (cons mark (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
260 ;;  For the Chinese calendar the calculations for the new moon need to be more
365            (extract-calendar-year
366             (calendar-gregorian-from-absolute
367              (floor (calendar-absolute-from-astro newJDE))))))
368        (/ calendar-time-zone 60.0 24.0))))
375 as governed by the values of calendar-daylight-savings-starts,
376 calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
377 calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
378 calendar-time-zone."
379   (let* ((date (calendar-gregorian-from-absolute
380                 (floor (calendar-absolute-from-astro d))))
381          (year (+ (extract-calendar-year date)
382 		  (/ (calendar-day-number date) 365.25)))
388     (let* ((a-date (calendar-absolute-from-astro date))
390            (date (calendar-gregorian-from-absolute (truncate a-date)))
392       (calendar-astro-from-absolute
393        (+ (calendar-absolute-from-gregorian (car adj))