lisp/calendar/solar.el

   1 ;;; solar.el --- calendar functions for solar events
   2
   3 ;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
   6 ;;      Denis B. Roegel <Denis.Roegel@loria.fr>
   7 ;; Keywords: calendar
   8 ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary,
   9 ;;      holidays
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This collection of functions implements the features of calendar.el,
  31 ;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and
  32 ;; equinoxes/solstices.
  33
  34 ;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
  35 ;; Almanac Office, United States Naval Observatory, Washington, 1984, on
  36 ;; ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
  37 ;; Willmann-Bell, Inc., 1985, on ``Astronomical Algorithms'' by Jean Meeus,
  38 ;; Willmann-Bell, Inc., 1991, and on ``Planetary Programs and Tables from
  39 ;; -4000 to +2800'' by Pierre Bretagnon and Jean-Louis Simon, Willmann-Bell,
  40 ;; Inc., 1986.
  41
  42 ;;
  43 ;; Accuracy:
  44 ;;    1. Sunrise/sunset times will be accurate to the minute for years
  45 ;;       1951--2050.  For other years the times will be within +/- 2 minutes.
  46 ;;
  47 ;;    2. Equinox/solstice times will be accurate to the minute for years
  48 ;;       1951--2050.  For other years the times will be within +/- 1 minute.
  49
  50 ;; Technical details of all the calendrical calculations can be found in
  51 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  52 ;; Cambridge University Press (1997).
  53
  54 ;; Comments, corrections, and improvements should be sent to
  55 ;;  Edward M. Reingold               Department of Computer Science
  56 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  57 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  58 ;;                                   Urbana, Illinois 61801
  59
  60 ;;; Code:
  61
  62 (if (fboundp 'atan)
  63     (require 'lisp-float-type)
  64   (error "Solar/lunar calculations impossible since floating point is unavailable"))
  65
  66 (require 'cal-dst)
  67 (require 'cal-julian)
  68
  69 ;;;###autoload
  70 (defcustom calendar-time-display-form
  71   '(12-hours ":" minutes am-pm
  72     (if time-zone " (") time-zone (if time-zone ")"))
  73   "*The pseudo-pattern that governs the way a time of day is formatted.
  74
  75 A pseudo-pattern is a list of expressions that can involve the keywords
  76 `12-hours', `24-hours', and `minutes',  all numbers in string form,
  77 and `am-pm' and `time-zone',  both alphabetic strings.
  78
  79 For example, the form
  80
  81   '(24-hours \":\" minutes
  82     (if time-zone \" (\") time-zone (if time-zone \")\"))
  83
  84 would give military-style times like `21:07 (UTC)'."
  85   :type 'sexp
  86   :group 'calendar)
  87
  88 ;;;###autoload
  89 (defcustom calendar-latitude nil
  90   "*Latitude of `calendar-location-name' in degrees.
  91
  92 The value can be either a decimal fraction (one place of accuracy is
  93 sufficient), + north, - south, such as 40.7 for New York City, or the value
  94 can be a vector [degrees minutes north/south] such as [40 50 north] for New
  95 York City.
  96
  97 This variable should be set in `site-start'.el."
  98   :type '(choice (const nil)
  99                  (number :tag "Exact")
 100                  (vector :value [0 0 north]
 101                          (integer :tag "Degrees")
 102                          (integer :tag "Minutes")
 103                          (choice :tag "Position"
 104                                  (const north)
 105                                  (const south))))
 106   :group 'calendar)
 107
 108 ;;;###autoload
 109 (defcustom calendar-longitude nil
 110   "*Longitude of `calendar-location-name' in degrees.
 111
 112 The value can be either a decimal fraction (one place of accuracy is
 113 sufficient), + east, - west, such as -73.9 for New York City, or the value
 114 can be a vector [degrees minutes east/west] such as [73 55 west] for New
 115 York City.
 116
 117 This variable should be set in `site-start'.el."
 118   :type '(choice (const nil)
 119                  (number :tag "Exact")
 120                  (vector :value [0 0 west]
 121                          (integer :tag "Degrees")
 122                          (integer :tag "Minutes")
 123                          (choice :tag "Position"
 124                                  (const east)
 125                                  (const west))))
 126   :group 'calendar)
 127
 128 (defsubst calendar-latitude ()
 129   "Convert calendar-latitude to a signed decimal fraction, if needed."
 130   (if (numberp calendar-latitude)
 131       calendar-latitude
 132     (let ((lat (+ (aref calendar-latitude 0)
 133                   (/ (aref calendar-latitude 1) 60.0))))
 134       (if (equal (aref calendar-latitude 2) 'north)
 135           lat
 136         (- lat)))))
 137
 138 (defsubst calendar-longitude ()
 139   "Convert calendar-longitude to a signed decimal fraction, if needed."
 140   (if (numberp calendar-longitude)
 141       calendar-longitude
 142     (let ((long (+ (aref calendar-longitude 0)
 143                   (/ (aref calendar-longitude 1) 60.0))))
 144       (if (equal (aref calendar-longitude 2) 'east)
 145           long
 146         (- long)))))
 147
 148 ;;;###autoload
 149 (defcustom calendar-location-name
 150   '(let ((float-output-format "%.1f"))
 151      (format "%s%s, %s%s"
 152              (if (numberp calendar-latitude)
 153                  (abs calendar-latitude)
 154                (+ (aref calendar-latitude 0)
 155                   (/ (aref calendar-latitude 1) 60.0)))
 156              (if (numberp calendar-latitude)
 157                  (if (> calendar-latitude 0) "N" "S")
 158                (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
 159              (if (numberp calendar-longitude)
 160                  (abs calendar-longitude)
 161                (+ (aref calendar-longitude 0)
 162                   (/ (aref calendar-longitude 1) 60.0)))
 163              (if (numberp calendar-longitude)
 164                  (if (> calendar-longitude 0) "E" "W")
 165                (if (equal (aref calendar-longitude 2) 'east) "E" "W"))))
 166   "*Expression evaluating to name of `calendar-longitude', `calendar-latitude'.
 167 For example, \"New York City\".  Default value is just the latitude, longitude
 168 pair.
 169
 170 This variable should be set in `site-start'.el."
 171   :type 'sexp
 172   :group 'calendar)
 173
 174 (defcustom solar-error 0.5
 175 "*Tolerance (in minutes) for sunrise/sunset calculations.
 176
 177 A larger value makes the calculations for sunrise/sunset faster, but less
 178 accurate.  The default is half a minute (30 seconds), so that sunrise/sunset
 179 times will be correct to the minute.
 180
 181 It is useless to set the value smaller than 4*delta, where delta is the
 182 accuracy in the longitude of the sun (given by the function
 183 `solar-ecliptic-coordinates') in degrees since (delta/360) x (86400/60) = 4 x
 184 delta.  At present, delta = 0.01 degrees, so the value of the variable
 185 `solar-error' should be at least 0.04 minutes (about 2.5 seconds)."
 186   :type 'number
 187   :group 'calendar)
 188
 189 (defvar solar-n-hemi-seasons
 190   '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")
 191   "List of season changes for the northern hemisphere.")
 192
 193 (defvar solar-s-hemi-seasons
 194   '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
 195   "List of season changes for the southern hemisphere.")
 196
 197 (defvar solar-sidereal-time-greenwich-midnight
 198    nil
 199    "Sidereal time at Greenwich at midnight (universal time).")
 200
 201 (defvar solar-spring-or-summer-season nil
 202   "T if spring or summer and nil otherwise.
 203 Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.")
 204
 205 (defun solar-setup ()
 206   "Prompt user for latitude, longitude, and time zone."
 207   (beep)
 208   (if (not calendar-longitude)
 209       (setq calendar-longitude
 210             (solar-get-number
 211              "Enter longitude (decimal fraction; + east, - west): ")))
 212   (if (not calendar-latitude)
 213       (setq calendar-latitude
 214             (solar-get-number
 215              "Enter latitude (decimal fraction; + north, - south): ")))
 216   (if (not calendar-time-zone)
 217       (setq calendar-time-zone
 218             (solar-get-number
 219              "Enter difference from Coordinated Universal Time (in minutes): "))))
 220
 221 (defun solar-get-number (prompt)
 222   "Return a number from the minibuffer, prompting with PROMPT.
 223 Returns nil if nothing was entered."
 224   (let ((x (read-string prompt "")))
 225     (if (not (string-equal x ""))
 226         (string-to-int x))))
 227
 228 ;; The condition-case stuff is needed to catch bogus arithmetic
 229 ;; exceptions that occur on some machines (like Sparcs)
 230 (defun solar-sin-degrees (x)
 231   (condition-case nil
 232       (sin (degrees-to-radians (mod x 360.0)))
 233     (solar-sin-degrees x)))
 234 (defun solar-cosine-degrees (x)
 235    (condition-case nil
 236        (cos (degrees-to-radians (mod x 360.0)))
 237      (solar-cosine-degrees x)))
 238 (defun solar-tangent-degrees (x)
 239   (condition-case nil
 240       (tan (degrees-to-radians (mod x 360.0)))
 241     (solar-tangent-degrees x)))
 242
 243 (defun solar-xy-to-quadrant (x y)
 244   "Determines the quadrant of the point X, Y."
 245   (if (> x 0)
 246       (if (> y 0) 1 4)
 247       (if (> y 0) 2 3)))
 248
 249 (defun solar-degrees-to-quadrant (angle)
 250   "Determines the quadrant of ANGLE."
 251   (1+ (floor (mod angle 360) 90)))
 252
 253 (defun solar-arctan (x quad)
 254   "Arctangent of X in quadrant QUAD."
 255   (let ((deg (radians-to-degrees (atan x))))
 256     (cond ((equal quad 2)   (+ deg 180))
 257           ((equal quad 3)   (+ deg 180))
 258           ((equal quad 4)   (+ deg 360))
 259           (t                deg))))
 260
 261 (defun solar-atn2 (x y)
 262    "Arctan of point X, Y."
 263    (if (= x 0)
 264        (if (> y 0) 90 270)
 265      (solar-arctan (/ y x) x)))
 266
 267 (defun solar-arccos (x)
 268      "Arcos of X."
 269      (let ((y (sqrt (- 1 (* x x)))))
 270        (solar-atn2 x y)))
 271
 272 (defun solar-arcsin (y)
 273      "Arcsin of Y."
 274      (let ((x (sqrt (- 1 (* y y)))))
 275        (solar-atn2 x y)
 276        ))
 277
 278 (defsubst solar-degrees-to-hours (degrees)
 279   "Convert DEGREES to hours."
 280   (/ degrees 15.0))
 281
 282 (defsubst solar-hours-to-days (hour)
 283   "Convert HOUR to decimal fraction of a day."
 284   (/ hour 24.0))
 285
 286 (defun solar-right-ascension (longitude obliquity)
 287   "Right ascension of the sun, in hours, given LONGITUDE and OBLIQUITY.
 288 Both arguments are in degrees."
 289   (solar-degrees-to-hours
 290    (solar-arctan
 291     (* (solar-cosine-degrees obliquity) (solar-tangent-degrees longitude))
 292     (solar-degrees-to-quadrant longitude))))
 293
 294 (defun solar-declination (longitude obliquity)
 295   "Declination of the sun, in degrees, given LONGITUDE and OBLIQUITY.
 296 Both arguments are in degrees."
 297   (solar-arcsin
 298    (* (solar-sin-degrees obliquity)
 299       (solar-sin-degrees longitude))))
 300
 301 (defun solar-sunrise-and-sunset (time latitude longitude)
 302   "Sunrise, sunset and length of day.
 303 Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location.
 304
 305 TIME is a pair with the first component being the number of Julian centuries
 306 elapsed at 0 Universal Time, and the second component being the universal
 307 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 308 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 309 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
 310
 311 Coordinates are included because this function is called with latitude=10
 312 degrees to find out if polar regions have 24 hours of sun or only night."
 313   (let* ((rise-time (solar-moment -1 latitude longitude time))
 314          (set-time (solar-moment 1 latitude longitude time))
 315          (day-length))
 316     (if (not (and rise-time set-time))
 317         (if (or (and (> latitude 0) solar-spring-or-summer-season)
 318                 (and (< latitude 0) (not solar-spring-or-summer-season)))
 319             (setq day-length 0)
 320           (setq day-length 24))
 321         (setq day-length (- set-time rise-time)))
 322     (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil)
 323           (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil)
 324           day-length)))
 325
 326 (defun solar-moment (direction latitude longitude time)
 327   "Sunrise/sunset at location.
 328 Sunrise if DIRECTION =-1 or sunset if =1 at LATITUDE, LONGITUDE, with midday
 329 being TIME.
 330
 331 TIME is a pair with the first component being the number of Julian centuries
 332 elapsed at 0 Universal Time, and the second component being the universal
 333 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 334 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 335 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
 336
 337 Uses binary search."
 338   (let* ((ut (car (cdr time)))
 339          (possible 1) ; we assume that rise or set are possible
 340          (utmin (+ ut (* direction 12.0)))
 341          (utmax ut)    ; the time searched is between utmin and utmax
 342             ; utmin and utmax are in hours
 343          (utmoment-old 0.0)    ; rise or set approximation
 344          (utmoment 1.0) ; rise or set approximation
 345          (hut 0)         ; sun height at utmoment
 346          (t0 (car time))
 347          (hmin (car (cdr
 348                (solar-horizontal-coordinates (list t0 utmin)
 349                                                 latitude longitude t))))
 350          (hmax (car (cdr
 351                (solar-horizontal-coordinates (list t0 utmax)
 352                                                 latitude longitude t)))))
 353        ; -0.61 degrees is the height of the middle of the sun, when it rises
 354        ;   or sets.
 355      (if (< hmin -0.61)
 356               (if (> hmax -0.61)
 357                   (while ;(< i 20) ; we perform a simple dichotomy
 358                          ; (> (abs (+ hut 0.61)) epsilon)
 359                          (>= (abs (- utmoment utmoment-old))
 360                              (/ solar-error 60))
 361                     (setq utmoment-old utmoment)
 362                     (setq utmoment (/ (+ utmin utmax) 2))
 363                     (setq hut (car (cdr
 364                                     (solar-horizontal-coordinates
 365                                    (list t0 utmoment) latitude longitude t))))
 366                     (if (< hut -0.61) (setq utmin utmoment))
 367                     (if (> hut -0.61) (setq utmax utmoment))
 368                    )
 369                 (setq possible 0)) ; the sun never rises
 370                 (setq possible 0)) ; the sun never sets
 371      (if (equal possible 0) nil utmoment)))
 372
 373 (defun solar-time-string (time time-zone)
 374   "Printable form for decimal fraction TIME in TIME-ZONE.
 375 Format used is given by `calendar-time-display-form'."
 376   (let* ((time (round (* 60 time)))
 377          (24-hours (/ time 60))
 378          (minutes (format "%02d" (% time 60)))
 379          (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
 380          (am-pm (if (>= 24-hours 12) "pm" "am"))
 381          (24-hours (format "%02d" 24-hours)))
 382     (mapconcat 'eval calendar-time-display-form "")))
 383
 384
 385 (defun solar-daylight (time)
 386   "Printable form for time expressed in hours."
 387   (format "%d:%02d"
 388           (floor time)
 389           (floor (* 60 (- time (floor time))))))
 390
 391 (defun solar-exact-local-noon (date)
 392   "Date and Universal Time of local noon at *local date* date.
 393
 394 The date may be different from the one asked for, but it will be the right
 395 local date.  The second component of date should be an integer."
 396   (let* ((nd date)
 397          (ut (- 12.0 (/ (calendar-longitude) 15)))
 398          (te (solar-time-equation date ut)))
 399     (setq ut (- ut te))
 400     (if (>= ut 24)
 401         (progn
 402           (setq nd (list (car date) (+ 1 (car (cdr date)))
 403                          (car (cdr (cdr date)))))
 404           (setq ut (- ut 24))))
 405     (if (< ut 0)
 406         (progn
 407           (setq nd (list (car date) (- (car (cdr date)) 1)
 408                          (car (cdr (cdr date)))))
 409           (setq ut (+ ut 24))))
 410     (setq nd (calendar-gregorian-from-absolute
 411                        (calendar-absolute-from-gregorian nd)))
 412         ; date standardization
 413     (list nd ut)))
 414
 415 (defun solar-sunrise-sunset (date)
 416   "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE.
 417
 418 Corresponding value is nil if there is no sunrise/sunset."
 419   (let* (; first, get the exact moment of local noon.
 420          (exact-local-noon (solar-exact-local-noon date))
 421          ; get the the time from the 2000 epoch.
 422          (t0 (solar-julian-ut-centuries (car exact-local-noon)))
 423          ; store the sidereal time at Greenwich at midnight of UT time.
 424          ; find if summer or winter slightly above the equator
 425          (equator-rise-set
 426           (progn (setq solar-sidereal-time-greenwich-midnight
 427                        (solar-sidereal-time t0))
 428                  (solar-sunrise-and-sunset
 429                   (list t0 (car (cdr exact-local-noon)))
 430                   10.0
 431                   (calendar-longitude))))
 432          ; store the spring/summer information,
 433          ; compute sunrise and sunset (two first components of rise-set).
 434          ; length of day is the third component (it is only the difference
 435          ; between sunset and sunrise when there is a sunset and a sunrise)
 436          (rise-set
 437           (progn
 438             (setq solar-spring-or-summer-season
 439                   (if (> (car (cdr (cdr equator-rise-set))) 12) 1 0))
 440             (solar-sunrise-and-sunset
 441              (list t0 (car (cdr exact-local-noon)))
 442              (calendar-latitude)
 443              (calendar-longitude))))
 444          (rise (car rise-set))
 445          (adj-rise (if rise (dst-adjust-time date rise) nil))
 446          (set (car (cdr rise-set)))
 447          (adj-set (if set (dst-adjust-time date set) nil))
 448          (length  (car (cdr (cdr rise-set)))) )
 449     (list
 450      (and rise (calendar-date-equal date (car adj-rise)) (cdr adj-rise))
 451      (and set (calendar-date-equal date (car adj-set)) (cdr adj-set))
 452      (solar-daylight length))))
 453
 454 (defun solar-sunrise-sunset-string (date)
 455   "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE."
 456   (let ((l (solar-sunrise-sunset date)))
 457     (format
 458      "%s, %s at %s (%s hours daylight)"
 459      (if (car l)
 460          (concat "Sunrise " (apply 'solar-time-string (car l)))
 461        "No sunrise")
 462      (if (car (cdr l))
 463          (concat "sunset " (apply 'solar-time-string (car (cdr l))))
 464        "no sunset")
 465      (eval calendar-location-name)
 466      (car (cdr (cdr l))))))
 467
 468 (defun solar-julian-ut-centuries (date)
 469   "Number of Julian centuries elapsed since 1 Jan, 2000 at noon  U.T. for Gregorian DATE."
 470   (/ (- (calendar-absolute-from-gregorian date)
 471         (calendar-absolute-from-gregorian '(1 1.5 2000)))
 472      36525.0))
 473
 474 (defun solar-ephemeris-time(time)
 475   "Ephemeris Time at moment TIME.
 476
 477 TIME is a pair with the first component being the number of Julian centuries
 478 elapsed at 0 Universal Time, and the second component being the universal
 479 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 480 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 481 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
 482
 483 Result is in julian centuries of ephemeris time."
 484   (let* ((t0 (car time))
 485          (ut (car (cdr time)))
 486          (t1 (+ t0 (/ (/ ut 24.0) 36525)))
 487          (y (+ 2000 (* 100 t1)))
 488          (dt (* 86400 (solar-ephemeris-correction (floor y)))))
 489       (+ t1 (/ (/ dt 86400) 36525))))
 490
 491 (defun solar-date-next-longitude (d l)
 492   "First moment on or after Julian day number D when sun's longitude is a
 493 multiple of L degrees at calendar-location-name with that location's
 494 local time (including any daylight savings rules).
 495
 496 L must be an integer divisor of 360.
 497
 498 Result is in local time expressed astronomical (Julian) day numbers.
 499
 500 The values of calendar-daylight-savings-starts,
 501 calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
 502 calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
 503 calendar-time-zone are used to interpret local time."
 504   (let* ((long)
 505          (start d)
 506          (start-long (solar-longitude d))
 507          (next (mod (* l (1+ (floor (/ start-long l)))) 360))
 508          (end (+ d (* (/ l 360.0) 400)))
 509          (end-long (solar-longitude end)))
 510     (while                 ;; bisection search for nearest minute
 511         (< 0.00001 (- end start))
 512       ;; start   <= d    < end
 513       ;; start-long <= next < end-long when next != 0
 514       ;; when next = 0, we look for the discontinuity (start-long is near 360
 515       ;;                and end-long is small (less than l).
 516       (setq d (/ (+ start end) 2.0))
 517       (setq long (solar-longitude d))
 518       (if (or (and (/= next 0) (< long next))
 519               (and (= next 0) (< l long)))
 520           (progn
 521             (setq start d)
 522             (setq start-long long))
 523         (setq end d)
 524         (setq end-long long)))
 525     (/ (+ start end) 2.0)))
 526
 527 (defun solar-horizontal-coordinates
 528           (time latitude longitude for-sunrise-sunset)
 529   "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
 530
 531 TIME is a pair with the first component being the number of Julian centuries
 532 elapsed at 0 Universal Time, and the second component being the universal
 533 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 534 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 535 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
 536
 537 The azimuth is given in degrees as well as the height (between -180 and 180)."
 538   (let* ((ut (car (cdr time)))
 539          (ec (solar-equatorial-coordinates time for-sunrise-sunset))
 540          (st (+ solar-sidereal-time-greenwich-midnight
 541                 (* ut 1.00273790935)))
 542          (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude))))
 543                        ; hour angle (in degrees)
 544          (de (car (cdr ec)))
 545          (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah)
 546                                    (solar-sin-degrees latitude))
 547                                 (* (solar-tangent-degrees de)
 548                                    (solar-cosine-degrees latitude)))
 549                               (solar-sin-degrees ah)))
 550          (height (solar-arcsin
 551                   (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
 552                      (* (solar-cosine-degrees latitude)
 553                         (solar-cosine-degrees de)
 554                         (solar-cosine-degrees ah))))))
 555     (if (> height 180) (setq height (- height 360)))
 556     (list azimuth height)))
 557
 558 (defun solar-equatorial-coordinates (time for-sunrise-sunset)
 559   "Right ascension (in hours) and declination (in degrees) of the sun at TIME.
 560
 561 TIME is a pair with the first component being the number of Julian centuries
 562 elapsed at 0 Universal Time, and the second component being the universal
 563 time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
 564 \(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
 565 Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."
 566    (let* ((tm (solar-ephemeris-time time))
 567           (ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
 568      (list (solar-right-ascension (car ec) (car (cdr ec)))
 569            (solar-declination (car ec) (car (cdr ec))))))
 570
 571 (defun solar-ecliptic-coordinates (time for-sunrise-sunset)
 572   "Apparent longitude of the sun, ecliptic inclination, (both in degrees)
 573 equation of time (in hours) and nutation in longitude (in seconds)
 574 at moment `time', expressed in julian centuries of Ephemeris Time
 575 since January 1st, 2000, at 12 ET."
 576   (let* ((l (+ 280.46645
 577                (* 36000.76983 time)
 578                (* 0.0003032 time time))) ; sun mean longitude
 579          (ml (+ 218.3165
 580                 (* 481267.8813 time))) ; moon mean longitude
 581          (m (+ 357.52910
 582                (* 35999.05030 time)
 583                (* -0.0001559 time time)
 584                (* -0.00000048 time time time))) ; sun mean anomaly
 585          (i (+ 23.43929111 (* -0.013004167 time)
 586                (* -0.00000016389 time time)
 587                (* 0.0000005036 time time time))); mean inclination
 588          (c (+ (* (+ 1.914600
 589                      (* -0.004817 time)
 590                      (* -0.000014 time time))
 591                   (solar-sin-degrees m))
 592                (* (+ 0.019993 (* -0.000101 time))
 593                   (solar-sin-degrees (* 2 m)))
 594                (* 0.000290
 595                   (solar-sin-degrees (* 3 m))))) ; center equation
 596          (L (+ l c)) ; total longitude
 597          (omega (+ 125.04
 598                    (* -1934.136 time))) ; longitude of moon's ascending node
 599                                         ; on the ecliptic
 600          (nut (if (not for-sunrise-sunset)
 601                  (+ (* -17.20 (solar-sin-degrees omega))
 602                  (* -1.32 (solar-sin-degrees (* 2 l)))
 603                  (* -0.23 (solar-sin-degrees (* 2 ml)))
 604                  (* 0.21 (solar-sin-degrees (* 2 omega))))
 605                nil))
 606                   ; nut = nutation in longitude, measured in seconds of angle.
 607          (ecc (if (not for-sunrise-sunset)
 608                  (+ 0.016708617
 609                  (* -0.000042037 time)
 610                  (* -0.0000001236 time time)) ; eccentricity of earth's orbit
 611                nil))
 612          (app (+ L
 613                  -0.00569
 614                  (* -0.00478
 615                     (solar-sin-degrees omega)))) ; apparent longitude of sun
 616          (y (if (not for-sunrise-sunset)
 617                  (* (solar-tangent-degrees (/ i 2))
 618                   (solar-tangent-degrees (/ i 2)))
 619                 nil))
 620          (time-eq (if (not for-sunrise-sunset)
 621                     (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
 622                      (* -2 ecc (solar-sin-degrees m))
 623                      (* 4 ecc y (solar-sin-degrees m)
 624                                 (solar-cosine-degrees (* 2 l)))
 625                      (* -0.5 y y  (solar-sin-degrees (* 4 l)))
 626                      (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
 627                       3.1415926535)
 628                     nil)))
 629                   ; equation of time, in hours
 630     (list app i time-eq nut)))
 631
 632 (defun solar-longitude (d)
 633   "Longitude of sun on astronomical (Julian) day number D.
 634 Accurary is about 0.0006 degree (about 365.25*24*60*0.0006/360 = 1 minutes).
 635
 636 The values of calendar-daylight-savings-starts,
 637 calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
 638 calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
 639 calendar-time-zone are used to interpret local time."
 640   (let* ((a-d (calendar-absolute-from-astro d))
 641          ;; get Universal Time
 642          (date (calendar-astro-from-absolute
 643                 (- a-d
 644                    (if (dst-in-effect a-d)
 645                        (/ calendar-daylight-time-offset 24.0 60.0) 0)
 646                    (/ calendar-time-zone 60.0 24.0))))
 647          ;; get Ephemeris Time
 648          (date (+ date (solar-ephemeris-correction
 649                         (extract-calendar-year
 650                          (calendar-gregorian-from-absolute
 651                           (floor
 652                            (calendar-absolute-from-astro
 653                             date)))))))
 654          (U (/ (- date 2451545) 3652500))
 655          (longitude
 656           (+ 4.9353929
 657              (* 62833.1961680 U)
 658              (* 0.0000001
 659                 (apply '+
 660                        (mapcar '(lambda (x)
 661                                   (* (car x)
 662                                      (sin (mod
 663                                            (+ (car (cdr x))
 664                                               (* (car (cdr (cdr x))) U))
 665                                            (* 2 pi)))))
 666                                solar-data-list)))))
 667          (aberration
 668           (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973)))
 669          (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 pi)))
 670          (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 pi)))
 671          (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2))))))
 672     (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
 673
 674 (defconst solar-data-list
 675   '((403406 4.721964 1.621043)
 676     (195207 5.937458 62830.348067)
 677     (119433 1.115589 62830.821524)
 678     (112392 5.781616 62829.634302)
 679     (3891 5.5474 125660.5691)
 680     (2819 1.5120 125660.984)
 681     (1721 4.1897 62832.4766)
 682     (0 1.163 0.813)
 683     (660 5.415 125659.31)
 684     (350 4.315 57533.85)
 685     (334 4.553 -33.931)
 686     (314 5.198 777137.715)
 687     (268 5.989 78604.191)
 688     (242 2.911 5.412)
 689     (234 1.423 39302.098)
 690     (158 0.061 -34.861)
 691     (132 2.317 115067.698)
 692     (129 3.193 15774.337)
 693     (114 2.828 5296.670)
 694     (99 0.52 58849.27)
 695     (93 4.65 5296.11)
 696     (86 4.35 -3980.70)
 697     (78 2.75 52237.69)
 698     (72 4.50 55076.47)
 699     (68 3.23 261.08)
 700     (64 1.22 15773.85)
 701     (46 0.14 188491.03)
 702     (38 3.44 -7756.55)
 703     (37 4.37 264.89)
 704     (32 1.14 117906.27)
 705     (29 2.84 55075.75)
 706     (28 5.96 -7961.39)
 707     (27 5.09 188489.81)
 708     (27 1.72 2132.19)
 709     (25 2.56 109771.03)
 710     (24 1.92 54868.56)
 711     (21 0.09 25443.93)
 712     (21 5.98 -55731.43)
 713     (20 4.03 60697.74)
 714     (18 4.47 2132.79)
 715     (17 0.79 109771.63)
 716     (14 4.24 -7752.82)
 717     (13 2.01 188491.91)
 718     (13 2.65 207.81)
 719     (13 4.98 29424.63)
 720     (12 0.93 -7.99)
 721     (10 2.21 46941.14)
 722     (10 3.59 -68.29)
 723     (10 1.50 21463.25)
 724     (10 2.55 157208.40)))
 725
 726 (defun solar-ephemeris-correction (year)
 727   "Ephemeris time minus Universal Time during Gregorian year.
 728 Result is in days.
 729
 730 For the years 1800-1987, the maximum error is 1.9 seconds.
 731 For the other years, the maximum error is about 30 seconds."
 732   (cond ((and (<= 1988 year) (< year 2020))
 733          (/ (+ year -2000 67.0) 60.0 60.0 24.0))
 734         ((and (<= 1900 year) (< year 1988))
 735          (let* ((theta (/ (- (calendar-astro-from-absolute
 736                               (calendar-absolute-from-gregorian
 737                                (list 7 1 year)))
 738                              (calendar-astro-from-absolute
 739                               (calendar-absolute-from-gregorian
 740                                '(1 1 1900))))
 741                           36525.0))
 742                 (theta2 (* theta theta))
 743                 (theta3 (* theta2 theta))
 744                 (theta4 (* theta2 theta2))
 745                 (theta5 (* theta3 theta2)))
 746            (+ -0.00002
 747               (* 0.000297 theta)
 748               (* 0.025184 theta2)
 749               (* -0.181133 theta3)
 750               (* 0.553040 theta4)
 751               (* -0.861938 theta5)
 752               (* 0.677066 theta3 theta3)
 753               (* -0.212591 theta4 theta3))))
 754         ((and (<= 1800 year) (< year 1900))
 755          (let* ((theta (/ (- (calendar-astro-from-absolute
 756                               (calendar-absolute-from-gregorian
 757                                (list 7 1 year)))
 758                              (calendar-astro-from-absolute
 759                               (calendar-absolute-from-gregorian
 760                                '(1 1 1900))))
 761                           36525.0))
 762                 (theta2 (* theta theta))
 763                 (theta3 (* theta2 theta))
 764                 (theta4 (* theta2 theta2))
 765                 (theta5 (* theta3 theta2)))
 766            (+ -0.000009
 767               (* 0.003844 theta)
 768               (* 0.083563 theta2)
 769               (* 0.865736 theta3)
 770               (* 4.867575 theta4)
 771               (* 15.845535 theta5)
 772               (* 31.332267 theta3 theta3)
 773               (* 38.291999 theta4 theta3)
 774               (* 28.316289 theta4 theta4)
 775               (* 11.636204 theta4 theta5)
 776               (* 2.043794 theta5 theta5))))
 777         ((and (<= 1620 year) (< year 1800))
 778          (let ((x (/ (- year 1600) 10.0)))
 779            (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0)))
 780         (t (let* ((tmp (- (calendar-astro-from-absolute
 781                            (calendar-absolute-from-gregorian
 782                             (list 1 1 year)))
 783                           2382148))
 784                   (second (- (/ (* tmp tmp) 41048480.0) 15)))
 785              (/ second 60.0 60.0 24.0)))))
 786
 787 (defun solar-sidereal-time (t0)
 788   "Sidereal time (in hours) in Greenwich.
 789
 790 At T0=Julian centuries of universal time.
 791 T0 must correspond to 0 hours UT."
 792    (let* ((mean-sid-time (+ 6.6973746
 793                            (* 2400.051337 t0)
 794                            (* 0.0000258622 t0 t0)
 795                            (* -0.0000000017222 t0 t0 t0)))
 796           (et (solar-ephemeris-time (list t0 0.0)))
 797           (nut-i (solar-ecliptic-coordinates et nil))
 798           (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
 799           (i (car (cdr nut-i)))) ; inclination
 800        (mod (+ (mod (+ mean-sid-time
 801                     (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
 802                24.0)
 803             24.0)))
 804
 805 (defun solar-time-equation (date ut)
 806   "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
 807   (let* ((et (solar-date-to-et date ut))
 808          (ec (solar-ecliptic-coordinates et nil)))
 809      (car (cdr (cdr ec)))))
 810
 811 (defun solar-date-to-et (date ut)
 812   "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
 813 Expressed in julian centuries of Ephemeris Time."
 814     (let ((t0 (solar-julian-ut-centuries date)))
 815       (solar-ephemeris-time (list t0 ut))))
 816
 817 ;;;###autoload
 818 (defun sunrise-sunset (&optional arg)
 819   "Local time of sunrise and sunset for today.  Accurate to a few seconds.
 820 If called with an optional prefix argument, prompt for date.
 821
 822 If called with an optional double prefix argument, prompt for longitude,
 823 latitude, time zone, and date, and always use standard time.
 824
 825 This function is suitable for execution in a .emacs file."
 826  (interactive "p")
 827  (or arg (setq arg 1))
 828  (if (and (< arg 16)
 829           (not (and calendar-latitude calendar-longitude calendar-time-zone)))
 830      (solar-setup))
 831  (let* ((calendar-longitude
 832          (if (< arg 16) calendar-longitude
 833            (solar-get-number
 834             "Enter longitude (decimal fraction; + east, - west): ")))
 835         (calendar-latitude
 836          (if (< arg 16) calendar-latitude
 837            (solar-get-number
 838             "Enter latitude (decimal fraction; + north, - south): ")))
 839         (calendar-time-zone
 840          (if (< arg 16) calendar-time-zone
 841            (solar-get-number
 842             "Enter difference from Coordinated Universal Time (in minutes): ")))
 843         (calendar-location-name
 844          (if (< arg 16) calendar-location-name
 845            (let ((float-output-format "%.1f"))
 846              (format "%s%s, %s%s"
 847                      (if (numberp calendar-latitude)
 848                          (abs calendar-latitude)
 849                        (+ (aref calendar-latitude 0)
 850                           (/ (aref calendar-latitude 1) 60.0)))
 851                      (if (numberp calendar-latitude)
 852                          (if (> calendar-latitude 0) "N" "S")
 853                        (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
 854                      (if (numberp calendar-longitude)
 855                          (abs calendar-longitude)
 856                        (+ (aref calendar-longitude 0)
 857                           (/ (aref calendar-longitude 1) 60.0)))
 858                      (if (numberp calendar-longitude)
 859                          (if (> calendar-longitude 0) "E" "W")
 860                        (if (equal (aref calendar-longitude 2) 'east)
 861                            "E" "W"))))))
 862         (calendar-standard-time-zone-name
 863          (if (< arg 16) calendar-standard-time-zone-name
 864            (cond ((= calendar-time-zone 0) "UTC")
 865                  ((< calendar-time-zone 0)
 866                      (format "UTC%dmin" calendar-time-zone))
 867                  (t  (format "UTC+%dmin" calendar-time-zone)))))
 868         (calendar-daylight-savings-starts
 869          (if (< arg 16) calendar-daylight-savings-starts))
 870         (calendar-daylight-savings-ends
 871          (if (< arg 16) calendar-daylight-savings-ends))
 872         (date (if (< arg 4) (calendar-current-date) (calendar-read-date)))
 873         (date-string (calendar-date-string date t))
 874         (time-string (solar-sunrise-sunset-string date))
 875         (msg (format "%s: %s" date-string time-string))
 876         (one-window (one-window-p t)))
 877    (if (<= (length msg) (frame-width))
 878        (message "%s" msg)
 879      (with-output-to-temp-buffer "*temp*"
 880        (princ (concat date-string "\n" time-string)))
 881      (message "%s"
 882               (substitute-command-keys
 883                (if one-window
 884                    (if pop-up-windows
 885                        "Type \\[delete-other-windows] to remove temp window."
 886                      "Type \\[switch-to-buffer] RET to remove temp window.")
 887                  "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
 888
 889 (defun calendar-sunrise-sunset ()
 890   "Local time of sunrise and sunset for date under cursor.
 891 Accurate to a few seconds."
 892   (interactive)
 893   (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
 894       (solar-setup))
 895   (let ((date (calendar-cursor-to-date t)))
 896     (message "%s: %s"
 897              (calendar-date-string date t t)
 898              (solar-sunrise-sunset-string date))))
 899
 900 (defun diary-sunrise-sunset ()
 901   "Local time of sunrise and sunset as a diary entry.
 902 Accurate to a few seconds."
 903   (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
 904       (solar-setup))
 905   (solar-sunrise-sunset-string date))
 906
 907 (defun diary-sabbath-candles ()
 908   "Local time of candle lighting diary entry--applies if date is a Friday.
 909 No diary entry if there is no sunset on that date."
 910   (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
 911       (solar-setup))
 912   (if (= (% (calendar-absolute-from-gregorian date) 7) 5);;  Friday
 913       (let* ((sunset (car (cdr (solar-sunrise-sunset date))))
 914                   (light (if sunset
 915                         (cons (- (car sunset) (/ 18.0 60.0)) (cdr sunset)))))
 916         (if sunset
 917             (format "%s Sabbath candle lighting"
 918                     (apply 'solar-time-string light))))))
 919
 920 (defun solar-equinoxes/solstices (k year)
 921   "Date of equinox/solstice K for YEAR.
 922 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
 923 K=3, winter solstice.
 924 RESULT is a gregorian local date.
 925
 926 Accurate to less than a minute between 1951 and 2050."
 927   (let* ((JDE0 (solar-mean-equinoxes/solstices k year))
 928          (T (/ (- JDE0 2451545.0) 36525))
 929          (W (- (* 35999.373 T) 2.47))
 930          (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
 931                             (* 0.0007 (solar-cosine-degrees (* 2 W)))))
 932          (S (apply '+ (mapcar '(lambda(x)
 933                                  (* (car x) (solar-cosine-degrees
 934                                              (+ (* (car (cdr (cdr x))) T)
 935                                                   (car (cdr x))))))
 936                               solar-seasons-data)))
 937          (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
 938          (correction (+ 102.3 (* 123.5 T) (* 32.5 T T)))
 939              ; ephemeris time correction
 940          (JD (- JDE (/ correction 86400)))
 941          (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
 942          (time (- (- JD 0.5) (floor (- JD 0.5))))
 943          )
 944       (list (car date) (+ (car (cdr date)) time
 945                           (/ (/ calendar-time-zone 60.0) 24.0))
 946             (car (cdr (cdr date))))))
 947
 948 ; from Meeus, 1991, page 166
 949 (defun solar-mean-equinoxes/solstices (k year)
 950   "Julian day of mean equinox/solstice K for YEAR.
 951 K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
 952 solstice.  These formulas are only to be used between 1000 BC and 3000 AD."
 953   (let ((y (/ year 1000.0))
 954         (z (/ (- year 2000) 1000.0)))
 955     (if (< year 1000) ; actually between -1000 and 1000
 956              (cond ((equal k 0) (+ 1721139.29189
 957                                    (*  365242.13740 y)
 958                                    (* 0.06134 y y)
 959                                    (* 0.00111 y y y)
 960                                    (* -0.00071 y y y y)))
 961                    ((equal k 1) (+ 1721233.25401
 962                                    (* 365241.72562 y)
 963                                    (* -0.05323 y y)
 964                                    (* 0.00907 y y y)
 965                                    (* 0.00025 y y y y)))
 966                    ((equal k 2) (+ 1721325.70455
 967                                    (* 365242.49558 y)
 968                                    (* -0.11677 y y)
 969                                    (* -0.00297 y y y)
 970                                    (* 0.00074 y y y y)))
 971                    ((equal k 3) (+ 1721414.39987
 972                                    (* 365242.88257 y)
 973                                    (* -0.00769 y y)
 974                                    (* -0.00933 y y y)
 975                                    (* -0.00006 y y y y))))
 976                       ; actually between 1000 and 3000
 977              (cond ((equal k 0) (+ 2451623.80984
 978                                    (* 365242.37404  z)
 979                                    (* 0.05169 z z)
 980                                    (* -0.00411 z z z)
 981                                    (* -0.00057 z z z z)))
 982                    ((equal k 1) (+ 2451716.56767
 983                                    (* 365241.62603 z)
 984                                    (* 0.00325 z z)
 985                                    (* 0.00888 z z z)
 986                                    (* -0.00030 z z z z)))
 987                    ((equal k 2) (+ 2451810.21715
 988                                    (* 365242.01767 z)
 989                                    (* -0.11575 z z)
 990                                    (* 0.00337 z z z)
 991                                    (* 0.00078 z z z z)))
 992                    ((equal k 3) (+ 2451900.05952
 993                                    (* 365242.74049 z)
 994                                    (* -0.06223 z z)
 995                                    (* -0.00823 z z z)
 996                                    (* 0.00032 z z z z)))))))
 997
 998 ; from Meeus, 1991, page 167
 999 (defconst solar-seasons-data
1000   '((485 324.96 1934.136)
1001     (203 337.23 32964.467)
1002     (199 342.08 20.186)
1003     (182 27.85 445267.112)
1004     (156 73.14 45036.886)
1005     (136 171.52 22518.443)
1006     (77 222.54 65928.934)
1007     (74 296.72 3034.906)
1008     (70 243.58 9037.513)
1009     (58 119.81 33718.147)
1010     (52 297.17 150.678)
1011     (50 21.02 2281.226)
1012     (45 247.54 29929.562)
1013     (44 325.15 31555.956)
1014     (29 60.93 4443.417)
1015     (18 155.12 67555.328)
1016     (17 288.79 4562.452)
1017     (16 198.04 62894.029)
1018     (14 199.76 31436.921)
1019     (12 95.39 14577.848)
1020     (12 287.11 31931.756)
1021     (12 320.81 34777.259)
1022     (9 227.73 1222.114)
1023     (8 15.45 16859.074)))
1024
1025 ;;;###autoload
1026 (defun solar-equinoxes-solstices ()
1027   "*local* date and time of equinoxes and solstices, if visible in the calendar window.
1028 Requires floating point."
1029   (let ((m displayed-month)
1030         (y displayed-year))
1031     (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
1032                                         ((= 2 (% m 3))  1)
1033                                         (t              0)))
1034     (let* ((calendar-standard-time-zone-name
1035             (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
1036            (calendar-daylight-savings-starts
1037             (if calendar-time-zone calendar-daylight-savings-starts))
1038            (calendar-daylight-savings-ends
1039             (if calendar-time-zone calendar-daylight-savings-ends))
1040            (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
1041            (k (1- (/ m 3)))
1042            (d0 (solar-equinoxes/solstices k y))
1043            (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
1044            (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
1045            (adj (dst-adjust-time d1 h0))
1046            (d (list (car d1) (+ (car (cdr d1))
1047                   (/ (car (cdr adj)) 24.0))
1048                     (car (cdr (cdr d1)))))
1049            ; The following is nearly as accurate, but not quite:
1050            ;(d0 (solar-date-next-longitude
1051            ;    (calendar-astro-from-absolute
1052            ;     (calendar-absolute-from-gregorian
1053            ;      (list (+ 3 (* k 3)) 15 y)))
1054            ;    90))
1055            ;(abs-day (calendar-absolute-from-astro d)))
1056            (abs-day (calendar-absolute-from-gregorian d)))
1057       (list
1058        (list (calendar-gregorian-from-absolute (floor abs-day))
1059              (format "%s %s"
1060                      (nth k (if (and calendar-latitude
1061                                      (< (calendar-latitude) 0))
1062                                 solar-s-hemi-seasons
1063                               solar-n-hemi-seasons))
1064                      (solar-time-string
1065                       (* 24 (- abs-day (floor abs-day)))
1066                       (if (dst-in-effect abs-day)
1067                           calendar-daylight-time-zone-name
1068                         calendar-standard-time-zone-name))))))))
1069
1070
1071 (provide 'solar)
1072
1073 ;;; solar.el ends here