Add arch taglines

[bpt/emacs.git] / lisp / calendar / solar.el

diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index d85c99c..8a514fa 100644 (file)
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,6 +1,6 @@
 ;;; solar.el --- calendar functions for solar events
 
 ;;; solar.el --- calendar functions for solar events
 

-;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1995, 1997, 2003 Free Software Foundation, Inc.

 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;;     Denis B. Roegel <Denis.Roegel@loria.fr>
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;;     Denis B. Roegel <Denis.Roegel@loria.fr>


@@ -59,6 +59,9 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(defvar displayed-month)
+(defvar displayed-year)
+

 (if (fboundp 'atan)
     (require 'lisp-float-type)
   (error "Solar/lunar calculations impossible since floating point is unavailable"))
 (if (fboundp 'atan)
     (require 'lisp-float-type)
   (error "Solar/lunar calculations impossible since floating point is unavailable"))


@@ -73,8 +76,8 @@
   "*The pseudo-pattern that governs the way a time of day is formatted.
 
 A pseudo-pattern is a list of expressions that can involve the keywords
   "*The pseudo-pattern that governs the way a time of day is formatted.
 
 A pseudo-pattern is a list of expressions that can involve the keywords

-`12-hours', `24-hours', and `minutes',  all numbers in string form,
-and `am-pm' and `time-zone',  both alphabetic strings.
+`12-hours', `24-hours', and `minutes', all numbers in string form,
+and `am-pm' and `time-zone', both alphabetic strings.

 
 For example, the form
 
 
 For example, the form
 


@@ -194,8 +197,8 @@ delta.  At present, delta = 0.01 degrees, so the value of the variable
   '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
   "List of season changes for the southern hemisphere.")
 
   '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
   "List of season changes for the southern hemisphere.")
 

-(defvar solar-sidereal-time-greenwich-midnight 
-   nil 
+(defvar solar-sidereal-time-greenwich-midnight
+   nil

    "Sidereal time at Greenwich at midnight (universal time).")
 
 (defvar solar-northern-spring-or-summer-season nil
    "Sidereal time at Greenwich at midnight (universal time).")
 
 (defvar solar-northern-spring-or-summer-season nil


@@ -239,7 +242,7 @@ Returns nil if nothing was entered."
   (condition-case nil
       (tan (degrees-to-radians (mod x 360.0)))
     (solar-tangent-degrees x)))
   (condition-case nil
       (tan (degrees-to-radians (mod x 360.0)))
     (solar-tangent-degrees x)))

-      
+

 (defun solar-xy-to-quadrant (x y)
   "Determines the quadrant of the point X, Y."
   (if (> x 0)
 (defun solar-xy-to-quadrant (x y)
   "Determines the quadrant of the point X, Y."
   (if (> x 0)


@@ -262,7 +265,7 @@ Returns nil if nothing was entered."
    "Arctan of point X, Y."
    (if (= x 0)
        (if (> y 0) 90 270)
    "Arctan of point X, Y."
    (if (= x 0)
        (if (> y 0) 90 270)

-     (solar-arctan (/ y x) x)))
+     (solar-arctan (/ y x) (solar-xy-to-quadrant x y))))

 
 (defun solar-arccos (x)
      "Arcos of X."
 
 (defun solar-arccos (x)
      "Arcos of X."


@@ -399,7 +402,7 @@ Format used is given by `calendar-time-display-form'."
           (floor (* 60 (- time (floor time))))))
 
 (defun solar-exact-local-noon (date)
           (floor (* 60 (- time (floor time))))))
 
 (defun solar-exact-local-noon (date)

-  "Date and Universal Time of local noon at *local date* date. 
+  "Date and Universal Time of local noon at *local date* date.

 
 The date may be different from the one asked for, but it will be the right
 local date.  The second component of date should be an integer."
 
 The date may be different from the one asked for, but it will be the right
 local date.  The second component of date should be an integer."


@@ -408,12 +411,12 @@ local date.  The second component of date should be an integer."
          (te (solar-time-equation date ut)))
     (setq ut (- ut te))
     (if (>= ut 24)
          (te (solar-time-equation date ut)))
     (setq ut (- ut te))
     (if (>= ut 24)

-        (progn 
+        (progn

           (setq nd (list (car date) (+ 1 (car (cdr date)))
                          (car (cdr (cdr date)))))
           (setq ut (- ut 24))))
     (if (< ut 0)
           (setq nd (list (car date) (+ 1 (car (cdr date)))
                          (car (cdr (cdr date)))))
           (setq ut (- ut 24))))
     (if (< ut 0)

-        (progn 
+        (progn

           (setq nd (list (car date) (- (car (cdr date)) 1)
                          (car (cdr (cdr date)))))
           (setq ut (+ ut 24))))
           (setq nd (list (car date) (- (car (cdr date)) 1)
                          (car (cdr (cdr date)))))
           (setq ut (+ ut 24))))


@@ -477,10 +480,10 @@ Corresponding value is nil if there is no sunrise/sunset."
 
 (defun solar-julian-ut-centuries (date)
   "Number of Julian centuries elapsed since 1 Jan, 2000 at noon  U.T. for Gregorian DATE."
 
 (defun solar-julian-ut-centuries (date)
   "Number of Julian centuries elapsed since 1 Jan, 2000 at noon  U.T. for Gregorian DATE."

-  (/ (- (calendar-absolute-from-gregorian date) 
+  (/ (- (calendar-absolute-from-gregorian date)

         (calendar-absolute-from-gregorian '(1 1.5 2000)))
      36525.0))
         (calendar-absolute-from-gregorian '(1 1.5 2000)))
      36525.0))

-  
+

 (defun solar-ephemeris-time(time)
   "Ephemeris Time at moment TIME.
 
 (defun solar-ephemeris-time(time)
   "Ephemeris Time at moment TIME.
 


@@ -534,7 +537,7 @@ calendar-time-zone are used to interpret local time."
         (setq end-long long)))
     (/ (+ start end) 2.0)))
 
         (setq end-long long)))
     (/ (+ start end) 2.0)))
 

-(defun solar-horizontal-coordinates 
+(defun solar-horizontal-coordinates

           (time latitude longitude for-sunrise-sunset)
   "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
 
           (time latitude longitude for-sunrise-sunset)
   "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
 


@@ -557,7 +560,7 @@ The azimuth is given in degrees as well as the height (between -180 and 180)."
                                 (* (solar-tangent-degrees de)
                                    (solar-cosine-degrees latitude)))
                               (solar-sin-degrees ah)))
                                 (* (solar-tangent-degrees de)
                                    (solar-cosine-degrees latitude)))
                               (solar-sin-degrees ah)))

-         (height (solar-arcsin 
+         (height (solar-arcsin

                   (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
                      (* (solar-cosine-degrees latitude)
                         (solar-cosine-degrees de)
                   (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
                      (* (solar-cosine-degrees latitude)
                         (solar-cosine-degrees de)


@@ -573,7 +576,7 @@ elapsed at 0 Universal Time, and the second component being the universal
 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."
 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."

-   (let* ((tm (solar-ephemeris-time time)) 
+   (let* ((tm (solar-ephemeris-time time))

           (ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
      (list (solar-right-ascension (car ec) (car (cdr ec)))
            (solar-declination (car ec) (car (cdr ec))))))
           (ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
      (list (solar-right-ascension (car ec) (car (cdr ec)))
            (solar-declination (car ec) (car (cdr ec))))))


@@ -585,16 +588,16 @@ at moment `time', expressed in julian centuries of Ephemeris Time
 since January 1st, 2000, at 12 ET."
   (let* ((l (+ 280.46645
                (* 36000.76983 time)
 since January 1st, 2000, at 12 ET."
   (let* ((l (+ 280.46645
                (* 36000.76983 time)

-               (* 0.0003032 time time))) ; sun mean longitude 
+               (* 0.0003032 time time))) ; sun mean longitude

          (ml (+ 218.3165
          (ml (+ 218.3165

-                (* 481267.8813 time))) ; moon mean longitude 
+                (* 481267.8813 time))) ; moon mean longitude

          (m (+ 357.52910
                (* 35999.05030 time)
                (* -0.0001559 time time)
          (m (+ 357.52910
                (* 35999.05030 time)
                (* -0.0001559 time time)

-               (* -0.00000048 time time time))) ; sun mean anomaly 
+               (* -0.00000048 time time time))) ; sun mean anomaly

          (i (+ 23.43929111 (* -0.013004167 time)
                (* -0.00000016389 time time)
          (i (+ 23.43929111 (* -0.013004167 time)
                (* -0.00000016389 time time)

-               (* 0.0000005036 time time time))); mean inclination 
+               (* 0.0000005036 time time time))); mean inclination

          (c (+ (* (+ 1.914600
                      (* -0.004817 time)
                      (* -0.000014 time time))
          (c (+ (* (+ 1.914600
                      (* -0.004817 time)
                      (* -0.000014 time time))


@@ -602,8 +605,8 @@ since January 1st, 2000, at 12 ET."
                (* (+ 0.019993 (* -0.000101 time))
                   (solar-sin-degrees (* 2 m)))
                (* 0.000290
                (* (+ 0.019993 (* -0.000101 time))
                   (solar-sin-degrees (* 2 m)))
                (* 0.000290

-                  (solar-sin-degrees (* 3 m))))) ; center equation 
-         (L (+ l c)) ; total longitude 
+                  (solar-sin-degrees (* 3 m))))) ; center equation
+         (L (+ l c)) ; total longitude

          (omega (+ 125.04
                    (* -1934.136 time))) ; longitude of moon's ascending node
                                         ; on the ecliptic
          (omega (+ 125.04
                    (* -1934.136 time))) ; longitude of moon's ascending node
                                         ; on the ecliptic


@@ -624,13 +627,13 @@ since January 1st, 2000, at 12 ET."
                  (* -0.00478
                     (solar-sin-degrees omega)))) ; apparent longitude of sun
          (y (if (not for-sunrise-sunset)
                  (* -0.00478
                     (solar-sin-degrees omega)))) ; apparent longitude of sun
          (y (if (not for-sunrise-sunset)

-                 (* (solar-tangent-degrees (/ i 2)) 
+                 (* (solar-tangent-degrees (/ i 2))

                   (solar-tangent-degrees (/ i 2)))
                 nil))
          (time-eq (if (not for-sunrise-sunset)
                     (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
                      (* -2 ecc (solar-sin-degrees m))
                   (solar-tangent-degrees (/ i 2)))
                 nil))
          (time-eq (if (not for-sunrise-sunset)
                     (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
                      (* -2 ecc (solar-sin-degrees m))

-                     (* 4 ecc y (solar-sin-degrees m) 
+                     (* 4 ecc y (solar-sin-degrees m)

                                 (solar-cosine-degrees (* 2 l)))
                      (* -0.5 y y  (solar-sin-degrees (* 4 l)))
                      (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
                                 (solar-cosine-degrees (* 2 l)))
                      (* -0.5 y y  (solar-sin-degrees (* 4 l)))
                      (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))


@@ -807,7 +810,7 @@ T0 must correspond to 0 hours UT."
           (nut-i (solar-ecliptic-coordinates et nil))
           (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
           (i (car (cdr nut-i)))) ; inclination
           (nut-i (solar-ecliptic-coordinates et nil))
           (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
           (i (car (cdr nut-i)))) ; inclination

-       (mod (+ (mod (+ mean-sid-time 
+       (mod (+ (mod (+ mean-sid-time

                     (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
                24.0)
             24.0)))
                     (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
                24.0)
             24.0)))


@@ -895,7 +898,7 @@ This function is suitable for execution in a .emacs file."
                        "Type \\[delete-other-windows] to remove temp window."
                      "Type \\[switch-to-buffer] RET to remove temp window.")
                  "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
                        "Type \\[delete-other-windows] to remove temp window."
                      "Type \\[switch-to-buffer] RET to remove temp window.")
                  "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))

- 
+

 (defun calendar-sunrise-sunset ()
   "Local time of sunrise and sunset for date under cursor.
 Accurate to a few seconds."
 (defun calendar-sunrise-sunset ()
   "Local time of sunrise and sunset for date under cursor.
 Accurate to a few seconds."


@@ -924,7 +927,7 @@ Accurate to a few seconds."
   "Local time of candle lighting diary entry--applies if date is a Friday.
 No diary entry if there is no sunset on that date.
 
   "Local time of candle lighting diary entry--applies if date is a Friday.
 No diary entry if there is no sunset on that date.
 

-An optional parameter MARK specifies a face or single-character string to 
+An optional parameter MARK specifies a face or single-character string to

 use when highlighting the day in the calendar."
   (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
       (solar-setup))
 use when highlighting the day in the calendar."
   (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
       (solar-setup))


@@ -939,10 +942,37 @@ use when highlighting the day in the calendar."
                  (format "%s Sabbath candle lighting"
                     (apply 'solar-time-string light)))))))
 
                  (format "%s Sabbath candle lighting"
                     (apply 'solar-time-string light)))))))
 

+; from Meeus, 1991, page 167
+(defconst solar-seasons-data
+  '((485 324.96 1934.136)
+    (203 337.23 32964.467)
+    (199 342.08 20.186)
+    (182 27.85 445267.112)
+    (156 73.14 45036.886)
+    (136 171.52 22518.443)
+    (77 222.54 65928.934)
+    (74 296.72 3034.906)
+    (70 243.58 9037.513)
+    (58 119.81 33718.147)
+    (52 297.17 150.678)
+    (50 21.02 2281.226)
+    (45 247.54 29929.562)
+    (44 325.15 31555.956)
+    (29 60.93 4443.417)
+    (18 155.12 67555.328)
+    (17 288.79 4562.452)
+    (16 198.04 62894.029)
+    (14 199.76 31436.921)
+    (12 95.39 14577.848)
+    (12 287.11 31931.756)
+    (12 320.81 34777.259)
+    (9 227.73 1222.114)
+    (8 15.45 16859.074)))
+

 (defun solar-equinoxes/solstices (k year)
   "Date of equinox/solstice K for YEAR.
 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
 (defun solar-equinoxes/solstices (k year)
   "Date of equinox/solstice K for YEAR.
 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;

-K=3, winter solstice. 
+K=3, winter solstice.

 RESULT is a gregorian local date.
 
 Accurate to less than a minute between 1951 and 2050."
 RESULT is a gregorian local date.
 
 Accurate to less than a minute between 1951 and 2050."


@@ -951,13 +981,13 @@ Accurate to less than a minute between 1951 and 2050."
          (W (- (* 35999.373 T) 2.47))
          (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
                             (* 0.0007 (solar-cosine-degrees (* 2 W)))))
          (W (- (* 35999.373 T) 2.47))
          (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
                             (* 0.0007 (solar-cosine-degrees (* 2 W)))))

-         (S (apply '+ (mapcar '(lambda(x) 
-                                 (* (car x) (solar-cosine-degrees 
+         (S (apply '+ (mapcar '(lambda(x)
+                                 (* (car x) (solar-cosine-degrees

                                              (+ (* (car (cdr (cdr x))) T)
                                              (+ (* (car (cdr (cdr x))) T)

-                                                  (car (cdr x)))))) 
+                                                  (car (cdr x))))))

                               solar-seasons-data)))
          (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
                               solar-seasons-data)))
          (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))

-         (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) 
+         (correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))

              ; ephemeris time correction
          (JD (- JDE (/ correction 86400)))
          (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
              ; ephemeris time correction
          (JD (- JDE (/ correction 86400)))
          (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))


@@ -969,7 +999,7 @@ Accurate to less than a minute between 1951 and 2050."
 
 ; from Meeus, 1991, page 166
 (defun solar-mean-equinoxes/solstices (k year)
 
 ; from Meeus, 1991, page 166
 (defun solar-mean-equinoxes/solstices (k year)

-  "Julian day of mean equinox/solstice K for YEAR.  
+  "Julian day of mean equinox/solstice K for YEAR.

 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
 solstice.  These formulas are only to be used between 1000 BC and 3000 AD."
   (let ((y (/ year 1000.0))
 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
 solstice.  These formulas are only to be used between 1000 BC and 3000 AD."
   (let ((y (/ year 1000.0))


@@ -1017,33 +1047,6 @@ solstice.  These formulas are only to be used between 1000 BC and 3000 AD."
                                    (* -0.00823 z z z)
                                    (* 0.00032 z z z z)))))))
 
                                    (* -0.00823 z z z)
                                    (* 0.00032 z z z z)))))))
 

-; from Meeus, 1991, page 167
-(defconst solar-seasons-data
-  '((485 324.96 1934.136)
-    (203 337.23 32964.467)
-    (199 342.08 20.186)
-    (182 27.85 445267.112)
-    (156 73.14 45036.886)
-    (136 171.52 22518.443)
-    (77 222.54 65928.934)
-    (74 296.72 3034.906)
-    (70 243.58 9037.513)
-    (58 119.81 33718.147)
-    (52 297.17 150.678)
-    (50 21.02 2281.226)
-    (45 247.54 29929.562)
-    (44 325.15 31555.956)
-    (29 60.93 4443.417)
-    (18 155.12 67555.328)
-    (17 288.79 4562.452)
-    (16 198.04 62894.029)
-    (14 199.76 31436.921)
-    (12 95.39 14577.848)
-    (12 287.11 31931.756)
-    (12 320.81 34777.259)
-    (9 227.73 1222.114)
-    (8 15.45 16859.074)))
-

 ;;;###autoload
 (defun solar-equinoxes-solstices ()
   "*local* date and time of equinoxes and solstices, if visible in the calendar window.
 ;;;###autoload
 (defun solar-equinoxes-solstices ()
   "*local* date and time of equinoxes and solstices, if visible in the calendar window.


@@ -1061,13 +1064,14 @@ Requires floating point."
             (if calendar-time-zone calendar-daylight-savings-ends))
            (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
            (k (1- (/ m 3)))
             (if calendar-time-zone calendar-daylight-savings-ends))
            (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
            (k (1- (/ m 3)))

-           (d0 (solar-equinoxes/solstices k y)) 
+           (d0 (solar-equinoxes/solstices k y))

            (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))
            (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 d1) (+ (car (cdr d1))  
-                  (/ (car (cdr adj)) 24.0))
-                    (car (cdr (cdr d1)))))
+           (d (list (car (car adj))
+                    (+ (car (cdr (car adj))  )
+                       (/ (car (cdr adj)) 24.0))
+                    (car (cdr (cdr (car adj))))))

            ; The following is nearly as accurate, but not quite:
           ;(d0 (solar-date-next-longitude
            ;    (calendar-astro-from-absolute
            ; The following is nearly as accurate, but not quite:
           ;(d0 (solar-date-next-longitude
            ;    (calendar-astro-from-absolute


@@ -1092,4 +1096,5 @@ Requires floating point."
 
 (provide 'solar)
 
 
 (provide 'solar)
 

+;;; arch-tag: bc0ff693-df58-4666-bde4-2a7837ccb8fe

 ;;; solar.el ends here
 ;;; solar.el ends here