Mercurial > emacs
changeset 104547:8c67d84c0faa
(lunar-phase-names): New option.
(lunar-phase): Doc fix.
(lunar-cycles-per-year): New constant.
(lunar-index): New function.
(lunar-phase-list, diary-lunar-phases): Use lunar-index.
(lunar-phase-name): Use lunar-phase-names.
(calendar-lunar-phases): Use format.
(lunar-new-moon-on-or-after): Use lunar-cycles-per-year.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Sat, 22 Aug 2009 19:45:30 +0000 |
| parents | 2bed47021053 |
| children | d787a9b6a87e |
| files | lisp/ChangeLog lisp/calendar/lunar.el |
| diffstat | 2 files changed, 54 insertions(+), 39 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Aug 22 19:42:58 2009 +0000 +++ b/lisp/ChangeLog Sat Aug 22 19:45:30 2009 +0000 @@ -1,5 +1,14 @@ 2009-08-22 Glenn Morris <rgm@gnu.org> + * calendar/lunar.el (lunar-phase-names): New option. + (lunar-phase): Doc fix. + (lunar-cycles-per-year): New constant. + (lunar-index): New function. + (lunar-phase-list, diary-lunar-phases): Use lunar-index. + (lunar-phase-name): Use lunar-phase-names. + (calendar-lunar-phases): Use format. + (lunar-new-moon-on-or-after): Use lunar-cycles-per-year. + * progmodes/cperl-mode.el (cperl-imenu-name-and-position): Copy imenu-example--name-and-position function here for own use. (cperl-xsub-scan): Use cperl-imenu-name-and-position.
--- a/lisp/calendar/lunar.el Sat Aug 22 19:42:58 2009 +0000 +++ b/lisp/calendar/lunar.el Sat Aug 22 19:45:30 2009 +0000 @@ -44,17 +44,28 @@ ;; calendar-astro-to-absolute and v versa are cal-autoloads. ;;;(require 'cal-julian) +(defcustom lunar-phase-names + '("New Moon" "First Quarter Moon" "Full Moon" "Last Quarter Moon") + "List of names for the lunar phases." + :type '(list + (string :tag "New Moon") + (string :tag "First Quarter Moon") + (string :tag "Full Moon") + (string :tag "Last Quarter Moon")) + :group 'calendar + :version "23.2") + (defun lunar-phase (index) "Local date and time of lunar phase INDEX. Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900; remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, -3 last quarter." +3 last quarter. Returns a list (DATE TIME PHASE)." (let* ((phase (mod index 4)) (index (/ index 4.0)) (time (/ index 1236.85)) (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900)) 0.75933 - (* 29.53058868 index) + (* 29.53058868 index) ; FIXME 29.530588853? (* 0.0001178 time time) (* -0.000000155 time time time) (* 0.00033 @@ -136,28 +147,37 @@ (adj (dst-adjust-time date time))) (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) +(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853 + "Mean number of lunar cycles per 365.25 day year.") + +;; FIXME new-moon index; use in lunar-phase-list implies always below. +(defun lunar-index (date) + "Return the lunar index for Gregorian date DATE. +This is 4 times the approximate number of new moons since 1 Jan 1900. +The factor of 4 allows (mod INDEX 4) to represent the four quarters." + (* 4 (truncate + (* lunar-cycles-per-year + ;; Years since 1900, as a real. + (+ (calendar-extract-year date) + (/ (calendar-day-number date) 366.0) + -1900))))) + (defun lunar-phase-list (month year) "List of lunar phases for three months starting with Gregorian MONTH, YEAR." - (let* ((end-month month) - (end-year year) - (start-month month) - (start-year year) - (end-date (progn + (let* ((index (lunar-index (list month 1 year))) + (new-moon (lunar-phase index)) + (end-date (let ((end-month month) + (end-year year)) (calendar-increment-month end-month end-year 3) (list (list end-month 1 end-year)))) + ;; Alternative for start-date: +;;; (calendar-gregorian-from-absolute +;;; (1- (calendar-absolute-from-gregorian (list month 1 year)))) (start-date (progn - (calendar-increment-month start-month start-year -1) - (list (list start-month - (calendar-last-day-of-month - start-month start-year) - start-year)))) - (index (* 4 (truncate - (* 12.3685 - (+ year - ( / (calendar-day-number (list month 1 year)) - 366.0) - -1900))))) - (new-moon (lunar-phase index)) + (calendar-increment-month month year -1) + (list (list month + (calendar-last-day-of-month month year) + year)))) list) (while (calendar-date-compare new-moon end-date) (if (calendar-date-compare start-date new-moon) @@ -169,10 +189,7 @@ (defun lunar-phase-name (phase) "Name of lunar PHASE. 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter." - (cond ((= 0 phase) "New Moon") - ((= 1 phase) "First Quarter Moon") - ((= 2 phase) "Full Moon") - ((= 3 phase) "Last Quarter Moon"))) + (nth phase lunar-phase-names)) (defvar displayed-month) ; from calendar-generate (defvar displayed-year) @@ -204,14 +221,9 @@ (insert (mapconcat (lambda (x) - (let ((date (car x)) - (time (cadr x)) - (phase (nth 2 x))) - (concat (calendar-date-string date) - ": " - (lunar-phase-name phase) - " " - time))) + (format "%s: %s %s" (calendar-date-string (car x)) + (lunar-phase-name (nth 2 x)) + (cadr x))) (lunar-phase-list m1 y1) "\n"))) (message "Computing phases of the moon...done")))) @@ -244,13 +256,7 @@ "Moon phases diary entry. An optional parameter MARK specifies a face or single-character string to use when highlighting the day in the calendar." - (let* ((index (* 4 - (truncate - (* 12.3685 - (+ (calendar-extract-year date) - ( / (calendar-day-number date) - 366.0) - -1900))))) + (let* ((index (lunar-index date)) (phase (lunar-phase index))) (while (calendar-date-compare phase (list date)) (setq index (1+ index) @@ -385,7 +391,7 @@ (floor (calendar-astro-to-absolute d)))) (year (+ (calendar-extract-year date) (/ (calendar-day-number date) 365.25))) - (k (floor (* (- year 2000.0) 12.3685))) + (k (floor (* (- year 2000.0) lunar-cycles-per-year))) (date (lunar-new-moon-time k)) (a-date (progn (while (< date d)