code.delx.au - gnu-emacs/blob - lisp/calendar/cal-hebrew.el

   1 ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
   2
   3 ;; Copyright (C) 1995, 1997, 2001-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
   6 ;;         Edward M. Reingold <reingold@cs.uiuc.edu>
   7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
   8 ;; Keywords: calendar
   9 ;; Human-Keywords: Hebrew calendar, calendar, diary
  10 ;; Package: calendar
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; See calendar.el.
  30
  31 ;;; Code:
  32
  33 (require 'calendar)
  34
  35 (defcustom diary-hebrew-sabbath-candles-minutes 18
  36   "Number of minutes before sunset for sabbath candle lighting.
  37 Used by `diary-hebrew-sabbath-candles'."
  38   :group 'diary
  39   :type 'integer
  40   :version "21.1")
  41
  42 ;; End of user options.
  43
  44 (defun calendar-hebrew-leap-year-p (year)
  45   "Non-nil if YEAR is a Hebrew calendar leap year."
  46   (< (% (1+ (* 7 year)) 19) 7))
  47
  48 (defun calendar-hebrew-last-month-of-year (year)
  49   "The last month of the Hebrew calendar YEAR."
  50   (if (calendar-hebrew-leap-year-p year)
  51       13
  52     12))
  53
  54 (defun calendar-hebrew-elapsed-days (year)
  55   "Days to mean conjunction of Tishri of Hebrew YEAR.
  56 Measured from Sunday before start of Hebrew calendar."
  57   (let* ((months-elapsed
  58           (+ (* 235 (/ (1- year) 19)) ; months in complete cycles so far
  59              (* 12 (% (1- year) 19))  ; regular months in this cycle
  60              (/ (1+ (* 7 (% (1- year) 19))) 19))) ; leap months this cycle
  61          (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
  62          (hours-elapsed (+ 5
  63                            (* 12 months-elapsed)
  64                            (* 793 (/ months-elapsed 1080))
  65                            (/ parts-elapsed 1080)))
  66          (parts                         ; conjunction parts
  67           (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
  68          (day                           ; conjunction day
  69           (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
  70          (alternative-day
  71           (if (or (>= parts 19440) ; if the new moon is at or after midday
  72                   (and (= (% day 7) 2)  ; ...or is on a Tuesday...
  73                        (>= parts 9924) ; at 9 hours, 204 parts or later...
  74                        ;; of a common year...
  75                        (not (calendar-hebrew-leap-year-p year)))
  76                   (and (= (% day 7) 1)  ; ...or is on a Monday...
  77                        (>= parts 16789) ; at 15 hours, 589 parts or later...
  78                        ;; at the end of a leap year.
  79                        (calendar-hebrew-leap-year-p (1- year))))
  80               ;; Then postpone Rosh HaShanah one day.
  81               (1+ day)
  82             ;; Else:
  83             day)))
  84     ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
  85     (if (memq (% alternative-day 7) (list 0 3 5))
  86         ;; Then postpone it one (more) day and return.
  87         (1+ alternative-day)
  88       ;; Else return.
  89       alternative-day)))
  90
  91 (defun calendar-hebrew-days-in-year (year)
  92   "Number of days in Hebrew YEAR."
  93   (- (calendar-hebrew-elapsed-days (1+ year))
  94      (calendar-hebrew-elapsed-days year)))
  95
  96 (defun calendar-hebrew-long-heshvan-p (year)
  97   "Non-nil if Heshvan is long in Hebrew YEAR."
  98   (= (% (calendar-hebrew-days-in-year year) 10) 5))
  99
 100 (defun calendar-hebrew-short-kislev-p (year)
 101   "Non-nil if Kislev is short in Hebrew YEAR."
 102   (= (% (calendar-hebrew-days-in-year year) 10) 3))
 103
 104 (defun calendar-hebrew-last-day-of-month (month year)
 105   "The last day of MONTH in YEAR."
 106   (if (or (memq month (list 2 4 6 10 13))
 107           (and (= month 12) (not (calendar-hebrew-leap-year-p year)))
 108           (and (= month 8) (not (calendar-hebrew-long-heshvan-p year)))
 109           (and (= month 9) (calendar-hebrew-short-kislev-p year)))
 110       29
 111     30))
 112
 113 (defun calendar-hebrew-to-absolute (date)
 114   "Absolute date of Hebrew DATE.
 115 The absolute date is the number of days elapsed since the (imaginary)
 116 Gregorian date Sunday, December 31, 1 BC."
 117   (let ((month (calendar-extract-month date))
 118         (day (calendar-extract-day date))
 119         (year (calendar-extract-year date)))
 120     (+ day                              ; days so far this month
 121        (if (< month 7)                  ; before Tishri
 122            ;; Then add days in prior months this year before and after Nisan.
 123            (+ (calendar-sum
 124                m 7 (<= m (calendar-hebrew-last-month-of-year year))
 125                (calendar-hebrew-last-day-of-month m year))
 126               (calendar-sum
 127                m 1 (< m month)
 128                (calendar-hebrew-last-day-of-month m year)))
 129          ;; Else add days in prior months this year.
 130          (calendar-sum
 131           m 7 (< m month)
 132           (calendar-hebrew-last-day-of-month m year)))
 133        (calendar-hebrew-elapsed-days year) ; days in prior years
 134        -1373429)))               ; days elapsed before absolute date 1
 135
 136 (defun calendar-hebrew-from-absolute (date)
 137   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
 138 The absolute date is the number of days elapsed since the (imaginary)
 139 Gregorian date Sunday, December 31, 1 BC."
 140   (let* ((greg-date (calendar-gregorian-from-absolute date))
 141          (year (+ 3760 (calendar-extract-year greg-date)))
 142          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
 143                       (1- (calendar-extract-month greg-date))))
 144          (length (progn
 145                    (while (>= date (calendar-hebrew-to-absolute
 146                                     (list 7 1 (1+ year))))
 147                      (setq year (1+ year)))
 148                    (calendar-hebrew-last-month-of-year year)))
 149          day)
 150     (while (> date
 151               (calendar-hebrew-to-absolute
 152                (list month
 153                      (calendar-hebrew-last-day-of-month month year)
 154                      year)))
 155       (setq month (1+ (% month length))))
 156     (setq day (1+
 157                (- date (calendar-hebrew-to-absolute (list month 1 year)))))
 158     (list month day year)))
 159
 160 (defconst calendar-hebrew-month-name-array-common-year
 161   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 162    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]
 163   "Array of strings giving the names of the Hebrew months in a common year.")
 164
 165 (defconst calendar-hebrew-month-name-array-leap-year
 166   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 167    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]
 168   "Array of strings giving the names of the Hebrew months in a leap year.")
 169
 170 ;;;###cal-autoload
 171 (defun calendar-hebrew-date-string (&optional date)
 172   "String of Hebrew date before sunset of Gregorian DATE.
 173 Defaults to today's date if DATE is not given.
 174 Driven by the variable `calendar-date-display-form'."
 175   (let* ((hebrew-date (calendar-hebrew-from-absolute
 176                        (calendar-absolute-from-gregorian
 177                         (or date (calendar-current-date)))))
 178          (calendar-month-name-array
 179           (if (calendar-hebrew-leap-year-p (calendar-extract-year hebrew-date))
 180               calendar-hebrew-month-name-array-leap-year
 181             calendar-hebrew-month-name-array-common-year)))
 182     (calendar-date-string hebrew-date nil t)))
 183
 184 ;;;###cal-autoload
 185 (defun calendar-hebrew-print-date ()
 186   "Show the Hebrew calendar equivalent of the date under the cursor."
 187   (interactive)
 188   (message "Hebrew date (until sunset): %s"
 189            (calendar-hebrew-date-string (calendar-cursor-to-date t))))
 190
 191 (defun calendar-hebrew-yahrzeit (death-date year)
 192   "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
 193   (let ((death-day (calendar-extract-day death-date))
 194         (death-month (calendar-extract-month death-date))
 195         (death-year (calendar-extract-year death-date)))
 196     (cond
 197      ;; If it's Heshvan 30 it depends on the first anniversary; if
 198      ;; that was not Heshvan 30, use the day before Kislev 1.
 199      ((and (= death-month 8)
 200            (= death-day 30)
 201            (not (calendar-hebrew-long-heshvan-p (1+ death-year))))
 202       (1- (calendar-hebrew-to-absolute (list 9 1 year))))
 203      ;; If it's Kislev 30 it depends on the first anniversary; if that
 204      ;; was not Kislev 30, use the day before Teveth 1.
 205      ((and (= death-month 9)
 206            (= death-day 30)
 207            (calendar-hebrew-short-kislev-p (1+ death-year)))
 208       (1- (calendar-hebrew-to-absolute (list 10 1 year))))
 209      ;; If it's Adar II, use the same day in last month of year (Adar
 210      ;; or Adar II).
 211      ((= death-month 13)
 212       (calendar-hebrew-to-absolute
 213        (list (calendar-hebrew-last-month-of-year year) death-day year)))
 214      ;; If it's the 30th in Adar I and year is not a leap year (so
 215      ;; Adar has only 29 days), use the last day in Shevat.
 216      ((and (= death-day 30)
 217            (= death-month 12)
 218            (not (calendar-hebrew-leap-year-p year)))
 219       (calendar-hebrew-to-absolute (list 11 30 year)))
 220      ;; In all other cases, use the normal anniversary of the date of death.
 221      (t (calendar-hebrew-to-absolute
 222          (list death-month death-day year))))))
 223
 224 (defun calendar-hebrew-read-date ()
 225   "Interactively read the arguments for a Hebrew date command.
 226 Reads a year, month, and day."
 227   (let* ((today (calendar-current-date))
 228          (year (calendar-read
 229                 "Hebrew calendar year (>3760): "
 230                 (lambda (x) (> x 3760))
 231                 (number-to-string
 232                  (calendar-extract-year
 233                   (calendar-hebrew-from-absolute
 234                    (calendar-absolute-from-gregorian today))))))
 235          (month-array (if (calendar-hebrew-leap-year-p year)
 236                           calendar-hebrew-month-name-array-leap-year
 237                         calendar-hebrew-month-name-array-common-year))
 238          (completion-ignore-case t)
 239          (month (cdr (assoc-string
 240                       (completing-read
 241                        "Hebrew calendar month name: "
 242                        (mapcar 'list (append month-array nil))
 243                        (if (= year 3761)
 244                            (lambda (x)
 245                              (let ((m (cdr
 246                                        (assoc-string
 247                                         (car x)
 248                                         (calendar-make-alist month-array)
 249                                         t))))
 250                                (< 0
 251                                   (calendar-hebrew-to-absolute
 252                                    (list m
 253                                          (calendar-hebrew-last-day-of-month
 254                                           m year)
 255                                          year))))))
 256                        t)
 257                       (calendar-make-alist month-array 1) t)))
 258          (last (calendar-hebrew-last-day-of-month month year))
 259          (first (if (and (= year 3761) (= month 10))
 260                     18 1))
 261          (day (calendar-read
 262                (format "Hebrew calendar day (%d-%d): "
 263                        first last)
 264                (lambda (x) (and (<= first x) (<= x last))))))
 265     (list (list month day year))))
 266
 267 ;;;###cal-autoload
 268 (defun calendar-hebrew-goto-date (date &optional noecho)
 269   "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil."
 270   (interactive (calendar-hebrew-read-date))
 271   (calendar-goto-date (calendar-gregorian-from-absolute
 272                        (calendar-hebrew-to-absolute date)))
 273   (or noecho (calendar-hebrew-print-date)))
 274
 275 (defvar displayed-month)                ; from calendar-generate
 276
 277 (defun calendar-hebrew-date-is-visible-p (month day)
 278   "Return non-nil if Hebrew MONTH DAY is visible in the calendar window.
 279 Returns the corresponding Gregorian date."
 280   ;; This test is only to speed things up a bit; it works fine without it.
 281   (if (memq displayed-month
 282             ;; What this is doing is equivalent to +1,2,3,4,5 modulo 12, ie:
 283             ;;  (mapcar (lambda (n) (let ((x (mod n 12)))
 284             ;;                        (if (zerop x) 12
 285             ;;                          x)))
 286             ;;          (number-sequence (1+ month) (+ 5 month)))
 287             ;; Ie it makes a list:
 288             ;;  2  3  4  5  6 when month = 1
 289             ;;  3  4  5  6  7 when month = 2
 290             ;; ...
 291             ;;  8  9 10 11 12 when month = 7
 292             ;;  9 10 11 12  1 when month = 8
 293             ;; ...
 294             ;; 12  1  2  3  4 when month = 11
 295             ;;  1  2  3  4  5 when month = 12
 296             ;; This implies that hebrew month N cannot occur outside
 297             ;; Gregorian months N:N+6 (the calendar shows
 298             ;; displayed-month +/- 1 at any time).
 299             ;; So to put it another way:
 300             ;;  (calendar-interval month 1 displayed-month
 301             ;;                    (if (> month displayed-month) 2 1))
 302             ;; must be >= 1 and <= 5.  This could be expanded to:
 303             ;;  (if (> month displayed-month) (+ 12 (- displayed-month month))
 304             ;;    (- displayed-month month)
 305             (list
 306              (if (< 11 month) (- month 11) (+ month 1))
 307              (if (< 10 month) (- month 10) (+ month 2))
 308              (if (<  9 month) (- month  9) (+ month 3))
 309              (if (<  8 month) (- month  8) (+ month 4))
 310              (if (<  7 month) (- month  7) (+ month 5))))
 311       (calendar-nongregorian-visible-p
 312        month day 'calendar-hebrew-to-absolute
 313        'calendar-hebrew-from-absolute
 314        ;; Hebrew new year is start of month 7.
 315        ;; If hmonth >= 7, choose the higher year.
 316        (lambda (m) (> m 6)))))
 317
 318 ;;;###holiday-autoload
 319 (defun holiday-hebrew (month day string)
 320   "Holiday on MONTH, DAY (Hebrew) called STRING.
 321 If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
 322 Gregorian date in the form of the list (((month day year) STRING)).  Returns
 323 nil if it is not visible in the current calendar window."
 324   (let ((gdate (calendar-hebrew-date-is-visible-p month day)))
 325     (if gdate (list (list gdate string)))))
 326
 327 ;; h-r-h-e should be called from holidays code.
 328 (declare-function holiday-filter-visible-calendar "holidays" (l))
 329
 330 (defvar displayed-year)
 331
 332 ;;;###holiday-autoload
 333 (defun holiday-hebrew-rosh-hashanah (&optional all)
 334   "List of dates related to Rosh Hashanah, as visible in calendar window.
 335 Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag'
 336 or ALL is non-nil."
 337   (when (memq displayed-month '(8 9 10 11))
 338     (let ((abs-r-h (calendar-hebrew-to-absolute
 339                     (list 7 1 (+ displayed-year 3761)))))
 340       (holiday-filter-visible-calendar
 341        (append
 342         (list
 343          (list (calendar-gregorian-from-absolute abs-r-h)
 344                (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
 345          (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
 346                "Yom Kippur")
 347          (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
 348                "Sukkot")
 349          (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
 350                "Shemini Atzeret")
 351          (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
 352                "Simchat Torah"))
 353         (when (or all calendar-hebrew-all-holidays-flag)
 354           (list
 355            (list (calendar-gregorian-from-absolute
 356                   (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
 357                  "Selichot (night)")
 358            (list (calendar-gregorian-from-absolute (1- abs-r-h))
 359                  "Erev Rosh HaShanah")
 360            (list (calendar-gregorian-from-absolute (1+ abs-r-h))
 361                  "Rosh HaShanah (second day)")
 362            (list (calendar-gregorian-from-absolute
 363                   (+ abs-r-h (if (= (% abs-r-h 7) 4) 3 2)))
 364                  "Tzom Gedaliah")
 365            (list (calendar-gregorian-from-absolute
 366                   (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
 367                  "Shabbat Shuvah")
 368            (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
 369                  "Erev Yom Kippur")
 370            (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
 371                  "Erev Sukkot")
 372            (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
 373                  "Sukkot (second day)")
 374            (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
 375                  "Hol Hamoed Sukkot (first day)")
 376            (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
 377                  "Hol Hamoed Sukkot (second day)")
 378            (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
 379                  "Hol Hamoed Sukkot (third day)")
 380            (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
 381                  "Hol Hamoed Sukkot (fourth day)")
 382            (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
 383                    "Hoshanah Rabbah"))))))))
 384
 385 ;;;###holiday-autoload
 386 (defun holiday-hebrew-hanukkah (&optional all)
 387   "List of dates related to Hanukkah, as visible in calendar window.
 388 Shows only Hanukkah, unless `calendar-hebrew-all-holidays-flag' or ALL
 389 is non-nil."
 390   ;; This test is only to speed things up a bit, it works fine without it.
 391   (when (memq displayed-month '(10 11 12 1 2))
 392     (let* ((m displayed-month)
 393            (y displayed-year)
 394            (h-y (progn
 395                   (calendar-increment-month m y 1)
 396                   (calendar-extract-year
 397                    (calendar-hebrew-from-absolute
 398                     (calendar-absolute-from-gregorian
 399                      (list m (calendar-last-day-of-month m y) y))))))
 400            (abs-h (calendar-hebrew-to-absolute (list 9 25 h-y)))
 401            (ord ["first" "second" "third" "fourth" "fifth" "sixth"
 402                  "seventh" "eighth"])
 403            han)
 404       (holiday-filter-visible-calendar
 405        (if (or all calendar-hebrew-all-holidays-flag)
 406            (append
 407             (list
 408              (list (calendar-gregorian-from-absolute (1- abs-h))
 409                    "Erev Hanukkah"))
 410             (dotimes (i 8 (nreverse han))
 411               (push (list
 412                      (calendar-gregorian-from-absolute (+ abs-h i))
 413                      (format "Hanukkah (%s day)" (aref ord i)))
 414                     han)))
 415          (list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah")))))))
 416
 417 ;;;###holiday-autoload
 418 (defun holiday-hebrew-passover (&optional all)
 419   "List of dates related to Passover, as visible in calendar window.
 420 Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag'
 421 or ALL is non-nil."
 422   (when (< displayed-month 8)
 423     (let ((abs-p (calendar-hebrew-to-absolute
 424                   (list 1 15 (+ displayed-year 3760)))))
 425       (holiday-filter-visible-calendar
 426        ;; The first two are out of order when the others are added.
 427        (append
 428         (list
 429          (list (calendar-gregorian-from-absolute abs-p) "Passover")
 430          (list (calendar-gregorian-from-absolute (+ abs-p 50))
 431                     "Shavuot"))
 432         (when (or all calendar-hebrew-all-holidays-flag)
 433           (let ((wday (% abs-p 7)))
 434             (list
 435              (list (calendar-gregorian-from-absolute
 436                     (calendar-dayname-on-or-before 6 (- abs-p 43)))
 437                    "Shabbat Shekalim")
 438              (list (calendar-gregorian-from-absolute
 439                     (calendar-dayname-on-or-before 6 (- abs-p 30)))
 440                    "Shabbat Zachor")
 441              (list (calendar-gregorian-from-absolute
 442                     (- abs-p (if (= wday 2) 33 31)))
 443                    "Fast of Esther")
 444              (list (calendar-gregorian-from-absolute (- abs-p 31))
 445                    "Erev Purim")
 446              (list (calendar-gregorian-from-absolute (- abs-p 30))
 447                    "Purim")
 448              (list (calendar-gregorian-from-absolute
 449                     (- abs-p (if (zerop wday) 28 29)))
 450                    "Shushan Purim")
 451              (list (calendar-gregorian-from-absolute
 452                     (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
 453                    "Shabbat Parah")
 454              (list (calendar-gregorian-from-absolute
 455                     (calendar-dayname-on-or-before 6 (- abs-p 14)))
 456                    "Shabbat HaHodesh")
 457              (list (calendar-gregorian-from-absolute
 458                     (calendar-dayname-on-or-before 6 (1- abs-p)))
 459                    "Shabbat HaGadol")
 460              (list (calendar-gregorian-from-absolute (1- abs-p))
 461                    "Erev Passover")
 462              (list (calendar-gregorian-from-absolute (1+ abs-p))
 463                    "Passover (second day)")
 464              (list (calendar-gregorian-from-absolute (+ abs-p 2))
 465                    "Hol Hamoed Passover (first day)")
 466              (list (calendar-gregorian-from-absolute (+ abs-p 3))
 467                    "Hol Hamoed Passover (second day)")
 468              (list (calendar-gregorian-from-absolute (+ abs-p 4))
 469                    "Hol Hamoed Passover (third day)")
 470              (list (calendar-gregorian-from-absolute (+ abs-p 5))
 471                    "Hol Hamoed Passover (fourth day)")
 472              (list (calendar-gregorian-from-absolute (+ abs-p 6))
 473                    "Passover (seventh day)")
 474              (list (calendar-gregorian-from-absolute (+ abs-p 7))
 475                    "Passover (eighth day)")
 476              (list (calendar-gregorian-from-absolute
 477                     (+ abs-p (if (zerop (% (+ abs-p 12) 7))
 478                                  13
 479                                12)))
 480                    "Yom HaShoah")
 481              (list (calendar-gregorian-from-absolute
 482                     (+ abs-p
 483                        ;; If falls on Sat or Fri, moves to preceding Thurs.
 484                        ;; If falls on Mon, moves to Tues (since 2004).
 485                        (cond ((zerop wday) 18) ; Sat
 486                              ((= wday 6) 19)   ; Fri
 487                              ((= wday 2) 21)   ; Mon
 488                              (t 20))))
 489                    "Yom HaAtzma'ut")
 490              (list (calendar-gregorian-from-absolute (+ abs-p 33))
 491                    "Lag BaOmer")
 492              (list (calendar-gregorian-from-absolute (+ abs-p 43))
 493                    "Yom Yerushalaim")
 494              (list (calendar-gregorian-from-absolute (+ abs-p 49))
 495                    "Erev Shavuot")
 496              (list (calendar-gregorian-from-absolute (+ abs-p 51))
 497                    "Shavuot (second day)")))))))))
 498
 499 ;;;###holiday-autoload
 500 (defun holiday-hebrew-tisha-b-av ()
 501   "List of dates around Tisha B'Av, as visible in calendar window."
 502   (when (memq displayed-month '(5 6 7 8 9))
 503     (let* ((abs-t-a (calendar-hebrew-to-absolute
 504                      (list 5 9 (+ displayed-year 3760))))
 505            (wday (% abs-t-a 7)))
 506       (holiday-filter-visible-calendar
 507        (list
 508         (list (calendar-gregorian-from-absolute
 509                (- abs-t-a (if (= wday 6) 20 21)))
 510               "Tzom Tammuz")
 511         (list (calendar-gregorian-from-absolute
 512                (calendar-dayname-on-or-before 6 abs-t-a))
 513               "Shabbat Hazon")
 514         (list (calendar-gregorian-from-absolute
 515                (if (= wday 6) (1+ abs-t-a) abs-t-a))
 516               "Tisha B'Av")
 517         (list (calendar-gregorian-from-absolute
 518                (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
 519               "Shabbat Nahamu"))))))
 520
 521 (autoload 'holiday-julian "cal-julian")
 522
 523 ;;;###holiday-autoload
 524 (defun holiday-hebrew-misc ()
 525   "Miscellaneous Hebrew holidays, if visible in calendar window.
 526 Includes: Tal Umatar, Tzom Teveth, Tu B'Shevat, Shabbat Shirah, and
 527 Kiddush HaHamah."
 528   (let ((m displayed-month)
 529         (y displayed-year)
 530         year h-year)
 531     (append
 532      (holiday-julian
 533       11
 534       (progn
 535         (calendar-increment-month m y -1)
 536         (setq year (calendar-extract-year
 537                     (calendar-julian-from-absolute
 538                      (calendar-absolute-from-gregorian (list m 1 y)))))
 539         (if (zerop (% (1+ year) 4))
 540             22
 541           21)) "\"Tal Umatar\" (evening)")
 542      (holiday-hebrew
 543       10
 544       (progn
 545         (setq h-year (calendar-extract-year
 546                       (calendar-hebrew-from-absolute
 547                        (calendar-absolute-from-gregorian
 548                         (list displayed-month 28 displayed-year)))))
 549         (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year))
 550                     7))
 551             11 10))
 552       "Tzom Teveth")
 553      (holiday-hebrew 11 15 "Tu B'Shevat")
 554      (holiday-hebrew
 555       11
 556       (progn
 557         (setq m displayed-month
 558               y displayed-year
 559               h-year (progn
 560                        (calendar-increment-month m y 1)
 561                        (calendar-extract-year
 562                         (calendar-hebrew-from-absolute
 563                          (calendar-absolute-from-gregorian
 564                           (list m (calendar-last-day-of-month m y) y))))))
 565         (calendar-extract-day
 566          (calendar-hebrew-from-absolute
 567           (calendar-dayname-on-or-before
 568            6 (calendar-hebrew-to-absolute
 569               (list 11
 570                     (if (= 6
 571                            (% (calendar-hebrew-to-absolute
 572                                (list 7 1 h-year))
 573                               7))
 574                         17 16) h-year))))))
 575       "Shabbat Shirah")
 576      (and (progn
 577             (setq m displayed-month
 578                   y displayed-year
 579                   year (progn
 580                          (calendar-increment-month m y -1)
 581                          (calendar-extract-year
 582                           (calendar-julian-from-absolute
 583                            (calendar-absolute-from-gregorian (list m 1 y))))))
 584             (= 21 (% year 28)))
 585           (holiday-julian 3 26 "Kiddush HaHamah")))))
 586
 587
 588 (autoload 'diary-list-entries-1 "diary-lib")
 589
 590 ;;;###diary-autoload
 591 (defun diary-hebrew-list-entries ()
 592   "Add any Hebrew date entries from the diary file to `diary-entries-list'.
 593 Hebrew date diary entries must be prefaced by `diary-hebrew-entry-symbol'
 594 \(normally an `H').  The same diary date forms govern the style
 595 of the Hebrew calendar entries, except that the Hebrew month
 596 names cannot be abbreviated.  The Hebrew months are numbered
 597 from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being
 598 Adar II; you must use `Adar I' if you want Adar of a common
 599 Hebrew year.  If a Hebrew date diary entry begins with
 600 `diary-nonmarking-symbol', the entry will appear in the diary
 601 listing, but will not be marked in the calendar.  This function
 602 is provided for use with `diary-nongregorian-listing-hook'."
 603   (diary-list-entries-1 calendar-hebrew-month-name-array-leap-year
 604                         diary-hebrew-entry-symbol
 605                         'calendar-hebrew-from-absolute))
 606
 607 (autoload 'calendar-mark-complex "diary-lib")
 608
 609 ;;;###diary-autoload
 610 (defun calendar-hebrew-mark-date-pattern (month day year &optional color)
 611   "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
 612 A value of 0 in any position is a wildcard.  Optional argument COLOR is
 613 passed to `calendar-mark-visible-date' as MARK."
 614   ;; FIXME not the same as the Bahá’í and Islamic cases, so can't use
 615   ;; calendar-mark-1.
 616   (with-current-buffer calendar-buffer
 617     (if (and (not (zerop month)) (not (zerop day)))
 618         (if (not (zerop year))
 619             ;; Fully specified Hebrew date.
 620             (let ((date (calendar-gregorian-from-absolute
 621                          (calendar-hebrew-to-absolute
 622                           (list month day year)))))
 623               (if (calendar-date-is-visible-p date)
 624                   (calendar-mark-visible-date date color)))
 625           ;; Month and day in any year.
 626           (let ((gdate (calendar-hebrew-date-is-visible-p month day)))
 627             (if gdate (calendar-mark-visible-date gdate color))))
 628       (calendar-mark-complex month day year
 629                              'calendar-hebrew-from-absolute color))))
 630
 631 (autoload 'diary-mark-entries-1 "diary-lib")
 632
 633 ;;;###diary-autoload
 634 (defun diary-hebrew-mark-entries ()
 635   "Mark days in the calendar window that have Hebrew date diary entries.
 636 Marks each entry in `diary-file' (or included files) visible in the calendar
 637 window.  See `list-hebrew-diary-entries' for more information."
 638   (diary-mark-entries-1 'calendar-hebrew-mark-date-pattern
 639                         calendar-hebrew-month-name-array-leap-year
 640                         diary-hebrew-entry-symbol
 641                         'calendar-hebrew-from-absolute))
 642
 643 (autoload 'diary-insert-entry-1 "diary-lib")
 644
 645 ;;;###cal-autoload
 646 (defun diary-hebrew-insert-entry (arg)
 647   "Insert a diary entry for the Hebrew date at point.
 648 Prefix argument ARG makes the entry nonmarking."
 649   (interactive "P")
 650   (diary-insert-entry-1 nil arg calendar-hebrew-month-name-array-leap-year
 651                         diary-hebrew-entry-symbol
 652                         'calendar-hebrew-from-absolute))
 653
 654 ;;;###cal-autoload
 655 (defun diary-hebrew-insert-monthly-entry (arg)
 656   "Insert a monthly diary entry.
 657 For the day of the Hebrew month corresponding to the date indicated by point.
 658 Prefix argument ARG makes the entry nonmarking."
 659   (interactive "P")
 660   (diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year
 661                         diary-hebrew-entry-symbol
 662                         'calendar-hebrew-from-absolute))
 663
 664 ;;;###cal-autoload
 665 (defun diary-hebrew-insert-yearly-entry (arg)
 666   "Insert an annual diary entry.
 667 For the day of the Hebrew year corresponding to the date indicated by point.
 668 Prefix argument ARG makes the entry nonmarking."
 669   (interactive "P")
 670   (diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year
 671                         diary-hebrew-entry-symbol
 672                         'calendar-hebrew-from-absolute))
 673
 674 ;;;###autoload
 675 (defun calendar-hebrew-list-yahrzeits (death-date start-year end-year)
 676   "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
 677 When called interactively from the calendar window, the date of death is taken
 678 from the cursor position."
 679   (interactive
 680    (let* ((death-date
 681            (if (equal (current-buffer) (get-buffer calendar-buffer))
 682                (calendar-cursor-to-date t)
 683              (let* ((today (calendar-current-date))
 684                     (year (calendar-read
 685                            "Year of death (>0): "
 686                            (lambda (x) (> x 0))
 687                            (number-to-string (calendar-extract-year today))))
 688                     (month-array calendar-month-name-array)
 689                     (completion-ignore-case t)
 690                     (month (cdr (assoc-string
 691                                  (completing-read
 692                                   "Month of death (name): "
 693                                   (mapcar 'list (append month-array nil))
 694                                   nil t)
 695                                  (calendar-make-alist month-array 1) t)))
 696                     (last (calendar-last-day-of-month month year))
 697                     (day (calendar-read
 698                           (format "Day of death (1-%d): " last)
 699                           (lambda (x) (and (< 0 x) (<= x last))))))
 700                (list month day year))))
 701           (death-year (calendar-extract-year death-date))
 702           (start-year (calendar-read
 703                        (format "Starting year of Yahrzeit table (>%d): "
 704                                death-year)
 705                        (lambda (x) (> x death-year))
 706                        (number-to-string (1+ death-year))))
 707           (end-year (calendar-read
 708                      (format "Ending year of Yahrzeit table (>=%d): "
 709                              start-year)
 710                      (lambda (x) (>= x start-year)))))
 711      (list death-date start-year end-year)))
 712   (message "Computing Yahrzeits...")
 713   (let* ((h-date (calendar-hebrew-from-absolute
 714                   (calendar-absolute-from-gregorian death-date)))
 715          (h-year (calendar-extract-year h-date))
 716          (i (1- start-year)))
 717     (calendar-in-read-only-buffer calendar-hebrew-yahrzeit-buffer
 718       (calendar-set-mode-line
 719        (format "Yahrzeit dates for %s = %s"
 720                (calendar-date-string death-date)
 721                (let ((calendar-month-name-array
 722                       (if (calendar-hebrew-leap-year-p h-year)
 723                           calendar-hebrew-month-name-array-leap-year
 724                         calendar-hebrew-month-name-array-common-year)))
 725                  (calendar-date-string h-date nil t))))
 726       (while (<= (setq i (1+ i)) end-year)
 727         (insert
 728          (calendar-date-string
 729           (calendar-gregorian-from-absolute
 730            (calendar-hebrew-yahrzeit
 731             h-date
 732             (calendar-extract-year
 733              (calendar-hebrew-from-absolute
 734               (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))))
 735   (message "Computing Yahrzeits...done"))
 736
 737 (defun calendar-hebrew-birthday (date year)
 738   "Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR."
 739   (let ((b-day (calendar-extract-day date))
 740         (b-month (calendar-extract-month date))
 741         (b-year (calendar-extract-year date)))
 742     ;; If it's Adar in a normal Hebrew year or Adar II in a Hebrew leap year...
 743     (if (= b-month (calendar-hebrew-last-month-of-year b-year))
 744         ;; ...then use the same day in last month of Hebrew year.
 745         (calendar-hebrew-to-absolute
 746          (list (calendar-hebrew-last-month-of-year year) b-day year))
 747       ;; Else use the normal anniversary of the birth date,
 748       ;; or the corresponding day in years without that date.
 749       (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
 750
 751 (defvar date)
 752
 753 ;; To be called from diary-list-sexp-entries, where DATE is bound.
 754 ;;;###diary-autoload
 755 (defun diary-hebrew-date ()
 756   "Hebrew calendar equivalent of date diary entry."
 757   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 758
 759 (defvar entry)
 760 (declare-function diary-ordinal-suffix "diary-lib" (n))
 761
 762 ;;;###diary-autoload
 763 (defun diary-hebrew-birthday (month day year &optional after-sunset)
 764   "Hebrew birthday diary entry.
 765 Entry applies if date is birthdate (MONTH DAY YEAR), or the day before.
 766 The order of the input parameters changes according to
 767 `calendar-date-style' (e.g. to DAY MONTH YEAR in the European style).
 768
 769 Assumes the associated diary entry is the name of the person.
 770
 771 Although the date of birth is specified by the *civil* calendar,
 772 this function determines the proper Hebrew calendar birthday.
 773 If the optional argument AFTER-SUNSET is non-nil, this means the
 774 birth occurred after local sunset on the given civil date.
 775 In this case, the following civil date corresponds to the Hebrew birthday."
 776   (let* ((h-date (calendar-hebrew-from-absolute
 777                   (+ (calendar-absolute-from-gregorian
 778                       (diary-make-date month day year))
 779                      (if after-sunset 1 0))))
 780          (h-year (calendar-extract-year h-date))     ; birth-day
 781          (d (calendar-absolute-from-gregorian date)) ; today
 782          (h-yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
 783          (age (- h-yr h-year))          ; current H year - birth H-year
 784          (b-date (calendar-hebrew-birthday h-date h-yr)))
 785     (and (> age 0) (memq b-date (list d (1+ d)))
 786          (format "%s's %d%s Hebrew birthday%s" entry age
 787                  (diary-ordinal-suffix age)
 788                  (if (= b-date d) "" " (evening)")))))
 789
 790 ;;;###diary-autoload
 791 (defun diary-hebrew-omer (&optional mark)
 792   "Omer count diary entry.
 793 Entry applies if date is within 50 days after Passover.
 794
 795 An optional parameter MARK specifies a face or single-character string to
 796 use when highlighting the day in the calendar."
 797   (let* ((passover
 798           (calendar-hebrew-to-absolute
 799            (list 1 15 (+ (calendar-extract-year date) 3760))))
 800          (omer (- (calendar-absolute-from-gregorian date) passover))
 801          (week (/ omer 7))
 802          (day (% omer 7)))
 803     (if (and (> omer 0) (< omer 50))
 804         (cons mark
 805               (format "Day %d%s of the omer (until sunset)"
 806                       omer
 807                       (if (zerop week)
 808                           ""
 809                         (format ", that is, %d week%s%s"
 810                                 week
 811                                 (if (= week 1) "" "s")
 812                                 (if (zerop day)
 813                                     ""
 814                                   (format " and %d day%s"
 815                                           day (if (= day 1) "" "s"))))))))))
 816
 817 (autoload 'diary-make-date "diary-lib")
 818
 819 (declare-function diary-ordinal-suffix "diary-lib" (n))
 820
 821 ;;;###diary-autoload
 822 (defun diary-hebrew-yahrzeit (death-month death-day death-year
 823                                           &optional mark after-sunset)
 824   "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before.
 825 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary
 826 entry is assumed to be the name of the person.  Although the date
 827 of death is specified by the civil calendar, the proper Hebrew
 828 calendar Yahrzeit is determined.
 829
 830 If the death occurred after local sunset on the given civil date,
 831 the following civil date corresponds to the Hebrew date of
 832 death--set the optional parameter AFTER-SUNSET non-nil in this case.
 833
 834 The order of the input parameters changes according to `calendar-date-style'
 835 \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style).
 836
 837 An optional parameter MARK specifies a face or single-character string to
 838 use when highlighting the day in the calendar."
 839   (let* ((h-date (calendar-hebrew-from-absolute
 840                   (+ (calendar-absolute-from-gregorian
 841                       (diary-make-date death-month death-day death-year))
 842                      (if after-sunset 1 0))))
 843          (h-year (calendar-extract-year h-date))
 844          (d (calendar-absolute-from-gregorian date))
 845          (yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
 846          (diff (- yr h-year))
 847          (y (calendar-hebrew-yahrzeit h-date yr)))
 848     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
 849         (cons mark
 850               (format "Yahrzeit of %s%s: %d%s anniversary"
 851                       entry
 852                       (if (= y d) "" " (evening)")
 853                       diff
 854                       (diary-ordinal-suffix diff))))))
 855
 856 ;;;###diary-autoload
 857 (defun diary-hebrew-rosh-hodesh (&optional mark)
 858   "Rosh Hodesh diary entry.
 859 Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
 860
 861 An optional parameter MARK specifies a face or single-character string to
 862 use when highlighting the day in the calendar."
 863   (let* ((d (calendar-absolute-from-gregorian date))
 864          (h-date (calendar-hebrew-from-absolute d))
 865          (h-month (calendar-extract-month h-date))
 866          (h-day (calendar-extract-day h-date))
 867          (h-year (calendar-extract-year h-date))
 868          (leap-year (calendar-hebrew-leap-year-p h-year))
 869          (last-day (calendar-hebrew-last-day-of-month h-month h-year))
 870          (h-month-names
 871           (if leap-year
 872               calendar-hebrew-month-name-array-leap-year
 873             calendar-hebrew-month-name-array-common-year))
 874          (this-month (aref h-month-names (1- h-month)))
 875          (h-yesterday (calendar-extract-day
 876                        (calendar-hebrew-from-absolute (1- d)))))
 877     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
 878         (cons mark
 879               (format
 880                "Rosh Hodesh %s"
 881                (if (= h-day 30)
 882                    (format
 883                     "%s (first day)"
 884                     ;; Next month must be in the same year since this
 885                     ;; month can't be the last month of the year since
 886                     ;; it has 30 days
 887                     (aref h-month-names h-month))
 888                  (if (= h-yesterday 30)
 889                      (format "%s (second day)" this-month)
 890                    this-month))))
 891       (if (= (% d 7) 6)        ; Saturday--check for Shabbat Mevarchim
 892           (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
 893                  (cons mark
 894                        (format "Mevarchim Rosh Hodesh %s (%s)"
 895                                (aref h-month-names
 896                                      (if (= h-month
 897                                             (calendar-hebrew-last-month-of-year
 898                                              h-year))
 899                                          0 h-month))
 900                                (aref calendar-day-name-array (- 29 h-day)))))
 901                 ((and (< h-day 30) (> h-day 22) (= 30 last-day))
 902                  (cons mark
 903                        (format "Mevarchim Rosh Hodesh %s (%s-%s)"
 904                                (aref h-month-names h-month)
 905                                (if (= h-day 29)
 906                                    "tomorrow"
 907                                  (aref calendar-day-name-array (- 29 h-day)))
 908                                (aref calendar-day-name-array
 909                                      (% (- 30 h-day) 7))))))
 910         (if (and (= h-day 29) (/= h-month 6))
 911             (cons mark
 912                   (format "Erev Rosh Hodesh %s"
 913                           (aref h-month-names
 914                                 (if (= h-month
 915                                        (calendar-hebrew-last-month-of-year
 916                                         h-year))
 917                                     0 h-month)))))))))
 918
 919 (defconst calendar-hebrew-parashiot-names
 920   ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
 921    "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
 922    "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
 923    "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
 924    "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
 925    "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"      "Behaalot'cha"
 926    "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
 927    "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
 928    "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
 929   "The names of the parashiot in the Torah.")
 930
 931 (defun calendar-hebrew-parasha-name (p)
 932   "Name(s) corresponding to parasha P."
 933   (if (arrayp p)                        ; combined parasha
 934       (format "%s/%s"
 935               (aref calendar-hebrew-parashiot-names (aref p 0))
 936               (aref calendar-hebrew-parashiot-names (aref p 1)))
 937     (aref calendar-hebrew-parashiot-names p)))
 938
 939 ;; Following 14 constants are used in diary-parasha (intern).
 940
 941 ;; The seven ordinary year types (keviot).
 942 (defconst calendar-hebrew-year-Saturday-incomplete-Sunday
 943   [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
 944        23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 945        43 44 45 46 47 48 49 50]
 946   "The structure of the parashiot.
 947 Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
 948 29 days), and has Passover start on Sunday.")
 949
 950 (defconst calendar-hebrew-year-Saturday-complete-Tuesday
 951   [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
 952        23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 953        43 44 45 46 47 48 49 [50 51]]
 954   "The structure of the parashiot.
 955 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
 956 have 30 days), and has Passover start on Tuesday.")
 957
 958 (defconst calendar-hebrew-year-Monday-incomplete-Tuesday
 959   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
 960       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 961       43 44 45 46 47 48 49 [50 51]]
 962   "The structure of the parashiot.
 963 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
 964 have 29 days), and has Passover start on Tuesday.")
 965
 966 (defconst calendar-hebrew-year-Monday-complete-Thursday
 967   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
 968       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
 969       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 970   "The structure of the parashiot.
 971 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
 972 30 days), and has Passover start on Thursday.")
 973
 974 (defconst calendar-hebrew-year-Tuesday-regular-Thursday
 975   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
 976       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
 977       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
 978   "The structure of the parashiot.
 979 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
 980 Kislev has 30 days), and has Passover start on Thursday.")
 981
 982 (defconst calendar-hebrew-year-Thursday-regular-Saturday
 983   [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23
 984       24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
 985       (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
 986       49 50]
 987   "The structure of the parashiot.
 988 Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
 989 Kislev has 30 days), and has Passover start on Saturday.")
 990
 991 (defconst calendar-hebrew-year-Thursday-complete-Sunday
 992   [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
 993       23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
 994       43 44 45 46 47 48 49 50]
 995   "The structure of the parashiot.
 996 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
 997 have 30 days), and has Passover start on Sunday.")
 998
 999 ;; The seven leap year types (keviot).
1000 (defconst calendar-hebrew-year-Saturday-incomplete-Tuesday
1001   [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1002        23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
1003        43 44 45 46 47 48 49 [50 51]]
1004   "The structure of the parashiot.
1005 Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
1006 have 29 days), and has Passover start on Tuesday.")
1007
1008 (defconst calendar-hebrew-year-Saturday-complete-Thursday
1009   [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1010        23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1011        (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1012   "The structure of the parashiot.
1013 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1014 have 30 days), and has Passover start on Thursday.")
1015
1016 (defconst calendar-hebrew-year-Monday-incomplete-Thursday
1017   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1018       23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1019       (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1020   "The structure of the parashiot.
1021 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1022 have 29 days), and has Passover start on Thursday.")
1023
1024 (defconst calendar-hebrew-year-Monday-complete-Saturday
1025   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1026       23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1027       (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1028       (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1029   "The structure of the parashiot.
1030 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
1031 30 days), and has Passover start on Saturday.")
1032
1033 (defconst calendar-hebrew-year-Tuesday-regular-Saturday
1034   [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1035       23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1036       (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1037       (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1038   "The structure of the parashiot.
1039 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1040 Kislev has 30 days), and has Passover start on Saturday.")
1041
1042 (defconst calendar-hebrew-year-Thursday-incomplete-Sunday
1043   [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1044       23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1045       43 44 45 46 47 48 49 50]
1046   "The structure of the parashiot.
1047 Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
1048 have 29 days), and has Passover start on Sunday.")
1049
1050 (defconst calendar-hebrew-year-Thursday-complete-Tuesday
1051   [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
1052       23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1053       43 44 45 46 47 48 49 [50 51]]
1054   "The structure of the parashiot.
1055 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
1056 have 30 days), and has Passover start on Tuesday.")
1057
1058 ;;;###diary-autoload
1059 (defun diary-hebrew-parasha (&optional mark)
1060   "Parasha diary entry--entry applies if date is a Saturday.
1061 An optional parameter MARK specifies a face or single-character string to
1062 use when highlighting the day in the calendar."
1063   (let ((d (calendar-absolute-from-gregorian date)))
1064     (if (= (% d 7) 6)                   ; Saturday
1065         (let* ((h-year (calendar-extract-year
1066                         (calendar-hebrew-from-absolute d)))
1067                (rosh-hashanah
1068                 (calendar-hebrew-to-absolute (list 7 1 h-year)))
1069                (passover
1070                 (calendar-hebrew-to-absolute (list 1 15 h-year)))
1071                (rosh-hashanah-day
1072                 (aref calendar-day-name-array (% rosh-hashanah 7)))
1073                (passover-day
1074                 (aref calendar-day-name-array (% passover 7)))
1075                (long-h (calendar-hebrew-long-heshvan-p h-year))
1076                (short-k (calendar-hebrew-short-kislev-p h-year))
1077                (type (cond ((and long-h (not short-k)) "complete")
1078                            ((and (not long-h) short-k) "incomplete")
1079                            (t "regular")))
1080                (year-format
1081                 (symbol-value
1082                  (intern (format "calendar-hebrew-year-%s-%s-%s" ; keviah
1083                                  rosh-hashanah-day type passover-day))))
1084                (first-saturday            ; of Hebrew year
1085                 (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
1086                (saturday             ; which Saturday of the Hebrew year
1087                 (/ (- d first-saturday) 7))
1088                (parasha (aref year-format saturday)))
1089           (if parasha
1090               (cons mark
1091                     (format
1092                      "Parashat %s"
1093                      (if (listp parasha) ; Israel differs from diaspora
1094                          (if (car parasha)
1095                              (format "%s (diaspora), %s (Israel)"
1096                                      (calendar-hebrew-parasha-name
1097                                       (car parasha))
1098                                      (calendar-hebrew-parasha-name
1099                                       (cdr parasha)))
1100                            (format "%s (Israel)"
1101                                    (calendar-hebrew-parasha-name
1102                                     (cdr parasha))))
1103                        (calendar-hebrew-parasha-name parasha)))))))))
1104
1105
1106 (declare-function solar-setup "solar" ())
1107 (declare-function solar-sunrise-sunset "solar" (date))
1108 (defvar calendar-latitude)
1109 (defvar calendar-longitude)
1110 (defvar calendar-time-zone)
1111
1112
1113 ;; To be called from diary-list-sexp-entries, where DATE is bound.
1114 ;;;###diary-autoload
1115 (defun diary-hebrew-sabbath-candles (&optional mark)
1116   "Local time of candle lighting diary entry--applies if date is a Friday.
1117 No diary entry if there is no sunset on that date.  Uses
1118 `diary-hebrew-sabbath-candles-minutes'.
1119
1120 An optional parameter MARK specifies a face or single-character string to
1121 use when highlighting the day in the calendar."
1122   (require 'solar)
1123   (or (and calendar-latitude calendar-longitude calendar-time-zone)
1124       (solar-setup))
1125   (if (= (% (calendar-absolute-from-gregorian date) 7) 5) ; Friday
1126       (let ((sunset (cadr (solar-sunrise-sunset date))))
1127         (if sunset
1128             (cons mark (format
1129                         "%s Sabbath candle lighting"
1130                         (apply 'solar-time-string
1131                                (cons (- (car sunset)
1132                                         (/ diary-hebrew-sabbath-candles-minutes
1133                                            60.0))
1134                                      (cdr sunset)))))))))
1135
1136
1137 (provide 'cal-hebrew)
1138
1139 ;;; cal-hebrew.el ends here