lisp/calendar/solar.el

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