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

[Glenn Morris]

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

Index: solar.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/solar.el,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -b -r1.69 -r1.70
--- solar.el    8 Mar 2008 23:07:08 -0000       1.69
+++ solar.el    13 Mar 2008 04:04:14 -0000      1.70
@@ -7,8 +7,7 @@
 ;;     Denis B. Roegel <address@hidden>
 ;; Maintainer: Glenn Morris <address@hidden>
 ;; Keywords: calendar
-;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary,
-;;     holidays
+;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, 
holidays
 
 ;; This file is part of GNU Emacs.
 
@@ -146,7 +145,7 @@
   :group 'calendar)
 
 (defcustom solar-error 0.5
-"Tolerance (in minutes) for sunrise/sunset calculations.
+  "Tolerance (in minutes) for sunrise/sunset calculations.
 
 A larger value makes the calculations for sunrise/sunset faster, but less
 accurate.  The default is half a minute (30 seconds), so that sunrise/sunset
@@ -221,8 +220,8 @@
   (or calendar-time-zone
       (setq calendar-time-zone
             (solar-get-number
-             "Enter difference from Coordinated Universal Time (in \
-minutes): "))))
+             "Enter difference from Coordinated Universal Time (in minutes): ")
+            )))
 
 (defun solar-get-number (prompt)
   "Return a number from the minibuffer, prompting with PROMPT.
@@ -347,7 +346,7 @@
 accounting for the edge of the sun being on the horizon.
 
 Uses binary search."
-  (let* ((ut (car (cdr time)))
+  (let* ((ut (cadr time))
          (possible t)        ; we assume that rise or set are possible
          (utmin (+ ut (* direction 12.0)))
          (utmax ut)     ; the time searched is between utmin and utmax
@@ -356,31 +355,27 @@
          (utmoment 1.0)                 ; rise or set approximation
          (hut 0)                        ; sun height at utmoment
          (t0 (car time))
-         (hmin (car (cdr
-               (solar-horizontal-coordinates (list t0 utmin)
+         (hmin (cadr (solar-horizontal-coordinates (list t0 utmin)
+                                                   latitude longitude t)))
+         (hmax (cadr (solar-horizontal-coordinates (list t0 utmax)
                                                 latitude longitude t))))
-         (hmax (car (cdr
-               (solar-horizontal-coordinates (list t0 utmax)
-                                                latitude longitude t)))))
     ;; -0.61 degrees is the height of the middle of the sun, when it
     ;; rises or sets.
      (if (< hmin height)
               (if (> hmax height)
                   (while ;;; (< i 20)   ; we perform a simple dichotomy
-                         ;;; (> (abs (- hut height)) epsilon)
+;;; (> (abs (- hut height)) epsilon)
                          (>= (abs (- utmoment utmoment-old))
                              (/ solar-error 60))
-                    (setq utmoment-old utmoment)
-                    (setq utmoment (/ (+ utmin utmax) 2))
-                    (setq hut (car (cdr
-                                    (solar-horizontal-coordinates
-                                   (list t0 utmoment) latitude longitude t))))
+              (setq utmoment-old utmoment
+                    utmoment (/ (+ utmin utmax) 2)
+                    hut (cadr (solar-horizontal-coordinates
+                               (list t0 utmoment) latitude longitude t)))
                     (if (< hut height) (setq utmin utmoment))
-                    (if (> hut height) (setq utmax utmoment))
-                   )
+              (if (> hut height) (setq utmax utmoment)))
                 (setq possible nil))    ; the sun never rises
                 (setq possible nil))    ; the sun never sets
-     (if (not possible) nil utmoment)))
+    (if possible utmoment)))
 
 (defun solar-time-string (time time-zone)
   "Printable form for decimal fraction TIME in TIME-ZONE.
@@ -409,18 +404,15 @@
          (te (solar-time-equation date ut)))
     (setq ut (- ut te))
     (if (>= ut 24)
-        (progn
-          (setq nd (list (car date) (+ 1 (car (cdr date)))
-                         (car (cdr (cdr date)))))
-          (setq ut (- ut 24))))
+        (setq nd (list (car date) (1+ (cadr date))
+                       (nth 2 date))
+              ut (- ut 24)))
     (if (< ut 0)
-        (progn
-          (setq nd (list (car date) (- (car (cdr date)) 1)
-                         (car (cdr (cdr date)))))
-          (setq ut (+ ut 24))))
-    (setq nd (calendar-gregorian-from-absolute
+        (setq nd (list (car date) (1- (cadr date))
+                       (nth 2 date))
+              ut (+ ut 24)))
+    (setq nd (calendar-gregorian-from-absolute ; date standardization
                        (calendar-absolute-from-gregorian nd)))
-        ; date standardization
     (list nd ut)))
 
 (defun solar-sunrise-sunset (date)
@@ -436,7 +428,7 @@
           (progn (setq solar-sidereal-time-greenwich-midnight
                        (solar-sidereal-time t0))
                  (solar-sunrise-and-sunset
-                  (list t0 (car (cdr exact-local-noon)))
+                  (list t0 (cadr exact-local-noon))
                   1.0
                   (calendar-longitude) 0)))
          ;; Store the spring/summer information, compute sunrise and
