]> code.delx.au - gnu-emacs/blobdiff - lisp/calendar/solar.el
Merge from trunk
[gnu-emacs] / lisp / calendar / solar.el
index 5aeb8ca0d048440ae3c61c71b50f82dd07858b67..b7a728461f0884dd38fa1e29e4d399a2fc15c007 100644 (file)
@@ -1,20 +1,21 @@
 ;;; 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>
 ;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays
+;; Package: calendar
 
 ;; 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
@@ -22,9 +23,7 @@
 ;; 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:
 
@@ -149,16 +148,27 @@ delta.  At present, delta = 0.01 degrees, so the value of the variable
   :type 'number
   :group 'calendar)
 
-;;; 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).")
@@ -642,18 +652,20 @@ Corresponding value is nil if there is no sunrise/sunset."
      (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
@@ -741,12 +753,12 @@ The values of `calendar-daylight-savings-starts',
                                     (sin (mod
                                           (+ (cadr x)
                                              (* (nth 2 x) U))
-                                          (* 2 pi)))))
+                                          (* 2 float-pi)))))
                                solar-data-list)))))
          (aberration
           (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973)))
-         (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 pi)))
-         (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 pi)))
+         (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 float-pi)))
+         (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 float-pi)))
          (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2))))))
     (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
 
@@ -855,17 +867,38 @@ This function is suitable for execution in a .emacs file."
 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 diary-list-sexp-entries, where DATE is bound.