;;; solar.el --- calendar functions for solar events
;; Copyright (C) 1992, 1993, 1995, 1997, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Denis B. Roegel <Denis.Roegel@loria.fr>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; This collection of functions implements the features of calendar.el,
-;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and
-;; equinoxes/solstices.
+;; See calendar.el. This file implements features that deal with
+;; times of day, sunrise/sunset, and equinoxes/solstices.
;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
;; Almanac Office, United States Naval Observatory, Washington, 1984, on
;; 2. Equinox/solstice times will be accurate to the minute for years
;; 1951--2050. For other years the times will be within +/- 1 minute.
-;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
-;; and Nachum Dershowitz, Cambridge University Press (2001).
-
;;; Code:
-(if (fboundp 'atan)
- (require 'lisp-float-type)
- (error "Solar calculations impossible since floating point is unavailable"))
-
+(require 'calendar)
(require 'cal-dst)
-(require 'cal-julian)
+;; calendar-astro-to-absolute and v versa are cal-autoloads.
+;;;(require 'cal-julian)
(defcustom calendar-time-display-form
:type 'number
:group 'calendar)
-(defcustom diary-sabbath-candles-minutes 18
- "Number of minutes before sunset for sabbath candle lighting."
- :group 'diary
- :type 'integer
- :version "21.1")
-
-
-;;; End of user options.
-
-
-(defconst solar-n-hemi-seasons
+(defcustom solar-n-hemi-seasons
'("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")
- "List of season changes for the northern hemisphere.")
+ "List of season changes for the northern hemisphere."
+ :type '(list
+ (string :tag "Vernal Equinox")
+ (string :tag "Summer Solstice")
+ (string :tag "Autumnal Equinox")
+ (string :tag "Winter Solstice"))
+ :group 'calendar)
-(defconst solar-s-hemi-seasons
+(defcustom solar-s-hemi-seasons
'("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
- "List of season changes for the southern hemisphere.")
+ "List of season changes for the southern hemisphere."
+ :type '(list
+ (string :tag "Autumnal Equinox")
+ (string :tag "Winter Solstice")
+ (string :tag "Vernal Equinox")
+ (string :tag "Summer Solstice"))
+ :group 'calendar)
+
+;;; End of user options.
(defvar solar-sidereal-time-greenwich-midnight nil
"Sidereal time at Greenwich at midnight (universal time).")
(and set-time (calendar-date-equal date (car adj-set)) (cdr adj-set))
(solar-daylight length))))
-(defun solar-sunrise-sunset-string (date)
- "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE."
+(defun solar-sunrise-sunset-string (date &optional nolocation)
+ "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE.
+Optional NOLOCATION non-nil means do not print the location."
(let ((l (solar-sunrise-sunset date)))
(format
- "%s, %s at %s (%s hours daylight)"
+ "%s, %s%s (%s hours daylight)"
(if (car l)
(concat "Sunrise " (apply 'solar-time-string (car l)))
"No sunrise")
(if (cadr l)
(concat "sunset " (apply 'solar-time-string (cadr l)))
"no sunset")
- (eval calendar-location-name)
+ (if nolocation ""
+ (format " at %s" (eval calendar-location-name)))
(nth 2 l))))
(defconst solar-data-list
`calendar-daylight-savings-starts-time', `calendar-daylight-savings-ends',
`calendar-daylight-savings-ends-time', `calendar-daylight-time-offset', and
`calendar-time-zone' are used to interpret local time."
- (let* ((a-d (calendar-absolute-from-astro d))
+ (let* ((a-d (calendar-astro-to-absolute d))
;; Get Universal Time.
(date (calendar-astro-from-absolute
(- a-d
(/ calendar-time-zone 60.0 24.0))))
;; Get Ephemeris Time.
(date (+ date (solar-ephemeris-correction
- (extract-calendar-year
+ (calendar-extract-year
(calendar-gregorian-from-absolute
(floor
- (calendar-absolute-from-astro
+ (calendar-astro-to-absolute
date)))))))
(U (/ (- date 2451545) 3652500))
(longitude
end-long long)))
(/ (+ start end) 2.0)))
+;; FIXME but there already is solar-sunrise-sunset.
;;;###autoload
(defun sunrise-sunset (&optional arg)
"Local time of sunrise and sunset for today. Accurate to a few seconds.
contents of temp window."))))))
;;;###cal-autoload
-(defun calendar-sunrise-sunset ()
+(defun calendar-sunrise-sunset (&optional event)
"Local time of sunrise and sunset for date under cursor.
Accurate to a few seconds."
- (interactive)
+ (interactive (list last-nonmenu-event))
(or (and calendar-latitude calendar-longitude calendar-time-zone)
(solar-setup))
- (let ((date (calendar-cursor-to-date t)))
+ (let ((date (calendar-cursor-to-date t event)))
(message "%s: %s"
(calendar-date-string date t t)
(solar-sunrise-sunset-string date))))
+;;;###cal-autoload
+(defun calendar-sunrise-sunset-month (&optional event)
+ "Local time of sunrise and sunset for month under cursor or at EVENT."
+ (interactive (list last-nonmenu-event))
+ (or (and calendar-latitude calendar-longitude calendar-time-zone)
+ (solar-setup))
+ (let* ((date (calendar-cursor-to-date t event))
+ (month (car date))
+ (year (nth 2 date))
+ (last (calendar-last-day-of-month month year))
+ (title (format "Sunrise/sunset times for %s %d at %s"
+ (calendar-month-name month) year
+ (eval calendar-location-name))))
+ (calendar-in-read-only-buffer solar-sunrises-buffer
+ (calendar-set-mode-line title)
+ (insert title ":\n\n")
+ (dotimes (i last)
+ (setq date (list month (1+ i) year))
+ (insert (format "%s %2d: " (calendar-month-name month t) (1+ i))
+ (solar-sunrise-sunset-string date t) "\n")))))
+
(defvar date)
-;; To be called from list-sexp-diary-entries, where DATE is bound.
+;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-sunrise-sunset ()
"Local time of sunrise and sunset as a diary entry.
(solar-setup))
(solar-sunrise-sunset-string date))
-;; To be called from list-sexp-diary-entries, where DATE is bound.
-;;;###diary-autoload
-(defun diary-sabbath-candles (&optional mark)
- "Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date.
-
-An optional parameter MARK specifies a face or single-character string to
-use when highlighting the day in the calendar."
- (or (and calendar-latitude calendar-longitude calendar-time-zone)
- (solar-setup))
- (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday
- (let* ((sunset (cadr (solar-sunrise-sunset date)))
- (light (if sunset
- (cons (- (car sunset)
- (/ diary-sabbath-candles-minutes 60.0))
- (cdr sunset)))))
- (if sunset
- (cons mark
- (format "%s Sabbath candle lighting"
- (apply 'solar-time-string light)))))))
-
;; From Meeus, 1991, page 167.
(defconst solar-seasons-data
'((485 324.96 1934.136)
(* -0.00823 z z z)
(* 0.00032 z z z z)))))))
-(defvar displayed-month) ; from generate-calendar
+(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
;;;###holiday-autoload
(defun solar-equinoxes-solstices ()
"Local date and time of equinoxes and solstices, if visible in the calendar.
Requires floating point."
- (let ((m displayed-month)
- (y displayed-year))
- (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
- ((= 2 (% m 3)) 1)
- (t 0)))
- (let* ((calendar-standard-time-zone-name
- (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
- (calendar-daylight-savings-starts
- (if calendar-time-zone calendar-daylight-savings-starts))
- (calendar-daylight-savings-ends
- (if calendar-time-zone calendar-daylight-savings-ends))
- (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
- (k (1- (/ m 3)))
- (d0 (solar-equinoxes/solstices k y))
- (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0)))
- (h0 (* 24 (- (cadr d0) (floor (cadr d0)))))
- (adj (dst-adjust-time d1 h0))
- (d (list (caar adj)
- (+ (car (cdar adj))
- (/ (cadr adj) 24.0))
- (cadr (cdar adj))))
- ;; The following is nearly as accurate, but not quite:
- ;; (d0 (solar-date-next-longitude
- ;; (calendar-astro-from-absolute
- ;; (calendar-absolute-from-gregorian
- ;; (list (+ 3 (* k 3)) 15 y)))
- ;; 90))
- ;; (abs-day (calendar-absolute-from-astro d)))
- (abs-day (calendar-absolute-from-gregorian d)))
- (list
- (list (calendar-gregorian-from-absolute (floor abs-day))
- (format "%s %s"
- (nth k (if (and calendar-latitude
- (< (calendar-latitude) 0))
- solar-s-hemi-seasons
- solar-n-hemi-seasons))
- (solar-time-string
- (* 24 (- abs-day (floor abs-day)))
- (if (dst-in-effect abs-day)
- calendar-daylight-time-zone-name
- calendar-standard-time-zone-name))))))))
+ (let* ((m displayed-month)
+ (y displayed-year)
+ (calendar-standard-time-zone-name
+ (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
+ (calendar-daylight-savings-starts
+ (if calendar-time-zone calendar-daylight-savings-starts))
+ (calendar-daylight-savings-ends
+ (if calendar-time-zone calendar-daylight-savings-ends))
+ (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
+ (k (progn
+ (calendar-increment-month m y (cond ((= 1 (% m 3)) -1)
+ ((= 2 (% m 3)) 1)
+ (t 0)))
+ (1- (/ m 3))))
+ (d0 (solar-equinoxes/solstices k y))
+ (d1 (list (car d0) (floor (cadr d0)) (nth 2 d0)))
+ (h0 (* 24 (- (cadr d0) (floor (cadr d0)))))
+ (adj (dst-adjust-time d1 h0))
+ (d (list (caar adj)
+ (+ (car (cdar adj))
+ (/ (cadr adj) 24.0))
+ (cadr (cdar adj))))
+ ;; The following is nearly as accurate, but not quite:
+ ;; (d0 (solar-date-next-longitude
+ ;; (calendar-astro-from-absolute
+ ;; (calendar-absolute-from-gregorian
+ ;; (list (+ 3 (* k 3)) 15 y)))
+ ;; 90))
+ ;; (abs-day (calendar-astro-to-absolute d)))
+ (abs-day (calendar-absolute-from-gregorian d)))
+ (list
+ (list (calendar-gregorian-from-absolute (floor abs-day))
+ (format "%s %s"
+ (nth k (if (and calendar-latitude
+ (< (calendar-latitude) 0))
+ solar-s-hemi-seasons
+ solar-n-hemi-seasons))
+ (solar-time-string
+ (* 24 (- abs-day (floor abs-day)))
+ (if (dst-in-effect abs-day)
+ calendar-daylight-time-zone-name
+ calendar-standard-time-zone-name)))))))
(provide 'solar)