lisp/calendar/cal-hebrew.el

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