mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-03 02:31:03 -08:00
3f65970414
* lisp/calendar/cal-bahai.el (calendar-absolute-from-bahai) (calendar-print-bahai-date, calendar-bahai-prompt-for-date) (calendar-goto-bahai-date, list-bahai-diary-entries) (mark-bahai-calendar-date-pattern, mark-bahai-diary-entries) (insert-bahai-diary-entry, insert-monthly-bahai-diary-entry) (insert-yearly-bahai-diary-entry): * lisp/calendar/cal-china.el (chinese-calendar-time-zone) (chinese-calendar-location-name) (chinese-calendar-daylight-time-offset) (chinese-calendar-standard-time-zone-name) (chinese-calendar-daylight-time-zone-name) (chinese-calendar-daylight-savings-starts) (chinese-calendar-daylight-savings-ends) (chinese-calendar-daylight-savings-starts-time) (chinese-calendar-daylight-savings-ends-time) (chinese-calendar-celestial-stem) (chinese-calendar-terrestrial-branch) (calendar-absolute-from-chinese, calendar-print-chinese-date) (calendar-goto-chinese-date): * lisp/calendar/cal-coptic.el (calendar-absolute-from-coptic) (calendar-print-coptic-date, coptic-prompt-for-date) (calendar-goto-coptic-date, calendar-absolute-from-ethiopic) (calendar-print-ethiopic-date, calendar-goto-ethiopic-date): * lisp/calendar/cal-french.el (calendar-absolute-from-french) (calendar-print-french-date, calendar-goto-french-date): * lisp/calendar/cal-hebrew.el (diary-sabbath-candles-minutes) (calendar-absolute-from-hebrew, calendar-print-hebrew-date) (hebrew-calendar-yahrzeit, calendar-goto-hebrew-date) (holiday-rosh-hashanah-etc, holiday-hanukkah) (holiday-passover-etc, holiday-tisha-b-av-etc) (list-hebrew-diary-entries, mark-hebrew-calendar-date-pattern) (mark-hebrew-diary-entries, insert-hebrew-diary-entry) (insert-monthly-hebrew-diary-entry) (insert-yearly-hebrew-diary-entry, list-yahrzeit-dates) (diary-omer, diary-yahrzeit, diary-rosh-hodesh, diary-parasha) (diary-sabbath-candles): * lisp/calendar/cal-islam.el (calendar-absolute-from-islamic) (calendar-print-islamic-date, calendar-goto-islamic-date) (list-islamic-diary-entries, mark-islamic-calendar-date-pattern) (mark-islamic-diary-entries, insert-islamic-diary-entry) (insert-monthly-islamic-diary-entry) (insert-yearly-islamic-diary-entry): * lisp/calendar/cal-iso.el (calendar-absolute-from-iso) (calendar-print-iso-date, calendar-iso-read-args) (calendar-goto-iso-date, calendar-goto-iso-week): * lisp/calendar/cal-julian.el (calendar-absolute-from-julian) (calendar-print-julian-date, calendar-goto-julian-date) (calendar-absolute-from-astro, calendar-print-astro-day-number) (calendar-goto-astro-day-number): * lisp/calendar/cal-mayan.el (calendar-print-mayan-date) (calendar-next-haab-date, calendar-previous-haab-date) (calendar-next-tzolkin-date, calendar-previous-tzolkin-date) (calendar-next-calendar-round-date) (calendar-previous-calendar-round-date) (calendar-absolute-from-mayan-long-count) (calendar-goto-mayan-long-count-date): * lisp/calendar/cal-move.el (scroll-calendar-left) (scroll-calendar-right, scroll-calendar-left-three-months) (scroll-calendar-right-three-months): * lisp/calendar/cal-persia.el (calendar-absolute-from-persian) (calendar-print-persian-date, persian-prompt-for-date) (calendar-goto-persian-date): * lisp/calendar/cal-x.el (calendar-after-frame-setup-hooks): * lisp/calendar/calendar.el (view-diary-entries-initially) (mark-diary-entries-in-calendar, calendar-today-face) (diary-face, holiday-face, view-calendar-holidays-initially) (mark-holidays-in-calendar, initial-calendar-window-hook) (today-visible-calendar-hook, today-invisible-calendar-hook) (hebrew-diary-entry-symbol, islamic-diary-entry-symbol) (bahai-diary-entry-symbol, american-date-diary-pattern) (european-date-diary-pattern, european-calendar-display-form) (american-calendar-display-form, holidays-in-diary-buffer) (all-hebrew-calendar-holidays, all-christian-calendar-holidays) (all-islamic-calendar-holidays, all-bahai-calendar-holidays) (fancy-diary-buffer, increment-calendar-month) (extract-calendar-month, extract-calendar-day) (extract-calendar-year, exit-calendar, calendar-date-is-legal-p) (mark-visible-calendar-date, calendar-version): * lisp/calendar/diary-lib.el (diary-button-face, sexp-diary-entry-symbol) (diary-display-hook, list-diary-entries-hook) (mark-diary-entries-hook, nongregorian-diary-listing-hook) (nongregorian-diary-marking-hook, print-diary-entries-hook) (abbreviated-calendar-year, number-of-diary-entries) (view-other-diary-entries, add-to-diary-list) (include-other-diary-files, simple-diary-display) (fancy-diary-display, print-diary-entries, mark-diary-entries) (mark-sexp-diary-entries, mark-included-diary-files) (mark-calendar-days-named, mark-calendar-month) (mark-calendar-date-pattern, sort-diary-entries) (list-sexp-diary-entries, make-diary-entry, insert-diary-entry) (insert-weekly-diary-entry, insert-monthly-diary-entry) (insert-yearly-diary-entry, insert-anniversary-diary-entry) (insert-block-diary-entry, insert-cyclic-diary-entry) (fancy-diary-font-lock-keywords, fancy-diary-display-mode): * lisp/calendar/holidays.el (general-holidays, oriental-holidays) (local-holidays, other-holidays, hebrew-holidays) (christian-holidays, islamic-holidays, bahai-holidays) (solar-holidays, list-calendar-holidays) (check-calendar-holidays, mark-calendar-holidays) (filter-visible-calendar-holidays): * lisp/calendar/lunar.el (calendar-phases-of-moon, phases-of-moon) (diary-phases-of-moon): Remove obsolete aliases. * lisp/calendar/cal-menu.el (cal-menu-load-hook): Remove obsolete hook. * calendar/cal-x.el (calendar-one-frame-setup) (calendar-only-one-frame-setup, calendar-two-frame-setup): Remove obsolete functions. (cal-x-load-hook): Remove obsolete hook. * calendar/calendar.el (european-calendar-style): Remove obsolete variable. (calendar-date-style): No longer consult european-calendar-style. * calendar/calendar.el (european-calendar, american-calendar): Remove obsolete commands. * calendar/calendar.el (calendar-for-loop): Remove obsolete macro. * calendar/diary-lib.el (diary-face): Remove obsolete variable. (diary-font-lock-date-forms, diary-fancy-font-lock-keywords): Use the face `diary' instead of the variable `diary-face'. * calendar/holidays.el (hebrew-holidays-1, hebrew-holidays-2) (hebrew-holidays-3, hebrew-holidays-4): Remove obsolete variables. * lisp/calendar/icalendar.el (icalendar--date-style): Remove function. Replace all uses with calendar-date-style. * lisp/textmodes/remember.el (calendar-date-style): Declare. (remember-diary-convert-entry): No longer consult european-calendar-style. * test/automated/icalendar-tests.el (icalendar--calendar-style): Remove test, no longer relevant.
203 lines
7.8 KiB
EmacsLisp
203 lines
7.8 KiB
EmacsLisp
;;; cal-julian.el --- calendar functions for the Julian calendar
|
|
|
|
;; Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc.
|
|
|
|
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
|
;; Maintainer: Glenn Morris <rgm@gnu.org>
|
|
;; Keywords: calendar
|
|
;; Human-Keywords: Julian calendar, Julian day number, calendar, diary
|
|
;; Package: calendar
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; 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 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
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; See calendar.el.
|
|
|
|
;;; Code:
|
|
|
|
(require 'calendar)
|
|
|
|
(defun calendar-julian-to-absolute (date)
|
|
"The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
|
|
The Gregorian date Sunday, December 31, 1 BC is imaginary."
|
|
(let ((month (calendar-extract-month date))
|
|
(year (calendar-extract-year date)))
|
|
(+ (calendar-day-number date)
|
|
(if (and (zerop (% year 100))
|
|
(not (zerop (% year 400)))
|
|
(> month 2))
|
|
1 0) ; correct for Julian but not Gregorian leap year
|
|
(* 365 (1- year))
|
|
(/ (1- year) 4)
|
|
-2)))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-julian-from-absolute (date)
|
|
"Compute the Julian (month day year) corresponding to the absolute DATE.
|
|
The absolute date is the number of days elapsed since the (imaginary)
|
|
Gregorian date Sunday, December 31, 1 BC."
|
|
(let* ((approx (/ (+ date 2) 366)) ; approximation from below
|
|
(year ; search forward from the approximation
|
|
(+ approx
|
|
(calendar-sum y approx
|
|
(>= date (calendar-julian-to-absolute
|
|
(list 1 1 (1+ y))))
|
|
1)))
|
|
(month ; search forward from January
|
|
(1+ (calendar-sum m 1
|
|
(> date
|
|
(calendar-julian-to-absolute
|
|
(list m
|
|
(if (and (= m 2) (zerop (% year 4)))
|
|
29
|
|
(aref [31 28 31 30 31 30 31
|
|
31 30 31 30 31]
|
|
(1- m)))
|
|
year)))
|
|
1)))
|
|
(day ; calculate the day by subtraction
|
|
(- date (1- (calendar-julian-to-absolute (list month 1 year))))))
|
|
(list month day year)))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-julian-date-string (&optional date)
|
|
"String of Julian date of Gregorian DATE.
|
|
Defaults to today's date if DATE is not given.
|
|
Driven by the variable `calendar-date-display-form'."
|
|
(calendar-date-string
|
|
(calendar-julian-from-absolute
|
|
(calendar-absolute-from-gregorian (or date (calendar-current-date))))
|
|
nil t))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-julian-print-date ()
|
|
"Show the Julian calendar equivalent of the date under the cursor."
|
|
(interactive)
|
|
(message "Julian date: %s"
|
|
(calendar-julian-date-string (calendar-cursor-to-date t))))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-julian-goto-date (date &optional noecho)
|
|
"Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil."
|
|
(interactive
|
|
(let* ((today (calendar-current-date))
|
|
(year (calendar-read
|
|
"Julian calendar year (>0): "
|
|
(lambda (x) (> x 0))
|
|
(number-to-string
|
|
(calendar-extract-year
|
|
(calendar-julian-from-absolute
|
|
(calendar-absolute-from-gregorian
|
|
today))))))
|
|
(month-array calendar-month-name-array)
|
|
(completion-ignore-case t)
|
|
(month (cdr (assoc-string
|
|
(completing-read
|
|
"Julian calendar month name: "
|
|
(mapcar 'list (append month-array nil))
|
|
nil t)
|
|
(calendar-make-alist month-array 1) t)))
|
|
(last
|
|
(if (and (zerop (% year 4)) (= month 2))
|
|
29
|
|
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
|
|
(day (calendar-read
|
|
(format "Julian calendar day (%d-%d): "
|
|
(if (and (= year 1) (= month 1)) 3 1) last)
|
|
(lambda (x)
|
|
(and (< (if (and (= year 1) (= month 1)) 2 0) x)
|
|
(<= x last))))))
|
|
(list (list month day year))))
|
|
(calendar-goto-date (calendar-gregorian-from-absolute
|
|
(calendar-julian-to-absolute date)))
|
|
(or noecho (calendar-julian-print-date)))
|
|
|
|
;;;###holiday-autoload
|
|
(defun holiday-julian (month day string)
|
|
"Holiday on MONTH, DAY (Julian) called STRING.
|
|
If MONTH, DAY (Julian) is visible, the value returned is corresponding
|
|
Gregorian date in the form of the list (((month day year) STRING)). Returns
|
|
nil if it is not visible in the current calendar window."
|
|
(let ((gdate (calendar-nongregorian-visible-p
|
|
month day 'calendar-julian-to-absolute
|
|
'calendar-julian-from-absolute
|
|
;; In the Gregorian case, we'd use the lower year when
|
|
;; month >= 11. In the Julian case, there is an offset
|
|
;; of two weeks (ie 1 Nov Greg = 19 Oct Julian). So we
|
|
;; use month >= 10, since it can't cause any problems.
|
|
(lambda (m) (< m 10)))))
|
|
(if gdate (list (list gdate string)))))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-astro-to-absolute (d)
|
|
"Absolute date of astronomical (Julian) day number D."
|
|
(- d 1721424.5))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-astro-from-absolute (d)
|
|
"Astronomical (Julian) day number of absolute date D."
|
|
(+ d 1721424.5))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-astro-date-string (&optional date)
|
|
"String of astronomical (Julian) day number after noon UTC of Gregorian DATE.
|
|
Defaults to today's date if DATE is not given."
|
|
(number-to-string
|
|
(ceiling
|
|
(calendar-astro-from-absolute
|
|
(calendar-absolute-from-gregorian (or date (calendar-current-date)))))))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-astro-print-day-number ()
|
|
"Show astronomical (Julian) day number after noon UTC on cursor date."
|
|
(interactive)
|
|
(message
|
|
"Astronomical (Julian) day number (at noon UTC): %s.0"
|
|
(calendar-astro-date-string (calendar-cursor-to-date t))))
|
|
|
|
;;;###cal-autoload
|
|
(defun calendar-astro-goto-day-number (daynumber &optional noecho)
|
|
"Move cursor to astronomical (Julian) DAYNUMBER.
|
|
Echo astronomical (Julian) day number unless NOECHO is non-nil."
|
|
(interactive (list (calendar-read
|
|
"Astronomical (Julian) day number (>1721425): "
|
|
(lambda (x) (> x 1721425)))))
|
|
(calendar-goto-date
|
|
(calendar-gregorian-from-absolute
|
|
(floor
|
|
(calendar-astro-to-absolute daynumber))))
|
|
(or noecho (calendar-astro-print-day-number)))
|
|
|
|
|
|
(defvar date)
|
|
|
|
;; To be called from diary-list-sexp-entries, where DATE is bound.
|
|
;;;###diary-autoload
|
|
(defun diary-julian-date ()
|
|
"Julian calendar equivalent of date diary entry."
|
|
(format "Julian date: %s" (calendar-julian-date-string date)))
|
|
|
|
;; To be called from diary-list-sexp-entries, where DATE is bound.
|
|
;;;###diary-autoload
|
|
(defun diary-astro-day-number ()
|
|
"Astronomical (Julian) day number diary entry."
|
|
(format "Astronomical (Julian) day number at noon UTC: %s.0"
|
|
(calendar-astro-date-string date)))
|
|
|
|
(provide 'cal-julian)
|
|
|
|
;;; cal-julian.el ends here
|