lisp/calendar/cal-hebrew.el

   1 ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
   2
   3 ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
   6 ;;      Edward M. Reingold <reingold@cs.uiuc.edu>
   7 ;; Keywords: calendar
   8 ;; Human-Keywords: Hebrew calendar, calendar, diary
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This collection of functions implements the features of calendar.el and
  30 ;; diary.el that deal with the Hebrew calendar.
  31
  32 ;; Technical details of all the calendrical calculations can be found in
  33 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  34 ;; Cambridge University Press (1997).
  35
  36 ;; Comments, corrections, and improvements should be sent to
  37 ;;  Edward M. Reingold               Department of Computer Science
  38 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  39 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  40 ;;                                   Urbana, Illinois 61801
  41
  42 ;;; Code:
  43
  44 (require 'calendar)
  45
  46 (defun calendar-hebrew-from-absolute (date)
  47   "Compute the Hebrew date (month day year) corresponding to absolute DATE.
  48 The absolute date is the number of days elapsed since the (imaginary)
  49 Gregorian date Sunday, December 31, 1 BC."
  50   (let* ((greg-date (calendar-gregorian-from-absolute date))
  51          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
  52                  (1- (extract-calendar-month greg-date))))
  53          (day)
  54          (year (+ 3760 (extract-calendar-year greg-date))))
  55     (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
  56         (setq year (1+ year)))
  57     (let ((length (hebrew-calendar-last-month-of-year year)))
  58       (while (> date
  59                 (calendar-absolute-from-hebrew
  60                  (list month
  61                        (hebrew-calendar-last-day-of-month month year)
  62                        year)))
  63         (setq month (1+ (% month length)))))
  64     (setq day (1+
  65                (- date (calendar-absolute-from-hebrew (list month 1 year)))))
  66     (list month day year)))
  67
  68 (defun hebrew-calendar-leap-year-p (year)
  69   "t if YEAR is a Hebrew calendar leap year."
  70   (< (% (1+ (* 7 year)) 19) 7))
  71
  72 (defun hebrew-calendar-last-month-of-year (year)
  73   "The last month of the Hebrew calendar YEAR."
  74   (if (hebrew-calendar-leap-year-p year)
  75       13
  76     12))
  77
  78 (defun hebrew-calendar-last-day-of-month (month year)
  79   "The last day of MONTH in YEAR."
  80   (if (or (memq month (list 2 4 6 10 13))
  81           (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
  82           (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
  83           (and (= month 9) (hebrew-calendar-short-kislev-p year)))
  84       29
  85     30))
  86
  87 (defun hebrew-calendar-elapsed-days (year)
  88   "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
  89   (let* ((months-elapsed
  90           (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
  91              (* 12 (% (1- year) 19))      ;; Regular months in this cycle
  92              (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
  93          (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
  94          (hours-elapsed (+ 5
  95                            (* 12 months-elapsed)
  96                            (* 793 (/ months-elapsed 1080))
  97                            (/ parts-elapsed 1080)))
  98          (parts                                  ;; Conjunction parts
  99           (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
 100          (day                                    ;; Conjunction day
 101           (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
 102          (alternative-day
 103           (if (or (>= parts 19440)    ;; If the new moon is at or after midday,
 104                   (and (= (% day 7) 2);; ...or is on a Tuesday...
 105                        (>= parts 9924)  ;;    at 9 hours, 204 parts or later...
 106                        (not (hebrew-calendar-leap-year-p year)));; of a
 107                                                                 ;; common year,
 108                   (and (= (% day 7) 1);; ...or is on a Monday...
 109                        (>= parts 16789) ;;   at 15 hours, 589 parts or later...
 110                        (hebrew-calendar-leap-year-p (1- year))));; at the end
 111                                                      ;; of a leap year
 112        ;; Then postpone Rosh HaShanah one day
 113               (1+ day)
 114        ;; Else
 115             day)))
 116     (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
 117         (memq (% alternative-day 7) (list 0 3 5))
 118   ;; Then postpone it one (more) day and return
 119         (1+ alternative-day)
 120   ;; Else return
 121       alternative-day)))
 122
 123 (defun hebrew-calendar-days-in-year (year)
 124   "Number of days in Hebrew YEAR."
 125   (- (hebrew-calendar-elapsed-days (1+ year))
 126      (hebrew-calendar-elapsed-days year)))
 127
 128 (defun hebrew-calendar-long-heshvan-p (year)
 129   "t if Heshvan is long in Hebrew YEAR."
 130   (= (% (hebrew-calendar-days-in-year year) 10) 5))
 131
 132 (defun hebrew-calendar-short-kislev-p (year)
 133   "t if Kislev is short in Hebrew YEAR."
 134   (= (% (hebrew-calendar-days-in-year year) 10) 3))
 135
 136 (defun calendar-absolute-from-hebrew (date)
 137   "Absolute date of Hebrew DATE.
 138 The absolute date is the number of days elapsed since the (imaginary)
 139 Gregorian date Sunday, December 31, 1 BC."
 140   (let* ((month (extract-calendar-month date))
 141          (day (extract-calendar-day date))
 142          (year (extract-calendar-year date)))
 143     (+ day                            ;; Days so far this month.
 144        (if (< month 7);; before Tishri
 145      ;; Then add days in prior months this year before and after Nisan
 146            (+ (calendar-sum
 147                m 7 (<= m (hebrew-calendar-last-month-of-year year))
 148                (hebrew-calendar-last-day-of-month m year))
 149               (calendar-sum
 150                m 1 (< m month)
 151                (hebrew-calendar-last-day-of-month m year)))
 152      ;; Else add days in prior months this year
 153          (calendar-sum
 154           m 7 (< m month)
 155           (hebrew-calendar-last-day-of-month m year)))
 156     (hebrew-calendar-elapsed-days year);; Days in prior years.
 157     -1373429)))                        ;; Days elapsed before absolute date 1.
 158
 159 (defvar calendar-hebrew-month-name-array-common-year
 160   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 161    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
 162
 163 (defvar calendar-hebrew-month-name-array-leap-year
 164   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 165    "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
 166
 167 (defun calendar-hebrew-date-string (&optional date)
 168   "String of Hebrew date before sunset of Gregorian DATE.
 169 Defaults to today's date if DATE is not given.
 170 Driven by the variable `calendar-date-display-form'."
 171   (let* ((hebrew-date (calendar-hebrew-from-absolute
 172                        (calendar-absolute-from-gregorian
 173                         (or date (calendar-current-date)))))
 174          (calendar-month-name-array
 175           (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
 176               calendar-hebrew-month-name-array-leap-year
 177             calendar-hebrew-month-name-array-common-year)))
 178     (calendar-date-string hebrew-date nil t)))
 179
 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
 199      ;; that 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
 205      ;; year (Adar 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
 210      ;; (so 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-goto-hebrew-date (date &optional noecho)
 220   "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t."
 221   (interactive
 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-ignore-case
 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-ignore-case
 242                                           (car x)
 243                                           (calendar-make-alist
 244                                            month-array)))))
 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))))
 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   (calendar-goto-date (calendar-gregorian-from-absolute
 262                        (calendar-absolute-from-hebrew date)))
 263   (or noecho (calendar-print-hebrew-date)))
 264
 265 (defun holiday-hebrew (month day string)
 266   "Holiday on MONTH, DAY (Hebrew) called STRING.
 267 If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
 268 Gregorian date in the form of the list (((month day year) STRING)).  Returns
 269 nil if it is not visible in the current calendar window."
 270   (if (memq displayed-month;;  This test is only to speed things up a bit;
 271             (list          ;;  it works fine without the test too.
 272              (if (< 11 month) (- month 11) (+ month 1))
 273              (if (< 10 month) (- month 10) (+ month 2))
 274              (if (<  9 month) (- month  9) (+ month 3))
 275              (if (<  8 month) (- month  8) (+ month 4))
 276              (if (<  7 month) (- month  7) (+ month 5))))
 277       (let ((m1 displayed-month)
 278             (y1 displayed-year)
 279             (m2 displayed-month)
 280             (y2 displayed-year)
 281             (year))
 282         (increment-calendar-month m1 y1 -1)
 283         (increment-calendar-month m2 y2 1)
 284         (let* ((start-date (calendar-absolute-from-gregorian
 285                             (list m1 1 y1)))
 286                (end-date (calendar-absolute-from-gregorian
 287                           (list m2 (calendar-last-day-of-month m2 y2) y2)))
 288                (hebrew-start (calendar-hebrew-from-absolute start-date))
 289                (hebrew-end (calendar-hebrew-from-absolute end-date))
 290                (hebrew-y1 (extract-calendar-year hebrew-start))
 291                (hebrew-y2 (extract-calendar-year hebrew-end)))
 292           (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
 293           (let ((date (calendar-gregorian-from-absolute
 294                        (calendar-absolute-from-hebrew
 295                         (list month day year)))))
 296             (if (calendar-date-is-visible-p date)
 297                 (list (list date string))))))))
 298
 299 (defun holiday-rosh-hashanah-etc ()
 300   "List of dates related to Rosh Hashanah, as visible in calendar window."
 301   (if (or (< displayed-month 8)
 302           (> displayed-month 11))
 303       nil;; None of the dates is visible
 304     (let* ((abs-r-h (calendar-absolute-from-hebrew
 305                       (list 7 1 (+ displayed-year 3761))))
 306             (mandatory
 307              (list
 308               (list (calendar-gregorian-from-absolute abs-r-h)
 309                     (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
 310               (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
 311                     "Yom Kippur")
 312               (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
 313                     "Sukkot")
 314               (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
 315                     "Shemini Atzeret")
 316               (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
 317                     "Simchat Torah")))
 318            (optional
 319             (list
 320              (list (calendar-gregorian-from-absolute
 321                     (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
 322                    "Selichot (night)")
 323              (list (calendar-gregorian-from-absolute (1- abs-r-h))
 324                    "Erev Rosh HaShanah")
 325              (list (calendar-gregorian-from-absolute (1+ abs-r-h))
 326                    "Rosh HaShanah (second day)")
 327              (list (calendar-gregorian-from-absolute
 328                     (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
 329                    "Tzom Gedaliah")
 330              (list (calendar-gregorian-from-absolute
 331                     (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
 332                    "Shabbat Shuvah")
 333              (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
 334                    "Erev Yom Kippur")
 335              (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
 336                    "Erev Sukkot")
 337              (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
 338                    "Sukkot (second day)")
 339              (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
 340                    "Hol Hamoed Sukkot (first day)")
 341              (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
 342                    "Hol Hamoed Sukkot (second day)")
 343              (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
 344                    "Hol Hamoed Sukkot (third day)")
 345              (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
 346                    "Hol Hamoed Sukkot (fourth day)")
 347              (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
 348                    "Hoshanah Rabbah")))
 349             (output-list
 350              (filter-visible-calendar-holidays mandatory)))
 351       (if all-hebrew-calendar-holidays
 352           (setq output-list
 353                 (append
 354                  (filter-visible-calendar-holidays optional)
 355                  output-list)))
 356       output-list)))
 357
 358 (defun holiday-hanukkah ()
 359   "List of dates related to Hanukkah, as visible in calendar window."
 360     (if (memq displayed-month;;  This test is only to speed things up a bit;
 361               '(10 11 12 1 2));; it works fine without the test too.
 362         (let ((m displayed-month)
 363               (y displayed-year))
 364           (increment-calendar-month m y 1)
 365           (let* ((h-y (extract-calendar-year
 366                          (calendar-hebrew-from-absolute
 367                           (calendar-absolute-from-gregorian
 368                            (list m (calendar-last-day-of-month m y) y)))))
 369                  (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y))))
 370             (filter-visible-calendar-holidays
 371              (list
 372               (list (calendar-gregorian-from-absolute (1- abs-h))
 373                     "Erev Hanukkah")
 374               (list (calendar-gregorian-from-absolute abs-h)
 375                     "Hanukkah (first day)")
 376               (list (calendar-gregorian-from-absolute (1+ abs-h))
 377                     "Hanukkah (second day)")
 378               (list (calendar-gregorian-from-absolute (+ abs-h 2))
 379                     "Hanukkah (third day)")
 380               (list (calendar-gregorian-from-absolute (+ abs-h 3))
 381                     "Hanukkah (fourth day)")
 382               (list (calendar-gregorian-from-absolute (+ abs-h 4))
 383                     "Hanukkah (fifth day)")
 384               (list (calendar-gregorian-from-absolute (+ abs-h 5))
 385                     "Hanukkah (sixth day)")
 386               (list (calendar-gregorian-from-absolute (+ abs-h 6))
 387                     "Hanukkah (seventh day)")
 388               (list (calendar-gregorian-from-absolute (+ abs-h 7))
 389                     "Hanukkah (eighth day)")))))))
 390
 391 (defun holiday-passover-etc ()
 392   "List of dates related to Passover, as visible in calendar window."
 393  (if (< 7 displayed-month)
 394       nil;; None of the dates is visible
 395     (let* ((abs-p (calendar-absolute-from-hebrew
 396                       (list 1 15 (+ displayed-year 3760))))
 397            (mandatory
 398             (list
 399              (list (calendar-gregorian-from-absolute abs-p)
 400                    "Passover")
 401              (list (calendar-gregorian-from-absolute (+ abs-p 50))
 402                    "Shavuot")))
 403            (optional
 404             (list
 405              (list (calendar-gregorian-from-absolute
 406                     (calendar-dayname-on-or-before 6 (- abs-p 43)))
 407                    "Shabbat Shekalim")
 408              (list (calendar-gregorian-from-absolute
 409                     (calendar-dayname-on-or-before 6 (- abs-p 30)))
 410                    "Shabbat Zachor")
 411              (list (calendar-gregorian-from-absolute
 412                     (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
 413                    "Fast of Esther")
 414              (list (calendar-gregorian-from-absolute (- abs-p 31))
 415                    "Erev Purim")
 416              (list (calendar-gregorian-from-absolute (- abs-p 30))
 417                    "Purim")
 418              (list (calendar-gregorian-from-absolute
 419                     (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
 420                    "Shushan Purim")
 421              (list (calendar-gregorian-from-absolute
 422                     (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
 423                    "Shabbat Parah")
 424              (list (calendar-gregorian-from-absolute
 425                     (calendar-dayname-on-or-before 6 (- abs-p 14)))
 426                    "Shabbat HaHodesh")
 427              (list (calendar-gregorian-from-absolute
 428                     (calendar-dayname-on-or-before 6 (1- abs-p)))
 429                    "Shabbat HaGadol")
 430              (list (calendar-gregorian-from-absolute (1- abs-p))
 431                    "Erev Passover")
 432              (list (calendar-gregorian-from-absolute (1+ abs-p))
 433                    "Passover (second day)")
 434              (list (calendar-gregorian-from-absolute (+ abs-p 2))
 435                    "Hol Hamoed Passover (first day)")
 436              (list (calendar-gregorian-from-absolute (+ abs-p 3))
 437                    "Hol Hamoed Passover (second day)")
 438              (list (calendar-gregorian-from-absolute (+ abs-p 4))
 439                    "Hol Hamoed Passover (third day)")
 440              (list (calendar-gregorian-from-absolute (+ abs-p 5))
 441                    "Hol Hamoed Passover (fourth day)")
 442              (list (calendar-gregorian-from-absolute (+ abs-p 6))
 443                    "Passover (seventh day)")
 444              (list (calendar-gregorian-from-absolute (+ abs-p 7))
 445                    "Passover (eighth day)")
 446              (list (calendar-gregorian-from-absolute
 447                     (if (zerop (% (+ abs-p 12) 7))
 448                         (+ abs-p 13)
 449                       (+ abs-p 12)))
 450                    "Yom HaShoah")
 451              (list (calendar-gregorian-from-absolute
 452                     (if (zerop (% abs-p 7))
 453                         (+ abs-p 18)
 454                       (if (= (% abs-p 7) 6)
 455                           (+ abs-p 19)
 456                         (+ abs-p 20))))
 457                    "Yom HaAtzma'ut")
 458              (list (calendar-gregorian-from-absolute (+ abs-p 33))
 459                    "Lag BaOmer")
 460              (list (calendar-gregorian-from-absolute (+ abs-p 43))
 461                    "Yom Yerushalaim")
 462              (list (calendar-gregorian-from-absolute (+ abs-p 49))
 463                    "Erev Shavuot")
 464              (list (calendar-gregorian-from-absolute (+ abs-p 51))
 465                    "Shavuot (second day)")))
 466            (output-list
 467              (filter-visible-calendar-holidays mandatory)))
 468       (if all-hebrew-calendar-holidays
 469           (setq output-list
 470                 (append
 471                  (filter-visible-calendar-holidays optional)
 472                  output-list)))
 473       output-list)))
 474
 475 (defun holiday-tisha-b-av-etc ()
 476   "List of dates around Tisha B'Av, as visible in calendar window."
 477   (if (or (< displayed-month 5)
 478           (> displayed-month 9))
 479       nil;; None of the dates is visible
 480     (let* ((abs-t-a (calendar-absolute-from-hebrew
 481                       (list 5 9 (+ displayed-year 3760)))))
 482
 483       (filter-visible-calendar-holidays
 484        (list
 485         (list (calendar-gregorian-from-absolute
 486                (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
 487               "Tzom Tammuz")
 488         (list (calendar-gregorian-from-absolute
 489                (calendar-dayname-on-or-before 6 abs-t-a))
 490               "Shabbat Hazon")
 491         (list (calendar-gregorian-from-absolute
 492                (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
 493               "Tisha B'Av")
 494         (list (calendar-gregorian-from-absolute
 495                (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
 496               "Shabbat Nahamu"))))))
 497
 498 (defun list-hebrew-diary-entries ()
 499   "Add any Hebrew date entries from the diary file to `diary-entries-list'.
 500 Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol'
 501 \(normally an `H').  The same diary date forms govern the style of the Hebrew
 502 calendar entries, except that the Hebrew month names must be spelled in full.
 503 The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
 504 Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
 505 common Hebrew year.  If a Hebrew date diary entry begins with a
 506 `diary-nonmarking-symbol', the entry will appear in the diary listing, but will
 507 not be marked in the calendar.  This function is provided for use with the
 508 `nongregorian-diary-listing-hook'."
 509   (if (< 0 number)
 510       (let ((buffer-read-only nil)
 511             (diary-modified (buffer-modified-p))
 512             (gdate original-date)
 513             (mark (regexp-quote diary-nonmarking-symbol)))
 514         (calendar-for-loop i from 1 to number do
 515            (let* ((d diary-date-forms)
 516                   (hdate (calendar-hebrew-from-absolute
 517                           (calendar-absolute-from-gregorian gdate)))
 518                   (month (extract-calendar-month hdate))
 519                   (day (extract-calendar-day hdate))
 520                   (year (extract-calendar-year hdate)))
 521              (while d
 522                (let*
 523                    ((date-form (if (equal (car (car d)) 'backup)
 524                                    (cdr (car d))
 525                                  (car d)))
 526                     (backup (equal (car (car d)) 'backup))
 527                     (dayname
 528                      (concat
 529                       (calendar-day-name gdate) "\\|"
 530                       (substring (calendar-day-name gdate) 0 3) ".?"))
 531                     (calendar-month-name-array
 532                      calendar-hebrew-month-name-array-leap-year)
 533                     (monthname
 534                      (concat
 535                       "\\*\\|"
 536                       (calendar-month-name month)))
 537                     (month (concat "\\*\\|0*" (int-to-string month)))
 538                     (day (concat "\\*\\|0*" (int-to-string day)))
 539                     (year
 540                      (concat
 541                       "\\*\\|0*" (int-to-string year)
 542                       (if abbreviated-calendar-year
 543                           (concat "\\|" (int-to-string (% year 100)))
 544                         "")))
 545                     (regexp
 546                      (concat
 547                       "\\(\\`\\|\^M\\|\n\\)" mark "?"
 548                       (regexp-quote hebrew-diary-entry-symbol)
 549                       "\\("
 550                       (mapconcat 'eval date-form "\\)\\(")
 551                       "\\)"))
 552                     (case-fold-search t))
 553                  (goto-char (point-min))
 554                  (while (re-search-forward regexp nil t)
 555                    (if backup (re-search-backward "\\<" nil t))
 556                    (if (and (or (char-equal (preceding-char) ?\^M)
 557                                 (char-equal (preceding-char) ?\n))
 558                             (not (looking-at " \\|\^I")))
 559                        ;;  Diary entry that consists only of date.
 560                        (backward-char 1)
 561                      ;;  Found a nonempty diary entry--make it visible and
 562                      ;;  add it to the list.
 563                      (let ((entry-start (point))
 564                            (date-start))
 565                        (re-search-backward "\^M\\|\n\\|\\`")
 566                        (setq date-start (point))
 567                        (re-search-forward "\^M\\|\n" nil t 2)
 568                        (while (looking-at " \\|\^I")
 569                          (re-search-forward "\^M\\|\n" nil t))
 570                        (backward-char 1)
 571                        (subst-char-in-region date-start (point) ?\^M ?\n t)
 572                        (add-to-diary-list
 573                         gdate
 574                         (buffer-substring-no-properties entry-start (point))
 575                         (buffer-substring-no-properties
 576                          (1+ date-start) (1- entry-start)))))))
 577                (setq d (cdr d))))
 578            (setq gdate
 579                  (calendar-gregorian-from-absolute
 580                   (1+ (calendar-absolute-from-gregorian gdate)))))
 581            (set-buffer-modified-p diary-modified))
 582         (goto-char (point-min))))
 583
 584 (defun mark-hebrew-diary-entries ()
 585   "Mark days in the calendar window that have Hebrew date diary entries.
 586 Each entry in diary-file (or included files) visible in the calendar window
 587 is marked.  Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
 588 \(normally an `H').  The same diary-date-forms govern the style of the Hebrew
 589 calendar entries, except that the Hebrew month names must be spelled in full.
 590 The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
 591 Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
 592 common Hebrew year.  Hebrew date diary entries that begin with a
 593 diary-nonmarking symbol will not be marked in the calendar.  This function
 594 is provided for use as part of the nongregorian-diary-marking-hook."
 595   (let ((d diary-date-forms))
 596     (while d
 597       (let*
 598           ((date-form (if (equal (car (car d)) 'backup)
 599                           (cdr (car d))
 600                         (car d)));; ignore 'backup directive
 601            (dayname (diary-name-pattern calendar-day-name-array))
 602            (monthname
 603             (concat
 604              (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
 605              "\\|\\*"))
 606            (month "[0-9]+\\|\\*")
 607            (day "[0-9]+\\|\\*")
 608            (year "[0-9]+\\|\\*")
 609            (l (length date-form))
 610            (d-name-pos (- l (length (memq 'dayname date-form))))
 611            (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
 612            (m-name-pos (- l (length (memq 'monthname date-form))))
 613            (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
 614            (d-pos (- l (length (memq 'day date-form))))
 615            (d-pos (if (/= l d-pos) (+ 2 d-pos)))
 616            (m-pos (- l (length (memq 'month date-form))))
 617            (m-pos (if (/= l m-pos) (+ 2 m-pos)))
 618            (y-pos (- l (length (memq 'year date-form))))
 619            (y-pos (if (/= l y-pos) (+ 2 y-pos)))
 620            (regexp
 621             (concat
 622              "\\(\\`\\|\^M\\|\n\\)"
 623              (regexp-quote hebrew-diary-entry-symbol)
 624              "\\("
 625              (mapconcat 'eval date-form "\\)\\(")
 626              "\\)"))
 627            (case-fold-search t))
 628         (goto-char (point-min))
 629         (while (re-search-forward regexp nil t)
 630           (let* ((dd-name
 631                   (if d-name-pos
 632                       (buffer-substring
 633                        (match-beginning d-name-pos)
 634                        (match-end d-name-pos))))
 635                  (mm-name
 636                   (if m-name-pos
 637                       (buffer-substring
 638                        (match-beginning m-name-pos)
 639                        (match-end m-name-pos))))
 640                  (mm (string-to-int
 641                       (if m-pos
 642                           (buffer-substring
 643                            (match-beginning m-pos)
 644                            (match-end m-pos))
 645                         "")))
 646                  (dd (string-to-int
 647                       (if d-pos
 648                           (buffer-substring
 649                            (match-beginning d-pos)
 650                            (match-end d-pos))
 651                         "")))
 652                  (y-str (if y-pos
 653                             (buffer-substring
 654                              (match-beginning y-pos)
 655                              (match-end y-pos))))
 656                  (yy (if (not y-str)
 657                          0
 658                        (if (and (= (length y-str) 2)
 659                                 abbreviated-calendar-year)
 660                            (let* ((current-y
 661                                    (extract-calendar-year
 662                                     (calendar-hebrew-from-absolute
 663                                      (calendar-absolute-from-gregorian
 664                                       (calendar-current-date)))))
 665                                   (y (+ (string-to-int y-str)
 666                                         (* 100 (/ current-y 100)))))
 667                              (if (> (- y current-y) 50)
 668                                  (- y 100)
 669                                (if (> (- current-y y) 50)
 670                                    (+ y 100)
 671                                  y)))
 672                          (string-to-int y-str)))))
 673             (if dd-name
 674                 (mark-calendar-days-named
 675                  (cdr (assoc-ignore-case
 676                        (substring dd-name 0 3)
 677                        (calendar-make-alist
 678                         calendar-day-name-array
 679                         0
 680                         '(lambda (x) (substring x 0 3))))))
 681               (if mm-name
 682                   (if (string-equal mm-name "*")
 683                       (setq mm 0)
 684                     (setq
 685                       mm
 686                       (cdr
 687                         (assoc-ignore-case
 688                          mm-name
 689                          (calendar-make-alist
 690                           calendar-hebrew-month-name-array-leap-year))))))
 691               (mark-hebrew-calendar-date-pattern mm dd yy)))))
 692       (setq d (cdr d)))))
 693
 694 (defun mark-hebrew-calendar-date-pattern (month day year)
 695   "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
 696 A value of 0 in any position is a wildcard."
 697   (save-excursion
 698     (set-buffer calendar-buffer)
 699     (if (and (/= 0 month) (/= 0 day))
 700         (if (/= 0 year)
 701             ;; Fully specified Hebrew date.
 702             (let ((date (calendar-gregorian-from-absolute
 703                          (calendar-absolute-from-hebrew
 704                           (list month day year)))))
 705               (if (calendar-date-is-visible-p date)
 706                   (mark-visible-calendar-date date)))
 707           ;; Month and day in any year--this taken from the holiday stuff.
 708           (if (memq displayed-month;;  This test is only to speed things up a
 709                     (list          ;;  bit; it works fine without the test too.
 710                      (if (< 11 month) (- month 11) (+ month 1))
 711                      (if (< 10 month) (- month 10) (+ month 2))
 712                      (if (<  9 month) (- month  9) (+ month 3))
 713                      (if (<  8 month) (- month  8) (+ month 4))
 714                      (if (<  7 month) (- month  7) (+ month 5))))
 715               (let ((m1 displayed-month)
 716                     (y1 displayed-year)
 717                     (m2 displayed-month)
 718                     (y2 displayed-year)
 719                     (year))
 720                 (increment-calendar-month m1 y1 -1)
 721                 (increment-calendar-month m2 y2 1)
 722                 (let* ((start-date (calendar-absolute-from-gregorian
 723                                     (list m1 1 y1)))
 724                        (end-date (calendar-absolute-from-gregorian
 725                                   (list m2
 726                                         (calendar-last-day-of-month m2 y2)
 727                                         y2)))
 728                        (hebrew-start
 729                         (calendar-hebrew-from-absolute start-date))
 730                        (hebrew-end (calendar-hebrew-from-absolute end-date))
 731                        (hebrew-y1 (extract-calendar-year hebrew-start))
 732                        (hebrew-y2 (extract-calendar-year hebrew-end)))
 733                   (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
 734                   (let ((date (calendar-gregorian-from-absolute
 735                                (calendar-absolute-from-hebrew
 736                                 (list month day year)))))
 737                     (if (calendar-date-is-visible-p date)
 738                         (mark-visible-calendar-date date)))))))
 739       ;; Not one of the simple cases--check all visible dates for match.
 740       ;; Actually, the following code takes care of ALL of the cases, but
 741       ;; it's much too slow to be used for the simple (common) cases.
 742       (let ((m displayed-month)
 743             (y displayed-year)
 744             (first-date)
 745             (last-date))
 746         (increment-calendar-month m y -1)
 747         (setq first-date
 748               (calendar-absolute-from-gregorian
 749                (list m 1 y)))
 750         (increment-calendar-month m y 2)
 751         (setq last-date
 752               (calendar-absolute-from-gregorian
 753                (list m (calendar-last-day-of-month m y) y)))
 754         (calendar-for-loop date from first-date to last-date do
 755           (let* ((h-date (calendar-hebrew-from-absolute date))
 756                  (h-month (extract-calendar-month h-date))
 757                  (h-day (extract-calendar-day h-date))
 758                  (h-year (extract-calendar-year h-date)))
 759             (and (or (zerop month)
 760                      (= month h-month))
 761                  (or (zerop day)
 762                      (= day h-day))
 763                  (or (zerop year)
 764                      (= year h-year))
 765                  (mark-visible-calendar-date
 766                   (calendar-gregorian-from-absolute date)))))))))
 767
 768 (defun insert-hebrew-diary-entry (arg)
 769   "Insert a diary entry.
 770 For the Hebrew date corresponding to the date indicated by point.
 771 Prefix arg will make the entry nonmarking."
 772   (interactive "P")
 773   (let* ((calendar-month-name-array
 774           calendar-hebrew-month-name-array-leap-year))
 775     (make-diary-entry
 776      (concat
 777       hebrew-diary-entry-symbol
 778       (calendar-date-string
 779        (calendar-hebrew-from-absolute
 780         (calendar-absolute-from-gregorian
 781          (calendar-cursor-to-date t)))
 782        nil t))
 783      arg)))
 784
 785 (defun insert-monthly-hebrew-diary-entry (arg)
 786   "Insert a monthly diary entry.
 787 For the day of the Hebrew month corresponding to the date indicated by point.
 788 Prefix arg will make the entry nonmarking."
 789   (interactive "P")
 790   (let* ((calendar-date-display-form
 791           (if european-calendar-style '(day " * ") '("* " day )))
 792          (calendar-month-name-array
 793           calendar-hebrew-month-name-array-leap-year))
 794     (make-diary-entry
 795      (concat
 796       hebrew-diary-entry-symbol
 797       (calendar-date-string
 798        (calendar-hebrew-from-absolute
 799         (calendar-absolute-from-gregorian
 800          (calendar-cursor-to-date t)))))
 801      arg)))
 802
 803 (defun insert-yearly-hebrew-diary-entry (arg)
 804   "Insert an annual diary entry.
 805 For the day of the Hebrew year corresponding to the date indicated by point.
 806 Prefix arg will make the entry nonmarking."
 807   (interactive "P")
 808   (let* ((calendar-date-display-form
 809           (if european-calendar-style
 810               '(day " " monthname)
 811             '(monthname " " day)))
 812          (calendar-month-name-array
 813           calendar-hebrew-month-name-array-leap-year))
 814     (make-diary-entry
 815      (concat
 816       hebrew-diary-entry-symbol
 817       (calendar-date-string
 818        (calendar-hebrew-from-absolute
 819         (calendar-absolute-from-gregorian
 820          (calendar-cursor-to-date t)))))
 821      arg)))
 822
 823 ;;;###autoload
 824 (defun list-yahrzeit-dates (death-date start-year end-year)
 825   "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
 826 When called interactively from the calendar window, the date of death is taken
 827 from the cursor position."
 828   (interactive
 829    (let* ((death-date
 830            (if (equal (current-buffer) (get-buffer calendar-buffer))
 831                (calendar-cursor-to-date)
 832              (let* ((today (calendar-current-date))
 833                     (year (calendar-read
 834                            "Year of death (>0): "
 835                            '(lambda (x) (> x 0))
 836                            (int-to-string (extract-calendar-year today))))
 837                     (month-array calendar-month-name-array)
 838                     (completion-ignore-case t)
 839                     (month (cdr (assoc-ignore-case
 840                                  (completing-read
 841                                   "Month of death (name): "
 842                                   (mapcar 'list (append month-array nil))
 843                                   nil t)
 844                                  (calendar-make-alist month-array 1))))
 845                     (last (calendar-last-day-of-month month year))
 846                     (day (calendar-read
 847                           (format "Day of death (1-%d): " last)
 848                           '(lambda (x) (and (< 0 x) (<= x last))))))
 849                (list month day year))))
 850           (death-year (extract-calendar-year death-date))
 851           (start-year (calendar-read
 852                        (format "Starting year of Yahrzeit table (>%d): "
 853                                death-year)
 854                        '(lambda (x) (> x death-year))
 855                        (int-to-string (1+ death-year))))
 856           (end-year (calendar-read
 857                      (format "Ending year of Yahrzeit table (>=%d): "
 858                              start-year)
 859                        '(lambda (x) (>= x start-year)))))
 860    (list death-date start-year end-year)))
 861   (message "Computing yahrzeits...")
 862   (let* ((yahrzeit-buffer "*Yahrzeits*")
 863          (h-date (calendar-hebrew-from-absolute
 864                   (calendar-absolute-from-gregorian death-date)))
 865          (h-month (extract-calendar-month h-date))
 866          (h-day (extract-calendar-day h-date))
 867          (h-year (extract-calendar-year h-date)))
 868     (set-buffer (get-buffer-create yahrzeit-buffer))
 869     (setq buffer-read-only nil)
 870     (calendar-set-mode-line
 871      (format "Yahrzeit dates for %s = %s"
 872              (calendar-date-string death-date)
 873              (let ((calendar-month-name-array
 874                     (if (hebrew-calendar-leap-year-p h-year)
 875                         calendar-hebrew-month-name-array-leap-year
 876                       calendar-hebrew-month-name-array-common-year)))
 877                (calendar-date-string h-date nil t))))
 878     (erase-buffer)
 879     (goto-char (point-min))
 880     (calendar-for-loop i from start-year to end-year do
 881         (insert
 882          (calendar-date-string
 883           (calendar-gregorian-from-absolute
 884            (hebrew-calendar-yahrzeit
 885             h-date
 886             (extract-calendar-year
 887              (calendar-hebrew-from-absolute
 888               (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))
 889     (goto-char (point-min))
 890     (set-buffer-modified-p nil)
 891     (setq buffer-read-only t)
 892     (display-buffer yahrzeit-buffer)
 893     (message "Computing yahrzeits...done")))
 894
 895 (defun diary-hebrew-date ()
 896   "Hebrew calendar equivalent of date diary entry."
 897   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 898
 899 (defun diary-omer ()
 900   "Omer count diary entry.
 901 Entry applies if date is within 50 days after Passover."
 902   (let* ((passover
 903           (calendar-absolute-from-hebrew
 904            (list 1 15 (+ (extract-calendar-year date) 3760))))
 905          (omer (- (calendar-absolute-from-gregorian date) passover))
 906          (week (/ omer 7))
 907          (day (% omer 7)))
 908     (if (and (> omer 0) (< omer 50))
 909         (format "Day %d%s of the omer (until sunset)"
 910                 omer
 911                 (if (zerop week)
 912                     ""
 913                   (format ", that is, %d week%s%s"
 914                           week
 915                           (if (= week 1) "" "s")
 916                           (if (zerop day)
 917                               ""
 918                             (format " and %d day%s"
 919                                     day (if (= day 1) "" "s")))))))))
 920
 921 (defun diary-yahrzeit (death-month death-day death-year)
 922   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
 923 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 924 to be the name of the person.  Date of death is on the *civil* calendar;
 925 although the date of death is specified by the civil calendar, the proper
 926 Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
 927 order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
 928   (let* ((h-date (calendar-hebrew-from-absolute
 929                   (calendar-absolute-from-gregorian
 930                    (if european-calendar-style
 931                        (list death-day death-month death-year)
 932                    (list death-month death-day death-year)))))
 933          (h-month (extract-calendar-month h-date))
 934          (h-day (extract-calendar-day h-date))
 935          (h-year (extract-calendar-year h-date))
 936          (d (calendar-absolute-from-gregorian date))
 937          (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
 938          (diff (- yr h-year))
 939          (y (hebrew-calendar-yahrzeit h-date yr)))
 940     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
 941         (format "Yahrzeit of %s%s: %d%s anniversary"
 942                 entry
 943                 (if (= y d) "" " (evening)")
 944                 diff
 945                 (cond ((= (% diff 10) 1) "st")
 946                       ((= (% diff 10) 2) "nd")
 947                       ((= (% diff 10) 3) "rd")
 948                       (t "th"))))))
 949
 950 (defun diary-rosh-hodesh ()
 951   "Rosh Hodesh diary entry.
 952 Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
 953   (let* ((d (calendar-absolute-from-gregorian date))
 954          (h-date (calendar-hebrew-from-absolute d))
 955          (h-month (extract-calendar-month h-date))
 956          (h-day (extract-calendar-day h-date))
 957          (h-year (extract-calendar-year h-date))
 958          (leap-year (hebrew-calendar-leap-year-p h-year))
 959          (last-day (hebrew-calendar-last-day-of-month h-month h-year))
 960          (h-month-names
 961           (if leap-year
 962               calendar-hebrew-month-name-array-leap-year
 963             calendar-hebrew-month-name-array-common-year))
 964          (this-month (aref h-month-names (1- h-month)))
 965          (h-yesterday (extract-calendar-day
 966                        (calendar-hebrew-from-absolute (1- d)))))
 967     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
 968         (format
 969          "Rosh Hodesh %s"
 970          (if (= h-day 30)
 971              (format
 972               "%s (first day)"
 973               ;; next month must be in the same year since this
 974               ;; month can't be the last month of the year since
 975               ;; it has 30 days
 976               (aref h-month-names h-month))
 977            (if (= h-yesterday 30)
 978                (format "%s (second day)" this-month)
 979              this-month)))
 980       (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarchim
 981           (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
 982                  (format "Mevarchim Rosh Hodesh %s (%s)"
 983                          (aref h-month-names
 984                                (if (= h-month
 985                                       (hebrew-calendar-last-month-of-year
 986                                        h-year))
 987                                    0 h-month))
 988                          (aref calendar-day-name-array (- 29 h-day))))
 989                 ((and (< h-day 30) (> h-day 22) (= 30 last-day))
 990                  (format "Mevarchim Rosh Hodesh %s (%s-%s)"
 991                          (aref h-month-names h-month)
 992                          (if (= h-day 29)
 993                              "tomorrow"
 994                            (aref calendar-day-name-array (- 29 h-day)))
 995                          (aref calendar-day-name-array
 996                                (% (- 30 h-day) 7)))))
 997         (if (and (= h-day 29) (/= h-month 6))
 998             (format "Erev Rosh Hodesh %s"
 999                     (aref h-month-names
1000                           (if (= h-month
1001                                  (hebrew-calendar-last-month-of-year
1002                                   h-year))
1003                               0 h-month))))))))
1004
1005 (defun diary-parasha ()
1006   "Parasha diary entry--entry applies if date is a Saturday."
1007   (let ((d (calendar-absolute-from-gregorian date)))
1008     (if (= (% d 7) 6);;  Saturday
1009         (let*
1010             ((h-year (extract-calendar-year
1011                       (calendar-hebrew-from-absolute d)))
1012              (rosh-hashanah
1013               (calendar-absolute-from-hebrew (list 7 1 h-year)))
1014              (passover
1015               (calendar-absolute-from-hebrew (list 1 15 h-year)))
1016              (rosh-hashanah-day
1017               (aref calendar-day-name-array (% rosh-hashanah 7)))
1018              (passover-day
1019               (aref calendar-day-name-array (% passover 7)))
1020              (long-h (hebrew-calendar-long-heshvan-p h-year))
1021              (short-k (hebrew-calendar-short-kislev-p h-year))
1022              (type (cond ((and long-h (not short-k)) "complete")
1023                          ((and (not long-h) short-k) "incomplete")
1024                          (t "regular")))
1025              (year-format
1026               (symbol-value
1027                (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
1028                                rosh-hashanah-day type passover-day))))
1029              (first-saturday;; of Hebrew year
1030               (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
1031              (saturday;; which Saturday of the Hebrew year
1032               (/ (- d first-saturday) 7))
1033              (parasha (aref year-format saturday)))
1034           (if parasha
1035               (format
1036                "Parashat %s"
1037                (if (listp parasha);; Israel differs from diaspora
1038                    (if (car parasha)
1039                        (format "%s (diaspora), %s (Israel)"
1040                                (hebrew-calendar-parasha-name (car parasha))
1041                                (hebrew-calendar-parasha-name (cdr parasha)))
1042                      (format "%s (Israel)"
1043                              (hebrew-calendar-parasha-name (cdr parasha))))
1044                  (hebrew-calendar-parasha-name parasha))))))))
1045
1046 (defvar hebrew-calendar-parashiot-names
1047 ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
1048  "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
1049  "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
1050  "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
1051  "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
1052  "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
1053  "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
1054  "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
1055  "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
1056   "The names of the parashiot in the Torah.")
1057
1058 ;; The seven ordinary year types (keviot)
1059
1060 (defconst hebrew-calendar-year-Saturday-incomplete-Sunday
1061   [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]
1062     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1063     43 44 45 46 47 48 49 50]
1064   "The structure of the parashiot.
1065 Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
1066 29 days), and has Passover start on Sunday.")
1067
1068 (defconst hebrew-calendar-year-Saturday-complete-Tuesday
1069   [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]
1070     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1071     43 44 45 46 47 48 49 [50 51]]
1072   "The structure of the parashiot.
1073 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1074 have 30 days), and has Passover start on Tuesday.")
1075
1076 (defconst hebrew-calendar-year-Monday-incomplete-Tuesday
1077   [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]
1078     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1079     43 44 45 46 47 48 49 [50 51]]
1080   "The structure of the parashiot.
1081 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1082 have 29 days), and has Passover start on Tuesday.")
1083
1084 (defconst hebrew-calendar-year-Monday-complete-Thursday
1085   [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]
1086    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1087    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1088   "The structure of the parashiot.
1089 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
1090 30 days), and has Passover start on Thursday.")
1091
1092 (defconst hebrew-calendar-year-Tuesday-regular-Thursday
1093   [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]
1094    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1095    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1096   "The structure of the parashiot.
1097 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1098 Kislev has 30 days), and has Passover start on Thursday.")
1099
1100 (defconst hebrew-calendar-year-Thursday-regular-Saturday
1101   [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
1102    24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
1103    (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
1104    49 50]
1105   "The structure of the parashiot.
1106 Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
1107 Kislev has 30 days), and has Passover start on Saturday.")
1108
1109 (defconst hebrew-calendar-year-Thursday-complete-Sunday
1110   [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
1111     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1112     43 44 45 46 47 48 49 50]
1113   "The structure of the parashiot.
1114 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
1115 have 30 days), and has Passover start on Sunday.")
1116
1117 ;; The seven leap year types (keviot)
1118
1119 (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
1120   [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
1121     23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
1122     43 44 45 46 47 48 49 [50 51]]
1123   "The structure of the parashiot.
1124 Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
1125 have 29 days), and has Passover start on Tuesday.")
1126
1127 (defconst hebrew-calendar-year-Saturday-complete-Thursday
1128   [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
1129    23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1130    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1131   "The structure of the parashiot.
1132 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1133 have 30 days), and has Passover start on Thursday.")
1134
1135 (defconst hebrew-calendar-year-Monday-incomplete-Thursday
1136   [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
1137    23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1138    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1139   "The structure of the parashiot.
1140 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1141 have 29 days), and has Passover start on Thursday.")
1142
1143 (defconst hebrew-calendar-year-Monday-complete-Saturday
1144   [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
1145    23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1146    (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1147    (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1148   "The structure of the parashiot.
1149 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
1150 30 days), and has Passover start on Saturday.")
1151
1152 (defconst hebrew-calendar-year-Tuesday-regular-Saturday
1153   [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
1154    23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1155    (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1156    (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1157   "The structure of the parashiot.
1158 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1159 Kislev has 30 days), and has Passover start on Saturday.")
1160
1161 (defconst hebrew-calendar-year-Thursday-incomplete-Sunday
1162   [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
1163     23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1164     43 44 45 46 47 48 49 50]
1165   "The structure of the parashiot.
1166 Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
1167 have 29 days), and has Passover start on Sunday.")
1168
1169 (defconst hebrew-calendar-year-Thursday-complete-Tuesday
1170   [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
1171     23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1172     43 44 45 46 47 48 49 [50 51]]
1173   "The structure of the parashiot.
1174 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
1175 have 30 days), and has Passover start on Tuesday.")
1176
1177 (defun hebrew-calendar-parasha-name (p)
1178   "Name(s) corresponding to parasha P."
1179   (if (arrayp p);; combined parasha
1180       (format "%s/%s"
1181               (aref hebrew-calendar-parashiot-names (aref p 0))
1182               (aref hebrew-calendar-parashiot-names (aref p 1)))
1183     (aref hebrew-calendar-parashiot-names p)))
1184
1185 (provide 'cal-hebrew)
1186
1187 ;;; cal-hebrew.el ends here