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