[Emacs-diffs] Changes to emacs/lisp/calendar/lunar.el,v

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       08/03/14 07:08:37

Index: lunar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/lunar.el,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -b -r1.35 -r1.36
--- lunar.el    13 Mar 2008 06:29:28 -0000      1.35
+++ lunar.el    14 Mar 2008 07:08:37 -0000      1.36
@@ -45,45 +45,12 @@
 
 ;;; Code:
 
-(defvar date)
-(defvar displayed-month)
-(defvar displayed-year)
-
 (if (fboundp 'atan)
     (require 'lisp-float-type)
   (error "Lunar calculations impossible since floating point is unavailable"))
 
 (require 'solar)
 
-(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))
-    (increment-calendar-month end-month end-year 3)
-    (increment-calendar-month start-month start-year -1)
-    (let* ((end-date (list (list end-month 1 end-year)))
-           (start-date (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))
-           (list))
-      (while (calendar-date-compare new-moon end-date)
-        (if (calendar-date-compare start-date new-moon)
-            (setq list (append list (list new-moon))))
-        (setq index (1+ index))
-        (setq new-moon (lunar-phase index)))
-      list)))
-
 (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;
@@ -176,6 +143,35 @@
          (adj (dst-adjust-time date time)))
     (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
 
+(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))
+    (increment-calendar-month end-month end-year 3)
+    (increment-calendar-month start-month start-year -1)
+    (let* ((end-date (list (list end-month 1 end-year)))
+           (start-date (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))
+           (list))
+      (while (calendar-date-compare new-moon end-date)
+        (if (calendar-date-compare start-date new-moon)
+            (setq list (append list (list new-moon))))
+        (setq index (1+ index)
+              new-moon (lunar-phase index)))
+      list)))
+
 (defun lunar-phase-name (phase)
   "Name of lunar PHASE.
 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter."
@@ -184,6 +180,9 @@
         ((= 2 phase) "Full Moon")
         ((= 3 phase) "Last Quarter Moon")))
 
+(defvar displayed-month)                ; from generate-calendar
+(defvar displayed-year)
+
 ;;;###cal-autoload
 (defun calendar-phases-of-moon ()
   "Create a buffer with the lunar phases for the current calendar window."
@@ -208,8 +207,8 @@
      (mapconcat
       (lambda (x)
          (let ((date (car x))
-               (time (car (cdr x)))
-               (phase (car (cdr (cdr x)))))
+              (time (cadr x))
+              (phase (nth 2 x)))
            (concat (calendar-date-string date)
                    ": "
                    (lunar-phase-name phase)
@@ -229,16 +228,19 @@
 This function is suitable for execution in a .emacs file."
   (interactive "P")
   (save-excursion
-    (let* ((date (if arg
-                     (calendar-read-date t)
+    (let* ((date (if arg (calendar-read-date t)
                    (calendar-current-date)))
            (displayed-month (extract-calendar-month date))
            (displayed-year (extract-calendar-year date)))
       (calendar-phases-of-moon))))
 
+(defvar date)
+
+;; To be called from list-sexp-diary-entries, where DATE is bound.
+
 ;;;###diary-autoload
 (defun diary-phases-of-moon (&optional mark)
-"Moon phases diary entry.
+  "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
@@ -250,11 +252,11 @@
                           -1900)))))
          (phase (lunar-phase index)))
     (while (calendar-date-compare phase (list date))
-      (setq index (1+ index))
-      (setq phase (lunar-phase index)))
+      (setq index (1+ index)
+            phase (lunar-phase index)))
     (if (calendar-date-equal (car phase) date)
-        (cons mark (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
-                (car (cdr phase)))))))
+        (cons mark (concat (lunar-phase-name (nth 2 phase)) " "
+                           (cadr phase))))))
 
 ;;  For the Chinese calendar the calculations for the new moon need to be more
 ;;  accurate than those above, so we use more terms in the approximation.
@@ -370,10 +372,10 @@
 The fractional part is the time of day.
 
 The date and time are local time, including any daylight saving rules,
-as governed by the values of calendar-daylight-savings-starts,
-calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
-calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
-calendar-time-zone."
+as governed by the values of `calendar-daylight-savings-starts',
+`calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends',
+`calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', and
+`calendar-time-zone'."
   (let* ((date (calendar-gregorian-from-absolute
                 (floor (calendar-absolute-from-astro d))))
          (year (+ (extract-calendar-year date)
@@ -381,15 +383,15 @@
          (k (floor (* (- year 2000.0) 12.3685)))
          (date (lunar-new-moon-time k)))
     (while (< date d)
-      (setq k (1+ k))
-      (setq date (lunar-new-moon-time k)))
+      (setq k (1+ k)
+            date (lunar-new-moon-time k)))
     (let* ((a-date (calendar-absolute-from-astro date))
            (time (* 24 (- a-date (truncate a-date))))
            (date (calendar-gregorian-from-absolute (truncate a-date)))
            (adj (dst-adjust-time date time)))
       (calendar-astro-from-absolute
        (+ (calendar-absolute-from-gregorian (car adj))
-          (/ (car (cdr adj)) 24.0))))))
+          (/ (cadr adj) 24.0))))))
 
 (provide 'lunar)