@@ -446,16 +438,16 @@
          (rise-set
           (progn
             (setq solar-northern-spring-or-summer-season
-                  (if (> (car (cdr (cdr equator-rise-set))) 12) t nil))
+                  (> (nth 2 equator-rise-set) 12))
             (solar-sunrise-and-sunset
-             (list t0 (car (cdr exact-local-noon)))
+             (list t0 (cadr exact-local-noon))
              (calendar-latitude)
              (calendar-longitude) -0.61)))
          (rise (car rise-set))
-         (adj-rise (if rise (dst-adjust-time date rise) nil))
-         (set (car (cdr rise-set)))
-         (adj-set (if set (dst-adjust-time date set) nil))
-         (length  (car (cdr (cdr rise-set)))) )
+         (adj-rise (if rise (dst-adjust-time date rise)))
+         (set (cadr rise-set))          ; FIXME ?
+         (adj-set (if set (dst-adjust-time date set)))
+         (length (nth 2 rise-set)))
     (list
      (and rise (calendar-date-equal date (car adj-rise)) (cdr adj-rise))
      (and set (calendar-date-equal date (car adj-set)) (cdr adj-set))
@@ -469,11 +461,11 @@
      (if (car l)
          (concat "Sunrise " (apply 'solar-time-string (car l)))
        "No sunrise")
-     (if (car (cdr l))
-         (concat "sunset " (apply 'solar-time-string (car (cdr l))))
+     (if (cadr l)
+         (concat "sunset " (apply 'solar-time-string (cadr l)))
        "no sunset")
      (eval calendar-location-name)
-     (car (cdr (cdr l))))))
+     (nth 2 l))))
 
 (defun solar-julian-ut-centuries (date)
   "Number of Julian centuries since 1 Jan, 2000 at noon UT for Gregorian DATE."
@@ -491,7 +483,7 @@
 
 Result is in Julian centuries of ephemeris time."
   (let* ((t0 (car time))
-         (ut (car (cdr time)))
+         (ut (cadr time))
          (t1 (+ t0 (/ (/ ut 24.0) 36525)))
          (y (+ 2000 (* 100 t1)))
          (dt (* 86400 (solar-ephemeris-correction (floor y)))))
@@ -518,15 +510,14 @@
       ;; start-long <= next < end-long when next != 0
       ;; when next = 0, we look for the discontinuity (start-long is near 360
       ;;                and end-long is small (less than l).
-      (setq d (/ (+ start end) 2.0))
-      (setq long (solar-longitude d))
-      (if (or (and (/= next 0) (< long next))
-              (and (= next 0) (< l long)))
-          (progn
-            (setq start d)
-            (setq start-long long))
-        (setq end d)
-        (setq end-long long)))
+      (setq d (/ (+ start end) 2.0)
+            long (solar-longitude d))
+      (if (or (and (not (zerop next)) (< long next))
+              (and (zerop next) (< l long)))
+          (setq start d
+                start-long long)
+        (setq end d
+              end-long long)))
     (/ (+ start end) 2.0)))
 
 (defun solar-horizontal-coordinates (time latitude longitude sunrise-flag)
@@ -793,8 +784,8 @@
                            (* -0.0000000017222 t0 t0 t0)))
           (et (solar-ephemeris-time (list t0 0.0)))
           (nut-i (solar-ecliptic-coordinates et nil))
