lisp/calendar/cal-hebrew.el

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