summaryrefslogtreecommitdiff
path: root/lisp/calendar/lunar.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calendar/lunar.el')
-rw-r--r--lisp/calendar/lunar.el44
1 files changed, 33 insertions, 11 deletions
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 616d2b0c4ed..1c0f4da0f4b 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,4 +1,4 @@
-;;; lunar.el --- calendar functions for phases of the moon
+;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
;; Foundation, Inc.
@@ -91,6 +91,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(* -0.0016528 time time)
(* -0.00000239 time time time))
360.0))
+ (eclipse (eclipse-check moon-lat phase))
(adjustment
(if (memq phase '(0 2))
(+ (* (- 0.1734 (* 0.000393 time))
@@ -146,7 +147,26 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (dst-adjust-time date time)))
- (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
+ (list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse)))
+
+;; from "Astronomy with your Personal Computer", Subroutine Eclipse
+;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990
+(defun eclipse-check (moon-lat phase)
+ (let* ((moon-lat (* (/ float-pi 180) moon-lat))
+ (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi))
+ float-pi))))
+ (moon-lat (if (> moon-lat 0.37)
+ (- float-pi moon-lat)
+ moon-lat))
+ (phase-name (cond ((= phase 0) "Solar")
+ ((= phase 2) "Lunar")
+ (t ""))))
+ (cond ((< moon-lat 2.42600766e-1)
+ (concat "** " phase-name " Eclipse **"))
+ ((< moon-lat 0.37)
+ (concat "** " phase-name " Eclipse possible **"))
+ (t
+ ""))))
(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853
"Mean number of lunar cycles per 365.25 day year.")
@@ -222,9 +242,10 @@ use instead of point."
(insert
(mapconcat
(lambda (x)
- (format "%s: %s %s" (calendar-date-string (car x))
+ (format "%s: %s %s %s" (calendar-date-string (car x))
(lunar-phase-name (nth 2 x))
- (cadr x)))
+ (cadr x)
+ (car (last x))))
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
@@ -234,6 +255,8 @@ use instead of point."
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file."
(interactive "P")
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(save-excursion
(let* ((date (if arg (calendar-read-date t)
(calendar-current-date)))
@@ -241,18 +264,17 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-lunar-phases))))
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-lunar-phases (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(let* ((index (lunar-index date))
(phase (lunar-phase index)))
(while (calendar-date-compare phase (list date))