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 (&optional mark)
 900   "Omer count diary entry.
 901 Entry applies if date is within 50 days after Passover.
 902
 903 An optional parameter MARK specifies a face or single-character string to
 904 use when highlighting the day in the calendar."
 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         (cons mark
 913               (format "Day %d%s of the omer (until sunset)"
 914                       omer
 915                       (if (zerop week)
 916                           ""
 917                         (format ", that is, %d week%s%s"
 918                                 week
 919                                 (if (= week 1) "" "s")
 920                                 (if (zerop day)
 921                                     ""
 922                                   (format " and %d day%s"
 923                                           day (if (= day 1) "" "s"))))))))))
 924
 925 (defun diary-yahrzeit (death-month death-day death-year &optional mark)
 926   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
 927 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 928 to be the name of the person.  Date of death is on the *civil* calendar;
 929 although the date of death is specified by the civil calendar, the proper
 930 Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
 931 order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.
 932
 933 An optional parameter MARK specifies a face or single-character string to
 934 use when highlighting the day in the calendar."
 935   (let* ((h-date (calendar-hebrew-from-absolute
 936                   (calendar-absolute-from-gregorian
 937                    (if european-calendar-style
 938                        (list death-day death-month death-year)
 939                      (list death-month death-day death-year)))))
 940          (h-month (extract-calendar-month h-date))
 941          (h-day (extract-calendar-day h-date))
 942          (h-year (extract-calendar-year h-date))
 943          (d (calendar-absolute-from-gregorian date))
 944          (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
 945          (diff (- yr h-year))
 946          (y (hebrew-calendar-yahrzeit h-date yr)))
 947     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
 948         (cons mark
 949               (format "Yahrzeit of %s%s: %d%s anniversary"
 950                       entry
 951                       (if (= y d) "" " (evening)")
 952                       diff
 953                       (cond ((= (% diff 10) 1) "st")
 954                             ((= (% diff 10) 2) "nd")
 955                             ((= (% diff 10) 3) "rd")
 956                             (t "th")))))))
 957
 958 (defun diary-rosh-hodesh (&optional mark)
 959   "Rosh Hodesh diary entry.
 960 Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
 961
 962 An optional parameter MARK specifies a face or single-character string to
 963 use when highlighting the day in the calendar."
 964   (let* ((d (calendar-absolute-from-gregorian date))
 965          (h-date (calendar-hebrew-from-absolute d))
 966          (h-month (extract-calendar-month h-date))
 967          (h-day (extract-calendar-day h-date))
 968          (h-year (extract-calendar-year h-date))
 969          (leap-year (hebrew-calendar-leap-year-p h-year))
 970          (last-day (hebrew-calendar-last-day-of-month h-month h-year))
 971          (h-month-names
 972           (if leap-year
 973               calendar-hebrew-month-name-array-leap-year
 974             calendar-hebrew-month-name-array-common-year))
 975          (this-month (aref h-month-names (1- h-month)))
 976          (h-yesterday (extract-calendar-day
 977                        (calendar-hebrew-from-absolute (1- d)))))
 978     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
 979         (cons mark
 980               (format
 981                "Rosh Hodesh %s"
 982                (if (= h-day 30)
 983                    (format
 984                     "%s (first day)"
 985                     ;; next month must be in the same year since this
 986                     ;; month can't be the last month of the year since
 987                     ;; it has 30 days
 988                     (aref h-month-names h-month))
 989                  (if (= h-yesterday 30)
 990                      (format "%s (second day)" this-month)
 991                    this-month))))
 992       (if (= (% d 7) 6) ;; Saturday--check for Shabbat Mevarchim
 993           (cons mark
 994                 (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
 995                        (format "Mevarchim Rosh Hodesh %s (%s)"
 996                                (aref h-month-names
 997                                      (if (= h-month
 998                                             (hebrew-calendar-last-month-of-year
 999                                              h-year))
1000                                          0 h-month))
1001                                (aref calendar-day-name-array (- 29 h-day))))
1002                       ((and (< h-day 30) (> h-day 22) (= 30 last-day))
1003                        (format "Mevarchim Rosh Hodesh %s (%s-%s)"
1004                                (aref h-month-names h-month)
1005                                (if (= h-day 29)
1006                                    "tomorrow"
1007                                  (aref calendar-day-name-array (- 29 h-day)))
1008                                (aref calendar-day-name-array
1009                                      (% (- 30 h-day) 7))))))
1010         (if (and (= h-day 29) (/= h-month 6))
1011             (cons mark
1012                   (format "Erev Rosh Hodesh %s"
1013                           (aref h-month-names
1014                                 (if (= h-month
1015                                        (hebrew-calendar-last-month-of-year
1016                                         h-year))
1017                                     0 h-month)))))))))
1018
1019 (defun diary-parasha (&optional mark)
1020   "Parasha diary entry--entry applies if date is a Saturday.
1021
1022 An optional parameter MARK specifies a face or single-character string to
1023 use when highlighting the day in the calendar."
1024   (let ((d (calendar-absolute-from-gregorian date)))
1025     (if (= (% d 7) 6) ;;  Saturday
1026         (let*
1027             ((h-year (extract-calendar-year
1028                       (calendar-hebrew-from-absolute d)))
1029              (rosh-hashanah
1030               (calendar-absolute-from-hebrew (list 7 1 h-year)))
1031              (passover
1032               (calendar-absolute-from-hebrew (list 1 15 h-year)))
1033              (rosh-hashanah-day
1034               (aref calendar-day-name-array (% rosh-hashanah 7)))
1035              (passover-day
1036               (aref calendar-day-name-array (% passover 7)))
1037              (long-h (hebrew-calendar-long-heshvan-p h-year))
1038              (short-k (hebrew-calendar-short-kislev-p h-year))
1039              (type (cond ((and long-h (not short-k)) "complete")
1040                          ((and (not long-h) short-k) "incomplete")
1041                          (t "regular")))
1042              (year-format
1043               (symbol-value
1044                (intern (format "hebrew-calendar-year-%s-%s-%s" ;; keviah
1045                                rosh-hashanah-day type passover-day))))
1046              (first-saturday ;; of Hebrew year
1047               (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
1048              (saturday ;; which Saturday of the Hebrew year
1049               (/ (- d first-saturday) 7))
1050              (parasha (aref year-format saturday)))
1051           (if parasha
1052               (cons mark
1053                     (format
1054                      "Parashat %s"
1055                      (if (listp parasha) ;; Israel differs from diaspora
1056                          (if (car parasha)
1057                              (format "%s (diaspora), %s (Israel)"
1058                                      (hebrew-calendar-parasha-name (car parasha))
1059                                      (hebrew-calendar-parasha-name (cdr parasha)))
1060                            (format "%s (Israel)"
1061                                    (hebrew-calendar-parasha-name (cdr parasha))))
1062                        (hebrew-calendar-parasha-name parasha)))))))))
1063
1064 (defvar hebrew-calendar-parashiot-names
1065 ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
1066  "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
1067  "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
1068  "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
1069  "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
1070  "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
1071  "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
1072  "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
1073  "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
1074   "The names of the parashiot in the Torah.")
1075
1076 ;; The seven ordinary year types (keviot)
1077
1078 (defconst hebrew-calendar-year-Saturday-incomplete-Sunday
1079   [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]
1080     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1081     43 44 45 46 47 48 49 50]
1082   "The structure of the parashiot.
1083 Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
1084 29 days), and has Passover start on Sunday.")
1085
1086 (defconst hebrew-calendar-year-Saturday-complete-Tuesday
1087   [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]
1088     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1089     43 44 45 46 47 48 49 [50 51]]
1090   "The structure of the parashiot.
1091 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1092 have 30 days), and has Passover start on Tuesday.")
1093
1094 (defconst hebrew-calendar-year-Monday-incomplete-Tuesday
1095   [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]
1096     23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1097     43 44 45 46 47 48 49 [50 51]]
1098   "The structure of the parashiot.
1099 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1100 have 29 days), and has Passover start on Tuesday.")
1101
1102 (defconst hebrew-calendar-year-Monday-complete-Thursday
1103   [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]
1104    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1105    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1106   "The structure of the parashiot.
1107 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
1108 30 days), and has Passover start on Thursday.")
1109
1110 (defconst hebrew-calendar-year-Tuesday-regular-Thursday
1111   [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]
1112    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1113    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1114   "The structure of the parashiot.
1115 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1116 Kislev has 30 days), and has Passover start on Thursday.")
1117
1118 (defconst hebrew-calendar-year-Thursday-regular-Saturday
1119   [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
1120    24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
1121    (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
1122    49 50]
1123   "The structure of the parashiot.
1124 Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
1125 Kislev has 30 days), and has Passover start on Saturday.")
1126
1127 (defconst hebrew-calendar-year-Thursday-complete-Sunday
1128   [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 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1130     43 44 45 46 47 48 49 50]
1131   "The structure of the parashiot.
1132 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
1133 have 30 days), and has Passover start on Sunday.")
1134
1135 ;; The seven leap year types (keviot)
1136
1137 (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
1138   [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
1139     23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
1140     43 44 45 46 47 48 49 [50 51]]
1141   "The structure of the parashiot.
1142 Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
1143 have 29 days), and has Passover start on Tuesday.")
1144
1145 (defconst hebrew-calendar-year-Saturday-complete-Thursday
1146   [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
1147    23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1148    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1149   "The structure of the parashiot.
1150 Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1151 have 30 days), and has Passover start on Thursday.")
1152
1153 (defconst hebrew-calendar-year-Monday-incomplete-Thursday
1154   [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
1155    23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1156    (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1157   "The structure of the parashiot.
1158 Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1159 have 29 days), and has Passover start on Thursday.")
1160
1161 (defconst hebrew-calendar-year-Monday-complete-Saturday
1162   [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
1163    23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1164    (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1165    (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1166   "The structure of the parashiot.
1167 Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
1168 30 days), and has Passover start on Saturday.")
1169
1170 (defconst hebrew-calendar-year-Tuesday-regular-Saturday
1171   [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
1172    23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1173    (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1174    (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1175   "The structure of the parashiot.
1176 Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1177 Kislev has 30 days), and has Passover start on Saturday.")
1178
1179 (defconst hebrew-calendar-year-Thursday-incomplete-Sunday
1180   [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
1181     23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1182     43 44 45 46 47 48 49 50]
1183   "The structure of the parashiot.
1184 Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
1185 have 29 days), and has Passover start on Sunday.")
1186
1187 (defconst hebrew-calendar-year-Thursday-complete-Tuesday
1188   [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
1189     23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1190     43 44 45 46 47 48 49 [50 51]]
1191   "The structure of the parashiot.
1192 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
1193 have 30 days), and has Passover start on Tuesday.")
1194
1195 (defun hebrew-calendar-parasha-name (p)
1196   "Name(s) corresponding to parasha P."
1197   (if (arrayp p);; combined parasha
1198       (format "%s/%s"
1199               (aref hebrew-calendar-parashiot-names (aref p 0))
1200               (aref hebrew-calendar-parashiot-names (aref p 1)))
1201     (aref hebrew-calendar-parashiot-names p)))
1202
1203 (provide 'cal-hebrew)
1204
1205 ;;; cal-hebrew.el ends here