-(defun calendar-absolute-from-iso (date)
- "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The `ISO year' corresponds approximately to the Gregorian year, but
-weeks start on Monday and end on Sunday. The first week of the ISO year is
-the first such week in which at least 4 days are in a year. The ISO
-commercial DATE has the form (week day year) in which week is in the range
-1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
-Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary."
- (let* ((week (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date)))
- (+ (calendar-dayname-on-or-before
- 1 (+ 3 (calendar-absolute-from-gregorian (list 1 1 year))))
- (* 7 (1- week))
- (if (= day 0) 6 (1- day)))))
-
-(defun calendar-iso-from-absolute (date)
- "Compute the `ISO commercial date' corresponding to the absolute DATE.
-The ISO year corresponds approximately to the Gregorian year, but weeks
-start on Monday and end on Sunday. The first week of the ISO year is the
-first such week in which at least 4 days are in a year. The ISO commercial
-date has the form (week day year) in which week is in the range 1..52 and
-day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The
-absolute date is the number of days elapsed since the (imaginary) Gregorian
-date Sunday, December 31, 1 BC."
- (let* ((approx (extract-calendar-year
- (calendar-gregorian-from-absolute (- date 3))))
- (year (+ approx
- (calendar-sum y approx
- (>= date (calendar-absolute-from-iso (list 1 1 (1+ y))))
- 1))))
- (list
- (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7))
- (% date 7)
- year)))
-
-(defun calendar-iso-date-string (&optional date)
- "String of ISO date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
- (let* ((d (calendar-absolute-from-gregorian
- (or date (calendar-current-date))))
- (day (% d 7))
- (iso-date (calendar-iso-from-absolute d)))
- (format "Day %s of week %d of %d"
- (if (zerop day) 7 day)
- (extract-calendar-month iso-date)
- (extract-calendar-year iso-date))))
-
-(defun calendar-print-iso-date ()
- "Show equivalent ISO date for the date under the cursor."
- (interactive)
- (message "ISO date: %s"
- (calendar-iso-date-string (calendar-cursor-to-date t))))
-
-(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-absolute-from-julian (list 1 1 (1+ y))))
- 1)))
- (month ;; Search forward from January.
- (1+ (calendar-sum m 1
- (> date
- (calendar-absolute-from-julian
- (list m
- (if (and (= m 2) (= (% year 4) 0))
- 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-absolute-from-julian (list month 1 year))))))
- (list month day year)))
-
-(defun calendar-absolute-from-julian (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 (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date)))
- (+ (calendar-day-number date)
- (if (and (= (% year 100) 0)
- (/= (% year 400) 0)
- (> month 2))
- 1 0);; Correct for Julian but not Gregorian leap year.
- (* 365 (1- year))
- (/ (1- year) 4)
- -2)))
-
-(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))
-
-(defun calendar-print-julian-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))))
-
-(defun islamic-calendar-leap-year-p (year)
- "Returns t if YEAR is a leap year on the Islamic calendar."
- (memq (% year 30)
- (list 2 5 7 10 13 16 18 21 24 26 29)))
-
-(defun islamic-calendar-last-day-of-month (month year)
- "The last day in MONTH during YEAR on the Islamic calendar."
- (cond
- ((memq month (list 1 3 5 7 9 11)) 30)
- ((memq month (list 2 4 6 8 10)) 29)
- (t (if (islamic-calendar-leap-year-p year) 30 29))))
-
-(defun islamic-calendar-day-number (date)
- "Return the day number within the year of the Islamic date DATE."
- (let* ((month (extract-calendar-month date))
- (day (extract-calendar-day date)))
- (+ (* 30 (/ month 2))
- (* 29 (/ (1- month) 2))
- day)))
-
-(defun calendar-absolute-from-islamic (date)
- "Absolute date of Islamic DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
- (let* ((month (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date))
- (y (% year 30))
- (leap-years-in-cycle
- (cond
- ((< y 3) 0) ((< y 6) 1) ((< y 8) 2) ((< y 11) 3) ((< y 14) 4)
- ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9)
- (t 10))))
- (+ (islamic-calendar-day-number date);; days so far this year
- (* (1- year) 354) ;; days in all non-leap years
- (* 11 (/ year 30)) ;; leap days in complete cycles
- leap-years-in-cycle ;; leap days this cycle
- 227014))) ;; days before start of calendar
-
-(defun calendar-islamic-from-absolute (date)
- "Compute the Islamic date (month day year) corresponding to absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
- (if (< date 227015)
- (list 0 0 0);; pre-Islamic date
- (let* ((approx (/ (- date 227014) 355));; Approximation from below.
- (year ;; Search forward from the approximation.
- (+ approx
- (calendar-sum y approx
- (>= date (calendar-absolute-from-islamic
- (list 1 1 (1+ y))))
- 1)))
- (month ;; Search forward from Muharram.
- (1+ (calendar-sum m 1
- (> date
- (calendar-absolute-from-islamic
- (list m
- (islamic-calendar-last-day-of-month
- m year)
- year)))
- 1)))
- (day ;; Calculate the day by subtraction.
- (- date
- (1- (calendar-absolute-from-islamic (list month 1 year))))))
- (list month day year))))
-
-(defvar calendar-islamic-month-name-array
- ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
- "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"])
-
-(defun calendar-islamic-date-string (&optional date)
- "String of Islamic date before sunset of Gregorian DATE.
-Returns the empty string if DATE is pre-Islamic.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
- (let ((calendar-month-name-array calendar-islamic-month-name-array)
- (islamic-date (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (or date (calendar-current-date))))))
- (if (< (extract-calendar-year islamic-date) 1)
- ""
- (calendar-date-string islamic-date nil t))))
-
-(defun calendar-print-islamic-date ()
- "Show the Islamic calendar equivalent of the date under the cursor."
- (interactive)
- (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
- (if (string-equal i "")
- (message "Date is pre-Islamic")
- (message "Islamic date (until sunset): %s" i))))
-
-(defun calendar-hebrew-from-absolute (date)
- "Compute the Hebrew date (month day year) corresponding to absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
- (let* ((greg-date (calendar-gregorian-from-absolute date))
- (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
- (1- (extract-calendar-month greg-date))))
- (day)
- (year (+ 3760 (extract-calendar-year greg-date))))
- (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
- (setq year (1+ year)))
- (let ((length (hebrew-calendar-last-month-of-year year)))
- (while (> date
- (calendar-absolute-from-hebrew
- (list month
- (hebrew-calendar-last-day-of-month month year)
- year)))
- (setq month (1+ (% month length)))))
- (setq day (1+
- (- date (calendar-absolute-from-hebrew (list month 1 year)))))
- (list month day year)))
-
-(defun hebrew-calendar-leap-year-p (year)
- "t if YEAR is a Hebrew calendar leap year."
- (< (% (1+ (* 7 year)) 19) 7))
-
-(defun hebrew-calendar-last-month-of-year (year)
- "The last month of the Hebrew calendar YEAR."
- (if (hebrew-calendar-leap-year-p year)
- 13
- 12))
-
-(defun hebrew-calendar-last-day-of-month (month year)
- "The last day of MONTH in YEAR."
- (if (or (memq month (list 2 4 6 10 13))
- (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
- (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
- (and (= month 9) (hebrew-calendar-short-kislev-p year)))
- 29
- 30))
-
-(defun hebrew-calendar-elapsed-days (year)
- "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
- (let* ((months-elapsed
- (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
- (* 12 (% (1- year) 19)) ;; Regular months in this cycle
- (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
- (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
- (hours-elapsed (+ 5
- (* 12 months-elapsed)
- (* 793 (/ months-elapsed 1080))
- (/ parts-elapsed 1080)))
- (parts ;; Conjunction parts
- (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
- (day ;; Conjunction day
- (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
- (alternative-day
- (if (or (>= parts 19440) ;; If the new moon is at or after midday,
- (and (= (% day 7) 2);; ...or is on a Tuesday...
- (>= parts 9924) ;; at 9 hours, 204 parts or later...
- (not (hebrew-calendar-leap-year-p year)));; of a
- ;; common year,
- (and (= (% day 7) 1);; ...or is on a Monday...
- (>= parts 16789) ;; at 15 hours, 589 parts or later...
- (hebrew-calendar-leap-year-p (1- year))));; at the end
- ;; of a leap year
- ;; Then postpone Rosh HaShanah one day
- (1+ day)
- ;; Else
- day)))
- (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
- (memq (% alternative-day 7) (list 0 3 5))
- ;; Then postpone it one (more) day and return
- (1+ alternative-day)
- ;; Else return
- alternative-day)))
-
-(defun hebrew-calendar-days-in-year (year)
- "Number of days in Hebrew YEAR."
- (- (hebrew-calendar-elapsed-days (1+ year))
- (hebrew-calendar-elapsed-days year)))
-
-(defun hebrew-calendar-long-heshvan-p (year)
- "t if Heshvan is long in Hebrew YEAR."
- (= (% (hebrew-calendar-days-in-year year) 10) 5))
-
-(defun hebrew-calendar-short-kislev-p (year)
- "t if Kislev is short in Hebrew YEAR."
- (= (% (hebrew-calendar-days-in-year year) 10) 3))
-
-(defun calendar-absolute-from-hebrew (date)
- "Absolute date of Hebrew DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
- (let* ((month (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date)))
- (+ day ;; Days so far this month.
- (if (< month 7);; before Tishri
- ;; Then add days in prior months this year before and after Nisan
- (+ (calendar-sum
- m 7 (<= m (hebrew-calendar-last-month-of-year year))
- (hebrew-calendar-last-day-of-month m year))
- (calendar-sum
- m 1 (< m month)
- (hebrew-calendar-last-day-of-month m year)))
- ;; Else add days in prior months this year
- (calendar-sum
- m 7 (< m month)
- (hebrew-calendar-last-day-of-month m year)))
- (hebrew-calendar-elapsed-days year);; Days in prior years.
- -1373429))) ;; Days elapsed before absolute date 1.
-
-(defvar calendar-hebrew-month-name-array-common-year
- ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
- "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
-
-(defvar calendar-hebrew-month-name-array-leap-year
- ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
- "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
-
-(defun calendar-hebrew-date-string (&optional date)
- "String of Hebrew date before sunset of Gregorian DATE.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
- (let* ((hebrew-date (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (or date (calendar-current-date)))))
- (calendar-month-name-array
- (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
- calendar-hebrew-month-name-array-leap-year
- calendar-hebrew-month-name-array-common-year)))
- (calendar-date-string hebrew-date nil t)))
-
-(defun calendar-print-hebrew-date ()
- "Show the Hebrew calendar equivalent of the date under the cursor."
- (interactive)
- (message "Hebrew date (until sunset): %s"
- (calendar-hebrew-date-string (calendar-cursor-to-date t))))
-
-(defun hebrew-calendar-yahrzeit (death-date year)
- "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
- (let* ((death-day (extract-calendar-day death-date))
- (death-month (extract-calendar-month death-date))
- (death-year (extract-calendar-year death-date)))
- (cond
- ;; If it's Heshvan 30 it depends on the first anniversary; if
- ;; that was not Heshvan 30, use the day before Kislev 1.
- ((and (= death-month 8)
- (= death-day 30)
- (not (hebrew-calendar-long-heshvan-p (1+ death-year))))
- (1- (calendar-absolute-from-hebrew (list 9 1 year))))
- ;; If it's Kislev 30 it depends on the first anniversary; if
- ;; that was not Kislev 30, use the day before Teveth 1.
- ((and (= death-month 9)
- (= death-day 30)
- (hebrew-calendar-short-kislev-p (1+ death-year)))
- (1- (calendar-absolute-from-hebrew (list 10 1 year))))
- ;; If it's Adar II, use the same day in last month of
- ;; year (Adar or Adar II).
- ((= death-month 13)
- (calendar-absolute-from-hebrew
- (list (hebrew-calendar-last-month-of-year year) death-day year)))
- ;; If it's the 30th in Adar I and year is not a leap year
- ;; (so Adar has only 29 days), use the last day in Shevat.
- ((and (= death-day 30)
- (= death-month 12)
- (not (hebrew-calendar-leap-year-p year)))
- (calendar-absolute-from-hebrew (list 11 30 year)))
- ;; In all other cases, use the normal anniversary of the date of death.
- (t (calendar-absolute-from-hebrew
- (list death-month death-day year))))))
-