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

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