-          (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
-          (i (car (cdr nut-i))))              ; inclination
+         (nut (nth 3 nut-i))            ; nutation
+         (i (cadr nut-i)))              ; inclination
        (mod (+ (mod (+ mean-sid-time
                     (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
                24.0)
@@ -802,15 +793,12 @@
 
 (defun solar-time-equation (date ut)
   "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
-  (let* ((et (solar-date-to-et date ut))
-         (ec (solar-ecliptic-coordinates et nil)))
-     (car (cdr (cdr ec)))))
+  (nth 2 (solar-ecliptic-coordinates (solar-date-to-et date ut) nil)))
 
 (defun solar-date-to-et (date ut)
   "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
 Expressed in Julian centuries of Ephemeris Time."
-    (let ((t0 (solar-julian-ut-centuries date)))
-      (solar-ephemeris-time (list t0 ut))))
+  (solar-ephemeris-time (list (solar-julian-ut-centuries date) ut)))
 
 ;;;###autoload
 (defun sunrise-sunset (&optional arg)
@@ -915,7 +903,7 @@
   (or (and calendar-latitude calendar-longitude calendar-time-zone)
       (solar-setup))
   (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ;  Friday
-      (let* ((sunset (car (cdr (solar-sunrise-sunset date))))
+      (let* ((sunset (cadr (solar-sunrise-sunset date)))
              (light (if sunset
                         (cons (- (car sunset)
                                  (/ diary-sabbath-candles-minutes 60.0))
@@ -965,19 +953,17 @@
                             (* 0.0007 (solar-cosine-degrees (* 2 W)))))
          (S (apply '+ (mapcar (lambda(x)
                                  (* (car x) (solar-cosine-degrees
-                                             (+ (* (car (cdr (cdr x))) T)
-                                                  (car (cdr x))))))
+                                            (+ (* (nth 2 x) T) (cadr x)))))
                               solar-seasons-data)))
          (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
          ;; Ephemeris time correction.
          (correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))
          (JD (- JDE (/ correction 86400)))
          (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
-         (time (- (- JD 0.5) (floor (- JD 0.5))))
-         )
-      (list (car date) (+ (car (cdr date)) time
+         (time (- (- JD 0.5) (floor (- JD 0.5)))))
+    (list (car date) (+ (cadr date) time
                           (/ (/ calendar-time-zone 60.0) 24.0))
-            (car (cdr (cdr date))))))
+          (nth 2 date))))
 
 ;; From Meeus, 1991, page 166.
 (defun solar-mean-equinoxes/solstices (k year)
@@ -1049,10 +1035,10 @@
            (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
            (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
            (adj (dst-adjust-time d1 h0))
-           (d (list (car (car adj))
-                    (+ (car (cdr (car adj))  )
-                       (/ (car (cdr adj)) 24.0))
-                    (car (cdr (cdr (car adj))))))
+           (d (list (caar adj)
+                    (+ (car (cdar adj))
+                       (/ (cadr adj) 24.0))
+                    (cadr (cdar adj))))
            ;; The following is nearly as accurate, but not quite:
           ;; (d0 (solar-date-next-longitude
            ;;     (calendar-astro-from-absolute